diff options
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 | |||
8 | import Spear.App | 8 | import Spear.App |
9 | import Spear.Game | 9 | import Spear.Game |
10 | import Spear.Math.AABB | 10 | import Spear.Math.AABB |
11 | import Spear.Math.Spatial | ||
11 | import Spear.Math.Spatial2 | 12 | import Spear.Math.Spatial2 |
12 | import Spear.Math.Vector | 13 | import Spear.Math.Vector |
13 | import Spear.Window | 14 | import Spear.Window |
@@ -28,10 +29,10 @@ step :: Elapsed -> Dt -> [InputEvent] -> Game GameState Bool | |||
28 | step elapsed dt inputEvents = do | 29 | step 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 = | |||
63 | renderGO :: GameObject -> IO () | 64 | renderGO :: GameObject -> IO () |
64 | renderGO go = do | 65 | renderGO 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 | |||
76 | process = mapM_ procEvent | 77 | process = mapM_ procEvent |
77 | 78 | ||
78 | procEvent (Resize w h) = | 79 | procEvent (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 |
91 | procEvent _ = return () | 92 | procEvent _ = return () |
92 | 93 | ||
93 | translate = mapMaybe translate' | 94 | translateEvents = mapMaybe translateEvents' |
94 | 95 | where translateEvents' (KeyDown KEY_LEFT) = Just MoveLeft | |
95 | translate' (KeyDown KEY_LEFT) = Just MoveLeft | 96 | translateEvents' (KeyDown KEY_RIGHT) = Just MoveRight |
96 | translate' (KeyDown KEY_RIGHT) = Just MoveRight | 97 | translateEvents' (KeyUp KEY_LEFT) = Just StopLeft |
97 | translate' (KeyUp KEY_LEFT) = Just StopLeft | 98 | translateEvents' (KeyUp KEY_RIGHT) = Just StopRight |
98 | translate' (KeyUp KEY_RIGHT) = Just StopRight | 99 | translateEvents' _ = Nothing |
99 | translate' _ = Nothing | ||
100 | 100 | ||
101 | exitRequested = elem (KeyDown KEY_ESC) | 101 | exitRequested = 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 | |||
1 | module Pong | 5 | module Pong |
2 | ( GameEvent (..), | 6 | ( GameEvent (..), |
3 | GameObject, | 7 | GameObject, |
@@ -7,25 +11,29 @@ module Pong | |||
7 | ) | 11 | ) |
8 | where | 12 | where |
9 | 13 | ||
10 | import Data.Monoid (mconcat) | ||
11 | import GHC.Float (double2Float) | ||
12 | import Spear.Math.AABB | 14 | import Spear.Math.AABB |
15 | import Spear.Math.Algebra | ||
16 | import Spear.Math.Spatial | ||
13 | import Spear.Math.Spatial2 | 17 | import Spear.Math.Spatial2 |
14 | import Spear.Math.Vector | 18 | import Spear.Math.Vector |
19 | import Spear.Prelude | ||
15 | import Spear.Step | 20 | import Spear.Step |
16 | 21 | ||
22 | import Data.Monoid (mconcat) | ||
23 | |||
24 | |||
17 | -- Configuration | 25 | -- Configuration |
18 | 26 | ||
19 | padSize = vec2 0.07 0.02 | 27 | padSize = vec2 0.07 0.02 |
20 | ballSize = 0.012 | 28 | ballSize = 0.012 :: Float |
21 | ballSpeed = 0.6 | 29 | ballSpeed = 0.6 :: Float |
22 | initialBallVelocity = vec2 1 1 | 30 | initialBallVelocity = vec2 1 1 |
23 | maxBounceAngle = 65 * pi/180 | 31 | maxBounceAngle = (65::Float) * (pi::Float)/(180::Float) |
24 | playerSpeed = 1.0 | 32 | playerSpeed = 1.0 :: Float |
25 | enemySpeed = 1.5 | 33 | enemySpeed = 3.0 :: Float |
26 | initialEnemyPos = vec2 0.5 0.9 | 34 | initialEnemyPos = vec2 0.5 0.9 |
27 | initialPlayerPos = vec2 0.5 0.1 | 35 | initialPlayerPos = vec2 0.5 0.1 |
28 | initialBallPos = vec2 0.5 0.5 | 36 | initialBallPos = vec2 0.5 0.5 |
29 | 37 | ||
30 | -- Game events | 38 | -- Game events |
31 | 39 | ||
@@ -40,13 +48,36 @@ data GameEvent | |||
40 | 48 | ||
41 | data GameObject = GameObject | 49 | data 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 | ||
47 | instance Spatial2 GameObject where | 55 | |
48 | getObj2 = obj | 56 | instance Has2dTransform GameObject where |
49 | setObj2 s o = s {obj = o} | 57 | set2dTransform transform object = object { basis = transform } |
58 | transform2 = basis | ||
59 | |||
60 | |||
61 | instance Positional GameObject Vector2 where | ||
62 | setPosition p = with2dTransform (setPosition p) | ||
63 | position = position . basis | ||
64 | translate v = with2dTransform (translate v) | ||
65 | |||
66 | |||
67 | instance 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 | |||
77 | instance Spatial GameObject Vector2 Angle Transform2 where | ||
78 | setTransform t obj = obj { basis = t } | ||
79 | transform = basis | ||
80 | |||
50 | 81 | ||
51 | stepWorld :: Elapsed -> Dt -> [GameEvent] -> [GameObject] -> [GameObject] | 82 | stepWorld :: Elapsed -> Dt -> [GameEvent] -> [GameObject] -> [GameObject] |
52 | stepWorld elapsed dt evts gos = map (update elapsed dt evts gos) gos | 83 | stepWorld elapsed dt evts gos = map (update elapsed dt evts gos) gos |
@@ -60,13 +91,12 @@ ballBox, padBox :: AABB2 | |||
60 | ballBox = AABB2 (vec2 (-s) (-s)) (vec2 s s) where s = ballSize | 91 | ballBox = AABB2 (vec2 (-s) (-s)) (vec2 s s) where s = ballSize |
61 | padBox = AABB2 (-padSize) padSize | 92 | padBox = AABB2 (-padSize) padSize |
62 | 93 | ||
63 | obj2 = obj2FromVectors unitx2 unity2 | ||
64 | |||
65 | newWorld = | 94 | newWorld = |
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. |
77 | collideBall :: Vector2 -> Step [GameObject] e GameObject (Vector2, GameObject) | 107 | collideBall :: Vector2 -> Step [GameObject] e GameObject (Vector2, GameObject) |
78 | collideBall vel = step $ \_ dt gos _ ball -> | 108 | collideBall 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 | ||
90 | paddleBounce :: GameObject -> Vector2 -> GameObject -> Vector2 | 120 | paddleBounce :: GameObject -> Vector2 -> GameObject -> Vector2 |
91 | paddleBounce ball v paddle = | 121 | paddleBounce 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 = | |||
105 | collide :: GameObject -> GameObject -> Bool | 135 | collide :: GameObject -> GameObject -> Bool |
106 | collide go1 go2 = | 136 | collide 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 | ||
117 | aabbAdd (AABB2 pmin pmax) p = AABB2 (p + pmin) (p + pmax) | ||
118 | |||
119 | moveBall :: Step s e (Vector2, GameObject) GameObject | 147 | moveBall :: Step s e (Vector2, GameObject) GameObject |
120 | moveBall = step $ \_ dt _ _ (vel, ball) -> (move (scale dt vel) ball, moveBall) | 148 | moveBall = 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 | ||
126 | movePad :: Step s e GameObject GameObject | 154 | movePad :: Step s e GameObject GameObject |
127 | movePad = step $ \elapsed _ _ _ pad -> | 155 | movePad = 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 | ||
139 | moveGO = | 168 | moveGO = |
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 | ||
145 | moveGO' :: Vector2 -> Step s e GameObject GameObject | 174 | moveGO' :: Vector2 -> Step s e GameObject GameObject |
146 | moveGO' dir = step $ \_ dt _ _ go -> (move (scale dt dir) go, moveGO' dir) | 175 | moveGO' dir = step $ \_ dt _ _ go -> (translate (dir * dt) go, moveGO' dir) |
147 | 176 | ||
148 | clamp :: Step s e GameObject GameObject | 177 | clamp :: Step s e GameObject GameObject |
149 | clamp = spure $ \go -> | 178 | clamp = 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 | |||
12 | data-dir: "" | 12 | data-dir: "" |
13 | 13 | ||
14 | library | 14 | library |
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 | ) |
88 | where | 88 | where |
89 | 89 | ||
90 | import Control.Monad | 90 | import Control.Monad |
91 | import Control.Monad.Trans.Class | 91 | import Control.Monad.Trans.Class |
92 | import Control.Monad.Trans.State as State | 92 | import Control.Monad.Trans.State as State |
93 | import qualified Data.ByteString.Char8 as B | 93 | import qualified Data.ByteString.Char8 as B |
94 | import Data.StateVar | 94 | import Data.StateVar |
95 | import Data.Word | 95 | import Data.Word |
96 | import Foreign.C.String | 96 | import Foreign.C.String |
97 | import Foreign.C.Types | 97 | import Foreign.C.Types |
98 | import Foreign.Marshal.Alloc (alloca) | 98 | import Foreign.Marshal.Alloc (alloca) |
99 | import Foreign.Marshal.Array (withArray) | 99 | import Foreign.Marshal.Array (withArray) |
100 | import Foreign.Marshal.Utils as Foreign (with) | 100 | import Foreign.Marshal.Utils as Foreign (with) |
101 | import Foreign.Ptr | 101 | import Foreign.Ptr |
102 | import Foreign.Storable | 102 | import Foreign.Storable |
103 | import Foreign.Storable (peek) | 103 | import Foreign.Storable (peek) |
104 | import Graphics.GL.Core46 | 104 | import Graphics.GL.Core46 |
105 | import Spear.Assets.Image | 105 | import Prelude hiding ((*)) |
106 | import Spear.Game | 106 | import Spear.Assets.Image |
107 | import Spear.Math.Matrix3 (Matrix3) | 107 | import Spear.Game |
108 | import Spear.Math.Matrix4 (Matrix4) | 108 | import Spear.Math.Algebra |
109 | import Spear.Math.Vector | 109 | import Spear.Math.Matrix3 (Matrix3) |
110 | import System.Directory (doesFileExist, getCurrentDirectory, setCurrentDirectory) | 110 | import Spear.Math.Matrix4 (Matrix4) |
111 | import System.IO (hPutStrLn, stderr) | 111 | import Spear.Math.Vector |
112 | import Unsafe.Coerce | 112 | import System.Directory (doesFileExist, getCurrentDirectory, |
113 | setCurrentDirectory) | ||
114 | import System.IO (hPutStrLn, stderr) | ||
115 | import 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. |
119 | data GLSLShader = GLSLShader | 122 | data 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. |
128 | data GLSLProgram = GLSLProgram | 131 | data 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 | |||
137 | data ShaderType = VertexShader | FragmentShader | GeometryShader deriving (Eq, Show) | 140 | data ShaderType = VertexShader | FragmentShader | GeometryShader deriving (Eq, Show) |
138 | 141 | ||
139 | toGLShader :: ShaderType -> GLenum | 142 | toGLShader :: ShaderType -> GLenum |
140 | toGLShader VertexShader = GL_VERTEX_SHADER | 143 | toGLShader VertexShader = GL_VERTEX_SHADER |
141 | toGLShader FragmentShader = GL_FRAGMENT_SHADER | 144 | toGLShader FragmentShader = GL_FRAGMENT_SHADER |
142 | toGLShader GeometryShader = GL_GEOMETRY_SHADER | 145 | toGLShader 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. |
530 | data GLBuffer = GLBuffer | 533 | data GLBuffer = GLBuffer |
531 | { getBuffer :: GLuint, | 534 | { getBuffer :: GLuint, |
532 | rkey :: Resource | 535 | rkey :: Resource |
533 | } | 536 | } |
534 | 537 | ||
535 | instance ResourceClass GLBuffer where | 538 | instance ResourceClass GLBuffer where |
@@ -544,10 +547,10 @@ data TargetBuffer | |||
544 | deriving (Eq, Show) | 547 | deriving (Eq, Show) |
545 | 548 | ||
546 | fromTarget :: TargetBuffer -> GLenum | 549 | fromTarget :: TargetBuffer -> GLenum |
547 | fromTarget ArrayBuffer = GL_ARRAY_BUFFER | 550 | fromTarget ArrayBuffer = GL_ARRAY_BUFFER |
548 | fromTarget ElementArrayBuffer = GL_ELEMENT_ARRAY_BUFFER | 551 | fromTarget ElementArrayBuffer = GL_ELEMENT_ARRAY_BUFFER |
549 | fromTarget PixelPackBuffer = GL_PIXEL_PACK_BUFFER | 552 | fromTarget PixelPackBuffer = GL_PIXEL_PACK_BUFFER |
550 | fromTarget PixelUnpackBuffer = GL_PIXEL_UNPACK_BUFFER | 553 | fromTarget PixelUnpackBuffer = GL_PIXEL_UNPACK_BUFFER |
551 | 554 | ||
552 | -- | A buffer usage. | 555 | -- | A buffer usage. |
553 | data BufferUsage | 556 | data BufferUsage |
@@ -563,12 +566,12 @@ data BufferUsage | |||
563 | deriving (Eq, Show) | 566 | deriving (Eq, Show) |
564 | 567 | ||
565 | fromUsage :: BufferUsage -> GLenum | 568 | fromUsage :: BufferUsage -> GLenum |
566 | fromUsage StreamDraw = GL_STREAM_DRAW | 569 | fromUsage StreamDraw = GL_STREAM_DRAW |
567 | fromUsage StreamRead = GL_STREAM_READ | 570 | fromUsage StreamRead = GL_STREAM_READ |
568 | fromUsage StreamCopy = GL_STREAM_COPY | 571 | fromUsage StreamCopy = GL_STREAM_COPY |
569 | fromUsage StaticDraw = GL_STATIC_DRAW | 572 | fromUsage StaticDraw = GL_STATIC_DRAW |
570 | fromUsage StaticRead = GL_STATIC_READ | 573 | fromUsage StaticRead = GL_STATIC_READ |
571 | fromUsage StaticCopy = GL_STATIC_COPY | 574 | fromUsage StaticCopy = GL_STATIC_COPY |
572 | fromUsage DynamicDraw = GL_DYNAMIC_DRAW | 575 | fromUsage DynamicDraw = GL_DYNAMIC_DRAW |
573 | fromUsage DynamicRead = GL_DYNAMIC_READ | 576 | fromUsage DynamicRead = GL_DYNAMIC_READ |
574 | fromUsage DynamicCopy = GL_DYNAMIC_COPY | 577 | fromUsage DynamicCopy = GL_DYNAMIC_COPY |
@@ -780,7 +783,7 @@ getGLError = fmap translate glGetError | |||
780 | printGLError :: IO () | 783 | printGLError :: IO () |
781 | printGLError = | 784 | printGLError = |
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 | ) |
31 | where | 31 | where |
32 | 32 | ||
33 | import Control.Monad.Catch | 33 | import Control.Monad.Catch |
34 | import Control.Monad.State.Strict | 34 | import Control.Monad.State.Strict |
35 | import Control.Monad.Trans.Class (lift) | 35 | import Control.Monad.Trans.Class (lift) |
36 | import qualified Control.Monad.Trans.Resource as R | 36 | import qualified Control.Monad.Trans.Resource as R |
37 | 37 | ||
38 | type Resource = R.ReleaseKey | 38 | type 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'. |
84 | assertMaybe :: Maybe a -> GameException -> Game s a | 84 | assertMaybe :: Maybe a -> GameException -> Game s a |
85 | assertMaybe Nothing err = gameError' err | 85 | assertMaybe Nothing err = gameError' err |
86 | assertMaybe (Just x) _ = return x | 86 | assertMaybe (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. |
89 | catchGameError :: Game s a -> (GameException -> Game s a) -> Game s a | 89 | catchGameError :: 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 | |||
1 | module Spear.Math.AABB | 5 | module Spear.Math.AABB |
2 | ( | 6 | ( |
3 | AABB2(..) | 7 | AABB2(..) |
@@ -9,9 +13,12 @@ module Spear.Math.AABB | |||
9 | ) | 13 | ) |
10 | where | 14 | where |
11 | 15 | ||
12 | import Spear.Math.Vector | 16 | import Spear.Math.Spatial |
17 | import Spear.Math.Vector | ||
18 | import Spear.Prelude | ||
19 | |||
20 | import Data.List (foldl') | ||
13 | 21 | ||
14 | import Data.List (foldl') | ||
15 | 22 | ||
16 | -- | An axis-aligned bounding box in 2D space. | 23 | -- | An axis-aligned bounding box in 2D space. |
17 | data AABB2 = AABB2 {-# UNPACK #-} !Vector2 {-# UNPACK #-} !Vector2 deriving Show | 24 | data 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. |
20 | data AABB3 = AABB3 {-# UNPACK #-} !Vector3 {-# UNPACK #-} !Vector3 deriving Show | 27 | data AABB3 = AABB3 {-# UNPACK #-} !Vector3 {-# UNPACK #-} !Vector3 deriving Show |
21 | 28 | ||
29 | |||
30 | instance 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 | |||
36 | instance 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. |
23 | aabb2 :: [Vector2] -> AABB2 | 43 | aabb2 :: [Vector2] -> AABB2 |
24 | aabb2 [] = AABB2 zero2 zero2 | 44 | aabb2 = foldl' union (AABB2 zero2 zero2) |
25 | aabb2 (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. |
29 | aabb3 :: [Vector3] -> AABB3 | 48 | aabb3 :: [Vector3] -> AABB3 |
30 | aabb3 [] = AABB3 zero3 zero3 | 49 | aabb3 = foldl' union (AABB3 zero3 zero3) |
31 | aabb3 (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. |
35 | aabb2pt :: AABB2 -> Vector2 -> Bool | 53 | aabb2pt :: 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 | |||
5 | module Spear.Math.Algebra | ||
6 | where | ||
7 | |||
8 | import Foreign.C.Types | ||
9 | import Prelude hiding ((*), (+), (-), (/)) | ||
10 | import qualified Prelude as P | ||
11 | |||
12 | |||
13 | -- | General addition. | ||
14 | class Addition a b where | ||
15 | infixl 6 + | ||
16 | (+) :: a -> b -> a | ||
17 | |||
18 | -- | General subtraction. | ||
19 | class Subtraction a b where | ||
20 | infixl 6 - | ||
21 | (-) :: a -> b -> a | ||
22 | |||
23 | -- | General multiplication. | ||
24 | class Product a b c | a b -> c where | ||
25 | infixl 7 * | ||
26 | (*) :: a -> b -> c | ||
27 | |||
28 | -- | General division. | ||
29 | class 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. | ||
41 | instance Addition Int Int where (+) = (P.+) | ||
42 | instance Addition Float Float where (+) = (P.+) | ||
43 | instance Addition Double Double where (+) = (P.+) | ||
44 | instance Addition CUInt CUInt where (+) = (P.+) | ||
45 | |||
46 | instance Subtraction Int Int where (-) = (P.-) | ||
47 | instance Subtraction Float Float where (-) = (P.-) | ||
48 | instance Subtraction Double Double where (-) = (P.-) | ||
49 | |||
50 | instance Product Int Int Int where (*) = (P.*) | ||
51 | instance Product Float Float Float where (*) = (P.*) | ||
52 | instance Product Double Double Double where (*) = (P.*) | ||
53 | instance Product CUInt CUInt CUInt where (*) = (P.*) | ||
54 | |||
55 | instance Quotient Int Int where (/) = P.div | ||
56 | instance Quotient Float Float where (/) = (P./) | ||
57 | instance 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. | ||
62 | add :: Addition a a => a -> a -> a | ||
63 | add a b = a + b | ||
64 | |||
65 | sub :: Subtraction a a => a -> a -> a | ||
66 | sub a b = a - b | ||
67 | |||
68 | mul :: Product a a a => a -> a -> a | ||
69 | mul a b = a * b | ||
70 | |||
71 | div :: Quotient a a => a -> a -> a | ||
72 | div a b = a / b | ||
73 | |||
74 | |||
75 | {- instance Num a => Addition a a where | ||
76 | (+) = (P.+) | ||
77 | |||
78 | instance Num a => Subtraction a a where | ||
79 | (-) = (P.+) | ||
80 | |||
81 | instance Num a => Product a a where | ||
82 | type Prod a a = a | ||
83 | |||
84 | (*) = (P.*) | ||
85 | |||
86 | instance 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 | |||
102 | lerp 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 | |||
1 | module Spear.Math.Camera | 3 | module Spear.Math.Camera |
2 | ( | 4 | ( |
3 | Camera | 5 | Camera |
@@ -15,27 +17,52 @@ module Spear.Math.Camera | |||
15 | ) | 17 | ) |
16 | where | 18 | where |
17 | 19 | ||
18 | import qualified Spear.Math.Matrix4 as M | 20 | import qualified Spear.Math.Matrix4 as M |
19 | import Spear.Math.Spatial3 | 21 | import Spear.Math.Spatial |
20 | import Spear.Math.Vector | 22 | import Spear.Math.Spatial3 |
23 | import Spear.Math.Vector | ||
24 | |||
21 | 25 | ||
22 | data Camera = Camera | 26 | data 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 | ||
27 | instance Spatial3 Camera where | ||
28 | getObj3 = spatial | ||
29 | setObj3 cam o = cam { spatial = o } | ||
30 | 31 | ||
31 | type Fovy = Float | 32 | instance Has3dTransform Camera where |
33 | set3dTransform transform camera = camera { basis = transform } | ||
34 | transform3 = basis | ||
35 | |||
36 | |||
37 | instance Positional Camera Vector3 where | ||
38 | setPosition p = with3dTransform (setPosition p) | ||
39 | position = position . basis | ||
40 | translate v = with3dTransform (translate v) | ||
41 | |||
42 | |||
43 | instance 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 | |||
53 | instance Spatial Camera Vector3 Rotation3 Transform3 where | ||
54 | setTransform transform camera = camera { basis = transform } | ||
55 | transform = basis | ||
56 | |||
57 | |||
58 | type Fovy = Float | ||
32 | type Aspect = Float | 59 | type Aspect = Float |
33 | type Near = Float | 60 | type Near = Float |
34 | type Far = Float | 61 | type Far = Float |
35 | type Left = Float | 62 | type Left = Float |
36 | type Right = Float | 63 | type Right = Float |
37 | type Bottom = Float | 64 | type Bottom = Float |
38 | type Top = Float | 65 | type Top = Float |
39 | 66 | ||
40 | -- | Build a perspective camera. | 67 | -- | Build a perspective camera. |
41 | perspective :: Fovy -- ^ Fovy - Vertical field of view angle in degrees. | 68 | perspective :: 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 | |||
51 | perspective fovy r n f right up fwd pos = | 77 | perspective 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. |
59 | ortho :: Left -- ^ Left. | 84 | ortho :: 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 | |||
71 | ortho l r b t n f right up fwd pos = | 95 | ortho 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 | |||
1 | module Spear.Math.Circle | 5 | module Spear.Math.Circle |
2 | where | 6 | where |
3 | 7 | ||
4 | import Spear.Math.Vector | 8 | import Spear.Math.Algebra |
9 | import Spear.Math.Vector | ||
10 | import Spear.Prelude | ||
11 | |||
12 | import Data.List (foldl') | ||
13 | import Spear.Math.Spatial | ||
14 | import Spear.Math.Spatial2 | ||
5 | 15 | ||
6 | import Data.List (foldl') | ||
7 | 16 | ||
8 | -- | A circle in 2D space. | 17 | -- | A circle in 2D space. |
9 | data Circle = Circle | 18 | data Circle = Circle |
@@ -11,12 +20,19 @@ data Circle = Circle | |||
11 | , radius :: {-# UNPACK #-} !Float | 20 | , radius :: {-# UNPACK #-} !Float |
12 | } | 21 | } |
13 | 22 | ||
23 | |||
24 | instance 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. |
15 | circle :: [Vector2] -> Circle | 31 | circle :: [Vector2] -> Circle |
16 | circle [] = Circle zero2 0 | 32 | circle [] = Circle zero2 0 |
17 | circle (x:xs) = Circle c r | 33 | circle (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 | |||
1 | module Spear.Math.Collision | 3 | module Spear.Math.Collision |
2 | ( | 4 | ( |
3 | CollisionType(..) | 5 | CollisionType(..) |
@@ -23,15 +25,17 @@ module Spear.Math.Collision | |||
23 | ) | 25 | ) |
24 | where | 26 | where |
25 | 27 | ||
26 | import Spear.Assets.Model | 28 | import Spear.Assets.Model |
27 | import Spear.Math.AABB | 29 | import Spear.Math.AABB |
28 | import Spear.Math.Circle | 30 | import Spear.Math.Algebra |
31 | import Spear.Math.Circle | ||
29 | import qualified Spear.Math.Matrix4 as M4 | 32 | import qualified Spear.Math.Matrix4 as M4 |
30 | import Spear.Math.Plane | 33 | import Spear.Math.Plane |
31 | import Spear.Math.Sphere | 34 | import Spear.Math.Sphere |
32 | import Spear.Math.Vector | 35 | import Spear.Math.Vector |
36 | import Spear.Prelude | ||
33 | 37 | ||
34 | import Data.List (foldl') | 38 | import Data.List (foldl') |
35 | 39 | ||
36 | data CollisionType = NoCollision | Collision | FullyContains | FullyContainedBy | 40 | data 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 | ||
41 | class Collisionable2 a where | 45 | class 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 | ||
49 | instance Collisionable2 AABB2 where | 52 | instance 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 | ||
69 | instance Collisionable2 Circle where | 71 | instance 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 | ||
85 | instance Collisionable2 Collisioner2 where | 86 | instance 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 | |||
93 | aabbPoints :: AABB2 -> [Vector2] | 94 | aabbPoints :: AABB2 -> [Vector2] |
94 | aabbPoints (AABB2 min max) = [p1,p2,p3,p4,p5,p6,p7,p8] | 95 | aabbPoints (AABB2 min max) = [p1,p2,p3,p4,p5,p6,p7,p8] |
95 | where | 96 | where |
@@ -142,15 +143,15 @@ buildAABB2 cols = aabb2 $ generatePoints cols | |||
142 | aabb2FromCircle :: Circle -> AABB2 | 143 | aabb2FromCircle :: Circle -> AABB2 |
143 | aabb2FromCircle (Circle c r) = AABB2 bot top | 144 | aabb2FromCircle (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. |
149 | circleFromAABB2 :: AABB2 -> Circle | 150 | circleFromAABB2 :: AABB2 -> Circle |
150 | circleFromAABB2 (AABB2 min max) = Circle c r | 151 | circleFromAABB2 (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 | ||
155 | generatePoints :: [Collisioner2] -> [Vector2] | 156 | generatePoints :: [Collisioner2] -> [Vector2] |
156 | generatePoints = foldl' generate [] | 157 | generatePoints = 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. |
177 | collide :: Collisioner2 -> Collisioner2 -> CollisionType | 178 | collide :: Collisioner2 -> Collisioner2 -> CollisionType |
@@ -183,13 +184,11 @@ collide (CircleCol circle) (AABB2Col box) = collideCircle circle box | |||
183 | -- | Move the collisioner. | 184 | -- | Move the collisioner. |
184 | move :: Vector2 -> Collisioner2 -> Collisioner2 | 185 | move :: Vector2 -> Collisioner2 -> Collisioner2 |
185 | move v (AABB2Col (AABB2 min max)) = AABB2Col (AABB2 (min+v) (max+v)) | 186 | move v (AABB2Col (AABB2 min max)) = AABB2Col (AABB2 (min+v) (max+v)) |
186 | move v (CircleCol (Circle c r)) = CircleCol (Circle (c+v) r) | 187 | move v (CircleCol (Circle c r)) = CircleCol (Circle (c+v) r) |
187 | |||
188 | 188 | ||
189 | -- 3D collision | ||
190 | 189 | ||
190 | -- | 3D collision | ||
191 | class Collisionable3 a where | 191 | class 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 | ||
199 | instance Collisionable3 AABB3 where | 198 | instance 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 | ||
220 | instance Collisionable3 Sphere where | 218 | instance 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 | |||
238 | aabb3FromSphere :: Sphere -> AABB3 | 235 | aabb3FromSphere :: Sphere -> AABB3 |
239 | aabb3FromSphere (Sphere c r) = AABB3 bot top | 236 | aabb3FromSphere (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 | |||
1 | module Spear.Math.Matrix3 | 5 | module 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 | ) |
40 | where | 45 | where |
41 | 46 | ||
47 | import Spear.Math.Algebra hiding (mul) | ||
48 | import Spear.Math.Vector | ||
49 | import Spear.Prelude hiding (mul) | ||
42 | 50 | ||
43 | import Spear.Math.Vector | 51 | import Foreign.Storable |
44 | |||
45 | import 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 | ||
56 | instance Show Matrix3 where | 62 | instance 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 | ||
66 | instance Num Matrix3 where | 71 | instance 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 | |||
79 | instance 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 | |||
87 | instance 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 | |||
100 | instance Storable Matrix3 where | 103 | instance 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 | |||
122 | col1 (Matrix3 _ a10 _ _ a11 _ _ a12 _ ) = vec3 a10 a11 a12 | 125 | col1 (Matrix3 _ a10 _ _ a11 _ _ a12 _ ) = vec3 a10 a11 a12 |
123 | col2 (Matrix3 _ _ a20 _ _ a21 _ _ a22) = vec3 a20 a21 a22 | 126 | col2 (Matrix3 _ _ a20 _ _ a21 _ _ a22) = vec3 a20 a21 a22 |
124 | 127 | ||
125 | |||
126 | row0 (Matrix3 a00 a10 a20 _ _ _ _ _ _ ) = vec3 a00 a10 a20 | 128 | row0 (Matrix3 a00 a10 a20 _ _ _ _ _ _ ) = vec3 a00 a10 a20 |
127 | row1 (Matrix3 _ _ _ a01 a11 a21 _ _ _ ) = vec3 a01 a11 a21 | 129 | row1 (Matrix3 _ _ _ a01 a11 a21 _ _ _ ) = vec3 a01 a11 a21 |
128 | row2 (Matrix3 _ _ _ _ _ _ a02 a12 a22) = vec3 a02 a12 a22 | 130 | row2 (Matrix3 _ _ _ _ _ _ a02 a12 a22) = vec3 a02 a12 a22 |
129 | 131 | ||
130 | |||
131 | right (Matrix3 a00 _ _ a01 _ _ _ _ _) = vec2 a00 a01 | 132 | right (Matrix3 a00 _ _ a01 _ _ _ _ _) = vec2 a00 a01 |
132 | up (Matrix3 _ a10 _ _ a11 _ _ _ _) = vec2 a10 a11 | 133 | up (Matrix3 _ a10 _ _ a11 _ _ _ _) = vec2 a10 a11 |
133 | forward (Matrix3 _ a10 _ _ a11 _ _ _ _) = vec2 a10 a11 | 134 | position (Matrix3 _ _ a20 _ _ a21 _ _ _) = vec2 a20 a21 |
134 | position (Matrix3 _ _ a20 _ _ a21 _ _ _) = vec2 a20 a21 | 135 | forward = up |
136 | |||
137 | setRight (Vector2 x y) matrix = matrix { m00 = x, m01 = y } | ||
138 | setUp (Vector2 x y) matrix = matrix { m10 = x, m11 = y } | ||
139 | setPosition (Vector2 x y) matrix = matrix { m20 = x, m21 = y} | ||
140 | setForward = setUp | ||
135 | 141 | ||
136 | 142 | ||
137 | -- | Build a matrix from the specified values. | 143 | -- | Build a matrix from the specified values. |
138 | mat3 = Matrix3 | 144 | mat3 = Matrix3 |
139 | 145 | ||
140 | |||
141 | -- | Build a matrix from three vectors in 3D. | 146 | -- | Build a matrix from three vectors in 3D. |
142 | mat3fromVec :: Vector3 -> Vector3 -> Vector3 -> Matrix3 | 147 | mat3fromVec :: Vector3 -> Vector3 -> Vector3 -> Matrix3 |
143 | mat3fromVec v0 v1 v2 = Matrix3 | 148 | mat3fromVec 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. |
150 | transform :: Vector2 -- ^ Right vector | 154 | transform :: Vector2 -- ^ Right vector |
151 | -> Vector2 -- ^ Forward vector | 155 | -> Vector2 -- ^ Forward vector |
152 | -> Vector2 -- ^ Position | 156 | -> Vector2 -- ^ Position |
153 | -> Matrix3 -- ^ Transform | 157 | -> Matrix3 -- ^ Transform |
154 | |||
155 | transform r f p = mat3 | 158 | transform 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. |
162 | translation :: Matrix3 -> Matrix3 | 164 | translation :: Matrix3 -> Matrix3 |
163 | translation (Matrix3 | 165 | translation (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. |
174 | rotation :: Matrix3 -> Matrix3 | 175 | rotation :: Matrix3 -> Matrix3 |
175 | rotation (Matrix3 | 176 | rotation (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. |
186 | id :: Matrix3 | 186 | id :: Matrix3 |
187 | id = mat3 | 187 | id = 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. |
194 | transl :: Float -- ^ Translation on the x axis | 193 | translate |
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 | |
198 | transl tx ty = mat3 | 197 | translate 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. |
205 | translv :: Vector2 -> Matrix3 | 203 | translatev :: Vector2 -> Matrix3 |
206 | translv v = mat3 | 204 | translatev 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. |
226 | scale :: Float -> Float -> Float -> Matrix3 | 222 | scale :: 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. |
234 | scalev :: Vector3 -> Matrix3 | 229 | scalev :: Vector3 -> Matrix3 |
235 | scalev v = mat3 | 230 | scalev 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. |
246 | reflectX :: Matrix3 | 240 | reflectX :: Matrix3 |
247 | reflectX = mat3 | 241 | reflectX = 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. |
254 | reflectY :: Matrix3 | 247 | reflectY :: Matrix3 |
255 | reflectY = mat3 | 248 | reflectY = 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. |
262 | reflectZ :: Matrix3 | 254 | reflectZ :: Matrix3 |
263 | reflectZ = mat3 | 255 | reflectZ = 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. |
270 | transpose :: Matrix3 -> Matrix3 | 261 | transpose :: Matrix3 -> Matrix3 |
271 | transpose m = mat3 | 262 | transpose 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. |
278 | mulp :: Matrix3 -> Vector2 -> Vector2 | 268 | mulp :: Matrix3 -> Vector2 -> Vector2 |
279 | mulp m v = vec2 x' y' | 269 | mulp 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. |
288 | muld :: Matrix3 -> Vector2 -> Vector2 | 277 | muld :: Matrix3 -> Vector2 -> Vector2 |
289 | muld m v = vec2 x' y' | 278 | muld 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. |
297 | mul :: Matrix3 -> Vector3 -> Vector3 | 285 | mul :: Matrix3 -> Vector3 -> Vector3 |
298 | mul m v = vec3 x' y' z' | 286 | mul 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. |
307 | zipWith :: (Float -> Float -> Float) -> Matrix3 -> Matrix3 -> Matrix3 | 294 | zipWith :: (Float -> Float -> Float) -> Matrix3 -> Matrix3 -> Matrix3 |
308 | zipWith f a b = Matrix3 | 295 | zipWith 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'. |
315 | map :: (Float -> Float) -> Matrix3 -> Matrix3 | 301 | map :: (Float -> Float) -> Matrix3 -> Matrix3 |
316 | map f m = Matrix3 | 302 | map 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. |
323 | inverseTransform :: Matrix3 -> Matrix3 | 308 | inverseTransform :: Matrix3 -> Matrix3 |
324 | inverseTransform mat = | 309 | inverseTransform 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 | |||
334 | fromDeg :: (Floating a) => a -> a | ||
335 | fromDeg = (*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 | |||
1 | module Spear.Math.Matrix4 | 5 | module 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 | ) |
51 | where | 56 | where |
52 | 57 | ||
58 | import Spear.Math.Algebra hiding (mul) | ||
59 | import Spear.Math.Vector | ||
60 | import Spear.Prelude hiding (mul) | ||
53 | 61 | ||
54 | import Spear.Math.Vector | 62 | import Foreign.Storable |
55 | |||
56 | import 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 | ||
68 | instance Show Matrix4 where | 74 | instance 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 | ||
79 | instance Num Matrix4 where | 84 | instance 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 | |||
93 | instance 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 | |||
102 | instance 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 | 126 | instance 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 | ||
123 | instance Storable Matrix4 where | 134 | instance Storable Matrix4 where |
@@ -150,23 +161,24 @@ col1 (Matrix4 _ a10 _ _ _ a11 _ _ _ a12 _ _ _ a13 _ _ ) = | |||
150 | col2 (Matrix4 _ _ a20 _ _ _ a21 _ _ _ a22 _ _ _ a23 _ ) = vec4 a20 a21 a22 a23 | 161 | col2 (Matrix4 _ _ a20 _ _ _ a21 _ _ _ a22 _ _ _ a23 _ ) = vec4 a20 a21 a22 a23 |
151 | col3 (Matrix4 _ _ _ a30 _ _ _ a31 _ _ _ a32 _ _ _ a33) = vec4 a30 a31 a32 a33 | 162 | col3 (Matrix4 _ _ _ a30 _ _ _ a31 _ _ _ a32 _ _ _ a33) = vec4 a30 a31 a32 a33 |
152 | 163 | ||
153 | |||
154 | row0 (Matrix4 a00 a01 a02 a03 _ _ _ _ _ _ _ _ _ _ _ _ ) = vec4 a00 a01 a02 a03 | 164 | row0 (Matrix4 a00 a01 a02 a03 _ _ _ _ _ _ _ _ _ _ _ _ ) = vec4 a00 a01 a02 a03 |
155 | row1 (Matrix4 _ _ _ _ a10 a11 a12 a13 _ _ _ _ _ _ _ _ ) = vec4 a10 a11 a12 a13 | 165 | row1 (Matrix4 _ _ _ _ a10 a11 a12 a13 _ _ _ _ _ _ _ _ ) = vec4 a10 a11 a12 a13 |
156 | row2 (Matrix4 _ _ _ _ _ _ _ _ a20 a21 a22 a23 _ _ _ _ ) = vec4 a20 a21 a22 a23 | 166 | row2 (Matrix4 _ _ _ _ _ _ _ _ a20 a21 a22 a23 _ _ _ _ ) = vec4 a20 a21 a22 a23 |
157 | row3 (Matrix4 _ _ _ _ _ _ _ _ _ _ _ _ a30 a31 a32 a33) = vec4 a30 a31 a32 a33 | 167 | row3 (Matrix4 _ _ _ _ _ _ _ _ _ _ _ _ a30 a31 a32 a33) = vec4 a30 a31 a32 a33 |
158 | 168 | ||
159 | |||
160 | right (Matrix4 a00 _ _ _ a01 _ _ _ a02 _ _ _ _ _ _ _) = vec3 a00 a01 a02 | 169 | right (Matrix4 a00 _ _ _ a01 _ _ _ a02 _ _ _ _ _ _ _) = vec3 a00 a01 a02 |
161 | up (Matrix4 _ a10 _ _ _ a11 _ _ _ a12 _ _ _ _ _ _) = vec3 a10 a11 a12 | 170 | up (Matrix4 _ a10 _ _ _ a11 _ _ _ a12 _ _ _ _ _ _) = vec3 a10 a11 a12 |
162 | forward (Matrix4 _ _ a20 _ _ _ a21 _ _ _ a22 _ _ _ _ _) = vec3 a20 a21 a22 | 171 | forward (Matrix4 _ _ a20 _ _ _ a21 _ _ _ a22 _ _ _ _ _) = vec3 a20 a21 a22 |
163 | position (Matrix4 _ _ _ a30 _ _ _ a31 _ _ _ a32 _ _ _ _) = vec3 a30 a31 a32 | 172 | position (Matrix4 _ _ _ a30 _ _ _ a31 _ _ _ a32 _ _ _ _) = vec3 a30 a31 a32 |
164 | 173 | ||
174 | setRight (Vector3 x y z) matrix = matrix { m00 = x, m01 = y, m02 = z } | ||
175 | setUp (Vector3 x y z) matrix = matrix { m10 = x, m11 = y, m12 = z } | ||
176 | setForward (Vector3 x y z) matrix = matrix { m20 = x, m21 = y, m22 = z } | ||
177 | setPosition (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. |
167 | mat4 = Matrix4 | 180 | mat4 = Matrix4 |
168 | 181 | ||
169 | |||
170 | -- | Build a matrix from four vectors in 4D. | 182 | -- | Build a matrix from four vectors in 4D. |
171 | mat4fromVec :: Vector4 -> Vector4 -> Vector4 -> Vector4 -> Matrix4 | 183 | mat4fromVec :: Vector4 -> Vector4 -> Vector4 -> Vector4 -> Matrix4 |
172 | mat4fromVec v0 v1 v2 v3 = Matrix4 | 184 | mat4fromVec 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. |
180 | transform :: Vector3 -- ^ Right vector. | 191 | transform :: 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 | |||
186 | transform right up fwd pos = mat4 | 196 | transform 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. |
194 | translation :: Matrix4 -> Matrix4 | 203 | translation :: Matrix4 -> Matrix4 |
195 | translation (Matrix4 | 204 | translation (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. |
208 | rotation :: Matrix4 -> Matrix4 | 216 | rotation :: Matrix4 -> Matrix4 |
209 | rotation (Matrix4 | 217 | rotation (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. |
222 | lookAt :: Vector3 -- ^ Eye position. | 229 | lookAt :: Vector3 -- ^ Eye position. |
223 | -> Vector3 -- ^ Target point. | 230 | -> Vector3 -- ^ Target point. |
224 | -> Matrix4 | 231 | -> Matrix4 |
225 | |||
226 | lookAt pos target = | 232 | lookAt 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. |
235 | zipWith :: (Float -> Float -> Float) -> Matrix4 -> Matrix4 -> Matrix4 | 240 | zipWith :: (Float -> Float -> Float) -> Matrix4 -> Matrix4 -> Matrix4 |
236 | zipWith f a b = Matrix4 | 241 | zipWith 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. |
244 | map :: (Float -> Float) -> Matrix4 -> Matrix4 | 248 | map :: (Float -> Float) -> Matrix4 -> Matrix4 |
245 | map f m = Matrix4 | 249 | map 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. |
253 | id :: Matrix4 | 256 | id :: Matrix4 |
254 | id = mat4 | 257 | id = 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. |
262 | transl :: Float -> Float -> Float -> Matrix4 | 264 | transl :: Float -> Float -> Float -> Matrix4 |
263 | transl x y z = mat4 | 265 | transl 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. |
271 | translv :: Vector3 -> Matrix4 | 272 | translv :: Vector3 -> Matrix4 |
272 | translv v = mat4 | 273 | translv 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. |
281 | rotX :: Float -> Matrix4 | 281 | rotX :: 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. |
342 | scale :: Float -> Float -> Float -> Matrix4 | 338 | scale :: 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. |
351 | scalev :: Vector3 -> Matrix4 | 346 | scalev :: Vector3 -> Matrix4 |
352 | scalev v = mat4 | 347 | scalev 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. |
364 | reflectX :: Matrix4 | 358 | reflectX :: Matrix4 |
365 | reflectX = mat4 | 359 | reflectX = 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. |
373 | reflectY :: Matrix4 | 366 | reflectY :: Matrix4 |
374 | reflectY = mat4 | 367 | reflectY = 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. |
382 | reflectZ :: Matrix4 | 374 | reflectZ :: Matrix4 |
383 | reflectZ = mat4 | 375 | reflectZ = 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. |
391 | ortho :: Float -- ^ Left. | 382 | ortho :: 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 | |||
399 | ortho l r b t n f = | 389 | ortho 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. |
411 | perspective :: Float -- ^ Fovy - Vertical field of view angle in degrees. | 400 | perspective :: 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 |
416 | perspective fovy r near far = | 405 | perspective 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. |
427 | planeProj :: Vector3 -- ^ Plane normal | 415 | planeProj :: 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. |
447 | transpose :: Matrix4 -> Matrix4 | 434 | transpose :: Matrix4 -> Matrix4 |
448 | transpose m = mat4 | 435 | transpose 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. |
456 | inverseTransform :: Matrix4 -> Matrix4 | 442 | inverseTransform :: Matrix4 -> Matrix4 |
457 | inverseTransform mat = | 443 | inverseTransform 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. |
472 | inverse :: Matrix4 -> Matrix4 | 457 | inverse :: Matrix4 -> Matrix4 |
473 | inverse mat = | 458 | inverse 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. |
627 | mulp :: Matrix4 -> Vector3 -> Vector3 | 611 | mulp :: Matrix4 -> Vector3 -> Vector3 |
628 | mulp = mul 1 | 612 | mulp = 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. |
632 | muld :: Matrix4 -> Vector3 -> Vector3 | 615 | muld :: Matrix4 -> Vector3 -> Vector3 |
633 | muld = mul 0 | 616 | muld = 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 | |||
650 | toRAD = (*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 | |||
1 | module Spear.Math.MatrixUtils | 3 | module Spear.Math.MatrixUtils |
2 | ( | 4 | ( |
3 | fastNormalMatrix | 5 | fastNormalMatrix |
@@ -11,11 +13,12 @@ module Spear.Math.MatrixUtils | |||
11 | ) | 13 | ) |
12 | where | 14 | where |
13 | 15 | ||
14 | import Spear.Math.Camera as Cam | 16 | import Spear.Math.Camera as Cam |
15 | import Spear.Math.Matrix3 as M3 | 17 | import Spear.Math.Matrix3 as M3 |
16 | import Spear.Math.Matrix4 as M4 | 18 | import Spear.Math.Matrix4 as M4 |
17 | import Spear.Math.Spatial3 as S | 19 | import Spear.Math.Spatial3 as S |
18 | import Spear.Math.Vector as V | 20 | import Spear.Math.Vector as V |
21 | import Spear.Prelude | ||
19 | 22 | ||
20 | -- | Compute the normal matrix of the given matrix. | 23 | -- | Compute the normal matrix of the given matrix. |
21 | fastNormalMatrix :: Matrix4 -> Matrix3 | 24 | fastNormalMatrix :: Matrix4 -> Matrix3 |
@@ -39,9 +42,9 @@ unproject :: Matrix4 -- ^ Inverse projection matrix | |||
39 | -> Vector3 | 42 | -> Vector3 |
40 | unproject projI modelviewI vpx vpy w h x y z = | 43 | unproject 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 |
79 | rpgTransform h a axis pos viewI = | 82 | rpgTransform 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 | |||
134 | objToClip :: Camera -> Matrix4 -> Vector3 -> Vector2 | 137 | objToClip :: Camera -> Matrix4 -> Vector3 -> Vector2 |
135 | objToClip cam model p = | 138 | objToClip 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 | |||
1 | module Spear.Math.Plane | 3 | module Spear.Math.Plane |
2 | ( | 4 | ( |
3 | Plane | 5 | Plane |
@@ -6,7 +8,8 @@ module Spear.Math.Plane | |||
6 | ) | 8 | ) |
7 | where | 9 | where |
8 | 10 | ||
9 | import Spear.Math.Vector | 11 | import Spear.Math.Vector |
12 | import Spear.Prelude | ||
10 | 13 | ||
11 | data PointPlanePos = Front | Back | Contained deriving (Eq, Show) | 14 | data 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 | |||
1 | module Spear.Math.Quaternion | 3 | module Spear.Math.Quaternion |
2 | ( | 4 | ( |
3 | Quaternion | 5 | Quaternion |
@@ -16,8 +18,9 @@ module Spear.Math.Quaternion | |||
16 | ) | 18 | ) |
17 | where | 19 | where |
18 | 20 | ||
19 | 21 | import Spear.Math.Algebra | |
20 | import Spear.Math.Vector | 22 | import Spear.Math.Vector |
23 | import Spear.Prelude | ||
21 | 24 | ||
22 | 25 | ||
23 | newtype Quaternion = Quaternion { getVec :: Vector4 } | 26 | newtype Quaternion = Quaternion { getVec :: Vector4 } |
@@ -47,7 +50,7 @@ qAxisAngle :: Vector3 -> Float -> Quaternion | |||
47 | qAxisAngle axis angle = | 50 | qAxisAngle 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 | |||
102 | qrot :: Quaternion -> Vector3 -> Vector3 | 105 | qrot :: Quaternion -> Vector3 -> Vector3 |
103 | qrot q v = toVec3 $ q `qmul` qvec3 v 0 `qmul` qconj q | 106 | qrot 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 | |||
107 | toRAD = 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 | |||
1 | module Spear.Math.Ray | 5 | module Spear.Math.Ray |
2 | ( | 6 | ( |
3 | Ray(..) | 7 | Ray(..) |
@@ -7,8 +11,12 @@ module Spear.Math.Ray | |||
7 | where | 11 | where |
8 | 12 | ||
9 | 13 | ||
10 | import Spear.Math.Utils | 14 | import qualified Spear.Math.Matrix3 as Matrix3 |
11 | import Spear.Math.Vector | 15 | import Spear.Math.Spatial |
16 | import Spear.Math.Spatial2 | ||
17 | import Spear.Math.Utils | ||
18 | import Spear.Math.Vector | ||
19 | import Spear.Prelude | ||
12 | 20 | ||
13 | 21 | ||
14 | data Ray = Ray | 22 | data Ray = Ray |
@@ -17,6 +25,29 @@ data Ray = Ray | |||
17 | } | 25 | } |
18 | 26 | ||
19 | 27 | ||
28 | instance 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 | |||
34 | instance 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 | |||
44 | instance 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. |
21 | raylr :: Ray -> Vector2 -> Side | 52 | raylr :: Ray -> Vector2 -> Side |
22 | raylr (Ray o d) p | 53 | raylr (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 | |||
7 | Objects that only move are basically the rotationally-invariant ones: AABB, | ||
8 | circle, sphere, point light, omnidirectional sound source, etc. | ||
9 | |||
10 | Conversely for objects that only rotate, which are position-invariant: | ||
11 | directional light sources, for example, or a single vector. | ||
12 | |||
13 | Objects that both move and rotate are called "spatials". These are the | ||
14 | first-class citizens of space. | ||
15 | |||
16 | The lack of ad-hoc overloading in Haskell also makes function names a bit | ||
17 | annoying, so all the type classes here are general over 2d/3d space so that | ||
18 | we can use the same names for everything (e.g., "translate" to move an object, | ||
19 | regardless of whether it is a 2D or 3D object). | ||
20 | -} | ||
21 | {-# LANGUAGE FlexibleContexts #-} | ||
22 | {-# LANGUAGE FunctionalDependencies #-} | ||
23 | {-# LANGUAGE NoImplicitPrelude #-} | ||
24 | {-# LANGUAGE TypeSynonymInstances #-} | ||
25 | |||
26 | module Spear.Math.Spatial where | ||
27 | |||
28 | import Spear.Math.Algebra | ||
29 | import Spear.Math.Vector | ||
30 | import Spear.Prelude | ||
31 | |||
32 | |||
33 | type Angle = Float -- TODO: consider newtype for Angle and Radius. | ||
34 | type 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 | |||
42 | class 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 | |||
53 | class 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 | |||
76 | class (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. | ||
88 | move :: Positional a v => Float -> (a -> v) -> a -> a | ||
89 | move delta axis a = translate (axis a * delta) a | ||
90 | |||
91 | -- | Move the spatial upwards. | ||
92 | moveRight delta = move delta right | ||
93 | |||
94 | -- | Move the spatial downwards. | ||
95 | moveLeft delta = moveRight (-delta) | ||
96 | |||
97 | -- | Move the spatial upwards. | ||
98 | moveUp delta = move delta up | ||
99 | |||
100 | -- | Move the spatial downwards. | ||
101 | moveDown delta = moveUp (-delta) | ||
102 | |||
103 | -- | Move the spatial forwards. | ||
104 | moveFwd delta = move delta forward | ||
105 | |||
106 | -- | Move the spatial backwards. | ||
107 | moveBack delta = moveFwd (-delta) | ||
108 | |||
109 | -- | Make the spatial look at the given point. | ||
110 | lookAt :: Vector v => Spatial a v r t => v -> a -> a | ||
111 | lookAt 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 | |||
1 | module Spear.Math.Spatial2 | 7 | module 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 | ) | ||
28 | where | 8 | where |
29 | 9 | ||
30 | import Spear.Math.Vector | 10 | import qualified Spear.Math.Matrix3 as Matrix3 |
31 | import qualified Spear.Math.Matrix3 as M | 11 | import Spear.Math.Matrix3 (Matrix3) |
32 | 12 | import Spear.Math.Spatial as Spatial | |
33 | type Angle = Float | 13 | import Spear.Math.Vector |
34 | type Radius = Float | 14 | import Spear.Prelude |
35 | 15 | ||
36 | -- | An entity that can be moved around in 2D space. | 16 | |
37 | class Spatial2 s where | 17 | type Positional2 a = Positional a Vector2 |
38 | 18 | type Rotational2 a = Rotational a Angle | |
39 | -- | Gets the spatial's Obj2. | 19 | type 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 | 23 | newtype Transform2 = Transform2 { transform2Matrix :: Matrix3 } deriving Show |
44 | 24 | ||
45 | -- | Move the spatial. | 25 | |
46 | move :: Spatial2 s => Vector2 -> s -> s | 26 | instance Rotational Vector2 Vector2 Angle where |
47 | move 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) |
50 | moveFwd :: Spatial2 s => Float -> s -> s | 30 | |
51 | moveFwd 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 |
54 | moveBack :: Spatial2 s => Float -> s -> s | 34 | |
55 | moveBack 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 |
58 | moveUp :: Spatial2 s => Float -> s -> s | 38 | |
59 | moveUp 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 | |
62 | moveDown :: Spatial2 s => Float -> s -> s | 42 | instance Positional Transform2 Vector2 where |
63 | moveDown 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 | |
66 | moveLeft :: Spatial2 s => Float -> s -> s | 46 | position = Matrix3.position . transform2Matrix |
67 | moveLeft 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 | |
70 | moveRight :: Spatial2 s => Float -> s -> s | 50 | |
71 | moveRight a s = let o = getObj2 s in setObj2 s $ o { p = p o + scale a (right o) } | 51 | instance Rotational Transform2 Vector2 Angle where |
72 | 52 | setRotation angle = | |
73 | -- | Rotate the spatial. | 53 | Transform2 . Matrix3.setRight r' . Matrix3.setUp u' . transform2Matrix |
74 | rotate :: Spatial2 s => Float -> s -> s | 54 | where r' = Spatial.rotate angle unitx2 |
75 | rotate 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 |
81 | setRotation :: Spatial2 s => Float -> s -> s | 61 | where r' = Spatial.rotate angle (Matrix3.right matrix) |
82 | setRotation 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 | |
87 | rotate' :: Float -> Vector2 -> Vector2 | 67 | |
88 | rotate' 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) = |
91 | pos :: Spatial2 s => s -> Vector2 | 71 | Transform2 $ Matrix3.transform (perp forward) forward (Matrix3.position matrix) |
92 | pos = p . getObj2 | 72 | |
93 | 73 | ||
94 | -- | Get the spatial's forward vector. | 74 | instance Spatial Transform2 Vector2 Angle Matrix3 where |
95 | fwd :: Spatial2 s => s -> Vector2 | 75 | setTransform matrix _ = Transform2 matrix |
96 | fwd = u . getObj2 | 76 | |
97 | 77 | transform (Transform2 matrix) = matrix | |
98 | -- | Get the spatial's up vector. | 78 | |
99 | up :: Spatial2 s => s -> Vector2 | 79 | |
100 | up = u . getObj2 | 80 | class Has2dTransform a where |
101 | 81 | -- | Set the object's 2d transform. | |
102 | -- | Get the spatial's right vector. | 82 | set2dTransform :: Transform2 -> a -> a |
103 | right :: Spatial2 s => s -> Vector2 | 83 | |
104 | right = r . getObj2 | 84 | -- | Get the object's 2d transform. |
105 | 85 | transform2 :: a -> Transform2 | |
106 | -- | Get the spatial's transform. | 86 | |
107 | transform :: Spatial2 s => s -> M.Matrix3 | 87 | |
108 | transform s = let o = getObj2 s in M.transform (r o) (u o) (p o) | 88 | with2dTransform :: Has2dTransform a => (Transform2 -> Transform2) -> a -> a |
109 | 89 | with2dTransform f obj = set2dTransform (f $ transform2 obj) obj | |
110 | -- | Set the spatial's transform. | 90 | |
111 | setTransform :: Spatial2 s => M.Matrix3 -> s -> s | 91 | -- | Build a 2d transform from right, up, and position vectors. |
112 | setTransform t s = | 92 | newTransform2 :: Vector2 -> Vector2 -> Vector2 -> Transform2 |
113 | let o = Obj2 (M.right t) (M.up t) (M.position t) | 93 | newTransform2 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. |
117 | setPos :: Spatial2 s => Vector2 -> s -> s | 97 | posTransform2 :: Positional a Vector2 => a -> Matrix3 |
118 | setPos pos s = setObj2 s $ (getObj2 s) { p = pos } | 98 | posTransform2 = Matrix3.translatev . position |
119 | 99 | ||
120 | -- | Make the spatial look at the given point. | 100 | -- TODO: Get a transform matrix from a 2d rotational. |
121 | lookAt :: Spatial2 s => Vector2 -> s -> s | 101 | |
122 | lookAt 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 | 106 | orbit :: Positional a Vector2 => Vector2 -> Angle -> Radius -> a -> a |
127 | |||
128 | -- | Make the 'Spatial' orbit around the given point | ||
129 | orbit :: Spatial2 s => Vector2 -> Angle -> Radius -> s -> s | ||
130 | orbit pt angle radius s = | 107 | orbit 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. | ||
137 | data Obj2 = Obj2 | ||
138 | { r :: Vector2 | ||
139 | , u :: Vector2 | ||
140 | , p :: Vector2 | ||
141 | } deriving Show | ||
142 | |||
143 | instance Spatial2 Obj2 where | ||
144 | getObj2 = id | ||
145 | setObj2 _ o' = o' | ||
146 | |||
147 | obj2FromVectors :: Right2 -> Up2 -> Position2 -> Obj2 | ||
148 | obj2FromVectors = Obj2 | ||
149 | |||
150 | obj2FromTransform :: M.Matrix3 -> Obj2 | ||
151 | obj2FromTransform 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 | |||
1 | module Spear.Math.Spatial3 | 7 | module 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 | ) | ||
26 | where | 8 | where |
27 | 9 | ||
28 | import Spear.Math.Vector | 10 | import Spear.Math.Algebra |
29 | import qualified Spear.Math.Matrix4 as M | 11 | import qualified Spear.Math.Matrix4 as Matrix4 |
30 | 12 | import Spear.Math.Matrix4 (Matrix4) | |
31 | type Matrix4 = M.Matrix4 | 13 | import Spear.Math.Spatial |
32 | 14 | import Spear.Math.Vector | |
33 | class Spatial3 s where | 15 | import Spear.Prelude |
34 | 16 | ||
35 | -- | Gets the spatial's Obj3. | 17 | |
36 | getObj3 :: s -> Obj3 | 18 | data 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 |
42 | move :: Spatial3 s => Vector3 -> s -> s | 24 | |
43 | move 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. | 27 | newtype Transform3 = Transform3 { transform3Matrix :: Matrix4 } deriving Show |
46 | moveFwd :: Spatial3 s => Float -> s -> s | 28 | |
47 | moveFwd a s = let o = getObj3 s in setObj3 s $ o { p = p o + scale a (f o) } | 29 | |
48 | 30 | type Positional3 a = Positional a Vector3 | |
49 | -- | Move the spatial backwards. | 31 | type Rotational3 a = Rotational a Angle |
50 | moveBack :: Spatial3 s => Float -> s -> s | 32 | type Spatial3 s = Spatial s Vector3 Rotation3 Transform3 |
51 | moveBack 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. | 35 | instance Positional Transform3 Vector3 where |
54 | moveLeft :: Spatial3 s => Float -> s -> s | 36 | setPosition p (Transform3 matrix) = |
55 | moveLeft 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 |
58 | moveRight :: Spatial3 s => Float -> s -> s | 40 | |
59 | moveRight 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 | |
62 | rotate :: Spatial3 s => Vector3 -> Float -> s -> s | 44 | instance Rotational Transform3 Vector3 Rotation3 where |
63 | rotate 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 |
69 | pitch :: Spatial3 s => Float -> s -> s | 51 | |
70 | pitch 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 |
80 | yaw :: Spatial3 s => Float -> s -> s | 62 | |
81 | yaw 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 | |
91 | roll :: Spatial3 s => Float -> s -> s | 73 | instance Spatial Transform3 Vector3 Rotation3 Matrix4 where |
92 | roll 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) |
102 | pos :: Spatial3 s => s -> Vector3 | 84 | (Matrix4.position matrix) |
103 | pos = p . getObj3 | 85 | |
104 | 86 | ||
105 | -- | Get the spatial's forward vector. | 87 | class Has3dTransform a where |
106 | fwd :: Spatial3 s => s -> Vector3 | 88 | -- | Set the object's 3d transform. |
107 | fwd = f . getObj3 | 89 | set3dTransform :: Transform3 -> a -> a |
108 | 90 | ||
109 | -- | Get the spatial's up vector. | 91 | -- | Get the object's 3d transform. |
110 | up :: Spatial3 s => s -> Vector3 | 92 | transform3 :: a -> Transform3 |
111 | up = u . getObj3 | 93 | |
112 | 94 | ||
113 | -- | Get the spatial's right vector. | 95 | with3dTransform :: Has3dTransform a => (Transform3 -> Transform3) -> a -> a |
114 | right :: Spatial3 s => s -> Vector3 | 96 | with3dTransform f obj = set3dTransform (f $ transform3 obj) obj |
115 | right = r . getObj3 | 97 | |
116 | 98 | -- | Build a 3d transform from right, up, forward and position vectors. | |
117 | -- | Get the spatial's transform. | 99 | newTransform3 :: Vector3 -> Vector3 -> Vector3 -> Vector3 -> Transform3 |
118 | transform :: Spatial3 s => s -> Matrix4 | 100 | newTransform3 right up forward pos = Transform3 $ |
119 | transform 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. |
122 | setTransform :: Spatial3 s => Matrix4 -> s -> s | 104 | rotate3 :: Vector3 -> Float -> Transform3 -> Transform3 |
123 | setTransform t s = | 105 | rotate3 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. |
128 | setPos :: Spatial3 s => Vector3 -> s -> s | 110 | pitch :: Float -> Transform3 -> Transform3 |
129 | setPos pos s = setObj3 s $ (getObj3 s) { p = pos } | 111 | pitch angle (Transform3 matrix) = |
130 | 112 | let sa = sin angle | |
131 | -- | Make the spatial look at the given point. | 113 | ca = cos angle |
132 | lookAt :: Spatial3 s => Vector3 -> s -> s | 114 | f' = normalise $ (ca * Matrix4.forward matrix) + (sa * Matrix4.up matrix) |
133 | lookAt 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 | 119 | yaw :: Float -> Transform3 -> Transform3 |
138 | in setTransform (M.transform r u (-fwd) position) s | 120 | yaw angle (Transform3 matrix) = |
139 | 121 | let sa = sin angle | |
140 | -- | Make the spatial orbit around the given point | 122 | ca = cos angle |
141 | orbit :: 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. | ||
128 | roll :: Float -> Transform3 -> Transform3 | ||
129 | roll 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 | ||
138 | orbit :: 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 | 145 | orbit pt anglex angley radius = | |
149 | orbit 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. | ||
162 | data Obj3 = Obj3 | ||
163 | { r :: Vector3 | ||
164 | , u :: Vector3 | ||
165 | , f :: Vector3 | ||
166 | , p :: Vector3 | ||
167 | } deriving Show | ||
168 | |||
169 | instance Spatial3 Obj3 where | ||
170 | getObj3 = id | ||
171 | setObj3 _ o' = o' | ||
172 | |||
173 | fromVectors :: Right3 -> Up3 -> Forward3 -> Position3 -> Obj3 | ||
174 | fromVectors = Obj3 | ||
175 | |||
176 | fromTransform :: Matrix4 -> Obj3 | ||
177 | fromTransform m = Obj3 (M.right m) (M.up m) (M.forward m) (M.position m) | ||
178 | |||
179 | toRAD = (*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 | |||
1 | module Spear.Math.Sphere | 4 | module Spear.Math.Sphere |
2 | where | 5 | where |
3 | 6 | ||
4 | import Spear.Math.Vector | 7 | import Spear.Math.Algebra |
8 | import Spear.Math.Spatial | ||
9 | import Spear.Math.Spatial3 | ||
10 | import Spear.Math.Vector | ||
11 | import Spear.Prelude | ||
12 | |||
13 | import Data.List (foldl') | ||
5 | 14 | ||
6 | import Data.List (foldl') | ||
7 | 15 | ||
8 | -- | A sphere in 3D space. | 16 | -- | A sphere in 3D space. |
9 | data Sphere = Sphere | 17 | data Sphere = Sphere |
@@ -11,12 +19,19 @@ data Sphere = Sphere | |||
11 | , radius :: {-# UNPACK #-} !Float | 19 | , radius :: {-# UNPACK #-} !Float |
12 | } | 20 | } |
13 | 21 | ||
22 | |||
23 | instance 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. |
15 | sphere :: [Vector3] -> Sphere | 30 | sphere :: [Vector3] -> Sphere |
16 | sphere [] = Sphere zero3 0 | 31 | sphere [] = Sphere zero3 0 |
17 | sphere (x:xs) = Sphere c r | 32 | sphere (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 | ) |
5 | where | 5 | where |
6 | 6 | ||
7 | import Spear.Math.Algebra | ||
8 | import Spear.Math.Vector | ||
7 | 9 | ||
8 | import Spear.Math.Vector | 10 | import Foreign.C.Types |
9 | 11 | import Foreign.Storable | |
10 | import Foreign.C.Types | 12 | import Prelude hiding ((*)) |
11 | import Foreign.Storable | ||
12 | 13 | ||
13 | 14 | ||
14 | data Triangle = Triangle | 15 | data Triangle = Triangle |
@@ -18,23 +19,17 @@ data Triangle = Triangle | |||
18 | } | 19 | } |
19 | 20 | ||
20 | 21 | ||
21 | sizeVector3 = 3 * sizeOf (undefined :: CFloat) | ||
22 | |||
23 | |||
24 | instance Storable Triangle where | 22 | instance 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 | |||
1 | module Spear.Math.Utils | 3 | module Spear.Math.Utils |
2 | ( | 4 | ( |
3 | Side(..) | 5 | Side(..) |
@@ -7,9 +9,10 @@ module Spear.Math.Utils | |||
7 | ) | 9 | ) |
8 | where | 10 | where |
9 | 11 | ||
10 | 12 | import Spear.Math.Algebra | |
11 | import Spear.Math.Matrix4 as M4 | 13 | import Spear.Math.Matrix4 as M4 |
12 | import Spear.Math.Vector as V | 14 | import Spear.Math.Vector as V |
15 | import Spear.Prelude | ||
13 | 16 | ||
14 | 17 | ||
15 | data Side = L | R deriving (Eq, Show) | 18 | data 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 @@ | |||
1 | module Spear.Math.Vector.Vector | 1 | {-# LANGUAGE FlexibleContexts #-} |
2 | where | 2 | |
3 | 3 | module Spear.Math.Vector.Vector where | |
4 | class (Fractional a, Ord a) => Vector a where | 4 | |
5 | -- | Create a vector from the given list. | 5 | import Spear.Math.Algebra |
6 | fromList :: [Float] -> a | 6 | |
7 | 7 | ||
8 | -- | Return the vector's x coordinate. | 8 | class |
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 | |||
1 | module Spear.Math.Vector.Vector2 | 5 | module Spear.Math.Vector.Vector2 |
2 | ( | 6 | ( |
3 | Vector2(..) | 7 | Vector2(..) |
@@ -14,30 +18,72 @@ module Spear.Math.Vector.Vector2 | |||
14 | ) | 18 | ) |
15 | where | 19 | where |
16 | 20 | ||
21 | import Spear.Math.Algebra | ||
17 | import Spear.Math.Vector.Vector | 22 | import Spear.Math.Vector.Vector |
23 | import Spear.Prelude | ||
18 | 24 | ||
19 | import Foreign.C.Types (CFloat) | 25 | import Foreign.C.Types (CFloat) |
20 | import Foreign.Storable | 26 | import Foreign.Storable |
27 | import qualified Prelude as P | ||
28 | |||
21 | 29 | ||
22 | type Right2 = Vector2 | 30 | type Right2 = Vector2 |
23 | type Up2 = Vector2 | 31 | type Up2 = Vector2 |
24 | type Position2 = Vector2 | 32 | type Position2 = Vector2 |
25 | 33 | ||
34 | |||
26 | -- | Represents a vector in 2D. | 35 | -- | Represents a vector in 2D. |
27 | data Vector2 = Vector2 {-# UNPACK #-} !Float {-# UNPACK #-} !Float deriving (Eq, Show) | 36 | data Vector2 = Vector2 {-# UNPACK #-} !Float {-# UNPACK #-} !Float deriving (Eq, Show) |
28 | 37 | ||
29 | 38 | ||
30 | instance Num Vector2 where | 39 | instance 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 | |||
44 | instance 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 | |||
49 | instance 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 | |||
54 | instance Quotient Vector2 Vector2 where | ||
55 | {-# INLINABLE (/) #-} | ||
56 | Vector2 ax ay / Vector2 bx by = Vector2 (ax / bx) (ay / by) | ||
57 | |||
58 | |||
59 | -- Scalar product. | ||
60 | instance Product Vector2 Float Vector2 where | ||
61 | {-# INLINABLE (*) #-} | ||
62 | (Vector2 x y) * s = Vector2 (s * x) (s * y) | ||
63 | |||
64 | |||
65 | instance Product Float Vector2 Vector2 where | ||
66 | {-# INLINABLE (*) #-} | ||
67 | s * (Vector2 x y) = Vector2 (s * x) (s * y) | ||
68 | |||
69 | |||
70 | -- Scalar division. | ||
71 | instance Quotient Vector2 Float where | ||
72 | {-# INLINABLE (/) #-} | ||
73 | (Vector2 x y) / s = Vector2 (x / s) (y / s) | ||
74 | |||
75 | |||
76 | instance 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 | ||
39 | instance Fractional Vector2 where | 85 | instance 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 | ||
53 | instance Vector Vector2 where | 99 | instance 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 | ||
90 | sizeFloat = sizeOf (undefined :: CFloat) | 133 | sizeFloat = sizeOf (undefined :: CFloat) |
91 | 134 | ||
92 | 135 | ||
93 | instance Storable Vector2 where | 136 | instance 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. |
117 | vec2 :: Float -> Float -> Vector2 | 160 | vec2 :: Float -> Float -> Vector2 |
118 | vec2 ax ay = Vector2 ax ay | 161 | vec2 = 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 | |||
1 | module Spear.Math.Vector.Vector3 | 5 | module 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 | ) |
18 | where | 23 | where |
19 | 24 | ||
20 | 25 | import Spear.Math.Algebra | |
21 | import Spear.Math.Vector.Vector | 26 | import Spear.Math.Vector.Vector |
27 | import Spear.Prelude | ||
22 | 28 | ||
23 | import Foreign.C.Types (CFloat) | 29 | import Foreign.C.Types (CFloat) |
24 | import Foreign.Storable | 30 | import Foreign.Storable |
31 | import qualified Prelude as P | ||
25 | 32 | ||
26 | type Right3 = Vector3 | 33 | type Right3 = Vector3 |
27 | type Up3 = Vector3 | 34 | type Up3 = Vector3 |
28 | type Forward3 = Vector3 | 35 | type Forward3 = Vector3 |
29 | type Position3 = Vector3 | 36 | type 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 | ||
39 | instance Num Vector3 where | 46 | |
47 | sizeVector3 = (3::Int) * sizeOf (undefined :: CFloat) | ||
48 | |||
49 | |||
50 | instance 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 | |||
55 | instance 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 | |||
60 | instance 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 | |||
65 | instance 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. | ||
71 | instance Product Vector3 Float Vector3 where | ||
72 | {-# INLINABLE (*) #-} | ||
73 | (Vector3 x y z) * s = Vector3 (s * x) (s * y) (s * z) | ||
74 | |||
75 | |||
76 | instance 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. | ||
82 | instance Quotient Vector3 Float where | ||
83 | {-# INLINABLE (/) #-} | ||
84 | (Vector3 x y z) / s = Vector3 (x / s) (y / s) (y / s) | ||
85 | |||
86 | |||
87 | instance 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 | ||
48 | instance Fractional Vector3 where | 96 | instance 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 | ||
79 | instance Vector Vector3 where | 129 | instance 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 | ||
120 | sizeFloat = sizeOf (undefined :: CFloat) | 167 | sizeFloat = sizeOf (undefined :: CFloat) |
121 | 168 | ||
122 | 169 | ||
123 | instance Storable Vector3 where | 170 | instance 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. |
140 | unitx3 = Vector3 1 0 0 | 187 | unitx3 = Vector3 1 0 0 |
141 | 188 | ||
142 | |||
143 | -- | Unit vector along the Y axis. | 189 | -- | Unit vector along the Y axis. |
144 | unity3 = Vector3 0 1 0 | 190 | unity3 = Vector3 0 1 0 |
145 | 191 | ||
146 | |||
147 | -- | Unit vector along the Z axis. | 192 | -- | Unit vector along the Z axis. |
148 | unitz3 = Vector3 0 0 1 | 193 | unitz3 = Vector3 0 0 1 |
149 | 194 | ||
150 | |||
151 | -- | Zero vector. | 195 | -- | Zero vector. |
152 | zero3 = Vector3 0 0 0 | 196 | zero3 = 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. |
156 | vec3 :: Float -> Float -> Float -> Vector3 | 199 | vec3 :: Float -> Float -> Float -> Vector3 |
157 | vec3 ax ay az = Vector3 ax ay az | 200 | vec3 = 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. |
161 | orbit :: Vector3 -- ^ Sphere center. | 203 | orbit :: 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 | |||
167 | orbit center radius anglex angley = | 208 | orbit 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. |
182 | cross :: Vector3 -> Vector3 -> Vector3 | 220 | cross :: 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 | |||
1 | module Spear.Math.Vector.Vector4 | 5 | module Spear.Math.Vector.Vector4 |
2 | ( | 6 | ( |
3 | Vector4(..) | 7 | Vector4(..) |
@@ -11,11 +15,13 @@ module Spear.Math.Vector.Vector4 | |||
11 | ) | 15 | ) |
12 | where | 16 | where |
13 | 17 | ||
14 | 18 | import Spear.Math.Algebra | |
15 | import Spear.Math.Vector.Vector | 19 | import Spear.Math.Vector.Vector |
20 | import Spear.Prelude | ||
16 | 21 | ||
17 | import Foreign.C.Types (CFloat) | 22 | import Foreign.C.Types (CFloat) |
18 | import Foreign.Storable | 23 | import Foreign.Storable |
24 | import 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 | ||
36 | instance 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 | |||
42 | instance 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 | |||
48 | instance 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 | |||
54 | instance 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. | ||
61 | instance 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 | |||
66 | instance 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. | ||
72 | instance Quotient Vector4 Float where | ||
73 | {-# INLINABLE (/) #-} | ||
74 | (Vector4 x y z w) / s = Vector4 (x / s) (y / s) (y / s) (w / s) | ||
75 | |||
76 | |||
30 | instance Num Vector4 where | 77 | instance 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 | ||
39 | instance Fractional Vector4 where | 86 | instance 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 | ||
76 | instance Vector Vector4 where | 123 | instance 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 | ||
121 | sizeFloat = sizeOf (undefined :: CFloat) | 165 | sizeFloat = sizeOf (undefined :: CFloat) |
122 | 166 | ||
123 | 167 | ||
124 | instance Storable Vector4 where | 168 | instance 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. |
143 | unitx4 = Vector4 1 0 0 0 | 187 | unitx4 = Vector4 1 0 0 0 |
144 | 188 | ||
145 | |||
146 | -- | Unit vector along the Y axis. | 189 | -- | Unit vector along the Y axis. |
147 | unity4 = Vector4 0 1 0 0 | 190 | unity4 = Vector4 0 1 0 0 |
148 | 191 | ||
149 | |||
150 | -- | Unit vector along the Z axis. | 192 | -- | Unit vector along the Z axis. |
151 | unitz4 = Vector4 0 0 1 0 | 193 | unitz4 = Vector4 0 0 1 0 |
152 | 194 | ||
153 | -- | Unit vector along the W axis. | 195 | -- | Unit vector along the W axis. |
154 | unitw4 = Vector4 0 0 0 1 | 196 | unitw4 = 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. |
158 | vec4 :: Float -> Float -> Float -> Float -> Vector4 | 199 | vec4 :: Float -> Float -> Float -> Float -> Vector4 |
159 | vec4 ax ay az aw = Vector4 ax ay az aw | 200 | vec4 = 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 | |||
3 | module Spear.Prelude | ||
4 | ( module BasePrelude | ||
5 | , module Spear.Math.Algebra | ||
6 | ) where | ||
7 | |||
8 | import Prelude as BasePrelude hiding (div, (*), (+), (-), | ||
9 | (/)) | ||
10 | import 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 | |||
1 | module Spear.Render.AnimatedModel | 4 | module Spear.Render.AnimatedModel |
2 | ( -- * Data types | 5 | ( -- * Data types |
3 | AnimatedModelResource, | 6 | AnimatedModelResource, |
@@ -31,19 +34,24 @@ module Spear.Render.AnimatedModel | |||
31 | ) | 34 | ) |
32 | where | 35 | where |
33 | 36 | ||
34 | import Control.Applicative ((<$>), (<*>)) | 37 | import Spear.Assets.Model |
35 | import qualified Data.Vector as V | 38 | import Spear.Game |
36 | import Spear.Assets.Model | 39 | import Spear.GL |
37 | import Spear.GL | 40 | import Spear.Math.AABB |
38 | import Spear.Game | 41 | import Spear.Math.Algebra |
39 | import Spear.Math.AABB | 42 | import Spear.Math.Collision |
40 | import Spear.Math.Collision | 43 | import Spear.Math.Matrix4 (Matrix4) |
41 | import Spear.Math.Matrix4 (Matrix4) | 44 | import Spear.Math.Vector |
42 | import Spear.Math.Vector | 45 | import Spear.Prelude |
43 | import Spear.Render.Material | 46 | import Spear.Render.Material |
44 | import Spear.Render.Model | 47 | import Spear.Render.Model |
45 | import Spear.Render.Program | 48 | import Spear.Render.Program |
46 | import Unsafe.Coerce (unsafeCoerce) | 49 | |
50 | import Control.Applicative ((<$>), (<*>)) | ||
51 | import qualified Data.Vector as V | ||
52 | import Foreign.C.Types | ||
53 | import Unsafe.Coerce (unsafeCoerce) | ||
54 | |||
47 | 55 | ||
48 | type AnimationSpeed = Float | 56 | type 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. |
53 | data AnimatedModelResource = AnimatedModelResource | 61 | data 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 | ||
64 | instance Eq AnimatedModelResource where | 72 | instance 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. |
84 | data AnimatedModelRenderer = AnimatedModelRenderer | 92 | data 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. |
173 | update :: Float -> AnimatedModelRenderer -> AnimatedModelRenderer | ||
165 | update dt (AnimatedModelRenderer model curAnim startFrame endFrame curFrame fp s) = | 174 | update 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. |
199 | setAnimation :: Enum a => a -> AnimatedModelRenderer -> AnimatedModelRenderer | 208 | setAnimation :: 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 | ) |
21 | where | 21 | where |
22 | 22 | ||
23 | import qualified Data.Vector as V | 23 | import Spear.Assets.Model |
24 | import Spear.Assets.Model | 24 | import Spear.Game |
25 | import Spear.GL | 25 | import Spear.GL |
26 | import Spear.Game | 26 | import Spear.Math.AABB |
27 | import Spear.Math.AABB | 27 | import Spear.Math.Algebra |
28 | import Spear.Math.Collision | 28 | import Spear.Math.Collision |
29 | import Spear.Math.Matrix4 (Matrix4) | 29 | import Spear.Math.Matrix4 (Matrix4) |
30 | import Spear.Math.Vector | 30 | import Spear.Math.Vector |
31 | import Spear.Render.Material | 31 | import Spear.Render.Material |
32 | import Spear.Render.Model | 32 | import Spear.Render.Model |
33 | import Spear.Render.Program | 33 | import Spear.Render.Program |
34 | import Unsafe.Coerce (unsafeCoerce) | 34 | |
35 | import qualified Data.Vector as V | ||
36 | import Foreign.C.Types | ||
37 | import Prelude hiding ((*)) | ||
38 | import Unsafe.Coerce (unsafeCoerce) | ||
39 | |||
35 | 40 | ||
36 | data StaticModelResource = StaticModelResource | 41 | data 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 | ||
45 | instance Eq StaticModelResource where | 50 | instance 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 | ) |
16 | where | 16 | where |
17 | 17 | ||
18 | import Control.Monad.State.Strict | 18 | import Control.Monad.State.Strict |
19 | import Control.Monad.Trans (lift) | 19 | import Control.Monad.Trans (lift) |
20 | import Data.List as L (find) | 20 | import Data.List as L (find) |
21 | import Data.Map as M | 21 | import Data.Map as M |
22 | import qualified Data.StateVar as SV (get) | 22 | import qualified Data.StateVar as SV (get) |
23 | import Spear.Assets.Model as Model | 23 | import Prelude hiding ((*)) |
24 | import qualified Spear.GL as GL | 24 | import Spear.Assets.Model as Model |
25 | import Spear.Game | 25 | import Spear.Game |
26 | import Spear.Math.Collision | 26 | import qualified Spear.GL as GL |
27 | import Spear.Math.Matrix3 as M3 | 27 | import Spear.Math.Algebra |
28 | import Spear.Math.Matrix4 as M4 | 28 | import Spear.Math.Collision |
29 | import Spear.Math.MatrixUtils (fastNormalMatrix) | 29 | import Spear.Math.Matrix3 as M3 |
30 | import Spear.Math.Vector | 30 | import Spear.Math.Matrix4 as M4 |
31 | import Spear.Render.AnimatedModel as AM | 31 | import Spear.Math.MatrixUtils (fastNormalMatrix) |
32 | import Spear.Render.Material | 32 | import Spear.Math.Vector |
33 | import Spear.Render.Program | 33 | import Spear.Render.AnimatedModel as AM |
34 | import Spear.Render.StaticModel as SM | 34 | import Spear.Render.Material |
35 | import Spear.Scene.Graph | 35 | import Spear.Render.Program |
36 | import Spear.Scene.SceneResources | 36 | import Spear.Render.StaticModel as SM |
37 | import Text.Printf (printf) | 37 | import Spear.Scene.Graph |
38 | import Spear.Scene.SceneResources | ||
39 | import Text.Printf (printf) | ||
38 | 40 | ||
39 | type Loader = Game SceneResources | 41 | type Loader = Game SceneResources |
40 | 42 | ||
@@ -62,8 +64,8 @@ resourceMap' :: SceneGraph -> Loader () | |||
62 | resourceMap' node@(SceneLeaf nid props) = do | 64 | resourceMap' 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 () |
67 | resourceMap' node@(SceneNode nid props children) = do | 69 | resourceMap' 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 | |||
169 | loadModel' file rotation scale = do | 171 | loadModel' 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. |
301 | value :: String -> [Property] -> Maybe [String] | 303 | value :: String -> [Property] -> Maybe [String] |
302 | value name props = case L.find ((==) name . fst) props of | 304 | value 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 | ||
306 | unspecified :: Maybe a -> a -> a | 308 | unspecified :: Maybe a -> a -> a |
307 | unspecified (Just x) _ = x | 309 | unspecified (Just x) _ = x |
308 | unspecified Nothing x = x | 310 | unspecified Nothing x = x |
309 | 311 | ||
310 | mandatory :: String -> [Property] -> Game s [String] | 312 | mandatory :: String -> [Property] -> Game s [String] |
311 | mandatory name props = case value name props of | 313 | mandatory 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 | ||
315 | mandatory' :: String -> [Property] -> Loader [String] | 317 | mandatory' :: String -> [Property] -> Loader [String] |
316 | mandatory' name props = mandatory name props | 318 | mandatory' name props = mandatory name props |
@@ -325,19 +327,19 @@ asVec2 :: Functor f => f [String] -> f Vector2 | |||
325 | asVec2 val = fmap toVec2 val | 327 | asVec2 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 | ||
330 | asVec3 :: Functor f => f [String] -> f Vector3 | 332 | asVec3 :: Functor f => f [String] -> f Vector3 |
331 | asVec3 val = fmap toVec3 val | 333 | asVec3 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 | ||
336 | asVec4 :: Functor f => f [String] -> f Vector4 | 338 | asVec4 :: Functor f => f [String] -> f Vector4 |
337 | asVec4 val = fmap toVec4 val | 339 | asVec4 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 | ||
342 | asRotation :: Functor f => f [String] -> f Rotation | 344 | asRotation :: Functor f => f [String] -> f Rotation |
343 | asRotation val = fmap parseRotation val | 345 | asRotation 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 | ||
347 | data Rotation = Rotation | 349 | data 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) | |||
31 | import qualified Data.Map as Map | 31 | import qualified Data.Map as Map |
32 | import Data.Monoid | 32 | import Data.Monoid |
33 | 33 | ||
34 | type Elapsed = Double | 34 | type Elapsed = Float |
35 | 35 | ||
36 | type Dt = Float | 36 | type Dt = Float |
37 | 37 | ||