packages feed

pine 0.1.0.2 → 0.1.0.3

raw patch · 9 files changed

+314/−177 lines, 9 filesdep +lineardep +mtldep ~sdl2new-component:exe:pine-fps-exe

Dependencies added: linear, mtl

Dependency ranges changed: sdl2

Files

README.md view
@@ -9,7 +9,9 @@  <br> -Currently a Work In Progress, but technically functional. Documentation is currently minimal and that is something I'm working on, as well as everything else+Currently a Work In Progress, but technically barely functional. The example in the app folder works, it displays an 800x800 window with the Pine logo.++Documentation is currently minimal and that is something I'm working on, as well as everything else.  ### TODO:
+ app/FPS.hs view
@@ -0,0 +1,40 @@+{-# LANGUAGE OverloadedStrings #-}++module Main where++import Pine+import qualified SDL+import Control.Monad.State++-- define the state of the game+data App = App+  { logo :: Image+  , frames :: (Int, Double)+  }++gameInit =+  App+    (newImage "src/Media/logo.png" Nothing (Just $ rect 200 200 400 400))+    (0,0)++inc :: DeltaTime -> PineState App+inc dt =+  with $ \state ->+    let (count,accum) = frames state+    in (Cont, state {frames = (count+1, accum+dt)})++instance Stateful App where+  update _ WindowClose               = quit+  update _ (KeyPressed SDL.KeycodeQ) = do+    appState <- get+    let (count,accum) = frames appState+    quitLog $ "Average FPS: " <> show (1 / (accum / fromIntegral count))+  update dt Step                     = inc dt+  update _ _                         = cont++instance Drawable App where+  draw = fromImage . logo++-- | This simply opens a window with the Pine logo displayed+main :: IO ()+main = pine "Pine" withDefaultConfig gameInit
app/Main.hs view
@@ -1,6 +1,24 @@+{-# LANGUAGE OverloadedStrings #-}+ module Main where  import Pine+import qualified SDL +-- define the state of the game+data DefaultState = Logo Image++defaultInitial = Logo $ newImage "src/Media/logo.png" Nothing (Just $ rect 200 200 400 400)++instance Stateful DefaultState where+  update _ Load                      = return $ Log "Hello, Pine!"+  update _ WindowClose               = return Quit+  update _ (KeyPressed SDL.KeycodeQ) = return $ QuitWithLog "Goodbye, Pine!"+  update _ _                         = return Cont++instance Drawable DefaultState where+  draw (Logo img) = fromImage img++-- | This simply opens a window with the Pine logo displayed main :: IO ()-main = runDefault+main = pine "Pine" withDefaultConfig defaultInitial
pine.cabal view
@@ -1,13 +1,13 @@ cabal-version: 2.2 --- This file has been generated from package.yaml by hpack version 0.31.2.+-- This file has been generated from package.yaml by hpack version 0.33.0. -- -- see: https://github.com/sol/hpack ----- hash: c6906bc45dcc27ae37ed3ac5ae2e0ab85f7cbd22e891ba597dca6603e515ea25+-- hash: 599ef45b2d5a0dd0ba895eee72f9fd8f6e8f6fa7a4bfab1b8bb0f7dc90696ef4  name:           pine-version:        0.1.0.2+version:        0.1.0.3 synopsis:       Functional 2D Game Framework description:    Please see the README on GitHub at <https://github.com/grinshpon/pine#readme> category:       Game@@ -32,14 +32,16 @@       Pine       Pine.Internal       Pine.Internal.Keyboard-      Pine.Internal.Renderer+      Pine.Internal.Pine       Pine.Internal.Types   hs-source-dirs:       src   build-depends:       base >=4.7 && <5     , containers >=0.6 && <0.7-    , sdl2 >=2.4 && <2.5+    , linear+    , mtl >=2.2+    , sdl2 >=2.5     , sdl2-image >=0.1 && <2.1     , stm >=2.4 && <2.6     , text >=1.2.3 && <1.3@@ -53,13 +55,32 @@   build-depends:       base >=4.7 && <5     , containers >=0.6 && <0.7+    , linear+    , mtl >=2.2     , pine-    , sdl2 >=2.4 && <2.5+    , sdl2 >=2.5     , sdl2-image >=0.1 && <2.1     , stm >=2.4 && <2.6     , text >=1.2.3 && <1.3   default-language: Haskell2010 +executable pine-fps-exe+  main-is: FPS.hs+  hs-source-dirs:+      app+  ghc-options: -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      base >=4.7 && <5+    , containers >=0.6 && <0.7+    , linear+    , mtl >=2.2+    , pine+    , sdl2 >=2.5+    , sdl2-image >=0.1 && <2.1+    , stm >=2.4 && <2.6+    , text >=1.2.3 && <1.3+  default-language: Haskell2010+ test-suite pine-test   type: exitcode-stdio-1.0   main-is: Spec.hs@@ -69,8 +90,10 @@   build-depends:       base >=4.7 && <5     , containers >=0.6 && <0.7+    , linear+    , mtl >=2.2     , pine-    , sdl2 >=2.4 && <2.5+    , sdl2 >=2.5     , sdl2-image >=0.1 && <2.1     , stm >=2.4 && <2.6     , text >=1.2.3 && <1.3
src/Pine.hs view
@@ -1,20 +1,20 @@- -- | Everything you need is reixported by Pine, so you do not need to import any of the internal modules. module Pine-  ( runDefault-  , pine+  ( pine+  , withDefaultConfig+  , with   , Drawable(..)   , Stateful(..)+  , PineState+  , Return(..)+  , cont,quit,contLog,quitLog   , Image(..)   , newImage+  , rect   , Scene   , fromImage   , Event(..)+  , DeltaTime   ) where  import Pine.Internal----- | Run the default program, which displays the Pine logo-runDefault :: IO ()-runDefault = defaultApp
src/Pine/Internal.hs view
@@ -1,8 +1,7 @@ module Pine.Internal-  ( Pine.Internal.Renderer.defaultApp-  , Pine.Internal.Renderer.pine+  ( module Pine.Internal.Pine   , module Pine.Internal.Types   ) where -import Pine.Internal.Renderer+import Pine.Internal.Pine import Pine.Internal.Types
+ src/Pine/Internal/Pine.hs view
@@ -0,0 +1,140 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE LambdaCase #-}++module Pine.Internal.Pine+  ( pine+  , withDefaultConfig+  , with+  ) where++import Pine.Internal.Types++import qualified SDL+import qualified SDL.Image as SDLI+import Control.Concurrent.STM++import Data.Text (Text)+import Data.Map (Map)+import qualified Data.Map as M+import Control.Monad+import Control.Monad.State+import Data.Word (Word32)++type TextureCache = Map FilePath SDL.Texture++-- | This function initializes the window and takes an initial `Stateful` object that will be updated.+pine :: (Stateful s, Drawable s)+     => Text -- ^ Title+     -> SDL.WindowConfig -- ^ Window Configuration+     -> s -- ^ Initial state+     -> IO ()+pine title windowConfig state_ = do+  SDL.initializeAll+  window <- SDL.createWindow title windowConfig+  renderer <- SDL.createRenderer window (-1) $ SDL.RendererConfig+    { SDL.rendererType = SDL.AcceleratedRenderer+    , SDL.rendererTargetTexture = False+    }+  let+    appLoop :: TextureCache -> IO ()+    appLoop cache = do+      updateQueue <- newTChanIO+      timer <- SDL.addTimer 16 (fpsTimer updateQueue)+      time <- SDL.ticks+      dcache <- updateEvents (fromIntegral time / 1000) [Load] state_ >>= \case+        Just loadState -> SDL.pollEvents >>= appStep time updateQueue cache loadState+        Nothing        -> pure cache+      _ <- SDL.removeTimer timer+      foldMap SDL.destroyTexture dcache+      SDL.destroyRenderer renderer+      SDL.destroyWindow window++    appStep :: (Stateful s, Drawable s) => Word32 -> TChan () -> TextureCache -> s -> [SDL.Event] -> IO TextureCache+    appStep time updateQueue cache state sdlEvents = do+      atomically $ readTChan updateQueue -- not ideal, events could get backed up+      time' <- SDL.ticks+      let dt = (fromIntegral (time' - time) :: Double) / 1000+      --print $ 1/dt+      cache' <- drawScene cache $ draw state+--      mousePos <- SDL.getModalMouseLocation >>= \case  --waiting for PR to be merged on sdl2+--        SDL.AbsoluteModalLocation (SDL.P pos) -> pos+--        SDL.RelativeModalLocation pos -> pos+      let pineEvents = eventState sdlEvents+      updateEvents dt (Step:pineEvents) state >>= \case+        Just newState -> SDL.pollEvents >>= appStep time' updateQueue cache' newState+        Nothing       -> pure cache'+      where+        eventState events =+          case events of+            [] -> []+            (ev:evs) ->+              [SDLEvent ev] <> case SDL.eventPayload ev of+                SDL.WindowClosedEvent _ -> [WindowClose] <> (eventState evs)+                SDL.KeyboardEvent keyboardEvent ->+                  case SDL.keyboardEventKeyMotion keyboardEvent of+                    SDL.Pressed  -> [KeyPressed  (SDL.keysymKeycode (SDL.keyboardEventKeysym keyboardEvent))] <> (eventState evs)+                    SDL.Released -> [KeyReleased (SDL.keysymKeycode (SDL.keyboardEventKeysym keyboardEvent))] <> (eventState evs)+                SDL.MouseMotionEvent mmeData -> [MouseMoved (SDL.mouseMotionEventRelMotion mmeData)] <> (eventState evs) -- maybe include new position as well+                _ -> (eventState evs)++    updateEvents :: (Stateful s, Drawable s) => DeltaTime -> [Event] -> s -> IO (Maybe s)+    updateEvents _  []     state = pure $ Just state+    updateEvents dt (e:es) state = do+      let (r, nState) = runState (update dt e) state+      case r of+        Cont          -> updateEvents dt es nState+        Log s         -> putStrLn s *> (updateEvents dt es nState)+        QuitWithLog s -> putStrLn s *> (pure $ Nothing)+        Quit          -> pure $ Nothing++    fpsTimer :: TChan () -> Word32 -> IO SDL.RetriggerTimer+    fpsTimer updateQueue _ = do+      atomically $ writeTChan updateQueue ()+      pure $ SDL.Reschedule 16++    drawScene :: TextureCache -> Scene -> IO TextureCache+    drawScene cache canvas = do+      SDL.clear renderer+      cache' <- drawScene' cache canvas+      SDL.present renderer+      pure cache'++    drawScene' :: TextureCache -> Scene -> IO TextureCache+    drawScene' cache canvas = do+      case canvas of+        SingleScene m -> loadMedia cache [m]+        MultiScene ms -> loadMedia cache ms+        EmptyScene    -> pure cache++    loadMedia :: TextureCache -> [Media] -> IO TextureCache+    loadMedia cache [] = pure cache+    loadMedia cache (m:imgs) =+      case m of+        MImage img ->+          case cache M.!? (imageSrc img) of+            Nothing -> do+              tex <- SDLI.loadTexture renderer (imageSrc img)+              SDL.copy renderer tex Nothing Nothing+              loadMedia (M.insert (imageSrc img) tex cache) imgs+            Just tex -> do+              SDL.copy renderer tex (imageQuad img) (imageRect img)+              loadMedia cache imgs+        _ -> loadMedia cache imgs++   in appLoop mempty++withDefaultConfig = SDL.WindowConfig+  { SDL.windowBorder        = True+  , SDL.windowHighDPI       = False+  , SDL.windowInputGrabbed  = False+  , SDL.windowMode          = SDL.Windowed+  , SDL.windowGraphicsContext = SDL.NoGraphicsContext+  , SDL.windowPosition      = SDL.Wherever+  , SDL.windowResizable     = True+  , SDL.windowInitialSize   = SDL.V2 800 800+  , SDL.windowVisible       = True+  }++with :: (MonadState s m) => (s -> (a,s)) -> m a+with = state
− src/Pine/Internal/Renderer.hs 
@@ -1,142 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE LambdaCase #-}--module Pine.Internal.Renderer-  ( defaultApp-  , pine-  ) where--import Pine.Internal.Types--import qualified SDL-import qualified SDL.Image as SDLI-import Control.Concurrent.STM--import Data.Text (Text)-import Data.Map (Map)-import qualified Data.Map as M-import Control.Monad-import Data.Word (Word32)--type TextureCache = Map FilePath SDL.Texture---- | This function initializes the window and takes an initial `Stateful` object that will be updated.-pine :: (Stateful s, Drawable s)-     => Text-     -> SDL.WindowConfig-     -> s-     -> IO ()-pine title windowConfig state_ = do-  SDL.initializeAll-  window <- SDL.createWindow title windowConfig-  renderer <- SDL.createRenderer window (-1) $ SDL.RendererConfig-    { SDL.rendererType = SDL.AcceleratedRenderer-    , SDL.rendererTargetTexture = False-    }-  let-    appLoop :: TextureCache -> IO ()-    appLoop cache = do-      updateQueue <- newTChanIO-      timer <- SDL.addTimer 16 (fpsTimer updateQueue)-      time <- SDL.ticks-      SDL.pollEvent >>= go time updateQueue cache state_-      _ <- SDL.removeTimer timer-      pure ()--    go :: (Stateful s, Drawable s) => Word32 -> TChan () -> TextureCache -> s -> Maybe SDL.Event -> IO ()-    go time updateQueue cache state mevent = do-      atomically $ readTChan updateQueue -- not ideal, events could get backed up-      time' <- SDL.ticks-      let dt = (fromIntegral (time' - time) :: Double) / 1000-      --print $ 1/dt-      cache' <- drawScene cache $ draw state-      case mevent of-        Nothing -> SDL.pollEvent >>= go time' updateQueue cache' (update (DeltaTime dt) state)-        Just ev -> case SDL.eventPayload ev of-          SDL.WindowClosedEvent _ -> pure ()-          _ -> SDL.pollEvent >>= go time' updateQueue cache' (update (SDLEvent ev) $ update (DeltaTime dt) state)--    fpsTimer :: TChan () -> Word32 -> IO SDL.RetriggerTimer-    fpsTimer updateQueue _ = do-      atomically $ writeTChan updateQueue ()-      pure $ SDL.Reschedule 16--    drawScene :: TextureCache -> Scene -> IO TextureCache-    drawScene cache canvas = do-      SDL.clear renderer-      cache' <- drawScene' cache canvas-      SDL.present renderer-      pure cache'--    drawScene' :: TextureCache -> Scene -> IO TextureCache-    drawScene' cache canvas = do-      case canvas of-        SingleImage img -> drawImages cache [img]-        Images imgs -> drawImages cache imgs-        EmptyScene -> pure cache--    drawImages :: TextureCache -> [Image] -> IO TextureCache-    drawImages cache [] = pure cache-    drawImages cache (img:imgs) =-      case cache M.!? (imageSrc img) of-        Nothing -> do-          tex <- SDLI.loadTexture renderer (imageSrc img)-          SDL.copy renderer tex Nothing Nothing-          drawImages (M.insert (imageSrc img) tex cache) imgs-        Just tex -> do-          SDL.copy renderer tex Nothing Nothing-          drawImages cache imgs--   in appLoop mempty--data DefaultState = Logo Image--instance Stateful DefaultState where-  initial = Logo $ newImage "src/Media/logo.png"-  update = const id--instance Drawable DefaultState where-  draw (Logo img) = fromImage img---- | This simply opens a window with the Pine logo displayed-defaultApp :: IO ()-defaultApp = pine "Pine" defaultConfig (initial :: DefaultState)-  where-    defaultConfig = SDL.WindowConfig-      { SDL.windowBorder        = True-      , SDL.windowHighDPI       = False-      , SDL.windowInputGrabbed  = False-      , SDL.windowMode          = SDL.Windowed-      , SDL.windowOpenGL        = Nothing-      , SDL.windowPosition      = SDL.Wherever-      , SDL.windowResizable     = True-      , SDL.windowInitialSize   = SDL.V2 800 800-      , SDL.windowVisible       = True-      }--{--  addEventWatch $ \ev ->-    case eventPayload ev of-      WindowSizeChangedEvent sizeChangeData ->-        putStrLn $ "eventWatch windowSizeChanged: " ++ show sizeChangeData-      KeyboardEvent kev ->-        putStrLn "key event"-      _ -> return ()-  appLoop mempty-    where-      appLoop :: TextureCache -> IO ()-      appLoop tc = pollEvent >>= go tc--      go :: TextureCache -> Maybe Event -> IO ()-      go tc = \case-        Nothing -> pollEvent >>= go tc-        Just ev -> case eventPayload ev of-          KeyboardEvent keyboardEvent-            |  keyboardEventKeyMotion keyboardEvent == Pressed &&-               keysymKeycode (keyboardEventKeysym keyboardEvent) == KeycodeQ-            -> return ()-          _ -> pollEvent >>= go tc-----}
src/Pine/Internal/Types.hs view
@@ -1,44 +1,101 @@ module Pine.Internal.Types where -import qualified SDL (Event)+import qualified SDL -- (Event, Rectangle(..), WindowConfig, Keycode(..))+import qualified SDL.Vect as SDLV+import Foreign.C.Types (CInt)+import Data.Int (Int32)+import Linear (V2)  import Data.Semigroup+import Control.Monad.State -- see below --- DeltaTime Double | KeyPress | KeyRelease | KeyState deriving (Eq, Show) --ideas--- | placeholder-data Event = DeltaTime Double | SDLEvent SDL.Event deriving (Eq, Show)+data Event+  = Load -- ^ very first event to be called+  | Step -- ^ Other events may be called multiple times per frame, but the Step event occurs once per frame+  | KeyPressed  SDL.Keycode+  | KeyReleased SDL.Keycode+  | KeyState --(Key -> Bool)+  | MousePosition (V2 Int32)+  | MouseMoved (V2 Int32)+  | MouseClick MouseButton+  | MouseScroll -- WIP+  | WindowPosition (Double, Double)+  | WindowResized (Double,Double)+  | WindowMinimized+--  | AudioState AudioState+  | WindowClose+  | SDLEvent SDL.Event--(raw SDL data, shouldn't be used typically)+  deriving (Eq, Show) +data MouseButton = MouseLeft | MouseRight | MouseMiddle deriving (Eq, Show) +data Return = Cont | Log String | Quit | QuitWithLog String -- change config settings (like resize window), show/hide mouse++-- | Most apps or games do not run forever, and sometimes people like to log things while building up a project.+-- In order for the user of this framework to do that, they must be able to send values back to the main control loop.+type PineState s = State s Return++cont,quit :: PineState s+cont = pure Cont+quit = pure Quit++contLog,quitLog :: String -> PineState s+contLog s = pure $ Log s+quitLog s = pure $ QuitWithLog s++ -- | Drawable class contains the draw function, which takes a type and converts it into a `Scene` class Drawable d where   draw :: d -> Scene +type DeltaTime = Double+ -- | Stateful class contains initial and update functions. Any objects in your game, including the overrall world, will update according to events that occur class Stateful s where-  initial :: s-  update  :: Event -> s -> s+  update :: DeltaTime -> Event -> PineState s  -- | An Image which is converted into a `Texture`-newtype Image = Image-  { imageSrc :: FilePath+data Image = Image+  { imageSrc  :: FilePath -- ^ source file+  , imageQuad :: Maybe (SDL.Rectangle CInt) -- ^ quad, or Nothing for entire image+  , imageRect :: Maybe (SDL.Rectangle CInt) -- ^ location and dimensions, or Nothing to fit entire window   } deriving (Eq, Show) -- put in other info later (like dimensions, quads, etc) +-- | Construct a rectangle+rect :: ()+     => CInt -- ^ x+     -> CInt -- ^ y+     -> CInt -- ^ w+     -> CInt -- ^ h+     -> SDL.Rectangle CInt+rect x y w h = SDL.Rectangle (SDLV.P $ SDLV.V2 x y) (SDLV.V2 w h) + -- | Create an image from a file-newImage :: FilePath -> Image+newImage :: ()+         => FilePath -- ^ The source of the image file+         -> Maybe (SDL.Rectangle CInt) -- ^ A quad or Nothing for the whole image+         -> Maybe (SDL.Rectangle CInt) -> Image -- ^ The rendering target: The location of the image on the window and its size, or Nothing to take up the whole window. newImage = Image +newtype Audio = Audio -- WIP+  { audiosrc :: FilePath+  } deriving (Eq, Show) +data AudioState = Playing Audio | Stopped Audio deriving (Eq, Show) --WIP++data Playback = Playback Audio | Continue Audio | Stop Audio deriving (Eq, Show) -- WIP+ data Media = MImage Image | MAudio | MText deriving (Eq, Show) -- WIP (TODO: replace instances of Image in Scene with Media  -- | A Scene can be empty, a single `Image`, or a group of `Image`s. (WIP: Later text and other stuff will be added)-data Scene = EmptyScene | SingleImage Image | Images [Image] deriving (Eq, Show)+data Scene = EmptyScene | SingleScene Media | MultiScene [Media] deriving (Eq, Show)  instance Semigroup Scene where-  (<>) (SingleImage img1) (SingleImage img2) = Images [img1,img2]-  (<>) (Images imgs1) (Images imgs2) = Images $ imgs1 <> imgs2-  (<>) (SingleImage img) (Images imgs) = Images $ img:imgs-  (<>) (Images imgs) (SingleImage img) = Images $ imgs <> [img]+  (<>) (SingleScene img1) (SingleScene img2) = MultiScene [img1,img2]+  (<>) (MultiScene imgs1) (MultiScene imgs2) = MultiScene $ imgs1 <> imgs2+  (<>) (SingleScene img) (MultiScene imgs) = MultiScene $ img:imgs+  (<>) (MultiScene imgs) (SingleScene img) = MultiScene $ imgs <> [img]   (<>) EmptyScene c = c   (<>) c EmptyScene = c @@ -48,4 +105,4 @@  -- | Convert a single `Image` into a `Scene` fromImage :: Image -> Scene-fromImage = SingleImage+fromImage = SingleScene . MImage