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

Fix button label rendering

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