123 lines
4.0 KiB
Haskell
123 lines
4.0 KiB
Haskell
module Dodge.Render
|
|
( module Dodge.Render.Picture
|
|
, doDrawing
|
|
, doDrawing'
|
|
)
|
|
where
|
|
import Dodge.Data
|
|
import Dodge.Base
|
|
|
|
import Dodge.Render.HUD
|
|
import Dodge.Render.MenuScreen
|
|
import Dodge.Render.Picture
|
|
import Dodge.Render.PerspectiveMatrix
|
|
|
|
import Geometry
|
|
import Picture
|
|
import Shader
|
|
|
|
import Picture.Render
|
|
import Picture.Preload
|
|
|
|
import Data.Graph.Inductive.Query.DFS
|
|
import Data.Graph.Inductive.Graph
|
|
|
|
import Control.Monad.State
|
|
import Data.List
|
|
import Data.Bifunctor
|
|
|
|
import Foreign (Word32)
|
|
import Data.Function
|
|
import Control.Applicative
|
|
import Control.Lens
|
|
import Data.Maybe
|
|
import qualified Data.IntMap.Strict as IM
|
|
import qualified Data.Map as M
|
|
import qualified Data.Set as S
|
|
import Graphics.Rendering.OpenGL hiding (color,scale,translate,rotate)
|
|
|
|
import qualified SDL
|
|
|
|
doDrawing :: RenderData -> World -> IO (Word32)
|
|
doDrawing pdata w = do
|
|
sTicks <- SDL.ticks
|
|
clear [ColorBuffer,DepthBuffer]
|
|
let rot = _cameraRot w
|
|
zoom = _cameraZoom w
|
|
trans@(tranx,trany) = _cameraCenter w
|
|
wins@(winx,winy) = (_windowX w,_windowY w)
|
|
wallPointsCol = wallsPointsAndCols w
|
|
windowPoints = wallsWindows w
|
|
lightPoints = lightsForGloom' w
|
|
viewFroms@(viewFromx,viewFromy) = _cameraViewFrom w
|
|
pic = worldPictures w
|
|
wallPoints = map fst wallPointsCol
|
|
setCommonUniforms pdata rot zoom trans wins
|
|
depthFunc $= Just Less
|
|
pmat <- (newMatrix RowMajor $ perspectiveMatrix w) :: IO (GLmatrix GLfloat)
|
|
createLightMap pdata rot zoom trans wins wallPoints lightPoints viewFroms pmat
|
|
blendFuncSeparate $= ((SrcAlphaSaturate, OneMinusSrcAlpha), (Zero,One))
|
|
-- clear [DepthBuffer]
|
|
depthFunc $= Just Always
|
|
renderBackground pdata rot zoom trans wins
|
|
depthFunc $= Just Lequal
|
|
renderWalls pdata wallPointsCol pmat
|
|
setWallDepth pdata wallPoints (viewFromx,viewFromy) pmat
|
|
-- depthFunc $= Just Lequal
|
|
renderFoldable pdata $ picToLTree (Just 0) pic
|
|
-- reset blend so that light map doesn't apply
|
|
-- blendFunc $= (SrcAlpha,OneMinusSrcAlpha)
|
|
blendFuncSeparate $= ((SrcAlpha,OneMinusSrcAlpha) , (Zero,One))
|
|
-- blendFunc $= (SrcAlpha,OneMinusSrcAlpha)
|
|
renderFoldable pdata $ picToLTree (Just 1) pic
|
|
|
|
-- set drawing for on top
|
|
blendFuncSeparate $= ((SrcAlphaSaturate, OneMinusSrcAlpha), (Zero,One))
|
|
|
|
renderFoldable pdata $ picToLTree (Just 2) pic
|
|
|
|
depthMask $= Disabled
|
|
renderWalls pdata windowPoints pmat
|
|
depthMask $= Enabled
|
|
|
|
resetShaderUniforms (map extractProgAndUnis $ _listShaders pdata)
|
|
----------------------
|
|
blendFunc $= (SrcAlpha,OneMinusSrcAlpha)
|
|
renderFoldable pdata (picToLTree Nothing $ fixedCoordPictures w)
|
|
eTicks <- SDL.ticks
|
|
return (eTicks - sTicks)
|
|
doDrawing' :: RenderData -> World -> IO (Word32)
|
|
doDrawing' pdata w = do
|
|
bindFramebuffer Framebuffer $= defaultFramebufferObject
|
|
sTicks <- SDL.ticks
|
|
clear [ColorBuffer,DepthBuffer]
|
|
let rot = _cameraRot w
|
|
zoom = _cameraZoom w
|
|
trans@(tranx,trany) = _cameraCenter w
|
|
wins@(winx,winy) = (_windowX w,_windowY w)
|
|
wallPointsCol = wallsPointsAndCols w
|
|
windowPoints = wallsWindows w
|
|
lightPoints = lightsForGloom' w
|
|
viewFroms@(viewFromx,viewFromy) = _cameraViewFrom w
|
|
pic = worldPictures w
|
|
wallPoints = map fst wallPointsCol
|
|
pmat <- (newMatrix RowMajor
|
|
$ perspectiveMatrix w) :: IO (GLmatrix GLfloat)
|
|
setCommonUniforms pdata rot zoom trans wins
|
|
|
|
depthMask $= Disabled
|
|
renderBackground pdata rot zoom trans wins
|
|
depthMask $= Enabled
|
|
blend $= Enabled
|
|
blendFunc $= (SrcAlpha, OneMinusSrcAlpha)
|
|
-- not sure why renderWalls and setWallDepth aren't combined
|
|
renderWalls pdata wallPointsCol pmat
|
|
setWallDepth pdata wallPoints (viewFromx,viewFromy) pmat
|
|
depthFunc $= Just Lequal
|
|
renderFoldable pdata $ picToLTree (Just 0) pic
|
|
renderFoldable pdata $ picToLTree (Just 1) pic
|
|
renderFoldable pdata $ picToLTree (Just 2) pic
|
|
eTicks <- SDL.ticks
|
|
return (eTicks - sTicks)
|
|
|