New Algebra module and Spatial abstraction.

2 files changed, 80 insertions, 51 deletions

diff --git a/Demos/Pong/Main.hs b/Demos/Pong/Main.hs
index 0644f9d..a49efec 100644
--- a/Demos/Pong/Main.hs
+++ b/Demos/Pong/Main.hs
@@ -8,6 +8,7 @@ import           Pong
 import           Spear.App
 import           Spear.Game
 import           Spear.Math.AABB
+import           Spear.Math.Spatial
 import           Spear.Math.Spatial2
 import           Spear.Math.Vector
 import           Spear.Window
@@ -28,10 +29,10 @@ step :: Elapsed -> Dt -> [InputEvent] -> Game GameState Bool
 step elapsed dt inputEvents = do
   gs <- getGameState
   gameIO . process $ inputEvents
-  let events = translate inputEvents
+  let events = translateEvents inputEvents
   modifyGameState $ \gs ->
     gs
-      { world = stepWorld elapsed dt events (world gs)
+      { world = stepWorld (realToFrac elapsed) dt events (world gs)
       }
   getGameState >>= \gs -> gameIO . render $ world gs
   return (not $ exitRequested inputEvents)
@@ -63,7 +64,7 @@ renderBackground =
 renderGO :: GameObject -> IO ()
 renderGO go = do
   let (AABB2 (Vector2 xmin' ymin') (Vector2 xmax' ymax')) = aabb go
-      (Vector2 xcenter ycenter) = pos go
+      (Vector2 xcenter ycenter) = position go
       (xmin, ymin, xmax, ymax) = (f2d xmin', f2d ymin', f2d xmax', f2d ymax')
   GL.preservingMatrix $ do
     GL.translate (GL.Vector3 (f2d xcenter) (f2d ycenter) 0)
@@ -76,7 +77,7 @@ renderGO go = do
 process = mapM_ procEvent
 
 procEvent (Resize w h) =
-  let r = (fromIntegral w) / (fromIntegral h)
+  let r = fromIntegral w / fromIntegral h
       pad    = if r > 1 then (r-1) / 2 else (1/r - 1) / 2
       left   = if r > 1 then -pad else 0
       right  = if r > 1 then 1 + pad else 1
@@ -90,13 +91,12 @@ procEvent (Resize w h) =
     GL.matrixMode $= GL.Modelview 0
 procEvent _ = return ()
 
-translate = mapMaybe translate'
-
-translate' (KeyDown KEY_LEFT)  = Just MoveLeft
-translate' (KeyDown KEY_RIGHT) = Just MoveRight
-translate' (KeyUp KEY_LEFT)    = Just StopLeft
-translate' (KeyUp KEY_RIGHT)   = Just StopRight
-translate' _                   = Nothing
+translateEvents = mapMaybe translateEvents'
+  where translateEvents' (KeyDown KEY_LEFT)  = Just MoveLeft
+        translateEvents' (KeyDown KEY_RIGHT) = Just MoveRight
+        translateEvents' (KeyUp KEY_LEFT)    = Just StopLeft
+        translateEvents' (KeyUp KEY_RIGHT)   = Just StopRight
+        translateEvents' _                   = Nothing
 
 exitRequested = elem (KeyDown KEY_ESC)
 
diff --git a/Demos/Pong/Pong.hs b/Demos/Pong/Pong.hs
index 0e24a42..104a92e 100644
--- a/Demos/Pong/Pong.hs
+++ b/Demos/Pong/Pong.hs
@@ -1,3 +1,7 @@
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE NoImplicitPrelude     #-}
+{-# LANGUAGE TypeSynonymInstances  #-}
+
 module Pong
   ( GameEvent (..),
     GameObject,
@@ -7,25 +11,29 @@ module Pong
   )
 where
 
-import           Data.Monoid         (mconcat)
-import           GHC.Float           (double2Float)
 import           Spear.Math.AABB
+import           Spear.Math.Algebra
+import           Spear.Math.Spatial
 import           Spear.Math.Spatial2
 import           Spear.Math.Vector
+import           Spear.Prelude
 import           Spear.Step
 
+import           Data.Monoid         (mconcat)
+
+
 -- Configuration
 
-padSize = vec2 0.07 0.02
-ballSize = 0.012
-ballSpeed = 0.6
+padSize             = vec2 0.07 0.02
+ballSize            = 0.012 :: Float
+ballSpeed           = 0.6 :: Float
 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
+maxBounceAngle      = (65::Float) * (pi::Float)/(180::Float)
+playerSpeed         = 1.0 :: Float
+enemySpeed          = 3.0 :: Float
+initialEnemyPos     = vec2 0.5 0.9
+initialPlayerPos    = vec2 0.5 0.1
+initialBallPos      = vec2 0.5 0.5
 
 -- Game events
 
@@ -40,13 +48,36 @@ data GameEvent
 
 data GameObject = GameObject
   { aabb   :: AABB2,
-    obj    :: Obj2,
+    basis  :: Transform2,
     gostep :: Step [GameObject] [GameEvent] GameObject GameObject
   }
 
-instance Spatial2 GameObject where
-  getObj2 = obj
-  setObj2 s o = s {obj = o}
+
+instance Has2dTransform GameObject where
+  set2dTransform transform object = object { basis = transform }
+  transform2 = basis
+
+
+instance Positional GameObject Vector2 where
+  setPosition p = with2dTransform (setPosition p)
+  position = position . basis
+  translate v = with2dTransform (translate v)
+
+
+instance Rotational GameObject Vector2 Angle where
+  setRotation r = with2dTransform (setRotation r)
+  rotation = rotation . basis
+  rotate angle = with2dTransform (rotate angle)
+  right = right . basis
+  up = up . basis
+  forward = forward . basis
+  setForward v = with2dTransform (setForward v)
+
+
+instance Spatial GameObject Vector2 Angle Transform2 where
+  setTransform t obj = obj { basis = t }
+  transform = basis
+
 
 stepWorld :: Elapsed -> Dt -> [GameEvent] -> [GameObject] -> [GameObject]
 stepWorld elapsed dt evts gos = map (update elapsed dt evts gos) gos
@@ -60,13 +91,12 @@ ballBox, padBox :: AABB2
 ballBox = AABB2 (vec2 (-s) (-s)) (vec2 s s) where s = ballSize
 padBox = AABB2 (-padSize) padSize
 
-obj2 = obj2FromVectors unitx2 unity2
-
 newWorld =
-  [ GameObject ballBox (obj2 initialBallPos) $ stepBall initialBallVelocity,
-    GameObject padBox (obj2 initialEnemyPos) stepEnemy,
-    GameObject padBox (obj2 initialPlayerPos) stepPlayer
+  [ GameObject ballBox (makeAt initialBallPos) $ stepBall initialBallVelocity,
+    GameObject padBox  (makeAt initialEnemyPos)  stepEnemy,
+    GameObject padBox  (makeAt initialPlayerPos) stepPlayer
   ]
+  where makeAt = newTransform2 unitx2 unity2
 
 -- Ball steppers
 
@@ -76,7 +106,7 @@ stepBall vel = collideBall vel .> moveBall
 -- 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
+  let (AABB2 pmin pmax) = translate (position ball) (aabb ball)
       collideSide = x pmin < 0 || x pmax > 1
       collideBack = y pmin < 0 || y pmax > 1
       collidePaddle = any (collide ball) (tail gos)
@@ -84,18 +114,18 @@ collideBall vel = step $ \_ dt gos _ ball ->
       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')
+      delta = (1::Float) + if collideSide || collideBack || collidePaddle then (2::Float)*dt else (0::Float)
+   in ((ballSpeed * 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
+    let (AABB2 pmin pmax) = translate (position paddle) (aabb paddle)
+        center = (x pmin + x pmax) / (2::Float)
         -- 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)
+        offset = (x (position ball) - center) / ((x pmax - x pmin) / (2::Float))
         angle  = offset * maxBounceAngle
         -- When it bounces off of a paddle, y vel is flipped.
         ysign = -(signum (y v))
@@ -105,19 +135,17 @@ paddleBounce ball v paddle =
 collide :: GameObject -> GameObject -> Bool
 collide go1 go2 =
   let (AABB2 (Vector2 xmin1 ymin1) (Vector2 xmax1 ymax1)) =
-        aabb go1 `aabbAdd` pos go1
+        translate (position go1) (aabb go1)
       (AABB2 (Vector2 xmin2 ymin2) (Vector2 xmax2 ymax2)) =
-        aabb go2 `aabbAdd` pos go2
+        translate (position go2) (aabb go2)
    in not $
         xmax1 < xmin2
           || xmin1 > xmax2
           || ymax1 < ymin2
           || ymin1 > ymax2
 
-aabbAdd (AABB2 pmin pmax) p = AABB2 (p + pmin) (p + pmax)
-
 moveBall :: Step s e (Vector2, GameObject) GameObject
-moveBall = step $ \_ dt _ _ (vel, ball) -> (move (scale dt vel) ball, moveBall)
+moveBall = step $ \_ dt _ _ (vel, ball) -> (translate (vel * dt) ball, moveBall)
 
 -- Enemy stepper
 
@@ -125,12 +153,13 @@ stepEnemy = movePad
 
 movePad :: Step s e GameObject GameObject
 movePad = step $ \elapsed _ _ _ pad ->
-  let p = vec2 px 0.9
+  let enemyY = 0.9
+      p = vec2 px enemyY
       px =
-        double2Float (sin (elapsed * enemySpeed) * 0.5 + 0.5)
-          * (1 - 2 * x padSize)
+        (sin (enemySpeed * elapsed) * (0.5::Float) + (0.5::Float))
+          * ((1::Float) - (2::Float) * x padSize)
           + x padSize
-   in (setPos p pad, movePad)
+   in (setPosition p pad, movePad)
 
 -- Player stepper
 
@@ -138,20 +167,20 @@ stepPlayer = sfold moveGO .> clamp
 
 moveGO =
   mconcat
-    [ switch StopLeft sid MoveLeft (moveGO' $ vec2 (-playerSpeed) 0),
-      switch StopRight sid MoveRight (moveGO' $ vec2 playerSpeed 0)
+    [ switch StopLeft  sid MoveLeft  (moveGO' $ vec2 (-playerSpeed) 0),
+      switch StopRight sid MoveRight (moveGO' $ vec2   playerSpeed  0)
     ]
 
 moveGO' :: Vector2 -> Step s e GameObject GameObject
-moveGO' dir = step $ \_ dt _ _ go -> (move (scale dt dir) go, moveGO' dir)
+moveGO' dir = step $ \_ dt _ _ go -> (translate (dir * dt) go, moveGO' dir)
 
 clamp :: Step s e GameObject GameObject
 clamp = spure $ \go ->
   let p' = vec2 (clamp' x s (1 - s)) y
-      (Vector2 x y) = pos go
+      (Vector2 x y) = position go
       clamp' x a b
         | x < a = a
         | x > b = b
         | otherwise = x
       (Vector2 s _) = padSize
-   in setPos p' go
+   in setPosition p' go