diff --git a/src/Dodge/Combine.hs b/src/Dodge/Combine.hs index f89a9e7bc..2001ef5e0 100644 --- a/src/Dodge/Combine.hs +++ b/src/Dodge/Combine.hs @@ -27,33 +27,52 @@ import Data.Map.Merge.Strict import Data.Maybe import Data.List (scanl',sortOn,sort) -combinationsTrie :: Trie (Int,ItemBaseType) Item +combinationsTrie :: Trie (IcAmount,ItemBaseType) Item combinationsTrie = foldr - (uncurry insertInTrie . first (sortOn snd)) + (uncurry insertInTrie . first sort) emptyTrie itemCombinations +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 + f (x,n,y) = [((i,x),(i,y)) | i <- [1..n]] + +lookupItems' :: IM.IntMap Item -> [([(IcAmount,Int)],Item)] +lookupItems' = flip multiLookupTrieI combinationsTrie . sortOn fst . splitIcAmounts . invertInventory + +combineItemListYou :: World -> [([Int],Item)] +combineItemListYou = map (first f) . lookupItems' . yourInv + where + f = concatMap g + g (amount,i) = replicate (_toInt amount) i + + -- 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,Int)] +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,Int)] - -> Trie (Int,ItemBaseType) Item +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 n' (mods,i) + 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,Int)]] +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,Int)] +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) :) ) [] @@ -61,8 +80,8 @@ invertListInv = IM.foldrWithKey -- gives a list of indices-item pairs. -- Note that within the pair, indices can be repeated if two or more of an item -- are needed -combineItemListYou :: World -> [([Int],Item)] -combineItemListYou = map (second fst) . combineItemListYou' +combineItemListYou'' :: World -> [([Int],Item)] +combineItemListYou'' = map (second fst) . combineItemListYou' combineItemListYou' :: World -> [([Int],(Item,[String]))] combineItemListYou' = map addModules . concatMap lookupItems . invertListInvMult . yourInv diff --git a/src/Dodge/Combine/Combinations.hs b/src/Dodge/Combine/Combinations.hs index ed4a19650..a5ad0b0be 100644 --- a/src/Dodge/Combine/Combinations.hs +++ b/src/Dodge/Combine/Combinations.hs @@ -14,7 +14,7 @@ import LensHelp --import Data.Maybe -itemCombinations :: [([(Int,ItemBaseType)],Item)] +itemCombinations :: [([(IcAmount,ItemBaseType)],Item)] itemCombinations = [ po [PIPE, HARDWARE] (bangStick 1) , po [BANGSTICK 1, TIN] pistol diff --git a/src/Dodge/Creature.hs b/src/Dodge/Creature.hs index 08195ace5..0958e7384 100644 --- a/src/Dodge/Creature.hs +++ b/src/Dodge/Creature.hs @@ -213,6 +213,23 @@ inventoryX c = case c of , makeTypeCraftNum 1 DRUM , makeTypeCraftNum 1 MOTOR ] + 'F' -> + [ makeTypeCraftNum 5 PIPE + , makeTypeCraftNum 5 TUBE + , makeTypeCraftNum 5 HARDWARE + , makeTypeCraftNum 5 TIN + , makeTypeCraftNum 5 CAN + , makeTypeCraftNum 5 SPRING + , makeTypeCraftNum 5 PUMP + , makeTypeCraftNum 5 MAGNET + , makeTypeCraftNum 5 PLANK + , makeTypeCraftNum 5 PLATE + , makeTypeCraftNum 5 DRUM + , makeTypeCraftNum 5 MOTOR + , makeTypeCraftNum 5 TRANSFORMER + , makeTypeCraftNum 5 PRISM + , makeTypeCraftNum 5 LIGHTER + ] _ -> [] testInventory :: IM.IntMap Item diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 0e61bb541..3e924cb6f 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -22,7 +22,9 @@ module Dodge.Data , module Dodge.Config.Data , module Dodge.Equipment.Data , module MaybeHelp + , module Dodge.Data.ItemAmount ) where +import Dodge.Data.ItemAmount import Dodge.ShortShow import Dodge.Creature.State.Data import Dodge.Creature.Stance.Data @@ -469,6 +471,8 @@ data Equipment = Equipment _itUseAimStance :: Item -> AimStance _itUseAimStance = _aimStance . _useAim . _itUse + + data ItemConsumption = LoadableAmmo { _laType :: AmmoType @@ -483,7 +487,7 @@ data ItemConsumption , _wpCharge :: Int } | ItemItselfConsumable - { _itAmount :: Int + { _icAmount :: IcAmount } | NoConsumption data Item = Item diff --git a/src/Dodge/Data/ItemAmount.hs b/src/Dodge/Data/ItemAmount.hs new file mode 100644 index 000000000..42a57a5cd --- /dev/null +++ b/src/Dodge/Data/ItemAmount.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +module Dodge.Data.ItemAmount where + +newtype IcAmount = IcAmount {_toInt :: Int} + deriving (Eq,Ord,Num,Integral,Real,Enum) +instance Show IcAmount where + show (IcAmount i) = 'x':show i diff --git a/src/Dodge/Default.hs b/src/Dodge/Default.hs index 628055090..d669748e8 100644 --- a/src/Dodge/Default.hs +++ b/src/Dodge/Default.hs @@ -167,7 +167,7 @@ defaultItZoom :: ItZoom defaultItZoom = ItZoom 20 0.2 1 defaultConsumable :: Item defaultConsumable = defaultItem - { _itConsumption = ItemItselfConsumable {_itAmount = 1} + { _itConsumption = ItemItselfConsumable {_icAmount = 1} , _itInvColor = blue , _itDimension = defItDimCol blue } diff --git a/src/Dodge/Default/Item.hs b/src/Dodge/Default/Item.hs index d6c4fd90e..8b6d74d2c 100644 --- a/src/Dodge/Default/Item.hs +++ b/src/Dodge/Default/Item.hs @@ -53,7 +53,7 @@ basicItemDisplay it = Prelude.take (itSlotsTaken it) $ Nothing' -> show (_laLoaded am) Just' x -> show x ++ "R" ++ show (_laLoaded am) Just am@ChargeableAmmo{} -> show $ _wpCharge am - Just x@ItemItselfConsumable{} -> "x" ++ show (_itAmount x) + Just x@ItemItselfConsumable{} -> show (_icAmount x) Just NoConsumption -> "" Nothing -> "" theparam = fromMaybe [] diff --git a/src/Dodge/FloorItem.hs b/src/Dodge/FloorItem.hs index 8a246e6a9..c9df6c3c3 100644 --- a/src/Dodge/FloorItem.hs +++ b/src/Dodge/FloorItem.hs @@ -28,7 +28,7 @@ copyItemToFloorID pos it w = (,) flid $ w' _ -> id flid = IM.newKey $ _floorItems w theflit = FlIt - {_flIt = it & itConsumption . itAmount %~ const 1 + {_flIt = it & itConsumption . icAmount %~ const 1 ,_flItPos = p' ,_flItRot = rot ,_flItID = flid diff --git a/src/Dodge/Inventory.hs b/src/Dodge/Inventory.hs index 19be5b072..ff60beee0 100644 --- a/src/Dodge/Inventory.hs +++ b/src/Dodge/Inventory.hs @@ -52,8 +52,8 @@ rmInvItem :: Int -- ^ Creature id -> Int -- ^ Inventory position -> World -> World -rmInvItem cid invid w = case w ^? creatures . ix cid . crInv . ix invid . itConsumption . itAmount of - Just x | x > 1 -> w & creatures . ix cid . crInv . ix invid . itConsumption . itAmount %~ subtract 1 +rmInvItem cid invid w = case w ^? creatures . ix cid . crInv . ix invid . itConsumption . icAmount of + Just x | x > 1 -> w & creatures . ix cid . crInv . ix invid . itConsumption . icAmount %~ subtract 1 _ -> w & creatures . ix cid . crInv %~ f & creatures . ix cid . crInvSel %~ g & creatures . ix cid . crLeftInvSel %~ g' diff --git a/src/Dodge/Inventory/Add.hs b/src/Dodge/Inventory/Add.hs index 59334da96..2462c46e1 100644 --- a/src/Dodge/Inventory/Add.hs +++ b/src/Dodge/Inventory/Add.hs @@ -11,7 +11,7 @@ putItemInInvID cid flid w = fromMaybe w $ tryPutItemInInv cid (_floorItems w IM.! flid) w putItemInInvSlot :: Int -> Item -> IM.IntMap Item -> IM.IntMap Item -putItemInInvSlot = IM.insertWith (const $ itConsumption . itAmount +~ 1) +putItemInInvSlot = IM.insertWith (const $ itConsumption . icAmount +~ 1) {- | Pick up a specific item. -} tryPutItemInInv :: Int -> FloorItem -> World -> Maybe World diff --git a/src/Dodge/Inventory/ItemSpace.hs b/src/Dodge/Inventory/ItemSpace.hs index b769fdf88..989a279e6 100644 --- a/src/Dodge/Inventory/ItemSpace.hs +++ b/src/Dodge/Inventory/ItemSpace.hs @@ -8,6 +8,6 @@ import Control.Lens --import Data.Maybe itSlotsTaken :: Item -> Int -itSlotsTaken it = case it ^? itConsumption . itAmount of +itSlotsTaken it = case it ^? itConsumption . icAmount of Nothing -> moduleSizes it + ceiling (_itInvSize it) Just i -> moduleSizes it + ceiling (_itInvSize it * fromIntegral i) diff --git a/src/Dodge/Item/Amount.hs b/src/Dodge/Item/Amount.hs index 6df6a404f..e776d5994 100644 --- a/src/Dodge/Item/Amount.hs +++ b/src/Dodge/Item/Amount.hs @@ -3,5 +3,5 @@ import Dodge.Data import Data.Maybe import Control.Lens -itStackAmount :: Item -> Int -itStackAmount it = fromMaybe 1 $ it ^? itConsumption . itAmount +itStackAmount :: Item -> IcAmount +itStackAmount it = fromMaybe 1 $ it ^? itConsumption . icAmount diff --git a/src/Dodge/Item/Craftable.hs b/src/Dodge/Item/Craftable.hs index b2b977da2..c3ccfeaf4 100644 --- a/src/Dodge/Item/Craftable.hs +++ b/src/Dodge/Item/Craftable.hs @@ -13,7 +13,7 @@ makeTypeCraftNum :: Int -> ItemBaseType -> Item makeTypeCraftNum i ct = defaultCraftable { _itInvSize = 0.5 , _itCurseStatus = Uncursed - , _itConsumption = ItemItselfConsumable i + , _itConsumption = ItemItselfConsumable $ IcAmount i } & itType . iyBase .~ ct diff --git a/src/SimpleTrie.hs b/src/SimpleTrie.hs index 86667e1c1..25a8f414a 100644 --- a/src/SimpleTrie.hs +++ b/src/SimpleTrie.hs @@ -32,3 +32,11 @@ multiLookupTrie xs t@(Trie my ch) case M.lookup z ch of Nothing -> multiLookupTrie zs t Just t' -> map (_1 %~ (z:)) (multiLookupTrie zs t') ++ multiLookupTrie zs t + +multiLookupTrieI :: Ord a => [(a,c)] -> Trie a b -> [([c],b)] +multiLookupTrieI xs t@(Trie my ch) + | null xs || null ch = maybe [] (\y -> [([],y)]) my + | otherwise = let ((z1,z2):zs) = xs in + case M.lookup z1 ch of + Nothing -> multiLookupTrieI zs t + Just t' -> map (_1 %~ (z2:)) (multiLookupTrieI zs t') ++ multiLookupTrieI zs t