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

Add num_shadow_casters graphics parameter, allow cycle down enum options

Browse Source
This commit is contained in:
justin
2023-02-26 23:38:58 +00:00
parent bf1bd5bb0b
commit 6b0f78d4eb
9 changed files with 203 additions and 151 deletions
Download Patch File Download Diff File Expand all files Collapse all files
data/texture/charMap.png
BIN
View File
Binary file not shown.
Side by Side Swipe Overlay

Before

Width:  |  Height:  |  Size: 3.4 KiB

After

Width:  |  Height:  |  Size: 3.4 KiB

src/Dodge/Data/Config.hs
+28 -1
View File
@@ -10,6 +10,30 @@ import qualified Data.Set as S
{-# ANN module "HLint: ignore Use camelCase" #-} {-# ANN module "HLint: ignore Use camelCase" #-}
data NumShadowCasters
= NumShadowCasters0
| NumShadowCasters1
| NumShadowCasters2
| NumShadowCasters3
| NumShadowCasters4
| NumShadowCasters5
| NumShadowCasters6
| NumShadowCasters7
| NumShadowCasters8
| NumShadowCasters9
| NumShadowCasters10
| NumShadowCasters11
| NumShadowCasters12
| NumShadowCasters13
| NumShadowCasters14
| NumShadowCasters15
| NumShadowCasters16
| NumShadowCasters17
| NumShadowCasters18
| NumShadowCasters19
| NumShadowCasters20
deriving (Show,Eq,Bounded,Ord,Enum)
data Configuration = Configuration data Configuration = Configuration
{ _volume_master :: Float { _volume_master :: Float
, _volume_sound :: Float , _volume_sound :: Float
@@ -18,6 +42,7 @@ data Configuration = Configuration
, _graphics_cloud_shadows :: Bool , _graphics_cloud_shadows :: Bool
, _graphics_object_shadows :: ObjectShadows , _graphics_object_shadows :: ObjectShadows
, _graphics_resolution_factor :: ResFactor , _graphics_resolution_factor :: ResFactor
, _graphics_num_shadow_casters :: NumShadowCasters
, _windowX :: Float , _windowX :: Float
, _windowY :: Float , _windowY :: Float
, _windowPosX :: Int , _windowPosX :: Int
@@ -81,7 +106,8 @@ defaultConfig =
, _graphics_wall_textured = True , _graphics_wall_textured = True
, _graphics_cloud_shadows = True , _graphics_cloud_shadows = True
, _graphics_object_shadows = GeoObjShads , _graphics_object_shadows = GeoObjShads
, _graphics_resolution_factor = FullRes , _graphics_resolution_factor = QuarterRes
, _graphics_num_shadow_casters = toEnum 10
, _windowX = 800 , _windowX = 800
, _windowY = 600 , _windowY = 600
, _windowPosX = 0 , _windowPosX = 0
@@ -95,6 +121,7 @@ debugOn :: DebugBool -> Configuration -> Bool
debugOn db = S.member db . _debug_booleans debugOn db = S.member db . _debug_booleans
makeLenses ''Configuration makeLenses ''Configuration
deriveJSON defaultOptions ''NumShadowCasters
deriveJSON defaultOptions ''ResFactor deriveJSON defaultOptions ''ResFactor
deriveJSON defaultOptions ''ObjectShadows deriveJSON defaultOptions ''ObjectShadows
deriveJSON defaultOptions ''RoomClipping deriveJSON defaultOptions ''RoomClipping
src/Dodge/Menu.hs
+1
View File
@@ -186,6 +186,7 @@ graphicsMenuOptions =
, makeBoolOption graphics_wall_textured "WALL TEXTURES" , makeBoolOption graphics_wall_textured "WALL TEXTURES"
, makeEnumOption graphics_object_shadows "OBJECT SHADOWS" id , makeEnumOption graphics_object_shadows "OBJECT SHADOWS" id
, makeBoolOption graphics_cloud_shadows "CLOUD SHADOWS" , makeBoolOption graphics_cloud_shadows "CLOUD SHADOWS"
, makeEnumOption graphics_num_shadow_casters "SHADOW CASTERS" id
] ]
gameOverMenu :: Universe -> ScreenLayer gameOverMenu :: Universe -> ScreenLayer
src/Dodge/Menu/OptionType.hs
+7 -1
View File
@@ -11,8 +11,9 @@ makeBoolOption lns t =
(\u -> MODStringOption t (show (u ^# uvConfig . lns))) (\u -> MODStringOption t (show (u ^# uvConfig . lns)))
makeEnumOption lns str sideeff = makeEnumOption lns str sideeff =
Toggle Toggle2
(\u -> sideeff (u & uvConfig . lns #%~ cycleEnum)) (\u -> sideeff (u & uvConfig . lns #%~ cycleEnum))
(\u -> sideeff (u & uvConfig . lns #%~ cycleDownEnum))
(\u -> MODStringOption str (show (u ^# uvConfig . lns))) (\u -> MODStringOption str (show (u ^# uvConfig . lns)))
makeSubmenuOption submenu t = Toggle (pushScreen submenu) (const t) makeSubmenuOption submenu t = Toggle (pushScreen submenu) (const t)
@@ -21,3 +22,8 @@ cycleEnum :: (Eq a, Enum a, Bounded a) => a -> a
cycleEnum x cycleEnum x
| x == maxBound = minBound | x == maxBound = minBound
| otherwise = succ x | otherwise = succ x
cycleDownEnum :: (Eq a, Enum a, Bounded a) => a -> a
cycleDownEnum x
| x == minBound = maxBound
| otherwise = pred x
src/Dodge/Render.hs
+5 -5
View File
@@ -21,7 +21,7 @@ import Graphics.GL.Core43
import Graphics.Rendering.OpenGL hiding (color, rotate, scale, translate) import Graphics.Rendering.OpenGL hiding (color, rotate, scale, translate)
import MatrixHelper import MatrixHelper
import Render import Render
import qualified SDL --import qualified SDL
import Shader import Shader
import Shader.Bind import Shader.Bind
import Shader.Data import Shader.Data
@@ -29,9 +29,9 @@ import Shader.ExtraPrimitive
import Shader.Parameters import Shader.Parameters
import Shader.Poke import Shader.Poke
doDrawing :: RenderData -> Universe -> IO Word32 doDrawing :: RenderData -> Universe -> IO ()
doDrawing pdata u = do doDrawing pdata u = do
sTicks <- SDL.ticks -- sTicks <- SDL.ticks
let w = _uvWorld u let w = _uvWorld u
cfig = _uvConfig u cfig = _uvConfig u
rot = w ^. cWorld . camPos . camRot rot = w ^. cWorld . camPos . camRot
@@ -293,8 +293,8 @@ doDrawing pdata u = do
renderLayer FixedCoordLayer shadV layerCounts renderLayer FixedCoordLayer shadV layerCounts
renderFoldable shadV $ fixedCoordPictures u renderFoldable shadV $ fixedCoordPictures u
depthMask $= Enabled depthMask $= Enabled
eTicks <- SDL.ticks -- eTicks <- SDL.ticks
return (eTicks - sTicks) -- return (eTicks - sTicks)
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- note: currently assume there is only one UBO, we only bind it once at setup -- note: currently assume there is only one UBO, we only bind it once at setup
src/Dodge/Render/Lights.hs
+4 -1
View File
@@ -2,6 +2,7 @@ module Dodge.Render.Lights (
lightsToRender, lightsToRender,
) where ) where
import Data.List (sortOn)
import Data.Maybe import Data.Maybe
import Dodge.Data.LWorld import Dodge.Data.LWorld
import Dodge.Data.CamPos import Dodge.Data.CamPos
@@ -11,7 +12,9 @@ import qualified IntMapHelp as IM
import Control.Lens import Control.Lens
lightsToRender :: Configuration -> CamPos -> LWorld -> [(Point3, Float, Point3)] lightsToRender :: Configuration -> CamPos -> LWorld -> [(Point3, Float, Point3)]
lightsToRender cfig campos w = {-# INLINE lightsToRender #-}
lightsToRender cfig campos w = take (fromEnum $ cfig ^. graphics_num_shadow_casters) $
sortOn (\(_,x,_) -> negate x) $
mapMaybe getLS (IM.elems $ w ^. lightSources) mapMaybe getLS (IM.elems $ w ^. lightSources)
++ mapMaybe getTLS (w ^. tempLightSources) ++ mapMaybe getTLS (w ^. tempLightSources)
where where
src/Dodge/TestString.hs
+7 -1
View File
@@ -1,5 +1,7 @@
module Dodge.TestString where module Dodge.TestString where
import Dodge.Render.ShapePicture
import Dodge.Render.Lights
import Data.Aeson (ToJSON) import Data.Aeson (ToJSON)
import Data.ByteString.Lazy.Char8 (unpack) import Data.ByteString.Lazy.Char8 (unpack)
import qualified Data.Aeson.Encode.Pretty as AEP import qualified Data.Aeson.Encode.Pretty as AEP
@@ -10,7 +12,11 @@ import Dodge.Data.Universe
--import qualified Data.Map.Strict as M --import qualified Data.Map.Strict as M
--import qualified IntMapHelp as IM --import qualified IntMapHelp as IM
testStringInit :: Universe -> [String] testStringInit :: Universe -> [String]
testStringInit u = [show $ u ^? uvWorld . hud . hudElement . diSections . sssExtra . sssSelPos . _Just] testStringInit u = [show $ length $ lightsToRender (u ^. uvConfig) (u ^. uvWorld . cWorld . camPos)
(u ^. uvWorld . cWorld . lWorld)
, show $ length $ fst $ worldSPic (u ^. uvConfig) (u ^. uvWorld)
, show $ length $ snd $ worldSPic (u ^. uvConfig) (u ^. uvWorld) ]
--[show $ u ^? uvWorld . hud . hudElement . diSections . sssExtra . sssSelPos . _Just]
-- [show $ fmap IM.keys $ u ^? uvWorld . hud . hudElement . subInventory . ciSections . sssSections] -- [show $ fmap IM.keys $ u ^? uvWorld . hud . hudElement . subInventory . ciSections . sssSections]
getPretty :: ToJSON a => a -> [String] getPretty :: ToJSON a => a -> [String]
src/Preload/Render.hs
+148 -139
View File
@@ -1,23 +1,22 @@
--{-# LANGUAGE TemplateHaskell #-} --{-# LANGUAGE TemplateHaskell #-}
--{-# OPTIONS_GHC -Wno-unused-top-binds #-} --{-# OPTIONS_GHC -Wno-unused-top-binds #-}
module Preload.Render module Preload.Render (
( preloadRender preloadRender,
, cleanUpRenderPreload cleanUpRenderPreload,
) ) where
where
import Shader
import Shader.Data
import Shader.Compile
import Shader.AuxAddition
import Shader.Parameters
import Shader.Bind
import Framebuffer.Setup
import Data.Preload.Render
import Graphics.Rendering.OpenGL hiding (Point,translate,scale,imageHeight)
import Control.Monad import Control.Monad
import Foreign import Data.Preload.Render
import qualified Data.Vector.Mutable as MV import qualified Data.Vector.Mutable as MV
import Foreign
import Framebuffer.Setup
import Graphics.Rendering.OpenGL hiding (Point, imageHeight, scale, translate)
import Shader
import Shader.AuxAddition
import Shader.Bind
import Shader.Compile
import Shader.Data
import Shader.Parameters
numDrawableWalls :: Int numDrawableWalls :: Int
numDrawableWalls = 5000 numDrawableWalls = 5000
@@ -33,12 +32,12 @@ preloadRender = do
wpVBOname <- genObjectName wpVBOname <- genObjectName
wpVBOptr <- mallocArray (8 * numDrawableWalls) wpVBOptr <- mallocArray (8 * numDrawableWalls)
bindBuffer ArrayBuffer $= Just wpVBOname bindBuffer ArrayBuffer $= Just wpVBOname
bufferData ArrayBuffer $= bufferData ArrayBuffer
(fromIntegral $ floatSize * numDrawableWalls * 8 $= ( fromIntegral $ floatSize * numDrawableWalls * 8
, nullPtr , nullPtr
, StreamDraw , StreamDraw
) )
let wpVBO = VBO {_vbo = wpVBOname, _vboPtr = wpVBOptr, _vboAttribSizes = [4,4], _vboStride = 8} let wpVBO = VBO{_vbo = wpVBOname, _vboPtr = wpVBOptr, _vboAttribSizes = [4, 4], _vboStride = 8}
wpVAOname <- genObjectName wpVAOname <- genObjectName
bindVertexArrayObject $= Just wpVAOname bindVertexArrayObject $= Just wpVAOname
bindBuffer ArrayBuffer $= Just wpVBOname bindBuffer ArrayBuffer $= Just wpVBOname
@@ -47,42 +46,42 @@ preloadRender = do
bindVertexArrayObject $= Just wpColVAOname bindVertexArrayObject $= Just wpColVAOname
setupVertexAttribPointer 0 4 8 0 setupVertexAttribPointer 0 4 8 0
setupVertexAttribPointer 1 4 8 4 setupVertexAttribPointer 1 4 8 4
let wpVAO = VAO {_vao = wpVAOname, _vaoVBO = wpVBO} let wpVAO = VAO{_vao = wpVAOname, _vaoVBO = wpVBO}
wpColVAO = VAO {_vao = wpColVAOname, _vaoVBO = wpVBO} wpColVAO = VAO{_vao = wpColVAOname, _vaoVBO = wpVBO}
-- setup window points VBO, VAOs and shaders -- setup window points VBO, VAOs and shaders
winVBOname <- genObjectName winVBOname <- genObjectName
winVBOptr <- mallocArray (8 * numDrawableWalls) winVBOptr <- mallocArray (8 * numDrawableWalls)
bindBuffer ArrayBuffer $= Just winVBOname bindBuffer ArrayBuffer $= Just winVBOname
bufferData ArrayBuffer $= bufferData ArrayBuffer
(fromIntegral $ floatSize * numDrawableWalls * 8 $= ( fromIntegral $ floatSize * numDrawableWalls * 8
, nullPtr , nullPtr
, StreamDraw , StreamDraw
) )
let winVBO = VBO {_vbo = winVBOname, _vboPtr = winVBOptr, _vboAttribSizes = [4,4], _vboStride = 8} let winVBO = VBO{_vbo = winVBOname, _vboPtr = winVBOptr, _vboAttribSizes = [4, 4], _vboStride = 8}
winColVAOname <- genObjectName winColVAOname <- genObjectName
bindVertexArrayObject $= Just winColVAOname bindVertexArrayObject $= Just winColVAOname
setupVertexAttribPointer 0 4 8 0 setupVertexAttribPointer 0 4 8 0
setupVertexAttribPointer 1 4 8 4 setupVertexAttribPointer 1 4 8 4
let winColVAO = VAO {_vao = winColVAOname, _vaoVBO = winVBO} let winColVAO = VAO{_vao = winColVAOname, _vaoVBO = winVBO}
-- setup shape geometry/cap VBO and two VAOs -- setup shape geometry/cap VBO and two VAOs
shEBOname <- genObjectName shEBOname <- genObjectName
shEBOptr <- mallocArray numDrawableElements shEBOptr <- mallocArray numDrawableElements
bindBuffer ElementArrayBuffer $= Just shEBOname bindBuffer ElementArrayBuffer $= Just shEBOname
bufferData ElementArrayBuffer $= bufferData ElementArrayBuffer
( fromIntegral $ glushortSize * numDrawableElements $= ( fromIntegral $ glushortSize * numDrawableElements
, nullPtr , nullPtr
, StreamDraw , StreamDraw
) )
let shEBO = EBO {_ebo = shEBOname, _eboPtr = shEBOptr} let shEBO = EBO{_ebo = shEBOname, _eboPtr = shEBOptr}
shVBOname <- genObjectName shVBOname <- genObjectName
shVBOptr <- mallocArray (7 * numDrawableElements) shVBOptr <- mallocArray (7 * numDrawableElements)
bindBuffer ArrayBuffer $= Just shVBOname bindBuffer ArrayBuffer $= Just shVBOname
bufferData ArrayBuffer $= bufferData ArrayBuffer
( fromIntegral $ floatSize * numDrawableElements * 7 $= ( fromIntegral $ floatSize * numDrawableElements * 7
, nullPtr , nullPtr
, StreamDraw , StreamDraw
) )
let shVBO = VBO {_vbo = shVBOname, _vboPtr = shVBOptr, _vboAttribSizes = [4,4], _vboStride = 8} let shVBO = VBO{_vbo = shVBOname, _vboPtr = shVBOptr, _vboAttribSizes = [4, 4], _vboStride = 8}
shPosColVAOname <- genObjectName shPosColVAOname <- genObjectName
bindVertexArrayObject $= Just shPosColVAOname bindVertexArrayObject $= Just shPosColVAOname
bindBuffer ArrayBuffer $= Just shVBOname bindBuffer ArrayBuffer $= Just shVBOname
@@ -94,8 +93,8 @@ preloadRender = do
bindBuffer ArrayBuffer $= Just shVBOname bindBuffer ArrayBuffer $= Just shVBOname
setupVertexAttribPointer 0 3 7 0 setupVertexAttribPointer 0 3 7 0
bindBuffer ElementArrayBuffer $= Just shEBOname bindBuffer ElementArrayBuffer $= Just shEBOname
let shPosColVAO = VAO { _vao = shPosColVAOname, _vaoVBO = shVBO } let shPosColVAO = VAO{_vao = shPosColVAOname, _vaoVBO = shVBO}
shPosVAO = VAO { _vao = shPosVAOname, _vaoVBO = shVBO } shPosVAO = VAO{_vao = shPosVAOname, _vaoVBO = shVBO}
--setup silhouette edge VAO --setup silhouette edge VAO
shEdgeVAOname <- genObjectName shEdgeVAOname <- genObjectName
bindVertexArrayObject $= Just shEdgeVAOname bindVertexArrayObject $= Just shEdgeVAOname
@@ -106,59 +105,64 @@ preloadRender = do
silEBOptr <- mallocArray numDrawableElements silEBOptr <- mallocArray numDrawableElements
-- it may be important to bind this while the correct VAO is bound -- it may be important to bind this while the correct VAO is bound
bindBuffer ElementArrayBuffer $= Just silEBOname bindBuffer ElementArrayBuffer $= Just silEBOname
bufferData ElementArrayBuffer $= bufferData ElementArrayBuffer
( fromIntegral $ glushortSize * numDrawableElements $= ( fromIntegral $ glushortSize * numDrawableElements
, nullPtr , nullPtr
, StreamDraw , StreamDraw
) )
let silEBO = EBO {_ebo = silEBOname, _eboPtr = silEBOptr} let silEBO = EBO{_ebo = silEBOname, _eboPtr = silEBOptr}
shEdgeVAO = VAO { _vao = shEdgeVAOname, _vaoVBO = shVBO } shEdgeVAO = VAO{_vao = shEdgeVAOname, _vaoVBO = shVBO}
-- lighting shaders -- lighting shaders
lightingWallShadShad <- makeShaderUsingVAO "lighting/wallShadow" [vert,geom,frag] EPoints wpVAO lightingWallShadShad <-
>>= addUniforms ["lightPos"] makeShaderUsingVAO "lighting/wallShadow" [vert, geom, frag] EPoints wpVAO
lightingCapShad >>= addUniforms ["lightPos"]
<- makeShaderUsingVAO "lighting/cap" [vert,geom,frag] ETriangles shPosVAO lightingCapShad <-
>>= addUniforms ["lightPos"] makeShaderUsingVAO "lighting/cap" [vert, geom, frag] ETriangles shPosVAO
lightingLineShadowShad >>= addUniforms ["lightPos"]
<- makeShaderUsingVAO "lighting/lineShadow" [vert,geom,frag] ELinesAdjacency shEdgeVAO lightingLineShadowShad <-
>>= addUniforms ["lightPos","radiusUniform"] makeShaderUsingVAO "lighting/lineShadow" [vert, geom, frag] ELinesAdjacency shEdgeVAO
-- positional shader >>= addUniforms ["lightPos", "radiusUniform"]
positionalBlankShad <- makeShader "positional/blank" [vert,frag] [3] ETriangles -- positional shader
-- 2D draw shaders positionalBlankShad <- makeShader "positional/blank" [vert, frag] [3] ETriangles
bslist <- makeShader "dualTwoD/basic" [vert,frag] [3,4] ETriangles -- 2D draw shaders
bslista <- makeShader "dualTwoD/basic" [vert,frag] [3,4] ETriangles bslist <- makeShader "dualTwoD/basic" [vert, frag] [3, 4] ETriangles
aslist <- makeShader "dualTwoD/arc" [vert,frag] [3,4,3] ETriangles bslista <- makeShader "dualTwoD/basic" [vert, frag] [3, 4] ETriangles
eslist <- makeShader "dualTwoD/ellipse" [vert,geom,frag] [3,4] ETriangles aslist <- makeShader "dualTwoD/arc" [vert, frag] [3, 4, 3] ETriangles
bezierQuadShader <- makeShader "dualTwoD/bezierQuad" [vert,frag] [3,4,4] ETriangleStrip eslist <- makeShader "dualTwoD/ellipse" [vert, geom, frag] [3, 4] ETriangles
cslist <- makeShader "dualTwoD/character" [vert,frag] [3,4,2] ETriangles bezierQuadShader <- makeShader "dualTwoD/bezierQuad" [vert, frag] [3, 4, 4] ETriangleStrip
>>= vaddTextureNoFilter "data/texture/charMap.png" cslist <-
-- this should really be a 2d texture array makeShader "dualTwoD/character" [vert, frag] [3, 4, 2] ETriangles
basicTweakZShad <- makeShader "dualTwoD/basicTweakZ" [vert,frag] [4,4] ETriangles >>= vaddTextureNoFilter "data/texture/charMap.png"
-- fullscreen shaders -- this should really be a 2d texture array
basicTweakZShad <- makeShader "dualTwoD/basicTweakZ" [vert, frag] [4, 4] ETriangles
-- fullscreen shaders
--fullscreenAlphaHalveShad <- makeShaderSized "fullscreen/alphaHalve" [vert,frag] [2] 4 ETriangleStrip --fullscreenAlphaHalveShad <- makeShaderSized "fullscreen/alphaHalve" [vert,frag] [2] 4 ETriangleStrip
--pokeArray (shadVBOptr fullscreenAlphaHalveShad) $ concat cornerListNoCoord --pokeArray (shadVBOptr fullscreenAlphaHalveShad) $ concat cornerListNoCoord
-- texture shaders, no textures attached -- texture shaders, no textures attached
fsShad <- makeShaderSized "texture/simple" [vert,frag] [2,2] 4 ETriangleStrip fsShad <- makeShaderSized "texture/simple" [vert, frag] [2, 2] 4 ETriangleStrip
-- note we directly poke the shader vertex data here -- note we directly poke the shader vertex data here
pokeArray (shadVBOptr fsShad) $ concat cornerList pokeArray (shadVBOptr fsShad) $ concat cornerList
bloomBlurShad <- makeShaderUsingShaderVAO "texture/bloomBlur" [vert,frag] ETriangleStrip fsShad bloomBlurShad <- makeShaderUsingShaderVAO "texture/bloomBlur" [vert, frag] ETriangleStrip fsShad
colorBlurShad <- makeShaderUsingShaderVAO "texture/colorBlur" [vert,frag] ETriangleStrip fsShad colorBlurShad <- makeShaderUsingShaderVAO "texture/colorBlur" [vert, frag] ETriangleStrip fsShad
grayscaleShad <- makeShaderUsingShaderVAO "texture/grayscale" [vert,frag] ETriangleStrip fsShad grayscaleShad <- makeShaderUsingShaderVAO "texture/grayscale" [vert, frag] ETriangleStrip fsShad
lightingTextureShad <- makeShaderUsingShaderVAO "lighting/texture" [vert,frag] ETriangleStrip fsShad lightingTextureShad <-
>>= addUniforms ["lightPos","lumRad"] makeShaderUsingShaderVAO "lighting/texture" [vert, frag] ETriangleStrip fsShad
barrelShad <- makeShader "texture/barrel" [vert,geom,frag] [2,2,2,1] EPoints >>= addUniforms ["lightPos", "lumRad"]
-- blank wallShader barrelShad <- makeShader "texture/barrel" [vert, geom, frag] [2, 2, 2, 1] EPoints
wallBlankShad <- makeShaderUsingVAO "wall/blank" [vert,geom,frag] EPoints wpColVAO -- blank wallShader
-- textured wallShader wallBlankShad <- makeShaderUsingVAO "wall/blank" [vert, geom, frag] EPoints wpColVAO
wallTextureShad <- makeShaderUsingVAO "wall/texture" [vert,geom,frag] EPoints wpColVAO -- textured wallShader
>>= addTexture "data/texture/grayscaleDirt.png" wallTextureShad <-
---- texture array shader makeShaderUsingVAO "wall/texture" [vert, geom, frag] EPoints wpColVAO
textArrayShad <- makeShader "texture/arrayPos" [vert,frag] [3,3] ETriangles >>= addTexture "data/texture/grayscaleDirt.png"
>>= addTextureArray "data/texture/ayene_wooden_floor_transformed.png" ---- texture array shader
-- >>= addTextureArray "data/texture/ayene_wooden_floor.png" textArrayShad <-
makeShader "texture/arrayPos" [vert, frag] [3, 3] ETriangles
>>= addTextureArray "data/texture/ayene_wooden_floor_transformed.png"
-- >>= addTextureArray "data/texture/ayene_wooden_floor.png"
-- bind fixed vertex data -- bind fixed vertex data
bindShaderBuffers [fsShad] [4,4] bindShaderBuffers [fsShad] [4, 4]
framebuf2 <- setupTextureFramebuffer 800 600 framebuf2 <- setupTextureFramebuffer 800 600
framebuf3 <- setupTextureFramebuffer 800 600 framebuf3 <- setupTextureFramebuffer 800 600
@@ -166,11 +170,11 @@ preloadRender = do
bindRenderbuffer Renderbuffer $= rboBaseBloomName bindRenderbuffer Renderbuffer $= rboBaseBloomName
renderbufferStorage Renderbuffer Depth24Stencil8 (RenderbufferSize 800 600) renderbufferStorage Renderbuffer Depth24Stencil8 (RenderbufferSize 800 600)
fboBaseName <- setupFramebuffer2GivenStencil rboBaseBloomName fboBaseName <- setupFramebuffer2GivenStencil rboBaseBloomName
fboCloudName <- setupFramebuffer2GivenStencil rboBaseBloomName fboCloudName <- setupFramebuffer2GivenStencil rboBaseBloomName
fboBloomName <- setupFramebufferGivenStencil rboBaseBloomName fboBloomName <- setupFramebufferGivenStencil rboBaseBloomName
fboColorName <- setupFramebufferGivenStencil rboBaseBloomName fboColorName <- setupFramebufferGivenStencil rboBaseBloomName
fboPosName <- setupFramebufferGivenStencil rboBaseBloomName fboPosName <- setupFramebufferGivenStencil rboBaseBloomName
fboLightingName <- setupFramebufferGivenStencil rboBaseBloomName fboLightingName <- setupFramebufferGivenStencil rboBaseBloomName
fboLightingHighName <- setupFramebufferGivenStencil rboBaseBloomName fboLightingHighName <- setupFramebufferGivenStencil rboBaseBloomName
@@ -178,64 +182,69 @@ preloadRender = do
fboHalf2Name <- setupTextureFramebuffer 300 300 fboHalf2Name <- setupTextureFramebuffer 300 300
fboHalf3Name <- setupTextureFramebuffer 300 300 fboHalf3Name <- setupTextureFramebuffer 300 300
-- reset to default framebuffer, ready for drawing direct to screen -- reset to default framebuffer, ready for drawing direct to screen
bindFramebuffer Framebuffer $= defaultFramebufferObject bindFramebuffer Framebuffer $= defaultFramebufferObject
-- set the clearColor to have 1 alpha -- set the clearColor to have 1 alpha
clearColor $= Color4 0 0 0 1 clearColor $= Color4 0 0 0 1
shadV <- MV.new 6 shadV <- MV.new 6
zipWithM_ (MV.write shadV) [0..5] zipWithM_
[ bslist -- note the ordering is very important (MV.write shadV)
, basicTweakZShad -- ShadNum [0 .. 5]
[ bslist -- note the ordering is very important
, basicTweakZShad -- ShadNum
, bezierQuadShader , bezierQuadShader
, cslist , cslist
, aslist , aslist
, eslist , eslist
] ]
return $ RenderData return $
{ _pictureShaders = shadV RenderData
, _shapeShader = bslista {_shadVAO = shPosColVAO } { _pictureShaders = shadV
, _shapeEBO = shEBO , _shapeShader = bslista{_shadVAO = shPosColVAO}
, _silhouetteEBO = silEBO , _shapeEBO = shEBO
, _lightingCapShader = lightingCapShad , _silhouetteEBO = silEBO
, _lightingLineShadowShader = lightingLineShadowShad , _lightingCapShader = lightingCapShad
, _positionalBlankShader = positionalBlankShad , _lightingLineShadowShader = lightingLineShadowShad
, _lightingWallShadShader = lightingWallShadShad , _positionalBlankShader = positionalBlankShad
, _wallBlankShader = wallBlankShad , _lightingWallShadShader = lightingWallShadShad
, _wallTextureShader = wallTextureShad , _wallBlankShader = wallBlankShad
, _windowShader = wallBlankShad { _shadVAO = winColVAO } , _wallTextureShader = wallTextureShad
, _textureArrayShader = textArrayShad , _windowShader = wallBlankShad{_shadVAO = winColVAO}
, _fullscreenShader = fsShad , _textureArrayShader = textArrayShad
, _lightingTextureShader = lightingTextureShad , _fullscreenShader = fsShad
, _bloomBlurShader = bloomBlurShad , _lightingTextureShader = lightingTextureShad
, _colorBlurShader = colorBlurShad , _bloomBlurShader = bloomBlurShad
, _barrelShader = barrelShad , _colorBlurShader = colorBlurShad
, _grayscaleShader = grayscaleShad , _barrelShader = barrelShad
, _fbo2 = framebuf2 , _grayscaleShader = grayscaleShad
, _fbo3 = framebuf3 , _fbo2 = framebuf2
, _fboHalf1 = fboHalf1Name , _fbo3 = framebuf3
, _fboHalf2 = fboHalf2Name , _fboHalf1 = fboHalf1Name
, _fboHalf3 = fboHalf3Name , _fboHalf2 = fboHalf2Name
, _fboLighting = fboLightingName , _fboHalf3 = fboHalf3Name
, _fboLightingHigh = fboLightingHighName , _fboLighting = fboLightingName
, _fboBase = fboBaseName , _fboLightingHigh = fboLightingHighName
, _fboCloud = fboCloudName , _fboBase = fboBaseName
, _fboBloom = fboBloomName , _fboCloud = fboCloudName
, _fboColor = fboColorName , _fboBloom = fboBloomName
, _fboPos = fboPosName , _fboColor = fboColorName
, _rboBaseBloom = rboBaseBloomName , _fboPos = fboPosName
, _matUBO = theUBO , _rboBaseBloom = rboBaseBloomName
} , _matUBO = theUBO
}
--------------------end preloadRender --------------------end preloadRender
cornerList :: [[Float]] cornerList :: [[Float]]
cornerList = cornerList =
[[-1, 1,0,1] [ [-1, 1, 0, 1]
,[-1,-1,0,0] , [-1, -1, 0, 0]
,[ 1, 1,1,1] , [1, 1, 1, 1]
,[ 1,-1,1,0] , [1, -1, 1, 0]
] ]
cleanUpRenderPreload :: RenderData -> IO () cleanUpRenderPreload :: RenderData -> IO ()
cleanUpRenderPreload pd = do cleanUpRenderPreload pd = do
-- TODO fix this -- TODO fix this
src/Render.hs
+3 -3
View File
@@ -63,14 +63,14 @@ createLightMap pdata lightPoints nWalls nSils nCaps drawObjShads toPos drawCPUSh
-- 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
stencilOpSeparate Front $= (OpKeep, OpKeep, OpIncrWrap)
stencilOpSeparate Back $= (OpKeep, OpKeep, OpDecrWrap)
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 Back $= (OpKeep, OpKeep, OpDecrWrap)
stencilFunc $= (Always, 0, 255) stencilFunc $= (Always, 0, 255)
--draw wall shadows --draw wall shadows
currentProgram $= Just (_shadProg lwallShad) currentProgram $= Just (_shadProg lwallShad)
@@ -110,7 +110,7 @@ createLightMap pdata lightPoints nWalls nSils nCaps drawObjShads toPos drawCPUSh
-- 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 $= ltextShad ^? shadProg --Just (_shadProg ltextShad) currentProgram $= ltextShad ^? shadProg --Just (_shadProg ltextShad)
uniform (_shadUnis ltextShad V.! 0) $= Vector3 x y z uniform (_shadUnis ltextShad V.! 0) $= Vector3 x y z