Fix button label rendering
This commit is contained in:
+30
-30
@@ -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
@@ -48,7 +48,7 @@ lev1 = do
|
||||
-- [randomiseLinks =<< pistolerRoom]
|
||||
[return $ return $ Right deadEndRoom
|
||||
]
|
||||
-- ++ [slowDoorRoom]
|
||||
++ [slowDoorRoom]
|
||||
++ [return $ connectRoom corridor
|
||||
,return $ connectRoom door]
|
||||
-- ++ [randomiseLinks =<< longRoom]
|
||||
|
||||
Reference in New Issue
Block a user