Cleanup matrices
This commit is contained in:
+7
-17
@@ -57,22 +57,13 @@ doDrawing pdata w = do
|
||||
wallPoints = map fst wallPointsCol
|
||||
|
||||
-- set the coordinate uniform ready for drawing elements using world coordinates
|
||||
let pmat = perspectiveMatrixb rot camzoom trans wins viewFroms
|
||||
withArray pmat $ \ptr ->
|
||||
bufferData UniformBuffer $=
|
||||
(fromIntegral $ sizeOf (head pmat) * length pmat
|
||||
,ptr
|
||||
,StreamDraw
|
||||
)
|
||||
bufferUBO $ perspectiveMatrixb rot camzoom trans wins viewFroms
|
||||
|
||||
depthFunc $= Just Less
|
||||
-- draw the lightmap. Probably changes the bound framebufferObject
|
||||
createLightMap pdata (w ^. config . shadow_resolution) wallPoints lightPoints viewFroms
|
||||
(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
|
||||
-- the depth buffer is ready to be drawn on
|
||||
blendFuncSeparate $= ((SrcAlphaSaturate, OneMinusSrcAlpha), (Zero,One))
|
||||
@@ -129,13 +120,7 @@ doDrawing pdata w = do
|
||||
drawShader (_grayscaleShader pdata) 4
|
||||
blend $= Enabled
|
||||
|
||||
let pmata = perspectiveMatrixc 0 1 (0,0) (2,2)
|
||||
withArray pmata $ \ptr ->
|
||||
bufferData UniformBuffer $=
|
||||
(fromIntegral $ sizeOf (head pmat) * length pmat
|
||||
,ptr
|
||||
,StreamDraw
|
||||
)
|
||||
bufferUBO $ perspectiveMatrixc 0 1 (0,0) (2,2)
|
||||
|
||||
blendFunc $= (SrcAlpha,OneMinusSrcAlpha)
|
||||
_ <- 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
|
||||
:: RenderData
|
||||
-> [((Point2,Point2),Point4)] -- ^ List: wall positions and color
|
||||
|
||||
@@ -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
|
||||
girder :: Color -> Float -> Point2 -> Point2 -> Picture
|
||||
girder col w x y = pictures $
|
||||
(setDepth (-0.1) $ color col $ pictures $
|
||||
setDepth (-0.1) (color col $ pictures $
|
||||
[ thickLine [xt,yt] 3
|
||||
, thickLine [xb,yb] 3
|
||||
]
|
||||
|
||||
+22
-113
@@ -1,9 +1,6 @@
|
||||
module MatrixHelper
|
||||
( perspectiveMatrix
|
||||
, perspectiveMatrixa
|
||||
, perspectiveMatrixb
|
||||
( perspectiveMatrixb
|
||||
, perspectiveMatrixc
|
||||
, isoMatrix
|
||||
) where
|
||||
--import Geometry
|
||||
import Geometry.Data
|
||||
@@ -12,97 +9,6 @@ import Linear.Matrix
|
||||
import Linear.V4
|
||||
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
|
||||
:: Float -- ^ Rotation
|
||||
-> Float -- ^ Zoom
|
||||
@@ -111,13 +17,14 @@ perspectiveMatrixb
|
||||
-> Point2 -- ^ View froms
|
||||
-> [GLfloat]
|
||||
perspectiveMatrixb rot zoom (tranx,trany) (winx,winy) (viewFromx,viewFromy) =
|
||||
let wmat = lmt $ lmt (scaleMat (2*zoom/winx,2*zoom/winy))
|
||||
!*! rotMatr (-rot)
|
||||
!*! lmt (transMat (viewFromx-tranx,viewFromy-trany))
|
||||
!*! lmt perMat
|
||||
!*! lmt (transMat (-viewFromx,-viewFromy))
|
||||
vToL (V4 a b c d) = [a,b,c,d]
|
||||
in concatMap vToL $ vToL wmat
|
||||
concatMap vToL
|
||||
. vToL
|
||||
. lmt
|
||||
$ scaleMat (2*zoom/winx,2*zoom/winy)
|
||||
!*! rotMatr (-rot)
|
||||
!*! transMat (viewFromx-tranx,viewFromy-trany)
|
||||
!*! perMat
|
||||
!*! transMat (-viewFromx,-viewFromy)
|
||||
|
||||
perspectiveMatrixc
|
||||
:: Float -- ^ Rotation
|
||||
@@ -125,22 +32,25 @@ perspectiveMatrixc
|
||||
-> Point2 -- ^ Translation
|
||||
-> Point2 -- ^ Window size
|
||||
-> [GLfloat]
|
||||
perspectiveMatrixc rot zoom (tranx,trany) (winx,winy) =
|
||||
let wmat = lmt $ lmt (scaleMat (2*zoom/winx,2*zoom/winy))
|
||||
!*! rotMatr (-rot)
|
||||
!*! lmt (transMat (-tranx,-trany))
|
||||
vToL (V4 a b c d) = [a,b,c,d]
|
||||
in concatMap vToL $ vToL wmat
|
||||
perspectiveMatrixc rot zoom (tranx,trany) (winx,winy) = concatMap vToL
|
||||
. vToL
|
||||
. lmt
|
||||
$ scaleMat (2*zoom/winx,2*zoom/winy)
|
||||
!*! rotMatr (-rot)
|
||||
!*! transMat (-tranx,-trany)
|
||||
|
||||
lmt :: V4 (V4 a) -> V4 (V4 a)
|
||||
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 1 0 0 0)
|
||||
(V4 0 1 0 0)
|
||||
(V4 0 0 1 0)
|
||||
(V4 0 0 1 1)
|
||||
(V4 0 0 0 1)
|
||||
|
||||
scaleMat :: Point2 -> V4 (V4 Float)
|
||||
scaleMat (x,y) = V4
|
||||
@@ -158,8 +68,7 @@ rotMatr a = V4
|
||||
|
||||
transMat :: Point2 -> V4 (V4 Float)
|
||||
transMat (x,y) = V4
|
||||
(V4 1 0 0 0)
|
||||
(V4 0 1 0 0)
|
||||
(V4 1 0 0 x)
|
||||
(V4 0 1 0 y)
|
||||
(V4 0 0 1 0)
|
||||
(V4 x y 0 1)
|
||||
|
||||
(V4 0 0 0 1)
|
||||
|
||||
@@ -226,7 +226,7 @@ renderFoldable pdata struct = do
|
||||
-- before it performs another state change
|
||||
bindShaderBuffers slist is
|
||||
|
||||
drawShaders slist is
|
||||
zipWithM_ drawShader slist is
|
||||
|
||||
pokeEndTicks <- SDL.ticks
|
||||
return $ pokeEndTicks - pokeStartTicks
|
||||
|
||||
@@ -18,9 +18,11 @@ import Foreign
|
||||
|
||||
preloadRender :: IO RenderData
|
||||
preloadRender = do
|
||||
|
||||
-- set up uniform buffer object
|
||||
theUBO <- genObjectName
|
||||
bindBuffer UniformBuffer $= Just theUBO
|
||||
bufferData UniformBuffer $= (64, nullPtr, StaticDraw)
|
||||
bufferData UniformBuffer $= (64, nullPtr, DynamicDraw)
|
||||
bindBufferBase IndexedUniformBuffer 0 $= Just theUBO
|
||||
|
||||
-- lighting shaders
|
||||
|
||||
@@ -2,7 +2,6 @@ module Shader
|
||||
( bindArrayBuffers
|
||||
, bindShaderBuffers
|
||||
, drawShader
|
||||
, drawShaders
|
||||
, freeShaderPointers
|
||||
) where
|
||||
--import Geometry.Data
|
||||
@@ -20,8 +19,6 @@ import Graphics.Rendering.OpenGL hiding (Point,translate,scale,imageHeight)
|
||||
bindArrayBuffers :: Int -> VBO -> IO ()
|
||||
bindArrayBuffers numVs theVBO = do
|
||||
bindBuffer ArrayBuffer $= Just (_vbo theVBO)
|
||||
-- bufferData ArrayBuffer $=
|
||||
-- (fromIntegral $ floatSize * numVs * sum (_vboAttribSizes theVBO), _vboPointer theVBO, DynamicDraw)
|
||||
bufferSubData
|
||||
ArrayBuffer
|
||||
WriteToBuffer
|
||||
@@ -34,9 +31,6 @@ bindShaderBuffers = zipWithM_ f
|
||||
where
|
||||
f fs i = bindArrayBuffers i $ _vaoVBO $ _shaderVAO fs
|
||||
|
||||
drawShaders :: [FullShader] -> [Int] -> IO ()
|
||||
drawShaders = zipWithM_ drawShader
|
||||
|
||||
drawShader :: FullShader -> Int -> IO ()
|
||||
{-# INLINE drawShader #-}
|
||||
drawShader fs i = do
|
||||
|
||||
@@ -42,8 +42,7 @@ makeShader s shaderlist sizes pm renStrat = do
|
||||
makeSourcedShader :: String -> [ShaderType] -> IO Program
|
||||
makeSourcedShader s sts = do
|
||||
sources <- forM sts $ \st -> BS.readFile ("shader/" ++ s ++ shaderTypeExt st)
|
||||
prog <- makeShaderProgram s $ zip sts sources
|
||||
return prog
|
||||
makeShaderProgram s $ zip sts sources
|
||||
|
||||
shaderTypeExt :: ShaderType -> String
|
||||
shaderTypeExt VertexShader = ".vert"
|
||||
|
||||
Reference in New Issue
Block a user