justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Cleanup item combinations, prevent creation of identical items

Browse Source
This commit is contained in:
justin
2022-06-08 21:20:52 +01:00
parent ebf4594bea
commit 91f426e56e
5 changed files with 33 additions and 83 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Combine.hs
+20 -77
View File
@@ -1,9 +1,9 @@
{-# LANGUAGE TupleSections #-}
--{-# LANGUAGE TupleSections #-}
module Dodge.Combine
( combinePoss
, combineSizes
, combineItemListYou
, combineItemListYou'
, combineItemListStringInfo
, toggleCombineInv
, enterCombineInv
) where
@@ -12,13 +12,12 @@ import Dodge.Base.You
import Dodge.Data
import Dodge.Item.Amount
import Dodge.Inventory.ItemSpace
import Dodge.Combine.Module
--import Dodge.Combine.Module
import Dodge.Module
--import Dodge.Combine.Data
import Multiset
--import Multiset
import SimpleTrie
--import Data.Foldable
import Data.Map.Merge.Strict
import Control.Monad
import Control.Lens
@@ -40,6 +39,7 @@ 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
@@ -54,24 +54,28 @@ combineItemListYouX = map (first f) . lookupItems' . yourInv
f = concatMap g
g (amount,i) = replicate (_toInt amount) i
combineItemListYou' :: World -> [([Int],(Item,[String]))]
combineItemListYou' w = map (cmm (yourInv w)) $ combineItemListYouX w
combineItemListStringInfo :: World -> [([Int],([String],Item))]
combineItemListStringInfo w = filter (f . snd . snd) . map (cmm inv) $ combineItemListYouX w
--combineItemListStringInfo w = map (cmm inv) $ combineItemListYouX w
where
inv = yourInv w
f itm = _itType itm `notElem` fmap _itType inv
combineItemListYou :: World -> [([Int],Item)]
combineItemListYou = map (second fst) . combineItemListYou'
combineItemListYou = map (second snd) . combineItemListStringInfo
cmm :: IM.IntMap Item -> ([Int],Item) -> ([Int],(Item,[String]))
cmm inv (is,itm) = (is,(itm & itType . iyModules .~ mods, s))
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
(s,mods) = combineModuleMaps (_iyModules $ _itType itm) mms
mms = map (_iyModules . _itType . (inv IM.!)) is
combineModuleMaps :: M.Map ModuleSlot ItemModuleType -> [M.Map ModuleSlot ItemModuleType]
combineModuleMaps :: M.Map ModuleSlot ItemModuleType
-> [M.Map ModuleSlot ItemModuleType]
-> ([String],M.Map ModuleSlot ItemModuleType)
combineModuleMaps = foldM cMod
cMod :: M.Map ModuleSlot ItemModuleType
-> (M.Map ModuleSlot ItemModuleType)
-> M.Map ModuleSlot ItemModuleType
-> ([String],M.Map ModuleSlot ItemModuleType)
cMod = mergeA
preserveMissing
@@ -82,72 +86,12 @@ cMod = mergeA
f _ md = ([rm "REMOVES" md],False)
g _ EMPTYMODULE md = ([],md)
g _ md EMPTYMODULE = ([],md)
g _ md1 md2 = ([rm "REPLACES" md1 ++ rm " WITH " md2],md2)
g _ md2 md1 = ([rm "REPLACES" md1 ++ rm " WITH" md2],md2)
rm str md = str ++ " "++fullModuleName md
fullModuleName :: ItemModuleType -> [Char]
fullModuleName :: ItemModuleType -> String
fullModuleName = fromMaybe "EMPTYMODULE" . moduleName
-- 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 ItemModuleType,ItemBaseType,Int,IcAmount)]
-> [ ([(M.Map ModuleSlot ItemModuleType,Int)],Item) ]
lookupItems xs = lookupItemsUsingTrie (sortOn (\(_,ct,_,_) -> ct) xs) combinationsTrie
lookupItemsUsingTrie :: [(M.Map ModuleSlot ItemModuleType,ItemBaseType,Int,IcAmount)]
-> Trie (IcAmount,ItemBaseType) Item
-> [ ([(M.Map ModuleSlot ItemModuleType,Int)],Item) ]
lookupItemsUsingTrie [] t = maybeToList $ ([],) <$> _trieMVal t
lookupItemsUsingTrie ((mods,ct,i,n):xs) t = do
n' <- [1..min n 4]
let is = replicate (_toInt n') (mods,i)
concatMap (map (first (is ++)) . lookupItemsUsingTrie xs) $ maybeToList (_trieChildren t M.!? (n',ct))
invertListInvMult :: IM.IntMap Item -> [[(M.Map ModuleSlot ItemModuleType,ItemBaseType,Int,IcAmount)]]
invertListInvMult = powlistUpToN 4 . invertListInv
invertListInv :: IM.IntMap Item -> [(M.Map ModuleSlot ItemModuleType,ItemBaseType,Int,IcAmount)]
invertListInv = IM.foldrWithKey
(\k it -> ((_iyModules $ _itType it,_iyBase $ _itType it, k, itStackAmount it) :) )
[]
combineItemListYou'' :: World -> [([Int],(Item,[String]))]
combineItemListYou'' = map addModules . concatMap lookupItems . invertListInvMult . yourInv
addModules :: ([(M.Map ModuleSlot ItemModuleType,Int)],Item)
-> ([Int],(Item,[String]))
addModules (ps,it) = (is , (applyModules newm it, ss))
where
(ms,is) = unzip ps
m = ([],_iyModules $ _itType it)
(ss,newm) = foldr f m ms
f m' (s,m'') = (s ++ s',m''')
where
(s',m''') = combineModules m' m''
applyModules :: M.Map ModuleSlot ItemModuleType -> Item -> Item
applyModules ms it = foldr moduleModification (it & itType . iyModules .~ ms) ms
combineModules :: M.Map ModuleSlot ItemModuleType
-> M.Map ModuleSlot ItemModuleType
-> ([String],M.Map ModuleSlot ItemModuleType)
combineModules = mergeA
(traverseMaybeMissing f)
(traverseMissing g)
(zipWithAMatched h)
where
f _ imt | imt /= EMPTYMODULE = ("WARNING:REMOVES":ss imt,Nothing)
f _ _ = ([],Nothing)
g _ m = ([], m)
h _ im1 im2 | im1 /= EMPTYMODULE && im2 /= EMPTYMODULE
= ("WARNING:REMOVES":ss im1,im2)
h _ _ im | im /= EMPTYMODULE = ([],im)
h _ im _ = ([],im)
ss imt = [fromJust $ moduleName imt]
toggleCombineInv :: World -> World
toggleCombineInv w = case _hudElement (_hud w) of
DisplayInventory CombineInventory {} -> w & hud . hudElement .~ DisplayInventory NoSubInventory
@@ -159,7 +103,6 @@ enterCombineInv w = w & hud . hudElement .~ DisplayInventory (CombineInventory m
mi = 0 <$ listToMaybe (combineItemListYou w)
combineSizes :: World -> [Int]
--combineSizes = map (ceiling . _itInvSize . snd) . combineItemListYou
combineSizes = map (itSlotsTaken . snd) . combineItemListYou
combinePoss :: World -> [Int]
src/Dodge/Combine/Module.hs
+3
View File
@@ -52,3 +52,6 @@ moduleModification imt = case imt of
where
p = fromMaybe (_crPos cr) $ it ^? itTargeting . tgPos . _Just
a = argV (mouseWorldPos w -.- p)
applyModules :: Item -> Item
applyModules it = foldr moduleModification it (_iyModules (_itType it))
src/Dodge/Event.hs
+2 -1
View File
@@ -18,6 +18,7 @@ import Dodge.Combine
import Dodge.Event.Keyboard
--import Dodge.Event.Menu
import Dodge.Base
import Dodge.Combine.Module
import Dodge.Data
--import Dodge.Base.Window
import Dodge.PreloadData
@@ -109,7 +110,7 @@ doCombine i w = case combineItemListYou w !? i of
Nothing -> w
Just (is,it) -> enterCombineInv
. uncurry (putItemInInvID yid)
. copyItemToFloorID (_crPos $ you w) it
. copyItemToFloorID (_crPos $ you w) (applyModules it)
$ foldr (rmInvItem yid) w (sort is)
where
yid = _yourID w
src/Dodge/Render/HUD.hs
+1 -1
View File
@@ -93,7 +93,7 @@ subInventoryDisplay subinv cfig w = case subinv of
, fromMaybe mempty $ do
i <- mi
cpos <- combinePoss w !? i
strs <- fmap (snd . snd) (combineItemListYou' w !? i)
strs <- fmap (fst . snd) (combineItemListStringInfo w !? i)
return $ listTextPicturesAtOffset (subInvX + 150) 60 cfig cpos $ map (color red . text) strs
, fromMaybe mempty $ do
i <- mi
src/Dodge/Terminal.hs
+7 -4
View File
@@ -123,7 +123,10 @@ makeColorTermLine :: Color -> String -> TerminalLine
makeColorTermLine col str = TerminalLineDisplay 0 $ const (str,col)
makeTermLine :: String -> TerminalLine
makeTermLine = makeColorTermLine (greyN 0.9)
makeTermLine = makeColorTermLine termTextColor
termTextColor :: Color
termTextColor = greyN 0.9
termSoundLine :: SoundID -> TerminalLine
termSoundLine sid = TerminalLineEffect 0 termsound
@@ -239,7 +242,7 @@ doDeathToggle (TerminalToggle trid f) = ix trid %~ f
connectionBlurb1 :: [TerminalLine]
connectionBlurb1 =
[termSoundLine computerBeepingS
,TerminalLineDisplay 0 (const ("CONNECTING ...",white))
,TerminalLineDisplay 10 (const ("...",white))
,TerminalLineDisplay 10 (const ("CONNECTED",white))
,TerminalLineDisplay 0 (const ("CONNECTING",termTextColor))
,TerminalLineDisplay 10 (const ("...",termTextColor))
,TerminalLineDisplay 10 (const ("CONNECTED",termTextColor))
,TerminalLineTerminalEffect 0 (tmStatus .~ TerminalReady)]