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
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
|
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE TypeSynonymInstances #-}
module Pong
( GameEvent (..),
GameObject,
newWorld,
stepWorld,
aabb,
)
where
import Spear.Math.AABB
import Spear.Math.Algebra
import Spear.Math.Spatial
import Spear.Math.Spatial2
import Spear.Math.Vector
import Spear.Prelude
import Spear.Step
import Data.Monoid (mconcat)
-- Configuration
padSize = vec2 0.07 0.015
ballSize = 0.012 :: Float
ballSpeed = 0.7 :: Float
initialBallVelocity = vec2 1 1
maxBounceAngle = (65::Float) * (pi::Float)/(180::Float)
playerSpeed = 1.0 :: Float
enemySpeed = 7.0 :: Float
enemyMomentum = 1.0 :: Float
initialEnemyPos = vec2 0.5 0.9
initialPlayerPos = vec2 0.5 0.1
initialBallPos = vec2 0.5 0.5
-- Game events
data GameEvent
= MoveLeft
| MoveRight
deriving (Eq, Ord, Show)
-- Game objects
data GameObject = GameObject
{ aabb :: AABB2,
basis :: Transform2,
gostep :: Step [GameObject] [GameEvent] GameObject GameObject
}
instance Has2dTransform GameObject where
set2dTransform transform object = object { basis = transform }
transform2 = basis
instance Positional GameObject Vector2 where
setPosition p = with2dTransform (setPosition p)
position = position . basis
translate v = with2dTransform (translate v)
instance Rotational GameObject Vector2 Angle where
setRotation r = with2dTransform (setRotation r)
rotation = rotation . basis
rotate angle = with2dTransform (rotate angle)
right = right . basis
up = up . basis
forward = forward . basis
setForward v = with2dTransform (setForward v)
instance Spatial GameObject Vector2 Angle Transform2 where
setTransform t obj = obj { basis = t }
transform = basis
ballBox, padBox :: AABB2
ballBox = AABB2 (vec2 (-s) (-s)) (vec2 s s) where s = ballSize
padBox = AABB2 (-padSize) padSize
newWorld =
[ GameObject ballBox (makeAt initialBallPos) $ stepBall initialBallVelocity,
GameObject padBox (makeAt initialEnemyPos) stepEnemy,
GameObject padBox (makeAt initialPlayerPos) stepPlayer
]
where makeAt = newTransform2 unitx2 unity2
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'}
-- 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) = translate (position ball) (aabb ball)
sideCollision = x pmin < 0 || x pmax > 1
backCollision = y pmin < 0 || y pmax > 1
flipX v@(Vector2 x y) = if sideCollision then vec2 (-x) y else v
flipY v@(Vector2 x y) = if backCollision then vec2 x (-y) else v
vel' = normalise . (\v -> foldl (paddleBounce ball) v (tail gos)) . flipX . flipY $ vel
collision = vel' /= vel
-- Apply offset when collision occurs to avoid sticky collisions.
delta = (1::Float) + if collision then (3::Float)*dt else (0::Float)
in ((ballSpeed * delta * vel', ball), collideBall vel')
paddleBounce :: GameObject -> Vector2 -> GameObject -> Vector2
paddleBounce ball v paddle =
if collide ball paddle
then
let (AABB2 pmin pmax) = translate (position paddle) (aabb paddle)
center = (x pmin + x pmax) / (2::Float)
-- Normalized offset of the ball from the paddle's center, [-1, +1].
-- It's outside the [-1, +1] range if there is no collision.
offset = (x (position ball) - center) / ((x pmax - x pmin) / (2::Float))
angle = offset * maxBounceAngle
-- When it bounces off of a paddle, y vel is flipped.
ysign = -(signum (y v))
in vec2 (sin angle) (ysign * cos angle)
else v
collide :: GameObject -> GameObject -> Bool
collide go1 go2 =
let (AABB2 (Vector2 xmin1 ymin1) (Vector2 xmax1 ymax1)) =
translate (position go1) (aabb go1)
(AABB2 (Vector2 xmin2 ymin2) (Vector2 xmax2 ymax2)) =
translate (position go2) (aabb go2)
in not $
xmax1 < xmin2 ||
xmin1 > xmax2 ||
ymax1 < ymin2 ||
ymin1 > ymax2
moveBall :: Step s e (Vector2, GameObject) GameObject
moveBall = step $ \_ dt _ _ (vel, ball) -> (translate (vel * dt) ball, moveBall)
-- Enemy stepper
stepEnemy = movePad 0 .> clamp
movePad :: Float -> Step [GameObject] e GameObject GameObject
movePad previousMomentumVector = step $ \_ dt gos _ pad ->
let ball = head gos
heading = (x . position $ ball) - (x . position $ pad)
chaseVector = enemySpeed * heading
momentumVector = previousMomentumVector + enemyMomentum * heading * dt
vx = chaseVector * dt + momentumVector
in (translate (vec2 vx 0) pad, movePad momentumVector)
sign :: Float -> Float
sign x = if x >= 0 then 1 else -1
-- Player stepper
stepPlayer = sfold moveGO .> clamp
moveGO = mconcat
[ swhen MoveLeft $ moveGO' (vec2 (-playerSpeed) 0)
, swhen MoveRight $ moveGO' (vec2 playerSpeed 0)
]
moveGO' :: Vector2 -> Step s e GameObject GameObject
moveGO' dir = step $ \_ dt _ _ go -> (translate (dir * dt) go, moveGO' dir)
clamp :: Step s e GameObject GameObject
clamp = spure $ \go ->
let p' = vec2 (clamp' x s (1 - s)) y
(Vector2 x y) = position go
clamp' x a b
| x < a = a
| x > b = b
| otherwise = x
(Vector2 s _) = padSize
in setPosition p' go
|
