109 lines
3.4 KiB
Haskell
109 lines
3.4 KiB
Haskell
--{-# LANGUAGE TupleSections #-}
|
|
module Dodge.Combine
|
|
( combinePoss
|
|
, combineSizes
|
|
, combineItemListYou
|
|
, combineListInfo
|
|
, toggleCombineInv
|
|
, enterCombineInv
|
|
) where
|
|
import Dodge.Combine.Combinations
|
|
import Dodge.Base.You
|
|
import Dodge.Data
|
|
import Dodge.Item.Amount
|
|
import Dodge.Inventory.ItemSpace
|
|
--import Dodge.Combine.Module
|
|
import Dodge.Module
|
|
--import Dodge.Combine.Data
|
|
--import Multiset
|
|
import SimpleTrie
|
|
|
|
import Data.Map.Merge.Strict
|
|
import Control.Monad
|
|
import Control.Lens
|
|
import Data.Bifunctor
|
|
import qualified Data.IntMap.Strict as IM
|
|
--import qualified Data.IntSet as IS
|
|
import qualified Data.Map.Strict as M
|
|
--import Data.Map.Merge.Strict
|
|
import Data.Maybe
|
|
import Data.List (scanl',sortOn,sort)
|
|
|
|
combinationsTrie :: Trie (IcAmount,ItemBaseType) Item
|
|
combinationsTrie = foldr
|
|
(uncurry insertInTrie . first sort)
|
|
emptyTrie
|
|
itemCombinations
|
|
|
|
invertInventory :: IM.IntMap Item -> [(ItemBaseType,IcAmount,Int)]
|
|
invertInventory = IM.foldrWithKey
|
|
(\k it -> ((_iyBase $ _itType it, itStackAmount it,k) :) )
|
|
[]
|
|
|
|
splitIcAmounts :: [(ItemBaseType,IcAmount,Int)] -> [((IcAmount,ItemBaseType),(IcAmount,Int))]
|
|
splitIcAmounts = concatMap f
|
|
where
|
|
f (x,n,y) = [((i,x),(i,y)) | i <- [1..n]]
|
|
|
|
lookupItems :: IM.IntMap Item -> [([(IcAmount,Int)],Item)]
|
|
lookupItems = flip multiLookupTrieI combinationsTrie . sortOn fst . splitIcAmounts . invertInventory
|
|
|
|
combineItemListYouX :: World -> [([Int],Item)]
|
|
combineItemListYouX = map (first $ concatMap g) . lookupItems . yourInv
|
|
where
|
|
g (amount,i) = replicate (_toInt 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 _hudElement (_hud w) of
|
|
DisplayInventory CombineInventory {} -> w & hud . hudElement .~ DisplayInventory NoSubInventory
|
|
_ -> w & enterCombineInv
|
|
|
|
enterCombineInv :: World -> World
|
|
enterCombineInv w = w & 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
|