new example

It's a rectangle following the mouse

affection.cabal

@@ -94,3 +94,20 @@ executable example01
                      , mtl
   else
     buildable:       False
+
+executable example02
+  hs-source-dirs:    examples
+  main-is:           example02.hs
+  ghc-options:       -threaded -Wall
+  default-language:  Haskell2010
+  default-extensions: OverloadedStrings
+  if flag(examples)
+    build-depends:     base
+                     , affection
+                     , sdl2
+                     , gegl
+                     , babl
+                     , containers
+                     , mtl
+  else
+    buildable:       False

examples/example02.hs

@@ -0,0 +1,136 @@
+{-# LANGUAGE RecordWildCards #-}
+
+import Affection
+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.Ptr (castPtr)
+import Foreign.Storable (peek)
+import Foreign.C.Types
+
+import Debug.Trace
+
+main :: IO ()
+main = do
+  conf <- return $ AffectionConfig
+    { initComponents = All
+    , windowTitle    = "Affection: example00"
+    , windowConfig   = SDL.defaultWindow
+    , drawLoop       = draw
+    , updateLoop     = update
+    , loadState      = load
+    , cleanUp        = clean
+    }
+  withAffection conf
+
+data UserData = UserData
+  { nodeGraph   :: M.Map String G.GeglNode
+  , foreground  :: G.GeglBuffer
+  , coordinates :: Maybe (Int, Int)
+  }
+
+data Particle = Particle
+  { particleCoords :: (Int, Int)
+  , particleTTL    :: Double
+  , particleVel    :: (Int, Int)
+  }
+
+load :: SDL.Surface -> IO UserData
+load surface = 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"
+  let SDL.Surface rawSurfacePtr _ = surface
+  -- display <- G.gegl_node_new_child root $ G.Operation "dodo:sdl-surface" $
+  --   [ G.Property "surface" $ G.PropertyPointer $ castPtr rawSurfacePtr ]
+  over <- G.gegl_node_new_child root G.defaultOverOperation
+  traceM "over"
+  buffer <- G.gegl_buffer_new (G.GeglRectangle 0 0 800 600) =<<
+    B.babl_format (B.PixelFormat B.RGBA B.CFfloat)
+  bufsrc <- G.gegl_node_new_child root $ G.bufferSourceOperation
+    [ G.Property "buffer" $ G.PropertyBuffer buffer
+    ]
+  traceM "buffer-source"
+  G.gegl_node_link_many [checkerboard, over]
+  G.gegl_node_connect_to bufsrc "output" over "aux"
+  traceM "connections made"
+  myMap <- return $ M.fromList
+    [ ("root"        , root)
+    , ("over"        , over)
+    -- , ("display"     , display)
+    , ("background"  , checkerboard)
+    , ("foreground"  , bufsrc)
+    ]
+  let roi = G.GeglRectangle 0 0 20 20
+  traceM "loading complete"
+  return $ UserData
+    { nodeGraph = myMap
+    , foreground = buffer
+    , coordinates = Nothing
+    }
+
+draw :: Affection UserData ()
+draw = do
+  traceM "drawing"
+  AffectionData{..} <- get
+  let UserData{..} = userState
+  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.RGBA B.CFu8)
+  SDL.V2 (CInt rw) (CInt rh) <- SDL.surfaceDimensions drawSurface
+  let (w, h) = (fromIntegral rw, fromIntegral rh)
+  maybe (return ()) (\(x, y) -> do
+    liftIO $ drawRect foreground (G.RGB 1 0 0) (Line 2) (G.GeglRectangle (x - 10) (y - 10) 20 20)
+    ) coordinates
+  -- liftIO $ G.gegl_node_process $ nodeGraph M.! "display"
+  liftIO $ G.gegl_node_blit
+    (nodeGraph M.! "over" :: 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
+  liftIO $ clearArea foreground (GeglRectangle 0 0 w h)
+
+update :: Double -> AffectionState (AffectionData UserData) IO ()
+update sec = do
+  traceM "updating"
+  -- liftIO $ delaySec 5
+  ad@AffectionData{..} <- get
+  let ud@UserData{..} = userState
+  traceM $ (show $ 1 / sec) ++ " FPS"
+  ev <- liftIO $ SDL.pollEvent
+  maybe (return ()) (\e ->
+    case SDL.eventPayload e of
+      SDL.MouseMotionEvent dat -> do
+        let (SDL.P (SDL.V2 x y)) = SDL.mouseMotionEventPos dat
+        put $ ad 
+          { userState = ud
+            { coordinates = Just (fromIntegral x, fromIntegral y)
+            }
+          }
+      SDL.WindowClosedEvent _ -> do
+        traceM "seeya!"
+        put $ ad
+          { quitEvent = True
+          }
+      _ ->
+        return ()
+    ) ev
+
+clean :: UserData -> IO ()
+clean _ = return ()