diff --git a/Pong.hs b/Pong.hs new file mode 100644 index 0000000..d2b7898 --- /dev/null +++ b/Pong.hs @@ -0,0 +1,93 @@ +{-# LANGUAGE Arrows #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE TypeApplications #-} + +module Main where + +import Aztecs +import qualified Aztecs.ECS.Access as A +import qualified Aztecs.ECS.Query as Q +import qualified Aztecs.ECS.System as S +import qualified Aztecs.SDL as SDL +import Aztecs.SDL.Image (Image (..)) +import qualified Aztecs.SDL.Image as IMG +import Control.Arrow +import Control.DeepSeq +import GHC.Generics +import SDL ( V2 (..),) + +data PlayerKind = LeftPlayer | RightPlayer + deriving (Show, Eq, Generic, NFData) + +data Player = Player + { playerKind :: PlayerKind, + playerPosition :: Float + } + deriving (Show, Eq, Generic, NFData) + +instance Component Player + +setup :: Schedule IO () () +setup = proc () -> do + ballTexture <- system . load $ asset "assets/ball.png" () -< () + paddleTexture <- system . load $ asset "assets/paddle.png" () -< () + + access + ( \(ballTexture, paddleTexture) -> do + A.spawn_ $ bundle Window {windowTitle = "Aztecs"} + A.spawn_ $ bundle Camera {cameraViewport = V2 1000 500, cameraScale = 5} <> bundle transform2d + A.spawn_ $ + bundle Player {playerKind = LeftPlayer, playerPosition = 0} + <> bundle transform2d + <> bundle Image {imageTexture = paddleTexture} + A.spawn_ $ + bundle Player {playerKind = RightPlayer, playerPosition = 0} + <> bundle transform2d {transformTranslation = V2 50 0} + <> bundle Image {imageTexture = paddleTexture} + A.spawn_ $ + bundle Image {imageTexture = ballTexture} + <> bundle transform2d {transformTranslation = V2 10 10} + ) + -< + (ballTexture, paddleTexture) + +update :: System () () +update = proc () -> do + kb <- S.single Q.fetch -< () + let delta = 0.01 + makeDelta keyUp keyDown = + if isKeyPressed keyUp kb then -delta else if isKeyPressed keyDown kb then delta else 0 + leftDelta = makeDelta KeyW KeyS + rightDelta = makeDelta KeyUp KeyDown + S.map + ( proc (leftDelta, rightDelta) -> do + player <- Q.fetch -< () + transform <- Q.fetch @_ @Transform2D -< () + let d = case playerKind player of + LeftPlayer -> leftDelta + RightPlayer -> rightDelta + V2 x _ = transformTranslation transform + y = playerPosition player + d + Q.set -< transform {transformTranslation = V2 x $ round y} + Q.set -< player {playerPosition = y} + ) + -< + (leftDelta, rightDelta) + returnA -< () + +game :: Schedule IO () () +game = + SDL.setup + >>> system IMG.setup + >>> setup + >>> forever_ + ( IMG.load + >>> SDL.update + >>> system update + >>> system IMG.draw + >>> SDL.draw + ) + +main :: IO () +main = runSchedule_ game diff --git a/README.md b/README.md new file mode 100644 index 0000000..0acae74 --- /dev/null +++ b/README.md @@ -0,0 +1,8 @@ +# Aztecs Examples + +Example applications using [Aztecs](https://github.com/aztecs-hs/aztecs) + +## Running examples + +Examples can be run from the root folder of this repo with `cabal run {example}` (such as `cabal run ECS`). + diff --git a/assets/ball.png b/assets/ball.png new file mode 100644 index 0000000..b441812 Binary files /dev/null and b/assets/ball.png differ diff --git a/assets/paddle.png b/assets/paddle.png new file mode 100644 index 0000000..4341692 Binary files /dev/null and b/assets/paddle.png differ diff --git a/aztecs-examples.cabal b/aztecs-examples.cabal index 4fc77dc..856ba64 100644 --- a/aztecs-examples.cabal +++ b/aztecs-examples.cabal @@ -45,6 +45,18 @@ executable window aztecs-sdl >=0.4 && <0.5, sdl2 +executable pong + main-is: Pong.hs + default-language: Haskell2010 + ghc-options: -Wall + build-depends: + base, + aztecs >=0.7 && <0.8, + aztecs-sdl >=0.4 && <0.5, + aztecs-sdl-image >=0.4 && <0.5, + deepseq >=1, + sdl2 + executable image main-is: Image.hs default-language: Haskell2010