diff --git a/app/Main.hs b/app/Main.hs index f5985b239..931abcce0 100644 --- a/app/Main.hs +++ b/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 diff --git a/package.yaml b/package.yaml index 414eae508..0bfbb2f1c 100644 --- a/package.yaml +++ b/package.yaml @@ -28,6 +28,7 @@ dependencies: - sdl2-mixer - text - OpenGL +- OpenGLRaw - raw-strings-qq - bytestring - lens diff --git a/shader/lighting/lineShadow.geom b/shader/lighting/lineShadow.geom index f7533f061..5056070d3 100644 --- a/shader/lighting/lineShadow.geom +++ b/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(); - vec4 p1 = gl_in[1].gl_Position; - gl_Position = f(p1); EmitVertex(); - vec4 p2 = shift(p0); - gl_Position = f(p2); EmitVertex(); - vec4 p3 = shift(p1); - gl_Position = f(p3); EmitVertex(); - EndPrimitive(); + vec3 n0 = gl_in[2].gl_Position.xyz; + vec3 n1 = gl_in[3].gl_Position.xyz; + vec3 lightDir = p0.xyz - lightPos.xyz; + if ( dot(n0 , lightDir) * dot(n1 , lightDir) < 0 ); + { + gl_Position = f(p0); EmitVertex(); + vec4 p1 = gl_in[1].gl_Position; + 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(); } diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index e401c9fe4..4408981c8 100644 --- a/src/Dodge/Data.hs +++ b/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) diff --git a/src/Dodge/LevelGen.hs b/src/Dodge/LevelGen.hs index 27afaa29b..b94173112 100644 --- a/src/Dodge/LevelGen.hs +++ b/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 diff --git a/src/Dodge/LevelGen/Data.hs b/src/Dodge/LevelGen/Data.hs index a15d54725..37d0ce3ef 100644 --- a/src/Dodge/LevelGen/Data.hs +++ b/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 diff --git a/src/Dodge/Render.hs b/src/Dodge/Render.hs index c6f437513..1c5a62fcb 100644 --- a/src/Dodge/Render.hs +++ b/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 diff --git a/src/Dodge/Render/Picture.hs b/src/Dodge/Render/Picture.hs index 8d7911bc6..755c75a27 100644 --- a/src/Dodge/Render/Picture.hs +++ b/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 = pictures . _foregroundDecorations +foregroundPics :: World -> [Polyhedra] +foregroundPics = _foregroundDecorations fixedCoordPictures :: World -> Picture fixedCoordPictures w = case _menuLayers w of diff --git a/src/Dodge/Room/Foreground.hs b/src/Dodge/Room/Foreground.hs index e3b6a6442..9efaf4ad9 100644 --- a/src/Dodge/Room/Foreground.hs +++ b/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 x@(xx,xy) y = pictures - --[color orange . pictures . map (poly3D . map ( ( , black) . ( +.+.+ (x,y,50)))) $ boxXYZ - [ color orange . pictures . map (poly3D . map ( (,black) . (+.+.+ (xx,xy,50)))) +highPipe :: Point2 -> Point2 -> [Polyhedra] +highPipe x@(xx,xy) y = + [ Polyhedron . map (map ( (,orange) . (+.+.+ (xx,xy,50)))) $ boxABC (a,b,0) (a',b',0) (0,0,10) - ,verticalPipe 5 orange x 0 100 - ,verticalPipe 5 orange y 0 100 - ,verticalPipe 5 orange (0.5 *.* (x +.+ y)) 50 100 +-- ,verticalPipe 5 orange x 0 100 +-- ,verticalPipe 5 orange y 0 100 +-- ,verticalPipe 5 orange (0.5 *.* (x +.+ y)) 50 100 ] where (a,b) = y -.- x diff --git a/src/Dodge/Room/Start.hs b/src/Dodge/Room/Start.hs index e3cb6db8a..b48a16df0 100644 --- a/src/Dodge/Room/Start.hs +++ b/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 - [ highPipe (0,h/3) (w, h/3) - , girderV cola 10 (0,3*h/4) (w, 3*h/4) - , girder colb 5 (0,5*h/8) (w, 5*h/8) - ] + let fground = sPS (0,0) 0 $ PutForeground $ highPipe (0,h/3) (w, h/3) +-- , girderV cola 10 (0,3*h/4) (w, 3*h/4) +-- , 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 - cola = dark . dark . light . light $ light red - colb = dark . dark . light . light $ light blue +-- where +-- cola = dark . dark . light . light $ light red +-- colb = dark . dark . light . light $ light blue diff --git a/src/Geometry/Vector3D.hs b/src/Geometry/Vector3D.hs index 5044b14a0..58ea69f59 100644 --- a/src/Geometry/Vector3D.hs +++ b/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) + diff --git a/src/Picture.hs b/src/Picture.hs index 4bc9fae97..6d427d674 100644 --- a/src/Picture.hs +++ b/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 diff --git a/src/Polyhedra.hs b/src/Polyhedra.hs index 33208c9d2..7ecd95465 100644 --- a/src/Polyhedra.hs +++ b/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: --- 1. a list of faces, --- 2. a list of edges. --- Each face is a list of points that are assumed to lie on a plane, and be --- ordered to form an anticlockwise convex polygon within that plane. +translateXY :: Float -> Float -> Polyhedra -> Polyhedra +translateXY x y = pyFaces %~ (map $ map $ first $ tran) + where + tran (a,b,c) = (a+x,b+y,c) + +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 - { _pyFaces :: [[Point3]] - , _pyEdges :: [(Point3,Point3,Point3,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 diff --git a/src/Polyhedra/Data.hs b/src/Polyhedra/Data.hs new file mode 100644 index 000000000..7a3bd717b --- /dev/null +++ b/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 diff --git a/src/Preload/Render.hs b/src/Preload/Render.hs index 697b9748f..3922269a0 100644 --- a/src/Preload/Render.hs +++ b/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 - lslist <- makeShader "twoD/basic" [vert,frag] [3,4] Lines pokeLineStrat - aslist <- makeShader "twoD/arc" [vert,frag] [3,4,3] Triangles pokeArcStrat - eslist <- makeShader "twoD/ellipse" [vert,geom,frag] [3,4] Triangles pokeEllStrat - bezierQuadShader <- makeShader "twoD/bezierQuad" [vert,frag] [3,4,4] TriangleStrip pokeBezQStrat - cslist <- makeShader "twoD/character" [vert,frag] [3,4,2] Triangles pokeCharStrat + bslist <- makeShader "twoD/basic" [vert,frag] [3,4] ETriangles pokeTriStrat + lslist <- makeShader "twoD/basic" [vert,frag] [3,4] ELines pokeLineStrat + aslist <- makeShader "twoD/arc" [vert,frag] [3,4,3] ETriangles pokeArcStrat + eslist <- makeShader "twoD/ellipse" [vert,geom,frag] [3,4] ETriangles pokeEllStrat + bezierQuadShader <- makeShader "twoD/bezierQuad" [vert,frag] [3,4,4] ETriangleStrip pokeBezQStrat + 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 diff --git a/src/Picture/Render.hs b/src/Render.hs similarity index 91% rename from src/Picture/Render.hs rename to src/Render.hs index ac80bd2ee..e1403958d 100644 --- a/src/Picture/Render.hs +++ b/src/Render.hs @@ -1,8 +1,4 @@ ---{-# LANGUAGE DeriveFoldable, StandaloneDeriving #-} -{- -Rendering of a picture. --} -module Picture.Render +module 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 diff --git a/src/Shader.hs b/src/Shader.hs index 8f22d2824..300331a23 100644 --- a/src/Shader.hs +++ b/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 diff --git a/src/Shader/Compile.hs b/src/Shader/Compile.hs index 2a5e278c6..49936b711 100644 --- a/src/Shader/Compile.hs +++ b/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 diff --git a/src/Shader/Data.hs b/src/Shader/Data.hs index 117c628cb..201b1215b 100644 --- a/src/Shader/Data.hs +++ b/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 diff --git a/src/Shader/ExtraPrimitive.hs b/src/Shader/ExtraPrimitive.hs new file mode 100644 index 000000000..802e232d5 --- /dev/null +++ b/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