Linting
This commit is contained in:
+45
-42
@@ -1,40 +1,43 @@
|
||||
--{-# LANGUAGE Strict #-}
|
||||
{-# LANGUAGE DeriveFoldable, StandaloneDeriving #-}
|
||||
--{-# LANGUAGE DeriveFoldable, StandaloneDeriving #-}
|
||||
{-
|
||||
Rendering of a picture.
|
||||
-}
|
||||
module Picture.Render
|
||||
( module Picture.Render
|
||||
, picToLTree
|
||||
-- , perspectiveMatrix
|
||||
)
|
||||
where
|
||||
|
||||
import Shader
|
||||
import MatrixHelper
|
||||
|
||||
import Control.Lens
|
||||
import Control.Monad
|
||||
|
||||
import qualified Control.Foldl as F
|
||||
|
||||
import Picture.Preload
|
||||
import Picture.Data
|
||||
import Picture.Tree
|
||||
import Geometry
|
||||
|
||||
import Control.Lens
|
||||
import Control.Monad
|
||||
import qualified Control.Foldl as F
|
||||
import Foreign hiding (rotate)
|
||||
|
||||
import Graphics.Rendering.OpenGL hiding (Line,translate,scale,imageHeight,imageWidth,Polygon,Color,T)
|
||||
|
||||
import Data.Foldable
|
||||
import Data.Maybe (fromJust)
|
||||
|
||||
import qualified Data.IntMap.Strict as IM
|
||||
import qualified SDL
|
||||
|
||||
import qualified SDL as SDL
|
||||
|
||||
renderPicture' :: RenderData -> Float -> Float -> Point2 -> Point2 ->
|
||||
[((Point2,Point2),Point4)] -> [((Point2,Point2),Point4)] -> [Point4] ->
|
||||
(Float,Float) -> Picture -> IO (Word32)
|
||||
renderPicture' pdata rot zoom trans@(tranx,trany) wins@(winx,winy) wallPointsCol windowPoints lightPoints
|
||||
renderPicture
|
||||
:: RenderData -- ^ Preloaded render data
|
||||
-> Float -- ^ Rotation
|
||||
-> Float -- ^ Zoom
|
||||
-> Point2 -- ^ Translation
|
||||
-> Point2 -- ^ Window size
|
||||
-> [((Point2,Point2),Point4)] -- ^ Wall data
|
||||
-> [((Point2,Point2),Point4)] -- ^ Window data
|
||||
-> [Point4] -- ^ Lights data
|
||||
-> (Float,Float) -- ^ View from point
|
||||
-> Picture -- ^ Picture
|
||||
-> IO Word32 -- ^ Time taken according to SDL.ticks
|
||||
renderPicture pdata rot zoom trans@(tranx,trany) wins@(winx,winy) wallPointsCol windowPoints lightPoints
|
||||
viewFroms@(viewFromx,viewFromy) pic = do
|
||||
startTicks <- SDL.ticks
|
||||
let wallPoints = map fst wallPointsCol
|
||||
@@ -83,27 +86,27 @@ renderWalls pdata wps pmat = do
|
||||
n <- F.foldM (pokeShader $ _wallFaceShader pdata) wps
|
||||
bindShaderBuffers [_wallFaceShader pdata] [n]
|
||||
currentProgram $= Just (_shaderProgram $ _wallFaceShader pdata)
|
||||
uniform ( (fromJust $ _shaderCustomUnis $ _wallFaceShader pdata) !! 0)
|
||||
uniform (head (fromJust $ _shaderCustomUnis $ _wallFaceShader pdata) )
|
||||
$= pmat
|
||||
drawShader (_wallFaceShader pdata) n
|
||||
|
||||
setWallDepth :: RenderData -> [(Point2,Point2)] -> (Float,Float) -> GLmatrix GLfloat -> IO Word32
|
||||
setWallDepth pdata wallPoints (viewFromx,viewFromy) pmat = do
|
||||
startTicks <- SDL.ticks
|
||||
colorMask $= (Color4 Disabled Disabled Disabled Disabled)
|
||||
colorMask $= Color4 Disabled Disabled Disabled Disabled
|
||||
nWalls <- F.foldM (pokeShader $ _wallShadowShader pdata) wallPoints
|
||||
bindShaderBuffers [_wallShadowShader pdata] [nWalls]
|
||||
|
||||
currentProgram $= Just (_shaderProgram $ _wallShadowShader pdata)
|
||||
uniform (head $ fromJust $ _shaderCustomUnis $ _wallShadowShader pdata)
|
||||
$= Vector2 viewFromx viewFromy
|
||||
uniform ( (fromJust $ _shaderCustomUnis $ _wallShadowShader pdata) !! 1)
|
||||
uniform ( fromJust (_shaderCustomUnis $ _wallShadowShader pdata) !! 1)
|
||||
$= pmat
|
||||
uniform ( (fromJust $ _shaderCustomUnis $ _wallShadowShader pdata) !! 2)
|
||||
uniform ( fromJust (_shaderCustomUnis $ _wallShadowShader pdata) !! 2)
|
||||
$= (0 :: Float)
|
||||
-- cullFace $= Just Front
|
||||
drawShader (_wallShadowShader pdata) nWalls
|
||||
colorMask $= (Color4 Enabled Enabled Enabled Enabled)
|
||||
colorMask $= Color4 Enabled Enabled Enabled Enabled
|
||||
endTicks <- SDL.ticks
|
||||
return $ endTicks - startTicks
|
||||
|
||||
@@ -113,7 +116,7 @@ createLightMap :: RenderData -> Float -> Float -> (Float,Float) -> (Float,Float)
|
||||
createLightMap pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints
|
||||
(viewFromx,viewFromy) pmat = do
|
||||
|
||||
bindFramebuffer Framebuffer $= (_spareFBO pdata)
|
||||
bindFramebuffer Framebuffer $= _spareFBO pdata
|
||||
-- clear buffer to full alpha and furthest depth
|
||||
clearColor $= Color4 0 0 0 1
|
||||
clearDepth $= 1
|
||||
@@ -126,17 +129,17 @@ createLightMap pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints
|
||||
bindShaderBuffers [_wallShadowShader pdata] [nWalls]
|
||||
-- set uniforms for shader that draws lights
|
||||
currentProgram $= Just (_shaderProgram $ _wallLightShader pdata)
|
||||
uniform ( (fromJust $ _shaderCustomUnis $ _wallLightShader pdata) !! 1)
|
||||
uniform ( fromJust (_shaderCustomUnis $ _wallLightShader pdata) !! 1)
|
||||
$= pmat
|
||||
-- draw walls from your point of view in order to set z buffer
|
||||
colorMask $= (Color4 Disabled Disabled Disabled Disabled)
|
||||
colorMask $= Color4 Disabled Disabled Disabled Disabled
|
||||
let (tx,ty) = (tranx,trany) -.- (viewFromx,viewFromy)
|
||||
currentProgram $= Just (_shaderProgram $ _wallShadowShader pdata)
|
||||
uniform (head $ fromJust $ _shaderCustomUnis $ _wallShadowShader pdata)
|
||||
$= Vector2 viewFromx viewFromy
|
||||
uniform ( (fromJust $ _shaderCustomUnis $ _wallShadowShader pdata) !! 1)
|
||||
uniform ( fromJust (_shaderCustomUnis $ _wallShadowShader pdata) !! 1)
|
||||
$= pmat
|
||||
uniform ( (fromJust $ _shaderCustomUnis $ _wallShadowShader pdata) !! 2)
|
||||
uniform ( fromJust (_shaderCustomUnis $ _wallShadowShader pdata) !! 2)
|
||||
$= (0 :: Float)
|
||||
cullFace $= Just Back
|
||||
drawShader (_wallShadowShader pdata) nWalls
|
||||
@@ -169,27 +172,27 @@ createLightMap pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints
|
||||
drawShader (_wallShadowShader pdata) nWalls
|
||||
-- draw floor light circles
|
||||
cullFace $= Nothing
|
||||
colorMask $= (Color4 Disabled Disabled Disabled Enabled)
|
||||
colorMask $= Color4 Disabled Disabled Disabled Enabled
|
||||
bindShaderBuffers [_lightSourceShader pdata] [1]
|
||||
stencilFunc $= (Equal, 0, 255)
|
||||
drawShader (_lightSourceShader pdata) 1
|
||||
-- draw wall light "circles"
|
||||
currentProgram $= Just (_shaderProgram $ _wallLightShader pdata)
|
||||
uniform (head $ fromJust $ _shaderCustomUnis $ _wallLightShader pdata)
|
||||
$= Vector2 x y
|
||||
uniform ( (fromJust $ _shaderCustomUnis $ _wallLightShader pdata) !! 2)
|
||||
$= Vector2 r lum
|
||||
$= Vector2 x y
|
||||
uniform (fromJust (_shaderCustomUnis $ _wallLightShader pdata) !! 2)
|
||||
$= Vector2 r lum
|
||||
drawShader (_wallLightShader pdata) nWallLights
|
||||
depthMask $= Enabled
|
||||
cullFace $= Nothing
|
||||
stencilTest $= Disabled
|
||||
blend $= Disabled
|
||||
bindFramebuffer Framebuffer $= defaultFramebufferObject
|
||||
colorMask $= (Color4 Disabled Disabled Disabled Enabled)
|
||||
colorMask $= Color4 Disabled Disabled Disabled Enabled
|
||||
bindShaderBuffers [_fullscreenShader pdata] [4]
|
||||
textureBinding Texture2D $= Just (_fboTexture pdata)
|
||||
drawShader (_fullscreenShader pdata) 4
|
||||
colorMask $= (Color4 Enabled Enabled Enabled Enabled)
|
||||
colorMask $= Color4 Enabled Enabled Enabled Enabled
|
||||
blend $= Enabled
|
||||
|
||||
renderBackground :: RenderData -> Float -> Float -> (Float,Float) -> (Float,Float) -> IO ()
|
||||
@@ -202,20 +205,20 @@ renderBackground pdata rot zoom (tranx,trany) (winx,winy) = do
|
||||
currentProgram $= Just (_shaderProgram $ _backgroundShader pdata)
|
||||
bindVertexArrayObject $= Just (_vao $ _shaderVAO $ _backgroundShader pdata)
|
||||
let backPtr = (\(_,x,_) -> x) $ head $ _vaoBufferTargets $ _shaderVAO $ _backgroundShader pdata
|
||||
backPtr2 = (\(_,x,_) -> x) $ (_vaoBufferTargets $ _shaderVAO $ _backgroundShader pdata) !! 1
|
||||
backPtr2 = (\(_,x,_) -> x) $ _vaoBufferTargets (_shaderVAO $ _backgroundShader pdata) !! 1
|
||||
pokeFourOff backPtr 0 (tranx,trany,rot,zoom)
|
||||
pokeTwoOff backPtr2 0 (winx,winy)
|
||||
textureBinding Texture2D $= (fmap _textureObject $ _shaderTexture $ _backgroundShader pdata)
|
||||
drawArrays Points (fromIntegral 0) (fromIntegral 1)
|
||||
textureBinding Texture2D $= _textureObject <$> _shaderTexture (_backgroundShader pdata)
|
||||
drawArrays Points 0 1
|
||||
|
||||
setCommonUniforms :: RenderData -> Float -> Float -> (Float,Float) -> (Float,Float) -> IO ()
|
||||
setCommonUniforms pdata rot zoom (tranx,trany) (winx,winy) = do
|
||||
setShaderUniforms rot zoom (tranx,trany) (winx,winy)
|
||||
( (extractProgAndUnis $ _lightSourceShader pdata)
|
||||
: (extractProgAndUnis $ _wallShadowShader pdata)
|
||||
: (extractProgAndUnis $ _wallLightShader pdata)
|
||||
: (extractProgAndUnis $ _backgroundShader pdata)
|
||||
: (map extractProgAndUnis $ _listShaders pdata)
|
||||
( extractProgAndUnis (_lightSourceShader pdata)
|
||||
: extractProgAndUnis (_wallShadowShader pdata)
|
||||
: extractProgAndUnis (_wallLightShader pdata)
|
||||
: extractProgAndUnis (_backgroundShader pdata)
|
||||
: map extractProgAndUnis (_listShaders pdata)
|
||||
)
|
||||
|
||||
renderFoldable :: Foldable f => RenderData -> f RenderType -> IO Word32
|
||||
|
||||
Reference in New Issue
Block a user