aboutsummaryrefslogtreecommitdiff
path: root/Graphics/Glyph/GeometryBuilder.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Graphics/Glyph/GeometryBuilder.hs')
-rw-r--r--Graphics/Glyph/GeometryBuilder.hs44
1 files changed, 26 insertions, 18 deletions
diff --git a/Graphics/Glyph/GeometryBuilder.hs b/Graphics/Glyph/GeometryBuilder.hs
index 31be715..53c6681 100644
--- a/Graphics/Glyph/GeometryBuilder.hs
+++ b/Graphics/Glyph/GeometryBuilder.hs
@@ -3,7 +3,6 @@
module Graphics.Glyph.GeometryBuilder where
import Data.Sequence as Seq
-import Data.Setters
import Data.Maybe
import Graphics.Glyph.Util
@@ -95,10 +94,8 @@ data GeometryBuilder a = GeometryBuilder {
gRet :: a
}
-$(declareSetters ''GeometryBuilder)
-
generating :: OutType -> GeometryBuilder () -> GeometryBuilder ()
-generating TriangleStrip builder = setGOutType (Just TriangleStrip) $ builder
+generating TriangleStrip builder = builder { gOutType = Just TriangleStrip }
generating Triangles builder = do
let (nSeq,_) =
Fold.foldl' (\(tSeq,cnt) datum ->
@@ -109,45 +106,57 @@ generating Triangles builder = do
_ -> (tSeq |> datum,cnt)
) (Seq.empty, 0) (gList builder)
- setGOutType (Just Triangles) $
- setGList nSeq builder
+ builder {
+ gOutType = Just Triangles,
+ gList = nSeq
+ }
projectionMatrixUniform :: String -> GeometryBuilder ()
-projectionMatrixUniform str = setPjMatrixUniform (Just str) $ return ()
+projectionMatrixUniform str = (return ()) { pjMatrixUniform = (Just str) }
modelViewMatrixUniform :: String -> GeometryBuilder ()
-modelViewMatrixUniform str = setMvMatrixUniform (Just str) $ return ()
+modelViewMatrixUniform str = (return ()) { mvMatrixUniform = (Just str) }
maxVerticies :: Int -> GeometryBuilder ()
-maxVerticies i = setMaxVerts (Just i) $ return ()
+maxVerticies i = (return ()) { maxVerts = (Just i) }
textureOutput :: String -> GeometryBuilder ()
-textureOutput str = setTextureOut (Just str) $ return ()
+textureOutput str = (return ()) { textureOut = (Just str) }
normalOutput :: String -> GeometryBuilder ()
-normalOutput str = setNormalOut (Just str) $ return ()
+normalOutput str = (return ()) { normalOut = (Just str) }
positionOutput :: String -> GeometryBuilder ()
-positionOutput str = setPositionOut (Just str) $ return ()
+positionOutput str = (return ()) { positionOut = (Just str) }
gVertex4 :: Float -> Float -> Float -> Float -> GeometryBuilder ()
-gVertex4 x y z w = setGList (Seq.singleton $ Vertex x y z w) $ return ()
+gVertex4 x y z w = (return ()) { gList = Seq.singleton $ Vertex x y z w }
gNormal3 :: Float -> Float -> Float -> GeometryBuilder ()
-gNormal3 x y z = setGList (Seq.singleton $ Normal x y z) $ return ()
+gNormal3 x y z = (return ()) { gList = (Seq.singleton $ Normal x y z) }
gTexture2 :: Float -> Float -> GeometryBuilder ()
-gTexture2 x y = setGList (Seq.singleton $ Texture x y) $ return ()
+gTexture2 x y = (return ()) { gList = (Seq.singleton $ Texture x y) }
gEmitVertex :: GeometryBuilder ()
-gEmitVertex = setGList (Seq.singleton $ EmitVertex) $ return ()
+gEmitVertex = (return ()) { gList = (Seq.singleton $ EmitVertex) }
gEndPrimitive :: GeometryBuilder ()
-gEndPrimitive = setGList (Seq.singleton $ EndPrimitive) $ return ()
+gEndPrimitive = (return ()) { gList = Seq.singleton $ EndPrimitive }
gVertex4E :: Float -> Float -> Float -> Float -> GeometryBuilder ()
gVertex4E x y z w = gVertex4 x y z w >> gEmitVertex
+instance Functor GeometryBuilder where
+ fmap f bb = bb >>= (return . f)
+
+instance Applicative GeometryBuilder where
+ (<*>) afn aa = do
+ fn <- afn
+ a <- aa
+ return (fn a)
+
+ pure = return
instance Monad GeometryBuilder where
aB >> bB = GeometryBuilder
@@ -171,7 +180,6 @@ instance Monad GeometryBuilder where
Nothing
Nothing
Nothing
- fail = error
instance IsModelBuilder Float GeometryBuilder where