From fb17502781ae21ea5da9d40fca34a67a62c7f4c6 Mon Sep 17 00:00:00 2001 From: Ross Date: Fri, 26 Mar 2021 14:20:13 +0000 Subject: [PATCH 1/2] Allow modifiable speed changes --- src/Dodge/AIs.hs | 4 ++-- src/Dodge/Data.hs | 2 ++ src/Dodge/Default.hs | 2 ++ src/Dodge/Event/Keyboard.hs | 2 ++ 4 files changed, 8 insertions(+), 2 deletions(-) diff --git a/src/Dodge/AIs.hs b/src/Dodge/AIs.hs index 086c7cc26..b6fa76d60 100644 --- a/src/Dodge/AIs.hs +++ b/src/Dodge/AIs.hs @@ -1878,8 +1878,8 @@ 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 = 8 * equipFactor * (fromMaybe 1 $ yourItem w ^? itAimingSpeed) - speed = 3 * equipFactor + where strafeSpeed = _varMovementStrafeSpeedModifier 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 diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index d75953019..4df0c71f9 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -88,6 +88,8 @@ data World = World , _seenLocations :: IM.IntMap (World -> Point2,String) , _selLocation :: Int , _keyConfig :: KeyConfigSDL + , _varMovementSpeedModifier :: Float + , _varMovementStrafeSpeedModifier :: Float } data Corpse = Corpse diff --git a/src/Dodge/Default.hs b/src/Dodge/Default.hs index 5f99c6e0e..e289fb33d 100644 --- a/src/Dodge/Default.hs +++ b/src/Dodge/Default.hs @@ -232,6 +232,8 @@ defaultWorld = World ] , _selLocation = 0 , _keyConfig = defaultKeyConfigSDL + , _varMovementSpeedModifier = 3 + , _varMovementStrafeSpeedModifier = 3 } youLight = -- LS {_lsEff = \w _ p -> (logistic 1 1 1 (d p w * 0.01) ) diff --git a/src/Dodge/Event/Keyboard.hs b/src/Dodge/Event/Keyboard.hs index 4d19b0ec9..b3018ad97 100644 --- a/src/Dodge/Event/Keyboard.hs +++ b/src/Dodge/Event/Keyboard.hs @@ -34,6 +34,8 @@ handlePressedKey _ scancode w -- Rotation seems to be duplicated here and in Camera.hs ? why | scancode == rotateCameraPlusKey (_keyConfig w) = Just $ w {_cameraRot = _cameraRot w + 0.01} | scancode == rotateCameraMinusKey (_keyConfig w) = Just $ w {_cameraRot = _cameraRot w - 0.01} + | scancode == ScancodeF7 = Just $ w {_varMovementSpeedModifier = _varMovementSpeedModifier w - 1} + | scancode == ScancodeF8 = Just $ w {_varMovementSpeedModifier = _varMovementSpeedModifier w + 1} handlePressedKey _ _ w = Just w From 881359c4ac67400f0ddcf77b0dc4fd026a3e2e77 Mon Sep 17 00:00:00 2001 From: Ross Date: Sat, 27 Mar 2021 12:56:27 +0000 Subject: [PATCH 2/2] Refactor grenades and rockets to allow different explosions --- src/Dodge/Critters.hs | 2 +- src/Dodge/Data.hs | 8 ++ src/Dodge/Item/Weapon.hs | 212 ++++++++++++++++++++++++++++++++++++--- 3 files changed, 207 insertions(+), 15 deletions(-) diff --git a/src/Dodge/Critters.hs b/src/Dodge/Critters.hs index c1b56821b..b6b24d957 100644 --- a/src/Dodge/Critters.hs +++ b/src/Dodge/Critters.hs @@ -350,7 +350,7 @@ startCr = defaultCreature , _crHP = 10000 , _crMaxHP = 1500 , _crInv = IM.fromList (zip [0..20] - ([pistol,autoGun,launcher,lasGun,grenade + ([pistol,flameGrenade, teslaGrenade, autoGun,launcher,flameLauncher, poisonLauncher, teslaLauncher, lasGun,grenade ,ltAutoGun,flamer,multGun,spreadGun,remoteLauncher ,longGun ,hvAutoGun diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 4df0c71f9..00c93f049 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -484,6 +484,14 @@ data Projectile = Projectile { _ptPos :: Point2 , _ptID :: Int , _ptUpdate :: World -> World } + | Shell { _ptPos :: Point2 + , _ptStartPos :: Point2 + , _ptVel :: Point2 + , _ptPict :: Picture + , _ptID :: Int + , _ptUpdate :: World -> World + , _ptExplosion :: Point2-> World -> World + } data DamageType = Piercing {_dmAmount :: Int , _dmFrom :: Point2 , _dmAt :: Point2 , _dmTo :: Point2 } | Blunt {_dmAmount :: Int , _dmFrom :: Point2 , _dmAt :: Point2 , _dmTo :: Point2 } diff --git a/src/Dodge/Item/Weapon.hs b/src/Dodge/Item/Weapon.hs index 8f05a6db4..a0f51aa96 100644 --- a/src/Dodge/Item/Weapon.hs +++ b/src/Dodge/Item/Weapon.hs @@ -333,6 +333,21 @@ launcher = defaultGun , _itHammer = NoHammer , _itEffect = NoItEffect } +flameLauncher = launcher + { _itName = "FLROCKO" + , _wpFire = shoot $ aRocket' makeFlameShellAt + } + +poisonLauncher = launcher + { _itName = "POISROCK" + , _wpFire = shoot $ aRocket' makePoisonShellAt + } + +teslaLauncher = launcher + { _itName = "TESLROCK" + , _wpFire = shoot $ aRocket' makeTeslaShellAt + } + bezierGun = defaultAutoGun { _itName = "B-GUN" , _wpFire = maybeSetTarget $ \p -> shootWithSound 0 @@ -697,36 +712,80 @@ aTractorBeam col cid w dir = _crDir cr itRef = _crInvSel cr -aRocket :: Int -> World -> World -aRocket cid w +-- |The aRocket' function allows us to define the shell to be used +aRocket' :: (Int -> Int -> Point2 -> Float -> Projectile) -> Int -> World -> World +aRocket' shell cid w = soundOnce (fromIntegral launcherSound) - $ over projectiles (IM.insert i (makeShellAt i cid pos dir)) w + $ over projectiles (IM.insert i (shell i cid pos dir)) w where i = newProjectileKey w cr = (_creatures w IM.! cid) pos = _crPos cr +.+ ((_crRad cr +1) *.* unitVectorAtAngle dir) dir = _crDir cr +aRocket :: Int -> World -> World +aRocket = aRocket' makeShellAt +-- = soundOnce (fromIntegral launcherSound) +-- $ over projectiles (IM.insert i (makeShellAt i cid pos dir)) w +-- where i = newProjectileKey w +-- cr = (_creatures w IM.! cid) +-- pos = _crPos cr +.+ ((_crRad cr +1) *.* unitVectorAtAngle dir) +-- dir = _crDir cr + makeShellAt :: Int -> Int -> Point2 -> Float -> Projectile -makeShellAt i cid pos dir = Projectile +makeShellAt i cid pos dir = Shell { _ptPos = pos , _ptStartPos = pos , _ptVel = rotateV dir (1,0) , _ptPict = blank -- onLayer PtLayer $ uncurry translate pos $ rotate (radToDeg dir) shellPic , _ptID = i , _ptUpdate = moveShell 50 i cid 0 (rotateV dir (2,0)) + , _ptExplosion = shellExplosionAt + } + +makeFlameShellAt :: Int -> Int -> Point2 -> Float -> Projectile +makeFlameShellAt i cid pos dir = Shell + { _ptPos = pos + , _ptStartPos = pos + , _ptVel = rotateV dir (1,0) + , _ptPict = blank -- onLayer PtLayer $ uncurry translate pos $ rotate (radToDeg dir) shellPic + , _ptID = i + , _ptUpdate = moveShell 50 i cid 0 (rotateV dir (2,0)) + , _ptExplosion = makeFlameExplosionAt + } + +makePoisonShellAt :: Int -> Int -> Point2 -> Float -> Projectile +makePoisonShellAt i cid pos dir = Shell + { _ptPos = pos + , _ptStartPos = pos + , _ptVel = rotateV dir (1,0) + , _ptPict = blank -- onLayer PtLayer $ uncurry translate pos $ rotate (radToDeg dir) shellPic + , _ptID = i + , _ptUpdate = moveShell 50 i cid 0 (rotateV dir (2,0)) + , _ptExplosion = makePoisonExplosionAt + } + +makeTeslaShellAt :: Int -> Int -> Point2 -> Float -> Projectile +makeTeslaShellAt i cid pos dir = Shell + { _ptPos = pos + , _ptStartPos = pos + , _ptVel = rotateV dir (1,0) + , _ptPict = blank -- onLayer PtLayer $ uncurry translate pos $ rotate (radToDeg dir) shellPic + , _ptID = i + , _ptUpdate = moveShell 50 i cid 0 (rotateV dir (2,0)) + , _ptExplosion = makeTeslaExplosionAt } moveShell :: Int -> Int -> Int -> Float -> Point2 -> World -> World moveShell time i cid rot accel w | time > 40 = if circOnSomeWall oldPos 4 w - then shellExplosionAt oldPos $ over projectiles (IM.delete i) w + then projectileExplosion oldPos $ over projectiles (IM.delete i) w else over (projectiles . ix i . ptPos) (+.+ vel) $ set (projectiles . ix i . ptPict) piclow $ set (projectiles . ix i . ptUpdate) (moveShell (time-1) i cid rot (rotateV rot accel)) w | time == 35 = case thingHit of - Just p -> shellExplosionAt oldPos + Just p -> projectileExplosion oldPos $ over projectiles (IM.delete i) w Nothing -> over (projectiles . ix i . ptPos) (+.+ vel) $ set (projectiles . ix i . ptPict) pic @@ -734,7 +793,7 @@ moveShell time i cid rot accel w (moveShell (time-1) i cid spin accel) w | time >= 20 = case thingHit of - Just p -> shellExplosionAt oldPos + Just p -> projectileExplosion oldPos $ over projectiles (IM.delete i) w Nothing -> over (projectiles . ix i . ptPos) (+.+ vel) $ set (projectiles . ix i . ptPict) pic @@ -743,7 +802,7 @@ moveShell time i cid rot accel w w | time > -99 = case thingHit of - Just p -> shellExplosionAt oldPos + Just p -> projectileExplosion oldPos $ stopSoundFrom (ShellSound i) $ over projectiles (IM.delete i) w Nothing -> over (projectiles . ix i . ptPos) (+.+ vel) @@ -758,7 +817,7 @@ moveShell time i cid rot accel w $ smokeGen w | time > -200 = case thingHit of - Just p -> shellExplosionAt oldPos + Just p -> projectileExplosion oldPos $ stopSoundFrom (ShellSound i) $ over projectiles (IM.delete i) w Nothing -> over (projectiles . ix i . ptPos) (+.+ vel) @@ -766,12 +825,13 @@ moveShell time i cid rot accel w $ set (projectiles . ix i . ptUpdate) (moveShell (time-1) i cid rot (rotateV rot accel)) w - | otherwise = shellExplosionAt oldPos + | otherwise = projectileExplosion oldPos $ stopSoundFrom (ShellSound i) $ over projectiles (IM.delete i) w where pt = _projectiles w IM.! i oldPos = _ptPos pt vel = _ptVel pt + projectileExplosion = _ptExplosion pt newPos = oldPos +.+ vel (frict,g) = randomR (0.6,0.9) $ _randGen w (sparkD,_) = randomR (-0.5,0.5) $ _randGen w @@ -870,6 +930,74 @@ aFlame a cid w resetAngle = set (creatures . ix cid . crInv . ix (_crInvSel cr) . wpFire) (shoot $ aFlame angle) +-- The following should be improved.... +makePoisonExplosionAt :: Point2 -> World -> World +makePoisonExplosionAt p w = soundOnce grenadeBang + $ makeGasCloud p (velocities!!1) + $ makeGasCloud p (velocities!!2) + $ makeGasCloud p (velocities!!3) + w + where + xs = randomRs (-2,2) $ _randGen w -- one infinite list of randoms + velocities = zip (take 10 xs) (drop 10 xs) + +makeTeslaExplosionAt :: Point2 -> World -> World +makeTeslaExplosionAt pos w = soundOnce grenadeBang + -- This is obviously the best way.... + $ over projectiles (IM.insert (pks!!1) (makeTeslaArcAt (pks!!1) pos (xs!!1))) + $ over projectiles (IM.insert (pks!!2) (makeTeslaArcAt (pks!!2) pos (xs!!2))) + $ over projectiles (IM.insert (pks!!3) (makeTeslaArcAt (pks!!3) pos (xs!!3))) + $ over projectiles (IM.insert (pks!!4) (makeTeslaArcAt (pks!!4) pos (xs!!4))) + $ over projectiles (IM.insert (pks!!5) (makeTeslaArcAt (pks!!5) pos (xs!!5))) + $ over projectiles (IM.insert (pks!!6) (makeTeslaArcAt (pks!!6) pos (xs!!6))) + $ over projectiles (IM.insert (pks!!7) (makeTeslaArcAt (pks!!7) pos (xs!!7))) + $ over projectiles (IM.insert (pks!!8) (makeTeslaArcAt (pks!!8) pos (xs!!8))) + $ over projectiles (IM.insert (pks!!9) (makeTeslaArcAt (pks!!9) pos (xs!!9))) + $ over projectiles (IM.insert (pks!!10) (makeTeslaArcAt (pks!!10) pos (xs!!10))) + $ over projectiles (IM.insert (pks!!11) (makeTeslaArcAt (pks!!11) pos (xs!!11))) + $ over projectiles (IM.insert (pks!!12) (makeTeslaArcAt (pks!!12) pos (xs!!12))) + $ over projectiles (IM.insert (pks!!13) (makeTeslaArcAt (pks!!13) pos (xs!!13))) + $ over projectiles (IM.insert (pks!!14) (makeTeslaArcAt (pks!!14) pos (xs!!14))) + $ over projectiles (IM.insert (pks!!15) (makeTeslaArcAt (pks!!15) pos (xs!!15))) + $ over projectiles (IM.insert (pks!!16) (makeTeslaArcAt (pks!!16) pos (xs!!16))) + $ over projectiles (IM.insert (pks!!17) (makeTeslaArcAt (pks!!17) pos (xs!!17))) + $ over projectiles (IM.insert (pks!!18) (makeTeslaArcAt (pks!!18) pos (xs!!18))) + $ over projectiles (IM.insert (pks!!19) (makeTeslaArcAt (pks!!19) pos (xs!!19))) + $ over projectiles (IM.insert (pks!!20) (makeTeslaArcAt (pks!!20) pos (xs!!20))) + $ over projectiles (IM.insert (pks!!21) (makeTeslaArcAt (pks!!21) pos (xs!!21))) + $ over projectiles (IM.insert (pks!!22) (makeTeslaArcAt (pks!!22) pos (xs!!22))) + $ over projectiles (IM.insert (pks!!23) (makeTeslaArcAt (pks!!23) pos (xs!!23))) + $ over projectiles (IM.insert (pks!!24) (makeTeslaArcAt (pks!!24) pos (xs!!24))) + $ over projectiles (IM.insert (pks!!25) (makeTeslaArcAt (pks!!25) pos (xs!!25))) + $ over projectiles (IM.insert (pks!!26) (makeTeslaArcAt (pks!!26) pos (xs!!26))) + $ over projectiles (IM.insert (pks!!27) (makeTeslaArcAt (pks!!27) pos (xs!!27))) + $ over projectiles (IM.insert (pks!!28) (makeTeslaArcAt (pks!!28) pos (xs!!28))) + $ over projectiles (IM.insert (pks!!29) (makeTeslaArcAt (pks!!29) pos (xs!!29))) + w + where + -- rad or 360? + xs = randomRs (0,7) $ _randGen w + p = newProjectileKey w + pks = [p..] + +makeFlameExplosionAt :: Point2 -> World -> World +makeFlameExplosionAt p w = soundOnce grenadeBang + $ makeFlame p (velocities!!1) (Just 0) + $ makeFlame p (velocities!!2) (Just 90) + $ makeFlame p (velocities!!3) (Just 180) + $ makeFlame p (velocities!!4) (Just 0) + $ makeFlame p (velocities!!5) (Just 0) + $ makeFlame p (velocities!!6) (Just 0) + $ makeFlame p (velocities!!7) (Just 0) + $ makeFlame p (velocities!!8) (Just 0) + $ makeFlame p (velocities!!9) (Just 0) + $ makeFlame p (velocities!!10) (Just 0) + $ w + where + xs = randomRs (-2,2) $ _randGen w -- one infinite list of randoms + velocities = zip (take 10 xs) (drop 10 xs) + + makeFlame :: Point2 -> Point2 -> Maybe Int -> World -> World makeFlame pos vel maycid = over particles' ((:) theFlame) where theFlame = @@ -961,10 +1089,13 @@ reflect a b = a + 2*(a-b) moveGrenade :: Int -> Float -> Int -> World -> World moveGrenade 0 dir pID w = over projectiles (IM.delete pID) - $ makeExplosionAt (_ptPos (_projectiles w IM.! pID)) + $ explosion (_ptPos (_projectiles w IM.! pID)) -- $ set (pointToItem (_itemPositions w IM.! wpID) . itEquipPict) -- (drawWeapon $ grenadePic 50) w + where + pt = _projectiles w IM.! pID + explosion = _ptExplosion pt moveGrenade time dir pID w = case hitWl of Just _ -> soundOnce (fromIntegral tapQuiet) updatedWorld @@ -1243,6 +1374,25 @@ grenade = Throwable } where fuseTime = 50 f x = 50 / fromIntegral x + + +flameGrenade :: Item +flameGrenade = grenade { + _itName = "FLMGREN " ++ show fuseTime + , _twFire = throwGrenade' makeFlameExplosionAt fuseTime + } + where fuseTime = 50 + f x = 50 / fromIntegral x + +teslaGrenade :: Item +teslaGrenade = grenade { + _itName = "TLSGREN " ++ show fuseTime + , _twFire = throwGrenade' makeTeslaExplosionAt fuseTime + } + where fuseTime = 50 + f x = 50 / fromIntegral x + + increaseFuse :: Int -> Int -> World -> World increaseFuse fuse i w = w & creatures . ix 0 . crInv . ix itRef . itScrollUp .~ decreaseFuse newTime & creatures . ix 0 . crInv . ix itRef . itScrollDown .~ increaseFuse newTime @@ -1282,15 +1432,16 @@ remoteBomb = defaultThrowable } -throwGrenade :: Int -> Int -> World -> World -throwGrenade fuseTime n w = setWp $ removePict $ over projectiles addG $ set randGen g w +throwGrenade' :: (Point2 -> World -> World) -> Int -> Int -> World -> World +throwGrenade' explosion fuseTime n w = setWp $ removePict $ over projectiles addG $ set randGen g w where addG = IM.insert i - $ Projectile { _ptPos = p + $ Shell { _ptPos = p , _ptStartPos = p , _ptVel = v , _ptPict = onLayer PtLayer $ uncurry translate p $ grenadePic 0 , _ptID = i , _ptUpdate = moveGrenade fuseTime dir i + , _ptExplosion = explosion } j = _crInvSel $ _creatures w IM.! n removePict = set (creatures . ix n . crInv . ix j . itEquipPict) $ \ _ _ -> blank @@ -1309,6 +1460,35 @@ throwGrenade fuseTime n w = setWp $ removePict $ over projectiles addG $ set ran setWp :: World -> World setWp w' = w' & creatures . ix n . crInv . ix j . itEffect .~ throwArmReset 20 +throwGrenade :: Int -> Int -> World -> World +throwGrenade = throwGrenade' makeExplosionAt +-- setWp $ removePict $ over projectiles addG $ set randGen g w +-- where addG = IM.insert i +-- $ Shell { _ptPos = p +-- , _ptStartPos = p +-- , _ptVel = v +-- , _ptPict = onLayer PtLayer $ uncurry translate p $ grenadePic 0 +-- , _ptID = i +-- , _ptUpdate = moveGrenade fuseTime dir i +-- , _ptExplosion = makeExplosionAt +-- } +-- j = _crInvSel $ _creatures w IM.! n +-- removePict = set (creatures . ix n . crInv . ix j . itEquipPict) $ \ _ _ -> blank +-- i = newProjectileKey w +-- (a, g) = randomR (-grenadeAccA,grenadeAccA::Float) (_randGen w) +-- (l, _) = randomR (1 - 2*grenadeAccL,1+grenadeAccL::Float) g +-- -- v = 0.02 * l / _cameraZoom w *.* rotateV (a+_cameraRot w) (limitRange $ _mousePos w) +-- v' = 1 / (fromIntegral fuseTime * _cameraZoom w) *.* rotateV (_cameraRot w) ( _mousePos w) +-- v | magV v' > 6 = 6 *.* normalizeV v' +-- | otherwise = v' +-- cr = _creatures w IM.! n +-- p' = _crPos cr +.+ rotateV (_crDir cr) (_crRad cr,0) +-- p | circOnSomeWall p' 4 w = _crPos cr +.+ rotateV (_crDir cr) (_crRad cr-4,0) +-- | otherwise = p' +-- dir = argV v +-- setWp :: World -> World +-- setWp w' = w' & creatures . ix n . crInv . ix j . itEffect .~ throwArmReset 20 + throwArmReset :: Int -> ItEffect throwArmReset x = ItInvEffect {_itInvEffect = f @@ -2059,3 +2239,7 @@ makeLaserScope p ep d relFrac = Particle' ] ,_ptUpdate' = \w pt -> (w, Just $ pt & ptUpdate' .~ \w' _ -> (w',Nothing)) } + + + +