From ebc0eea6c76ba793cc5ff045e18a62e7d0fd4ddb Mon Sep 17 00:00:00 2001 From: nek0 Date: Mon, 26 Dec 2016 14:06:51 +0100 Subject: [PATCH] make previous examples work again --- affection.cabal | 64 ++++++++++++++-------------- examples/example00.hs | 20 +++------ examples/example01.hs | 98 ++++++++----------------------------------- examples/example03.hs | 2 +- 4 files changed, 57 insertions(+), 127 deletions(-) diff --git a/affection.cabal b/affection.cabal index 76b39b0..e88248e 100644 --- a/affection.cabal +++ b/affection.cabal @@ -64,39 +64,39 @@ library , glib -- , sdl2-image --- executable example00 --- hs-source-dirs: examples --- main-is: example00.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 example00 + hs-source-dirs: examples + main-is: example00.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 example01 --- hs-source-dirs: examples --- main-is: example01.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 example01 + hs-source-dirs: examples + main-is: example01.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 example02 hs-source-dirs: examples diff --git a/examples/example00.hs b/examples/example00.hs index 84b370d..f2569af 100644 --- a/examples/example00.hs +++ b/examples/example00.hs @@ -7,6 +7,8 @@ import qualified GEGL as G import qualified BABL as B import qualified Data.Map.Strict as M +import Control.Monad (when) + import Foreign.Storable (peek) import Foreign.C.Types (CInt(..)) @@ -36,7 +38,6 @@ main = do data UserData = UserData { nodeGraph :: M.Map String G.GeglNode - , elapsedTime :: Double } load :: SDL.Surface -> IO UserData @@ -69,7 +70,6 @@ load _ = do traceM "loading complete" return $ UserData { nodeGraph = myMap - , elapsedTime = 0 } draw :: Affection UserData () @@ -99,18 +99,10 @@ draw = do update :: Double -> Affection UserData () update sec = do traceM "updating" - -- liftIO $ delaySec 5 - ad@AffectionData{..} <- get - let ud@UserData{..} = userState - traceM $ show elapsedTime - if elapsedTime < 5 - then - put $ ad - { userState = ud - { elapsedTime = elapsedTime + sec - } - } - else + ad <- get + ud@UserData{..} <- getAffection + traceM $ (show $ 1 / sec) ++ " FPS" + when (elapsedTime ad > 5) $ put $ ad { quitEvent = True } diff --git a/examples/example01.hs b/examples/example01.hs index bb61e2b..89675e5 100644 --- a/examples/example01.hs +++ b/examples/example01.hs @@ -7,6 +7,8 @@ import qualified GEGL as G import qualified BABL as B import qualified Data.Map.Strict as M +import Control.Monad (when) + import Foreign.Storable (peek) import Foreign.C.Types @@ -37,7 +39,6 @@ main = do data UserData = UserData { nodeGraph :: M.Map String G.GeglNode , foreground :: G.GeglBuffer - , elapsedTime :: Double } load :: SDL.Surface -> IO UserData @@ -54,111 +55,48 @@ load _ = do traceM "over" buffer <- G.gegl_buffer_new (Just $ G.GeglRectangle 0 0 800 600) =<< B.babl_format (B.PixelFormat B.RGBA B.CFfloat) - bufsrc <- G.gegl_node_new_child root $ G.bufferSourceOperation + sink <- G.gegl_node_new_child root $ G.Operation "gegl:copy-buffer" [ G.Property "buffer" $ G.PropertyBuffer buffer ] traceM "buffer-source" - G.gegl_node_link checkerboard over - G.gegl_node_connect_to bufsrc "output" over "aux" + 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 "width" $ G.PropertyDouble 800 + , G.Property "height" $ G.PropertyDouble 600 + ] + G.gegl_node_link_many [checkerboard, over, crop, sink] + G.gegl_node_connect_to nop "output" over "aux" traceM "connections made" myMap <- return $ M.fromList [ ("root" , root) , ("over" , over) , ("background" , checkerboard) - , ("foreground" , bufsrc) + , ("sink" , sink) + , ("nop" , nop) ] let roi = G.GeglRectangle 0 0 20 20 - -- G.iterateOver - -- buffer - -- roi - -- (B.PixelFormat B.RGBA B.CFfloat) - -- G.GeglAccessReadWrite - -- G.GeglAbyssNone - -- (\(G.Pixel px py pc) -> - -- let dsqr = (((10 - px) ^ 2) + ((10 - py) ^ 2)) - -- (G.CVfloat (CFloat pr), G.CVfloat (CFloat pg), G.CVfloat (CFloat pb), G.CVfloat (CFloat pa)) = pc - -- dist = (sqrt (fromIntegral dsqr :: Float)) - -- in if dsqr < 100 - -- then - -- if dist < fromIntegral 9 - -- then - -- G.Pixel px py - -- ( G.CVfloat $ CFloat 0 - -- , G.CVfloat $ CFloat 0 - -- , G.CVfloat $ CFloat 0 - -- , G.CVfloat $ CFloat $ if pa < 1 then 1 else pa - -- ) - -- else - -- let alpha = fromIntegral 10 - dist - -- dst_a = pa - -- a = alpha + dst_a * (1 - alpha) - -- a_term = dst_a * (1 - alpha) - -- red = 0 * alpha + pr * a_term - -- gre = 0 * alpha + pg * a_term - -- blu = 0 * alpha + pb * a_term - -- in - -- G.Pixel px py - -- ( G.CVfloat $ CFloat $ red / a - -- , G.CVfloat $ CFloat $ gre / a - -- , G.CVfloat $ CFloat $ blu / a - -- , G.CVfloat $ CFloat $ if pa < alpha then alpha else pa - -- ) - -- else - -- G.Pixel px py pc - -- ) traceM "loading complete" return $ UserData { nodeGraph = myMap , foreground = buffer - , elapsedTime = 0 } draw :: Affection UserData () draw = do traceM "drawing" UserData{..} <- getAffection - -- AffectionData{..} <- get - -- let UserData{..} = userState - -- -- liftIO $ SDL.lockSurface drawSurface - -- pixels <- liftIO $ SDL.surfacePixels drawSurface - -- let SDL.Surface rawSurfacePtr _ = drawSurface - -- rawSurface <- liftIO $ peek rawSurfacePtr - -- pixelFormat <- liftIO $ peek $ Raw.surfaceFormat rawSurface - -- format <- liftIO $ (B.babl_format $ B.PixelFormat B.RGBA B.CFu8) - -- SDL.V2 (CInt rw) (CInt rh) <- SDL.surfaceDimensions drawSurface - -- let (w, h) = (fromIntegral rw, fromIntegral rh) - drawRect foreground (nodeGraph M.! "over") (G.RGB 1 0 0) (Line 2) (G.GeglRectangle 10 10 500 500) - -- liftIO $ G.gegl_node_blit - -- (nodeGraph M.! "over" :: G.GeglNode) - -- 1 - -- (G.GeglRectangle 0 0 w h) - -- format - -- pixels - -- (fromIntegral (Raw.pixelFormatBytesPerPixel pixelFormat) * w) - -- [G.GeglBlitDefault] - -- liftIO $ SDL.unlockSurface drawSurface - -- liftIO $ SDL.updateWindowSurface drawWindow + drawRect' (nodeGraph M.! "nop") (G.RGB 1 0 0) Fill (G.GeglRectangle 10 10 500 500) foreground + liftIO $ G.gegl_node_process $ nodeGraph M.! "sink" update :: Double -> AffectionState (AffectionData UserData) IO () update sec = do traceM "updating" -- liftIO $ delaySec 5 - ad@AffectionData{..} <- get - let ud@UserData{..} = userState + ad <- get + ud@UserData{..} <- getAffection traceM $ (show $ 1 / sec) ++ " FPS" - if elapsedTime < 20 - then do - fg <- liftIO $ G.gegl_buffer_get_extent foreground - _ <- liftIO $ G.gegl_buffer_set_extent foreground $ fg - { G.rectangleX = G.rectangleX fg + 1 - , G.rectangleY = G.rectangleY fg + 1 - } - put $ ad - { userState = ud - { elapsedTime = elapsedTime + sec - } - } - else + when (elapsedTime ad > 20) $ put $ ad { quitEvent = True } diff --git a/examples/example03.hs b/examples/example03.hs index 53af30b..8121058 100644 --- a/examples/example03.hs +++ b/examples/example03.hs @@ -53,7 +53,7 @@ load _ = do [G.Property "buffer" $ G.PropertyBuffer buffer ] traceM "buffer-sink" - nop <- G.gegl_node_new_child root $ G.Operation "nop" [] + 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 "width" $ G.PropertyDouble 800