Continue bullet refactor

src/Dodge/Bullet.hs

@@ -2,7 +2,6 @@ module Dodge.Bullet where
 import Dodge.WorldEvent.SpawnParticle
 import Dodge.Creature.Test
 import Dodge.Data
-import Dodge.Particle.HitEffect.ExpireAndDamage
 import Dodge.Creature.HandPos
 import Dodge.Base.Coordinate
 import Dodge.Base.Wall
@@ -10,13 +9,13 @@ import Geometry
 import LensHelp
 import StreamingHelp
 
+import qualified Data.IntMap.Strict as IM
 import qualified Streaming.Prelude as S
 import Data.Maybe
 import Dodge.Movement.Turn
 import Dodge.WorldEvent.ThingsHit
 import Control.Monad.State
 import System.Random
-
 --import Data.Bifunctor
 
 updateBullet :: World -> Bullet -> (World,Maybe Bullet)
@@ -30,7 +29,6 @@ aBulAt
     -> Point2   -- ^ Start position
     -> Point2  -- ^ Velocity
     -> Float    -- ^ Drag
---    -> HitEffect' 
     -> Float    -- ^ Bullet width
     -> BulletTrajectory
     -> BulletEffect
@@ -55,38 +53,33 @@ aBulAt vfact pos vel drag width butraj be bs dams = Bullet
     bulstate = maybe NormalBulletState DelayedBullet vfact
 
 useAmmoParams :: Maybe Float -> Item -> Creature -> World -> World
-useAmmoParams vfact it cr w = w & instantBullets .:~ aBulAt 
+useAmmoParams vfact it cr w = w & instantBullets .:~ (_amBullet bultype
-    vfact 
+    & buPos .~ sp 
-    sp
+    & buTrajectory %~ settrajectory
-    (rotateV dir (muzvel *.* _amBulVel bultype))           -- vel
+    & buVel %~ (rotateV dir . (muzvel *.*))
-    (_rifling $ _itParams it)   -- drag
+    & buDrag *~ _rifling (_itParams it)
-    (_amBulWth bultype) 
+    & buState %~ setstate
-    thetraj
+    )
-    (_amBulEffect bultype)
-    (_amBulSpawn bultype)
-    (_amBulDams bultype)
   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
     muzvel = _muzVel $ _itParams it
     muzlength = aimingMuzzlePos cr it
-    thetraj = case _amBulTraj bultype of
+    settrajectory traj = case traj 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)
 
 {- Update for a generic bullet.  -}
 mvBullet :: World -> Bullet -> (World, Maybe Bullet)
@@ -168,3 +161,66 @@ mvBulletSlow x w 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
+    Nothing -> (w, mvPt bt)
+    Just x -> (doDamages' fdm x bt w, destroyAt' (fst x) bt)
+mvPt :: Bullet -> Maybe Bullet
+mvPt pt = Just $ pt
+    & buPos %~ (+.+ _buVel pt)
+    & buOldPos .~ _buPos pt
+    & buTimer -~ 1
+
+destroyAt' :: Point2 -> Bullet -> Maybe Bullet
+destroyAt' hitp pt = Just $ pt 
+    & buState  .~ DyingBulletState
+    & buPos     .~ hitp
+    & buOldPos  .~ _buPos pt
+    & buTimer   %~ (min 3 . subtract 1)
+
+penWalls 
+    :: HitCreatureEffect' 
+    -> HitWallEffect' 
+    -> Bullet 
+    -> [(Point2, Either Creature Wall)] 
+    -> World 
+    -> (World, Maybe Bullet)
+penWalls crEff wlEff pt hitThings w = case hitThings of
+    []              -> (              w, mvPt pt)
+    ((p,Left cr):_) -> (crEff pt p cr w, destroyAt' p pt)
+    ((p,Right wl):hs) | _wlFireThrough wl 
+                    -> first (wlEff pt p wl) $ penWalls crEff wlEff pt hs w
+    ((p,Right wl):_) -> (wlEff pt p wl w, destroyAt' p pt)
+
+type HitCreatureEffect'   = Bullet -> Point2 -> Creature   -> World -> World
+type HitWallEffect'       = Bullet -> Point2 -> Wall       -> World -> World
+
+doDamages' :: (Bullet -> Point2 -> [Damage])
+    -> (Point2, Either Creature Wall)
+    -> Bullet
+    -> World
+    -> World
+doDamages' fdm (p,thhit) bt = case thhit of
+    Left cr -> creatures . ix (_crID cr) . crState . csDamage .++~ dams
+    Right wl -> wallDamages %~ IM.insertWith (++) (_wlID wl) dams
+  where
+    dams = fdm bt p
+
+penetrate 
+    :: ((Point2,Either Creature Wall) -> Bullet -> Maybe Bullet) 
+        -- | penetration test, can update particle if it penetrates
+    -> (Bullet -> Point2 -> [Damage]) -- | damages when penetrating
+    -> (Bullet -> Point2 -> [Damage]) -- | damages when not penetrating
+    -> Bullet
+    -> Stream (Of (Point2, Either Creature Wall)) Identity ()
+    -> World
+    -> (World, Maybe Bullet)
+penetrate t pendam stopdam pt hitThings w = case runIdentity $ S.uncons hitThings of
+    Nothing -> (w, mvPt pt)
+    Just (x,xs) -> case t x pt of
+        Nothing -> expireAndDamage' stopdam pt hitThings w
+        Just pt' -> first (doDamages' pendam x pt) $ penetrate t pendam stopdam pt' xs w

src/Dodge/Combine/Module.hs

@@ -17,17 +17,17 @@ moduleModification imt = case imt of
     DRUMMAG     -> itConsumption . laMax .~ 45
     BELTMAG     -> itConsumption . laMax .~ 150
     MAGNETMAG   -> itUse . useDelay . rateMax .~ 4
-    INCENDBUL   -> itConsumption . laAmmoType . amBulSpawn .~ BulBall IncBall
+    INCENDBUL   -> itConsumption . laAmmoType . amBullet . buSpawn .~ BulBall IncBall
-    BOUNCEBUL   -> itConsumption . laAmmoType . amBulEffect .~ BounceBullet 
+    BOUNCEBUL   -> itConsumption . laAmmoType . amBullet . buEffect .~ BounceBullet 
-    STATICBUL   -> itConsumption . laAmmoType . amBulSpawn .~ BulBall TeslaBall
+    STATICBUL   -> itConsumption . laAmmoType . amBullet . buSpawn .~ BulBall TeslaBall
-    CONCUSBUL   -> itConsumption . laAmmoType . amBulSpawn .~ BulBall ConcBall
+    CONCUSBUL   -> itConsumption . laAmmoType . amBullet . buSpawn .~ BulBall ConcBall
     TARGCR      -> itTargeting .~ targetRBCreature
     TARGLAS     -> itTargeting .~ targetLaser
     TARGPOS     -> itTargeting .~ targetRBPress
-    MAGNETTRAJ  -> (itConsumption . laAmmoType . amBulTraj .~ MagnetTrajectory 0) 
+    MAGNETTRAJ  -> (itConsumption . laAmmoType . amBullet . buTrajectory .~ MagnetTrajectory 0) 
-                . (itConsumption . laAmmoType . amBulVel  .~ V2 10 0)
+        . (itConsumption . laAmmoType . amBullet . buVel  .~ V2 10 0)
-    FLECHETRAJ  -> itConsumption . laAmmoType . amBulTraj .~ FlechetteTrajectory 0 
+    FLECHETRAJ  -> itConsumption . laAmmoType . amBullet . buTrajectory .~ FlechetteTrajectory 0 
-    BEZIERTRAJ  -> itConsumption . laAmmoType . amBulTraj .~ BezierTrajectory 0 0 0
+    BEZIERTRAJ  -> itConsumption . laAmmoType . amBullet . buTrajectory .~ BezierTrajectory 0 0 0
     INCENDLAS   -> itParams . lasBeam .~ BeamCombine flameBeamCombine
     SPLITLAS    -> itParams . lasBeam .~ BeamCombine splitBeamCombine
     STATICLAS   -> (itParams . lasBeam .~ BeamCombine teslaBeamCombine)

src/Dodge/Data.hs

@@ -635,17 +635,10 @@ data AmmoType
         , _amString :: String
         , _amPjDraw :: Prop -> SPic
         , _amPjCreation :: Item -> Creature -> World -> World
---        , _aProjectile :: Ammo -> Prop
         }
     | BulletAmmo
         { _amString :: String 
---        , _amBulEff :: HitEffect'
+        , _amBullet :: Bullet
-        , _amBulDams :: [Damage]
-        , _amBulWth :: Float
-        , _amBulVel :: Point2
-        , _amBulTraj :: BulletTrajectory
-        , _amBulEffect :: BulletEffect
-        , _amBulSpawn  :: BulletSpawn
         }
     | DroneAmmo
         { _amString :: String }

src/Dodge/Data/Bullet.hs

@@ -23,16 +23,14 @@ data BulletState = NormalBulletState
     | DyingBulletState
     | DelayedBullet Float
 data BulletUpdateMod = NoBulletUpdateMod
-
+data BulletEffect 
-data BulletEffect = DestroyBullet
+    = DestroyBullet
     | BounceBullet
     | PenetrateBullet
 data BulletSpawn = BulBall EnergyBall | BulSpark
-
 data BulletTrajectory
     = BasicBulletTrajectory
     | BezierTrajectory Point2 Point2 Point2
     | FlechetteTrajectory Point2
     | MagnetTrajectory Point2
-
 makeLenses ''Bullet

src/Dodge/Data/DamageType.hs

@@ -41,12 +41,10 @@ data Damage = Damage
     , _dmEffect :: DamageEffect
     }
   deriving (Eq,Ord,Show)
-
 isElectrical :: Damage -> Bool
 isElectrical dm = case _dmType dm of
     ELECTRICAL -> True
     _ -> False
-
 isMovementDam :: Damage -> Bool
 isMovementDam dm = case _dmType dm of
     TORQUEDAM -> True

src/Dodge/Item/Weapon/Bullet.hs

@@ -3,26 +3,44 @@ module Dodge.Item.Weapon.Bullet
     , hvBullet
     ) where
 import Dodge.Data
-import Dodge.Particle.Damage
 
+import Control.Lens
 import Geometry.Data
 basicBullet :: AmmoType
 basicBullet = BulletAmmo
     { _amString = "BASIC"
-    , _amBulDams = basicBulDams
+    , _amBullet = defaultBullet
-    , _amBulWth = 2
-    , _amBulVel = V2 50 0
-    , _amBulTraj = BasicBulletTrajectory
-    , _amBulEffect = DestroyBullet
-    , _amBulSpawn = BulSpark
     }
+defaultBullet :: Bullet
+defaultBullet = Bullet
+    { _buState  = NormalBulletState
+    , _buEffect = DestroyBullet
+    , _buSpawn  = BulSpark
+    , _buUpdateMod  = NoBulletUpdateMod
+    , _buTrajectory = BasicBulletTrajectory
+    , _buVel    = V2 50 0
+    , _buDrag   = 1
+    , _buPos    = 0
+    , _buOldPos = 0
+    , _buWidth  = 2
+    , _buTimer  = 100
+    , _buDamages    = basicBulDams
+    }
+basicBulDams :: [Damage]
+basicBulDams =
+    [ Damage PIERCING 100 0 0 0 NoDamageEffect
+    , Damage PUSHDAM    1 0 0 0 . PushBackDamage $ 2
+    ]
 hvBullet :: AmmoType
 hvBullet = BulletAmmo
     { _amString = "HVBULLET"
-    , _amBulDams = hvBulDams
+    , _amBullet = defaultBullet
-    , _amBulWth = 6
+        & buWidth .~ 6
-    , _amBulVel = V2 80 0
+        & buVel .~ V2 80 0
-    , _amBulTraj = BasicBulletTrajectory
+        & buDamages .~ heavyBulDams
-    , _amBulEffect = DestroyBullet
-    , _amBulSpawn = BulSpark
     }
+heavyBulDams :: [Damage]
+heavyBulDams =
+    [ Damage PIERCING 300 0 0 0 NoDamageEffect
+    , Damage PUSHDAM    1 0 0 0 $ PushBackDamage 2
+    ]

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

@@ -8,8 +8,8 @@ module Dodge.Item.Weapon.BulletGun.Rod
     ) where
 import Dodge.Data
 import Dodge.Reloading.Action
-import Dodge.Particle.Damage
 import Dodge.Default.Weapon
+import Dodge.Item.Weapon.Bullet
 import Dodge.Default
 import Dodge.Item.Weapon.ZoomScope
 import Dodge.Item.Weapon.ExtraEffect
@@ -57,7 +57,7 @@ bangRod = defaultBulletWeapon
     & itUse . useAim . aimZoom .~ defaultItZoom {_itZoomFac = 1.5}
     & itUse . useAim . aimHandlePos .~ 5
     & itUse . useAim . aimMuzPos .~ 30
-    & itConsumption . laAmmoType . amBulDams .~ heavyBulDams
+    & itConsumption . laAmmoType .~ hvBullet
 elephantGun :: Item
 elephantGun = bangRod
     & itType . iyBase .~ HELD ELEPHANTGUN

src/Dodge/Item/Weapon/BulletGuns.hs

@@ -127,7 +127,7 @@ bangCone = defaultBulletWeapon
 coneRandItemUpdate :: State StdGen (Item -> Item)
 coneRandItemUpdate = do
     wth <- state $ randomR (1,5)
-    return (\it -> it & itConsumption . laAmmoType . amBulWth .~ wth)
+    return (itConsumption . laAmmoType . amBullet . buWidth .~ wth)
 coneRandItemParams :: State StdGen (ItemParams -> ItemParams)
 coneRandItemParams = do
     muzv <- state $ randomR (0.5,1)

src/Dodge/Particle/Damage.hs

@@ -15,17 +15,6 @@ simpleDam' dt amount bt p = [ Damage dt amount sp p ep NoDamageEffect ]
     bulVel = _buVel bt
     ep = sp +.+ bulVel
 
-heavyBulDams :: [Damage]
-heavyBulDams =
-    [ Damage PIERCING 300 0 0 0 NoDamageEffect
-    , Damage PUSHDAM    1 0 0 0 $ PushBackDamage 2
-    ]
-
-basicBulDams :: [Damage]
-basicBulDams =
-    [ Damage PIERCING 100 0 0 0 NoDamageEffect
-    , Damage PUSHDAM    1 0 0 0 . PushBackDamage $ 2
-    ]
 
 basicSparkDams :: Particle -> Point2 -> [Damage]
 basicSparkDams bt p = [ Damage SPARKING 1 sp p ep NoDamageEffect ]

src/Dodge/Particle/HitEffect.hs

@@ -1,27 +0,0 @@
-module Dodge.Particle.HitEffect
-    ( penWalls
-    , module Dodge.Particle.HitEffect.ExpireAndDamage
-    ) where
-import Dodge.Data
-import Dodge.Particle.Update
-import Dodge.Particle.HitEffect.ExpireAndDamage
-import Geometry
-
-import Data.Bifunctor
-
-type HitCreatureEffect'   = Bullet -> Point2 -> Creature   -> World -> World
-type HitWallEffect'       = Bullet -> Point2 -> Wall       -> World -> World
-
-penWalls 
-    :: HitCreatureEffect' 
-    -> HitWallEffect' 
-    -> Bullet 
-    -> [(Point2, Either Creature Wall)] 
-    -> World 
-    -> (World, Maybe Bullet)
-penWalls crEff wlEff pt hitThings w = case hitThings of
-    []              -> (              w, mvPt pt)
-    ((p,Left cr):_) -> (crEff pt p cr w, destroyAt' p pt)
-    ((p,Right wl):hs) | _wlFireThrough wl 
-                    -> first (wlEff pt p wl) $ penWalls crEff wlEff pt hs w
-    ((p,Right wl):_) -> (wlEff pt p wl w, destroyAt' p pt)

src/Dodge/Particle/HitEffect/ExpireAndDamage.hs

@@ -17,14 +17,6 @@ expireAndDamage fdm bt things w = case runIdentity $ S.head_ things of
     Nothing -> (w, mvPt' bt)
     Just x -> (doDamages fdm x bt w, destroyAt (fst x) 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
-    Nothing -> (w, mvPt bt)
-    Just x -> (doDamages' fdm x bt w, destroyAt' (fst x) bt)
 
 doDamages :: (Particle -> Point2 -> [Damage])
     -> (Point2, Either Creature Wall)
@@ -36,14 +28,3 @@ doDamages fdm (p,thhit) bt = case thhit of
     Right wl -> wallDamages %~ IM.insertWith (++) (_wlID wl) dams
   where
     dams = fdm bt p
-
-doDamages' :: (Bullet -> Point2 -> [Damage])
-    -> (Point2, Either Creature Wall)
-    -> Bullet
-    -> World
-    -> World
-doDamages' fdm (p,thhit) bt = case thhit of
-    Left cr -> creatures . ix (_crID cr) . crState . csDamage .++~ dams
-    Right wl -> wallDamages %~ IM.insertWith (++) (_wlID wl) dams
-  where
-    dams = fdm bt p

src/Dodge/Particle/HitEffect/Penetrate.hs

@@ -1,25 +0,0 @@
-module Dodge.Particle.HitEffect.Penetrate where
-import Dodge.Data
-import Dodge.Particle.Update
-import Dodge.Particle.HitEffect.ExpireAndDamage
-import Geometry
---import LensHelp
-
-import Data.Bifunctor
-import Streaming
-import qualified Streaming.Prelude as S
-
-penetrate 
-    :: ((Point2,Either Creature Wall) -> Bullet -> Maybe Bullet) 
-        -- | penetration test, can update particle if it penetrates
-    -> (Bullet -> Point2 -> [Damage]) -- | damages when penetrating
-    -> (Bullet -> Point2 -> [Damage]) -- | damages when not penetrating
-    -> Bullet
-    -> Stream (Of (Point2, Either Creature Wall)) Identity ()
-    -> World
-    -> (World, Maybe Bullet)
-penetrate t pendam stopdam pt hitThings w = case runIdentity $ S.uncons hitThings of
-    Nothing -> (w, mvPt pt)
-    Just (x,xs) -> case t x pt of
-        Nothing -> expireAndDamage' stopdam pt hitThings w
-        Just pt' -> first (doDamages' pendam x pt) $ penetrate t pendam stopdam pt' xs w

src/Dodge/Particle/Update.hs

@@ -3,12 +3,6 @@ import Dodge.Data
 import LensHelp
 import Geometry
 
-mvPt :: Bullet -> Maybe Bullet
-mvPt pt = Just $ pt
-    & buPos %~ (+.+ _buVel pt)
-    & buOldPos .~ _buPos pt
-    & buTimer -~ 1
-
 mvPt' :: Particle -> Maybe Particle
 mvPt' pt = Just $ pt
     & ptTrail %~ f
@@ -21,12 +15,6 @@ destroyAt hitp pt = Just $ pt
     & ptUpdate .~ killParticleUpdate
     & ptTrail  .:~ hitp
     & ptTimer %~ (min 3 . subtract 1)
-destroyAt' :: Point2 -> Bullet -> Maybe Bullet
-destroyAt' hitp pt = Just $ pt 
-    & buState  .~ DyingBulletState
-    & buPos     .~ hitp
-    & buOldPos  .~ _buPos pt
-    & buTimer   %~ (min 3 . subtract 1)
 
 killParticleUpdate :: World -> Particle -> (World,Maybe Particle)
 killParticleUpdate w pt 

src/Dodge/WorldEvent/Shockwave.hs

@@ -118,4 +118,3 @@ moveInverseShockwave w pt
           where
             cpos = _crPos cr
             v = normalizeV (cpos -.- p)
-