objdemo: pass view matrix from haskell.

1 files changed, 230 insertions, 0 deletions

diff --git a/Matrix.hs b/Matrix.hs
new file mode 100644
index 0000000..b47e223
--- /dev/null
+++ b/Matrix.hs
@@ -0,0 +1,230 @@
+{-# LANGUAGE BangPatterns, FlexibleContexts #-}
+module Matrix where
+
+import Numeric.LinearAlgebra
+import Foreign.Storable
+import Data.Vector.Generic as V (snoc,init)
+import Prelude hiding ((<>))
+
+rotMatrixX :: (Storable a, Floating a) => a -> Matrix a
+rotMatrixX a = (4><4)
+    [ 1 , 0 , 0  , 0
+    , 0 , c , -s , 0
+    , 0 , s , c  , 0
+    , 0 , 0 , 0  , 1 ] where (c,s) = (cos a, sin a)
+
+
+rotMatrixY :: (Storable a, Floating a) => a -> Matrix a
+rotMatrixY a = (4><4)
+    [  c , 0 , s , 0
+    ,  0 , 1 , 0 , 0
+    , -s , 0 , c , 0
+    ,  0 , 0 , 0 , 1 ] where (c,s) = (cos a, sin a)
+
+rotMatrixZ :: (Storable a, Floating a) => a -> Matrix a
+rotMatrixZ a = (4><4)
+    [ c , -s , 0 , 0
+    , s ,  c , 0 , 0
+    , 0 ,  0 , 1 , 0
+    , 0 ,  0 , 0 , 1 ] where (c,s) = (cos a, sin a)
+
+
+-- | Equivalent to
+--
+-- > translateBefore3to4 v m = translation v <> homoMatrix m
+--
+-- where translation and homoMatrix are taken as the usual transformations into
+-- the 4-dimensional homogeneous coordinate space.
+translateBefore3to4 :: Numeric t =>
+                        Vector t    -- 3 vector (translation)
+                        -> Matrix t -- 3><3 matrix (projection)
+                        -> Matrix t -- 4><4 matrix (projection)
+translateBefore3to4 v p3 = fromRows $ rs ++ [u]
+ where
+    !u = snoc (v <# p3) 1
+    rs = map (`snoc` 0) $ toRows p3
+{-# SPECIALIZE translateBefore3to4 :: Vector R -> Matrix R -> Matrix R #-}
+
+{-
+lookat pos target up = translateBefore3to4 (negate pos) r
+  where
+    backward  = normalize $ pos - target
+    rightward = normalize $ up `cross` backward
+    upward    = backward `cross` rightward
+    r = fromColumns [rightward,upward,backward]
+
+    -- Rebind 'normalize' in order to support Float which has no Field
+    -- instance.
+    normalize :: (Linear t c, Fractional t, Normed (c t)) => c t -> c t
+    normalize v = scale (1 / realToFrac (norm_2 v)) v
+-}
+
+-- | Camera transformation matrix (4x4).
+lookat :: (Numeric t, Num (Vector t), Fractional t, Normed (Vector t)) =>
+    Vector t    -- ^ Camera position 3-vector.
+    -> Vector t -- ^ Target position 3-vector.
+    -> Vector t -- ^ Upward direction 3-vector.
+    -> Matrix t
+lookat pos target up = fromRows
+    [ snoc rightward         (- dot rightward pos)
+    , snoc upward            (- dot upward    pos)
+    , snoc backward          (- dot backward  pos)
+    , snoc (fromList[0,0,0]) 1
+    ]
+  where
+    backward  = normalize $ pos - target
+    rightward = normalize $ up `cross` backward
+    upward    = backward `cross` rightward
+
+    -- Rebind 'normalize' in order to support Float which has no Field
+    -- instance.
+    normalize :: (Linear t c, Fractional t, Normed (c t)) => c t -> c t
+    normalize v = scale (1 / realToFrac (norm_2 v)) v
+
+{-# SPECIALIZE lookat :: Vector R -> Vector R -> Vector R -> Matrix R #-}
+
+
+
+
+
+-- lookat pos target up <> rot t
+--    == lookat ((((pos - target) <# rot (-t))) + target)
+--              target
+--
+-- | Perspective transformation 4x4 matrix.
+perspective :: (Storable a, Floating a) =>
+                a    -- ^ Near plane clipping distance (always positive).
+                -> a -- ^ Far plane clipping distance (always positive).
+                -> a -- ^ Field of view of the y axis, in radians.
+                -> a -- ^ Aspect ratio, i.e. screen's width\/height.
+                -> Matrix a
+perspective n f fovy aspect = (4><4)
+    [ (2*n/(r-l))    , 0             , 0              , 0
+    , 0              , (2*n/(t-b))   , 0              , 0
+    , (-(r+l)/(r-l)) , ((t+b)/(t-b)) , (-(f+n)/(f-n)) , (-1)
+    , 0              , 0             , (-2*f*n/(f-n)) , 0    ]
+  where
+    t = n*tan(fovy/2)
+    b = -t
+    r = aspect*t
+    l = -r
+
+
+
+-- | Build a look at view matrix
+{-
+lookat2
+  :: (Epsilon a, Floating a)
+  => V3 a -- ^ Eye
+  -> V3 a -- ^ Center
+  -> V3 a -- ^ Up
+  -> M44 a
+-}
+lookat2 :: (Normed (Vector a), Field a, Num (Vector a)) =>
+                 Vector a -> Vector a -> Vector a -> Matrix a
+lookat2 eye center up = fromColumns
+   [ snoc xa xd
+   , snoc ya yd
+   , snoc (-za) zd
+   , fromList [ 0 , 0 , 0 , 1 ] ]
+  where za = normalize $ center - eye
+        xa = normalize $ cross za up
+        ya = cross xa za
+        xd = -dot xa eye
+        yd = -dot ya eye
+        zd = dot za eye
+
+{-
+
+-- | Build a look at view matrix
+lookAt
+  :: (Epsilon a, Floating a)
+  => V3 a -- ^ Eye
+  -> V3 a -- ^ Center
+  -> V3 a -- ^ Up
+  -> M44 a
+lookAt eye center up =
+  V4 (V4 (xa^._x)  (xa^._y)  (xa^._z)  xd)
+     (V4 (ya^._x)  (ya^._y)  (ya^._z)  yd)
+     (V4 (-za^._x) (-za^._y) (-za^._z) zd)
+     (V4 0         0         0          1)
+  where za = normalize $ center - eye
+        xa = normalize $ cross za up
+        ya = cross xa za
+        xd = -dot xa eye
+        yd = -dot ya eye
+        zd = dot za eye
+
+-- | Build a matrix for a symmetric perspective-view frustum
+perspective
+  :: Floating a
+  => a -- ^ FOV (y direction, in radians)
+  -> a -- ^ Aspect ratio
+  -> a -- ^ Near plane
+  -> a -- ^ Far plane
+  -> M44 a
+perspective fovy aspect near far =
+  V4 (V4 x 0 0    0)
+     (V4 0 y 0    0)
+     (V4 0 0 z    w)
+     (V4 0 0 (-1) 0)
+  where tanHalfFovy = tan $ fovy / 2
+        x = 1 / (aspect * tanHalfFovy)
+        y = 1 / tanHalfFovy
+        fpn = far + near
+        fmn = far - near
+        oon = 0.5/near
+        oof = 0.5/far
+        -- z = 1 / (near/fpn - far/fpn) -- would be better by .5 bits
+        z = -fpn/fmn
+        w = 1/(oof-oon) -- 13 bits error reduced to 0.17
+        -- w = -(2 * far * near) / fmn
+
+
+-- | Perspective transformation matrix in row major order.
+perspective :: Float  -- ^ Near plane clipping distance (always positive).
+            -> Float  -- ^ Far plane clipping distance (always positive).
+            -> Float  -- ^ Field of view of the y axis, in radians.
+            -> Float  -- ^ Aspect ratio, i.e. screen's width\/height.
+            -> Mat4
+perspective n f fovy aspect = transpose $
+    Mat4 (Vec4 (2*n/(r-l))       0       (-(r+l)/(r-l))        0)
+         (Vec4     0        (2*n/(t-b))  ((t+b)/(t-b))         0)
+         (Vec4     0             0       (-(f+n)/(f-n))  (-2*f*n/(f-n)))
+         (Vec4     0             0            (-1)             0)
+  where
+    t = n*tan(fovy/2)
+    b = -t
+    r = aspect*t
+    l = -r
+
+-}
+
+lookAtRotate :: (Normed (Vector t), Num (Vector t), Numeric t,
+                       Floating t) =>
+                      Vector t -> Vector t -> Vector t -> t -> Matrix t
+lookAtRotate pos target up t = lookat pos target up <> m
+ where
+    m = rotMatrixX t {- <> rotMatrixZ t -}
+
+rotateLookAt :: (Normed (Vector t), Floating t, Num (Vector t),
+                       Numeric t) =>
+                      Vector t -> Vector t -> Vector t -> t -> Matrix t
+rotateLookAt pos target up t = lookat pos' target up'
+    where
+        m = rotMatrixX (-t)
+        pos' = V.init $ (m #> snoc pos 0)
+        up' = V.init (m #> snoc up 0)
+
+
+{-
+void UniformMatrix{234}{fd}v( int location, sizei count, boolean transpose, const float *value );
+void UniformMatrix{2x3,3x2,2x4,4x2,3x4,4x3}{fd}v( int location, sizei count, boolean transpose, const float *value );
+
+The UniformMatrix{234}fv and UniformMatrix{234}dv commands will load count 2 ×
+2, 3 × 3, or 4 × 4 matrices (corresponding to 2, 3, or 4 in the command name)
+of single- or double-precision floating-point values, respectively, into a
+uniform defined as a matrix or an array of matrices. If transpose is FALSE ,
+the matrix is specified in column major order, otherwise in row major order.
+
+-}