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
-    _ -> 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