diff --git a/src/Dodge/Combine.hs b/src/Dodge/Combine.hs index 2303c97a3..85f881163 100644 --- a/src/Dodge/Combine.hs +++ b/src/Dodge/Combine.hs @@ -2,11 +2,13 @@ module Dodge.Combine where import Dodge.Base.You import Dodge.Data +import Dodge.Item.Amount --import Dodge.Combine.Data import Multiset import Dodge.Item.Weapon.BulletGuns import Dodge.Item.Weapon.Launcher --import Dodge.Item.Craftable +import SimpleTrie import Control.Lens import Data.Bifunctor @@ -14,10 +16,17 @@ import qualified Data.IntMap.Strict as IM --import qualified Data.IntSet as IS import qualified Data.Map.Strict as M import Data.Maybe -import Data.List (scanl') +import Data.List (sort,scanl') itemCombinations :: [ (M.Map CombineType Int, Item) ] -itemCombinations = map (first toMultiset) $ +itemCombinations = map (first toMultiset) itemCombinations' + +combinationsTrie :: Trie CombineType Item +combinationsTrie = foldr (uncurry insertInTrie) emptyTrie + $ map (first sort) itemCombinations' + +itemCombinations' :: [([CombineType],Item)] +itemCombinations' = [ p [PIPE,HARDWARE] (bangStick 1) , p [BANGSTICK 1,TIN] pistol , p [PISTOL, SPRING, HARDWARE] autoPistol @@ -37,6 +46,7 @@ itemCombinations = map (first toMultiset) $ , p [BANGCANE,TIN] rifle , p [RIFLE,SPRING,HARDWARE] autoRifle , p [RIFLE,SPRING,CAN] assaultRifle + , p [BANGCANE,BANGCANE] miniGun , p [PIPE,PIPE,PIPE,HARDWARE] bangRod , p [BANGROD,PLANK,HARDWARE] elephantGun @@ -52,28 +62,65 @@ itemCombinations = map (first toMultiset) $ where p = (,) -combinations :: [(M.Map CombineType Int, CombineType)] -combinations = map (second _itType) itemCombinations - combineToItem :: M.Map CombineType Int -> Maybe Item combineToItem m = lookup m itemCombinations +expandItem :: (Int,Item) -> [(Int,CombineType)] +expandItem (i,it) = case it ^? itConsumption . itAmount of + Nothing -> [(i,_itType it)] + Just j -> replicate j (i,_itType it) + combineItemList :: IM.IntMap Item -> [([Int],Item)] -combineItemList m = mapMaybe (pushoutmaybe . second combineToItem) +combineItemList m + = mapMaybe (pushoutmaybe . second combineToItem) . concatMap itemsMultisets . powlistN 4 $ IM.toList m where pushoutmaybe (_,Nothing) = Nothing pushoutmaybe (x,Just y) = Just (x,y) ---combineItemList :: IM.IntMap CombineType -> [([Int],Item)] ---combineItemList m = mapMaybe (pushoutmaybe . second (combineToItem . toMultiset) . unzip) --- . powlistN 4 --- $ IM.toList m --- where --- pushoutmaybe (_,Nothing) = Nothing --- pushoutmaybe (x,Just y) = Just (x,y) +lookupTypeTrie :: [CombineType] -> Maybe Item +lookupTypeTrie = flip lookupTrie combinationsTrie . sort + +combineItemList' :: IM.IntMap Item -> [([Int],Item)] +combineItemList' + = mapMaybe (pushoutmaybe . second lookupTypeTrie) + . listCombos + where + pushoutmaybe (_,Nothing) = Nothing + pushoutmaybe (x,Just y) = Just (x,y) + +listCombos :: IM.IntMap Item -> [([Int], [CombineType])] +listCombos = concatMap expandOut . invertListInvMult + +expandOut :: [(CombineType,Int,Int)] -> [([Int],[CombineType])] +expandOut [] = [([],[])] +expandOut (x:xs) = (<>) <$> f x <*> expandOut xs + where + f (ct,i,n) = map (\j -> (replicate j i,replicate j ct)) [1..n] + +invertListInvMult :: IM.IntMap Item -> [[(CombineType,Int,Int)]] +invertListInvMult = powlistN 4 . invertListInv + +invertListInv :: IM.IntMap Item -> [(CombineType,Int,Int)] +invertListInv = IM.foldrWithKey + (\k it -> ((_itType it, k, itStackAmount it) :) ) + [] + +invertInv :: IM.IntMap Item -> M.Map CombineType (IM.IntMap Int) +invertInv = IM.foldrWithKey + (\k it -> M.insertWith IM.union (_itType it) (IM.singleton k (itStackAmount it))) + M.empty + +expandCounts :: (Int,(Int,a)) -> [[(Int,a)]] +expandCounts (i,(j,ct)) = [ replicate k (i,ct) | k <- [1..j]] + +multisetsWithCounts :: IM.IntMap Item -> [[(Int,(Int,CombineType))]] +multisetsWithCounts = powlistN 4 . IM.toList . IM.map countAndType + where + countAndType it = (fromMaybe 1 $ it ^? itConsumption . itAmount + , _itType it) -- multiple multisets produced by a single item stack are combined using the list monad itemsMultisets :: [(Int,Item)] -> [([Int],M.Map CombineType Int)] @@ -88,18 +135,8 @@ itemMultisets (i,it) = case it ^? itConsumption . itAmount of where thetype = _itType it -itemTypeAmounts :: Item -> [[CombineType]] -itemTypeAmounts it = case it ^? itConsumption . itAmount of - Nothing -> [[thetype]] - Just i -> map (`replicate` thetype) [1 .. i] - where - thetype = _itType it - combineItemListYou :: World -> [([Int],Item)] -combineItemListYou = combineItemList . yourInv - -combineListYou :: World -> [([Int],CombineType)] -combineListYou = fmap (second _itType) . combineItemListYou +combineItemListYou = combineItemList' . yourInv toggleCombineInv :: World -> World toggleCombineInv w = case _inventoryMode w of @@ -109,10 +146,7 @@ toggleCombineInv w = case _inventoryMode w of enterCombineInv :: World -> World enterCombineInv w = w & inventoryMode .~ CombineInventory mi where - mi = 0 <$ listToMaybe (combineListYou w) - -combine :: M.Map CombineType Int -> Maybe CombineType -combine m = lookup m combinations + mi = 0 <$ listToMaybe (combineItemListYou w) combineSizes :: World -> [Int] combineSizes = map (ceiling . _itInvSize . snd) . combineItemListYou diff --git a/src/Dodge/Creature.hs b/src/Dodge/Creature.hs index 717c68111..642e359a1 100644 --- a/src/Dodge/Creature.hs +++ b/src/Dodge/Creature.hs @@ -177,6 +177,7 @@ testInventory = IM.fromList $ zip [0..] , makeTypeCraftNum 3 CAN , makeTypeCraftNum 3 TIN , makeTypeCraftNum 3 PLANK + , makeTypeCraftNum 1 MOTOR ] stackedInventory :: IM.IntMap Item stackedInventory = IM.fromList $ zip [0..] diff --git a/src/Dodge/Creature/HandPos.hs b/src/Dodge/Creature/HandPos.hs index 1d4153ca1..c3af75747 100644 --- a/src/Dodge/Creature/HandPos.hs +++ b/src/Dodge/Creature/HandPos.hs @@ -3,4 +3,4 @@ import Dodge.Data import Geometry crHandPos :: Creature -> Point3 -crHandPos cr = V3 0 0 20 +crHandPos _ = V3 0 0 20 diff --git a/src/Dodge/Default/Weapon.hs b/src/Dodge/Default/Weapon.hs index 1f5c76a19..b1596a0ea 100644 --- a/src/Dodge/Default/Weapon.hs +++ b/src/Dodge/Default/Weapon.hs @@ -6,7 +6,7 @@ import Dodge.Item.Draw import Picture import ShapePicture import Shape -import Geometry.Vector3D +--import Geometry.Vector3D import Geometry --import Dodge.TweakBullet diff --git a/src/Dodge/Event.hs b/src/Dodge/Event.hs index 34470a46b..60e31c851 100644 --- a/src/Dodge/Event.hs +++ b/src/Dodge/Event.hs @@ -144,7 +144,7 @@ wheelEvent y w = case (_carteDisplay w, _inventoryMode w) of & inventoryMode . combineInvSel . _Just %~ ((`mod` numcombs) . subtract yi) (_, _) -> w where - numcombs = length $ combineListYou w + numcombs = length $ combineItemListYou w yi = round $ signum y numLocs = (fst . IM.findMax $ _seenLocations w) + 1 rbDown = ButtonRight `S.member` _mouseButtons w diff --git a/src/Dodge/Item/Amount.hs b/src/Dodge/Item/Amount.hs new file mode 100644 index 000000000..6df6a404f --- /dev/null +++ b/src/Dodge/Item/Amount.hs @@ -0,0 +1,7 @@ +module Dodge.Item.Amount where +import Dodge.Data +import Data.Maybe +import Control.Lens + +itStackAmount :: Item -> Int +itStackAmount it = fromMaybe 1 $ it ^? itConsumption . itAmount diff --git a/src/Dodge/Item/Weapon/Bezier.hs b/src/Dodge/Item/Weapon/Bezier.hs index 48bcdbf32..91c904a2a 100644 --- a/src/Dodge/Item/Weapon/Bezier.hs +++ b/src/Dodge/Item/Weapon/Bezier.hs @@ -5,7 +5,7 @@ import Dodge.Data import Dodge.Base import Dodge.Default.Weapon import Dodge.Item.Weapon.Targeting -import Dodge.Item.Weapon.BulletGuns +--import Dodge.Item.Weapon.BulletGuns import Dodge.Item.Weapon.TriggerType import Dodge.Item.Weapon.ExtraEffect --import Dodge.Default @@ -15,7 +15,7 @@ import Dodge.WorldEvent.HitEffect import Dodge.RandomHelp import Dodge.SoundLogic.LoadSound import Geometry -import ShapePicture +--import ShapePicture import Data.Maybe import Control.Lens @@ -46,8 +46,6 @@ bezierGun = defaultGun { _ammoMax = 50 } } -bezierGunSPic :: Item -> SPic -bezierGunSPic = autoGunPic shootBezier :: Point2 -> Creature -> World -> World shootBezier targetp cr w = w & particles %~ (theBullet :) diff --git a/src/Dodge/Item/Weapon/BulletGuns.hs b/src/Dodge/Item/Weapon/BulletGuns.hs index 518a3a11b..223edcdd3 100644 --- a/src/Dodge/Item/Weapon/BulletGuns.hs +++ b/src/Dodge/Item/Weapon/BulletGuns.hs @@ -252,7 +252,8 @@ rifle = bangCane {_handlePos = 5 ,_muzPos = 25 } - , _dimSPic = const $ noPic $ colorSH red $ upperPrismPoly 3 $ rectXH 25 2 + , _dimSPic = \it -> noPic $ (colorSH red $ upperPrismPoly 3 $ rectXH 25 2) + <> makeClipAt (V3 10 (-2) 0) it } } & itUse . useAim . aimStance .~ TwoHandTwist @@ -262,6 +263,12 @@ rifle = bangCane & itConsumption . reloadType .~ ActiveClear & itConsumption . reloadTime .~ 80 +makeClipAt :: Point3 -> Item -> Shape +makeClipAt p it = translateSH p $ upperPrismPoly 1 $ rectNSEW 0 (-y) (-2) 2 + where + y = fromIntegral y' * 0.3 + y' = fromMaybe 0 $ it ^? itConsumption . ammoLoaded + autoRifle :: Item autoRifle = rifle & itName .~ "AUTORIFLE" @@ -557,19 +564,7 @@ pistol = defaultGun } , _itTweaks = defaultBulletSelTweak } ---pistolPic :: Item -> SPic ---pistolPic it = noPic $ colorSH green (prismPoly --- (map (addZ 3) $ rectNESW 3 3 (-3) (-3)) --- (map (addZ 0) $ rectNESW 5 3 (-5) (-7)) --- ) --- <> translateSH (V3 (-4) 5.5 4) (rotateSH pi $ bulletClip am) --- where --- am = _ammoLoaded $ _itConsumption it -bulletClip :: Int -> Shape -bulletClip x = rotateSHx (negate $ pi/4) . upperPrismPoly 2 $ rectNESW 3 0 (3 - 0.25 * am) (-5) - where - am = fromIntegral x hvAutoGun :: Item hvAutoGun = defaultAutoGun @@ -600,17 +595,6 @@ hvAutoGun = defaultAutoGun ,"* " ++ fromMaybe " " (maybeRateStatus it) ++ " *" ] } -hvAutoGunPic :: Item -> SPic -hvAutoGunPic it = - ( colorSH orange (prismPoly - (map (addZ 5) $ rectNESW 3 12 (-3) (-8)) - (map (addZ 0) $ rectNESW 5 12 (-5) (-12)) - ) - <> bulletClip am - , mempty - ) - where - am = _ammoLoaded $ _itConsumption it autoPistol :: Item autoPistol = pistol & itUse . useMods .~ (ammoCheckI : pistolAfterHamMods) @@ -657,19 +641,9 @@ ltAutoGun = defaultAutoGun } , _itTweaks = defaultBulletSelTweak } -ltAutoGunPic :: Item -> SPic -ltAutoGunPic it = - ( colorSH green $ prismPoly - (map (addZ 5) $ mirrorXAxis [V2 (-2) 3, V2 5 3, V2 10 0]) - (map (addZ 0) $ mirrorXAxis [V2 (-5) 5, V2 5 5, V2 10 0]) - <> bulletClip am - , mempty - ) - where - am = _ammoLoaded $ _itConsumption it miniGun :: Item miniGun = defaultAutoGun - { _itName = "MINI-G" + { _itName = "MINIGUN" , _itType = MINIGUN , _itConsumption = defaultAmmo { _aoType = basicBullet @@ -809,14 +783,6 @@ spreadGun = defaultGun -- , _itFloorPict = spreadGunPic , _itTweaks = defaultBulletSelTweak } -spreadGunPic :: Item -> SPic -spreadGunPic it = - ( colorSH green (upperPrismPoly 5 $ map toV2[(-3,0),(3,6),(3,-6)]) - <> bulletClip am - , mempty - ) - where - am = _ammoLoaded $ _itConsumption it multGun :: Item multGun = defaultGun { _itName = "MULTGUN" @@ -855,21 +821,6 @@ multGun = defaultGun } , _itTweaks = defaultBulletSelTweak } -multGunSPic :: Item -> SPic -multGunSPic it = - ( colorSH red ( - upperPrismPoly 2 (rectNESW 4 8 (-4) (-12)) <> - translateSHf 8 0 (concatMap barrel [12,7,2,-3,-8] <> - upperPrismPoly 2 (map toV2 [(-1.5,12),(-2,12),(-2,-12),(-1.5,-12)]) - ) - ) <> bulletClip am - , mempty - ) - where - barrel y = prismPoly - (map (addZ 5) $ rectNSEW y (y-4) 2 0 ) - (map (addZ 0) $ rectNSEW y (y-4) 2 (-2)) - am = _ammoLoaded $ _itConsumption it longGun :: Item longGun = defaultGun { _itName = "LONGGUN" @@ -901,11 +852,6 @@ longGun = defaultGun , _itAttachment = ItScope (V2 0 0) 0 1 False , _itEffect = itemLaserScopeEffect } -longGunSPic :: Item -> SPic -longGunSPic _ = - ( colorSH orange $ upperPrismPoly 5 $ rectXH 25 2 - , mempty - ) zoomLongGun :: Float -> Creature -> Item -> Item zoomLongGun x _ diff --git a/src/Dodge/Item/Weapon/TriggerType.hs b/src/Dodge/Item/Weapon/TriggerType.hs index 49aed375d..b38228c32 100644 --- a/src/Dodge/Item/Weapon/TriggerType.hs +++ b/src/Dodge/Item/Weapon/TriggerType.hs @@ -53,7 +53,7 @@ import Dodge.Reloading import Dodge.WorldEvent import Dodge.RandomHelp import Dodge.Inventory.Lock -import Dodge.Creature.HandPos +--import Dodge.Creature.HandPos --import Dodge.Default import Sound.Data import Geometry diff --git a/src/Dodge/Render/HUD.hs b/src/Dodge/Render/HUD.hs index c52e11d2b..affb80a9c 100644 --- a/src/Dodge/Render/HUD.hs +++ b/src/Dodge/Render/HUD.hs @@ -156,7 +156,7 @@ combineListStringPictures w = case concatMap (itemText . snd) . combineItemListY xs -> xs combineListLnks :: World -> [(Int,[Int])] -combineListLnks = zip [0..] . map fst . combineListYou +combineListLnks = zip [0..] . map fst . combineItemListYou ammoTweakStrings :: Maybe Item -> [String] ammoTweakStrings it = case it ^? _Just . itTweaks . tweakParams of diff --git a/src/Multiset.hs b/src/Multiset.hs index 93dd16542..ff83472f4 100644 --- a/src/Multiset.hs +++ b/src/Multiset.hs @@ -1,13 +1,18 @@ {-# LANGUAGE TupleSections #-} module Multiset where import qualified Data.Map.Strict as M +import qualified Data.IntMap.Strict as IM +import qualified Data.IntSet as IS import Control.Monad +import Data.List (subsequences) powlistN :: Int -> [a] ->[[a]] powlistN _ [] = [[]] powlistN n (x:xs) | n <=0 = [[]] | otherwise = ((x:) <$> powlistN (n-1) xs) ++ powlistN n xs +powlistN' :: Int -> [a] ->[[a]] +powlistN' k = filter ( ( k >= ) . length ) . subsequences -- exponential, so don't use it on long lists powlist :: [a] -> [[a]] @@ -15,3 +20,8 @@ powlist = filterM (const [True,False]) toMultiset :: Ord a => [a] -> M.Map a Int toMultiset = foldr (uncurry (M.insertWith (+)) . (, 1)) M.empty + +invertIntMap :: Ord a => IM.IntMap a -> M.Map a IS.IntSet +invertIntMap = IM.foldrWithKey + (\k x -> M.insertWith IS.union x (IS.singleton k)) + M.empty diff --git a/src/SimpleTrie.hs b/src/SimpleTrie.hs new file mode 100644 index 000000000..367cee8eb --- /dev/null +++ b/src/SimpleTrie.hs @@ -0,0 +1,26 @@ +{-# LANGUAGE TemplateHaskell #-} +module SimpleTrie where +import Data.Map +import Control.Lens +data Trie a b = Trie + { _trieMVal :: Maybe b + , _trieChildren :: Map a (Trie a b) + } +makeLenses ''Trie + +emptyTrie :: Trie a b +emptyTrie = Trie Nothing empty + +singletonTrie :: Ord a => [a] -> b -> Trie a b +singletonTrie (k:ks) x = Trie Nothing $ singleton k $ singletonTrie ks x +singletonTrie [] x = Trie (Just x) empty + +insertInTrie :: Ord a => [a] -> b -> Trie a b -> Trie a b +insertInTrie [] x = trieMVal .~ Just x +insertInTrie (k:ks) x = trieChildren %~ insertWith f k (singletonTrie ks x) + where + f _ = insertInTrie ks x + +lookupTrie :: Ord a => [a] -> Trie a b -> Maybe b +lookupTrie [] t = _trieMVal t +lookupTrie (k:ks) t = _trieChildren t !? k >>= lookupTrie ks