diff options
Diffstat (limited to 'Graphics/Glyph/GeometryBuilder.hs')
-rw-r--r-- | Graphics/Glyph/GeometryBuilder.hs | 44 |
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 |