Fix module combing

This commit is contained in:
2022-06-08 19:48:01 +01:00
parent 95ec30837a
commit dd4515a748
2 changed files with 27 additions and 10 deletions
+16 -9
View File
@@ -48,14 +48,16 @@ splitIcAmounts = concatMap f
lookupItems' :: IM.IntMap Item -> [([(IcAmount,Int)],Item)] lookupItems' :: IM.IntMap Item -> [([(IcAmount,Int)],Item)]
lookupItems' = flip multiLookupTrieI combinationsTrie . sortOn fst . splitIcAmounts . invertInventory lookupItems' = flip multiLookupTrieI combinationsTrie . sortOn fst . splitIcAmounts . invertInventory
combineItemListYou :: World -> [([Int],Item)] combineItemListYouX :: World -> [([Int],Item)]
combineItemListYou = map (first f) . lookupItems' . yourInv combineItemListYouX = map (first f) . lookupItems' . yourInv
where where
f = concatMap g f = concatMap g
g (amount,i) = replicate (_toInt amount) i g (amount,i) = replicate (_toInt amount) i
combineItemListYou' :: World -> [([Int],(Item,[String]))] combineItemListYou' :: World -> [([Int],(Item,[String]))]
combineItemListYou' w = map (cmm (yourInv w)) $ combineItemListYou w combineItemListYou' w = map (cmm (yourInv w)) $ combineItemListYouX w
combineItemListYou = map (second fst) . combineItemListYou'
cmm :: IM.IntMap Item -> ([Int],Item) -> ([Int],(Item,[String])) cmm :: IM.IntMap Item -> ([Int],Item) -> ([Int],(Item,[String]))
cmm inv (is,itm) = (is,(itm & itType . iyModules .~ mods, s)) cmm inv (is,itm) = (is,(itm & itType . iyModules .~ mods, s))
@@ -65,23 +67,28 @@ cmm inv (is,itm) = (is,(itm & itType . iyModules .~ mods, s))
combineModuleMaps :: M.Map ModuleSlot ItemModuleType -> [M.Map ModuleSlot ItemModuleType] combineModuleMaps :: M.Map ModuleSlot ItemModuleType -> [M.Map ModuleSlot ItemModuleType]
-> ([String],M.Map ModuleSlot ItemModuleType) -> ([String],M.Map ModuleSlot ItemModuleType)
combineModuleMaps = foldrM cMod combineModuleMaps = foldM cMod
cMod :: M.Map ModuleSlot ItemModuleType cMod :: M.Map ModuleSlot ItemModuleType
-> (M.Map ModuleSlot ItemModuleType) -> (M.Map ModuleSlot ItemModuleType)
-> ([String],M.Map ModuleSlot ItemModuleType) -> ([String],M.Map ModuleSlot ItemModuleType)
cMod = mergeA cMod = mergeA
preserveMissing
(filterAMissing f) (filterAMissing f)
(filterAMissing f')
(zipWithAMatched g) (zipWithAMatched g)
where where
f k EMPTYMODULE = ([],False) f k EMPTYMODULE = ([],False)
f k md = ([],False) f k md = ([rm "REMOVES" md],False)
f' k EMPTYMODULE = ([],True) f' k EMPTYMODULE = ([],True)
f' k md = ([rm md++"SECOND"++show k],True) f' k md = ([rm "KEEPS" md],True)
g k EMPTYMODULE md = ([],md) g k EMPTYMODULE md = ([],md)
g k md1 md2 = ([rm md1++"BOTH"],md2) g k md EMPTYMODULE = ([],md)
rm md = "REMOVES "++fromJust (moduleName md) g k md1 md2 = ([rm "REPLACES" md1 ++ rm " WITH " md2],md2)
rm str md = str ++ " "++fullModuleName md
sm k = show k ++ ":"
fullModuleName = fromMaybe "EMPTYMODULE" . moduleName
-- this can probably be improved by going through accessing the combinations -- this can probably be improved by going through accessing the combinations
+11 -1
View File
@@ -21,6 +21,7 @@ import qualified Data.Vector as V
--import Data.Foldable --import Data.Foldable
import Data.Maybe import Data.Maybe
import qualified Data.IntMap.Strict as IM import qualified Data.IntMap.Strict as IM
import qualified Data.Map.Strict as M
import qualified Data.Set as S import qualified Data.Set as S
--import qualified Data.IntSet as IS --import qualified Data.IntSet as IS
import Control.Lens import Control.Lens
@@ -109,7 +110,11 @@ subInventoryDisplay subinv cfig w = case subinv of
<> foldMap (topCursorTypeWidth listCursorNESW (topInvW +2) cfig w) lnks <> foldMap (topCursorTypeWidth listCursorNESW (topInvW +2) cfig w) lnks
<> combineCounts cfig w lnks <> combineCounts cfig w lnks
] ]
InspectInventory -> invHead cfig "INSPECT" InspectInventory -> mconcat
[ selcursor' listCursorNESW
, invHead cfig "INSPECT"
, listTextPicturesAt subInvX 60 cfig $ map text (itmInfo it)
]
where where
closeobjectcursor = case selectedCloseObject w of closeobjectcursor = case selectedCloseObject w of
Nothing -> mempty Nothing -> mempty
@@ -133,6 +138,11 @@ subInventoryDisplay subinv cfig w = case subinv of
then drawRBOptions cfig w (_rbOptions w) then drawRBOptions cfig w (_rbOptions w)
else mempty else mempty
itmInfo :: Maybe Item -> [String]
itmInfo mit = fromMaybe [] $ do
itm <- mit
return (map show . M.assocs . _iyModules $ _itType itm)
displayTerminal :: Int -> Configuration -> World -> Picture displayTerminal :: Int -> Configuration -> World -> Picture
displayTerminal tid cfig w = fromMaybe mempty $ do displayTerminal tid cfig w = fromMaybe mempty $ do
tm <- w ^? terminals . ix tid tm <- w ^? terminals . ix tid