From f05381be47a69e8c2a825b38769f4b327935d1c9 Mon Sep 17 00:00:00 2001 From: jgk Date: Wed, 26 May 2021 03:35:30 +0200 Subject: [PATCH] Refactor shell movement, modularised in a tweakable way --- src/Dodge/Creature.hs | 1 + src/Dodge/Data.hs | 4 + src/Dodge/Default/Shell.hs | 2 + src/Dodge/Default/Weapon.hs | 6 ++ src/Dodge/Item/Weapon.hs | 55 +---------- src/Dodge/Item/Weapon/Bezier.hs | 57 ++++++++++++ src/Dodge/Item/Weapon/ExtraEffect.hs | 6 +- src/Dodge/Item/Weapon/Launcher.hs | 131 ++++++++++++++++----------- src/Dodge/Item/Weapon/Targeting.hs | 20 ++++ 9 files changed, 170 insertions(+), 112 deletions(-) create mode 100644 src/Dodge/Item/Weapon/Bezier.hs create mode 100644 src/Dodge/Item/Weapon/Targeting.hs diff --git a/src/Dodge/Creature.hs b/src/Dodge/Creature.hs index 63ca01bf8..36279d8f5 100644 --- a/src/Dodge/Creature.hs +++ b/src/Dodge/Creature.hs @@ -30,6 +30,7 @@ import Dodge.Data import Dodge.Default import Dodge.Item.Weapon import Dodge.Item.Weapon.Launcher +import Dodge.Item.Weapon.Bezier import Dodge.Item.Equipment import Dodge.Item.Consumable import Dodge.WorldEvent.Cloud diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 2501c539b..34e9f794c 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -390,6 +390,8 @@ data Ammo = ShellAmmo { _amPayload :: Point2 -> World -> World , _amString :: String + , _amPjMove :: Item -> Creature -> [Projectile -> World -> World] + , _amPjDraw :: Projectile -> Picture } | BulletAmmo { _amString :: String @@ -408,12 +410,14 @@ data Projectile { _pjPos :: Point2 , _pjStartPos :: Point2 , _pjVel :: Point2 + , _pjAcc :: Point2 , _pjDir :: Float , _pjSpin :: Float , _pjDraw :: Projectile -> Picture , _pjID :: Int , _pjUpdate :: Projectile -> World -> World , _pjPayload :: Point2 -> World -> World + , _pjTimer :: Int } | LinearShockwave { _pjDraw :: Projectile -> Picture diff --git a/src/Dodge/Default/Shell.hs b/src/Dodge/Default/Shell.hs index 76ae12dd1..98def6d00 100644 --- a/src/Dodge/Default/Shell.hs +++ b/src/Dodge/Default/Shell.hs @@ -8,10 +8,12 @@ defaultShell = Shell { _pjPos = (0,0) , _pjStartPos = (0,0) , _pjVel = (0,0) + , _pjAcc = (0,0) , _pjDir = 0 , _pjSpin = 0 , _pjDraw = \_ -> blank , _pjID = 0 + , _pjTimer = 0 , _pjUpdate = \_ -> id , _pjPayload = \_ -> id } diff --git a/src/Dodge/Default/Weapon.hs b/src/Dodge/Default/Weapon.hs index 45ee059e3..b3d105332 100644 --- a/src/Dodge/Default/Weapon.hs +++ b/src/Dodge/Default/Weapon.hs @@ -37,3 +37,9 @@ defaultGun = Weapon , _itTargeting = Nothing , _itWorldTrigger = Nothing } +defaultAutoGun :: Item +defaultAutoGun = defaultGun + { _itScrollUp = const id + , _itScrollDown = const id + , _itInvDisplay = basicWeaponDisplay + } diff --git a/src/Dodge/Item/Weapon.hs b/src/Dodge/Item/Weapon.hs index b8b108d84..3a875412d 100644 --- a/src/Dodge/Item/Weapon.hs +++ b/src/Dodge/Item/Weapon.hs @@ -13,8 +13,6 @@ import Dodge.Default --import Dodge.Default.Shell import Dodge.Item.Draw import Dodge.Particle.Bullet.HitEffect -import Dodge.Particle.Bullet.Spawn ---import Dodge.Item.Weapon.Decoration import Dodge.Item.Weapon.InventoryDisplay import Dodge.Item.Weapon.TriggerType import Dodge.Item.Weapon.ExtraEffect @@ -83,12 +81,6 @@ pistol = Weapon , _itTargeting = Nothing , _itWorldTrigger = Nothing } -defaultAutoGun :: Item -defaultAutoGun = autoGun - { _itScrollUp = const id - , _itScrollDown = const id - , _itInvDisplay = basicWeaponDisplay - } effectGun :: String -> (Creature -> World -> World) -> Item effectGun name eff = defaultGun { _itName = name ++ "Gun" @@ -161,7 +153,7 @@ rezGun = defaultGun ] } teslaGun :: Item -teslaGun = defaultAutoGun +teslaGun = defaultGun { _itName = "TESLA" , _itIdentity = TeslaGun , _wpMaxAmmo = 200 @@ -261,52 +253,7 @@ tractorGun = defaultAutoGun , _itAimingRange = 0.5 , _itEquipPict = pictureWeaponOnAim $ color blue $ pictures [polygon $ rectNESW 1.5 6 (-1.5) 0 ] } -useTargetPos - :: (Maybe Point2 -> Creature -> World -> World) - -> Creature - -> World - -> World -useTargetPos f cr w = case cr ^? crInv . ix (_crInvSel cr) . itTargeting . _Just of - Nothing -> w - Just (g,_) -> f (g w) cr w -bezierGun :: Item -bezierGun = defaultAutoGun - { _itName = "B-GUN" - , _itUse = \_ -> useTargetPos $ \p -> - shootWithSound 0 - . withMuzFlare - . withRecoil 40 - . torqueBefore 0.05 -- I believe that this doesn't affect - $ shootBezier $ fromJust p -- <- the start point - , _itAttachment = Nothing - , _itScrollUp = removeItAttachment 0 - , _itScrollDown = removeItAttachment 0 - , _itHammer = HammerUp - , _itEffect = rbSetTarget - , _itZoom = defaultItZoom - , _itAimingRange = 0 - } - -shootBezier :: Point2 -> Creature -> World -> World -shootBezier targetp cr w = w & particles %~ (theBullet :) - where - theBullet = aCurveBulAt - (Just cid) - white - startp - (controlp +.+ randPos) - (targetp +.+ randPos') - (destroyOnImpact bulHitCr bulHitWall' bulHitFF') - 5 - controlp = mouseWorldPos w - cid = _crID cr - dir = _crDir cr - startp = _crPos cr +.+ rotateV dir (_crRad cr + 1,0) - (randPos,randPos') = flip evalState (_randGen w) $ do - a <- randInCirc 10 - b <- randInCirc 20 - return (a,b) removeItAttachment :: Int -> Int -> World -> World removeItAttachment i _ w = w & creatures . ix i . crInv . ix itRef . itAttachment .~ Nothing diff --git a/src/Dodge/Item/Weapon/Bezier.hs b/src/Dodge/Item/Weapon/Bezier.hs new file mode 100644 index 000000000..48ea4fb01 --- /dev/null +++ b/src/Dodge/Item/Weapon/Bezier.hs @@ -0,0 +1,57 @@ +module Dodge.Item.Weapon.Bezier + where +import Dodge.Data +import Dodge.Base +import Dodge.Default.Weapon +import Dodge.Item.Weapon.Targeting +import Dodge.Item.Weapon.TriggerType +import Dodge.Item.Weapon.ExtraEffect +import Dodge.Default +import Dodge.Particle.Bullet.Spawn +import Dodge.Particle.Bullet.HitEffect +import Dodge.WorldEvent.HitEffect +import Dodge.RandomHelp +import Picture +import Geometry + +--import System.Random +import Data.Maybe +import Control.Lens +import Control.Monad.State +bezierGun :: Item +bezierGun = defaultGun + { _itName = "B-GUN" + , _itUse = \_ -> useTargetPos $ \p -> + shootWithSound 0 + . withMuzFlare + . withRecoil 40 + . torqueBefore 0.05 -- I believe that this doesn't affect + $ shootBezier $ fromJust p -- <- the start point + , _itAttachment = Nothing + , _itScrollUp = removeItTarget 0 + , _itScrollDown = removeItTarget 0 + , _itHammer = HammerUp + , _itEffect = rbSetTarget + , _itZoom = defaultItZoom + , _itAimingRange = 0 + } + +shootBezier :: Point2 -> Creature -> World -> World +shootBezier targetp cr w = w & particles %~ (theBullet :) + where + theBullet = aCurveBulAt + (Just cid) + white + startp + (controlp +.+ randPos) + (targetp +.+ randPos') + (destroyOnImpact bulHitCr bulHitWall' bulHitFF') + 5 + controlp = mouseWorldPos w + cid = _crID cr + dir = _crDir cr + startp = _crPos cr +.+ rotateV dir (_crRad cr + 1,0) + (randPos,randPos') = flip evalState (_randGen w) $ do + a <- randInCirc 10 + b <- randInCirc 20 + return (a,b) diff --git a/src/Dodge/Item/Weapon/ExtraEffect.hs b/src/Dodge/Item/Weapon/ExtraEffect.hs index 44c9bb7a1..b66357422 100644 --- a/src/Dodge/Item/Weapon/ExtraEffect.hs +++ b/src/Dodge/Item/Weapon/ExtraEffect.hs @@ -111,13 +111,13 @@ rbSetTarget = ItInvEffect | _crInvSel cr /= invid = w | SDL.ButtonRight `S.member` _mouseButtons w = w & creatures . ix (_crID cr) . crInv . ix invid . itTargeting - %~ maybe (Just $ targetCurrentMousePos w) Just + %~ maybe (Just $ targetRBMousePos w) Just | otherwise = w & creatures . ix (_crID cr) . crInv . ix invid . itTargeting .~ Nothing -targetCurrentMousePos +targetRBMousePos :: World -> (World -> Maybe Point2, Int -> Item -> Creature -> World -> Picture) -targetCurrentMousePos w = (f, \_ _ _ w' -> cursorPic w') +targetRBMousePos w = (f, \_ _ _ w' -> cursorPic w') where f _ = Just mwp mwp = mouseWorldPos w diff --git a/src/Dodge/Item/Weapon/Launcher.hs b/src/Dodge/Item/Weapon/Launcher.hs index fca3416b3..8ccf6fc71 100644 --- a/src/Dodge/Item/Weapon/Launcher.hs +++ b/src/Dodge/Item/Weapon/Launcher.hs @@ -45,8 +45,17 @@ launcher = defaultGun , _wpAmmo = ShellAmmo { _amPayload = makeExplosionAt , _amString = "" + , _amPjMove = basicAmPjMoves + , _amPjDraw = shellPic } } + +basicAmPjMoves :: Item -> Creature -> [Projectile -> World -> World] +basicAmPjMoves _ cr = + [reduceSpinBy 0.995 + ,pjEffAtTime 35 $ trySpinByCID (_crID cr) + ] + flameLauncher :: Item flameLauncher = launcher & wpAmmo . amPayload .~ makeFlameExplosionAt poisonLauncher :: Item @@ -61,93 +70,105 @@ aRocketWithItemParams -> World aRocketWithItemParams it cr w = over projectiles (IM.insert i theShell) w where - pl = _amPayload $ _wpAmmo it - cid = _crID cr + am = _wpAmmo it i = IM.newKey $ _projectiles w pos = _crPos cr +.+ ((_crRad cr +1) *.* unitVectorAtAngle dir) dir = _crDir cr - theShell = makeShellAt pl i cid pos dir - -makeShellAt - :: (Point2 -> World -> World) - -- ^ Payload - -> Int -- ^ Projectile id - -> Int -- ^ Creature id - -> Point2 -- ^ Start position - -> Float -- ^ Direction - -> Projectile -makeShellAt pl i cid pos dir = defaultShell - { _pjPos = pos - , _pjStartPos = pos - , _pjVel = rotateV dir (1,0) - , _pjDraw = \_ -> blank - , _pjID = i - , _pjUpdate = \_ -> moveShell 50 i cid 0 (rotateV dir (3,0)) - , _pjPayload = pl - } + ammoMvs pj w' = foldr ($ pj) w' (_amPjMove am it cr) + theShell = defaultShell + { _pjPos = pos + , _pjStartPos = pos + , _pjVel = rotateV dir (1,0) + , _pjAcc = rotateV dir (3,0) + , _pjDraw = _amPjDraw am + , _pjID = i + , _pjUpdate = \pj -> ammoMvs pj . decTimMvVel pj . moveShell pj + , _pjPayload = _amPayload am + , _pjTimer = 50 + } moveShell - :: Int -- ^ Timer (frames) - -> Int -- ^ Projectile id - -> Int -- ^ Creature id - -> Float -- ^ Rotation - -> Point2 -- ^ Acceleration - -> World -> World -moveShell time i cid rot accel w + :: Projectile -- ^ Projectile id + -> World + -> World +moveShell pj w | time > 40 = if circOnSomeWall oldPos 4 w then doExplode else w - & projectiles . ix i . pjPos %~ (+.+ vel) - & projectiles . ix i . pjDraw .~ (\_ -> piclow) - & projectiles . ix i . pjUpdate .~ (\_ -> moveShell (time-1) i cid rot (rotateV rot accel)) | isJust thingHit = doExplode - | time == 35 = w - & projectiles . ix i . pjPos %~ (+.+ vel) - & projectiles . ix i . pjDraw .~ (\_ -> pic) - & projectiles . ix i . pjUpdate .~ \_ -> moveShell (time-1) i cid spin accel | time >= 20 = w - & projectiles . ix i . pjPos %~ (+.+ vel) - & projectiles . ix i . pjDraw .~ (\_ -> pic) - & projectiles . ix i . pjUpdate .~ (\_ -> moveShell (time-1) i cid rot' (rotateV rot accel)) | time > -99 = w - & projectiles . ix i . pjPos %~ (+.+ vel) & randGen .~ g - & projectiles . ix i . pjDraw .~ (\_ -> pic) - & projectiles . ix i . pjUpdate .~ (\_ -> moveShell (time-1) i cid rot' (rotateV rot accel)) & projectiles . ix i . pjVel %~ (\v -> accel +.+ frict *.* v) & soundFromPos (ShellSound i) newPos (fromIntegral smokeTrailSound) 1 250 & makeFlameletTimed (oldPos -.- vel) (vel +.+ rotateV (pi+sparkD) accel) Nothing 3 10 & smokeGen | time > -200 = w - & projectiles . ix i . pjPos %~ (+.+ vel) - & projectiles . ix i . pjDraw .~ (\_ -> pic) - & projectiles . ix i . pjUpdate .~ (\_ -> moveShell (time-1) i cid rot' (rotateV rot accel)) | otherwise = doExplode where + time = _pjTimer pj + accel = _pjAcc pj doExplode = w & projectileExplosion oldPos & stopSoundFrom (ShellSound i) & projectiles %~ IM.delete i - pj = _projectiles w IM.! i + i = _pjID pj oldPos = _pjPos pj vel = _pjVel pj projectileExplosion = _pjPayload pj newPos = oldPos +.+ vel (frict,g) = randomR (0.6,0.9) $ _randGen w (sparkD,_) = randomR (-0.2,0.2) $ _randGen w - dir = argV vel - pic = onLayer PtLayer $ uncurry translate newPos $ rotate (argV accel) shellPic - piclow = onLayerL [levLayer CrLayer - 2] - $ uncurry translate newPos $ rotate (argV accel) shellPic hitCr = fst <$> collideCircCrsPoint oldPos newPos 4 w hitWl = fst <$> collideCircWalls' oldPos newPos 2 (wallsNearPoint newPos w) thingHit = hitCr <|> hitWl - spin = case w ^? creatures . ix cid of - Just cr -> negate $ min 0.2 $ max (-0.2) $ normalizeAnglePi (dir - _crDir cr) / 20 - _ -> 0 r1 = randInCirc 10 & evalState $ _randGen w smokeGen = makeSmokeCloudAt (oldPos +.+ r1 +.+ 30 *.* normalizeV (oldPos -.- newPos)) - rot' = rot * 0.995 -shellPic :: Picture -shellPic = color black $ polygon [(-6,4),(-6,-4),(6,-4),(8,0),(6,4)] +reduceSpinBy :: Float -> Projectile -> World -> World +reduceSpinBy x pj = projectiles . ix (_pjID pj) . pjSpin *~ x + +shellPic :: Projectile -> Picture +shellPic pj + | t > 40 = onLayerL [levLayer CrLayer - 2] + $ uncurry translate pos $ rotate (argV accel) basePic + | otherwise = onLayer PtLayer $ uncurry translate pos $ rotate (argV accel) basePic + where + basePic = color black $ polygon [(-6,4),(-6,-4),(6,-4),(8,0),(6,4)] + accel = _pjAcc pj + pos = _pjPos pj + t = _pjTimer pj + +decTimMvVel :: Projectile -> World -> World +decTimMvVel pj = projectiles . ix pjid %~ + ( (pjTimer -~ 1) + . (pjPos %~ (+.+ vel) ) + . (pjAcc %~ rotateV rot ) + ) + where + rot = _pjSpin pj + vel = _pjVel pj + pjid = _pjID pj + +pjEffAtTime + :: Int + -> (Projectile -> World -> World) + -> Projectile + -> World + -> World +pjEffAtTime t f pj + | _pjTimer pj == t = f pj + | otherwise = id + +trySpinByCID + :: Int -- ^ creature id + -> Projectile + -> World + -> World +trySpinByCID cid pj w = w & projectiles . ix pjid . pjSpin .~ newSpin + where + pjid = _pjID pj + dir = argV $ _pjVel pj + newSpin = case w ^? creatures . ix cid of + Just cr -> negate $ min 0.2 $ max (-0.2) $ normalizeAnglePi (dir - _crDir cr) / 20 + _ -> 0 diff --git a/src/Dodge/Item/Weapon/Targeting.hs b/src/Dodge/Item/Weapon/Targeting.hs new file mode 100644 index 000000000..aaae9aa5a --- /dev/null +++ b/src/Dodge/Item/Weapon/Targeting.hs @@ -0,0 +1,20 @@ +module Dodge.Item.Weapon.Targeting + where +import Dodge.Data + +import Control.Lens +import qualified Data.IntMap.Strict as IM +useTargetPos + :: (Maybe Point2 -> Creature -> World -> World) + -> Creature + -> World + -> World +useTargetPos f cr w = case cr ^? crInv . ix (_crInvSel cr) . itTargeting . _Just of + Nothing -> w + Just (g,_) -> f (g w) cr w + +removeItTarget :: Int -> Int -> World -> World +removeItTarget i _ w = w & creatures . ix i . crInv . ix itRef . itTargeting .~ Nothing + where + cr = _creatures w IM.! i + itRef = _crInvSel cr