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
, _fbo2 :: (FramebufferObject, TextureObject)
, _fbo3 :: (FramebufferObject, TextureObject)
, _fboFourth1 :: (FramebufferObject, TextureObject)
, _fboFourth2 :: (FramebufferObject, TextureObject)
, _fboHalf1 :: (FramebufferObject, TextureObject)
, _fboHalf2 :: (FramebufferObject, TextureObject)
, _fboHalf3 :: (FramebufferObject, TextureObject)
, _fboBase :: (FramebufferObject, (TextureObject, TextureObject))
, _fboCloud :: (FramebufferObject, (TextureObject, 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.ChaseCrit
import Dodge.Creature.ArmourChase
import Dodge.Creature.Silhouette
import Dodge.Data
import Dodge.Default
import Dodge.Item.Weapon
@@ -146,6 +147,7 @@ startCr = defaultCreature
, _crMvDir = pi/2
, _crID = 0
, _crPict = basicCrPict black
, _crSilhouette = basicCrSilhouette
, _crUpdate = stateUpdate yourControl
, _crRad = 10
, _crMass = 10
src/Dodge/Creature/ShadowBox.hs
+4 -4
View File
@@ -6,9 +6,9 @@ import Geometry
import qualified Data.IntMap as IM
crToBox :: Creature -> [[Point3]]
crToBox cr = map (map f . polyToTris) $ boxXYZ 10 10 15
crToBox cr = map (map f . polyToTris) $ boxXYZ 8 8 15
where
f = (+ V3 (x-5) (y-5) 1)
f = (+ V3 (x-4) (y-4) 1)
V2 x y = _crPos cr
youBox' :: World -> [[Point3]]
youBox' w = crToBox' $ _creatures w IM.! 0
@@ -17,9 +17,9 @@ youBox :: World -> [Point3]
youBox = concat . youBox'
crToBox' :: Creature -> [[Point3]]
crToBox' cr = map (map f . polyToTris) $ boxXYZ 20 20 15
crToBox' cr = map (map f . polyToTris) $ boxXYZ 12 12 15
where
f = (+ V3 (x-10) (y-10) 1)
f = (+ V3 (x-6) (y-6) 0)
V2 x y = _crPos cr
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
, _crID :: Int
, _crPict :: Creature -> World -> Picture
, _crSilhouette :: Creature -> [Point3]
, _crUpdate
:: Creature
-> World
src/Dodge/Default.hs
+1
View File
@@ -31,6 +31,7 @@ defaultCreature = Creature
, _crMvDir = 0
, _crID = 1
, _crPict = \_ _ -> setLayer 0 $ onLayer CrLayer $ circleSolid 10
, _crSilhouette = const []
, _crUpdate = \cr _ -> (Endo id , Just cr)
, _crRad = 10
, _crMass = 10
src/Dodge/Render.hs
+22 -10
View File
@@ -8,7 +8,8 @@ import Dodge.Data
import Dodge.Config.Data
import Dodge.Base.Window
import Dodge.Render.Picture
--import Dodge.Creature.ShadowBox
import Dodge.Creature.ShadowBox
import Dodge.Creature.Silhouette
import Geometry
import Render
import Data.Preload.Render
@@ -55,7 +56,8 @@ doDrawing pdata w = do
nWalls <- poke224s (shadVBOptr $ _wallTextureShader pdata) wallPointsCol
nSils <- pokePoint3s (shadVBOptr $ _lightingLineShadowShader pdata)
$
--youSil w ++
--youSil w ++
creatureSilhouettes w ++
_foregroundEdgeVerx w
-- poke foreground geometry for caps
nCaps <- pokePoint3s (shadVBOptr $ _lightingCapShader pdata)
@@ -75,9 +77,8 @@ doDrawing pdata w = do
clear [ColorBuffer,DepthBuffer]
depthFunc $= Just Less
-- draw wall occlusions from the camera's point of view
currentProgram $= Just (_shaderProgram $ _lightingOccludeShader pdata)
uniform (head $ _shaderCustomUnis $ _lightingOccludeShader pdata)
$= viewFrom3d
currentProgram $= Just (_shadProg $ _lightingOccludeShader pdata)
uniform (head $ _shadUnis $ _lightingOccludeShader pdata) $= viewFrom3d
drawShader (_lightingOccludeShader pdata) nWalls
--draw walls onto base buffer
if w ^. config . wall_textured
@@ -118,12 +119,12 @@ doDrawing pdata w = do
--setup downscale viewport for blurring bloom
viewport $= (Position 0 0
, 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
textureBinding Texture2D $= Just (snd $ _fboBloom pdata)
blend $= Disabled
drawShader (_bloomBlurShader pdata) 4
replicateM_ 5 $ pingPongBetween (_fboFourth1 pdata) (_fboFourth2 pdata) (_bloomBlurShader pdata)
replicateM_ 5 $ pingPongBetween (_fboHalf1 pdata) (_fboHalf2 pdata) (_bloomBlurShader pdata)
blend $= Enabled
viewport $= (Position 0 0
, divideSize (w ^. config . shadow_resolution) $ Size (round $ fstV2 wins) (round $ sndV2 wins))
@@ -144,11 +145,21 @@ doDrawing pdata w = do
drawBuffers $= [NoBuffers,FBOColorAttachment 1]
renderLayer 2 shadV layerCounts
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
blend $= Enabled
----draw lightmap for cloud buffer
bindFramebuffer Framebuffer $= fst (_fboLighting 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
clearColor $= Color4 0 0 0 0
--apply lightmap to cloud buffer
@@ -167,7 +178,7 @@ doDrawing pdata w = do
bindFramebuffer Framebuffer $= fst (_fboBase pdata)
blend $= Enabled
blendFunc $= (SrcAlpha, One)
textureBinding Texture2D $= Just (snd $ _fboFourth1 pdata)
textureBinding Texture2D $= Just (snd $ _fboHalf1 pdata)
drawShader (_fullscreenShader pdata) 4
blendFunc $= (SrcAlpha, OneMinusSrcAlpha)
--draw shadowed clouds onto base buffer
@@ -233,7 +244,7 @@ renderWindows
renderWindows pdata wps = do
n <- poke224s (shadVBOptr $ _windowShader pdata) wps
bindShaderBuffers [_windowShader pdata] [n]
currentProgram $= Just (_shaderProgram $ _windowShader pdata)
currentProgram $= Just (_shadProg $ _windowShader pdata)
--cullFace $= Just Back
drawShader (_windowShader pdata) n
--cullFace $= Nothing
@@ -246,3 +257,4 @@ renderTextureWalls pdata nWalls = do
cullFace $= Just Back
drawShader (_wallTextureShader pdata) nWalls
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''
[fbo2, fbo3]
foldM (updateFBOTO (xsize `div` 2) (ysize `div` 2) linMinMagFilter GL_RGBA16F) rdata'''
[fboFourth1,fboFourth2]
[fboHalf1,fboHalf2,fboHalf3]
resizeRBO
:: RenderbufferObject
src/Preload/Render.hs
+13 -14
View File
@@ -129,8 +129,9 @@ preloadRender = do
fboLightingName <- setupFramebufferGivenStencil rboBaseBloomName
fboLightingHighName <- setupFramebufferGivenStencil rboBaseBloomName
fboFourth1Name <- setupTextureFramebuffer 300 300
fboFourth2Name <- setupTextureFramebuffer 300 300
fboHalf1Name <- setupTextureFramebuffer 300 300
fboHalf2Name <- setupTextureFramebuffer 300 300
fboHalf3Name <- setupTextureFramebuffer 300 300
-- reset to default framebuffer, ready for drawing direct to screen
bindFramebuffer Framebuffer $= defaultFramebufferObject
@@ -150,26 +151,24 @@ preloadRender = do
return $ RenderData
{ _pictureShaders = shadV
--, _lightingSurfaceShader = lightingSurfaceShad
, _lightingCapShader = lightingCapShad
, _lightingLineShadowShader = lightingLineShadowShad
, _lightingOccludeShader = wsShad {_shaderVAO = wpVAO}
--, _lightingWallShader = wlLightShad {_shaderVAO = wpVAO}
, _wallBlankShader = wlBlank { _shaderVAO = wpColVAO }
, _wallTextureShader = wlTexture { _shaderVAO = wpColVAO }
, _windowShader = wlBlank { _shaderVAO = winColVAO }
, _lightingOccludeShader = wsShad {_shadVAO = wpVAO}
, _wallBlankShader = wlBlank { _shadVAO = wpColVAO }
, _wallTextureShader = wlTexture { _shadVAO = wpColVAO }
, _windowShader = wlBlank { _shadVAO = winColVAO }
, _textureArrayShader = textArrayShad
, _fullscreenShader = fsShad
, _fullLightingShader = fullLightingShad
--, _fullscreenAlphaHalveShader = fullscreenAlphaHalveShad
, _bloomBlurShader = bloomBlurShad
, _colorBlurShader = colorBlurShad
, _fullLightingShader = fullLightingShad
, _bloomBlurShader = bloomBlurShad
, _colorBlurShader = colorBlurShad
, _barrelShader = barrelShad
, _grayscaleShader = grayscaleShad
, _fbo2 = framebuf2
, _fbo3 = framebuf3
, _fboFourth1 = fboFourth1Name
, _fboFourth2 = fboFourth2Name
, _fboHalf1 = fboHalf1Name
, _fboHalf2 = fboHalf2Name
, _fboHalf3 = fboHalf3Name
, _fboLighting = fboLightingName
, _fboLightingHigh = fboLightingHighName
--, _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)
stencilFunc $= (Always, 0, 255)
--draw wall shadows
currentProgram $= Just (_shaderProgram $ _lightingOccludeShader pdata)
uniform (head $ _shaderCustomUnis $ _lightingOccludeShader pdata)
currentProgram $= Just (_shadProg $ _lightingOccludeShader pdata)
uniform (head $ _shadUnis $ _lightingOccludeShader pdata)
$= Vector3 x y z
drawShader (_lightingOccludeShader pdata) nWalls
--draw silhouette shadows
currentProgram $= Just (_shaderProgram $ _lightingLineShadowShader pdata)
uniform (head $ _shaderCustomUnis $ _lightingLineShadowShader pdata)
currentProgram $= Just (_shadProg $ _lightingLineShadowShader pdata)
uniform (head $ _shadUnis $ _lightingLineShadowShader pdata)
$= Vector3 x y z
drawShader (_lightingLineShadowShader pdata) nSils
cullFace $= Just Back
--draw caps on the near plane as required
currentProgram $= Just (_shaderProgram $ _lightingCapShader pdata)
uniform (head $ _shaderCustomUnis $ _lightingCapShader pdata)
currentProgram $= Just (_shadProg $ _lightingCapShader pdata)
uniform (head $ _shadUnis $ _lightingCapShader pdata)
$= Vector3 x y z
drawShader (_lightingCapShader pdata) nCaps
--draw lightmap itself
@@ -83,10 +83,10 @@ createLightMap pdata lightPoints nWalls nSils nCaps toPos = do
colorMask $= Color4 Enabled Enabled Enabled Enabled
stencilOp $= (OpKeep,OpKeep,OpKeep)
stencilFunc $= (Equal, 0, 255)
currentProgram $= Just (_shaderProgram $ _fullLightingShader pdata)
uniform (head $ _shaderCustomUnis $ _fullLightingShader pdata)
currentProgram $= Just (_shadProg $ _fullLightingShader pdata)
uniform (head $ _shadUnis $ _fullLightingShader pdata)
$= Vector3 x y z
uniform (_shaderCustomUnis (_fullLightingShader pdata) !! 1)
uniform (_shadUnis (_fullLightingShader pdata) !! 1)
$= Vector4 r g b rad
drawShader (_fullLightingShader pdata) 4
--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 #-}
drawShaderLay l countsVector shadIn fs = do
i <- UMV.read countsVector shadIn
currentProgram $= Just (_shaderProgram fs)
bindVertexArrayObject $= Just (_vao $ _shaderVAO fs)
case _shaderTexture fs of
currentProgram $= Just (_shadProg fs)
bindVertexArrayObject $= Just (_vao $ _shadVAO fs)
case _shadTex fs of
Just ShaderTexture{_textureObject = txo}
-> textureBinding Texture2D $= Just txo
_ -> return ()
glDrawArrays (marshalEPrimitiveMode $ _shaderDrawPrimitive fs) (fromIntegral $ l*numSubElements) (fromIntegral i)
glDrawArrays
(marshalEPrimitiveMode $ _shadPrim fs)
(fromIntegral $ l*numSubElements)
(fromIntegral i)
drawShader :: FullShader -> Int -> IO ()
{-# INLINE drawShader #-}
drawShader fs i = do
currentProgram $= Just (_shaderProgram fs)
bindVertexArrayObject $= Just (_vao $ _shaderVAO fs)
case _shaderTexture fs of
currentProgram $= Just (_shadProg fs)
bindVertexArrayObject $= Just (_vao $ _shadVAO fs)
case _shadTex fs of
Just ShaderTexture{_textureObject = txo}
-> textureBinding Texture2D $= Just txo
_ -> return ()
glDrawArrays (marshalEPrimitiveMode $ _shaderDrawPrimitive fs) 0 (fromIntegral i)
glDrawArrays
(marshalEPrimitiveMode $ _shadPrim fs)
0
(fromIntegral i)
freeShaderPointers :: FullShader -> IO ()
freeShaderPointers fs = free $ _vboPtr $ _vaoVBO $ _shaderVAO fs
freeShaderPointers fs = free $ _vboPtr $ _vaoVBO $ _shadVAO fs
pokeBindFoldable
:: MV.MVector (PrimState IO) FullShader
@@ -66,4 +72,4 @@ pokeBindFoldableLayer shadV counts m = do
shadVBOptr :: FullShader -> Ptr Float
{-# 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
textureFilter Texture2DArray $= ((Linear',Just Linear') , Linear')
generateMipmap' Texture2D
return $ shad & shaderTexture ?~ ShaderTexture {_textureObject = textureOb}
return $ shad & shadTex ?~ ShaderTexture {_textureObject = textureOb}
vaddTextureNoFilter :: String -> FullShader -> IO FullShader
vaddTextureNoFilter texturePath shad = do
@@ -48,7 +48,7 @@ vaddTextureNoFilter texturePath shad = do
--withArray texData $ \ptr -> do
V.unsafeWith (imageData tex) $ \ptr -> do
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 texturePath shad = do
@@ -62,7 +62,7 @@ addTextureNoFilter texturePath shad = do
glTexStorage2D GL_TEXTURE_2D 1 GL_RGBA8 wtex htex
V.unsafeWith (imageData tex) $ \ptr -> do
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
-- 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
textureFilter Texture2DArray $= ((Linear',Just Linear') , Linear')
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
tilesToLine
@@ -96,5 +96,5 @@ tilesToLine n w = concat . concat . transpose . chunksOf n . chunksOf w
addUniforms :: [String] -> FullShader -> IO FullShader
addUniforms uniStrings shad = do
uniLocs <- mapM (uniformLocation $ _shaderProgram shad) uniStrings
return $ shad & shaderCustomUnis %~ (++ uniLocs)
uniLocs <- mapM (uniformLocation $ _shadProg shad) uniStrings
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
where
f i shad = do
let theVBO = _vaoVBO $ _shaderVAO shad
let theVBO = _vaoVBO $ _shadVAO shad
stride = sum $ _vboAttribSizes theVBO
bindBuffer ArrayBuffer $= (Just . _vbo $ theVBO)
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 shads counts = MV.imapM_ f shads
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 = zipWithM_ f
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
vaob <- setupVAO sizes
return $ FullShader
{ _shaderProgram = prog
, _shaderVAO = vaob
, _shaderDrawPrimitive = pm
, _shaderTexture = Nothing
, _shaderCustomUnis = []
{ _shadProg = prog
, _shadVAO = vaob
, _shadPrim = pm
, _shadTex = Nothing
, _shadUnis = []
}
makeByteStringShader
:: String -- ^ (Arbitrary) name of the shader
@@ -46,11 +46,11 @@ makeByteStringShader s shaderlist sizes pm = do
prog <- makeShaderProgram s shaderlist
vaob <- setupVAO sizes
return $ FullShader
{ _shaderProgram = prog
, _shaderVAO = vaob
, _shaderDrawPrimitive = pm
, _shaderTexture = Nothing
, _shaderCustomUnis = []
{ _shadProg = prog
, _shadVAO = vaob
, _shadPrim = pm
, _shadTex = Nothing
, _shadUnis = []
}
makeByteStringShaderUsingVAO
:: String -- ^ (Arbitrary) name of the shader
@@ -61,10 +61,10 @@ makeByteStringShaderUsingVAO
makeByteStringShaderUsingVAO s shaderlist pm fs = do
prog <- makeShaderProgram s shaderlist
return $ fs
{ _shaderProgram = prog
, _shaderDrawPrimitive = pm
, _shaderTexture = Nothing
, _shaderCustomUnis = []
{ _shadProg = prog
, _shadPrim = pm
, _shadTex = Nothing
, _shadUnis = []
}
-- | Takes the VAO from another shader
@@ -77,10 +77,10 @@ makeShaderUsingShaderVAO
makeShaderUsingShaderVAO s shaderlist pm fs = do
prog <- makeSourcedShader s shaderlist
return $ fs
{ _shaderProgram = prog
, _shaderDrawPrimitive = pm
, _shaderTexture = Nothing
, _shaderCustomUnis = []
{ _shadProg = prog
, _shadPrim = pm
, _shadTex = Nothing
, _shadUnis = []
}
{- |
Compiles a full shader found within the shader directory.
@@ -97,11 +97,11 @@ makeShaderSized s shaderlist sizes ndraw pm = do
prog <- makeSourcedShader s shaderlist
vaob <- setupVAOSized sizes ndraw
return $ FullShader
{ _shaderProgram = prog
, _shaderVAO = vaob
, _shaderDrawPrimitive = pm
, _shaderTexture = Nothing
, _shaderCustomUnis = []
{ _shadProg = prog
, _shadVAO = vaob
, _shadPrim = pm
, _shadTex = Nothing
, _shadUnis = []
}
-- | Compile shader and get its uniform locations.
src/Shader/Data.hs
+10 -10
View File
@@ -10,11 +10,11 @@ module Shader.Data
-- | Lens functions
, vao
, vaoVBO
, shaderProgram
, shaderVAO
, shaderDrawPrimitive
, shaderTexture
, shaderCustomUnis
, shadProg
, shadVAO
, shadPrim
, shadTex
, shadUnis
, vbo
, vboPtr
, vboAttribSizes
@@ -29,11 +29,11 @@ import Foreign
import Control.Lens
{- | Datatype containing the necessary information for a single shader. -}
data FullShader = FullShader
{ _shaderProgram :: Program
, _shaderVAO :: VAO
, _shaderDrawPrimitive :: EPrimitiveMode
, _shaderTexture :: Maybe ShaderTexture
, _shaderCustomUnis :: [UniformLocation]
{ _shadProg :: Program
, _shadVAO :: VAO
, _shadPrim :: EPrimitiveMode
, _shadTex :: Maybe ShaderTexture
, _shadUnis :: [UniformLocation]
}
{- | Vertex array object: contains the reference to the object,
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 vbos offsets Verx{_vxPos=thePos,_vxCol=theCol,_vxExt=ext,_vxShadNum=theShadNum} = do
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)
poke34 thePtr thePos theCol
pokeArrayOff thePtr 7 ext
@@ -48,7 +48,7 @@ pokeLayVerx :: MV.MVector (PrimState IO) FullShader -> UMV.MVector (PrimState IO
--{-# INLINE pokeLayVerx #-}
pokeLayVerx vbos counts vx = do
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)
poke34 thePtr thePos theCol
pokeArrayOff thePtr 7 (_vxExt vx)