diff options
author | Jeanne-Kamikaze <jeannekamikaze@gmail.com> | 2013-08-18 12:08:06 +0200 |
---|---|---|
committer | Jeanne-Kamikaze <jeannekamikaze@gmail.com> | 2013-08-18 12:08:06 +0200 |
commit | 527272ec4fca5aa375e593b8a005c3206a1bcc27 (patch) | |
tree | e82100738beb350baf724e1e87fb329dd2de27fa /demos | |
parent | 12b9253d857be440b0fc72a3344de20e4c60732a (diff) |
Enhanced Step function
Diffstat (limited to 'demos')
-rw-r--r-- | demos/pong/Pong.hs | 54 |
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 | ||
31 | data GameObject = GameObject | 31 | data 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 | ||
37 | instance Spatial2 GameObject where | 37 | instance Spatial2 GameObject where |
@@ -43,7 +43,7 @@ stepWorld elapsed dt evts gos = map (update elapsed dt evts gos) gos | |||
43 | 43 | ||
44 | update :: Elapsed -> Dt -> [GameEvent] -> [GameObject] -> GameObject -> GameObject | 44 | update :: Elapsed -> Dt -> [GameEvent] -> [GameObject] -> GameObject -> GameObject |
45 | update elapsed dt evts gos go = | 45 | update 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 | ||
49 | ballBox :: AABB2 | 49 | ballBox :: 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 | |||
68 | ignore :: Step ([GameEvent], [GameObject], GameObject) GameObject | ||
69 | ignore = spure $ \(_,_,go) -> go | ||
70 | |||
71 | ignoreEvts :: Step ([GameEvent], [GameObject], GameObject) ([GameObject], GameObject) | ||
72 | ignoreEvts = spure $ \(_, world, go) -> (world, go) | ||
73 | |||
74 | ignoreGOs :: Step ([GameEvent], [GameObject], GameObject) ([GameEvent], GameObject) | ||
75 | ignoreGOs = spure $ \(evts, _, go) -> (evts, go) | ||
76 | |||
77 | -- Ball steppers | 66 | -- Ball steppers |
78 | 67 | ||
79 | stepBall vel = ignoreEvts .> collideBall vel .> moveBall | 68 | stepBall vel = collideBall vel .> moveBall |
80 | 69 | ||
81 | collideBall :: Vector2 -> Step ([GameObject], GameObject) (Vector2, GameObject) | 70 | collideBall :: Vector2 -> Step [GameObject] e GameObject (Vector2, GameObject) |
82 | collideBall vel = Step $ \_ _ (gos, ball) -> | 71 | collideBall 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 | ||
100 | aabbAdd (AABB2 pmin pmax) p = AABB2 (p+pmin) (p+pmax) | 89 | aabbAdd (AABB2 pmin pmax) p = AABB2 (p+pmin) (p+pmax) |
101 | 90 | ||
102 | moveBall :: Step (Vector2, GameObject) GameObject | 91 | moveBall :: Step s e (Vector2, GameObject) GameObject |
103 | moveBall = Step $ \_ dt (vel,ball) -> (move (scale dt vel) ball, moveBall) | 92 | moveBall = step $ \_ dt _ _ (vel,ball) -> (move (scale dt vel) ball, moveBall) |
104 | 93 | ||
105 | -- Enemy stepper | 94 | -- Enemy stepper |
106 | 95 | ||
107 | stepEnemy = ignore .> movePad | 96 | stepEnemy = movePad |
108 | 97 | ||
109 | movePad :: Step GameObject GameObject | 98 | movePad :: Step s e GameObject GameObject |
110 | movePad = Step $ \elapsed _ pad -> | 99 | movePad = 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 | ||
119 | stepPlayer = ignoreGOs | 108 | stepPlayer = sfold moveGO .> clamp |
120 | .> moveGO False MoveLeft StopLeft | 109 | |
121 | .> moveGO False MoveRight StopRight | 110 | moveGO = 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 | ||
125 | moveGO :: Bool -> GameEvent -> GameEvent | 115 | moveGO' :: Vector2 -> Step s e GameObject GameObject |
126 | -> Step ([GameEvent], GameObject) ([GameEvent], GameObject) | 116 | moveGO' dir = step $ \_ dt _ _ go -> (move (scale dt dir) go, moveGO' dir) |
127 | moveGO 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 | ||
132 | clamp :: Step GameObject GameObject | 118 | clamp :: Step s e GameObject GameObject |
133 | clamp = spure $ \go -> | 119 | clamp = 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 |