Initial pass at shadows from level geometry

app/Main.hs

@@ -13,7 +13,7 @@ import Dodge.Config.Update
 import Dodge.SoundLogic.LoadSound
 import Dodge.Debug.Flag.Data
 import Picture
-import Picture.Render
+import Render
 import Preload.Render
 import Picture.Tree
 import Sound

package.yaml

@@ -28,6 +28,7 @@ dependencies:
 - sdl2-mixer
 - text
 - OpenGL
+- OpenGLRaw
 - raw-strings-qq
 - bytestring
 - lens

shader/lighting/lineShadow.geom

@@ -1,5 +1,5 @@
 #version 430 core
-layout (lines) in;
+layout (lines_adjacency) in;
 layout (triangle_strip, max_vertices = 4) out;
 layout (std140, binding = 0) uniform TheMat { mat4 theMat; } ;
 uniform vec3 lightPos;
@@ -8,12 +8,25 @@ vec4 f (vec4 p) {return (theMat * p);}
 void main()
 {
     vec4 p0 = gl_in[0].gl_Position;
-    gl_Position = f(p0); EmitVertex();
+    vec3 n0 = gl_in[2].gl_Position.xyz;
-    vec4 p1 = gl_in[1].gl_Position;
+    vec3 n1 = gl_in[3].gl_Position.xyz;
-    gl_Position = f(p1); EmitVertex();
+    vec3 lightDir = p0.xyz - lightPos.xyz;
-    vec4 p2 = shift(p0);
+    if ( dot(n0 , lightDir) * dot(n1 , lightDir) < 0 );
-    gl_Position = f(p2); EmitVertex();
+    {
-    vec4 p3 = shift(p1);
+        gl_Position = f(p0); EmitVertex();
-    gl_Position = f(p3); EmitVertex();
+        vec4 p1 = gl_in[1].gl_Position;
-    EndPrimitive();
+        gl_Position = f(p1); EmitVertex();
+        vec4 p2 = shift(p0);
+        gl_Position = f(p2); EmitVertex();
+        vec4 p3 = shift(p1);
+        gl_Position = f(p3); EmitVertex();
+        EndPrimitive();
+    }
+    {
+    }
+    //gl_Position = vec4 (0,0,-0.5,1); EmitVertex();
+    //gl_Position = vec4 (1,0,-0.5,1); EmitVertex();
+    //gl_Position = vec4 (1,1,1,1); EmitVertex();
+    //gl_Position = vec4 (0,1,1,1); EmitVertex();
+    //EndPrimitive();
 }

src/Dodge/Data.hs

@@ -30,6 +30,7 @@ import Dodge.World.Trigger.Data
 import Data.Preload
 import Picture.Data
 import Geometry.Data
+import Polyhedra.Data
 import Sound.Data
 import qualified DoubleStack as DS
 
@@ -74,7 +75,7 @@ data World = World
     , _soundQueue           :: [(Int,Int16)]
     , _sounds               :: M.Map SoundOrigin Sound
     , _decorations          :: IM.IntMap Picture
-    , _foregroundDecorations :: [Picture]
+    , _foregroundDecorations :: [Polyhedra]
     , _corpses              :: IM.IntMap (IM.IntMap [Corpse])
     , _clickMousePos        :: (Float,Float)
     , _pathGraph            :: ~(Gr Point2 Float)

src/Dodge/LevelGen.hs

@@ -21,6 +21,7 @@ import Dodge.LevelGen.Data
 import Geometry
 import Geometry.Data
 import Picture
+import Polyhedra
 import qualified IntMapHelp as IM
 
 --import System.Random
@@ -93,7 +94,7 @@ placeSpot ps w = case _psType ps of
       where 
         (q:qs) = map (shiftPointBy (p,rot)) ps'
         rmCrossPaths w' = foldr (uncurry removePathsCrossing) w' $ zip (q:qs) (qs++[q])
-    PutForeground pic -> w & foregroundDecorations %~ (uncurry translate p (rotate rot pic) :)
+    PutForeground poly -> w & foregroundDecorations %~ (map (uncurry translateXY p . rotateXY rot) poly ++)
     PutNothing -> w
     PutID _ -> w
     --_   -> w

src/Dodge/LevelGen/Data.hs

@@ -4,6 +4,7 @@ module Dodge.LevelGen.Data
     where
 import Dodge.Data
 import Picture
+import Polyhedra.Data
 
 import Control.Lens
 import Control.Monad.State
@@ -22,7 +23,7 @@ data PSType = PutCrit {_unPutCrit :: Creature}
     | PutBtDoor Color Point2 Float Point2 Point2
     | PutSwitchDoor Color Point2 Float Point2 Point2
     | RandPS (State StdGen PSType)
-    | PutForeground Picture
+    | PutForeground [Polyhedra]
     | PutNothing
     | PutID { _putID :: Int}
 data PlacementSpot = PS

src/Dodge/Render.hs

@@ -14,7 +14,7 @@ import Dodge.Render.Picture
 import Geometry
 import Geometry.Data
 --import Picture
-import Picture.Render
+import Render
 import Data.Preload.Render
 import Picture.Data
 import Picture.Tree
@@ -22,6 +22,8 @@ import Shader
 import Shader.Data
 import Shader.Poke
 import MatrixHelper
+--import Polyhedra.Data
+import Polyhedra
 
 import Foreign
 --import Control.Applicative
@@ -102,7 +104,8 @@ doDrawing pdata w = do
 
     depthMask $= Enabled
     depthFunc $= Just Lequal
-    _ <- renderFoldable pdata $ picToLTree (Just 0) (foregroundPics w)
+    _ <- renderFoldable pdata $ picToLTree (Just 0) (polysToPic $ foregroundPics w)
+            --(Pictures $ concatmap (Poly3D 0 . _pyFaces) (foregroundPics w))
 
     -- draw the fbo to the screen
     -- allows for post-processing

src/Dodge/Render/Picture.hs

@@ -9,6 +9,7 @@ import Dodge.Render.MenuScreen
 import Geometry
 import Geometry.Data
 import Picture
+import Polyhedra.Data
 
 --import Dodge.Creature.YourControl
 
@@ -29,8 +30,8 @@ worldPictures w = pictures $ concat
     , map drawWallFloor (wallFloorsToDraw w)
     , testPic w
     ]
-foregroundPics :: World -> Picture
+foregroundPics :: World -> [Polyhedra]
-foregroundPics = pictures . _foregroundDecorations
+foregroundPics = _foregroundDecorations
 
 fixedCoordPictures :: World -> Picture
 fixedCoordPictures w = case _menuLayers w of 

src/Dodge/Room/Foreground.hs

@@ -8,6 +8,7 @@ import Geometry
 import Geometry.Data
 import Geometry.Vector3D
 import Polyhedra
+import Polyhedra.Data
 
 import Data.List
 import Data.Maybe
@@ -47,14 +48,13 @@ diagonalLinesRect pa pb w d ang = zip lhsPoints $ map findDiPoint lhsPoints
         ]
     yN = d * 0.5 *.* normalizeV (pa -.- pb)
 
-highPipe :: Point2 -> Point2 -> Picture
+highPipe :: Point2 -> Point2 -> [Polyhedra]
-highPipe x@(xx,xy) y = pictures 
+highPipe x@(xx,xy) y = 
-    --[color orange . pictures . map (poly3D . map ( ( , black) . ( +.+.+ (x,y,50)))) $ boxXYZ 
+    [ Polyhedron . map (map ( (,orange) . (+.+.+ (xx,xy,50)))) 
-    [ color orange . pictures . map (poly3D . map ( (,black) . (+.+.+ (xx,xy,50)))) 
         $ boxABC (a,b,0) (a',b',0) (0,0,10)
-    ,verticalPipe 5 orange x 0 100 
+--    ,verticalPipe 5 orange x 0 100 
-    ,verticalPipe 5 orange y 0 100 
+--    ,verticalPipe 5 orange y 0 100 
-    ,verticalPipe 5 orange (0.5 *.* (x +.+ y)) 50 100 
+--    ,verticalPipe 5 orange (0.5 *.* (x +.+ y)) 50 100 
     ]
   where
     (a,b) = y -.- x

src/Dodge/Room/Start.hs

@@ -7,7 +7,7 @@ import Dodge.Room.Procedural
 import Dodge.Room.Foreground
 import Dodge.Layout.Tree.Polymorphic
 import Dodge.LevelGen.Data
-import Picture
+--import Picture
 --import Geometry
 
 import Data.Tree
@@ -22,12 +22,10 @@ startRoom :: RandomGen g => State g (Tree (Either Room Room))
 startRoom = do
     w <- state $ randomR (100,400)
     h <- state $ randomR (200,400)
-    let fground = sPS (0,0) 0 $ PutForeground $ pictures
+    let fground = sPS (0,0) 0 $ PutForeground $ highPipe (0,h/3) (w, h/3)
-            [ highPipe (0,h/3) (w, h/3)
+--            , girderV cola 10 (0,3*h/4) (w, 3*h/4)
-            , girderV cola 10 (0,3*h/4) (w, 3*h/4)
+--            , girder colb 5 (0,5*h/8) (w, 5*h/8)
-            , girder colb 5 (0,5*h/8) (w, 5*h/8)
-            ]
     treeFromPost [Left rezBox, Left door] . Right <$> randomiseOutLinks (shiftRoomBy ((-20,-20),0) $ roomRectAutoLinks w h & rmPS %~ (fground :))
-  where
+--  where
-    cola = dark . dark . light . light $ light red
+--    cola = dark . dark . light . light $ light red
-    colb = dark . dark . light . light $ light blue
+--    colb = dark . dark . light . light $ light blue

src/Geometry/Vector3D.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE BangPatterns #-}
 module Geometry.Vector3D
     where
+import Geometry.Vector
 import Geometry.Data
 
 infixl 6 +.+.+, -.-.-
@@ -40,3 +41,10 @@ crossProd (x,y,z) (a,b,c) =
     , z * a - x * c
     , x * b - y * a
     )
+
+rotate3 :: Float -> Point3 -> Point3
+{-# INLINE rotate3 #-}
+rotate3 a (x,y,z) = (x',y',z)
+  where 
+    (x',y') = rotateV a (x,y)
+

src/Picture.hs

@@ -47,6 +47,7 @@ module Picture
     )
   where
 import Geometry
+import Geometry.Vector3D
 import Geometry.Data
 import Picture.Data
 
@@ -148,12 +149,6 @@ scale :: Float -> Float -> Picture -> Picture
 {-# INLINE scale #-}
 scale x y = OverPic (scale3 x y) id
 
-rotate3 :: Float -> Point3 -> Point3
-{-# INLINE rotate3 #-}
-rotate3 a (x,y,z) = (x',y',z)
-  where 
-    (x',y') = rotateV a (x,y)
-
 rotate :: Float -> Picture -> Picture
 {-# INLINE rotate #-}
 rotate a = OverPic (rotate3 a) id

src/Polyhedra.hs

@@ -2,22 +2,28 @@ module Polyhedra
     where
 import Geometry.Data
 import Geometry.Vector3D
+import Polyhedra.Data
+import Picture.Data
+import Picture
 
 import Data.Maybe
 import Data.List
+import Data.Bifunctor
+import Control.Lens
 
--- | Polyhedra are represented using two types of data: 
+translateXY :: Float -> Float -> Polyhedra -> Polyhedra
--- 1. a list of faces,
+translateXY x y = pyFaces %~ (map $ map $ first $ tran)
--- 2. a list of edges.
+  where
--- Each face is a list of points that are assumed to lie on a plane, and be
+    tran (a,b,c) = (a+x,b+y,c)
--- ordered to form an anticlockwise convex polygon within that plane.
+
+rotateXY :: Float -> Polyhedra -> Polyhedra
+rotateXY a = over pyFaces $ map $ map $ first $ rotate3 a
+
+-- Another representation of polyhedra is as a list of edges.
 -- Each edge is a tuple containing four points: the first two are the two edge
 -- coordinates, the last two being the normals of two planes of the polyhedra
 -- that the edge connects.
-data Polyhedra = Polyhedron
+    --, _pyEdges :: [(Point3,Point3,Point3,Point3)]
-    { _pyFaces :: [[Point3]]
-    , _pyEdges :: [(Point3,Point3,Point3,Point3)]
-    }
 
 constructEdges :: [[Point3]] -> [(Point3,Point3,Point3,Point3)]
 constructEdges (face:faces) = mapMaybe (findReverseEdge otherEdges) (faceEdges face) 
@@ -74,3 +80,15 @@ boxABC a b c =
     faceNC = rhombus b a
     faceNB = rhombus a c
     faceNA = rhombus c b
+
+polyToPics :: Polyhedra -> [Picture]
+polyToPics = map (Poly3D 0) . _pyFaces
+
+polysToPic :: [Polyhedra] -> Picture
+polysToPic = pictures . concatMap polyToPics
+
+polyToEdges :: Polyhedra -> [(Point3,Point3,Point3,Point3)]
+polyToEdges = constructEdges . map (map fst) . _pyFaces
+
+polyToRender :: Polyhedra -> [RenderType]
+polyToRender = map Render3 . map flat4 . polyToEdges

src/Polyhedra/Data.hs

@@ -0,0 +1,15 @@
+{-# LANGUAGE TemplateHaskell #-}
+--{-# LANGUAGE Strict #-}
+module Polyhedra.Data
+    where
+import Geometry.Data
+
+import Control.Lens
+-- | Polyhedra are represented as a list of faces.
+-- Each face is a list of points (and colours) that are assumed to lie on a plane, and be
+-- ordered to form an anticlockwise convex polygon within that plane.
+data Polyhedra = Polyhedron
+    { _pyFaces :: [[(Point3,Point4)]]
+    }
+
+makeLenses ''Polyhedra

src/Preload/Render.hs

@@ -26,43 +26,43 @@ preloadRender = do
     bindBufferBase IndexedUniformBuffer 0 $= Just theUBO
 
 -- lighting shaders
-    wsShad <- makeShader "lighting/occlude" [vert,geom,frag] [4] Points pokeWPStrat
+    wsShad <- makeShader "lighting/occlude" [vert,geom,frag] [4] EPoints pokeWPStrat
                 >>= addUniforms ["lightPos"]
     wlLightShad 
-         <- makeShader "lighting/wall" [vert,geom,frag] [4] Points pokeWPStrat
+         <- makeShader "lighting/wall" [vert,geom,frag] [4] EPoints pokeWPStrat
                 >>= addUniforms ["lightPos","radLum"]
     lightingSurfaceShad
-         <- makeShader "lighting/surface" [vert,frag] [3] Triangles poke3
+         <- makeShader "lighting/surface" [vert,frag] [3] ETriangles poke3
                 >>= addUniforms ["lightPos","radLum"]
     lightingLineShadowShad
-        <- makeShader "lighting/lineShadow" [vert,geom,frag] [3] Lines poke3
+        <- makeShader "lighting/lineShadow" [vert,geom,frag] [3] ELinesAdjacency poke3
                 >>= addUniforms ["lightPos"]
 -- 2D draw shaders
-    bslist <- makeShader "twoD/basic"   [vert,frag]      [3,4]   Triangles pokeTriStrat
+    bslist <- makeShader "twoD/basic"   [vert,frag] [3,4]   ETriangles pokeTriStrat
-    lslist <- makeShader "twoD/basic"   [vert,frag]      [3,4]   Lines     pokeLineStrat
+    lslist <- makeShader "twoD/basic"   [vert,frag] [3,4]   ELines     pokeLineStrat
-    aslist <- makeShader "twoD/arc"     [vert,frag] [3,4,3] Triangles    pokeArcStrat
+    aslist <- makeShader "twoD/arc"     [vert,frag] [3,4,3] ETriangles    pokeArcStrat
-    eslist <- makeShader "twoD/ellipse" [vert,geom,frag] [3,4]   Triangles pokeEllStrat
+    eslist <- makeShader "twoD/ellipse" [vert,geom,frag] [3,4]   ETriangles pokeEllStrat
-    bezierQuadShader <- makeShader "twoD/bezierQuad" [vert,frag] [3,4,4]  TriangleStrip pokeBezQStrat
+    bezierQuadShader <- makeShader "twoD/bezierQuad" [vert,frag] [3,4,4]  ETriangleStrip pokeBezQStrat
-    cslist <- makeShader "twoD/character" [vert,frag] [3,4,2] Triangles pokeCharStrat
+    cslist <- makeShader "twoD/character" [vert,frag] [3,4,2] ETriangles pokeCharStrat
                   >>= addTexture "data/texture/charMap.png"
 -- texture shaders, no textures attached
-    fsShad <- makeShader "texture/simple" [vert,frag] [2,2] TriangleStrip $ const cornerList
+    fsShad <- makeShader "texture/simple" [vert,frag] [2,2] ETriangleStrip $ const cornerList
     -- note we directly poke the shader vertex data here
     pokeArray (_vboPointer $ _vaoVBO $ _shaderVAO fsShad) $ concat cornerList
-    boxBlurShad <- makeShader "texture/boxBlur" [vert,frag] [2,2] TriangleStrip $ const cornerList
+    boxBlurShad <- makeShader "texture/boxBlur" [vert,frag] [2,2] ETriangleStrip $ const cornerList
     pokeArray (_vboPointer $ _vaoVBO $ _shaderVAO boxBlurShad) $ concat cornerList
-    grayscaleShad <- makeShader "texture/grayscale" [vert,frag] [2,2] TriangleStrip $ const cornerList
+    grayscaleShad <- makeShader "texture/grayscale" [vert,frag] [2,2] ETriangleStrip $ const cornerList
     pokeArray (_vboPointer $ _vaoVBO $ _shaderVAO grayscaleShad) $ concat cornerList
 -- blank wallShader
-    wlBlank <- makeShader "wall/blank" [vert,geom,frag] [4,4] Points pokeWPColStrat
+    wlBlank <- makeShader "wall/blank" [vert,geom,frag] [4,4] EPoints pokeWPColStrat
 -- textured wallShader
-    wlTexture <- makeShader "wall/texture" [vert,geom,frag] [4,4] Points pokeWPColStrat
+    wlTexture <- makeShader "wall/texture" [vert,geom,frag] [4,4] EPoints pokeWPColStrat
                 >>= addTexture "data/texture/grayscaleDirt.png"
 ---- texture shader
-    textShad <- makeShader "texture/simpleWorld" [vert,frag] [3,2] Triangles poke32
+    textShad <- makeShader "texture/simpleWorld" [vert,frag] [3,2] ETriangles poke32
         >>= addTexture "data/texture/ayene_wooden_floor.png"
 ---- texture array shader
-    textArrayShad <- makeShader "texture/array" [vert,frag] [3,3] Triangles poke33
+    textArrayShad <- makeShader "texture/array" [vert,frag] [3,3] ETriangles poke33
         >>= addTextureArray "data/texture/ayene_wooden_floor.png"
 -- framebuffer for lighting
     (fbo,fboTO,fboRBO) <- setupFramebufferWithStencil

src/Render.hs

@@ -1,8 +1,4 @@
---{-# LANGUAGE DeriveFoldable, StandaloneDeriving #-}
+module Render
-{-
-Rendering of a picture.
--}
-module Picture.Render
     where
 import Shader
 import Shader.Data
@@ -12,6 +8,8 @@ import Data.Preload.Render
 import Picture.Data
 --import Geometry
 import Geometry.Data
+import Polyhedra.Data
+import Polyhedra
 
 --import Control.Lens
 import Control.Monad
@@ -57,7 +55,7 @@ createLightMap
     -> [(Point2,Point2)]    -- Wall pairs
     -> [(Point3,Float,Float)]             -- Lights
     -> (Float,Float)        -- View from position
-    -> Picture              -- foreground pictures
+    -> [Polyhedra]          -- foreground geometry
     -> IO ()
 createLightMap pdata resDiv wallPoints lightPoints (viewFromx,viewFromy) fpics = do
     -- get viewport size so we can reset it later
@@ -72,6 +70,10 @@ createLightMap pdata resDiv wallPoints lightPoints (viewFromx,viewFromy) fpics =
     nWalls <- F.foldM (pokeShader $ _lightingOccludeShader pdata) (map Render22 wallPoints)
     bindShaderBuffers [_lightingOccludeShader pdata] [nWalls]
 
+    -- store foreground geometry into buffer
+    nSils <- F.foldM (pokeShader $ _lightingLineShadowShader pdata) (concatMap polyToRender fpics)
+    bindShaderBuffers [_lightingLineShadowShader pdata] [nSils]
+
 -- clear buffer to full alpha and furthest depth
 -- clearColor is specified in preloadRender
     clear [ColorBuffer,DepthBuffer]
@@ -108,9 +110,20 @@ createLightMap pdata resDiv wallPoints lightPoints (viewFromx,viewFromy) fpics =
         uniform (head $  _shaderCustomUnis $ _lightingOccludeShader pdata)
             $= Vector3 x y z
         drawShader (_lightingOccludeShader pdata) nWalls
+
+        --cullFace $= Nothing
+        currentProgram $= Just (_shaderProgram $ _lightingLineShadowShader pdata)
+        uniform (head $  _shaderCustomUnis $ _lightingLineShadowShader pdata)
+            $= Vector3 x y z
+        drawShader (_lightingLineShadowShader pdata) nSils
+
         cullFace $= Just Front
         stencilOp $= (OpKeep,OpKeep,OpDecr)
+        currentProgram $= Just (_shaderProgram $ _lightingOccludeShader pdata)
         drawShader (_lightingOccludeShader pdata) nWalls
+
+        currentProgram $= Just (_shaderProgram $ _lightingLineShadowShader pdata)
+        drawShader (_lightingLineShadowShader pdata) nSils
 -- draw floor light circles
         cullFace $= Nothing
         colorMask $= Color4 Disabled Disabled Disabled Enabled

src/Shader.hs

@@ -7,11 +7,13 @@ module Shader
 --import Geometry.Data
 import Shader.Data
 import Shader.Parameters
+import Shader.ExtraPrimitive
 --import MatrixHelper
 
 import Foreign
 import Control.Monad
 import Graphics.Rendering.OpenGL hiding (Point,translate,scale,imageHeight)
+import Graphics.GL.Core43
 --import Text.RawString.QQ
 --import Linear.Matrix
 --import Linear.V4
@@ -40,7 +42,7 @@ drawShader fs i = do
         Just ShaderTexture{_textureObject = txo}
             -> textureBinding Texture2D $= Just txo
         _   -> return ()
-    drawArrays (_shaderDrawPrimitive fs) 0 (fromIntegral i)
+    glDrawArrays (marshalEPrimitiveMode $ _shaderDrawPrimitive fs) 0 (fromIntegral i)
 
 freeShaderPointers :: FullShader -> IO ()
 freeShaderPointers fs = free $ _vboPointer $ _vaoVBO $ _shaderVAO fs

src/Shader/Compile.hs

@@ -21,7 +21,7 @@ makeShader
     :: String       -- ^ First part of the name of the shader
     -> [ShaderType] -- ^ Filetype extensions
     -> [Int]   -- ^ The input vertex sizes
-    -> PrimitiveMode
+    -> EPrimitiveMode
     -> (RenderType -> [[Float]])   -- ^ Poke strategy: method for creating a list of vertex data to be bound
     -> IO FullShader
 makeShader s shaderlist sizes pm renStrat = do

src/Shader/Data.hs

@@ -7,6 +7,7 @@ module Shader.Data
     , VBO (..)
     , FullShader (..)
     , ShaderTexture (..)
+    , EPrimitiveMode (..)
 -- | Lens functions
     , vao
     , vaoVBO
@@ -25,6 +26,7 @@ import Picture.Data
 import Graphics.Rendering.OpenGL
 import Foreign
 import Control.Lens
+--import Graphics.GL.Types
 {- | Vertex array object: contains the reference to the object,
 and its buffer targets.  -}
 data VAO = VAO
@@ -46,7 +48,7 @@ data FullShader = FullShader
     { _shaderProgram :: Program
     , _shaderVAO :: VAO
     , _shaderPokeStrategy :: RenderType -> [[Float]]-- -> F.FoldM IO RenderType Int
-    , _shaderDrawPrimitive :: PrimitiveMode
+    , _shaderDrawPrimitive :: EPrimitiveMode
     , _shaderTexture :: Maybe ShaderTexture
     , _shaderCustomUnis :: [UniformLocation]
     }
@@ -54,5 +56,19 @@ data FullShader = FullShader
 newtype ShaderTexture = ShaderTexture
     { _textureObject :: TextureObject }
 
+data EPrimitiveMode
+    = EPoints
+    | ELines
+    | ELinesAdjacency
+    | ELineLoop
+    | ELineStrip
+    | ETriangles
+    | ETriangleStrip
+    | ETriangleFan
+    | EQuads
+    | EQuadStrip
+    | EPolygon
+    | EPatches
+
 makeLenses ''VAO
 makeLenses ''FullShader

src/Shader/ExtraPrimitive.hs

@@ -0,0 +1,21 @@
+module Shader.ExtraPrimitive
+    where
+import Shader.Data
+
+import Graphics.GL.Types
+import Graphics.GL.Tokens
+
+marshalEPrimitiveMode :: EPrimitiveMode -> GLenum
+marshalEPrimitiveMode x = case x of
+   EPoints -> GL_POINTS
+   ELines -> GL_LINES
+   ELinesAdjacency -> GL_LINES_ADJACENCY
+   ELineLoop -> GL_LINE_LOOP
+   ELineStrip -> GL_LINE_STRIP
+   ETriangles -> GL_TRIANGLES
+   ETriangleStrip -> GL_TRIANGLE_STRIP
+   ETriangleFan -> GL_TRIANGLE_FAN
+   EQuads -> GL_QUADS
+   EQuadStrip -> GL_QUAD_STRIP
+   EPolygon -> GL_POLYGON
+   EPatches -> GL_PATCHES