diff --git a/affection.cabal b/affection.cabal index 7a0a3c2..a63cb4d 100644 --- a/affection.cabal +++ b/affection.cabal @@ -122,6 +122,23 @@ executable example02 else buildable: False +executable example02.1 + hs-source-dirs: examples + main-is: example02.1.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 + executable example03 hs-source-dirs: examples main-is: example03.hs diff --git a/examples/example02.1.hs b/examples/example02.1.hs new file mode 100644 index 0000000..aa2d443 --- /dev/null +++ b/examples/example02.1.hs @@ -0,0 +1,169 @@ +{-# 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 ()