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

Improve speed of polygon rendering by folding tree type

Browse Source
This commit is contained in:
justin
2021-02-17 16:54:46 +01:00
parent c7aa5f707e
commit 6f838ed1ef
10 changed files with 378 additions and 200 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Rendering.hs
+54 -50
View File
@@ -78,72 +78,78 @@ draw'' b w-- | (Char 'm') `S.member` _keys w
drawNode (i,x) = color yellow $ uncurry translate x $ scale 0.05 0.05 $ text $ show i
collectDrawings :: World -> Picture
collectDrawings w = screenShift (decPicts <> ppPicts <> itFloorPicts
<> crPicts
<> clPicts
<> buttonPicts <> ptPicts
<> ptPicts'
<> afterPtPicts'
<> wlPicts
<> wallShadows
<> smokeShadows
)
<> onLayer LabelLayer
(itLabels <> ppLabels <> btLabels)
<> hudDrawings w
<> onLayer MenuLayer menuScreen
collectDrawings w = pictures
[screenShift $
pictures $ concat
[ decPicts
, ppPicts
, itFloorPicts
, crPicts
, clPicts
, buttonPicts
, ptPicts
, ptPicts'
, afterPtPicts'
, wlPicts
, wallShadows
, smokeShadows
]
, onLayer LabelLayer $ pictures [itLabels, ppLabels, btLabels]
, hudDrawings w
, onLayer MenuLayer menuScreen
]
-- <> [onLayer GloomLayer $ theLighting w]
where
screenShift = scale zoom zoom . rotate (radToDeg (_cameraRot w) )
. uncurry translate ((0,0) -.- _cameraPos w)
zoom = _cameraZoom w
decPicts :: Picture
decPicts = mconcat $ IM.elems $ _decorations w
ptPicts = mconcat $ map _ptPict (IM.elems (_particles w))
ptPicts' = mconcat $ map _ptPict' $ _particles' w
afterPtPicts' = mconcat $ map _ptPict' $ _afterParticles' w
buttonPicts = mconcat $ map btDraw (IM.elems (_buttons w))
ppPicts = mconcat $ map ppDraw (IM.elems (_pressPlates w))
crPicts :: Picture
crPicts = mconcat $ map crDraw $ IM.elems $ _creatures w
clPicts = mconcat $ map clDraw $ IM.elems $ _clouds w
wallShadows = mconcat $ map (drawWallShadow w) $ wallShadowsToDraw w
smokeShadows = mconcat $ map (drawSmokeShadow w) $ _smoke w
wlPicts = mconcat $ map drawWall (wallsToDraw w)
decPicts = IM.elems $ _decorations w
ptPicts = map _ptPict (IM.elems (_particles w))
ptPicts' = map _ptPict' $ _particles' w
afterPtPicts' = map _ptPict' $ _afterParticles' w
buttonPicts = map btDraw (IM.elems (_buttons w))
ppPicts = map ppDraw (IM.elems (_pressPlates w))
crPicts = map crDraw $ IM.elems $ _creatures w
clPicts = map clDraw $ IM.elems $ _clouds w
wallShadows = map (drawWallShadow w) $ wallShadowsToDraw w
smokeShadows = map (drawSmokeShadow w) $ _smoke w
wlPicts = map drawWall (wallsToDraw w)
itFloorPicts = map (drawItem) (IM.elems (_floorItems w))
yourPos = _crPos $ you w
yourRot = _crDir $ you w
yourRad = _crRad $ you w
-- itFloorPicts = zipWith (uncurry translate) (map _flItPos (IM.elems (_floorItems w)))
-- (map (_itFloorPict . _flIt) (IM.elems (_floorItems w)))
itFloorPicts = mconcat $ map (drawItem) (IM.elems (_floorItems w))
itLabels = mconcat $ map (drawItemName w) (IM.elems (_floorItems w))
ppLabels = mconcat $ map (drawPPText w) (IM.elems (_pressPlates w))
btLabels = mconcat $ map (drawButText w) (IM.elems (_buttons w))
itLabels = pictures $ map (drawItemName w) (IM.elems (_floorItems w))
ppLabels = pictures $ map (drawPPText w) (IM.elems (_pressPlates w))
btLabels = pictures $ map (drawButText w) (IM.elems (_buttons w))
menuScreen :: Picture
menuScreen = case _menuState w of
InGame -> blank
LevelMenu x ->
mconcat [color (withAlpha 0.5 black) $ polygon $ screenBox w
pictures [color (withAlpha 0.5 black) $ polygon $ screenBox w
,tst (-100) 100 0.4 ("LEVEL "++show x)
] <> controlsList
PauseMenu -> mconcat [color (withAlpha 0.5 black) $ polygon $ screenBox w
,controlsList
]
PauseMenu -> pictures [color (withAlpha 0.5 black) $ polygon $ screenBox w
,tst (-100) 100 0.4 "PAUSED"
,tst (-100) 50 0.2 "n - new level"
,tst (-100) 0 0.2 "r - restart"
] <> controlsList
GameOverMenu -> mconcat [color (withAlpha 0.5 black) $ polygon $ screenBox w
, controlsList
]
GameOverMenu -> pictures [color (withAlpha 0.5 black) $ polygon $ screenBox w
,tst (-100) 100 0.4 "GAME OVER"
,tst (-100) 50 0.2 "n - new level"
,tst (-100) 0 0.2 "r - restart"
]
<> controlsList
,controlsList
]
where tst x y sc t = translate x y $ scale sc sc $ color white $ text t
hudDrawings :: World -> Picture
hudDrawings w = (onLayer InvLayer)
$ displayInv 0 w
<> mconcat
[ dShadCol white $ displayHP 0 w
$ pictures
[ displayInv 0 w
, dShadCol white $ displayHP 0 w
, dShadCol (itCol (yourItem w))
$ drawCursor w, translate (-390) 20
$ scale 0.05 0.05 $ dShadCol white $ text (_testString w)
@@ -169,7 +175,7 @@ drawCursor w = translate (105-halfWidth w)
where iPos = _crInvSel $ _creatures w IM.! _yourID w
controlsList = mconcat [tst (-250) (-130) 0.15 "controls:"
controlsList = pictures [tst (-250) (-130) 0.15 "controls:"
,tst (-150) (-130) 0.15 "wasd"
,tst 0 (-130) 0.15 "movement"
,tst (-150) (-160) 0.15 "[rmb]"
@@ -215,20 +221,18 @@ wallsToDraw w = filter isVisible $ IM.elems $ wallsOnScreen w
wallsOnScreen :: World -> IM.IntMap Wall
wallsOnScreen w = wallsNearZones (zoneOfScreen w) w
drawSmokeShadow :: World -> Smoke -> Drawing
drawSmokeShadow :: World -> Smoke -> Picture
drawSmokeShadow w sm@(Smoke {_smPos = p, _smRad = r', _smColor = c, _smPs = ps, _smTime = t})
= (
onLayerL [74,0] $ color col $
= pictures
[ onLayerL [74,0] $ color col $
pictures [uncurry translate p $ circle r'
,line $ (\(x,y) -> [x,y]) $ smokePerpLine (_cameraPos w) p sm
,line [_cameraPos w, mouseWorldPos w]
,trap' p
]
)
<>
(onLayerL [74] $ color (withAlpha 0.1 c) $ pictures
, onLayerL [74] $ color (withAlpha 0.1 c) $ pictures
$ concatMap (f . (+.+ p)) p's
)
]
where
r = r'/2
col | smokeLOS (_cameraPos w) (mouseWorldPos w) w = red
@@ -363,7 +367,7 @@ linePointsBetween p p' | d > 99 = map (\m -> p +.+ fromIntegral m *.* p'') [0..n
p'' = (1/fromIntegral n) *.* (p' -.- p)
displayInv :: Int -> World -> Picture
displayInv n w = mconcat $ zipWith (translate (10-halfWidth w))
displayInv n w = pictures $ zipWith (translate (10-halfWidth w))
(map (\x-> halfHeight w-(25*(fromIntegral x+1))) ns) $ map dItem' is
where (ns,is) = unzip $ IM.toList $ _crInv $ _creatures w IM.! n