Fix module combing
This commit is contained in:
+16
-9
@@ -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
@@ -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
|
||||||
|
|||||||
Reference in New Issue
Block a user