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

Cleanup matrices

Browse Source
This commit is contained in:
jgk
2021-06-24 18:49:10 +02:00
parent d4795749e3
commit bae8a4ed94
7 changed files with 35 additions and 141 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Render.hs
+7 -17
View File
@@ -57,22 +57,13 @@ doDrawing pdata w = do
wallPoints = map fst wallPointsCol wallPoints = map fst wallPointsCol
-- set the coordinate uniform ready for drawing elements using world coordinates -- set the coordinate uniform ready for drawing elements using world coordinates
let pmat = perspectiveMatrixb rot camzoom trans wins viewFroms bufferUBO $ perspectiveMatrixb rot camzoom trans wins viewFroms
withArray pmat $ \ptr ->
bufferData UniformBuffer $=
(fromIntegral $ sizeOf (head pmat) * length pmat
,ptr
,StreamDraw
)
depthFunc $= Just Less depthFunc $= Just Less
-- draw the lightmap. Probably changes the bound framebufferObject -- draw the lightmap. Probably changes the bound framebufferObject
createLightMap pdata (w ^. config . shadow_resolution) wallPoints lightPoints viewFroms createLightMap pdata (w ^. config . shadow_resolution) wallPoints lightPoints viewFroms
(foregroundPics w) (foregroundPics w)
-- -- set the coordinate uniforms ready for drawing elements using world coordinates
-- setCommonUniforms pdata rot camzoom trans wins
-- draw the background. Assumes that depth testing is not enabled or that -- draw the background. Assumes that depth testing is not enabled or that
-- the depth buffer is ready to be drawn on -- the depth buffer is ready to be drawn on
blendFuncSeparate $= ((SrcAlphaSaturate, OneMinusSrcAlpha), (Zero,One)) blendFuncSeparate $= ((SrcAlphaSaturate, OneMinusSrcAlpha), (Zero,One))
@@ -129,13 +120,7 @@ doDrawing pdata w = do
drawShader (_grayscaleShader pdata) 4 drawShader (_grayscaleShader pdata) 4
blend $= Enabled blend $= Enabled
let pmata = perspectiveMatrixc 0 1 (0,0) (2,2) bufferUBO $ perspectiveMatrixc 0 1 (0,0) (2,2)
withArray pmata $ \ptr ->
bufferData UniformBuffer $=
(fromIntegral $ sizeOf (head pmat) * length pmat
,ptr
,StreamDraw
)
blendFunc $= (SrcAlpha,OneMinusSrcAlpha) blendFunc $= (SrcAlpha,OneMinusSrcAlpha)
_ <- renderFoldable pdata (picToLTree Nothing $ fixedCoordPictures w) _ <- renderFoldable pdata (picToLTree Nothing $ fixedCoordPictures w)
@@ -144,6 +129,11 @@ doDrawing pdata w = do
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- note we currently assume there is only one UBO, we only bind it once at setup
bufferUBO :: [Float] -> IO ()
bufferUBO mat = withArray mat $ \ptr ->
bufferSubData UniformBuffer WriteToBuffer 0 64 ptr
renderBlankWalls renderBlankWalls
:: RenderData :: RenderData
-> [((Point2,Point2),Point4)] -- ^ List: wall positions and color -> [((Point2,Point2),Point4)] -- ^ List: wall positions and color
src/Dodge/Room/Foreground.hs
+1 -1
View File
@@ -89,7 +89,7 @@ girderV col w x y = setDepth (-0.1) $ color col $ pictures $
bs' = catMaybes $ zipWith (fmap . (,)) as $ f (3*pi/4) as bs' = catMaybes $ zipWith (fmap . (,)) as $ f (3*pi/4) as
girder :: Color -> Float -> Point2 -> Point2 -> Picture girder :: Color -> Float -> Point2 -> Point2 -> Picture
girder col w x y = pictures $ girder col w x y = pictures $
(setDepth (-0.1) $ color col $ pictures $ setDepth (-0.1) (color col $ pictures $
[ thickLine [xt,yt] 3 [ thickLine [xt,yt] 3
, thickLine [xb,yb] 3 , thickLine [xb,yb] 3
] ]
src/MatrixHelper.hs
+22 -113
View File
@@ -1,9 +1,6 @@
module MatrixHelper module MatrixHelper
( perspectiveMatrix ( perspectiveMatrixb
, perspectiveMatrixa
, perspectiveMatrixb
, perspectiveMatrixc , perspectiveMatrixc
, isoMatrix
) where ) where
--import Geometry --import Geometry
import Geometry.Data import Geometry.Data
@@ -12,97 +9,6 @@ import Linear.Matrix
import Linear.V4 import Linear.V4
import Graphics.Rendering.OpenGL (GLfloat) import Graphics.Rendering.OpenGL (GLfloat)
perspectiveMatrix
:: Float -- ^ Rotation
-> Float -- ^ Zoom
-> Point2 -- ^ Translation
-> Point2 -- ^ Window size
-> Point2 -- ^ View froms
-> [GLfloat]
perspectiveMatrix rot zoom (tranx,trany) (winx,winy) (viewFromx,viewFromy) =
let scalMat = Linear.Matrix.transpose $ V4
(V4 (2*zoom/winx) 0 0 (0::GLfloat))
(V4 0 (2*zoom/winy) 0 0)
(V4 0 0 1 0)
(V4 0 0 0 1)
rotMat = Linear.Matrix.transpose $
V4 (V4 (cos rot) (sin (-rot)) 0 0)
(V4 (sin rot) (cos rot) 0 0)
(V4 0 0 1 0)
(V4 0 0 0 1)
tranMat2 = Linear.Matrix.transpose $
V4 (V4 1 0 0 0)
(V4 0 1 0 0)
(V4 0 0 1 0)
(V4 (viewFromx-tranx) (viewFromy-trany) 0 1)
tranMat1 = Linear.Matrix.transpose $
V4 (V4 1 0 0 0)
(V4 0 1 0 0)
(V4 0 0 1 0)
(V4 (-viewFromx) (-viewFromy) 0 1)
wmat = scalMat !*! rotMat !*! tranMat2 !*! lmt perMat !*! tranMat1
vToL (V4 a b c d) = [a,b,c,d]
in concatMap vToL $ vToL wmat
{- | A matrix that gives a top down view with no perspective. -}
isoMatrix
:: Float -- ^ Rotation
-> Float -- ^ Zoom
-> Point2 -- ^ Translation
-> Point2 -- ^ Window size
-> Point2 -- ^ View froms
-> [GLfloat]
isoMatrix rot czoom (tranx,trany) (winx,winy) _ =
let scalMat = Linear.Matrix.transpose $
V4 (V4 (2*czoom/winx) 0 0 (0::GLfloat))
(V4 0 (2*czoom/winy) 0 0)
(V4 0 0 1 0)
(V4 0 0 0 1)
rotMat = Linear.Matrix.transpose $
V4 (V4 (cos rot) (sin (-rot)) 0 0)
(V4 (sin rot) (cos rot) 0 0)
(V4 0 0 1 0)
(V4 0 0 0 1)
tranMat = Linear.Matrix.transpose $
V4 (V4 1 0 0 0)
(V4 0 1 0 0)
(V4 0 0 1 0)
(V4 (-tranx) (-trany) 0 1)
wmat = scalMat !*! rotMat !*! tranMat
vToL (V4 a b c d) = [a,b,c,d]
in concatMap vToL $ vToL wmat
perspectiveMatrixa
:: Float -- ^ Rotation
-> Float -- ^ Zoom
-> Point2 -- ^ Translation
-> Point2 -- ^ Window size
-> Point2 -- ^ View froms
-> [Float]
perspectiveMatrixa rot zoom (tranx,trany) (winx,winy) (viewFromx,viewFromy) =
let scalMat = V4
(V4 (2*zoom/winx) 0 0 (0))
(V4 0 (2*zoom/winy) 0 0)
(V4 0 0 1 0)
(V4 0 0 0 1)
rotMat =
V4 (V4 (cos rot) (sin (-rot)) 0 0)
(V4 (sin rot) (cos rot) 0 0)
(V4 0 0 1 0)
(V4 0 0 0 1)
tranMat2 =
V4 (V4 1 0 0 0)
(V4 0 1 0 0)
(V4 0 0 1 0)
(V4 (viewFromx-tranx) (viewFromy-trany) 0 1)
tranMat1 =
V4 (V4 1 0 0 0)
(V4 0 1 0 0)
(V4 0 0 1 0)
(V4 (-viewFromx) (-viewFromy) 0 1)
wmat = scalMat !*! rotMat !*! tranMat2 !*! lmt perMat !*! tranMat1
vToL (V4 a b c d) = [a,b,c,d]
in concatMap vToL $ vToL wmat
perspectiveMatrixb perspectiveMatrixb
:: Float -- ^ Rotation :: Float -- ^ Rotation
-> Float -- ^ Zoom -> Float -- ^ Zoom
@@ -111,13 +17,14 @@ perspectiveMatrixb
-> Point2 -- ^ View froms -> Point2 -- ^ View froms
-> [GLfloat] -> [GLfloat]
perspectiveMatrixb rot zoom (tranx,trany) (winx,winy) (viewFromx,viewFromy) = perspectiveMatrixb rot zoom (tranx,trany) (winx,winy) (viewFromx,viewFromy) =
let wmat = lmt $ lmt (scaleMat (2*zoom/winx,2*zoom/winy)) concatMap vToL
!*! rotMatr (-rot) . vToL
!*! lmt (transMat (viewFromx-tranx,viewFromy-trany)) . lmt
!*! lmt perMat $ scaleMat (2*zoom/winx,2*zoom/winy)
!*! lmt (transMat (-viewFromx,-viewFromy)) !*! rotMatr (-rot)
vToL (V4 a b c d) = [a,b,c,d] !*! transMat (viewFromx-tranx,viewFromy-trany)
in concatMap vToL $ vToL wmat !*! perMat
!*! transMat (-viewFromx,-viewFromy)
perspectiveMatrixc perspectiveMatrixc
:: Float -- ^ Rotation :: Float -- ^ Rotation
@@ -125,22 +32,25 @@ perspectiveMatrixc
-> Point2 -- ^ Translation -> Point2 -- ^ Translation
-> Point2 -- ^ Window size -> Point2 -- ^ Window size
-> [GLfloat] -> [GLfloat]
perspectiveMatrixc rot zoom (tranx,trany) (winx,winy) = perspectiveMatrixc rot zoom (tranx,trany) (winx,winy) = concatMap vToL
let wmat = lmt $ lmt (scaleMat (2*zoom/winx,2*zoom/winy)) . vToL
!*! rotMatr (-rot) . lmt
!*! lmt (transMat (-tranx,-trany)) $ scaleMat (2*zoom/winx,2*zoom/winy)
vToL (V4 a b c d) = [a,b,c,d] !*! rotMatr (-rot)
in concatMap vToL $ vToL wmat !*! transMat (-tranx,-trany)
lmt :: V4 (V4 a) -> V4 (V4 a) lmt :: V4 (V4 a) -> V4 (V4 a)
lmt = Linear.Matrix.transpose lmt = Linear.Matrix.transpose
vToL :: V4 a -> [a]
vToL (V4 a b c d) = [a,b,c,d]
perMat :: V4 (V4 Float) perMat :: V4 (V4 Float)
perMat = V4 perMat = V4
(V4 1 0 0 0) (V4 1 0 0 0)
(V4 0 1 0 0) (V4 0 1 0 0)
(V4 0 0 1 0)
(V4 0 0 1 1) (V4 0 0 1 1)
(V4 0 0 0 1)
scaleMat :: Point2 -> V4 (V4 Float) scaleMat :: Point2 -> V4 (V4 Float)
scaleMat (x,y) = V4 scaleMat (x,y) = V4
@@ -158,8 +68,7 @@ rotMatr a = V4
transMat :: Point2 -> V4 (V4 Float) transMat :: Point2 -> V4 (V4 Float)
transMat (x,y) = V4 transMat (x,y) = V4
(V4 1 0 0 0) (V4 1 0 0 x)
(V4 0 1 0 0) (V4 0 1 0 y)
(V4 0 0 1 0) (V4 0 0 1 0)
(V4 x y 0 1) (V4 0 0 0 1)
src/Picture/Render.hs
+1 -1
View File
@@ -226,7 +226,7 @@ renderFoldable pdata struct = do
-- before it performs another state change -- before it performs another state change
bindShaderBuffers slist is bindShaderBuffers slist is
drawShaders slist is zipWithM_ drawShader slist is
pokeEndTicks <- SDL.ticks pokeEndTicks <- SDL.ticks
return $ pokeEndTicks - pokeStartTicks return $ pokeEndTicks - pokeStartTicks
src/Preload/Render.hs
+3 -1
View File
@@ -18,9 +18,11 @@ import Foreign
preloadRender :: IO RenderData preloadRender :: IO RenderData
preloadRender = do preloadRender = do
-- set up uniform buffer object
theUBO <- genObjectName theUBO <- genObjectName
bindBuffer UniformBuffer $= Just theUBO bindBuffer UniformBuffer $= Just theUBO
bufferData UniformBuffer $= (64, nullPtr, StaticDraw) bufferData UniformBuffer $= (64, nullPtr, DynamicDraw)
bindBufferBase IndexedUniformBuffer 0 $= Just theUBO bindBufferBase IndexedUniformBuffer 0 $= Just theUBO
-- lighting shaders -- lighting shaders
src/Shader.hs
-6
View File
@@ -2,7 +2,6 @@ module Shader
( bindArrayBuffers ( bindArrayBuffers
, bindShaderBuffers , bindShaderBuffers
, drawShader , drawShader
, drawShaders
, freeShaderPointers , freeShaderPointers
) where ) where
--import Geometry.Data --import Geometry.Data
@@ -20,8 +19,6 @@ import Graphics.Rendering.OpenGL hiding (Point,translate,scale,imageHeight)
bindArrayBuffers :: Int -> VBO -> IO () bindArrayBuffers :: Int -> VBO -> IO ()
bindArrayBuffers numVs theVBO = do bindArrayBuffers numVs theVBO = do
bindBuffer ArrayBuffer $= Just (_vbo theVBO) bindBuffer ArrayBuffer $= Just (_vbo theVBO)
-- bufferData ArrayBuffer $=
-- (fromIntegral $ floatSize * numVs * sum (_vboAttribSizes theVBO), _vboPointer theVBO, DynamicDraw)
bufferSubData bufferSubData
ArrayBuffer ArrayBuffer
WriteToBuffer WriteToBuffer
@@ -34,9 +31,6 @@ bindShaderBuffers = zipWithM_ f
where where
f fs i = bindArrayBuffers i $ _vaoVBO $ _shaderVAO fs f fs i = bindArrayBuffers i $ _vaoVBO $ _shaderVAO fs
drawShaders :: [FullShader] -> [Int] -> IO ()
drawShaders = zipWithM_ drawShader
drawShader :: FullShader -> Int -> IO () drawShader :: FullShader -> Int -> IO ()
{-# INLINE drawShader #-} {-# INLINE drawShader #-}
drawShader fs i = do drawShader fs i = do
src/Shader/Compile.hs
+1 -2
View File
@@ -42,8 +42,7 @@ makeShader s shaderlist sizes pm renStrat = do
makeSourcedShader :: String -> [ShaderType] -> IO Program makeSourcedShader :: String -> [ShaderType] -> IO Program
makeSourcedShader s sts = do makeSourcedShader s sts = do
sources <- forM sts $ \st -> BS.readFile ("shader/" ++ s ++ shaderTypeExt st) sources <- forM sts $ \st -> BS.readFile ("shader/" ++ s ++ shaderTypeExt st)
prog <- makeShaderProgram s $ zip sts sources makeShaderProgram s $ zip sts sources
return prog
shaderTypeExt :: ShaderType -> String shaderTypeExt :: ShaderType -> String
shaderTypeExt VertexShader = ".vert" shaderTypeExt VertexShader = ".vert"