Improve combine menu visuals

2022-05-24 15:25:05 +01:00
parent 7f55ba117f
commit 7c472c4ca4
4 changed files with 37 additions and 68 deletions
@@ -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)
-        . activateEquipmentAt (_rbOptions w))
-    Just EquipUse{} -> setuhamdown $ lhammer $ (toggleEquipmentAt (_rbOptions w) (_crInvSel cr)
-        . activateEquipmentAt (_rbOptions w))
+    Just LeftUse {} -> doequipmentchange
+    Just EquipUse{} -> doequipmentchange
    -- 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
-    Nothing -> setuhamdown w
+    Just NoUse  -> 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 
@@ -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
@@ -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
@@ -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,43 +128,40 @@ 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)
-            -> f cyan invid (_crInvEquipped cr IM.! invid)
+        Just invid -> f cyan invid (_crInvEquipped cr IM.! invid)
        _ -> mempty
    equipcursors = IM.foldMapWithKey (f yellow) (_crInvEquipped cr)
-    f col invid epos 
-        | _crInvSel cr /= invid || not (ButtonRight `S.member` _mouseButtons w)
-            = listTextPictureAt 144 0 cfig (selNumPos invid w) . color col $ text $ eqPosText epos
-        | otherwise = mempty
+    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)
+--            = listTextPictureAt 144 0 cfig (selNumPos invid w) . color col $ text $ eqPosText epos
+--        | 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
-    MoveEquipment {_allocOldPos = oldp }
-        -> putontext <> extratext ("MOVES FROM "++eqPosText oldp)
+        -> midtext "PUT ONTO"
+    MoveEquipment {}
+        -> 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")
-    putontext   = listTextPictureAt 144 0 cfig curpos (text " PUT ONTO")
-    extratext str = listTextPictureAt 350 0 cfig curpos (text (str ++ deactivatetext))
+    midtext str = listTextPictureAt 252 0 cfig curpos (text str)
+    extratext str = listTextPictureAt 432 0 cfig curpos (text (str ++ deactivatetext))
    deactivatetext = case w ^? rbOptions . opActivateEquipment . deactivateEquipment of
        Just k -> " DEACTIVATES " ++ _itName (_crInv (you w) IM.! k)
        Nothing -> ""
    curpos = invSelPos w
    otheritem j = _itName (_crInv (you w) IM.! j)
 drawRBOptions _ _ _ = mempty
-    

 eqPosText :: EquipPosition -> String
 eqPosText ep = case ep of
@@ -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
-        Nothing -> mempty
+        Just ItemItselfConsumable{} -> color (selNumCol i w) $ uncurryV translate (selNumTextPos cfig w i) . scale 0.1 0.1 . text $ ('-': show (length is + 1))
+        _ -> 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 
-    = ctype 0 0 cfig (selNumPos i w) (selNumCol i w) topInvW (selNumSlots i w)
+topCursorTypeWidth ctype width cfig w i 
+    = 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