From e23e0761843b0432de9045660322425968a06c7e Mon Sep 17 00:00:00 2001 From: jgk Date: Sat, 24 Apr 2021 19:35:49 +0200 Subject: [PATCH] Partial fix to jetPack --- src/Dodge/Creature.hs | 8 +- src/Dodge/Creature/Inanimate.hs | 8 +- src/Dodge/Creature/YourControl.hs | 9 +- src/Dodge/CreatureState.hs | 245 ------------------------------ src/Dodge/Item/Weapon.hs | 7 +- src/Dodge/Update.hs | 3 +- 6 files changed, 18 insertions(+), 262 deletions(-) delete mode 100644 src/Dodge/CreatureState.hs diff --git a/src/Dodge/Creature.hs b/src/Dodge/Creature.hs index f65870692..2f5c93381 100644 --- a/src/Dodge/Creature.hs +++ b/src/Dodge/Creature.hs @@ -3,10 +3,8 @@ module Dodge.Creature , module Dodge.Creature.Inanimate ) where --- imports {{{ import Dodge.Data import Dodge.AIs -import Dodge.CreatureState import Dodge.Default import Dodge.Base import Dodge.Item.Weapon @@ -14,6 +12,7 @@ import Dodge.Item.Consumable import Dodge.WorldEvent.Cloud import Dodge.Creature.YourControl import Dodge.Creature.Inanimate +import Dodge.Creature.State import Dodge.Item import Picture @@ -257,6 +256,7 @@ startCr = defaultCreature startInventory = IM.fromList (zip [0..20] ( + [ --jetPack --[pistol --,blinkGun --,spawnGun lamp @@ -273,8 +273,8 @@ startInventory = IM.fromList (zip [0..20] --,miniGun --,medkit 50 --,bezierGun - --] - -- ++ + ] + ++ repeat NoItem)) smokeGenGun = effectGun "smoke" $ \_ -> spawnSmokeAtCursor diff --git a/src/Dodge/Creature/Inanimate.hs b/src/Dodge/Creature/Inanimate.hs index 5ed5f4f6d..5455951b3 100644 --- a/src/Dodge/Creature/Inanimate.hs +++ b/src/Dodge/Creature/Inanimate.hs @@ -1,16 +1,16 @@ +{- +Inanimate objects such as lamps, barrels, etc +-} module Dodge.Creature.Inanimate where import Dodge.Data import Dodge.Base import Dodge.Default -import Dodge.CreatureState +import Dodge.Creature.State import Dodge.LightSources import Dodge.WorldEvent.Flash - import Dodge.WorldEvent.Sound - import Dodge.Creature.Update hiding (CRUpdate) - import Picture import qualified Data.IntMap.Strict as IM diff --git a/src/Dodge/Creature/YourControl.hs b/src/Dodge/Creature/YourControl.hs index 5cbbbde06..e69613029 100644 --- a/src/Dodge/Creature/YourControl.hs +++ b/src/Dodge/Creature/YourControl.hs @@ -4,8 +4,8 @@ module Dodge.Creature.YourControl import Dodge.Data import Dodge.Base import Dodge.CreatureAction +import Dodge.Creature.State import Dodge.Update.UsingInput -import Dodge.CreatureState import Dodge.Config.KeyConfig import Geometry @@ -23,9 +23,10 @@ yourControl :: World -> (World -> World,StdGen) -> Creature -> ((World -> World, yourControl w (f,g) cr = ( (updateUsingInput . f, g) , Just . crAutoReload . mouseActionsCr (_mouseButtons w) $ wasdWithAiming w speed strafeSpeed 0 cr ) - where strafeSpeed = _varMovementSpeedModifier w * equipFactor * (fromMaybe 1 $ yourItem w ^? itAimingSpeed) - speed = _varMovementSpeedModifier w * equipFactor - equipFactor = product $ map equipSpeed $ IM.elems $ _crInv $ _creatures w IM.! 0 + where + strafeSpeed = _varMovementSpeedModifier w * equipFactor * (fromMaybe 1 $ yourItem w ^? itAimingSpeed) + speed = _varMovementSpeedModifier w * equipFactor + equipFactor = product $ map equipSpeed $ IM.elems $ _crInv $ _creatures w IM.! 0 wasdWithAiming :: World -> Float -> Float -> Int -> Creature -> Creature wasdWithAiming w speed aimSpeed i cr diff --git a/src/Dodge/CreatureState.hs b/src/Dodge/CreatureState.hs deleted file mode 100644 index d7a30b6b6..000000000 --- a/src/Dodge/CreatureState.hs +++ /dev/null @@ -1,245 +0,0 @@ -module Dodge.CreatureState where --- imports {{{ -import Dodge.Data -import Dodge.Base -import Dodge.SoundLogic -import Dodge.RandomHelp -import Dodge.WorldEvent -import Dodge.WallCreatureCollisions -import Dodge.CreatureAction - -import Geometry -import Picture - -import Data.List -import Data.Char -import Data.Maybe -import Data.Function -import Data.Graph.Inductive.Graph -import Data.Graph.Inductive.PatriciaTree -import Data.Graph.Inductive.Query.SP -import Codec.BMP -import qualified Data.ByteString as B -import Control.Lens -import Control.Applicative -import Control.Monad.State -import Control.Monad -import qualified SDL as SDL -import qualified SDL.Mixer as Mix -import System.Random -import qualified Data.Set as S -import qualified Data.IntMap.Strict as IM -import qualified Data.Map as M - -import Foreign.ForeignPtr -import Control.Concurrent ----} - -type CRUpdate = World -> (World -> World,StdGen) -> Creature -> ((World -> World,StdGen), Maybe Creature) - --- the movement is updated before the ai in order to correctly set the oldpos --- the whole of this update cycle could do with a rethink, it is becoming --- convoluted -stateUpdate :: CRUpdate -> CRUpdate -stateUpdate u w (f,g) cr = case u w (f,g) (updateMovement g cr) of - ((f',g') , maybeCr) -> ( (invSideEff cr . movementSideEff cr . dropifdead . f' - , g') - , fmap (updateReloadCounter . reducePastDamage . doDamage) - $ crOrCorpse =<< maybeCr - ) - where - crOrCorpse cr | cr ^. crHP > 0 = Just cr - | otherwise = Nothing - dropifdead | cr ^.crHP > 0 = id - | otherwise = stopSoundFrom (CrWeaponSound (_crID cr)) - . over decorations addCorpse - . insertIt - crBeforeDeath = colCrWall w $ cr - addCorpse = insertNewKey $ uncurry translate (_crOldPos cr) - $ rotate (_crDir cr) - (_crCorpse cr) - maybeIt = evalState (maybeTakeOne $ IM.elems (_crInv cr)) (_randGen w) - insertIt = case maybeIt of --- Just it -> createItemAt (offset +.+ _crPos crBeforeDeath) - Just it -> createItemAt (offset +.+ _crOldPos cr) - (FlIt {_flIt=it,_flItPos=(0,0),_flItRot=rot,_flItID=0}) - Nothing -> id - offset = _crRad cr *.* unitVectorAtAngle rot - (rot,_) = randomR (-pi,pi) g - - -setOldPos :: Creature -> Creature -setOldPos cr = set crOldPos (_crPos cr) cr - -doDamage :: Creature -> Creature -doDamage cr = set (crState . crDamage) [] $ over (crState . crPastDamage) (+ hpLost) - damagedCr - where dams = _crDamage $ _crState cr - startHP = _crHP cr - damagedCr = snd $ (_crApplyDamage (_crState cr)) dams cr - afterHP = _crHP damagedCr - hpLost = startHP - afterHP -- note this can be negative - -sumDamage :: Creature -> DamageType -> Int -> Int -sumDamage cr dm x = x + _dmAmount dm - -reducePastDamage :: Creature -> Creature -reducePastDamage = over (crState . crPastDamage) rdpdam - where rdpdam x | x > 500 = x - 55 - | x > 200 = x - 25 - | x > 20 = x - 5 - | x > 0 = x - 1 - | otherwise = 0 - -movementSideEff :: Creature -> World -> World -movementSideEff cr w - | hasJetPack - = case cr ^? crState . stance . carriage of - Just (Boosting v) - -> makeFlameletTimed - (oldPos +.+ (_crRad cr + 3) *.* (unitVectorAtAngle $ _crDir cr + pi)) - (momentum +.+ 1 *.* rotateV randDir (vInverse v)) - Nothing - 1 - 20 - $ set randGen g - w - _ -> w - | otherwise = case cr ^? crState . stance . carriage of - Just (Walking x y) -> takeStep x y w - _ -> w - where hasJetPack = any (\it -> it ^? itIdentity == Just JetPack) $ _crInv cr - oldPos = _crOldPos cr - momentum' = 0.97 *.* (_crPos cr -.- _crOldPos cr) - momentum'' | magV momentum' > 3 = 3 *.* normalizeV momentum' - | otherwise = momentum' - momentum = momentum'' +.+ 0.01 *.* unitVectorAtAngle randAng - (randDir,g) = randomR (-0.5,0.5) $ _randGen w - (randAng,_) = randomR (0,2*pi) $ _randGen w - - (v1:v2:v3:_) = fst $ runState ((sequence . repeat . randInCirc) 0.1) $ _randGen w - (r1:r2:r3:_) = map ((*.*) 100) (v2:v3:v1:[]) - - crHasMoved = dist (_crPos cr) (_crOldPos cr) > 0.5 - takeStep x y | crHasMoved && x < 20 && x + y >= 20 = soundMultiFrom footor 22 3 0 - | crHasMoved && x < 80 && x + y >= 80 = soundMultiFrom footor 23 3 0 - | otherwise = id - footor = [FootstepSound 0,FootstepSound 1] - -invSideEff :: Creature -> World -> World -invSideEff cr w = weaponReloadSounds cr $ IM.foldrWithKey f w (_crInv cr) - where f i it w' = case it ^? itEffect . itInvEffect of - Nothing -> w' - Just g -> g cr i w' - -weaponReloadSounds :: Creature -> World -> World -weaponReloadSounds cr w = case _crInv cr IM.!? _crInvSel cr of - Just (Weapon {_wpReloadState = 0}) - -> w - Just (Weapon {_wpReloadState = 1}) - -> stopSoundFrom (CrReloadSound cid) w - Just (Weapon {}) - -> soundFrom (CrReloadSound cid) reloadSound (1) 0 w - _ - -> w - where cid = _crID cr - -updateMovement :: StdGen -> Creature -> Creature -updateMovement g cr - | isFrictionless cr = over crPos (+.+ momentum) - $ setOldPos - cr - | otherwise - = case cr ^? crState . stance . carriage of - Just (Walking x y) - -> set (crState . stance . carriage) (Walking ((x+y)`mod`120) 0) - $ setOldPos - cr - _ -> set (crState . stance . carriage) (Walking 0 0) - $ setOldPos - cr - where - momentum' = 0.97 *.* (_crPos cr -.- _crOldPos cr) - momentum'' | magV momentum' > 3 = 3 *.* normalizeV momentum' - | otherwise = momentum' - momentum = momentum'' +.+ 0.01 *.* unitVectorAtAngle randAng - (randAng,_) = randomR (0,2*pi) g - -isFrictionless :: Creature -> Bool -isFrictionless cr = case cr ^? crState . stance . carriage of - Just (Boosting _) -> True - Just (Floating) -> True - _ -> False - -updateReloadCounter :: Creature -> Creature -updateReloadCounter cr = over (crInv . ix iSel . wpFireState) decreaseToZero - . over (crInv . ix iSel . wpReloadState) decreaseToZero - $ cr - where iSel = _crInvSel cr - -decreaseToZero :: Int -> Int -decreaseToZero x | x > 0 = x - 1 - | otherwise = 0 - - ---comb :: (StdGen -> Creature -> World -> World) -> (StdGen -> Creature -> Maybe Creature) --- -> CRUpdate ---comb - -onDeath :: (Creature -> World -> World) -> CRUpdate -> CRUpdate -onDeath h u w (f,g) cr - | _crHP cr > 0 = u w (f,g) cr - | otherwise = ( ( h cr . f, g ) , Nothing ) - -updateBarrel :: - World -> (World -> World,StdGen) -> Creature -> ((World -> World , StdGen), Maybe Creature) -updateBarrel w (f,g) cr | _crHP cr > 0 = ((f, g), newCr) - | otherwise = ((f, g), Nothing) - where damages = _crDamage $ _crState cr - newCr = Just $ doDamage cr - --- it is easy to leave off the "f" here --- should find some better way of doing all this that is less prone to error -updateExpBarrel :: - World -> (World -> World,StdGen) -> Creature -> ((World -> World , StdGen), Maybe Creature) -updateExpBarrel w (f,g) cr - | _crHP cr > 0 = ((f . foldr (.) id pierceSparks . hiss, g'), newCr) - | otherwise = ((f . makeExplosionAt (_crPos cr) . stopSounds , g'), Nothing) - where damages = _crDamage $ _crState cr - pierceSparks :: [World -> World] - pierceSparks - = zipWith4 (\p a colid time-> (createBarrelSpark time colid (_crPos cr +.+ p) (a + argV p)) - (Just $ _crID cr)) - poss as colids times - as = randomRs (-0.7,0.7) $ g - colids = randomRs (0,11) $ g - times = randomRs (2,5) $ g - (g',_) = split g - poss = _piercedPoints $ _crSpState $ _crState cr - --newCr = Just $ doDamage $ applyFuseDamage cr -- $ foldr perforate cr damages - newCr = Just $ applyFuseDamage $ set (crState . crDamage) [] $ damToExpBarrel damages cr - perforate :: DamageType -> Creature -> Creature - perforate (Piercing amount sp int ep) cr = over (crState . crSpState . piercedPoints) - ((:) $ int -.- _crPos cr) cr - perforate _ cr = cr - applyFuseDamage cr = over crHP (\hp -> hp - length (_piercedPoints - $ _crSpState $ _crState cr)) - cr - hiss | poss == [] = id - | otherwise = soundMultiFrom [BarrelHiss 0,BarrelHiss 1] 41 50 1 - stopSounds = stopSoundFrom (BarrelHiss 0) . stopSoundFrom (BarrelHiss 1) - -damToExpBarrel :: [DamageType] -> Creature -> Creature -damToExpBarrel ds cr = foldr damToExpBarrel' (foldr damToExpBarrel' cr pierceDam) otherDam - where (pierceDam,otherDam) = partition isPierce ds - isPierce (Piercing {}) = True - isPierce _ = False - -damToExpBarrel' :: DamageType -> Creature -> Creature -damToExpBarrel' (Piercing amount sp int ep) cr - = over (crState . crSpState . piercedPoints) ((:) $ int -.- _crPos cr) - $ over crHP (\hp -> hp - div amount 200) cr -damToExpBarrel' (PoisonDam {}) cr = cr -damToExpBarrel' (SparkDam {}) cr = cr -damToExpBarrel' (PushDam {_dmPushBack = v}) cr = cr Control.Lens.& crPos %~ (+.+) (1 / _crMass cr *.* v) -damToExpBarrel' dt cr = cr Control.Lens.& crHP -~ _dmAmount dt diff --git a/src/Dodge/Item/Weapon.hs b/src/Dodge/Item/Weapon.hs index 5284e8e57..68c7b3069 100644 --- a/src/Dodge/Item/Weapon.hs +++ b/src/Dodge/Item/Weapon.hs @@ -1755,7 +1755,8 @@ mvBlip :: Point2 -> Color -> Int -> Int -> World -> Particle' -> (World, Maybe P mvBlip p col maxt 0 w pt = (w, Nothing) mvBlip p col maxt t w pt = (w, Just $ pt & ptUpdate' .~ mvBlip p col maxt (t-1) - & ptDraw .~ (const $ onLayerL [levLayer ShadowLayer, 2] + & ptDraw .~ (const . setDepth (-0.5) + . setLayer 1 $ uncurry translate p $ color (withAlpha (fromIntegral t / fromIntegral maxt) col) $ circleSolid 2) @@ -1773,7 +1774,7 @@ mvSonar x p w pt = (w, Just $ pt {_ptDraw = const pic ,_ptUpdate' = mvSonar (x-1) p } ) - where pic = onLayerL [levLayer ShadowLayer, 2] $ pictures + where pic = setDepth (-0.5) . setLayer 1 $ pictures -- $ sweepPics ++ crBlips -- ++ wallBlips crBlips = mapMaybe crBlip $ IM.elems $ _creatures w @@ -1866,7 +1867,7 @@ autoSonarEffect = ItInvEffect {_itInvEffect = f 50 } where f 0 cr i w = aSonarPulse (_crID cr) w & creatures . ix (_crID cr) . crInv . ix i - . itEffect . itInvEffect .~ f 40 + . itEffect . itInvEffect .~ f 140 f t cr i w = w & creatures . ix (_crID cr) . crInv . ix i . itEffect . itInvEffect .~ f (t-1) diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index 4044618ed..a1aa75b4a 100644 --- a/src/Dodge/Update.hs +++ b/src/Dodge/Update.hs @@ -100,9 +100,8 @@ updateParticles' w = updateCreatures :: World -> World updateCreatures w = f $ set randGen newG $ set creatures (IM.mapMaybe id crs) w where - ((f,newG),crs) = IM.mapAccum (\g' cr -> _crUpdate cr w g' (setOldPos cr)) (id,_randGen w) + ((f,newG),crs) = IM.mapAccum (\g' cr -> _crUpdate cr w g' cr) (id,_randGen w) $ _creatures w - setOldPos cr = cr & crOldPos .~ _crPos cr wallEvents :: World -> World