Initial pass at shadows from level geometry
This commit is contained in:
+1
-1
@@ -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
|
||||
|
||||
@@ -28,6 +28,7 @@ dependencies:
|
||||
- sdl2-mixer
|
||||
- text
|
||||
- OpenGL
|
||||
- OpenGLRaw
|
||||
- raw-strings-qq
|
||||
- bytestring
|
||||
- lens
|
||||
|
||||
@@ -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,6 +8,11 @@ vec4 f (vec4 p) {return (theMat * p);}
|
||||
void main()
|
||||
{
|
||||
vec4 p0 = gl_in[0].gl_Position;
|
||||
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();
|
||||
@@ -17,3 +22,11 @@ void main()
|
||||
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();
|
||||
}
|
||||
|
||||
+2
-1
@@ -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)
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
+5
-2
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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)
|
||||
|
||||
|
||||
+1
-6
@@ -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
|
||||
|
||||
+27
-9
@@ -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
|
||||
|
||||
@@ -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
|
||||
+17
-17
@@ -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
|
||||
|
||||
@@ -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
|
||||
+3
-1
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
+17
-1
@@ -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
|
||||
|
||||
@@ -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
|
||||
Reference in New Issue
Block a user