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
|
module Pong
(
GameEvent(..)
, GameObject
, newWorld
, stepWorld
, aabb
)
where
import Spear.Math.AABB
import Spear.Math.Spatial2
import Spear.Math.Vector
import Spear.Step
import Data.List (foldl')
import Data.Monoid
import GHC.Float (double2Float)
-- 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 :: AABB2
ballBox = AABB2 (vec2 (-s) (-s)) (vec2 s s) where s = 0.01
padSize = vec2 0.05 0.02
padBox = AABB2 (-padSize) padSize
obj2 x y = obj2FromVectors unitx2 unity2 (vec2 x y)
ballVelocity = Vector2 0.3 0.3
newWorld =
[ GameObject ballBox (obj2 0.5 0.5) $ stepBall ballVelocity
, GameObject padBox (obj2 0.5 0.9) stepEnemy
, GameObject padBox (obj2 0.5 0.1) stepPlayer
]
-- Ball steppers
stepBall vel = collideBall vel .> moveBall
collideBall :: Vector2 -> Step [GameObject] e GameObject (Vector2, GameObject)
collideBall vel = step $ \_ _ 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
in ((vel', 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 (-1) 0)
, switch StopRight sid MoveRight (moveGO' $ vec2 1 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 = if x < a then a else if x > b then b else x
(Vector2 s _) = padSize
in setPos p' go
toDir True MoveLeft = vec2 (-1) 0
toDir True MoveRight = vec2 1 0
toDir _ _ = vec2 0 0
|
