From f10147a471427b6556ecad6f5e0a68dead188f25 Mon Sep 17 00:00:00 2001 From: 3gg <3gg@shellblade.net> Date: Thu, 31 Aug 2023 19:12:47 -0700 Subject: New Algebra module and Spatial abstraction. --- Demos/Pong/Main.hs | 22 +++++------ Demos/Pong/Pong.hs | 109 +++++++++++++++++++++++++++++++++-------------------- 2 files changed, 80 insertions(+), 51 deletions(-) (limited to 'Demos') 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 -- cgit v1.2.3