Refactor bouncing bullets

src/Dodge/Bullet.hs

@@ -1,10 +1,12 @@
-module Dodge.Bullet where
+module Dodge.Bullet 
+    ( updateBullet
+    , useAmmoParams
+    ) where
 import Dodge.WorldEvent.SpawnParticle
 import Dodge.Creature.Test
 import Dodge.Data
 import Dodge.Creature.HandPos
 import Dodge.Base.Coordinate
-import Dodge.Base.Wall
 import Geometry
 import LensHelp
 import StreamingHelp
@@ -24,34 +26,6 @@ updateBullet w bu = case _buState bu of
     DelayedBullet x -> mvBulletSlow x w bu
     _ -> mvBullet w bu
 
-aBulAt
-    :: Maybe Float    -- ^ Start velocity step factor
-    -> Point2   -- ^ Start position
-    -> Point2  -- ^ Velocity
-    -> Float    -- ^ Drag
-    -> Float    -- ^ Bullet width
-    -> BulletTrajectory
-    -> BulletEffect
-    -> BulletSpawn
-    -> [Damage]
-    -> Bullet
-aBulAt vfact pos vel drag width butraj be bs dams = Bullet
-    { _buState = bulstate
-    , _buSpawn = bs
-    , _buEffect = be
-    , _buUpdateMod = NoBulletUpdateMod
-    , _buTrajectory = butraj
-    , _buVel  = vel
-    , _buDrag = drag
-    , _buPos = pos
-    , _buOldPos = pos
-    , _buWidth = width
-    , _buTimer = 100
-    , _buDamages = dams
-    }
-  where
-    bulstate = maybe NormalBulletState DelayedBullet vfact
-
 useAmmoParams :: Maybe Float -> Item -> Creature -> World -> World
 useAmmoParams vfact it cr w = w & instantBullets .:~ (_amBullet bultype
     & buPos .~ sp 
@@ -94,27 +68,40 @@ mvBullet w bt'
         let (thepart,g) = runState (partspawn hp) $ _randGen w'
         return $ w' & instantParticles .:~ thepart
             & randGen .~ g
-    maybebounce = case _buEffect bt' of
+    maybebounce = fromMaybe id $ do
-        BounceBullet -> case runIdentity (S.head_ hitstream) of
+        guard (_buEffect bt' == BounceBullet)
-            Just (hp, Left cr) | crIsArmouredFrom hp cr -> instantBullets .:~ bouncer
+        (hp,crwl) <- runIdentity (S.head_ hitstream)
-              where
+        dir <- bounceDir (hp,crwl)
-                bouncer = (aBulAt Nothing pOut reflectVel (_buDrag bt) (_buWidth bt) 
+        return $ instantBullets .:~ (bt
-                            BasicBulletTrajectory (_buEffect bt) (_buSpawn bt) (_buDamages bt)
+            & buPos .~ hp +.+ (normalizeV (_buPos bt' -.- hp))
-                          ) {_buTimer = _buTimer bt - 1}
+            & buVel %~ reflectIn dir
-                pOut = hp +.+ 2 *.* newDir
+            & buTrajectory .~ BasicBulletTrajectory
-                reflectVel = magV bulVel *.* newDir
+            & buTimer -~ 1
-                newDir = squashNormalizeV (hp -.- _crPos cr)
+            )
-                bulVel = _buVel bt
+    --maybebounce = case _buEffect bt' of
-            Just (hp, Right wl) -> instantBullets .:~ thebouncer
+    --    BounceBullet -> case runIdentity (S.head_ hitstream) of
-              where
+    --        Just (hp, Left cr) | crIsArmouredFrom hp cr -> instantBullets .:~ bouncer
-                reflectVel = reflVelWall wl (_buVel bt)
+    --          where
-                thebouncer = aBulAt Nothing --id 
+    --            bouncer = bt
-                    pOut reflectVel (_buDrag bt) (_buWidth bt) BasicBulletTrajectory (_buEffect bt)
+    --                & buPos .~ pOut 
-                        (_buSpawn bt) (_buDamages bt)
+    --                & buVel .~ reflectVel 
-                    & buTimer .~ _buTimer bt - 1
+    --                & buTrajectory .~ BasicBulletTrajectory
-                pOut = hp +.+ squashNormalizeV (p -.- hp)
+    --                & buTimer -~ 1
-            _ -> id
+    --            pOut = hp +.+ 2 *.* newDir
-        _ -> id
+    --            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
     dodrag = case _buTrajectory bt of
@@ -130,6 +117,11 @@ mvBullet w bt'
     hiteff  = hitEffFromBul
     t       = _buTimer bt
 
+bounceDir :: (Point2, Either Creature Wall) -> Maybe Point2
+bounceDir (_,Right wl) = Just $ uncurry (-.-) (_wlLine wl)
+bounceDir (p,Left  cr) | crIsArmouredFrom p cr = Just $ vNormal $ p -.- _crPos cr
+bounceDir _ = Nothing
+
 bulletSpawn :: Bullet -> Maybe (Point2 -> State StdGen Particle)
 bulletSpawn bu = case _buSpawn bu of
     BulSpark -> Nothing
@@ -167,10 +159,11 @@ expireAndDamage' :: (Bullet -> Point2 -> [Damage])
     -> World
     -> (World, Maybe Bullet)
 expireAndDamage' fdm bt things w = case runIdentity $ S.head_ things of
-    Nothing -> (w, mvPt bt)
+    Nothing -> (w, moveBullet bt)
     Just x -> (doDamages' fdm x bt w, destroyAt' (fst x) bt)
-mvPt :: Bullet -> Maybe Bullet
+
-mvPt pt = Just $ pt
+moveBullet :: Bullet -> Maybe Bullet
+moveBullet pt = Just $ pt
     & buPos %~ (+.+ _buVel pt)
     & buOldPos .~ _buPos pt
     & buTimer -~ 1
@@ -182,22 +175,22 @@ destroyAt' hitp pt = Just $ pt
     & buOldPos  .~ _buPos pt
     & buTimer   %~ (min 3 . subtract 1)
 
-penWalls 
+--penWalls 
-    :: HitCreatureEffect' 
+--    :: HitCreatureEffect' 
-    -> HitWallEffect' 
+--    -> HitWallEffect' 
-    -> Bullet 
+--    -> Bullet 
-    -> [(Point2, Either Creature Wall)] 
+--    -> [(Point2, Either Creature Wall)] 
-    -> World 
+--    -> World 
-    -> (World, Maybe Bullet)
+--    -> (World, Maybe Bullet)
-penWalls crEff wlEff pt hitThings w = case hitThings of
+--penWalls crEff wlEff pt hitThings w = case hitThings of
-    []              -> (              w, mvPt pt)
+--    []              -> (              w, moveBullet pt)
-    ((p,Left cr):_) -> (crEff pt p cr w, destroyAt' p pt)
+--    ((p,Left cr):_) -> (crEff pt p cr w, destroyAt' p pt)
-    ((p,Right wl):hs) | _wlFireThrough wl 
+--    ((p,Right wl):hs) | _wlFireThrough wl 
-                    -> first (wlEff pt p wl) $ penWalls crEff wlEff pt hs w
+--                    -> first (wlEff pt p wl) $ penWalls crEff wlEff pt hs w
-    ((p,Right wl):_) -> (wlEff pt p wl w, destroyAt' p pt)
+--    ((p,Right wl):_) -> (wlEff pt p wl w, destroyAt' p pt)
 
-type HitCreatureEffect'   = Bullet -> Point2 -> Creature   -> World -> World
+--type HitCreatureEffect'   = Bullet -> Point2 -> Creature   -> World -> World
-type HitWallEffect'       = Bullet -> Point2 -> Wall       -> World -> World
+--type HitWallEffect'       = Bullet -> Point2 -> Wall       -> World -> World
 
 doDamages' :: (Bullet -> Point2 -> [Damage])
     -> (Point2, Either Creature Wall)
@@ -210,17 +203,17 @@ doDamages' fdm (p,thhit) bt = case thhit of
   where
     dams = fdm bt p
 
-penetrate 
+--penetrate 
-    :: ((Point2,Either Creature Wall) -> Bullet -> Maybe Bullet) 
+--    :: ((Point2,Either Creature Wall) -> Bullet -> Maybe Bullet) 
-        -- | penetration test, can update particle if it penetrates
+--        -- | penetration test, can update particle if it penetrates
-    -> (Bullet -> Point2 -> [Damage]) -- | damages when penetrating
+--    -> (Bullet -> Point2 -> [Damage]) -- | damages when penetrating
-    -> (Bullet -> Point2 -> [Damage]) -- | damages when not penetrating
+--    -> (Bullet -> Point2 -> [Damage]) -- | damages when not penetrating
-    -> Bullet
+--    -> Bullet
-    -> Stream (Of (Point2, Either Creature Wall)) Identity ()
+--    -> Stream (Of (Point2, Either Creature Wall)) Identity ()
-    -> World
+--    -> World
-    -> (World, Maybe Bullet)
+--    -> (World, Maybe Bullet)
-penetrate t pendam stopdam pt hitThings w = case runIdentity $ S.uncons hitThings of
+--penetrate t pendam stopdam pt hitThings w = case runIdentity $ S.uncons hitThings of
-    Nothing -> (w, mvPt pt)
+--    Nothing -> (w, moveBullet pt)
-    Just (x,xs) -> case t x pt of
+--    Just (x,xs) -> case t x pt of
-        Nothing -> expireAndDamage' stopdam pt hitThings w
+--        Nothing -> expireAndDamage' stopdam pt hitThings w
-        Just pt' -> first (doDamages' pendam x pt) $ penetrate t pendam stopdam pt' xs w
+--        Just pt' -> first (doDamages' pendam x pt) $ penetrate t pendam stopdam pt' xs w

src/Dodge/Data/Bullet.hs

@@ -27,6 +27,7 @@ data BulletEffect
     = DestroyBullet
     | BounceBullet
     | PenetrateBullet
+  deriving (Eq,Ord,Show,Read,Enum,Bounded)
 data BulletSpawn = BulBall EnergyBall | BulSpark
 data BulletTrajectory
     = BasicBulletTrajectory

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

@@ -112,7 +112,7 @@ repeater :: Item
 repeater = rifle
     & itType . iyModules . at ModRifleMag ?~ EMPTYMODULE
     & itType . iyBase .~ HELD REPEATER
-    & itConsumption . laCycle .~ [loadEject 50, loadInsert 40 ,loadPrime 20]
+    & itConsumption . laCycle .~ [loadEject 20, loadInsert 20 ,loadPrime 20]
     & itConsumption . laMax .~ 15
 
 

src/Geometry.hs

@@ -115,6 +115,9 @@ difference x y
 reflectIn :: Point2 -> Point2 -> Point2
 reflectIn line vec = rotateV (2 * angleBetween line vec) vec
 
+reflectIn' :: Point2 -> Point2 -> Point2
+reflectIn' line vec = rotateV (2 * angleBetween vec line) vec
+
 -- | Find angle between two points.
 -- Not normalised, ranges from -2*pi to 2*pi.
 angleBetween :: Point2 -> Point2 -> Float