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/pong/Pong.hs | |
| parent | 8f2ec33e8c15e523b2b60d3bfd8e6360313a0657 (diff) | |
Add App module.
Diffstat (limited to 'demos/pong/Pong.hs')
| -rw-r--r-- | demos/pong/Pong.hs | 46 |
1 files changed, 28 insertions, 18 deletions
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 | ||
