aboutsummaryrefslogtreecommitdiff
path: root/demos/pong/Pong.hs
diff options
context:
space:
mode:
authorJeanne-Kamikaze <jeannekamikaze@gmail.com>2013-08-18 12:08:06 +0200
committerJeanne-Kamikaze <jeannekamikaze@gmail.com>2013-08-18 12:08:06 +0200
commit527272ec4fca5aa375e593b8a005c3206a1bcc27 (patch)
treee82100738beb350baf724e1e87fb329dd2de27fa /demos/pong/Pong.hs
parent12b9253d857be440b0fc72a3344de20e4c60732a (diff)
Enhanced Step function
Diffstat (limited to 'demos/pong/Pong.hs')
-rw-r--r--demos/pong/Pong.hs54
1 files changed, 20 insertions, 34 deletions
diff --git a/demos/pong/Pong.hs b/demos/pong/Pong.hs
index b323aa2..6b2f888 100644
--- a/demos/pong/Pong.hs
+++ b/demos/pong/Pong.hs
@@ -24,14 +24,14 @@ data GameEvent
24 | MoveRight 24 | MoveRight
25 | StopLeft 25 | StopLeft
26 | StopRight 26 | StopRight
27 deriving Eq 27 deriving (Eq, Ord)
28 28
29-- Game objects 29-- Game objects
30 30
31data GameObject = GameObject 31data GameObject = GameObject
32 { aabb :: AABB2 32 { aabb :: AABB2
33 , obj :: Obj2 33 , obj :: Obj2
34 , gostep :: Step ([GameEvent], [GameObject], GameObject) GameObject 34 , gostep :: Step [GameObject] [GameEvent] GameObject GameObject
35 } 35 }
36 36
37instance Spatial2 GameObject where 37instance Spatial2 GameObject where
@@ -43,7 +43,7 @@ stepWorld elapsed dt evts gos = map (update elapsed dt evts gos) gos
43 43
44update :: Elapsed -> Dt -> [GameEvent] -> [GameObject] -> GameObject -> GameObject 44update :: Elapsed -> Dt -> [GameEvent] -> [GameObject] -> GameObject -> GameObject
45update elapsed dt evts gos go = 45update elapsed dt evts gos go =
46 let (go', s') = step (gostep go) elapsed dt (evts, gos, go) 46 let (go', s') = runStep (gostep go) elapsed dt gos evts go
47 in go' { gostep = s' } 47 in go' { gostep = s' }
48 48
49ballBox :: AABB2 49ballBox :: AABB2
@@ -63,23 +63,12 @@ newWorld =
63 , GameObject padBox (obj2 0.5 0.1) stepPlayer 63 , GameObject padBox (obj2 0.5 0.1) stepPlayer
64 ] 64 ]
65 65
66-- Generic steppers
67
68ignore :: Step ([GameEvent], [GameObject], GameObject) GameObject
69ignore = spure $ \(_,_,go) -> go
70
71ignoreEvts :: Step ([GameEvent], [GameObject], GameObject) ([GameObject], GameObject)
72ignoreEvts = spure $ \(_, world, go) -> (world, go)
73
74ignoreGOs :: Step ([GameEvent], [GameObject], GameObject) ([GameEvent], GameObject)
75ignoreGOs = spure $ \(evts, _, go) -> (evts, go)
76
77-- Ball steppers 66-- Ball steppers
78 67
79stepBall vel = ignoreEvts .> collideBall vel .> moveBall 68stepBall vel = collideBall vel .> moveBall
80 69
81collideBall :: Vector2 -> Step ([GameObject], GameObject) (Vector2, GameObject) 70collideBall :: Vector2 -> Step [GameObject] e GameObject (Vector2, GameObject)
82collideBall vel = Step $ \_ _ (gos, ball) -> 71collideBall vel = step $ \_ _ gos _ ball ->
83 let (AABB2 pmin pmax) = aabb ball `aabbAdd` pos ball 72 let (AABB2 pmin pmax) = aabb ball `aabbAdd` pos ball
84 collideCol = x pmin < 0 || x pmax > 1 73 collideCol = x pmin < 0 || x pmax > 1
85 collideRow = y pmin < 0 || y pmax > 1 74 collideRow = y pmin < 0 || y pmax > 1
@@ -99,15 +88,15 @@ collide go1 go2 =
99 88
100aabbAdd (AABB2 pmin pmax) p = AABB2 (p+pmin) (p+pmax) 89aabbAdd (AABB2 pmin pmax) p = AABB2 (p+pmin) (p+pmax)
101 90
102moveBall :: Step (Vector2, GameObject) GameObject 91moveBall :: Step s e (Vector2, GameObject) GameObject
103moveBall = Step $ \_ dt (vel,ball) -> (move (scale dt vel) ball, moveBall) 92moveBall = step $ \_ dt _ _ (vel,ball) -> (move (scale dt vel) ball, moveBall)
104 93
105-- Enemy stepper 94-- Enemy stepper
106 95
107stepEnemy = ignore .> movePad 96stepEnemy = movePad
108 97
109movePad :: Step GameObject GameObject 98movePad :: Step s e GameObject GameObject
110movePad = Step $ \elapsed _ pad -> 99movePad = step $ \elapsed _ _ _ pad ->
111 let p = vec2 px 0.9 100 let p = vec2 px 0.9
112 px = double2Float (sin elapsed * 0.5 + 0.5) 101 px = double2Float (sin elapsed * 0.5 + 0.5)
113 * (1 - 2 * x padSize) 102 * (1 - 2 * x padSize)
@@ -116,20 +105,17 @@ movePad = Step $ \elapsed _ pad ->
116 105
117-- Player stepper 106-- Player stepper
118 107
119stepPlayer = ignoreGOs 108stepPlayer = sfold moveGO .> clamp
120 .> moveGO False MoveLeft StopLeft 109
121 .> moveGO False MoveRight StopRight 110moveGO = mconcat
122 .> ssnd 111 [ switch StopLeft sid MoveLeft (moveGO' $ vec2 (-1) 0)
123 .> clamp 112 , switch StopRight sid MoveRight (moveGO' $ vec2 1 0)
113 ]
124 114
125moveGO :: Bool -> GameEvent -> GameEvent 115moveGO' :: Vector2 -> Step s e GameObject GameObject
126 -> Step ([GameEvent], GameObject) ([GameEvent], GameObject) 116moveGO' dir = step $ \_ dt _ _ go -> (move (scale dt dir) go, moveGO' dir)
127moveGO moving start stop = Step $ \_ dt (evts, go) ->
128 let moving' = (moving || any (==start) evts) && not (any (==stop) evts)
129 dir = scale dt $ toDir moving' start
130 in ((evts, move dir go), moveGO moving' start stop)
131 117
132clamp :: Step GameObject GameObject 118clamp :: Step s e GameObject GameObject
133clamp = spure $ \go -> 119clamp = spure $ \go ->
134 let p' = vec2 (clamp' x s (1 - s)) y 120 let p' = vec2 (clamp' x s (1 - s)) y
135 (Vector2 x y) = pos go 121 (Vector2 x y) = pos go