{-# 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 -- } { coordinates :: (Double, Double) , 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 -- } return $ UserData { coordinates = (400, 300) , lastTick = 0 } -- drawInit :: Affection UserData () -- drawInit = do -- UserData{..} <- getAffection -- present (GeglRectangle 0 0 800 600) foreground True draw :: Affection UserData () draw = do UserData{..} <- getAffection traceM "loading" root <- liftIO $ G.gegl_node_new traceM "new root node" checkerboard <- liftIO $ 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 <- liftIO $ G.gegl_node_new_child root G.defaultOverOperation traceM "over" buffer <- liftIO $ G.gegl_buffer_new (Just $ G.GeglRectangle 0 0 800 600) =<< B.babl_format (B.PixelFormat B.RGBA B.CFfloat) sink <- liftIO $ G.gegl_node_new_child root $ G.Operation "gegl:copy-buffer" $ props $ prop "buffer" buffer traceM "buffer-sink" rect <- liftIO $ G.gegl_node_new_child root $ G.Operation "gegl:rectangle" $ props $ do prop "x" $ fst coordinates prop "y" $ snd coordinates prop "width" (20::Double) prop "height" (20::Double) prop "color" $ G.RGBA 1 0 0 0.5 traceM "rect" crop <- liftIO $ G.gegl_node_new_child root $ G.Operation "gegl:crop" $ props $ do prop "width" (800::Double) prop "height" (600::Double) liftIO $ G.gegl_node_link_many [checkerboard, over, crop, sink] _ <- liftIO $ 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" process (myMap M.! "sink") present (GeglRectangle 0 0 800 600) buffer True update :: Affection UserData () update = do traceM "updating" tick <- getElapsedTime ud <- getAffection putAffection $ ud { lastTick = tick } let dt = tick - lastTick ud return () traceM $ (show $ 1 / dt) ++ " FPS" handle (SDL.MouseMotionEvent dat) = do let (SDL.P (SDL.V2 x y)) = SDL.mouseMotionEventPos dat ud <- getAffection putAffection ud { coordinates = (fromIntegral (x - 10), fromIntegral (y - 10)) } -- 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 ()