aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-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.cabal2
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
1module Main where 3module Main where
2 4
3import Data.Maybe (mapMaybe) 5import Data.Maybe (mapMaybe)
4import Graphics.Rendering.OpenGL.GL (($=)) 6import Graphics.Rendering.OpenGL.GL (($=))
5import qualified Graphics.Rendering.OpenGL.GL as GL 7import Graphics.Rendering.OpenGL.GL qualified as GL
6import Pong 8import Pong
7import Spear.App 9import Spear.App
8import Spear.Game 10import 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
62ballBox, padBox :: AABB2 62ballBox, padBox :: AABB2
63ballBox = AABB2 (vec2 (- s) (- s)) (vec2 s s) where s = ballSize 63ballBox = AABB2 (vec2 (-s) (-s)) (vec2 s s) where s = ballSize
64padBox = AABB2 (- padSize) padSize 64padBox = AABB2 (-padSize) padSize
65 65
66obj2 = obj2FromVectors unitx2 unity2 66obj2 = 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
123moveGO = 124moveGO =
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
119executable pong 119executable 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