diff options
-rw-r--r-- | Spear/Math/Camera.hs | 24 | ||||
-rw-r--r-- | Spear/Math/Spatial3.hs | 89 | ||||
-rw-r--r-- | Spear/Scene/Light.hs | 55 |
3 files changed, 53 insertions, 115 deletions
diff --git a/Spear/Math/Camera.hs b/Spear/Math/Camera.hs index 86d6f9e..e7062ab 100644 --- a/Spear/Math/Camera.hs +++ b/Spear/Math/Camera.hs | |||
@@ -15,17 +15,19 @@ module Spear.Math.Camera | |||
15 | ) | 15 | ) |
16 | where | 16 | where |
17 | 17 | ||
18 | |||
19 | import qualified Spear.Math.Matrix4 as M | 18 | import qualified Spear.Math.Matrix4 as M |
20 | import Spear.Math.Spatial3 | 19 | import Spear.Math.Spatial3 |
21 | import Spear.Math.Vector | 20 | import Spear.Math.Vector |
22 | 21 | ||
23 | |||
24 | data Camera = Camera | 22 | data Camera = Camera |
25 | { projection :: M.Matrix4 -- ^ Get the camera's projection. | 23 | { projection :: M.Matrix4 -- ^ Get the camera's projection. |
26 | , spatial :: Obj3 | 24 | , spatial :: Obj3 |
27 | } | 25 | } |
28 | 26 | ||
27 | instance Spatial3 Camera where | ||
28 | getObj3 = spatial | ||
29 | setObj3 cam o = cam { spatial = o } | ||
30 | |||
29 | type Fovy = Float | 31 | type Fovy = Float |
30 | type Aspect = Float | 32 | type Aspect = Float |
31 | type Near = Float | 33 | type Near = Float |
@@ -71,21 +73,3 @@ ortho l r b t n f right up fwd pos = | |||
71 | { projection = M.ortho l r b t n f | 73 | { projection = M.ortho l r b t n f |
72 | , spatial = fromVectors right up fwd pos | 74 | , spatial = fromVectors right up fwd pos |
73 | } | 75 | } |
74 | |||
75 | |||
76 | instance Spatial3 Camera where | ||
77 | move v cam = cam { spatial = move v $ spatial cam } | ||
78 | moveFwd s cam = cam { spatial = moveFwd s $ spatial cam } | ||
79 | moveBack s cam = cam { spatial = moveBack s $ spatial cam } | ||
80 | strafeLeft s cam = cam { spatial = strafeLeft s $ spatial cam } | ||
81 | strafeRight s cam = cam { spatial = strafeRight s $ spatial cam } | ||
82 | pitch a cam = cam { spatial = pitch a $ spatial cam } | ||
83 | yaw a cam = cam { spatial = yaw a $ spatial cam } | ||
84 | roll a cam = cam { spatial = roll a $ spatial cam } | ||
85 | pos cam = pos $ spatial cam | ||
86 | fwd cam = fwd $ spatial cam | ||
87 | up cam = up $ spatial cam | ||
88 | right cam = right $ spatial cam | ||
89 | transform cam = transform $ spatial cam | ||
90 | setTransform m cam = cam { spatial = setTransform m $ spatial cam } | ||
91 | setPos p cam = cam { spatial = setPos p $ spatial cam } | ||
diff --git a/Spear/Math/Spatial3.hs b/Spear/Math/Spatial3.hs index 2bc772e..7d0420a 100644 --- a/Spear/Math/Spatial3.hs +++ b/Spear/Math/Spatial3.hs | |||
@@ -11,50 +11,99 @@ import Spear.Math.Vector | |||
11 | import Spear.Math.Matrix4 as M hiding (scale) | 11 | import Spear.Math.Matrix4 as M hiding (scale) |
12 | 12 | ||
13 | class Spatial3 s where | 13 | class Spatial3 s where |
14 | -- | Gets the spatial's internal Obj3. | ||
15 | getObj3 :: s -> Obj3 | ||
16 | |||
17 | -- | Set the spatial's internal Obj3. | ||
18 | setObj3 :: s -> Obj3 -> s | ||
19 | |||
14 | -- | Move the spatial. | 20 | -- | Move the spatial. |
15 | move :: Vector3 -> s -> s | 21 | move :: Vector3 -> s -> s |
22 | move d s = let o = getObj3 s in setObj3 s $ o { p = p o + d } | ||
16 | 23 | ||
17 | -- | Move the spatial forwards. | 24 | -- | Move the spatial forwards. |
18 | moveFwd :: Float -> s -> s | 25 | moveFwd :: Float -> s -> s |
26 | moveFwd a s = let o = getObj3 s in setObj3 s $ o { p = p o + scale a (f o) } | ||
19 | 27 | ||
20 | -- | Move the spatial backwards. | 28 | -- | Move the spatial backwards. |
21 | moveBack :: Float -> s -> s | 29 | moveBack :: Float -> s -> s |
30 | moveBack a s = let o = getObj3 s in setObj3 s $ o { p = p o + scale (-a) (f o) } | ||
22 | 31 | ||
23 | -- | Make the spatial strafe left. | 32 | -- | Make the spatial strafe left. |
24 | strafeLeft :: Float -> s -> s | 33 | strafeLeft :: Float -> s -> s |
34 | strafeLeft a s = let o = getObj3 s in setObj3 s $ o { p = p o + scale (-a) (r o) } | ||
25 | 35 | ||
26 | -- | Make the spatial Strafe right. | 36 | -- | Make the spatial Strafe right. |
27 | strafeRight :: Float -> s -> s | 37 | strafeRight :: Float -> s -> s |
38 | strafeRight a s = let o = getObj3 s in setObj3 s $ o { p = p o + scale a (r o) } | ||
28 | 39 | ||
29 | -- | Rotate the spatial about its local X axis. | 40 | -- | Rotate the spatial about its local X axis. |
30 | pitch :: Float -> s -> s | 41 | pitch :: Float -> s -> s |
42 | pitch a s = | ||
43 | let o = getObj3 s | ||
44 | a' = toRAD a | ||
45 | sa = sin a' | ||
46 | ca = cos a' | ||
47 | f' = normalise $ scale ca (f o) + scale sa (u o) | ||
48 | u' = normalise $ r o `cross` f' | ||
49 | in setObj3 s $ o { u = u', f = f' } | ||
31 | 50 | ||
32 | -- | Rotate the spatial about its local Y axis. | 51 | -- | Rotate the spatial about its local Y axis. |
33 | yaw :: Float -> s -> s | 52 | yaw :: Float -> s -> s |
53 | yaw a s = | ||
54 | let o = getObj3 s | ||
55 | a' = toRAD a | ||
56 | sa = sin a' | ||
57 | ca = cos a' | ||
58 | r' = normalise $ scale ca (r o) + scale sa (f o) | ||
59 | f' = normalise $ u o `cross` r' | ||
60 | in setObj3 s $ o { r = r', f = f' } | ||
34 | 61 | ||
35 | -- | Rotate the spatial about its local Z axis. | 62 | -- | Rotate the spatial about its local Z axis. |
36 | roll :: Float -> s -> s | 63 | roll :: Float -> s -> s |
64 | roll a s = | ||
65 | let o = getObj3 s | ||
66 | a' = toRAD a | ||
67 | sa = sin a' | ||
68 | ca = cos a' | ||
69 | u' = normalise $ scale ca (u o) - scale sa (r o) | ||
70 | r' = normalise $ f o `cross` u' | ||
71 | in setObj3 s $ o { r = r', u = u' } | ||
37 | 72 | ||
38 | -- | Get the spatial's position. | 73 | -- | Get the spatial's position. |
39 | pos :: s -> Vector3 | 74 | pos :: s -> Vector3 |
75 | pos = p . getObj3 | ||
40 | 76 | ||
41 | -- | Get the spatial's forward vector. | 77 | -- | Get the spatial's forward vector. |
42 | fwd :: s -> Vector3 | 78 | fwd :: s -> Vector3 |
79 | fwd = f . getObj3 | ||
43 | 80 | ||
44 | -- | Get the spatial's up vector. | 81 | -- | Get the spatial's up vector. |
45 | up :: s -> Vector3 | 82 | up :: s -> Vector3 |
83 | up = u . getObj3 | ||
46 | 84 | ||
47 | -- | Get the spatial's right vector. | 85 | -- | Get the spatial's right vector. |
48 | right :: s -> Vector3 | 86 | right :: s -> Vector3 |
87 | right = r . getObj3 | ||
49 | 88 | ||
50 | -- | Get the spatial's transform. | 89 | -- | Get the spatial's transform. |
51 | transform :: s -> Matrix4 | 90 | transform :: s -> Matrix4 |
91 | transform s = let o = getObj3 s in M.transform (r o) (u o) (scale (-1) $ f o) (p o) | ||
52 | 92 | ||
53 | -- | Set the spatial's transform. | 93 | -- | Set the spatial's transform. |
54 | setTransform :: Matrix4 -> s -> s | 94 | setTransform :: Matrix4 -> s -> s |
95 | setTransform t s = | ||
96 | let o = Obj3 | ||
97 | { r = M.right t | ||
98 | , u = M.up t | ||
99 | , f = scale (-1) $ M.forward t | ||
100 | , p = M.position t | ||
101 | } | ||
102 | in setObj3 s o | ||
55 | 103 | ||
56 | -- | Set the spatial's position. | 104 | -- | Set the spatial's position. |
57 | setPos :: Vector3 -> s -> s | 105 | setPos :: Vector3 -> s -> s |
106 | setPos pos s = setObj3 s $ (getObj3 s) { p = pos } | ||
58 | 107 | ||
59 | -- | Make the spatial look at the given point. | 108 | -- | Make the spatial look at the given point. |
60 | lookAt :: Vector3 -> s -> s | 109 | lookAt :: Vector3 -> s -> s |
@@ -95,46 +144,6 @@ data Obj3 = Obj3 | |||
95 | , p :: Vector3 | 144 | , p :: Vector3 |
96 | } deriving Show | 145 | } deriving Show |
97 | 146 | ||
98 | instance Spatial3 Obj3 where | ||
99 | move d o = o { p = p o + d } | ||
100 | moveFwd s o = o { p = p o + scale (-s) (f o) } | ||
101 | moveBack s o = o { p = p o + scale s (f o) } | ||
102 | strafeLeft s o = o { p = p o + scale (-s) (r o) } | ||
103 | strafeRight s o = o { p = p o + scale s (r o) } | ||
104 | pitch a o = | ||
105 | let a' = toRAD a | ||
106 | sa = sin a' | ||
107 | ca = cos a' | ||
108 | r' = normalise $ scale ca (r o) + scale sa (f o) | ||
109 | f' = normalise $ r' `cross` u o | ||
110 | in o { r = r', f = f' } | ||
111 | yaw a o = | ||
112 | let a' = toRAD a | ||
113 | sa = sin a' | ||
114 | ca = cos a' | ||
115 | f' = normalise $ scale ca (f o) + scale sa (u o) | ||
116 | u' = normalise $ r o `cross` f' | ||
117 | in o { u = u', f = f' } | ||
118 | roll a o = | ||
119 | let a' = toRAD a | ||
120 | sa = sin a' | ||
121 | ca = cos a' | ||
122 | u' = normalise $ scale ca (u o) - scale sa (r o) | ||
123 | f' = normalise $ f o `cross` u' | ||
124 | in o { u = u', f = f' } | ||
125 | pos = p | ||
126 | fwd = f | ||
127 | up = u | ||
128 | right = r | ||
129 | transform o = M.transform (r o) (u o) (f o) (p o) | ||
130 | setTransform t o = Obj3 | ||
131 | { r = M.right t | ||
132 | , u = M.up t | ||
133 | , f = M.forward t | ||
134 | , p = M.position t | ||
135 | } | ||
136 | setPos pos o = o { p = pos } | ||
137 | |||
138 | fromVectors :: Right3 -> Up3 -> Forward3 -> Position3 -> Obj3 | 147 | fromVectors :: Right3 -> Up3 -> Forward3 -> Position3 -> Obj3 |
139 | fromVectors = Obj3 | 148 | fromVectors = Obj3 |
140 | 149 | ||
diff --git a/Spear/Scene/Light.hs b/Spear/Scene/Light.hs index 5f43b19..f63b91d 100644 --- a/Spear/Scene/Light.hs +++ b/Spear/Scene/Light.hs | |||
@@ -29,58 +29,3 @@ data Light | |||
29 | , specular :: Vector3 | 29 | , specular :: Vector3 |
30 | , transform :: M.Matrix4 | 30 | , transform :: M.Matrix4 |
31 | } | 31 | } |
32 | |||
33 | |||
34 | instance S.Spatial3 Light where | ||
35 | move _ l@DirectionalLight {} = l | ||
36 | move v l = l { transform = M.translv v * transform l} | ||
37 | |||
38 | moveFwd _ l@DirectionalLight {} = l | ||
39 | moveFwd f l = l { transform = M.translv (scale f $ S.fwd l) * transform l } | ||
40 | |||
41 | moveBack _ l@DirectionalLight {} = l | ||
42 | moveBack f l = l { transform = M.translv (scale (-f) $ S.fwd l) * transform l } | ||
43 | |||
44 | strafeLeft _ l@DirectionalLight {} = l | ||
45 | strafeLeft f l = l { transform = M.translv (scale (-f) $ S.right l) * transform l } | ||
46 | |||
47 | strafeRight _ l@DirectionalLight {} = l | ||
48 | strafeRight f l = l { transform = M.translv (scale f $ S.right l) * transform l } | ||
49 | |||
50 | pitch _ l@DirectionalLight {} = l | ||
51 | pitch a l = l { transform = transform l * M.axisAngle (S.right l) a } | ||
52 | |||
53 | yaw _ l@DirectionalLight {} = l | ||
54 | yaw a l = l { transform = transform l * M.axisAngle (S.up l) a } | ||
55 | |||
56 | roll _ l@DirectionalLight {} = l | ||
57 | roll a l = l { transform = transform l * M.axisAngle (S.fwd l) a } | ||
58 | |||
59 | pos l@DirectionalLight {} = vec3 0 0 0 | ||
60 | pos l = M.position . transform $ l | ||
61 | |||
62 | fwd (DirectionalLight _ _ _ f) = f | ||
63 | fwd l = M.forward . transform $ l | ||
64 | |||
65 | up l@DirectionalLight {} = vec3 0 1 0 | ||
66 | up l = M.up . transform $ l | ||
67 | |||
68 | right l@DirectionalLight {} = vec3 1 0 0 | ||
69 | right l = M.right . transform $ l | ||
70 | |||
71 | transform (PointLight _ _ _ transf) = transf | ||
72 | transform (DirectionalLight _ _ _ fwd) = | ||
73 | let up' = vec3 0 1 0 | ||
74 | right = up `cross` fwd | ||
75 | up = fwd `cross` right | ||
76 | in | ||
77 | M.transform up right fwd (vec3 0 0 0) | ||
78 | transform (SpotLight _ _ _ transf) = transf | ||
79 | |||
80 | setTransform _ l@DirectionalLight {} = l | ||
81 | setTransform t l = l { Spear.Scene.Light.transform = t } | ||
82 | |||
83 | setPos _ l@DirectionalLight {} = l | ||
84 | setPos pos l = | ||
85 | let t = Spear.Scene.Light.transform l | ||
86 | in l { transform = M.transform (M.right t) (M.up t) (M.forward t) pos } | ||