aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Demos/Pong/Pong.hs59
-rw-r--r--Spear.cabal2
-rw-r--r--Spear/Math/Vector.hs12
-rw-r--r--Spear/Math/Vector/Vector.hs (renamed from Spear/Math/Vector/Class.hs)20
-rw-r--r--Spear/Math/Vector/Vector2.hs16
-rw-r--r--Spear/Math/Vector/Vector3.hs8
-rw-r--r--Spear/Math/Vector/Vector4.hs8
-rw-r--r--Spear/Window.hs1
8 files changed, 67 insertions, 59 deletions
diff --git a/Demos/Pong/Pong.hs b/Demos/Pong/Pong.hs
index fd7fbeb..0e24a42 100644
--- a/Demos/Pong/Pong.hs
+++ b/Demos/Pong/Pong.hs
@@ -16,18 +16,15 @@ import Spear.Step
16 16
17-- Configuration 17-- Configuration
18 18
19padSize = vec2 0.05 0.02 19padSize = vec2 0.07 0.02
20 20ballSize = 0.012
21ballSize = 0.01 21ballSpeed = 0.6
22 22initialBallVelocity = vec2 1 1
23ballVelocity = vec2 0.3 0.3 23maxBounceAngle = 65 * pi/180
24 24playerSpeed = 1.0
25playerSpeed = 0.7 25enemySpeed = 1.5
26
27initialEnemyPos = vec2 0.5 0.9 26initialEnemyPos = vec2 0.5 0.9
28
29initialPlayerPos = vec2 0.5 0.1 27initialPlayerPos = vec2 0.5 0.1
30
31initialBallPos = vec2 0.5 0.5 28initialBallPos = vec2 0.5 0.5
32 29
33-- Game events 30-- Game events
@@ -66,7 +63,7 @@ padBox = AABB2 (-padSize) padSize
66obj2 = obj2FromVectors unitx2 unity2 63obj2 = obj2FromVectors unitx2 unity2
67 64
68newWorld = 65newWorld =
69 [ GameObject ballBox (obj2 initialBallPos) $ stepBall ballVelocity, 66 [ GameObject ballBox (obj2 initialBallPos) $ stepBall initialBallVelocity,
70 GameObject padBox (obj2 initialEnemyPos) stepEnemy, 67 GameObject padBox (obj2 initialEnemyPos) stepEnemy,
71 GameObject padBox (obj2 initialPlayerPos) stepPlayer 68 GameObject padBox (obj2 initialPlayerPos) stepPlayer
72 ] 69 ]
@@ -75,19 +72,37 @@ newWorld =
75 72
76stepBall vel = collideBall vel .> moveBall 73stepBall vel = collideBall vel .> moveBall
77 74
75-- TODO: in collideBall and paddleBounce, we should an apply an offset to the
76-- ball when collision is detected.
78collideBall :: Vector2 -> Step [GameObject] e GameObject (Vector2, GameObject) 77collideBall :: Vector2 -> Step [GameObject] e GameObject (Vector2, GameObject)
79collideBall vel = step $ \_ dt gos _ ball -> 78collideBall vel = step $ \_ dt gos _ ball ->
80 let (AABB2 pmin pmax) = aabb ball `aabbAdd` pos ball 79 let (AABB2 pmin pmax) = aabb ball `aabbAdd` pos ball
81 collideCol = x pmin < 0 || x pmax > 1 80 collideSide = x pmin < 0 || x pmax > 1
82 collideRow = y pmin < 0 || y pmax > 1 || any (collide ball) (tail gos) 81 collideBack = y pmin < 0 || y pmax > 1
83 negx v@(Vector2 x y) = if collideCol then vec2 (-x) y else v 82 collidePaddle = any (collide ball) (tail gos)
84 negy v@(Vector2 x y) = if collideRow then vec2 x (-y) else v 83 flipX v@(Vector2 x y) = if collideSide then vec2 (-x) y else v
85 vel' = negx . negy $ vel 84 flipY v@(Vector2 x y) = if collideBack then vec2 x (-y) else v
86 delta = dt -- A small delta to apply when collision occurs. 85 vel' = normalise . (\v -> foldl (paddleBounce ball) v (tail gos)) . flipX . flipY $ vel
87 adjustX = if collideCol then scale delta (vec2 (x vel) 0) else vec2 0 0 86 -- A small delta to apply when collision occurs.
88 adjustY = if collideRow then scale delta (vec2 0 (y vel)) else vec2 0 0 87 delta = 1 + if collideSide || collideBack || collidePaddle then 2*dt else 0
89 in ((vel' + adjustX + adjustY, ball), collideBall vel') 88 in ((scale ballSpeed (scale delta vel'), ball), collideBall vel')
90 89
90paddleBounce :: GameObject -> Vector2 -> GameObject -> Vector2
91paddleBounce ball v paddle =
92 if collide ball paddle
93 then
94 let (AABB2 pmin pmax) = aabb paddle `aabbAdd` pos paddle
95 center = (x pmin + x pmax) / 2
96 -- Normalized offset of the ball from the paddle's center, [-1, +1].
97 -- It's outside the [-1, +1] range if there is no collision.
98 offset = (x (pos ball) - center) / ((x pmax - x pmin) / 2)
99 angle = offset * maxBounceAngle
100 -- When it bounces off of a paddle, y vel is flipped.
101 ysign = -(signum (y v))
102 in vec2 (sin angle) (ysign * cos angle)
103 else v
104
105collide :: GameObject -> GameObject -> Bool
91collide go1 go2 = 106collide go1 go2 =
92 let (AABB2 (Vector2 xmin1 ymin1) (Vector2 xmax1 ymax1)) = 107 let (AABB2 (Vector2 xmin1 ymin1) (Vector2 xmax1 ymax1)) =
93 aabb go1 `aabbAdd` pos go1 108 aabb go1 `aabbAdd` pos go1
@@ -112,7 +127,7 @@ movePad :: Step s e GameObject GameObject
112movePad = step $ \elapsed _ _ _ pad -> 127movePad = step $ \elapsed _ _ _ pad ->
113 let p = vec2 px 0.9 128 let p = vec2 px 0.9
114 px = 129 px =
115 double2Float (sin elapsed * 0.5 + 0.5) 130 double2Float (sin (elapsed * enemySpeed) * 0.5 + 0.5)
116 * (1 - 2 * x padSize) 131 * (1 - 2 * x padSize)
117 + x padSize 132 + x padSize
118 in (setPos p pad, movePad) 133 in (setPos p pad, movePad)
diff --git a/Spear.cabal b/Spear.cabal
index 824f352..7025fcd 100644
--- a/Spear.cabal
+++ b/Spear.cabal
@@ -52,7 +52,7 @@ library
52 Spear.Math.Triangle 52 Spear.Math.Triangle
53 Spear.Math.Utils 53 Spear.Math.Utils
54 Spear.Math.Vector 54 Spear.Math.Vector
55 Spear.Math.Vector.Class 55 Spear.Math.Vector.Vector
56 Spear.Math.Vector.Vector2 56 Spear.Math.Vector.Vector2
57 Spear.Math.Vector.Vector3 57 Spear.Math.Vector.Vector3
58 Spear.Math.Vector.Vector4 58 Spear.Math.Vector.Vector4
diff --git a/Spear/Math/Vector.hs b/Spear/Math/Vector.hs
index dd5e496..b43f7ec 100644
--- a/Spear/Math/Vector.hs
+++ b/Spear/Math/Vector.hs
@@ -1,13 +1,13 @@
1module Spear.Math.Vector 1module Spear.Math.Vector
2( 2(
3 module Spear.Math.Vector.Vector2 3 module Spear.Math.Vector.Vector
4, module Spear.Math.Vector.Vector2
4, module Spear.Math.Vector.Vector3 5, module Spear.Math.Vector.Vector3
5, module Spear.Math.Vector.Vector4 6, module Spear.Math.Vector.Vector4
6, module Spear.Math.Vector.Class
7) 7)
8where 8where
9 9
10import Spear.Math.Vector.Vector2 10import Spear.Math.Vector.Vector
11import Spear.Math.Vector.Vector3 11import Spear.Math.Vector.Vector2
12import Spear.Math.Vector.Vector4 12import Spear.Math.Vector.Vector3
13import Spear.Math.Vector.Class 13import Spear.Math.Vector.Vector4
diff --git a/Spear/Math/Vector/Class.hs b/Spear/Math/Vector/Vector.hs
index 19ddfac..35b04e2 100644
--- a/Spear/Math/Vector/Class.hs
+++ b/Spear/Math/Vector/Vector.hs
@@ -1,10 +1,10 @@
1module Spear.Math.Vector.Class 1module Spear.Math.Vector.Vector
2where 2where
3 3
4class (Fractional a, Ord a) => VectorClass a where 4class (Fractional a, Ord a) => Vector a where
5 -- | Create a vector from the given list. 5 -- | Create a vector from the given list.
6 fromList :: [Float] -> a 6 fromList :: [Float] -> a
7 7
8 -- | Return the vector's x coordinate. 8 -- | Return the vector's x coordinate.
9 x :: a -> Float 9 x :: a -> Float
10 x _ = 0 10 x _ = 0
@@ -23,21 +23,21 @@ class (Fractional a, Ord a) => VectorClass a where
23 23
24 -- | Return the vector's ith coordinate. 24 -- | Return the vector's ith coordinate.
25 (!) :: a -> Int -> Float 25 (!) :: a -> Int -> Float
26 26
27 -- | Compute the given vectors' dot product. 27 -- | Compute the given vectors' dot product.
28 dot :: a -> a -> Float 28 dot :: a -> a -> Float
29 29
30 -- | Compute the given vector's squared norm. 30 -- | Compute the given vector's squared norm.
31 normSq :: a -> Float 31 normSq :: a -> Float
32 32
33 -- | Compute the given vector's norm. 33 -- | Compute the given vector's norm.
34 norm :: a -> Float 34 norm :: a -> Float
35 35
36 -- | Multiply the given vector with the given scalar. 36 -- | Multiply the given vector with the given scalar.
37 scale :: Float -> a -> a 37 scale :: Float -> a -> a
38 38
39 -- | Negate the given vector. 39 -- | Negate the given vector.
40 neg :: a -> a 40 neg :: a -> a
41 41
42 -- | Normalise the given vector. 42 -- | Normalise the given vector.
43 normalise :: a -> a \ No newline at end of file 43 normalise :: a -> a
diff --git a/Spear/Math/Vector/Vector2.hs b/Spear/Math/Vector/Vector2.hs
index dfb4fb9..5bbb632 100644
--- a/Spear/Math/Vector/Vector2.hs
+++ b/Spear/Math/Vector/Vector2.hs
@@ -14,10 +14,10 @@ module Spear.Math.Vector.Vector2
14) 14)
15where 15where
16 16
17import Spear.Math.Vector.Class 17import Spear.Math.Vector.Vector
18 18
19import Foreign.C.Types (CFloat) 19import Foreign.C.Types (CFloat)
20import Foreign.Storable 20import Foreign.Storable
21 21
22type Right2 = Vector2 22type Right2 = Vector2
23type Up2 = Vector2 23type Up2 = Vector2
@@ -50,7 +50,7 @@ instance Ord Vector2 where
50 min (Vector2 ax ay) (Vector2 bx by) = Vector2 (Prelude.min ax bx) (Prelude.min ay by) 50 min (Vector2 ax ay) (Vector2 bx by) = Vector2 (Prelude.min ax bx) (Prelude.min ay by)
51 51
52 52
53instance VectorClass Vector2 where 53instance Vector Vector2 where
54 {-# INLINABLE fromList #-} 54 {-# INLINABLE fromList #-}
55 fromList (ax:ay:_) = Vector2 ax ay 55 fromList (ax:ay:_) = Vector2 ax ay
56 56
@@ -104,27 +104,19 @@ instance Storable Vector2 where
104 pokeByteOff ptr sizeFloat ay 104 pokeByteOff ptr sizeFloat ay
105 105
106 106
107-- | Get the vector's x coordinate.
108
109
110
111-- | Unit vector along the X axis. 107-- | Unit vector along the X axis.
112unitx2 = Vector2 1 0 108unitx2 = Vector2 1 0
113 109
114
115-- | Unit vector along the Y axis. 110-- | Unit vector along the Y axis.
116unity2 = Vector2 0 1 111unity2 = Vector2 0 1
117 112
118
119-- | Zero vector. 113-- | Zero vector.
120zero2 = Vector2 0 0 114zero2 = Vector2 0 0
121 115
122
123-- | Create a vector from the given values. 116-- | Create a vector from the given values.
124vec2 :: Float -> Float -> Vector2 117vec2 :: Float -> Float -> Vector2
125vec2 ax ay = Vector2 ax ay 118vec2 ax ay = Vector2 ax ay
126 119
127
128-- | Compute a vector perpendicular to the given one, satisfying: 120-- | Compute a vector perpendicular to the given one, satisfying:
129-- 121--
130-- perp (Vector2 0 1) = Vector2 1 0 122-- perp (Vector2 0 1) = Vector2 1 0
diff --git a/Spear/Math/Vector/Vector3.hs b/Spear/Math/Vector/Vector3.hs
index 429df0f..82deba2 100644
--- a/Spear/Math/Vector/Vector3.hs
+++ b/Spear/Math/Vector/Vector3.hs
@@ -18,10 +18,10 @@ module Spear.Math.Vector.Vector3
18where 18where
19 19
20 20
21import Spear.Math.Vector.Class 21import Spear.Math.Vector.Vector
22 22
23import Foreign.C.Types (CFloat) 23import Foreign.C.Types (CFloat)
24import Foreign.Storable 24import Foreign.Storable
25 25
26type Right3 = Vector3 26type Right3 = Vector3
27type Up3 = Vector3 27type Up3 = Vector3
@@ -76,7 +76,7 @@ instance Ord Vector3 where
76 min (Vector3 ax ay az) (Vector3 bx by bz) = Vector3 (Prelude.min ax bx) (Prelude.min ay by) (Prelude.min az bz) 76 min (Vector3 ax ay az) (Vector3 bx by bz) = Vector3 (Prelude.min ax bx) (Prelude.min ay by) (Prelude.min az bz)
77 77
78 78
79instance VectorClass Vector3 where 79instance Vector Vector3 where
80 {-# INLINABLE fromList #-} 80 {-# INLINABLE fromList #-}
81 fromList (ax:ay:az:_) = Vector3 ax ay az 81 fromList (ax:ay:az:_) = Vector3 ax ay az
82 82
diff --git a/Spear/Math/Vector/Vector4.hs b/Spear/Math/Vector/Vector4.hs
index 4314b51..325eefc 100644
--- a/Spear/Math/Vector/Vector4.hs
+++ b/Spear/Math/Vector/Vector4.hs
@@ -12,10 +12,10 @@ module Spear.Math.Vector.Vector4
12where 12where
13 13
14 14
15import Spear.Math.Vector.Class 15import Spear.Math.Vector.Vector
16 16
17import Foreign.C.Types (CFloat) 17import Foreign.C.Types (CFloat)
18import Foreign.Storable 18import Foreign.Storable
19 19
20 20
21-- | Represents a vector in 3D. 21-- | Represents a vector in 3D.
@@ -73,7 +73,7 @@ instance Ord Vector4 where
73 Vector4 (Prelude.max ax bx) (Prelude.max ay by) (Prelude.max az bz) (Prelude.min aw bw) 73 Vector4 (Prelude.max ax bx) (Prelude.max ay by) (Prelude.max az bz) (Prelude.min aw bw)
74 74
75 75
76instance VectorClass Vector4 where 76instance Vector Vector4 where
77 {-# INLINABLE fromList #-} 77 {-# INLINABLE fromList #-}
78 fromList (ax:ay:az:aw:_) = Vector4 ax ay az aw 78 fromList (ax:ay:az:aw:_) = Vector4 ax ay az aw
79 79
diff --git a/Spear/Window.hs b/Spear/Window.hs
index ec90a2f..336910b 100644
--- a/Spear/Window.hs
+++ b/Spear/Window.hs
@@ -31,6 +31,7 @@ where
31import Control.Concurrent.MVar 31import Control.Concurrent.MVar
32import Control.Exception 32import Control.Exception
33import Control.Monad (foldM, unless, void, when) 33import Control.Monad (foldM, unless, void, when)
34import Data.Functor ((<&>))
34import Data.Maybe (fromJust, fromMaybe, isJust) 35import Data.Maybe (fromJust, fromMaybe, isJust)
35import qualified Graphics.UI.GLFW as GLFW 36import qualified Graphics.UI.GLFW as GLFW
36import Spear.Game 37import Spear.Game