diff --git a/examples/example04.hs b/examples/example04.hs new file mode 100644 index 0000000..a720487 --- /dev/null +++ b/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 ()