apecs-brillo 0.1.1.1 → 0.2.0.0
raw patch · 7 files changed
+326/−127 lines, 7 filesdep −apecs-physicsdep ~basedep ~brillodep ~brillo-renderingnew-component:exe:example-balls
Dependencies removed: apecs-physics
Dependency ranges changed: base, brillo, brillo-rendering
Files
- CHANGELOG.md +9/−2
- README.md +65/−1
- apecs-brillo.cabal +132/−14
- examples/balls/Main.hs +63/−0
- src/Apecs/Brillo.hs +57/−44
- src/Apecs/Physics/Brillo.hs +0/−65
- test/Spec.hs +0/−1
CHANGELOG.md view
@@ -1,5 +1,12 @@+## [0.2.0]+- Update to Brillo 3.0.0+- Rename `play` to `playWithApecs`+- Rename `foldDraw` to `cfoldDraw`+- Rename `foldDrawM` to `cfoldDrawM`+- Remove `Apecs.Brillo.Physics` entirely+ ## [0.1.1]-Brillo update patch+- Brillo update patch ## [0.1.0]-IDK, made this+- IDK, made this
README.md view
@@ -1,3 +1,67 @@ # apecs-brillo -Apecs' gloss package, but adapted for brillo+The camera is already handled, you only have to pass in your own drawing, stepping and key handling functions. Check the `Apecs.Brillo` documentation to see the type signatures.++```hs+module Example where++import Apecs qualified+import Brillo qualified+import Apecs.Brillo qualified as Brillo+import System.Exit (exitSuccess)+import Control.Monad (void)+import Linear++newtype Position = Position (V2 Float)+ deriving Show++instance Apecs.Component Position where+ type Storage Position = Apecs.Map Position++newtype Velocity = Velocity (V2 Float)+ deriving Show++instance Apecs.Component Velocity where+ type Storage Velocity = Apecs.Map Velocity++Apecs.makeWorld "World"+ [ ''Brillo.Camera+ , ''Position+ , ''Velocity+ ]++main :: IO ()+main = do+ world <- initWorld+ Apecs.runWith world do+ initialise+ Brillo.playWithApecs (Brillo.InWindow "Example" (800, 600) (10, 10)) Brillo.black 60 draw handleEvent step++initialise :: Apecs.System World ()+initialise = void do+ Apecs.newEntity (Position 0, Velocity (V2 12 (-16)))+ Apecs.newEntity (Position (V2 24 0), Velocity (V2 (-48) 8))+ Apecs.newEntity (Position (V2 48 24), Velocity (V2 32 16))++step :: Float -> Apecs.System World ()+step dT = do+ velocity dT+ gravity dT++velocity :: Float -> Apecs.System World ()+velocity dT = Apecs.cmap \(Position pos, Velocity vel) -> Position $ pos + vel ^* dT++gravity :: Float -> Apecs.System World ()+gravity dT = Apecs.cmap \(Velocity vel) -> Position $ vel + gravityVel ^* dT+ where gravityVel = V2 0 (-1)++handleEvent :: Brillo.Event -> Apecs.System World ()+handleEvent = \case+ Brillo.EventKey (Brillo.SpecialKey Brillo.KeyEsc) Brillo.Down _ _ -> Apecs.liftIO exitSuccess+ _ -> pure ()++draw :: Apecs.System World Brillo.Picture+draw = do+ drawnEntities <- Brillo.cfoldDraw \(Position (V2 x y)) -> Brillo.Translate x y $ Brillo.circleSolid 10++ pure $ Brillo.Color (Brillo.makeColorI 255 255 255 255) drawnEntities```
apecs-brillo.cabal view
@@ -5,12 +5,12 @@ -- see: https://github.com/sol/hpack name: apecs-brillo-version: 0.1.1.1+version: 0.2.0.0 synopsis: Apecs' gloss package, but adapted for brillo.-description: Please see the README on Codeberg at <https://github.com/execute214/apecs-brillo#readme>+description: A library that's meant to bridge the gap between brillo and gloss. category: Game engine author: Execute-maintainer: execute@erisws.com+maintainer: Execute copyright: 2017 Jonas Carpay, Execute license: BSD-3-Clause license-file: LICENSE@@ -26,24 +26,109 @@ library exposed-modules: Apecs.Brillo- Apecs.Physics.Brillo other-modules: Paths_apecs_brillo autogen-modules: Paths_apecs_brillo hs-source-dirs: src- ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints+ default-extensions:+ TemplateHaskell+ ImportQualifiedPost+ DuplicateRecordFields+ ApplicativeDo+ BlockArguments+ DeriveAnyClass+ DerivingVia+ LambdaCase+ NamedFieldPuns+ NumDecimals+ OverloadedLabels+ OverloadedLists+ OverloadedRecordDot+ OverloadedStrings+ MultiParamTypeClasses+ NoStarIsType+ PatternSynonyms+ RecordWildCards+ StrictData+ BangPatterns+ TypeAbstractions+ TypeFamilies+ FlexibleInstances+ FlexibleContexts+ DataKinds+ TypeOperators+ NoFieldSelectors+ ScopedTypeVariables+ TypeApplications+ TupleSections+ DeriveAnyClass+ DeriveTraversable+ DeriveGeneric+ ghc-options: -Wall -Wcompat -Wimplicit-lift -Wincomplete-patterns -Wincomplete-patterns -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-exported-signatures -Wmissing-methods -Wmissing-signatures -Wname-shadowing -Wno-deprecations -Wredundant-bang-patterns -Wredundant-constraints -Wunused-packages build-depends: apecs >=0.7 && <0.11- , apecs-physics >=0.3 && <5- , base >=4.7 && <5- , brillo ==2.*- , brillo-rendering ==2.*+ , base >=4.8 && <5+ , brillo ==3.*+ , brillo-rendering ==3.* , containers >=0.5 && <0.8 , linear >=1.2 && <2 default-language: Haskell2010 +executable example-balls+ main-is: Main.hs+ other-modules:+ Paths_apecs_brillo+ autogen-modules:+ Paths_apecs_brillo+ hs-source-dirs:+ examples/balls+ default-extensions:+ TemplateHaskell+ ImportQualifiedPost+ DuplicateRecordFields+ ApplicativeDo+ BlockArguments+ DeriveAnyClass+ DerivingVia+ LambdaCase+ NamedFieldPuns+ NumDecimals+ OverloadedLabels+ OverloadedLists+ OverloadedRecordDot+ OverloadedStrings+ MultiParamTypeClasses+ NoStarIsType+ PatternSynonyms+ RecordWildCards+ StrictData+ BangPatterns+ TypeAbstractions+ TypeFamilies+ FlexibleInstances+ FlexibleContexts+ DataKinds+ TypeOperators+ NoFieldSelectors+ ScopedTypeVariables+ TypeApplications+ TupleSections+ DeriveAnyClass+ DeriveTraversable+ DeriveGeneric+ ghc-options: -Wall -Wcompat -Wimplicit-lift -Wincomplete-patterns -Wincomplete-patterns -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-exported-signatures -Wmissing-methods -Wmissing-signatures -Wname-shadowing -Wno-deprecations -Wredundant-bang-patterns -Wredundant-constraints -Wunused-packages -threaded -rtsopts -with-rtsopts=-N+ build-depends:+ apecs >=0.7 && <0.11+ , apecs-brillo+ , base >=4.8 && <5+ , brillo ==3.*+ , brillo-rendering ==3.*+ , containers >=0.5 && <0.8+ , linear >=1.2 && <2+ default-language: Haskell2010+ test-suite apecs-brillo-test type: exitcode-stdio-1.0 main-is: Spec.hs@@ -53,14 +138,47 @@ Paths_apecs_brillo hs-source-dirs: test- ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N+ default-extensions:+ TemplateHaskell+ ImportQualifiedPost+ DuplicateRecordFields+ ApplicativeDo+ BlockArguments+ DeriveAnyClass+ DerivingVia+ LambdaCase+ NamedFieldPuns+ NumDecimals+ OverloadedLabels+ OverloadedLists+ OverloadedRecordDot+ OverloadedStrings+ MultiParamTypeClasses+ NoStarIsType+ PatternSynonyms+ RecordWildCards+ StrictData+ BangPatterns+ TypeAbstractions+ TypeFamilies+ FlexibleInstances+ FlexibleContexts+ DataKinds+ TypeOperators+ NoFieldSelectors+ ScopedTypeVariables+ TypeApplications+ TupleSections+ DeriveAnyClass+ DeriveTraversable+ DeriveGeneric+ ghc-options: -Wall -Wcompat -Wimplicit-lift -Wincomplete-patterns -Wincomplete-patterns -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-exported-signatures -Wmissing-methods -Wmissing-signatures -Wname-shadowing -Wno-deprecations -Wredundant-bang-patterns -Wredundant-constraints -Wunused-packages -threaded -rtsopts -with-rtsopts=-N build-depends: apecs >=0.7 && <0.11 , apecs-brillo- , apecs-physics >=0.3 && <5- , base >=4.7 && <5- , brillo ==2.*- , brillo-rendering ==2.*+ , base >=4.8 && <5+ , brillo ==3.*+ , brillo-rendering ==3.* , containers >=0.5 && <0.8 , linear >=1.2 && <2 default-language: Haskell2010
+ examples/balls/Main.hs view
@@ -0,0 +1,63 @@+{-# LANGUAGE FieldSelectors #-}+module Main where++import Apecs qualified+import Brillo qualified+import Apecs.Brillo qualified as Brillo+import System.Exit (exitSuccess)+import Control.Monad (void)+import Linear++newtype Position = Position (V2 Float)+ deriving Show++instance Apecs.Component Position where+ type Storage Position = Apecs.Map Position++newtype Velocity = Velocity (V2 Float)+ deriving Show++instance Apecs.Component Velocity where+ type Storage Velocity = Apecs.Map Velocity++Apecs.makeWorld "World"+ [ ''Brillo.Camera+ , ''Position+ , ''Velocity+ ]++main :: IO ()+main = do+ world <- initWorld+ Apecs.runWith world do+ initialise+ Brillo.playWithApecs (Brillo.InWindow "Example" (800, 600) (10, 10)) Brillo.black 60 draw handleEvent step++initialise :: Apecs.System World ()+initialise = void do+ Apecs.newEntity (Position 0, Velocity (V2 12 (-16)))+ Apecs.newEntity (Position (V2 24 0), Velocity (V2 (-48) 8))+ Apecs.newEntity (Position (V2 48 24), Velocity (V2 32 16))++step :: Float -> Apecs.System World ()+step dT = do+ velocity dT+ gravity dT++velocity :: Float -> Apecs.System World ()+velocity dT = Apecs.cmap \(Position pos, Velocity vel) -> Position $ pos + vel ^* dT++gravity :: Float -> Apecs.System World ()+gravity dT = Apecs.cmap \(Velocity vel) -> Position $ vel + gravityVel ^* dT+ where gravityVel = V2 0 (-1)++handleEvent :: Brillo.Event -> Apecs.System World ()+handleEvent = \case+ Brillo.EventKey (Brillo.SpecialKey Brillo.KeyEsc) Brillo.Down _ _ -> Apecs.liftIO exitSuccess+ _ -> pure ()++draw :: Apecs.System World Brillo.Picture+draw = do+ drawnEntities <- Brillo.cfoldDraw \(Position (V2 x y)) -> Brillo.Translate x y $ Brillo.circleSolid 10++ pure $ Brillo.Color (Brillo.makeColorI 255 255 255 255) drawnEntities
src/Apecs/Brillo.hs view
@@ -2,67 +2,80 @@ {-# LANGUAGE TypeFamilies #-} module Apecs.Brillo- ( module Apecs.Brillo- , module G- ) where+ ( Camera(..) -import Data.Semigroup (Semigroup (..))-import Brillo-import Brillo.Interface.IO.Game as G-import Linear.V2-import Linear.Vector+ , Brillo.Event(..)+ , Brillo.Key(..)+ , Brillo.SpecialKey(..)+ , Brillo.MouseButton(..)+ , Brillo.KeyState(..)+ , Brillo.Modifiers(..) -import Apecs+ , playWithApecs + , cameraTransform+ , windowToWorld++ , cfoldDraw+ , cfoldDrawM+ ) where++import Brillo qualified+import Brillo.Interface.IO.Game qualified as Brillo+import Linear+import Apecs qualified+ data Camera = Camera { camOffset :: V2 Float , camScale :: Float } deriving (Eq, Show, Read) instance Semigroup Camera where- Camera x1 r1 <> Camera x2 r2 = Camera (x1 + x2) (r1 * r2)+ Camera pos1 scale1 <> Camera pos2 scale2 = Camera (pos1 + pos2) (scale1 * scale2)+ instance Monoid Camera where mempty = Camera 0 1 mappend = (<>) --- | Apply a camera transformation to a picture-cameraTransform :: Camera -> Picture -> Picture-cameraTransform (Camera (V2 cx cy) cs) =- Scale cs cs . Translate (-cx) (-cy)+instance Apecs.Component Camera where type Storage Camera = Apecs.Global Camera -windowToWorld :: Camera -> (Float,Float) -> V2 Float-windowToWorld (Camera cx cs) (x,y) = V2 x y ^/ cs + cx+playWithApecs+ :: (Apecs.Has w IO Camera)+ => Brillo.Display -- ^ Display mode+ -> Brillo.Color -- ^ Background color+ -> Int -- ^ Desired FPS+ -> Apecs.System w Brillo.Picture -- ^ Drawing function+ -> (Brillo.Event -> Apecs.System w ()) -- ^ Event handling function+ -> (Float -> Apecs.System w ()) -- ^ Stepping function, with a time delta argument.+ -> Apecs.System w ()+playWithApecs disp col fps draw handle step = do+ w <- Apecs.ask+ Apecs.liftIO $ Brillo.playIO disp col fps w draw' handle' step'+ where+ handle' event = Apecs.runSystem $ handle event >> Apecs.ask -instance Component Camera where- type Storage Camera = Global Camera+ step' dT = Apecs.runSystem $ step dT >> Apecs.ask -play- :: (Has w IO Camera)- => Display -- ^ Display mode- -> Color -- ^ Background color- -> Int -- ^ Desired FPS- -> System w Picture -- ^ Drawing function- -> (Event -> System w ()) -- ^ Event handling function- -> (Float -> System w ()) -- ^ Stepping function, with a time delta argument.- -> System w ()-play disp col fps draw handle step = do- w <- ask- liftIO$ playIO disp col fps w draw' handle' step'- where- handle' event = runSystem $ handle event >> ask- step' dT = runSystem $ step dT >> ask- draw' = runSystem $ do- cam <- get global- cameraTransform cam <$> draw+ draw' = Apecs.runSystem do+ cam <- Apecs.get Apecs.global+ cameraTransform cam <$> draw +-- | Apply a camera transformation to a picture.+cameraTransform :: Camera -> Brillo.Picture -> Brillo.Picture+cameraTransform (Camera (V2 camX camY) camScale) = Brillo.Scale camScale camScale . Brillo.Translate (-camX) (-camY)++-- | Translates a position from the camera's offset and scale.+windowToWorld :: Camera -> (Float, Float) -> V2 Float+windowToWorld (Camera camPos camScale) (x, y) = V2 x y ^/ camScale + camPos+ -- | Renders a picture given a component rendering function.-foldDraw :: (Get w IO c, Members w IO c)- => (c -> Picture) -- ^ Component render function.- -> System w Picture-foldDraw fn = cfold (\pic -> mappend pic . fn) mempty+cfoldDraw :: (Apecs.Get w IO c, Apecs.Members w IO c)+ => (c -> Brillo.Picture) -- ^ Component render function.+ -> Apecs.System w Brillo.Picture+cfoldDraw f = Apecs.cfold (\p -> mappend p . f) mempty -- | Monadically renders a picture given a component rendering function.-foldDrawM :: (Get w IO c, Members w IO c)- => (c -> System w Picture) -- ^ Component render function.- -> System w Picture-foldDrawM fn = cfoldM (\pic -> fmap (mappend pic) . fn) mempty+cfoldDrawM :: (Apecs.Get w IO c, Apecs.Members w IO c)+ => (c -> Apecs.System w Brillo.Picture) -- ^ Component render function.+ -> Apecs.System w Brillo.Picture+cfoldDrawM f = Apecs.cfoldM (\p -> fmap (mappend p) . f) mempty
− src/Apecs/Physics/Brillo.hs
@@ -1,65 +0,0 @@-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE TypeFamilies #-}--module Apecs.Physics.Brillo- ( convexToPicture- , Transform, worldTransform, drawBody- , simulate- , module Apecs.Brillo- ) where--import Control.Monad (foldM)-import Data.Semigroup (Semigroup (..))-import Brillo.Geometry.Angle (radToDeg)-import Brillo.Interface.IO.Simulate (simulateIO)--import Apecs-import Apecs.Physics-import Apecs.Brillo--convexToPicture :: Convex -> Picture-convexToPicture (Convex [V2 x y] radius) = Translate (realToFrac x) (realToFrac y) $ Circle (realToFrac radius)-convexToPicture (Convex [a,b] _) = Line [v2ToTuple a, v2ToTuple b]-convexToPicture (Convex verts _) = Polygon (v2ToTuple <$> verts)--v2ToTuple :: V2 Double -> (Float, Float)-v2ToTuple (V2 x y) = (realToFrac x, realToFrac y)--type Transform = (Position, Angle)-worldTransform :: Transform -> Picture -> Picture-worldTransform (Position (V2 x y), Angle theta) =- Translate (realToFrac x) (realToFrac y) .- Rotate (negate . radToDeg . realToFrac $ theta)--drawBody :: Has w IO Physics => (Body, Transform, ShapeList) -> System w Picture-drawBody (btype, transform, ShapeList shapes) = Color shColor . worldTransform transform <$> foldM foldfn mempty shapes- where foldfn pic shapeEty = do- Shape _ convex <- get shapeEty- return . mappend pic $ convexToPicture convex- shColor = case btype of- DynamicBody -> red- KinematicBody -> green- StaticBody -> blue--simulate- :: ( Has w IO Camera- , Has w IO Physics- )- => Display- -> System w ()-simulate disp = do- w <- ask- liftIO $- simulateIO disp- black- 60- w- (\_ -> runSystem draw w)- (\_ _ _ -> runSystem (stepPhysics (1/60)) w >> return w)-- where- draw = do- pic <- foldDrawM drawBody- cam <- get global- return $ cameraTransform cam pic
test/Spec.hs view
@@ -1,7 +1,6 @@ module Spec where import Apecs-import Apecs.Brillo.Physics test :: IO () test = putStrLn "tests not done yet"