diff --git a/appDodge/Main.hs b/appDodge/Main.hs index e252d7dfe..00ab221a7 100644 --- a/appDodge/Main.hs +++ b/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 diff --git a/src/Dodge/Combine.hs b/src/Dodge/Combine.hs index 365711f8a..4848494aa 100644 --- a/src/Dodge/Combine.hs +++ b/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 xs = lookupItemsUsingTrie (sortOn (\(ct,_,_) -> ct) xs) combinationsTrie +lookupItems :: [(ItemModules,CombineType,Int,Int)] -> [ ([(ItemModules,Int)],Item) ] +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 diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 98b9f917b..0c24808bb 100644 --- a/src/Dodge/Data.hs +++ b/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 diff --git a/src/Dodge/Default.hs b/src/Dodge/Default.hs index e458c135f..748aa2948 100644 --- a/src/Dodge/Default.hs +++ b/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') diff --git a/src/Dodge/Default/Weapon.hs b/src/Dodge/Default/Weapon.hs index b1596a0ea..17a178133 100644 --- a/src/Dodge/Default/Weapon.hs +++ b/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 diff --git a/src/Dodge/Default/World.hs b/src/Dodge/Default/World.hs index 38d649d28..99d4b2f8d 100644 --- a/src/Dodge/Default/World.hs +++ b/src/Dodge/Default/World.hs @@ -87,7 +87,7 @@ defaultWorld = World , _worldBounds = defaultBounds , _maybeWorld = Nothing' , _rewindWorlds = [] - , _rewinding = NotRewinding + , _timeFlow = NormalTimeFlow , _lSelHammerPosition = HammerUp , _worldTerminal = Nothing' } diff --git a/src/Dodge/Inventory/ItemSpace.hs b/src/Dodge/Inventory/ItemSpace.hs index c7035fb30..7829054ec 100644 --- a/src/Dodge/Inventory/ItemSpace.hs +++ b/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) - Just i -> ceiling (_itInvSize it * fromIntegral i) + Nothing -> moduleSizes it + ceiling (_itInvSize it) + Just i -> moduleSizes it + ceiling (_itInvSize it * fromIntegral i) + diff --git a/src/Dodge/Item/Weapon/AmmoParams.hs b/src/Dodge/Item/Weapon/AmmoParams.hs index 44b0060f6..500f1a1f1 100644 --- a/src/Dodge/Item/Weapon/AmmoParams.hs +++ b/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) diff --git a/src/Dodge/Item/Weapon/BulletGun/Cane.hs b/src/Dodge/Item/Weapon/BulletGun/Cane.hs index 930a1ebee..a756a348b 100644 --- a/src/Dodge/Item/Weapon/BulletGun/Cane.hs +++ b/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 diff --git a/src/Dodge/Item/Weapon/InventoryDisplay.hs b/src/Dodge/Item/Weapon/InventoryDisplay.hs index 3b17dbe35..105c88e4a 100644 --- a/src/Dodge/Item/Weapon/InventoryDisplay.hs +++ b/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 diff --git a/src/Dodge/Item/Weapon/Utility.hs b/src/Dodge/Item/Weapon/Utility.hs index 46954f768..91f50123a 100644 --- a/src/Dodge/Item/Weapon/Utility.hs +++ b/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 diff --git a/src/Dodge/Module.hs b/src/Dodge/Module.hs new file mode 100644 index 000000000..751a935cd --- /dev/null +++ b/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 diff --git a/src/Dodge/Render/HUD.hs b/src/Dodge/Render/HUD.hs index 944be1a94..e3d8b46da 100644 --- a/src/Dodge/Render/HUD.hs +++ b/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 diff --git a/src/Dodge/Render/List.hs b/src/Dodge/Render/List.hs index 2d95d83cd..9b3cdd478 100644 --- a/src/Dodge/Render/List.hs +++ b/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(?!) diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index 9aa17b38b..2acf212d9 100644 --- a/src/Dodge/Update.hs +++ b/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 - Nothing' -> w & rewinding .~ NotRewinding + Just' w' -> w' & timeFlow .~ RewindingLastFrame + Nothing' -> w & timeFlow .~ NormalTimeFlow zoneCreatures :: World -> World zoneCreatures w = w diff --git a/src/Dodge/Update/UsingInput.hs b/src/Dodge/Update/UsingInput.hs index 87c25ee3d..966f2f09c 100644 --- a/src/Dodge/Update/UsingInput.hs +++ b/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