Add modules to items, upgrades the can persist through combinations

appDodge/Main.hs

@@ -78,7 +78,7 @@ updateRenderSplit u = do
 
 playSoundUnlessRewinding :: Universe -> IO (M.Map SoundOrigin Sound)
 playSoundUnlessRewinding u
-    | _rewinding w == RewindingNow = return M.empty
+    | _timeFlow w == RewindingNow = return M.empty
     | otherwise = playSoundAndUpdate (_soundData $ _preloadData u) (_playingSounds w) (_toPlaySounds w)
   where
     w = _uvWorld u
@@ -87,7 +87,6 @@ doSideEffects :: Universe -> IO Universe
 doSideEffects u = do
     let w = _uvWorld u
     let preData = _preloadData u
-    --newPlayingSounds <- playSoundAndUpdate (_soundData preData) (_playingSounds w) (_toPlaySounds w)
     newPlayingSounds <- playSoundUnlessRewinding u
     u' <- _sideEffects w u
     endTicks <- SDL.ticks
@@ -103,8 +102,6 @@ doSideEffects u = do
         & uvWorld . playingSounds .~ newPlayingSounds
         & uvWorld . toPlaySounds  .~ M.empty
         & uvWorld . sideEffects   .~ return
---        & uvWorld . rewinding .~ False  -- this is probably not the best place for this
-        
 
 doPreload :: IO PreloadData
 doPreload = do

src/Dodge/Combine.hs

@@ -3,6 +3,7 @@ module Dodge.Combine
     ( combinePoss
     , combineSizes
     , combineItemListYou
+    , combineItemListYou'
     , toggleCombineInv
     , enterCombineInv
     ) where
@@ -10,6 +11,7 @@ import Dodge.Combine.Combinations
 import Dodge.Base.You
 import Dodge.Data
 import Dodge.Item.Amount
+import Dodge.Inventory.ItemSpace
 --import Dodge.Combine.Data
 import Multiset
 import SimpleTrie
@@ -32,29 +34,52 @@ combinationsTrie = foldr
 -- trie going through each combine type in your inventory in order, rather than
 -- creating all multisets of combine types.
 
-lookupItems :: [(CombineType,Int,Int)] -> [ ([Int],Item) ]
+lookupItems :: [(ItemModules,CombineType,Int,Int)] -> [ ([(ItemModules,Int)],Item) ]
-lookupItems xs = lookupItemsUsingTrie (sortOn (\(ct,_,_) -> ct) xs) combinationsTrie
+lookupItems xs = lookupItemsUsingTrie (sortOn (\(_,ct,_,_) -> ct) xs) combinationsTrie
 
-lookupItemsUsingTrie :: [(CombineType,Int,Int)] -> Trie (Int,CombineType) Item -> [ ([Int],Item) ]
+lookupItemsUsingTrie :: [(ItemModules,CombineType,Int,Int)] 
+    -> Trie (Int,CombineType) Item -> [ ([(ItemModules,Int)],Item) ]
 lookupItemsUsingTrie [] t = maybeToList $ ([],) <$> _trieMVal t
-lookupItemsUsingTrie ((ct,i,n):xs) t = do
+lookupItemsUsingTrie ((mods,ct,i,n):xs) t = do
     n' <- [1..min n 4]
-    let is = replicate n' i
+    let is = replicate n' (mods,i)
     concatMap (map (first (is ++)) . lookupItemsUsingTrie xs) $ maybeToList (_trieChildren t M.!? (n',ct))
 
-invertListInvMult :: IM.IntMap Item -> [[(CombineType,Int,Int)]]
+invertListInvMult :: IM.IntMap Item -> [[(ItemModules,CombineType,Int,Int)]]
 invertListInvMult = powlistUpToN 4 . invertListInv
 
-invertListInv :: IM.IntMap Item -> [(CombineType,Int,Int)]
+invertListInv :: IM.IntMap Item -> [(ItemModules,CombineType,Int,Int)]
 invertListInv = IM.foldrWithKey
-    (\k it -> ((_itType it, k, itStackAmount it) :) )
+    (\k it -> ((_itModules it,_itType it, k, itStackAmount it) :) )
     []
 
 -- 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 = concatMap lookupItems . invertListInvMult . yourInv
+combineItemListYou = map (second fst) . combineItemListYou'
+
+combineItemListYou' :: World -> [([Int],(Item,[String]))]
+combineItemListYou' = concatMap addModules . concatMap lookupItems . invertListInvMult . yourInv
+
+addModules :: ([(ItemModules,Int)],Item) -> [([Int],(Item,[String]))]
+addModules (ps,it) = (is , ) <$> [ (it & itModules .~ themodules,s) | (themodules,s) <- combinedmodules]
+  where
+    (ms,is) = unzip ps
+    combinedmodules = foldr f [(_itModules it,[])] ms
+    f ims imss = concatMap (g ims) imss
+    g ims (ims',s) = map (second (s++)) $ combineModules ims ims'
+
+combineModules :: ItemModules -> ItemModules -> [(ItemModules,[String])]
+combineModules (ItemModules a1) (ItemModules a2)
+    = [(ItemModules a,ss) | (a,ss) <- combineModule a1 a2]
+
+combineModule :: ItemModule a -> ItemModule a -> [(ItemModule a,[String])]
+combineModule BlockedModule (ItemModule _ ss _) = [(BlockedModule, "WARNING:REMOVES":ss)]
+combineModule BlockedModule _ = [(BlockedModule,["a"])]
+combineModule m BlockedModule = [(m,[])]
+combineModule DefaultModule m = [(m,[])]
+combineModule m _ = [(m,[])]
 
 toggleCombineInv :: World -> World
 toggleCombineInv w = case _inventoryMode w of
@@ -67,7 +92,8 @@ enterCombineInv w = w & inventoryMode .~ CombineInventory mi
     mi = 0 <$ listToMaybe (combineItemListYou w)
 
 combineSizes :: World -> [Int]
-combineSizes = map (ceiling . _itInvSize . snd) . combineItemListYou
+--combineSizes = map (ceiling . _itInvSize . snd) . combineItemListYou
+combineSizes = map (itSlotsTaken . snd) . combineItemListYou
 
 combinePoss :: World -> [Int]
 combinePoss = scanl' (+) 0 . combineSizes

src/Dodge/Data.hs

@@ -125,17 +125,17 @@ data World = World
     , _gameRooms            :: [GameRoom] -- consider using and IntMap
     , _maybeWorld           :: Maybe' World
     , _rewindWorlds         :: [World]
-    , _rewinding            :: RewindingStatus
+    , _timeFlow             :: TimeFlowStatus
     , _worldClock           :: Int
     , _lSelHammerPosition   :: HammerPosition
     , _worldTerminal        :: Maybe' WorldTerminal
     }
 data WorldTerminal = WorldTerminal Int [(Int,String)]
 
-data RewindingStatus
+data TimeFlowStatus
     = RewindingNow
     | RewindingLastFrame
-    | NotRewinding
+    | NormalTimeFlow
   deriving (Eq,Ord)
 
 data SaveSlot = QuicksaveSlot | LevelStartSlot
@@ -341,7 +341,7 @@ _itUseAimStance :: Item -> AimStance
 _itUseAimStance = _aimStance . _useAim . _itUse
 data ItemConsumption
     = LoadableAmmo
-        { _aoType        :: AmmoType
+        { _aoType      :: AmmoType
         , _ammoMax     :: Int
         , _ammoLoaded  :: Int
         , _reloadTime  :: Int
@@ -375,6 +375,20 @@ data Item
         , _itCurseStatus :: CurseStatus
         , _itParams     :: ItemParams
         , _itTweaks     :: ItemTweaks
+        , _itModules    :: ItemModules
+        }
+
+data ItemModules = ItemModules
+    { _modHitEffect :: ItemModule HitEffect
+    }
+
+data ItemModule a 
+    = BlockedModule
+    | DefaultModule
+    | ItemModule
+        { _theModule :: a
+        , _modName :: [String]
+        , _modSize :: Int
         }
 
 data ItemDimension = ItemDimension
@@ -917,3 +931,5 @@ makeLenses ''ItemPortage
 makeLenses ''Magnet
 makeLenses ''Gust
 makeLenses ''GunBarrels
+makeLenses ''ItemModules
+makeLenses ''ItemModule

src/Dodge/Default.hs

@@ -154,6 +154,7 @@ defaultEquipment = Item
     , _itParams = NoParams
     , _itTweaks = NoTweaks
     , _itTargeting = Nothing
+    , _itModules = ItemModules BlockedModule
     }
 defaultItZoom :: ItZoom
 defaultItZoom = ItZoom 20 0.2 1
@@ -177,6 +178,7 @@ defaultConsumable = Item
     , _itParams = NoParams
     , _itDimension = defItDimCol blue
     , _itTweaks = NoTweaks
+    , _itModules = ItemModules BlockedModule
     }
 defaultApplyDamage :: [DamageType] -> Creature -> (World -> World, Creature)
 defaultApplyDamage ds cr = (id, doPoisonDam $ foldl' (flip $ \d c -> snd $ applyIndividualDamage d c) cr ds')

src/Dodge/Default/Weapon.hs

@@ -100,6 +100,9 @@ defaultGun = Item
     , _itTargeting = Nothing
     , _itParams = NoParams
     , _itTweaks = NoTweaks
+    , _itModules = ItemModules
+        { _modHitEffect = DefaultModule
+        }
     }
 defaultCraftable :: Item
 defaultCraftable = Item 
@@ -122,6 +125,7 @@ defaultCraftable = Item
     , _itParams = NoParams
     , _itDimension = defItDimCol green
     , _itTweaks = NoTweaks
+    , _itModules = ItemModules BlockedModule
     }
 defItDim :: ItemDimension
 defItDim = ItemDimension

src/Dodge/Default/World.hs

@@ -87,7 +87,7 @@ defaultWorld = World
     , _worldBounds = defaultBounds
     , _maybeWorld = Nothing'
     , _rewindWorlds = []
-    , _rewinding = NotRewinding
+    , _timeFlow = NormalTimeFlow
     , _lSelHammerPosition = HammerUp
     , _worldTerminal = Nothing'
     }

src/Dodge/Inventory/ItemSpace.hs

@@ -1,9 +1,14 @@
-module Dodge.Inventory.ItemSpace where
+module Dodge.Inventory.ItemSpace 
+    ( itSlotsTaken
+    ) where
 import Dodge.Data
+import Dodge.Module
 
 import Control.Lens
+--import Data.Maybe
 
 itSlotsTaken :: Item -> Int
 itSlotsTaken it = case it ^? itConsumption . itAmount of
-    Nothing -> ceiling (_itInvSize it)
+    Nothing -> moduleSizes it + ceiling (_itInvSize it)
-    Just i  -> ceiling (_itInvSize it * fromIntegral i)
+    Just i  -> moduleSizes it + ceiling (_itInvSize it * fromIntegral i)
+

src/Dodge/Item/Weapon/AmmoParams.hs

@@ -9,9 +9,12 @@ module Dodge.Item.Weapon.AmmoParams
 import Dodge.Data
 import Dodge.Particle.Bullet.Spawn
 import Dodge.Creature.HandPos
+import Dodge.WorldEvent.HitEffect
+import Dodge.Particle.Bullet.HitEffect
 import Geometry
 import LensHelp
 
+import Data.Maybe
 --import Control.Lens
 
 useAmmoParamsRate :: Int 
@@ -39,12 +42,15 @@ useAmmoParams it cr = withVelWthHiteff
     (_rifling $ _itParams it) 
     (_amBulWth b) 
     muzlength
-    (_amBulEff b) 
+    bulHitEff
+--    (_amBulEff b) 
     cr
   where
     muzlength = aimingMuzzlePos cr it
     muzvel = _muzVel $ _itParams it
     b = _aoType $ _itConsumption it
+    bulHitEff = fromMaybe (destroyOnImpact bulHitCr bulHitWall)
+        $ it ^? itModules . modHitEffect . theModule
 
 useAmmoParamsVelMod :: Float -> Item -> Creature -> World -> World
 useAmmoParamsVelMod vfact it = withDelayedVelWthHiteff vfact (_amBulVel b) (_rifling $ _itParams it) 

src/Dodge/Item/Weapon/BulletGun/Cane.hs

@@ -9,6 +9,8 @@ module Dodge.Item.Weapon.BulletGun.Cane
     , fastBurstRifle
     , miniGunX
     ) where
+import Dodge.Particle.Bullet.HitEffect
+import Dodge.WorldEvent.HitEffect
 import Dodge.Item.Weapon.BulletGun.Clip
 import Dodge.Data
 --import Dodge.ChainEffect
@@ -40,6 +42,8 @@ import Data.Maybe
 bangCane :: Item
 bangCane = defaultGun
     { _itName = "BANGCANE"
+    , _itModules = ItemModules
+        { _modHitEffect = ItemModule (destroyOnImpact bulIncCr bulIncWall) ["+INCENDIARY"] 1}
     , _itType = BANGCANE
     ,_itParams = BulletShooter
         { _muzVel = 0.8

src/Dodge/Item/Weapon/InventoryDisplay.hs

@@ -17,8 +17,9 @@ import Control.Lens
 basicItemDisplay :: Item -> [String]
 basicItemDisplay it = Prelude.take (itSlotsTaken it) $
     (midPadL 15 ' ' thename (' ' : thenumber) ++ theparam)
-    : repeat "*"
+    : moduleStrings ++ repeat "*"
   where 
+    moduleStrings = fromMaybe [] $ it ^? itModules . modHitEffect . modName
     thename  = _itName it
     thenumber = case it ^? itConsumption of
         Just am@LoadableAmmo{} -> case _reloadState am of 

src/Dodge/Item/Weapon/Utility.hs

@@ -38,7 +38,7 @@ rewindEffect _ cr invid w
     ptrWpCharge = creatures . ix (_crID cr) . crInv . ix invid . itConsumption . wpCharge
     maxcharge = _wpMaxCharge . _itConsumption $ _crInv cr IM.! invid
     w' = w & rewindWorlds .~ []
-        & rewinding .~ RewindingNow
+        & timeFlow .~ NormalTimeFlow
 
 useRewindGun :: Item -> Creature -> World -> World
 useRewindGun _ _ w = case _rewindWorlds w of

src/Dodge/Module.hs

@@ -0,0 +1,9 @@
+module Dodge.Module 
+    where
+import Dodge.Data
+
+import Control.Lens
+import Data.Maybe
+
+moduleSizes :: Item -> Int
+moduleSizes it = fromMaybe 0 $ it ^? itModules . modHitEffect . modSize

src/Dodge/Render/HUD.hs

@@ -84,6 +84,11 @@ subInventoryDisplay cfig w = case _inventoryMode w of
     CombineInventory mi -> pictures
         [ invHead cfig "COMBINE"
         , listTextPicturesAt subInvX 60 cfig $ combineListStringPictures w
+        , fromMaybe mempty $ do
+            i <- mi
+            cpos  <- combinePoss  w !? i
+            strs  <- fmap (snd . snd) (combineItemListYou' w !? i)
+            return $ listTextPicturesAtOffset (subInvX + 150) 60 cfig cpos $ map (color red . text) strs
         , fromMaybe mempty $ do
             i <- mi
             cpos  <- combinePoss  w !? i
@@ -290,7 +295,6 @@ itemText it = f $ case _itCurseStatus it of
   where
     thecolor = _itInvColor it
     f = take (itSlotsTaken it) . (++ replicate 10 (color (_itInvColor it) $ text "*"))
-    
 
 openCursorAt 
     :: Float    -- ^ Width

src/Dodge/Render/List.hs

@@ -10,8 +10,10 @@ import Data.Maybe
 -- given a list of pictures that are each the size of a "text" call, displays them as
 -- a list on the screen
 listTextPicturesAt :: Float -> Float -> Configuration -> [Picture] -> Picture
-listTextPicturesAt tx ty cfig = mconcat . zipWith (listTextPictureAt tx ty cfig) [0..]
+listTextPicturesAt tx ty cfig = listTextPicturesAtOffset tx ty cfig 0
 
+listTextPicturesAtOffset :: Float -> Float -> Configuration -> Int -> [Picture] -> Picture
+listTextPicturesAtOffset tx ty cfig i = mconcat . zipWith (listTextPictureAt tx ty cfig) [i..]
 
 -- displays a cursor that should match up to list text pictures
 -- the width of a character appears to be 9(?!)

src/Dodge/Update.hs

@@ -83,8 +83,8 @@ functionalUpdate cfig w = checkEndGame
 
 doRewind :: World -> World
 doRewind w = case _maybeWorld w of
-    Just' w' -> w' & rewinding .~ RewindingLastFrame
+    Just' w' -> w' & timeFlow .~ RewindingLastFrame
-    Nothing' -> w  & rewinding .~ NotRewinding
+    Nothing' -> w  & timeFlow .~ NormalTimeFlow
 
 zoneCreatures :: World -> World
 zoneCreatures w = w 

src/Dodge/Update/UsingInput.hs

@@ -18,15 +18,15 @@ updateUsingInput w = if _carteDisplay w
 
 updatePressedButtons :: S.Set MouseButton -> World -> World
 updatePressedButtons pkeys w 
-    | lbPressed && rbPressed = tryUseItem (you w) w
+    | lbPressed && rbPressed && inTopInv = tryUseItem (you w) w
     | lbPressed && 
-        (_inventoryMode w == TopInventory || _rewinding w == RewindingLastFrame)
+        (inTopInv || _timeFlow w == RewindingLastFrame)
         = useLeftItem (_yourID w) w
---    | lbPressed = w
     | mbPressed = w & clickMousePos .~ _mousePos w 
         & cameraRot -~ rotation
     | otherwise = w
   where 
+    inTopInv  = _inventoryMode w == TopInventory
     lbPressed = ButtonLeft `S.member` pkeys
     rbPressed = ButtonRight `S.member` pkeys
     mbPressed = ButtonMiddle `S.member` pkeys