111 lines
3.5 KiB
Haskell
111 lines
3.5 KiB
Haskell
{-# LANGUAGE LambdaCase #-}
|
|
|
|
module Dodge.Item.Display (
|
|
itemBaseName,
|
|
itemString,
|
|
basicItemDisplay,
|
|
itemInternalValue,
|
|
) where
|
|
|
|
import Dodge.BaseTriggerType
|
|
--import Dodge.Item.UseDelay
|
|
import ShortShow
|
|
import Data.Maybe
|
|
import Dodge.Data.World
|
|
import Dodge.Item.InvSize
|
|
import LensHelp
|
|
|
|
-- 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 has been moved out of this module 06/01/25
|
|
|
|
basicItemDisplay :: Item -> [String]
|
|
basicItemDisplay itm =
|
|
Prelude.take (itInvHeight itm) $
|
|
(itemBaseName (itm ^. itType) ++ anyinternalvalue) :
|
|
catMaybes [maybeWarmupStatus itm]
|
|
++ repeat "*"
|
|
where
|
|
anyinternalvalue = maybe "" f $ itemInternalValue itm
|
|
f (Left i) = ' ':shortShow i
|
|
f (Right s) = ' ':s
|
|
|
|
itemInternalValue :: Item -> Maybe (Either Int String)
|
|
itemInternalValue itm
|
|
| Just x <- itm ^? itUse . uInt = Just (Left x)
|
|
| Just x <- itm ^? itUse . useToggle = Just (Right $ show x)
|
|
| isJust $ itm ^? itTargeting . itTgPos . _Just = Just $ Right "!TARGETING"
|
|
| Just x <- itm ^. itConsumables = Just $ Left x
|
|
| UseAttach (APInt i) <- itm ^. itUse = Just $ Left i
|
|
| UseAttach (APProjectiles x) <- itm ^. itUse = Just . Right $ show x
|
|
| v <- itm ^? itUse . uValue = v
|
|
|
|
|
|
maybeWarmupStatus :: Item -> Maybe String
|
|
maybeWarmupStatus it = case baseItemTriggerType it ^? warmMax of
|
|
Nothing -> Nothing
|
|
--Just m -> case m - (_warmTime . _heldDelay $ _itUse it) of
|
|
Just m -> case m - _wTime (_itParams 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
|
|
|
|
-- 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"
|
|
ITEMSCAN -> "ITEMSCAN"
|
|
INTROSCAN t -> show t
|
|
MAPPER -> "MAPPER"
|
|
DETECTOR t -> show t
|
|
ARHUD -> "AR-HUD"
|
|
DROPPER x -> "DROPPER-" ++ showInventoryPathing x
|
|
CLICKER x -> "CLICKER-" ++ showInventoryPathing x
|
|
COPIER x -> "COPIER-" ++ showInventoryPathing x
|
|
BINGATE -> "BINGATE"
|
|
UNIGATE -> "UNIGATE"
|
|
NULGATE -> "NULGATE"
|
|
LASER -> "LASER"
|
|
|
|
showInventoryPathing :: InventoryPathing -> String
|
|
showInventoryPathing = \case
|
|
ABSOLUTE -> "ABS"
|
|
RELCURS -> "CURS"
|
|
RELITEM -> "HERE"
|
|
|
|
showAttachItem :: AttachType -> String
|
|
showAttachItem = \case
|
|
UNDERBARRELSLOT -> "UNDERBARRELSLOT"
|
|
ZOOMSCOPE -> "ZOOMSCOPE"
|
|
BULLETSYNTH -> "BSYNTH"
|
|
REMOTESCREEN -> "REM.SCREEN"
|
|
JOYSTICK -> "JOYSTICK"
|
|
REMOTEDETONATOR -> "REM.DETONATR"
|
|
SMOKEREDUCER -> "SMOKE.REDUCR"
|
|
HOMINGMODULE -> "HOMING MOD"
|
|
SHELLPAYLOAD x -> show x
|
|
GIMBAL -> "GIMBAL"
|
|
GYROSCOPE -> "GYROSCOPE"
|
|
CAPACITOR -> "CAPACITOR"
|
|
|
|
showEquipItem :: EquipItemType -> String
|
|
showEquipItem eit = case eit of
|
|
INVISIBILITYEQUIPMENT esite -> "INVISIBILITY " ++ show esite
|
|
_ -> show eit
|