138 lines
4.5 KiB
Haskell
138 lines
4.5 KiB
Haskell
{-# LANGUAGE LambdaCase #-}
|
|
module Dodge.Item.Display (
|
|
itemDisplay,
|
|
itemBaseName,
|
|
itemString,
|
|
basicItemDisplay,
|
|
) where
|
|
|
|
import Data.Maybe
|
|
import Dodge.Data.ComposedItem
|
|
import Dodge.Data.Creature
|
|
import Dodge.Item.InvSize
|
|
import LensHelp
|
|
import Padding
|
|
import ShortShow
|
|
|
|
-- Principles: base names should identify an item, numbers can change based on a
|
|
-- variety of factors but typically don't depend on functional quality,
|
|
-- colour gives an indication of an item's function within a structure
|
|
|
|
itemDisplay :: Creature -> ComposedItem -> [String]
|
|
itemDisplay cr ci =
|
|
zipWithDefaults
|
|
id
|
|
(leftPad 15 ' ')
|
|
itemDisplayPad
|
|
(basicItemDisplay itm)
|
|
(itemNumberDisplay 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 =
|
|
Prelude.take (itInvHeight itm) $
|
|
itemBaseName (itm ^. itType) :
|
|
--catMaybes [maybeWarmupStatus itm, maybeRateStatus itm]
|
|
catMaybes [maybeWarmupStatus itm]
|
|
++ repeat "*"
|
|
|
|
itemString :: Item -> String
|
|
itemString = head . basicItemDisplay
|
|
|
|
-- this should be immutable with the item type
|
|
itemBaseName :: ItemType -> String
|
|
itemBaseName = \case
|
|
CRAFT str -> show str
|
|
HELD hit -> case hit ^? xNum of
|
|
Just i -> takeWhile (/= ' ') (show hit) ++ show i
|
|
Nothing -> show hit
|
|
EQUIP eit -> showEquipItem eit
|
|
ATTACH ait -> showAttachItem ait
|
|
AMMOMAG ait -> show ait
|
|
TARGETING tt -> show tt
|
|
BULLETMOD (BulletModPayload btt) -> show btt
|
|
BULLETMOD (BulletModEffect btt) -> show btt
|
|
STICKYMOD -> "STICKYMOD"
|
|
ITEMSCANNER -> "ITEMSCANNER"
|
|
INTROSCAN t -> show t
|
|
|
|
showAttachItem :: AttachType -> String
|
|
showAttachItem t = case t of
|
|
UNDERBARRELSLOT -> "UNDERBARRELSLOT"
|
|
ZOOMSCOPE -> "ZOOMSCOPE"
|
|
BULLETSYNTH -> "BSYNTH"
|
|
REMOTESCREEN -> "REM.SCREEN"
|
|
JOYSTICK -> "JOYSTICK"
|
|
REMOTEDETONATOR -> "REM.DETONATR"
|
|
SMOKEREDUCER -> "SMOKE.REDUCR"
|
|
HOMINGMODULE -> "HOMING MOD"
|
|
AUGMENTEDHUD -> "AUGMENTED HUD"
|
|
SHELLPAYLOAD x -> show x
|
|
GIMBAL -> "GIMBAL"
|
|
GYROSCOPE -> "GYROSCOPE"
|
|
|
|
showEquipItem :: EquipItemType -> String
|
|
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 :: Creature -> ComposedItem -> [String]
|
|
itemNumberDisplay cr ci
|
|
| 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
|
|
-- Nothing -> Nothing
|
|
-- _ -> Just $ leftPad 3 ' ' (show (_rateMax . _heldDelay $ _itUse it))
|