Tweak display when equiping

src/Dodge/Item/Display.hs

@@ -2,6 +2,7 @@ module Dodge.Item.Display (
     itemDisplay,
     selectedItemDisplay,
     itemString,
+    itemBaseName,
 ) where
 
 import Data.Maybe

src/Dodge/ListDisplayParams.hs

@@ -43,7 +43,7 @@ invDisplayParams w =
 secondColumnParams :: ListDisplayParams
 secondColumnParams =
     defaultListDisplayParams
-        & ldpPos . spPixelOff .~ V2 subInvX (-61)
+        & ldpPos . spPixelOff .~ V2 subInvX (-71)
         & ldpCursorSides .~ [North, South, West]
 
 subInvX :: Float
@@ -73,4 +73,3 @@ optionListDisplayParams =
         & ldpVerticalGap .~ 0
         & ldpWidth .~ FixedSelectionWidth 50
         & ldpCursorSides .~ [North, South, West]
-

src/Dodge/Render/HUD.hs

@@ -3,8 +3,7 @@ module Dodge.Render.HUD (
     drawHUD,
 ) where
 
-import Dodge.Render.HUD.Carte
+import Dodge.Item.Display
-import Dodge.ScreenPos
 import Control.Lens
 import Control.Monad
 import qualified Data.Map.Strict as M
@@ -24,7 +23,9 @@ import Dodge.Inventory
 import Dodge.Item.Info
 import Dodge.ListDisplayParams
 import Dodge.Render.Connectors
+import Dodge.Render.HUD.Carte
 import Dodge.Render.List
+import Dodge.ScreenPos
 import Dodge.SelectionSections
 import Dodge.SelectionSections.Draw
 import Dodge.Tweak.Show
@@ -45,7 +46,13 @@ drawHUD cfig w = case w ^. hud . hudElement of
             <> drawSubInventory subinv cfig w
 
 drawHP :: Configuration -> World -> Picture
-drawHP cfig = dShadCol white . displayHP 0 cfig
+drawHP cfig =
+    dShadCol white
+        . translate (halfWidth cfig) (halfHeight cfig - 40)
+        . scale 0.2 0.2
+        . textRight
+        . show
+        . (^?! cWorld . lWorld . creatures . ix 0 . crHP)
 
 drawInventory :: SelectionSections () -> World -> Configuration -> Picture
 drawInventory sss = drawSelectionSections sss . invDisplayParams
@@ -121,35 +128,51 @@ drawRBOptions cfig w = fromMaybe mempty $ do
     sss <- w ^? hud . hudElement . diSections
     (i', j) <- sss ^? sssExtra . sssSelPos . _Just
     curpos <- selSecSelPos i' j sss
-    let midtext str = toTopLeft cfig $ translate 252 0 $ drawListElement 10 1 curpos (text str)
+    let ytext = drawListElement 0 1 curpos . text
-    let extratext str = toTopLeft cfig $ translate 432 0 $ drawListElement 10 1 curpos (text (str ++ deactivatetext))
+        midstr = case ae of
+            DoNotMoveEquipment -> ""
+            PutOnEquipment{} -> "  PUT ON"
+            MoveEquipment{} -> " MOVE TO"
+            SwapEquipment{} -> " MOVE TO"
+            ReplaceEquipment{} -> "  PUT ON"
+            RemoveEquipment{} -> "TAKE OFF"
+        extrastr = case ae of
+            SwapEquipment{_allocOldPos = oldp, _allocSwapID = sid} ->
+                "SWAPS " ++ otheritem sid ++ " ONTO " ++ eqPosText oldp
+            ReplaceEquipment{_allocRemoveID = rid} ->
+                "REMOVES " ++ otheritem rid
+            _ -> ""
     return $
-        toTopLeft cfig (translate 342 0 $ drawListYoff (curpos - i) (map (text . eqPosText) es))
+        toTopLeft cfig
-            <> case ae of
+             $ translate 290 (-1) (ytext midstr)
-                DoNotMoveEquipment -> mempty
+            <> translate 160 (-1) (listCursorChooseBorderScale 0 1 [North,South] curpos 0 white 21 1)
-                PutOnEquipment{} ->
+            <> translate 380 (-1) (drawListYoff (curpos - i) (map (text . eqPosText) es))
-                    midtext "PUT ONTO"
+            <> translate 380 (-1) (listCursorChooseBorderScale 0 1 [East] (curpos - i) 0 white 7 (length es))
-                MoveEquipment{} ->
+            <> translate 380 (-1) (listCursorChooseBorderScale 0 1 [West] (curpos + 1) 0 white 7 (length es - (i+1)))
-                    midtext "MOVE  TO" <> extratext []
+            <> translate 380 (-1) (listCursorChooseBorderScale 0 1 [West] (curpos - i) 0 white 7 i)
-                SwapEquipment{_allocOldPos = oldp, _allocSwapID = sid} ->
+            <> translate 380 (-1) (maybetopborder i curpos)
-                    midtext "MOVE  TO" <> extratext ("SWAPS " ++ otheritem sid ++ " ONTO " ++ eqPosText oldp)
+            <> translate 380 (-1) (maybebottomborder i (length es) curpos)
-                ReplaceEquipment{_allocRemoveID = rid} ->
+            <> translate 460 (-1) (ytext extrastr)
-                    midtext "PUT ONTO" <> extratext ("REMOVES " ++ otheritem rid)
-                RemoveEquipment{} ->
-                    midtext "TAKE OFF"
   where
-    deactivatetext = case w ^? rbOptions . opActivateEquipment . deactivateEquipment of
+    maybetopborder 0 curpos= listCursorChooseBorderScale 0 1 [North] curpos 0 white 7 1
-        Just k -> " DEACTIVATES " ++ show (_iyBase $ _itType (_crInv (you w) IM.! k))
+    maybetopborder _ _ = mempty
-        Nothing -> ""
+    maybebottomborder a b curpos 
-    otheritem j = show $ _iyBase $ _itType (_crInv (you w) IM.! j)
+        | a == b - 1
+                    = listCursorChooseBorderScale 0 1 [South] curpos 0 white 7 1
+        | otherwise = mempty
+    otheritem j = fromMaybe "" $ do
+        itm <- you w ^? crInv . ix j
+        return $ itemBaseName itm
 
 examineInventoryExtra :: Maybe Int -> Maybe Item -> Configuration -> Picture
 examineInventoryExtra mtweaki mitm cfig = fromMaybe mempty $ do
     tweaki <- mtweaki
     -- consider moving this functionality out into a tweaks module
     tparam <- mitm ^? _Just . itTweaks . tweakParams . ix tweaki
-    return $ toTopLeft cfig $ translate subInvX (-60) 
+    return $
-        $ listCursorNSW tweaki 0 white (length $ showTweak tparam) 15
+        toTopLeft cfig $
+            translate subInvX (-60) $
+                listCursorNSW tweaki 0 white (length $ showTweak tparam) 15
 
 combineInventoryExtra :: SelectionSections CombinableItem -> Configuration -> World -> Picture
 combineInventoryExtra sss cfig w = fromMaybe mempty $ do
@@ -173,8 +196,9 @@ combineInventoryExtra sss cfig w = fromMaybe mempty $ do
     invcursor i = fromMaybe mempty $ do
         sss' <- w ^? hud . hudElement . diSections
         let idp = invDisplayParams w
-        return $ translateScreenPos cfig (idp ^. ldpPos) 
+        return $
-            $ selSecDrawCursor 17 [North, South, East] idp sss' 0 i
+            translateScreenPos cfig (idp ^. ldpPos) $
+                selSecDrawCursor 17 [North, South, East] idp sss' 0 i
 
 displayTerminal :: Int -> Configuration -> LWorld -> Picture
 displayTerminal tid cfig w = fromMaybe mempty $ do
@@ -238,12 +262,10 @@ tweakString tp = rightPad 12 ' ' (show $ _tweakType tp) ++ " " ++ showTweak tp
 invHead :: Configuration -> String -> Picture
 invHead cfig =
     translateScreenPos cfig (fromTopLeft (V2 subInvX 80))
-    -- (- halfWidth cfig + subInvX + 20) (halfHeight cfig - 80)
         . dShadCol white
         . scale 0.4 0.4
         . textJustifyLeft
 
-
 --locPoss = map (cartePosToScreen cfig (w ^. hud) . ($ w) . doWorldPos . fst) . IM.elems . _seenLocations . _lWorld $ _cWorld w
 --locTexts = map fst locs
 
@@ -255,7 +277,6 @@ invHead cfig =
 --    h :: String -> Point2 -> Point2
 --    h s (V2 x y) = V2 (x + 9 * fromIntegral (length s)) y
 
-
 --selectedCloseObjectLink :: Configuration -> World -> Picture
 --selectedCloseObjectLink cfig w = mempty
 
@@ -288,7 +309,6 @@ invHead cfig =
 --                     ( halfHeight cfig - 20* (fromIntegral invPos +1) + 2.5)
 --          return . winScale cfig . color col $ lConnect p itScreenPos
 
-
 textSelItems :: [String] -> [SelectionItem ()]
 textSelItems = map (picsToSelectable . (: []))
 
@@ -303,16 +323,6 @@ picsToSelectable pics =
         , _siPayload = ()
         }
 
-
-
-displayHP :: Int -> Configuration -> World -> Picture
-displayHP cid cfig =
-    translate (halfWidth cfig) (halfHeight cfig -40)
-        . scale 0.2 0.2
-        . textRight
-        . show
-        . (^?! cWorld . lWorld . creatures . ix cid . crHP)
-
 -- there are still more ListDisplayParams to integrate here
 selNumTextEndPos :: Configuration -> ListDisplayParams -> SelectionSections a -> Int -> Int -> Maybe Point2
 selNumTextEndPos cfig ldp sss i j = do

src/Dodge/Render/List.hs

@@ -10,6 +10,7 @@ module Dodge.Render.List (
     drawListYoff,
     stackPicturesAt,
     toTopLeft,
+    listCursorChooseBorderScale ,
 ) where
 
 import Dodge.ScreenPos

src/Dodge/TestString.hs

@@ -18,9 +18,10 @@ import Dodge.Data.Universe
 --import qualified Data.Map.Strict as M
 --import qualified IntMapHelp as IM
 testStringInit :: Universe -> [String]
-testStringInit u =  getPrettyShort (u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crHotkeys)
+testStringInit _ = mempty
-    <> ["---"]
+--    getPrettyShort (u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crHotkeys)
-    <> getPrettyShort ( u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crInvHotkeys)
+--    <> ["---"]
+--    <> getPrettyShort ( u ^? uvWorld . cWorld . lWorld . creatures . ix 0 . crInvHotkeys)
     
 --    [show $ u ^. uvWorld . input . smoothScrollAmount
 --    , show $ getSmoothScrollValue (u ^. uvWorld . input)