151 lines
5.2 KiB
Haskell
151 lines
5.2 KiB
Haskell
module Dodge.Item.Display (
|
|
itemDisplay,
|
|
-- canAttachTargeting,
|
|
itemString,
|
|
itemBaseName,
|
|
basicItemDisplay,
|
|
) where
|
|
|
|
--import Control.Applicative
|
|
--import Control.Monad
|
|
import ShortShow
|
|
import Data.Maybe
|
|
import Dodge.Data.Creature
|
|
import LensHelp
|
|
import Padding
|
|
|
|
--canAttachTargeting :: TargetingType -> Item -> Bool
|
|
--canAttachTargeting TARGETLASER _ = True
|
|
--canAttachTargeting _ itm =
|
|
-- isJust (itm ^? itType . iyModules . ix ModBulletTrajectory . imtBulletTrajectoryType)
|
|
-- || Just LAUNCHHOME == (itm ^? itType . iyModules . ix ModLauncherHoming)
|
|
|
|
--targetingTypeString :: TargetType -> String
|
|
--targetingTypeString tt = case tt of
|
|
-- TARGETLASER -> "LASER"
|
|
-- TargetRBPress -> "POS"
|
|
-- TargetRBLine -> ""
|
|
-- TargetRBCreature -> "LIFEFORM"
|
|
-- TargetCursor -> "CURSOR"
|
|
|
|
itemDisplay :: Creature -> Item -> [String]
|
|
itemDisplay cr itm =
|
|
--itemDisplayWithNumber (showConsumption cr it) it
|
|
zipWithDefaults id (leftPad 15 ' ') itemDisplayPad (basicItemDisplay itm) (itemNumberDisplay cr itm)
|
|
|
|
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 (_itInvSize itm) $
|
|
itemBaseName itm :
|
|
--catMaybes [maybeWarmupStatus itm, maybeRateStatus itm]
|
|
catMaybes [maybeWarmupStatus itm]
|
|
-- ++ moduleStrings itm
|
|
++ repeat "*"
|
|
|
|
itemString :: Item -> String
|
|
itemString = head . basicItemDisplay
|
|
|
|
itemBaseName :: Item -> String
|
|
itemBaseName itm = case _itType itm of
|
|
CRAFT str -> show str
|
|
HELD hit -> case hit ^? xNum of
|
|
Just i -> takeWhile (/= ' ') (show hit) ++ show i
|
|
Nothing -> show hit
|
|
LEFT lit -> show lit
|
|
EQUIP eit -> showEquipItem eit
|
|
CONSUMABLE cit -> show cit
|
|
ATTACH ait -> showAttachItem ait itm
|
|
AMMOMAG ait -> show ait
|
|
TARGETING tt -> show tt
|
|
BULLETMOD (BulletModTrajectory btt) -> show btt
|
|
BULLETMOD (BulletModPayload btt) -> show btt
|
|
BULLETMOD (BulletModEffect btt) -> show btt
|
|
|
|
showAttachItem :: AttachType -> Item -> String
|
|
showAttachItem t itm = case t of
|
|
ZOOMSCOPE -> "ZOOMSCOPE"
|
|
-- TARGETATTACH x -> show x
|
|
BULLETSYNTHESIZER -> "BSYNTH"
|
|
REMOTESCREEN -> "REMOTE SCREEN " ++ show (itm ^? itUse . atLinkedProjectile . _Just)
|
|
HOMINGMODULE -> "HOMING MOD"
|
|
AUGMENTEDHUD -> "AUGMENTED HUD"
|
|
|
|
showEquipItem :: EquipItemType -> String
|
|
showEquipItem eit = case eit of
|
|
INVISIBILITYEQUIPMENT esite -> "INVISIBILITY " ++ show esite
|
|
_ -> show eit
|
|
|
|
showAutoRechargeProgress :: LeftConsumption -> String
|
|
showAutoRechargeProgress lc = case lc of
|
|
AutoRecharging{}
|
|
| _arLoaded lc < _arMax lc -> show (_arProgress lc) ++ "C" ++ show (_arLoaded lc)
|
|
| otherwise -> show (_arLoaded lc)
|
|
ChargeableAmmo{} -> show (_wpCharge lc)
|
|
|
|
--showReloadProgress :: Creature -> Item -> String
|
|
--showReloadProgress cr itm = case cr ^? crManipulation . manObject . inInventory . iselAction of
|
|
-- Just (ReloadAction i la) -> show i ++ showLoadActionType la ic
|
|
-- _ -> case ic of
|
|
-- InternalSource ia -> case ia ^? iaProgress . _Just . ix 0 of
|
|
-- Nothing -> show $ ia ^. iaLoaded
|
|
-- Just la -> show (_actionTime la) ++ showLoadActionType la ic
|
|
-- AboveSource -> fromMaybe "XXXX" $ do
|
|
-- i <- fmap (subtract 1) $ itm ^? itLocation . ipInvID
|
|
-- x <- cr ^? crInv . ix i . itUse . equipEffect . eeUse . euseAmmoAmount
|
|
-- return $ showIntKMG' x
|
|
-- where
|
|
-- ic = (itm ^?! itUse . heldConsumption . laSource)
|
|
|
|
itemNumberDisplay :: Creature -> Item -> [String]
|
|
itemNumberDisplay cr itm = case iu of
|
|
UseHeld{} -> []
|
|
UseHotkey{} -> [showAutoRechargeProgress (_leftConsumption iu)]
|
|
EquipUse{} -> showEquipmentNumber cr itm
|
|
CraftUse -> []
|
|
UseConsume {} -> []
|
|
AttachUse {} -> []
|
|
UseAmmoMag {} -> [maybe "" shortShow $ itm ^? itUse . amagLoadStatus . iaLoaded]
|
|
ScopeUse OpticScope {_opticZoom = x} -> [shortShow x]
|
|
ScopeUse {} -> []
|
|
TargetingUse {_tgPos = mp} -> [maybe "" shortShow mp]
|
|
-- this could be cleaner here...
|
|
BulletModUse {} -> mempty
|
|
where
|
|
iu = itm ^?! itUse
|
|
|
|
showEquipmentNumber :: Creature -> Item -> [String]
|
|
showEquipmentNumber _ itm = case _eeUse ee of
|
|
EFuelSource x _ -> [show x]
|
|
EAmmoSource{_euseAmmoAmount = x} -> [show x]--showAmmoSource cr itm
|
|
EBatterySource{_euseBatteryAmount = x} -> [show x]
|
|
_ -> [""]
|
|
where
|
|
ee = itm ^?! itUse . equipEffect
|
|
|
|
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))
|