new example

examples/example04.hs

@@ -0,0 +1,120 @@
+{-# LANGUAGE RecordWildCards #-}
+
+import Affection
+import qualified SDL
+import qualified GEGL as G
+import qualified BABL as B
+import qualified BABL.FFI.Format as B
+import qualified Data.Map.Strict as M
+
+import Foreign.C.Types
+import Foreign.Ptr (castPtr, nullPtr)
+import Foreign.Marshal.Utils (new)
+
+import System.Random (randomRIO)
+
+import Control.Monad (unless)
+
+import Debug.Trace
+
+main :: IO ()
+main = do
+  conf <- return $ AffectionConfig
+    { initComponents = All
+    , windowTitle    = "Affection: example00"
+    , windowConfig   = SDL.defaultWindow
+    , preLoop        = return ()
+    , drawLoop       = draw
+    , updateLoop     = update
+    , loadState      = load
+    , cleanUp        = clean
+    }
+  withAffection conf
+
+data UserData = UserData
+  { nodeGraph   :: M.Map String G.GeglNode
+  , coordinates :: Maybe (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"
+  over <- G.gegl_node_new_child root G.defaultOverOperation
+  traceM "over"
+  nop <- G.gegl_node_new_child root $ G.Operation "gegl:nop" []
+  traceM "nop"
+  crop <- G.gegl_node_new_child root $ G.Operation "gegl:crop"
+    [ G.Property "x" $ G.PropertyDouble 0
+    , G.Property "y" $ G.PropertyDouble 0
+    , G.Property "width" $ G.PropertyDouble 800
+    , G.Property "height" $ G.PropertyDouble 600
+    ]
+  traceM "crop"
+  format <- B.babl_format $ B.PixelFormat B.RGBA B.CFu8
+  pixels <- liftIO $ new =<< SDL.surfacePixels surface
+  sink <- G.gegl_node_new_child root $ G.Operation "gegl:buffer-sink"
+    [ G.Property "buffer" $ G.PropertyPointer $ castPtr $ pixels
+    , G.Property "format" $ G.PropertyPointer $ nullPtr
+    ]
+  traceM "sink"
+  G.gegl_node_link_many [checkerboard, over, crop, sink]
+  diw <- G.gegl_node_connect_to nop "output" over "aux"
+  unless diw (error "connect failed")
+  traceM "connections made"
+  myMap <- return $ M.fromList
+    [ ("root"        , root)
+    , ("over"        , over)
+    , ("background"  , checkerboard)
+    , ("nop"         , nop)
+    , ("crop"        , crop)
+    , ("sink"        , sink)
+    ]
+  traceM "loading complete"
+  return $ UserData
+    { nodeGraph = myMap
+    , coordinates = Nothing
+    }
+
+update :: Double -> AffectionState (AffectionData UserData) IO ()
+update sec = do
+  traceM "updating"
+  ad <- get
+  ud <- getAffection
+  traceM $ (show $ 1 / sec) ++ " FPS"
+  ev <- liftIO $ SDL.pollEvents
+  mapM_ (\e ->
+    case SDL.eventPayload e of
+      SDL.MouseButtonEvent dat -> do
+        let (SDL.P (SDL.V2 x y)) = SDL.mouseButtonEventPos dat
+        drawRect
+          (nodeGraph ud M.! "nop")
+          (G.RGBA 1 0 0 0.5)
+          Fill
+          (G.GeglRectangle (fromIntegral x - 10) (fromIntegral y - 10) 20 20)
+        traceM $ "drewn a rectangle at " ++ show x ++ " " ++ show y
+      SDL.WindowClosedEvent _ -> do
+        traceM "seeya!"
+        put $ ad
+          { quitEvent = True
+          }
+      _ ->
+        return ()
+    ) ev
+
+draw :: Affection UserData ()
+draw = do
+  ad <- get
+  ud <- getAffection
+  liftIO $ SDL.lockSurface $ drawSurface ad
+  liftIO $ G.gegl_node_process (nodeGraph ud M.! "sink")
+  liftIO $ SDL.unlockSurface $ drawSurface ad
+
+clean :: UserData -> IO ()
+clean _ = return ()