diff options
-rw-r--r-- | Matrix.hs | 186 | ||||
-rw-r--r-- | mainObj.hs | 5 |
2 files changed, 19 insertions, 172 deletions
@@ -6,60 +6,30 @@ import Foreign.Storable | |||
6 | import Data.Vector.Generic as V (snoc,init) | 6 | import Data.Vector.Generic as V (snoc,init) |
7 | import Prelude hiding ((<>)) | 7 | import Prelude hiding ((<>)) |
8 | 8 | ||
9 | -- | 3×3 rotation matrix about the x axis. | ||
9 | rotMatrixX :: (Storable a, Floating a) => a -> Matrix a | 10 | rotMatrixX :: (Storable a, Floating a) => a -> Matrix a |
10 | rotMatrixX a = (4><4) | 11 | rotMatrixX a = (3><3) |
11 | [ 1 , 0 , 0 , 0 | 12 | [ 1 , 0 , 0 |
12 | , 0 , c , -s , 0 | 13 | , 0 , c , -s |
13 | , 0 , s , c , 0 | 14 | , 0 , s , c ] where (c,s) = (cos a, sin a) |
14 | , 0 , 0 , 0 , 1 ] where (c,s) = (cos a, sin a) | ||
15 | 15 | ||
16 | 16 | ||
17 | -- | 3×3 rotation matrix about the y axis. | ||
17 | rotMatrixY :: (Storable a, Floating a) => a -> Matrix a | 18 | rotMatrixY :: (Storable a, Floating a) => a -> Matrix a |
18 | rotMatrixY a = (4><4) | 19 | rotMatrixY a = (3><3) |
19 | [ c , 0 , s , 0 | 20 | [ c , 0 , s |
20 | , 0 , 1 , 0 , 0 | 21 | , 0 , 1 , 0 |
21 | , -s , 0 , c , 0 | 22 | , -s , 0 , c ] where (c,s) = (cos a, sin a) |
22 | , 0 , 0 , 0 , 1 ] where (c,s) = (cos a, sin a) | ||
23 | 23 | ||
24 | -- | 3×3 rotation matrix about the z axis. | ||
24 | rotMatrixZ :: (Storable a, Floating a) => a -> Matrix a | 25 | rotMatrixZ :: (Storable a, Floating a) => a -> Matrix a |
25 | rotMatrixZ a = (4><4) | 26 | rotMatrixZ a = (3><3) |
26 | [ c , -s , 0 , 0 | 27 | [ c , -s , 0 |
27 | , s , c , 0 , 0 | 28 | , s , c , 0 |
28 | , 0 , 0 , 1 , 0 | 29 | , 0 , 0 , 1 ] where (c,s) = (cos a, sin a) |
29 | , 0 , 0 , 0 , 1 ] where (c,s) = (cos a, sin a) | ||
30 | 30 | ||
31 | 31 | ||
32 | -- | Equivalent to | 32 | -- | Camera transformation matrix (4×4). |
33 | -- | ||
34 | -- > translateBefore3to4 v m = translation v <> homoMatrix m | ||
35 | -- | ||
36 | -- where translation and homoMatrix are taken as the usual transformations into | ||
37 | -- the 4-dimensional homogeneous coordinate space. | ||
38 | translateBefore3to4 :: Numeric t => | ||
39 | Vector t -- 3 vector (translation) | ||
40 | -> Matrix t -- 3><3 matrix (projection) | ||
41 | -> Matrix t -- 4><4 matrix (projection) | ||
42 | translateBefore3to4 v p3 = fromRows $ rs ++ [u] | ||
43 | where | ||
44 | !u = snoc (v <# p3) 1 | ||
45 | rs = map (`snoc` 0) $ toRows p3 | ||
46 | {-# SPECIALIZE translateBefore3to4 :: Vector R -> Matrix R -> Matrix R #-} | ||
47 | |||
48 | {- | ||
49 | lookat pos target up = translateBefore3to4 (negate pos) r | ||
50 | where | ||
51 | backward = normalize $ pos - target | ||
52 | rightward = normalize $ up `cross` backward | ||
53 | upward = backward `cross` rightward | ||
54 | r = fromColumns [rightward,upward,backward] | ||
55 | |||
56 | -- Rebind 'normalize' in order to support Float which has no Field | ||
57 | -- instance. | ||
58 | normalize :: (Linear t c, Fractional t, Normed (c t)) => c t -> c t | ||
59 | normalize v = scale (1 / realToFrac (norm_2 v)) v | ||
60 | -} | ||
61 | |||
62 | -- | Camera transformation matrix (4x4). | ||
63 | lookat :: (Numeric t, Num (Vector t), Fractional t, Normed (Vector t)) => | 33 | lookat :: (Numeric t, Num (Vector t), Fractional t, Normed (Vector t)) => |
64 | Vector t -- ^ Camera position 3-vector. | 34 | Vector t -- ^ Camera position 3-vector. |
65 | -> Vector t -- ^ Target position 3-vector. | 35 | -> Vector t -- ^ Target position 3-vector. |
@@ -85,13 +55,11 @@ lookat pos target up = fromRows | |||
85 | 55 | ||
86 | 56 | ||
87 | 57 | ||
88 | |||
89 | |||
90 | -- lookat pos target up <> rot t | 58 | -- lookat pos target up <> rot t |
91 | -- == lookat ((((pos - target) <# rot (-t))) + target) | 59 | -- == lookat ((((pos - target) <# rot (-t))) + target) |
92 | -- target | 60 | -- target |
93 | -- | 61 | -- |
94 | -- | Perspective transformation 4x4 matrix. | 62 | -- | Perspective transformation 4×4 matrix. |
95 | perspective :: (Storable a, Floating a) => | 63 | perspective :: (Storable a, Floating a) => |
96 | a -- ^ Near plane clipping distance (always positive). | 64 | a -- ^ Near plane clipping distance (always positive). |
97 | -> a -- ^ Far plane clipping distance (always positive). | 65 | -> a -- ^ Far plane clipping distance (always positive). |
@@ -108,123 +76,3 @@ perspective n f fovy aspect = (4><4) | |||
108 | b = -t | 76 | b = -t |
109 | r = aspect*t | 77 | r = aspect*t |
110 | l = -r | 78 | l = -r |
111 | |||
112 | |||
113 | |||
114 | -- | Build a look at view matrix | ||
115 | {- | ||
116 | lookat2 | ||
117 | :: (Epsilon a, Floating a) | ||
118 | => V3 a -- ^ Eye | ||
119 | -> V3 a -- ^ Center | ||
120 | -> V3 a -- ^ Up | ||
121 | -> M44 a | ||
122 | -} | ||
123 | lookat2 :: (Normed (Vector a), Field a, Num (Vector a)) => | ||
124 | Vector a -> Vector a -> Vector a -> Matrix a | ||
125 | lookat2 eye center up = fromColumns | ||
126 | [ snoc xa xd | ||
127 | , snoc ya yd | ||
128 | , snoc (-za) zd | ||
129 | , fromList [ 0 , 0 , 0 , 1 ] ] | ||
130 | where za = normalize $ center - eye | ||
131 | xa = normalize $ cross za up | ||
132 | ya = cross xa za | ||
133 | xd = -dot xa eye | ||
134 | yd = -dot ya eye | ||
135 | zd = dot za eye | ||
136 | |||
137 | {- | ||
138 | |||
139 | -- | Build a look at view matrix | ||
140 | lookAt | ||
141 | :: (Epsilon a, Floating a) | ||
142 | => V3 a -- ^ Eye | ||
143 | -> V3 a -- ^ Center | ||
144 | -> V3 a -- ^ Up | ||
145 | -> M44 a | ||
146 | lookAt eye center up = | ||
147 | V4 (V4 (xa^._x) (xa^._y) (xa^._z) xd) | ||
148 | (V4 (ya^._x) (ya^._y) (ya^._z) yd) | ||
149 | (V4 (-za^._x) (-za^._y) (-za^._z) zd) | ||
150 | (V4 0 0 0 1) | ||
151 | where za = normalize $ center - eye | ||
152 | xa = normalize $ cross za up | ||
153 | ya = cross xa za | ||
154 | xd = -dot xa eye | ||
155 | yd = -dot ya eye | ||
156 | zd = dot za eye | ||
157 | |||
158 | -- | Build a matrix for a symmetric perspective-view frustum | ||
159 | perspective | ||
160 | :: Floating a | ||
161 | => a -- ^ FOV (y direction, in radians) | ||
162 | -> a -- ^ Aspect ratio | ||
163 | -> a -- ^ Near plane | ||
164 | -> a -- ^ Far plane | ||
165 | -> M44 a | ||
166 | perspective fovy aspect near far = | ||
167 | V4 (V4 x 0 0 0) | ||
168 | (V4 0 y 0 0) | ||
169 | (V4 0 0 z w) | ||
170 | (V4 0 0 (-1) 0) | ||
171 | where tanHalfFovy = tan $ fovy / 2 | ||
172 | x = 1 / (aspect * tanHalfFovy) | ||
173 | y = 1 / tanHalfFovy | ||
174 | fpn = far + near | ||
175 | fmn = far - near | ||
176 | oon = 0.5/near | ||
177 | oof = 0.5/far | ||
178 | -- z = 1 / (near/fpn - far/fpn) -- would be better by .5 bits | ||
179 | z = -fpn/fmn | ||
180 | w = 1/(oof-oon) -- 13 bits error reduced to 0.17 | ||
181 | -- w = -(2 * far * near) / fmn | ||
182 | |||
183 | |||
184 | -- | Perspective transformation matrix in row major order. | ||
185 | perspective :: Float -- ^ Near plane clipping distance (always positive). | ||
186 | -> Float -- ^ Far plane clipping distance (always positive). | ||
187 | -> Float -- ^ Field of view of the y axis, in radians. | ||
188 | -> Float -- ^ Aspect ratio, i.e. screen's width\/height. | ||
189 | -> Mat4 | ||
190 | perspective n f fovy aspect = transpose $ | ||
191 | Mat4 (Vec4 (2*n/(r-l)) 0 (-(r+l)/(r-l)) 0) | ||
192 | (Vec4 0 (2*n/(t-b)) ((t+b)/(t-b)) 0) | ||
193 | (Vec4 0 0 (-(f+n)/(f-n)) (-2*f*n/(f-n))) | ||
194 | (Vec4 0 0 (-1) 0) | ||
195 | where | ||
196 | t = n*tan(fovy/2) | ||
197 | b = -t | ||
198 | r = aspect*t | ||
199 | l = -r | ||
200 | |||
201 | -} | ||
202 | |||
203 | lookAtRotate :: (Normed (Vector t), Num (Vector t), Numeric t, | ||
204 | Floating t) => | ||
205 | Vector t -> Vector t -> Vector t -> t -> Matrix t | ||
206 | lookAtRotate pos target up t = lookat pos target up <> m | ||
207 | where | ||
208 | m = rotMatrixX t {- <> rotMatrixZ t -} | ||
209 | |||
210 | rotateLookAt :: (Normed (Vector t), Floating t, Num (Vector t), | ||
211 | Numeric t) => | ||
212 | Vector t -> Vector t -> Vector t -> t -> Matrix t | ||
213 | rotateLookAt pos target up t = lookat pos' target up' | ||
214 | where | ||
215 | m = rotMatrixX (-t) | ||
216 | pos' = V.init $ (m #> snoc pos 0) | ||
217 | up' = V.init (m #> snoc up 0) | ||
218 | |||
219 | |||
220 | {- | ||
221 | void UniformMatrix{234}{fd}v( int location, sizei count, boolean transpose, const float *value ); | ||
222 | void UniformMatrix{2x3,3x2,2x4,4x2,3x4,4x3}{fd}v( int location, sizei count, boolean transpose, const float *value ); | ||
223 | |||
224 | The UniformMatrix{234}fv and UniformMatrix{234}dv commands will load count 2 × | ||
225 | 2, 3 × 3, or 4 × 4 matrices (corresponding to 2, 3, or 4 in the command name) | ||
226 | of single- or double-precision floating-point values, respectively, into a | ||
227 | uniform defined as a matrix or an array of matrices. If transpose is FALSE , | ||
228 | the matrix is specified in column major order, otherwise in row major order. | ||
229 | |||
230 | -} | ||
@@ -13,7 +13,6 @@ import Data.Text (Text) | |||
13 | import Data.Map.Strict (Map) | 13 | import Data.Map.Strict (Map) |
14 | import qualified Data.Map.Strict as Map | 14 | import qualified Data.Map.Strict as Map |
15 | import qualified Data.Vector as V | 15 | import qualified Data.Vector as V |
16 | import Data.Vector.Generic as VG (init,snoc) | ||
17 | import GI.Gdk.Objects | 16 | import GI.Gdk.Objects |
18 | import GI.GLib.Constants | 17 | import GI.GLib.Constants |
19 | import GI.Gtk as Gtk hiding (main) | 18 | import GI.Gtk as Gtk hiding (main) |
@@ -82,8 +81,8 @@ setUniforms gl storage st = do | |||
82 | roZ = rotMatrixZ (-tf) | 81 | roZ = rotMatrixZ (-tf) |
83 | roX = rotMatrixX (-tf) | 82 | roX = rotMatrixX (-tf) |
84 | ro = roZ <> roX | 83 | ro = roZ <> roX |
85 | pos = VG.init (ro #> fromList [0,0,10,0]) | 84 | pos = ro #> fromList [0,0,10] |
86 | up = VG.init (ro #> fromList [0,1,0,0]) | 85 | up = ro #> fromList [0,1,0] |
87 | cam = lookat pos 0 up | 86 | cam = lookat pos 0 up |
88 | LC.updateUniforms storage $ do | 87 | LC.updateUniforms storage $ do |
89 | "cam" @= return (cam :: Matrix Float) | 88 | "cam" @= return (cam :: Matrix Float) |