103 lines
3.2 KiB
Haskell
103 lines
3.2 KiB
Haskell
--{-# LANGUAGE TupleSections #-}
|
|
module Dodge.Combine (
|
|
combinePoss,
|
|
combineSizes,
|
|
combineItemListYou,
|
|
combineListInfo,
|
|
toggleCombineInv,
|
|
enterCombineInv,
|
|
) where
|
|
|
|
import Control.Lens
|
|
import Control.Monad
|
|
import Data.Bifunctor
|
|
import Data.List (scanl', sortOn)
|
|
import Data.Map.Merge.Strict
|
|
import qualified Data.Map.Strict as M
|
|
import Data.Maybe
|
|
import Dodge.Base.You
|
|
import Dodge.Combine.Trie
|
|
import Dodge.Data.World
|
|
import Dodge.Inventory.ItemSpace
|
|
import Dodge.Item.Amount
|
|
import Dodge.Module
|
|
import qualified IntMapHelp as IM
|
|
import SimpleTrie
|
|
|
|
invertInventory :: IM.IntMap Item -> [(ItemBaseType, ItAmount, Int)]
|
|
invertInventory =
|
|
IM.foldrWithKey
|
|
(\k it -> ((_iyBase $ _itType it, itStackAmount it, k) :))
|
|
[]
|
|
|
|
splitItAmounts :: [(ItemBaseType, ItAmount, Int)] -> [((ItAmount, ItemBaseType), (ItAmount, Int))]
|
|
splitItAmounts = concatMap f
|
|
where
|
|
f (x, n, y) = [((i, x), (i, y)) | i <- [1 .. n]]
|
|
|
|
lookupItems :: IM.IntMap Item -> [([(ItAmount, Int)], Item)]
|
|
lookupItems = flip multiLookupTrieI combinationsTrie . sortOn fst . splitItAmounts . invertInventory
|
|
|
|
combineItemListYouX :: World -> [([Int], Item)]
|
|
combineItemListYouX = map (first $ concatMap g) . lookupItems . yourInv
|
|
where
|
|
g (amount, i) = replicate (_getItAmount amount) i
|
|
|
|
combineListInfo :: World -> [([Int], ([String], Item))]
|
|
combineListInfo w = filter (f . snd . snd) . map (cmm inv) $ combineItemListYouX w
|
|
where
|
|
inv = yourInv w
|
|
f itm = _itType itm `notElem` fmap _itType inv
|
|
|
|
combineItemListYou :: World -> [([Int], Item)]
|
|
combineItemListYou = map (second snd) . combineListInfo
|
|
|
|
cmm :: IM.IntMap Item -> ([Int], Item) -> ([Int], ([String], Item))
|
|
cmm inv (is, itm) = (is, itm & itType . iyModules %%~ flip combineModuleMaps mms)
|
|
where
|
|
mms = map (_iyModules . _itType . (inv IM.!)) is
|
|
|
|
combineModuleMaps ::
|
|
M.Map ModuleSlot ItemModuleType ->
|
|
[M.Map ModuleSlot ItemModuleType] ->
|
|
([String], M.Map ModuleSlot ItemModuleType)
|
|
combineModuleMaps = foldM combineTwoModuleMaps
|
|
|
|
combineTwoModuleMaps ::
|
|
M.Map ModuleSlot ItemModuleType ->
|
|
M.Map ModuleSlot ItemModuleType ->
|
|
([String], M.Map ModuleSlot ItemModuleType)
|
|
combineTwoModuleMaps =
|
|
mergeA
|
|
preserveMissing
|
|
(filterAMissing f)
|
|
(zipWithAMatched g)
|
|
where
|
|
f _ EMPTYMODULE = ([], False)
|
|
f _ md = ([rm "REMOVES" md], False)
|
|
g _ EMPTYMODULE md = ([], md)
|
|
g _ md EMPTYMODULE = ([], md)
|
|
g _ md2 md1 = ([rm "REPLACES" md1 ++ rm " WITH" md2], md2)
|
|
rm str md = str ++ " " ++ fullModuleName md
|
|
|
|
-- g above could be a monoid of some description...
|
|
|
|
fullModuleName :: ItemModuleType -> String
|
|
fullModuleName = fromMaybe "EMPTYMODULE" . moduleName
|
|
|
|
toggleCombineInv :: World -> World
|
|
toggleCombineInv w = case w ^. cWorld . lWorld . hud . hudElement of
|
|
DisplayInventory CombineInventory{} -> w & cWorld . lWorld . hud . hudElement .~ DisplayInventory NoSubInventory
|
|
_ -> w & enterCombineInv
|
|
|
|
enterCombineInv :: World -> World
|
|
enterCombineInv w = w & cWorld . lWorld . hud . hudElement .~ DisplayInventory (CombineInventory mi)
|
|
where
|
|
mi = 0 <$ listToMaybe (combineItemListYou w)
|
|
|
|
combineSizes :: World -> [Int]
|
|
combineSizes = map (itSlotsTaken . snd) . combineItemListYou
|
|
|
|
combinePoss :: World -> [Int]
|
|
combinePoss = scanl' (+) 0 . combineSizes
|