From 40d88c4fd2c0ed01b36731c17ac48a57a3a44bb7 Mon Sep 17 00:00:00 2001 From: nek0 Date: Sun, 11 Dec 2016 12:11:58 +0100 Subject: [PATCH] new example It's a rectangle following the mouse --- affection.cabal | 17 ++++++ examples/example02.hs | 136 ++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 153 insertions(+) create mode 100644 examples/example02.hs diff --git a/affection.cabal b/affection.cabal index 4c15e11..c5fc553 100644 --- a/affection.cabal +++ b/affection.cabal @@ -94,3 +94,20 @@ executable example01 , mtl else buildable: False + +executable example02 + hs-source-dirs: examples + main-is: example02.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 diff --git a/examples/example02.hs b/examples/example02.hs new file mode 100644 index 0000000..f32721c --- /dev/null +++ b/examples/example02.hs @@ -0,0 +1,136 @@ +{-# LANGUAGE RecordWildCards #-} + +import Affection +import qualified SDL +import qualified SDL.Raw as Raw +import qualified GEGL as G +import qualified BABL as B +import qualified Data.Map.Strict as M + +import Foreign.Ptr (castPtr) +import Foreign.Storable (peek) +import Foreign.C.Types + +import Debug.Trace + +main :: IO () +main = do + conf <- return $ AffectionConfig + { initComponents = All + , windowTitle = "Affection: example00" + , windowConfig = SDL.defaultWindow + , drawLoop = draw + , updateLoop = update + , loadState = load + , cleanUp = clean + } + withAffection conf + +data UserData = UserData + { nodeGraph :: M.Map String G.GeglNode + , foreground :: G.GeglBuffer + , coordinates :: Maybe (Int, Int) + } + +data Particle = Particle + { particleCoords :: (Int, Int) + , particleTTL :: Double + , particleVel :: (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" + let SDL.Surface rawSurfacePtr _ = surface + -- display <- G.gegl_node_new_child root $ G.Operation "dodo:sdl-surface" $ + -- [ G.Property "surface" $ G.PropertyPointer $ castPtr rawSurfacePtr ] + over <- G.gegl_node_new_child root G.defaultOverOperation + traceM "over" + buffer <- G.gegl_buffer_new (G.GeglRectangle 0 0 800 600) =<< + B.babl_format (B.PixelFormat B.RGBA B.CFfloat) + bufsrc <- G.gegl_node_new_child root $ G.bufferSourceOperation + [ G.Property "buffer" $ G.PropertyBuffer buffer + ] + traceM "buffer-source" + G.gegl_node_link_many [checkerboard, over] + G.gegl_node_connect_to bufsrc "output" over "aux" + traceM "connections made" + myMap <- return $ M.fromList + [ ("root" , root) + , ("over" , over) + -- , ("display" , display) + , ("background" , checkerboard) + , ("foreground" , bufsrc) + ] + let roi = G.GeglRectangle 0 0 20 20 + traceM "loading complete" + return $ UserData + { nodeGraph = myMap + , foreground = buffer + , coordinates = Nothing + } + +draw :: Affection UserData () +draw = do + traceM "drawing" + 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) + maybe (return ()) (\(x, y) -> do + liftIO $ drawRect foreground (G.RGB 1 0 0) (Line 2) (G.GeglRectangle (x - 10) (y - 10) 20 20) + ) coordinates + -- liftIO $ G.gegl_node_process $ nodeGraph M.! "display" + 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 + liftIO $ clearArea foreground (GeglRectangle 0 0 w h) + +update :: Double -> AffectionState (AffectionData UserData) IO () +update sec = do + traceM "updating" + -- liftIO $ delaySec 5 + ad@AffectionData{..} <- get + let ud@UserData{..} = userState + traceM $ (show $ 1 / sec) ++ " FPS" + ev <- liftIO $ SDL.pollEvent + maybe (return ()) (\e -> + case SDL.eventPayload e of + SDL.MouseMotionEvent dat -> do + let (SDL.P (SDL.V2 x y)) = SDL.mouseMotionEventPos dat + put $ ad + { userState = ud + { coordinates = Just (fromIntegral x, fromIntegral y) + } + } + SDL.WindowClosedEvent _ -> do + traceM "seeya!" + put $ ad + { quitEvent = True + } + _ -> + return () + ) ev + +clean :: UserData -> IO () +clean _ = return ()