Move bullet bouncing into separate datatype field

src/Dodge/Bullet.hs

@@ -1,15 +1,21 @@
 module Dodge.Bullet where
+import Dodge.Particle.Damage
+import Dodge.Creature.Test
 import Dodge.Data
+import Dodge.Particle.HitEffect.ExpireAndDamage
 import Dodge.Creature.HandPos
 import Dodge.Base.Coordinate
+import Dodge.Base.Wall
 import Geometry
 import LensHelp
+import StreamingHelp
 
+import qualified Streaming.Prelude as S
 import Data.Maybe
 import Dodge.Movement.Turn
 import Dodge.WorldEvent.ThingsHit
 
-import Data.Bifunctor
+--import Data.Bifunctor
 
 updateBullet :: World -> Bullet -> (World,Maybe Bullet)
 updateBullet w bu = case _buState bu of
@@ -22,12 +28,16 @@ aBulAt
     -> Point2   -- ^ Start position
     -> Point2  -- ^ Velocity
     -> Float    -- ^ Drag
-    -> HitEffect' 
+--    -> HitEffect' 
     -> Float    -- ^ Bullet width
     -> BulletTrajectory
+    -> BulletEffect
+    -> BulletSpawn
     -> Bullet
-aBulAt vfact pos vel drag hiteff width butraj = Bullet
+aBulAt vfact pos vel drag width butraj be bs = Bullet
     { _buState = bulstate
+    , _buSpawn = bs
+    , _buEffect = be
     , _buUpdateMod = NoBulletUpdateMod
     , _buTrajectory = butraj
     , _buVel  = vel
@@ -36,7 +46,6 @@ aBulAt vfact pos vel drag hiteff width butraj = Bullet
     , _buOldPos = pos
     , _buWidth = width
     , _buTimer = 100
-    , _buHitEff = hiteff
     }
   where
     bulstate = maybe NormalBulletState DelayedBullet vfact
@@ -47,9 +56,10 @@ useAmmoParams vfact it cr w = w & instantBullets .:~ aBulAt
     sp
     (rotateV dir (muzvel *.* _amBulVel bultype))           -- vel
     (_rifling $ _itParams it)   -- drag
-    (_amBulEff bultype) 
     (_amBulWth bultype) 
     thetraj
+    (_amBulEffect bultype)
+    (_amBulSpawn bultype)
   where
     sp = _crPos cr +.+ (muzlength + 10) *.* unitVectorAtAngle dir
     dir = _crDir cr
@@ -77,9 +87,31 @@ useAmmoParams vfact it cr w = w & instantBullets .:~ aBulAt
 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
+    | otherwise = bimap maybebounce (fmap dodrag) $ 
+        hiteff bt hitstream w
   where
+    maybebounce = case _buEffect bt' of
+        BounceBullet -> case runIdentity (S.head_ hitstream) of
+            Just (hp, Left cr) | crIsArmouredFrom hp cr -> instantBullets .:~ bouncer
+              where
+                bouncer = (aBulAt Nothing pOut reflectVel (_buDrag bt) (_buWidth bt) 
+                            BasicBulletTrajectory (_buEffect bt) (_buSpawn bt)
+                          ) {_buTimer = _buTimer bt - 1}
+                pOut = hp +.+ 2 *.* newDir
+                reflectVel = magV bulVel *.* newDir
+                newDir = squashNormalizeV (hp -.- _crPos cr)
+                bulVel = _buVel bt
+            Just (hp, Right wl) -> instantBullets .:~ thebouncer
+              where
+                reflectVel = reflVelWall wl (_buVel bt)
+                thebouncer = aBulAt Nothing --id 
+                    pOut reflectVel (_buDrag bt) (_buWidth bt) BasicBulletTrajectory (_buEffect bt)
+                        (_buSpawn bt)
+                    & buTimer .~ _buTimer bt - 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
     dodrag = case _buTrajectory bt of
         BasicBulletTrajectory -> buVel .*.*~ drag
@@ -91,8 +123,33 @@ mvBullet w bt'
     drag = _buDrag bt
     p       = _buPos bt
     vel     = _buVel bt
-    hiteff  = _buHitEff bt
+    hiteff  = hitEffFromBul
     t       = _buTimer bt
+    --BounceBullet bt -> w & instantBullets .:~ thebouncer
+    --  where
+    --    reflectVel = reflVelWall wl (_buVel 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
+    --    sp = _dmFrom dm
+--    BounceBullet bt | crIsArmouredFrom p cr -> w & instantBullets .:~ bouncer
+--      where
+--        bouncer = (aBulAt Nothing pOut reflectVel (_buDrag bt) (_buHitEff bt) (_buWidth bt) 
+--                    BasicBulletTrajectory
+--                  ) {_buTimer = _buTimer bt - 1}
+--        pOut = p +.+ 2 *.* newDir
+--        reflectVel = magV bulVel *.* newDir
+--        newDir = squashNormalizeV (p -.- _crPos cr)
+--        bulVel = _buVel bt
+--    BounceBullet _ -> w
+
+hitEffFromBul :: Bullet
+    -> Stream (Of (Point2, Either Creature Wall)) Identity ()
+    -> World 
+    -> (World,Maybe Bullet)
+hitEffFromBul = expireAndDamage' basicBulDams
 
 mvBulletSlow :: Float -> World -> Bullet -> (World, Maybe Bullet)
 mvBulletSlow x w bt' 
@@ -106,5 +163,5 @@ mvBulletSlow x w bt'
     drag = _buDrag bt
     p       = _buPos bt
     vel     = x *.* _buVel bt
-    hiteff  = _buHitEff bt
+    hiteff  = hitEffFromBul
     t       = _buTimer bt