{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-- | Item slots for UI and AI item collections.
module Game.LambdaHack.Client.UI.ItemSlot
  ( SlotChar(..), ItemSlots(..), SingleItemSlots
  , allSlots, intSlots, slotLabel
  , assignSlot, sortSlotMap, mergeItemSlots
  ) where

import Prelude ()

import Game.LambdaHack.Core.Prelude

import           Data.Binary
import           Data.Bits (unsafeShiftL, unsafeShiftR)
import           Data.Char
import qualified Data.EnumMap.Strict as EM
import qualified Data.Text as T

import           Game.LambdaHack.Common.Item
import           Game.LambdaHack.Common.Types
import qualified Game.LambdaHack.Content.ItemKind as IK
import           Game.LambdaHack.Definition.Defs

-- | Slot label. Usually just a character. Sometimes with a numerical prefix.
data SlotChar = SlotChar {SlotChar -> Int
slotPrefix :: Int, SlotChar -> Char
slotChar :: Char}
  deriving (Int -> SlotChar -> ShowS
[SlotChar] -> ShowS
SlotChar -> String
(Int -> SlotChar -> ShowS)
-> (SlotChar -> String) -> ([SlotChar] -> ShowS) -> Show SlotChar
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SlotChar] -> ShowS
$cshowList :: [SlotChar] -> ShowS
show :: SlotChar -> String
$cshow :: SlotChar -> String
showsPrec :: Int -> SlotChar -> ShowS
$cshowsPrec :: Int -> SlotChar -> ShowS
Show, SlotChar -> SlotChar -> Bool
(SlotChar -> SlotChar -> Bool)
-> (SlotChar -> SlotChar -> Bool) -> Eq SlotChar
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SlotChar -> SlotChar -> Bool
$c/= :: SlotChar -> SlotChar -> Bool
== :: SlotChar -> SlotChar -> Bool
$c== :: SlotChar -> SlotChar -> Bool
Eq)

instance Ord SlotChar where
  compare :: SlotChar -> SlotChar -> Ordering
compare = (SlotChar -> Int) -> SlotChar -> SlotChar -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing SlotChar -> Int
forall a. Enum a => a -> Int
fromEnum

instance Binary SlotChar where
  put :: SlotChar -> Put
put = Int -> Put
forall t. Binary t => t -> Put
put (Int -> Put) -> (SlotChar -> Int) -> SlotChar -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SlotChar -> Int
forall a. Enum a => a -> Int
fromEnum
  get :: Get SlotChar
get = (Int -> SlotChar) -> Get Int -> Get SlotChar
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> SlotChar
forall a. Enum a => Int -> a
toEnum Get Int
forall t. Binary t => Get t
get

instance Enum SlotChar where
  fromEnum :: SlotChar -> Int
fromEnum (SlotChar n :: Int
n c :: Char
c) =
    Int -> Int -> Int
forall a. Bits a => a -> Int -> a
unsafeShiftL Int
n 8 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Char -> Int
ord Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (if Char -> Bool
isUpper Char
c then 100 else 0)
  toEnum :: Int -> SlotChar
toEnum e :: Int
e =
    let n :: Int
n = Int -> Int -> Int
forall a. Bits a => a -> Int -> a
unsafeShiftR Int
e 8
        c0 :: Int
c0 = Int
e Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int -> Int -> Int
forall a. Bits a => a -> Int -> a
unsafeShiftL Int
n 8
        c100 :: Int
c100 = Int
c0 Int -> Int -> Int
forall a. Num a => a -> a -> a
- if Int
c0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 150 then 100 else 0
    in Int -> Char -> SlotChar
SlotChar Int
n (Int -> Char
chr Int
c100)

type SingleItemSlots = EM.EnumMap SlotChar ItemId

-- | A collection of mappings from slot labels to item identifiers.
newtype ItemSlots = ItemSlots (EM.EnumMap SLore SingleItemSlots)
  deriving (Int -> ItemSlots -> ShowS
[ItemSlots] -> ShowS
ItemSlots -> String
(Int -> ItemSlots -> ShowS)
-> (ItemSlots -> String)
-> ([ItemSlots] -> ShowS)
-> Show ItemSlots
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ItemSlots] -> ShowS
$cshowList :: [ItemSlots] -> ShowS
show :: ItemSlots -> String
$cshow :: ItemSlots -> String
showsPrec :: Int -> ItemSlots -> ShowS
$cshowsPrec :: Int -> ItemSlots -> ShowS
Show, Get ItemSlots
[ItemSlots] -> Put
ItemSlots -> Put
(ItemSlots -> Put)
-> Get ItemSlots -> ([ItemSlots] -> Put) -> Binary ItemSlots
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [ItemSlots] -> Put
$cputList :: [ItemSlots] -> Put
get :: Get ItemSlots
$cget :: Get ItemSlots
put :: ItemSlots -> Put
$cput :: ItemSlots -> Put
Binary)

allChars :: [Char]
allChars :: String
allChars = ['a'..'z'] String -> ShowS
forall a. [a] -> [a] -> [a]
++ ['A'..'Z']

allSlots :: [SlotChar]
allSlots :: [SlotChar]
allSlots = (Int -> [SlotChar]) -> [Int] -> [SlotChar]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\n :: Int
n -> (Char -> SlotChar) -> String -> [SlotChar]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Char -> SlotChar
SlotChar Int
n) String
allChars) [0..]

intSlots :: [SlotChar]
intSlots :: [SlotChar]
intSlots = (Int -> SlotChar) -> [Int] -> [SlotChar]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Char -> SlotChar
`SlotChar` 'a') [0..]

slotLabel :: SlotChar -> Text
slotLabel :: SlotChar -> Text
slotLabel x :: SlotChar
x =
  Text -> Char -> Text
T.snoc (if SlotChar -> Int
slotPrefix SlotChar
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 then Text
T.empty else Int -> Text
forall a. Show a => a -> Text
tshow (Int -> Text) -> Int -> Text
forall a b. (a -> b) -> a -> b
$ SlotChar -> Int
slotPrefix SlotChar
x)
         (SlotChar -> Char
slotChar SlotChar
x)
  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ")"

-- | Assigns a slot to an item, e.g., for inclusion in equipment of a hero.
-- At first, e.g., when item is spotted on the floor, the slot is
-- not user-friendly. After any player's item manipulation action,
-- slots are sorted and a fully human-readable slot is then assigned.
-- Only then the slot can be viewed by the player.
assignSlot :: SingleItemSlots -> SlotChar
assignSlot :: SingleItemSlots -> SlotChar
assignSlot lSlots :: SingleItemSlots
lSlots =
  let maxPrefix :: Int
maxPrefix = case SingleItemSlots -> Maybe ((SlotChar, ItemId), SingleItemSlots)
forall k a. Enum k => EnumMap k a -> Maybe ((k, a), EnumMap k a)
EM.maxViewWithKey SingleItemSlots
lSlots of
        Just ((lm :: SlotChar
lm, _), _) -> SlotChar -> Int
slotPrefix SlotChar
lm
        Nothing -> 0
  in Int -> Char -> SlotChar
SlotChar (Int
maxPrefix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1) 'x'

sortSlotMap :: (ItemId -> ItemFull) -> SingleItemSlots -> SingleItemSlots
sortSlotMap :: (ItemId -> ItemFull) -> SingleItemSlots -> SingleItemSlots
sortSlotMap itemToF :: ItemId -> ItemFull
itemToF em :: SingleItemSlots
em =
  -- If appearance and aspects the same, keep the order from before sort.
  let kindAndAppearance :: ItemId
-> (Bool, ContentId ItemKind, ItemDisco, Char, Text, Flavour,
    Maybe FactionId)
kindAndAppearance iid :: ItemId
iid =
        let ItemFull{itemBase :: ItemFull -> Item
itemBase=Item{..}, ..} = ItemId -> ItemFull
itemToF ItemId
iid
        in ( Bool -> Bool
not Bool
itemSuspect, ContentId ItemKind
itemKindId, ItemDisco
itemDisco
           , ItemKind -> Char
IK.isymbol ItemKind
itemKind, ItemKind -> Text
IK.iname ItemKind
itemKind
           , Flavour
jflavour, Maybe FactionId
jfid )
      sortItemIds :: [ItemId] -> [ItemId]
sortItemIds = (ItemId
 -> (Bool, ContentId ItemKind, ItemDisco, Char, Text, Flavour,
     Maybe FactionId))
-> [ItemId] -> [ItemId]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn ItemId
-> (Bool, ContentId ItemKind, ItemDisco, Char, Text, Flavour,
    Maybe FactionId)
kindAndAppearance
  in [(SlotChar, ItemId)] -> SingleItemSlots
forall k a. Enum k => [(k, a)] -> EnumMap k a
EM.fromDistinctAscList ([(SlotChar, ItemId)] -> SingleItemSlots)
-> [(SlotChar, ItemId)] -> SingleItemSlots
forall a b. (a -> b) -> a -> b
$ [SlotChar] -> [ItemId] -> [(SlotChar, ItemId)]
forall a b. [a] -> [b] -> [(a, b)]
zip [SlotChar]
allSlots ([ItemId] -> [(SlotChar, ItemId)])
-> [ItemId] -> [(SlotChar, ItemId)]
forall a b. (a -> b) -> a -> b
$ [ItemId] -> [ItemId]
sortItemIds ([ItemId] -> [ItemId]) -> [ItemId] -> [ItemId]
forall a b. (a -> b) -> a -> b
$ SingleItemSlots -> [ItemId]
forall k a. EnumMap k a -> [a]
EM.elems SingleItemSlots
em

mergeItemSlots :: (ItemId -> ItemFull) -> [SingleItemSlots] -> SingleItemSlots
mergeItemSlots :: (ItemId -> ItemFull) -> [SingleItemSlots] -> SingleItemSlots
mergeItemSlots itemToF :: ItemId -> ItemFull
itemToF ems :: [SingleItemSlots]
ems =
  let renumberSlot :: Int -> SlotChar -> SlotChar
renumberSlot n :: Int
n SlotChar{Int
slotPrefix :: Int
slotPrefix :: SlotChar -> Int
slotPrefix, Char
slotChar :: Char
slotChar :: SlotChar -> Char
slotChar} =
        $WSlotChar :: Int -> Char -> SlotChar
SlotChar{slotPrefix :: Int
slotPrefix = Int
slotPrefix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* 1000000, Char
slotChar :: Char
slotChar :: Char
slotChar}
      renumberMap :: Int -> EnumMap SlotChar a -> EnumMap SlotChar a
renumberMap n :: Int
n = (SlotChar -> SlotChar) -> EnumMap SlotChar a -> EnumMap SlotChar a
forall k a. Enum k => (k -> k) -> EnumMap k a -> EnumMap k a
EM.mapKeys (Int -> SlotChar -> SlotChar
renumberSlot Int
n)
      rms :: [SingleItemSlots]
rms = (Int -> SingleItemSlots -> SingleItemSlots)
-> [Int] -> [SingleItemSlots] -> [SingleItemSlots]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> SingleItemSlots -> SingleItemSlots
forall a. Int -> EnumMap SlotChar a -> EnumMap SlotChar a
renumberMap [0..] [SingleItemSlots]
ems
      em :: SingleItemSlots
em = (ItemId -> ItemId -> ItemId)
-> [SingleItemSlots] -> SingleItemSlots
forall a k. (a -> a -> a) -> [EnumMap k a] -> EnumMap k a
EM.unionsWith (\_ _ -> String -> ItemId
forall a. HasCallStack => String -> a
error "mergeItemSlots: duplicate keys") [SingleItemSlots]
rms
  in (ItemId -> ItemFull) -> SingleItemSlots -> SingleItemSlots
sortSlotMap ItemId -> ItemFull
itemToF SingleItemSlots
em