From 13f2255ba7153581201d19db50497739e78392e8 Mon Sep 17 00:00:00 2001 From: justin Date: Mon, 18 Jul 2022 11:20:29 +0100 Subject: [PATCH] Fix minigun --- src/Dodge/Bullet.hs | 77 ++++++------------------- src/Dodge/Default/Weapon.hs | 2 +- src/Dodge/Item/Weapon/BulletGun/Cane.hs | 27 ++++----- src/Dodge/Item/Weapon/TriggerType.hs | 8 +++ src/Geometry.hs | 6 +- 5 files changed, 41 insertions(+), 79 deletions(-) diff --git a/src/Dodge/Bullet.hs b/src/Dodge/Bullet.hs index ab394b610..7fd162315 100644 --- a/src/Dodge/Bullet.hs +++ b/src/Dodge/Bullet.hs @@ -23,21 +23,17 @@ import System.Random updateBullet :: World -> Bullet -> (World,Maybe Bullet) updateBullet w bu = case _buState bu of DyingBulletState -> (w,Nothing) - DelayedBullet x -> mvBulletSlow x w bu - _ -> mvBullet w bu + DelayedBullet x -> mvBullet x w bu + _ -> mvBullet 1 w bu -useAmmoParams :: Maybe Float -> Item -> Creature -> World -> World -useAmmoParams vfact it cr w = w & instantBullets .:~ (_amBullet bultype +useAmmoParams :: Item -> Creature -> World -> World +useAmmoParams it cr w = w & instantBullets .:~ (_amBullet bultype & buPos .~ sp & buTrajectory %~ settrajectory & buVel %~ (rotateV dir . (muzvel *.*)) & buDrag *~ _rifling (_itParams it) - & buState %~ setstate ) where - setstate = case vfact of - Nothing -> id - Just x -> const $ DelayedBullet x sp = _crPos cr +.+ (muzlength + 10) *.* unitVectorAtAngle dir dir = _crDir cr bultype = _laAmmoType $ _itConsumption it @@ -56,8 +52,8 @@ useAmmoParams vfact it cr w = w & instantBullets .:~ (_amBullet bultype return $ BezierTrajectory sp tpos (mouseWorldPos w) {- Update for a generic bullet. -} -mvBullet :: World -> Bullet -> (World, Maybe Bullet) -mvBullet w bt' +mvBullet :: Float -> World -> Bullet -> (World, Maybe Bullet) +mvBullet x w bt' | t <= 0 || magV (_buVel bt) < 1 = (w,Nothing) | otherwise = bimap (maybespawn . maybebounce) (fmap dodrag) $ hiteff bt hitstream w @@ -73,37 +69,14 @@ mvBullet w bt' (hp,crwl) <- runIdentity (S.head_ hitstream) dir <- bounceDir (hp,crwl) return $ instantBullets .:~ (bt - & buPos .~ hp +.+ (normalizeV (_buPos bt' -.- hp)) + & buPos .~ hp +.+ normalizeV (_buPos bt' -.- hp) & buVel %~ reflectIn dir & buTrajectory .~ BasicBulletTrajectory & buTimer -~ 1 ) - --maybebounce = case _buEffect bt' of - -- BounceBullet -> case runIdentity (S.head_ hitstream) of - -- Just (hp, Left cr) | crIsArmouredFrom hp cr -> instantBullets .:~ bouncer - -- where - -- bouncer = bt - -- & buPos .~ pOut - -- & buVel .~ reflectVel - -- & buTrajectory .~ BasicBulletTrajectory - -- & buTimer -~ 1 - -- pOut = hp +.+ 2 *.* newDir - -- reflectVel = reflectIn newDir bulVel --magV bulVel *.* newDir - -- newDir = squashNormalizeV (hp -.- _crPos cr) - -- bulVel = _buVel bt - -- Just (hp, Right wl) -> instantBullets .:~ bouncer - -- where - -- reflectVel = reflVelWall wl (_buVel bt) - -- bouncer = bt - -- & buPos .~ pOut - -- & buVel .~ reflectVel - -- & buTrajectory .~ BasicBulletTrajectory - -- & buTimer -~ 1 - -- pOut = hp +.+ squashNormalizeV (p -.- hp) - -- _ -> id - -- _ -> id hitstream = thingsHit p (p +.+ vel) w - bt = foldr (\mg b -> _mgField mg mg b) bt' $ _magnets w + bt = (foldr (\mg b -> _mgField mg mg b) bt' $ _magnets w) + & buState .~ NormalBulletState dodrag = case _buTrajectory bt of BasicBulletTrajectory -> buVel .*.*~ drag MagnetTrajectory tpos -> buVel .+.+~ 5 *.* normalizeV (tpos -.- _buPos bt) @@ -114,7 +87,7 @@ mvBullet w bt' drag = _buDrag bt p = _buPos bt vel = _buVel bt - hiteff = hitEffFromBul + hiteff = hitEffFromBul x t = _buTimer bt bounceDir :: (Point2, Either Creature Wall) -> Maybe Point2 @@ -129,42 +102,28 @@ bulletSpawn bu = case _buSpawn bu of BulBall ConcBall -> Just concBall BulBall TeslaBall -> Just aStaticBall -hitEffFromBul :: Bullet +hitEffFromBul :: Float -> Bullet -> Stream (Of (Point2, Either Creature Wall)) Identity () -> World -> (World,Maybe Bullet) -hitEffFromBul = expireAndDamage' setfromtodams +hitEffFromBul x = expireAndDamage' x setfromtodams where setfromtodams bu p = map f (_buDamages bu) where f = (dmFrom .~ _buPos bu) . (dmAt .~ p) . (dmTo .~ _buPos bu +.+ _buVel bu) -mvBulletSlow :: Float -> World -> Bullet -> (World, Maybe Bullet) -mvBulletSlow x w bt' - | t <= 0 || magV (_buVel bt) < 1 = (w,Nothing) - | otherwise = second (fmap dodrag) $ - hiteff bt (thingsHit p (p +.+ vel) w) w - where - bt = foldr (\mg b -> _mgField mg mg b) bt' $ _magnets w - dodrag = (buVel .*.*~ drag) - . (buState .~ NormalBulletState) - drag = _buDrag bt - p = _buPos bt - vel = x *.* _buVel bt - hiteff = hitEffFromBul - t = _buTimer bt -expireAndDamage' :: (Bullet -> Point2 -> [Damage]) +expireAndDamage' :: Float -> (Bullet -> Point2 -> [Damage]) -> Bullet -> Stream (Of (Point2, Either Creature Wall)) Identity () -> World -> (World, Maybe Bullet) -expireAndDamage' fdm bt things w = case runIdentity $ S.head_ things of - Nothing -> (w, moveBullet bt) +expireAndDamage' y fdm bt things w = case runIdentity $ S.head_ things of + Nothing -> (w, moveBullet y bt) Just x -> (doDamages' fdm x bt w, destroyAt' (fst x) bt) -moveBullet :: Bullet -> Maybe Bullet -moveBullet pt = Just $ pt - & buPos %~ (+.+ _buVel pt) +moveBullet :: Float -> Bullet -> Maybe Bullet +moveBullet x pt = Just $ pt + & buPos %~ (+.+ x *.* _buVel pt) & buOldPos .~ _buPos pt & buTimer -~ 1 diff --git a/src/Dodge/Default/Weapon.hs b/src/Dodge/Default/Weapon.hs index 7bb16a10e..abe8c4d86 100644 --- a/src/Dodge/Default/Weapon.hs +++ b/src/Dodge/Default/Weapon.hs @@ -109,7 +109,7 @@ defaultWeapon = defaultItem defaultBulletWeapon :: Item defaultBulletWeapon = defaultWeapon & itConsumption .~ defaultBulletLoadable - & itUse . rUse .~ useAmmoParams Nothing + & itUse . rUse .~ useAmmoParams defaultItemValue :: ItemValue defaultItemValue = ItemValue 10 MundaneItem diff --git a/src/Dodge/Item/Weapon/BulletGun/Cane.hs b/src/Dodge/Item/Weapon/BulletGun/Cane.hs index f05e8a650..b7b477c82 100644 --- a/src/Dodge/Item/Weapon/BulletGun/Cane.hs +++ b/src/Dodge/Item/Weapon/BulletGun/Cane.hs @@ -176,7 +176,7 @@ burstRifle = repeater -- ] miniGunUse :: Int -> ItemUse miniGunUse i = defaultrUse - & rUse .~ useAmmoParams (Just 1) + & rUse .~ useAmmoParams & useDelay .~ NoDelay & useMods .~ [ ammoCheckI @@ -186,23 +186,18 @@ miniGunUse i = defaultrUse , withSmoke 1 black 20 200 5 , withMuzFlareI , useAmmoAmount i + , withSidePushI (y * 50) + , torqueBefore (y * 0.05) + , afterRecoil (y * 5) ] <> - concat [ - [ withSidePushI 50 - , torqueBefore 0.05 - , afterRecoil recoilAmount - , withRandomOffset - , withOldDir x - , trigDoAlso (useAmmoParams $ Just x) - ] | x <- map ((/fromIntegral i) . fromIntegral) [1..i-1] - ] - <> - [ withSidePushI 50 - , afterRecoil recoilAmount - , withRandomOffset - ] + [ trigDoAlso' (moddelay x) (modcrpos x) useAmmoParams + | x <- map ((/fromIntegral i) . fromIntegral) [1..i-1] + ] where - recoilAmount = 5 + y = fromIntegral i + moddelay x = itConsumption . laAmmoType . amBullet . buState .~ DelayedBullet x + modcrpos x cr = cr & crDir %~ tweenAngles x (_crOldDir cr) + & crPos %~ tweenPoints x (_crOldPos cr) miniGunX :: Int -> Item miniGunX i = defaultAutoGun diff --git a/src/Dodge/Item/Weapon/TriggerType.hs b/src/Dodge/Item/Weapon/TriggerType.hs index 7cc7804e0..396b3e5ad 100644 --- a/src/Dodge/Item/Weapon/TriggerType.hs +++ b/src/Dodge/Item/Weapon/TriggerType.hs @@ -12,6 +12,7 @@ module Dodge.Item.Weapon.TriggerType , crAtMuzPos , withOldDir , trigDoAlso + , trigDoAlso' , withTempLight , withItem , withItemUpdate @@ -96,6 +97,13 @@ lockInvFor :: Int -> ChainEffect lockInvFor i f it cr = f it cr . (delayedEvents .:~ (i, unlockInv (_crID cr))) . lockInv (_crID cr) +trigDoAlso' + :: (Item -> Item) + -> (Creature -> Creature) + -> (Item -> Creature -> World -> World) + -> ChainEffect +trigDoAlso' fit fcr f g itm cr = g itm cr . f (fit itm) (fcr cr) + -- Note that this uses the "base" creature and item values trigDoAlso :: (Item -> Creature -> World -> World) diff --git a/src/Geometry.hs b/src/Geometry.hs index b6e2e7bec..35a2247e3 100644 --- a/src/Geometry.hs +++ b/src/Geometry.hs @@ -38,6 +38,9 @@ alongSegBy :: Float -> Point2 -> Point2 -> Point2 alongSegBy !x !a !b = a +.+ y *.* normalizeV (b -.- a) where y = min x $ dist a b + +tweenPoints :: Float -> Point2 -> Point2 -> Point2 +tweenPoints = alongSegBy -- | Debug version of 'pointInPolygon'. errorPointInPolygon :: Int -> Point2 -> [Point2] -> Bool errorPointInPolygon !i !p xs @@ -115,9 +118,6 @@ difference x y reflectIn :: Point2 -> Point2 -> Point2 reflectIn line vec = rotateV (2 * angleBetween line vec) vec -reflectIn' :: Point2 -> Point2 -> Point2 -reflectIn' line vec = rotateV (2 * angleBetween vec line) vec - -- | Find angle between two points. -- Not normalised, ranges from -2*pi to 2*pi. angleBetween :: Point2 -> Point2 -> Float