Improve combine menu visuals

src/Dodge/Creature/Impulse/UseItem.hs

@@ -22,14 +22,12 @@ itemEffect :: Creature -> Item -> World -> World
 itemEffect cr it w = case it ^? itUse of
     Just RightUse {_rUse = eff,_useMods = usemods} 
                     -> hammerTest $ foldr ($) eff usemods it cr
-    Just LeftUse {} -> setuhamdown $ lhammer $ (toggleEquipmentAt (_rbOptions w) (_crInvSel cr)
+    Just LeftUse {} -> doequipmentchange
-        . activateEquipmentAt (_rbOptions w))
+    Just EquipUse{} -> doequipmentchange
-    Just EquipUse{} -> setuhamdown $ lhammer $ (toggleEquipmentAt (_rbOptions w) (_crInvSel cr)
-        . activateEquipmentAt (_rbOptions w))
     -- ConsumeUse will cause problems if the item is not selected
     Just (ConsumeUse eff) -> setuhamdown $ hammerTest $ eff it cr . rmInvItem (_crID cr) (_crInvSel cr)
-    Just NoUse -> setuhamdown w
+    Just NoUse  -> setuhamdown w
-    Nothing -> setuhamdown w
+    Nothing     -> setuhamdown w
   where
     hammerTest f = case _crHammerPosition cr of
         HammerUp -> f w
@@ -38,6 +36,8 @@ itemEffect cr it w = case it ^? itUse of
         HammerUp -> creatures . ix (_crID cr) %~ f'
         _ -> id
     setuhamdown = creatures . ix (_crID cr) . crHammerPosition .~ HammerDown
+    doequipmentchange = setuhamdown $ lhammer (toggleEquipmentAt (_rbOptions w) (_crInvSel cr)
+        . activateEquipmentAt (_rbOptions w))
 
 activateEquipmentAt :: RightButtonOptions -> Creature -> Creature
 activateEquipmentAt rbo = case (rbo ^? opActivateEquipment . activateEquipment, rbo ^? opActivateEquipment . deactivateEquipment) of
@@ -68,41 +68,6 @@ toggleEquipmentAt rbops invid cr = case rbops ^? opAllocateEquipment of
         -> cr & crEquipment . at oldp .~ Nothing
             & crInvEquipped . at invid .~ Nothing
     Nothing -> error "tried to toggle equipment whilst not prepared"
---    case cr ^? crInvEquipped . ix invid of
---    Just epos -> cr & crInvEquipped . at invid .~ Nothing
---        & crEquipment . at epos .~ Nothing
---    Nothing -> equipUsingSite invid itm cr
-
--- | First check if the item is already equiped, then do nothing
-equipUsingSiteCheck :: Int -> Item -> Creature -> Creature
-equipUsingSiteCheck invid itm cr
-    | isJust (cr ^? crInvEquipped . ix invid) = cr
-    | otherwise = equipUsingSite invid itm cr
-
-equipUsingSite :: Int -> Item -> Creature -> Creature
-equipUsingSite invid itm cr = cr
-    & crInvEquipped . at invid ?~ epos
-    & crEquipment . at epos ?~ invid
-    & removeOtherEquipment
-  where
-    epos = eqSiteToPos cr (_eqSite $ _itUse itm)
-    removeOtherEquipment = case cr ^? crEquipment . ix epos of
-        Nothing -> id
-        Just oid -> (crInvEquipped . at oid .~ Nothing) . removeIfLUse oid
-    removeIfLUse oid
-        | _crLeftInvSel cr == Just oid = crLeftInvSel .~ Nothing
-        | otherwise = id
-
-eqSiteToPos :: Creature -> EquipSite -> EquipPosition
-eqSiteToPos cr es = case es of
-    GoesOnHead      -> OnHead
-    GoesOnChest     -> OnChest
-    GoesOnBack      -> OnBack
-    GoesOnLegs      -> OnLegs
-    GoesOnSpecial   -> OnSpecial
-    GoesOnWrist     -> case cr ^? crEquipment . ix OnLeftWrist of
-        Nothing -> OnLeftWrist
-        _ -> OnRightWrist
 
 useLeftItem :: Int -> World -> World
 useLeftItem cid w 

src/Dodge/Event.hs

@@ -152,7 +152,7 @@ wheelEvent y w = case _hudElement $ _hud w of
 scrollRBOption :: Float -> World -> World
 scrollRBOption y w
     | y < 0 = w & rbOptions . opSel %~ (min (length (_opEquip (_rbOptions w))-1) . (+1))
-    | y > 0 = w & rbOptions . opSel %~ (max 0 . (subtract 1))
+    | y > 0 = w & rbOptions . opSel %~ (max 0 . subtract 1)
     | otherwise = w
 
 -- nice idea, but the chain of setters and getters seems prohibitive

src/Dodge/Inventory.hs

@@ -108,7 +108,7 @@ selNumPos i w = splitgap + (foldl' (+) 0 . fst $ IM.split i (augmentedInvSizes w
         | otherwise = 1
 
 selNumTextPos :: Configuration -> World -> Int -> Point2
-selNumTextPos cfig w i = V2 (150 - hw) ( hh + 20 * fromIntegral ipos + 7.5)
+selNumTextPos cfig w i = V2 (150 - hw) ( hh - (20 * fromIntegral ipos + 20))
   where
     hh = halfHeight cfig
     hw = halfWidth  cfig

src/Dodge/Render/HUD.hs

@@ -101,6 +101,7 @@ subInventoryDisplay subinv cfig w = case subinv of
             cpos  <- combinePoss  w !? i
             csize <- combineSizes w !? i
             col   <- (combineItemListYou w !? i) <&> _itInvColor . snd
+            --return $ listCursorNSW subInvX 60 cfig cpos col 15 csize
             return $ listCursorNSW subInvX 60 cfig cpos col 15 csize
         , fromMaybe mempty $ do
             i <- mi
@@ -108,7 +109,7 @@ subInventoryDisplay subinv cfig w = case subinv of
             col  <- (combineItemListYou w !? i) <&> _itInvColor . snd
             lnks <- map fst (combineItemListYou w) !? i
             return $ lnkMidPosInvSelsCol cfig w cpos col lnks
-                <> foldMap (cursorAtInvSel listCursorNESW cfig w) lnks
+                <> foldMap (topCursorTypeWidth listCursorNESW (topInvW +2) cfig w) lnks
                 <> combineCounts cfig w lnks
         ]
     InspectInventory -> invHead cfig "INSPECT"
@@ -119,7 +120,7 @@ subInventoryDisplay subinv cfig w = case subinv of
     itcol = fromMaybe (greyN 0.5) (it ^? _Just . itInvColor)
     cr = you w
     it = yourItem w
-    selcursor' ct = fromMaybe mempty $ ct 0 0 cfig curpos itcol topInvW cury <$ it
+    selcursor' ct = fromMaybe mempty $ ct 0 0 cfig curpos itcol (determineInvSelCursorWidth w) cury <$ it
     selcursor = selcursor' selcursortype
     selcursortype
         | ButtonRight `S.member` _mouseButtons w = listCursorNESW
@@ -127,36 +128,34 @@ subInventoryDisplay subinv cfig w = case subinv of
     curpos = invSelPos w
     cury   = fromMaybe 1 $ augmentedInvSizes w IM.!? _crInvSel (you w)
     equipcursor = case _crLeftInvSel cr of
-        Just invid | _crInvSel cr /= invid || not (ButtonRight `S.member` _mouseButtons w)
+        Just invid -> f cyan invid (_crInvEquipped cr IM.! invid)
-            -> f cyan invid (_crInvEquipped cr IM.! invid)
         _ -> mempty
     equipcursors = IM.foldMapWithKey (f yellow) (_crInvEquipped cr)
-    f col invid epos 
+    f col invid epos = listTextPictureAt 144 0 cfig (selNumPos invid w) . color col $ text $ eqPosText epos
-        | _crInvSel cr /= invid || not (ButtonRight `S.member` _mouseButtons w)
+--        | _crInvSel cr /= invid || not (ButtonRight `S.member` _mouseButtons w)
-            = listTextPictureAt 144 0 cfig (selNumPos invid w) . color col $ text $ eqPosText epos
+--            = listTextPictureAt 144 0 cfig (selNumPos invid w) . color col $ text $ eqPosText epos
-        | otherwise = mempty
+--        | otherwise = mempty
     --rboptions = listTextPicturesAtOffset 200 0 cfig (selNumPos invid w) ["TEST","ME"]
     rboptions = drawRBOptions cfig w (_rbOptions w)
 
 drawRBOptions :: Configuration -> World -> RightButtonOptions -> Picture
 drawRBOptions cfig w EquipOptions{_opEquip = es,_opSel=i, _opAllocateEquipment=ae} = 
-  listTextPicturesAtOffset 252 0 cfig (curpos-i) (map (text . eqPosText) es)
+  listTextPicturesAtOffset 342 0 cfig (curpos-i) (map (text . eqPosText) es)
   <> case ae of
     DoNotMoveEquipment -> mempty
     PutOnEquipment {}
-        -> putontext
+        -> midtext "PUT ONTO"
-    MoveEquipment {_allocOldPos = oldp }
+    MoveEquipment {}
-        -> putontext <> extratext ("MOVES FROM "++eqPosText oldp)
+        -> midtext "MOVE  TO" <> extratext []
     SwapEquipment { _allocOldPos = oldp, _allocSwapID = sid }
-        -> putontext <> extratext ("SWAPS "++otheritem sid ++ " ONTO " ++eqPosText oldp)
+        -> midtext "MOVE  TO" <> extratext ("SWAPS "++otheritem sid ++ " ONTO " ++eqPosText oldp)
     ReplaceEquipment { _allocRemoveID = rid }
-        -> putontext <> extratext ("REMOVES " ++ otheritem rid)
+        -> midtext "PUT ONTO" <> extratext ("REMOVES " ++ otheritem rid)
     RemoveEquipment { }
-        -> takeofftext
+        -> midtext "TAKE OFF"
   where
-    takeofftext = listTextPictureAt 144 0 cfig curpos (text " TAKE OFF")
+    midtext str = listTextPictureAt 252 0 cfig curpos (text str)
-    putontext   = listTextPictureAt 144 0 cfig curpos (text " PUT ONTO")
+    extratext str = listTextPictureAt 432 0 cfig curpos (text (str ++ deactivatetext))
-    extratext str = listTextPictureAt 350 0 cfig curpos (text (str ++ deactivatetext))
     deactivatetext = case w ^? rbOptions . opActivateEquipment . deactivateEquipment of
         Just k -> " DEACTIVATES " ++ _itName (_crInv (you w) IM.! k)
         Nothing -> ""
@@ -164,7 +163,6 @@ drawRBOptions cfig w EquipOptions{_opEquip = es,_opSel=i, _opAllocateEquipment=a
     otheritem j = _itName (_crInv (you w) IM.! j)
 drawRBOptions _ _ _ = mempty
 
-
 eqPosText :: EquipPosition -> String
 eqPosText ep = case ep of
     OnHead          -> "HEAD"
@@ -206,23 +204,29 @@ combineCounts :: Configuration -> World -> [Int] -> Picture
 combineCounts cfig w = winScale cfig . foldMap f . group
   where
     f (i:is) = case yourInv w ^? ix i . itConsumption of
-        Just _ -> color (selNumCol i w) $ uncurryV translate (V2 10 5 +.+ selNumMidHeight cfig w i) . scale 0.1 0.1 . text . show $ length is + 1
+        Just ItemItselfConsumable{} -> color (selNumCol i w) $ uncurryV translate (selNumTextPos cfig w i) . scale 0.1 0.1 . text $ ('-': show (length is + 1))
-        Nothing -> mempty
+        _ -> mempty
     f _ = mempty
 
 lnkMidPosInvSelsCol :: Configuration -> World -> Int -> Color -> [Int] -> Picture
 lnkMidPosInvSelsCol cfig w i col = winScale cfig 
-    . concatMap (\j -> zConnectCol rp (selNumMidHeight cfig w j) col white white (selNumCol j w))
+    . concatMap (\j -> zConnectCol rp (V2 18 0+selNumMidHeight cfig w j) col white white (selNumCol j w))
   where
 --    lp ipos = V2 (150 - hw) ( hh - (20 * fromIntegral ipos + 17.5))
     rp = V2 (190 - hw) ( hh - (20 * fromIntegral i + 77.5))
     hh = halfHeight cfig
     hw = halfWidth  cfig
 
-cursorAtInvSel ::  (Float -> Float -> Configuration -> Int -> Color -> Int -> Int -> Picture)
+topCursorTypeWidth ::  (Float -> Float -> Configuration -> Int -> Color -> Int -> Int -> Picture)
+    -> Int
     -> Configuration -> World -> Int -> Picture
-cursorAtInvSel ctype cfig w i 
+topCursorTypeWidth ctype width cfig w i 
-    = ctype 0 0 cfig (selNumPos i w) (selNumCol i w) topInvW (selNumSlots i w)
+    = ctype 0 0 cfig (selNumPos i w) (selNumCol i w) width (selNumSlots i w)
+
+determineInvSelCursorWidth :: World -> Int
+determineInvSelCursorWidth w = case _rbOptions w of
+   NoRightButtonOptions -> topInvW
+   EquipOptions {} -> 47
 
 --listSelHeight :: Configuration -> World -> Int -> Float
 --listSelHeight