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

Improve floor item labels

Browse Source
This commit is contained in:
jgk
2021-03-08 19:09:24 +01:00
parent 9f58066dba
commit c8705a88c2
1 changed files with 52 additions and 24 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Rendering.hs
+52 -24
View File
@@ -62,10 +62,48 @@ activeObjectText w = case closestActiveObject w of
[ scale (2/_windowX w) (2/_windowY w)
$ translate (0.25*_windowX w) (0.25*_windowY w)
$ scale 0.1 0.1 $ text $ _btText bt
, line [ (0,0),(0.5,0.5)]
, line [sc $ rotateV (0 - _cameraRot w) $ _cameraZoom w *.* (_btPos bt -.- _cameraPos w)
,(0.5,0.5)
]
]
where btp = _btPos bt
Just (Left flit) -> blank
where sc (x, y) = (x*2/_windowX w, y*2/_windowY w)
Just (Left flit)
-> pictures
[ color col $ scale (2/_windowX w) (2/_windowY w)
$ t
$ scale 0.1 0.1 $ text itText
, lineCol [(itScreenPos, withAlpha 0 col)
,(sc p' , col)
,(sc p , col)
]
]
where sc (x, y) = (x*2/_windowX w, y*2/_windowY w)
col = _itInvColor theIt
theIt = _flIt flit
itScreenPos = sc $ rotateV (0 - _cameraRot w) $ _cameraZoom w *.* (_flItPos flit -.- _cameraPos w)
freeSlot = checkInvSlots theIt $ _crInv $ you w
t = case freeSlot of
Just i -> translate (pushout - halfWidth w) (halfHeight w - 20* (fromIntegral i +1))
Nothing -> translate (0.25*_windowX w) (0.25*_windowY w)
p = case freeSlot of
Just i -> ( pushout - halfWidth w + textWidth
, halfHeight w - 20* (fromIntegral i +1) + 2.5
)
Nothing -> ( 0.25*_windowX w
, 0.25*_windowY w
)
p' = case freeSlot of
Just i -> ( pushout - halfWidth w + 130
, halfHeight w - 20* (fromIntegral i +1) + 2.5
)
Nothing -> ( 0.25*_windowX w
, 0.25*_windowY w
)
itText = _itName $ _flIt flit
textWidth = 9 * fromIntegral (length itText)
pushout = 80
worldPictures :: World -> Picture
worldPictures w
@@ -81,7 +119,7 @@ worldPictures w
, wlPicts
, wallShadows
, smokeShadows
, itLabels
-- , itLabels
, ppLabels
, btLabels
]
@@ -286,16 +324,6 @@ outsideScreenPolygon w = [tr,tl,bl,br]
bl = scTran $ scRot $ scZoom (- (3*halfWidth w),- (3* halfHeight w))
x = halfWidth w + halfHeight w
-- wallShadowsToDrawOnScreen :: World -> [Wall]
-- wallShadowsToDrawOnScreen w = --IM.elems $ _walls w
-- sortBy (compare `on` not . _wlIsSeeThrough) $ filter isVisible $ IM.elems
-- $ _walls w
-- -- $ wallsOnScreen w
-- -- should really sort this out
-- where onScreen wall = lineOnScreen w (_wlLine wall)
-- isVisible wl | wl ^? blVisible == Just False = False
-- | otherwise = onScreen wl
wallShadowsToDraw :: World -> [Wall]
wallShadowsToDraw w = --IM.elems $ _walls w
filter isVisible $ IM.elems -- $ _walls w
@@ -383,11 +411,11 @@ drawButText w bt | magV (_crPos (you w) -.- _btPos bt) < 100
&& hasLOS (_btPos bt) (_crPos (you w)) w
&& _btState bt /= BtNoLabel
= 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)]
--[ 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)]
]
| otherwise = blank
@@ -415,11 +443,11 @@ drawItemName :: World -> FloorItem -> Picture
drawItemName w flIt | magV (_crPos (you w) -.- _flItPos flIt) < 100
&& hasLOS (_flItPos flIt) (_crPos (you w)) w
= pictures
[ scale (2/_windowX w) (2/_windowY w)
. t
. translate (-15) (-10*sqrt zoom - 5) $ dShadCol white
$ scale 0.1 0.1 $ text $ nameOfItem
, tranItPos' $ line [(-8,10),(-15,10),(-15,-10),(-8,-10)]
--[ scale (2/_windowX w) (2/_windowY w)
-- . t
-- . translate (-15) (-10*sqrt zoom - 5) $ dShadCol white
-- $ scale 0.1 0.1 $ text $ nameOfItem
[ tranItPos' $ line [(-8,10),(-15,10),(-15,-10),(-8,-10)]
, tranItPos' $ line [( 8,10),( 15,10),( 15,-10),( 8,-10)]
]
| otherwise = blank