Refactor vao preload

This commit is contained in:
2021-02-19 12:41:46 +01:00
parent f4db9bf9a1
commit f6efe98181
16 changed files with 441 additions and 485 deletions
+22 -20
View File
@@ -51,7 +51,7 @@ draw'' b w-- | (Char 'm') `S.member` _keys w
= case _mapDisplay w of
(True, z) -> (blank
,pictures [color white $ circleSolid 3
,scale z z $ rotate (radToDeg (_cameraRot w))
,scale z z $ rotate (0 - (_cameraRot w))
$ uncurry translate ((0,0) -.- _cameraCenter w)
$ pictures $ mapMaybe mapWall $ IM.elems $ _walls w]
)
@@ -68,7 +68,7 @@ draw'' b w-- | (Char 'm') `S.member` _keys w
x2 = (x''+1)
y1 = (y''-1)
y2 = (y''+1)
screenShift = scale zoom zoom . rotate (radToDeg (_cameraRot w) )
screenShift = scale zoom zoom . rotate (0 - (_cameraRot w) )
. uncurry translate ((0,0) -.- _cameraPos w)
zoom = _cameraZoom w
pathsTest = map drawPair $ _pathGraph' w
@@ -100,7 +100,7 @@ collectDrawings w = pictures
]
-- <> [onLayer GloomLayer $ theLighting w]
where
screenShift = scale zoom zoom . rotate (radToDeg (_cameraRot w) )
screenShift = scale zoom zoom . rotate (0 - (_cameraRot w) )
. uncurry translate ((0,0) -.- _cameraPos w)
zoom = _cameraZoom w
decPicts = IM.elems $ _decorations w
@@ -127,12 +127,13 @@ collectDrawings w = pictures
menuScreen = case _menuState w of
InGame -> blank
LevelMenu x ->
pictures [color (withAlpha 0.5 black) $ polygon $ screenBox w
,tst (-100) 100 0.4 ("LEVEL "++show x)
pictures [--color (withAlpha 0.5 black) $ polygon $ screenBox w
tst (-100) 100 0.4 ("LEVEL "++show x)
,controlsList
]
PauseMenu -> pictures [color (withAlpha 0.5 black) $ polygon $ screenBox w
,tst (-100) 100 0.4 "PAUSED"
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
@@ -157,11 +158,11 @@ hudDrawings w = (onLayer InvLayer)
where itCol = fromMaybe (greyN 0.5) . (^? itInvColor)
crDraw :: Creature -> Drawing
crDraw c = uncurry translate (_crPos c) $ rotateRad (_crDir c) (_crPict c c)
crDraw c = uncurry translate (_crPos c) $ rotate (_crDir c) (_crPict c c)
ppDraw :: PressPlate -> Drawing
ppDraw c = uncurry translate (_ppPos c) $ rotateRad (_ppRot c) (_ppPict c)
ppDraw c = uncurry translate (_ppPos c) $ rotate (_ppRot c) (_ppPict c)
btDraw :: Button -> Drawing
btDraw c = uncurry translate (_btPos c) $ rotateRad (_btRot c) (_btPict c)
btDraw c = uncurry translate (_btPos c) $ rotate (_btRot c) (_btPict c)
clDraw :: Cloud -> Drawing
clDraw c = uncurry translate (_clPos c) $ (_clPict c c)
@@ -171,6 +172,7 @@ drawCursor w = translate (105-halfWidth w)
(halfHeight w - (25* (fromIntegral iPos)) - 20
)
-- $ rectangleWire 200 25
$ color white
$ line [(200,12.5),(-100,12.5),(-100,-12.5),(200,-12.5)]
where iPos = _crInvSel $ _creatures w IM.! _yourID w
@@ -242,7 +244,7 @@ drawSmokeShadow w sm@(Smoke {_smPos = p, _smRad = r', _smColor = c, _smPs = ps,
pb p' = p' -.- orth p'
pao p' = pa p' +.+ l *.* safeNormalizeV (pa p' -.- _cameraCenter w)
pbo p' = pb p' +.+ l *.* safeNormalizeV (pb p' -.- _cameraCenter w)
semiCirc p' = uncurry translate p' $ rotate (radToDeg (a p')) $ arcSolid 0 180 r
semiCirc p' = uncurry translate p' $ rotate (0 - (a p')) $ arcSolid 0 180 r
a p' = pi - argV (orth p')
trap p' = polygon [pa p', pb p', pbo p', pao p']
f p' = [semiCirc p', trap p']
@@ -256,7 +258,7 @@ drawSmokeShadow w sm@(Smoke {_smPos = p, _smRad = r', _smColor = c, _smPs = ps,
pao' p' = pa' p' +.+ l *.* safeNormalizeV (pa' p' -.- _cameraCenter w)
pbo' p' = pb' p' +.+ l *.* safeNormalizeV (pb' p' -.- _cameraCenter w)
trap' p' = line [pa' p', pb' p', pbo' p', pao' p',pa' p']
semiCirc' p' = uncurry translate p' $ rotate (radToDeg (a p')) $ arcSolid 0 180 r'
semiCirc' p' = uncurry translate p' $ rotate (0 - (a p')) $ arcSolid 0 180 r'
drawWall :: Wall -> Drawing
@@ -283,7 +285,7 @@ printPoint p = color white $ uncurry translate p $ pictures [circle 3 ,scale 0.0
printRotPoint :: Float -> Point2 -> Picture
printRotPoint r p = color white $ uncurry translate p $ pictures [circle 3
, rotate r $ scale 0.1 0.1 $ text (show p)]
, rotate (0 - r) $ scale 0.1 0.1 $ text (show p)]
outsideScreenPolygon :: World -> [Point2]
outsideScreenPolygon w = [tr,tl,bl,br]
@@ -390,42 +392,42 @@ drawButText :: World -> Button -> Picture
drawButText w bt | magV (_crPos (you w) -.- _btPos bt) < 100
&& hasLOS (_btPos bt) (_crPos (you w)) w
&& _btState bt /= BtNoLabel
= t $ rotate (radToDeg (-_cameraRot w))
= t $ rotate (_cameraRot w)
$ pictures $ [ scLine [(-8,10),(-15,10),(-15,-10),(-8,-10)]
, scLine [( 8,10),( 15,10),( 15,-10),( 8,-10)]
,translate (-15) (-10*sqrt zoom - 5) $ dShadCol white
$ scale 0.1 0.1 $ text $ _btText bt
]
| otherwise = blank
where t = rotate (radToDeg (_cameraRot w)) . uncurry translate (zoom *.* (_btPos bt -.- _cameraPos w))
where t = rotate (0 - (_cameraRot w)) . uncurry translate (zoom *.* (_btPos bt -.- _cameraPos w))
zoom = _cameraZoom w
scLine = dShadCol white . line . fmap (sqrt zoom *.*)
drawPPText :: World -> PressPlate -> Picture
drawPPText w pp | magV (_crPos (you w) -.- _ppPos pp) < 100
&& hasLOS (_ppPos pp) (_crPos (you w)) w
= t $ rotate (radToDeg (-_cameraRot w))
= t $ rotate (_cameraRot w)
$ pictures $ [ scLine [(-8,10),(-15,10),(-15,-10),(-8,-10)]
, scLine [( 8,10),( 15,10),( 15,-10),( 8,-10)]
,translate (-15) (-10*sqrt zoom - 5) $ dShadCol white
$ scale 0.1 0.1 $ text $ _ppText pp
]
| otherwise = blank
where t = rotate (radToDeg (_cameraRot w)) . uncurry translate (zoom *.* (_ppPos pp -.- _cameraPos w))
where t = rotate (0 - (_cameraRot w)) . uncurry translate (zoom *.* (_ppPos pp -.- _cameraPos w))
zoom = _cameraZoom w
scLine = dShadCol white . line . fmap (sqrt zoom *.*)
drawItemName :: World -> FloorItem -> Picture
drawItemName w flIt | magV (_crPos (you w) -.- _flItPos flIt) < 100
&& hasLOS (_flItPos flIt) (_crPos (you w)) w
= t $ rotate (radToDeg (-_cameraRot w))
= t $ rotate (_cameraRot w)
$ pictures $ [ scLine [(-8,10),(-15,10),(-15,-10),(-8,-10)]
, scLine [( 8,10),( 15,10),( 15,-10),( 8,-10)]
,translate (-15) (-10*sqrt zoom - 5) $ dShadCol white
$ scale 0.1 0.1 $ text $ nameOfItem
]
| otherwise = blank
where t = rotate (radToDeg (_cameraRot w)) . uncurry translate (zoom *.* (_flItPos flIt -.- _cameraPos w))
where t = rotate (0 - (_cameraRot w)) . uncurry translate (zoom *.* (_flItPos flIt -.- _cameraPos w))
nameOfItem = case flIt of FlIt {} -> _itName $ _flIt flIt
FlAm {_flAm = PistolBullet} -> "Bullets"
FlAm {_flAm = LiquidFuel} -> "Liquid Fuel"
@@ -472,7 +474,7 @@ drawFF (FF {_ffLine = l, _ffColor = col}) = pictures [color white $ line l, colo
drawFFShadow :: World -> ForceField -> [Picture]
drawFFShadow w ff
| youOnFF = []
| otherwise = map (rotate (radToDeg (- _cameraRot w)) . pane)
| otherwise = map (rotate ( _cameraRot w) . pane)
[0,0.05..0.25]
where p = rotateV (-_cameraRot w) $ ypShift
x = rotateV (-_cameraRot w) x'