Initial pass at shadows from level geometry

This commit is contained in:
jgk
2021-06-29 15:27:26 +02:00
parent 089dcc3f5d
commit 3d16c33d33
20 changed files with 181 additions and 74 deletions
+1 -1
View File
@@ -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
+1
View File
@@ -28,6 +28,7 @@ dependencies:
- sdl2-mixer
- text
- OpenGL
- OpenGLRaw
- raw-strings-qq
- bytestring
- lens
+14 -1
View File
@@ -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();
@@ -16,4 +21,12 @@ void main()
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();
}
+2 -1
View File
@@ -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)
+2 -1
View File
@@ -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
+2 -1
View File
@@ -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
View File
@@ -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
+3 -2
View File
@@ -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
+7 -7
View File
@@ -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 -9
View File
@@ -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
+8
View File
@@ -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
View File
@@ -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
View File
@@ -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
+15
View File
@@ -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
View File
@@ -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
+19 -6
View File
@@ -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
View File
@@ -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
+1 -1
View File
@@ -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
View File
@@ -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
+21
View File
@@ -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