Run "ormolu" on all source files.

9 files changed, 1400 insertions, 1002 deletions

diff --git a/Graphics/Glyph/BufferBuilder.hs b/Graphics/Glyph/BufferBuilder.hs
index 4800d3d..5704875 100644
--- a/Graphics/Glyph/BufferBuilder.hs
+++ b/Graphics/Glyph/BufferBuilder.hs
@@ -1,22 +1,22 @@
-{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskell #-}
+
 module Graphics.Glyph.BufferBuilder where
 
 import Control.Monad
-import Graphics.Rendering.OpenGL
-import Foreign.Storable
-import Foreign.Ptr
 import Data.Array.Storable
-import Debug.Trace
 import qualified Data.Foldable as Fold
 import Data.Sequence as Seq
-
+import Debug.Trace
+import Foreign.Ptr
+import Foreign.Storable
 import Graphics.Glyph.Mat4
 import Graphics.Glyph.Util
-
+import Graphics.Rendering.OpenGL
 import System.IO.Unsafe
 
-data BufferBuilder3D = Plot BufferBuilder3D (GLfloat,GLfloat,GLfloat) Int Int | End
+data BufferBuilder3D = Plot BufferBuilder3D (GLfloat, GLfloat, GLfloat) Int Int | End
+
 bufferSize :: BufferBuilder3D -> Int
 bufferSize End = 0
 bufferSize (Plot _ _ l _) = l
@@ -30,30 +30,33 @@ sizeofGLfloat = 4
 
 {- A state monad that keeps track of operations
  - and will compile them into a buffer -}
-data Builder b a = Builder {
-    bList :: Seq (BuildDatum b),
-    bReturn :: a
-} | BuildError String
-
-data BuildDatum b =
-    VertexLink (b,b,b)  |
-    NormalLink (b,b,b)  |
-    ColorLink (b,b,b,b) |
-    TextureLink (b,b) deriving Show
-
-data CompiledBuild b = CompiledBuild {
-    bStride :: Int,
-    bEnabled :: (Bool,Bool,Bool),
-    nElems  :: Int,
+data Builder b a
+  = Builder
+      { bList :: Seq (BuildDatum b),
+        bReturn :: a
+      }
+  | BuildError String
+
+data BuildDatum b
+  = VertexLink (b, b, b)
+  | NormalLink (b, b, b)
+  | ColorLink (b, b, b, b)
+  | TextureLink (b, b)
+  deriving (Show)
+
+data CompiledBuild b = CompiledBuild
+  { bStride :: Int,
+    bEnabled :: (Bool, Bool, Bool),
+    nElems :: Int,
     array :: StorableArray Int b
-}
+  }
 
 bufferLength :: (Integral a) => CompiledBuild b -> a
 bufferLength = fromIntegral . nElems
 
 instance Show (CompiledBuild x) where
-    show (CompiledBuild stride enabled n _) =
-        "[CompiledBuild stride="++!stride++" enabled"++!enabled++" n="++!n++"]"
+  show (CompiledBuild stride enabled n _) =
+    "[CompiledBuild stride=" ++! stride ++ " enabled" ++! enabled ++ " n=" ++! n ++ "]"
 
 instance Functor (Builder t) where
   fmap f b = b >>= (return . f)
@@ -66,106 +69,134 @@ instance Applicative (Builder t) where
     return (fn a)
 
 instance Monad (Builder t) where
-    (Builder lst1 _) >> (Builder lst2 ret) = Builder (lst2 >< lst1) ret
-    BuildError str >> _ = BuildError str
-    _ >> BuildError str = BuildError str
+  (Builder lst1 _) >> (Builder lst2 ret) = Builder (lst2 >< lst1) ret
+  BuildError str >> _ = BuildError str
+  _ >> BuildError str = BuildError str
 
-    b1@(Builder _ ret1) >>= func = b1 >> func ret1
-    BuildError str >>= _ = BuildError str
+  b1@(Builder _ ret1) >>= func = b1 >> func ret1
+  BuildError str >>= _ = BuildError str
 
-    return = Builder empty
+  return = Builder empty
 
 {- Add a vertex to the current builder -}
-bVertex3 :: (a,a,a) -> Builder a ()
+bVertex3 :: (a, a, a) -> Builder a ()
 bVertex3 vert = Builder (Seq.singleton $ VertexLink vert) ()
 
-bTexture2 :: (a,a) -> Builder a ()
+bTexture2 :: (a, a) -> Builder a ()
 bTexture2 tex = Builder (Seq.singleton $ TextureLink tex) ()
 
-bNormal3 :: (a,a,a) -> Builder a ()
+bNormal3 :: (a, a, a) -> Builder a ()
 bNormal3 norm = Builder (Seq.singleton $ NormalLink norm) ()
 
-bColor4 :: (a,a,a,a) -> Builder a ()
+bColor4 :: (a, a, a, a) -> Builder a ()
 bColor4 col = Builder (Seq.singleton $ ColorLink col) ()
 
 compilingBuilder :: (Storable b, Num b, Show b) => Builder b x -> IO (CompiledBuild b)
 compilingBuilder (Builder lst _) = do
-    -- Size of the elements
-    let sizeof = sizeOf $ tmp (Seq.index lst 0)
-                  where tmp (VertexLink (a,_,_)) = a
-                        tmp _ = 0
-    {- Simply figure out what types of elementse
-     - exist in this buffer -}
-    let en@(bn,bc,bt) = Fold.foldl' (\(bn,bc,bt) ele ->
-                                case ele of
-                                    NormalLink _ -> (True,bc,bt)
-                                    ColorLink _ -> (bn,True,bt)
-                                    TextureLink _ -> (bn,bc,True)
-                                    VertexLink _ -> (bn,bc,bt)) (False,False,False) lst
-    {- Calculate the stride; number of floats per element -}
-    let stride = (3 + (?)bn * 3 + (?)bc * 4 + (?)bt * 2) * sizeof
-                    where (?) True = 1
-                          (?) False = 0
-    --             Cur color normal texture buffer
-    let (nverts,_,_,_,buffer) =
-         Fold.foldl' (\(num,cn,cc,ct,ll) ele ->
-                   -- trace ("foldl " ++! ele) $
-                    case ele of
-                        NormalLink nn -> (num,nn,cc,ct,ll)
-                        ColorLink nc -> (num,cn,nc,ct,ll)
-                        TextureLink nt -> (num,cn,cc,nt,ll)
-                        VertexLink vert ->
-                         (num+1,cn,cc,ct,
-                            ll >< (tp3 True vert >< tp3 bn cn >< tp4 bc cc >< tp2 bt ct)
-                            )) ( 0, (0,0,0), (0,0,0,0), (0,0), Seq.empty ) (Seq.reverse lst)
-
-    let blst = (Fold.toList buffer)
-    arr <- blst `seq` newListArray (0,Seq.length buffer) blst
-    let compiledRet = CompiledBuild stride en nverts arr
-    compiledRet `seq` putStrLn ("Compiled: " ++! compiledRet ) `seq` return compiledRet
+  -- Size of the elements
+  let sizeof = sizeOf $ tmp (Seq.index lst 0)
+        where
+          tmp (VertexLink (a, _, _)) = a
+          tmp _ = 0
+  {- Simply figure out what types of elementse
+   - exist in this buffer -}
+  let en@(bn, bc, bt) =
+        Fold.foldl'
+          ( \(bn, bc, bt) ele ->
+              case ele of
+                NormalLink _ -> (True, bc, bt)
+                ColorLink _ -> (bn, True, bt)
+                TextureLink _ -> (bn, bc, True)
+                VertexLink _ -> (bn, bc, bt)
+          )
+          (False, False, False)
+          lst
+  {- Calculate the stride; number of floats per element -}
+  let stride = (3 + (?) bn * 3 + (?) bc * 4 + (?) bt * 2) * sizeof
+        where
+          (?) True = 1
+          (?) False = 0
+  --             Cur color normal texture buffer
+  let (nverts, _, _, _, buffer) =
+        Fold.foldl'
+          ( \(num, cn, cc, ct, ll) ele ->
+              -- trace ("foldl " ++! ele) $
+              case ele of
+                NormalLink nn -> (num, nn, cc, ct, ll)
+                ColorLink nc -> (num, cn, nc, ct, ll)
+                TextureLink nt -> (num, cn, cc, nt, ll)
+                VertexLink vert ->
+                  ( num + 1,
+                    cn,
+                    cc,
+                    ct,
+                    ll >< (tp3 True vert >< tp3 bn cn >< tp4 bc cc >< tp2 bt ct)
+                  )
+          )
+          (0, (0, 0, 0), (0, 0, 0, 0), (0, 0), Seq.empty)
+          (Seq.reverse lst)
+
+  let blst = (Fold.toList buffer)
+  arr <- blst `seq` newListArray (0, Seq.length buffer) blst
+  let compiledRet = CompiledBuild stride en nverts arr
+  compiledRet `seq` putStrLn ("Compiled: " ++! compiledRet) `seq` return compiledRet
   where
-      tp2 True (a,b)  = Seq.fromList [a,b]
-      tp2 False _  = empty
- 
-      tp3 True (a,b,c) = Seq.fromList [a,b,c]
-      tp3 False _ = empty
- 
-      tp4 True (a,b,c,d) = Seq.fromList [a,b,c,d]
-      tp4 False _ = empty
+    tp2 True (a, b) = Seq.fromList [a, b]
+    tp2 False _ = empty
+
+    tp3 True (a, b, c) = Seq.fromList [a, b, c]
+    tp3 False _ = empty
+
+    tp4 True (a, b, c, d) = Seq.fromList [a, b, c, d]
+    tp4 False _ = empty
 
 storableArrayToBuffer :: (Storable el) => BufferTarget -> StorableArray Int el -> IO BufferObject
 storableArrayToBuffer target arr = do
-    let sizeof = sizeOf $ unsafePerformIO (readArray arr 0)
-    [buffer] <- genObjectNames 1
-    bindBuffer target $= Just buffer
-    len <- getBounds arr >>= (\(a,b) -> return $ (b - a) * sizeof )
-    withStorableArray arr $ \ptr ->
-        bufferData target $= (fromIntegral len, ptr, StaticDraw)
-    return buffer
+  let sizeof = sizeOf $ unsafePerformIO (readArray arr 0)
+  [buffer] <- genObjectNames 1
+  bindBuffer target $= Just buffer
+  len <- getBounds arr >>= (\(a, b) -> return $ (b - a) * sizeof)
+  withStorableArray arr $ \ptr ->
+    bufferData target $= (fromIntegral len, ptr, StaticDraw)
+  return buffer
 
 vertexArrayDescriptor :: CompiledBuild GLfloat -> VertexArrayDescriptor GLfloat
 vertexArrayDescriptor (CompiledBuild stride _ _ _) = VertexArrayDescriptor 3 Float (fromIntegral stride) (wordPtrToPtr 0)
 
 normalArrayDescriptor :: CompiledBuild GLfloat -> Maybe (VertexArrayDescriptor GLfloat)
-normalArrayDescriptor (CompiledBuild stride (True,_,_) _ _) =
-                Just $ VertexArrayDescriptor 3 Float
-                        (fromIntegral stride) (wordPtrToPtr (3*4))
-normalArrayDescriptor  _ = Nothing
+normalArrayDescriptor (CompiledBuild stride (True, _, _) _ _) =
+  Just $
+    VertexArrayDescriptor
+      3
+      Float
+      (fromIntegral stride)
+      (wordPtrToPtr (3 * 4))
+normalArrayDescriptor _ = Nothing
 
 colorArrayDescriptor :: CompiledBuild GLfloat -> Maybe (VertexArrayDescriptor GLfloat)
-colorArrayDescriptor (CompiledBuild stride tup@(_,True,_) _ _) =
-                Just $ VertexArrayDescriptor 4 Float
-                        (fromIntegral stride) (wordPtrToPtr (offset tup))
-                where offset (b1,_,_) = if b1 then (6*4) else (3*4)
-                        
-colorArrayDescriptor  _ = Nothing
+colorArrayDescriptor (CompiledBuild stride tup@(_, True, _) _ _) =
+  Just $
+    VertexArrayDescriptor
+      4
+      Float
+      (fromIntegral stride)
+      (wordPtrToPtr (offset tup))
+  where
+    offset (b1, _, _) = if b1 then (6 * 4) else (3 * 4)
+colorArrayDescriptor _ = Nothing
 
 textureArrayDescriptor :: CompiledBuild GLfloat -> Maybe (VertexArrayDescriptor GLfloat)
-textureArrayDescriptor (CompiledBuild stride tup@(_,_,True) _ _) =
-                Just $ VertexArrayDescriptor 2 Float
-                        (fromIntegral stride) (wordPtrToPtr (offset tup))
-                where offset (b1,b2,_) = (3 + (ifp b1 3) + (ifp b2 4)) * 4
-                      ifp b x = if b then x else 0  
-textureArrayDescriptor  _ = Nothing
+textureArrayDescriptor (CompiledBuild stride tup@(_, _, True) _ _) =
+  Just $
+    VertexArrayDescriptor
+      2
+      Float
+      (fromIntegral stride)
+      (wordPtrToPtr (offset tup))
+  where
+    offset (b1, b2, _) = (3 + (ifp b1 3) + (ifp b2 4)) * 4
+    ifp b x = if b then x else 0
+textureArrayDescriptor _ = Nothing
+
 createBufferObject :: BufferTarget -> CompiledBuild GLfloat -> IO BufferObject
 createBufferObject target (CompiledBuild _ _ _ arr) = storableArrayToBuffer target arr
diff --git a/Graphics/Glyph/GLMath.hs b/Graphics/Glyph/GLMath.hs
index bec796c..7cd4471 100644
--- a/Graphics/Glyph/GLMath.hs
+++ b/Graphics/Glyph/GLMath.hs
@@ -1,145 +1,259 @@
 {-# LANGUAGE MultiParamTypeClasses #-}
+
 module Graphics.Glyph.GLMath where
-    import Graphics.Glyph.Mat4
-    import qualified Graphics.Rendering.OpenGL as GL
-    import Graphics.Rendering.OpenGL (GLfloat,Uniform,Vertex3(..),uniform,UniformComponent)
-    import Data.Angle
-    import Debug.Trace
-
-    data Vec2 a = Vec2 (a,a) deriving Show
-    data Vec3 a = Vec3 (a,a,a) deriving Show
-    data Vec4 a = Vec4 (a,a,a,a) deriving Show
-
-    instance UniformComponent a => Uniform (Vec3 a) where
-        uniform loc = GL.makeStateVar
-                        (do
-                            (Vertex3 x y z) <-
-                                GL.get (uniform loc)
-                            return (Vec3 (x,y,z)) )
-                        (\(Vec3 (x,y,z)) -> uniform loc GL.$= Vertex3 x y z)
-
-    class (Floating flT) => Vector flT b where
-        (<+>) :: b flT -> b flT -> b flT
-        (<->) :: b flT -> b flT -> b flT
-        norm :: b flT -> flT
-        normalize :: b flT -> b flT
-        vDot :: b flT -> b flT -> flT
-        vScale :: flT -> b flT -> b flT
-
-
-    (<.>) :: (Vector a b) => b a -> b a -> a
-    (<.>) = vDot
-
-    (|||) :: (Vector a b) => b a -> a
-    (|||) = norm
-
-    instance (Floating flT) => Vector flT Vec2 where
-        (<+>) (Vec2 (a,b)) (Vec2 (c,d)) = Vec2 (a+c,b+d)
-        (<->) (Vec2 (a,b)) (Vec2 (c,d)) = Vec2 (a-c,b-d)
-        vDot (Vec2 (a,b)) (Vec2 (c,d)) = a * c + b * d
-        vScale c (Vec2 (a,b)) = Vec2 (a*c,b*c)
-        norm (Vec2 (a,b)) = sqrt (a*a + b*b)
-        normalize vec@(Vec2 (a,b)) = 
-            let n = norm vec in Vec2 (a/n,b/n)
-
-    instance (Floating flT) => Vector flT Vec3 where
-        (<+>) (Vec3 (a,b,c)) (Vec3 (d,e,f)) = Vec3 (a+d,b+e,c+f)
-        (<->) (Vec3 (a,b,c)) (Vec3 (d,e,f)) = Vec3 (a-d,b-e,c-f)
-        vDot (Vec3 (a,b,c)) (Vec3 (d,e,f)) = a * d + b * e + c * f
-        vScale x (Vec3 (a,b,c)) = Vec3 (a*x,b*x,c*x)
-        norm (Vec3 (a,b,c)) = sqrt (a*a + b*b + c*c)
-        normalize vec@(Vec3 (a,b,c)) = 
-            let n = norm vec in Vec3 (a/n,b/n,c/n)
-
-    instance (Floating flT) => Vector flT Vec4 where
-        (<+>) (Vec4 (a,b,c,g)) (Vec4 (d,e,f,h)) = Vec4 (a+d,b+e,c+f,g+h)
-        (<->) (Vec4 (a,b,c,g)) (Vec4 (d,e,f,h)) = Vec4 (a-d,b-e,c-f,g-h)
-        vDot  (Vec4 (a,b,c,g)) (Vec4 (d,e,f,h)) = a * d + b * e + c * f + g * h
-        vScale x (Vec4 (a,b,c,d)) = Vec4 (a*x,b*x,c*x,d*x)
-        norm (Vec4 (a,b,c,d)) = sqrt (a*a + b*b + c*c + d*d)
-        normalize vec@(Vec4 (a,b,c,d)) = 
-            let n = norm vec in Vec4 (a/n,b/n,c/n,d/n)
-
-    cross :: (Num a) => Vec3 a -> Vec3 a -> Vec3 a
-    cross (Vec3 (u1,u2,u3)) (Vec3 (v1,v2,v3)) =
-            Vec3 ( u2*v3 - u3*v2,
-                      u3*v1 - u1*v3,
-                      u1*v2 - u2*v1 )
-    (×) :: (Num a) => Vec3 a -> Vec3 a -> Vec3 a
-    (×) = cross
-
-    lookAtMatrix :: Vec3 GLfloat -> Vec3 GLfloat -> Vec3 GLfloat -> Mat4 GLfloat
-    lookAtMatrix e@(Vec3 (ex,ey,ez)) c u =
-        let f@(Vec3 (fx,fy,fz)) = normalize (c <-> e)
-            s@(Vec3 (sx,sy,sz)) = normalize (f × u)
-            u'@(Vec3 (ux,uy,uz))   = s × f in 
-               Matrix (sx, ux, -fx, 0,
-                       sy, uy, -fy, 0,
-                       sz, uz, -fz, 0,
-                       -(s<.>e) , -(u'<.>e),  (f<.>e),  1 )
-
-    perspectiveMatrix :: GLfloat -> GLfloat -> GLfloat -> GLfloat -> Mat4 GLfloat
-    {- as close to copied from glm as possible -}
-    perspectiveMatrix fov asp zn zf =
-        let tanHalfFovy = tangent (Degrees fov/2)
-            res00 = 1 / (asp * tanHalfFovy)
-            res11 = 1 / tanHalfFovy
-            res22 = - (zf + zn) / (zf - zn)
-            res23 = - 1
-            res32 = - (2 * zf * zn) / (zf - zn) in
-        trace ("res22=" ++ (show res22)) $
-        Matrix (res00, 0, 0, 0,
-                0, res11, 0, 0,
-                0, 0, res22, res23,
-                0, 0, res32, 0)
-
-    class VectorMatrix vecT matT where
-        vTranslate :: matT -> vecT -> matT
-        (-*|)  :: matT -> vecT -> vecT
-
-    instance (Num a) => VectorMatrix (Vec3 a) (Mat3 a) where
-        vTranslate (Matrix3 (a00,a01,a02,
-                             a10,a11,a12,
-                             a20,a21,a22)) (Vec3 (a,b,c)) =
-                        Matrix3 (a00,a01,a02+a,
-                                 a10,a11,a12+b,
-                                 a20,a21,a22+c)
-
-        (Matrix3 (a00,a01,a02,
-                 a10,a11,a12,
-                 a20,a21,a22)) -*| (Vec3 (a,b,c)) = 
-                                    Vec3 (a00 * a + a01 * b + a02 * c,
-                                          a10 * a + a11 * b + a12 * c,
-                                          a20 * a + a21 * b + a22 * c )
-
-
-
-
-    instance (Num a) => VectorMatrix (Vec4 a) (Mat4 a) where
-        vTranslate mat (Vec4 tmp) = translateMat4 mat tmp
-        mat -*| tmp = glslMatMul mat tmp
-
-    glslMatMul :: (Num a) => Mat4 a -> Vec4 a -> Vec4 a
-    glslMatMul (Matrix (m00,m01,m02,m03,
-                m10,m11,m12,m13,
-                m20,m21,m22,m23,
-                m30,m31,m32,m33)) (Vec4 (v0,v1,v2,v3)) =
-                    Vec4 ( v0 * m00 + v1 * m10 + v2 * m20 + v3 * m30,
-                           v0 * m01 + v1 * m11 + v2 * m21 + v3 * m31,
-                           v0 * m02 + v1 * m12 + v2 * m22 + v3 * m32,
-                           v0 * m03 + v1 * m13 + v2 * m23 + v3 * m33 )
-
-    (==>) :: (Num a) => Mat4 a -> Vec4 a -> Mat4 a
-    (==>) = glslMatTranslate
-    glslMatTranslate :: (Num a) => Mat4 a -> Vec4 a -> Mat4 a
-    glslMatTranslate
-        mat@(Matrix (m00,m01,m02,m03,
-                m10,m11,m12,m13,
-                m20,m21,m22,m23,
-                m30,m31,m32,m33)) vec =
-                    let (Vec4 (v0,v1,v2,v3)) = mat -*| vec in
-                    (Matrix (m00,m01,m02,m03,
-                             m10,m11,m12,m13,
-                             m20,m21,m22,m23,
-                             m30+v0,m31+v1,m32+v2,m33+v3))
-                    
+
+import Data.Angle
+import Debug.Trace
+import Graphics.Glyph.Mat4
+import Graphics.Rendering.OpenGL (GLfloat, Uniform, UniformComponent, Vertex3 (..), uniform)
+import qualified Graphics.Rendering.OpenGL as GL
+
+data Vec2 a = Vec2 (a, a) deriving (Show)
+
+data Vec3 a = Vec3 (a, a, a) deriving (Show)
+
+data Vec4 a = Vec4 (a, a, a, a) deriving (Show)
+
+instance UniformComponent a => Uniform (Vec3 a) where
+  uniform loc =
+    GL.makeStateVar
+      ( do
+          (Vertex3 x y z) <-
+            GL.get (uniform loc)
+          return (Vec3 (x, y, z))
+      )
+      (\(Vec3 (x, y, z)) -> uniform loc GL.$= Vertex3 x y z)
+
+class (Floating flT) => Vector flT b where
+  (<+>) :: b flT -> b flT -> b flT
+  (<->) :: b flT -> b flT -> b flT
+  norm :: b flT -> flT
+  normalize :: b flT -> b flT
+  vDot :: b flT -> b flT -> flT
+  vScale :: flT -> b flT -> b flT
+
+(<.>) :: (Vector a b) => b a -> b a -> a
+(<.>) = vDot
+
+(|||) :: (Vector a b) => b a -> a
+(|||) = norm
+
+instance (Floating flT) => Vector flT Vec2 where
+  (<+>) (Vec2 (a, b)) (Vec2 (c, d)) = Vec2 (a + c, b + d)
+  (<->) (Vec2 (a, b)) (Vec2 (c, d)) = Vec2 (a - c, b - d)
+  vDot (Vec2 (a, b)) (Vec2 (c, d)) = a * c + b * d
+  vScale c (Vec2 (a, b)) = Vec2 (a * c, b * c)
+  norm (Vec2 (a, b)) = sqrt (a * a + b * b)
+  normalize vec@(Vec2 (a, b)) =
+    let n = norm vec in Vec2 (a / n, b / n)
+
+instance (Floating flT) => Vector flT Vec3 where
+  (<+>) (Vec3 (a, b, c)) (Vec3 (d, e, f)) = Vec3 (a + d, b + e, c + f)
+  (<->) (Vec3 (a, b, c)) (Vec3 (d, e, f)) = Vec3 (a - d, b - e, c - f)
+  vDot (Vec3 (a, b, c)) (Vec3 (d, e, f)) = a * d + b * e + c * f
+  vScale x (Vec3 (a, b, c)) = Vec3 (a * x, b * x, c * x)
+  norm (Vec3 (a, b, c)) = sqrt (a * a + b * b + c * c)
+  normalize vec@(Vec3 (a, b, c)) =
+    let n = norm vec in Vec3 (a / n, b / n, c / n)
+
+instance (Floating flT) => Vector flT Vec4 where
+  (<+>) (Vec4 (a, b, c, g)) (Vec4 (d, e, f, h)) = Vec4 (a + d, b + e, c + f, g + h)
+  (<->) (Vec4 (a, b, c, g)) (Vec4 (d, e, f, h)) = Vec4 (a - d, b - e, c - f, g - h)
+  vDot (Vec4 (a, b, c, g)) (Vec4 (d, e, f, h)) = a * d + b * e + c * f + g * h
+  vScale x (Vec4 (a, b, c, d)) = Vec4 (a * x, b * x, c * x, d * x)
+  norm (Vec4 (a, b, c, d)) = sqrt (a * a + b * b + c * c + d * d)
+  normalize vec@(Vec4 (a, b, c, d)) =
+    let n = norm vec in Vec4 (a / n, b / n, c / n, d / n)
+
+cross :: (Num a) => Vec3 a -> Vec3 a -> Vec3 a
+cross (Vec3 (u1, u2, u3)) (Vec3 (v1, v2, v3)) =
+  Vec3
+    ( u2 * v3 - u3 * v2,
+      u3 * v1 - u1 * v3,
+      u1 * v2 - u2 * v1
+    )
+
+(×) :: (Num a) => Vec3 a -> Vec3 a -> Vec3 a
+(×) = cross
+
+lookAtMatrix :: Vec3 GLfloat -> Vec3 GLfloat -> Vec3 GLfloat -> Mat4 GLfloat
+lookAtMatrix e@(Vec3 (ex, ey, ez)) c u =
+  let f@(Vec3 (fx, fy, fz)) = normalize (c <-> e)
+      s@(Vec3 (sx, sy, sz)) = normalize (f × u)
+      u'@(Vec3 (ux, uy, uz)) = s × f
+   in Matrix
+        ( sx,
+          ux,
+          - fx,
+          0,
+          sy,
+          uy,
+          - fy,
+          0,
+          sz,
+          uz,
+          - fz,
+          0,
+          - (s <.> e),
+          - (u' <.> e),
+          (f <.> e),
+          1
+        )
+
+perspectiveMatrix :: GLfloat -> GLfloat -> GLfloat -> GLfloat -> Mat4 GLfloat
+{- as close to copied from glm as possible -}
+perspectiveMatrix fov asp zn zf =
+  let tanHalfFovy = tangent (Degrees fov / 2)
+      res00 = 1 / (asp * tanHalfFovy)
+      res11 = 1 / tanHalfFovy
+      res22 = - (zf + zn) / (zf - zn)
+      res23 = - 1
+      res32 = - (2 * zf * zn) / (zf - zn)
+   in trace ("res22=" ++ (show res22)) $
+        Matrix
+          ( res00,
+            0,
+            0,
+            0,
+            0,
+            res11,
+            0,
+            0,
+            0,
+            0,
+            res22,
+            res23,
+            0,
+            0,
+            res32,
+            0
+          )
+
+class VectorMatrix vecT matT where
+  vTranslate :: matT -> vecT -> matT
+  (-*|) :: matT -> vecT -> vecT
+
+instance (Num a) => VectorMatrix (Vec3 a) (Mat3 a) where
+  vTranslate
+    ( Matrix3
+        ( a00,
+          a01,
+          a02,
+          a10,
+          a11,
+          a12,
+          a20,
+          a21,
+          a22
+          )
+      )
+    (Vec3 (a, b, c)) =
+      Matrix3
+        ( a00,
+          a01,
+          a02 + a,
+          a10,
+          a11,
+          a12 + b,
+          a20,
+          a21,
+          a22 + c
+        )
+
+  ( Matrix3
+      ( a00,
+        a01,
+        a02,
+        a10,
+        a11,
+        a12,
+        a20,
+        a21,
+        a22
+        )
+    )
+    -*| (Vec3 (a, b, c)) =
+      Vec3
+        ( a00 * a + a01 * b + a02 * c,
+          a10 * a + a11 * b + a12 * c,
+          a20 * a + a21 * b + a22 * c
+        )
+
+instance (Num a) => VectorMatrix (Vec4 a) (Mat4 a) where
+  vTranslate mat (Vec4 tmp) = translateMat4 mat tmp
+  mat -*| tmp = glslMatMul mat tmp
+
+glslMatMul :: (Num a) => Mat4 a -> Vec4 a -> Vec4 a
+glslMatMul
+  ( Matrix
+      ( m00,
+        m01,
+        m02,
+        m03,
+        m10,
+        m11,
+        m12,
+        m13,
+        m20,
+        m21,
+        m22,
+        m23,
+        m30,
+        m31,
+        m32,
+        m33
+        )
+    )
+  (Vec4 (v0, v1, v2, v3)) =
+    Vec4
+      ( v0 * m00 + v1 * m10 + v2 * m20 + v3 * m30,
+        v0 * m01 + v1 * m11 + v2 * m21 + v3 * m31,
+        v0 * m02 + v1 * m12 + v2 * m22 + v3 * m32,
+        v0 * m03 + v1 * m13 + v2 * m23 + v3 * m33
+      )
+
+(==>) :: (Num a) => Mat4 a -> Vec4 a -> Mat4 a
+(==>) = glslMatTranslate
+
+glslMatTranslate :: (Num a) => Mat4 a -> Vec4 a -> Mat4 a
+glslMatTranslate
+  mat@( Matrix
+          ( m00,
+            m01,
+            m02,
+            m03,
+            m10,
+            m11,
+            m12,
+            m13,
+            m20,
+            m21,
+            m22,
+            m23,
+            m30,
+            m31,
+            m32,
+            m33
+            )
+        )
+  vec =
+    let (Vec4 (v0, v1, v2, v3)) = mat -*| vec
+     in ( Matrix
+            ( m00,
+              m01,
+              m02,
+              m03,
+              m10,
+              m11,
+              m12,
+              m13,
+              m20,
+              m21,
+              m22,
+              m23,
+              m30 + v0,
+              m31 + v1,
+              m32 + v2,
+              m33 + v3
+            )
+        )
diff --git a/Graphics/Glyph/GlyphObject.hs b/Graphics/Glyph/GlyphObject.hs
index 239007d..ef83cd8 100644
--- a/Graphics/Glyph/GlyphObject.hs
+++ b/Graphics/Glyph/GlyphObject.hs
@@ -1,12 +1,12 @@
 {-# LANGUAGE TemplateHaskell #-}
 
-module Graphics.Glyph.GlyphObject (
-    GlyphObject(..),
+module Graphics.Glyph.GlyphObject
+  ( GlyphObject (..),
     getBufferObject,
     getCompiledData,
     getVertexAttribute,
     getNormalAttribute,
-    getColorAttribute ,
+    getColorAttribute,
     getTextureAttribute,
     getResources,
     getSetupRoutine,
@@ -16,41 +16,44 @@ module Graphics.Glyph.GlyphObject (
     setCompiledData,
     setVertexAttribute,
     setNormalAttribute,
-    setColorAttribute ,
+    setColorAttribute,
     setTextureAttribute,
     setResources,
     setSetupRoutine,
     setTeardownRoutine,
     setPrimitiveMode,
-    prepare, teardown,
-    Drawable, draw, newGlyphObject,
-    newDefaultGlyphObject
-) where
+    prepare,
+    teardown,
+    Drawable,
+    draw,
+    newGlyphObject,
+    newDefaultGlyphObject,
+  )
+where
 
+import Control.Applicative
+import Control.Monad
+import Data.Maybe
 import Graphics.Glyph.BufferBuilder
 import Graphics.Glyph.Util
 import Graphics.Rendering.OpenGL
 
-import Control.Monad
-import Control.Applicative
-import Data.Maybe
-
 class Drawable a where
-    -- mvMat -> pMat -> obj -> IO ()
-    draw :: a -> IO ()
+  -- mvMat -> pMat -> obj -> IO ()
+  draw :: a -> IO ()
 
-data GlyphObject a = GlyphObject {
-    bufferObject :: BufferObject, -- buffer
+data GlyphObject a = GlyphObject
+  { bufferObject :: BufferObject, -- buffer
     compiledData :: (CompiledBuild GLfloat), -- compiled data
     vertexAttribute :: AttribLocation, -- vertex attribute
     normalAttribute :: (Maybe AttribLocation), -- normal attrib
-    colorAttribute  :: (Maybe AttribLocation), -- color attrib
+    colorAttribute :: (Maybe AttribLocation), -- color attrib
     textureAttribute :: (Maybe AttribLocation), -- texture attrib
     resources :: a, -- Resources
     setupRoutine :: (Maybe (GlyphObject a -> IO ())), -- Setup
     teardownRoutine :: (Maybe (GlyphObject a -> IO ())), -- Tear down
     primitiveMode :: PrimitiveMode
-}
+  }
 
 getBufferObject :: GlyphObject a -> BufferObject
 getBufferObject = bufferObject
@@ -64,8 +67,8 @@ getVertexAttribute = vertexAttribute
 getNormalAttribute :: GlyphObject a -> (Maybe AttribLocation)
 getNormalAttribute = normalAttribute
 
-getColorAttribute  :: GlyphObject a -> (Maybe AttribLocation)
-getColorAttribute  = colorAttribute
+getColorAttribute :: GlyphObject a -> (Maybe AttribLocation)
+getColorAttribute = colorAttribute
 
 getTextureAttribute :: GlyphObject a -> (Maybe AttribLocation)
 getTextureAttribute = textureAttribute
@@ -83,104 +86,109 @@ getPrimitiveMode :: GlyphObject a -> PrimitiveMode
 getPrimitiveMode = primitiveMode
 
 setBufferObject :: GlyphObject a -> BufferObject -> GlyphObject a
-setBufferObject o a = o { bufferObject = a }
+setBufferObject o a = o {bufferObject = a}
 
 setCompiledData :: GlyphObject a -> (CompiledBuild GLfloat) -> GlyphObject a
-setCompiledData o a = o { compiledData = a }
+setCompiledData o a = o {compiledData = a}
 
 setVertexAttribute :: GlyphObject a -> AttribLocation -> GlyphObject a
-setVertexAttribute o a = o { vertexAttribute = a }
+setVertexAttribute o a = o {vertexAttribute = a}
 
 setNormalAttribute :: GlyphObject a -> (Maybe AttribLocation) -> GlyphObject a
-setNormalAttribute o a = o { normalAttribute = a }
+setNormalAttribute o a = o {normalAttribute = a}
 
-setColorAttribute  :: GlyphObject a -> (Maybe AttribLocation) -> GlyphObject a
-setColorAttribute  o a = o { colorAttribute = a }
+setColorAttribute :: GlyphObject a -> (Maybe AttribLocation) -> GlyphObject a
+setColorAttribute o a = o {colorAttribute = a}
 
 setTextureAttribute :: GlyphObject a -> (Maybe AttribLocation) -> GlyphObject a
-setTextureAttribute o a = o { textureAttribute = a }
+setTextureAttribute o a = o {textureAttribute = a}
 
 setResources :: GlyphObject a -> a -> GlyphObject a
-setResources o a = o { resources = a }
+setResources o a = o {resources = a}
 
 setSetupRoutine :: GlyphObject a -> (Maybe (GlyphObject a -> IO ())) -> GlyphObject a
-setSetupRoutine o a = o { setupRoutine = a }
+setSetupRoutine o a = o {setupRoutine = a}
 
 setTeardownRoutine :: GlyphObject a -> (Maybe (GlyphObject a -> IO ())) -> GlyphObject a
-setTeardownRoutine o a = o { teardownRoutine = a }
+setTeardownRoutine o a = o {teardownRoutine = a}
 
 setPrimitiveMode :: GlyphObject a -> PrimitiveMode -> GlyphObject a
-setPrimitiveMode o a = o { primitiveMode = a }
-
-newGlyphObject :: Builder GLfloat x ->
-    AttribLocation ->
-    Maybe AttribLocation ->
-    Maybe AttribLocation ->
-    Maybe AttribLocation ->
-    a ->
-    Maybe (GlyphObject a -> IO ()) ->
-    Maybe (GlyphObject a -> IO ()) ->
-    PrimitiveMode ->
-    IO (GlyphObject a)
-
+setPrimitiveMode o a = o {primitiveMode = a}
+
+newGlyphObject ::
+  Builder GLfloat x ->
+  AttribLocation ->
+  Maybe AttribLocation ->
+  Maybe AttribLocation ->
+  Maybe AttribLocation ->
+  a ->
+  Maybe (GlyphObject a -> IO ()) ->
+  Maybe (GlyphObject a -> IO ()) ->
+  PrimitiveMode ->
+  IO (GlyphObject a)
 newGlyphObject builder vertAttr normAttr colorAttr textureAttr res setup tear mode = do
-    compiled <- compilingBuilder builder
-    buffer <- createBufferObject ArrayBuffer compiled
-    return $ GlyphObject buffer compiled vertAttr normAttr colorAttr textureAttr res setup tear mode
+  compiled <- compilingBuilder builder
+  buffer <- createBufferObject ArrayBuffer compiled
+  return $ GlyphObject buffer compiled vertAttr normAttr colorAttr textureAttr res setup tear mode
 
-prepare :: GlyphObject a -> (GlyphObject a -> IO()) -> GlyphObject a
-prepare a b = a { setupRoutine = (Just b) }
+prepare :: GlyphObject a -> (GlyphObject a -> IO ()) -> GlyphObject a
+prepare a b = a {setupRoutine = (Just b)}
 
-teardown :: GlyphObject a -> (GlyphObject a -> IO()) -> GlyphObject a
-teardown a b = a { teardownRoutine = Just b }
+teardown :: GlyphObject a -> (GlyphObject a -> IO ()) -> GlyphObject a
+teardown a b = a {teardownRoutine = Just b}
 
 instance Drawable (GlyphObject a) where
-    draw obj@(GlyphObject bo co vAttr nAttr cAttr tAttr _ setup tearDown p) = do
-        {- Setup whatever we need for the object to draw itself -}
-        maybe (return ()) (apply obj) setup
-
-        {- Get the array descriptors for the possible
-         - parts -}
-        let vad = vertexArrayDescriptor co
-        let nad = normalArrayDescriptor co
-        let cad = colorArrayDescriptor co
-        let tad = textureArrayDescriptor co
-
-        bindBuffer ArrayBuffer $= Just bo
-        let enabled = catMaybes $
-             map liftMaybe [(Just vAttr,Just vad), (nAttr, nad), (cAttr,cad), (tAttr,tad)]
-
-        forM_ enabled $ \(attr, ad) -> do
-            vertexAttribPointer attr $= (ToFloat, ad)
-            vertexAttribArray attr $= Enabled
-
-        drawArrays p 0 (bufferLength co)
-            
-        forM_ enabled $ \(attr, _) -> do
-            vertexAttribArray attr $= Disabled
-            
-        {- Tear down whatever the object needs -}
-        maybe (return ()) (apply obj) tearDown
-        where liftMaybe (Just a, Just b) = Just (a,b)
-              liftMaybe _ = Nothing
-              apply obj' f = f obj'
+  draw obj@(GlyphObject bo co vAttr nAttr cAttr tAttr _ setup tearDown p) = do
+    {- Setup whatever we need for the object to draw itself -}
+    maybe (return ()) (apply obj) setup
+
+    {- Get the array descriptors for the possible
+     - parts -}
+    let vad = vertexArrayDescriptor co
+    let nad = normalArrayDescriptor co
+    let cad = colorArrayDescriptor co
+    let tad = textureArrayDescriptor co
+
+    bindBuffer ArrayBuffer $= Just bo
+    let enabled =
+          catMaybes $
+            map liftMaybe [(Just vAttr, Just vad), (nAttr, nad), (cAttr, cad), (tAttr, tad)]
+
+    forM_ enabled $ \(attr, ad) -> do
+      vertexAttribPointer attr $= (ToFloat, ad)
+      vertexAttribArray attr $= Enabled
+
+    drawArrays p 0 (bufferLength co)
+
+    forM_ enabled $ \(attr, _) -> do
+      vertexAttribArray attr $= Disabled
+
+    {- Tear down whatever the object needs -}
+    maybe (return ()) (apply obj) tearDown
+    where
+      liftMaybe (Just a, Just b) = Just (a, b)
+      liftMaybe _ = Nothing
+      apply obj' f = f obj'
 
 instance (Show a) => Show (GlyphObject a) where
-    show (GlyphObject _ co vAttr nAttr cAttr tAttr res _ _ p) =
-        "[GlyphObject compiled=" ++! co ++ " vertAttr=" ++! vAttr ++
-            " normalAttr="++!nAttr++" colorAttr="++!cAttr++" textureAttr="++!tAttr++" res="++!res++" PrimitiveMode="++!p++"]"
-
+  show (GlyphObject _ co vAttr nAttr cAttr tAttr res _ _ p) =
+    "[GlyphObject compiled=" ++! co ++ " vertAttr=" ++! vAttr
+      ++ " normalAttr=" ++! nAttr
+      ++ " colorAttr=" ++! cAttr
+      ++ " textureAttr=" ++! tAttr
+      ++ " res=" ++! res
+      ++ " PrimitiveMode=" ++! p
+      ++ "]"
 
 newDefaultGlyphObject :: Builder GLfloat x -> a -> IO (GlyphObject a)
 newDefaultGlyphObject builder resources =
-                        newGlyphObject builder
-                                       (AttribLocation 0) -- vertex
-                                       (Just $ AttribLocation 1) -- normal
-                                       (Just $ AttribLocation 2) -- color
-                                       (Just $ AttribLocation 3) -- texture
-