From 91f426e56e7b0d9f3faa9e2d03b6ced0d4c64687 Mon Sep 17 00:00:00 2001 From: justin Date: Wed, 8 Jun 2022 21:20:52 +0100 Subject: [PATCH] Cleanup item combinations, prevent creation of identical items --- src/Dodge/Combine.hs | 97 ++++++++----------------------------- src/Dodge/Combine/Module.hs | 3 ++ src/Dodge/Event.hs | 3 +- src/Dodge/Render/HUD.hs | 2 +- src/Dodge/Terminal.hs | 11 +++-- 5 files changed, 33 insertions(+), 83 deletions(-) diff --git a/src/Dodge/Combine.hs b/src/Dodge/Combine.hs index 448938b01..bf384047a 100644 --- a/src/Dodge/Combine.hs +++ b/src/Dodge/Combine.hs @@ -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] diff --git a/src/Dodge/Combine/Module.hs b/src/Dodge/Combine/Module.hs index aeb44656a..a1c6a6767 100644 --- a/src/Dodge/Combine/Module.hs +++ b/src/Dodge/Combine/Module.hs @@ -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)) diff --git a/src/Dodge/Event.hs b/src/Dodge/Event.hs index 7a1ba9c94..6237dc540 100644 --- a/src/Dodge/Event.hs +++ b/src/Dodge/Event.hs @@ -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 diff --git a/src/Dodge/Render/HUD.hs b/src/Dodge/Render/HUD.hs index 3bcaec1a6..4383a71e8 100644 --- a/src/Dodge/Render/HUD.hs +++ b/src/Dodge/Render/HUD.hs @@ -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 diff --git a/src/Dodge/Terminal.hs b/src/Dodge/Terminal.hs index 6c220e521..a6a890691 100644 --- a/src/Dodge/Terminal.hs +++ b/src/Dodge/Terminal.hs @@ -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)]