diff options
-rw-r--r-- | Demos/Pong/Pong.hs | 59 | ||||
-rw-r--r-- | Spear.cabal | 2 | ||||
-rw-r--r-- | Spear/Math/Vector.hs | 12 | ||||
-rw-r--r-- | Spear/Math/Vector/Vector.hs (renamed from Spear/Math/Vector/Class.hs) | 20 | ||||
-rw-r--r-- | Spear/Math/Vector/Vector2.hs | 16 | ||||
-rw-r--r-- | Spear/Math/Vector/Vector3.hs | 8 | ||||
-rw-r--r-- | Spear/Math/Vector/Vector4.hs | 8 | ||||
-rw-r--r-- | Spear/Window.hs | 1 |
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 | ||
19 | padSize = vec2 0.05 0.02 | 19 | padSize = vec2 0.07 0.02 |
20 | 20 | ballSize = 0.012 | |
21 | ballSize = 0.01 | 21 | ballSpeed = 0.6 |
22 | 22 | initialBallVelocity = vec2 1 1 | |
23 | ballVelocity = vec2 0.3 0.3 | 23 | maxBounceAngle = 65 * pi/180 |
24 | 24 | playerSpeed = 1.0 | |
25 | playerSpeed = 0.7 | 25 | enemySpeed = 1.5 |
26 | |||
27 | initialEnemyPos = vec2 0.5 0.9 | 26 | initialEnemyPos = vec2 0.5 0.9 |
28 | |||
29 | initialPlayerPos = vec2 0.5 0.1 | 27 | initialPlayerPos = vec2 0.5 0.1 |
30 | |||
31 | initialBallPos = vec2 0.5 0.5 | 28 | initialBallPos = vec2 0.5 0.5 |
32 | 29 | ||
33 | -- Game events | 30 | -- Game events |
@@ -66,7 +63,7 @@ padBox = AABB2 (-padSize) padSize | |||
66 | obj2 = obj2FromVectors unitx2 unity2 | 63 | obj2 = obj2FromVectors unitx2 unity2 |
67 | 64 | ||
68 | newWorld = | 65 | newWorld = |
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 | ||
76 | stepBall vel = collideBall vel .> moveBall | 73 | stepBall 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. | ||
78 | collideBall :: Vector2 -> Step [GameObject] e GameObject (Vector2, GameObject) | 77 | collideBall :: Vector2 -> Step [GameObject] e GameObject (Vector2, GameObject) |
79 | collideBall vel = step $ \_ dt gos _ ball -> | 78 | collideBall 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 | ||
90 | paddleBounce :: GameObject -> Vector2 -> GameObject -> Vector2 | ||
91 | paddleBounce 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 | |||
105 | collide :: GameObject -> GameObject -> Bool | ||
91 | collide go1 go2 = | 106 | collide 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 | |||
112 | movePad = step $ \elapsed _ _ _ pad -> | 127 | movePad = 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 @@ | |||
1 | module Spear.Math.Vector | 1 | module 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 | ) |
8 | where | 8 | where |
9 | 9 | ||
10 | import Spear.Math.Vector.Vector2 | 10 | import Spear.Math.Vector.Vector |
11 | import Spear.Math.Vector.Vector3 | 11 | import Spear.Math.Vector.Vector2 |
12 | import Spear.Math.Vector.Vector4 | 12 | import Spear.Math.Vector.Vector3 |
13 | import Spear.Math.Vector.Class | 13 | import 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 @@ | |||
1 | module Spear.Math.Vector.Class | 1 | module Spear.Math.Vector.Vector |
2 | where | 2 | where |
3 | 3 | ||
4 | class (Fractional a, Ord a) => VectorClass a where | 4 | class (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 | ) |
15 | where | 15 | where |
16 | 16 | ||
17 | import Spear.Math.Vector.Class | 17 | import Spear.Math.Vector.Vector |
18 | 18 | ||
19 | import Foreign.C.Types (CFloat) | 19 | import Foreign.C.Types (CFloat) |
20 | import Foreign.Storable | 20 | import Foreign.Storable |
21 | 21 | ||
22 | type Right2 = Vector2 | 22 | type Right2 = Vector2 |
23 | type Up2 = Vector2 | 23 | type 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 | ||
53 | instance VectorClass Vector2 where | 53 | instance 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. |
112 | unitx2 = Vector2 1 0 | 108 | unitx2 = Vector2 1 0 |
113 | 109 | ||
114 | |||
115 | -- | Unit vector along the Y axis. | 110 | -- | Unit vector along the Y axis. |
116 | unity2 = Vector2 0 1 | 111 | unity2 = Vector2 0 1 |
117 | 112 | ||
118 | |||
119 | -- | Zero vector. | 113 | -- | Zero vector. |
120 | zero2 = Vector2 0 0 | 114 | zero2 = Vector2 0 0 |
121 | 115 | ||
122 | |||
123 | -- | Create a vector from the given values. | 116 | -- | Create a vector from the given values. |
124 | vec2 :: Float -> Float -> Vector2 | 117 | vec2 :: Float -> Float -> Vector2 |
125 | vec2 ax ay = Vector2 ax ay | 118 | vec2 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 | |||
18 | where | 18 | where |
19 | 19 | ||
20 | 20 | ||
21 | import Spear.Math.Vector.Class | 21 | import Spear.Math.Vector.Vector |
22 | 22 | ||
23 | import Foreign.C.Types (CFloat) | 23 | import Foreign.C.Types (CFloat) |
24 | import Foreign.Storable | 24 | import Foreign.Storable |
25 | 25 | ||
26 | type Right3 = Vector3 | 26 | type Right3 = Vector3 |
27 | type Up3 = Vector3 | 27 | type 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 | ||
79 | instance VectorClass Vector3 where | 79 | instance 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 | |||
12 | where | 12 | where |
13 | 13 | ||
14 | 14 | ||
15 | import Spear.Math.Vector.Class | 15 | import Spear.Math.Vector.Vector |
16 | 16 | ||
17 | import Foreign.C.Types (CFloat) | 17 | import Foreign.C.Types (CFloat) |
18 | import Foreign.Storable | 18 | import 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 | ||
76 | instance VectorClass Vector4 where | 76 | instance 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 | |||
31 | import Control.Concurrent.MVar | 31 | import Control.Concurrent.MVar |
32 | import Control.Exception | 32 | import Control.Exception |
33 | import Control.Monad (foldM, unless, void, when) | 33 | import Control.Monad (foldM, unless, void, when) |
34 | import Data.Functor ((<&>)) | ||
34 | import Data.Maybe (fromJust, fromMaybe, isJust) | 35 | import Data.Maybe (fromJust, fromMaybe, isJust) |
35 | import qualified Graphics.UI.GLFW as GLFW | 36 | import qualified Graphics.UI.GLFW as GLFW |
36 | import Spear.Game | 37 | import Spear.Game |