switching to 3D

affection.cabal

@@ -72,6 +72,7 @@ library
                      , clock
                      , glib
                      , bytestring
+                     , OpenGL
                      -- , sdl2-image
 
 -- executable example00

src/Affection.hs

@@ -2,6 +2,7 @@
 {-# LANGUAGE BangPatterns #-}
 module Affection
     ( withAffection
+    , get
     , getAffection
     , putAffection
     -- , withWindow
@@ -13,7 +14,7 @@ module Affection
 import qualified SDL
 import qualified SDL.Internal.Numbered as SDL (toNumber)
 import qualified SDL.Raw as Raw
-import qualified GEGL as G
+-- import qualified GEGL as G
 
 import Data.Maybe
 import Data.IORef
@@ -39,6 +40,8 @@ import Affection.Actor as A
 import Affection.Animation as A
 import Affection.Util as A
 
+import Graphics.Rendering.OpenGL as GL (clear, flush, ClearBuffer(..))
+
 import qualified BABL as B
 
 -- | Main function which bootstraps everything else.
@@ -52,7 +55,7 @@ withAffection AffectionConfig{..} = do
       SDL.initializeAll
     Only is ->
       SDL.initialize is
-  G.gegl_init
+  -- G.gegl_init
   -- give SDL render quality
   SDL.HintRenderScaleQuality SDL.$= SDL.ScaleLinear
   -- just checking…
@@ -63,35 +66,36 @@ withAffection AffectionConfig{..} = do
   -- construct window
   window <- SDL.createWindow windowTitle windowConfig
   SDL.showWindow window
-  -- create renderer
+  context <- SDL.glCreateContext(window)
-  renderer <- SDL.createRenderer
+  -- -- create renderer
-    window
+  -- renderer <- SDL.createRenderer
-    (-1)
+  --   window
-    SDL.defaultRenderer
+  --   (-1)
-  -- make draw texture
+  --   SDL.defaultRenderer
-  texture <- SDL.createTexture
+  -- -- make draw texture
-    renderer
+  -- texture <- SDL.createTexture
-    SDL.ABGR8888
+  --   renderer
-    SDL.TextureAccessStreaming
+  --   SDL.ABGR8888
-    (case canvasSize of
+  --   SDL.TextureAccessStreaming
-      Just (cw, ch) -> (SDL.V2
+  --   (case canvasSize of
-        (CInt $ fromIntegral cw)
+  --     Just (cw, ch) -> (SDL.V2
-        (CInt $ fromIntegral ch)
+  --       (CInt $ fromIntegral cw)
-        )
+  --       (CInt $ fromIntegral ch)
-      Nothing ->
+  --       )
-        SDL.windowInitialSize windowConfig
+  --     Nothing ->
-      )
+  --       SDL.windowInitialSize windowConfig
-  -- make draw surface
+  --     )
-  -- pixelFormat <- liftIO $ peek . Raw.surfaceFormat =<< peek ptr
+  -- -- make draw surface
+  -- -- pixelFormat <- liftIO $ peek . Raw.surfaceFormat =<< peek ptr
   let SDL.V2 (CInt rw) (CInt rh) = windowInitialSize windowConfig
       (w, h) = case canvasSize of
         Just (cw, ch) -> (cw, ch)
         Nothing       -> (fromIntegral rw, fromIntegral rh)
-      -- stride = fromIntegral (Raw.pixelFormatBytesPerPixel pixelFormat) * w
+  --     -- stride = fromIntegral (Raw.pixelFormatBytesPerPixel pixelFormat) * w
-      bablFormat = B.PixelFormat B.RGBA B.CFu8
+  --     bablFormat = B.PixelFormat B.RGBA B.CFu8
-      cpp        = B.babl_components_per_pixel bablFormat
+  --     cpp        = B.babl_components_per_pixel bablFormat
-      !stride    = cpp * w
+  --     !stride    = cpp * w
-  format <- B.babl_format bablFormat
+  -- format <- B.babl_format bablFormat
   -- get current time
   SDL.setWindowMode window initScreenMode
   execTime <- getTime Monotonic
@@ -99,15 +103,16 @@ withAffection AffectionConfig{..} = do
     { quitEvent       = False
     , userState       = x
     , drawWindow      = window
-    , windowRenderer  = renderer
+    , glContext       = context
-    , drawTexture     = texture
+    -- , windowRenderer  = renderer
-    , drawFormat      = format
+    -- , drawTexture     = texture
+    -- , drawFormat      = format
     , drawDimensions  = case canvasSize of
         Just (cw, ch) -> (cw, ch)
         Nothing       -> (w, h)
     , screenMode      = initScreenMode
-    , drawStride      = stride
+    -- , drawStride      = stride
-    , drawCPP         = cpp
+    -- , drawCPP         = cpp
     , drawStack       = []
     , elapsedTime     = 0
     , deltaTime       = 0
@@ -126,8 +131,8 @@ withAffection AffectionConfig{..} = do
         -- Measure time difference form last run
         now      <- liftIO $ getTime Monotonic
         let lastTime = sysTime ad
-        -- clean draw requests from last run
+        -- -- clean draw requests from last run
-        MP.mapM_ (invalidateDrawRequest (drawStride ad) (drawCPP ad)) (drawStack ad)
+        -- MP.mapM_ (invalidateDrawRequest (drawStride ad) (drawCPP ad)) (drawStack ad)
         -- clean the renderer form last time
         -- SDL.clear renderer
         -- compute dt and update elapsedTime
@@ -144,16 +149,19 @@ withAffection AffectionConfig{..} = do
         -- execute user defined update loop
         unless (pausedTime ad) (updateLoop dt)
         -- execute user defined draw loop
+        liftIO $ GL.clear [ColorBuffer, DepthBuffer]
         drawLoop
+        liftIO $ flush
         -- handle all new draw requests
         ad2 <- get
-        clear <- catMaybes <$>
+        -- clear <- catMaybes <$>
-          MP.mapM (handleDrawRequest (drawStride ad) (drawCPP ad)) (drawStack ad2)
+        --   MP.mapM (handleDrawRequest (drawStride ad) (drawCPP ad)) (drawStack ad2)
-        -- save all draw requests to clear in next run
+        -- -- save all draw requests to clear in next run
-        put $ ad2
+        -- put $ ad2
-          { drawStack = clear }
+        --   { drawStack = clear }
         -- actual drawing
-        SDL.present (windowRenderer ad2)
+        SDL.glSwapWindow window
+        -- SDL.present (windowRenderer ad2)
         -- save new time
         ad3 <- get
         when (sysTime ad == sysTime ad3) (
@@ -163,7 +171,7 @@ withAffection AffectionConfig{..} = do
           )
       )
     ) initContainer
-  G.gegl_exit
+  -- G.gegl_exit
   cleanUp $ userState nState
   SDL.destroyWindow window
   SDL.quit

src/Affection/Types.hs

@@ -86,6 +86,7 @@ data AffectionData us = AffectionData
   { quitEvent       :: Bool               -- ^ Loop breaker.
   , userState       :: us                 -- ^ State data provided by user
   , drawWindow      :: SDL.Window         -- ^ SDL window
+  , glContext       :: SDL.GLContext      -- ^ OpenGL rendering context
   , windowRenderer  :: SDL.Renderer       -- ^ Internal renderer of window
   , drawTexture     :: SDL.Texture        -- ^ SDL Texture to draw to
   , drawFormat      :: B.BablFormatPtr    -- ^ Target format