diff options
Diffstat (limited to 'Demos/Pong')
-rw-r--r-- | Demos/Pong/Main.hs | 26 | ||||
-rw-r--r-- | Demos/Pong/Pong.hs | 85 |
2 files changed, 55 insertions, 56 deletions
diff --git a/Demos/Pong/Main.hs b/Demos/Pong/Main.hs index 0237a26..21fcb0c 100644 --- a/Demos/Pong/Main.hs +++ b/Demos/Pong/Main.hs | |||
@@ -14,6 +14,7 @@ import Spear.Render.Core.State | |||
14 | import Spear.Render.Immediate | 14 | import Spear.Render.Immediate |
15 | import Spear.Window | 15 | import Spear.Window |
16 | 16 | ||
17 | import Control.Monad (when) | ||
17 | import Data.Maybe (mapMaybe) | 18 | import Data.Maybe (mapMaybe) |
18 | 19 | ||
19 | 20 | ||
@@ -28,7 +29,7 @@ data GameState = GameState | |||
28 | app = App step render resize | 29 | app = App step render resize |
29 | 30 | ||
30 | main = | 31 | main = |
31 | withWindow (900, 600) (Just "Pong") initGame endGame $ | 32 | withWindow (1920, 1200) (Just "Pong") initGame endGame $ |
32 | loop app | 33 | loop app |
33 | 34 | ||
34 | initGame :: Window -> Game () GameState | 35 | initGame :: Window -> Game () GameState |
@@ -44,13 +45,22 @@ endGame = do | |||
44 | step :: Elapsed -> Dt -> [InputEvent] -> Game GameState Bool | 45 | step :: Elapsed -> Dt -> [InputEvent] -> Game GameState Bool |
45 | step elapsed dt inputEvents = do | 46 | step elapsed dt inputEvents = do |
46 | gs <- getGameState | 47 | gs <- getGameState |
47 | let events = translateEvents inputEvents | 48 | events <- processInput (window gs) |
49 | --when (events /= []) $ gameIO . putStrLn $ show events | ||
48 | modifyGameState $ \gs -> | 50 | modifyGameState $ \gs -> |
49 | gs | 51 | gs |
50 | { world = stepWorld (realToFrac elapsed) (realToFrac dt) events (world gs) | 52 | { world = stepWorld (realToFrac elapsed) (realToFrac dt) events (world gs) |
51 | } | 53 | } |
52 | return (not $ exitRequested inputEvents) | 54 | return (not $ exitRequested inputEvents) |
53 | 55 | ||
56 | processInput :: Window -> Game GameState [GameEvent] | ||
57 | processInput window = processKeys window | ||
58 | [ (KEY_A, MoveLeft) | ||
59 | , (KEY_D, MoveRight) | ||
60 | ] | ||
61 | |||
62 | exitRequested = elem (KeyDown KEY_ESC) | ||
63 | |||
54 | render :: Game GameState () | 64 | render :: Game GameState () |
55 | render = do | 65 | render = do |
56 | gameState <- getGameState | 66 | gameState <- getGameState |
@@ -79,7 +89,7 @@ renderBackground = | |||
79 | let pmin = 0 :: Float | 89 | let pmin = 0 :: Float |
80 | pmax = 1 :: Float | 90 | pmax = 1 :: Float |
81 | in do | 91 | in do |
82 | immSetColour (vec4 0.6 0.35 0.6 1.0) | 92 | immSetColour (vec4 0.0 0.25 0.41 1.0) |
83 | immDrawQuads2d [ | 93 | immDrawQuads2d [ |
84 | (vec2 pmin pmin | 94 | (vec2 pmin pmin |
85 | ,vec2 pmax pmin | 95 | ,vec2 pmax pmin |
@@ -98,7 +108,6 @@ renderGO go = do | |||
98 | ,vec2 xmax ymax | 108 | ,vec2 xmax ymax |
99 | ,vec2 xmin ymax)] | 109 | ,vec2 xmin ymax)] |
100 | 110 | ||
101 | -- TODO: Fix the resize hang. | ||
102 | resize :: WindowEvent -> Game GameState () | 111 | resize :: WindowEvent -> Game GameState () |
103 | resize (ResizeEvent w h) = | 112 | resize (ResizeEvent w h) = |
104 | let r = fromIntegral w / fromIntegral h | 113 | let r = fromIntegral w / fromIntegral h |
@@ -112,12 +121,3 @@ resize (ResizeEvent w h) = | |||
112 | modifyGameState $ \state -> state { | 121 | modifyGameState $ \state -> state { |
113 | viewProjection = Matrix4.ortho left right bottom top (-1) 1 | 122 | viewProjection = Matrix4.ortho left right bottom top (-1) 1 |
114 | } | 123 | } |
115 | |||
116 | translateEvents = mapMaybe translateEvents' | ||
117 | where translateEvents' (KeyDown KEY_LEFT) = Just MoveLeft | ||
118 | translateEvents' (KeyDown KEY_RIGHT) = Just MoveRight | ||
119 | translateEvents' (KeyUp KEY_LEFT) = Just StopLeft | ||
120 | translateEvents' (KeyUp KEY_RIGHT) = Just StopRight | ||
121 | translateEvents' _ = Nothing | ||
122 | |||
123 | exitRequested = elem (KeyDown KEY_ESC) | ||
diff --git a/Demos/Pong/Pong.hs b/Demos/Pong/Pong.hs index 104a92e..dd8855b 100644 --- a/Demos/Pong/Pong.hs +++ b/Demos/Pong/Pong.hs | |||
@@ -24,13 +24,14 @@ import Data.Monoid (mconcat) | |||
24 | 24 | ||
25 | -- Configuration | 25 | -- Configuration |
26 | 26 | ||
27 | padSize = vec2 0.07 0.02 | 27 | padSize = vec2 0.07 0.015 |
28 | ballSize = 0.012 :: Float | 28 | ballSize = 0.012 :: Float |
29 | ballSpeed = 0.6 :: Float | 29 | ballSpeed = 0.7 :: Float |
30 | initialBallVelocity = vec2 1 1 | 30 | initialBallVelocity = vec2 1 1 |
31 | maxBounceAngle = (65::Float) * (pi::Float)/(180::Float) | 31 | maxBounceAngle = (65::Float) * (pi::Float)/(180::Float) |
32 | playerSpeed = 1.0 :: Float | 32 | playerSpeed = 1.0 :: Float |
33 | enemySpeed = 3.0 :: Float | 33 | enemySpeed = 7.0 :: Float |
34 | enemyMomentum = 0.1 :: Float | ||
34 | initialEnemyPos = vec2 0.5 0.9 | 35 | initialEnemyPos = vec2 0.5 0.9 |
35 | initialPlayerPos = vec2 0.5 0.1 | 36 | initialPlayerPos = vec2 0.5 0.1 |
36 | initialBallPos = vec2 0.5 0.5 | 37 | initialBallPos = vec2 0.5 0.5 |
@@ -40,9 +41,7 @@ initialBallPos = vec2 0.5 0.5 | |||
40 | data GameEvent | 41 | data GameEvent |
41 | = MoveLeft | 42 | = MoveLeft |
42 | | MoveRight | 43 | | MoveRight |
43 | | StopLeft | 44 | deriving (Eq, Ord, Show) |
44 | | StopRight | ||
45 | deriving (Eq, Ord) | ||
46 | 45 | ||
47 | -- Game objects | 46 | -- Game objects |
48 | 47 | ||
@@ -79,17 +78,9 @@ instance Spatial GameObject Vector2 Angle Transform2 where | |||
79 | transform = basis | 78 | transform = basis |
80 | 79 | ||
81 | 80 | ||
82 | stepWorld :: Elapsed -> Dt -> [GameEvent] -> [GameObject] -> [GameObject] | ||
83 | stepWorld elapsed dt evts gos = map (update elapsed dt evts gos) gos | ||
84 | |||
85 | update :: Elapsed -> Dt -> [GameEvent] -> [GameObject] -> GameObject -> GameObject | ||
86 | update elapsed dt evts gos go = | ||
87 | let (go', s') = runStep (gostep go) elapsed dt gos evts go | ||
88 | in go' {gostep = s'} | ||
89 | |||
90 | ballBox, padBox :: AABB2 | 81 | ballBox, padBox :: AABB2 |
91 | ballBox = AABB2 (vec2 (-s) (-s)) (vec2 s s) where s = ballSize | 82 | ballBox = AABB2 (vec2 (-s) (-s)) (vec2 s s) where s = ballSize |
92 | padBox = AABB2 (-padSize) padSize | 83 | padBox = AABB2 (-padSize) padSize |
93 | 84 | ||
94 | newWorld = | 85 | newWorld = |
95 | [ GameObject ballBox (makeAt initialBallPos) $ stepBall initialBallVelocity, | 86 | [ GameObject ballBox (makeAt initialBallPos) $ stepBall initialBallVelocity, |
@@ -98,23 +89,30 @@ newWorld = | |||
98 | ] | 89 | ] |
99 | where makeAt = newTransform2 unitx2 unity2 | 90 | where makeAt = newTransform2 unitx2 unity2 |
100 | 91 | ||
92 | |||
93 | stepWorld :: Elapsed -> Dt -> [GameEvent] -> [GameObject] -> [GameObject] | ||
94 | stepWorld elapsed dt evts gos = map (update elapsed dt evts gos) gos | ||
95 | |||
96 | update :: Elapsed -> Dt -> [GameEvent] -> [GameObject] -> GameObject -> GameObject | ||
97 | update elapsed dt evts gos go = | ||
98 | let (go', s') = runStep (gostep go) elapsed dt gos evts go | ||
99 | in go' {gostep = s'} | ||
100 | |||
101 | -- Ball steppers | 101 | -- Ball steppers |
102 | 102 | ||
103 | stepBall vel = collideBall vel .> moveBall | 103 | stepBall vel = collideBall vel .> moveBall |
104 | 104 | ||
105 | -- TODO: in collideBall and paddleBounce, we should an apply an offset to the | ||
106 | -- ball when collision is detected. | ||
107 | collideBall :: Vector2 -> Step [GameObject] e GameObject (Vector2, GameObject) | 105 | collideBall :: Vector2 -> Step [GameObject] e GameObject (Vector2, GameObject) |
108 | collideBall vel = step $ \_ dt gos _ ball -> | 106 | collideBall vel = step $ \_ dt gos _ ball -> |
109 | let (AABB2 pmin pmax) = translate (position ball) (aabb ball) | 107 | let (AABB2 pmin pmax) = translate (position ball) (aabb ball) |
110 | collideSide = x pmin < 0 || x pmax > 1 | 108 | sideCollision = x pmin < 0 || x pmax > 1 |
111 | collideBack = y pmin < 0 || y pmax > 1 | 109 | backCollision = y pmin < 0 || y pmax > 1 |
112 | collidePaddle = any (collide ball) (tail gos) | 110 | flipX v@(Vector2 x y) = if sideCollision then vec2 (-x) y else v |
113 | flipX v@(Vector2 x y) = if collideSide then vec2 (-x) y else v | 111 | flipY v@(Vector2 x y) = if backCollision then vec2 x (-y) else v |
114 | flipY v@(Vector2 x y) = if collideBack then vec2 x (-y) else v | ||
115 | vel' = normalise . (\v -> foldl (paddleBounce ball) v (tail gos)) . flipX . flipY $ vel | 112 | vel' = normalise . (\v -> foldl (paddleBounce ball) v (tail gos)) . flipX . flipY $ vel |
116 | -- A small delta to apply when collision occurs. | 113 | collision = vel' /= vel |
117 | delta = (1::Float) + if collideSide || collideBack || collidePaddle then (2::Float)*dt else (0::Float) | 114 | -- Apply offset when collision occurs to avoid sticky collisions. |
115 | delta = (1::Float) + if collision then (3::Float)*dt else (0::Float) | ||
118 | in ((ballSpeed * delta * vel', ball), collideBall vel') | 116 | in ((ballSpeed * delta * vel', ball), collideBall vel') |
119 | 117 | ||
120 | paddleBounce :: GameObject -> Vector2 -> GameObject -> Vector2 | 118 | paddleBounce :: GameObject -> Vector2 -> GameObject -> Vector2 |
@@ -139,37 +137,38 @@ collide go1 go2 = | |||
139 | (AABB2 (Vector2 xmin2 ymin2) (Vector2 xmax2 ymax2)) = | 137 | (AABB2 (Vector2 xmin2 ymin2) (Vector2 xmax2 ymax2)) = |
140 | translate (position go2) (aabb go2) | 138 | translate (position go2) (aabb go2) |
141 | in not $ | 139 | in not $ |
142 | xmax1 < xmin2 | 140 | xmax1 < xmin2 || |
143 | || xmin1 > xmax2 | 141 | xmin1 > xmax2 || |
144 | || ymax1 < ymin2 | 142 | ymax1 < ymin2 || |
145 | || ymin1 > ymax2 | 143 | ymin1 > ymax2 |
146 | 144 | ||
147 | moveBall :: Step s e (Vector2, GameObject) GameObject | 145 | moveBall :: Step s e (Vector2, GameObject) GameObject |
148 | moveBall = step $ \_ dt _ _ (vel, ball) -> (translate (vel * dt) ball, moveBall) | 146 | moveBall = step $ \_ dt _ _ (vel, ball) -> (translate (vel * dt) ball, moveBall) |
149 | 147 | ||
150 | -- Enemy stepper | 148 | -- Enemy stepper |
151 | 149 | ||
152 | stepEnemy = movePad | 150 | stepEnemy = movePad 0 .> clamp |
153 | 151 | ||
154 | movePad :: Step s e GameObject GameObject | 152 | movePad :: Float -> Step [GameObject] e GameObject GameObject |
155 | movePad = step $ \elapsed _ _ _ pad -> | 153 | movePad previousMomentum = step $ \_ dt gos _ pad -> |
156 | let enemyY = 0.9 | 154 | let ball = head gos |
157 | p = vec2 px enemyY | 155 | offset = (x . position $ ball) - (x . position $ pad) |
158 | px = | 156 | chaseVector = enemySpeed * offset |
159 | (sin (enemySpeed * elapsed) * (0.5::Float) + (0.5::Float)) | 157 | momentum = previousMomentum + enemyMomentum * chaseVector |
160 | * ((1::Float) - (2::Float) * x padSize) | 158 | vx = chaseVector + momentum |
161 | + x padSize | 159 | in (translate (vec2 (vx * dt) 0) pad, movePad momentum) |
162 | in (setPosition p pad, movePad) | 160 | |
161 | sign :: Float -> Float | ||
162 | sign x = if x >= 0 then 1 else -1 | ||
163 | 163 | ||
164 | -- Player stepper | 164 | -- Player stepper |
165 | 165 | ||
166 | stepPlayer = sfold moveGO .> clamp | 166 | stepPlayer = sfold moveGO .> clamp |
167 | 167 | ||
168 | moveGO = | 168 | moveGO = mconcat |
169 | mconcat | 169 | [ swhen MoveLeft $ moveGO' (vec2 (-playerSpeed) 0) |
170 | [ switch StopLeft sid MoveLeft (moveGO' $ vec2 (-playerSpeed) 0), | 170 | , swhen MoveRight $ moveGO' (vec2 playerSpeed 0) |
171 | switch StopRight sid MoveRight (moveGO' $ vec2 playerSpeed 0) | 171 | ] |
172 | ] | ||
173 | 172 | ||
174 | moveGO' :: Vector2 -> Step s e GameObject GameObject | 173 | moveGO' :: Vector2 -> Step s e GameObject GameObject |
175 | moveGO' dir = step $ \_ dt _ _ go -> (translate (dir * dt) go, moveGO' dir) | 174 | moveGO' dir = step $ \_ dt _ _ go -> (translate (dir * dt) go, moveGO' dir) |