From c8705a88c254d46be1c58b03e52c4885156873e5 Mon Sep 17 00:00:00 2001
From: jgk <justin.g.kruger@gmail.com>
Date: Mon, 8 Mar 2021 19:09:24 +0100
Subject: [PATCH] Improve floor item labels

---
 src/Dodge/Rendering.hs | 76 +++++++++++++++++++++++++++++-------------
 1 file changed, 52 insertions(+), 24 deletions(-)

diff --git a/src/Dodge/Rendering.hs b/src/Dodge/Rendering.hs
index 92a3cee64..8bbb7e9a2 100644
--- a/src/Dodge/Rendering.hs
+++ b/src/Dodge/Rendering.hs
@@ -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