diff --git a/src/Dodge/Inventory/SelectionList.hs b/src/Dodge/Inventory/SelectionList.hs index 9714e89ca..2aec75535 100644 --- a/src/Dodge/Inventory/SelectionList.hs +++ b/src/Dodge/Inventory/SelectionList.hs @@ -1,4 +1,4 @@ ---{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE LambdaCase #-} module Dodge.Inventory.SelectionList ( invSelectionItem, @@ -6,6 +6,8 @@ module Dodge.Inventory.SelectionList ( closeButtonToSelectionItem, ) where +import ShortShow +import Data.Maybe import Dodge.Data.DoubleTree import Dodge.Item.InvSize import Dodge.Data.ComposedItem @@ -46,6 +48,66 @@ invSelectionItem w indent loc = col = itemInvColor ci pics = itemDisplay w cr ci +itemDisplay :: World -> Creature -> ComposedItem -> [String] +itemDisplay w cr ci = + zipWithDefaults + id + (leftPad 15 ' ') + itemDisplayPad + (basicItemDisplay itm) + (itemNumberDisplay w cr ci) + where + itm = ci ^. _1 + +zipWithDefaults :: (a -> c) -> (b -> c) -> (a -> b -> c) -> [a] -> [b] -> [c] +zipWithDefaults f g h = go + where + go [] bs = map g bs + go as [] = map f as + go (a : as) (b : bs) = h a b : go as bs + +itemDisplayPad :: [Char] -> String -> [Char] +itemDisplayPad ls rs + | rs == "" = ls + | otherwise = midPadL 15 ' ' ls (' ' : rs) + +-- this can change, but probably won't when (say) dropped and then picked up +-- again +-- that is to say, it should not change based on functional positioning +itemNumberDisplay :: World -> Creature -> ComposedItem -> [String] +itemNumberDisplay w cr ci + | Just x <- ci ^? _1 . itUse . uInt = [show x] + | Just x <- ci ^? _1 . itUse . useToggle = [show x] + | ITEMSCAN <- ci ^. _1 . itType + , Just ExamineInventory <- w ^? hud . hudElement . subInventory + = ["ACTIVE"] + | EQUIP WRIST_ECG <- ci ^. _1 . itType = + [displayPulse $ cr ^?! crType . avatarPulse . pulseProgress] + | HELD ALTERIFLE <- ci ^. _1 . itType = + case ci ^? _1 . itUse . heldAim . aimMuzzles . ix 0 . mzAmmoSlot of + Just 0 -> ["/"] + _ -> ["\\"] + | isJust $ ci ^? _1 . itTargeting . itTgPos . _Just = + ["!TARG!"] + | Just x <- ci ^? _1 . itConsumables . magLoadStatus . iaLoaded = [shortShow x] + | UseAttach (APInt i) <- ci ^. _1 . itUse = [show i] +-- | UseAttach (APLinkProjectile i) <- ci ^. _1 . itUse = [show i] + | UseAttach (APProjectiles x) <- ci ^. _1 . itUse = [show x] + | UseScope OpticScope{_opticZoom = x} <- ci ^. _1 . itUse = [shortShow x] + | Just t <- ci ^? _1 . itType . ibtIntroScanType = [introScanDisplay cr t] + | otherwise = mempty + +introScanDisplay :: Creature -> IntroScanType -> String +introScanDisplay cr = \case + HEALTH -> shortShow (cr ^. crHP) + MAXHEALTH -> shortShow (cr ^. crMaxHP) + +displayPulse :: Int -> String +displayPulse 0 = "*****" +displayPulse x = take 5 $ drop y "----^-----" + where + y = min 5 $ x `div` 3 + hotkeyToString :: Hotkey -> String hotkeyToString x = case x of HotkeyQ -> "[Q]" diff --git a/src/Dodge/Item/Display.hs b/src/Dodge/Item/Display.hs index d23dd025c..53093a6f6 100644 --- a/src/Dodge/Item/Display.hs +++ b/src/Dodge/Item/Display.hs @@ -1,6 +1,5 @@ {-# LANGUAGE LambdaCase #-} module Dodge.Item.Display ( - itemDisplay, itemBaseName, itemString, basicItemDisplay, @@ -18,28 +17,6 @@ import ShortShow -- variety of factors but typically don't depend on functional quality, -- colour gives an indication of an item's function within a structure -itemDisplay :: World -> Creature -> ComposedItem -> [String] -itemDisplay w cr ci = - zipWithDefaults - id - (leftPad 15 ' ') - itemDisplayPad - (basicItemDisplay itm) - (itemNumberDisplay w cr ci) - where - itm = ci ^. _1 - -zipWithDefaults :: (a -> c) -> (b -> c) -> (a -> b -> c) -> [a] -> [b] -> [c] -zipWithDefaults f g h = go - where - go [] bs = map g bs - go as [] = map f as - go (a : as) (b : bs) = h a b : go as bs - -itemDisplayPad :: [Char] -> String -> [Char] -itemDisplayPad ls rs - | rs == "" = ls - | otherwise = midPadL 15 ' ' ls (' ' : rs) basicItemDisplay :: Item -> [String] basicItemDisplay itm = @@ -49,6 +26,17 @@ basicItemDisplay itm = catMaybes [maybeWarmupStatus itm] ++ repeat "*" +maybeWarmupStatus :: Item -> Maybe String +maybeWarmupStatus it = case it ^? itUse . heldDelay . warmMax of + Nothing -> Nothing + Just m -> case m - (_warmTime . _heldDelay $ _itUse it) of + x + | x <= 1 -> Just "*WARM" + | otherwise -> + let n = show x + in Just $ Prelude.take (5 - Prelude.length n) "*WARM" ++ n + + itemString :: Item -> String itemString = head . basicItemDisplay @@ -102,52 +90,6 @@ showEquipItem eit = case eit of INVISIBILITYEQUIPMENT esite -> "INVISIBILITY " ++ show esite _ -> show eit --- this can change, but probably won't when (say) dropped and then picked up --- again --- that is to say, it should not change based on functional positioning -itemNumberDisplay :: World -> Creature -> ComposedItem -> [String] -itemNumberDisplay w cr ci - | Just x <- ci ^? _1 . itUse . uInt = [show x] - | Just x <- ci ^? _1 . itUse . useToggle = [show x] - | ITEMSCAN <- ci ^. _1 . itType - , Just ExamineInventory <- w ^? hud . hudElement . subInventory - = ["ACTIVE"] - | EQUIP WRIST_ECG <- ci ^. _1 . itType = - [displayPulse $ cr ^?! crType . avatarPulse . pulseProgress] - | HELD ALTERIFLE <- ci ^. _1 . itType = - case ci ^? _1 . itUse . heldAim . aimMuzzles . ix 0 . mzAmmoSlot of - Just 0 -> ["/"] - _ -> ["\\"] - | isJust $ ci ^? _1 . itTargeting . itTgPos . _Just = - ["!TARG!"] - | Just x <- ci ^? _1 . itConsumables . magLoadStatus . iaLoaded = [shortShow x] - | UseAttach (APInt i) <- ci ^. _1 . itUse = [show i] --- | UseAttach (APLinkProjectile i) <- ci ^. _1 . itUse = [show i] - | UseAttach (APProjectiles x) <- ci ^. _1 . itUse = [show x] - | UseScope OpticScope{_opticZoom = x} <- ci ^. _1 . itUse = [shortShow x] - | Just t <- ci ^? _1 . itType . ibtIntroScanType = [introScanDisplay cr t] - | otherwise = mempty - -introScanDisplay :: Creature -> IntroScanType -> String -introScanDisplay cr = \case - HEALTH -> shortShow (cr ^. crHP) - MAXHEALTH -> shortShow (cr ^. crMaxHP) - -displayPulse :: Int -> String -displayPulse 0 = "*****" -displayPulse x = take 5 $ drop y "----^-----" - where - y = min 5 $ x `div` 3 - -maybeWarmupStatus :: Item -> Maybe String -maybeWarmupStatus it = case it ^? itUse . heldDelay . warmMax of - Nothing -> Nothing - Just m -> case m - (_warmTime . _heldDelay $ _itUse it) of - x - | x <= 1 -> Just "*WARM" - | otherwise -> - let n = show x - in Just $ Prelude.take (5 - Prelude.length n) "*WARM" ++ n --maybeRateStatus :: Item -> Maybe String --maybeRateStatus it = case it ^? itUse . heldDelay . rateMaxMax of