diff options
author | 3gg <3gg@shellblade.net> | 2022-09-18 17:18:03 -0700 |
---|---|---|
committer | 3gg <3gg@shellblade.net> | 2022-09-18 17:18:03 -0700 |
commit | d81c62adbc955855438f1626c685e92794017d2d (patch) | |
tree | 2c01aca5f304aa810e39a9dd15b126a55841929b /demos | |
parent | 8f2ec33e8c15e523b2b60d3bfd8e6360313a0657 (diff) |
Add App module.
Diffstat (limited to 'demos')
-rw-r--r-- | demos/pong/Main.hs | 15 | ||||
-rw-r--r-- | demos/pong/Pong.hs | 46 | ||||
-rw-r--r-- | demos/pong/pong.cabal | 2 |
3 files changed, 36 insertions, 27 deletions
diff --git a/demos/pong/Main.hs b/demos/pong/Main.hs index 3563c30..a9dfcdd 100644 --- a/demos/pong/Main.hs +++ b/demos/pong/Main.hs | |||
@@ -4,6 +4,7 @@ import Data.Maybe (mapMaybe) | |||
4 | import Graphics.Rendering.OpenGL.GL (($=)) | 4 | import Graphics.Rendering.OpenGL.GL (($=)) |
5 | import qualified Graphics.Rendering.OpenGL.GL as GL | 5 | import qualified Graphics.Rendering.OpenGL.GL as GL |
6 | import Pong | 6 | import Pong |
7 | import Spear.App | ||
7 | import Spear.Game | 8 | import Spear.Game |
8 | import Spear.Math.AABB | 9 | import Spear.Math.AABB |
9 | import Spear.Math.Spatial2 | 10 | import Spear.Math.Spatial2 |
@@ -27,19 +28,17 @@ initGame window = do | |||
27 | GL.loadIdentity | 28 | GL.loadIdentity |
28 | return $ GameState window newWorld | 29 | return $ GameState window newWorld |
29 | 30 | ||
30 | step :: Elapsed -> Dt -> Game GameState Bool | 31 | step :: Elapsed -> Dt -> [InputEvent] -> Game GameState Bool |
31 | step elapsed dt = do | 32 | step elapsed dt inputEvents = do |
32 | --gameIO $ putStrLn "Tick" | ||
33 | gs <- getGameState | 33 | gs <- getGameState |
34 | evts <- events (window gs) | 34 | gameIO . process $ inputEvents |
35 | gameIO . process $ evts | 35 | let events = translate inputEvents |
36 | let evts' = translate evts | ||
37 | modifyGameState $ \gs -> | 36 | modifyGameState $ \gs -> |
38 | gs | 37 | gs |
39 | { world = stepWorld elapsed dt evts' (world gs) | 38 | { world = stepWorld elapsed dt events (world gs) |
40 | } | 39 | } |
41 | getGameState >>= \gs -> gameIO . render $ world gs | 40 | getGameState >>= \gs -> gameIO . render $ world gs |
42 | return (not $ exitRequested evts) | 41 | return (not $ exitRequested inputEvents) |
43 | 42 | ||
44 | render world = do | 43 | render world = do |
45 | GL.clear [GL.ColorBuffer] | 44 | GL.clear [GL.ColorBuffer] |
diff --git a/demos/pong/Pong.hs b/demos/pong/Pong.hs index 232c69a..906e89b 100644 --- a/demos/pong/Pong.hs +++ b/demos/pong/Pong.hs | |||
@@ -14,6 +14,22 @@ import Spear.Math.Spatial2 | |||
14 | import Spear.Math.Vector | 14 | import Spear.Math.Vector |
15 | import Spear.Step | 15 | import Spear.Step |
16 | 16 | ||
17 | -- Configuration | ||
18 | |||
19 | padSize = vec2 0.05 0.02 | ||
20 | |||
21 | ballSize = 0.01 | ||
22 | |||
23 | ballVelocity = vec2 0.3 0.3 | ||
24 | |||
25 | playerSpeed = 0.7 | ||
26 | |||
27 | initialEnemyPos = vec2 0.5 0.9 | ||
28 | |||
29 | initialPlayerPos = vec2 0.5 0.1 | ||
30 | |||
31 | initialBallPos = vec2 0.5 0.5 | ||
32 | |||
17 | -- Game events | 33 | -- Game events |
18 | 34 | ||
19 | data GameEvent | 35 | data GameEvent |
@@ -43,21 +59,16 @@ update elapsed dt evts gos go = | |||
43 | let (go', s') = runStep (gostep go) elapsed dt gos evts go | 59 | let (go', s') = runStep (gostep go) elapsed dt gos evts go |
44 | in go' {gostep = s'} | 60 | in go' {gostep = s'} |
45 | 61 | ||
46 | ballBox :: AABB2 | 62 | ballBox, padBox :: AABB2 |
47 | ballBox = AABB2 (vec2 (- s) (- s)) (vec2 s s) where s = 0.01 | 63 | ballBox = AABB2 (vec2 (- s) (- s)) (vec2 s s) where s = ballSize |
48 | |||
49 | padSize = vec2 0.05 0.02 | ||
50 | |||
51 | padBox = AABB2 (- padSize) padSize | 64 | padBox = AABB2 (- padSize) padSize |
52 | 65 | ||
53 | obj2 x y = obj2FromVectors unitx2 unity2 (vec2 x y) | 66 | obj2 = obj2FromVectors unitx2 unity2 |
54 | |||
55 | ballVelocity = Vector2 0.3 0.3 | ||
56 | 67 | ||
57 | newWorld = | 68 | newWorld = |
58 | [ GameObject ballBox (obj2 0.5 0.5) $ stepBall ballVelocity, | 69 | [ GameObject ballBox (obj2 initialBallPos) $ stepBall ballVelocity, |
59 | GameObject padBox (obj2 0.5 0.9) stepEnemy, | 70 | GameObject padBox (obj2 initialEnemyPos) stepEnemy, |
60 | GameObject padBox (obj2 0.5 0.1) stepPlayer | 71 | GameObject padBox (obj2 initialPlayerPos) stepPlayer |
61 | ] | 72 | ] |
62 | 73 | ||
63 | -- Ball steppers | 74 | -- Ball steppers |
@@ -110,8 +121,8 @@ stepPlayer = sfold moveGO .> clamp | |||
110 | 121 | ||
111 | moveGO = | 122 | moveGO = |
112 | mconcat | 123 | mconcat |
113 | [ switch StopLeft sid MoveLeft (moveGO' $ vec2 (-1) 0), | 124 | [ switch StopLeft sid MoveLeft (moveGO' $ vec2 (- playerSpeed) 0), |
114 | switch StopRight sid MoveRight (moveGO' $ vec2 1 0) | 125 | switch StopRight sid MoveRight (moveGO' $ vec2 playerSpeed 0) |
115 | ] | 126 | ] |
116 | 127 | ||
117 | moveGO' :: Vector2 -> Step s e GameObject GameObject | 128 | moveGO' :: Vector2 -> Step s e GameObject GameObject |
@@ -121,10 +132,9 @@ clamp :: Step s e GameObject GameObject | |||
121 | clamp = spure $ \go -> | 132 | clamp = spure $ \go -> |
122 | let p' = vec2 (clamp' x s (1 - s)) y | 133 | let p' = vec2 (clamp' x s (1 - s)) y |
123 | (Vector2 x y) = pos go | 134 | (Vector2 x y) = pos go |
124 | clamp' x a b = if x < a then a else if x > b then b else x | 135 | clamp' x a b |
136 | | x < a = a | ||
137 | | x > b = b | ||
138 | | otherwise = x | ||
125 | (Vector2 s _) = padSize | 139 | (Vector2 s _) = padSize |
126 | in setPos p' go | 140 | in setPos p' go |
127 | |||
128 | toDir True MoveLeft = vec2 (-1) 0 | ||
129 | toDir True MoveRight = vec2 1 0 | ||
130 | toDir _ _ = vec2 0 0 | ||
diff --git a/demos/pong/pong.cabal b/demos/pong/pong.cabal index 23ada51..aec96ee 100644 --- a/demos/pong/pong.cabal +++ b/demos/pong/pong.cabal | |||
@@ -17,5 +17,5 @@ cabal-version: >=1.8 | |||
17 | executable pong | 17 | executable pong |
18 | -- hs-source-dirs: src | 18 | -- hs-source-dirs: src |
19 | main-is: Main.hs | 19 | main-is: Main.hs |
20 | -- other-modules: | 20 | other-modules: Pong |
21 | build-depends: base, Spear, OpenGL | 21 | build-depends: base, Spear, OpenGL |