aboutsummaryrefslogtreecommitdiff
path: root/demos/pong/Pong.hs
diff options
context:
space:
mode:
Diffstat (limited to 'demos/pong/Pong.hs')
-rw-r--r--demos/pong/Pong.hs46
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
14import Spear.Math.Vector 14import Spear.Math.Vector
15import Spear.Step 15import Spear.Step
16 16
17-- Configuration
18
19padSize = vec2 0.05 0.02
20
21ballSize = 0.01
22
23ballVelocity = vec2 0.3 0.3
24
25playerSpeed = 0.7
26
27initialEnemyPos = vec2 0.5 0.9
28
29initialPlayerPos = vec2 0.5 0.1
30
31initialBallPos = vec2 0.5 0.5
32
17-- Game events 33-- Game events
18 34
19data GameEvent 35data 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
46ballBox :: AABB2 62ballBox, padBox :: AABB2
47ballBox = AABB2 (vec2 (- s) (- s)) (vec2 s s) where s = 0.01 63ballBox = AABB2 (vec2 (- s) (- s)) (vec2 s s) where s = ballSize
48
49padSize = vec2 0.05 0.02
50
51padBox = AABB2 (- padSize) padSize 64padBox = AABB2 (- padSize) padSize
52 65
53obj2 x y = obj2FromVectors unitx2 unity2 (vec2 x y) 66obj2 = obj2FromVectors unitx2 unity2
54
55ballVelocity = Vector2 0.3 0.3
56 67
57newWorld = 68newWorld =
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
111moveGO = 122moveGO =
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
117moveGO' :: Vector2 -> Step s e GameObject GameObject 128moveGO' :: Vector2 -> Step s e GameObject GameObject
@@ -121,10 +132,9 @@ clamp :: Step s e GameObject GameObject
121clamp = spure $ \go -> 132clamp = 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
128toDir True MoveLeft = vec2 (-1) 0
129toDir True MoveRight = vec2 1 0
130toDir _ _ = vec2 0 0