Refactor light source and wall shadow shaders
This commit is contained in:
+35
-104
@@ -37,6 +37,8 @@ import qualified Graphics.Rendering.OpenGL as GL
|
||||
|
||||
import Data.Foldable
|
||||
import Data.List
|
||||
import Data.Maybe (fromJust)
|
||||
|
||||
--import qualified Data.Vector.Storable as V
|
||||
import qualified Data.IntMap as IM
|
||||
--import qualified Data.DList as DL
|
||||
@@ -45,39 +47,6 @@ import qualified Data.IntMap as IM
|
||||
|
||||
import qualified SDL as SDL
|
||||
|
||||
|
||||
--picToAlt :: (Ap.Alternative f, Monoid (f RenderType)) => Int -> Picture -> f RenderType
|
||||
--{-# INLINE picToAlt #-}
|
||||
--picToAlt x (Polygon i ps)
|
||||
-- | i == x = Ap.pure $ RenderPoly $ zip (map zeroZ $ polyToTris ps) $ repeat black
|
||||
-- | otherwise = Ap.empty
|
||||
--picToAlt x (PolygonCol i vs)
|
||||
-- | i /= x = Ap.empty
|
||||
-- | otherwise =
|
||||
-- let (ps,cs) = unzip vs
|
||||
-- in Ap.pure $ RenderPoly $ zip (map zeroZ $ polyToTris ps) $ polyToTris cs
|
||||
--picToAlt x (Circle i r)
|
||||
-- | i == x = Ap.pure $ RenderCirc $ ((0,0,0),black,r)
|
||||
-- | otherwise = Ap.empty
|
||||
--picToAlt x (Ellipse i (ax,ay) (bx,by) r)
|
||||
-- | i == x = Ap.pure $ RenderEllipse [((ax,ay+r,0),black)
|
||||
-- ,((ax,ay-r,0),black)
|
||||
-- ,((bx,by-r,0),black)
|
||||
-- ]
|
||||
-- | otherwise = Ap.empty
|
||||
--picToAlt x (ThickArc i startA endA rad wdth)
|
||||
-- | i == x = Ap.pure $ RenderArc $ ((0,0,0),black,(startA,endA,rad,wdth))
|
||||
-- | otherwise = Ap.empty
|
||||
--picToAlt x (Line i ps)
|
||||
-- | i == x = Ap.pure $ RenderLine $ zip (map zeroZ $ doubleLine ps) $ repeat white
|
||||
-- | otherwise = Ap.empty
|
||||
--picToAlt x (Text i s)
|
||||
-- | i == x = Ap.pure $ RenderText $ stringToList s
|
||||
-- | otherwise = Ap.empty
|
||||
--picToAlt j Blank = Ap.empty
|
||||
--picToAlt j (Pictures pics) = mconcat $ fmap (picToAlt j) pics
|
||||
|
||||
|
||||
pokeTwoOff :: Ptr Float -> Int -> (Float,Float) -> IO ()
|
||||
{-# INLINE pokeTwoOff #-}
|
||||
pokeTwoOff ptr n (x,y) = do
|
||||
@@ -97,36 +66,6 @@ pokeFourOff ptr n (x,y,z,w) = do
|
||||
pokeElemOff ptr (4*n+2) z
|
||||
pokeElemOff ptr (4*n+3) w
|
||||
|
||||
setShaderUniforms :: Float -> Float -> Point2 -> Point2 -> [FullShader RenderType] -> IO ()
|
||||
setShaderUniforms rot zoom (tranx,trany) (winx,winy) fss = do
|
||||
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)
|
||||
let 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)
|
||||
let 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)
|
||||
let wmat = scalMat !*! rotMat !*! tranMat
|
||||
vToL (V4 a b c d) = [a,b,c,d]
|
||||
wmata <- (newMatrix RowMajor $ concatMap vToL $ vToL wmat) :: IO (GLmatrix GLfloat)
|
||||
|
||||
-- set common uniforms
|
||||
forM_ fss $ \shad -> do
|
||||
currentProgram $= Just (_shaderProgram shad)
|
||||
uniform (_shaderUniforms shad !! 0) $= Vector2 winx winy
|
||||
uniform (_shaderUniforms shad !! 1) $= zoom
|
||||
uniform (_shaderUniforms shad !! 2) $= rot
|
||||
uniform (_shaderUniforms shad !! 3) $= Vector2 tranx trany
|
||||
uniform (_shaderUniforms shad !! 4) $= wmata
|
||||
|
||||
renderPicture' :: RenderData -> Float -> Float -> (Float,Float) -> (Float,Float) ->
|
||||
[(Point2,Point2,Point2,Point2)] -> [Point4] -> Picture -> IO (Word32,Word32)
|
||||
renderPicture' pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints pic = do
|
||||
@@ -158,10 +97,14 @@ renderPicture' pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints p
|
||||
wmata <- (newMatrix RowMajor $ concatMap vToL $ vToL wmat) :: IO (GLmatrix GLfloat)
|
||||
|
||||
-- set common uniforms
|
||||
setShaderUniforms rot zoom (tranx,trany) (winx,winy) (_listShaders pdata)
|
||||
setShaderUniforms rot zoom (tranx,trany) (winx,winy)
|
||||
( (extractProgAndUnis $ _lightSourceShader pdata)
|
||||
: (extractProgAndUnis $ _wlShadShader pdata)
|
||||
: (map extractProgAndUnis $ _listShaders pdata)
|
||||
)
|
||||
|
||||
forM_ [_lightmapCircleShader pdata
|
||||
,_backShader pdata
|
||||
forM_ [--lightmapCircleShader pdata
|
||||
_backShader pdata
|
||||
,_wallShadowShader pdata
|
||||
] $ \shad -> do
|
||||
currentProgram $= Just (fst shad)
|
||||
@@ -172,32 +115,31 @@ renderPicture' pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints p
|
||||
uniform (snd shad !! 4) $= wmata
|
||||
|
||||
-- draw lightmap
|
||||
bindVertexArrayObject $= Just (_vao $ _wallVAO pdata)
|
||||
let wallPtr = (\(_,x,_) -> x) $ head $ _vaoBufferTargets $ _wallVAO pdata
|
||||
wallPtr2 = (\(_,x,_) -> x) $ (_vaoBufferTargets $ _wallVAO pdata) !! 1
|
||||
foldWalls n ((x,y),(z,w),(a,b),(c,d)) = do
|
||||
pokeFourOff wallPtr n (x,y,z,w)
|
||||
pokeFourOff wallPtr2 n (a,b,c,d)
|
||||
return $ n+1
|
||||
nWalls <- foldM foldWalls 0 wallPoints
|
||||
bindArrayBuffers (length wallPoints) $ _vaoBufferTargets $ _wallVAO pdata
|
||||
|
||||
nWalls <- F.foldM (pokeShader (_wlShadShader pdata)) wallPoints
|
||||
bindShaderBuffers [_wlShadShader pdata] [nWalls]
|
||||
|
||||
forM_ lightPoints $ \(x,y,r,lum) -> do
|
||||
cullFace $= Just Front
|
||||
clear [DepthBuffer]
|
||||
currentProgram $= Just (fst $ _wallShadowShader pdata)
|
||||
bindVertexArrayObject $= Just (_vao $ _wallVAO pdata)
|
||||
uniform (_wssLightPos pdata) $= Vector2 (x) (y)
|
||||
|
||||
-- currentProgram does get called twice: here and inside drawShader below
|
||||
currentProgram $= Just (_shaderProgram $ _wlShadShader pdata)
|
||||
uniform (head $ fromJust $ _shaderCustomUnis $ _wlShadShader pdata)
|
||||
$= Vector2 (x) (y)
|
||||
blendFunc $= (Zero,One)
|
||||
drawArrays Points (fromIntegral 0) (fromIntegral $ nWalls)
|
||||
drawShader (_wlShadShader pdata) nWalls
|
||||
|
||||
cullFace $= Nothing
|
||||
currentProgram $= Just (fst $ _lightmapCircleShader pdata)
|
||||
bindVertexArrayObject $= Just (_vao $ _fadeCircVAO pdata)
|
||||
let fadeCircPtr = (\(_,ptr,_) -> ptr) $ head $ _vaoBufferTargets $ _fadeCircVAO pdata
|
||||
pokeFourOff fadeCircPtr 0 (x,y,r,lum)
|
||||
bindArrayBuffers (1) $ _vaoBufferTargets $ _fadeCircVAO pdata
|
||||
|
||||
let lightPtr = (\(_,ptr,_) -> ptr) $ head
|
||||
$ _vaoBufferTargets $ _shaderVAO $ _lightSourceShader pdata
|
||||
pokeFourOff lightPtr 0 (x,y,r,lum)
|
||||
bindShaderBuffers [_lightSourceShader pdata] [1]
|
||||
|
||||
blendFuncSeparate $= ((Zero,Zero),(Zero, OneMinusSrcAlpha))
|
||||
drawArrays Points (fromIntegral 0) (fromIntegral 1)
|
||||
drawShader (_lightSourceShader pdata) 1
|
||||
|
||||
startWallTicks <- SDL.ticks
|
||||
wallPokeEnd <- SDL.ticks
|
||||
ticksS <- SDL.ticks
|
||||
@@ -222,30 +164,19 @@ renderPicture' pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints p
|
||||
depthFunc $= Just Lequal
|
||||
|
||||
-- draw layer 0
|
||||
ticks2 <- renderTree' pdata rot zoom (tranx,trany) (winx,winy) $ picToLTree (Just 0) pic
|
||||
ticks2 <- renderFoldable pdata rot zoom (tranx,trany) (winx,winy) $ picToLTree (Just 0) pic
|
||||
--((picToAlt 0 pic) :: [RenderType])
|
||||
-- reset blend so that light map doesn't apply
|
||||
blendFunc $= (SrcAlpha,OneMinusSrcAlpha)
|
||||
ticks3 <- renderTree' pdata rot zoom (tranx,trany) (winx,winy) $ picToLTree (Just 1) pic
|
||||
ticks3 <- renderFoldable pdata rot zoom (tranx,trany) (winx,winy) $ picToLTree (Just 1) pic
|
||||
-- set drawing for on top
|
||||
aticks <- SDL.ticks
|
||||
blendFuncSeparate $= ((SrcAlphaSaturate, OneMinusSrcAlpha), (Zero,One))
|
||||
ticks4 <- renderTree' pdata rot zoom (tranx,trany) (winx,winy) $ picToLTree (Just 2) pic
|
||||
ticks4 <- renderFoldable pdata rot zoom (tranx,trany) (winx,winy) $ picToLTree (Just 2) pic
|
||||
bticks <- SDL.ticks
|
||||
-- reset uniforms (hacky for now)
|
||||
idmat <- (newMatrix RowMajor [1,0,0,0
|
||||
,0,1,0,0
|
||||
,0,0,1,0
|
||||
,0,0,0,1
|
||||
]
|
||||
) :: IO (GLmatrix GLfloat)
|
||||
forM_ (_listShaders pdata) $ \shad -> do
|
||||
currentProgram $= Just (_shaderProgram shad)
|
||||
uniform (_shaderUniforms shad !! 0) $= Vector2 (2::Float) 2
|
||||
uniform (_shaderUniforms shad !! 1) $= (1::Float)
|
||||
uniform (_shaderUniforms shad !! 2) $= (0::Float)
|
||||
uniform (_shaderUniforms shad !! 3) $= Vector2 (0::Float) 0
|
||||
uniform (_shaderUniforms shad !! 4) $= idmat
|
||||
|
||||
resetShaderUniforms (map extractProgAndUnis $ _listShaders pdata)
|
||||
|
||||
endWallTicks <- SDL.ticks
|
||||
--return (ticksAfterL, ticks2+ticks3+ticks4, endWallTicks - startWallTicks)
|
||||
ticksE <- SDL.ticks
|
||||
@@ -256,9 +187,9 @@ renderPicture' pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints p
|
||||
bufferOffset :: Integral a => a -> Ptr b
|
||||
bufferOffset = plusPtr nullPtr . fromIntegral
|
||||
|
||||
renderTree' :: Foldable f => RenderData -> Float -> Float -> (Float,Float) -> (Float,Float)
|
||||
renderFoldable :: Foldable f => RenderData -> Float -> Float -> (Float,Float) -> (Float,Float)
|
||||
-> f RenderType -> IO Word32
|
||||
renderTree' pdata rot zoom (tranx,trany) (winx,winy) tree = do
|
||||
renderFoldable pdata rot zoom (tranx,trany) (winx,winy) tree = do
|
||||
pokeStartTicks <- SDL.ticks
|
||||
|
||||
let slist = _listShaders pdata
|
||||
|
||||
Reference in New Issue
Block a user