loop/src/Dodge/Item/Display.hs

module Dodge.Item.Display (
    --itemDisplay,
    itemDisplayOffset,
    canAttachTargetingBelow,
    --    selectedItemDisplay,
    itemString,
    itemBaseName,
    basicItemDisplay,
) where

import Control.Applicative
import Control.Monad
import Data.Maybe
import Dodge.Data.Creature
import Dodge.Item.Info
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
    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 -> show ait

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
    CraftUse x -> [show $ x ^. getItAmount]
    ConsumeUse {_useAmount = x} -> [show $ x ^. getItAmount]
    AttachUse {} -> []
    
  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))