68 lines
2.0 KiB
Haskell
68 lines
2.0 KiB
Haskell
module Dodge.Inventory.SelectionList (
|
|
invSelectionItem,
|
|
closeObjectToSelectionItem,
|
|
) where
|
|
|
|
import Padding
|
|
import Dodge.Equipment.Text
|
|
import Dodge.Data.SelectionList
|
|
import Dodge.Data.World
|
|
import Dodge.Item.SlotsTaken
|
|
import Dodge.Item.Display
|
|
import LensHelp
|
|
import Picture.Base
|
|
|
|
invSelectionItem :: Creature -> Int -> Item -> SelectionItem ()
|
|
invSelectionItem cr i it =
|
|
SelectionItem
|
|
{ _siPictures = pics & ix 0 %~ (++ anyequippos ++ anyhotkey)
|
|
, _siHeight = length pics
|
|
, _siIsSelectable = True
|
|
, _siColor = col
|
|
, _siOffX = 0
|
|
, _siPayload = ()
|
|
}
|
|
where
|
|
anyhotkey = maybe [] ((' ':) .hotkeyToString) (cr ^? crInvHotkeys . ix i)
|
|
anyequippos = maybe [] (rightPad 8 ' ' . (' ':) . eqPosText) (cr ^? crInvEquipped . ix i)
|
|
col = _itInvColor it
|
|
pics = take (itSlotsTaken it) . (++ replicate 10 "*") $ case _itCurseStatus it of
|
|
UndroppableIdentified -> itemDisplay it
|
|
_ | cr ^? crManipulation . manObject . inInventory . ispItem == Just i -> selectedItemDisplay cr it
|
|
_ -> itemDisplay it
|
|
|
|
hotkeyToString :: Hotkey -> String
|
|
hotkeyToString x = case x of
|
|
HotkeyQ -> "[Q]"
|
|
HotkeyE -> "[E]"
|
|
Hotkey1 -> "[1]"
|
|
Hotkey2 -> "[2]"
|
|
Hotkey3 -> "[3]"
|
|
Hotkey4 -> "[4]"
|
|
Hotkey5 -> "[5]"
|
|
Hotkey6 -> "[6]"
|
|
Hotkey7 -> "[7]"
|
|
Hotkey8 -> "[8]"
|
|
Hotkey9 -> "[9]"
|
|
Hotkey0 -> "[0]"
|
|
|
|
closeObjectToSelectionItem :: Either FloorItem Button -> SelectionItem ()
|
|
closeObjectToSelectionItem e =
|
|
SelectionItem
|
|
{ _siPictures = pics
|
|
, _siHeight = length pics
|
|
, _siIsSelectable = True
|
|
, --, _siWidth = 15
|
|
_siColor = col
|
|
, _siOffX = 2
|
|
, _siPayload = ()
|
|
}
|
|
where
|
|
(pics, col) = closeObjectToTextPictures e
|
|
|
|
--
|
|
closeObjectToTextPictures :: Either FloorItem Button -> ([String], Color)
|
|
closeObjectToTextPictures e = case e of
|
|
Left flit -> let it = _flIt flit in (itemDisplay it, _itInvColor it)
|
|
Right bt -> ([_btText bt], yellow)
|