1 files changed, 129 insertions, 120 deletions

diff --git a/Graphics/Glyph/GeometryBuilder.hs b/Graphics/Glyph/GeometryBuilder.hs
index 53c6681..0b87490 100644
--- a/Graphics/Glyph/GeometryBuilder.hs
+++ b/Graphics/Glyph/GeometryBuilder.hs
@@ -1,148 +1,156 @@
-{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
-module Graphics.Glyph.GeometryBuilder where
-
-import Data.Sequence as Seq
-import Data.Maybe
+{-# LANGUAGE TemplateHaskell #-}
 
-import Graphics.Glyph.Util
-import Graphics.Glyph.BufferBuilder
+module Graphics.Glyph.GeometryBuilder where
 
-import Data.ByteStringBuilder
 import Data.ByteString.Lazy
 import Data.ByteString.Lazy.Char8 as BSLC
+import Data.ByteStringBuilder
 import Data.Foldable as Fold
-
+import Data.Maybe
+import Data.Sequence as Seq
+import Graphics.Glyph.BufferBuilder
+import Graphics.Glyph.Util
 import Text.Printf
 
 data OutType = TriangleStrip | Triangles
+
 instance Show OutType where
-    show TriangleStrip = "triangle_strip"
-    show Triangles = "triangle_strip"
+  show TriangleStrip = "triangle_strip"
+  show Triangles = "triangle_strip"
 
 buildSourceAsString :: GeometryBuilder a -> String
 buildSourceAsString = BSLC.unpack . buildSource
 
 buildSource :: GeometryBuilder a -> ByteString
 buildSource builder =
-    runBuilder $ do
-        putSLn "#version 150"
-        putSLn "#extension GL_ARB_explicit_attrib_location : enable"
-        putSLn "#extension GL_ARB_explicit_uniform_location : enable"
-        putSLn "layout(points) in ;"
-    
-        let isVertex (Vertex _ _ _ _) = True
-            isVertex _ = False
-        putSLn $ printf "layout(%s,max_vertices=%d) out ;"
-                    (show $ maybeDefault TriangleStrip $ gOutType builder)
-                    (Seq.length $ Seq.filter isVertex $ gList builder)
-
-        forM_ (textureOut builder) $ putSLn.("out vec2 "++) . (++";")
-        forM_ (normalOut builder) $ putSLn.("out vec3 "++) . (++";")
-        forM_ (positionOut builder) $ putSLn.("out vec4 "++) . (++";")
-        
-        let pjMatStr = fromJust (pjMatrixUniform builder >||> Just "pjMatrix")
-        let mvMatStr = fromJust (mvMatrixUniform builder >||> Just "mvMatrix")
-
-        Fold.mapM_ (putSLn.("uniform mat4 "++).(++";")) [pjMatStr, mvMatStr]
-
-        putSLn "void main() {"
-
-        let vertexOutF =
-             case positionOut builder of
-                Nothing ->
-                    printf "\tgl_Position = %s * (gl_in[0].gl_Position + %s * vec4(%f,%f,%f,%f));"
-                        pjMatStr mvMatStr
-                Just str -> 
-                    printf "\tgl_Position = %s * (%s = gl_in[0].gl_Position + %s * vec4(%f,%f,%f,%f));"
-                        pjMatStr str mvMatStr
-        let normalOutF = case normalOut builder of
-             Nothing -> const3 ""
-             Just str -> printf "\t%s = -inverse(transpose(mat3(%s))) * vec3(%f,%f,%f);" str mvMatStr
-
-        let textureOutF = case textureOut builder of
-             Nothing -> const2 ""
-             Just str -> printf "\t%s = vec2(%f,%f);" str
-
-        forM_ (gList builder) $ \datum ->
-            case datum of
-                Vertex x y z w -> putSLn $ vertexOutF x y z w
-                Normal x y z -> putSLn $ normalOutF x y z
-                Texture x y -> putSLn $ textureOutF x y
-                EmitVertex -> putSLn "\tEmitVertex();"
-                EndPrimitive -> putSLn "\tEndPrimitive();"
-        putSLn "}"
-
-data GeometryDatum =
-    Vertex  Float Float Float Float |
-    Texture Float Float |
-    Normal  Float Float Float |
-    EmitVertex |
-    EndPrimitive
-
-data GeometryBuilder a = GeometryBuilder {
-    gList :: (Seq GeometryDatum),
-
+  runBuilder $ do
+    putSLn "#version 150"
+    putSLn "#extension GL_ARB_explicit_attrib_location : enable"
+    putSLn "#extension GL_ARB_explicit_uniform_location : enable"
+    putSLn "layout(points) in ;"
+
+    let isVertex (Vertex _ _ _ _) = True
+        isVertex _ = False
+    putSLn $
+      printf
+        "layout(%s,max_vertices=%d) out ;"
+        (show $ maybeDefault TriangleStrip $ gOutType builder)
+        (Seq.length $ Seq.filter isVertex $ gList builder)
+
+    forM_ (textureOut builder) $ putSLn . ("out vec2 " ++) . (++ ";")
+    forM_ (normalOut builder) $ putSLn . ("out vec3 " ++) . (++ ";")
+    forM_ (positionOut builder) $ putSLn . ("out vec4 " ++) . (++ ";")
+
+    let pjMatStr = fromJust (pjMatrixUniform builder >||> Just "pjMatrix")
+    let mvMatStr = fromJust (mvMatrixUniform builder >||> Just "mvMatrix")
+
+    Fold.mapM_ (putSLn . ("uniform mat4 " ++) . (++ ";")) [pjMatStr, mvMatStr]
+
+    putSLn "void main() {"
+
+    let vertexOutF =
+          case positionOut builder of
+            Nothing ->
+              printf
+                "\tgl_Position = %s * (gl_in[0].gl_Position + %s * vec4(%f,%f,%f,%f));"
+                pjMatStr
+                mvMatStr
+            Just str ->
+              printf
+                "\tgl_Position = %s * (%s = gl_in[0].gl_Position + %s * vec4(%f,%f,%f,%f));"
+                pjMatStr
+                str
+                mvMatStr
+    let normalOutF = case normalOut builder of
+          Nothing -> const3 ""
+          Just str -> printf "\t%s = -inverse(transpose(mat3(%s))) * vec3(%f,%f,%f);" str mvMatStr
+
+    let textureOutF = case textureOut builder of
+          Nothing -> const2 ""
+          Just str -> printf "\t%s = vec2(%f,%f);" str
+
+    forM_ (gList builder) $ \datum ->
+      case datum of
+        Vertex x y z w -> putSLn $ vertexOutF x y z w
+        Normal x y z -> putSLn $ normalOutF x y z
+        Texture x y -> putSLn $ textureOutF x y
+        EmitVertex -> putSLn "\tEmitVertex();"
+        EndPrimitive -> putSLn "\tEndPrimitive();"
+    putSLn "}"
+
+data GeometryDatum
+  = Vertex Float Float Float Float
+  | Texture Float Float
+  | Normal Float Float Float
+  | EmitVertex
+  | EndPrimitive
+
+data GeometryBuilder a = GeometryBuilder
+  { gList :: (Seq GeometryDatum),
     gOutType :: Maybe OutType,
     pjMatrixUniform :: Maybe String,
     mvMatrixUniform :: Maybe String,
     maxVerts :: Maybe Int,
-
     textureOut :: Maybe String,
     normalOut :: Maybe String,
     positionOut :: Maybe String,
     gRet :: a
-}
+  }
 
 generating :: OutType -> GeometryBuilder () -> GeometryBuilder ()
-generating TriangleStrip builder = builder { gOutType = Just TriangleStrip }
+generating TriangleStrip builder = builder {gOutType = Just TriangleStrip}
 generating Triangles builder = do
-    let (nSeq,_) =
-         Fold.foldl' (\(tSeq,cnt) datum ->
-            case datum of
+  let (nSeq, _) =
+        Fold.foldl'
+          ( \(tSeq, cnt) datum ->
+              case datum of
                 EmitVertex ->
-                    if cnt == (2::Int) then (tSeq |> datum |> EndPrimitive, 0)
+                  if cnt == (2 :: Int)
+                    then (tSeq |> datum |> EndPrimitive, 0)
                     else (tSeq |> datum, cnt + 1)
-                _ -> (tSeq |> datum,cnt)
-            ) (Seq.empty, 0) (gList builder)
+                _ -> (tSeq |> datum, cnt)
+          )
+          (Seq.empty, 0)
+          (gList builder)
 
-    builder {
-      gOutType = Just Triangles,
+  builder
+    { gOutType = Just Triangles,
       gList = nSeq
     }
 
 projectionMatrixUniform :: String -> GeometryBuilder ()
-projectionMatrixUniform str = (return ()) { pjMatrixUniform = (Just str) }
+projectionMatrixUniform str = (return ()) {pjMatrixUniform = (Just str)}
 
 modelViewMatrixUniform :: String -> GeometryBuilder ()
-modelViewMatrixUniform str = (return ()) { mvMatrixUniform = (Just str) }
+modelViewMatrixUniform str = (return ()) {mvMatrixUniform = (Just str)}
 
 maxVerticies :: Int -> GeometryBuilder ()
-maxVerticies i = (return ()) { maxVerts = (Just i) }
+maxVerticies i = (return ()) {maxVerts = (Just i)}
 
 textureOutput :: String -> GeometryBuilder ()
-textureOutput str = (return ()) { textureOut = (Just str) }
+textureOutput str = (return ()) {textureOut = (Just str)}
 
 normalOutput :: String -> GeometryBuilder ()
-normalOutput str = (return ()) { normalOut = (Just str) }
+normalOutput str = (return ()) {normalOut = (Just str)}
 
 positionOutput :: String -> GeometryBuilder ()
-positionOutput str = (return ()) { positionOut = (Just str) }
+positionOutput str = (return ()) {positionOut = (Just str)}
 
 gVertex4 :: Float -> Float -> Float -> Float -> GeometryBuilder ()
-gVertex4 x y z w = (return ()) { gList = Seq.singleton $ Vertex x y z w }
+gVertex4 x y z w = (return ()) {gList = Seq.singleton $ Vertex x y z w}
 
 gNormal3 :: Float -> Float -> Float -> GeometryBuilder ()
-gNormal3 x y z = (return ()) { gList = (Seq.singleton $ Normal x y z) }
+gNormal3 x y z = (return ()) {gList = (Seq.singleton $ Normal x y z)}
 
 gTexture2 :: Float -> Float -> GeometryBuilder ()
-gTexture2 x y = (return ()) { gList = (Seq.singleton $ Texture x y) }
+gTexture2 x y = (return ()) {gList = (Seq.singleton $ Texture x y)}
 
 gEmitVertex :: GeometryBuilder ()
-gEmitVertex = (return ()) { gList = (Seq.singleton $ EmitVertex) }
+gEmitVertex = (return ()) {gList = (Seq.singleton $ EmitVertex)}
 
 gEndPrimitive :: GeometryBuilder ()
-gEndPrimitive = (return ()) { gList = Seq.singleton $ EndPrimitive }
+gEndPrimitive = (return ()) {gList = Seq.singleton $ EndPrimitive}
 
 gVertex4E :: Float -> Float -> Float -> Float -> GeometryBuilder ()
 gVertex4E x y z w = gVertex4 x y z w >> gEmitVertex
@@ -152,38 +160,39 @@ instance Functor GeometryBuilder where
 
 instance Applicative GeometryBuilder where
   (<*>) afn aa = do
-     fn <- afn
-     a <- aa
-     return (fn a)
+    fn <- afn
+    a <- aa
+    return (fn a)
 
   pure = return
 
 instance Monad GeometryBuilder where
-    aB >> bB = GeometryBuilder
-                (gList aB >< gList bB)
-                (select gOutType gOutType)
-                (select pjMatrixUniform pjMatrixUniform)
-                (select mvMatrixUniform mvMatrixUniform)
-                (select maxVerts maxVerts)
-                (select textureOut textureOut)
-                (select normalOut normalOut)
-                (select positionOut positionOut)
-                (gRet bB)
-                where select f1 f2 = (f1 bB) >||> (f2 aB)
-    aB >>= func = aB >> func (gRet aB)
-    return = GeometryBuilder
-                Seq.empty
-                Nothing
-                Nothing
-                Nothing
-                Nothing
-                Nothing
-                Nothing
-                Nothing
-    
+  aB >> bB =
+    GeometryBuilder
+      (gList aB >< gList bB)
+      (select gOutType gOutType)
+      (select pjMatrixUniform pjMatrixUniform)
+      (select mvMatrixUniform mvMatrixUniform)
+      (select maxVerts maxVerts)
+      (select textureOut textureOut)
+      (select normalOut normalOut)
+      (select positionOut positionOut)
+      (gRet bB)
+    where
+      select f1 f2 = (f1 bB) >||> (f2 aB)
+  aB >>= func = aB >> func (gRet aB)
+  return =
+    GeometryBuilder
+      Seq.empty
+      Nothing
+      Nothing
+      Nothing
+      Nothing
+      Nothing
+      Nothing
+      Nothing
 
 instance IsModelBuilder Float GeometryBuilder where
-    plotVertex3 x y z = gVertex4E x y z 0
-    plotNormal = gNormal3
-    plotTexture = gTexture2
-
+  plotVertex3 x y z = gVertex4E x y z 0
+  plotNormal = gNormal3
+  plotTexture = gTexture2