Files
loop/src/Dodge/Item/Display.hs
T

182 lines
6.4 KiB
Haskell

module Dodge.Item.Display (
--itemDisplay,
itemDisplayOffset,
canAttachTargetingBelow,
-- selectedItemDisplay,
itemString,
itemBaseName,
basicItemDisplay,
) where
import Control.Applicative
import Control.Monad
import Dodge.Item.Info
import Data.Maybe
import Dodge.Data.Creature
import Dodge.Item.SlotsTaken
import Dodge.Module
import LensHelp
import Padding
itemDisplayOffset :: Creature -> Item -> (Int,[String])
itemDisplayOffset cr itm = case itm ^. itType . iyBase of
EQUIP (TARGETINGHAT tt) | targetItemCanAttachAbove cr itm
-> (-1, leftPad 15 ' ' (targetingTypeString tt) :
(itemDisplay cr itm & ix 0 %~ (\s -> itemDisplayPad s (replicate (length (targetingTypeString tt)) '^') )))
EQUIP (TARGETINGHAT tt)
-> (0, itemDisplay cr itm & ix 0 %~ (\s -> itemDisplayPad s (targetingTypeString tt)))
_ -> (0, itemDisplay cr itm)
targetItemCanAttachAbove :: Creature -> Item -> Bool
targetItemCanAttachAbove cr itm = fromMaybe False $ do
i <- itm ^? itLocation . ipInvID
itm' <- cr ^? crInv . ix (i - 1)
return $ canAttachTargetingBelow itm'
canAttachTargetingBelow :: Item -> Bool
canAttachTargetingBelow 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 (itSlotsTaken itm) $
itemBaseName itm :
catMaybes [maybeWarmupStatus itm, maybeRateStatus itm]
++ moduleStrings itm
++ repeat "*"
itemString :: Item -> String
itemString = head . basicItemDisplay
itemBaseName :: Item -> String
itemBaseName it = case _iyBase $ _itType it of
NoItemType -> show "NoItemType"
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
showEquipItem :: EquipItemType -> String
showEquipItem eit = case eit of
TARGETINGHAT _ -> "TARG.HAT"
_ -> 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
HeldUse{} -> [showReloadProgress cr itm]
LeftUse{} -> [showAutoRechargeProgress (_leftConsumption iu)]
EquipUse{} -> showEquipmentNumber cr itm
_ -> [show $ iu ^?! useAmount . getItAmount]
where
iu = itm ^?! itUse
showEquipmentNumber :: Creature -> Item -> [String]
showEquipmentNumber cr itm = case _eeUse ee of
EFuelSource x _ -> [show x]
EAmmoSource {} -> showAmmoSource cr itm
EBatterySource {_euseBatteryAmount = x} -> [show x]
_ -> [""]
where
ee = itm ^?! itUse . equipEffect
showAmmoSource :: Creature -> Item -> [String]
showAmmoSource cr itm = fromMaybe ["FAIL"] $ do
eu <- itm ^? itUse . equipEffect . eeUse
atype <- eu ^? euseAmmoSourceType
x <- fmap showIntKMG' $ eu ^? euseAmmoAmount
i <- itm ^? itLocation . ipInvID
(do
at' <- cr ^? crInv . ix (i + 1) . itUse . heldConsumption . laSourceType
as <- cr ^? crInv . ix (i + 1) . itUse . heldConsumption . laSource
guard (at' == atype && as == AboveSource)
return ["vvvv",x] ) <|> Just [x]
showReloadProgress :: Creature -> Item -> String
showReloadProgress cr itm = case ic ^? laSource of
Just (InternalSource ia) -> case ia ^? iaProgress . _Just . ix 0 of
Nothing -> maybe "" show $ ic ^? laSource . _InternalSource . iaLoaded
Just la -> showLoadActionType la (_laSource ic)
Just AboveSource -> fromMaybe "||||" $ do
i <- fmap (subtract 1) $ itm ^? itLocation . ipInvID
_ <- cr ^? crInv . ix i . itUse . equipEffect . eeUse . euseAmmoAmount
return ""
_ -> ""
where
ic = itm ^?! itUse . heldConsumption
showLoadActionType :: LoadAction -> AmmoSource -> String
showLoadActionType la as = case la of
LoadEject{} -> "E"
LoadInsert{} -> "L"
LoadAdd{} -> "A" ++ x
LoadPrime{} -> "P"
where
x = maybe "" show $ as ^? _InternalSource . iaLoaded
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))