Better physics and Vector class rename.

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
 
 -- 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/Vector.hs
index 19ddfac..35b04e2 100644
--- a/Spear/Math/Vector/Class.hs
+++ b/Spear/Math/Vector/Vector.hs
@@ -1,10 +1,10 @@
-module Spear.Math.Vector.Class

+module Spear.Math.Vector.Vector

 where

 

-class (Fractional a, Ord a) => VectorClass a 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

@@ -23,21 +23,21 @@ class (Fractional a, Ord a) => VectorClass a where
 

       -- | 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
+      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