196 lines
7.1 KiB
Haskell
196 lines
7.1 KiB
Haskell
module Render
|
|
where
|
|
import Shader
|
|
import Shader.Data
|
|
--import Shader.Poke
|
|
import Data.Preload.Render
|
|
import Picture.Data
|
|
import Geometry.Data
|
|
|
|
--import Data.Foldable
|
|
import Foreign hiding (rotate)
|
|
import Graphics.Rendering.OpenGL hiding (Line,translate,scale,imageHeight,Polygon,Color,T)
|
|
import qualified SDL
|
|
import qualified Data.Vector.Unboxed.Mutable as UMV
|
|
import qualified Data.Vector.Mutable as MV
|
|
import Control.Monad.Primitive
|
|
import qualified Data.Vector.Fusion.Stream.Monadic as VS
|
|
|
|
divideSize :: Int -> Size -> Size
|
|
divideSize i (Size x y) = Size (div x $ fromIntegral i) (div y $ fromIntegral i)
|
|
|
|
sizeToTexSize :: Size -> TextureSize2D
|
|
sizeToTexSize (Size x y) = TextureSize2D x y
|
|
|
|
{- | Determine where light is shining in the world. -}
|
|
createLightMap
|
|
:: RenderData
|
|
-> [(Point3,Float,Point3)] -- Lights
|
|
-> Int -- ^ number of walls
|
|
-> Int -- ^ number of silhoutte lines to draw
|
|
-> Int -- ^ number of surface triangles to draw
|
|
-> IO ()
|
|
createLightMap pdata lightPoints nWalls nSils nsurfVs = do
|
|
depthFunc $= Just Less
|
|
-- clear buffer to full alpha and furthest depth
|
|
-- clearColor is specified in preloadRender
|
|
clearColor $= Color4 1 1 1 1
|
|
clear [ColorBuffer,DepthBuffer]
|
|
--colorMask $= Color4 Disabled Disabled Disabled Disabled
|
|
cullFace $= Just Back
|
|
-- we assume that the camera position uniforms have been correctly set elsewhere
|
|
-- draw wall surfaces from the camera's point of view in order to set z buffer
|
|
drawShader (_lightingWallShader pdata) nWalls
|
|
-- draw foreground elements the camera's your point of view to set z buffer
|
|
drawShader (_lightingSurfaceShader pdata) nsurfVs
|
|
-- draw wall occlusions from the camera's point of view
|
|
drawShader (_lightingOccludeShader pdata) nWalls
|
|
--hypothesis: the above three draw calls only work because the
|
|
--uniform was set to your position, that being the last light source in the list
|
|
--if this hypothesis is correct, then the code is brittle and should be changed
|
|
|
|
-- for each of the lights:
|
|
-- stencil out the walls from this light's point of view
|
|
-- draw fading lightmap circles on the floor
|
|
-- draw fading lightmaps on the walls
|
|
depthMask $= Disabled
|
|
blendFunc $= (Zero, OneMinusSrcColor)
|
|
stencilTest $= Enabled
|
|
depthFunc $= Just Lequal
|
|
flip VS.mapM_ (VS.fromList lightPoints) $ \(V3 x y z,rad,V3 r g b) -> do
|
|
--forM_ lightPoints $ \(V3 x y z,r,lum) -> do
|
|
-- stencil out shadows
|
|
colorMask $= Color4 Disabled Disabled Disabled Disabled
|
|
clear [StencilBuffer]
|
|
cullFace $= Just Back
|
|
stencilOp $= (OpKeep,OpKeep,OpIncr)
|
|
stencilFunc $= (Always, 0, 255)
|
|
currentProgram $= Just (_shaderProgram $ _lightingOccludeShader pdata)
|
|
uniform (head $ _shaderCustomUnis $ _lightingOccludeShader pdata)
|
|
$= Vector3 x y z
|
|
drawShader (_lightingOccludeShader pdata) nWalls
|
|
currentProgram $= Just (_shaderProgram $ _lightingLineShadowShader pdata)
|
|
uniform (head $ _shaderCustomUnis $ _lightingLineShadowShader pdata)
|
|
$= Vector3 x y z
|
|
drawShader (_lightingLineShadowShader pdata) nSils
|
|
|
|
cullFace $= Just Front
|
|
stencilOp $= (OpKeep,OpKeep,OpDecr)
|
|
currentProgram $= Just (_shaderProgram $ _lightingOccludeShader pdata)
|
|
drawShader (_lightingOccludeShader pdata) nWalls
|
|
currentProgram $= Just (_shaderProgram $ _lightingLineShadowShader pdata)
|
|
drawShader (_lightingLineShadowShader pdata) nSils
|
|
|
|
-- draw geometry surfaces
|
|
cullFace $= Just Back
|
|
--colorMask $= Color4 Disabled Disabled Disabled Enabled
|
|
colorMask $= Color4 Enabled Enabled Enabled Enabled
|
|
stencilFunc $= (Equal, 0, 255)
|
|
currentProgram $= Just (_shaderProgram $ _lightingSurfaceShader pdata)
|
|
uniform (head $ _shaderCustomUnis $ _lightingSurfaceShader pdata)
|
|
$= Vector3 x y z
|
|
uniform (_shaderCustomUnis (_lightingSurfaceShader pdata) !! 1)
|
|
$= Vector4 r g b rad
|
|
drawShader (_lightingSurfaceShader pdata) nsurfVs
|
|
-- draw wall light "circles"
|
|
currentProgram $= Just (_shaderProgram $ _lightingWallShader pdata)
|
|
uniform (head $ _shaderCustomUnis $ _lightingWallShader pdata)
|
|
$= Vector3 x y z
|
|
uniform (_shaderCustomUnis (_lightingWallShader pdata) !! 1)
|
|
$= Vector4 r g b rad
|
|
drawShader (_lightingWallShader pdata) nWalls
|
|
cullFace $= Nothing
|
|
stencilTest $= Disabled
|
|
{- | Blur between two framebuffers.
|
|
Assumes no depth testing is done -}
|
|
pingPongBlur :: RenderData -> IO ()
|
|
pingPongBlur pdata = do
|
|
bindFramebuffer Framebuffer $= fst (_fbo3 pdata)
|
|
textureBinding Texture2D $= Just (snd $ _fbo2 pdata)
|
|
drawShader (_bloomBlurShader pdata) 4
|
|
|
|
bindFramebuffer Framebuffer $= fst (_fbo2 pdata)
|
|
textureBinding Texture2D $= Just (snd $ _fbo3 pdata)
|
|
drawShader (_bloomBlurShader pdata) 4
|
|
-- assumes that vertices have already been sent to the shader
|
|
pingPongBetween
|
|
:: (FramebufferObject,TextureObject)
|
|
-> (FramebufferObject,TextureObject)
|
|
-> FullShader
|
|
-> IO ()
|
|
pingPongBetween (fb1,to1) (fb2,to2) fs = do
|
|
bindFramebuffer Framebuffer $= fb2
|
|
textureBinding Texture2D $= Just to1
|
|
drawShader fs 4
|
|
|
|
bindFramebuffer Framebuffer $= fb1
|
|
textureBinding Texture2D $= Just to2
|
|
drawShader fs 4
|
|
|
|
drawTextureOnFramebuffer
|
|
:: FullShader
|
|
-> FramebufferObject
|
|
-> TextureObject
|
|
-> IO ()
|
|
drawTextureOnFramebuffer fs fbo to = do
|
|
bindFramebuffer Framebuffer $= fbo
|
|
textureBinding Texture2D $= Just to
|
|
drawShader fs 4
|
|
|
|
renderFoldable
|
|
:: MV.MVector (PrimState IO) FullShader
|
|
-> Picture
|
|
-> IO ()
|
|
renderFoldable shadV struct = do
|
|
counts <- UMV.replicate 6 0
|
|
pokeBindFoldable shadV counts struct
|
|
MV.imapM_ (drawShaderLay 0 counts) shadV
|
|
|
|
renderFoldableTimed
|
|
:: MV.MVector (PrimState IO) FullShader
|
|
-> Picture
|
|
-> IO Word32
|
|
renderFoldableTimed shadV struct = do
|
|
pokeStartTicks <- SDL.ticks
|
|
counts <- UMV.replicate 6 0
|
|
pokeBindFoldable shadV counts struct
|
|
MV.imapM_ (drawShaderLay 0 counts) shadV
|
|
pokeEndTicks <- SDL.ticks
|
|
return $ pokeEndTicks - pokeStartTicks
|
|
------------------------------end renderFoldable
|
|
renderLayer
|
|
:: Int
|
|
-> MV.MVector (PrimState IO) FullShader
|
|
-> UMV.MVector (PrimState IO) Int
|
|
-> IO ()
|
|
renderLayer layer shads counts = do
|
|
let layerCounts = UMV.slice (layer * 6) 6 counts
|
|
MV.imapM_ (drawShaderLay layer layerCounts) shads
|
|
|
|
pokeTwoOff
|
|
:: Ptr Float
|
|
-> Int
|
|
-> (Float,Float)
|
|
-> IO ()
|
|
{-# INLINE pokeTwoOff #-}
|
|
pokeTwoOff ptr n (x,y) = do
|
|
pokeElemOff ptr (2*n+0) x
|
|
pokeElemOff ptr (2*n+1) y
|
|
pokeThreeOff
|
|
:: Ptr Float
|
|
-> Int
|
|
-> (Float,Float,Float)
|
|
-> IO ()
|
|
{-# INLINE pokeThreeOff #-}
|
|
pokeThreeOff ptr n (x,y,z) = do
|
|
pokeElemOff ptr (3*n+0) x
|
|
pokeElemOff ptr (3*n+1) y
|
|
pokeElemOff ptr (3*n+2) z
|
|
pokeFourOff :: Ptr Float -> Int -> (Float,Float,Float,Float) -> IO ()
|
|
{-# INLINE pokeFourOff #-}
|
|
pokeFourOff ptr n (x,y,z,w) = do
|
|
pokeElemOff ptr (4*n+0) x
|
|
pokeElemOff ptr (4*n+1) y
|
|
pokeElemOff ptr (4*n+2) z
|
|
pokeElemOff ptr (4*n+3) w
|