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

Cleanup, start to add creature silhouettes

Browse Source
This commit is contained in:
justin
2021-09-02 11:06:04 +01:00
parent 02193add68
commit 9d2f42dbc9
16 changed files with 142 additions and 94 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Data/Preload/Render.hs
+3 -2
View File
@@ -31,8 +31,9 @@ data RenderData = RenderData
, _pictureShaders :: MV.MVector (PrimState IO) FullShader , _pictureShaders :: MV.MVector (PrimState IO) FullShader
, _fbo2 :: (FramebufferObject, TextureObject) , _fbo2 :: (FramebufferObject, TextureObject)
, _fbo3 :: (FramebufferObject, TextureObject) , _fbo3 :: (FramebufferObject, TextureObject)
, _fboFourth1 :: (FramebufferObject, TextureObject) , _fboHalf1 :: (FramebufferObject, TextureObject)
, _fboFourth2 :: (FramebufferObject, TextureObject) , _fboHalf2 :: (FramebufferObject, TextureObject)
, _fboHalf3 :: (FramebufferObject, TextureObject)
, _fboBase :: (FramebufferObject, (TextureObject, TextureObject)) , _fboBase :: (FramebufferObject, (TextureObject, TextureObject))
, _fboCloud :: (FramebufferObject, (TextureObject, TextureObject)) , _fboCloud :: (FramebufferObject, (TextureObject, TextureObject))
, _fboBloom :: (FramebufferObject, TextureObject) , _fboBloom :: (FramebufferObject, TextureObject)
src/Dodge/Creature.hs
+2
View File
@@ -26,6 +26,7 @@ import Dodge.Creature.SpreadGunCrit
import Dodge.Creature.AutoCrit import Dodge.Creature.AutoCrit
import Dodge.Creature.ChaseCrit import Dodge.Creature.ChaseCrit
import Dodge.Creature.ArmourChase import Dodge.Creature.ArmourChase
import Dodge.Creature.Silhouette
import Dodge.Data import Dodge.Data
import Dodge.Default import Dodge.Default
import Dodge.Item.Weapon import Dodge.Item.Weapon
@@ -146,6 +147,7 @@ startCr = defaultCreature
, _crMvDir = pi/2 , _crMvDir = pi/2
, _crID = 0 , _crID = 0
, _crPict = basicCrPict black , _crPict = basicCrPict black
, _crSilhouette = basicCrSilhouette
, _crUpdate = stateUpdate yourControl , _crUpdate = stateUpdate yourControl
, _crRad = 10 , _crRad = 10
, _crMass = 10 , _crMass = 10
src/Dodge/Creature/ShadowBox.hs
+4 -4
View File
@@ -6,9 +6,9 @@ import Geometry
import qualified Data.IntMap as IM import qualified Data.IntMap as IM
crToBox :: Creature -> [[Point3]] crToBox :: Creature -> [[Point3]]
crToBox cr = map (map f . polyToTris) $ boxXYZ 10 10 15 crToBox cr = map (map f . polyToTris) $ boxXYZ 8 8 15
where where
f = (+ V3 (x-5) (y-5) 1) f = (+ V3 (x-4) (y-4) 1)
V2 x y = _crPos cr V2 x y = _crPos cr
youBox' :: World -> [[Point3]] youBox' :: World -> [[Point3]]
youBox' w = crToBox' $ _creatures w IM.! 0 youBox' w = crToBox' $ _creatures w IM.! 0
@@ -17,9 +17,9 @@ youBox :: World -> [Point3]
youBox = concat . youBox' youBox = concat . youBox'
crToBox' :: Creature -> [[Point3]] crToBox' :: Creature -> [[Point3]]
crToBox' cr = map (map f . polyToTris) $ boxXYZ 20 20 15 crToBox' cr = map (map f . polyToTris) $ boxXYZ 12 12 15
where where
f = (+ V3 (x-10) (y-10) 1) f = (+ V3 (x-6) (y-6) 0)
V2 x y = _crPos cr V2 x y = _crPos cr
youSil :: World -> [Point3] youSil :: World -> [Point3]
src/Dodge/Creature/Silhouette.hs
+26
View File
@@ -0,0 +1,26 @@
module Dodge.Creature.Silhouette
( creatureSilhouettes
, basicCrSilhouette
)
where
import Dodge.Data
import Polyhedra
import Geometry
import qualified Data.IntMap as IM
creatureSilhouettes :: World -> [Point3]
creatureSilhouettes w = concatMap f . IM.elems $ _creatures w
where
f cr = _crSilhouette cr cr
crBox :: [Point3]
crBox = constructEdgesList . map (map f . polyToTris) $ boxXYZ 12 12 15
where
f = (+ V3 (-6) (-6) 0)
basicCrSilhouette :: Creature -> [Point3]
basicCrSilhouette cr = map theTrans crBox
where
theTrans = (+ V3 x y 0)
V2 x y = _crPos cr
src/Dodge/Data.hs
+1
View File
@@ -161,6 +161,7 @@ data Creature = Creature
, _crMvDir :: Float , _crMvDir :: Float
, _crID :: Int , _crID :: Int
, _crPict :: Creature -> World -> Picture , _crPict :: Creature -> World -> Picture
, _crSilhouette :: Creature -> [Point3]
, _crUpdate , _crUpdate
:: Creature :: Creature
-> World -> World
src/Dodge/Default.hs
+1
View File
@@ -31,6 +31,7 @@ defaultCreature = Creature
, _crMvDir = 0 , _crMvDir = 0
, _crID = 1 , _crID = 1
, _crPict = \_ _ -> setLayer 0 $ onLayer CrLayer $ circleSolid 10 , _crPict = \_ _ -> setLayer 0 $ onLayer CrLayer $ circleSolid 10
, _crSilhouette = const []
, _crUpdate = \cr _ -> (Endo id , Just cr) , _crUpdate = \cr _ -> (Endo id , Just cr)
, _crRad = 10 , _crRad = 10
, _crMass = 10 , _crMass = 10
src/Dodge/Render.hs
+22 -10
View File
@@ -8,7 +8,8 @@ import Dodge.Data
import Dodge.Config.Data import Dodge.Config.Data
import Dodge.Base.Window import Dodge.Base.Window
import Dodge.Render.Picture import Dodge.Render.Picture
--import Dodge.Creature.ShadowBox import Dodge.Creature.ShadowBox
import Dodge.Creature.Silhouette
import Geometry import Geometry
import Render import Render
import Data.Preload.Render import Data.Preload.Render
@@ -55,7 +56,8 @@ doDrawing pdata w = do
nWalls <- poke224s (shadVBOptr $ _wallTextureShader pdata) wallPointsCol nWalls <- poke224s (shadVBOptr $ _wallTextureShader pdata) wallPointsCol
nSils <- pokePoint3s (shadVBOptr $ _lightingLineShadowShader pdata) nSils <- pokePoint3s (shadVBOptr $ _lightingLineShadowShader pdata)
$ $
--youSil w ++ --youSil w ++
creatureSilhouettes w ++
_foregroundEdgeVerx w _foregroundEdgeVerx w
-- poke foreground geometry for caps -- poke foreground geometry for caps
nCaps <- pokePoint3s (shadVBOptr $ _lightingCapShader pdata) nCaps <- pokePoint3s (shadVBOptr $ _lightingCapShader pdata)
@@ -75,9 +77,8 @@ doDrawing pdata w = 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 (_shaderProgram $ _lightingOccludeShader pdata) currentProgram $= Just (_shadProg $ _lightingOccludeShader pdata)
uniform (head $ _shaderCustomUnis $ _lightingOccludeShader pdata) uniform (head $ _shadUnis $ _lightingOccludeShader pdata) $= viewFrom3d
$= viewFrom3d
drawShader (_lightingOccludeShader pdata) nWalls drawShader (_lightingOccludeShader pdata) nWalls
--draw walls onto base buffer --draw walls onto base buffer
if w ^. config . wall_textured if w ^. config . wall_textured
@@ -118,12 +119,12 @@ doDrawing pdata w = do
--setup downscale viewport for blurring bloom --setup downscale viewport for blurring bloom
viewport $= (Position 0 0 viewport $= (Position 0 0
, divideSize (2 * (w ^. config . shadow_resolution)) $ Size (round $ fstV2 wins) (round $ sndV2 wins)) , divideSize (2 * (w ^. config . shadow_resolution)) $ Size (round $ fstV2 wins) (round $ sndV2 wins))
bindFramebuffer Framebuffer $= fst (_fboFourth1 pdata) bindFramebuffer Framebuffer $= fst (_fboHalf1 pdata)
depthFunc $= Just Always depthFunc $= Just Always
textureBinding Texture2D $= Just (snd $ _fboBloom pdata) textureBinding Texture2D $= Just (snd $ _fboBloom pdata)
blend $= Disabled blend $= Disabled
drawShader (_bloomBlurShader pdata) 4 drawShader (_bloomBlurShader pdata) 4
replicateM_ 5 $ pingPongBetween (_fboFourth1 pdata) (_fboFourth2 pdata) (_bloomBlurShader pdata) replicateM_ 5 $ pingPongBetween (_fboHalf1 pdata) (_fboHalf2 pdata) (_bloomBlurShader pdata)
blend $= Enabled blend $= Enabled
viewport $= (Position 0 0 viewport $= (Position 0 0
, divideSize (w ^. config . shadow_resolution) $ Size (round $ fstV2 wins) (round $ sndV2 wins)) , divideSize (w ^. config . shadow_resolution) $ Size (round $ fstV2 wins) (round $ sndV2 wins))
@@ -144,11 +145,21 @@ doDrawing pdata w = do
drawBuffers $= [NoBuffers,FBOColorAttachment 1] drawBuffers $= [NoBuffers,FBOColorAttachment 1]
renderLayer 2 shadV layerCounts renderLayer 2 shadV layerCounts
renderWindows pdata windowPoints renderWindows pdata windowPoints
-- --downscale transparency depths
-- viewport $= (Position 0 0
-- , divideSize (2 * (w ^. config . shadow_resolution)) $ Size (round $ fstV2 wins) (round $ sndV2 wins))
-- bindFramebuffer Framebuffer $= fst (_fboHalf3 pdata)
-- bindTO (snd $ snd $ _fboCloud pdata)
-- depthFunc $= Just Always
-- drawShader (_fullscreenShader pdata) 4
-- viewport $= (Position 0 0
-- , divideSize (w ^. config . shadow_resolution) $ Size (round $ fstV2 wins) (round $ sndV2 wins))
----draw lightmap for cloud buffer
depthMask $= Disabled depthMask $= Disabled
blend $= Enabled blend $= Enabled
----draw lightmap for cloud buffer
bindFramebuffer Framebuffer $= fst (_fboLighting pdata) bindFramebuffer Framebuffer $= fst (_fboLighting pdata)
createLightMap pdata lightPoints nWalls nSils nCaps (snd $ snd $ _fboCloud pdata) createLightMap pdata lightPoints nWalls nSils nCaps (snd $ snd $ _fboCloud pdata)
-- createLightMap pdata lightPoints nWalls nSils nCaps (snd $ _fboHalf3 pdata)
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
@@ -167,7 +178,7 @@ doDrawing pdata w = do
bindFramebuffer Framebuffer $= fst (_fboBase pdata) bindFramebuffer Framebuffer $= fst (_fboBase pdata)
blend $= Enabled blend $= Enabled
blendFunc $= (SrcAlpha, One) blendFunc $= (SrcAlpha, One)
textureBinding Texture2D $= Just (snd $ _fboFourth1 pdata) textureBinding Texture2D $= Just (snd $ _fboHalf1 pdata)
drawShader (_fullscreenShader pdata) 4 drawShader (_fullscreenShader pdata) 4
blendFunc $= (SrcAlpha, OneMinusSrcAlpha) blendFunc $= (SrcAlpha, OneMinusSrcAlpha)
--draw shadowed clouds onto base buffer --draw shadowed clouds onto base buffer
@@ -233,7 +244,7 @@ renderWindows
renderWindows pdata wps = do renderWindows pdata wps = do
n <- poke224s (shadVBOptr $ _windowShader pdata) wps n <- poke224s (shadVBOptr $ _windowShader pdata) wps
bindShaderBuffers [_windowShader pdata] [n] bindShaderBuffers [_windowShader pdata] [n]
currentProgram $= Just (_shaderProgram $ _windowShader pdata) currentProgram $= Just (_shadProg $ _windowShader pdata)
--cullFace $= Just Back --cullFace $= Just Back
drawShader (_windowShader pdata) n drawShader (_windowShader pdata) n
--cullFace $= Nothing --cullFace $= Nothing
@@ -246,3 +257,4 @@ renderTextureWalls pdata nWalls = do
cullFace $= Just Back cullFace $= Just Back
drawShader (_wallTextureShader pdata) nWalls drawShader (_wallTextureShader pdata) nWalls
cullFace $= Nothing cullFace $= Nothing
src/Framebuffer/Update.hs
+1 -1
View File
@@ -31,7 +31,7 @@ sizeFBOs xsize ysize xfull yfull rdata = do
rdata''' <- foldM (updateFBOTO xfull yfull minMagFilter GL_RGBA8) rdata'' rdata''' <- foldM (updateFBOTO xfull yfull minMagFilter GL_RGBA8) rdata''
[fbo2, fbo3] [fbo2, fbo3]
foldM (updateFBOTO (xsize `div` 2) (ysize `div` 2) linMinMagFilter GL_RGBA16F) rdata''' foldM (updateFBOTO (xsize `div` 2) (ysize `div` 2) linMinMagFilter GL_RGBA16F) rdata'''
[fboFourth1,fboFourth2] [fboHalf1,fboHalf2,fboHalf3]
resizeRBO resizeRBO
:: RenderbufferObject :: RenderbufferObject
src/Preload/Render.hs
+13 -14
View File
@@ -129,8 +129,9 @@ preloadRender = do
fboLightingName <- setupFramebufferGivenStencil rboBaseBloomName fboLightingName <- setupFramebufferGivenStencil rboBaseBloomName
fboLightingHighName <- setupFramebufferGivenStencil rboBaseBloomName fboLightingHighName <- setupFramebufferGivenStencil rboBaseBloomName
fboFourth1Name <- setupTextureFramebuffer 300 300 fboHalf1Name <- setupTextureFramebuffer 300 300
fboFourth2Name <- setupTextureFramebuffer 300 300 fboHalf2Name <- 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
@@ -150,26 +151,24 @@ preloadRender = do
return $ RenderData return $ RenderData
{ _pictureShaders = shadV { _pictureShaders = shadV
--, _lightingSurfaceShader = lightingSurfaceShad
, _lightingCapShader = lightingCapShad , _lightingCapShader = lightingCapShad
, _lightingLineShadowShader = lightingLineShadowShad , _lightingLineShadowShader = lightingLineShadowShad
, _lightingOccludeShader = wsShad {_shaderVAO = wpVAO} , _lightingOccludeShader = wsShad {_shadVAO = wpVAO}
--, _lightingWallShader = wlLightShad {_shaderVAO = wpVAO} , _wallBlankShader = wlBlank { _shadVAO = wpColVAO }
, _wallBlankShader = wlBlank { _shaderVAO = wpColVAO } , _wallTextureShader = wlTexture { _shadVAO = wpColVAO }
, _wallTextureShader = wlTexture { _shaderVAO = wpColVAO } , _windowShader = wlBlank { _shadVAO = winColVAO }
, _windowShader = wlBlank { _shaderVAO = winColVAO }
, _textureArrayShader = textArrayShad , _textureArrayShader = textArrayShad
, _fullscreenShader = fsShad , _fullscreenShader = fsShad
, _fullLightingShader = fullLightingShad , _fullLightingShader = fullLightingShad
--, _fullscreenAlphaHalveShader = fullscreenAlphaHalveShad , _bloomBlurShader = bloomBlurShad
, _bloomBlurShader = bloomBlurShad , _colorBlurShader = colorBlurShad
, _colorBlurShader = colorBlurShad
, _barrelShader = barrelShad , _barrelShader = barrelShad
, _grayscaleShader = grayscaleShad , _grayscaleShader = grayscaleShad
, _fbo2 = framebuf2 , _fbo2 = framebuf2
, _fbo3 = framebuf3 , _fbo3 = framebuf3
, _fboFourth1 = fboFourth1Name , _fboHalf1 = fboHalf1Name
, _fboFourth2 = fboFourth2Name , _fboHalf2 = fboHalf2Name
, _fboHalf3 = fboHalf3Name
, _fboLighting = fboLightingName , _fboLighting = fboLightingName
, _fboLightingHigh = fboLightingHighName , _fboLightingHigh = fboLightingHighName
--, _rboLighting = rboLightingName --, _rboLighting = rboLightingName
src/Render.hs
+9 -9
View File
@@ -61,19 +61,19 @@ createLightMap pdata lightPoints nWalls nSils nCaps toPos = do
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 (_shaderProgram $ _lightingOccludeShader pdata) currentProgram $= Just (_shadProg $ _lightingOccludeShader pdata)
uniform (head $ _shaderCustomUnis $ _lightingOccludeShader pdata) uniform (head $ _shadUnis $ _lightingOccludeShader pdata)
$= Vector3 x y z $= Vector3 x y z
drawShader (_lightingOccludeShader pdata) nWalls drawShader (_lightingOccludeShader pdata) nWalls
--draw silhouette shadows --draw silhouette shadows
currentProgram $= Just (_shaderProgram $ _lightingLineShadowShader pdata) currentProgram $= Just (_shadProg $ _lightingLineShadowShader pdata)
uniform (head $ _shaderCustomUnis $ _lightingLineShadowShader pdata) uniform (head $ _shadUnis $ _lightingLineShadowShader pdata)
$= Vector3 x y z $= Vector3 x y z
drawShader (_lightingLineShadowShader pdata) nSils drawShader (_lightingLineShadowShader pdata) nSils
cullFace $= Just Back cullFace $= Just Back
--draw caps on the near plane as required --draw caps on the near plane as required
currentProgram $= Just (_shaderProgram $ _lightingCapShader pdata) currentProgram $= Just (_shadProg $ _lightingCapShader pdata)
uniform (head $ _shaderCustomUnis $ _lightingCapShader pdata) uniform (head $ _shadUnis $ _lightingCapShader pdata)
$= Vector3 x y z $= Vector3 x y z
drawShader (_lightingCapShader pdata) nCaps drawShader (_lightingCapShader pdata) nCaps
--draw lightmap itself --draw lightmap itself
@@ -83,10 +83,10 @@ createLightMap pdata lightPoints nWalls nSils nCaps toPos = do
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 (_shaderProgram $ _fullLightingShader pdata) currentProgram $= Just (_shadProg $ _fullLightingShader pdata)
uniform (head $ _shaderCustomUnis $ _fullLightingShader pdata) uniform (head $ _shadUnis $ _fullLightingShader pdata)
$= Vector3 x y z $= Vector3 x y z
uniform (_shaderCustomUnis (_fullLightingShader pdata) !! 1) uniform (_shadUnis (_fullLightingShader pdata) !! 1)
$= Vector4 r g b rad $= Vector4 r g b rad
drawShader (_fullLightingShader pdata) 4 drawShader (_fullLightingShader pdata) 4
--cleanup: may not be necessary, depending on what comes after... --cleanup: may not be necessary, depending on what comes after...
src/Shader.hs
+16 -10
View File
@@ -24,27 +24,33 @@ drawShaderLay :: Int -> UMV.MVector (PrimState IO) Int -> Int -> FullShader -> I
{-# INLINE drawShaderLay #-} {-# INLINE drawShaderLay #-}
drawShaderLay l countsVector shadIn fs = do drawShaderLay l countsVector shadIn fs = do
i <- UMV.read countsVector shadIn i <- UMV.read countsVector shadIn
currentProgram $= Just (_shaderProgram fs) currentProgram $= Just (_shadProg fs)
bindVertexArrayObject $= Just (_vao $ _shaderVAO fs) bindVertexArrayObject $= Just (_vao $ _shadVAO fs)
case _shaderTexture fs of case _shadTex fs of
Just ShaderTexture{_textureObject = txo} Just ShaderTexture{_textureObject = txo}
-> textureBinding Texture2D $= Just txo -> textureBinding Texture2D $= Just txo
_ -> return () _ -> return ()
glDrawArrays (marshalEPrimitiveMode $ _shaderDrawPrimitive fs) (fromIntegral $ l*numSubElements) (fromIntegral i) glDrawArrays
(marshalEPrimitiveMode $ _shadPrim fs)
(fromIntegral $ l*numSubElements)
(fromIntegral i)
drawShader :: FullShader -> Int -> IO () drawShader :: FullShader -> Int -> IO ()
{-# INLINE drawShader #-} {-# INLINE drawShader #-}
drawShader fs i = do drawShader fs i = do
currentProgram $= Just (_shaderProgram fs) currentProgram $= Just (_shadProg fs)
bindVertexArrayObject $= Just (_vao $ _shaderVAO fs) bindVertexArrayObject $= Just (_vao $ _shadVAO fs)
case _shaderTexture fs of case _shadTex fs of
Just ShaderTexture{_textureObject = txo} Just ShaderTexture{_textureObject = txo}
-> textureBinding Texture2D $= Just txo -> textureBinding Texture2D $= Just txo
_ -> return () _ -> return ()
glDrawArrays (marshalEPrimitiveMode $ _shaderDrawPrimitive fs) 0 (fromIntegral i) glDrawArrays
(marshalEPrimitiveMode $ _shadPrim fs)
0
(fromIntegral i)
freeShaderPointers :: FullShader -> IO () freeShaderPointers :: FullShader -> IO ()
freeShaderPointers fs = free $ _vboPtr $ _vaoVBO $ _shaderVAO fs freeShaderPointers fs = free $ _vboPtr $ _vaoVBO $ _shadVAO fs
pokeBindFoldable pokeBindFoldable
:: MV.MVector (PrimState IO) FullShader :: MV.MVector (PrimState IO) FullShader
@@ -66,4 +72,4 @@ pokeBindFoldableLayer shadV counts m = do
shadVBOptr :: FullShader -> Ptr Float shadVBOptr :: FullShader -> Ptr Float
{-# INLINE shadVBOptr #-} {-# INLINE shadVBOptr #-}
shadVBOptr = _vboPtr . _vaoVBO . _shaderVAO shadVBOptr = _vboPtr . _vaoVBO . _shadVAO
src/Shader/AuxAddition.hs
+6 -6
View File
@@ -33,7 +33,7 @@ addTexture texturePath shad = 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
return $ shad & shaderTexture ?~ ShaderTexture {_textureObject = textureOb} return $ shad & shadTex ?~ ShaderTexture {_textureObject = textureOb}
vaddTextureNoFilter :: String -> FullShader -> IO FullShader vaddTextureNoFilter :: String -> FullShader -> IO FullShader
vaddTextureNoFilter texturePath shad = do vaddTextureNoFilter texturePath shad = do
@@ -48,7 +48,7 @@ vaddTextureNoFilter texturePath shad = do
--withArray texData $ \ptr -> do --withArray texData $ \ptr -> do
V.unsafeWith (imageData tex) $ \ptr -> do V.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 & shaderTexture ?~ ShaderTexture {_textureObject = textureOb} return $ shad & shadTex ?~ ShaderTexture {_textureObject = textureOb}
addTextureNoFilter :: String -> FullShader -> IO FullShader addTextureNoFilter :: String -> FullShader -> IO FullShader
addTextureNoFilter texturePath shad = do addTextureNoFilter texturePath shad = do
@@ -62,7 +62,7 @@ addTextureNoFilter texturePath shad = do
glTexStorage2D GL_TEXTURE_2D 1 GL_RGBA8 wtex htex glTexStorage2D GL_TEXTURE_2D 1 GL_RGBA8 wtex htex
V.unsafeWith (imageData tex) $ \ptr -> do V.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 & shaderTexture ?~ ShaderTexture {_textureObject = textureOb} return $ shad & shadTex ?~ ShaderTexture {_textureObject = textureOb}
-- | for transforming a 256x256 image containing 64 tiles of 16x16 pixels into -- | for transforming a 256x256 image containing 64 tiles of 16x16 pixels into
-- an image that was directly readable by glTexSubImage3D, used the -- an image that was directly readable by glTexSubImage3D, used the
@@ -84,7 +84,7 @@ addTextureArray texturePath shad = 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
textureFilter Texture2DArray $= ((Linear',Just Linear') , Linear') textureFilter Texture2DArray $= ((Linear',Just Linear') , Linear')
generateMipmap' Texture2DArray generateMipmap' Texture2DArray
return $ shad & shaderTexture ?~ ShaderTexture {_textureObject = textureOb} return $ shad & shadTex ?~ ShaderTexture {_textureObject = textureOb}
-- I am completely unclear on why this works with its current parameters -- I am completely unclear on why this works with its current parameters
tilesToLine tilesToLine
@@ -96,5 +96,5 @@ 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 $ _shaderProgram shad) uniStrings uniLocs <- mapM (uniformLocation $ _shadProg shad) uniStrings
return $ shad & shaderCustomUnis %~ (++ uniLocs) return $ shad & shadUnis %~ (++ uniLocs)
src/Shader/Bind.hs
+3 -3
View File
@@ -29,7 +29,7 @@ bindShaderLayers :: MV.MVector (PrimState IO) FullShader -> UMV.MVector (PrimSta
bindShaderLayers shads counts = MV.imapM_ f shads bindShaderLayers shads counts = MV.imapM_ f shads
where where
f i shad = do f i shad = do
let theVBO = _vaoVBO $ _shaderVAO shad let theVBO = _vaoVBO $ _shadVAO shad
stride = sum $ _vboAttribSizes theVBO stride = sum $ _vboAttribSizes theVBO
bindBuffer ArrayBuffer $= (Just . _vbo $ theVBO) bindBuffer ArrayBuffer $= (Just . _vbo $ theVBO)
VS.mapM_ (g stride theVBO) $ VS.enumFromStepN 0 1 6 -- [0..5] VS.mapM_ (g stride theVBO) $ VS.enumFromStepN 0 1 6 -- [0..5]
@@ -46,9 +46,9 @@ bindShaderLayers shads counts = MV.imapM_ f shads
bindShader :: MV.MVector (PrimState IO) FullShader -> UMV.MVector (PrimState IO) Int -> IO () bindShader :: MV.MVector (PrimState IO) FullShader -> UMV.MVector (PrimState IO) Int -> IO ()
bindShader shads counts = MV.imapM_ f shads bindShader shads counts = MV.imapM_ f shads
where where
f i shad = UMV.read counts i >>= flip bindArrayBuffers (_vaoVBO . _shaderVAO $ shad) f i shad = UMV.read counts i >>= flip bindArrayBuffers (_vaoVBO . _shadVAO $ shad)
bindShaderBuffers :: [FullShader] -> [Int] -> IO () bindShaderBuffers :: [FullShader] -> [Int] -> IO ()
bindShaderBuffers = zipWithM_ f bindShaderBuffers = zipWithM_ f
where where
f fs i = bindArrayBuffers i $ _vaoVBO $ _shaderVAO fs f fs i = bindArrayBuffers i $ _vaoVBO $ _shadVAO fs
src/Shader/Compile.hs
+23 -23
View File
@@ -30,11 +30,11 @@ makeShader s shaderlist sizes pm = do
prog <- makeSourcedShader s shaderlist prog <- makeSourcedShader s shaderlist
vaob <- setupVAO sizes vaob <- setupVAO sizes
return $ FullShader return $ FullShader
{ _shaderProgram = prog { _shadProg = prog
, _shaderVAO = vaob , _shadVAO = vaob
, _shaderDrawPrimitive = pm , _shadPrim = pm
, _shaderTexture = Nothing , _shadTex = Nothing
, _shaderCustomUnis = [] , _shadUnis = []
} }
makeByteStringShader makeByteStringShader
:: String -- ^ (Arbitrary) name of the shader :: String -- ^ (Arbitrary) name of the shader
@@ -46,11 +46,11 @@ makeByteStringShader s shaderlist sizes pm = do
prog <- makeShaderProgram s shaderlist prog <- makeShaderProgram s shaderlist
vaob <- setupVAO sizes vaob <- setupVAO sizes
return $ FullShader return $ FullShader
{ _shaderProgram = prog { _shadProg = prog
, _shaderVAO = vaob , _shadVAO = vaob
, _shaderDrawPrimitive = pm , _shadPrim = pm
, _shaderTexture = Nothing , _shadTex = Nothing
, _shaderCustomUnis = [] , _shadUnis = []
} }
makeByteStringShaderUsingVAO makeByteStringShaderUsingVAO
:: String -- ^ (Arbitrary) name of the shader :: String -- ^ (Arbitrary) name of the shader
@@ -61,10 +61,10 @@ makeByteStringShaderUsingVAO
makeByteStringShaderUsingVAO s shaderlist pm fs = do makeByteStringShaderUsingVAO s shaderlist pm fs = do
prog <- makeShaderProgram s shaderlist prog <- makeShaderProgram s shaderlist
return $ fs return $ fs
{ _shaderProgram = prog { _shadProg = prog
, _shaderDrawPrimitive = pm , _shadPrim = pm
, _shaderTexture = Nothing , _shadTex = Nothing
, _shaderCustomUnis = [] , _shadUnis = []
} }
-- | Takes the VAO from another shader -- | Takes the VAO from another shader
@@ -77,10 +77,10 @@ makeShaderUsingShaderVAO
makeShaderUsingShaderVAO s shaderlist pm fs = do makeShaderUsingShaderVAO s shaderlist pm fs = do
prog <- makeSourcedShader s shaderlist prog <- makeSourcedShader s shaderlist
return $ fs return $ fs
{ _shaderProgram = prog { _shadProg = prog
, _shaderDrawPrimitive = pm , _shadPrim = pm
, _shaderTexture = Nothing , _shadTex = Nothing
, _shaderCustomUnis = [] , _shadUnis = []
} }
{- | {- |
Compiles a full shader found within the shader directory. Compiles a full shader found within the shader directory.
@@ -97,11 +97,11 @@ makeShaderSized s shaderlist sizes ndraw pm = do
prog <- makeSourcedShader s shaderlist prog <- makeSourcedShader s shaderlist
vaob <- setupVAOSized sizes ndraw vaob <- setupVAOSized sizes ndraw
return $ FullShader return $ FullShader
{ _shaderProgram = prog { _shadProg = prog
, _shaderVAO = vaob , _shadVAO = vaob
, _shaderDrawPrimitive = pm , _shadPrim = pm
, _shaderTexture = Nothing , _shadTex = Nothing
, _shaderCustomUnis = [] , _shadUnis = []
} }
-- | Compile shader and get its uniform locations. -- | Compile shader and get its uniform locations.
src/Shader/Data.hs
+10 -10
View File
@@ -10,11 +10,11 @@ module Shader.Data
-- | Lens functions -- | Lens functions
, vao , vao
, vaoVBO , vaoVBO
, shaderProgram , shadProg
, shaderVAO , shadVAO
, shaderDrawPrimitive , shadPrim
, shaderTexture , shadTex
, shaderCustomUnis , shadUnis
, vbo , vbo
, vboPtr , vboPtr
, vboAttribSizes , vboAttribSizes
@@ -29,11 +29,11 @@ import Foreign
import Control.Lens import Control.Lens
{- | Datatype containing the necessary information for a single shader. -} {- | Datatype containing the necessary information for a single shader. -}
data FullShader = FullShader data FullShader = FullShader
{ _shaderProgram :: Program { _shadProg :: Program
, _shaderVAO :: VAO , _shadVAO :: VAO
, _shaderDrawPrimitive :: EPrimitiveMode , _shadPrim :: EPrimitiveMode
, _shaderTexture :: Maybe ShaderTexture , _shadTex :: Maybe ShaderTexture
, _shaderCustomUnis :: [UniformLocation] , _shadUnis :: [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
+2 -2
View File
@@ -29,7 +29,7 @@ pokeVerxs vbos count vxs = VS.mapM_ (pokeVerx vbos count) $ VS.fromList vxs
pokeVerx :: MV.MVector (PrimState IO) FullShader -> UMV.MVector (PrimState IO) Int -> Verx -> IO () pokeVerx :: MV.MVector (PrimState IO) FullShader -> UMV.MVector (PrimState IO) Int -> Verx -> IO ()
pokeVerx vbos offsets Verx{_vxPos=thePos,_vxCol=theCol,_vxExt=ext,_vxShadNum=theShadNum} = do pokeVerx vbos offsets Verx{_vxPos=thePos,_vxCol=theCol,_vxExt=ext,_vxShadNum=theShadNum} = do
typeOff <- UMV.unsafeRead offsets sn typeOff <- UMV.unsafeRead offsets sn
basePtr <- _vboPtr . _vaoVBO . _shaderVAO <$> MV.read vbos sn basePtr <- _vboPtr . _vaoVBO . _shadVAO <$> MV.read vbos sn
let thePtr = plusPtr basePtr (typeOff * pokeStride sn * floatSize) let thePtr = plusPtr basePtr (typeOff * pokeStride sn * floatSize)
poke34 thePtr thePos theCol poke34 thePtr thePos theCol
pokeArrayOff thePtr 7 ext pokeArrayOff thePtr 7 ext
@@ -48,7 +48,7 @@ pokeLayVerx :: MV.MVector (PrimState IO) FullShader -> UMV.MVector (PrimState IO
--{-# INLINE pokeLayVerx #-} --{-# INLINE pokeLayVerx #-}
pokeLayVerx vbos counts vx = do pokeLayVerx vbos counts vx = do
theOff <- UMV.unsafeRead counts vecPos theOff <- UMV.unsafeRead counts vecPos
basePtr <- _vboPtr . _vaoVBO . _shaderVAO <$> MV.unsafeRead vbos sn basePtr <- _vboPtr . _vaoVBO . _shadVAO <$> MV.unsafeRead vbos sn
let thePtr = plusPtr basePtr ((theOff + layOff) * theStride * floatSize) let thePtr = plusPtr basePtr ((theOff + layOff) * theStride * floatSize)
poke34 thePtr thePos theCol poke34 thePtr thePos theCol
pokeArrayOff thePtr 7 (_vxExt vx) pokeArrayOff thePtr 7 (_vxExt vx)