diff options
-rw-r--r-- | Demos/Pong/Main.hs (renamed from demos/pong/Main.hs) | 4 | ||||
-rw-r--r-- | Demos/Pong/Pong.hs (renamed from demos/pong/Pong.hs) | 13 | ||||
-rw-r--r-- | Demos/Pong/Setup.hs (renamed from demos/pong/Setup.hs) | 0 | ||||
-rw-r--r-- | Spear.cabal | 2 |
4 files changed, 11 insertions, 8 deletions
diff --git a/demos/pong/Main.hs b/Demos/Pong/Main.hs index a9dfcdd..4dbe0a3 100644 --- a/demos/pong/Main.hs +++ b/Demos/Pong/Main.hs | |||
@@ -1,8 +1,10 @@ | |||
1 | {-# LANGUAGE ImportQualifiedPost #-} | ||
2 | |||
1 | module Main where | 3 | module Main where |
2 | 4 | ||
3 | import Data.Maybe (mapMaybe) | 5 | import Data.Maybe (mapMaybe) |
4 | import Graphics.Rendering.OpenGL.GL (($=)) | 6 | import Graphics.Rendering.OpenGL.GL (($=)) |
5 | import qualified Graphics.Rendering.OpenGL.GL as GL | 7 | import Graphics.Rendering.OpenGL.GL qualified as GL |
6 | import Pong | 8 | import Pong |
7 | import Spear.App | 9 | import Spear.App |
8 | import Spear.Game | 10 | import Spear.Game |
diff --git a/demos/pong/Pong.hs b/Demos/Pong/Pong.hs index accc75d..b048bbc 100644 --- a/demos/pong/Pong.hs +++ b/Demos/Pong/Pong.hs | |||
@@ -60,8 +60,8 @@ update elapsed dt evts gos go = | |||
60 | in go' {gostep = s'} | 60 | in go' {gostep = s'} |
61 | 61 | ||
62 | ballBox, padBox :: AABB2 | 62 | ballBox, padBox :: AABB2 |
63 | ballBox = AABB2 (vec2 (- s) (- s)) (vec2 s s) where s = ballSize | 63 | ballBox = AABB2 (vec2 (-s) (-s)) (vec2 s s) where s = ballSize |
64 | padBox = AABB2 (- padSize) padSize | 64 | padBox = AABB2 (-padSize) padSize |
65 | 65 | ||
66 | obj2 = obj2FromVectors unitx2 unity2 | 66 | obj2 = obj2FromVectors unitx2 unity2 |
67 | 67 | ||
@@ -80,8 +80,8 @@ collideBall vel = step $ \_ dt gos _ ball -> | |||
80 | let (AABB2 pmin pmax) = aabb ball `aabbAdd` pos ball | 80 | let (AABB2 pmin pmax) = aabb ball `aabbAdd` pos ball |
81 | collideCol = x pmin < 0 || x pmax > 1 | 81 | collideCol = x pmin < 0 || x pmax > 1 |
82 | collideRow = y pmin < 0 || y pmax > 1 || any (collide ball) (tail gos) | 82 | collideRow = y pmin < 0 || y pmax > 1 || any (collide ball) (tail gos) |
83 | negx v@(Vector2 x y) = if collideCol then vec2 (- x) y else v | 83 | negx v@(Vector2 x y) = if collideCol then vec2 (-x) y else v |
84 | negy v@(Vector2 x y) = if collideRow then vec2 x (- y) else v | 84 | negy v@(Vector2 x y) = if collideRow then vec2 x (-y) else v |
85 | vel' = negx . negy $ vel | 85 | vel' = negx . negy $ vel |
86 | delta = dt -- A small delta to apply when collision occurs. | 86 | delta = dt -- A small delta to apply when collision occurs. |
87 | adjustX = if collideCol then scale delta (vec2 (x vel) 0) else vec2 0 0 | 87 | adjustX = if collideCol then scale delta (vec2 (x vel) 0) else vec2 0 0 |
@@ -94,7 +94,8 @@ collide go1 go2 = | |||
94 | (AABB2 (Vector2 xmin2 ymin2) (Vector2 xmax2 ymax2)) = | 94 | (AABB2 (Vector2 xmin2 ymin2) (Vector2 xmax2 ymax2)) = |
95 | aabb go2 `aabbAdd` pos go2 | 95 | aabb go2 `aabbAdd` pos go2 |
96 | in not $ | 96 | in not $ |
97 | xmax1 < xmin2 || xmin1 > xmax2 | 97 | xmax1 < xmin2 |
98 | || xmin1 > xmax2 | ||
98 | || ymax1 < ymin2 | 99 | || ymax1 < ymin2 |
99 | || ymin1 > ymax2 | 100 | || ymin1 > ymax2 |
100 | 101 | ||
@@ -122,7 +123,7 @@ stepPlayer = sfold moveGO .> clamp | |||
122 | 123 | ||
123 | moveGO = | 124 | moveGO = |
124 | mconcat | 125 | mconcat |
125 | [ switch StopLeft sid MoveLeft (moveGO' $ vec2 (- playerSpeed) 0), | 126 | [ switch StopLeft sid MoveLeft (moveGO' $ vec2 (-playerSpeed) 0), |
126 | switch StopRight sid MoveRight (moveGO' $ vec2 playerSpeed 0) | 127 | switch StopRight sid MoveRight (moveGO' $ vec2 playerSpeed 0) |
127 | ] | 128 | ] |
128 | 129 | ||
diff --git a/demos/pong/Setup.hs b/Demos/Pong/Setup.hs index e8ef27d..e8ef27d 100644 --- a/demos/pong/Setup.hs +++ b/Demos/Pong/Setup.hs | |||
diff --git a/Spear.cabal b/Spear.cabal index 81ca38a..824f352 100644 --- a/Spear.cabal +++ b/Spear.cabal | |||
@@ -117,7 +117,7 @@ library | |||
117 | ghc-prof-options: -O2 -fprof-auto -fprof-cafs | 117 | ghc-prof-options: -O2 -fprof-auto -fprof-cafs |
118 | 118 | ||
119 | executable pong | 119 | executable pong |
120 | hs-source-dirs: demos/pong | 120 | hs-source-dirs: Demos/Pong |
121 | main-is: Main.hs | 121 | main-is: Main.hs |
122 | other-modules: Pong | 122 | other-modules: Pong |
123 | build-depends: base, Spear, OpenGL | 123 | build-depends: base, Spear, OpenGL |