Cleanup item combinations, prevent creation of identical items

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]))]
+combineItemListStringInfo :: World -> [([Int],([String],Item))]
-combineItemListYou' w = map (cmm (yourInv w)) $ combineItemListYouX w
+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 :: IM.IntMap Item -> ([Int],Item) -> ([Int],([String],Item))
-cmm inv (is,itm) = (is,(itm & itType . iyModules .~ mods, s))
+cmm inv (is,itm) = (is,itm & itType . iyModules %%~ flip combineModuleMaps mms)
   where
-    mms = map (_iyModules . _itType . (inv IM.!)) $ is
+    mms = map (_iyModules . _itType . (inv IM.!)) is
-    (s,mods) = combineModuleMaps (_iyModules $ _itType itm) mms
     
-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

@@ -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

@@ -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

@@ -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

@@ -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 0 (const ("CONNECTING",termTextColor))
-    ,TerminalLineDisplay 10 (const ("...",white))
+    ,TerminalLineDisplay 10 (const ("...",termTextColor))
-    ,TerminalLineDisplay 10 (const ("CONNECTED",white))
+    ,TerminalLineDisplay 10 (const ("CONNECTED",termTextColor))
     ,TerminalLineTerminalEffect 0 (tmStatus .~ TerminalReady)]