{-# LANGUAGE RecordWildCards #-} import Affection import qualified SDL import qualified GEGL as G import qualified BABL as B import qualified Data.Map.Strict as M import Debug.Trace main :: IO () main = do conf <- return $ AffectionConfig { initComponents = All , windowTitle = "Affection: example00" , windowConfig = SDL.defaultWindow , preLoop = return () , eventLoop = handle , updateLoop = update , drawLoop = draw , loadState = load , cleanUp = clean } withAffection conf data UserData = UserData { nodeGraph :: M.Map String G.GeglNode , foreground :: G.GeglBuffer , lastTick :: Double } 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 $ props $ do prop "color1" $ G.RGBA 0.4 0.4 0.4 1 prop "color2" $ G.RGBA 0.6 0.6 0.6 1 traceM "checkerboard" over <- G.gegl_node_new_child root G.defaultOverOperation traceM "over" buffer <- G.gegl_buffer_new (Just $ G.GeglRectangle 0 0 800 600) =<< B.babl_format (B.PixelFormat B.RGBA B.CFfloat) sink <- G.gegl_node_new_child root $ G.Operation "gegl:copy-buffer" $ props $ prop "buffer" buffer traceM "buffer-sink" rect <- G.gegl_node_new_child root $ G.Operation "gegl:rectangle" $ props $ do prop "x" (0::Double) prop "y" (0::Double) prop "width" (20::Double) prop "height" (20::Double) prop "color" $ G.RGBA 1 0 0 0.5 traceM "rect" crop <- G.gegl_node_new_child root $ G.Operation "gegl:crop" $ props $ do prop "width" (800::Double) prop "height" (600::Double) G.gegl_node_link_many [checkerboard, over, crop, sink] _ <- G.gegl_node_connect_to rect "output" over "aux" traceM "connections made" myMap <- return $ M.fromList [ ("root" , root) , ("over" , over) , ("background" , checkerboard) , ("sink" , sink) , ("rect" , rect) , ("crop" , crop) ] traceM "loading complete" return $ UserData { nodeGraph = myMap , foreground = buffer , lastTick = 0 } -- drawInit :: Affection UserData () -- drawInit = do -- UserData{..} <- getAffection -- present (GeglRectangle 0 0 800 600) foreground True draw :: Affection UserData () draw = do UserData{..} <- getAffection process (nodeGraph M.! "sink") present (GeglRectangle 0 0 800 600) foreground True update :: Affection UserData () update = do traceM "updating" tick <- getTick ud <- getAffection putAffection $ ud { lastTick = tick } let dt = tick - lastTick ud return () traceM $ (show $ 1 / dt) ++ " FPS" handle :: SDL.EventPayload -> Affection UserData () handle (SDL.MouseMotionEvent dat) = do let (SDL.P (SDL.V2 x y)) = SDL.mouseMotionEventPos dat ud <- getAffection liftIO $ G.gegl_node_set (nodeGraph ud M.! "rect") $ G.Operation "" $ props $ do prop "x" (fromIntegral (x - 10) :: Double) prop "y" $ (fromIntegral (y - 10) :: Double) handle (SDL.WindowClosedEvent _) = do traceM "seeya!" quit handle _ = return () clean :: UserData -> IO () clean _ = return ()