1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
|
module Pong
( GameEvent (..),
GameObject,
newWorld,
stepWorld,
aabb,
)
where
import Data.Monoid (mconcat)
import GHC.Float (double2Float)
import Spear.Math.AABB
import Spear.Math.Spatial2
import Spear.Math.Vector
import Spear.Step
-- Configuration
padSize = vec2 0.05 0.02
ballSize = 0.01
ballVelocity = vec2 0.3 0.3
playerSpeed = 0.7
initialEnemyPos = vec2 0.5 0.9
initialPlayerPos = vec2 0.5 0.1
initialBallPos = vec2 0.5 0.5
-- Game events
data GameEvent
= MoveLeft
| MoveRight
| StopLeft
| StopRight
deriving (Eq, Ord)
-- Game objects
data GameObject = GameObject
{ aabb :: AABB2,
obj :: Obj2,
gostep :: Step [GameObject] [GameEvent] GameObject GameObject
}
instance Spatial2 GameObject where
getObj2 = obj
setObj2 s o = s {obj = o}
stepWorld :: Elapsed -> Dt -> [GameEvent] -> [GameObject] -> [GameObject]
stepWorld elapsed dt evts gos = map (update elapsed dt evts gos) gos
update :: Elapsed -> Dt -> [GameEvent] -> [GameObject] -> GameObject -> GameObject
update elapsed dt evts gos go =
let (go', s') = runStep (gostep go) elapsed dt gos evts go
in go' {gostep = s'}
ballBox, padBox :: AABB2
ballBox = AABB2 (vec2 (- s) (- s)) (vec2 s s) where s = ballSize
padBox = AABB2 (- padSize) padSize
obj2 = obj2FromVectors unitx2 unity2
newWorld =
[ GameObject ballBox (obj2 initialBallPos) $ stepBall ballVelocity,
GameObject padBox (obj2 initialEnemyPos) stepEnemy,
GameObject padBox (obj2 initialPlayerPos) stepPlayer
]
-- Ball steppers
stepBall vel = collideBall vel .> moveBall
collideBall :: Vector2 -> Step [GameObject] e GameObject (Vector2, GameObject)
collideBall vel = step $ \_ dt gos _ ball ->
let (AABB2 pmin pmax) = aabb ball `aabbAdd` pos ball
collideCol = x pmin < 0 || x pmax > 1
collideRow = y pmin < 0 || y pmax > 1 || any (collide ball) (tail gos)
negx v@(Vector2 x y) = if collideCol then vec2 (- x) y else v
negy v@(Vector2 x y) = if collideRow then vec2 x (- y) else v
vel' = negx . negy $ vel
delta = dt -- A small delta to apply when collision occurs.
adjustX = if collideCol then scale delta (vec2 (x vel) 0) else vec2 0 0
adjustY = if collideRow then scale delta (vec2 0 (y vel)) else vec2 0 0
in ((vel' + adjustX + adjustY, ball), collideBall vel')
collide go1 go2 =
let (AABB2 (Vector2 xmin1 ymin1) (Vector2 xmax1 ymax1)) =
aabb go1 `aabbAdd` pos go1
(AABB2 (Vector2 xmin2 ymin2) (Vector2 xmax2 ymax2)) =
aabb go2 `aabbAdd` pos go2
in not $
xmax1 < xmin2 || xmin1 > xmax2
|| ymax1 < ymin2
|| ymin1 > ymax2
aabbAdd (AABB2 pmin pmax) p = AABB2 (p + pmin) (p + pmax)
moveBall :: Step s e (Vector2, GameObject) GameObject
moveBall = step $ \_ dt _ _ (vel, ball) -> (move (scale dt vel) ball, moveBall)
-- Enemy stepper
stepEnemy = movePad
movePad :: Step s e GameObject GameObject
movePad = step $ \elapsed _ _ _ pad ->
let p = vec2 px 0.9
px =
double2Float (sin elapsed * 0.5 + 0.5)
* (1 - 2 * x padSize)
+ x padSize
in (setPos p pad, movePad)
-- Player stepper
stepPlayer = sfold moveGO .> clamp
moveGO =
mconcat
[ switch StopLeft sid MoveLeft (moveGO' $ vec2 (- playerSpeed) 0),
switch StopRight sid MoveRight (moveGO' $ vec2 playerSpeed 0)
]
moveGO' :: Vector2 -> Step s e GameObject GameObject
moveGO' dir = step $ \_ dt _ _ go -> (move (scale dt dir) go, moveGO' dir)
clamp :: Step s e GameObject GameObject
clamp = spure $ \go ->
let p' = vec2 (clamp' x s (1 - s)) y
(Vector2 x y) = pos go
clamp' x a b
| x < a = a
| x > b = b
| otherwise = x
(Vector2 s _) = padSize
in setPos p' go
|
