Fix button label rendering

This commit is contained in:
jgk
2021-03-08 15:17:33 +01:00
parent dd5e49dccc
commit 70f8914767
2 changed files with 31 additions and 31 deletions
+30 -30
View File
@@ -24,15 +24,11 @@ import qualified Data.Set as S
-- }}}
fixedCoordPictures :: World -> Picture
fixedCoordPictures w = pictures
-- [ scaler $ onLayer LabelLayer $ pictures [itLabels, ppLabels, btLabels]
[ scaler $ onLayer LabelLayer $ pictures [ppLabels, btLabels]
, scaler $ hudDrawings w
-- [ scaler $ onLayer LabelLayer $ pictures [ppLabels, btLabels]
[ scaler $ hudDrawings w
, scaler $ onLayer MenuLayer menuScreen
]
where scaler = scale (2 / _windowX w) (2 / _windowY 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
@@ -71,6 +67,8 @@ worldPictures w
, wallShadows
, smokeShadows
, itLabels
, ppLabels
, btLabels
]
where
decPicts = IM.elems $ _decorations w
@@ -93,8 +91,8 @@ worldPictures w
--
scaler = onLayer LabelLayer . setLayer 1
itLabels = map (scaler . drawItemName w) (IM.elems (_floorItems w))
ppLabels = pictures $ map (drawPPText w) (IM.elems (_pressPlates w))
btLabels = pictures $ map (drawButText w) (IM.elems (_buttons w))
ppLabels = map (scaler . drawPPText w) (IM.elems (_pressPlates w))
btLabels = map (scaler . drawButText w) (IM.elems (_buttons w))
menuScreen :: Picture
menuScreen = case _menuState w of
InGame -> blank
@@ -315,10 +313,8 @@ lineOnScreen w (p1:p2:_) = errorPointInPolygon 8 p1 sp || errorPointInPolygon 9
drawWallShadow :: World -> Wall -> Drawing
--drawWallShadow w _ = blank
drawWallShadow w wall
| isRHS sightFrom x y = blank
-- | otherwise = onLayerL l $ color shadCol $ polygon $ points
| otherwise = colorAndLayer $ polygon $ points
where
colorAndLayer | _wlIsSeeThrough wall = setLayer 2
@@ -374,16 +370,29 @@ 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 (_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
]
= pictures
[ scale (2/_windowX w) (2/_windowY w)
. t
. translate (-15) (-10*sqrt zoom - 5) $ dShadCol white
$ scale 0.1 0.1 $ text $ _btText bt
, tranItPos' $ line [(-8,10),(-15,10),(-15,-10),(-8,-10)]
, tranItPos' $ line [( 8,10),( 15,10),( 15,-10),( 8,-10)]
]
-- = 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 (0 - (_cameraRot w)) . uncurry translate (zoom *.* (_btPos bt -.- _cameraPos w))
where tranItPos' = uncurry translate (_btPos bt) . rotate (_cameraRot w)
t = rotate (0 - (_cameraRot w))
. uncurry translate (zoom *.* (_btPos bt -.- _cameraPos w))
. rotate (_cameraRot w)
zoom = _cameraZoom w
scLine = dShadCol white . line . fmap (sqrt zoom *.*)
-- 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
@@ -407,19 +416,11 @@ drawItemName w flIt | magV (_crPos (you w) -.- _flItPos flIt) < 100
. t
. translate (-15) (-10*sqrt zoom - 5) $ dShadCol white
$ scale 0.1 0.1 $ text $ nameOfItem
, tranItPos' $ scLine [(-8,10),(-15,10),(-15,-10),(-8,-10)]
, tranItPos' $ scLine [( 8,10),( 15,10),( 15,-10),( 8,-10)]
, tranItPos' $ line [(-8,10),(-15,10),(-15,-10),(-8,-10)]
, tranItPos' $ line [( 8,10),( 15,10),( 15,-10),( 8,-10)]
]
-- ,
-- 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 tranItPos = uncurry translate $ zoom *.* (_flItPos flIt -.- _cameraPos w)
tranItPos' = uncurry translate (_flItPos flIt) . rotate (_cameraRot w)
where tranItPos' = uncurry translate (_flItPos flIt) . rotate (_cameraRot w)
t = rotate (0 - (_cameraRot w))
. uncurry translate (zoom *.* (_flItPos flIt -.- _cameraPos w))
. rotate (_cameraRot w)
@@ -427,7 +428,6 @@ drawItemName w flIt | magV (_crPos (you w) -.- _flItPos flIt) < 100
FlAm {_flAm = PistolBullet} -> "Bullets"
FlAm {_flAm = LiquidFuel} -> "Liquid Fuel"
zoom = _cameraZoom w
scLine = line -- . fmap ( zoom *.*)
ringPict :: Drawing
ringPict = onLayer LabelLayer $ dShadCol white $ pictures [line [(-8,10),(-15,10),(-15,-10),(-8,-10)]
+1 -1
View File
@@ -48,7 +48,7 @@ lev1 = do
-- [randomiseLinks =<< pistolerRoom]
[return $ return $ Right deadEndRoom
]
-- ++ [slowDoorRoom]
++ [slowDoorRoom]
++ [return $ connectRoom corridor
,return $ connectRoom door]
-- ++ [randomiseLinks =<< longRoom]