From 4541db68038929e800637d92163b8adfc424c2fe Mon Sep 17 00:00:00 2001 From: Jeanne-Kamikaze Date: Tue, 12 Mar 2013 20:03:56 +0100 Subject: Added Obj3 --- Spear/App/Input.hs | 40 ++++---------- Spear/GL.hs | 3 +- Spear/Math/Camera.hs | 100 ++++++++++++++++++++-------------- Spear/Math/MatrixUtils.hs | 9 ++-- Spear/Math/Spatial3.hs | 134 +++++++++++++++++++++++++++++++++------------- Spear/Scene/GameObject.hs | 3 +- 6 files changed, 176 insertions(+), 113 deletions(-) diff --git a/Spear/App/Input.hs b/Spear/App/Input.hs index 0207147..9fa140a 100644 --- a/Spear/App/Input.hs +++ b/Spear/App/Input.hs @@ -27,14 +27,12 @@ module Spear.App.Input ) where - import Data.Char (ord) import qualified Data.Vector.Unboxed as V import qualified Graphics.UI.GLFW as GLFW import Graphics.Rendering.OpenGL.GL.CoordTrans import Data.StateVar - data Key = KEY_A | KEY_B | KEY_C | KEY_D | KEY_E | KEY_F | KEY_G | KEY_H | KEY_I | KEY_J | KEY_K | KEY_L | KEY_M | KEY_N | KEY_O | KEY_P @@ -42,33 +40,28 @@ data Key | KEY_Y | KEY_Z | KEY_0 | KEY_1 | KEY_2 | KEY_3 | KEY_4 | KEY_5 | KEY_6 | KEY_7 | KEY_8 | KEY_9 | KEY_F1 | KEY_F2 | KEY_F3 | KEY_F4 | KEY_F5 | KEY_F6 | KEY_F7 | KEY_F8 | KEY_F9 | KEY_F10 - | KEY_F11 | KEY_F12 | KEY_ESC | KEY_SPACE + | KEY_F11 | KEY_F12 | KEY_ESC | KEY_SPACE | KEY_UP | KEY_DOWN + | KEY_LEFT | KEY_RIGHT deriving (Enum, Bounded) - type Keyboard = Key -> Bool - data MouseButton = LMB | RMB | MMB deriving (Enum, Bounded) - data MouseProp = MouseX | MouseY | MouseDX | MouseDY deriving Enum - data Mouse = Mouse { button :: MouseButton -> Bool , property :: MouseProp -> Float } - data Input = Input { keyboard :: Keyboard , mouse :: Mouse } - -- | Return a new dummy keyboard. -- -- This function should be called to get an initial keyboard. @@ -79,7 +72,6 @@ data Input = Input newKeyboard :: Keyboard newKeyboard = const False - -- | Get the keyboard. getKeyboard :: IO Keyboard getKeyboard = @@ -90,7 +82,6 @@ getKeyboard = (fmap (V.fromList . fmap ((==) GLFW.Press)) . mapM GLFW.getKey . fmap toGLFWkey $ keys) >>= return . keyboard' - -- | Return a new dummy mouse. -- -- This function should be called to get an initial mouse. @@ -101,7 +92,6 @@ getKeyboard = newMouse :: Mouse newMouse = Mouse (const False) (const 0) - -- | Get the mouse. -- -- The previous mouse state is required to compute position deltas. @@ -109,21 +99,21 @@ getMouse :: Mouse -> IO Mouse getMouse oldMouse = let getButton :: V.Vector Bool -> MouseButton -> Bool getButton mousestate button = mousestate V.! fromEnum button - + getProp :: V.Vector Float -> MouseProp -> Float getProp props prop = props V.! fromEnum prop - + props xpos ypos = V.fromList [ xpos, ypos , xpos - property oldMouse MouseX , ypos - property oldMouse MouseY ] - + getButtonState = fmap (V.fromList . fmap ((==) GLFW.Press)) . mapM GLFW.getMouseButton . fmap toGLFWbutton $ buttons - + buttons = fmap toEnum [0..fromEnum (maxBound :: MouseButton)] in do Position xpos ypos <- get GLFW.mousePos @@ -133,12 +123,10 @@ getMouse oldMouse = , property = getProp $ props (fromIntegral xpos) (fromIntegral ypos) } - -- | Return a new dummy input. newInput :: Input newInput = Input newKeyboard newMouse - -- | Get input devices. getInput :: Input -> IO Input getInput (Input _ oldMouse) = do @@ -146,12 +134,10 @@ getInput (Input _ oldMouse) = do mouse <- getMouse oldMouse return $ Input keyboard mouse - -- | Poll input devices. pollInput :: IO () pollInput = GLFW.pollEvents - -- | Return a mouse that reacts to button toggles. toggledMouse :: Mouse -- ^ Previous mouse state. -> Mouse -- ^ Current mouse state. @@ -159,7 +145,6 @@ toggledMouse :: Mouse -- ^ Previous mouse state. toggledMouse prev cur = cur { button = \bt -> button cur bt && not (button prev bt) } - -- | Return a keyboard that reacts to key toggles. toggledKeyboard :: Keyboard -- ^ Previous keyboard state. -> Keyboard -- ^ Current keyboard state. @@ -167,9 +152,6 @@ toggledKeyboard :: Keyboard -- ^ Previous keyboard state. toggledKeyboard prev cur key = cur key && not (prev key) - - - -- | Delay configuration for each mouse button. type ButtonDelay = MouseButton -> Float @@ -181,13 +163,11 @@ data DelayedMouse = DelayedMouse , accum :: V.Vector Float } - newDM :: ButtonDelay -- ^ Delay configuration for each button. -> DelayedMouse newDM delay = DelayedMouse newMouse delay $ V.replicate (fromEnum (maxBound :: MouseButton)) 0 - updateDM :: DelayedMouse -- ^ Current mouse state. -> Float -- ^ Time elapsed since last udpate. -> DelayedMouse @@ -199,13 +179,11 @@ updateDM (DelayedMouse mouse delay accum) dt = button' b = active b && button mouse b accum' = accum V.// fmap newDelay [0 .. fromEnum (maxBound :: MouseButton)] newDelay x = let b = toEnum x - in (x, if button' b then 0 else time b) + in (x, if button' b then 0 else time b) in DelayedMouse mouse { button = button' } delay accum' - - toGLFWkey :: Key -> Int toGLFWkey KEY_A = ord 'A' toGLFWkey KEY_B = ord 'B' @@ -257,6 +235,10 @@ toGLFWkey KEY_F11 = fromEnum GLFW.F11 toGLFWkey KEY_F12 = fromEnum GLFW.F12 toGLFWkey KEY_ESC = fromEnum GLFW.ESC toGLFWkey KEY_SPACE = ord ' ' +toGLFWkey KEY_UP = fromEnum GLFW.UP +toGLFWkey KEY_DOWN = fromEnum GLFW.DOWN +toGLFWkey KEY_LEFT = fromEnum GLFW.LEFT +toGLFWkey KEY_RIGHT = fromEnum GLFW.RIGHT toGLFWbutton :: MouseButton -> GLFW.MouseButton diff --git a/Spear/GL.hs b/Spear/GL.hs index 6792d35..af96da4 100644 --- a/Spear/GL.hs +++ b/Spear/GL.hs @@ -452,7 +452,8 @@ attribVAOPointer -> Int -- ^ Offset to the first component in the array. -> IO () attribVAOPointer idx ncomp dattype normalise stride off = - glVertexAttribPointer idx ncomp dattype (unsafeCoerce normalise) stride (unsafeCoerce off) + glVertexAttribPointer idx ncomp dattype normalise' stride (unsafeCoerce off) + where normalise' = if normalise then 1 else 0 -- | Draw the bound vao. drawArrays diff --git a/Spear/Math/Camera.hs b/Spear/Math/Camera.hs index a86d5f5..9484bef 100644 --- a/Spear/Math/Camera.hs +++ b/Spear/Math/Camera.hs @@ -1,71 +1,89 @@ module Spear.Math.Camera +( + Camera +, Fovy +, Aspect +, Near +, Far +, Left +, Right +, Bottom +, Top +, projection +) where import qualified Spear.Math.Matrix4 as M -import qualified Spear.Math.Spatial3 as S +import Spear.Math.Spatial3 import Spear.Math.Vector data Camera = Camera - { projection :: M.Matrix4 - , transform :: M.Matrix4 + { projection :: M.Matrix4 -- ^ Get the camera's projection. + , spatial :: Obj3 } +type Fovy = Float +type Aspect = Float +type Near = Float +type Far = Float +type Left = Float +type Right = Float +type Bottom = Float +type Top = Float -- | Build a perspective camera. -perspective :: Float -- ^ Fovy - Vertical field of view angle in degrees. - -> Float -- ^ Aspect ratio. - -> Float -- ^ Near clip. - -> Float -- ^ Far clip. - -> Vector3 -- ^ Right vector. - -> Vector3 -- ^ Up vector. - -> Vector3 -- ^ Forward vector. - -> Vector3 -- ^ Position vector. +perspective :: Fovy -- ^ Fovy - Vertical field of view angle in degrees. + -> Aspect -- ^ Aspect ratio. + -> Near -- ^ Near clip. + -> Far -- ^ Far clip. + -> Right3 -- ^ Right vector. + -> Up3 -- ^ Up vector. + -> Forward3 -- ^ Forward vector. + -> Position3 -- ^ Position vector. -> Camera perspective fovy r n f right up fwd pos = Camera { projection = M.perspective fovy r n f - , transform = M.transform right up (neg fwd) pos + , spatial = fromVectors right up fwd pos } -- | Build an orthogonal camera. -ortho :: Float -- ^ Left. - -> Float -- ^ Right. - -> Float -- ^ Bottom. - -> Float -- ^ Top. - -> Float -- ^ Near clip. - -> Float -- ^ Far clip. - -> Vector3 -- ^ Right vector. - -> Vector3 -- ^ Up vector. - -> Vector3 -- ^ Forward vector. - -> Vector3 -- ^ Position vector. +ortho :: Left -- ^ Left. + -> Right -- ^ Right. + -> Bottom -- ^ Bottom. + -> Top -- ^ Top. + -> Near -- ^ Near clip. + -> Far -- ^ Far clip. + -> Right3 -- ^ Right vector. + -> Up3 -- ^ Up vector. + -> Forward3 -- ^ Forward vector. + -> Position3 -- ^ Position vector. -> Camera ortho l r b t n f right up fwd pos = Camera { projection = M.ortho l r b t n f - , transform = M.transform right up (neg fwd) pos + , spatial = fromVectors right up fwd pos } -instance S.Spatial3 Camera where - move v cam = cam { transform = M.translv v * transform cam } - moveFwd f cam = cam { transform = M.translv (scale f $ S.fwd cam) * transform cam } - moveBack f cam = cam { transform = M.translv (scale (-f) $ S.fwd cam) * transform cam } - strafeLeft f cam = cam { transform = M.translv (scale (-f) $ S.right cam) * transform cam } - strafeRight f cam = cam { transform = M.translv (scale f $ S.right cam) * transform cam } - pitch a cam = cam { transform = transform cam * M.axisAngle (S.right cam) a } - yaw a cam = cam { transform = transform cam * M.axisAngle (S.up cam) a } - roll a cam = cam { transform = transform cam * M.axisAngle (S.fwd cam) a } - pos = M.position . transform - fwd = M.forward . transform - up = M.up . transform - right = M.right . transform - transform (Camera _ t) = t - setTransform t (Camera proj _) = Camera proj t - setPos pos (Camera proj t) = Camera proj $ - M.transform (M.right t) (M.up t) (M.forward t) pos - +instance Spatial3 Camera where + move v cam = cam { spatial = move v $ spatial cam } + moveFwd s cam = cam { spatial = moveFwd s $ spatial cam } + moveBack s cam = cam { spatial = moveBack s $ spatial cam } + strafeLeft s cam = cam { spatial = strafeLeft s $ spatial cam } + strafeRight s cam = cam { spatial = strafeRight s $ spatial cam } + pitch a cam = cam { spatial = pitch a $ spatial cam } + yaw a cam = cam { spatial = yaw a $ spatial cam } + roll a cam = cam { spatial = roll a $ spatial cam } + pos cam = pos $ spatial cam + fwd cam = fwd $ spatial cam + up cam = up $ spatial cam + right cam = right $ spatial cam + transform cam = transform $ spatial cam + setTransform m cam = cam { spatial = setTransform m $ spatial cam } + setPos p cam = cam { spatial = setPos p $ spatial cam } diff --git a/Spear/Math/MatrixUtils.hs b/Spear/Math/MatrixUtils.hs index 79bd049..e4273a1 100644 --- a/Spear/Math/MatrixUtils.hs +++ b/Spear/Math/MatrixUtils.hs @@ -15,6 +15,7 @@ where import Spear.Math.Camera as Cam import Spear.Math.Matrix3 as M3 import Spear.Math.Matrix4 as M4 +import Spear.Math.Spatial3 as S import Spear.Math.Vector as V @@ -112,7 +113,7 @@ pltTransform mat = -- | Map an object's transform in world space to view space. --- +-- -- The XY plane in 2D translates to the X(-Z) plane in 3D. -- -- Use this in games such as RPGs and RTSs. @@ -130,9 +131,9 @@ rpgInverse h a axis pos viewI = -- | Map an object's transform in world space to view space. -- -- This function maps an object's transform in 2D to the object's inverse in 3D. --- +-- -- The XY plane in 2D translates to the XY plane in 3D. --- +-- -- Use this in games like platformers and space invaders style games. pltInverse :: Matrix3 -> Matrix4 pltInverse = M4.inverseTransform . pltTransform @@ -142,7 +143,7 @@ pltInverse = M4.inverseTransform . pltTransform objToClip :: Camera -> Matrix4 -> Vector3 -> Vector2 objToClip cam model p = let - view = M4.inverseTransform $ Cam.transform cam + view = M4.inverseTransform $ S.transform cam proj = Cam.projection cam p' = (proj * view * model) `M4.mulp` p in diff --git a/Spear/Math/Spatial3.hs b/Spear/Math/Spatial3.hs index 6db3853..2bc772e 100644 --- a/Spear/Math/Spatial3.hs +++ b/Spear/Math/Spatial3.hs @@ -1,58 +1,62 @@ module Spear.Math.Spatial3 +( + Spatial3(..) +, Obj3 +, fromVectors +, fromTransform +) where - import Spear.Math.Vector -import Spear.Math.Matrix4 as M - +import Spear.Math.Matrix4 as M hiding (scale) class Spatial3 s where - -- | Move the 'Spatial'. + -- | Move the spatial. move :: Vector3 -> s -> s - - -- | Move the 'Spatial' forwards. + + -- | Move the spatial forwards. moveFwd :: Float -> s -> s - - -- | Move the 'Spatial' backwards. + + -- | Move the spatial backwards. moveBack :: Float -> s -> s - - -- | Make the 'Spatial' strafe left. + + -- | Make the spatial strafe left. strafeLeft :: Float -> s -> s - - -- | Make the 'Spatial' Strafe right. + + -- | Make the spatial Strafe right. strafeRight :: Float -> s -> s - - -- | Rotate the 'Spatial' about its local X axis. + + -- | Rotate the spatial about its local X axis. pitch :: Float -> s -> s - - -- | Rotate the 'Spatial' about its local Y axis. + + -- | Rotate the spatial about its local Y axis. yaw :: Float -> s -> s - - -- | Rotate the 'Spatial' about its local Z axis. + + -- | Rotate the spatial about its local Z axis. roll :: Float -> s -> s - - -- | Get the 'Spatial''s position. + + -- | Get the spatial's position. pos :: s -> Vector3 - - -- | Get the 'Spatial''s forward vector. + + -- | Get the spatial's forward vector. fwd :: s -> Vector3 - - -- | Get the 'Spatial''s up vector. + + -- | Get the spatial's up vector. up :: s -> Vector3 - - -- | Get the 'Spatial''s right vector. + + -- | Get the spatial's right vector. right :: s -> Vector3 - - -- | Get the 'Spatial''s transform. + + -- | Get the spatial's transform. transform :: s -> Matrix4 - - -- | Set the 'Spatial''s transform. + + -- | Set the spatial's transform. setTransform :: Matrix4 -> s -> s - - -- | Set the 'Spatial''s position. + + -- | Set the spatial's position. setPos :: Vector3 -> s -> s - - -- | Make the 'Spatial' look at the given point. + + -- | Make the spatial look at the given point. lookAt :: Vector3 -> s -> s lookAt pt s = let position = pos s @@ -61,15 +65,15 @@ class Spatial3 s where u = r `cross` fwd in setTransform (M.transform r u (-fwd) position) s - - -- | Make the 'Spatial' orbit around the given point + + -- | Make the spatial orbit around the given point orbit :: Vector3 -- ^ Target point -> Float -- ^ Horizontal angle -> Float -- ^ Vertical angle -> Float -- ^ Orbit radius. -> s -> s - + orbit pt anglex angley radius s = let ax = anglex * pi / 180 ay = angley * pi / 180 @@ -82,3 +86,59 @@ class Spatial3 s where pz = (z pt) + radius*cx*cy in setPos (vec3 px py pz) s + +-- | An object in 3D space. +data Obj3 = Obj3 + { r :: Vector3 + , u :: Vector3 + , f :: Vector3 + , p :: Vector3 + } deriving Show + +instance Spatial3 Obj3 where + move d o = o { p = p o + d } + moveFwd s o = o { p = p o + scale (-s) (f o) } + moveBack s o = o { p = p o + scale s (f o) } + strafeLeft s o = o { p = p o + scale (-s) (r o) } + strafeRight s o = o { p = p o + scale s (r o) } + pitch a o = + let a' = toRAD a + sa = sin a' + ca = cos a' + r' = normalise $ scale ca (r o) + scale sa (f o) + f' = normalise $ r' `cross` u o + in o { r = r', f = f' } + yaw a o = + let a' = toRAD a + sa = sin a' + ca = cos a' + f' = normalise $ scale ca (f o) + scale sa (u o) + u' = normalise $ r o `cross` f' + in o { u = u', f = f' } + roll a o = + let a' = toRAD a + sa = sin a' + ca = cos a' + u' = normalise $ scale ca (u o) - scale sa (r o) + f' = normalise $ f o `cross` u' + in o { u = u', f = f' } + pos = p + fwd = f + up = u + right = r + transform o = M.transform (r o) (u o) (f o) (p o) + setTransform t o = Obj3 + { r = M.right t + , u = M.up t + , f = M.forward t + , p = M.position t + } + setPos pos o = o { p = pos } + +fromVectors :: Right3 -> Up3 -> Forward3 -> Position3 -> Obj3 +fromVectors = Obj3 + +fromTransform :: Matrix4 -> Obj3 +fromTransform m = Obj3 (M.right m) (M.up m) (M.forward m) (M.position m) + +toRAD = (*pi) . (/180) diff --git a/Spear/Scene/GameObject.hs b/Spear/Scene/GameObject.hs index ecbe7a1..30211f4 100644 --- a/Spear/Scene/GameObject.hs +++ b/Spear/Scene/GameObject.hs @@ -39,6 +39,7 @@ import qualified Spear.Math.Matrix3 as M3 import qualified Spear.Math.Matrix4 as M4 import Spear.Math.MatrixUtils import qualified Spear.Math.Spatial2 as S2 +import qualified Spear.Math.Spatial3 as S3 import Spear.Math.Utils import Spear.Math.Vector import qualified Spear.Render.AnimatedModel as AM @@ -264,7 +265,7 @@ goRender sprog aprog cam go = axis' = axis go a = angle go proj = Cam.projection cam - view = M4.inverseTransform $ Cam.transform cam + view = M4.inverseTransform $ S3.transform cam transf = S2.transform go normal = fastNormalMatrix modelview modelview = case style of -- cgit v1.2.3