aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--Demos/Pong/Main.hs22
-rw-r--r--Demos/Pong/Pong.hs109
-rw-r--r--Spear.cabal159
-rw-r--r--Spear/GL.hs79
-rw-r--r--Spear/Game.hs8
-rw-r--r--Spear/Math/AABB.hs34
-rw-r--r--Spear/Math/Algebra.hs102
-rw-r--r--Spear/Math/Camera.hs60
-rw-r--r--Spear/Math/Circle.hs22
-rw-r--r--Spear/Math/Collision.hs69
-rw-r--r--Spear/Math/Matrix3.hs103
-rw-r--r--Spear/Math/Matrix4.hs93
-rw-r--r--Spear/Math/MatrixUtils.hs31
-rw-r--r--Spear/Math/Plane.hs5
-rw-r--r--Spear/Math/Quaternion.hs13
-rw-r--r--Spear/Math/Ray.hs35
-rw-r--r--Spear/Math/Spatial.hs111
-rw-r--r--Spear/Math/Spatial2.hs253
-rw-r--r--Spear/Math/Spatial3.hs318
-rw-r--r--Spear/Math/Sphere.hs21
-rw-r--r--Spear/Math/Triangle.hs29
-rw-r--r--Spear/Math/Utils.hs11
-rw-r--r--Spear/Math/Vector/Vector.hs93
-rw-r--r--Spear/Math/Vector/Vector2.hs113
-rw-r--r--Spear/Math/Vector/Vector3.hs150
-rw-r--r--Spear/Math/Vector/Vector4.hs142
-rw-r--r--Spear/Prelude.hs10
-rw-r--r--Spear/Render/AnimatedModel.hs77
-rw-r--r--Spear/Render/StaticModel.hs41
-rw-r--r--Spear/Scene/Loader.hs66
-rw-r--r--Spear/Step.hs2
31 files changed, 1391 insertions, 990 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
8import Spear.App 8import Spear.App
9import Spear.Game 9import Spear.Game
10import Spear.Math.AABB 10import Spear.Math.AABB
11import Spear.Math.Spatial
11import Spear.Math.Spatial2 12import Spear.Math.Spatial2
12import Spear.Math.Vector 13import Spear.Math.Vector
13import Spear.Window 14import Spear.Window
@@ -28,10 +29,10 @@ step :: Elapsed -> Dt -> [InputEvent] -> Game GameState Bool
28step elapsed dt inputEvents = do 29step elapsed dt inputEvents = do
29 gs <- getGameState 30 gs <- getGameState
30 gameIO . process $ inputEvents 31 gameIO . process $ inputEvents
31 let events = translate inputEvents 32 let events = translateEvents inputEvents
32 modifyGameState $ \gs -> 33 modifyGameState $ \gs ->
33 gs 34 gs
34 { world = stepWorld elapsed dt events (world gs) 35 { world = stepWorld (realToFrac elapsed) dt events (world gs)
35 } 36 }
36 getGameState >>= \gs -> gameIO . render $ world gs 37 getGameState >>= \gs -> gameIO . render $ world gs
37 return (not $ exitRequested inputEvents) 38 return (not $ exitRequested inputEvents)
@@ -63,7 +64,7 @@ renderBackground =
63renderGO :: GameObject -> IO () 64renderGO :: GameObject -> IO ()
64renderGO go = do 65renderGO go = do
65 let (AABB2 (Vector2 xmin' ymin') (Vector2 xmax' ymax')) = aabb go 66 let (AABB2 (Vector2 xmin' ymin') (Vector2 xmax' ymax')) = aabb go
66 (Vector2 xcenter ycenter) = pos go 67 (Vector2 xcenter ycenter) = position go
67 (xmin, ymin, xmax, ymax) = (f2d xmin', f2d ymin', f2d xmax', f2d ymax') 68 (xmin, ymin, xmax, ymax) = (f2d xmin', f2d ymin', f2d xmax', f2d ymax')
68 GL.preservingMatrix $ do 69 GL.preservingMatrix $ do
69 GL.translate (GL.Vector3 (f2d xcenter) (f2d ycenter) 0) 70 GL.translate (GL.Vector3 (f2d xcenter) (f2d ycenter) 0)
@@ -76,7 +77,7 @@ renderGO go = do
76process = mapM_ procEvent 77process = mapM_ procEvent
77 78
78procEvent (Resize w h) = 79procEvent (Resize w h) =
79 let r = (fromIntegral w) / (fromIntegral h) 80 let r = fromIntegral w / fromIntegral h
80 pad = if r > 1 then (r-1) / 2 else (1/r - 1) / 2 81 pad = if r > 1 then (r-1) / 2 else (1/r - 1) / 2
81 left = if r > 1 then -pad else 0 82 left = if r > 1 then -pad else 0
82 right = if r > 1 then 1 + pad else 1 83 right = if r > 1 then 1 + pad else 1
@@ -90,13 +91,12 @@ procEvent (Resize w h) =
90 GL.matrixMode $= GL.Modelview 0 91 GL.matrixMode $= GL.Modelview 0
91procEvent _ = return () 92procEvent _ = return ()
92 93
93translate = mapMaybe translate' 94translateEvents = mapMaybe translateEvents'
94 95 where translateEvents' (KeyDown KEY_LEFT) = Just MoveLeft
95translate' (KeyDown KEY_LEFT) = Just MoveLeft 96 translateEvents' (KeyDown KEY_RIGHT) = Just MoveRight
96translate' (KeyDown KEY_RIGHT) = Just MoveRight 97 translateEvents' (KeyUp KEY_LEFT) = Just StopLeft
97translate' (KeyUp KEY_LEFT) = Just StopLeft 98 translateEvents' (KeyUp KEY_RIGHT) = Just StopRight
98translate' (KeyUp KEY_RIGHT) = Just StopRight 99 translateEvents' _ = Nothing
99translate' _ = Nothing
100 100
101exitRequested = elem (KeyDown KEY_ESC) 101exitRequested = elem (KeyDown KEY_ESC)
102 102
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 @@
1{-# LANGUAGE MultiParamTypeClasses #-}
2{-# LANGUAGE NoImplicitPrelude #-}
3{-# LANGUAGE TypeSynonymInstances #-}
4
1module Pong 5module Pong
2 ( GameEvent (..), 6 ( GameEvent (..),
3 GameObject, 7 GameObject,
@@ -7,25 +11,29 @@ module Pong
7 ) 11 )
8where 12where
9 13
10import Data.Monoid (mconcat)
11import GHC.Float (double2Float)
12import Spear.Math.AABB 14import Spear.Math.AABB
15import Spear.Math.Algebra
16import Spear.Math.Spatial
13import Spear.Math.Spatial2 17import Spear.Math.Spatial2
14import Spear.Math.Vector 18import Spear.Math.Vector
19import Spear.Prelude
15import Spear.Step 20import Spear.Step
16 21
22import Data.Monoid (mconcat)
23
24
17-- Configuration 25-- Configuration
18 26
19padSize = vec2 0.07 0.02 27padSize = vec2 0.07 0.02
20ballSize = 0.012 28ballSize = 0.012 :: Float
21ballSpeed = 0.6 29ballSpeed = 0.6 :: Float
22initialBallVelocity = vec2 1 1 30initialBallVelocity = vec2 1 1
23maxBounceAngle = 65 * pi/180 31maxBounceAngle = (65::Float) * (pi::Float)/(180::Float)
24playerSpeed = 1.0 32playerSpeed = 1.0 :: Float
25enemySpeed = 1.5 33enemySpeed = 3.0 :: Float
26initialEnemyPos = vec2 0.5 0.9 34initialEnemyPos = vec2 0.5 0.9
27initialPlayerPos = vec2 0.5 0.1 35initialPlayerPos = vec2 0.5 0.1
28initialBallPos = vec2 0.5 0.5 36initialBallPos = vec2 0.5 0.5
29 37
30-- Game events 38-- Game events
31 39
@@ -40,13 +48,36 @@ data GameEvent
40 48
41data GameObject = GameObject 49data GameObject = GameObject
42 { aabb :: AABB2, 50 { aabb :: AABB2,
43 obj :: Obj2, 51 basis :: Transform2,
44 gostep :: Step [GameObject] [GameEvent] GameObject GameObject 52 gostep :: Step [GameObject] [GameEvent] GameObject GameObject
45 } 53 }
46 54
47instance Spatial2 GameObject where 55
48 getObj2 = obj 56instance Has2dTransform GameObject where
49 setObj2 s o = s {obj = o} 57 set2dTransform transform object = object { basis = transform }
58 transform2 = basis
59
60
61instance Positional GameObject Vector2 where
62 setPosition p = with2dTransform (setPosition p)
63 position = position . basis
64 translate v = with2dTransform (translate v)
65
66
67instance Rotational GameObject Vector2 Angle where
68 setRotation r = with2dTransform (setRotation r)
69 rotation = rotation . basis
70 rotate angle = with2dTransform (rotate angle)
71 right = right . basis
72 up = up . basis
73 forward = forward . basis
74 setForward v = with2dTransform (setForward v)
75
76
77instance Spatial GameObject Vector2 Angle Transform2 where
78 setTransform t obj = obj { basis = t }
79 transform = basis
80
50 81
51stepWorld :: Elapsed -> Dt -> [GameEvent] -> [GameObject] -> [GameObject] 82stepWorld :: Elapsed -> Dt -> [GameEvent] -> [GameObject] -> [GameObject]
52stepWorld elapsed dt evts gos = map (update elapsed dt evts gos) gos 83stepWorld elapsed dt evts gos = map (update elapsed dt evts gos) gos
@@ -60,13 +91,12 @@ ballBox, padBox :: AABB2
60ballBox = AABB2 (vec2 (-s) (-s)) (vec2 s s) where s = ballSize 91ballBox = AABB2 (vec2 (-s) (-s)) (vec2 s s) where s = ballSize
61padBox = AABB2 (-padSize) padSize 92padBox = AABB2 (-padSize) padSize
62 93
63obj2 = obj2FromVectors unitx2 unity2
64
65newWorld = 94newWorld =
66 [ GameObject ballBox (obj2 initialBallPos) $ stepBall initialBallVelocity, 95 [ GameObject ballBox (makeAt initialBallPos) $ stepBall initialBallVelocity,
67 GameObject padBox (obj2 initialEnemyPos) stepEnemy, 96 GameObject padBox (makeAt initialEnemyPos) stepEnemy,
68 GameObject padBox (obj2 initialPlayerPos) stepPlayer 97 GameObject padBox (makeAt initialPlayerPos) stepPlayer
69 ] 98 ]
99 where makeAt = newTransform2 unitx2 unity2
70 100
71-- Ball steppers 101-- Ball steppers
72 102
@@ -76,7 +106,7 @@ stepBall vel = collideBall vel .> moveBall
76-- ball when collision is detected. 106-- ball when collision is detected.
77collideBall :: Vector2 -> Step [GameObject] e GameObject (Vector2, GameObject) 107collideBall :: Vector2 -> Step [GameObject] e GameObject (Vector2, GameObject)
78collideBall vel = step $ \_ dt gos _ ball -> 108collideBall vel = step $ \_ dt gos _ ball ->
79 let (AABB2 pmin pmax) = aabb ball `aabbAdd` pos ball 109 let (AABB2 pmin pmax) = translate (position ball) (aabb ball)
80 collideSide = x pmin < 0 || x pmax > 1 110 collideSide = x pmin < 0 || x pmax > 1
81 collideBack = y pmin < 0 || y pmax > 1 111 collideBack = y pmin < 0 || y pmax > 1
82 collidePaddle = any (collide ball) (tail gos) 112 collidePaddle = any (collide ball) (tail gos)
@@ -84,18 +114,18 @@ collideBall vel = step $ \_ dt gos _ ball ->
84 flipY v@(Vector2 x y) = if collideBack then vec2 x (-y) else v 114 flipY v@(Vector2 x y) = if collideBack then vec2 x (-y) else v
85 vel' = normalise . (\v -> foldl (paddleBounce ball) v (tail gos)) . flipX . flipY $ vel 115 vel' = normalise . (\v -> foldl (paddleBounce ball) v (tail gos)) . flipX . flipY $ vel
86 -- A small delta to apply when collision occurs. 116 -- A small delta to apply when collision occurs.
87 delta = 1 + if collideSide || collideBack || collidePaddle then 2*dt else 0 117 delta = (1::Float) + if collideSide || collideBack || collidePaddle then (2::Float)*dt else (0::Float)
88 in ((scale ballSpeed (scale delta vel'), ball), collideBall vel') 118 in ((ballSpeed * delta * vel', ball), collideBall vel')
89 119
90paddleBounce :: GameObject -> Vector2 -> GameObject -> Vector2 120paddleBounce :: GameObject -> Vector2 -> GameObject -> Vector2
91paddleBounce ball v paddle = 121paddleBounce ball v paddle =
92 if collide ball paddle 122 if collide ball paddle
93 then 123 then
94 let (AABB2 pmin pmax) = aabb paddle `aabbAdd` pos paddle 124 let (AABB2 pmin pmax) = translate (position paddle) (aabb paddle)
95 center = (x pmin + x pmax) / 2 125 center = (x pmin + x pmax) / (2::Float)
96 -- Normalized offset of the ball from the paddle's center, [-1, +1]. 126 -- Normalized offset of the ball from the paddle's center, [-1, +1].
97 -- It's outside the [-1, +1] range if there is no collision. 127 -- It's outside the [-1, +1] range if there is no collision.
98 offset = (x (pos ball) - center) / ((x pmax - x pmin) / 2) 128 offset = (x (position ball) - center) / ((x pmax - x pmin) / (2::Float))
99 angle = offset * maxBounceAngle 129 angle = offset * maxBounceAngle
100 -- When it bounces off of a paddle, y vel is flipped. 130 -- When it bounces off of a paddle, y vel is flipped.
101 ysign = -(signum (y v)) 131 ysign = -(signum (y v))
@@ -105,19 +135,17 @@ paddleBounce ball v paddle =
105collide :: GameObject -> GameObject -> Bool 135collide :: GameObject -> GameObject -> Bool
106collide go1 go2 = 136collide go1 go2 =
107 let (AABB2 (Vector2 xmin1 ymin1) (Vector2 xmax1 ymax1)) = 137 let (AABB2 (Vector2 xmin1 ymin1) (Vector2 xmax1 ymax1)) =
108 aabb go1 `aabbAdd` pos go1 138 translate (position go1) (aabb go1)
109 (AABB2 (Vector2 xmin2 ymin2) (Vector2 xmax2 ymax2)) = 139 (AABB2 (Vector2 xmin2 ymin2) (Vector2 xmax2 ymax2)) =
110 aabb go2 `aabbAdd` pos go2 140 translate (position go2) (aabb go2)
111 in not $ 141 in not $
112 xmax1 < xmin2 142 xmax1 < xmin2
113 || xmin1 > xmax2 143 || xmin1 > xmax2
114 || ymax1 < ymin2 144 || ymax1 < ymin2
115 || ymin1 > ymax2 145 || ymin1 > ymax2
116 146
117aabbAdd (AABB2 pmin pmax) p = AABB2 (p + pmin) (p + pmax)
118
119moveBall :: Step s e (Vector2, GameObject) GameObject 147moveBall :: Step s e (Vector2, GameObject) GameObject
120moveBall = step $ \_ dt _ _ (vel, ball) -> (move (scale dt vel) ball, moveBall) 148moveBall = step $ \_ dt _ _ (vel, ball) -> (translate (vel * dt) ball, moveBall)
121 149
122-- Enemy stepper 150-- Enemy stepper
123 151
@@ -125,12 +153,13 @@ stepEnemy = movePad
125 153
126movePad :: Step s e GameObject GameObject 154movePad :: Step s e GameObject GameObject
127movePad = step $ \elapsed _ _ _ pad -> 155movePad = step $ \elapsed _ _ _ pad ->
128 let p = vec2 px 0.9 156 let enemyY = 0.9
157 p = vec2 px enemyY
129 px = 158 px =
130 double2Float (sin (elapsed * enemySpeed) * 0.5 + 0.5) 159 (sin (enemySpeed * elapsed) * (0.5::Float) + (0.5::Float))
131 * (1 - 2 * x padSize) 160 * ((1::Float) - (2::Float) * x padSize)
132 + x padSize 161 + x padSize
133 in (setPos p pad, movePad) 162 in (setPosition p pad, movePad)
134 163
135-- Player stepper 164-- Player stepper
136 165
@@ -138,20 +167,20 @@ stepPlayer = sfold moveGO .> clamp
138 167
139moveGO = 168moveGO =
140 mconcat 169 mconcat
141 [ switch StopLeft sid MoveLeft (moveGO' $ vec2 (-playerSpeed) 0), 170 [ switch StopLeft sid MoveLeft (moveGO' $ vec2 (-playerSpeed) 0),
142 switch StopRight sid MoveRight (moveGO' $ vec2 playerSpeed 0) 171 switch StopRight sid MoveRight (moveGO' $ vec2 playerSpeed 0)
143 ] 172 ]
144 173
145moveGO' :: Vector2 -> Step s e GameObject GameObject 174moveGO' :: Vector2 -> Step s e GameObject GameObject
146moveGO' dir = step $ \_ dt _ _ go -> (move (scale dt dir) go, moveGO' dir) 175moveGO' dir = step $ \_ dt _ _ go -> (translate (dir * dt) go, moveGO' dir)
147 176
148clamp :: Step s e GameObject GameObject 177clamp :: Step s e GameObject GameObject
149clamp = spure $ \go -> 178clamp = spure $ \go ->
150 let p' = vec2 (clamp' x s (1 - s)) y 179 let p' = vec2 (clamp' x s (1 - s)) y
151 (Vector2 x y) = pos go 180 (Vector2 x y) = position go
152 clamp' x a b 181 clamp' x a b
153 | x < a = a 182 | x < a = a
154 | x > b = b 183 | x > b = b
155 | otherwise = x 184 | otherwise = x
156 (Vector2 s _) = padSize 185 (Vector2 s _) = padSize
157 in setPos p' go 186 in setPosition p' go
diff --git a/Spear.cabal b/Spear.cabal
index 7025fcd..448f7f4 100644
--- a/Spear.cabal
+++ b/Spear.cabal
@@ -12,63 +12,68 @@ author: Marc Sunet
12data-dir: "" 12data-dir: ""
13 13
14library 14library
15 build-depends: GLFW-b -any, 15 build-depends:
16 OpenGL >= 3, 16 GLFW-b -any,
17 OpenGLRaw -any, 17 OpenGL >= 3,
18 StateVar -any, 18 OpenGLRaw -any,
19 base -any, 19 StateVar -any,
20 bytestring -any, 20 base -any,
21 directory -any, 21 bytestring -any,
22 exceptions -any, 22 directory -any,
23 mtl -any, 23 exceptions -any,
24 transformers -any, 24 mtl -any,
25 resourcet -any, 25 transformers -any,
26 parsec >= 3, 26 resourcet -any,
27 containers -any, 27 parsec >= 3,
28 vector -any, 28 containers -any,
29 array -any 29 vector -any,
30 array -any
30 31
31 exposed-modules: Spear.App 32 exposed-modules:
32 Spear.Assets.Image 33 Spear.App
33 Spear.Assets.Model 34 Spear.Assets.Image
34 Spear.Game 35 Spear.Assets.Model
35 Spear.GL 36 Spear.Game
36 Spear.Math.AABB 37 Spear.GL
37 Spear.Math.Camera 38 Spear.Math.AABB
38 Spear.Math.Circle 39 Spear.Math.Algebra
39 Spear.Math.Collision 40 Spear.Math.Camera
40 Spear.Math.Frustum 41 Spear.Math.Circle
41 Spear.Math.Matrix3 42 Spear.Math.Collision
42 Spear.Math.Matrix4 43 Spear.Math.Frustum
43 Spear.Math.MatrixUtils 44 Spear.Math.Matrix3
44 Spear.Math.Octree 45 Spear.Math.Matrix4
45 Spear.Math.Plane 46 Spear.Math.MatrixUtils
46 Spear.Math.Quaternion 47 Spear.Math.Octree
47 Spear.Math.Ray 48 Spear.Math.Plane
48 Spear.Math.Segment 49 Spear.Math.Quaternion
49 Spear.Math.Spatial2 50 Spear.Math.Ray
50 Spear.Math.Spatial3 51 Spear.Math.Segment
51 Spear.Math.Sphere 52 Spear.Math.Spatial
52 Spear.Math.Triangle 53 Spear.Math.Spatial2
53 Spear.Math.Utils 54 Spear.Math.Spatial3
54 Spear.Math.Vector 55 Spear.Math.Sphere
55 Spear.Math.Vector.Vector 56 Spear.Math.Triangle
56 Spear.Math.Vector.Vector2 57 Spear.Math.Utils
57 Spear.Math.Vector.Vector3 58 Spear.Math.Vector
58 Spear.Math.Vector.Vector4 59 Spear.Math.Vector.Vector
59 Spear.Render.AnimatedModel 60 Spear.Math.Vector.Vector2
60 Spear.Render.Material 61 Spear.Math.Vector.Vector3
61 Spear.Render.Model 62 Spear.Math.Vector.Vector4
62 Spear.Render.Program 63 Spear.Prelude
63 Spear.Render.StaticModel 64 Spear.Render.AnimatedModel
64 Spear.Scene.Graph 65 Spear.Render.Material
65 Spear.Scene.Loader 66 Spear.Render.Model
66 Spear.Scene.SceneResources 67 Spear.Render.Program
67 Spear.Step 68 Spear.Render.StaticModel
68 Spear.Sys.Store 69 Spear.Scene.Graph
69 Spear.Sys.Store.ID 70 Spear.Scene.Loader
70 Spear.Sys.Timer 71 Spear.Scene.SceneResources
71 Spear.Window 72 Spear.Step
73 Spear.Sys.Store
74 Spear.Sys.Store.ID
75 Spear.Sys.Timer
76 Spear.Window
72 77
73 exposed: True 78 exposed: True
74 79
@@ -87,28 +92,28 @@ library
87 Spear/Render/RenderModel.c 92 Spear/Render/RenderModel.c
88 Spear/Sys/Timer/ctimer.c 93 Spear/Sys/Timer/ctimer.c
89 94
90 extensions: TypeFamilies 95 includes:
96 Spear/Assets/Image/BMP/BMP_load.h
97 Spear/Assets/Image/Image.h
98 Spear/Assets/Image/Image_error_code.h
99 Spear/Assets/Image/sys_types.h
100 Spear/Assets/Model/MD2/MD2_load.h
101 Spear/Assets/Model/OBJ/OBJ_load.h
102 Spear/Assets/Model/OBJ/cvector.h
103 Spear/Assets/Model/Model.h
104 Spear/Assets/Model/Model_error_code.h
105 Spear/Assets/Model/sys_types.h
106 Spear/Render/RenderModel.h
107 Timer/Timer.h
91 108
92 includes: Spear/Assets/Image/BMP/BMP_load.h 109 include-dirs:
93 Spear/Assets/Image/Image.h 110 .
94 Spear/Assets/Image/Image_error_code.h 111 Spear
95 Spear/Assets/Image/sys_types.h 112 Spear/Assets/Image
96 Spear/Assets/Model/MD2/MD2_load.h 113 Spear/Assets/Image/BMP
97 Spear/Assets/Model/OBJ/OBJ_load.h 114 Spear/Assets/Model
98 Spear/Assets/Model/OBJ/cvector.h 115 Spear/Render
99 Spear/Assets/Model/Model.h 116 Spear/Sys
100 Spear/Assets/Model/Model_error_code.h
101 Spear/Assets/Model/sys_types.h
102 Spear/Render/RenderModel.h
103 Timer/Timer.h
104
105 include-dirs: .
106 Spear
107 Spear/Assets/Image
108 Spear/Assets/Image/BMP
109 Spear/Assets/Model
110 Spear/Render
111 Spear/Sys
112 117
113 hs-source-dirs: . 118 hs-source-dirs: .
114 119
diff --git a/Spear/GL.hs b/Spear/GL.hs
index 21ed9ec..81a433e 100644
--- a/Spear/GL.hs
+++ b/Spear/GL.hs
@@ -87,29 +87,32 @@ module Spear.GL
87 ) 87 )
88where 88where
89 89
90import Control.Monad 90import Control.Monad
91import Control.Monad.Trans.Class 91import Control.Monad.Trans.Class
92import Control.Monad.Trans.State as State 92import Control.Monad.Trans.State as State
93import qualified Data.ByteString.Char8 as B 93import qualified Data.ByteString.Char8 as B
94import Data.StateVar 94import Data.StateVar
95import Data.Word 95import Data.Word
96import Foreign.C.String 96import Foreign.C.String
97import Foreign.C.Types 97import Foreign.C.Types
98import Foreign.Marshal.Alloc (alloca) 98import Foreign.Marshal.Alloc (alloca)
99import Foreign.Marshal.Array (withArray) 99import Foreign.Marshal.Array (withArray)
100import Foreign.Marshal.Utils as Foreign (with) 100import Foreign.Marshal.Utils as Foreign (with)
101import Foreign.Ptr 101import Foreign.Ptr
102import Foreign.Storable 102import Foreign.Storable
103import Foreign.Storable (peek) 103import Foreign.Storable (peek)
104import Graphics.GL.Core46 104import Graphics.GL.Core46
105import Spear.Assets.Image 105import Prelude hiding ((*))
106import Spear.Game 106import Spear.Assets.Image
107import Spear.Math.Matrix3 (Matrix3) 107import Spear.Game
108import Spear.Math.Matrix4 (Matrix4) 108import Spear.Math.Algebra
109import Spear.Math.Vector 109import Spear.Math.Matrix3 (Matrix3)
110import System.Directory (doesFileExist, getCurrentDirectory, setCurrentDirectory) 110import Spear.Math.Matrix4 (Matrix4)
111import System.IO (hPutStrLn, stderr) 111import Spear.Math.Vector
112import Unsafe.Coerce 112import System.Directory (doesFileExist, getCurrentDirectory,
113 setCurrentDirectory)
114import System.IO (hPutStrLn, stderr)
115import Unsafe.Coerce
113 116
114-- 117--
115-- MANAGEMENT 118-- MANAGEMENT
@@ -117,7 +120,7 @@ import Unsafe.Coerce
117 120
118-- | A GLSL shader handle. 121-- | A GLSL shader handle.
119data GLSLShader = GLSLShader 122data GLSLShader = GLSLShader
120 { getShader :: GLuint, 123 { getShader :: GLuint,
121 getShaderKey :: Resource 124 getShaderKey :: Resource
122 } 125 }
123 126
@@ -126,7 +129,7 @@ instance ResourceClass GLSLShader where
126 129
127-- | A GLSL program handle. 130-- | A GLSL program handle.
128data GLSLProgram = GLSLProgram 131data GLSLProgram = GLSLProgram
129 { getProgram :: GLuint, 132 { getProgram :: GLuint,
130 getProgramKey :: Resource 133 getProgramKey :: Resource
131 } 134 }
132 135
@@ -137,7 +140,7 @@ instance ResourceClass GLSLProgram where
137data ShaderType = VertexShader | FragmentShader | GeometryShader deriving (Eq, Show) 140data ShaderType = VertexShader | FragmentShader | GeometryShader deriving (Eq, Show)
138 141
139toGLShader :: ShaderType -> GLenum 142toGLShader :: ShaderType -> GLenum
140toGLShader VertexShader = GL_VERTEX_SHADER 143toGLShader VertexShader = GL_VERTEX_SHADER
141toGLShader FragmentShader = GL_FRAGMENT_SHADER 144toGLShader FragmentShader = GL_FRAGMENT_SHADER
142toGLShader GeometryShader = GL_GEOMETRY_SHADER 145toGLShader GeometryShader = GL_GEOMETRY_SHADER
143 146
@@ -529,7 +532,7 @@ drawElements mode count t idxs = glDrawElements mode (unsafeCoerce count) t idxs
529-- | An OpenGL buffer. 532-- | An OpenGL buffer.
530data GLBuffer = GLBuffer 533data GLBuffer = GLBuffer
531 { getBuffer :: GLuint, 534 { getBuffer :: GLuint,
532 rkey :: Resource 535 rkey :: Resource
533 } 536 }
534 537
535instance ResourceClass GLBuffer where 538instance ResourceClass GLBuffer where
@@ -544,10 +547,10 @@ data TargetBuffer
544 deriving (Eq, Show) 547 deriving (Eq, Show)
545 548
546fromTarget :: TargetBuffer -> GLenum 549fromTarget :: TargetBuffer -> GLenum
547fromTarget ArrayBuffer = GL_ARRAY_BUFFER 550fromTarget ArrayBuffer = GL_ARRAY_BUFFER
548fromTarget ElementArrayBuffer = GL_ELEMENT_ARRAY_BUFFER 551fromTarget ElementArrayBuffer = GL_ELEMENT_ARRAY_BUFFER
549fromTarget PixelPackBuffer = GL_PIXEL_PACK_BUFFER 552fromTarget PixelPackBuffer = GL_PIXEL_PACK_BUFFER
550fromTarget PixelUnpackBuffer = GL_PIXEL_UNPACK_BUFFER 553fromTarget PixelUnpackBuffer = GL_PIXEL_UNPACK_BUFFER
551 554
552-- | A buffer usage. 555-- | A buffer usage.
553data BufferUsage 556data BufferUsage
@@ -563,12 +566,12 @@ data BufferUsage
563 deriving (Eq, Show) 566 deriving (Eq, Show)
564 567
565fromUsage :: BufferUsage -> GLenum 568fromUsage :: BufferUsage -> GLenum
566fromUsage StreamDraw = GL_STREAM_DRAW 569fromUsage StreamDraw = GL_STREAM_DRAW
567fromUsage StreamRead = GL_STREAM_READ 570fromUsage StreamRead = GL_STREAM_READ
568fromUsage StreamCopy = GL_STREAM_COPY 571fromUsage StreamCopy = GL_STREAM_COPY
569fromUsage StaticDraw = GL_STATIC_DRAW 572fromUsage StaticDraw = GL_STATIC_DRAW
570fromUsage StaticRead = GL_STATIC_READ 573fromUsage StaticRead = GL_STATIC_READ
571fromUsage StaticCopy = GL_STATIC_COPY 574fromUsage StaticCopy = GL_STATIC_COPY
572fromUsage DynamicDraw = GL_DYNAMIC_DRAW 575fromUsage DynamicDraw = GL_DYNAMIC_DRAW
573fromUsage DynamicRead = GL_DYNAMIC_READ 576fromUsage DynamicRead = GL_DYNAMIC_READ
574fromUsage DynamicCopy = GL_DYNAMIC_COPY 577fromUsage DynamicCopy = GL_DYNAMIC_COPY
@@ -780,7 +783,7 @@ getGLError = fmap translate glGetError
780printGLError :: IO () 783printGLError :: IO ()
781printGLError = 784printGLError =
782 getGLError >>= \err -> case err of 785 getGLError >>= \err -> case err of
783 Nothing -> return () 786 Nothing -> return ()
784 Just str -> hPutStrLn stderr str 787 Just str -> hPutStrLn stderr str
785 788
786-- | Run the given setup action and check for OpenGL errors. 789-- | Run the given setup action and check for OpenGL errors.
@@ -793,4 +796,4 @@ assertGL action err = do
793 status <- gameIO getGLError 796 status <- gameIO getGLError
794 case status of 797 case status of
795 Just str -> gameError $ "OpenGL error raised: " ++ err ++ "; " ++ str 798 Just str -> gameError $ "OpenGL error raised: " ++ err ++ "; " ++ str
796 Nothing -> return result 799 Nothing -> return result
diff --git a/Spear/Game.hs b/Spear/Game.hs
index c5b043b..e43974f 100644
--- a/Spear/Game.hs
+++ b/Spear/Game.hs
@@ -30,9 +30,9 @@ module Spear.Game
30 ) 30 )
31where 31where
32 32
33import Control.Monad.Catch 33import Control.Monad.Catch
34import Control.Monad.State.Strict 34import Control.Monad.State.Strict
35import Control.Monad.Trans.Class (lift) 35import Control.Monad.Trans.Class (lift)
36import qualified Control.Monad.Trans.Resource as R 36import qualified Control.Monad.Trans.Resource as R
37 37
38type Resource = R.ReleaseKey 38type Resource = R.ReleaseKey
@@ -83,7 +83,7 @@ gameError' = lift . lift . throwM
83-- | Throw the given error if given 'Nothing'. 83-- | Throw the given error if given 'Nothing'.
84assertMaybe :: Maybe a -> GameException -> Game s a 84assertMaybe :: Maybe a -> GameException -> Game s a
85assertMaybe Nothing err = gameError' err 85assertMaybe Nothing err = gameError' err
86assertMaybe (Just x) _ = return x 86assertMaybe (Just x) _ = return x
87 87
88-- | Run the given game with the given error handler. 88-- | Run the given game with the given error handler.
89catchGameError :: Game s a -> (GameException -> Game s a) -> Game s a 89catchGameError :: Game s a -> (GameException -> Game s a) -> Game s a
diff --git a/Spear/Math/AABB.hs b/Spear/Math/AABB.hs
index de3b1a4..ab51ec9 100644
--- a/Spear/Math/AABB.hs
+++ b/Spear/Math/AABB.hs
@@ -1,3 +1,7 @@
1{-# LANGUAGE MultiParamTypeClasses #-}
2{-# LANGUAGE NoImplicitPrelude #-}
3{-# LANGUAGE TypeFamilies #-}
4
1module Spear.Math.AABB 5module Spear.Math.AABB
2( 6(
3 AABB2(..) 7 AABB2(..)
@@ -9,9 +13,12 @@ module Spear.Math.AABB
9) 13)
10where 14where
11 15
12import Spear.Math.Vector 16import Spear.Math.Spatial
17import Spear.Math.Vector
18import Spear.Prelude
19
20import Data.List (foldl')
13 21
14import Data.List (foldl')
15 22
16-- | An axis-aligned bounding box in 2D space. 23-- | An axis-aligned bounding box in 2D space.
17data AABB2 = AABB2 {-# UNPACK #-} !Vector2 {-# UNPACK #-} !Vector2 deriving Show 24data AABB2 = AABB2 {-# UNPACK #-} !Vector2 {-# UNPACK #-} !Vector2 deriving Show
@@ -19,17 +26,28 @@ data AABB2 = AABB2 {-# UNPACK #-} !Vector2 {-# UNPACK #-} !Vector2 deriving Show
19-- | An axis-aligned bounding box in 3D space. 26-- | An axis-aligned bounding box in 3D space.
20data AABB3 = AABB3 {-# UNPACK #-} !Vector3 {-# UNPACK #-} !Vector3 deriving Show 27data AABB3 = AABB3 {-# UNPACK #-} !Vector3 {-# UNPACK #-} !Vector3 deriving Show
21 28
29
30instance Positional AABB2 Vector2 where
31 setPosition p (AABB2 pmin pmax) = AABB2 p (p + (pmax - pmin))
32 position (AABB2 pmin pmax) = pmin
33 translate p (AABB2 pmin pmax) = AABB2 (p + pmin) (p + pmax)
34
35
36instance Positional AABB3 Vector3 where
37 setPosition p (AABB3 pmin pmax) = AABB3 p (p + (pmax - pmin))
38 position (AABB3 pmin pmax) = pmin
39 translate p (AABB3 pmin pmax) = AABB3 (p + pmin) (p + pmax)
40
41
22-- | Create a AABB from the given points. 42-- | Create a AABB from the given points.
23aabb2 :: [Vector2] -> AABB2 43aabb2 :: [Vector2] -> AABB2
24aabb2 [] = AABB2 zero2 zero2 44aabb2 = foldl' union (AABB2 zero2 zero2)
25aabb2 (x:xs) = foldl' update (AABB2 x x) xs 45 where union (AABB2 pmin pmax) p = AABB2 (min p pmin) (max p pmax)
26 where update (AABB2 pmin pmax) p = AABB2 (min p pmin) (max p pmax)
27 46
28-- | Create an AABB from the given points. 47-- | Create an AABB from the given points.
29aabb3 :: [Vector3] -> AABB3 48aabb3 :: [Vector3] -> AABB3
30aabb3 [] = AABB3 zero3 zero3 49aabb3 = foldl' union (AABB3 zero3 zero3)
31aabb3 (x:xs) = foldl' update (AABB3 x x) xs 50 where union (AABB3 pmin pmax) p = AABB3 (min p pmin) (max p pmax)
32 where update (AABB3 pmin pmax) p = AABB3 (min p pmin) (max p pmax)
33 51
34-- | Return 'True' if the given AABB contains the given point, 'False' otherwise. 52-- | Return 'True' if the given AABB contains the given point, 'False' otherwise.
35aabb2pt :: AABB2 -> Vector2 -> Bool 53aabb2pt :: AABB2 -> Vector2 -> Bool
diff --git a/Spear/Math/Algebra.hs b/Spear/Math/Algebra.hs
new file mode 100644
index 0000000..f6f8938
--- /dev/null
+++ b/Spear/Math/Algebra.hs
@@ -0,0 +1,102 @@
1{-# LANGUAGE FlexibleContexts #-}
2{-# LANGUAGE FunctionalDependencies #-}
3{-# LANGUAGE TypeFamilies #-}
4
5module Spear.Math.Algebra
6where
7
8import Foreign.C.Types
9import Prelude hiding ((*), (+), (-), (/))
10import qualified Prelude as P
11
12
13-- | General addition.
14class Addition a b where
15 infixl 6 +
16 (+) :: a -> b -> a
17
18-- | General subtraction.
19class Subtraction a b where
20 infixl 6 -
21 (-) :: a -> b -> a
22
23-- | General multiplication.
24class Product a b c | a b -> c where
25 infixl 7 *
26 (*) :: a -> b -> c
27
28-- | General division.
29class Quotient a b where
30 infixl 7 /
31 (/) :: a -> b -> a
32
33-- -- Commutative addition.
34-- class CommutativeAddition a b
35
36-- -- Commutative product.
37-- class CommutativeProduct a b
38
39
40-- Convenient definitions so that we can again use operators on scalars simply.
41instance Addition Int Int where (+) = (P.+)
42instance Addition Float Float where (+) = (P.+)
43instance Addition Double Double where (+) = (P.+)
44instance Addition CUInt CUInt where (+) = (P.+)
45
46instance Subtraction Int Int where (-) = (P.-)
47instance Subtraction Float Float where (-) = (P.-)
48instance Subtraction Double Double where (-) = (P.-)
49
50instance Product Int Int Int where (*) = (P.*)
51instance Product Float Float Float where (*) = (P.*)
52instance Product Double Double Double where (*) = (P.*)
53instance Product CUInt CUInt CUInt where (*) = (P.*)
54
55instance Quotient Int Int where (/) = P.div
56instance Quotient Float Float where (/) = (P./)
57instance Quotient Double Double where (/) = (P./)
58
59
60-- These definitions help in the implementations of Num. Num is needed if we
61-- want syntactic negation for a type.
62add :: Addition a a => a -> a -> a
63add a b = a + b
64
65sub :: Subtraction a a => a -> a -> a
66sub a b = a - b
67
68mul :: Product a a a => a -> a -> a
69mul a b = a * b
70
71div :: Quotient a a => a -> a -> a
72div a b = a / b
73
74
75{- instance Num a => Addition a a where
76 (+) = (P.+)
77
78instance Num a => Subtraction a a where
79 (-) = (P.+)
80
81instance Num a => Product a a where
82 type Prod a a = a
83
84 (*) = (P.*)
85
86instance Fractional a => Quotient a a where
87 (/) = (P./) -}
88
89
90-- instance Quotient Int Int where (/) = div
91
92-- instance (Addition a b c, CommutativeAddition a b) => Addition b a c where
93-- b + a = a + b
94
95-- instance (Product a b c, CommutativeProduct a b) => Product b a c where
96-- b * a = a * b
97
98-- instance Num a => CommutativeAddition a a
99-- instance Num a => CommutativeProduct a a
100
101
102lerp a b t = a + t * (b - a)
diff --git a/Spear/Math/Camera.hs b/Spear/Math/Camera.hs
index 220c435..030846a 100644
--- a/Spear/Math/Camera.hs
+++ b/Spear/Math/Camera.hs
@@ -1,3 +1,5 @@
1{-# LANGUAGE MultiParamTypeClasses #-}
2
1module Spear.Math.Camera 3module Spear.Math.Camera
2( 4(
3 Camera 5 Camera
@@ -15,27 +17,52 @@ module Spear.Math.Camera
15) 17)
16where 18where
17 19
18import qualified Spear.Math.Matrix4 as M 20import qualified Spear.Math.Matrix4 as M
19import Spear.Math.Spatial3 21import Spear.Math.Spatial
20import Spear.Math.Vector 22import Spear.Math.Spatial3
23import Spear.Math.Vector
24
21 25
22data Camera = Camera 26data Camera = Camera
23 { projection :: M.Matrix4 -- ^ Get the camera's projection. 27 { projection :: M.Matrix4 -- ^ Get the camera's projection.
24 , spatial :: Obj3 28 , basis :: Transform3
25 } 29 }
26 30
27instance Spatial3 Camera where
28 getObj3 = spatial
29 setObj3 cam o = cam { spatial = o }
30 31
31type Fovy = Float 32instance Has3dTransform Camera where
33 set3dTransform transform camera = camera { basis = transform }
34 transform3 = basis
35
36
37instance Positional Camera Vector3 where
38 setPosition p = with3dTransform (setPosition p)
39 position = position . basis
40 translate v = with3dTransform (translate v)
41
42
43instance Rotational Camera Vector3 Rotation3 where
44 setRotation rotation = with3dTransform (setRotation rotation)
45 rotation = rotation . basis
46 rotate rot = with3dTransform (rotate rot)
47 right = right . basis
48 up = up . basis
49 forward = forward . basis
50 setForward forward = with3dTransform (setForward forward)
51
52
53instance Spatial Camera Vector3 Rotation3 Transform3 where
54 setTransform transform camera = camera { basis = transform }
55 transform = basis
56
57
58type Fovy = Float
32type Aspect = Float 59type Aspect = Float
33type Near = Float 60type Near = Float
34type Far = Float 61type Far = Float
35type Left = Float 62type Left = Float
36type Right = Float 63type Right = Float
37type Bottom = Float 64type Bottom = Float
38type Top = Float 65type Top = Float
39 66
40-- | Build a perspective camera. 67-- | Build a perspective camera.
41perspective :: Fovy -- ^ Fovy - Vertical field of view angle in degrees. 68perspective :: Fovy -- ^ Fovy - Vertical field of view angle in degrees.
@@ -47,14 +74,12 @@ perspective :: Fovy -- ^ Fovy - Vertical field of view angle in degrees.
47 -> Forward3 -- ^ Forward vector. 74 -> Forward3 -- ^ Forward vector.
48 -> Position3 -- ^ Position vector. 75 -> Position3 -- ^ Position vector.
49 -> Camera 76 -> Camera
50
51perspective fovy r n f right up fwd pos = 77perspective fovy r n f right up fwd pos =
52 Camera 78 Camera
53 { projection = M.perspective fovy r n f 79 { projection = M.perspective fovy r n f
54 , spatial = fromVectors right up fwd pos 80 , basis = newTransform3 right up fwd pos
55 } 81 }
56 82
57
58-- | Build an orthogonal camera. 83-- | Build an orthogonal camera.
59ortho :: Left -- ^ Left. 84ortho :: Left -- ^ Left.
60 -> Right -- ^ Right. 85 -> Right -- ^ Right.
@@ -67,9 +92,8 @@ ortho :: Left -- ^ Left.
67 -> Forward3 -- ^ Forward vector. 92 -> Forward3 -- ^ Forward vector.
68 -> Position3 -- ^ Position vector. 93 -> Position3 -- ^ Position vector.
69 -> Camera 94 -> Camera
70
71ortho l r b t n f right up fwd pos = 95ortho l r b t n f right up fwd pos =
72 Camera 96 Camera
73 { projection = M.ortho l r b t n f 97 { projection = M.ortho l r b t n f
74 , spatial = fromVectors right up fwd pos 98 , basis = newTransform3 right up fwd pos
75 } 99 }
diff --git a/Spear/Math/Circle.hs b/Spear/Math/Circle.hs
index e4a9bb6..be17666 100644
--- a/Spear/Math/Circle.hs
+++ b/Spear/Math/Circle.hs
@@ -1,9 +1,18 @@
1{-# LANGUAGE MultiParamTypeClasses #-}
2{-# LANGUAGE NoImplicitPrelude #-}
3{-# LANGUAGE TypeFamilies #-}
4
1module Spear.Math.Circle 5module Spear.Math.Circle
2where 6where
3 7
4import Spear.Math.Vector 8import Spear.Math.Algebra
9import Spear.Math.Vector
10import Spear.Prelude
11
12import Data.List (foldl')
13import Spear.Math.Spatial
14import Spear.Math.Spatial2
5 15
6import Data.List (foldl')
7 16
8-- | A circle in 2D space. 17-- | A circle in 2D space.
9data Circle = Circle 18data Circle = Circle
@@ -11,12 +20,19 @@ data Circle = Circle
11 , radius :: {-# UNPACK #-} !Float 20 , radius :: {-# UNPACK #-} !Float
12 } 21 }
13 22
23
24instance Positional Circle Vector2 where
25 setPosition p circle = circle { center = p }
26 position = center
27 translate v circle = circle { center = center circle + v}
28
29
14-- | Create a circle from the given points. 30-- | Create a circle from the given points.
15circle :: [Vector2] -> Circle 31circle :: [Vector2] -> Circle
16circle [] = Circle zero2 0 32circle [] = Circle zero2 0
17circle (x:xs) = Circle c r 33circle (x:xs) = Circle c r
18 where 34 where
19 c = pmin + (pmax-pmin)/2 35 c = pmin + (pmax-pmin) / (2::Float)
20 r = norm $ pmax - c 36 r = norm $ pmax - c
21 (pmin,pmax) = foldl' update (x,x) xs 37 (pmin,pmax) = foldl' update (x,x) xs
22 update (pmin,pmax) p = (min p pmin, max p pmax) 38 update (pmin,pmax) p = (min p pmin, max p pmax)
diff --git a/Spear/Math/Collision.hs b/Spear/Math/Collision.hs
index a69ea7a..4412b10 100644
--- a/Spear/Math/Collision.hs
+++ b/Spear/Math/Collision.hs
@@ -1,3 +1,5 @@
1{-# LANGUAGE NoImplicitPrelude #-}
2
1module Spear.Math.Collision 3module Spear.Math.Collision
2( 4(
3 CollisionType(..) 5 CollisionType(..)
@@ -23,15 +25,17 @@ module Spear.Math.Collision
23) 25)
24where 26where
25 27
26import Spear.Assets.Model 28import Spear.Assets.Model
27import Spear.Math.AABB 29import Spear.Math.AABB
28import Spear.Math.Circle 30import Spear.Math.Algebra
31import Spear.Math.Circle
29import qualified Spear.Math.Matrix4 as M4 32import qualified Spear.Math.Matrix4 as M4
30import Spear.Math.Plane 33import Spear.Math.Plane
31import Spear.Math.Sphere 34import Spear.Math.Sphere
32import Spear.Math.Vector 35import Spear.Math.Vector
36import Spear.Prelude
33 37
34import Data.List (foldl') 38import Data.List (foldl')
35 39
36data CollisionType = NoCollision | Collision | FullyContains | FullyContainedBy 40data CollisionType = NoCollision | Collision | FullyContains | FullyContainedBy
37 deriving (Eq, Show) 41 deriving (Eq, Show)
@@ -39,7 +43,6 @@ data CollisionType = NoCollision | Collision | FullyContains | FullyContainedBy
39-- 2D collision 43-- 2D collision
40 44
41class Collisionable2 a where 45class Collisionable2 a where
42
43 -- | Collide the object with an AABB. 46 -- | Collide the object with an AABB.
44 collideAABB2 :: AABB2 -> a -> CollisionType 47 collideAABB2 :: AABB2 -> a -> CollisionType
45 48
@@ -47,7 +50,6 @@ class Collisionable2 a where
47 collideCircle :: Circle -> a -> CollisionType 50 collideCircle :: Circle -> a -> CollisionType
48 51
49instance Collisionable2 AABB2 where 52instance Collisionable2 AABB2 where
50
51 collideAABB2 box1@(AABB2 min1 max1) box2@(AABB2 min2 max2) 53 collideAABB2 box1@(AABB2 min1 max1) box2@(AABB2 min2 max2)
52 | (x max1) < (x min2) = NoCollision 54 | (x max1) < (x min2) = NoCollision
53 | (x min1) > (x max2) = NoCollision 55 | (x min1) > (x max2) = NoCollision
@@ -63,15 +65,14 @@ instance Collisionable2 AABB2 where
63 | otherwise = Collision 65 | otherwise = Collision
64 where 66 where
65 test = collideAABB2 aabb $ aabb2FromCircle circle 67 test = collideAABB2 aabb $ aabb2FromCircle circle
66 boxC = min + (max-min)/2 68 boxC = min + (max-min) / (2::Float)
67 l = norm $ min + (vec2 (x boxC) (y min)) - min 69 l = norm $ min + (vec2 (x boxC) (y min)) - min
68 70
69instance Collisionable2 Circle where 71instance Collisionable2 Circle where
70
71 collideAABB2 box circle = case collideCircle circle box of 72 collideAABB2 box circle = case collideCircle circle box of
72 FullyContains -> FullyContainedBy 73 FullyContains -> FullyContainedBy
73 FullyContainedBy -> FullyContains 74 FullyContainedBy -> FullyContains
74 x -> x 75 x -> x
75 76
76 collideCircle s1@(Circle c1 r1) s2@(Circle c2 r2) 77 collideCircle s1@(Circle c1 r1) s2@(Circle c2 r2)
77 | distance_centers <= sub_radii = if (r1 > r2) then FullyContains else FullyContainedBy 78 | distance_centers <= sub_radii = if (r1 > r2) then FullyContains else FullyContainedBy
@@ -83,13 +84,13 @@ instance Collisionable2 Circle where
83 sub_radii = (r1 - r2)^2 84 sub_radii = (r1 - r2)^2
84 85
85instance Collisionable2 Collisioner2 where 86instance Collisionable2 Collisioner2 where
86
87 collideAABB2 box (AABB2Col self) = collideAABB2 box self 87 collideAABB2 box (AABB2Col self) = collideAABB2 box self
88 collideAABB2 box (CircleCol self) = collideAABB2 box self 88 collideAABB2 box (CircleCol self) = collideAABB2 box self
89 89
90 collideCircle circle (AABB2Col self) = collideCircle circle self 90 collideCircle circle (AABB2Col self) = collideCircle circle self
91 collideCircle circle (CircleCol self) = collideCircle circle self 91 collideCircle circle (CircleCol self) = collideCircle circle self
92 92
93
93aabbPoints :: AABB2 -> [Vector2] 94aabbPoints :: AABB2 -> [Vector2]
94aabbPoints (AABB2 min max) = [p1,p2,p3,p4,p5,p6,p7,p8] 95aabbPoints (AABB2 min max) = [p1,p2,p3,p4,p5,p6,p7,p8]
95 where 96 where
@@ -142,15 +143,15 @@ buildAABB2 cols = aabb2 $ generatePoints cols
142aabb2FromCircle :: Circle -> AABB2 143aabb2FromCircle :: Circle -> AABB2
143aabb2FromCircle (Circle c r) = AABB2 bot top 144aabb2FromCircle (Circle c r) = AABB2 bot top
144 where 145 where
145 bot = c - (vec2 r r) 146 bot = c - vec2 r r
146 top = c + (vec2 r r) 147 top = c + vec2 r r
147 148
148-- | Create the minimal circle fully containing the specified box. 149-- | Create the minimal circle fully containing the specified box.
149circleFromAABB2 :: AABB2 -> Circle 150circleFromAABB2 :: AABB2 -> Circle
150circleFromAABB2 (AABB2 min max) = Circle c r 151circleFromAABB2 (AABB2 min max) = Circle c r
151 where 152 where
152 c = scale 0.5 (min + max) 153 c = (0.5::Float) * (min + max)
153 r = norm . scale 0.5 $ max - min 154 r = norm . (*(0.5::Float)) $ max - min
154 155
155generatePoints :: [Collisioner2] -> [Vector2] 156generatePoints :: [Collisioner2] -> [Vector2]
156generatePoints = foldl' generate [] 157generatePoints = foldl' generate []
@@ -168,10 +169,10 @@ generatePoints = foldl' generate []
168 169
169 generate acc (CircleCol (Circle c r)) = p1:p2:p3:p4:acc 170 generate acc (CircleCol (Circle c r)) = p1:p2:p3:p4:acc
170 where 171 where
171 p1 = c + unitx2 * (vec2 r r) 172 p1 = c + unitx2 * vec2 r r
172 p2 = c - unitx2 * (vec2 r r) 173 p2 = c - unitx2 * vec2 r r
173 p3 = c + unity2 * (vec2 r r) 174 p3 = c + unity2 * vec2 r r
174 p4 = c - unity2 * (vec2 r r) 175 p4 = c - unity2 * vec2 r r
175 176
176-- | Collide the given collisioners. 177-- | Collide the given collisioners.
177collide :: Collisioner2 -> Collisioner2 -> CollisionType 178collide :: Collisioner2 -> Collisioner2 -> CollisionType
@@ -183,13 +184,11 @@ collide (CircleCol circle) (AABB2Col box) = collideCircle circle box
183-- | Move the collisioner. 184-- | Move the collisioner.
184move :: Vector2 -> Collisioner2 -> Collisioner2 185move :: Vector2 -> Collisioner2 -> Collisioner2
185move v (AABB2Col (AABB2 min max)) = AABB2Col (AABB2 (min+v) (max+v)) 186move v (AABB2Col (AABB2 min max)) = AABB2Col (AABB2 (min+v) (max+v))
186move v (CircleCol (Circle c r)) = CircleCol (Circle (c+v) r) 187move v (CircleCol (Circle c r)) = CircleCol (Circle (c+v) r)
187
188 188
189-- 3D collision
190 189
190-- | 3D collision
191class Collisionable3 a where 191class Collisionable3 a where
192
193 -- | Collide the object with an AABB. 192 -- | Collide the object with an AABB.
194 collideAABB3 :: AABB3 -> a -> CollisionType 193 collideAABB3 :: AABB3 -> a -> CollisionType
195 194
@@ -197,12 +196,11 @@ class Collisionable3 a where
197 collideSphere :: Sphere -> a -> CollisionType 196 collideSphere :: Sphere -> a -> CollisionType
198 197
199instance Collisionable3 AABB3 where 198instance Collisionable3 AABB3 where
200
201 collideAABB3 box1@(AABB3 min1 max1) box2@(AABB3 min2 max2) 199 collideAABB3 box1@(AABB3 min1 max1) box2@(AABB3 min2 max2)
202 | (x max1) < (x min2) = NoCollision 200 | x max1 < x min2 = NoCollision
203 | (x min1) > (x max2) = NoCollision 201 | x min1 > x max2 = NoCollision
204 | (y max1) < (y min2) = NoCollision 202 | y max1 < y min2 = NoCollision
205 | (y min1) > (y max2) = NoCollision 203 | y min1 > y max2 = NoCollision
206 | box1 `aabb3pt` min2 && box1 `aabb3pt` max2 = FullyContains 204 | box1 `aabb3pt` min2 && box1 `aabb3pt` max2 = FullyContains
207 | box2 `aabb3pt` min1 && box2 `aabb3pt` max1 = FullyContainedBy 205 | box2 `aabb3pt` min1 && box2 `aabb3pt` max1 = FullyContainedBy
208 | otherwise = Collision 206 | otherwise = Collision
@@ -215,18 +213,17 @@ instance Collisionable3 AABB3 where
215 test = collideAABB3 aabb $ aabb3FromSphere sphere 213 test = collideAABB3 aabb $ aabb3FromSphere sphere
216 boxC = min + v 214 boxC = min + v
217 l = norm v 215 l = norm v
218 v = (max-min)/2 216 v = (max-min) / (2::Float)
219 217
220instance Collisionable3 Sphere where 218instance Collisionable3 Sphere where
221
222 collideAABB3 box sphere = case collideSphere sphere box of 219 collideAABB3 box sphere = case collideSphere sphere box of
223 FullyContains -> FullyContainedBy 220 FullyContains -> FullyContainedBy
224 FullyContainedBy -> FullyContains 221 FullyContainedBy -> FullyContains
225 x -> x 222 x -> x
226 223
227 collideSphere s1@(Sphere c1 r1) s2@(Sphere c2 r2) 224 collideSphere s1@(Sphere c1 r1) s2@(Sphere c2 r2)
228 | distance_centers <= sub_radii = 225 | distance_centers <= sub_radii =
229 if (r1 > r2) then FullyContains else FullyContainedBy 226 if r1 > r2 then FullyContains else FullyContainedBy
230 | distance_centers <= sum_radii = Collision 227 | distance_centers <= sum_radii = Collision
231 | otherwise = NoCollision 228 | otherwise = NoCollision
232 where 229 where
@@ -238,5 +235,5 @@ instance Collisionable3 Sphere where
238aabb3FromSphere :: Sphere -> AABB3 235aabb3FromSphere :: Sphere -> AABB3
239aabb3FromSphere (Sphere c r) = AABB3 bot top 236aabb3FromSphere (Sphere c r) = AABB3 bot top
240 where 237 where
241 bot = c - (vec3 r r r) 238 bot = c - vec3 r r r
242 top = c + (vec3 r r r) \ No newline at end of file 239 top = c + vec3 r r r
diff --git a/Spear/Math/Matrix3.hs b/Spear/Math/Matrix3.hs
index 7526827..c8ed6d2 100644
--- a/Spear/Math/Matrix3.hs
+++ b/Spear/Math/Matrix3.hs
@@ -1,3 +1,7 @@
1{-# LANGUAGE MultiParamTypeClasses #-}
2{-# LANGUAGE NoImplicitPrelude #-}
3{-# LANGUAGE TypeFamilies #-}
4
1module Spear.Math.Matrix3 5module Spear.Math.Matrix3
2( 6(
3 Matrix3 7 Matrix3
@@ -8,6 +12,7 @@ module Spear.Math.Matrix3
8, col0, col1, col2 12, col0, col1, col2
9, row0, row1, row2 13, row0, row1, row2
10, right, up, forward, position 14, right, up, forward, position
15, setRight, setUp, setForward, setPosition
11 -- * Construction 16 -- * Construction
12, mat3 17, mat3
13, mat3fromVec 18, mat3fromVec
@@ -17,8 +22,8 @@ module Spear.Math.Matrix3
17, Spear.Math.Matrix3.id 22, Spear.Math.Matrix3.id
18 -- * Transformations 23 -- * Transformations
19 -- ** Translation 24 -- ** Translation
20, transl 25, translate
21, translv 26, translatev
22 -- ** Rotation 27 -- ** Rotation
23, rot 28, rot
24 -- ** Scale 29 -- ** Scale
@@ -39,10 +44,11 @@ module Spear.Math.Matrix3
39) 44)
40where 45where
41 46
47import Spear.Math.Algebra hiding (mul)
48import Spear.Math.Vector
49import Spear.Prelude hiding (mul)
42 50
43import Spear.Math.Vector 51import Foreign.Storable
44
45import Foreign.Storable
46 52
47 53
48-- | Represents a 3x3 column major matrix. 54-- | Represents a 3x3 column major matrix.
@@ -54,7 +60,6 @@ data Matrix3 = Matrix3
54 60
55 61
56instance Show Matrix3 where 62instance Show Matrix3 where
57
58 show (Matrix3 m00 m10 m20 m01 m11 m21 m02 m12 m22) = 63 show (Matrix3 m00 m10 m20 m01 m11 m21 m02 m12 m22) =
59 show' m00 ++ ", " ++ show' m10 ++ ", " ++ show' m20 ++ "\n" ++ 64 show' m00 ++ ", " ++ show' m10 ++ ", " ++ show' m20 ++ "\n" ++
60 show' m01 ++ ", " ++ show' m11 ++ ", " ++ show' m21 ++ "\n" ++ 65 show' m01 ++ ", " ++ show' m11 ++ ", " ++ show' m21 ++ "\n" ++
@@ -63,53 +68,51 @@ instance Show Matrix3 where
63 show' f = if abs f < 0.0000001 then "0" else show f 68 show' f = if abs f < 0.0000001 then "0" else show f
64 69
65 70
66instance Num Matrix3 where 71instance Addition Matrix3 Matrix3 where
67 (Matrix3 a00 a01 a02 a03 a04 a05 a06 a07 a08) 72 (Matrix3 a00 a01 a02 a03 a04 a05 a06 a07 a08)
68 + (Matrix3 b00 b01 b02 b03 b04 b05 b06 b07 b08) 73 + (Matrix3 b00 b01 b02 b03 b04 b05 b06 b07 b08)
69 = Matrix3 (a00 + b00) (a01 + b01) (a02 + b02) 74 = Matrix3 (a00 + b00) (a01 + b01) (a02 + b02)
70 (a03 + b03) (a04 + b04) (a05 + b05) 75 (a03 + b03) (a04 + b04) (a05 + b05)
71 (a06 + b06) (a07 + b07) (a08 + b08) 76 (a06 + b06) (a07 + b07) (a08 + b08)
72 77
78
79instance Subtraction Matrix3 Matrix3 where
73 (Matrix3 a00 a01 a02 a03 a04 a05 a06 a07 a08) 80 (Matrix3 a00 a01 a02 a03 a04 a05 a06 a07 a08)
74 - (Matrix3 b00 b01 b02 b03 b04 b05 b06 b07 b08) 81 - (Matrix3 b00 b01 b02 b03 b04 b05 b06 b07 b08)
75 = Matrix3 (a00 - b00) (a01 - b01) (a02 - b02) 82 = Matrix3 (a00 - b00) (a01 - b01) (a02 - b02)
76 (a03 - b03) (a04 - b04) (a05 - b05) 83 (a03 - b03) (a04 - b04) (a05 - b05)
77 (a06 - b06) (a07 - b07) (a08 - b08) 84 (a06 - b06) (a07 - b07) (a08 - b08)
78 85
86
87instance Product Matrix3 Matrix3 Matrix3 where
79 (Matrix3 a00 a10 a20 a01 a11 a21 a02 a12 a22) 88 (Matrix3 a00 a10 a20 a01 a11 a21 a02 a12 a22)
80 * (Matrix3 b00 b10 b20 b01 b11 b21 b02 b12 b22) 89 * (Matrix3 b00 b10 b20 b01 b11 b21 b02 b12 b22)
81 = Matrix3 (a00 * b00 + a10 * b01 + a20 * b02) 90 = Matrix3 (a00 * b00 + a10 * b01 + a20 * b02)
82 (a00 * b10 + a10 * b11 + a20 * b12) 91 (a00 * b10 + a10 * b11 + a20 * b12)
83 (a00 * b20 + a10 * b21 + a20 * b22) 92 (a00 * b20 + a10 * b21 + a20 * b22)
84 93
85 (a01 * b00 + a11 * b01 + a21 * b02) 94 (a01 * b00 + a11 * b01 + a21 * b02)
86 (a01 * b10 + a11 * b11 + a21 * b12) 95 (a01 * b10 + a11 * b11 + a21 * b12)
87 (a01 * b20 + a11 * b21 + a21 * b22) 96 (a01 * b20 + a11 * b21 + a21 * b22)
88 97
89 (a02 * b00 + a12 * b01 + a22 * b02) 98 (a02 * b00 + a12 * b01 + a22 * b02)
90 (a02 * b10 + a12 * b11 + a22 * b12) 99 (a02 * b10 + a12 * b11 + a22 * b12)
91 (a02 * b20 + a12 * b21 + a22 * b22) 100 (a02 * b20 + a12 * b21 + a22 * b22)
92 101
93 abs = Spear.Math.Matrix3.map abs 102
94
95 signum = Spear.Math.Matrix3.map signum
96
97 fromInteger i = mat3 i' i' i' i' i' i' i' i' i' where i' = fromInteger i
98
99
100instance Storable Matrix3 where 103instance Storable Matrix3 where
101 sizeOf _ = 36 104 sizeOf _ = 36
102 alignment _ = 4 105 alignment _ = 4
103 106
104 peek ptr = do 107 peek ptr = do
105 a00 <- peekByteOff ptr 0; a01 <- peekByteOff ptr 4; a02 <- peekByteOff ptr 8; 108 a00 <- peekByteOff ptr 0; a01 <- peekByteOff ptr 4; a02 <- peekByteOff ptr 8;
106 a10 <- peekByteOff ptr 12; a11 <- peekByteOff ptr 16; a12 <- peekByteOff ptr 20; 109 a10 <- peekByteOff ptr 12; a11 <- peekByteOff ptr 16; a12 <- peekByteOff ptr 20;
107 a20 <- peekByteOff ptr 24; a21 <- peekByteOff ptr 28; a22 <- peekByteOff ptr 32; 110 a20 <- peekByteOff ptr 24; a21 <- peekByteOff ptr 28; a22 <- peekByteOff ptr 32;
108 111
109 return $ Matrix3 a00 a10 a20 112 return $ Matrix3 a00 a10 a20
110 a01 a11 a21 113 a01 a11 a21
111 a02 a12 a22 114 a02 a12 a22
112 115
113 poke ptr (Matrix3 a00 a01 a02 116 poke ptr (Matrix3 a00 a01 a02
114 a10 a11 a12 117 a10 a11 a12
115 a20 a21 a22) = do 118 a20 a21 a22) = do
@@ -122,22 +125,24 @@ col0 (Matrix3 a00 _ _ a01 _ _ a02 _ _ ) = vec3 a00 a01 a02
122col1 (Matrix3 _ a10 _ _ a11 _ _ a12 _ ) = vec3 a10 a11 a12 125col1 (Matrix3 _ a10 _ _ a11 _ _ a12 _ ) = vec3 a10 a11 a12
123col2 (Matrix3 _ _ a20 _ _ a21 _ _ a22) = vec3 a20 a21 a22 126col2 (Matrix3 _ _ a20 _ _ a21 _ _ a22) = vec3 a20 a21 a22
124 127
125
126row0 (Matrix3 a00 a10 a20 _ _ _ _ _ _ ) = vec3 a00 a10 a20 128row0 (Matrix3 a00 a10 a20 _ _ _ _ _ _ ) = vec3 a00 a10 a20
127row1 (Matrix3 _ _ _ a01 a11 a21 _ _ _ ) = vec3 a01 a11 a21 129row1 (Matrix3 _ _ _ a01 a11 a21 _ _ _ ) = vec3 a01 a11 a21
128row2 (Matrix3 _ _ _ _ _ _ a02 a12 a22) = vec3 a02 a12 a22 130row2 (Matrix3 _ _ _ _ _ _ a02 a12 a22) = vec3 a02 a12 a22
129 131
130
131right (Matrix3 a00 _ _ a01 _ _ _ _ _) = vec2 a00 a01 132right (Matrix3 a00 _ _ a01 _ _ _ _ _) = vec2 a00 a01
132up (Matrix3 _ a10 _ _ a11 _ _ _ _) = vec2 a10 a11 133up (Matrix3 _ a10 _ _ a11 _ _ _ _) = vec2 a10 a11
133forward (Matrix3 _ a10 _ _ a11 _ _ _ _) = vec2 a10 a11 134position (Matrix3 _ _ a20 _ _ a21 _ _ _) = vec2 a20 a21
134position (Matrix3 _ _ a20 _ _ a21 _ _ _) = vec2 a20 a21 135forward = up
136
137setRight (Vector2 x y) matrix = matrix { m00 = x, m01 = y }
138setUp (Vector2 x y) matrix = matrix { m10 = x, m11 = y }
139setPosition (Vector2 x y) matrix = matrix { m20 = x, m21 = y}
140setForward = setUp
135 141
136 142
137-- | Build a matrix from the specified values. 143-- | Build a matrix from the specified values.
138mat3 = Matrix3 144mat3 = Matrix3
139 145
140
141-- | Build a matrix from three vectors in 3D. 146-- | Build a matrix from three vectors in 3D.
142mat3fromVec :: Vector3 -> Vector3 -> Vector3 -> Matrix3 147mat3fromVec :: Vector3 -> Vector3 -> Vector3 -> Matrix3
143mat3fromVec v0 v1 v2 = Matrix3 148mat3fromVec v0 v1 v2 = Matrix3
@@ -145,19 +150,16 @@ mat3fromVec v0 v1 v2 = Matrix3
145 (y v0) (y v1) (y v2) 150 (y v0) (y v1) (y v2)
146 (z v0) (z v1) (z v2) 151 (z v0) (z v1) (z v2)
147 152
148
149-- | Build a transformation matrix. 153-- | Build a transformation matrix.
150transform :: Vector2 -- ^ Right vector 154transform :: Vector2 -- ^ Right vector
151 -> Vector2 -- ^ Forward vector 155 -> Vector2 -- ^ Forward vector
152 -> Vector2 -- ^ Position 156 -> Vector2 -- ^ Position
153 -> Matrix3 -- ^ Transform 157 -> Matrix3 -- ^ Transform
154
155transform r f p = mat3 158transform r f p = mat3
156 (x r) (x f) (x p) 159 (x r) (x f) (x p)
157 (y r) (y f) (y p) 160 (y r) (y f) (y p)
158 0 0 1 161 0 0 1
159 162
160
161-- | Get the translation part of the given transformation matrix. 163-- | Get the translation part of the given transformation matrix.
162translation :: Matrix3 -> Matrix3 164translation :: Matrix3 -> Matrix3
163translation (Matrix3 165translation (Matrix3
@@ -169,7 +171,6 @@ translation (Matrix3
169 0 1 a21 171 0 1 a21
170 0 0 a22 172 0 0 a22
171 173
172
173-- | Get the rotation part of the given transformationmatrix. 174-- | Get the rotation part of the given transformationmatrix.
174rotation :: Matrix3 -> Matrix3 175rotation :: Matrix3 -> Matrix3
175rotation (Matrix3 176rotation (Matrix3
@@ -181,7 +182,6 @@ rotation (Matrix3
181 a01 a11 0 182 a01 a11 0
182 a02 a12 1 183 a02 a12 1
183 184
184
185-- | Return the identity matrix. 185-- | Return the identity matrix.
186id :: Matrix3 186id :: Matrix3
187id = mat3 187id = mat3
@@ -189,26 +189,23 @@ id = mat3
189 0 1 0 189 0 1 0
190 0 0 1 190 0 0 1
191 191
192
193-- | Create a translation matrix. 192-- | Create a translation matrix.
194transl :: Float -- ^ Translation on the x axis 193translate
195 -> Float -- ^ Translation on the y axis 194 :: Float -- ^ Translation on the x axis
196 -> Matrix3 195 -> Float -- ^ Translation on the y axis
197 196 -> Matrix3
198transl tx ty = mat3 197translate tx ty = mat3
199 1 0 tx 198 1 0 tx
200 0 1 ty 199 0 1 ty
201 0 0 1 200 0 0 1
202 201
203
204-- | Create a translation matrix. 202-- | Create a translation matrix.
205translv :: Vector2 -> Matrix3 203translatev :: Vector2 -> Matrix3
206translv v = mat3 204translatev v = mat3
207 1 0 (x v) 205 1 0 (x v)
208 0 1 (y v) 206 0 1 (y v)
209 0 0 1 207 0 0 1
210 208
211
212-- | Create a rotation matrix rotating counter-clockwise about the Z axis. 209-- | Create a rotation matrix rotating counter-clockwise about the Z axis.
213-- 210--
214-- The given angle must be in degrees. 211-- The given angle must be in degrees.
@@ -218,9 +215,8 @@ rot angle = mat3
218 s c 0 215 s c 0
219 0 0 1 216 0 0 1
220 where 217 where
221 s = sin . fromDeg $ angle 218 s = sin angle
222 c = cos . fromDeg $ angle 219 c = cos angle
223
224 220
225-- | Create a scale matrix. 221-- | Create a scale matrix.
226scale :: Float -> Float -> Float -> Matrix3 222scale :: Float -> Float -> Float -> Matrix3
@@ -228,8 +224,7 @@ scale sx sy sz = mat3
228 sx 0 0 224 sx 0 0
229 0 sy 0 225 0 sy 0
230 0 0 sz 226 0 0 sz
231 227
232
233-- | Create a scale matrix. 228-- | Create a scale matrix.
234scalev :: Vector3 -> Matrix3 229scalev :: Vector3 -> Matrix3
235scalev v = mat3 230scalev v = mat3
@@ -241,7 +236,6 @@ scalev v = mat3
241 sy = y v 236 sy = y v
242 sz = z v 237 sz = z v
243 238
244
245-- | Create an X reflection matrix. 239-- | Create an X reflection matrix.
246reflectX :: Matrix3 240reflectX :: Matrix3
247reflectX = mat3 241reflectX = mat3
@@ -249,7 +243,6 @@ reflectX = mat3
249 0 1 0 243 0 1 0
250 0 0 1 244 0 0 1
251 245
252
253-- | Create a Y reflection matrix. 246-- | Create a Y reflection matrix.
254reflectY :: Matrix3 247reflectY :: Matrix3
255reflectY = mat3 248reflectY = mat3
@@ -257,7 +250,6 @@ reflectY = mat3
257 0 (-1) 0 250 0 (-1) 0
258 0 0 1 251 0 0 1
259 252
260
261-- | Create a Z reflection matrix. 253-- | Create a Z reflection matrix.
262reflectZ :: Matrix3 254reflectZ :: Matrix3
263reflectZ = mat3 255reflectZ = mat3
@@ -265,7 +257,6 @@ reflectZ = mat3
265 0 1 0 257 0 1 0
266 0 0 (-1) 258 0 0 (-1)
267 259
268
269-- | Transpose the specified matrix. 260-- | Transpose the specified matrix.
270transpose :: Matrix3 -> Matrix3 261transpose :: Matrix3 -> Matrix3
271transpose m = mat3 262transpose m = mat3
@@ -273,7 +264,6 @@ transpose m = mat3
273 (m10 m) (m11 m) (m12 m) 264 (m10 m) (m11 m) (m12 m)
274 (m20 m) (m21 m) (m22 m) 265 (m20 m) (m21 m) (m22 m)
275 266
276
277-- | Transform the given point vector in 2D space with the given matrix. 267-- | Transform the given point vector in 2D space with the given matrix.
278mulp :: Matrix3 -> Vector2 -> Vector2 268mulp :: Matrix3 -> Vector2 -> Vector2
279mulp m v = vec2 x' y' 269mulp m v = vec2 x' y'
@@ -283,7 +273,6 @@ mulp m v = vec2 x' y'
283 y' = row1 m `dot` v' 273 y' = row1 m `dot` v'
284 274
285 275
286
287-- | Transform the given directional vector in 2D space with the given matrix. 276-- | Transform the given directional vector in 2D space with the given matrix.
288muld :: Matrix3 -> Vector2 -> Vector2 277muld :: Matrix3 -> Vector2 -> Vector2
289muld m v = vec2 x' y' 278muld m v = vec2 x' y'
@@ -292,7 +281,6 @@ muld m v = vec2 x' y'
292 x' = row0 m `dot` v' 281 x' = row0 m `dot` v'
293 y' = row1 m `dot` v' 282 y' = row1 m `dot` v'
294 283
295
296-- | Transform the given vector in 3D space with the given matrix. 284-- | Transform the given vector in 3D space with the given matrix.
297mul :: Matrix3 -> Vector3 -> Vector3 285mul :: Matrix3 -> Vector3 -> Vector3
298mul m v = vec3 x' y' z' 286mul m v = vec3 x' y' z'
@@ -302,7 +290,6 @@ mul m v = vec3 x' y' z'
302 y' = row1 m `dot` v' 290 y' = row1 m `dot` v'
303 z' = row2 m `dot` v' 291 z' = row2 m `dot` v'
304 292
305
306-- | Zip two 'Matrix3' together with the specified function. 293-- | Zip two 'Matrix3' together with the specified function.
307zipWith :: (Float -> Float -> Float) -> Matrix3 -> Matrix3 -> Matrix3 294zipWith :: (Float -> Float -> Float) -> Matrix3 -> Matrix3 -> Matrix3
308zipWith f a b = Matrix3 295zipWith f a b = Matrix3
@@ -310,7 +297,6 @@ zipWith f a b = Matrix3
310 (f (m01 a) (m01 b)) (f (m11 a) (m11 b)) (f (m21 a) (m21 b)) 297 (f (m01 a) (m01 b)) (f (m11 a) (m11 b)) (f (m21 a) (m21 b))
311 (f (m02 a) (m02 b)) (f (m12 a) (m12 b)) (f (m22 a) (m22 b)) 298 (f (m02 a) (m02 b)) (f (m12 a) (m12 b)) (f (m22 a) (m22 b))
312 299
313
314-- | Map the specified function to the specified 'Matrix3'. 300-- | Map the specified function to the specified 'Matrix3'.
315map :: (Float -> Float) -> Matrix3 -> Matrix3 301map :: (Float -> Float) -> Matrix3 -> Matrix3
316map f m = Matrix3 302map f m = Matrix3
@@ -318,7 +304,6 @@ map f m = Matrix3
318 (f . m01 $ m) (f . m11 $ m) (f . m21 $ m) 304 (f . m01 $ m) (f . m11 $ m) (f . m21 $ m)
319 (f . m02 $ m) (f . m12 $ m) (f . m22 $ m) 305 (f . m02 $ m) (f . m12 $ m) (f . m22 $ m)
320 306
321
322-- | Compute the inverse transform of the given transformation matrix. 307-- | Compute the inverse transform of the given transformation matrix.
323inverseTransform :: Matrix3 -> Matrix3 308inverseTransform :: Matrix3 -> Matrix3
324inverseTransform mat = 309inverseTransform mat =
@@ -329,7 +314,3 @@ inverseTransform mat =
329 (x r) (y r) (t `dot` r) 314 (x r) (y r) (t `dot` r)
330 (x f) (y f) (t `dot` f) 315 (x f) (y f) (t `dot` f)
331 0 0 1 316 0 0 1
332
333
334fromDeg :: (Floating a) => a -> a
335fromDeg = (*pi) . (/180)
diff --git a/Spear/Math/Matrix4.hs b/Spear/Math/Matrix4.hs
index 16f7c93..bc74a27 100644
--- a/Spear/Math/Matrix4.hs
+++ b/Spear/Math/Matrix4.hs
@@ -1,3 +1,7 @@
1{-# LANGUAGE MultiParamTypeClasses #-}
2{-# LANGUAGE NoImplicitPrelude #-}
3{-# LANGUAGE TypeFamilies #-}
4
1module Spear.Math.Matrix4 5module Spear.Math.Matrix4
2( 6(
3 Matrix4 7 Matrix4
@@ -9,6 +13,7 @@ module Spear.Math.Matrix4
9, col0, col1, col2, col3 13, col0, col1, col2, col3
10, row0, row1, row2, row3 14, row0, row1, row2, row3
11, right, up, forward, position 15, right, up, forward, position
16, setRight, setUp, setForward, setPosition
12 -- * Construction 17 -- * Construction
13, mat4 18, mat4
14, mat4fromVec 19, mat4fromVec
@@ -50,10 +55,11 @@ module Spear.Math.Matrix4
50) 55)
51where 56where
52 57
58import Spear.Math.Algebra hiding (mul)
59import Spear.Math.Vector
60import Spear.Prelude hiding (mul)
53 61
54import Spear.Math.Vector 62import Foreign.Storable
55
56import Foreign.Storable
57 63
58 64
59-- | Represents a 4x4 column major matrix. 65-- | Represents a 4x4 column major matrix.
@@ -66,7 +72,6 @@ data Matrix4 = Matrix4
66 72
67 73
68instance Show Matrix4 where 74instance Show Matrix4 where
69
70 show (Matrix4 m00 m10 m20 m30 m01 m11 m21 m31 m02 m12 m22 m32 m03 m13 m23 m33) = 75 show (Matrix4 m00 m10 m20 m30 m01 m11 m21 m31 m02 m12 m22 m32 m03 m13 m23 m33) =
71 show' m00 ++ ", " ++ show' m10 ++ ", " ++ show' m20 ++ ", " ++ show' m30 ++ "\n" ++ 76 show' m00 ++ ", " ++ show' m10 ++ ", " ++ show' m20 ++ ", " ++ show' m30 ++ "\n" ++
72 show' m01 ++ ", " ++ show' m11 ++ ", " ++ show' m21 ++ ", " ++ show' m31 ++ "\n" ++ 77 show' m01 ++ ", " ++ show' m11 ++ ", " ++ show' m21 ++ ", " ++ show' m31 ++ "\n" ++
@@ -76,7 +81,7 @@ instance Show Matrix4 where
76 show' f = if abs f < 0.0000001 then "0" else show f 81 show' f = if abs f < 0.0000001 then "0" else show f
77 82
78 83
79instance Num Matrix4 where 84instance Addition Matrix4 Matrix4 where
80 (Matrix4 a00 a01 a02 a03 a04 a05 a06 a07 a08 a09 a10 a11 a12 a13 a14 a15) 85 (Matrix4 a00 a01 a02 a03 a04 a05 a06 a07 a08 a09 a10 a11 a12 a13 a14 a15)
81 + (Matrix4 b00 b01 b02 b03 b04 b05 b06 b07 b08 b09 b10 b11 b12 b13 b14 b15) 86 + (Matrix4 b00 b01 b02 b03 b04 b05 b06 b07 b08 b09 b10 b11 b12 b13 b14 b15)
82 = Matrix4 (a00 + b00) (a01 + b01) (a02 + b02) (a03 + b03) 87 = Matrix4 (a00 + b00) (a01 + b01) (a02 + b02) (a03 + b03)
@@ -84,6 +89,8 @@ instance Num Matrix4 where
84 (a08 + b08) (a09 + b09) (a10 + b10) (a11 + b11) 89 (a08 + b08) (a09 + b09) (a10 + b10) (a11 + b11)
85 (a12 + b12) (a13 + b13) (a14 + b14) (a15 + b15) 90 (a12 + b12) (a13 + b13) (a14 + b14) (a15 + b15)
86 91
92
93instance Subtraction Matrix4 Matrix4 where
87 (Matrix4 a00 a01 a02 a03 a04 a05 a06 a07 a08 a09 a10 a11 a12 a13 a14 a15) 94 (Matrix4 a00 a01 a02 a03 a04 a05 a06 a07 a08 a09 a10 a11 a12 a13 a14 a15)
88 - (Matrix4 b00 b01 b02 b03 b04 b05 b06 b07 b08 b09 b10 b11 b12 b13 b14 b15) 95 - (Matrix4 b00 b01 b02 b03 b04 b05 b06 b07 b08 b09 b10 b11 b12 b13 b14 b15)
89 = Matrix4 (a00 - b00) (a01 - b01) (a02 - b02) (a03 - b03) 96 = Matrix4 (a00 - b00) (a01 - b01) (a02 - b02) (a03 - b03)
@@ -91,6 +98,8 @@ instance Num Matrix4 where
91 (a08 - b08) (a09 - b09) (a10 - b10) (a11 - b11) 98 (a08 - b08) (a09 - b09) (a10 - b10) (a11 - b11)
92 (a12 - b12) (a13 - b13) (a14 - b14) (a15 - b15) 99 (a12 - b12) (a13 - b13) (a14 - b14) (a15 - b15)
93 100
101
102instance Product Matrix4 Matrix4 Matrix4 where
94 (Matrix4 a00 a10 a20 a30 a01 a11 a21 a31 a02 a12 a22 a32 a03 a13 a23 a33) 103 (Matrix4 a00 a10 a20 a30 a01 a11 a21 a31 a02 a12 a22 a32 a03 a13 a23 a33)
95 * (Matrix4 b00 b10 b20 b30 b01 b11 b21 b31 b02 b12 b22 b32 b03 b13 b23 b33) 104 * (Matrix4 b00 b10 b20 b30 b01 b11 b21 b31 b02 b12 b22 b32 b03 b13 b23 b33)
96 = Matrix4 (a00 * b00 + a10 * b01 + a20 * b02 + a30 * b03) 105 = Matrix4 (a00 * b00 + a10 * b01 + a20 * b02 + a30 * b03)
@@ -113,11 +122,13 @@ instance Num Matrix4 where
113 (a03 * b20 + a13 * b21 + a23 * b22 + a33 * b23) 122 (a03 * b20 + a13 * b21 + a23 * b22 + a33 * b23)
114 (a03 * b30 + a13 * b31 + a23 * b32 + a33 * b33) 123 (a03 * b30 + a13 * b31 + a23 * b32 + a33 * b33)
115 124
116 abs = Spear.Math.Matrix4.map abs
117
118 signum = Spear.Math.Matrix4.map signum
119 125
120 fromInteger i = mat4 i' i' i' i' i' i' i' i' i' i' i' i' i' i' i' i' where i' = fromInteger i 126instance Product Matrix4 Float Matrix4 where
127 (Matrix4 a00 a10 a20 a30 a01 a11 a21 a31 a02 a12 a22 a32 a03 a13 a23 a33) * s =
128 Matrix4 (a00 * s) (a10 * s) (a20 * s) (a30 * s)
129 (a01 * s) (a11 * s) (a21 * s) (a31 * s)
130 (a02 * s) (a12 * s) (a22 * s) (a32 * s)
131 (a03 * s) (a13 * s) (a23 * s) (a33 * s)
121 132
122 133
123instance Storable Matrix4 where 134instance Storable Matrix4 where
@@ -150,23 +161,24 @@ col1 (Matrix4 _ a10 _ _ _ a11 _ _ _ a12 _ _ _ a13 _ _ ) =
150col2 (Matrix4 _ _ a20 _ _ _ a21 _ _ _ a22 _ _ _ a23 _ ) = vec4 a20 a21 a22 a23 161col2 (Matrix4 _ _ a20 _ _ _ a21 _ _ _ a22 _ _ _ a23 _ ) = vec4 a20 a21 a22 a23
151col3 (Matrix4 _ _ _ a30 _ _ _ a31 _ _ _ a32 _ _ _ a33) = vec4 a30 a31 a32 a33 162col3 (Matrix4 _ _ _ a30 _ _ _ a31 _ _ _ a32 _ _ _ a33) = vec4 a30 a31 a32 a33
152 163
153
154row0 (Matrix4 a00 a01 a02 a03 _ _ _ _ _ _ _ _ _ _ _ _ ) = vec4 a00 a01 a02 a03 164row0 (Matrix4 a00 a01 a02 a03 _ _ _ _ _ _ _ _ _ _ _ _ ) = vec4 a00 a01 a02 a03
155row1 (Matrix4 _ _ _ _ a10 a11 a12 a13 _ _ _ _ _ _ _ _ ) = vec4 a10 a11 a12 a13 165row1 (Matrix4 _ _ _ _ a10 a11 a12 a13 _ _ _ _ _ _ _ _ ) = vec4 a10 a11 a12 a13
156row2 (Matrix4 _ _ _ _ _ _ _ _ a20 a21 a22 a23 _ _ _ _ ) = vec4 a20 a21 a22 a23 166row2 (Matrix4 _ _ _ _ _ _ _ _ a20 a21 a22 a23 _ _ _ _ ) = vec4 a20 a21 a22 a23
157row3 (Matrix4 _ _ _ _ _ _ _ _ _ _ _ _ a30 a31 a32 a33) = vec4 a30 a31 a32 a33 167row3 (Matrix4 _ _ _ _ _ _ _ _ _ _ _ _ a30 a31 a32 a33) = vec4 a30 a31 a32 a33
158 168
159
160right (Matrix4 a00 _ _ _ a01 _ _ _ a02 _ _ _ _ _ _ _) = vec3 a00 a01 a02 169right (Matrix4 a00 _ _ _ a01 _ _ _ a02 _ _ _ _ _ _ _) = vec3 a00 a01 a02
161up (Matrix4 _ a10 _ _ _ a11 _ _ _ a12 _ _ _ _ _ _) = vec3 a10 a11 a12 170up (Matrix4 _ a10 _ _ _ a11 _ _ _ a12 _ _ _ _ _ _) = vec3 a10 a11 a12
162forward (Matrix4 _ _ a20 _ _ _ a21 _ _ _ a22 _ _ _ _ _) = vec3 a20 a21 a22 171forward (Matrix4 _ _ a20 _ _ _ a21 _ _ _ a22 _ _ _ _ _) = vec3 a20 a21 a22
163position (Matrix4 _ _ _ a30 _ _ _ a31 _ _ _ a32 _ _ _ _) = vec3 a30 a31 a32 172position (Matrix4 _ _ _ a30 _ _ _ a31 _ _ _ a32 _ _ _ _) = vec3 a30 a31 a32
164 173
174setRight (Vector3 x y z) matrix = matrix { m00 = x, m01 = y, m02 = z }
175setUp (Vector3 x y z) matrix = matrix { m10 = x, m11 = y, m12 = z }
176setForward (Vector3 x y z) matrix = matrix { m20 = x, m21 = y, m22 = z }
177setPosition (Vector3 x y z) matrix = matrix { m30 = x, m31 = y, m32 = z }
165 178
166-- | Build a matrix from the specified values. 179-- | Build a matrix from the specified values.
167mat4 = Matrix4 180mat4 = Matrix4
168 181
169
170-- | Build a matrix from four vectors in 4D. 182-- | Build a matrix from four vectors in 4D.
171mat4fromVec :: Vector4 -> Vector4 -> Vector4 -> Vector4 -> Matrix4 183mat4fromVec :: Vector4 -> Vector4 -> Vector4 -> Vector4 -> Matrix4
172mat4fromVec v0 v1 v2 v3 = Matrix4 184mat4fromVec v0 v1 v2 v3 = Matrix4
@@ -175,21 +187,18 @@ mat4fromVec v0 v1 v2 v3 = Matrix4
175 (z v0) (z v1) (z v2) (z v3) 187 (z v0) (z v1) (z v2) (z v3)
176 (w v0) (w v1) (w v2) (w v3) 188 (w v0) (w v1) (w v2) (w v3)
177 189
178
179-- | Build a transformation 'Matrix4' from the given vectors. 190-- | Build a transformation 'Matrix4' from the given vectors.
180transform :: Vector3 -- ^ Right vector. 191transform :: Vector3 -- ^ Right vector.
181 -> Vector3 -- ^ Up vector. 192 -> Vector3 -- ^ Up vector.
182 -> Vector3 -- ^ Forward vector. 193 -> Vector3 -- ^ Forward vector.
183 -> Vector3 -- ^ Position. 194 -> Vector3 -- ^ Position.
184 -> Matrix4 195 -> Matrix4
185
186transform right up fwd pos = mat4 196transform right up fwd pos = mat4
187 (x right) (x up) (x fwd) (x pos) 197 (x right) (x up) (x fwd) (x pos)
188 (y right) (y up) (y fwd) (y pos) 198 (y right) (y up) (y fwd) (y pos)
189 (z right) (z up) (z fwd) (z pos) 199 (z right) (z up) (z fwd) (z pos)
190 0 0 0 1 200 0 0 0 1
191 201
192
193-- | Get the translation part of the given transformation matrix. 202-- | Get the translation part of the given transformation matrix.
194translation :: Matrix4 -> Matrix4 203translation :: Matrix4 -> Matrix4
195translation (Matrix4 204translation (Matrix4
@@ -203,7 +212,6 @@ translation (Matrix4
203 0 0 1 a32 212 0 0 1 a32
204 0 0 0 a33 213 0 0 0 a33
205 214
206
207-- | Get the rotation part of the given transformation matrix. 215-- | Get the rotation part of the given transformation matrix.
208rotation :: Matrix4 -> Matrix4 216rotation :: Matrix4 -> Matrix4
209rotation (Matrix4 217rotation (Matrix4
@@ -217,12 +225,10 @@ rotation (Matrix4
217 a02 a12 a22 0 225 a02 a12 a22 0
218 a03 a13 a23 1 226 a03 a13 a23 1
219 227
220
221-- | Build a transformation 'Matrix4' defined by the given position and target. 228-- | Build a transformation 'Matrix4' defined by the given position and target.
222lookAt :: Vector3 -- ^ Eye position. 229lookAt :: Vector3 -- ^ Eye position.
223 -> Vector3 -- ^ Target point. 230 -> Vector3 -- ^ Target point.
224 -> Matrix4 231 -> Matrix4
225
226lookAt pos target = 232lookAt pos target =
227 let fwd = normalise $ target - pos 233 let fwd = normalise $ target - pos
228 r = fwd `cross` unity3 234 r = fwd `cross` unity3
@@ -230,7 +236,6 @@ lookAt pos target =
230 in 236 in
231 transform r u (-fwd) pos 237 transform r u (-fwd) pos
232 238
233
234-- | Zip two matrices together with the specified function. 239-- | Zip two matrices together with the specified function.
235zipWith :: (Float -> Float -> Float) -> Matrix4 -> Matrix4 -> Matrix4 240zipWith :: (Float -> Float -> Float) -> Matrix4 -> Matrix4 -> Matrix4
236zipWith f a b = Matrix4 241zipWith f a b = Matrix4
@@ -239,7 +244,6 @@ zipWith f a b = Matrix4
239 (f (m02 a) (m02 b)) (f (m12 a) (m12 b)) (f (m22 a) (m22 b)) (f (m32 a) (m32 b)) 244 (f (m02 a) (m02 b)) (f (m12 a) (m12 b)) (f (m22 a) (m22 b)) (f (m32 a) (m32 b))
240 (f (m03 a) (m03 b)) (f (m13 a) (m13 b)) (f (m23 a) (m23 b)) (f (m33 a) (m33 b)) 245 (f (m03 a) (m03 b)) (f (m13 a) (m13 b)) (f (m23 a) (m23 b)) (f (m33 a) (m33 b))
241 246
242
243-- | Map the specified function to the specified matrix. 247-- | Map the specified function to the specified matrix.
244map :: (Float -> Float) -> Matrix4 -> Matrix4 248map :: (Float -> Float) -> Matrix4 -> Matrix4
245map f m = Matrix4 249map f m = Matrix4
@@ -248,7 +252,6 @@ map f m = Matrix4
248 (f . m02 $ m) (f . m12 $ m) (f . m22 $ m) (f . m32 $ m) 252 (f . m02 $ m) (f . m12 $ m) (f . m22 $ m) (f . m32 $ m)
249 (f . m03 $ m) (f . m13 $ m) (f . m23 $ m) (f . m33 $ m) 253 (f . m03 $ m) (f . m13 $ m) (f . m23 $ m) (f . m33 $ m)
250 254
251
252-- | Return the identity matrix. 255-- | Return the identity matrix.
253id :: Matrix4 256id :: Matrix4
254id = mat4 257id = mat4
@@ -257,7 +260,6 @@ id = mat4
257 0 0 1 0 260 0 0 1 0
258 0 0 0 1 261 0 0 0 1
259 262
260
261-- | Create a translation matrix. 263-- | Create a translation matrix.
262transl :: Float -> Float -> Float -> Matrix4 264transl :: Float -> Float -> Float -> Matrix4
263transl x y z = mat4 265transl x y z = mat4
@@ -266,7 +268,6 @@ transl x y z = mat4
266 0 0 1 z 268 0 0 1 z
267 0 0 0 1 269 0 0 0 1
268 270
269
270-- | Create a translation matrix. 271-- | Create a translation matrix.
271translv :: Vector3 -> Matrix4 272translv :: Vector3 -> Matrix4
272translv v = mat4 273translv v = mat4
@@ -275,7 +276,6 @@ translv v = mat4
275 0 0 1 (z v) 276 0 0 1 (z v)
276 0 0 0 1 277 0 0 0 1
277 278
278
279-- | Create a rotation matrix rotating about the X axis. 279-- | Create a rotation matrix rotating about the X axis.
280-- The given angle must be in degrees. 280-- The given angle must be in degrees.
281rotX :: Float -> Matrix4 281rotX :: Float -> Matrix4
@@ -285,9 +285,8 @@ rotX angle = mat4
285 0 s c 0 285 0 s c 0
286 0 0 0 1 286 0 0 0 1
287 where 287 where
288 s = sin . toRAD $ angle 288 s = sin angle
289 c = cos . toRAD $ angle 289 c = cos angle
290
291 290
292-- | Create a rotation matrix rotating about the Y axis. 291-- | Create a rotation matrix rotating about the Y axis.
293-- The given angle must be in degrees. 292-- The given angle must be in degrees.
@@ -298,9 +297,8 @@ rotY angle = mat4
298 (-s) 0 c 0 297 (-s) 0 c 0
299 0 0 0 1 298 0 0 0 1
300 where 299 where
301 s = sin . toRAD $ angle 300 s = sin angle
302 c = cos . toRAD $ angle 301 c = cos angle
303
304 302
305-- | Create a rotation matrix rotating about the Z axis. 303-- | Create a rotation matrix rotating about the Z axis.
306-- The given angle must be in degrees. 304-- The given angle must be in degrees.
@@ -311,9 +309,8 @@ rotZ angle = mat4
311 0 0 1 0 309 0 0 1 0
312 0 0 0 1 310 0 0 0 1
313 where 311 where
314 s = sin . toRAD $ angle 312 s = sin angle
315 c = cos . toRAD $ angle 313 c = cos angle
316
317 314
318-- | Create a rotation matrix rotating about the specified axis. 315-- | Create a rotation matrix rotating about the specified axis.
319-- The given angle must be in degrees. 316-- The given angle must be in degrees.
@@ -327,16 +324,15 @@ axisAngle v angle = mat4
327 ax = x v 324 ax = x v
328 ay = y v 325 ay = y v
329 az = z v 326 az = z v
330 s = sin . toRAD $ angle 327 s = sin angle
331 c = cos . toRAD $ angle 328 c = cos angle
332 xy = ax*ay 329 xy = ax*ay
333 xz = ax*az 330 xz = ax*az
334 yz = ay*az 331 yz = ay*az
335 sx = s*ax 332 sx = s*ax
336 sy = s*ay 333 sy = s*ay
337 sz = s*az 334 sz = s*az
338 omc = 1 - c 335 omc = (1::Float) - c
339
340 336
341-- | Create a scale matrix. 337-- | Create a scale matrix.
342scale :: Float -> Float -> Float -> Matrix4 338scale :: Float -> Float -> Float -> Matrix4
@@ -346,7 +342,6 @@ scale sx sy sz = mat4
346 0 0 sz 0 342 0 0 sz 0
347 0 0 0 1 343 0 0 0 1
348 344
349
350-- | Create a scale matrix. 345-- | Create a scale matrix.
351scalev :: Vector3 -> Matrix4 346scalev :: Vector3 -> Matrix4
352scalev v = mat4 347scalev v = mat4
@@ -359,7 +354,6 @@ scalev v = mat4
359 sy = y v 354 sy = y v
360 sz = z v 355 sz = z v
361 356
362
363-- | Create an X reflection matrix. 357-- | Create an X reflection matrix.
364reflectX :: Matrix4 358reflectX :: Matrix4
365reflectX = mat4 359reflectX = mat4
@@ -368,7 +362,6 @@ reflectX = mat4
368 0 0 1 0 362 0 0 1 0
369 0 0 0 1 363 0 0 0 1
370 364
371
372-- | Create a Y reflection matrix. 365-- | Create a Y reflection matrix.
373reflectY :: Matrix4 366reflectY :: Matrix4
374reflectY = mat4 367reflectY = mat4
@@ -377,7 +370,6 @@ reflectY = mat4
377 0 0 1 0 370 0 0 1 0
378 0 0 0 1 371 0 0 0 1
379 372
380
381-- | Create a Z reflection matrix. 373-- | Create a Z reflection matrix.
382reflectZ :: Matrix4 374reflectZ :: Matrix4
383reflectZ = mat4 375reflectZ = mat4
@@ -386,7 +378,6 @@ reflectZ = mat4
386 0 0 (-1) 0 378 0 0 (-1) 0
387 0 0 0 1 379 0 0 0 1
388 380
389
390-- | Create an orthogonal projection matrix. 381-- | Create an orthogonal projection matrix.
391ortho :: Float -- ^ Left. 382ortho :: Float -- ^ Left.
392 -> Float -- ^ Right. 383 -> Float -- ^ Right.
@@ -395,7 +386,6 @@ ortho :: Float -- ^ Left.
395 -> Float -- ^ Near clip. 386 -> Float -- ^ Near clip.
396 -> Float -- ^ Far clip. 387 -> Float -- ^ Far clip.
397 -> Matrix4 388 -> Matrix4
398
399ortho l r b t n f = 389ortho l r b t n f =
400 let tx = (-(r+l)/(r-l)) 390 let tx = (-(r+l)/(r-l))
401 ty = (-(t+b)/(t-b)) 391 ty = (-(t+b)/(t-b))
@@ -406,7 +396,6 @@ ortho l r b t n f =
406 0 0 ((-2)/(f-n)) tz 396 0 0 ((-2)/(f-n)) tz
407 0 0 0 1 397 0 0 0 1
408 398
409
410-- | Create a perspective projection matrix. 399-- | Create a perspective projection matrix.
411perspective :: Float -- ^ Fovy - Vertical field of view angle in degrees. 400perspective :: Float -- ^ Fovy - Vertical field of view angle in degrees.
412 -> Float -- ^ Aspect ratio. 401 -> Float -- ^ Aspect ratio.
@@ -414,15 +403,14 @@ perspective :: Float -- ^ Fovy - Vertical field of view angle in degrees.
414 -> Float -- ^ Far clip distance 403 -> Float -- ^ Far clip distance
415 -> Matrix4 404 -> Matrix4
416perspective fovy r near far = 405perspective fovy r near far =
417 let f = 1 / tan (toRAD fovy / 2) 406 let f = 1 / tan (fovy / (2::Float))
418 a = near - far 407 a = near - far
419 in mat4 408 in mat4
420 (f/r) 0 0 0 409 (f/r) 0 0 0
421 0 f 0 0 410 0 f 0 0
422 0 0 ((far+near)/a) (2*far*near/a) 411 0 0 ((far+near)/a) ((2::Float)*far*near/a)
423 0 0 (-1) 0 412 0 0 (-1) 0
424 413
425
426-- | Create a plane projection matrix. 414-- | Create a plane projection matrix.
427planeProj :: Vector3 -- ^ Plane normal 415planeProj :: Vector3 -- ^ Plane normal
428 -> Float -- ^ Plane distance from the origin 416 -> Float -- ^ Plane distance from the origin
@@ -442,7 +430,6 @@ planeProj n d l =
442 (-nx*lz) (-ny*lz) (d + c - nz*lz) (-lz*d) 430 (-nx*lz) (-ny*lz) (d + c - nz*lz) (-lz*d)
443 (-nx) (-ny) (-nz) c 431 (-nx) (-ny) (-nz) c
444 432
445
446-- | Transpose the specified matrix. 433-- | Transpose the specified matrix.
447transpose :: Matrix4 -> Matrix4 434transpose :: Matrix4 -> Matrix4
448transpose m = mat4 435transpose m = mat4
@@ -451,7 +438,6 @@ transpose m = mat4
451 (m20 m) (m21 m) (m22 m) (m23 m) 438 (m20 m) (m21 m) (m22 m) (m23 m)
452 (m30 m) (m31 m) (m32 m) (m33 m) 439 (m30 m) (m31 m) (m32 m) (m33 m)
453 440
454
455-- | Invert the given transformation matrix. 441-- | Invert the given transformation matrix.
456inverseTransform :: Matrix4 -> Matrix4 442inverseTransform :: Matrix4 -> Matrix4
457inverseTransform mat = 443inverseTransform mat =
@@ -467,7 +453,6 @@ inverseTransform mat =
467 (x f) (y f) (z f) (-t `dot` f) 453 (x f) (y f) (z f) (-t `dot` f)
468 0 0 0 1 454 0 0 0 1
469 455
470
471-- | Invert the given matrix. 456-- | Invert the given matrix.
472inverse :: Matrix4 -> Matrix4 457inverse :: Matrix4 -> Matrix4
473inverse mat = 458inverse mat =
@@ -605,7 +590,7 @@ inverse mat =
605 in 590 in
606 if det' == 0 then Spear.Math.Matrix4.id 591 if det' == 0 then Spear.Math.Matrix4.id
607 else 592 else
608 let det = 1 / det' 593 let det = (1::Float) / det'
609 in mat4 594 in mat4
610 (m00' * det) (m04' * det) (m08' * det) (m12' * det) 595 (m00' * det) (m04' * det) (m08' * det) (m12' * det)
611 (m01' * det) (m05' * det) (m09' * det) (m13' * det) 596 (m01' * det) (m05' * det) (m09' * det) (m13' * det)
@@ -622,17 +607,14 @@ mul w m v = vec3 x' y' z'
622 y' = row1 m `dot` v' 607 y' = row1 m `dot` v'
623 z' = row2 m `dot` v' 608 z' = row2 m `dot` v'
624 609
625
626-- | Transform the given point vector in 3D space with the given matrix. 610-- | Transform the given point vector in 3D space with the given matrix.
627mulp :: Matrix4 -> Vector3 -> Vector3 611mulp :: Matrix4 -> Vector3 -> Vector3
628mulp = mul 1 612mulp = mul 1
629 613
630
631-- | Transform the given directional vector in 3D space with the given matrix. 614-- | Transform the given directional vector in 3D space with the given matrix.
632muld :: Matrix4 -> Vector3 -> Vector3 615muld :: Matrix4 -> Vector3 -> Vector3
633muld = mul 0 616muld = mul 0
634 617
635
636-- | Transform the given vector with the given matrix. 618-- | Transform the given vector with the given matrix.
637-- 619--
638-- The vector is brought from homogeneous space to 3D space by performing a 620-- The vector is brought from homogeneous space to 3D space by performing a
@@ -645,6 +627,3 @@ mul' w m v = vec3 (x'/w') (y'/w') (z'/w')
645 y' = row1 m `dot` v' 627 y' = row1 m `dot` v'
646 z' = row2 m `dot` v' 628 z' = row2 m `dot` v'
647 w' = row3 m `dot` v' 629 w' = row3 m `dot` v'
648
649
650toRAD = (*pi) . (/180)
diff --git a/Spear/Math/MatrixUtils.hs b/Spear/Math/MatrixUtils.hs
index 567bee1..cca5c48 100644
--- a/Spear/Math/MatrixUtils.hs
+++ b/Spear/Math/MatrixUtils.hs
@@ -1,3 +1,5 @@
1{-# LANGUAGE NoImplicitPrelude #-}
2
1module Spear.Math.MatrixUtils 3module Spear.Math.MatrixUtils
2( 4(
3 fastNormalMatrix 5 fastNormalMatrix
@@ -11,11 +13,12 @@ module Spear.Math.MatrixUtils
11) 13)
12where 14where
13 15
14import Spear.Math.Camera as Cam 16import Spear.Math.Camera as Cam
15import Spear.Math.Matrix3 as M3 17import Spear.Math.Matrix3 as M3
16import Spear.Math.Matrix4 as M4 18import Spear.Math.Matrix4 as M4
17import Spear.Math.Spatial3 as S 19import Spear.Math.Spatial3 as S
18import Spear.Math.Vector as V 20import Spear.Math.Vector as V
21import Spear.Prelude
19 22
20-- | Compute the normal matrix of the given matrix. 23-- | Compute the normal matrix of the given matrix.
21fastNormalMatrix :: Matrix4 -> Matrix3 24fastNormalMatrix :: Matrix4 -> Matrix3
@@ -39,9 +42,9 @@ unproject :: Matrix4 -- ^ Inverse projection matrix
39 -> Vector3 42 -> Vector3
40unproject projI modelviewI vpx vpy w h x y z = 43unproject projI modelviewI vpx vpy w h x y z =
41 let 44 let
42 xmouse = 2*(x-vpx)/w - 1 45 xmouse = (2::Float) * (x-vpx)/w - (1::Float)
43 ymouse = 2*(y-vpy)/h - 1 46 ymouse = (2::Float) * (y-vpy)/h - (1::Float)
44 zmouse = 2*z - 1 47 zmouse = (2::Float) * z - (1::Float)
45 in 48 in
46 (modelviewI * projI) `M4.mulp` vec3 xmouse ymouse zmouse 49 (modelviewI * projI) `M4.mulp` vec3 xmouse ymouse zmouse
47 50
@@ -64,7 +67,7 @@ rpgUnproject projI viewI vpx vpy w h wx wy =
64 p1 = unproject projI viewI vpx vpy w h wx wy 0 67 p1 = unproject projI viewI vpx vpy w h wx wy 0
65 p2 = unproject projI viewI vpx vpy w h wx wy (-1) 68 p2 = unproject projI viewI vpx vpy w h wx wy (-1)
66 lambda = (y p1 / (y p1 - y p2)) 69 lambda = (y p1 / (y p1 - y p2))
67 p' = p1 + V.scale lambda (p2 - p1) 70 p' = p1 + lambda * (p2 - p1)
68 in 71 in
69 vec2 (x p') (-(z p')) 72 vec2 (x p') (-(z p'))
70 73
@@ -77,10 +80,10 @@ rpgTransform
77 -> Matrix4 -- ^ Inverse view matrix 80 -> Matrix4 -- ^ Inverse view matrix
78 -> Matrix4 81 -> Matrix4
79rpgTransform h a axis pos viewI = 82rpgTransform h a axis pos viewI =
80 let p1 = viewI `M4.mulp` (vec3 (x pos) (y pos) 0) 83 let p1 = viewI `M4.mulp` vec3 (x pos) (y pos) 0
81 p2 = viewI `M4.mulp` (vec3 (x pos) (y pos) (-1)) 84 p2 = viewI `M4.mulp` vec3 (x pos) (y pos) (-1)
82 lambda = (y p1 / (y p1 - y p2)) 85 lambda = (y p1 / (y p1 - y p2))
83 p = p1 + V.scale lambda (p2 - p1) 86 p = p1 + lambda * (p2 - p1)
84 mat' = axisAngle axis a 87 mat' = axisAngle axis a
85 r = M4.right mat' 88 r = M4.right mat'
86 u = M4.up mat' 89 u = M4.up mat'
@@ -134,8 +137,8 @@ pltInverse = M4.inverseTransform . pltTransform
134objToClip :: Camera -> Matrix4 -> Vector3 -> Vector2 137objToClip :: Camera -> Matrix4 -> Vector3 -> Vector2
135objToClip cam model p = 138objToClip cam model p =
136 let 139 let
137 view = M4.inverseTransform $ S.transform cam 140 view = M4.inverseTransform . transform3Matrix . transform3 $ cam
138 proj = Cam.projection cam 141 proj = projection cam
139 p' = (proj * view * model) `M4.mulp` p 142 p' = (proj * view * model) `M4.mulp` p
140 in 143 in
141 vec2 (x p') (y p') 144 vec2 (x p') (y p')
diff --git a/Spear/Math/Plane.hs b/Spear/Math/Plane.hs
index ee788b5..5440a43 100644
--- a/Spear/Math/Plane.hs
+++ b/Spear/Math/Plane.hs
@@ -1,3 +1,5 @@
1{-# LANGUAGE NoImplicitPrelude #-}
2
1module Spear.Math.Plane 3module Spear.Math.Plane
2( 4(
3 Plane 5 Plane
@@ -6,7 +8,8 @@ module Spear.Math.Plane
6) 8)
7where 9where
8 10
9import Spear.Math.Vector 11import Spear.Math.Vector
12import Spear.Prelude
10 13
11data PointPlanePos = Front | Back | Contained deriving (Eq, Show) 14data PointPlanePos = Front | Back | Contained deriving (Eq, Show)
12 15
diff --git a/Spear/Math/Quaternion.hs b/Spear/Math/Quaternion.hs
index 78aca9c..c4d96d5 100644
--- a/Spear/Math/Quaternion.hs
+++ b/Spear/Math/Quaternion.hs
@@ -1,3 +1,5 @@
1{-# LANGUAGE NoImplicitPrelude #-}
2
1module Spear.Math.Quaternion 3module Spear.Math.Quaternion
2( 4(
3 Quaternion 5 Quaternion
@@ -16,8 +18,9 @@ module Spear.Math.Quaternion
16) 18)
17where 19where
18 20
19 21import Spear.Math.Algebra
20import Spear.Math.Vector 22import Spear.Math.Vector
23import Spear.Prelude
21 24
22 25
23newtype Quaternion = Quaternion { getVec :: Vector4 } 26newtype Quaternion = Quaternion { getVec :: Vector4 }
@@ -47,7 +50,7 @@ qAxisAngle :: Vector3 -> Float -> Quaternion
47qAxisAngle axis angle = 50qAxisAngle axis angle =
48 let s' = norm axis 51 let s' = norm axis
49 s = if s' == 0 then 1 else s' 52 s = if s' == 0 then 1 else s'
50 a = angle * toRAD * 0.5 53 a = angle * (0.5::Float)
51 sa = sin a 54 sa = sin a
52 qw = cos a 55 qw = cos a
53 qx = x axis * sa * s 56 qx = x axis * sa * s
@@ -102,7 +105,3 @@ qnorm = norm . getVec
102qrot :: Quaternion -> Vector3 -> Vector3 105qrot :: Quaternion -> Vector3 -> Vector3
103qrot q v = toVec3 $ q `qmul` qvec3 v 0 `qmul` qconj q 106qrot q v = toVec3 $ q `qmul` qvec3 v 0 `qmul` qconj q
104 where toVec3 (Quaternion q) = vec3 (x q) (y q) (z q) 107 where toVec3 (Quaternion q) = vec3 (x q) (y q) (z q)
105
106
107toRAD = pi / 180
108
diff --git a/Spear/Math/Ray.hs b/Spear/Math/Ray.hs
index 009455d..5bd4d7c 100644
--- a/Spear/Math/Ray.hs
+++ b/Spear/Math/Ray.hs
@@ -1,3 +1,7 @@
1{-# LANGUAGE MultiParamTypeClasses #-}
2{-# LANGUAGE NoImplicitPrelude #-}
3{-# LANGUAGE TypeSynonymInstances #-}
4
1module Spear.Math.Ray 5module Spear.Math.Ray
2( 6(
3 Ray(..) 7 Ray(..)
@@ -7,8 +11,12 @@ module Spear.Math.Ray
7where 11where
8 12
9 13
10import Spear.Math.Utils 14import qualified Spear.Math.Matrix3 as Matrix3
11import Spear.Math.Vector 15import Spear.Math.Spatial
16import Spear.Math.Spatial2
17import Spear.Math.Utils
18import Spear.Math.Vector
19import Spear.Prelude
12 20
13 21
14data Ray = Ray 22data Ray = Ray
@@ -17,6 +25,29 @@ data Ray = Ray
17 } 25 }
18 26
19 27
28instance Positional Ray Vector2 where
29 setPosition p ray = ray { origin = p }
30 position = origin
31 translate v ray = ray { origin = origin ray + v }
32
33
34instance Rotational Ray Vector2 Angle where
35 setRotation angle ray = ray { dir = setRotation angle (dir ray) }
36 rotation = rotation . dir
37 rotate angle ray = ray { dir = rotate angle (dir ray) }
38 right = right . dir
39 up = up . dir
40 forward = forward . dir
41 setForward forward ray = ray { dir = forward }
42
43
44instance Spatial Ray Vector2 Angle Transform2 where
45 setTransform (Transform2 matrix) ray =
46 ray { origin = Matrix3.position matrix, dir = Matrix3.up matrix }
47 transform ray =
48 Transform2 $ Matrix3.transform (perp $ dir ray) (dir ray) (origin ray)
49
50
20-- | Classify the given point's position with respect to the given ray. Left/Right test. 51-- | Classify the given point's position with respect to the given ray. Left/Right test.
21raylr :: Ray -> Vector2 -> Side 52raylr :: Ray -> Vector2 -> Side
22raylr (Ray o d) p 53raylr (Ray o d) p
diff --git a/Spear/Math/Spatial.hs b/Spear/Math/Spatial.hs
new file mode 100644
index 0000000..bfab6c2
--- /dev/null
+++ b/Spear/Math/Spatial.hs
@@ -0,0 +1,111 @@
1{- This module categorizes objects in space. We identify three types of objects:
2
3- Objects that only move (Positional).
4- Objects that only rotate (Rotational).
5- Objects that both move and rotate (Spatial).
6
7Objects that only move are basically the rotationally-invariant ones: AABB,
8circle, sphere, point light, omnidirectional sound source, etc.
9
10Conversely for objects that only rotate, which are position-invariant:
11directional light sources, for example, or a single vector.
12
13Objects that both move and rotate are called "spatials". These are the
14first-class citizens of space.
15
16The lack of ad-hoc overloading in Haskell also makes function names a bit
17annoying, so all the type classes here are general over 2d/3d space so that
18we can use the same names for everything (e.g., "translate" to move an object,
19regardless of whether it is a 2D or 3D object).
20-}
21{-# LANGUAGE FlexibleContexts #-}
22{-# LANGUAGE FunctionalDependencies #-}
23{-# LANGUAGE NoImplicitPrelude #-}
24{-# LANGUAGE TypeSynonymInstances #-}
25
26module Spear.Math.Spatial where
27
28import Spear.Math.Algebra
29import Spear.Math.Vector
30import Spear.Prelude
31
32
33type Angle = Float -- TODO: consider newtype for Angle and Radius.
34type Radius = Float -- TODO: Move somewhere more appropriate.
35
36-- TODO: consider a general concept of Rotation (Angle and Quaternion) that
37-- then conditions Rotational like Vector conditions Positional. That would
38-- allow us to get a basis out of a Rotational much like we can do now with
39-- Positional (because we know it operates on Vectors).
40
41
42class Vector v => Positional a v | a -> v where
43 -- | Set the object's position.
44 setPosition :: v -> a -> a
45
46 -- | Get the object's position.
47 position :: a -> v
48
49 -- | Translate the object.
50 translate :: v -> a -> a
51
52
53class Rotational a v r | a -> v, a -> r where
54 -- | Set the object's rotation.
55 setRotation :: r -> a -> a
56
57 -- | Get the object's rotation.
58 rotation :: a -> r
59
60 -- | Rotate the object.
61 rotate :: r -> a -> a
62
63 -- | Get the object's right vector.
64 right :: a -> v
65
66 -- | Get the object's up vector.
67 up :: a -> v
68
69 -- | Get the object's forward vector.
70 forward :: a -> v
71
72 -- | Set the object's forward vector.
73 setForward :: v -> a -> a
74
75
76class (Positional a v, Rotational a v r) => Spatial a v r t | a -> t where
77 -- | Set the spatial's transform.
78 setTransform :: t -> a -> a
79
80 -- | Get the spatial's transform.
81 transform :: a -> t
82
83
84--------------------------------------------------------------------------------
85-- Spatial.
86
87-- | Move the spatial along the given axis scaled by the given delta.
88move :: Positional a v => Float -> (a -> v) -> a -> a
89move delta axis a = translate (axis a * delta) a
90
91-- | Move the spatial upwards.
92moveRight delta = move delta right
93
94-- | Move the spatial downwards.
95moveLeft delta = moveRight (-delta)
96
97-- | Move the spatial upwards.
98moveUp delta = move delta up
99
100-- | Move the spatial downwards.
101moveDown delta = moveUp (-delta)
102
103-- | Move the spatial forwards.
104moveFwd delta = move delta forward
105
106-- | Move the spatial backwards.
107moveBack delta = moveFwd (-delta)
108
109-- | Make the spatial look at the given point.
110lookAt :: Vector v => Spatial a v r t => v -> a -> a
111lookAt p a = setForward (normalise $ p - position a) a
diff --git a/Spear/Math/Spatial2.hs b/Spear/Math/Spatial2.hs
index b2399f8..1cc2b65 100644
--- a/Spear/Math/Spatial2.hs
+++ b/Spear/Math/Spatial2.hs
@@ -1,151 +1,110 @@
1{-# LANGUAGE ConstraintKinds #-}
2{-# LANGUAGE FlexibleContexts #-}
3{-# LANGUAGE MultiParamTypeClasses #-}
4{-# LANGUAGE NoImplicitPrelude #-}
5{-# LANGUAGE TypeSynonymInstances #-}
6
1module Spear.Math.Spatial2 7module Spear.Math.Spatial2
2(
3 Spatial2(..)
4, Obj2
5, Angle
6, Radius
7, move
8, moveFwd
9, moveBack
10, moveUp
11, moveDown
12, moveLeft
13, moveRight
14, rotate
15, setRotation
16, pos
17, fwd
18, up
19, right
20, transform
21, setTransform
22, setPos
23, lookAt
24, Spear.Math.Spatial2.orbit
25, obj2FromVectors
26, obj2FromTransform
27)
28where 8where
29 9
30import Spear.Math.Vector 10import qualified Spear.Math.Matrix3 as Matrix3
31import qualified Spear.Math.Matrix3 as M 11import Spear.Math.Matrix3 (Matrix3)
32 12import Spear.Math.Spatial as Spatial
33type Angle = Float 13import Spear.Math.Vector
34type Radius = Float 14import Spear.Prelude
35 15
36-- | An entity that can be moved around in 2D space. 16
37class Spatial2 s where 17type Positional2 a = Positional a Vector2
38 18type Rotational2 a = Rotational a Angle
39 -- | Gets the spatial's Obj2. 19type Spatial2 s = Spatial s Vector2 Angle Transform2
40 getObj2 :: s -> Obj2 20
41 21
42 -- | Set the spatial's Obj2. 22-- | A 2D transform.
43 setObj2 :: s -> Obj2 -> s 23newtype Transform2 = Transform2 { transform2Matrix :: Matrix3 } deriving Show
44 24
45-- | Move the spatial. 25
46move :: Spatial2 s => Vector2 -> s -> s 26instance Rotational Vector2 Vector2 Angle where
47move v s = let o = getObj2 s in setObj2 s $ o { p = p o + v } 27 setRotation angle v = norm v * Vector2 (cos angle) (sin angle)
48 28
49-- | Move the spatial forwards. 29 rotation v@(Vector2 x _) = acos (x / norm v)
50moveFwd :: Spatial2 s => Float -> s -> s 30
51moveFwd a s = let o = getObj2 s in setObj2 s $ o { p = p o + scale a (fwd o) } 31 rotate angle v = Vector2 (x v * cos angle) (y v * sin angle)
52 32
53-- | Move the spatial backwards. 33 right = perp
54moveBack :: Spatial2 s => Float -> s -> s 34
55moveBack a s = let o = getObj2 s in setObj2 s $ o { p = p o + scale (-a) (fwd o) } 35 up = id
56 36
57-- | Move the spatial up. 37 forward = id
58moveUp :: Spatial2 s => Float -> s -> s 38
59moveUp a s = let o = getObj2 s in setObj2 s $ o { p = p o + scale a (fwd o) } 39 setForward newForward _ = newForward
60 40
61-- | Move the spatial down. 41
62moveDown :: Spatial2 s => Float -> s -> s 42instance Positional Transform2 Vector2 where
63moveDown a s = let o = getObj2 s in setObj2 s $ o { p = p o + scale (-a) (fwd o) } 43 setPosition p (Transform2 matrix) =
64 44 Transform2 . Matrix3.setPosition p $ matrix
65-- | Make the spatial strafe left. 45
66moveLeft :: Spatial2 s => Float -> s -> s 46 position = Matrix3.position . transform2Matrix
67moveLeft a s = let o = getObj2 s in setObj2 s $ o { p = p o + scale (-a) (right o) } 47
68 48 translate v t@(Transform2 matrix) = setPosition (Matrix3.position matrix + v) t
69-- | Make the spatial Strafe right. 49
70moveRight :: Spatial2 s => Float -> s -> s 50
71moveRight a s = let o = getObj2 s in setObj2 s $ o { p = p o + scale a (right o) } 51instance Rotational Transform2 Vector2 Angle where
72 52 setRotation angle =
73-- | Rotate the spatial. 53 Transform2 . Matrix3.setRight r' . Matrix3.setUp u' . transform2Matrix
74rotate :: Spatial2 s => Float -> s -> s 54 where r' = Spatial.rotate angle unitx2
75rotate angle s = let o = getObj2 s in setObj2 s $ o 55 u' = Spatial.rotate angle unity2
76 { r = rotate' angle (r o) 56
77 , u = rotate' angle (u o) 57 rotation = rotation . Matrix3.right . transform2Matrix
78 } 58
79 59 rotate angle (Transform2 matrix) =
80-- | Set the spatial's rotation. 60 Transform2 . Matrix3.setRight r' . Matrix3.setUp u' $ matrix
81setRotation :: Spatial2 s => Float -> s -> s 61 where r' = Spatial.rotate angle (Matrix3.right matrix)
82setRotation angle s = let o = getObj2 s in setObj2 s $ o 62 u' = Spatial.rotate angle (Matrix3.up matrix)
83 { r = rotate' angle unitx2 63
84 , u = rotate' angle unity2 64 right = Matrix3.right . transform2Matrix
85 } 65
86 66 up = Matrix3.up . transform2Matrix
87rotate' :: Float -> Vector2 -> Vector2 67
88rotate' a' (Vector2 x y) = vec2 (x * cos a) (y * sin a) where a = a'*pi/180 68 forward = up
89 69
90-- | Get the spatial's position. 70 setForward forward (Transform2 matrix) =
91pos :: Spatial2 s => s -> Vector2 71 Transform2 $ Matrix3.transform (perp forward) forward (Matrix3.position matrix)
92pos = p . getObj2 72
93 73
94-- | Get the spatial's forward vector. 74instance Spatial Transform2 Vector2 Angle Matrix3 where
95fwd :: Spatial2 s => s -> Vector2 75 setTransform matrix _ = Transform2 matrix
96fwd = u . getObj2 76
97 77 transform (Transform2 matrix) = matrix
98-- | Get the spatial's up vector. 78
99up :: Spatial2 s => s -> Vector2 79
100up = u . getObj2 80class Has2dTransform a where
101 81 -- | Set the object's 2d transform.
102-- | Get the spatial's right vector. 82 set2dTransform :: Transform2 -> a -> a
103right :: Spatial2 s => s -> Vector2 83
104right = r . getObj2 84 -- | Get the object's 2d transform.
105 85 transform2 :: a -> Transform2
106-- | Get the spatial's transform. 86
107transform :: Spatial2 s => s -> M.Matrix3 87
108transform s = let o = getObj2 s in M.transform (r o) (u o) (p o) 88with2dTransform :: Has2dTransform a => (Transform2 -> Transform2) -> a -> a
109 89with2dTransform f obj = set2dTransform (f $ transform2 obj) obj
110-- | Set the spatial's transform. 90
111setTransform :: Spatial2 s => M.Matrix3 -> s -> s 91-- | Build a 2d transform from right, up, and position vectors.
112setTransform t s = 92newTransform2 :: Vector2 -> Vector2 -> Vector2 -> Transform2
113 let o = Obj2 (M.right t) (M.up t) (M.position t) 93newTransform2 right up position =
114 in setObj2 s o 94 Transform2 $ Matrix3.transform right up position
115 95
116-- | Set the spatial's position. 96-- | Get a transform matrix from a 2d positional.
117setPos :: Spatial2 s => Vector2 -> s -> s 97posTransform2 :: Positional a Vector2 => a -> Matrix3
118setPos pos s = setObj2 s $ (getObj2 s) { p = pos } 98posTransform2 = Matrix3.translatev . position
119 99
120-- | Make the spatial look at the given point. 100-- TODO: Get a transform matrix from a 2d rotational.
121lookAt :: Spatial2 s => Vector2 -> s -> s 101
122lookAt pt s = 102-- | Make the object orbit around the given point
123 let position = pos s 103--
124 fwd = normalise $ pt - position 104-- This only changes the object's position and not its direction. Use 'lookAt'
125 r = perp fwd 105-- to aim the object.
126 in setTransform (M.transform r fwd position) s 106orbit :: Positional a Vector2 => Vector2 -> Angle -> Radius -> a -> a
127
128-- | Make the 'Spatial' orbit around the given point
129orbit :: Spatial2 s => Vector2 -> Angle -> Radius -> s -> s
130orbit pt angle radius s = 107orbit pt angle radius s =
131 let a = angle * pi / 180 108 let px = x pt + radius * sin angle
132 px = (x pt) + radius * sin a 109 py = y pt + radius * cos angle
133 py = (y pt) + radius * cos a 110 in setPosition (vec2 px py) s
134 in setPos (vec2 px py) s
135
136-- | An object in 2D space.
137data Obj2 = Obj2
138 { r :: Vector2
139 , u :: Vector2
140 , p :: Vector2
141 } deriving Show
142
143instance Spatial2 Obj2 where
144 getObj2 = id
145 setObj2 _ o' = o'
146
147obj2FromVectors :: Right2 -> Up2 -> Position2 -> Obj2
148obj2FromVectors = Obj2
149
150obj2FromTransform :: M.Matrix3 -> Obj2
151obj2FromTransform m = Obj2 (M.right m) (M.up m) (M.position m) \ No newline at end of file
diff --git a/Spear/Math/Spatial3.hs b/Spear/Math/Spatial3.hs
index 896d5ae..0f804cc 100644
--- a/Spear/Math/Spatial3.hs
+++ b/Spear/Math/Spatial3.hs
@@ -1,179 +1,153 @@
1{-# LANGUAGE ConstraintKinds #-}
2{-# LANGUAGE FlexibleContexts #-}
3{-# LANGUAGE MultiParamTypeClasses #-}
4{-# LANGUAGE NoImplicitPrelude #-}
5{-# LANGUAGE TypeSynonymInstances #-}
6
1module Spear.Math.Spatial3 7module Spear.Math.Spatial3
2(
3 Spatial3(..)
4, Obj3
5, move
6, moveFwd
7, moveBack
8, moveLeft
9, moveRight
10, rotate
11, pitch
12, yaw
13, roll
14, pos
15, fwd
16, up
17, right
18, transform
19, setTransform
20, setPos
21, lookAt
22, Spear.Math.Spatial3.orbit
23, fromVectors
24, fromTransform
25)
26where 8where
27 9
28import Spear.Math.Vector 10import Spear.Math.Algebra
29import qualified Spear.Math.Matrix4 as M 11import qualified Spear.Math.Matrix4 as Matrix4
30 12import Spear.Math.Matrix4 (Matrix4)
31type Matrix4 = M.Matrix4 13import Spear.Math.Spatial
32 14import Spear.Math.Vector
33class Spatial3 s where 15import Spear.Prelude
34 16
35 -- | Gets the spatial's Obj3. 17
36 getObj3 :: s -> Obj3 18data Rotation3
37 19 = Pitch Angle
38 -- | Set the spatial's Obj3. 20 | Yaw Angle
39 setObj3 :: s -> Obj3 -> s 21 | Roll Angle
40 22 | AxisAngle Vector3 Angle
41-- | Move the spatial. 23 | RotationMatrix Matrix4
42move :: Spatial3 s => Vector3 -> s -> s 24
43move d s = let o = getObj3 s in setObj3 s $ o { p = p o + d } 25
44 26-- | A 3D transform.
45-- | Move the spatial forwards. 27newtype Transform3 = Transform3 { transform3Matrix :: Matrix4 } deriving Show
46moveFwd :: Spatial3 s => Float -> s -> s 28
47moveFwd a s = let o = getObj3 s in setObj3 s $ o { p = p o + scale a (f o) } 29
48 30type Positional3 a = Positional a Vector3
49-- | Move the spatial backwards. 31type Rotational3 a = Rotational a Angle
50moveBack :: Spatial3 s => Float -> s -> s 32type Spatial3 s = Spatial s Vector3 Rotation3 Transform3
51moveBack a s = let o = getObj3 s in setObj3 s $ o { p = p o + scale (-a) (f o) } 33
52 34
53-- | Make the spatial strafe left. 35instance Positional Transform3 Vector3 where
54moveLeft :: Spatial3 s => Float -> s -> s 36 setPosition p (Transform3 matrix) =
55moveLeft a s = let o = getObj3 s in setObj3 s $ o { p = p o + scale (-a) (r o) } 37 Transform3 . Matrix4.setPosition p $ matrix
56 38
57-- | Make the spatial Strafe right. 39 position = Matrix4.position . transform3Matrix
58moveRight :: Spatial3 s => Float -> s -> s 40
59moveRight a s = let o = getObj3 s in setObj3 s $ o { p = p o + scale a (r o) } 41 translate v t@(Transform3 matrix) = setPosition (Matrix4.position matrix + v) t
60 42
61-- | Rotate the spatial about the given axis. 43
62rotate :: Spatial3 s => Vector3 -> Float -> s -> s 44instance Rotational Transform3 Vector3 Rotation3 where
63rotate axis a s = 45 setRotation rotation _ = Transform3 $ case rotation of
64 let t = transform s 46 Pitch angle -> Matrix4.rotX angle
65 axis' = M.inverseTransform t `M.muld` axis 47 Yaw angle -> Matrix4.rotY angle
66 in setTransform (t * M.axisAngle axis' a) s 48 Roll angle -> Matrix4.rotZ angle
67 49 AxisAngle axis angle -> Matrix4.axisAngle axis angle
68-- | Rotate the spatial about its local X axis. 50 RotationMatrix matrix -> matrix
69pitch :: Spatial3 s => Float -> s -> s 51
70pitch a s = 52 rotation (Transform3 matrix) = RotationMatrix $ Matrix4.rotation matrix
71 let o = getObj3 s 53
72 a' = toRAD a 54 rotate rotation t@(Transform3 matrix) = case rotation of
73 sa = sin a' 55 Pitch angle -> pitch angle t
74 ca = cos a' 56 Yaw angle -> yaw angle t
75 f' = normalise $ scale ca (f o) + scale sa (u o) 57 Roll angle -> roll angle t
76 u' = normalise $ r o `cross` f' 58 AxisAngle axis angle -> Transform3 $ Matrix4.axisAngle axis angle * matrix
77 in setObj3 s $ o { u = u', f = f' } 59 RotationMatrix rot -> Transform3 $ rot * matrix
78 60
79-- | Rotate the spatial about its local Y axis. 61 right (Transform3 matrix) = Matrix4.right matrix
80yaw :: Spatial3 s => Float -> s -> s 62
81yaw a s = 63 up (Transform3 matrix) = Matrix4.up matrix
82 let o = getObj3 s 64
83 a' = toRAD a 65 forward (Transform3 matrix )= Matrix4.forward matrix
84 sa = sin a' 66
85 ca = cos a' 67 setForward forward (Transform3 matrix) =
86 r' = normalise $ scale ca (r o) + scale sa (f o) 68 let right = forward `cross` unity3
87 f' = normalise $ u o `cross` r' 69 up = right `cross` forward
88 in setObj3 s $ o { r = r', f = f' } 70 in Transform3 $ Matrix4.transform right up (neg forward) (Matrix4.position matrix)
89 71
90-- | Rotate the spatial about its local Z axis. 72
91roll :: Spatial3 s => Float -> s -> s 73instance Spatial Transform3 Vector3 Rotation3 Matrix4 where
92roll a s = 74 setTransform matrix _ = Transform3 $ Matrix4.transform
93 let o = getObj3 s 75 (Matrix4.right matrix)
94 a' = toRAD a 76 (Matrix4.up matrix)
95 sa = sin a' 77 (neg $ Matrix4.forward matrix)
96 ca = cos a' 78 (Matrix4.position matrix)
97 u' = normalise $ scale ca (u o) - scale sa (r o) 79
98 r' = normalise $ f o `cross` u' 80 transform (Transform3 matrix) = Matrix4.transform
99 in setObj3 s $ o { r = r', u = u' } 81 (Matrix4.right matrix)
100 82 (Matrix4.up matrix)
101-- | Get the spatial's position. 83 (neg $ Matrix4.forward matrix)
102pos :: Spatial3 s => s -> Vector3 84 (Matrix4.position matrix)
103pos = p . getObj3 85
104 86
105-- | Get the spatial's forward vector. 87class Has3dTransform a where
106fwd :: Spatial3 s => s -> Vector3 88 -- | Set the object's 3d transform.
107fwd = f . getObj3 89 set3dTransform :: Transform3 -> a -> a
108 90
109-- | Get the spatial's up vector. 91 -- | Get the object's 3d transform.
110up :: Spatial3 s => s -> Vector3 92 transform3 :: a -> Transform3
111up = u . getObj3 93
112 94
113-- | Get the spatial's right vector. 95with3dTransform :: Has3dTransform a => (Transform3 -> Transform3) -> a -> a
114right :: Spatial3 s => s -> Vector3 96with3dTransform f obj = set3dTransform (f $ transform3 obj) obj
115right = r . getObj3 97
116 98-- | Build a 3d transform from right, up, forward and position vectors.
117-- | Get the spatial's transform. 99newTransform3 :: Vector3 -> Vector3 -> Vector3 -> Vector3 -> Transform3
118transform :: Spatial3 s => s -> Matrix4 100newTransform3 right up forward pos = Transform3 $
119transform s = let o = getObj3 s in M.transform (r o) (u o) (scale (-1) $ f o) (p o) 101 Matrix4.transform right up (neg forward) pos
120 102
121-- | Set the spatial's transform. 103-- | Rotate the object about the given axis.
122setTransform :: Spatial3 s => Matrix4 -> s -> s 104rotate3 :: Vector3 -> Float -> Transform3 -> Transform3
123setTransform t s = 105rotate3 axis angle (Transform3 matrix) =
124 let o = Obj3 (M.right t) (M.up t) (scale (-1) $ M.forward t) (M.position t) 106 let axis' = Matrix4.inverseTransform matrix `Matrix4.muld` axis
125 in setObj3 s o 107 in Transform3 $ matrix * Matrix4.axisAngle axis' angle
126 108
127-- | Set the spatial's position. 109-- | Rotate the object about its local X axis.
128setPos :: Spatial3 s => Vector3 -> s -> s 110pitch :: Float -> Transform3 -> Transform3
129setPos pos s = setObj3 s $ (getObj3 s) { p = pos } 111pitch angle (Transform3 matrix) =
130 112 let sa = sin angle
131-- | Make the spatial look at the given point. 113 ca = cos angle
132lookAt :: Spatial3 s => Vector3 -> s -> s 114 f' = normalise $ (ca * Matrix4.forward matrix) + (sa * Matrix4.up matrix)
133lookAt pt s = 115 u' = normalise $ Matrix4.right matrix `cross` f'
134 let position = pos s 116 in Transform3 . Matrix4.setUp u' . Matrix4.setForward f' $ matrix
135 fwd = normalise $ pt - position 117
136 r = fwd `cross` unity3 118-- | Rotate the object about its local Y axis.
137 u = r `cross` fwd 119yaw :: Float -> Transform3 -> Transform3
138 in setTransform (M.transform r u (-fwd) position) s 120yaw angle (Transform3 matrix) =
139 121 let sa = sin angle
140-- | Make the spatial orbit around the given point 122 ca = cos angle
141orbit :: Spatial3 s 123 r' = normalise $ (ca * Matrix4.right matrix) + (sa * Matrix4.forward matrix)
124 f' = normalise $ Matrix4.up matrix `cross` r'
125 in Transform3 . Matrix4.setRight r' . Matrix4.setForward f' $ matrix
126
127-- | Rotate the object about its local Z axis.
128roll :: Float -> Transform3 -> Transform3
129roll angle (Transform3 matrix) =
130 let sa = sin angle
131 ca = cos angle
132 u' = normalise $ (ca * Matrix4.up matrix) - (sa * Matrix4.right matrix)
133 r' = normalise $ Matrix4.forward matrix `cross` u'
134 in Transform3 . Matrix4.setRight r' . Matrix4.setUp u' $ matrix
135
136
137-- | Make the object orbit around the given point
138orbit :: Positional a Vector3
142 => Vector3 -- ^ Target point 139 => Vector3 -- ^ Target point
143 -> Float -- ^ Horizontal angle 140 -> Float -- ^ Horizontal angle
144 -> Float -- ^ Vertical angle 141 -> Float -- ^ Vertical angle
145 -> Float -- ^ Orbit radius. 142 -> Float -- ^ Orbit radius.
146 -> s 143 -> a
147 -> s 144 -> a
148 145orbit pt anglex angley radius =
149orbit pt anglex angley radius s = 146 let sx = sin anglex
150 let ax = anglex * pi / 180 147 sy = sin angley
151 ay = angley * pi / 180 148 cx = cos anglex
152 sx = sin ax 149 cy = cos angley
153 sy = sin ay 150 px = x pt + radius*cy*sx
154 cx = cos ax 151 py = y pt + radius*sy
155 cy = cos ay 152 pz = z pt + radius*cx*cy
156 px = (x pt) + radius*cy*sx 153 in setPosition (vec3 px py pz)
157 py = (y pt) + radius*sy
158 pz = (z pt) + radius*cx*cy
159 in setPos (vec3 px py pz) s
160
161-- | An object in 3D space.
162data Obj3 = Obj3
163 { r :: Vector3
164 , u :: Vector3
165 , f :: Vector3
166 , p :: Vector3
167 } deriving Show
168
169instance Spatial3 Obj3 where
170 getObj3 = id
171 setObj3 _ o' = o'
172
173fromVectors :: Right3 -> Up3 -> Forward3 -> Position3 -> Obj3
174fromVectors = Obj3
175
176fromTransform :: Matrix4 -> Obj3
177fromTransform m = Obj3 (M.right m) (M.up m) (M.forward m) (M.position m)
178
179toRAD = (*pi) . (/180)
diff --git a/Spear/Math/Sphere.hs b/Spear/Math/Sphere.hs
index 197a9b2..1d20275 100644
--- a/Spear/Math/Sphere.hs
+++ b/Spear/Math/Sphere.hs
@@ -1,9 +1,17 @@
1{-# LANGUAGE MultiParamTypeClasses #-}
2{-# LANGUAGE NoImplicitPrelude #-}
3
1module Spear.Math.Sphere 4module Spear.Math.Sphere
2where 5where
3 6
4import Spear.Math.Vector 7import Spear.Math.Algebra
8import Spear.Math.Spatial
9import Spear.Math.Spatial3
10import Spear.Math.Vector
11import Spear.Prelude
12
13import Data.List (foldl')
5 14
6import Data.List (foldl')
7 15
8-- | A sphere in 3D space. 16-- | A sphere in 3D space.
9data Sphere = Sphere 17data Sphere = Sphere
@@ -11,12 +19,19 @@ data Sphere = Sphere
11 , radius :: {-# UNPACK #-} !Float 19 , radius :: {-# UNPACK #-} !Float
12 } 20 }
13 21
22
23instance Positional Sphere Vector3 where
24 setPosition p sphere = sphere { center = p }
25 position = center
26 translate v sphere = sphere { center = center sphere + v }
27
28
14-- | Create a sphere from the given points. 29-- | Create a sphere from the given points.
15sphere :: [Vector3] -> Sphere 30sphere :: [Vector3] -> Sphere
16sphere [] = Sphere zero3 0 31sphere [] = Sphere zero3 0
17sphere (x:xs) = Sphere c r 32sphere (x:xs) = Sphere c r
18 where 33 where
19 c = pmin + (pmax-pmin)/2 34 c = pmin + (pmax-pmin) / (2::Float)
20 r = norm $ pmax - c 35 r = norm $ pmax - c
21 (pmin,pmax) = foldl' update (x,x) xs 36 (pmin,pmax) = foldl' update (x,x) xs
22 update (pmin,pmax) p = (min p pmin, max p pmax) 37 update (pmin,pmax) p = (min p pmin, max p pmax)
diff --git a/Spear/Math/Triangle.hs b/Spear/Math/Triangle.hs
index 04c2639..c47879b 100644
--- a/Spear/Math/Triangle.hs
+++ b/Spear/Math/Triangle.hs
@@ -4,11 +4,12 @@ module Spear.Math.Triangle
4) 4)
5where 5where
6 6
7import Spear.Math.Algebra
8import Spear.Math.Vector
7 9
8import Spear.Math.Vector 10import Foreign.C.Types
9 11import Foreign.Storable
10import Foreign.C.Types 12import Prelude hiding ((*))
11import Foreign.Storable
12 13
13 14
14data Triangle = Triangle 15data Triangle = Triangle
@@ -18,23 +19,17 @@ data Triangle = Triangle
18 } 19 }
19 20
20 21
21sizeVector3 = 3 * sizeOf (undefined :: CFloat)
22
23
24instance Storable Triangle where 22instance Storable Triangle where
25 23 sizeOf _ = (3::Int) * sizeVector3
26 sizeOf _ = 3 * sizeVector3
27 alignment _ = alignment (undefined :: CFloat) 24 alignment _ = alignment (undefined :: CFloat)
28 25
29 peek ptr = do 26 peek ptr = do
30 p0 <- peekByteOff ptr 0 27 p0 <- peekByteOff ptr 0
31 p1 <- peekByteOff ptr $ 1 * sizeVector3 28 p1 <- peekByteOff ptr $ (1::Int) * sizeVector3
32 p2 <- peekByteOff ptr $ 2 * sizeVector3 29 p2 <- peekByteOff ptr $ (2::Int) * sizeVector3
33
34 return $ Triangle p0 p1 p2 30 return $ Triangle p0 p1 p2
35 31
36
37 poke ptr (Triangle p0 p1 p2) = do 32 poke ptr (Triangle p0 p1 p2) = do
38 pokeByteOff ptr 0 p0 33 pokeByteOff ptr 0 p0
39 pokeByteOff ptr (1*sizeVector3) p1 34 pokeByteOff ptr ((1::Int) * sizeVector3) p1
40 pokeByteOff ptr (2*sizeVector3) p2 35 pokeByteOff ptr ((2::Int) * sizeVector3) p2
diff --git a/Spear/Math/Utils.hs b/Spear/Math/Utils.hs
index 04c97bc..cd68cdc 100644
--- a/Spear/Math/Utils.hs
+++ b/Spear/Math/Utils.hs
@@ -1,3 +1,5 @@
1{-# LANGUAGE NoImplicitPrelude #-}
2
1module Spear.Math.Utils 3module Spear.Math.Utils
2( 4(
3 Side(..) 5 Side(..)
@@ -7,9 +9,10 @@ module Spear.Math.Utils
7) 9)
8where 10where
9 11
10 12import Spear.Math.Algebra
11import Spear.Math.Matrix4 as M4 13import Spear.Math.Matrix4 as M4
12import Spear.Math.Vector as V 14import Spear.Math.Vector as V
15import Spear.Prelude
13 16
14 17
15data Side = L | R deriving (Eq, Show) 18data Side = L | R deriving (Eq, Show)
@@ -33,6 +36,6 @@ viewToWorld2d p viewI =
33 p1 = viewI `mulp` p1' 36 p1 = viewI `mulp` p1'
34 p2 = p1 - M4.forward viewI 37 p2 = p1 - M4.forward viewI
35 lambda = (y p1 / (y p1 - y p2)) 38 lambda = (y p1 / (y p1 - y p2))
36 p' = p1 + V.scale lambda (p2 - p1) 39 p' = p1 + lambda * (p2 - p1)
37 in 40 in
38 vec2 (x p') (-z p') 41 vec2 (x p') (-z p')
diff --git a/Spear/Math/Vector/Vector.hs b/Spear/Math/Vector/Vector.hs
index 35b04e2..e7f6d53 100644
--- a/Spear/Math/Vector/Vector.hs
+++ b/Spear/Math/Vector/Vector.hs
@@ -1,43 +1,50 @@
1module Spear.Math.Vector.Vector 1{-# LANGUAGE FlexibleContexts #-}
2where 2
3 3module Spear.Math.Vector.Vector where
4class (Fractional a, Ord a) => Vector a where 4
5 -- | Create a vector from the given list. 5import Spear.Math.Algebra
6 fromList :: [Float] -> a 6
7 7
8 -- | Return the vector's x coordinate. 8class
9 x :: a -> Float 9 ( Addition v v
10 x _ = 0 10 , Subtraction v v
11 11 , Product v v v
12 -- | Return the vector's y coordinate. 12 , Product v Float v -- Scalar product.
13 y :: a -> Float 13 , Product Float v v) -- Scalar product.
14 y _ = 0 14 => Vector v where
15 15 -- | Create a vector from the given list.
16 -- | Return the vector's z coordinate. 16 fromList :: [Float] -> v
17 z :: a -> Float 17
18 z _ = 0 18 -- | Get the vector's x coordinate.
19 19 x :: v -> Float
20 -- | Return the vector's w coordinate. 20 x _ = 0
21 w :: a -> Float 21
22 w _ = 0 22 -- | Get the vector's y coordinate.
23 23 y :: v -> Float
24 -- | Return the vector's ith coordinate. 24 y _ = 0
25 (!) :: a -> Int -> Float 25
26 26 -- | Get the vector's z coordinate.
27 -- | Compute the given vectors' dot product. 27 z :: v -> Float
28 dot :: a -> a -> Float 28 z _ = 0
29 29
30 -- | Compute the given vector's squared norm. 30 -- | Get the vector's w coordinate.
31 normSq :: a -> Float 31 w :: v -> Float
32 32 w _ = 0
33 -- | Compute the given vector's norm. 33
34 norm :: a -> Float 34 -- | Get the vector's ith coordinate.
35 35 (!) :: v -> Int -> Float
36 -- | Multiply the given vector with the given scalar. 36
37 scale :: Float -> a -> a 37 -- | Compute the given vectors' dot product.
38 38 dot :: v -> v -> Float
39 -- | Negate the given vector. 39
40 neg :: a -> a 40 -- | Compute the given vector's squared norm.
41 41 normSq :: v -> Float
42 -- | Normalise the given vector. 42
43 normalise :: a -> a 43 -- | Compute the given vector's norm.
44 norm :: v -> Float
45
46 -- | Negate the given vector.
47 neg :: v -> v
48
49 -- | Normalise the given vector.
50 normalise :: v -> v
diff --git a/Spear/Math/Vector/Vector2.hs b/Spear/Math/Vector/Vector2.hs
index 5bbb632..1ede3a9 100644
--- a/Spear/Math/Vector/Vector2.hs
+++ b/Spear/Math/Vector/Vector2.hs
@@ -1,3 +1,7 @@
1{-# LANGUAGE MultiParamTypeClasses #-}
2{-# LANGUAGE NoImplicitPrelude #-}
3{-# LANGUAGE TypeFamilies #-}
4
1module Spear.Math.Vector.Vector2 5module Spear.Math.Vector.Vector2
2( 6(
3 Vector2(..) 7 Vector2(..)
@@ -14,30 +18,72 @@ module Spear.Math.Vector.Vector2
14) 18)
15where 19where
16 20
21import Spear.Math.Algebra
17import Spear.Math.Vector.Vector 22import Spear.Math.Vector.Vector
23import Spear.Prelude
18 24
19import Foreign.C.Types (CFloat) 25import Foreign.C.Types (CFloat)
20import Foreign.Storable 26import Foreign.Storable
27import qualified Prelude as P
28
21 29
22type Right2 = Vector2 30type Right2 = Vector2
23type Up2 = Vector2 31type Up2 = Vector2
24type Position2 = Vector2 32type Position2 = Vector2
25 33
34
26-- | Represents a vector in 2D. 35-- | Represents a vector in 2D.
27data Vector2 = Vector2 {-# UNPACK #-} !Float {-# UNPACK #-} !Float deriving (Eq, Show) 36data Vector2 = Vector2 {-# UNPACK #-} !Float {-# UNPACK #-} !Float deriving (Eq, Show)
28 37
29 38
30instance Num Vector2 where 39instance Addition Vector2 Vector2 where
40 {-# INLINABLE (+) #-}
31 Vector2 ax ay + Vector2 bx by = Vector2 (ax + bx) (ay + by) 41 Vector2 ax ay + Vector2 bx by = Vector2 (ax + bx) (ay + by)
42
43
44instance Subtraction Vector2 Vector2 where
45 {-# INLINABLE (-) #-}
32 Vector2 ax ay - Vector2 bx by = Vector2 (ax - bx) (ay - by) 46 Vector2 ax ay - Vector2 bx by = Vector2 (ax - bx) (ay - by)
47
48
49instance Product Vector2 Vector2 Vector2 where
50 {-# INLINABLE (*) #-}
33 Vector2 ax ay * Vector2 bx by = Vector2 (ax * bx) (ay * by) 51 Vector2 ax ay * Vector2 bx by = Vector2 (ax * bx) (ay * by)
52
53
54instance Quotient Vector2 Vector2 where
55 {-# INLINABLE (/) #-}
56 Vector2 ax ay / Vector2 bx by = Vector2 (ax / bx) (ay / by)
57
58
59-- Scalar product.
60instance Product Vector2 Float Vector2 where
61 {-# INLINABLE (*) #-}
62 (Vector2 x y) * s = Vector2 (s * x) (s * y)
63
64
65instance Product Float Vector2 Vector2 where
66 {-# INLINABLE (*) #-}
67 s * (Vector2 x y) = Vector2 (s * x) (s * y)
68
69
70-- Scalar division.
71instance Quotient Vector2 Float where
72 {-# INLINABLE (/) #-}
73 (Vector2 x y) / s = Vector2 (x / s) (y / s)
74
75
76instance Num Vector2 where
77 (+) = add
78 (-) = sub
79 (*) = mul
34 abs (Vector2 ax ay) = Vector2 (abs ax) (abs ay) 80 abs (Vector2 ax ay) = Vector2 (abs ax) (abs ay)
35 signum (Vector2 ax ay) = Vector2 (signum ax) (signum ay) 81 signum (Vector2 ax ay) = Vector2 (signum ax) (signum ay)
36 fromInteger i = Vector2 i' i' where i' = fromInteger i 82 fromInteger i = Vector2 i' i' where i' = fromInteger i
37 83
38 84
39instance Fractional Vector2 where 85instance Fractional Vector2 where
40 Vector2 ax ay / Vector2 bx by = Vector2 (ax / bx) (ay / by) 86 (/) = Spear.Math.Algebra.div
41 fromRational r = Vector2 r' r' where r' = fromRational r 87 fromRational r = Vector2 r' r' where r' = fromRational r
42 88
43 89
@@ -46,52 +92,49 @@ instance Ord Vector2 where
46 Vector2 ax ay >= Vector2 bx by = (ax >= bx) || (ax == bx && ay >= by) 92 Vector2 ax ay >= Vector2 bx by = (ax >= bx) || (ax == bx && ay >= by)
47 Vector2 ax ay < Vector2 bx by = (ax < bx) || (ax == bx && ay < by) 93 Vector2 ax ay < Vector2 bx by = (ax < bx) || (ax == bx && ay < by)
48 Vector2 ax ay > Vector2 bx by = (ax > bx) || (ax == bx && ay > by) 94 Vector2 ax ay > Vector2 bx by = (ax > bx) || (ax == bx && ay > by)
49 max (Vector2 ax ay) (Vector2 bx by) = Vector2 (Prelude.max ax bx) (Prelude.max ay by) 95 max (Vector2 ax ay) (Vector2 bx by) = Vector2 (max ax bx) (max ay by)
50 min (Vector2 ax ay) (Vector2 bx by) = Vector2 (Prelude.min ax bx) (Prelude.min ay by) 96 min (Vector2 ax ay) (Vector2 bx by) = Vector2 (min ax bx) (min ay by)
51 97
52 98
53instance Vector Vector2 where 99instance Vector Vector2 where
54 {-# INLINABLE fromList #-} 100 {-# INLINABLE fromList #-}
55 fromList (ax:ay:_) = Vector2 ax ay 101 fromList (ax:ay:_) = Vector2 ax ay
56
57 {-# INLINABLE x #-}
58 x (Vector2 ax _) = ax
59 102
60 {-# INLINABLE y #-} 103 {-# INLINABLE x #-}
61 y (Vector2 _ ay) = ay 104 x (Vector2 ax _) = ax
62 105
63 {-# INLINABLE (!) #-} 106 {-# INLINABLE y #-}
64 (Vector2 ax _) ! 0 = ax 107 y (Vector2 _ ay) = ay
65 (Vector2 _ ay) ! 1 = ay
66 _ ! _ = 0
67 108
68 {-# INLINABLE dot #-} 109 {-# INLINABLE (!) #-}
69 Vector2 ax ay `dot` Vector2 bx by = ax*bx + ay*by 110 (Vector2 ax _) ! 0 = ax
111 (Vector2 _ ay) ! 1 = ay
112 _ ! _ = 0
70 113
71 {-# INLINABLE normSq #-} 114 {-# INLINABLE dot #-}
72 normSq (Vector2 ax ay) = ax*ax + ay*ay 115 Vector2 ax ay `dot` Vector2 bx by = ax*bx + ay*by
73 116
74 {-# INLINABLE norm #-} 117 {-# INLINABLE normSq #-}
75 norm = sqrt . normSq 118 normSq (Vector2 ax ay) = ax*ax + ay*ay
76 119
77 {-# INLINABLE scale #-} 120 {-# INLINABLE norm #-}
78 scale s (Vector2 ax ay) = Vector2 (s*ax) (s*ay) 121 norm = sqrt . normSq
79 122
80 {-# INLINABLE neg #-} 123 {-# INLINABLE neg #-}
81 neg (Vector2 ax ay) = Vector2 (-ax) (-ay) 124 neg (Vector2 ax ay) = Vector2 (-ax) (-ay)
82 125
83 {-# INLINABLE normalise #-} 126 {-# INLINABLE normalise #-}
84 normalise v = 127 normalise v =
85 let n' = norm v 128 let n' = norm v
86 n = if n' == 0 then 1 else n' 129 n = if n' == 0 then 1 else n'
87 in scale (1.0 / n) v 130 in ((1.0::Float) / n) * v
88 131
89 132
90sizeFloat = sizeOf (undefined :: CFloat) 133sizeFloat = sizeOf (undefined :: CFloat)
91 134
92 135
93instance Storable Vector2 where 136instance Storable Vector2 where
94 sizeOf _ = 2*sizeFloat 137 sizeOf _ = (2::Int) * sizeFloat
95 alignment _ = alignment (undefined :: CFloat) 138 alignment _ = alignment (undefined :: CFloat)
96 139
97 peek ptr = do 140 peek ptr = do
@@ -115,9 +158,9 @@ zero2 = Vector2 0 0
115 158
116-- | Create a vector from the given values. 159-- | Create a vector from the given values.
117vec2 :: Float -> Float -> Vector2 160vec2 :: Float -> Float -> Vector2
118vec2 ax ay = Vector2 ax ay 161vec2 = Vector2
119 162
120-- | Compute a vector perpendicular to the given one, satisfying: 163-- | Compute a perpendicular vector satisfying:
121-- 164--
122-- perp (Vector2 0 1) = Vector2 1 0 165-- perp (Vector2 0 1) = Vector2 1 0
123-- 166--
diff --git a/Spear/Math/Vector/Vector3.hs b/Spear/Math/Vector/Vector3.hs
index 82deba2..9d44c8b 100644
--- a/Spear/Math/Vector/Vector3.hs
+++ b/Spear/Math/Vector/Vector3.hs
@@ -1,3 +1,7 @@
1{-# LANGUAGE MultiParamTypeClasses #-}
2{-# LANGUAGE NoImplicitPrelude #-}
3{-# LANGUAGE TypeFamilies #-}
4
1module Spear.Math.Vector.Vector3 5module Spear.Math.Vector.Vector3
2( 6(
3 Vector3(..) 7 Vector3(..)
@@ -5,6 +9,7 @@ module Spear.Math.Vector.Vector3
5, Up3 9, Up3
6, Forward3 10, Forward3
7, Position3 11, Position3
12, sizeVector3
8 -- * Construction 13 -- * Construction
9, unitx3 14, unitx3
10, unity3 15, unity3
@@ -17,15 +22,17 @@ module Spear.Math.Vector.Vector3
17) 22)
18where 23where
19 24
20 25import Spear.Math.Algebra
21import Spear.Math.Vector.Vector 26import Spear.Math.Vector.Vector
27import Spear.Prelude
22 28
23import Foreign.C.Types (CFloat) 29import Foreign.C.Types (CFloat)
24import Foreign.Storable 30import Foreign.Storable
31import qualified Prelude as P
25 32
26type Right3 = Vector3 33type Right3 = Vector3
27type Up3 = Vector3 34type Up3 = Vector3
28type Forward3 = Vector3 35type Forward3 = Vector3
29type Position3 = Vector3 36type Position3 = Vector3
30 37
31 38
@@ -36,17 +43,58 @@ data Vector3 = Vector3
36 {-# UNPACK #-} !Float 43 {-# UNPACK #-} !Float
37 deriving (Eq, Show) 44 deriving (Eq, Show)
38 45
39instance Num Vector3 where 46
47sizeVector3 = (3::Int) * sizeOf (undefined :: CFloat)
48
49
50instance Addition Vector3 Vector3 where
51 {-# INLINABLE (+) #-}
40 Vector3 ax ay az + Vector3 bx by bz = Vector3 (ax + bx) (ay + by) (az + bz) 52 Vector3 ax ay az + Vector3 bx by bz = Vector3 (ax + bx) (ay + by) (az + bz)
53
54
55instance Subtraction Vector3 Vector3 where
56 {-# INLINABLE (-) #-}
41 Vector3 ax ay az - Vector3 bx by bz = Vector3 (ax - bx) (ay - by) (az - bz) 57 Vector3 ax ay az - Vector3 bx by bz = Vector3 (ax - bx) (ay - by) (az - bz)
58
59
60instance Product Vector3 Vector3 Vector3 where
61 {-# INLINABLE (*) #-}
42 Vector3 ax ay az * Vector3 bx by bz = Vector3 (ax * bx) (ay * by) (az * bz) 62 Vector3 ax ay az * Vector3 bx by bz = Vector3 (ax * bx) (ay * by) (az * bz)
63
64
65instance Quotient Vector3 Vector3 where
66 {-# INLINABLE (/) #-}
67 Vector3 ax ay az / Vector3 bx by bz = Vector3 (ax / bx) (ay / by) (az / bz)
68
69
70-- Scalar product.
71instance Product Vector3 Float Vector3 where
72 {-# INLINABLE (*) #-}
73 (Vector3 x y z) * s = Vector3 (s * x) (s * y) (s * z)
74
75
76instance Product Float Vector3 Vector3 where
77 {-# INLINABLE (*) #-}
78 s * (Vector3 x y z) = Vector3 (s * x) (s * y) (s * z)
79
80
81-- Scalar division.
82instance Quotient Vector3 Float where
83 {-# INLINABLE (/) #-}
84 (Vector3 x y z) / s = Vector3 (x / s) (y / s) (y / s)
85
86
87instance Num Vector3 where
88 (+) = add
89 (-) = sub
90 (*) = mul
43 abs (Vector3 ax ay az) = Vector3 (abs ax) (abs ay) (abs az) 91 abs (Vector3 ax ay az) = Vector3 (abs ax) (abs ay) (abs az)
44 signum (Vector3 ax ay az) = Vector3 (signum ax) (signum ay) (signum az) 92 signum (Vector3 ax ay az) = Vector3 (signum ax) (signum ay) (signum az)
45 fromInteger i = Vector3 i' i' i' where i' = fromInteger i 93 fromInteger i = Vector3 i' i' i' where i' = fromInteger i
46 94
47 95
48instance Fractional Vector3 where 96instance Fractional Vector3 where
49 Vector3 ax ay az / Vector3 bx by bz = Vector3 (ax / bx) (ay / by) (az / bz) 97 (/) = Spear.Math.Algebra.div
50 fromRational r = Vector3 r' r' r' where r' = fromRational r 98 fromRational r = Vector3 r' r' r' where r' = fromRational r
51 99
52 100
@@ -71,91 +119,85 @@ instance Ord Vector3 where
71 || (ax == bx && ay > by) 119 || (ax == bx && ay > by)
72 || (ax == bx && ay == by && az > bz) 120 || (ax == bx && ay == by && az > bz)
73 121
74 max (Vector3 ax ay az) (Vector3 bx by bz) = Vector3 (Prelude.max ax bx) (Prelude.max ay by) (Prelude.max az bz) 122 max (Vector3 ax ay az) (Vector3 bx by bz) =
123 Vector3 (max ax bx) (max ay by) (max az bz)
75 124
76 min (Vector3 ax ay az) (Vector3 bx by bz) = Vector3 (Prelude.min ax bx) (Prelude.min ay by) (Prelude.min az bz) 125 min (Vector3 ax ay az) (Vector3 bx by bz) =
126 Vector3 (min ax bx) (min ay by) (min az bz)
77 127
78 128
79instance Vector Vector3 where 129instance Vector Vector3 where
80 {-# INLINABLE fromList #-} 130 {-# INLINABLE fromList #-}
81 fromList (ax:ay:az:_) = Vector3 ax ay az 131 fromList (ax:ay:az:_) = Vector3 ax ay az
82
83 {-# INLINABLE x #-}
84 x (Vector3 ax _ _ ) = ax
85 132
86 {-# INLINABLE y #-} 133 {-# INLINABLE x #-}
87 y (Vector3 _ ay _ ) = ay 134 x (Vector3 ax _ _ ) = ax
88 135
89 {-# INLINABLE z #-} 136 {-# INLINABLE y #-}
90 z (Vector3 _ _ az) = az 137 y (Vector3 _ ay _ ) = ay
91 138
92 {-# INLINABLE (!) #-} 139 {-# INLINABLE z #-}
93 (Vector3 ax _ _) ! 0 = ax 140 z (Vector3 _ _ az) = az
94 (Vector3 _ ay _) ! 1 = ay
95 (Vector3 _ _ az) ! 2 = az
96 _ ! _ = 0
97 141
98 {-# INLINABLE dot #-} 142 {-# INLINABLE (!) #-}
99 Vector3 ax ay az `dot` Vector3 bx by bz = ax*bx + ay*by + az*bz 143 (Vector3 ax _ _) ! 0 = ax
144 (Vector3 _ ay _) ! 1 = ay
145 (Vector3 _ _ az) ! 2 = az
146 _ ! _ = 0
100 147
101 {-# INLINABLE normSq #-} 148 {-# INLINABLE dot #-}
102 normSq (Vector3 ax ay az) = ax*ax + ay*ay + az*az 149 Vector3 ax ay az `dot` Vector3 bx by bz = ax*bx + ay*by + az*bz
103 150
104 {-# INLINABLE norm #-} 151 {-# INLINABLE normSq #-}
105 norm = sqrt . normSq 152 normSq (Vector3 ax ay az) = ax*ax + ay*ay + az*az
106 153
107 {-# INLINABLE scale #-} 154 {-# INLINABLE norm #-}
108 scale s (Vector3 ax ay az) = Vector3 (s*ax) (s*ay) (s*az) 155 norm = sqrt . normSq
109 156
110 {-# INLINABLE neg #-} 157 {-# INLINABLE neg #-}
111 neg (Vector3 ax ay az) = Vector3 (-ax) (-ay) (-az) 158 neg (Vector3 ax ay az) = Vector3 (-ax) (-ay) (-az)
112 159
113 {-# INLINABLE normalise #-} 160 {-# INLINABLE normalise #-}
114 normalise v = 161 normalise v =
115 let n' = norm v 162 let n' = norm v
116 n = if n' == 0 then 1 else n' 163 n = if n' == 0 then 1 else n'
117 in scale (1.0 / n) v 164 in ((1.0::Float) / n) * v
118 165
119 166
120sizeFloat = sizeOf (undefined :: CFloat) 167sizeFloat = sizeOf (undefined :: CFloat)
121 168
122 169
123instance Storable Vector3 where 170instance Storable Vector3 where
124 sizeOf _ = 3*sizeFloat 171 sizeOf _ = (3::Int) * sizeFloat
125 alignment _ = alignment (undefined :: CFloat) 172 alignment _ = alignment (undefined :: CFloat)
126 173
127 peek ptr = do 174 peek ptr = do
128 ax <- peekByteOff ptr 0 175 ax <- peekByteOff ptr 0
129 ay <- peekByteOff ptr $ 1*sizeFloat 176 ay <- peekByteOff ptr $ (1::Int) * sizeFloat
130 az <- peekByteOff ptr $ 2*sizeFloat 177 az <- peekByteOff ptr $ (2::Int) * sizeFloat
131 return (Vector3 ax ay az) 178 return (Vector3 ax ay az)
132 179
133 poke ptr (Vector3 ax ay az) = do 180 poke ptr (Vector3 ax ay az) = do
134 pokeByteOff ptr 0 ax 181 pokeByteOff ptr 0 ax
135 pokeByteOff ptr (1*sizeFloat) ay 182 pokeByteOff ptr ((1::Int) * sizeFloat) ay
136 pokeByteOff ptr (2*sizeFloat) az 183 pokeByteOff ptr ((2::Int) * sizeFloat) az
137 184
138 185
139-- | Unit vector along the X axis. 186-- | Unit vector along the X axis.
140unitx3 = Vector3 1 0 0 187unitx3 = Vector3 1 0 0
141 188
142
143-- | Unit vector along the Y axis. 189-- | Unit vector along the Y axis.
144unity3 = Vector3 0 1 0 190unity3 = Vector3 0 1 0
145 191
146
147-- | Unit vector along the Z axis. 192-- | Unit vector along the Z axis.
148unitz3 = Vector3 0 0 1 193unitz3 = Vector3 0 0 1
149 194
150
151-- | Zero vector. 195-- | Zero vector.
152zero3 = Vector3 0 0 0 196zero3 = Vector3 0 0 0
153 197
154
155-- | Create a 3D vector from the given values. 198-- | Create a 3D vector from the given values.
156vec3 :: Float -> Float -> Float -> Vector3 199vec3 :: Float -> Float -> Float -> Vector3
157vec3 ax ay az = Vector3 ax ay az 200vec3 = Vector3
158
159 201
160-- | Create a 3D vector as a point on a sphere. 202-- | Create a 3D vector as a point on a sphere.
161orbit :: Vector3 -- ^ Sphere center. 203orbit :: Vector3 -- ^ Sphere center.
@@ -163,21 +205,17 @@ orbit :: Vector3 -- ^ Sphere center.
163 -> Float -- ^ Azimuth angle. 205 -> Float -- ^ Azimuth angle.
164 -> Float -- ^ Zenith angle. 206 -> Float -- ^ Zenith angle.
165 -> Vector3 207 -> Vector3
166
167orbit center radius anglex angley = 208orbit center radius anglex angley =
168 let ax = anglex * pi / 180 209 let sx = sin anglex
169 ay = angley * pi / 180 210 sy = sin angley
170 sx = sin ax 211 cx = cos anglex
171 sy = sin ay 212 cy = cos angley
172 cx = cos ax
173 cy = cos ay
174 px = x center + radius*cy*sx 213 px = x center + radius*cy*sx
175 py = y center + radius*sy 214 py = y center + radius*sy
176 pz = z center + radius*cx*cy 215 pz = z center + radius*cx*cy
177 in 216 in
178 vec3 px py pz 217 vec3 px py pz
179 218
180
181-- | Compute the given vectors' cross product. 219-- | Compute the given vectors' cross product.
182cross :: Vector3 -> Vector3 -> Vector3 220cross :: Vector3 -> Vector3 -> Vector3
183(Vector3 ax ay az) `cross` (Vector3 bx by bz) = 221(Vector3 ax ay az) `cross` (Vector3 bx by bz) =
diff --git a/Spear/Math/Vector/Vector4.hs b/Spear/Math/Vector/Vector4.hs
index 325eefc..907295e 100644
--- a/Spear/Math/Vector/Vector4.hs
+++ b/Spear/Math/Vector/Vector4.hs
@@ -1,3 +1,7 @@
1{-# LANGUAGE MultiParamTypeClasses #-}
2{-# LANGUAGE NoImplicitPrelude #-}
3{-# LANGUAGE TypeFamilies #-}
4
1module Spear.Math.Vector.Vector4 5module Spear.Math.Vector.Vector4
2( 6(
3 Vector4(..) 7 Vector4(..)
@@ -11,11 +15,13 @@ module Spear.Math.Vector.Vector4
11) 15)
12where 16where
13 17
14 18import Spear.Math.Algebra
15import Spear.Math.Vector.Vector 19import Spear.Math.Vector.Vector
20import Spear.Prelude
16 21
17import Foreign.C.Types (CFloat) 22import Foreign.C.Types (CFloat)
18import Foreign.Storable 23import Foreign.Storable
24import qualified Prelude as P
19 25
20 26
21-- | Represents a vector in 3D. 27-- | Represents a vector in 3D.
@@ -27,17 +33,58 @@ data Vector4 = Vector4
27 deriving (Eq, Show) 33 deriving (Eq, Show)
28 34
29 35
36instance Addition Vector4 Vector4 where
37 {-# INLINABLE (+) #-}
38 Vector4 ax ay az aw + Vector4 bx by bz bw =
39 Vector4 (ax + bx) (ay + by) (az + bz) (aw + bw)
40
41
42instance Subtraction Vector4 Vector4 where
43 {-# INLINABLE (-) #-}
44 Vector4 ax ay az aw - Vector4 bx by bz bw =
45 Vector4 (ax - bx) (ay - by) (az - bz) (aw - bw)
46
47
48instance Product Vector4 Vector4 Vector4 where
49 {-# INLINABLE (*) #-}
50 Vector4 ax ay az aw * Vector4 bx by bz bw =
51 Vector4 (ax * bx) (ay * by) (az * bz) (aw * bw)
52
53
54instance Quotient Vector4 Vector4 where
55 {-# INLINABLE (/) #-}
56 Vector4 ax ay az aw / Vector4 bx by bz bw =
57 Vector4 (ax / bx) (ay / by) (az / bz) (aw / bw)
58
59
60-- Scalar product.
61instance Product Vector4 Float Vector4 where
62 {-# INLINABLE (*) #-}
63 (Vector4 x y z w) * s = Vector4 (s * x) (s * y) (s * z) (s * w)
64
65
66instance Product Float Vector4 Vector4 where
67 {-# INLINABLE (*) #-}
68 s * (Vector4 x y z w) = Vector4 (s * x) (s * y) (s * z) (s * w)
69
70
71-- Scalar division.
72instance Quotient Vector4 Float where
73 {-# INLINABLE (/) #-}
74 (Vector4 x y z w) / s = Vector4 (x / s) (y / s) (y / s) (w / s)
75
76
30instance Num Vector4 where 77instance Num Vector4 where
31 Vector4 ax ay az aw + Vector4 bx by bz bw = Vector4 (ax + bx) (ay + by) (az + bz) (aw + bw) 78 (+) = add
32 Vector4 ax ay az aw - Vector4 bx by bz bw = Vector4 (ax - bx) (ay - by) (az - bz) (aw - bw) 79 (-) = sub
33 Vector4 ax ay az aw * Vector4 bx by bz bw = Vector4 (ax * bx) (ay * by) (az * bz) (aw * bw) 80 (*) = mul
34 abs (Vector4 ax ay az aw) = Vector4 (abs ax) (abs ay) (abs az) (abs aw) 81 abs (Vector4 ax ay az aw) = Vector4 (abs ax) (abs ay) (abs az) (abs aw)
35 signum (Vector4 ax ay az aw) = Vector4 (signum ax) (signum ay) (signum az) (signum aw) 82 signum (Vector4 ax ay az aw) = Vector4 (signum ax) (signum ay) (signum az) (signum aw)
36 fromInteger i = Vector4 i' i' i' i' where i' = fromInteger i 83 fromInteger i = Vector4 i' i' i' i' where i' = fromInteger i
37 84
38 85
39instance Fractional Vector4 where 86instance Fractional Vector4 where
40 Vector4 ax ay az aw / Vector4 bx by bz bw = Vector4 (ax / bx) (ay / by) (az / bz) (aw / bw) 87 (/) = Spear.Math.Algebra.div
41 fromRational r = Vector4 r' r' r' r' where r' = fromRational r 88 fromRational r = Vector4 r' r' r' r' where r' = fromRational r
42 89
43 90
@@ -67,97 +114,90 @@ instance Ord Vector4 where
67 || (ax == bx && ay == by && az == bz && aw > bw) 114 || (ax == bx && ay == by && az == bz && aw > bw)
68 115
69 min (Vector4 ax ay az aw) (Vector4 bx by bz bw) = 116 min (Vector4 ax ay az aw) (Vector4 bx by bz bw) =
70 Vector4 (Prelude.min ax bx) (Prelude.min ay by) (Prelude.min az bz) (Prelude.min aw bw) 117 Vector4 (min ax bx) (min ay by) (min az bz) (min aw bw)
71 118
72 max (Vector4 ax ay az aw) (Vector4 bx by bz bw) = 119 max (Vector4 ax ay az aw) (Vector4 bx by bz bw) =
73 Vector4 (Prelude.max ax bx) (Prelude.max ay by) (Prelude.max az bz) (Prelude.min aw bw) 120 Vector4 (max ax bx) (max ay by) (max az bz) (min aw bw)
74 121
75 122
76instance Vector Vector4 where 123instance Vector Vector4 where
77 {-# INLINABLE fromList #-} 124 {-# INLINABLE fromList #-}
78 fromList (ax:ay:az:aw:_) = Vector4 ax ay az aw 125 fromList (ax:ay:az:aw:_) = Vector4 ax ay az aw
79 126
80 {-# INLINABLE x #-} 127 {-# INLINABLE x #-}
81 x (Vector4 ax _ _ _ ) = ax 128 x (Vector4 ax _ _ _ ) = ax
82 129
83 {-# INLINABLE y #-} 130 {-# INLINABLE y #-}
84 y (Vector4 _ ay _ _ ) = ay 131 y (Vector4 _ ay _ _ ) = ay
85 132
86 {-# INLINABLE z #-} 133 {-# INLINABLE z #-}
87 z (Vector4 _ _ az _ ) = az 134 z (Vector4 _ _ az _ ) = az
88 135
89 {-# INLINABLE w #-} 136 {-# INLINABLE w #-}
90 w (Vector4 _ _ _ aw) = aw 137 w (Vector4 _ _ _ aw) = aw
91 138
92 {-# INLINABLE (!) #-} 139 {-# INLINABLE (!) #-}
93 (Vector4 ax _ _ _) ! 0 = ax 140 (Vector4 ax _ _ _) ! 0 = ax
94 (Vector4 _ ay _ _) ! 1 = ay 141 (Vector4 _ ay _ _) ! 1 = ay
95 (Vector4 _ _ az _) ! 2 = az 142 (Vector4 _ _ az _) ! 2 = az
96 (Vector4 _ _ _ aw) ! 3 = aw 143 (Vector4 _ _ _ aw) ! 3 = aw
97 _ ! _ = 0 144 _ ! _ = 0
98 145
99 {-# INLINABLE dot #-} 146 {-# INLINABLE dot #-}
100 Vector4 ax ay az aw `dot` Vector4 bx by bz bw = ax*bx + ay*by + az*bz + aw*bw 147 Vector4 ax ay az aw `dot` Vector4 bx by bz bw = ax*bx + ay*by + az*bz + aw*bw
101 148
102 {-# INLINABLE normSq #-} 149 {-# INLINABLE normSq #-}
103 normSq (Vector4 ax ay az aw) = ax*ax + ay*ay + az*az + aw*aw 150 normSq (Vector4 ax ay az aw) = ax*ax + ay*ay + az*az + aw*aw
104 151
105 {-# INLINABLE norm #-} 152 {-# INLINABLE norm #-}
106 norm = sqrt . normSq 153 norm = sqrt . normSq
107 154
108 {-# INLINABLE scale #-} 155 {-# INLINABLE neg #-}
109 scale s (Vector4 ax ay az aw) = Vector4 (s*ax) (s*ay) (s*az) (s*aw) 156 neg (Vector4 ax ay az aw) = Vector4 (-ax) (-ay) (-az) (-aw)
110 157
111 {-# INLINABLE neg #-} 158 {-# INLINABLE normalise #-}
112 neg (Vector4 ax ay az aw) = Vector4 (-ax) (-ay) (-az) (-aw) 159 normalise v =
113 160 let n' = norm v
114 {-# INLINABLE normalise #-} 161 n = if n' == 0 then 1 else n'
115 normalise v = 162 in ((1.0::Float) / n) * v
116 let n' = norm v
117 n = if n' == 0 then 1 else n'
118 in scale (1.0 / n) v
119 163
120 164
121sizeFloat = sizeOf (undefined :: CFloat) 165sizeFloat = sizeOf (undefined :: CFloat)
122 166
123 167
124instance Storable Vector4 where 168instance Storable Vector4 where
125 sizeOf _ = 4*sizeFloat 169 sizeOf _ = (4::Int) * sizeFloat
126 alignment _ = alignment (undefined :: CFloat) 170 alignment _ = alignment (undefined :: CFloat)
127 171
128 peek ptr = do 172 peek ptr = do
129 ax <- peekByteOff ptr 0 173 ax <- peekByteOff ptr 0
130 ay <- peekByteOff ptr $ 1 * sizeFloat 174 ay <- peekByteOff ptr $ (1::Int) * sizeFloat
131 az <- peekByteOff ptr $ 2 * sizeFloat 175 az <- peekByteOff ptr $ (2::Int) * sizeFloat
132 aw <- peekByteOff ptr $ 3 * sizeFloat 176 aw <- peekByteOff ptr $ (3::Int) * sizeFloat
133 return (Vector4 ax ay az aw) 177 return (Vector4 ax ay az aw)
134 178
135 poke ptr (Vector4 ax ay az aw) = do 179 poke ptr (Vector4 ax ay az aw) = do
136 pokeByteOff ptr 0 ax 180 pokeByteOff ptr 0 ax
137 pokeByteOff ptr (1 * sizeFloat) ay 181 pokeByteOff ptr ((1::Int) * sizeFloat) ay
138 pokeByteOff ptr (2 * sizeFloat) az 182 pokeByteOff ptr ((2::Int) * sizeFloat) az
139 pokeByteOff ptr (3 * sizeFloat) aw 183 pokeByteOff ptr ((3::Int) * sizeFloat) aw
140 184
141 185
142-- | Unit vector along the X axis. 186-- | Unit vector along the X axis.
143unitx4 = Vector4 1 0 0 0 187unitx4 = Vector4 1 0 0 0
144 188
145
146-- | Unit vector along the Y axis. 189-- | Unit vector along the Y axis.
147unity4 = Vector4 0 1 0 0 190unity4 = Vector4 0 1 0 0
148 191
149
150-- | Unit vector along the Z axis. 192-- | Unit vector along the Z axis.
151unitz4 = Vector4 0 0 1 0 193unitz4 = Vector4 0 0 1 0
152 194
153-- | Unit vector along the W axis. 195-- | Unit vector along the W axis.
154unitw4 = Vector4 0 0 0 1 196unitw4 = Vector4 0 0 0 1
155 197
156
157-- | Create a 4D vector from the given values. 198-- | Create a 4D vector from the given values.
158vec4 :: Float -> Float -> Float -> Float -> Vector4 199vec4 :: Float -> Float -> Float -> Float -> Vector4
159vec4 ax ay az aw = Vector4 ax ay az aw 200vec4 = Vector4
160
161 201
162-- | Compute the given vectors' cross product. 202-- | Compute the given vectors' cross product.
163-- The vectors are projected to 3D space. The resulting vector is the cross product of the vectors' projections with w=0. 203-- The vectors are projected to 3D space. The resulting vector is the cross product of the vectors' projections with w=0.
diff --git a/Spear/Prelude.hs b/Spear/Prelude.hs
new file mode 100644
index 0000000..3c5fcac
--- /dev/null
+++ b/Spear/Prelude.hs
@@ -0,0 +1,10 @@
1{-# LANGUAGE NoImplicitPrelude #-}
2
3module Spear.Prelude
4( module BasePrelude
5, module Spear.Math.Algebra
6) where
7
8import Prelude as BasePrelude hiding (div, (*), (+), (-),
9 (/))
10import Spear.Math.Algebra
diff --git a/Spear/Render/AnimatedModel.hs b/Spear/Render/AnimatedModel.hs
index e69ce75..966fcc2 100644
--- a/Spear/Render/AnimatedModel.hs
+++ b/Spear/Render/AnimatedModel.hs
@@ -1,3 +1,6 @@
1
2{-# LANGUAGE NoImplicitPrelude #-}
3
1module Spear.Render.AnimatedModel 4module Spear.Render.AnimatedModel
2 ( -- * Data types 5 ( -- * Data types
3 AnimatedModelResource, 6 AnimatedModelResource,
@@ -31,19 +34,24 @@ module Spear.Render.AnimatedModel
31 ) 34 )
32where 35where
33 36
34import Control.Applicative ((<$>), (<*>)) 37import Spear.Assets.Model
35import qualified Data.Vector as V 38import Spear.Game
36import Spear.Assets.Model 39import Spear.GL
37import Spear.GL 40import Spear.Math.AABB
38import Spear.Game 41import Spear.Math.Algebra
39import Spear.Math.AABB 42import Spear.Math.Collision
40import Spear.Math.Collision 43import Spear.Math.Matrix4 (Matrix4)
41import Spear.Math.Matrix4 (Matrix4) 44import Spear.Math.Vector
42import Spear.Math.Vector 45import Spear.Prelude
43import Spear.Render.Material 46import Spear.Render.Material
44import Spear.Render.Model 47import Spear.Render.Model
45import Spear.Render.Program 48import Spear.Render.Program
46import Unsafe.Coerce (unsafeCoerce) 49
50import Control.Applicative ((<$>), (<*>))
51import qualified Data.Vector as V
52import Foreign.C.Types
53import Unsafe.Coerce (unsafeCoerce)
54
47 55
48type AnimationSpeed = Float 56type AnimationSpeed = Float
49 57
@@ -51,14 +59,14 @@ type AnimationSpeed = Float
51-- 59--
52-- Contains model data necessary to render an animated model. 60-- Contains model data necessary to render an animated model.
53data AnimatedModelResource = AnimatedModelResource 61data AnimatedModelResource = AnimatedModelResource
54 { model :: Model, 62 { model :: Model,
55 vao :: VAO, 63 vao :: VAO,
56 nFrames :: Int, 64 nFrames :: Int,
57 nVertices :: Int, 65 nVertices :: Int,
58 material :: Material, 66 material :: Material,
59 texture :: Texture, 67 texture :: Texture,
60 boxes :: V.Vector Box, 68 boxes :: V.Vector Box,
61 rkey :: Resource 69 rkey :: Resource
62 } 70 }
63 71
64instance Eq AnimatedModelResource where 72instance Eq AnimatedModelResource where
@@ -82,14 +90,14 @@ instance ResourceClass AnimatedModelResource where
82-- state changes by sorting 'AnimatedModelRenderer's by their underlying 90-- state changes by sorting 'AnimatedModelRenderer's by their underlying
83-- 'AnimatedModelResource' when rendering the scene. 91-- 'AnimatedModelResource' when rendering the scene.
84data AnimatedModelRenderer = AnimatedModelRenderer 92data AnimatedModelRenderer = AnimatedModelRenderer
85 { modelResource :: AnimatedModelResource, 93 { modelResource :: AnimatedModelResource,
86 currentAnim :: Int, 94 currentAnim :: Int,
87 frameStart :: Int, 95 frameStart :: Int,
88 frameEnd :: Int, 96 frameEnd :: Int,
89 -- | Get the renderer's current frame. 97 -- | Get the renderer's current frame.
90 currentFrame :: Int, 98 currentFrame :: Int,
91 -- | Get the renderer's frame progress. 99 -- | Get the renderer's frame progress.
92 frameProgress :: Float, 100 frameProgress :: Float,
93 -- | Get the renderer's animation speed. 101 -- | Get the renderer's animation speed.
94 animationSpeed :: Float 102 animationSpeed :: Float
95 } 103 }
@@ -119,7 +127,7 @@ animatedModelResource
119 boxes <- gameIO $ modelBoxes model 127 boxes <- gameIO $ modelBoxes model
120 128
121 gameIO $ do 129 gameIO $ do
122 let elemSize = 56 130 let elemSize = 56::CUInt
123 elemSize' = fromIntegral elemSize 131 elemSize' = fromIntegral elemSize
124 n = numVertices * numFrames 132 n = numVertices * numFrames
125 133
@@ -132,7 +140,7 @@ animatedModelResource
132 attribVAOPointer vertChan2 3 GL_FLOAT False elemSize' 12 140 attribVAOPointer vertChan2 3 GL_FLOAT False elemSize' 12
133 attribVAOPointer normChan1 3 GL_FLOAT False elemSize' 24 141 attribVAOPointer normChan1 3 GL_FLOAT False elemSize' 24
134 attribVAOPointer normChan2 3 GL_FLOAT False elemSize' 36 142 attribVAOPointer normChan2 3 GL_FLOAT False elemSize' 36
135 attribVAOPointer texChan 2 GL_FLOAT False elemSize' 48 143 attribVAOPointer texChan 2 GL_FLOAT False elemSize' 48
136 144
137 enableVAOAttrib vertChan1 145 enableVAOAttrib vertChan1
138 enableVAOAttrib vertChan2 146 enableVAOAttrib vertChan2
@@ -162,17 +170,18 @@ animatedModelRenderer animSpeed modelResource =
162 AnimatedModelRenderer modelResource 0 0 0 0 0 animSpeed 170 AnimatedModelRenderer modelResource 0 0 0 0 0 animSpeed
163 171
164-- | Update the renderer. 172-- | Update the renderer.
173update :: Float -> AnimatedModelRenderer -> AnimatedModelRenderer
165update dt (AnimatedModelRenderer model curAnim startFrame endFrame curFrame fp s) = 174update dt (AnimatedModelRenderer model curAnim startFrame endFrame curFrame fp s) =
166 AnimatedModelRenderer model curAnim startFrame endFrame curFrame' fp' s 175 AnimatedModelRenderer model curAnim startFrame endFrame curFrame' fp' s
167 where 176 where
168 f = fp + dt * s 177 f = fp + dt * s
169 nextFrame = f >= 1.0 178 nextFrame = f >= 1.0
170 fp' = if nextFrame then f - 1.0 else f 179 fp' = if nextFrame then f - (1::Float) else f
171 curFrame' = 180 curFrame' =
172 if nextFrame 181 if nextFrame
173 then 182 then
174 let x = curFrame + 1 183 let x = curFrame + (1::Int)
175 in if x > endFrame then startFrame else x 184 in if x > endFrame then startFrame else x
176 else curFrame 185 else curFrame
177 186
178-- | Get the model's ith bounding box. 187-- | Get the model's ith bounding box.
@@ -193,7 +202,7 @@ nextFrame rend =
193 let curFrame = currentFrame rend 202 let curFrame = currentFrame rend
194 in if curFrame == frameEnd rend 203 in if curFrame == frameEnd rend
195 then frameStart rend 204 then frameStart rend
196 else curFrame + 1 205 else curFrame + (1::Int)
197 206
198-- | Set the active animation to the given one. 207-- | Set the active animation to the given one.
199setAnimation :: Enum a => a -> AnimatedModelRenderer -> AnimatedModelRenderer 208setAnimation :: Enum a => a -> AnimatedModelRenderer -> AnimatedModelRenderer
@@ -248,7 +257,7 @@ mkColsFromAnimated f1 f2 fp modelview modelRes =
248 max1 = vec3 xmax1 ymax1 zmax1 257 max1 = vec3 xmax1 ymax1 zmax1
249 min2 = vec3 xmin2 ymin2 zmin2 258 min2 = vec3 xmin2 ymin2 zmin2
250 max2 = vec3 xmax2 ymax2 zmax2 259 max2 = vec3 xmax2 ymax2 zmax2
251 min = min1 + scale fp (min2 - min1) 260 min = min1 + fp * (min2 - min1)
252 max = max1 + scale fp (max2 - max1) 261 max = max1 + fp * (max2 - max1)
253 in mkCols modelview $ 262 in mkCols modelview $
254 Box (Vec3 (x min) (y min) (z min)) (Vec3 (x max) (y max) (z max)) 263 Box (Vec3 (x min) (y min) (z min)) (Vec3 (x max) (y max) (z max))
diff --git a/Spear/Render/StaticModel.hs b/Spear/Render/StaticModel.hs
index f0b141e..327e8b0 100644
--- a/Spear/Render/StaticModel.hs
+++ b/Spear/Render/StaticModel.hs
@@ -20,26 +20,31 @@ module Spear.Render.StaticModel
20 ) 20 )
21where 21where
22 22
23import qualified Data.Vector as V 23import Spear.Assets.Model
24import Spear.Assets.Model 24import Spear.Game
25import Spear.GL 25import Spear.GL
26import Spear.Game 26import Spear.Math.AABB
27import Spear.Math.AABB 27import Spear.Math.Algebra
28import Spear.Math.Collision 28import Spear.Math.Collision
29import Spear.Math.Matrix4 (Matrix4) 29import Spear.Math.Matrix4 (Matrix4)
30import Spear.Math.Vector 30import Spear.Math.Vector
31import Spear.Render.Material 31import Spear.Render.Material
32import Spear.Render.Model 32import Spear.Render.Model
33import Spear.Render.Program 33import Spear.Render.Program
34import Unsafe.Coerce (unsafeCoerce) 34
35import qualified Data.Vector as V
36import Foreign.C.Types
37import Prelude hiding ((*))
38import Unsafe.Coerce (unsafeCoerce)
39
35 40
36data StaticModelResource = StaticModelResource 41data StaticModelResource = StaticModelResource
37 { vao :: VAO, 42 { vao :: VAO,
38 nVertices :: Int, 43 nVertices :: Int,
39 material :: Material, 44 material :: Material,
40 texture :: Texture, 45 texture :: Texture,
41 boxes :: V.Vector Box, 46 boxes :: V.Vector Box,
42 rkey :: Resource 47 rkey :: Resource
43 } 48 }
44 49
45instance Eq StaticModelResource where 50instance Eq StaticModelResource where
@@ -75,7 +80,7 @@ staticModelResource (StaticProgramChannels vertChan normChan texChan) material t
75 boxes <- gameIO $ modelBoxes model 80 boxes <- gameIO $ modelBoxes model
76 81
77 gameIO $ do 82 gameIO $ do
78 let elemSize = 32 83 let elemSize = 32::CUInt
79 elemSize' = fromIntegral elemSize 84 elemSize' = fromIntegral elemSize
80 n = numVertices 85 n = numVertices
81 86
diff --git a/Spear/Scene/Loader.hs b/Spear/Scene/Loader.hs
index a4a7ea2..668a495 100644
--- a/Spear/Scene/Loader.hs
+++ b/Spear/Scene/Loader.hs
@@ -15,26 +15,28 @@ module Spear.Scene.Loader
15 ) 15 )
16where 16where
17 17
18import Control.Monad.State.Strict 18import Control.Monad.State.Strict
19import Control.Monad.Trans (lift) 19import Control.Monad.Trans (lift)
20import Data.List as L (find) 20import Data.List as L (find)
21import Data.Map as M 21import Data.Map as M
22import qualified Data.StateVar as SV (get) 22import qualified Data.StateVar as SV (get)
23import Spear.Assets.Model as Model 23import Prelude hiding ((*))
24import qualified Spear.GL as GL 24import Spear.Assets.Model as Model
25import Spear.Game 25import Spear.Game
26import Spear.Math.Collision 26import qualified Spear.GL as GL
27import Spear.Math.Matrix3 as M3 27import Spear.Math.Algebra
28import Spear.Math.Matrix4 as M4 28import Spear.Math.Collision
29import Spear.Math.MatrixUtils (fastNormalMatrix) 29import Spear.Math.Matrix3 as M3
30import Spear.Math.Vector 30import Spear.Math.Matrix4 as M4
31import Spear.Render.AnimatedModel as AM 31import Spear.Math.MatrixUtils (fastNormalMatrix)
32import Spear.Render.Material 32import Spear.Math.Vector
33import Spear.Render.Program 33import Spear.Render.AnimatedModel as AM
34import Spear.Render.StaticModel as SM 34import Spear.Render.Material
35import Spear.Scene.Graph 35import Spear.Render.Program
36import Spear.Scene.SceneResources 36import Spear.Render.StaticModel as SM
37import Text.Printf (printf) 37import Spear.Scene.Graph
38import Spear.Scene.SceneResources
39import Text.Printf (printf)
38 40
39type Loader = Game SceneResources 41type Loader = Game SceneResources
40 42
@@ -62,8 +64,8 @@ resourceMap' :: SceneGraph -> Loader ()
62resourceMap' node@(SceneLeaf nid props) = do 64resourceMap' node@(SceneLeaf nid props) = do
63 case nid of 65 case nid of
64 "shader-program" -> newShaderProgram node 66 "shader-program" -> newShaderProgram node
65 "model" -> newModel node 67 "model" -> newModel node
66 x -> return () 68 x -> return ()
67resourceMap' node@(SceneNode nid props children) = do 69resourceMap' node@(SceneNode nid props children) = do
68 mapM_ resourceMap' children 70 mapM_ resourceMap' children
69 71
@@ -169,7 +171,7 @@ loadModel' :: FilePath -> Maybe Rotation -> Maybe Vector3 -> Game s Model
169loadModel' file rotation scale = do 171loadModel' file rotation scale = do
170 let transform = 172 let transform =
171 ( case rotation of 173 ( case rotation of
172 Nothing -> Prelude.id 174 Nothing -> Prelude.id
173 Just rot -> rotateModel rot 175 Just rot -> rotateModel rot
174 ) 176 )
175 . ( case scale of 177 . ( case scale of
@@ -300,17 +302,17 @@ loadShader' file shaderType = loadResource file shaders addShader $ GL.loadShade
300-- Get the value of the given key. 302-- Get the value of the given key.
301value :: String -> [Property] -> Maybe [String] 303value :: String -> [Property] -> Maybe [String]
302value name props = case L.find ((==) name . fst) props of 304value name props = case L.find ((==) name . fst) props of
303 Nothing -> Nothing 305 Nothing -> Nothing
304 Just prop -> Just . snd $ prop 306 Just prop -> Just . snd $ prop
305 307
306unspecified :: Maybe a -> a -> a 308unspecified :: Maybe a -> a -> a
307unspecified (Just x) _ = x 309unspecified (Just x) _ = x
308unspecified Nothing x = x 310unspecified Nothing x = x
309 311
310mandatory :: String -> [Property] -> Game s [String] 312mandatory :: String -> [Property] -> Game s [String]
311mandatory name props = case value name props of 313mandatory name props = case value name props of
312 Nothing -> gameError $ "Loader::mandatory: key not found: " ++ name 314 Nothing -> gameError $ "Loader::mandatory: key not found: " ++ name
313 Just x -> return x 315 Just x -> return x
314 316
315mandatory' :: String -> [Property] -> Loader [String] 317mandatory' :: String -> [Property] -> Loader [String]
316mandatory' name props = mandatory name props 318mandatory' name props = mandatory name props
@@ -325,19 +327,19 @@ asVec2 :: Functor f => f [String] -> f Vector2
325asVec2 val = fmap toVec2 val 327asVec2 val = fmap toVec2 val
326 where 328 where
327 toVec2 (x : y : _) = vec2 (read x) (read y) 329 toVec2 (x : y : _) = vec2 (read x) (read y)
328 toVec2 (x : []) = let x' = read x in vec2 x' x' 330 toVec2 (x : []) = let x' = read x in vec2 x' x'
329 331
330asVec3 :: Functor f => f [String] -> f Vector3 332asVec3 :: Functor f => f [String] -> f Vector3
331asVec3 val = fmap toVec3 val 333asVec3 val = fmap toVec3 val
332 where 334 where
333 toVec3 (x : y : z : _) = vec3 (read x) (read y) (read z) 335 toVec3 (x : y : z : _) = vec3 (read x) (read y) (read z)
334 toVec3 (x : []) = let x' = read x in vec3 x' x' x' 336 toVec3 (x : []) = let x' = read x in vec3 x' x' x'
335 337
336asVec4 :: Functor f => f [String] -> f Vector4 338asVec4 :: Functor f => f [String] -> f Vector4
337asVec4 val = fmap toVec4 val 339asVec4 val = fmap toVec4 val
338 where 340 where
339 toVec4 (x : y : z : w : _) = vec4 (read x) (read y) (read z) (read w) 341 toVec4 (x : y : z : w : _) = vec4 (read x) (read y) (read z) (read w)
340 toVec4 (x : []) = let x' = read x in vec4 x' x' x' x' 342 toVec4 (x : []) = let x' = read x in vec4 x' x' x' x'
341 343
342asRotation :: Functor f => f [String] -> f Rotation 344asRotation :: Functor f => f [String] -> f Rotation
343asRotation val = fmap parseRotation val 345asRotation val = fmap parseRotation val
@@ -345,9 +347,9 @@ asRotation val = fmap parseRotation val
345 parseRotation (ax : ay : az : order : _) = Rotation (read ax) (read ay) (read az) (readOrder order) 347 parseRotation (ax : ay : az : order : _) = Rotation (read ax) (read ay) (read az) (readOrder order)
346 348
347data Rotation = Rotation 349data Rotation = Rotation
348 { ax :: Float, 350 { ax :: Float,
349 ay :: Float, 351 ay :: Float,
350 az :: Float, 352 az :: Float,
351 order :: RotationOrder 353 order :: RotationOrder
352 } 354 }
353 355
diff --git a/Spear/Step.hs b/Spear/Step.hs
index 609f387..cb4f71c 100644
--- a/Spear/Step.hs
+++ b/Spear/Step.hs
@@ -31,7 +31,7 @@ import Data.Map (Map)
31import qualified Data.Map as Map 31import qualified Data.Map as Map
32import Data.Monoid 32import Data.Monoid
33 33
34type Elapsed = Double 34type Elapsed = Float
35 35
36type Dt = Float 36type Dt = Float
37 37
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-21 23:28:04 +0000