justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Reorganise rendering in Dodge

Browse Source
This commit is contained in:
jgk
2021-04-01 11:28:53 +02:00
parent e62ff391a5
commit 1e9a07d1c8
13 changed files with 217 additions and 113 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Base.hs
+6 -5
View File
@@ -280,6 +280,12 @@ zoneOfLine :: Point2 -> Point2 -> [(Int,Int)]
zoneOfLine (aa,ab) (ba,bb) = nub $ concatMap f
$ digitalLine (zoneOfPoint (aa,ab)) (zoneOfPoint (ba,bb))
where f (x,y) = [(p,r) | p <-[x-1,x,x+1] , r<-[y-1,y,y+1]]
zoneOfLine' :: Point2 -> Point2 -> IM.IntMap IS.IntSet
{-# INLINE zoneOfLine' #-}
zoneOfLine' a b = expandLine $ digitalLine (x-1,y-1) (x'-1,y'-1)
where (x,y) = zoneOfPoint a
(x',y') = zoneOfPoint b
--zoneOfLine (aa,ab) (ba,bb) = nub $ concatMap f
-- $ digitalLine (zoneOfPoint (aa-n,ab-n)) (zoneOfPoint (ba-n,bb-n))
-- where f (x,y) = [(p,r) | p <-[x,x+1] , r<-[y,y+1]]
@@ -294,11 +300,6 @@ expandLine xs = IM.map expandSet
--expandSet s = s
where mk = IS.findMax s
zoneOfLine' :: Point2 -> Point2 -> IM.IntMap IS.IntSet
{-# INLINE zoneOfLine' #-}
zoneOfLine' a b = expandLine $ digitalLine (x-1,y-1) (x'-1,y'-1)
where (x,y) = zoneOfPoint a
(x',y') = zoneOfPoint b
--zoneOfLine a b = concatMap zoneNearPoint $ divideLine (2 * zoneSize) a b
--zoneOfLine a b = concatMap zoneNearPoint $ divideLine zoneSize a b
src/Dodge/Render.hs
+122
View File
@@ -0,0 +1,122 @@
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)
src/Dodge/Rendering/HUD.hs → src/Dodge/Render/HUD.hs
+1 -1
View File
@@ -1,4 +1,4 @@
module Dodge.Rendering.HUD
module Dodge.Render.HUD
where
import Dodge.Data
src/Dodge/Rendering/MenuScreen.hs → src/Dodge/Render/MenuScreen.hs
+1 -1
View File
@@ -1,4 +1,4 @@
module Dodge.Rendering.MenuScreen
module Dodge.Render.MenuScreen
( menuScreen
)
where
src/Dodge/Render/PerspectiveMatrix.hs
+50
View File
@@ -0,0 +1,50 @@
module Dodge.Render.PerspectiveMatrix
where
import Dodge.Data
import Geometry
import Linear.Matrix
import Linear.V4
import Graphics.Rendering.OpenGL (GLfloat)
perspectiveMatrix :: World -> [GLfloat]
perspectiveMatrix w =
let rot = _cameraRot w
zoom = _cameraZoom w
(tranx,trany) = _cameraCenter w
(winx,winy) = (_windowX w,_windowY w)
(viewFromx,viewFromy) = _cameraViewFrom w
scalMat = Linear.Matrix.transpose $ V4
(V4 (2*zoom/winx) 0 0 (0::GLfloat))
(V4 0 (2*zoom/winy) 0 0)
(V4 0 0 0.5 0) --scaled to make walls shorter
(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)
tranMat3 = Linear.Matrix.transpose $
V4 (V4 1 0 0 0)
(V4 0 1 0 0)
(V4 0 0 1 0)
(V4 (-tranx) (-trany) 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)
perMat = Linear.Matrix.transpose $
V4 (V4 1 0 0 0)
(V4 0 1 0 0)
(V4 0 0 1 1)
(V4 0 0 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 !*! perMat !*! tranMat1
vToL (V4 a b c d) = [a,b,c,d]
in concatMap vToL $ vToL wmat
src/Dodge/Rendering.hs → src/Dodge/Render/Picture.hs
+4 -16
View File
@@ -1,29 +1,17 @@
module Dodge.Rendering where
-- imports {{{
module Dodge.Render.Picture
where
import Dodge.Data
import Dodge.Base
--import Dodge.Inventory
import Dodge.Rendering.HUD
import Dodge.Rendering.MenuScreen
import Dodge.Render.HUD
import Dodge.Render.MenuScreen
import Geometry
import Picture
import Data.Graph.Inductive.Query.DFS
import Data.Graph.Inductive.Graph
import Control.Monad.State
import Data.List
import Data.Bifunctor
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
worldPictures :: World -> Picture
worldPictures w = pictures $ concat
src/Dodge/Update.hs
+5 -2
View File
@@ -71,8 +71,11 @@ updateLightSources w = set tempLightSources (catMaybes tlss) w'
updateProjectiles w = IM.foldr' _pjUpdate w $ _projectiles w
updateParticles' :: World -> World
updateParticles' w = set particles' (catMaybes ps) w'
where (w',ps) = mapAccumR (\a b -> _ptUpdate' b a b) w $ _particles' w
updateParticles' w =
--set particles' [] w
set particles' (catMaybes ps) w'
where
(w',ps) = mapAccumR (\a b -> _ptUpdate' b a b) w $ _particles' w
updateCreatures :: World -> World
updateCreatures w = f $ set randGen newG $ set creatures (IM.mapMaybe id crs) w
src/Dodge/WorldEvent/SpawnParticle.hs
+1
View File
@@ -167,6 +167,7 @@ moveFlamelet w pt
& btPassThrough' .~ Nothing
& btVel' .~ 0.8 *.* vel
damcrs = foldr ($) w $ map dodam $ filter closeCrs $ IM.elems $ _creatures w
-- damcrs = w
closeCrs cr = dist ep (_crPos cr) < _crRad cr + size
dodam cr = over (creatures . ix (_crID cr) . crState . crDamage)
((:) $ Flaming 3 sp ep ep)
src/Dodge/WorldEvent/ThingsHit.hs
+1 -1
View File
@@ -17,7 +17,7 @@ thingsHit sp ep w
where
hitCrs = IM.elems $ IM.filter (\cr -> circOnLine sp ep (_crPos cr) (_crRad cr))
$ _creatures w
-- $ creaturesAlongLine sp ep w
-- $ creaturesAlongLine sp ep w
crPs = map (\cr -> ssaTriPoint ep (_crPos cr) sp (_crRad cr)) hitCrs
crs = zip crPs (map E3x1 hitCrs)