justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Implement (not fully working) alternate shadow volumes

Browse Source
This commit is contained in:
justin
2023-02-24 19:51:41 +00:00
parent ed9a46a18d
commit bf1bd5bb0b
9 changed files with 136 additions and 116 deletions
Download Patch File Download Diff File Expand all files Collapse all files
shader/lighting/lineShadow.geom
+6 -2
View File
@@ -3,9 +3,10 @@ layout (lines_adjacency) in;
layout (triangle_strip, max_vertices = 4) out; layout (triangle_strip, max_vertices = 4) out;
layout (std140, binding = 0) uniform TheMat { mat4 theMat; } ; layout (std140, binding = 0) uniform TheMat { mat4 theMat; } ;
uniform vec3 lightPos; uniform vec3 lightPos;
uniform vec4 lumRad; uniform float radiusUniform;
//vec4 shift (vec4 p) { return (vec4 (p.xyz + (lumRad.a*normalize(p.xyz-lightPos)), 1));} //vec4 shift (vec4 p) { return (vec4 (p.xyz + (lumRad.a*normalize(p.xyz-lightPos)), 1));}
vec4 shift (vec4 p) { return (vec4 (p.xyz + (100000*(p.xyz-lightPos)), 1));} vec4 shift (vec4 p) { return (vec4 (p.xyz + (100000*(p.xyz-lightPos)), 1));}
vec4 shiftBy (float x,vec4 p) { return (vec4 (lightPos + (x*normalize(p.xyz-lightPos)), 1));}
//vec4 shift (vec4 p) { return (vec4 (lightPos + (lumRad.a*normalize(p.xyz-lightPos)), 1));} //vec4 shift (vec4 p) { return (vec4 (lightPos + (lumRad.a*normalize(p.xyz-lightPos)), 1));}
// copied from lighting/cap.geom, should not be changed on its own // copied from lighting/cap.geom, should not be changed on its own
vec4 projNear (vec4 pos) vec4 projNear (vec4 pos)
@@ -18,6 +19,7 @@ vec4 projNear (vec4 pos)
return vec4 ( xy, 140 , 1) ; return vec4 ( xy, 140 , 1) ;
} }
vec4 shiftNear (vec4 pos) vec4 shiftNear (vec4 pos)
//{ vec4 sp = shiftBy(radiusUniform,pos);
{ vec4 sp = shift(pos); { vec4 sp = shift(pos);
if (sp.z > 140) if (sp.z > 140)
{ return projNear(pos) ; } { return projNear(pos) ; }
@@ -27,6 +29,7 @@ vec4 shiftNear (vec4 pos)
vec4 f (vec4 p) {return (theMat * p);} vec4 f (vec4 p) {return (theMat * p);}
void main() void main()
{ {
float ru2 = radiusUniform * radiusUniform ;
vec4 p0 = gl_in[0].gl_Position; vec4 p0 = gl_in[0].gl_Position;
vec4 p1 = gl_in[1].gl_Position; vec4 p1 = gl_in[1].gl_Position;
vec4 mid = 0.5*(p0 + p1); vec4 mid = 0.5*(p0 + p1);
@@ -41,7 +44,8 @@ void main()
// first test if the edge is part of the silhouette // first test if the edge is part of the silhouette
// that is, if the normals of the faces connected by the edge point are in // that is, if the normals of the faces connected by the edge point are in
// "different directions" wrt the light direction // "different directions" wrt the light direction
if ( dot(n0 , lightDir) * dot(n1 , lightDir) <= 0 ) if ( dot(n0 , lightDir) * dot(n1 , lightDir) <= 0 &&
(dot(lightDir,lightDir) < ru2 || dot(lightDir2,lightDir2) < ru2) )
// using <= rather than < seems to get rid of overlapping shadow // using <= rather than < seems to get rid of overlapping shadow
// artefacts // artefacts
{ {
src/Dodge/Render.hs
+19 -12
View File
@@ -3,6 +3,8 @@ module Dodge.Render (
doDrawing, doDrawing,
) where ) where
import qualified Data.Vector as V
import Dodge.Render.Shadow
import Control.Lens import Control.Lens
import Control.Monad import Control.Monad
import qualified Control.Monad.Parallel as MP import qualified Control.Monad.Parallel as MP
@@ -105,14 +107,14 @@ doDrawing pdata u = do
, (_windowShader pdata, nWins) , (_windowShader pdata, nWins)
, (_textureArrayShader pdata, nFls) , (_textureArrayShader pdata, nFls)
] ]
bindBuffer ElementArrayBuffer $= Just (_ebo $ _shapeEBO pdata) bindBuffer ElementArrayBuffer $= pdata ^? shapeEBO . ebo --Just (_ebo $ _shapeEBO pdata)
bufferSubData bufferSubData
ElementArrayBuffer ElementArrayBuffer
WriteToBuffer WriteToBuffer
0 0
(fromIntegral $ glushortSize * nIndices) (fromIntegral $ glushortSize * nIndices)
(_eboPtr $ _shapeEBO pdata) (_eboPtr $ _shapeEBO pdata)
bindBuffer ElementArrayBuffer $= Just (_ebo $ _silhouetteEBO pdata) bindBuffer ElementArrayBuffer $= pdata ^? silhouetteEBO . ebo --Just (_ebo $ _silhouetteEBO pdata)
bufferSubData bufferSubData
ElementArrayBuffer ElementArrayBuffer
WriteToBuffer WriteToBuffer
@@ -127,9 +129,9 @@ doDrawing pdata u = do
clear [ColorBuffer, DepthBuffer] clear [ColorBuffer, DepthBuffer]
depthFunc $= Just Less depthFunc $= Just Less
-- draw wall occlusions from the camera's point of view -- draw wall occlusions from the camera's point of view
currentProgram $= Just (_shadProg lwShad) currentProgram $= lwShad ^? shadProg -- Just (_shadProg lwShad)
uniform (head $ _shadUnis lwShad) $= viewFrom3d uniform (_shadUnis lwShad V.! 0) $= viewFrom3d
bindVertexArrayObject $= Just (_vao $ _shadVAO lwShad) bindVertexArrayObject $= lwShad ^? shadVAO . vao -- Just (_vao $ _shadVAO lwShad)
unless (debugOn Remove_LOS cfig) $ unless (debugOn Remove_LOS cfig) $
glDrawArrays glDrawArrays
(marshalEPrimitiveMode $ _shadPrim lwShad) (marshalEPrimitiveMode $ _shadPrim lwShad)
@@ -144,7 +146,7 @@ doDrawing pdata u = do
--draw object shapes onto base buffer --draw object shapes onto base buffer
let fs = _shapeShader pdata let fs = _shapeShader pdata
currentProgram $= Just (_shadProg fs) currentProgram $= Just (_shadProg fs)
bindVertexArrayObject $= Just (_vao $ _shadVAO fs) bindVertexArrayObject $= fs ^? shadVAO . vao -- Just (_vao $ _shadVAO fs)
glDrawElements glDrawElements
(marshalEPrimitiveMode $ _shadPrim fs) (marshalEPrimitiveMode $ _shadPrim fs)
(fromIntegral nIndices) (fromIntegral nIndices)
@@ -161,18 +163,21 @@ doDrawing pdata u = do
nWalls nWalls
nSilIndices nSilIndices
nIndices nIndices
(_graphics_object_shadows $ _uvConfig u) --(_graphics_object_shadows $ _uvConfig u)
(snd $ snd $ _fboBase pdata) (u ^. uvConfig . graphics_object_shadows)
(snd $ snd $ pdata ^. fboBase)
(drawCPUShadows pdata ws)
colorMask $= Color4 Enabled Enabled Enabled Enabled colorMask $= Color4 Enabled Enabled Enabled Enabled
clearColor $= Color4 0 0 0 0 clearColor $= Color4 0 0 0 0
--apply lightmap to base buffer --apply lightmap to base buffer
bindFramebuffer Framebuffer $= fst (_fboBase pdata) bindFramebuffer Framebuffer $= pdata ^. fboBase . _1 --fst (_fboBase pdata)
textureBinding Texture2D $= Just (snd $ _fboLighting pdata) --textureBinding Texture2D $= Just (snd $ _fboLighting pdata)
textureBinding Texture2D $= pdata ^? fboLighting . _2 -- Just (snd $ _fboLighting pdata)
blend $= Enabled blend $= Enabled
blendFunc $= (Zero, OneMinusSrcColor) blendFunc $= (Zero, OneMinusSrcColor)
drawShader (_fullscreenShader pdata) 4 drawShader (_fullscreenShader pdata) 4
--draw bloom onto bloom buffer --draw bloom onto bloom buffer
bindFramebuffer Framebuffer $= fst (_fboBloom pdata) bindFramebuffer Framebuffer $= pdata ^. fboBloom . _1 --fst (_fboBloom pdata)
clear [ColorBuffer] clear [ColorBuffer]
depthFunc $= Just Less depthFunc $= Just Less
blendFunc $= (SrcAlpha, OneMinusSrcAlpha) blendFunc $= (SrcAlpha, OneMinusSrcAlpha)
@@ -185,7 +190,7 @@ doDrawing pdata u = do
setViewportSize (round winx `div` (2 * resFact)) (round winy `div` (2 * resFact)) setViewportSize (round winx `div` (2 * resFact)) (round winy `div` (2 * resFact))
bindFramebuffer Framebuffer $= fst (_fboHalf1 pdata) bindFramebuffer Framebuffer $= fst (_fboHalf1 pdata)
depthFunc $= Just Always depthFunc $= Just Always
textureBinding Texture2D $= Just (snd $ _fboBloom pdata) textureBinding Texture2D $= pdata ^? fboBloom . _2 -- Just (snd $ _fboBloom pdata)
blend $= Disabled blend $= Disabled
drawShader (_bloomBlurShader pdata) 4 drawShader (_bloomBlurShader pdata) 4
replicateM_ 9 $ pingPongBetween (_fboHalf1 pdata) (_fboHalf2 pdata) (_bloomBlurShader pdata) replicateM_ 9 $ pingPongBetween (_fboHalf1 pdata) (_fboHalf2 pdata) (_bloomBlurShader pdata)
@@ -224,6 +229,7 @@ doDrawing pdata u = do
nIndices nIndices
(_graphics_object_shadows $ _uvConfig u) (_graphics_object_shadows $ _uvConfig u)
(snd $ snd $ _fboCloud pdata) (snd $ snd $ _fboCloud pdata)
(drawCPUShadows pdata ws)
colorMask $= Color4 Enabled Enabled Enabled Enabled colorMask $= Color4 Enabled Enabled Enabled Enabled
clearColor $= Color4 0 0 0 0 clearColor $= Color4 0 0 0 0
--apply lightmap to cloud buffer --apply lightmap to cloud buffer
@@ -322,3 +328,4 @@ renderTextureWalls pdata nWalls = do
cullFace $= Just Back cullFace $= Just Back
drawShader (_wallTextureShader pdata) nWalls drawShader (_wallTextureShader pdata) nWalls
cullFace $= Nothing cullFace $= Nothing
src/Preload/Render.hs
+1 -2
View File
@@ -121,10 +121,9 @@ preloadRender = do
>>= addUniforms ["lightPos"] >>= addUniforms ["lightPos"]
lightingLineShadowShad lightingLineShadowShad
<- makeShaderUsingVAO "lighting/lineShadow" [vert,geom,frag] ELinesAdjacency shEdgeVAO <- makeShaderUsingVAO "lighting/lineShadow" [vert,geom,frag] ELinesAdjacency shEdgeVAO
>>= addUniforms ["lightPos","lumRad"] >>= addUniforms ["lightPos","radiusUniform"]
-- positional shader -- positional shader
positionalBlankShad <- makeShader "positional/blank" [vert,frag] [3] ETriangles positionalBlankShad <- makeShader "positional/blank" [vert,frag] [3] ETriangles
-- 2D draw shaders -- 2D draw shaders
bslist <- makeShader "dualTwoD/basic" [vert,frag] [3,4] ETriangles bslist <- makeShader "dualTwoD/basic" [vert,frag] [3,4] ETriangles
bslista <- makeShader "dualTwoD/basic" [vert,frag] [3,4] ETriangles bslista <- makeShader "dualTwoD/basic" [vert,frag] [3,4] ETriangles
src/Render.hs
+86 -80
View File
@@ -1,47 +1,56 @@
module Render module Render (
( createLightMap createLightMap,
, divideSize divideSize,
, renderFoldable renderFoldable,
, renderLayer renderLayer,
, pingPongBetween pingPongBetween,
, bindTO bindTO,
, bindFBO bindFBO,
) where ) where
import Dodge.Data.Config
import Shader
import Shader.ExtraPrimitive
import Shader.Data
import Data.Preload.Render
import Picture.Data
import Geometry.Data
import Foreign hiding (rotate) import Control.Lens
import Graphics.Rendering.OpenGL hiding (Line,translate,scale,imageHeight,Polygon,Color,T)
import qualified Data.Vector.Unboxed.Mutable as UMV
import qualified Data.Vector.Mutable as MV
import Control.Monad.Primitive import Control.Monad.Primitive
import Graphics.GL.Core43 import Data.Preload.Render
import qualified Data.Vector as V
--import Control.Monad --import Control.Monad
import qualified Data.Vector.Fusion.Stream.Monadic as VFSM import qualified Data.Vector.Fusion.Stream.Monadic as VFSM
import qualified Data.Vector.Mutable as MV
import qualified Data.Vector.Unboxed.Mutable as UMV
import Dodge.Data.Config
import Foreign hiding (rotate)
import Geometry.Data
import Graphics.GL.Core43
import Graphics.Rendering.OpenGL hiding (Color, Line, Polygon, T, imageHeight, scale, translate)
import Picture.Data
import Shader
import Shader.Data
import Shader.ExtraPrimitive
divideSize :: Int -> Size -> Size divideSize :: Int -> Size -> Size
divideSize i (Size x y) = Size (div x $ fromIntegral i) (div y $ fromIntegral i) divideSize i (Size x y) = Size (div x $ fromIntegral i) (div y $ fromIntegral i)
{- | Determine where light is shining in the world. -} -- | Determine where light is shining in the world.
createLightMap createLightMap ::
:: RenderData RenderData ->
-> [(Point3,Float,Point3)] -- Lights [(Point3, Float, Point3)] -> -- Lights
-> Int -- ^ number of walls
-> Int -- ^ number of silhoutte lines to draw -- | number of walls
-> Int -- ^ number of "caps" to attempt to draw Int ->
-> ObjectShadows -- ^ whether to draw object shadows or not -- | number of silhoutte lines to draw
-> TextureObject -- ^ the texture object giving positions Int ->
-> IO () -- | number of "caps" to attempt to draw
createLightMap pdata lightPoints nWalls nSils nCaps drawObjShads toPos = do Int ->
let llsShad = _lightingLineShadowShader pdata -- | whether to draw object shadows or not
let lcShad = _lightingCapShader pdata ObjectShadows ->
let lwShad = _lightingWallShadShader pdata -- | the texture object giving positions
let ltShad = _lightingTextureShader pdata TextureObject ->
(Point3 -> Float -> IO ()) -> -- attempt at drawing shadow not using geo shader
IO ()
createLightMap pdata lightPoints nWalls nSils nCaps drawObjShads toPos drawCPUShadows = do
let llinesShad = _lightingLineShadowShader pdata
lcapShad = _lightingCapShader pdata
lwallShad = _lightingWallShadShader pdata
ltextShad = _lightingTextureShader pdata
-- we assume that the renderbuffer's depth has been correctly set elsewhere -- we assume that the renderbuffer's depth has been correctly set elsewhere
-- we will not be changing that here -- we will not be changing that here
depthMask $= Disabled depthMask $= Disabled
@@ -49,82 +58,79 @@ createLightMap pdata lightPoints nWalls nSils nCaps drawObjShads toPos = do
clearColor $= Color4 1 1 1 1 clearColor $= Color4 1 1 1 1
clear [ColorBuffer] clear [ColorBuffer]
-- for each of the lights: -- for each of the lights:
-- 1. stencil out the walls from this light's point of view -- 1. stencil out the shadows from this light's point of view
-- 2. calculate lighting based on each fragment's position -- 2. calculate lighting based on each fragment's position
-- to consider: adding normals/a "material" for each fragment -- to consider: adding normals/a "material" for each fragment
blendFunc $= (Zero, OneMinusSrcColor) blendFunc $= (Zero, OneMinusSrcColor)
stencilTest $= Enabled stencilTest $= Enabled
flip VFSM.mapM_ (VFSM.fromList lightPoints) $ \(V3 x y z,rad,V3 r g b) -> do flip VFSM.mapM_ (VFSM.fromList lightPoints) $ \(V3 x y z, rad, V3 r g b) -> do
depthFunc $= Just Less depthFunc $= Just Less
-- setup stencil -- setup stencil
colorMask $= Color4 Disabled Disabled Disabled Disabled colorMask $= Color4 Disabled Disabled Disabled Disabled
clear [StencilBuffer] clear [StencilBuffer]
cullFace $= Nothing cullFace $= Nothing
stencilOpSeparate Front $= (OpKeep,OpKeep,OpIncrWrap) stencilOpSeparate Front $= (OpKeep, OpKeep, OpIncrWrap)
stencilOpSeparate Back $= (OpKeep,OpKeep,OpDecrWrap) stencilOpSeparate Back $= (OpKeep, OpKeep, OpDecrWrap)
stencilFunc $= (Always, 0, 255) stencilFunc $= (Always, 0, 255)
--draw wall shadows --draw wall shadows
currentProgram $= Just (_shadProg lwShad) currentProgram $= Just (_shadProg lwallShad)
uniform (head $ _shadUnis lwShad) uniform (_shadUnis lwallShad V.! 0)
$= Vector3 x y z $= Vector3 x y z
bindVertexArrayObject $= Just (_vao $ _shadVAO lwShad) bindVertexArrayObject $= lwallShad ^? shadVAO . vao -- Just (_vao $ _shadVAO lwallShad)
glDrawArrays glDrawArrays
(marshalEPrimitiveMode $ _shadPrim lwShad) (marshalEPrimitiveMode $ _shadPrim lwallShad)
0 0
(fromIntegral nWalls) (fromIntegral nWalls)
case drawObjShads of case drawObjShads of
GeoObjShads -> do GeoObjShads -> do
--draw silhouette shadows --draw silhouette shadows
currentProgram $= Just (_shadProg llsShad) currentProgram $= Just (_shadProg llinesShad)
uniform (head $ _shadUnis $ _lightingLineShadowShader pdata) uniform (_shadUnis llinesShad V.! 0) $= Vector3 x y z
$= Vector3 x y z uniform (_shadUnis llinesShad V.! 1) $= rad
uniform (_shadUnis ltShad !! 1) bindVertexArrayObject $= Just (_vao $ _shadVAO llinesShad)
$= Vector4 r g b rad
bindVertexArrayObject $= Just (_vao $ _shadVAO llsShad)
glDrawElements glDrawElements
(marshalEPrimitiveMode $ _shadPrim llsShad) (marshalEPrimitiveMode $ _shadPrim llinesShad)
(fromIntegral nSils) (fromIntegral nSils)
GL_UNSIGNED_SHORT GL_UNSIGNED_SHORT
nullPtr nullPtr
--draw caps on the near plane as required --draw caps on the near plane as required
cullFace $= Just Back cullFace $= Just Back
currentProgram $= Just (_shadProg lcShad) currentProgram $= Just (_shadProg lcapShad)
uniform (head $ _shadUnis lcShad) uniform (_shadUnis lcapShad V.! 0) $= Vector3 x y z
$= Vector3 x y z bindVertexArrayObject $= lcapShad ^? shadVAO . vao --Just (_vao $ _shadVAO lcapShad)
bindVertexArrayObject $= Just (_vao $ _shadVAO lcShad)
glDrawElements glDrawElements
(marshalEPrimitiveMode $ _shadPrim lcShad) (marshalEPrimitiveMode $ _shadPrim lcapShad)
(fromIntegral nCaps) (fromIntegral nCaps)
GL_UNSIGNED_SHORT GL_UNSIGNED_SHORT
nullPtr nullPtr
CPUObjShads -> drawCPUShadows (V3 x y z) rad
_ -> return () _ -> return ()
--draw lightmap itself --draw lightmap itself
depthFunc $= Just Always depthFunc $= Just Always
-- bind world position texture -- bind world position texture
bindTO toPos bindTO toPos
colorMask $= Color4 Enabled Enabled Enabled Enabled colorMask $= Color4 Enabled Enabled Enabled Enabled
stencilOp $= (OpKeep,OpKeep,OpKeep) stencilOp $= (OpKeep, OpKeep, OpKeep)
stencilFunc $= (Equal, 0, 255) stencilFunc $= (Equal, 0, 255)
currentProgram $= Just (_shadProg ltShad) currentProgram $= ltextShad ^? shadProg --Just (_shadProg ltextShad)
uniform (head $ _shadUnis ltShad) uniform (_shadUnis ltextShad V.! 0) $= Vector3 x y z
$= Vector3 x y z uniform (_shadUnis ltextShad V.! 1) $= Vector4 r g b rad
uniform (_shadUnis ltShad !! 1) bindVertexArrayObject $= ltextShad ^? shadVAO . vao -- Just (_vao $ _shadVAO ltextShad)
$= Vector4 r g b rad
bindVertexArrayObject $= Just (_vao $ _shadVAO ltShad)
glDrawArrays glDrawArrays
(marshalEPrimitiveMode (_shadPrim ltShad)) (marshalEPrimitiveMode (_shadPrim ltextShad))
0 0
(fromIntegral (4::Int)) (fromIntegral (4 :: Int))
--cleanup: may not be necessary, depending on what comes after... --cleanup: may not be necessary, depending on what comes after...
cullFace $= Nothing cullFace $= Nothing
stencilTest $= Disabled stencilTest $= Disabled
-- assumes that vertices have already been sent to the shader -- assumes that vertices have already been sent to the shader
pingPongBetween pingPongBetween ::
:: (FramebufferObject,TextureObject) (FramebufferObject, TextureObject) ->
-> (FramebufferObject,TextureObject) (FramebufferObject, TextureObject) ->
-> FullShader FullShader ->
-> IO () IO ()
pingPongBetween (fb1,to1) (fb2,to2) fs = do pingPongBetween (fb1, to1) (fb2, to2) fs = do
bindFramebuffer Framebuffer $= fb2 bindFramebuffer Framebuffer $= fb2
textureBinding Texture2D $= Just to1 textureBinding Texture2D $= Just to1
drawShader fs 4 drawShader fs 4
@@ -132,21 +138,21 @@ pingPongBetween (fb1,to1) (fb2,to2) fs = do
textureBinding Texture2D $= Just to2 textureBinding Texture2D $= Just to2
drawShader fs 4 drawShader fs 4
renderFoldable renderFoldable ::
:: MV.MVector (PrimState IO) FullShader MV.MVector (PrimState IO) FullShader ->
-> Picture Picture ->
-> IO () IO ()
renderFoldable shadV struct = do renderFoldable shadV struct = do
counts <- UMV.replicate 6 0 counts <- UMV.replicate 6 0
pokeBindFoldable shadV counts struct pokeBindFoldable shadV counts struct
MV.imapM_ (drawShaderLay 0 counts) shadV MV.imapM_ (drawShaderLay 0 counts) shadV
------------------------------end renderFoldable ------------------------------end renderFoldable
renderLayer renderLayer ::
:: Layer Layer ->
-> MV.MVector (PrimState IO) FullShader MV.MVector (PrimState IO) FullShader ->
-> UMV.MVector (PrimState IO) Int UMV.MVector (PrimState IO) Int ->
-> IO () IO ()
renderLayer layer shads counts = do renderLayer layer shads counts = do
let layerCounts = UMV.slice (ln * numLayers) 6 counts let layerCounts = UMV.slice (ln * numLayers) 6 counts
MV.imapM_ (drawShaderLay ln layerCounts) shads MV.imapM_ (drawShaderLay ln layerCounts) shads
src/Shader/AuxAddition.hs
+7 -6
View File
@@ -8,9 +8,10 @@ module Shader.AuxAddition
) where ) where
import Shader.Data import Shader.Data
import qualified Data.Vector as V
import Data.List.Extra import Data.List.Extra
import Codec.Picture import Codec.Picture
import qualified Data.Vector.Storable as V import qualified Data.Vector.Storable as VS
import Control.Lens import Control.Lens
import Graphics.Rendering.OpenGL hiding (Point,translate,scale,imageHeight) import Graphics.Rendering.OpenGL hiding (Point,translate,scale,imageHeight)
import Graphics.GL.Core43 import Graphics.GL.Core43
@@ -26,7 +27,7 @@ addTexture texturePath shad = do
let wtex = fromIntegral $ imageWidth tex let wtex = fromIntegral $ imageWidth tex
htex = fromIntegral $ imageHeight tex htex = fromIntegral $ imageHeight tex
glTexStorage2D GL_TEXTURE_2D 3 GL_RGBA8 wtex htex glTexStorage2D GL_TEXTURE_2D 3 GL_RGBA8 wtex htex
V.unsafeWith (imageData tex) $ \ptr -> do VS.unsafeWith (imageData tex) $ \ptr -> do
glTexSubImage2D GL_TEXTURE_2D 0 0 0 wtex htex GL_RGBA GL_UNSIGNED_BYTE ptr glTexSubImage2D GL_TEXTURE_2D 0 0 0 wtex htex GL_RGBA GL_UNSIGNED_BYTE ptr
textureFilter Texture2DArray $= ((Linear',Just Linear') , Linear') textureFilter Texture2DArray $= ((Linear',Just Linear') , Linear')
generateMipmap' Texture2D generateMipmap' Texture2D
@@ -42,7 +43,7 @@ vaddTextureNoFilter texturePath shad = do
let wtex = fromIntegral $ imageWidth tex let wtex = fromIntegral $ imageWidth tex
htex = fromIntegral $ imageHeight tex htex = fromIntegral $ imageHeight tex
glTexStorage2D GL_TEXTURE_2D 1 GL_RGBA8 wtex htex glTexStorage2D GL_TEXTURE_2D 1 GL_RGBA8 wtex htex
V.unsafeWith (imageData tex) $ \ptr -> do VS.unsafeWith (imageData tex) $ \ptr -> do
glTexSubImage2D GL_TEXTURE_2D 0 0 0 wtex htex GL_RGBA GL_UNSIGNED_BYTE ptr glTexSubImage2D GL_TEXTURE_2D 0 0 0 wtex htex GL_RGBA GL_UNSIGNED_BYTE ptr
return $ shad & shadTex ?~ ShaderTexture {_textureObject = textureOb} return $ shad & shadTex ?~ ShaderTexture {_textureObject = textureOb}
@@ -56,7 +57,7 @@ addTextureNoFilter texturePath shad = do
let wtex = fromIntegral $ imageWidth tex let wtex = fromIntegral $ imageWidth tex
htex = fromIntegral $ imageHeight tex htex = fromIntegral $ imageHeight tex
glTexStorage2D GL_TEXTURE_2D 1 GL_RGBA8 wtex htex glTexStorage2D GL_TEXTURE_2D 1 GL_RGBA8 wtex htex
V.unsafeWith (imageData tex) $ \ptr -> do VS.unsafeWith (imageData tex) $ \ptr -> do
glTexSubImage2D GL_TEXTURE_2D 0 0 0 wtex htex GL_RGBA GL_UNSIGNED_BYTE ptr glTexSubImage2D GL_TEXTURE_2D 0 0 0 wtex htex GL_RGBA GL_UNSIGNED_BYTE ptr
return $ shad & shadTex ?~ ShaderTexture {_textureObject = textureOb} return $ shad & shadTex ?~ ShaderTexture {_textureObject = textureOb}
@@ -75,7 +76,7 @@ addTextureArray texturePath shad = do
glTexStorage3D GL_TEXTURE_2D_ARRAY 3 GL_RGBA8 32 32 64 glTexStorage3D GL_TEXTURE_2D_ARRAY 3 GL_RGBA8 32 32 64
--writePng "atest.png" ((Image 256 256 (V.fromList texData)) :: Image PixelRGBA8) --writePng "atest.png" ((Image 256 256 (V.fromList texData)) :: Image PixelRGBA8)
--withArray texData $ \ptr -> do --withArray texData $ \ptr -> do
V.unsafeWith (imageData tex) $ \ptr -> do VS.unsafeWith (imageData tex) $ \ptr -> do
--glTexSubImage3D GL_TEXTURE_2D_ARRAY 0 0 0 0 32 32 64 GL_RGBA GL_UNSIGNED_BYTE ptr --glTexSubImage3D GL_TEXTURE_2D_ARRAY 0 0 0 0 32 32 64 GL_RGBA GL_UNSIGNED_BYTE ptr
glTexSubImage3D GL_TEXTURE_2D_ARRAY 0 0 0 0 32 32 64 GL_RGBA GL_UNSIGNED_BYTE ptr glTexSubImage3D GL_TEXTURE_2D_ARRAY 0 0 0 0 32 32 64 GL_RGBA GL_UNSIGNED_BYTE ptr
textureFilter Texture2DArray $= ((Linear',Just Linear') , Linear') textureFilter Texture2DArray $= ((Linear',Just Linear') , Linear')
@@ -93,4 +94,4 @@ tilesToLine n w = concat . concat . transpose . chunksOf n . chunksOf w
addUniforms :: [String] -> FullShader -> IO FullShader addUniforms :: [String] -> FullShader -> IO FullShader
addUniforms uniStrings shad = do addUniforms uniStrings shad = do
uniLocs <- mapM (uniformLocation $ _shadProg shad) uniStrings uniLocs <- mapM (uniformLocation $ _shadProg shad) uniStrings
return $ shad & shadUnis %~ (++ uniLocs) return $ shad & shadUnis %~ (V.++ V.fromList uniLocs)
src/Shader/Compile.hs
+6 -6
View File
@@ -35,7 +35,7 @@ makeShader s shaderlist sizes pm = do
, _shadVAO = vaob , _shadVAO = vaob
, _shadPrim = pm , _shadPrim = pm
, _shadTex = Nothing , _shadTex = Nothing
, _shadUnis = [] , _shadUnis = mempty
} }
makeByteStringShader makeByteStringShader
:: String -- ^ (Arbitrary) name of the shader :: String -- ^ (Arbitrary) name of the shader
@@ -51,7 +51,7 @@ makeByteStringShader s shaderlist sizes pm = do
, _shadVAO = vaob , _shadVAO = vaob
, _shadPrim = pm , _shadPrim = pm
, _shadTex = Nothing , _shadTex = Nothing
, _shadUnis = [] , _shadUnis = mempty
} }
makeByteStringShaderUsingVAO makeByteStringShaderUsingVAO
:: String -- ^ (Arbitrary) name of the shader :: String -- ^ (Arbitrary) name of the shader
@@ -65,7 +65,7 @@ makeByteStringShaderUsingVAO s shaderlist pm fs = do
{ _shadProg = prog { _shadProg = prog
, _shadPrim = pm , _shadPrim = pm
, _shadTex = Nothing , _shadTex = Nothing
, _shadUnis = [] , _shadUnis = mempty
} }
-- | Takes the VAO from elsewhere -- | Takes the VAO from elsewhere
@@ -82,7 +82,7 @@ makeShaderUsingVAO s shaderlist pm theVAO = do
, _shadVAO = theVAO , _shadVAO = theVAO
, _shadPrim = pm , _shadPrim = pm
, _shadTex = Nothing , _shadTex = Nothing
, _shadUnis = [] , _shadUnis = mempty
} }
-- | Takes the VAO from another shader -- | Takes the VAO from another shader
@@ -98,7 +98,7 @@ makeShaderUsingShaderVAO s shaderlist pm fs = do
{ _shadProg = prog { _shadProg = prog
, _shadPrim = pm , _shadPrim = pm
, _shadTex = Nothing , _shadTex = Nothing
, _shadUnis = [] , _shadUnis = mempty
} }
{- | {- |
Compiles a full shader found within the shader directory. Compiles a full shader found within the shader directory.
@@ -119,7 +119,7 @@ makeShaderSized s shaderlist sizes ndraw pm = do
, _shadVAO = vaob , _shadVAO = vaob
, _shadPrim = pm , _shadPrim = pm
, _shadTex = Nothing , _shadTex = Nothing
, _shadUnis = [] , _shadUnis = mempty
} }
-- | Compile shader and get its uniform locations. -- | Compile shader and get its uniform locations.
src/Shader/Data.hs
+2 -1
View File
@@ -27,6 +27,7 @@ module Shader.Data
, geom , geom
, frag , frag
) where ) where
import Data.Vector (Vector)
import Graphics.Rendering.OpenGL import Graphics.Rendering.OpenGL
import Foreign import Foreign
import Control.Lens import Control.Lens
@@ -36,7 +37,7 @@ data FullShader = FullShader
, _shadVAO :: VAO , _shadVAO :: VAO
, _shadPrim :: EPrimitiveMode , _shadPrim :: EPrimitiveMode
, _shadTex :: Maybe ShaderTexture , _shadTex :: Maybe ShaderTexture
, _shadUnis :: [UniformLocation] , _shadUnis :: Vector UniformLocation
} }
{- | Vertex array object: contains the reference to the object, {- | Vertex array object: contains the reference to the object,
and its buffer targets. -} and its buffer targets. -}
src/Shader/Poke.hs
+1
View File
@@ -4,6 +4,7 @@ module Shader.Poke
, pokeArrayOff , pokeArrayOff
, pokeShape , pokeShape
, pokeWallsWindowsFloor , pokeWallsWindowsFloor
, memoTopPrismEdgeIndices
) where ) where
import Shader.Data import Shader.Data
import Shader.Parameters import Shader.Parameters
src/Shape/Data.hs
+2 -1
View File
@@ -18,7 +18,7 @@ shVfromList = id
{-# INLINE shEfromList #-} {-# INLINE shEfromList #-}
shEfromList = id shEfromList = id
newtype ShapeType = TopPrism Int newtype ShapeType = TopPrism { _prismSize :: Int }
deriving newtype (Eq, Ord, Show, Read) deriving newtype (Eq, Ord, Show, Read)
--deriving stock Generic --deriving stock Generic
--deriving anyclass Flat --deriving anyclass Flat
@@ -43,6 +43,7 @@ pairToSV = uncurry ShapeV
makeLenses ''ShapeV makeLenses ''ShapeV
makeLenses ''ShapeObj makeLenses ''ShapeObj
makeLenses ''ShapeType
--type Shape' = Stream (Of ShapeObj) IO () --type Shape' = Stream (Of ShapeObj) IO ()
type Shape = [ShapeObj] type Shape = [ShapeObj]