122 lines
4.2 KiB
Haskell
122 lines
4.2 KiB
Haskell
{-# LANGUAGE TupleSections #-}
|
|
module Dodge.Combine
|
|
( combinePoss
|
|
, combineSizes
|
|
, combineItemListYou
|
|
, combineItemListYou'
|
|
, 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.Data
|
|
import Multiset
|
|
import SimpleTrie
|
|
|
|
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)
|
|
|
|
combinationsTrie :: Trie (Int,CombineType) Item
|
|
combinationsTrie = foldr
|
|
(uncurry insertInTrie . first (sortOn snd))
|
|
emptyTrie
|
|
itemCombinations
|
|
|
|
-- this can probably be improved by going through accessing the combinations
|
|
-- trie going through each combine type in your inventory in order, rather than
|
|
-- creating all multisets of combine types.
|
|
|
|
lookupItems :: [(M.Map ModuleSlot ItemModule,CombineType,Int,Int)]
|
|
-> [ ([(M.Map ModuleSlot ItemModule,Int)],Item) ]
|
|
lookupItems xs = lookupItemsUsingTrie (sortOn (\(_,ct,_,_) -> ct) xs) combinationsTrie
|
|
|
|
lookupItemsUsingTrie :: [(M.Map ModuleSlot ItemModule,CombineType,Int,Int)]
|
|
-> Trie (Int,CombineType) Item
|
|
-> [ ([(M.Map ModuleSlot ItemModule,Int)],Item) ]
|
|
lookupItemsUsingTrie [] t = maybeToList $ ([],) <$> _trieMVal t
|
|
lookupItemsUsingTrie ((mods,ct,i,n):xs) t = do
|
|
n' <- [1..min n 4]
|
|
let is = replicate n' (mods,i)
|
|
concatMap (map (first (is ++)) . lookupItemsUsingTrie xs) $ maybeToList (_trieChildren t M.!? (n',ct))
|
|
|
|
invertListInvMult :: IM.IntMap Item -> [[(M.Map ModuleSlot ItemModule,CombineType,Int,Int)]]
|
|
invertListInvMult = powlistUpToN 4 . invertListInv
|
|
|
|
invertListInv :: IM.IntMap Item -> [(M.Map ModuleSlot ItemModule,CombineType,Int,Int)]
|
|
invertListInv = IM.foldrWithKey
|
|
(\k it -> ((_itModules it,_itType it, k, itStackAmount it) :) )
|
|
[]
|
|
|
|
-- gives a list of indices-item pairs.
|
|
-- Note that within the pair, indices can be repeated if two or more of an item
|
|
-- are needed
|
|
combineItemListYou :: World -> [([Int],Item)]
|
|
combineItemListYou = map (second fst) . combineItemListYou'
|
|
|
|
combineItemListYou' :: World -> [([Int],(Item,[String]))]
|
|
combineItemListYou' = map addModules . concatMap lookupItems . invertListInvMult . yourInv
|
|
|
|
addModules :: ([(M.Map ModuleSlot ItemModule,Int)],Item)
|
|
-> ([Int],(Item,[String]))
|
|
addModules (ps,it) = (is , (applyModules newm it, ss))
|
|
where
|
|
(ms,is) = unzip ps
|
|
m = ([],_itModules it)
|
|
(ss,newm) = foldr f m ms
|
|
f m' (s,m'') = (s ++ s',m''')
|
|
where
|
|
(s',m''') = combineModules m' m''
|
|
|
|
applyModules :: M.Map ModuleSlot ItemModule -> Item -> Item
|
|
applyModules ms it = foldr f (it & itModules .~ ms) ms
|
|
where
|
|
f m = fromMaybe id (m ^? modModification)
|
|
-- (is , ) <$> [ (it & itModules .~ themodules,s) | (themodules,s) <- combinedmodules]
|
|
-- where
|
|
-- (ms,is) = unzip ps
|
|
-- combinedmodules = foldr f [(_itModules it,[])] ms
|
|
-- f :: M.Map ModuleSlot ItemModule -> [(M.Map ModuleSlot ItemModule,[String])] -> [(M.Map ModuleSlot ItemModule,[String])]
|
|
-- f ims imss = concatMap (g ims) imss
|
|
-- g ims (ims',s) = map (second (s++)) $ combineModules ims ims'
|
|
|
|
combineModules :: M.Map ModuleSlot ItemModule
|
|
-> M.Map ModuleSlot ItemModule
|
|
-> ([String],M.Map ModuleSlot ItemModule)
|
|
combineModules = mergeA
|
|
(traverseMaybeMissing f)
|
|
(traverseMissing g)
|
|
(zipWithAMatched h)
|
|
where
|
|
f _ ItemModule{_modName=ss} = ("WARNING:REMOVES":ss,Nothing)
|
|
f _ _ = ([],Nothing)
|
|
g _ m = ([], m)
|
|
h _ ItemModule{_modName=ss} im@ItemModule{} = ("WARNING:REMOVES":ss,im)
|
|
h _ _ im@ItemModule{} = ([],im)
|
|
h _ im _ = ([],im)
|
|
|
|
toggleCombineInv :: World -> World
|
|
toggleCombineInv w = case _inventoryMode w of
|
|
CombineInventory _ -> w & inventoryMode .~ TopInventory
|
|
_ -> w & enterCombineInv
|
|
|
|
enterCombineInv :: World -> World
|
|
enterCombineInv w = w & inventoryMode .~ CombineInventory mi
|
|
where
|
|
mi = 0 <$ listToMaybe (combineItemListYou w)
|
|
|
|
combineSizes :: World -> [Int]
|
|
--combineSizes = map (ceiling . _itInvSize . snd) . combineItemListYou
|
|
combineSizes = map (itSlotsTaken . snd) . combineItemListYou
|
|
|
|
combinePoss :: World -> [Int]
|
|
combinePoss = scanl' (+) 0 . combineSizes
|