Move bullet trajectory into bullet update function

src/Dodge/Bullet.hs

@@ -0,0 +1,75 @@
+module Dodge.Bullet where
+import Dodge.Data
+import Dodge.Particle.Bullet.Update
+import Dodge.Creature.HandPos
+import Dodge.Base.Coordinate
+import Geometry
+import LensHelp
+
+import Data.Maybe
+
+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
+
+aBulAt
+    :: Maybe Float    -- ^ Start velocity step factor
+--    -> (Bullet -> Bullet)
+    -> Point2   -- ^ Start position
+    -> Point2  -- ^ Velocity
+    -> Float    -- ^ Drag
+    -> HitEffect' 
+    -> Float    -- ^ Bullet width
+    -> BulletTrajectory
+    -> Bullet
+aBulAt vfact --updatemod 
+    pos vel drag hiteff width butraj = Bullet
+    { _buState = bulstate
+    , _buUpdateMod = NoBulletUpdateMod
+    , _buTrajectory = butraj
+    , _buVel  = vel
+    , _buDrag = drag
+    , _buPos = pos
+    , _buOldPos = pos
+    , _buWidth = width
+    , _buTimer = 100
+    , _buHitEff = hiteff
+    }
+  where
+    bulstate = fromMaybe NormalBulletState $ DelayedBullet <$> vfact
+
+useAmmoParams :: Maybe Float -> Item -> Creature -> World -> World
+useAmmoParams vfact it cr w = w & instantBullets .:~ aBulAt 
+    vfact 
+--    thetraj                     -- extra update
+    sp
+    (rotateV dir (muzvel *.* _amBulVel bultype))           -- vel
+    (_rifling $ _itParams it)   -- drag
+    (_amBulEff bultype) 
+    (_amBulWth bultype) 
+    thetraj
+--    (_amBulTraj bultype)
+  where
+    sp = _crPos cr +.+ (muzlength + 10) *.* unitVectorAtAngle dir
+    dir = _crDir cr
+    bultype = _laAmmoType $ _itConsumption it
+    muzvel = _muzVel $ _itParams it
+    muzlength = aimingMuzzlePos cr it
+    thetraj = case _amBulTraj bultype of
+        BasicBulletTrajectory -> BasicBulletTrajectory
+        MagnetTrajectory{} -> fromMaybe BasicBulletTrajectory $ do
+            tpos <- it ^? itTargeting . tgPos . _Just
+            return $ MagnetTrajectory tpos
+            --return $ \pt -> pt & buVel .+.+~ 5 *.* normalizeV (tpos -.- _buPos pt)
+        FlechetteTrajectory{} -> fromMaybe BasicBulletTrajectory $ do
+            tpos <- it ^? itTargeting . tgPos . _Just
+            return $ FlechetteTrajectory tpos
+            --return $ \pt -> pt & buVel %~ vecTurnTo 0.2 (_buPos pt) tpos
+        BezierTrajectory{} -> fromMaybe BasicBulletTrajectory $ do
+            tpos <- it ^? itTargeting . tgPos . _Just
+            return $ BezierTrajectory sp tpos (mouseWorldPos w)
+--            let bf t = bQuadToF (sp,mouseWorldPos w,tpos) $ (100 - t) * 0.05
+--            return $ \pt -> pt 
+--                & buVel .~ bf (fromIntegral $ _buTimer pt - 1) -.- bf (fromIntegral $ _buTimer pt)

src/Dodge/Combine/Module.hs

@@ -27,10 +27,10 @@ moduleModification imt = case imt of
     TARGCR      -> itTargeting .~ targetRBCreature
     TARGLAS     -> itTargeting .~ targetLaser
     TARGPOS     -> itTargeting .~ targetRBPress
-    MAGNETTRAJ  -> (itConsumption . laAmmoType . amBulTraj .~ MagnetTrajectory) 
+    MAGNETTRAJ  -> (itConsumption . laAmmoType . amBulTraj .~ MagnetTrajectory 0) 
                 . (itConsumption . laAmmoType . amBulVel  .~ V2 10 0)
-    FLECHETRAJ  -> itConsumption . laAmmoType . amBulTraj .~ FlechetteTrajectory
+    FLECHETRAJ  -> itConsumption . laAmmoType . amBulTraj .~ FlechetteTrajectory 0 
-    BEZIERTRAJ  -> itConsumption . laAmmoType . amBulTraj .~ BezierTrajectory
+    BEZIERTRAJ  -> itConsumption . laAmmoType . amBulTraj .~ BezierTrajectory 0 0 0
     INCENDLAS   -> itParams . lasBeam .~ BeamCombine flameBeamCombine
     SPLITLAS    -> itParams . lasBeam .~ BeamCombine splitBeamCombine
     STATICLAS   -> (itParams . lasBeam .~ BeamCombine teslaBeamCombine)

src/Dodge/Creature.hs

@@ -226,6 +226,17 @@ inventoryX c = case c of
 --            , lasWidePulse
             , makeTypeCraftNum 10 TRANSFORMER
             ]
+    'K' -> 
+        [ autoRifle
+        , makeTypeCraftNum 7 MICROCHIP
+        , makeTypeCraftNum 4 HARDWARE
+        , makeTypeCraftNum 2 MAGNET
+        , makeTypeCraftNum 1 MOTOR
+        , makeTypeCraftNum 2 ANTIMATTER
+        , makeTypeCraftNum 1 LIGHTSENSOR
+        , makeTypeCraftNum 1 SOUNDSENSOR
+        , makeTypeCraftNum 1 HEATSENSOR
+        ]
     _ -> []
 
 testInventory :: IM.IntMap Item

src/Dodge/Creature/Damage.hs

@@ -2,7 +2,7 @@ module Dodge.Creature.Damage where
 import Dodge.Data
 import Dodge.Creature.Test
 import Dodge.Particle.Spark
-import Dodge.Particle.Bullet.Spawn
+import Dodge.Bullet
 import Color
 import Geometry
 import LensHelp
@@ -44,8 +44,8 @@ applyDamageEffect dm de cr w = case de of
         & creatures . ix (_crID cr) . crDir +~ rot
     BounceBullet bt | crIsArmouredFrom p cr -> w & instantBullets .:~ bouncer
       where
-        bouncer = (aBulAt Nothing id pOut reflectVel (_buDrag bt)
+        bouncer = (aBulAt Nothing pOut reflectVel (_buDrag bt) (_buHitEff bt) (_buWidth bt) 
-                                          (_buHitEff bt) (_buWidth bt)
+                    BasicBulletTrajectory
                   ) {_buTimer = _buTimer bt - 1}
         pOut = p +.+ 2 *.* newDir
         reflectVel = magV bulVel *.* newDir

src/Dodge/Data.hs

@@ -524,8 +524,15 @@ data BeamType
         {_beamCombine :: (Point2 , (Point2,Point2,Beam) , (Point2,Point2,Beam)) -> World -> World}
     | BeamSimple
 
+data BulletState = NormalBulletState
+    | DyingBulletState
+    | DelayedBullet Float
+data BulletUpdateMod = NoBulletUpdateMod
+
 data Bullet = Bullet
-    { _buUpdate :: World -> Bullet -> (World, Maybe Bullet)
+    { _buState  :: BulletState
+    , _buUpdateMod :: BulletUpdateMod
+    , _buTrajectory :: BulletTrajectory
     , _buVel    :: Point2
     , _buDrag   :: Float
     , _buPos    :: Point2
@@ -645,9 +652,9 @@ type HitEffect' = Bullet
 
 data BulletTrajectory
     = BasicBulletTrajectory
-    | BezierTrajectory
+    | BezierTrajectory Point2 Point2 Point2
-    | FlechetteTrajectory
+    | FlechetteTrajectory Point2
-    | MagnetTrajectory
+    | MagnetTrajectory Point2
 
 data AmmoType
     = ProjectileAmmo

src/Dodge/Default/Weapon.hs

@@ -1,9 +1,9 @@
 module Dodge.Default.Weapon
     where
 import Dodge.Data
+import Dodge.Bullet
 import Dodge.Reloading.Action
 import Dodge.Item.Weapon.Bullet
-import Dodge.Item.Weapon.AmmoParams
 import Dodge.Default.Item
 import Dodge.Default.AimParams
 --import Dodge.Item.Draw

src/Dodge/Item/Draw/SPic.hs

@@ -1,6 +1,6 @@
 module Dodge.Item.Draw.SPic where
 import Dodge.Data
-import Dodge.Item.Weapon.AmmoParams
+import Dodge.Item.Weapon.FractionLoaded
 import ShapePicture
 import Shape
 import LensHelp

src/Dodge/Item/Weapon/AmmoParams.hs

@@ -1,61 +0,0 @@
-module Dodge.Item.Weapon.AmmoParams
-    ( useAmmoParams
-    , fractionLoadedAmmo
-    , fractionLoadedAmmo2
-    ) where
-import Dodge.Data
-import Dodge.Base
-import Dodge.Particle.Bullet.Spawn
-import Dodge.Creature.HandPos
-import Dodge.Movement.Turn
-import Geometry
-import LensHelp
-
-import Data.Maybe
---import Control.Lens
-
-useAmmoParams :: Maybe Float -> Item -> Creature -> World -> World
-useAmmoParams vfact it cr w = w & instantBullets .:~ aBulAt 
-    vfact 
-    thetraj                     -- extra update
-    sp
-    (rotateV dir (muzvel *.* _amBulVel bultype))           -- vel
-    (_rifling $ _itParams it)   -- drag
-    (_amBulEff bultype) 
-    (_amBulWth bultype) 
-  where
-    sp = _crPos cr +.+ (muzlength + 10) *.* unitVectorAtAngle dir
-    dir = _crDir cr
-    bultype = _laAmmoType $ _itConsumption it
-    muzvel = _muzVel $ _itParams it
-    muzlength = aimingMuzzlePos cr it
-    thetraj = case _amBulTraj bultype of
-        BasicBulletTrajectory -> id
-        MagnetTrajectory -> fromMaybe id $ do
-            tpos <- it ^? itTargeting . tgPos . _Just
-            return $ \pt -> pt & buVel .+.+~ 5 *.* normalizeV (tpos -.- _buPos pt)
-        FlechetteTrajectory -> fromMaybe id $ do
-            tpos <- it ^? itTargeting . tgPos . _Just
-            return $ \pt -> pt & buVel %~ vecTurnTo 0.2 (_buPos pt) tpos
-        BezierTrajectory -> fromMaybe id $ do
-            tpos <- it ^? itTargeting . tgPos . _Just
-            let bf t = bQuadToF (sp,mouseWorldPos w,tpos) $ (100 - t) * 0.05
-            return $ \pt -> pt 
-                & buVel .~ bf (fromIntegral $ _buTimer pt - 1) -.- bf (fromIntegral $ _buTimer pt)
-
----- this shouldn't really be used
-loadedAmmo :: Item -> Int
-loadedAmmo = _laLoaded . _itConsumption
---    | _laTransfer (_itConsumption it) == NoTransfer = _laLoaded (_itConsumption it)
---    | otherwise = 0
-
-fractionLoadedAmmo :: Item -> Float
-fractionLoadedAmmo it = fromIntegral (loadedAmmo it) / fromIntegral (itmaxammo it)
-  where
-    itmaxammo = _laMax . _itConsumption
-
-fractionLoadedAmmo2 :: Item -> Float
-fractionLoadedAmmo2 it = 1 - 
-    (1 - fromIntegral (loadedAmmo it) / fromIntegral (itMaxAmmo it))**2
-  where
-    itMaxAmmo = _laMax . _itConsumption

src/Dodge/Item/Weapon/BulletGun/Cane.hs

@@ -11,14 +11,9 @@ module Dodge.Item.Weapon.BulletGun.Cane
 --import Dodge.Particle.Bullet.HitEffect
 import Dodge.Reloading.Action
 import Dodge.Data
---import Dodge.ChainEffect
+import Dodge.Bullet
 import Dodge.Default.Weapon
 import Dodge.Default
---import Dodge.Item.Attachment
---import Dodge.Item.Weapon.ExtraEffect
---import Dodge.Item.Weapon.InventoryDisplay
-import Dodge.Item.Weapon.AmmoParams
---import Dodge.Item.Draw
 import Dodge.Item.Weapon.TriggerType
 import Dodge.SoundLogic.LoadSound
 import Picture

src/Dodge/Item/Weapon/FractionLoaded.hs

@@ -0,0 +1,22 @@
+module Dodge.Item.Weapon.FractionLoaded
+    ( fractionLoadedAmmo
+    , fractionLoadedAmmo2
+    ) where
+import Dodge.Data
+
+---- this shouldn't really be used
+loadedAmmo :: Item -> Int
+loadedAmmo = _laLoaded . _itConsumption
+--    | _laTransfer (_itConsumption it) == NoTransfer = _laLoaded (_itConsumption it)
+--    | otherwise = 0
+
+fractionLoadedAmmo :: Item -> Float
+fractionLoadedAmmo it = fromIntegral (loadedAmmo it) / fromIntegral (itmaxammo it)
+  where
+    itmaxammo = _laMax . _itConsumption
+
+fractionLoadedAmmo2 :: Item -> Float
+fractionLoadedAmmo2 it = 1 - 
+    (1 - fromIntegral (loadedAmmo it) / fromIntegral (itMaxAmmo it))**2
+  where
+    itMaxAmmo = _laMax . _itConsumption

src/Dodge/Particle/Bullet/Spawn.hs

@@ -1,35 +0,0 @@
-module Dodge.Particle.Bullet.Spawn
-    ( aBulAt
-    ) where
-import Dodge.Data
-import Dodge.Particle.Bullet.Update
-import Geometry
-import LensHelp
-
-import Data.Maybe
-import Data.Bifunctor
-
-aBulAt
-    :: Maybe Float    -- ^ Start velocity step factor
-    -> (Bullet -> Bullet)
-    -> Point2   -- ^ Start position
-    -> Point2  -- ^ Velocity
-    -> Float    -- ^ Drag
-    -> HitEffect' 
-    -> Float    -- ^ Bullet width
-    -> Bullet
-aBulAt vfact updatemod pos vel drag hiteff width = Bullet
-    { _buUpdate = theupdate
-    , _buVel  = fromMaybe 1 vfact *.* vel
-    , _buDrag = drag
-    , _buPos = pos
-    , _buOldPos = pos
-    , _buWidth = width
-    , _buTimer = 100
-    , _buHitEff = hiteff
-    }
-  where
-    theupdate = case vfact of
-        Just _  -> \w -> resetVel . mvBullet w . updatemod
-        Nothing -> \w -> mvBullet w . updatemod
-    resetVel = second $ fmap $ (buUpdate .~ (\w -> mvBullet w . updatemod)) . (buVel .~ vel)

src/Dodge/Particle/Bullet/Update.hs

@@ -2,10 +2,11 @@
 {- Bullet update.  -}
 module Dodge.Particle.Bullet.Update
     ( mvBullet
+    , mvBulletSlow
     , mvSpark
     ) where
 import Dodge.Data
---import Dodge.Base
+import Dodge.Movement.Turn
 import Dodge.WorldEvent.ThingsHit
 --import Picture
 import Geometry
@@ -20,13 +21,34 @@ mvBullet w bt'
         hiteff bt (thingsHit p (p +.+ vel) w) w
   where
     bt = foldr (\mg b -> _mgField mg mg b) bt' $ _magnets w
-    dodrag = buVel .*.*~ drag
+    dodrag = case _buTrajectory bt of
+        BasicBulletTrajectory -> buVel .*.*~ drag
+        MagnetTrajectory tpos -> buVel .+.+~ 5 *.* normalizeV (tpos -.- _buPos bt)
+        FlechetteTrajectory tpos -> buVel %~ vecTurnTo 0.2 (_buPos bt) tpos
+        BezierTrajectory spos tpos xpos -> 
+            let bf tm = bQuadToF (spos,xpos,tpos) $ (100 - tm) * 0.05
+            in buVel .~ bf (fromIntegral $ _buTimer bt - 1) -.- bf (fromIntegral $ _buTimer bt)
     drag = _buDrag bt
     p       = _buPos bt
     vel     = _buVel bt
     hiteff  = _buHitEff bt
     t       = _buTimer bt
 
+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  = _buHitEff bt
+    t       = _buTimer bt
+
 mvSpark :: World -> Particle -> (World, Maybe Particle)
 mvSpark w bt' 
     | t <= 0 || magV (_ptVel bt) < 1 = (w,Nothing)

src/Dodge/Particle/Update.hs

@@ -23,7 +23,7 @@ destroyAt hitp pt = Just $ pt
     & ptTimer %~ (min 3 . subtract 1)
 destroyAt' :: Point2 -> Bullet -> Maybe Bullet
 destroyAt' hitp pt = Just $ pt 
-    & buUpdate  .~ (\w -> const (w,Nothing))
+    & buState  .~ DyingBulletState
     & buPos     .~ hitp
     & buOldPos  .~ _buPos pt
     & buTimer   %~ (min 3 . subtract 1)

src/Dodge/Update.hs

@@ -5,6 +5,7 @@ Description : Simulation update
 -}
 module Dodge.Update ( updateUniverse ) where
 import Dodge.Data
+import Dodge.Bullet
 import Dodge.Update.Cloud
 import Dodge.Machine.Update
 import Dodge.RadarBlip
@@ -217,7 +218,7 @@ updateFlares = flares %~ mapMaybe updateFlare
 updateBullets :: World -> World
 updateBullets w = updateInstantBullets $ set bullets (catMaybes ps) w'
   where 
-    (w',ps) = mapAccumR (\a b -> _buUpdate b a b) w $ _bullets w
+    (w',ps) = mapAccumR (\a b -> updateBullet a b) w $ _bullets w
 
 {- Apply internal particle updates, delete 'Nothing's.  -}
 updateParticles :: World -> World
@@ -297,7 +298,7 @@ intersectSegSegs' _ _ _ = Nothing
 updateInstantBullets :: World -> World
 updateInstantBullets w = case _instantBullets w of
     [] -> w
-    ps -> let (w',ps') = mapAccumR (\a b -> _buUpdate b a b) (w {_instantBullets=[]}) ps
+    ps -> let (w',ps') = mapAccumR (\a b -> updateBullet a b) (w {_instantBullets=[]}) ps
         in updateInstantBullets $ w' & bullets .++~ catMaybes ps'
 
 updateInstantParticles :: World -> World

src/Dodge/Wall/DamageEffect.hs

@@ -1,7 +1,7 @@
 module Dodge.Wall.DamageEffect where
 import Dodge.Data
+import Dodge.Bullet
 import Dodge.Particle.Spark
-import Dodge.Particle.Bullet.Spawn
 import Dodge.Base.Wall
 import Dodge.Wall.Dust
 import Dodge.Block
@@ -135,7 +135,8 @@ wallDamageEffect dm wl w = case _dmEffect dm of
     BounceBullet bt -> w & instantBullets .:~ thebouncer
       where
         reflectVel = reflVelWall wl (_buVel bt)
-        thebouncer = aBulAt Nothing id pOut reflectVel (_buDrag bt) (_buHitEff bt) (_buWidth bt)
+        thebouncer = aBulAt Nothing --id 
+            pOut reflectVel (_buDrag bt) (_buHitEff bt) (_buWidth bt) BasicBulletTrajectory
             & buTimer .~ _buTimer bt - 1
         pOut = p +.+ squashNormalizeV (sp -.- p)
         p = _dmAt dm