get first example somewhat working

affection.cabal

@@ -68,6 +68,11 @@ executable example00
   if flag(examples)
     build-depends:     base
                      , affection
+                     , sdl2
+                     , gegl
+                     , babl
+                     , containers
+                     , mtl
   else
     buildable:       False
 

examples/example00.hs

@@ -1,10 +1,85 @@
+{-# LANGUAGE RecordWildCards #-}
+
 import Affection
-import Affection.Render
+import qualified SDL
+import qualified SDL.Raw as Raw
+import qualified GEGL as G
+import qualified BABL as B
+import qualified Data.Map.Strict as M
+
+import Foreign.Storable (peek)
+import Foreign.C.Types  (CInt(..))
+
+import Debug.Trace
+
+-- main :: IO ()
+-- main = withAllAffection $
+--   withDefaultWindow "test" $ do
+--     changeColor $ RGBA 255 255 255 255
+--     clear
+--     present
+--     liftIO $ delaySec 2
 
 main :: IO ()
-main = withAllAffection $
-  withDefaultWindow "test" $ do
-    changeColor $ RGBA 255 255 255 255
-    clear
-    present
-    liftIO $ delaySec 2
+main = do
+  conf <- return $ AffectionConfig
+    { initComponents = All
+    , windowTitle    = "Affection: example00"
+    , windowConfig   = SDL.defaultWindow
+    , drawLoop       = draw
+    , updateLoop     = update
+    , loadState      = load
+    }
+  withAffection conf
+
+type UserData = M.Map String G.GeglNode
+
+load :: SDL.Surface -> IO UserData
+load _ = do
+  traceM "loading"
+  root <- G.gegl_node_new
+  traceM "new root node"
+  checkerboard <- G.gegl_node_new_child root $ G.checkerboardOperation
+    [ G.Property "color1" $ G.PropertyColor $ G.RGBA 0.4 0.4 0.4 1
+    , G.Property "color2" $ G.PropertyColor $ G.RGBA 0.6 0.6 0.6 1
+    ]
+  traceM "checkerboard"
+  myMap <- return $ M.fromList
+    [ ("root"        , root)
+    , ("checkerboard", checkerboard)
+    ]
+  traceM "loading complete"
+  return myMap
+
+draw :: AffectionState (AffectionData UserData) IO ()
+draw = do
+  traceM "drawing"
+  AffectionData{..} <- get
+  liftIO $ SDL.lockSurface drawSurface
+  pixels <- liftIO $ SDL.surfacePixels drawSurface
+  let SDL.Surface rawSurfacePtr _ = drawSurface
+  rawSurface <- liftIO $ peek rawSurfacePtr
+  pixelFormat <- liftIO $ peek $ Raw.surfaceFormat rawSurface
+  format <- liftIO $ (B.babl_format $ B.PixelFormat B.R'G'B'A B.CFu8)
+  SDL.V2 (CInt rw) (CInt rh) <- SDL.surfaceDimensions drawSurface
+  let (w, h) = (fromIntegral rw, fromIntegral rh)
+  liftIO $ G.gegl_node_blit
+    (userState M.! "checkerboard" :: G.GeglNode)
+    1
+    (G.GeglRectangle 0 0 w h)
+    format
+    pixels
+    (fromIntegral (Raw.pixelFormatBytesPerPixel pixelFormat) * w)
+    [G.GeglBlitDefault]
+  liftIO $ SDL.unlockSurface drawSurface
+  liftIO $ SDL.updateWindowSurface drawWindow
+
+update :: Double -> AffectionState (AffectionData UserData) IO ()
+update sec = do
+  traceM "updating"
+  -- traceM $ show sec
+  -- liftIO $ delaySec 5
+  -- ud@AffectionData{..} <- get
+  -- put $ ud
+  --   { quitEvent = True
+  --   }

src/Affection.hs

@@ -4,6 +4,8 @@ module Affection
     , withWindow
     , withDefaultWindow
     , delaySec
+    , get
+    , put
     , module Affection.Render
     , module Types
     ) where
@@ -31,30 +33,33 @@ withAffection conf@AffectionConfig{..} = do
       SDL.initializeAll
     Only is ->
       SDL.initialize is
+  G.gegl_init
   execTime <- newMVar =<< getTime Monotonic
   window <- SDL.createWindow windowTitle windowConfig
   surface <- SDL.getWindowSurface window
-  initContainer <- return $ AffectionData
-    { affectionConfig = conf
-    , quitEvent       = False
-    , userState       = userData
+  initContainer <- return . (\x -> AffectionData
+    -- { affectionConfig = conf
+    { quitEvent       = False
+    , userState       = x
     , drawWindow      = window
     , drawSurface     = surface
-    }
-  state <- newMVar initContainer
+    }) =<< loadState surface
   (res, nState) <- runStateT ( Types.runState $
     whileM_ (do
         current <- get
-        return $ Types.quitEvent current
+        return $ not $ Types.quitEvent current
       )
-      $ do
+      (do
         now      <- liftIO $ getTime Monotonic
         lastTime <- liftIO $ fromMaybe now <$> tryReadMVar execTime
         drawLoop
         updateLoop $ (fromIntegral $ toNanoSecs $ diffTimeSpec lastTime now) /
           (fromIntegral 10 ^ 9)
-        liftIO $ putMVar execTime $ now
+        _ <- liftIO $ swapMVar execTime $ now
+        return ()
+      )
     ) initContainer
+  G.gegl_exit
   SDL.quit
 
 withWindow :: Monad m => T.Text -> WindowConfig -> SDL.RendererConfig -> RenderT m a -> IO ()

src/Affection/Types.hs

@@ -26,18 +26,24 @@ import Control.Concurrent.MVar
 
 -- | Configuration for the aplication. needed at startup.
 data AffectionConfig us = AffectionConfig
-  { initComponents :: InitComponents                            -- ^ SDL components to initialize at startup
-  , windowTitle    :: T.Text                                    -- ^ Window title
-  , windowConfig   :: SDL.WindowConfig                          -- ^ Window configuration
-  , drawLoop       :: AffectionState (AffectionData us) IO (IO ()) -- ^ Some function. Type to be determined.
-  , updateLoop     :: Double -> AffectionState (AffectionData us) IO (IO ())       -- ^ main update function. Takes nanoseconds as input.
-  , userData       :: us
+  { initComponents :: InitComponents
+      -- ^ SDL components to initialize at startup
+  , windowTitle    :: T.Text
+      -- ^ Window title
+  , windowConfig   :: SDL.WindowConfig
+      -- ^ Window configuration
+  , drawLoop       :: AffectionState (AffectionData us) IO ()
+      -- ^ Function for updating graphics.
+  , updateLoop     :: Double -> AffectionState (AffectionData us) IO ()
+      -- ^ Main update function. Takes fractions of a second as input.
+  , loadState      :: SDL.Surface -> IO us
+      -- ^ Provide your own load function to create this data.
   }
 
 -- | Main type for defining the look, feel and action of the whole application.
 data AffectionData us = AffectionData
-  { affectionConfig :: AffectionConfig us -- ^ Application configuration.
-  , quitEvent       :: Bool               -- ^ Loop breaker.
+  -- { affectionConfig :: AffectionConfig us -- ^ Application configuration.
+  { quitEvent       :: Bool               -- ^ Loop breaker.
   , userState       :: us                 -- ^ State data provided by user
   , drawWindow      :: SDL.Window         -- ^ SDL window
   , drawSurface     :: SDL.Surface        -- ^ SDL surface