Fix minigun

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
+    DelayedBullet x -> mvBullet x w bu
-    _ -> mvBullet w bu
+    _ -> mvBullet 1 w bu
 
-useAmmoParams :: Maybe Float -> Item -> Creature -> World -> World
+useAmmoParams :: Item -> Creature -> World -> World
-useAmmoParams vfact it cr w = w & instantBullets .:~ (_amBullet bultype
+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 :: Float -> World -> Bullet -> (World, Maybe Bullet)
-mvBullet w bt' 
+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)
+expireAndDamage' :: Float -> (Bullet -> Point2 -> [Damage])
-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])
     -> Bullet
     -> Stream (Of (Point2, Either Creature Wall)) Identity ()
     -> World
     -> (World, Maybe Bullet)
-expireAndDamage' fdm bt things w = case runIdentity $ S.head_ things of
+expireAndDamage' y fdm bt things w = case runIdentity $ S.head_ things of
-    Nothing -> (w, moveBullet bt)
+    Nothing -> (w, moveBullet y bt)
     Just x -> (doDamages' fdm x bt w, destroyAt' (fst x) bt)
 
-moveBullet :: Bullet -> Maybe Bullet
+moveBullet :: Float -> Bullet -> Maybe Bullet
-moveBullet pt = Just $ pt
+moveBullet x pt = Just $ pt
-    & buPos %~ (+.+ _buVel pt)
+    & buPos %~ (+.+ x *.* _buVel pt)
     & buOldPos .~ _buPos pt
     & buTimer -~ 1
 

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

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 [ 
+        [ trigDoAlso' (moddelay x) (modcrpos x) useAmmoParams 
-            [ withSidePushI 50
+            | x <- map ((/fromIntegral i) . fromIntegral) [1..i-1]
-            , 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
         ]
   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 

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)

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