diff options
Diffstat (limited to 'Demos/Pong')
-rw-r--r-- | Demos/Pong/Main.hs | 104 | ||||
-rw-r--r-- | Demos/Pong/Pong.hs | 186 |
2 files changed, 156 insertions, 134 deletions
diff --git a/Demos/Pong/Main.hs b/Demos/Pong/Main.hs index 0237a26..22b1021 100644 --- a/Demos/Pong/Main.hs +++ b/Demos/Pong/Main.hs | |||
@@ -1,3 +1,5 @@ | |||
1 | {-# LANGUAGE MultiParamTypeClasses #-} | ||
2 | |||
1 | module Main where | 3 | module Main where |
2 | 4 | ||
3 | import Pong | 5 | import Pong |
@@ -5,66 +7,85 @@ import Pong | |||
5 | import Spear.App | 7 | import Spear.App |
6 | import Spear.Game | 8 | import Spear.Game |
7 | import Spear.Math.AABB | 9 | import Spear.Math.AABB |
8 | import Spear.Math.Matrix4 as Matrix4 hiding (position) | 10 | import Spear.Math.Matrix4 as Matrix4 |
9 | import Spear.Math.Spatial | 11 | import Spear.Math.Spatial |
10 | import Spear.Math.Spatial2 | 12 | import Spear.Math.Spatial2 |
11 | import Spear.Math.Vector | 13 | import Spear.Math.Vector |
14 | import Spear.Physics.Collision | ||
12 | import Spear.Render.Core.Pipeline | 15 | import Spear.Render.Core.Pipeline |
13 | import Spear.Render.Core.State | 16 | import Spear.Render.Core.State |
14 | import Spear.Render.Immediate | 17 | import Spear.Render.Immediate |
18 | import Spear.Sound.Sound | ||
19 | import Spear.Sound.State | ||
15 | import Spear.Window | 20 | import Spear.Window |
16 | 21 | ||
17 | import Data.Maybe (mapMaybe) | 22 | import Control.Monad (when) |
18 | 23 | ||
19 | 24 | ||
20 | data GameState = GameState | 25 | data Pong = Pong |
21 | { window :: Window | 26 | { viewProjection :: Matrix4 |
22 | , renderCoreState :: RenderCoreState | 27 | , backgroundMusic :: SoundSource |
23 | , immRenderState :: ImmRenderState | ||
24 | , viewProjection :: Matrix4 | ||
25 | , world :: [GameObject] | 28 | , world :: [GameObject] |
26 | } | 29 | } |
27 | 30 | ||
28 | app = App step render resize | 31 | type GameState = AppState Pong |
32 | |||
33 | |||
34 | options = defaultAppOptions { title = "Pong" } | ||
35 | |||
36 | app = App options initGame endGame step render resize | ||
29 | 37 | ||
30 | main = | ||
31 | withWindow (900, 600) (Just "Pong") initGame endGame $ | ||
32 | loop app | ||
33 | 38 | ||
34 | initGame :: Window -> Game () GameState | 39 | main :: IO () |
35 | initGame window = do | 40 | main = runApp app |
36 | (immRenderState, renderCoreState) <- runSiblingGame newImmRenderer newRenderCoreState | 41 | |
37 | return $ GameState window renderCoreState immRenderState Matrix4.id newWorld | 42 | initGame :: Game AppContext Pong |
43 | initGame = do | ||
44 | music <- siblingGame $ do | ||
45 | musicBuffer <- loadAudioFile "/home/jeanne/Casual Tiki Party Main.wav" | ||
46 | music <- makeSoundSource | ||
47 | setSoundSourceBuffer music musicBuffer | ||
48 | setSoundLoopMode music Loop | ||
49 | playSounds [music] | ||
50 | return music | ||
51 | return $ Pong Matrix4.id music newWorld | ||
38 | 52 | ||
39 | endGame :: Game GameState () | 53 | endGame :: Game GameState () |
40 | endGame = do | 54 | endGame = return () |
41 | game <- getGameState | 55 | |
42 | runSubGame' (deleteImmRenderer $ immRenderState game) (renderCoreState game) | ||
43 | 56 | ||
44 | step :: Elapsed -> Dt -> [InputEvent] -> Game GameState Bool | 57 | step :: Elapsed -> Dt -> [InputEvent] -> Game GameState Bool |
45 | step elapsed dt inputEvents = do | 58 | step elapsed dt inputEvents = do |
46 | gs <- getGameState | 59 | appState <- get |
47 | let events = translateEvents inputEvents | 60 | gameState <- getGameState |
48 | modifyGameState $ \gs -> | 61 | events <- processInput (appWindow appState) |
49 | gs | 62 | --when (events /= []) $ liftIO . putStrLn $ show events |
50 | { world = stepWorld (realToFrac elapsed) (realToFrac dt) events (world gs) | 63 | modifyGameState $ \pong -> pong |
51 | } | 64 | { world = stepWorld (realToFrac elapsed) (realToFrac dt) events (world gameState) |
65 | } | ||
52 | return (not $ exitRequested inputEvents) | 66 | return (not $ exitRequested inputEvents) |
53 | 67 | ||
68 | processInput :: Window -> Game GameState [GameEvent] | ||
69 | processInput window = processKeys window | ||
70 | [ (KEY_A, MoveLeft) | ||
71 | , (KEY_D, MoveRight) | ||
72 | ] | ||
73 | |||
74 | exitRequested = elem (KeyDown KEY_ESC) | ||
75 | |||
76 | |||
54 | render :: Game GameState () | 77 | render :: Game GameState () |
55 | render = do | 78 | render = do |
56 | gameState <- getGameState | 79 | gameState <- getGameState |
57 | immRenderState' <- flip execSubGame (immRenderState gameState) $ do | 80 | siblingGame $ do |
58 | immStart | 81 | immStart |
59 | immSetViewProjectionMatrix (viewProjection gameState) | 82 | immSetViewProjectionMatrix (viewProjection gameState) |
60 | -- Clear the background to a different colour than the playable area to make | 83 | -- Clear the background to a different colour than the playable area to make |
61 | -- the latter distinguishable. | 84 | -- the latter distinguishable. |
62 | gameIO $ do | 85 | setClearColour (0.2, 0.2, 0.2, 0.0) |
63 | setClearColour (0.2, 0.2, 0.2, 0.0) | 86 | clearBuffers [ColourBuffer] |
64 | clearBuffers [ColourBuffer] | ||
65 | render' $ world gameState | 87 | render' $ world gameState |
66 | immEnd | 88 | immEnd |
67 | saveGameState $ gameState { immRenderState = immRenderState' } | ||
68 | 89 | ||
69 | render' :: [GameObject] -> Game ImmRenderState () | 90 | render' :: [GameObject] -> Game ImmRenderState () |
70 | render' world = do | 91 | render' world = do |
@@ -79,7 +100,7 @@ renderBackground = | |||
79 | let pmin = 0 :: Float | 100 | let pmin = 0 :: Float |
80 | pmax = 1 :: Float | 101 | pmax = 1 :: Float |
81 | in do | 102 | in do |
82 | immSetColour (vec4 0.6 0.35 0.6 1.0) | 103 | immSetColour (vec4 0.0 0.25 0.41 1.0) |
83 | immDrawQuads2d [ | 104 | immDrawQuads2d [ |
84 | (vec2 pmin pmin | 105 | (vec2 pmin pmin |
85 | ,vec2 pmax pmin | 106 | ,vec2 pmax pmin |
@@ -87,18 +108,16 @@ renderBackground = | |||
87 | ,vec2 pmin pmax)] | 108 | ,vec2 pmin pmax)] |
88 | 109 | ||
89 | renderGO :: GameObject -> Game ImmRenderState () | 110 | renderGO :: GameObject -> Game ImmRenderState () |
90 | renderGO go = do | 111 | renderGO go = |
91 | let (AABB2 (Vector2 xmin ymin) (Vector2 xmax ymax)) = aabb go | 112 | let (AABB2Volume (AABB2 (Vector2 xmin ymin) (Vector2 xmax ymax))) = boundingVolume go |
92 | (Vector2 xcenter ycenter) = position go | 113 | in |
93 | immPreservingMatrix $ do | ||
94 | immTranslate (vec3 xcenter ycenter 0) | ||
95 | immDrawQuads2d [ | 114 | immDrawQuads2d [ |
96 | (vec2 xmin ymin | 115 | (vec2 xmin ymin |
97 | ,vec2 xmax ymin | 116 | ,vec2 xmax ymin |
98 | ,vec2 xmax ymax | 117 | ,vec2 xmax ymax |
99 | ,vec2 xmin ymax)] | 118 | ,vec2 xmin ymax)] |
100 | 119 | ||
101 | -- TODO: Fix the resize hang. | 120 | |
102 | resize :: WindowEvent -> Game GameState () | 121 | resize :: WindowEvent -> Game GameState () |
103 | resize (ResizeEvent w h) = | 122 | resize (ResizeEvent w h) = |
104 | let r = fromIntegral w / fromIntegral h | 123 | let r = fromIntegral w / fromIntegral h |
@@ -108,16 +127,7 @@ resize (ResizeEvent w h) = | |||
108 | bottom = if r > 1 then 0 else -pad | 127 | bottom = if r > 1 then 0 else -pad |
109 | top = if r > 1 then 1 else 1 + pad | 128 | top = if r > 1 then 1 else 1 + pad |
110 | in do | 129 | in do |
111 | gameIO $ setViewport 0 0 w h | 130 | setViewport 0 0 w h |
112 | modifyGameState $ \state -> state { | 131 | modifyGameState $ \pong -> pong { |
113 | viewProjection = Matrix4.ortho left right bottom top (-1) 1 | 132 | viewProjection = Matrix4.ortho left right bottom top (-1) 1 |
114 | } | 133 | } |
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..0df05ea 100644 --- a/Demos/Pong/Pong.hs +++ b/Demos/Pong/Pong.hs | |||
@@ -3,12 +3,11 @@ | |||
3 | {-# LANGUAGE TypeSynonymInstances #-} | 3 | {-# LANGUAGE TypeSynonymInstances #-} |
4 | 4 | ||
5 | module Pong | 5 | module Pong |
6 | ( GameEvent (..), | 6 | ( GameEvent (..) |
7 | GameObject, | 7 | , GameObject |
8 | newWorld, | 8 | , newWorld |
9 | stepWorld, | 9 | , stepWorld |
10 | aabb, | 10 | ) |
11 | ) | ||
12 | where | 11 | where |
13 | 12 | ||
14 | import Spear.Math.AABB | 13 | import Spear.Math.AABB |
@@ -16,21 +15,23 @@ import Spear.Math.Algebra | |||
16 | import Spear.Math.Spatial | 15 | import Spear.Math.Spatial |
17 | import Spear.Math.Spatial2 | 16 | import Spear.Math.Spatial2 |
18 | import Spear.Math.Vector | 17 | import Spear.Math.Vector |
18 | import Spear.Physics.Collision | ||
19 | import Spear.Prelude | 19 | import Spear.Prelude |
20 | import Spear.Step | 20 | import Spear.Step |
21 | 21 | ||
22 | import Data.Monoid (mconcat) | 22 | import Data.Monoid (mconcat) |
23 | 23 | ||
24 | 24 | ||
25 | -- Configuration | 25 | -- Configuration |
26 | 26 | ||
27 | padSize = vec2 0.07 0.02 | 27 | padSize = vec2 0.070 0.015 |
28 | ballSize = 0.012 :: Float | 28 | ballSize = vec2 0.012 0.012 |
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 = 1.0 :: 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,16 +41,22 @@ initialBallPos = vec2 0.5 0.5 | |||
40 | data GameEvent | 41 | data GameEvent |
41 | = MoveLeft | 42 | = MoveLeft |
42 | | MoveRight | 43 | | MoveRight |
43 | | StopLeft | 44 | | Collision GameObjectId GameObjectId |
44 | | StopRight | 45 | deriving (Eq, Show) |
45 | deriving (Eq, Ord) | ||
46 | 46 | ||
47 | -- Game objects | 47 | -- Game objects |
48 | 48 | ||
49 | data GameObjectId | ||
50 | = Ball | ||
51 | | Enemy | ||
52 | | Player | ||
53 | deriving (Eq, Show) | ||
54 | |||
49 | data GameObject = GameObject | 55 | data GameObject = GameObject |
50 | { aabb :: AABB2, | 56 | { gameObjectId :: !GameObjectId |
51 | basis :: Transform2, | 57 | , gameObjectSize :: {-# UNPACK #-} !Vector2 |
52 | gostep :: Step [GameObject] [GameEvent] GameObject GameObject | 58 | , basis :: {-# UNPACK #-} !Transform2 |
59 | , gostep :: Step [GameObject] [GameEvent] GameObject GameObject | ||
53 | } | 60 | } |
54 | 61 | ||
55 | 62 | ||
@@ -79,108 +86,113 @@ instance Spatial GameObject Vector2 Angle Transform2 where | |||
79 | transform = basis | 86 | transform = basis |
80 | 87 | ||
81 | 88 | ||
82 | stepWorld :: Elapsed -> Dt -> [GameEvent] -> [GameObject] -> [GameObject] | 89 | instance Bounded2 GameObject where |
83 | stepWorld elapsed dt evts gos = map (update elapsed dt evts gos) gos | 90 | boundingVolume obj = aabb2Volume $ translate (position obj) (AABB2 (-size) size) |
84 | 91 | where size = gameObjectSize obj | |
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 | 92 | ||
90 | ballBox, padBox :: AABB2 | ||
91 | ballBox = AABB2 (vec2 (-s) (-s)) (vec2 s s) where s = ballSize | ||
92 | padBox = AABB2 (-padSize) padSize | ||
93 | 93 | ||
94 | newWorld = | 94 | newWorld = |
95 | [ GameObject ballBox (makeAt initialBallPos) $ stepBall initialBallVelocity, | 95 | [ GameObject Ball ballSize (makeAt initialBallPos) $ stepBall initialBallVelocity, |
96 | GameObject padBox (makeAt initialEnemyPos) stepEnemy, | 96 | GameObject Enemy padSize (makeAt initialEnemyPos) stepEnemy, |
97 | GameObject padBox (makeAt initialPlayerPos) stepPlayer | 97 | GameObject Player padSize (makeAt initialPlayerPos) stepPlayer |
98 | ] | 98 | ] |
99 | where makeAt = newTransform2 unitx2 unity2 | 99 | where makeAt = newTransform2 unitx2 unity2 |
100 | 100 | ||
101 | |||
102 | -- Step the game world: | ||
103 | -- 1. Simulate physics. | ||
104 | -- 2. Collide objects and clip -> produce collision events. | ||
105 | -- 3. Update game objects <- input collision events. | ||
106 | stepWorld :: Elapsed -> Dt -> [GameEvent] -> [GameObject] -> [GameObject] | ||
107 | stepWorld elapsed dt events gos@[ball, enemy, player] = | ||
108 | let | ||
109 | collisions = collide [ball] [enemy, player] | ||
110 | collisionEvents = (\(x,y) -> Collision (gameObjectId x) (gameObjectId y)) <$> collisions | ||
111 | events' = events ++ collisionEvents | ||
112 | in | ||
113 | map (update elapsed dt events' gos) gos | ||
114 | |||
115 | update :: Elapsed -> Dt -> [GameEvent] -> [GameObject] -> GameObject -> GameObject | ||
116 | update elapsed dt events gos go = | ||
117 | let (go', s') = runStep (gostep go) elapsed dt gos events go | ||
118 | in go' { gostep = s' } | ||
119 | |||
120 | |||
101 | -- Ball steppers | 121 | -- Ball steppers |
102 | 122 | ||
103 | stepBall vel = collideBall vel .> moveBall | 123 | stepBall vel = bounceBall vel .> moveBall -- .> clamp |
104 | 124 | ||
105 | -- TODO: in collideBall and paddleBounce, we should an apply an offset to the | 125 | bounceBall :: Vector2 -> Step [GameObject] [GameEvent] GameObject (Vector2, GameObject) |
106 | -- ball when collision is detected. | 126 | bounceBall vel = step $ \_ dt gos events ball -> |
107 | collideBall :: Vector2 -> Step [GameObject] e GameObject (Vector2, GameObject) | 127 | let (AABB2Volume (AABB2 pmin pmax)) = boundingVolume ball |
108 | collideBall vel = step $ \_ dt gos _ ball -> | 128 | sideCollision = x pmin < 0 || x pmax > 1 |
109 | let (AABB2 pmin pmax) = translate (position ball) (aabb ball) | 129 | backCollision = y pmin < 0 || y pmax > 1 |
110 | collideSide = x pmin < 0 || x pmax > 1 | 130 | flipX v@(Vector2 x y) = if sideCollision then vec2 (-x) y else v |
111 | collideBack = y pmin < 0 || y pmax > 1 | 131 | flipY v@(Vector2 x y) = if backCollision then vec2 x (-y) else v |
112 | collidePaddle = any (collide ball) (tail gos) | 132 | collideWithPaddles vel = foldl (paddleBounce ball events) vel (tail gos) |
113 | flipX v@(Vector2 x y) = if collideSide then vec2 (-x) y else v | 133 | vel' = normalise |
114 | flipY v@(Vector2 x y) = if collideBack then vec2 x (-y) else v | 134 | . collideWithPaddles |
115 | vel' = normalise . (\v -> foldl (paddleBounce ball) v (tail gos)) . flipX . flipY $ vel | 135 | . flipX |
116 | -- A small delta to apply when collision occurs. | 136 | . flipY |
117 | delta = (1::Float) + if collideSide || collideBack || collidePaddle then (2::Float)*dt else (0::Float) | 137 | $ vel |
118 | in ((ballSpeed * delta * vel', ball), collideBall vel') | 138 | collision = vel' /= vel |
119 | 139 | -- Apply offset when collision occurs to avoid sticky collisions. | |
120 | paddleBounce :: GameObject -> Vector2 -> GameObject -> Vector2 | 140 | delta = (1::Float) + if collision then (3::Float)*dt else (0::Float) |
121 | paddleBounce ball v paddle = | 141 | in ((ballSpeed * delta * vel', ball), bounceBall vel') |
122 | if collide ball paddle | 142 | |
143 | paddleBounce :: GameObject -> [GameEvent] -> Vector2 -> GameObject -> Vector2 | ||
144 | paddleBounce ball events vel paddle = | ||
145 | let collision = Collision Ball (gameObjectId paddle) `elem` events | ||
146 | in if collision | ||
123 | then | 147 | then |
124 | let (AABB2 pmin pmax) = translate (position paddle) (aabb paddle) | 148 | let (AABB2Volume (AABB2 pmin pmax)) = boundingVolume paddle |
125 | center = (x pmin + x pmax) / (2::Float) | 149 | center = (x pmin + x pmax) / (2::Float) |
126 | -- Normalized offset of the ball from the paddle's center, [-1, +1]. | 150 | -- Normalized offset of the ball from the paddle's center, [-1, +1]. |
127 | -- It's outside the [-1, +1] range if there is no collision. | 151 | -- It's outside the [-1, +1] range if there is no collision. |
128 | offset = (x (position ball) - center) / ((x pmax - x pmin) / (2::Float)) | 152 | offset = (x (position ball) - center) / ((x pmax - x pmin) / (2::Float)) |
129 | angle = offset * maxBounceAngle | 153 | angle = offset * maxBounceAngle |
130 | -- When it bounces off of a paddle, y vel is flipped. | 154 | -- When it bounces off of a paddle, y vel is flipped. |
131 | ysign = -(signum (y v)) | 155 | ysign = -(signum (y vel)) |
132 | in vec2 (sin angle) (ysign * cos angle) | 156 | in vec2 (sin angle) (ysign * cos angle) |
133 | else v | 157 | else vel |
134 | |||
135 | collide :: GameObject -> GameObject -> Bool | ||
136 | collide go1 go2 = | ||
137 | let (AABB2 (Vector2 xmin1 ymin1) (Vector2 xmax1 ymax1)) = | ||
138 | translate (position go1) (aabb go1) | ||
139 | (AABB2 (Vector2 xmin2 ymin2) (Vector2 xmax2 ymax2)) = | ||
140 | translate (position go2) (aabb go2) | ||
141 | in not $ | ||
142 | xmax1 < xmin2 | ||
143 | || xmin1 > xmax2 | ||
144 | || ymax1 < ymin2 | ||
145 | || ymin1 > ymax2 | ||
146 | 158 | ||
147 | moveBall :: Step s e (Vector2, GameObject) GameObject | 159 | moveBall :: Step s e (Vector2, GameObject) GameObject |
148 | moveBall = step $ \_ dt _ _ (vel, ball) -> (translate (vel * dt) ball, moveBall) | 160 | moveBall = step $ \_ dt _ _ (vel, ball) -> (translate (vel * dt) ball, moveBall) |
149 | 161 | ||
162 | |||
150 | -- Enemy stepper | 163 | -- Enemy stepper |
151 | 164 | ||
152 | stepEnemy = movePad | 165 | stepEnemy = movePad 0 .> spure clamp |
166 | |||
167 | movePad :: Float -> Step [GameObject] e GameObject GameObject | ||
168 | movePad previousMomentumVector = step $ \_ dt gos _ pad -> | ||
169 | let ball = head gos | ||
170 | heading = (x . position $ ball) - (x . position $ pad) | ||
171 | chaseVector = enemySpeed * heading | ||
172 | momentumVector = previousMomentumVector + enemyMomentum * heading * dt | ||
173 | vx = chaseVector * dt + momentumVector | ||
174 | in (translate (vec2 vx 0) pad, movePad momentumVector) | ||
153 | 175 | ||
154 | movePad :: Step s e GameObject GameObject | ||
155 | movePad = step $ \elapsed _ _ _ pad -> | ||
156 | let enemyY = 0.9 | ||
157 | p = vec2 px enemyY | ||
158 | px = | ||
159 | (sin (enemySpeed * elapsed) * (0.5::Float) + (0.5::Float)) | ||
160 | * ((1::Float) - (2::Float) * x padSize) | ||
161 | + x padSize | ||
162 | in (setPosition p pad, movePad) | ||
163 | 176 | ||
164 | -- Player stepper | 177 | -- Player stepper |
165 | 178 | ||
166 | stepPlayer = sfold moveGO .> clamp | 179 | stepPlayer = sfold movePlayer .> spure clamp |
167 | 180 | ||
168 | moveGO = | 181 | movePlayer = mconcat |
169 | mconcat | 182 | [ swhen MoveLeft $ movePlayer' (vec2 (-playerSpeed) 0) |
170 | [ switch StopLeft sid MoveLeft (moveGO' $ vec2 (-playerSpeed) 0), | 183 | , swhen MoveRight $ movePlayer' (vec2 playerSpeed 0) |
171 | switch StopRight sid MoveRight (moveGO' $ vec2 playerSpeed 0) | 184 | ] |
172 | ] | ||
173 | 185 | ||
174 | moveGO' :: Vector2 -> Step s e GameObject GameObject | 186 | movePlayer' :: Vector2 -> Step s e GameObject GameObject |
175 | moveGO' dir = step $ \_ dt _ _ go -> (translate (dir * dt) go, moveGO' dir) | 187 | movePlayer' dir = step $ \_ dt _ _ go -> (translate (dir * dt) go, movePlayer' dir) |
176 | 188 | ||
177 | clamp :: Step s e GameObject GameObject | 189 | clamp :: GameObject -> GameObject |
178 | clamp = spure $ \go -> | 190 | clamp go = |
179 | let p' = vec2 (clamp' x s (1 - s)) y | 191 | let p' = vec2 (clamp' x sx (1 - sx)) y |
180 | (Vector2 x y) = position go | 192 | (Vector2 x y) = position go |
181 | clamp' x a b | 193 | clamp' x a b |
182 | | x < a = a | 194 | | x < a = a |
183 | | x > b = b | 195 | | x > b = b |
184 | | otherwise = x | 196 | | otherwise = x |
185 | (Vector2 s _) = padSize | 197 | (Vector2 sx _) = gameObjectSize go |
186 | in setPosition p' go | 198 | in setPosition p' go |