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

Try to add compute shaders

Browse Source
This commit is contained in:
justin
2023-04-11 14:55:57 +01:00
parent 69a76dbf93
commit d79216555b
21 changed files with 457 additions and 246 deletions
Download Patch File Download Diff File Expand all files Collapse all files
appDodge/Main.hs
+11 -6
View File
@@ -20,7 +20,7 @@ import Dodge.Render
import Dodge.SoundLogic.LoadSound
import Dodge.TestString
import Dodge.Update
import qualified IntMapHelp as IM
--import qualified IntMapHelp as IM
import Loop
import Music
--import Picture
@@ -30,7 +30,7 @@ import Preload.Render
import SDL (($=))
import qualified SDL
import qualified SDL.Mixer as Mix
--import qualified SDL.Mixer as Mix
import Sound
import System.Directory
@@ -59,7 +59,7 @@ winConfig x y winpos =
{ SDL.windowGraphicsContext =
SDL.OpenGLContext $
SDL.defaultOpenGL
{ SDL.glProfile = SDL.Core SDL.Normal 4 3
{ SDL.glProfile = SDL.Core SDL.Normal 4 5
, SDL.glColorPrecision = SDL.V4 8 8 8 8
}
, SDL.windowPosition = theWinPos
@@ -128,13 +128,18 @@ doSideEffects u = do
doPreload :: IO PreloadData
doPreload = do
putStrLn "Start Render preload"
rData <- preloadRender
putStrLn "Start sound preload"
lChunks <- loadSounds
lMusic <- loadMusic
Mix.playMusic Mix.Forever (lMusic IM.! 0)
putStrLn "Skip music preload!"
-- lMusic <- loadMusic
-- Mix.playMusic Mix.Forever (lMusic IM.! 0)
putStrLn "Return PreloadData"
return
PreloadData
{ _renderData = rData
, _soundData = SoundData{_loadedChunks = lChunks}
, _musicData = MusicData{_loadedMusic = lMusic}
--, _musicData = MusicData{_loadedMusic = lMusic}
, _musicData = MusicData{_loadedMusic = undefined}
}
data/normalMaps/diffuseArray.png
BIN
View File
Binary file not shown.
Side by Side Swipe Overlay

Before

Width:  |  Height:  |  Size: 141 KiB

After

Width:  |  Height:  |  Size: 147 KiB

data/normalMaps/normalArray.png
BIN
View File
Binary file not shown.
Side by Side Swipe Overlay

Before

Width:  |  Height:  |  Size: 82 KiB

After

Width:  |  Height:  |  Size: 82 KiB

package.yaml
+14 -14
View File
@@ -21,31 +21,31 @@ description: Description text, TODO link to README.md
dependencies:
- base >= 4.7 && < 5
- aeson
- aeson-pretty
- containers
- unordered-containers
- deepseq
- dlist
- directory
- extra
- foldl
- graphviz
- template-haskell
- sdl2
- sdl2-mixer
- OpenGLRaw
- text
- bytestring
- lens
- mtl
- fgl
- random
- JuicyPixels
- vector
- dlist
- deepseq
- random
- sdl2
- sdl2-mixer
- template-haskell
- transformers
- foldl
- unordered-containers
- vector
- linear
- aeson
- aeson-pretty
#- store
- directory
- extra
- primitive
- monad-parallel
- parallel
@@ -71,7 +71,7 @@ executables:
#- -eventlog
- -rtsopts
- -with-rtsopts=+RTS
- -with-rtsopts=-N2
- -with-rtsopts=-N
#- -with-rtsopts=-l
- -flate-dmd-anal
- -fno-liberate-case
shader/compute/multiplyArray.comp
+7
View File
@@ -0,0 +1,7 @@
#version 450 core
layout(local_size_x= 1, local_size_y=1) in;
uniform sampler2DArray screenTexture;
layout(rgba8, binding = 5) uniform restrict writeonly image2D img_output;
void main()
{
}
shader/compute/shadow.comp
+40
View File
@@ -0,0 +1,40 @@
#version 450 core
layout(local_size_x= 16, local_size_y=1) in;
layout(rgba8, binding = 5) uniform restrict writeonly image2D img_output;
layout (std140, binding = 1) uniform LightsBlock
{
vec4 posBool[20];
vec4 colRad[20];
} ;
layout (binding = 0) uniform sampler2D posTexture;
layout (binding = 1) uniform sampler2D normals;
void main ()
{
shared vec3[20] larray;
uint i = gl_LocalInvocationID.x;
vec3 lightamount = vec3(0,0,0);
ivec2 pixel_coords = ivec2(gl_GlobalInvocationID.xy);
vec2 tex_coords = vec2((4*pixel_coords.x+4)/800.0, (4*pixel_coords.y+4)/835.0);
vec3 pos = texture(posTexture,tex_coords).xyz;
vec3 lightPos = posBool[i].xyz;
vec4 lumRad = colRad[i];
vec3 distVec = lightPos - pos;
float dist = dot (distVec,distVec);
if (dist > lumRad.a) { }
else
{
float x = 1 - dist / lumRad.a;
vec3 norm = texture(normals,tex_coords).xyz;
float y1 = dot(normalize(norm), normalize(distVec));
float y = float(y1 > 0 ? 1 : 0);
lightamount = y*x*lumRad.rgb;
}
larray[i] = lightamount;
if (i == 0)
//{ vec3 inverselight = 1 - lightamount;
{ vec3 inverselight = vec3(0,0,0);
// for (uint j=1 ; j < 20; ++j) {inverselight = inverselight * (1 - larray[j]);}
imageStore(img_output, pixel_coords, vec4(inverselight,1));
}
}
shader/shadow/light.frag
+1 -1
View File
@@ -32,5 +32,5 @@ float rad = lumRad.a;
float y = y2;
float x = 1 - dist / rad;
vec3 c = y* (x * x * x) * lumRad.rgb;
fColor = vec4(c, 0);
fColor = vec4(c, 1);
}
src/Color.hs
+8 -31
View File
@@ -1,35 +1,11 @@
--{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE StrictData #-}
module Color (
module Color,
module Color.Data,
) where
module Color where
import Data.Aeson
import Data.Aeson.TH
import Color.Data
import Geometry
data PaletteColor
= RED
| GREEN
| BLUE
| YELLOW
| CYAN
| MAGENTA
| ROSE
| VIOLET
| AZURE
| AQUAMARINE
| CHARTREUSE
| ORANGE
| WHITE
| BLACK
deriving (Eq, Ord, Enum, Show, Read) --Generic, Flat)
type RGBA = Point4
type Color = Point4
import Control.Lens
withAlpha :: Float -> RGBA -> RGBA
{-# INLINE withAlpha #-}
@@ -165,4 +141,5 @@ numColor _ = toV4 (1, 1, 1, 1)
light4 :: Color -> Color
light4 = light . light . light . light
deriveJSON defaultOptions ''PaletteColor
toColor256 :: Color -> Color256
toColor256 = over each floor . (255 *) . normalizeColor
src/Color/Data.hs
+37
View File
@@ -0,0 +1,37 @@
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE StrictData #-}
--{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-}
module Color.Data where
import Data.Aeson
import Data.Aeson.TH
import Data.Word
import Geometry
data PaletteColor
= RED
| GREEN
| BLUE
| YELLOW
| CYAN
| MAGENTA
| ROSE
| VIOLET
| AZURE
| AQUAMARINE
| CHARTREUSE
| ORANGE
| WHITE
| BLACK
deriving (Eq, Ord, Enum, Show, Read) --Generic, Flat)
type RGBA = Point4
type Color = Point4
type Color256 = V4 Word8
deriveJSON defaultOptions ''PaletteColor
src/Data/Preload/Render.hs
+2 -1
View File
@@ -11,7 +11,8 @@ import Graphics.GL.Core45
import Shader.Data
data RenderData = RenderData
{ _lightingWallShadShader :: Shader
{ _computeShadowShader :: GLuint
, _lightingWallShadShader :: Shader
, _lightingLineShadowShader :: Shader
, _lightingCapShader :: Shader
, _lightingTextureShader :: Shader
src/Dodge/Data/Config.hs
+1
View File
@@ -100,6 +100,7 @@ data ShadowRendering
| NoObjShads
| NoShadows
| NoLighting
| ComputeShader
deriving (Show, Eq, Ord, Enum, Bounded)
data RoomClipping = NoRoomClipBoundaries | AllRoomClipBoundaries | IntersectingRoomClipBoundaries
src/Dodge/Floor.hs
+8 -1
View File
@@ -15,6 +15,12 @@ import Dodge.Tree
import LensHelp
import RandomHelp
startWorldTreeTest :: Annotation
startWorldTreeTest =
OnwardList $
[ IntAnno $ AnTree . startRoom
]
initialAnoTree :: Annotation
initialAnoTree =
OnwardList $
@@ -103,4 +109,5 @@ initialAnoTree =
-- | A test level tree.
initialRoomTree :: State (StdGen, Int) (MetaTree Room String)
initialRoomTree = annoToRoomTree initialAnoTree
--initialRoomTree = annoToRoomTree initialAnoTree
initialRoomTree = annoToRoomTree startWorldTreeTest
src/Dodge/Placement/Instance/Wall.hs
+1 -1
View File
@@ -91,7 +91,7 @@ baseBlockPane =
--, _wlColor = greyN 0.5
, _wlColor = dark $ dark orange
--, _wlOpacity = Opaque 10
, _wlOpacity = Opaque 14
, _wlOpacity = Opaque 17
, _wlUnshadowed = True
, _wlFireThrough = True
, _wlPenetrable = True
src/Dodge/Render.hs
+100 -97
View File
@@ -209,6 +209,9 @@ doDrawing' win pdata u = do
pdata
glColorMask GL_TRUE GL_TRUE GL_TRUE GL_TRUE
--apply lightmap to base buffer
glDisable GL_CULL_FACE
glDepthFunc GL_ALWAYS
glDepthMask GL_FALSE
glBindFramebuffer GL_FRAMEBUFFER (pdata ^. fboBase . _1 . unFBO)
glBindTextureUnit 0 (pdata ^. fboLighting . _2 . unTO)
glEnable GL_BLEND
@@ -244,100 +247,100 @@ doDrawing' win pdata u = do
replicateM_ 2 $ pingPongBetween (_fboHalf1 pdata) (_fboHalf2 pdata) (_bloomBlurShader pdata)
glEnable GL_BLEND
setViewport _graphics_world_resolution cfig
--draw clouds onto cloud buffer
glBindFramebuffer GL_FRAMEBUFFER (_unFBO (fst (_fboCloud pdata)))
glDepthFunc GL_LEQUAL
glDepthMask GL_FALSE
--blendFunc $= (SrcAlphaSaturate,One)
--blendColor $= Color4 0.5 0.5 0.5 0.5
--blendFuncSeparate $= ((SrcAlphaSaturate,One) , (One,OneMinusSrcAlpha))
--blendFuncSeparate $= ((SrcAlpha, OneMinusSrcAlpha), (One, OneMinusSrcAlpha))
--glBlendFuncSeparate GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA GL_ONE GL_ONE_MINUS_SRC_ALPHA
glBlendFuncSeparate GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA GL_ONE_MINUS_DST_ALPHA GL_ONE
--glBlendFuncSeparate GL_SRC_ALPHA_SATURATE GL_ONE_MINUS_SRC_ALPHA GL_ONE GL_ONE_MINUS_SRC_ALPHA
--glBlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA
withArray [GL_COLOR_ATTACHMENT0, GL_NONE] $ \ptr -> glDrawBuffers 2 ptr
withArray [0.5, 0.5, 0.5, 0] $ \ptr ->
glClearNamedFramebufferfv
(pdata ^. fboCloud . _1 . unFBO)
GL_COLOR
0
ptr
-- renderLayer MidLayer shadV layerCounts
glUseProgram (pdata ^. cloudShader . shaderUINT)
glBindVertexArray $ pdata ^. cloudShader . shaderVAO . vaoName
glDrawElements
(pdata ^. cloudShader . shaderPrimitive . unPrimitiveMode)
(fromIntegral nCloudIs)
GL_UNSIGNED_SHORT
nullPtr
drawShader (_windowShader pdata) nWins
when (_graphics_cloud_shadows cfig) $ do
----render transparency depths
glDepthMask GL_TRUE
glDepthFunc GL_ALWAYS
glDisable GL_BLEND
withArray [GL_NONE, GL_COLOR_ATTACHMENT1, GL_COLOR_ATTACHMENT2] $ \ptr -> glDrawBuffers 3 ptr
withArray [0, 0, 0, 0] $ \ptr ->
glClearNamedFramebufferfv
(pdata ^. fboCloud . _1 . unFBO)
GL_COLOR
1
ptr
withArray [0, 0, 0, 0] $ \ptr ->
glClearNamedFramebufferfv
(pdata ^. fboCloud . _1 . unFBO)
GL_COLOR
2
ptr
glEnable GL_BLEND
-- we sum the positions weighted by alpha, and sum the alpha
glBlendFuncSeparatei 1 GL_SRC_ALPHA GL_ONE GL_ONE GL_ONE
-- and sum the normals weighted by alpha
glBlendFunci 2 GL_SRC_ALPHA GL_ONE
glUseProgram (pdata ^. cloudShader . shaderUINT)
glBindVertexArray $ pdata ^. cloudShader . shaderVAO . vaoName
glDepthMask GL_TRUE
glDrawElements
(pdata ^. cloudShader . shaderPrimitive . unPrimitiveMode)
(fromIntegral nCloudIs)
GL_UNSIGNED_SHORT
nullPtr
drawShader (_windowShader pdata) nWins
glBindFramebuffer GL_FRAMEBUFFER (pdata ^. fboPos . _1 . unFBO)
withArray [0, 0, 0, 0] $ \ptr ->
glClearNamedFramebufferfv
(pdata ^. fboPos . _1 . unFBO)
GL_COLOR
0
ptr
glBindTextureUnit 0 (pdata ^. fboCloud . _2 . _2 . unTO)
glDepthMask GL_FALSE
drawShader (pdata ^. alphaDivideShader) 4
----draw lightmap for cloud buffer
glDepthFunc GL_LESS
glEnable GL_BLEND
glBindFramebuffer GL_FRAMEBUFFER (_unFBO (fst (_fboLighting pdata)))
createLightMap
cfig
(fromIntegral trueNWalls)
nSilIndices
nIndices
(pdata ^. fboPos . _2)
(pdata ^. fboCloud . _2 . _3)
lightPoints
pdata
glInvalidateBufferData (pdata ^. vboShapes . vboName)
--apply lightmap to cloud buffer
glBindFramebuffer GL_FRAMEBUFFER (_unFBO (fst (_fboCloud pdata)))
glDepthMask GL_FALSE
withArray [GL_COLOR_ATTACHMENT0, GL_NONE] $ \ptr -> glDrawBuffers 2 ptr
glDepthFunc GL_ALWAYS
glBindTextureUnit 0 (_unTO . snd $ _fboLighting pdata)
glEnable GL_BLEND
glBlendFuncSeparate GL_ZERO GL_ONE_MINUS_SRC_COLOR GL_ZERO GL_ONE
drawShader (_fullscreenShader pdata) 4
glBlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA
-- --draw clouds onto cloud buffer
-- glBindFramebuffer GL_FRAMEBUFFER (_unFBO (fst (_fboCloud pdata)))
-- glDepthFunc GL_LEQUAL
-- glDepthMask GL_FALSE
-- --blendFunc $= (SrcAlphaSaturate,One)
-- --blendColor $= Color4 0.5 0.5 0.5 0.5
-- --blendFuncSeparate $= ((SrcAlphaSaturate,One) , (One,OneMinusSrcAlpha))
-- --blendFuncSeparate $= ((SrcAlpha, OneMinusSrcAlpha), (One, OneMinusSrcAlpha))
-- --glBlendFuncSeparate GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA GL_ONE GL_ONE_MINUS_SRC_ALPHA
-- glBlendFuncSeparate GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA GL_ONE_MINUS_DST_ALPHA GL_ONE
-- --glBlendFuncSeparate GL_SRC_ALPHA_SATURATE GL_ONE_MINUS_SRC_ALPHA GL_ONE GL_ONE_MINUS_SRC_ALPHA
-- --glBlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA
-- withArray [GL_COLOR_ATTACHMENT0, GL_NONE] $ \ptr -> glDrawBuffers 2 ptr
-- withArray [0.5, 0.5, 0.5, 0] $ \ptr ->
-- glClearNamedFramebufferfv
-- (pdata ^. fboCloud . _1 . unFBO)
-- GL_COLOR
-- 0
-- ptr
-- -- renderLayer MidLayer shadV layerCounts
-- glUseProgram (pdata ^. cloudShader . shaderUINT)
-- glBindVertexArray $ pdata ^. cloudShader . shaderVAO . vaoName
-- glDrawElements
-- (pdata ^. cloudShader . shaderPrimitive . unPrimitiveMode)
-- (fromIntegral nCloudIs)
-- GL_UNSIGNED_SHORT
-- nullPtr
-- drawShader (_windowShader pdata) nWins
-- when (_graphics_cloud_shadows cfig) $ do
-- ----render transparency depths
-- glDepthMask GL_TRUE
-- glDepthFunc GL_ALWAYS
-- glDisable GL_BLEND
-- withArray [GL_NONE, GL_COLOR_ATTACHMENT1, GL_COLOR_ATTACHMENT2] $ \ptr -> glDrawBuffers 3 ptr
-- withArray [0, 0, 0, 0] $ \ptr ->
-- glClearNamedFramebufferfv
-- (pdata ^. fboCloud . _1 . unFBO)
-- GL_COLOR
-- 1
-- ptr
-- withArray [0, 0, 0, 0] $ \ptr ->
-- glClearNamedFramebufferfv
-- (pdata ^. fboCloud . _1 . unFBO)
-- GL_COLOR
-- 2
-- ptr
-- glEnable GL_BLEND
-- -- we sum the positions weighted by alpha, and sum the alpha
-- glBlendFuncSeparatei 1 GL_SRC_ALPHA GL_ONE GL_ONE GL_ONE
-- -- and sum the normals weighted by alpha
-- glBlendFunci 2 GL_SRC_ALPHA GL_ONE
-- glUseProgram (pdata ^. cloudShader . shaderUINT)
-- glBindVertexArray $ pdata ^. cloudShader . shaderVAO . vaoName
-- glDepthMask GL_TRUE
-- glDrawElements
-- (pdata ^. cloudShader . shaderPrimitive . unPrimitiveMode)
-- (fromIntegral nCloudIs)
-- GL_UNSIGNED_SHORT
-- nullPtr
-- drawShader (_windowShader pdata) nWins
-- glBindFramebuffer GL_FRAMEBUFFER (pdata ^. fboPos . _1 . unFBO)
-- withArray [0, 0, 0, 0] $ \ptr ->
-- glClearNamedFramebufferfv
-- (pdata ^. fboPos . _1 . unFBO)
-- GL_COLOR
-- 0
-- ptr
-- glBindTextureUnit 0 (pdata ^. fboCloud . _2 . _2 . unTO)
-- glDepthMask GL_FALSE
-- drawShader (pdata ^. alphaDivideShader) 4
-- ----draw lightmap for cloud buffer
-- glDepthFunc GL_LESS
-- glEnable GL_BLEND
-- glBindFramebuffer GL_FRAMEBUFFER (_unFBO (fst (_fboLighting pdata)))
-- createLightMap
-- cfig
-- (fromIntegral trueNWalls)
-- nSilIndices
-- nIndices
-- (pdata ^. fboPos . _2)
-- (pdata ^. fboCloud . _2 . _3)
-- lightPoints
-- pdata
-- glInvalidateBufferData (pdata ^. vboShapes . vboName)
-- --apply lightmap to cloud buffer
-- glBindFramebuffer GL_FRAMEBUFFER (_unFBO (fst (_fboCloud pdata)))
-- glDepthMask GL_FALSE
-- withArray [GL_COLOR_ATTACHMENT0, GL_NONE] $ \ptr -> glDrawBuffers 2 ptr
-- glDepthFunc GL_ALWAYS
-- glBindTextureUnit 0 (_unTO . snd $ _fboLighting pdata)
-- glEnable GL_BLEND
-- glBlendFuncSeparate GL_ZERO GL_ONE_MINUS_SRC_COLOR GL_ZERO GL_ONE
-- drawShader (_fullscreenShader pdata) 4
-- glBlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA
-- bind base buffer for drawing bloom then clouds
glBindFramebuffer GL_FRAMEBUFFER (_unFBO (fst (_fboBase pdata)))
--Draw blurred bloom onto base buffer
@@ -346,9 +349,9 @@ doDrawing' win pdata u = do
glBindTextureUnit 0 (_unTO . snd $ _fboHalf1 pdata)
drawShader (_fullscreenShader pdata) 4
glBlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA
--draw shadowed clouds onto base buffer
glBindTextureUnit 0 (pdata ^. fboCloud . _2 . _1 . unTO)
drawShader (_fullscreenShader pdata) 4
-- --draw shadowed clouds onto base buffer
-- glBindTextureUnit 0 (pdata ^. fboCloud . _2 . _1 . unTO)
-- drawShader (_fullscreenShader pdata) 4
--set viewport for radial distortion
--setViewportSize (round winx) (round winy)
setViewport (const FullRes) cfig
src/Dodge/TestString.hs
+1
View File
@@ -19,6 +19,7 @@ import Dodge.Data.Universe
testStringInit :: Universe -> [String]
testStringInit u = [show $ u ^. uvWorld . input . smoothScrollAmount
, show $ getSmoothScrollValue (u ^. uvWorld . input)
, show (u ^. uvConfig . windowX) ++ " " ++ show (u ^. uvConfig . windowY)
]
-- [show $ length $ lightsToRender (u ^. uvConfig) (u ^. uvWorld . wCam)
-- (u ^. uvWorld . cWorld . lWorld)
src/Picture/Base.hs
+2 -1
View File
@@ -201,7 +201,8 @@ stackText = mconcat . zipWith (\y s -> translate 0 y $ centerText s) [0, 100 ..]
text :: String -> Picture
{-# INLINE text #-}
text = translate (-50) (-100) . drawText (10)
--text = translate (-50) (-100) . drawText (10)
text = translate (-50) (-100) . drawText (-10)
drawText :: Float -> String -> [Verx]
drawText gap = map f . stringToList gap
src/Preload/Render.hs
+78 -38
View File
@@ -6,20 +6,20 @@ module Preload.Render (
) where
import Control.Concurrent
import Shader.AuxAddition
import Shape.Data
import GLHelp
import Control.Lens
import Control.Monad
import Data.Preload.Render
import qualified Data.Vector.Mutable as MV
import Foreign
import Framebuffer.Setup
import GLHelp
import Graphics.GL.Core45
import Shader
import Shader.AuxAddition
import Shader.Compile
import Shader.Data
import Shader.Parameters
import Graphics.GL.Core45
import Shape.Data
{- BINDING LIST:
0 base
@@ -30,24 +30,46 @@ import Graphics.GL.Core45
preloadRender :: IO RenderData
preloadRender = do
putStrLn "Number cores available:"
getNumCapabilities >>= print
forM_ [0, 1, 2] $ \i -> do
putStrLn $ "GL_MAX_COMPUTE_WORK_GROUP_COUNT " ++ show i
alloca $ \ptr -> do
glGetIntegeri_v GL_MAX_COMPUTE_WORK_GROUP_COUNT i ptr
x <- peek ptr
putStrLn $ show x
forM_ [0, 1, 2] $ \i -> do
putStrLn $ "GL_MAX_COMPUTE_WORK_GROUP_SIZE " ++ show i
alloca $ \ptr -> do
glGetIntegeri_v GL_MAX_COMPUTE_WORK_GROUP_SIZE i ptr
x <- peek ptr
putStrLn $ show x
putStrLn $ "GL_MAX_COMPUTE_WORK_GROUP_INVOCATIONS"
alloca $ \ptr -> do
glGetIntegerv GL_MAX_COMPUTE_WORK_GROUP_INVOCATIONS ptr
x <- peek ptr
putStrLn $ show x
-- set up uniform buffer object
putStrLn "Setup UBO"
theUBO <- mglCreate glCreateBuffers
glNamedBufferData theUBO 64 nullPtr GL_STREAM_DRAW
glBindBufferBase GL_UNIFORM_BUFFER 0 theUBO
getNumCapabilities >>= print
-- orthonormalUBO <- mglCreate glCreateBuffers
-- withArray idMat $ \ptr ->
-- glNamedBufferStorage orthonormalUBO 64 ptr 0
-- orthonormalUBO <- mglCreate glCreateBuffers
-- withArray idMat $ \ptr ->
-- glNamedBufferStorage orthonormalUBO 64 ptr 0
lightsubo <- mglCreate glCreateBuffers
glNamedBufferData lightsubo 640 nullPtr GL_STREAM_DRAW
glBindBufferBase GL_UNIFORM_BUFFER 1 lightsubo
-- setup shape geometry/cap VBO and two VAOs
putStrLn "Setup shape VBO, VAO, EBO"
shVBO <- setupVBO nShapeVerxComp
shPosVAO <- setupVAOUsingVBO [4] shVBO
shPosVAO <- setupVAOUsingVBO [4] shVBO
shEBO <- setupEBO shPosVAO
-- note the shape shader vao is distinct from the position vao, but they
-- share an EBO
@@ -55,41 +77,52 @@ preloadRender = do
glVertexArrayElementBuffer (shapeshader ^. shaderVAO . vaoName) (shEBO ^. eboName)
--setup silhouette edge VAO
shedgevao <- setupVAOUsingVBO [4] shVBO
putStrLn "Setup silhouette VAO, EBO"
shedgevao <- setupVAOUsingVBO [4] shVBO
shedgeebo <- setupEBO shedgevao
putStrLn "Setup wall/windows VBO, VAO, EBO, shader"
let wallverxstrd = 8
wallvbo <- setupVBO wallverxstrd
winvbo <- setupVBO 8
windowshader <- makeShaderUsingVBO "wall/blank" [vert, geom, frag] [4, 4] pmPoints winvbo
wallshader <- makeShaderUsingVBO "wall/basic" [vert, geom, frag] [4, 4] pmPoints wallvbo
putStrLn "Setup lighting shaders"
lightingWallShadShad <-
makeShaderUsingVBO "lighting/wallShadow" [vert, geom] [4] pmPoints wallvbo
lightingCapShad <-
makeShaderUsingVAO "lighting/cap" [vert, geom] pmTriangles shPosVAO
lightingLineShadowShad <-
makeShaderUsingVAO "lighting/lineShadow" [vert, geom] pmLinesAdjacency shedgevao
makeShaderUsingVAO "lighting/lineShadow" [vert, geom] pmLinesAdjacency shedgevao
shadowedgeshader <-
makeShaderUsingVAO "shadow/edge" [vert, geom] pmLinesAdjacency shedgevao
shadowcapshader <-
makeShaderUsingVAO "shadow/cap" [vert, geom] pmTriangles shPosVAO
shadowwallshader <-
makeShaderUsingVBO "shadow/wallShadow" [vert, geom] [4] pmPoints wallvbo
shadowlightshader <- makeShaderSized "shadow/light" [vert, geom, frag]
[1] 1
pmPoints
shadowcombineshader <- makeShaderSized "shadow/combine" [vert,geom,frag] [1] 1 pmPoints
shadowlightshader <-
makeShaderSized
"shadow/light"
[vert, geom, frag]
[1]
1
pmPoints
shadowcombineshader <- makeShaderSized "shadow/combine" [vert, geom, frag] [1] 1 pmPoints
poke (shadVBOptr shadowlightshader) 1
-- 2D draw shaders
putStrLn "Setup 2D shaders"
bslist <- makeShaderVBO "dualTwoD/basic" [vert, frag] [3, 4] pmTriangles
aslist <- makeShaderVBO "dualTwoD/arc" [vert, frag] [3, 4, 3] pmTriangles
eslist <- makeShaderVBO "dualTwoD/ellipse" [vert, geom, frag] [3, 4] pmTriangles
cslist <-
makeShaderVBO "picture/charArray" [vert, frag] [3, 4, 4] pmTriangles
-- initTexture2DArray 50 "data/texture/charMapVertBig.png" 2 32 64 95 GL_NEAREST_MIPMAP_LINEAR GL_LINEAR
-- initTexture2DArray 50 "data/texture/charMapVert16Block.png" 2 16 32 95 GL_NEAREST GL_NEAREST
initTexture2DArray 50 "data/texture/charMapVert8Block.png" 2 8 16 95 GL_NEAREST GL_NEAREST
-- initTexture2DArray 50 "data/texture/charMapVertBig.png" 2 32 64 95 GL_NEAREST_MIPMAP_LINEAR GL_LINEAR
initTexture2DArray 50 "data/texture/charMapVert16Block.png" 2 16 32 95 GL_NEAREST GL_NEAREST
--initTexture2DArray 50 "data/texture/charMapVert8Block.png" 2 8 16 95 GL_NEAREST GL_NEAREST
--initTexture2DArray 50 "data/texture/charMapVertBig.png" 2 32 64 95 GL_LINEAR_MIPMAP_LINEAR GL_LINEAR
--initTexture2DArray 50 "data/texture/charMapVertBig.png" 2 32 64 95 GL_LINEAR_MIPMAP_NEAREST GL_LINEAR
putStrLn "Setup full screen shaders"
screentexturevbo <- mglCreate glCreateBuffers
withArray (concat cornerList) $ \ptr ->
glNamedBufferStorage
@@ -97,8 +130,8 @@ preloadRender = do
(fromIntegral $ floatSize * length (concat cornerList))
ptr
0
screentexturevao <- setupVAOvbo' [2,2] 4 screentexturevbo
alphadivideshader <- makeShaderUsingVAO "texture2D/alphaDivide" [vert,frag] pmTriangleStrip screentexturevao
screentexturevao <- setupVAOvbo' [2, 2] 4 screentexturevbo
alphadivideshader <- makeShaderUsingVAO "texture2D/alphaDivide" [vert, frag] pmTriangleStrip screentexturevao
fsShad <- makeShaderUsingVAO "texture/simple" [vert, frag] pmTriangleStrip screentexturevao
bloomBlurShad <- makeShaderUsingVAO "texture/bloomBlur" [vert, frag] pmTriangleStrip screentexturevao
colorBlurShad <- makeShaderUsingVAO "texture/colorBlur" [vert, frag] pmTriangleStrip screentexturevao
@@ -107,24 +140,24 @@ preloadRender = do
makeShaderUsingVAO "lighting/texture" [vert, frag] pmTriangleStrip screentexturevao
barrelShad <- makeShaderVBO "texture/barrel" [vert, geom, frag] [2, 2, 2, 1] pmPoints
-- blank wallShader
winvbo <- setupVBO 8
windowshader <- makeShaderUsingVBO "wall/blank" [vert, geom, frag] [4,4] pmPoints winvbo
wallshader <- makeShaderUsingVBO "wall/basic" [vert,geom,frag] [4,4] pmPoints wallvbo
putStrLn "Setup floor VBO, shader"
let floorverxstrd = 8
floorvbo <- setupVBOStatic floorverxstrd
floorshader <- makeShaderUsingVBO "floor/arrayPos" [vert, frag] [4,4] pmTriangles floorvbo
floorshader <- makeShaderUsingVBO "floor/arrayPos" [vert, frag] [4, 4] pmTriangles floorvbo
initTexture2DArraySquare 40 3 GL_LINEAR_MIPMAP_LINEAR GL_LINEAR "data/normalMaps/diffuseArray.png"
initTexture2DArraySquare 41 3 GL_LINEAR_MIPMAP_LINEAR GL_LINEAR "data/normalMaps/normalArray.png"
let cloudverxsizes = [4,4,4,4]
putStrLn "Setup cloud VBO, shader"
let cloudverxsizes = [4, 4, 4, 4]
cloudvbo <- setupVBO (sum cloudverxsizes)
(cloudshader, cloudebo)
<- makeShaderEBO "cloud/basic" [vert, frag] cloudverxsizes pmTriangles cloudvbo
(cloudshader, cloudebo) <-
makeShaderEBO "cloud/basic" [vert, frag] cloudverxsizes pmTriangles cloudvbo
framebuf2 <- newTextureFramebuffer
framebuf3 <- newTextureFramebuffer
putStrLn "Setup framebuffers"
rboBaseBloomName <- mglCreate glCreateRenderbuffers
glNamedRenderbufferStorage
glNamedRenderbufferStorage
rboBaseBloomName
GL_DEPTH24_STENCIL8
800
@@ -156,10 +189,16 @@ preloadRender = do
, aslist
, eslist
]
-- setup compute shader
computeshadowshader <- makeSourcedShader "compute/shadow" [GL_COMPUTE_SHADER]
initializeGLState
putStrLn "Return preload"
return $
RenderData
{ _pictureShaders = shadV
{ _computeShadowShader = computeshadowshader
, _pictureShaders = shadV
, _shapeShader = shapeshader -- & shaderVAO' .~ shPosColVAO
, _shapeEBO = shEBO
, _silhouetteEBO = shedgeebo
@@ -193,8 +232,8 @@ preloadRender = do
, _fboOverlay = fbooverlay
, _rboBaseBloom = rboBaseBloomName
, _matUBO = theUBO
-- , _orthonormalMatUBO = orthonormalUBO
, _lightsUBO = lightsubo
, -- , _orthonormalMatUBO = orthonormalUBO
_lightsUBO = lightsubo
, _vboWindows = winvbo
, _vboShapes = shVBO
, _floorVBO = floorvbo
@@ -215,6 +254,7 @@ cornerList =
, [1, 1, 1, 1]
, [1, -1, 1, 0]
]
--cornerListForTriangles :: [[Float]]
--cornerListForTriangles =
-- [ [-1, 1, 0, 1]
@@ -229,11 +269,11 @@ initializeGLState :: IO ()
initializeGLState = do
glEnable GL_DEPTH_TEST
cleanUpRenderPreload :: RenderData -> IO ()
cleanUpRenderPreload _ = return ()
--cleanUpRenderPreload pd = do
-- TODO fix this
--mapM_ freeShaderPointers $ _pictureShaders pd
--freeShaderPointers' $ _lightingWallShadShader pd
--freeShaderPointers' $ _fullscreenShader pd
-- TODO fix this
--mapM_ freeShaderPointers $ _pictureShaders pd
--freeShaderPointers' $ _lightingWallShadShader pd
--freeShaderPointers' $ _fullscreenShader pd
src/Render.hs
+27 -5
View File
@@ -44,6 +44,7 @@ createLightMap cfig = case shadrendertype of
InstancingShads -> instanceLightMap cfig
NoShadows -> const . const . const renderLightingNoShadows
NoLighting -> const . const . const . const . const . const renderFlatLighting
ComputeShader -> renderComputeShadows
_ -> renderShadows shadrendertype
where
shadrendertype = cfig ^. graphics_shadow_rendering
@@ -103,6 +104,28 @@ renderLightingNoShadows positiontexture normaltexture lightPoints pdata = do
glDisable GL_CULL_FACE
glDisable GL_STENCIL_TEST
renderComputeShadows ::
GLsizei ->
Int ->
Int ->
TO ->
TO ->
[(Point3, Float, Point3)] ->
RenderData ->
IO ()
renderComputeShadows _ _ _ toPos tanormals lightPoints rd = do
withArray (lightsToArray lightPoints) $ \ptr ->
glNamedBufferSubData (rd ^. lightsUBO) 0 620 ptr
glBindTextureUnit 0 (toPos ^. unTO)
glBindTextureUnit 1 (tanormals ^. unTO)
glBindImageTexture 5 (rd ^. fboLighting . _2 . unTO) 0 GL_FALSE 0 GL_WRITE_ONLY GL_RGBA8
glUseProgram (rd ^. computeShadowShader)
glDispatchCompute 800 835 1
-- the following should be later, just before the texture is accessed
--glMemoryBarrier GL_SHADER_IMAGE_ACCESS_BARRIER_BIT
glMemoryBarrier GL_TEXTURE_FETCH_BARRIER_BIT
return ()
renderFlatLighting :: RenderData -> IO ()
renderFlatLighting pdata = do
glBindFramebuffer GL_FRAMEBUFFER (_unFBO (fst (_fboLighting pdata)))
@@ -145,12 +168,14 @@ renderShadows shadrendertype nWalls nSils nCaps positiontexture normaltexture li
ptr
-- for each of the lights:
-- 1. stencil out the shadows from this light's point of view
-- 2. calculate lighting based on each fragment's position
-- to consider: adding normals/a "material" for each fragment
-- 2. calculate lighting based on each fragment's position and normal
glBlendFunc GL_ZERO GL_ONE_MINUS_SRC_COLOR
glEnable GL_STENCIL_TEST
glStencilOpSeparate GL_FRONT GL_KEEP GL_KEEP GL_INCR_WRAP
glStencilOpSeparate GL_BACK GL_KEEP GL_KEEP GL_DECR_WRAP
-- bind world position texture-- these will be used by the lighting shader
glBindTextureUnit 0 (positiontexture ^. unTO)
glBindTextureUnit 1 (normaltexture ^. unTO)
flip VFSM.mapM_ (VFSM.fromList lightPoints) $ \(V3 x y z, rad, V3 r g b) -> do
glDepthFunc GL_LESS
-- setup stencil
@@ -200,10 +225,7 @@ renderShadows shadrendertype nWalls nSils nCaps positiontexture normaltexture li
_ -> return ()
--draw lightmap itself
glDepthFunc GL_ALWAYS
-- bind world position texture
glDisable GL_CULL_FACE
glBindTextureUnit 0 (positiontexture ^. unTO)
glBindTextureUnit 1 (normaltexture ^. unTO)
glColorMask GL_TRUE GL_TRUE GL_TRUE GL_TRUE
glStencilFunc GL_EQUAL 0 255
glUseProgram (ltextShad ^. shaderUINT) --Just (_shadProg ltextShad)
src/Shader/Compile.hs
+6 -3
View File
@@ -12,6 +12,7 @@ module Shader.Compile (
setupVAOvbo',
setupEBO,
setupVertexAttribPointer,
makeSourcedShader,
) where
import Control.Lens
@@ -66,7 +67,8 @@ makeShaderEBO s shaderlist sizes pm vbo = do
shad <- makeShaderUsingVBO s shaderlist sizes pm vbo
ebo <- setupEBO (shad ^. shaderVAO)
glVertexArrayElementBuffer (shad ^. shaderVAO . vaoName) (ebo ^. eboName)
return ( shad
return
( shad
, ebo
)
@@ -81,7 +83,7 @@ makeShaderUsingVBO ::
VBO ->
IO Shader
makeShaderUsingVBO s shaderlist sizes pm vbo = do
vao <- setupVAOUsingVBO sizes vbo
vao <- setupVAOUsingVBO sizes vbo
makeShaderUsingVAO s shaderlist pm vao
setupVBO :: Int -> IO VBO
@@ -183,6 +185,7 @@ shaderTypeExt :: GLenum -> String
shaderTypeExt GL_VERTEX_SHADER = ".vert"
shaderTypeExt GL_GEOMETRY_SHADER = ".geom"
shaderTypeExt GL_FRAGMENT_SHADER = ".frag"
shaderTypeExt GL_COMPUTE_SHADER = ".comp"
shaderTypeExt _ = undefined
-- I think that this requires that the correct shader program is bound?
@@ -207,7 +210,7 @@ setupVAOUsingVBO sizes vbo = do
vaoname <- mglCreate glCreateVertexArrays
glBindVertexArray vaoname
setupVertexAttribs vbo vaoname sizes strd
return VAO { _vaoName = vaoname }
return VAO{_vaoName = vaoname}
setupEBO :: VAO -> IO EBO
setupEBO vao = do
src/Shader/Poke.hs
+110 -47
View File
@@ -3,22 +3,23 @@ module Shader.Poke (
pokeLayVerxs,
pokeArrayOff,
pokeShape,
pokeShape',
pokeWallsWindows,
memoTopPrismEdgeIndices,
pokeFloors
pokeFloors,
) where
import Geometry.Vector
import Dodge.Data.Wall
import Geometry.Triangulate
import Control.Monad.Primitive
import qualified Data.Vector as V
import qualified Data.Vector.Fusion.Stream.Monadic as VFSM
import qualified Data.Vector.Mutable as MV
import qualified Data.Vector.Unboxed as UV
import qualified Data.Vector.Unboxed.Mutable as UMV
import Dodge.Data.Wall
import Foreign
import Geometry.Data
import Geometry.Triangulate
import Geometry.Vector
import Graphics.GL.Core45
import Linear.V3 (cross)
import Picture.Data
@@ -34,6 +35,7 @@ pokeVerxs ::
pokeVerxs vbos count = VFSM.mapM_ (pokeVerx vbos count) . VFSM.fromList
pokeVerx :: MV.MVector (PrimState IO) (Shader, VBO) -> UMV.MVector (PrimState IO) Int -> Verx -> IO ()
{-# INLINE pokeVerx #-}
pokeVerx vbos offsets Verx{_vxPos = thePos, _vxCol = theCol, _vxExt = ext, _vxShadNum = shadnum} = do
typeOff <- UMV.unsafeRead offsets sn
basePtr <- _vboPtr . snd <$> MV.unsafeRead vbos sn
@@ -53,9 +55,10 @@ pokeWallsWindows ::
pokeWallsWindows wiptr truewlptr wis truewls = do
wlcounts2 <- VFSM.foldlM' (pokeW wiptr) 0 (VFSM.fromList wis)
wlcounts3 <- VFSM.foldlM' (pokeWall truewlptr) 0 (VFSM.fromList truewls)
return ( wlcounts2, wlcounts3)
return (wlcounts2, wlcounts3)
pokeFloors :: Ptr Float ->
pokeFloors ::
Ptr Float ->
[(Point3, Point3)] ->
IO Int
pokeFloors flptr fls = VFSM.foldlM' (pokeF flptr) 0 (VFSM.fromList fls)
@@ -72,8 +75,9 @@ pokeF ptr i' (V3 a b c, V3 d e f) = do
return $ i' + 1
pokeWall :: Ptr Float -> Int -> Wall -> IO Int
{-# INLINE pokeWall #-}
pokeWall ptr nw wl = do
UV.imapM_ f $ UV.fromList [x,y,x1,y1,t,a,1,1]
UV.imapM_ f $ UV.fromList [x, y, x1, y1, t, a, 1, 1]
return $ nw + 1
where
f i = pokeElemOff ptr (nw * 8 + i)
@@ -94,6 +98,15 @@ pokeW ptr i' ((V2 a b, V2 c d), V4 e f g h) = do
pokeElemOff ptr (i + 7) h
return $ i' + 1
pokeShape' ::
Ptr Float ->
Ptr GLushort ->
Ptr GLushort ->
(Int, Int, Int) ->
[Surface] ->
IO (Int, Int, Int)
pokeShape' = pokeShape $ const False
pokeShape ::
(Surface -> Bool) ->
Ptr Float ->
@@ -102,8 +115,9 @@ pokeShape ::
(Int, Int, Int) ->
[Surface] ->
IO (Int, Int, Int)
pokeShape shadowtest ptr iptr ieptr is = VFSM.foldlM' (pokeShapeObj shadowtest ptr iptr ieptr) is
. VFSM.fromList
pokeShape shadowtest ptr iptr ieptr is =
VFSM.foldlM' (pokeShapeObj shadowtest ptr iptr ieptr) is
. VFSM.fromList
pokeShapeObj ::
(Surface -> Bool) ->
@@ -139,12 +153,17 @@ pokeRoundedFaces sfid col size ptr iptr ieptr (nv, nsi, nei) (tc : bc : svs) = d
(pokeIndex nv iptr)
nsi
(memoTopPrismIndices V.! (size - 3))
nei' <- if sfid then return nei
else UV.foldM' (pokeIndex nv ieptr) nei $
memoTopPrismEdgeIndices V.! (size - 3)
nei' <-
if sfid
then return nei
else
UV.foldM' (pokeIndex nv ieptr) nei $
memoTopPrismEdgeIndices V.! (size - 3)
return (nv', nsi', nei')
where
xdata | sfid = 0
xdata
| sfid = 0 -- this records whether the shadow should be shown or not
-- honestly, I think things where faster without this
| otherwise = 1
pokeRoundedFaces _ _ _ _ _ _ _ _ = undefined
@@ -166,13 +185,16 @@ pokeCylinder sfid col size ptr iptr ieptr (nv, nsi, nei) (tc : bc : svs) = do
(pokeIndex nv iptr)
nsi
(memoCylinderIndices V.! (size - 3))
nei' <- if sfid
then return nei
else UV.foldM' (pokeIndex nv ieptr) nei $
memoTopPrismEdgeIndices V.! (size - 3)
nei' <-
if sfid
then return nei
else
UV.foldM' (pokeIndex nv ieptr) nei $
memoTopPrismEdgeIndices V.! (size - 3)
return (nv', nsi', nei')
where
xdata | sfid = 0
xdata
| sfid = 0
| otherwise = 1
pokeCylinder _ _ _ _ _ _ _ _ = undefined
@@ -180,11 +202,12 @@ pokeRoundedCurve :: Float -> Point4 -> Ptr Float -> Point3 -> Point3 -> [Point3]
{-# INLINE pokeRoundedCurve #-}
pokeRoundedCurve xdata col ptr tc bc = go True
where
go True (x : xs) n = pokeJustV xdata tc col ptr n x >>= go False xs
go False (x : xs) n = pokeJustV xdata bc col ptr n x >>= go True xs
go True (x : xs) n = pokeJustV xdata tc col ptr n x >>= go False xs
go False (x : xs) n = pokeJustV xdata bc col ptr n x >>= go True xs
go _ [] n = return n
pokeCylinderCaps :: Float -> Point4 -> Ptr Float -> Point3 -> Point3 -> [Point3] -> Int -> IO Int
{-# INLINE pokeCylinderCaps #-}
pokeCylinderCaps xdata col ptr tc bc = go True
where
go True (x : xs) n = pokeJustVInvNormal xdata tc col ptr n x >>= go False xs
@@ -209,17 +232,22 @@ pokeBox sfid col size ptr iptr ieptr (nv, nsi, nei) svs = do
(pokeIndex nv iptr)
nsi
(memoFlatIndices V.! (size -3))
nei' <- if sfid then return nei
else UV.foldM' (pokeIndex nv ieptr) nei $
memoBoxEdgeIndices V.! (size - 3)
nei' <-
if sfid
then return nei
else
UV.foldM' (pokeIndex nv ieptr) nei $
memoBoxEdgeIndices V.! (size - 3)
return (nv', nsi', nei')
where
svsv = UV.fromList svs
xdata | sfid = 0
xdata
| sfid = 0
| otherwise = 1
-- should probably use a vector of Point3
pokeBoxSurface :: Float -> Point4 -> Ptr Float -> UV.Vector Point3 -> Int -> [Int] -> IO Int
{-# INLINE pokeBoxSurface #-}
pokeBoxSurface xdata col ptr vs n is =
UV.foldM'
(pokeFlatV xdata norm col ptr)
@@ -241,11 +269,11 @@ boxSurfaces size =
where
f x = map (`mod` (size * 2)) [x, x + 1, x + 3, x + 2]
boxSurfaces' :: Int -> [[Int]]
boxSurfaces' n =
boxSurfacesIndices :: Int -> [[Int]]
boxSurfacesIndices n =
[0 .. n -1] :
reverse [n .. n * 2 -1] :
[ map ((2 * n) +) [4 * i, 4 * i + 1, 4 * i + 2, 4 * i + 3] | i <- [0 .. n -1]]
[map ((2 * n) +) [4 * i, 4 * i + 1, 4 * i + 2, 4 * i + 3] | i <- [0 .. n -1]]
pokeIndex ::
-- | base index
@@ -261,11 +289,11 @@ pokeIndex nv eiptr ni ioff = do
pokeElemOff eiptr ni (fromIntegral $ nv + ioff)
return $ ni + 1
memoFlatIndices :: V.Vector (UV.Vector Int)
{-# INLINE memoFlatIndices #-}
memoFlatIndices =
V.generate 10 $
UV.fromList . concatMap polyToTris . boxSurfaces' . (+ 3)
UV.fromList . concatMap polyToTris . boxSurfacesIndices . (+ 3)
memoTopPrismIndices :: V.Vector (UV.Vector Int)
{-# INLINE memoTopPrismIndices #-}
@@ -289,10 +317,21 @@ topPrismEdgeIndices ::
[Int]
topPrismEdgeIndices n = concatMap f [0 .. n -1]
where
f i = map g
[ 0 , 2 , 1 , 4
, 0 , 1 , -2 , 3
, 1 , 3 , -1 , 2
f i =
map
g
[ 0
, 2
, 1
, 4
, 0
, 1
, -2
, 3
, 1
, 3
, -1
, 2
]
where
g j = (2 * i + j) `mod` (2 * n)
@@ -308,10 +347,20 @@ boxEdgeIndices ::
[Int]
boxEdgeIndices n = concatMap f [0 .. n -1]
where
f i = [ g 0 , g 1 ,n + g 0 , g 2
, g 0 , n + g 0 , n + g (-1) , g 1
, n + g 0 , n + g 1 , n + g (-1) , g 1
]
f i =
[ g 0
, g 1
, n + g 0
, g 2
, g 0
, n + g 0
, n + g (-1)
, g 1
, n + g 0
, n + g 1
, n + g (-1)
, g 1
]
where
g j = (i + j) `mod` n
@@ -323,14 +372,22 @@ cylinderIndices n =
cylinderRoundIndices :: Int -> [Int]
cylinderRoundIndices n =
[ 2 * n -2 , 2 * n -1 , 1
, 2 * n -2 , 1 , 0 -- last side triangle (applies mod 2n)
[ 2 * n -2
, 2 * n -1
, 1
, 2 * n -2
, 1
, 0 -- last side triangle (applies mod 2n)
]
++ concatMap g [0 .. n -2] -- other triangles on sides
where
g x =
[ 2 * x , 2 * x + 1 , 2 * x + 3
, 2 * x , 2 * x + 3 , 2 * x + 2
[ 2 * x
, 2 * x + 1
, 2 * x + 3
, 2 * x
, 2 * x + 3
, 2 * x + 2
]
topPrismIndices :: Int -> [Int]
@@ -338,21 +395,27 @@ topPrismIndices n =
concatMap f [1 .. n -2] -- triangles on top face
++ concatMap f' [1 .. n -2] -- triangles on bottom face
-- these should be checked
++ [ 2 * n -2 , 2 * n -1 , 1
, 2 * n -2 , 1 , 0 -- last side triangle (applies mod 2n)
++ [ 2 * n -2
, 2 * n -1
, 1
, 2 * n -2
, 1
, 0 -- last side triangle (applies mod 2n)
]
++ concatMap g [0 .. n -2] -- other triangles on sides
where
f x = [0, 2 * x, 2 * x + 2]
f' x = [1, 2 * x + 3, 2 * x + 1]
g x =
[ 2 * x , 2 * x + 1 , 2 * x + 3
, 2 * x , 2 * x + 3 , 2 * x + 2
[ 2 * x
, 2 * x + 1
, 2 * x + 3
, 2 * x
, 2 * x + 3
, 2 * x + 2
]
-- consider changing the position to a vec4
-- and just doing two pokes rather than seven
-- (especially if adding normal data)
pokeJustV ::
Float ->
Point3 ->
src/Shader/Poke/Cloud.hs
+3
View File
@@ -15,6 +15,7 @@ pokeCloud vptr iptr (nv,ni) cl = do
return (nv + 4, ni + 6)
pokeCloudVerx :: Ptr Float -> Cloud -> Int -> Int -> (Float, Float) -> IO ()
{-# INLINE pokeCloudVerx #-}
pokeCloudVerx ptr cl nv i (dx, dy) =
UV.imapM_ (pokeCloudFloat ptr (nv + i)) $ UV.fromList
[x, y, cz, 1, r, g, b, a, cx, cy, cz, rad, dx, dy, 0, 0]
@@ -26,7 +27,9 @@ pokeCloudVerx ptr cl nv i (dx, dy) =
a = a' * min 1 (fromIntegral (_clTimer cl) / fadet)
pokeCloudFloat :: Ptr Float -> Int -> Int -> Float -> IO ()
{-# INLINE pokeCloudFloat #-}
pokeCloudFloat ptr nv i = pokeElemOff ptr (nv * 16 + i)
pokeCloudIndex :: Ptr GLushort -> Int -> Int -> Int -> Int -> IO ()
{-# INLINE pokeCloudIndex #-}
pokeCloudIndex ptr nv ni ioff voff = pokeElemOff ptr (ni + ioff) (fromIntegral $ nv + voff)