Fix minigun

2022-07-18 11:20:29 +01:00
parent ce36aa8295
commit 13f2255ba7
5 changed files with 41 additions and 79 deletions
@@ -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

@@ -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
@@ -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 
@@ -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)
@@ -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