237 lines
7.7 KiB
Haskell
237 lines
7.7 KiB
Haskell
{-# LANGUAGE LambdaCase #-}
|
|
|
|
module Dodge.Inventory.SelectionList (
|
|
invSelectionItem,
|
|
closeItemToSelectionItem,
|
|
closeButtonToSelectionItem,
|
|
getInventoryPath,
|
|
getItemValue,
|
|
) where
|
|
|
|
import Dodge.Creature.MaxHP
|
|
import Dodge.Data.Equipment.Misc
|
|
import Numeric
|
|
import Dodge.Inventory.Path
|
|
import Control.Applicative
|
|
import ShortShow
|
|
import Data.Maybe
|
|
import Dodge.Data.DoubleTree
|
|
import Dodge.Item.InvSize
|
|
import Dodge.Data.ComposedItem
|
|
import Dodge.Data.SelectionList
|
|
import Dodge.Data.World
|
|
import Dodge.Equipment.Text
|
|
import Dodge.Item.Display
|
|
import Dodge.Item.Grammar
|
|
import Dodge.Item.InventoryColor
|
|
import LensHelp
|
|
import NewInt
|
|
import Padding
|
|
import Picture.Base
|
|
|
|
invSelectionItem :: World -> Int -> LocationLDT ItemLink ComposedItem -> SelectionItem ()
|
|
invSelectionItem w indent loc =
|
|
SelectionItem
|
|
{ _siPictures = itemDisplay w cr ci
|
|
, _siHeight = itInvHeight $ ci ^. _1
|
|
, _siWidth = 15
|
|
, _siIsSelectable = True
|
|
, _siColor = itemInvColor ci
|
|
, _siOffX = indent
|
|
, _siPayload = ()
|
|
}
|
|
where
|
|
ci = loc ^. locLDT . ldtValue
|
|
cr = w ^?! cWorld . lWorld . creatures . ix 0
|
|
|
|
-- note the convoluted display of the hotkey/equipment, this was done to avoid a
|
|
-- space leak
|
|
itemDisplay :: World -> Creature -> ComposedItem -> [String]
|
|
itemDisplay w cr ci = -- f
|
|
basicItemDisplay itm
|
|
-- (itemNumberDisplay w cr ci)
|
|
`g` anyextra
|
|
where
|
|
itm = ci ^. _1
|
|
NInt itid = itm ^. itID
|
|
--f (x:xs) (y:_) = itemDisplayPad x y : xs
|
|
--f xs _ = xs
|
|
--g (x:xs) (y:_) = (rightPad 15 ' ' x ++ y) : xs
|
|
g (x:xs) (y:_) = (x ++ y) : xs
|
|
g xs _ = xs
|
|
anyextra = maybeToList (anyscroll <> anyexternal <> anyhotkey <> anyequippos)
|
|
anyhotkey = fmap hotkeyToString
|
|
(w ^? cWorld . lWorld . imHotkeys . unNIntMap . ix itid)
|
|
anyequippos = do
|
|
_ <- ci ^? _1 . itType . ibtEquip
|
|
epText <$> ci ^? _1 . itLocation . ilEquipSite
|
|
anyscroll = fmap absurround $ itemScrollDisplay =<< (ci ^? _1)
|
|
absurround str = " <" ++ str ++ ">"
|
|
anyexternal = fae <$> itemExternalValue itm w cr
|
|
-- will probably want to remote the !
|
|
fae (Left i) = " !"++shortShow i
|
|
fae (Right s) = " !" ++ s
|
|
|
|
epText :: Maybe EquipSite -> [Char]
|
|
epText (Just ep) = ' ' : rightPad 8 ' ' ('@' : eqPosText ep)
|
|
epText Nothing = " @NOT.EQP"
|
|
|
|
introScanValue :: Creature -> IntroScanType -> Either Int String
|
|
introScanValue cr = \case
|
|
HEALTH -> Left $ cr ^. crHP
|
|
MAXHEALTH -> Left $ crMaxHP $ cr ^. crType
|
|
|
|
itemExternalValue :: Item -> World -> Creature -> Maybe (Either Int String)
|
|
itemExternalValue itm w cr
|
|
| EQUIP WRIST_ECG <- itm ^. itType = Just . Right .
|
|
displayPulse $ cr ^?! crType . avatarPulse . pulseProgress
|
|
| Just t <- itm ^? itType . ibtIntroScanType = Just $ introScanValue cr t
|
|
| ITEMSCAN <- itm ^. itType
|
|
, Just ExamineInventory <- w ^? hud . hudElement . subInventory
|
|
= Just (Right "ON")
|
|
| BINGATE <- itm ^. itType = do
|
|
invid <- itm ^? itLocation . ilInvID
|
|
litm <- cr ^? crInv . ix (invid -2)
|
|
ritm <- cr ^? crInv . ix (invid -1)
|
|
x <- itm ^? itScroll . itsRangeInt
|
|
l <- getItemValue litm w cr ^? _Just . _Left
|
|
r <- getItemValue ritm w cr ^? _Just . _Left
|
|
Just . Left $ bgateCalc x l r
|
|
| UNIGATE <- itm ^. itType = do
|
|
invid <- itm ^? itLocation . ilInvID
|
|
itm' <- cr ^? crInv . ix (invid -1)
|
|
x <- itm ^? itScroll . itsRangeInt
|
|
y <- getItemValue itm' w cr ^? _Just . _Left
|
|
Just . Left $ ugateCalc x y
|
|
| otherwise = mempty
|
|
|
|
ugateCalc :: Int -> Int -> Int
|
|
ugateCalc x y = (x `div` ((2::Int) ^ (f y ::Int))::Int) `mod` 2
|
|
where
|
|
f i | i > 0 = 1
|
|
| otherwise = 0
|
|
|
|
bgateCalc :: Int -> Int -> Int -> Int
|
|
bgateCalc x l r = (x `div` ((2::Int) ^ ((2::Int)*f l + f r))) `mod` 2
|
|
where
|
|
f i | i > 0 = 1
|
|
| otherwise = 0
|
|
|
|
itemScrollDisplay :: Item -> Maybe String
|
|
itemScrollDisplay itm
|
|
| HELD ALTERIFLE <- itm ^. itType = Just $
|
|
case itm ^? itParams . alteRifleSwitch of
|
|
Just 0 -> "L"
|
|
_ -> "R"
|
|
| UseScope OpticScope{_opticZoom = x} <- itm ^. itUse = Just $ shortShow x
|
|
| UNIGATE <- itm ^. itType = do
|
|
i <- itm ^? itScroll . itsRangeInt
|
|
return $ toBinary 2 i
|
|
| BINGATE <- itm ^. itType = do
|
|
i <- itm ^? itScroll . itsRangeInt
|
|
return $ toBinary 4 i
|
|
| ItemScrollInt i <- itm ^. itScroll = Just $ show i
|
|
| ItemScrollIntRange _ i <- itm ^. itScroll = Just $ show i
|
|
| otherwise = Nothing
|
|
|
|
toBinary :: Int -> Int -> String
|
|
toBinary x = leftPad x '0' . ($ []) . showIntAtBase 2 f
|
|
where
|
|
f 0 = '0'
|
|
f _ = '1'
|
|
|
|
getItemValue :: Item -> World -> Creature -> Maybe (Either Int String)
|
|
getItemValue itm w cr = itemInternalValue itm <|> itemExternalValue itm w cr
|
|
<|> itemScrollValue itm
|
|
|
|
itemScrollValue :: Item -> Maybe (Either Int b)
|
|
itemScrollValue itm = Left <$> itm ^? itScroll . failing itsInt itsRangeInt
|
|
|
|
--itemDisplayPad :: [Char] -> String -> [Char]
|
|
--itemDisplayPad ls rs
|
|
-- | rs == "" = ls
|
|
-- | otherwise = midPadL 15 ' ' ls (' ' : rs)
|
|
|
|
--itemNumberDisplay :: World -> Creature -> ComposedItem -> [String]
|
|
--itemNumberDisplay w cr ci
|
|
-- | Just x <- ci ^? _1 . itUse . uInt = [show x]
|
|
-- | Just x <- ci ^? _1 . itUse . useToggle = [show x]
|
|
-- | ITEMSCAN <- ci ^. _1 . itType
|
|
-- , Just ExamineInventory <- w ^? hud . hudElement . subInventory = ["ACTIVE"]
|
|
-- | EQUIP WRIST_ECG <- ci ^. _1 . itType =
|
|
-- [displayPulse $ cr ^?! crType . avatarPulse . pulseProgress]
|
|
-- | isJust $ ci ^? _1 . itTargeting . itTgPos . _Just = ["!TARG!"]
|
|
-- | Just x <- ci ^? _1 . itConsumables . magLoadStatus . iaLoaded = [shortShow x]
|
|
-- | Just i <- ci ^? _1 . itUse . uaParams . apInt = [show i]
|
|
-- | Just x <- ci ^? _1 . itUse . uaParams . apProjectiles = [show 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
|
|
|
|
hotkeyToString :: Hotkey -> String
|
|
hotkeyToString x = " [" ++ hotkeyToChar x : "]"
|
|
|
|
hotkeyToChar :: Hotkey -> Char
|
|
hotkeyToChar = \case
|
|
HotkeyQ -> 'Q'
|
|
HotkeyE -> 'E'
|
|
HotkeyR -> 'R'
|
|
HotkeyZ -> 'Z'
|
|
HotkeyX -> 'X'
|
|
HotkeyC -> 'C'
|
|
HotkeyV -> 'V'
|
|
Hotkey1 -> '1'
|
|
Hotkey2 -> '2'
|
|
Hotkey3 -> '3'
|
|
Hotkey4 -> '4'
|
|
Hotkey5 -> '5'
|
|
Hotkey6 -> '6'
|
|
Hotkey7 -> '7'
|
|
Hotkey8 -> '8'
|
|
Hotkey9 -> '9'
|
|
Hotkey0 -> '0'
|
|
|
|
closeItemToSelectionItem :: World -> NewInt FloorInt -> Maybe (SelectionItem ())
|
|
closeItemToSelectionItem w (NInt i) = do
|
|
e <- w ^? cWorld . lWorld . floorItems . unNIntMap . ix i
|
|
let (pics, col) = closeItemToTextPictures e
|
|
return
|
|
SelectionItem
|
|
{ _siPictures = pics
|
|
, _siHeight = length pics
|
|
, _siWidth = 15
|
|
, _siIsSelectable = True
|
|
, _siColor = col
|
|
, _siOffX = 0
|
|
, _siPayload = ()
|
|
}
|
|
|
|
closeButtonToSelectionItem :: World -> Int -> Maybe (SelectionItem ())
|
|
closeButtonToSelectionItem w i = do
|
|
bt <- w ^? cWorld . lWorld . buttons . ix i
|
|
return
|
|
SelectionItem
|
|
{ _siPictures = [_btText bt]
|
|
, _siHeight = 1
|
|
, _siWidth = 15
|
|
, _siIsSelectable = True
|
|
, _siColor = yellow
|
|
, _siOffX = 0
|
|
, _siPayload = ()
|
|
}
|
|
|
|
closeItemToTextPictures :: FloorItem -> ([String], Color)
|
|
closeItemToTextPictures flit = (basicItemDisplay it, itemInvColor $ baseCI it)
|
|
where
|
|
it = _flIt flit
|