yampa-sdl2 (empty) → 0.0.1.1

raw patch · 17 files changed

+719/−0 lines, 17 filesdep +StateVardep +Yampadep +base

Dependencies added: StateVar, Yampa, base, colour, linear, sdl2, sdl2-gfx, text, yampa-sdl2

Files

• LICENSE +21/−0
• README.md +52/−0
• src/YampaSDL2.hs +48/−0
• src/YampaSDL2/Animation.hs +45/−0
• src/YampaSDL2/AppInput.hs +69/−0
• src/YampaSDL2/AppOutput.hs +55/−0
• src/YampaSDL2/Backend.hs +36/−0
• src/YampaSDL2/Backend/Close.hs +10/−0
• src/YampaSDL2/Backend/Init.hs +9/−0
• src/YampaSDL2/Backend/Input.hs +15/−0
• src/YampaSDL2/Backend/Output.hs +97/−0
• src/YampaSDL2/Backend/Parse.hs +46/−0
• src/YampaSDL2/Backend/SDL.hs +45/−0
• src/YampaSDL2/Geometry.hs +31/−0
• src/YampaSDL2/MainLoop.hs +25/−0
• test/Main.hs +44/−0
• yampa-sdl2.cabal +71/−0

@@ -0,0 +1,21 @@+MIT License++Copyright (c) 2018 Simre++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.

@@ -0,0 +1,52 @@+# YampaSDL2++YampaSDL2 provides SDL2 bindings to use with the FRP library [Yampa](https://github.com/ivanperez-keera/Yampa).++![Screenshot](./screenshot.png)+A screenshot of some drawn shapes.++## Roadmap++- [ ] Display Shapes+  - [x] Rectangle+  - [x] Circle+  - [x] Triangle+  - [ ] Polygon+- [ ] Display Images+- [x] Animations+- [x] Handle Input+- [ ] Play sound++**This library is still work in progress**+++## Getting started++### Prerequisites++yampa-sdl2 uses the C-libraries+- _sdl2_+- _sdl2-gfx_++Consequently, you need to have these two libraries installed on your computer.++### Installation++1. Download the library:+```bash+cd example-project+git clone https://github.com/Simre1/yampa-sdl2.git+```+2. Add it to your dependencies:+Edit your stack.yaml file and add yampa-sdl2 to packages.+Add the yampa-sdl2 dependency to your cabal file (or package.yaml)++3. Import the library with: `import YampaSDL2`++## How to use++Head over to the [wiki](https://github.com/Simre1/yampa-sdl2/wiki).++## License++This project is licensed under the MIT License - see the [LICENSE](LICENSE) file for details.

@@ -0,0 +1,48 @@+module YampaSDL2+  ( module YampaSDL2.MainLoop+  , module YampaSDL2.Backend+  , module YampaSDL2.Backend.SDL+  , module YampaSDL2.AppInput+  , module YampaSDL2.AppOutput+  , module YampaSDL2.Geometry+  , module YampaSDL2.Animation+  , module Data.Colour.Names+  , module Data.Colour.SRGB+  , module Linear.V2+  , module SDL.Input.Keyboard.Codes+  ) where++import Linear.V2+import Data.Colour.Names+import Data.Colour.SRGB+import SDL.Input.Keyboard.Codes++import YampaSDL2.AppInput+  ( AppInput+  , quit+  , anyKeyActive+  , anyKeyPress+  , mouseLeftActive+  , mouseLeftPress+  , mouseRightActive+  , mouseRightPress+  , mousePosition+  )+import YampaSDL2.AppOutput+  ( AppOutput(..)+  , Graphics(..)+  , Sound(..)+  , RenderShape(..)+  , Camera(..)+  , ShapeColour(..)+  )+import YampaSDL2.Backend (defaultBackendConfiguration, BackendConfiguration(..))+import YampaSDL2.Geometry (Shape(..))+import YampaSDL2.MainLoop (mainLoop)+import YampaSDL2.Animation+  ( Animation+  , AnimationType(..)+  , animate+  , newAnimation+  )+import YampaSDL2.Backend.SDL (sdlBackend)

@@ -0,0 +1,45 @@+{-|+Module      : Animation+Description : Provide an easy way to do animations+-}+{-# Language Arrows #-}++module YampaSDL2.Animation+  ( -- * Animation+    animate+  , Animation(..)+  , AnimationType(..)+  , newAnimation+  ) where++import FRP.Yampa++import YampaSDL2.AppOutput (RenderShape)++data Animation = Animation+  { frames :: [(Time, RenderShape)] -- ^ Time specifies how long the RenderShape is displayed, for example [(0.5, renderShape1), (0.5, renderShape2)]+  , type_ :: AnimationType+  }++newAnimation = Animation++data AnimationType = Once | Endless | Repeat Int | Alternate | AlternateEndless++animate :: Animation -> SF a (Maybe RenderShape)+animate animation+  | (null $ frames animation) = constant Nothing+  | otherwise = proc _ -> do+      frameEvent <- afterEach (getFrames animation) -< ()+      frame <- hold initialFrame -< frameEvent+      returnA -< return frame+        where initialFrame = let (_,frame) = head $ frames animation+                       in frame++getFrames :: Animation -> [(Time, RenderShape)]+getFrames (Animation{frames=frames,type_=type_}) =+  case type_ of+    Once -> frames+    Endless -> cycle frames+    Repeat times -> concat $ replicate times frames+    Alternate -> frames ++ reverse frames+    AlternateEndless -> cycle (frames ++ reverse frames)

@@ -0,0 +1,69 @@+{-|+Module      : Input+Description : Contains all input SF functions+-}++{-# Language Arrows #-}++module YampaSDL2.AppInput+  ( -- * Input+    AppInput(..)+  , initAppInput+    -- ** SFs+  , quit+  , anyKeyActive+  , anyKeyPress+  , mouseLeftActive+  , mouseLeftPress+  , mouseRightActive+  , mouseRightPress+  , mousePosition+  ) where++import FRP.Yampa+import FRP.Yampa.Event (maybeToEvent)+import Data.Maybe (isJust)+import SDL.Input.Keyboard.Codes+import Linear.V2++-- | Your main SF receives AppInput as input+data AppInput = AppInput+  { inpQuit :: Bool+  , inpKey :: Maybe Scancode+  , inpMousePos :: V2 Double+  , inpMouseLeft :: Maybe (V2 Double)+  , inpMouseRight :: Maybe (V2 Double)+  }++initAppInput :: AppInput+initAppInput = AppInput+  { inpQuit = False+  , inpKey = Nothing+  , inpMousePos = V2 0 0+  , inpMouseLeft = Nothing+  , inpMouseRight = Nothing+  }++quit :: SF AppInput (Event ())+quit = inpQuit ^>> edge++anyKeyActive :: SF AppInput (Event Scancode)+anyKeyActive = inpKey ^>> arr maybeToEvent++anyKeyPress :: SF AppInput (Event Scancode)+anyKeyPress = inpKey ^>> edgeJust++mouseLeftActive :: SF AppInput (Event (V2 Double))+mouseLeftActive = inpMouseLeft ^>> arr maybeToEvent++mouseLeftPress :: SF AppInput (Event (V2 Double))+mouseLeftPress = inpMouseLeft ^>> edgeJust++mouseRightActive :: SF AppInput (Event (V2 Double))+mouseRightActive = inpMouseRight ^>> arr maybeToEvent++mouseRightPress :: SF AppInput (Event (V2 Double))+mouseRightPress = inpMouseRight ^>> edgeJust++mousePosition :: SF AppInput (V2 Double)+mousePosition = arr inpMousePos

@@ -0,0 +1,55 @@+{-|+Module      : Output+Description : Datatypes to describe the output+-}++module YampaSDL2.AppOutput+  ( -- * Output+    AppOutput(..)+  , Graphics(..)+  , Camera(..)+  , RenderShape(..)+  , ShapeColour(..)+  , Sound(..)+  ) where++import Data.Colour+import Linear.V2++import YampaSDL2.Geometry (Shape)++++-- | Your main SF needs to create an AppOutput+data AppOutput = AppOutput+  { graphics :: Graphics+  , sound :: [Sound]+  , shouldExit :: Bool+  }++data Graphics = Graphics+  { camera :: Camera+  , objects :: [RenderShape]+  }++data Camera = Camera+  { cPos :: V2 Double -- ^Moves the view point+  , cSize :: V2 Double -- ^Set the size of the view, for example to zoom.+  }++data RenderShape+  = RS { shape :: Shape+       , colour :: ShapeColour+       , zIndex :: Int -- ^ Higher zIndex means the RenderShape is in front of the others.+       }++  |  -- | Allows you to move multiple RenderShapes at once with the same vector+    Container { containerCentre :: V2 Double+              , children :: [RenderShape] }++data ShapeColour+  = Filled (Colour Double)+  | Unfilled (Colour Double)++data Sound =+  NotImplementedYet

@@ -0,0 +1,36 @@+{-|+Module      : Backend+-}+module YampaSDL2.Backend+  ( -- * Backend+    Backend(..)+  , BackendConfiguration(..)+  , defaultBackendConfiguration+  ) where++import FRP.Yampa++import YampaSDL2.AppInput (AppInput)+++data Backend a b = Backend+  { initAction :: IO a+  , inputAction :: Bool -> IO (DTime, Maybe a)+  , outputAction :: Bool -> b -> IO Bool+  , parseInput :: SF a AppInput+  , closeAction :: IO ()+  }++data BackendConfiguration = BackendConfiguration+  { windowWidth :: Int+  , windowHeight :: Int+  , windowName :: String+  , windowResizable :: Bool+  }++defaultBackendConfiguration = BackendConfiguration+  { windowWidth = 800+  , windowHeight = 600+  , windowName = "App"+  , windowResizable = True+  }

@@ -0,0 +1,10 @@+module YampaSDL2.Backend.Close+  (closeAction) where++import qualified SDL++closeAction :: SDL.Renderer -> SDL.Window -> IO ()+closeAction r w = do+  SDL.destroyRenderer r+  SDL.destroyWindow w+  SDL.quit

@@ -0,0 +1,9 @@+module YampaSDL2.Backend.Init+  (initAction) where++import FRP.Yampa+import qualified SDL++initAction :: IO (Event SDL.EventPayload)+initAction = return NoEvent+

@@ -0,0 +1,15 @@+module YampaSDL2.Backend.Input+  (inputAction) where++import qualified SDL+import Control.Concurrent+import FRP.Yampa++inputAction :: MVar DTime -> Bool -> IO (DTime, Maybe (Event SDL.EventPayload))+inputAction lastInteraction _canBlock = do+  currentTime <- SDL.time+  dt <- (currentTime -) <$> swapMVar lastInteraction currentTime+  threadDelay $ round (10000 - dt) -- 10ms pause for roughly 100 FPS+  mEvent <- SDL.pollEvent+  return (dt, Event . SDL.eventPayload <$> mEvent)+

@@ -0,0 +1,97 @@+module YampaSDL2.Backend.Output+  (outputAction) where++import qualified SDL+import qualified SDL.Primitive as GFX+import SDL.Vect+import Data.Colour.SRGB+import Data.List (sortBy)+import Data.StateVar (($=))+import Control.Monad++import YampaSDL2.AppOutput ( AppOutput(..)+                           , Graphics (..)+                           , Camera (..)+                           , RenderShape (..)+                           , ShapeColour (..)+                           )+import YampaSDL2.Geometry++outputAction :: SDL.Renderer -> Bool -> AppOutput -> IO Bool+outputAction renderer changed ao =+  when changed ( do+    let os =+          sortBy (\r1 r2 -> zIndex r1 `compare` zIndex r2) $ objects (graphics ao)+        c = camera (graphics ao)++    SDL.rendererDrawColor renderer $= V4 maxBound maxBound maxBound maxBound+    texture <-+      SDL.createTexture+        renderer+        SDL.RGB24+        SDL.TextureAccessTarget+        ((fmap round . cSize) c)+    SDL.rendererRenderTarget renderer $= return texture+    SDL.clear renderer+    mapM_ (renderView renderer c) os+    SDL.rendererRenderTarget renderer $= Nothing+    SDL.clear renderer+    SDL.copy renderer texture Nothing Nothing+    SDL.present renderer+    SDL.destroyTexture texture+    )+  >> return (shouldExit ao)++renderView :: SDL.Renderer -> Camera -> RenderShape -> IO ()+renderView renderer cam rs = do+  let cameraPoint = (cPos cam)+      cameraView = (cSize cam)++  case rs of+    Container {containerCentre=centre, children=cs } -> do+      mapM_ (renderView renderer (Camera (cameraPoint - centre) cameraView)) (sortBy (\r1 r2 -> zIndex r1 `compare` zIndex r2) cs)+    RS {shape=s} -> do+      let shapePoint = shapeCentre (shape rs)+          adjustedShape =+            s { shapeCentre =+              (shapePoint - cameraPoint) + cameraView/2+            }+      case adjustedShape of+        Rectangle {shapeCentre = V2 x y, rectSize = V2 w h} -> do+          let (RGB r g b) = toSRGB24 (sColour rs)+          let draw = if sFilled rs then GFX.fillRectangle else GFX.rectangle+          draw renderer+            (round <$> V2 (x - w / 2) (getY cameraView - (y + h / 2)))+            (round <$> V2 (x + w / 2) (getY cameraView - (y - h / 2)))+            (V4 r g b maxBound)+        Circle {shapeCentre = V2 x y, radius=rad} -> do+          let (RGB r g b) = toSRGB24 (sColour rs)+          let draw = if sFilled rs then GFX.fillCircle else GFX.circle+          draw renderer+            (round <$> V2 x y)+            (round rad)+            (V4 r g b maxBound)+        Triangle {shapeCentre=V2 x y, pointA=V2 pax pay, pointB=V2 pbx pby, pointC=V2 pcx pcy} -> do+          let (RGB r g b) = toSRGB24 (sColour rs)+          let draw = if sFilled rs then GFX.fillTriangle else GFX.smoothTriangle+          draw renderer+            (round <$> V2 (x + pax) (getY cameraView - (y + pay)))+            (round <$> V2 (x + pbx) (getY cameraView - (y + pby)))+            (round <$> V2 (x + pcx) (getY cameraView - (y + pcy)))+            (V4 r g b maxBound)+  return ()++sColour :: RenderShape -> Colour Double+sColour rs =+  case colour rs of+    (Filled a) -> a+    (Unfilled a) -> a++sFilled :: RenderShape -> Bool+sFilled rs =+  case colour rs of+    (Filled _) -> True+    (Unfilled _) -> False++getY :: V2 a -> a+getY (V2 _ y) = y

@@ -0,0 +1,46 @@+module YampaSDL2.Backend.Parse+  (parseInput) where++import qualified SDL+import SDL.Vect+import FRP.Yampa++import YampaSDL2.AppInput (AppInput(..), initAppInput)++parseInput :: SF (Event SDL.EventPayload) AppInput+parseInput = accumHoldBy onSDLInput initAppInput++onSDLInput :: AppInput -> SDL.EventPayload -> AppInput+onSDLInput ai SDL.QuitEvent = ai {inpQuit = True}+onSDLInput ai (SDL.KeyboardEvent ev)+  | SDL.keyboardEventKeyMotion ev == SDL.Pressed =+    ai {inpKey = Just $ getKeyCode ev}+  | SDL.keyboardEventKeyMotion ev == SDL.Released =+    ai+    { inpKey =+        if inpKey ai == return (getKeyCode ev)+          then Nothing+          else inpKey ai+    }+  where+    getKeyCode = SDL.keysymScancode . SDL.keyboardEventKeysym+onSDLInput ai (SDL.MouseMotionEvent ev) =+  ai {inpMousePos = fromIntegral <$> V2 x y}+  where+    P (V2 x y) = SDL.mouseMotionEventPos ev+onSDLInput ai (SDL.MouseButtonEvent ev) =+  ai {inpMouseLeft = lmb, inpMouseRight = rmb}+  where+    motion = SDL.mouseButtonEventMotion ev+    button = SDL.mouseButtonEventButton ev+    pos = inpMousePos ai+    inpMod =+      case (motion, button) of+        (SDL.Released, SDL.ButtonLeft) -> first (const Nothing)+        (SDL.Pressed, SDL.ButtonLeft) -> first (const (Just pos))+        (SDL.Released, SDL.ButtonRight) -> second (const Nothing)+        (SDL.Pressed, SDL.ButtonRight) -> second (const (Just pos))+        _ -> id+    (lmb, rmb) = inpMod $ (inpMouseLeft &&& inpMouseRight) ai+onSDLInput ai _ = ai+

@@ -0,0 +1,45 @@+{-# LANGUAGE OverloadedStrings #-}++module YampaSDL2.Backend.SDL+  (sdlBackend) where++import qualified SDL+import SDL.Vect+import Control.Concurrent.MVar+import FRP.Yampa+import Data.Text (pack)++import qualified YampaSDL2.Backend.Init as Init+import qualified YampaSDL2.Backend.Input as Input+import qualified YampaSDL2.Backend.Output as Output+import qualified YampaSDL2.Backend.Parse as Parse+import qualified YampaSDL2.Backend.Close as Close++import YampaSDL2.AppOutput (AppOutput)+import YampaSDL2.Backend++-- | Set up SDL+sdlBackend ::+     BackendConfiguration -> IO (Backend (Event SDL.EventPayload) AppOutput)+sdlBackend bc = do+  SDL.initialize [SDL.InitVideo]+  window <- SDL.createWindow (pack $ windowName bc) windowConf+  SDL.showWindow window+  renderer <- SDL.createRenderer window (-1) SDL.defaultRenderer+  lastInteraction <- newMVar =<< SDL.time+  return $+    Backend+    { initAction = Init.initAction+    , inputAction = Input.inputAction lastInteraction+    , outputAction = Output.outputAction renderer+    , parseInput = Parse.parseInput+    , closeAction = Close.closeAction renderer window+    }+  where+    windowConf =+      SDL.defaultWindow+      { SDL.windowInitialSize =+          V2 (fromIntegral (windowWidth bc)) (fromIntegral (windowHeight bc))+        , SDL.windowResizable = windowResizable (bc)+      }+

@@ -0,0 +1,31 @@+{-|+Module      : Geometry+Description : Declares all shapes+-}++module YampaSDL2.Geometry+  ( -- ** Shapes+    Shape(..)+  ) where++import Linear.V2+++++data Shape =+    Rectangle+      { shapeCentre :: V2 Double+      , rectSize :: V2 Double+      }+  | Circle+     { shapeCentre :: V2 Double+     , radius :: Double+     }+  | Triangle+     { shapeCentre :: V2 Double+     , pointA :: V2 Double+     , pointB :: V2 Double+     , pointC :: V2 Double+     }+     -- ^ Think of shapeCentre as a vector which is applied to all 3 points of the triangle

@@ -0,0 +1,25 @@+{-|+Module      : MainLoop+-}+++module YampaSDL2.MainLoop+  ( -- * MainLoop+    mainLoop+  ) where++import FRP.Yampa++import YampaSDL2.AppInput+import YampaSDL2.AppOutput+import YampaSDL2.Backend++-- | Starts the Yampa loop+mainLoop :: Backend a AppOutput -> SF AppInput AppOutput -> IO ()+mainLoop backend sf = do+  reactimate+    (initAction backend)+    (inputAction backend)+    (outputAction backend)+    (parseInput backend >>> sf)+  closeAction backend

@@ -0,0 +1,44 @@+{-# Language Arrows #-}++import FRP.Yampa+import YampaSDL2++import Data.Maybe++main :: IO ()+main = do+  backend <- sdlBackend defaultBackendConfiguration+  mainLoop backend sf++sf :: SF AppInput AppOutput+sf = proc input -> do+  anyKeyE <- anyKeyActive -< input+  point <- accumHoldBy+    (\p int -> p + direction int)+    (V2 0 0) -< anyKeyE+  shouldQuit <- quit -< input++  objAnimated <- animate animation -< ()+  returnA -< AppOutput+    { graphics = Graphics+      { camera = camera+      , objects = [Container (V2 200 200) [obj1 point, fromMaybe obj5 objAnimated]]+      }+    , sound = []+    , shouldExit = isEvent shouldQuit+    }+  where camera = Camera (V2 0 0) (V2 800 600)+        shape1 = Triangle (V2 0 0) (V2 0 50) (V2 50 (-50)) (V2 (-50) (-50))+        shape2 point = Rectangle point (V2 50 50)+        obj1 point = RS (shape2 point) (Filled blue) 2+        obj2 = RS shape1 (Filled yellow) 1+        obj3 = RS shape1 (Filled violet) 1+        obj4 = RS shape1 (Filled green) 1+        obj5 = RS shape1 (Filled orange) 1+        animation = newAnimation [(0.5,obj2), (0.5,obj3), (0.5,obj4), (0.5, obj5)] Endless+        direction ScancodeRight = V2 1 0+        direction ScancodeLeft = V2 (-1) 0+        direction ScancodeDown = V2 0 (-1)+        direction ScancodeUp = V2 0 1+        direction _ = V2 0 0+

@@ -0,0 +1,71 @@+-- This file has been generated from package.yaml by hpack version 0.21.2.+--+-- see: https://github.com/sol/hpack+--+-- hash: 03e817a47b063a73dd635929d74cec6d550986109c6361e048e24ba1ffe9b4be++name:           yampa-sdl2+version:        0.0.1.1+synopsis:       Yampa and SDL2 made easy+description:    yampa-sdl2 lets you start coding your app right away instead of dealing with SDL2 first.+category:       Graphics+homepage:       https://github.com/Simre1/YampaSDL2#readme+author:         Simre+maintainer:     simre4775@gmail.com+copyright:      2018 Simre+license:        MIT+license-file:   LICENSE+build-type:     Simple+cabal-version:  >= 1.10++extra-source-files:+    README.md++library+  exposed-modules:+      YampaSDL2+  other-modules:+      YampaSDL2.Animation+      YampaSDL2.AppInput+      YampaSDL2.AppOutput+      YampaSDL2.Backend+      YampaSDL2.Backend.Close+      YampaSDL2.Backend.Init+      YampaSDL2.Backend.Input+      YampaSDL2.Backend.Output+      YampaSDL2.Backend.Parse+      YampaSDL2.Backend.SDL+      YampaSDL2.Geometry+      YampaSDL2.MainLoop+      Paths_yampa_sdl2+  hs-source-dirs:+      src+  build-depends:+      StateVar+    , Yampa+    , base >=4.7 && <5+    , colour+    , linear+    , sdl2+    , sdl2-gfx+    , text+  default-language: Haskell2010++test-suite YampaSDL2-test+  type: exitcode-stdio-1.0+  main-is: Main.hs+  other-modules:+      Paths_yampa_sdl2+  hs-source-dirs:+      test+  build-depends:+      StateVar+    , Yampa+    , base+    , colour+    , linear+    , sdl2+    , sdl2-gfx+    , text+    , yampa-sdl2+  default-language: Haskell2010