From 5a395dbb9491cee0a921553b331923d492a16fc4 Mon Sep 17 00:00:00 2001
From: 3gg <3gg@shellblade.net>
Date: Wed, 23 Aug 2023 08:47:16 -0700
Subject: Better physics and Vector class rename.
---
Demos/Pong/Pong.hs | 59 +++++++++++++++++++++++++++-----------------
Spear.cabal | 2 +-
Spear/Math/Vector.hs | 12 ++++-----
Spear/Math/Vector/Class.hs | 43 --------------------------------
Spear/Math/Vector/Vector.hs | 43 ++++++++++++++++++++++++++++++++
Spear/Math/Vector/Vector2.hs | 16 +++---------
Spear/Math/Vector/Vector3.hs | 8 +++---
Spear/Math/Vector/Vector4.hs | 8 +++---
Spear/Window.hs | 1 +
9 files changed, 100 insertions(+), 92 deletions(-)
delete mode 100644 Spear/Math/Vector/Class.hs
create mode 100644 Spear/Math/Vector/Vector.hs
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
-- Configuration
-padSize = vec2 0.05 0.02
-
-ballSize = 0.01
-
-ballVelocity = vec2 0.3 0.3
-
-playerSpeed = 0.7
-
+padSize = vec2 0.07 0.02
+ballSize = 0.012
+ballSpeed = 0.6
+initialBallVelocity = vec2 1 1
+maxBounceAngle = 65 * pi/180
+playerSpeed = 1.0
+enemySpeed = 1.5
initialEnemyPos = vec2 0.5 0.9
-
initialPlayerPos = vec2 0.5 0.1
-
initialBallPos = vec2 0.5 0.5
-- Game events
@@ -66,7 +63,7 @@ padBox = AABB2 (-padSize) padSize
obj2 = obj2FromVectors unitx2 unity2
newWorld =
- [ GameObject ballBox (obj2 initialBallPos) $ stepBall ballVelocity,
+ [ GameObject ballBox (obj2 initialBallPos) $ stepBall initialBallVelocity,
GameObject padBox (obj2 initialEnemyPos) stepEnemy,
GameObject padBox (obj2 initialPlayerPos) stepPlayer
]
@@ -75,19 +72,37 @@ newWorld =
stepBall vel = collideBall vel .> moveBall
+-- TODO: in collideBall and paddleBounce, we should an apply an offset to the
+-- ball when collision is detected.
collideBall :: Vector2 -> Step [GameObject] e GameObject (Vector2, GameObject)
collideBall vel = step $ \_ dt gos _ ball ->
let (AABB2 pmin pmax) = aabb ball `aabbAdd` pos ball
- collideCol = x pmin < 0 || x pmax > 1
- collideRow = y pmin < 0 || y pmax > 1 || any (collide ball) (tail gos)
- negx v@(Vector2 x y) = if collideCol then vec2 (-x) y else v
- negy v@(Vector2 x y) = if collideRow then vec2 x (-y) else v
- vel' = negx . negy $ vel
- delta = dt -- A small delta to apply when collision occurs.
- adjustX = if collideCol then scale delta (vec2 (x vel) 0) else vec2 0 0
- adjustY = if collideRow then scale delta (vec2 0 (y vel)) else vec2 0 0
- in ((vel' + adjustX + adjustY, ball), collideBall vel')
-
+ collideSide = x pmin < 0 || x pmax > 1
+ collideBack = y pmin < 0 || y pmax > 1
+ collidePaddle = any (collide ball) (tail gos)
+ flipX v@(Vector2 x y) = if collideSide then vec2 (-x) y else v
+ flipY v@(Vector2 x y) = if collideBack then vec2 x (-y) else v
+ vel' = normalise . (\v -> foldl (paddleBounce ball) v (tail gos)) . flipX . flipY $ vel
+ -- A small delta to apply when collision occurs.
+ delta = 1 + if collideSide || collideBack || collidePaddle then 2*dt else 0
+ in ((scale ballSpeed (scale delta vel'), ball), collideBall vel')
+
+paddleBounce :: GameObject -> Vector2 -> GameObject -> Vector2
+paddleBounce ball v paddle =
+ if collide ball paddle
+ then
+ let (AABB2 pmin pmax) = aabb paddle `aabbAdd` pos paddle
+ center = (x pmin + x pmax) / 2
+ -- Normalized offset of the ball from the paddle's center, [-1, +1].
+ -- It's outside the [-1, +1] range if there is no collision.
+ offset = (x (pos ball) - center) / ((x pmax - x pmin) / 2)
+ angle = offset * maxBounceAngle
+ -- When it bounces off of a paddle, y vel is flipped.
+ ysign = -(signum (y v))
+ in vec2 (sin angle) (ysign * cos angle)
+ else v
+
+collide :: GameObject -> GameObject -> Bool
collide go1 go2 =
let (AABB2 (Vector2 xmin1 ymin1) (Vector2 xmax1 ymax1)) =
aabb go1 `aabbAdd` pos go1
@@ -112,7 +127,7 @@ movePad :: Step s e GameObject GameObject
movePad = step $ \elapsed _ _ _ pad ->
let p = vec2 px 0.9
px =
- double2Float (sin elapsed * 0.5 + 0.5)
+ double2Float (sin (elapsed * enemySpeed) * 0.5 + 0.5)
* (1 - 2 * x padSize)
+ x padSize
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
Spear.Math.Triangle
Spear.Math.Utils
Spear.Math.Vector
- Spear.Math.Vector.Class
+ Spear.Math.Vector.Vector
Spear.Math.Vector.Vector2
Spear.Math.Vector.Vector3
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 @@
module Spear.Math.Vector
(
- module Spear.Math.Vector.Vector2
+ module Spear.Math.Vector.Vector
+, module Spear.Math.Vector.Vector2
, module Spear.Math.Vector.Vector3
, module Spear.Math.Vector.Vector4
-, module Spear.Math.Vector.Class
)
where
-import Spear.Math.Vector.Vector2
-import Spear.Math.Vector.Vector3
-import Spear.Math.Vector.Vector4
-import Spear.Math.Vector.Class
+import Spear.Math.Vector.Vector
+import Spear.Math.Vector.Vector2
+import Spear.Math.Vector.Vector3
+import Spear.Math.Vector.Vector4
diff --git a/Spear/Math/Vector/Class.hs b/Spear/Math/Vector/Class.hs
deleted file mode 100644
index 19ddfac..0000000
--- a/Spear/Math/Vector/Class.hs
+++ /dev/null
@@ -1,43 +0,0 @@
-module Spear.Math.Vector.Class
-where
-
-class (Fractional a, Ord a) => VectorClass a where
- -- | Create a vector from the given list.
- fromList :: [Float] -> a
-
- -- | Return the vector's x coordinate.
- x :: a -> Float
- x _ = 0
-
- -- | Return the vector's y coordinate.
- y :: a -> Float
- y _ = 0
-
- -- | Return the vector's z coordinate.
- z :: a -> Float
- z _ = 0
-
- -- | Return the vector's w coordinate.
- w :: a -> Float
- w _ = 0
-
- -- | Return the vector's ith coordinate.
- (!) :: a -> Int -> Float
-
- -- | Compute the given vectors' dot product.
- dot :: a -> a -> Float
-
- -- | Compute the given vector's squared norm.
- normSq :: a -> Float
-
- -- | Compute the given vector's norm.
- norm :: a -> Float
-
- -- | Multiply the given vector with the given scalar.
- scale :: Float -> a -> a
-
- -- | Negate the given vector.
- neg :: a -> a
-
- -- | Normalise the given vector.
- normalise :: a -> a
\ No newline at end of file
diff --git a/Spear/Math/Vector/Vector.hs b/Spear/Math/Vector/Vector.hs
new file mode 100644
index 0000000..35b04e2
--- /dev/null
+++ b/Spear/Math/Vector/Vector.hs
@@ -0,0 +1,43 @@
+module Spear.Math.Vector.Vector
+where
+
+class (Fractional a, Ord a) => Vector a where
+ -- | Create a vector from the given list.
+ fromList :: [Float] -> a
+
+ -- | Return the vector's x coordinate.
+ x :: a -> Float
+ x _ = 0
+
+ -- | Return the vector's y coordinate.
+ y :: a -> Float
+ y _ = 0
+
+ -- | Return the vector's z coordinate.
+ z :: a -> Float
+ z _ = 0
+
+ -- | Return the vector's w coordinate.
+ w :: a -> Float
+ w _ = 0
+
+ -- | Return the vector's ith coordinate.
+ (!) :: a -> Int -> Float
+
+ -- | Compute the given vectors' dot product.
+ dot :: a -> a -> Float
+
+ -- | Compute the given vector's squared norm.
+ normSq :: a -> Float
+
+ -- | Compute the given vector's norm.
+ norm :: a -> Float
+
+ -- | Multiply the given vector with the given scalar.
+ scale :: Float -> a -> a
+
+ -- | Negate the given vector.
+ neg :: a -> a
+
+ -- | Normalise the given vector.
+ 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
)
where
-import Spear.Math.Vector.Class
+import Spear.Math.Vector.Vector
-import Foreign.C.Types (CFloat)
-import Foreign.Storable
+import Foreign.C.Types (CFloat)
+import Foreign.Storable
type Right2 = Vector2
type Up2 = Vector2
@@ -50,7 +50,7 @@ instance Ord Vector2 where
min (Vector2 ax ay) (Vector2 bx by) = Vector2 (Prelude.min ax bx) (Prelude.min ay by)
-instance VectorClass Vector2 where
+instance Vector Vector2 where
{-# INLINABLE fromList #-}
fromList (ax:ay:_) = Vector2 ax ay
@@ -104,27 +104,19 @@ instance Storable Vector2 where
pokeByteOff ptr sizeFloat ay
--- | Get the vector's x coordinate.
-
-
-
-- | Unit vector along the X axis.
unitx2 = Vector2 1 0
-
-- | Unit vector along the Y axis.
unity2 = Vector2 0 1
-
-- | Zero vector.
zero2 = Vector2 0 0
-
-- | Create a vector from the given values.
vec2 :: Float -> Float -> Vector2
vec2 ax ay = Vector2 ax ay
-
-- | Compute a vector perpendicular to the given one, satisfying:
--
-- 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
where
-import Spear.Math.Vector.Class
+import Spear.Math.Vector.Vector
-import Foreign.C.Types (CFloat)
-import Foreign.Storable
+import Foreign.C.Types (CFloat)
+import Foreign.Storable
type Right3 = Vector3
type Up3 = Vector3
@@ -76,7 +76,7 @@ instance Ord Vector3 where
min (Vector3 ax ay az) (Vector3 bx by bz) = Vector3 (Prelude.min ax bx) (Prelude.min ay by) (Prelude.min az bz)
-instance VectorClass Vector3 where
+instance Vector Vector3 where
{-# INLINABLE fromList #-}
fromList (ax:ay:az:_) = Vector3 ax ay az
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
where
-import Spear.Math.Vector.Class
+import Spear.Math.Vector.Vector
-import Foreign.C.Types (CFloat)
-import Foreign.Storable
+import Foreign.C.Types (CFloat)
+import Foreign.Storable
-- | Represents a vector in 3D.
@@ -73,7 +73,7 @@ instance Ord Vector4 where
Vector4 (Prelude.max ax bx) (Prelude.max ay by) (Prelude.max az bz) (Prelude.min aw bw)
-instance VectorClass Vector4 where
+instance Vector Vector4 where
{-# INLINABLE fromList #-}
fromList (ax:ay:az:aw:_) = Vector4 ax ay az aw
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
import Control.Concurrent.MVar
import Control.Exception
import Control.Monad (foldM, unless, void, when)
+import Data.Functor ((<&>))
import Data.Maybe (fromJust, fromMaybe, isJust)
import qualified Graphics.UI.GLFW as GLFW
import Spear.Game
--
cgit v1.2.3