packages feed

lambdacube-engine-0.1.1: Graphics/LambdaCube/Math.hs

module Graphics.LambdaCube.Math where
import Graphics.LambdaCube.Types

vec4xscalar :: Vec4 -> FloatType -> Vec4
vec4xscalar (Vec4 x1 y1 z1 _) s = Vec4 (x1 * s) (y1 * s) (z1 * s) 0

vec4crossvec4 :: Vec4 -> Vec4 -> Vec4
vec4crossvec4 (Vec4 x1 y1 z1 _) (Vec4 x2 y2 z2 _) = Vec4 (y1*z2-y2*z1) (z1*x2-z2*x1) (x1*y2-x2*y1) 0

vec4subvec4 :: Vec4 -> Vec4 -> Vec4
vec4subvec4
    (Vec4
         a1 a2 a3 a4)
    (Vec4
         b1 b2 b3 b4)
    = (Vec4 (a1 - b1) (a2 - b2) (a3 - b3) (a4 - b4))

vec4addvec4 :: Vec4 -> Vec4 -> Vec4
vec4addvec4
    (Vec4
         a1 a2 a3 a4)
    (Vec4
         b1 b2 b3 b4)
    = (Vec4 (a1 + b1) (a2 + b2) (a3 + b3) (a4 + b4))

norm :: Vec4 -> Vec4
norm
    (Vec4
         a1 a2 a3 a4)
    = (Vec4 (a1 / l) (a2 / l) (a3 / l) (a4 / l))
  where
    l = sqrt (a1*a1 + a2*a2 + a3*a3 + a4*a4)

vec4xmat44 :: Vec4 -> Matrix4 -> Vec4
vec4xmat44
    (Vec4
         a1 a2 a3 a4)
    (Matrix4
        b11 b12 b13 b14
        b21 b22 b23 b24
        b31 b32 b33 b34
        b41 b42 b43 b44)
    = (Vec4
        (a1*b11+a2*b21+a3*b31+a4*b41) (a1*b12+a2*b22+a3*b32+a4*b42) (a1*b13+a2*b23+a3*b33+a4*b43) (a1*b14+a2*b24+a3*b34+a4*b44))

mat44xmat44 :: Matrix4 -> Matrix4 -> Matrix4
mat44xmat44
    (Matrix4
        a11 a12 a13 a14
        a21 a22 a23 a24
        a31 a32 a33 a34
        a41 a42 a43 a44)
    (Matrix4
        b11 b12 b13 b14
        b21 b22 b23 b24
        b31 b32 b33 b34
        b41 b42 b43 b44)
    = (Matrix4
        (a11*b11+a12*b21+a13*b31+a14*b41) (a11*b12+a12*b22+a13*b32+a14*b42) (a11*b13+a12*b23+a13*b33+a14*b43) (a11*b14+a12*b24+a13*b34+a14*b44)
        (a21*b11+a22*b21+a23*b31+a24*b41) (a21*b12+a22*b22+a23*b32+a24*b42) (a21*b13+a22*b23+a23*b33+a24*b43) (a21*b14+a22*b24+a23*b34+a24*b44)
        (a31*b11+a32*b21+a33*b31+a34*b41) (a31*b12+a32*b22+a33*b32+a34*b42) (a31*b13+a32*b23+a33*b33+a34*b43) (a31*b14+a32*b24+a33*b34+a34*b44)
        (a41*b11+a42*b21+a43*b31+a44*b41) (a41*b12+a42*b22+a43*b32+a44*b42) (a41*b13+a42*b23+a43*b33+a44*b43) (a41*b14+a42*b24+a43*b34+a44*b44))


transMatrix4 :: Matrix4 -> Matrix4
transMatrix4
    (Matrix4
        a11 a12 a13 a14
        a21 a22 a23 a24
        a31 a32 a33 a34
        a41 a42 a43 a44)
    = (Matrix4
        a11 a21 a31 a41
        a12 a22 a32 a42
        a13 a23 a33 a43
        a14 a24 a34 a44)
        
infixl 7 <>
a <> b = a `mat44xmat44` b

toListsMatrix4
    (Matrix4
        a11 a12 a13 a14
        a21 a22 a23 a24
        a31 a32 a33 a34
        a41 a42 a43 a44) = [a11, a12, a13, a14, a21, a22, a23, a24, a31, a32, a33, a34, a41, a42, a43, a44]
        
scal a = Matrix4
    a 0 0 0
    0 a 0 0
    0 0 a 0
    0 0 0 1 

transl x y z = Matrix4
    1 0 0 0
    0 1 0 0
    0 0 1 0
    x y z 1

rotX a = Matrix4
    1  0  0  0
    0  c  s  0
    0(-s) c  0
    0  0  0  1
  where
    c = cos a
    s = sin a

rotY a = Matrix4
     c 0 s 0
     0 1 0 0
    (-s) 0 c 0
     0 0 0 1 
  where
    c = cos a
    s = sin a

rotZ a = Matrix4
     c  s  0  0
   (-s) c  0  0
     0  0  1  0
     0  0  0  1
  where
    c = cos a
    s = sin a
    
--lookat eye@(Vec4 ex ey ez _) dir up =  (Matrix4 
lookat eye@(Vec4 ex ey ez _) dir up = (transl (-ex) (-ey) (-ez)) <> (Matrix4 
--lookat eye@(Vec4 ex ey ez _) dir up = (transl (ex) (ey) (ez)) <> Matrix4
    ux vx wx 0
    uy vy wy 0
    uz vz wz 0
    0  0  0  1)-- <> (transl (-ex) (-ey) (-ez))
  where
    w@(Vec4 wx wy wz _) = norm $ dir
    u@(Vec4 ux uy uz _) = norm $ up `vec4crossvec4` w
    v@(Vec4 vx vy vz _) = norm $ w `vec4crossvec4` u
 

mat44pos :: Matrix4 -> (FloatType,FloatType,FloatType,FloatType)
mat44pos
    (Matrix4
        _ _ _ _
        _ _ _ _
        _ _ _ _
        x y z w
    )
    = (x,y,z,w)

perpectiveMatrix fov aspect near far = Matrix4
    m00 0 0 0
    0 m11 0 0
    0 0 m22 (-1)
    0 0 m32 0
  where
    slopey  = tan $ fov * pi / 360
    m00     = 1 / slopey / aspect
    m11     = 1 / slopey
    m22     = -(near + far) / (far - near)
    m32     = -2 * near * far / (far - near)