103 lines
3.2 KiB
Haskell
103 lines
3.2 KiB
Haskell
--{-# LANGUAGE TupleSections #-}
|
|
module Dodge.Combine (
|
|
combineList,
|
|
combineList',
|
|
) where
|
|
|
|
import Dodge.Data.Universe
|
|
import Dodge.Data.Combine
|
|
import Dodge.Item.Display
|
|
import Color
|
|
--import Dodge.Data.SelectionList
|
|
import qualified Data.IntSet as IS
|
|
import Control.Lens
|
|
import Control.Monad
|
|
import Data.Bifunctor
|
|
import Data.List (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.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
|
|
|
|
combineList :: World -> [SelectionItem CombinableItem]
|
|
combineList w = case combineList' w of
|
|
[] -> [SelectionInfo ["No possible combinations"] 1 False white 0]
|
|
xs -> xs
|
|
|
|
combineList' :: World -> [SelectionItem CombinableItem]
|
|
combineList' = map f . combineListInfo
|
|
where
|
|
f (is,(strs,itm)) = SelectionItem
|
|
{ _siPictures = itemDisplay itm
|
|
, _siHeight = length (itemDisplay itm)
|
|
, _siIsSelectable = True
|
|
--, _siWidth = maximum (map length (itemDisplay itm))
|
|
, _siColor = _itInvColor itm
|
|
, _siOffX = 0
|
|
, _siPayload = CombinableItem is itm strs
|
|
}
|
|
|
|
combineListInfo :: World -> [([Int], ([String], Item))]
|
|
combineListInfo w = filter f . map (cmm inv) $ combineItemListYouX w
|
|
where
|
|
inv = yourInv w
|
|
f (is,(_,itm)) = _itType itm `notElem` fmap _itType (IM.restrictKeys inv (IS.fromList is))
|
|
|
|
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
|