Continue bullet refactor

src/Dodge/Bullet.hs

@@ -1,12 +1,15 @@
 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
+import Dodge.Movement.Turn
+import Dodge.WorldEvent.ThingsHit
+
+import Data.Bifunctor
 
 updateBullet :: World -> Bullet -> (World,Maybe Bullet)
 updateBullet w bu = case _buState bu of
@@ -16,7 +19,6 @@ updateBullet w bu = case _buState bu of
 
 aBulAt
     :: Maybe Float    -- ^ Start velocity step factor
---    -> (Bullet -> Bullet)
     -> Point2   -- ^ Start position
     -> Point2  -- ^ Velocity
     -> Float    -- ^ Drag
@@ -24,8 +26,7 @@ aBulAt
     -> Float    -- ^ Bullet width
     -> BulletTrajectory
     -> Bullet
-aBulAt vfact --updatemod 
+aBulAt vfact pos vel drag hiteff width butraj = Bullet
-    pos vel drag hiteff width butraj = Bullet
     { _buState = bulstate
     , _buUpdateMod = NoBulletUpdateMod
     , _buTrajectory = butraj
@@ -38,19 +39,17 @@ aBulAt vfact --updatemod
     , _buHitEff = hiteff
     }
   where
-    bulstate = fromMaybe NormalBulletState $ DelayedBullet <$> vfact
+    bulstate = maybe 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
@@ -73,3 +72,39 @@ useAmmoParams vfact it cr w = w & instantBullets .:~ aBulAt
 --            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)
+mvBullet 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 = 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

src/Dodge/Bullet/Draw.hs

@@ -1,4 +1,4 @@
-module Dodge.Particle.Bullet.Draw
+module Dodge.Bullet.Draw
     ( drawBul
     ) where
 import Dodge.Data

src/Dodge/Creature/Damage.hs

@@ -1,7 +1,7 @@
 module Dodge.Creature.Damage where
 import Dodge.Data
 import Dodge.Creature.Test
-import Dodge.Particle.Spark
+import Dodge.Spark
 import Dodge.Bullet
 import Color
 import Geometry

src/Dodge/Creature/Inanimate.hs

@@ -11,8 +11,7 @@ import Dodge.Data
 import Dodge.Creature.Lamp
 import Dodge.WorldEvent.Explosion
 import Dodge.Creature.Picture
---import Dodge.Creature.Stance.Data
+import Dodge.Spark
-import Dodge.Particle.Spark
 import Dodge.Default
 import Dodge.Creature.State
 import Picture

src/Dodge/Data.hs

@@ -539,8 +539,14 @@ data Bullet = Bullet
     , _buOldPos :: Point2
     , _buWidth  :: Float 
     , _buTimer  :: Int
+--    , _buEffect :: BulletEffect
     , _buHitEff :: HitEffect'
     }
+data BulletEffect = BulletSpark
+    | BulletBounce
+    | BulletBall EnergyBall
+
+data EnergyBall = IncBall | TeslaBall | ConcBall
 
 {- Objects without ids.
 Update themselves, perhaps with side effects.  -}

src/Dodge/Material/Damage.hs

@@ -1,14 +1,7 @@
 module Dodge.Material.Damage where
 import Dodge.Data
-import Dodge.Particle.Spark
+import Dodge.Spark
---import Dodge.Particle.Bullet.Spawn
---import Dodge.Base.Wall
---import Dodge.Wall.Dust
---import Dodge.Block
 import Geometry
---import LensHelp
-
---import Control.Monad.State
 
 damageMaterial :: Damage -> Material 
     -> Float -- the angle of the hit surface, in radians

src/Dodge/Particle/Bullet/Update.hs

@@ -1,64 +0,0 @@
---{-# LANGUAGE TupleSections #-}
-{- Bullet update.  -}
-module Dodge.Particle.Bullet.Update
-    ( mvBullet
-    , mvBulletSlow
-    , mvSpark
-    ) where
-import Dodge.Data
-import Dodge.Movement.Turn
-import Dodge.WorldEvent.ThingsHit
---import Picture
-import Geometry
-import LensHelp
-
-import Data.Bifunctor
-{- Update for a generic bullet.  -}
-mvBullet :: World -> Bullet -> (World, Maybe Bullet)
-mvBullet 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 = 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)
-    | otherwise = second (fmap dodrag) $ 
-        hiteff bt (thingsHit p (p +.+ vel) w) w
-  where
-    bt = bt'
-    dodrag = ptVel .*.*~ drag
-    drag = _ptDrag bt
-    (p:_)   = _ptTrail bt
-    vel     = _ptVel bt
-    hiteff  = _ptHitEff bt
-    t       = _ptTimer bt

src/Dodge/Particle/TeslaArc.hs

@@ -3,22 +3,12 @@ module Dodge.Particle.TeslaArc
     ) where
 import Dodge.Data
 import Dodge.Damage
---import Dodge.WorldEvent.Damage
+import Dodge.Spark
---import Dodge.Base
---import Dodge.Zone
---import Dodge.Base.Collide
-import Dodge.Particle.Spark
---import Dodge.WorldEvent.ThingsHit
 import RandomHelp
 import Picture
 import Geometry
---import qualified IntMapHelp as IM
 import LensHelp
 
---import Data.Function (on)
---import Data.List
---import Data.Maybe
-
 aTeslaArcAt :: Color -> [ArcStep] -> Particle
 aTeslaArcAt col thearc = PtTeslaArc
     { _ptPoints = map (^. asPos) thearc

src/Dodge/Render/ShapePicture.hs

@@ -5,7 +5,7 @@ import Dodge.Item.Draw.SPic
 import Dodge.Creature.Picture.Awareness
 import Dodge.Creature.Picture
 import Dodge.Particle.Draw
-import Dodge.Particle.Bullet.Draw
+import Dodge.Bullet.Draw
 import Dodge.RadarBlip
 import Dodge.Flare
 import Dodge.ShortShow

src/Dodge/Spark.hs

@@ -1,21 +1,37 @@
-module Dodge.Particle.Spark
+module Dodge.Spark
-    ( colSpark
+    ( mvSpark
+    , colSpark
     , colSparkRandDir
     , createBarrelSpark
     , randColDirTimeSpark
     ) where
 import Dodge.Data
-import Dodge.Particle.HitEffect.ExpireAndDamage
+import Dodge.WorldEvent.ThingsHit
-import Dodge.Particle.Damage
---import Dodge.Particle.Bullet.HitEffect
-import Dodge.Particle.Bullet.Update
---import Dodge.WorldEvent.HitEffect
-import Color
 import Geometry
 import LensHelp
+import Dodge.Particle.HitEffect.ExpireAndDamage
+import Dodge.Particle.Damage
+import Color
 
 import Control.Monad.State
 import System.Random
+
+import Data.Bifunctor
+
+mvSpark :: World -> Particle -> (World, Maybe Particle)
+mvSpark w bt' 
+    | t <= 0 || magV (_ptVel bt) < 1 = (w,Nothing)
+    | otherwise = second (fmap dodrag) $ 
+        hiteff bt (thingsHit p (p +.+ vel) w) w
+  where
+    bt = bt'
+    dodrag = ptVel .*.*~ drag
+    drag = _ptDrag bt
+    (p:_)   = _ptTrail bt
+    vel     = _ptVel bt
+    hiteff  = _ptHitEff bt
+    t       = _ptTimer bt
+
 --import Control.Lens
 -- TODO remove/simplify this function
 createBarrelSpark :: Point2 -> Float -> Int -> Int -> World -> World

src/Dodge/Update.hs

@@ -218,7 +218,7 @@ updateFlares = flares %~ mapMaybe updateFlare
 updateBullets :: World -> World
 updateBullets w = updateInstantBullets $ set bullets (catMaybes ps) w'
   where 
-    (w',ps) = mapAccumR (\a b -> updateBullet a b) w $ _bullets w
+    (w',ps) = mapAccumR updateBullet w $ _bullets w
 
 {- Apply internal particle updates, delete 'Nothing's.  -}
 updateParticles :: World -> World
@@ -298,7 +298,7 @@ intersectSegSegs' _ _ _ = Nothing
 updateInstantBullets :: World -> World
 updateInstantBullets w = case _instantBullets w of
     [] -> w
-    ps -> let (w',ps') = mapAccumR (\a b -> updateBullet a b) (w {_instantBullets=[]}) ps
+    ps -> let (w',ps') = mapAccumR updateBullet (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.Spark
 import Dodge.Base.Wall
 import Dodge.Wall.Dust
 import Dodge.Block