{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Game.LambdaHack.Client.UI.ItemSlot
( SlotChar(..), ItemSlots(..), SingleItemSlots
, allSlots, intSlots, slotLabel
, assignSlot, partyItemSet, sortSlotMap, mergeItemSlots
) where
import Prelude ()
import Game.LambdaHack.Common.Prelude
import Data.Binary
import Data.Bits (unsafeShiftL, unsafeShiftR)
import Data.Char
import qualified Data.EnumMap.Strict as EM
import qualified Data.EnumSet as ES
import Data.Function
import Data.Ord (comparing)
import qualified Data.Text as T
import Game.LambdaHack.Common.Actor
import Game.LambdaHack.Common.ActorState
import Game.LambdaHack.Common.Faction
import Game.LambdaHack.Common.Item
import Game.LambdaHack.Common.Misc
import Game.LambdaHack.Common.State
import qualified Game.LambdaHack.Content.ItemKind as IK
data SlotChar = SlotChar {slotPrefix :: Int, slotChar :: Char}
deriving (Show, Eq)
instance Ord SlotChar where
compare = comparing fromEnum
instance Binary SlotChar where
put = put . fromEnum
get = fmap toEnum get
instance Enum SlotChar where
fromEnum (SlotChar n c) =
unsafeShiftL n 8 + ord c + (if isUpper c then 100 else 0)
toEnum e =
let n = unsafeShiftR e 8
c0 = e - unsafeShiftL n 8
c100 = c0 - if c0 > 150 then 100 else 0
in SlotChar n (chr c100)
type SingleItemSlots = EM.EnumMap SlotChar ItemId
newtype ItemSlots = ItemSlots (EM.EnumMap SLore SingleItemSlots)
deriving (Show, Binary)
allChars :: [Char]
allChars = ['a'..'z'] ++ ['A'..'Z']
allSlots :: [SlotChar]
allSlots = concatMap (\n -> map (SlotChar n) allChars) [0..]
intSlots :: [SlotChar]
intSlots = map (flip SlotChar 'a') [0..]
slotLabel :: SlotChar -> Text
slotLabel x =
T.snoc (if slotPrefix x == 0 then T.empty else tshow $ slotPrefix x)
(slotChar x)
<> ")"
assignSlot :: ES.EnumSet ItemId -> SLore -> ItemSlots -> SlotChar
assignSlot partySet slore (ItemSlots itemSlots) =
head $ freeLowPrefix ++ free
where
lSlots = itemSlots EM.! slore
maxPrefix = case EM.maxViewWithKey lSlots of
Just ((lm, _), _) -> slotPrefix lm
Nothing -> 0
slotsUpTo k = concatMap (\n -> map (SlotChar n) allChars) [0..k]
f l = maybe True (`ES.notMember` partySet) $ EM.lookup l lSlots
free = filter f $ slotsUpTo (maxPrefix + 1)
g l = l {slotPrefix = maxPrefix} `EM.notMember` lSlots
freeLowPrefix = filter g free
partyItemSet :: SLore -> FactionId -> Maybe Actor -> State -> ES.EnumSet ItemId
partyItemSet slore fid mbody s =
let onPersons = combinedFromLore slore fid s
onGround = maybe EM.empty
(\b -> getFloorBag (blid b) (bpos b) s)
mbody
in ES.unions $ map EM.keysSet $ onPersons : [onGround | slore == SItem]
compareItemFull :: ItemFull -> ItemFull -> Ordering
compareItemFull itemFull1 itemFull2 =
let kindAndAppearance ItemFull{itemBase=Item{..}, ..} =
( not itemSuspect, itemKindId, itemDisco
, IK.isymbol itemKind, IK.iname itemKind
, jflavour, jfid, jlid )
in comparing kindAndAppearance itemFull1 itemFull2
sortSlotMap :: (ItemId -> ItemFull)-> ES.EnumSet ItemId -> SingleItemSlots
-> SingleItemSlots
sortSlotMap itemToF partySet em =
let (nearItems, farItems) = partition (`ES.member` partySet)
$ EM.elems em
f iid = (iid, itemToF iid)
sortItemIds l = map fst $ sortBy (compareItemFull `on` snd)
$ map f l
in EM.fromDistinctAscList $ zip allSlots
$ sortItemIds nearItems ++ sortItemIds farItems
mergeItemSlots :: (ItemId -> ItemFull) -> ES.EnumSet ItemId -> [SingleItemSlots]
-> SingleItemSlots
mergeItemSlots itemToF partySet ems =
let renumberSlot n SlotChar{slotPrefix, slotChar} =
SlotChar{slotPrefix = slotPrefix + n * 1000000, slotChar}
renumberMap n em1 = EM.mapKeys (renumberSlot n) em1
rms = zipWith renumberMap [0..] ems
em = EM.unionsWith (\_ _ -> error "mergeItemSlots: duplicate keys") rms
in sortSlotMap itemToF partySet em