Remove ptCrIgnore

src/Dodge/Creature/Damage.hs

@@ -38,7 +38,7 @@ applyDamageEffect dm de cr w = case de of
         & creatures . ix (_crID cr) . crDir +~ rot
     BounceBullet bt | crIsArmouredFrom p cr -> w & instantParticles .:~ bouncer
       where
-        bouncer = (aBulAt Nothing id (Just (_ptColor bt)) Nothing pOut reflectVel (_btDrag bt)
+        bouncer = (aBulAt Nothing id (Just (_ptColor bt)) pOut reflectVel (_btDrag bt)
                                           (_ptHitEff bt) (_ptWidth bt)
                   ) {_ptTimer = _ptTimer bt - 1}
         pOut = p +.+ 2 *.* newDir

src/Dodge/Creature/Inanimate.hs

@@ -71,7 +71,7 @@ updateExpBarrel cr w
     damages = _csDamage $ _crState cr
     pierceSparks :: [World -> World]
     pierceSparks 
-      = zipWith4 (\p a -> createBarrelSpark (_crPos cr +.+ p) (a + argV p) (Just $ _crID cr))
+      = zipWith4 (\p a -> createBarrelSpark (_crPos cr +.+ p) (a + argV p))
                             poss as times colids
     as =  randomRs (-0.7,0.7) g
     colids = randomRs (0,11) g

src/Dodge/Creature/State.hs

@@ -179,7 +179,6 @@ movementSideEff cr w
                 (oldPos +.+ (_crRad cr + 3) *.* unitVectorAtAngle (_crDir cr + pi))
                 20
                 (momentum +.+ 1 *.* rotateV randDir (vInverse v)) 
-                Nothing
                 1
                 20
         _   -> w

src/Dodge/Data.hs

@@ -670,21 +670,19 @@ data Particle
         , _btDrag   :: Float
         , _ptColor  :: Color
         , _ptTrail  :: [Point2]
-        , _ptCrIgnore :: Maybe Int
+        , _ptWidth  :: Float 
-        , _ptWidth :: Float 
+        , _ptTimer  :: Int
-        , _ptTimer :: Int
         , _ptHitEff :: HitEffect
         }
     | PtFlame  
         { _ptUpdate :: World -> Particle -> (World, Maybe Particle)
         , _ptVel    :: Point2
         , _ptColor  :: Color
-        , _ptPos :: Point2
+        , _ptPos    :: Point2
-        , _ptCrIgnore :: Maybe Int
+        , _ptWidth  :: Float 
-        , _ptWidth :: Float 
+        , _ptTimer  :: Int
-        , _ptTimer :: Int
         , _ptHitEff :: HitEffect
-        , _ptZ :: Float
+        , _ptZ      :: Float
         , _ptOriginalVel :: Point2
         }
     | PtIncBall  
@@ -692,7 +690,6 @@ data Particle
         , _ptVel    :: Point2
         , _ptColor  :: Color
         , _ptPos :: Point2
-        , _ptCrIgnore :: Maybe Int
         , _ptWidth :: Float 
         , _ptTimer :: Int
         , _ptHitEff :: HitEffect
@@ -704,7 +701,6 @@ data Particle
         , _ptVel    :: Point2
         , _ptColor  :: Color
         , _ptPos :: Point2
-        , _ptCrIgnore :: Maybe Int
         , _ptWidth :: Float 
         , _ptTimer :: Int
         , _ptHitEff :: HitEffect

src/Dodge/Item/Display.hs

@@ -16,13 +16,19 @@ import Data.Sequence
 itemString :: Item -> String
 itemString = head . itemDisplay
 
+itemBaseName :: Item -> String
+itemBaseName it = case  _iyBase $ _itType it of
+    CRAFT str -> show str
+    HELD str  -> show str
+    x -> show x
+
 itemDisplayWithNumber :: String -> Item -> [String]
 itemDisplayWithNumber numberstr it = Prelude.take (itSlotsTaken it) $
     (midPadL 15 ' ' thename (' ' : numberstr) ++ theparam)
     : catMaybes [maybeWarmupStatus it,maybeRateStatus it]
     ++ moduleStrings it ++ repeat "*"
   where 
-    thename  = show . _iyBase $ _itType it
+    thename  = itemBaseName it
     theparam = fromMaybe []
         . listToMaybe 
         $ mapMaybe ($ it) 

src/Dodge/Item/Weapon/AmmoParams.hs

@@ -40,15 +40,13 @@ useAmmoParams vfact it cr w = w & instantParticles .:~ aBulAt
     vfact 
     thetraj                     -- extra update
     Nothing                     -- color (default)
-    (Just cid)                  -- pass through creature
     sp
     (rotateV dir (muzvel *.* _amBulVel bultype))           -- vel
     (_rifling $ _itParams it)   -- drag
     (_amBulEff bultype) 
     (_amBulWth bultype) 
   where
-    sp = _crPos cr +.+ muzlength *.* unitVectorAtAngle dir
+    sp = _crPos cr +.+ (muzlength + 10) *.* unitVectorAtAngle dir
-    cid = _crID cr
     dir = _crDir cr
     bultype = _laAmmoType $ _itConsumption it
     muzvel = _muzVel $ _itParams it

src/Dodge/Item/Weapon/Launcher.hs

@@ -157,7 +157,7 @@ doThrust pj w = w
     & randGen .~ g
     & props . ix i . pjVel    %~ (\v -> accel +.+ frict *.* v)
     & soundContinue (ShellSound i) newPos missileLaunchS (Just 1)
-    & makeFlamelet (oldPos -.- vel) 0 (vel +.+ rotateV (pi+sparkD) accel) Nothing 3 10
+    & makeFlamelet (oldPos -.- vel) 0 (vel +.+ rotateV (pi+sparkD) accel) 3 10
     & shellTrailCloud (addZ 20 (oldPos +.+ r1 +.+ 30 *.* normalizeV (oldPos -.- newPos)))
   where
     accel = _pjAcc pj
@@ -302,7 +302,7 @@ moveRemoteShell cid itid pj w
                 )
             & soundContinue (ShellSound i) newPos missileLaunchS (Just 1)
             & smokeGen
-            & makeFlamelet oldPos 20 (0.5 *.* rotateV (pi+sparkD) accel) Nothing 3 10
+            & makeFlamelet oldPos 20 (0.5 *.* rotateV (pi+sparkD) accel) 3 10
     | time > -200 = w
     | otherwise = doExplosion
   where 

src/Dodge/Layout.hs

@@ -44,7 +44,6 @@ generateLevelFromRoomList gr' w = initWallZoning
     $ w { _walls        = wallsFromRooms rs
         , _gameRooms    = gameRoomsFromRooms (IM.elems rs')
         , _pathGraph    = path
---        , _pathGraphP   = pairPath
         }
         & pnZoning   %~ (\zn -> foldl' (flip $ updateZoning (:)) (zn & znObjects .~ mempty)
             (labNodes path))

src/Dodge/Particle/Bullet/Spawn.hs

@@ -14,21 +14,19 @@ aBulAt
     :: Maybe Float    -- ^ Start velocity step factor
     -> (Particle -> Particle)
     -> Maybe Color
-    -> Maybe Int -- ^ Pass-through creature id
     -> Point2   -- ^ Start position
     -> Point2  -- ^ Velocity
     -> Float    -- ^ Drag
     -> HitEffect 
     -> Float    -- ^ Bullet width
     -> Particle
-aBulAt vfact updatemod mcol maycid pos vel drag hiteff width = BulletPt
+aBulAt vfact updatemod mcol pos vel drag hiteff width = BulletPt
     { _ptUpdate = theupdate
     , _ptVel  = fromMaybe 1 vfact *.* vel
     , _btDrag = drag
     , _ptColor = fromMaybe (V4 200 200 200 2) mcol
 --    , _ptColor = V4 2 2 2 2
     , _ptTrail = [pos]
-    , _ptCrIgnore = maycid
     , _ptWidth = width
     , _ptTimer = 100
     , _ptHitEff = hiteff

src/Dodge/Particle/Bullet/Update.hs

@@ -16,12 +16,11 @@ mvBullet :: World -> Particle -> (World, Maybe Particle)
 mvBullet w bt' 
     | t <= 0 || magV (_ptVel bt) < 1 = (w,Nothing)
     | otherwise = second (fmap dodrag) $ 
-        hiteff bt (thingsHitExceptCr mcr p (p +.+ vel) w) w
+        hiteff bt (thingsHit p (p +.+ vel) w) w
   where
     bt = foldr (\mg b -> _mgField mg mg b) bt' $ _magnets w
     dodrag = ptVel .*.*~ drag
     drag = _btDrag bt
-    mcr     = _ptCrIgnore bt
     (p:_)   = _ptTrail bt
     vel     = _ptVel bt
     hiteff  = _ptHitEff bt

src/Dodge/Particle/Flame.hs

@@ -7,7 +7,8 @@ import LensHelp
 import System.Random
 
 makeFlame :: Point2 -> Point2 -> World -> World
-makeFlame pos vel w = w & instantParticles .:~ aFlameParticle t pos vel Nothing
+makeFlame pos vel w = w 
+    & instantParticles .:~ aFlameParticle t pos vel
     & randGen .~ g
   where 
     (t,g) = randomR (99,101) (_randGen w)

src/Dodge/Particle/Spark.hs

@@ -18,14 +18,13 @@ import Control.Monad.State
 import System.Random
 --import Control.Lens
 -- TODO remove/simplify this function
-createBarrelSpark :: Point2 -> Float -> Maybe Int -> Int -> Int -> World -> World
+createBarrelSpark :: Point2 -> Float -> Int -> Int -> World -> World
-createBarrelSpark pos dir maycid time colid = instantParticles .:~ BulletPt  
+createBarrelSpark pos dir time colid = instantParticles .:~ BulletPt  
     { _ptUpdate = mvBullet
     , _ptVel = rotateV dir (V2 5 0)
     , _btDrag = 0.9
     , _ptColor = numColor colid
     , _ptTrail = [pos]
-    , _ptCrIgnore = maycid
     , _ptWidth = 1
     , _ptTimer = time
     , _ptHitEff = expireAndDamage basicSparkDams
@@ -55,7 +54,6 @@ randColDirTimeSpark randcol randdir randtime pos w = w
         , _ptVel    = rotateV dir (V2 5 0)
         , _ptColor  = col
         , _ptTrail  = [pos]
-        , _ptCrIgnore = Nothing
         , _ptWidth = 1
         , _ptTimer = time
         , _ptHitEff = expireAndDamage basicSparkDams
@@ -74,7 +72,6 @@ colSparkRandDir randDir time col pos baseDir w = w
         , _ptVel = rotateV dir (V2 5 0)
         , _ptColor = col
         , _ptTrail = [pos]
-        , _ptCrIgnore = Nothing
         , _ptWidth = 1
         , _ptTimer = time
         , _ptHitEff = expireAndDamage basicSparkDams

src/Dodge/Particle/Update.hs

@@ -7,7 +7,6 @@ mvPt :: Particle -> Maybe Particle
 mvPt pt = Just $ pt
     & ptTrail %~ f
     & ptTimer -~ 1
-    & ptCrIgnore .~ Nothing
   where
     f trl = head trl +.+ _ptVel pt : trl
 

src/Dodge/Wall/DamageEffect.hs

@@ -135,7 +135,7 @@ wallDamageEffect dm wl w = case _dmEffect dm of
     BounceBullet bt -> w & instantParticles .:~ thebouncer
       where
         reflectVel = reflVelWall wl (_ptVel bt)
-        thebouncer = aBulAt Nothing id (Just (_ptColor bt)) Nothing pOut reflectVel (_btDrag bt) (_ptHitEff bt) (_ptWidth bt)
+        thebouncer = aBulAt Nothing id (Just (_ptColor bt)) pOut reflectVel (_btDrag bt) (_ptHitEff bt) (_ptWidth bt)
             & ptTimer .~ _ptTimer bt - 1
         pOut = p +.+ squashNormalizeV (sp -.- p)
         p = _dmAt dm

src/Dodge/WorldEvent/Explosion.hs

@@ -61,7 +61,7 @@ makeFlameExplosionAt p w
     & instantParticles .++~ newFlames
   where 
     newFlames = zipWith makeFlameWithVelAndTime velocities timers
-    makeFlameWithVelAndTime vel time = aFlameParticle time p vel Nothing
+    makeFlameWithVelAndTime vel time = aFlameParticle time p vel
     velocities = replicateM 15 (randInCirc 1) & evalState $ _randGen w
     timers     = randomRs (80,100) $ _randGen w
     -- the ( Nthing :: Maybe Int ) here is "maybe" a creature id that the
@@ -87,7 +87,7 @@ makeExplosionAt p w = w
     sizes = randomRs (2,9) $ _randGen w
     --times = randomRs (20,25) $ _randGen w
     times = randomRs (15,20) $ _randGen w
-    mF q z v size time = makeFlamelet q z v Nothing size time
+    mF q z v size time = makeFlamelet q z v size time
     newFs = zipWith5 mF fPs zs (fmap (3 *.*) fVs') sizes times
     addFlames w' = foldl' (flip ($)) w' newFs
     --pushAgainstWalls q = maybe q (uncurry (+.+)) $ reflectPointWalls p q wls

src/Dodge/WorldEvent/SpawnParticle.hs

@@ -31,42 +31,39 @@ aFlameParticle
     :: Int      -- ^ Timer
     -> Point2   -- ^ Position
     -> Point2   -- ^ Velocity
-    -> Maybe Int -- ^ Creature id
     -> Particle
-aFlameParticle t pos vel maycid = PtFlame
+aFlameParticle t pos vel = PtFlame
-    { _ptUpdate     = moveFlame vel
+    { _ptUpdate     = moveFlame
     , _ptVel        = vel
     , _ptColor      = red
     , _ptPos        = pos
-    , _ptCrIgnore   = maycid
     , _ptWidth      = 4
     , _ptTimer      = t
-    , _ptHitEff     = expireAndDamage $ simpleDam FLAMING 20
+    , _ptHitEff     = expireAndDamage $ simpleDam FLAMING 1
     , _ptZ           = 20
     , _ptOriginalVel = vel
     }
 {- TODO: add generalised area damage particles/hiteffects.  -}
-moveFlame :: Point2   -- ^ Rotation direction
+moveFlame :: World 
-    -> World 
     -> Particle
     -> (World, Maybe Particle)
-moveFlame rotd w pt 
+moveFlame w pt 
     | time <= 0 = (makeFlamerSmokeAt (addZ 20 ep) w, Nothing)
-    | otherwise = case runIdentity . S.head_ $ thingsHitExceptCr (_ptCrIgnore pt) sp ep w of
+    | otherwise = case runIdentity . S.head_ $ thingsHit sp ep w of
         Just (_,Left _)     -> (doSound $ dodamage w             , mvPt' 0.7)
         Just (p,Right wl)   -> (doSound $ dodamage w  , rfl wl p)
         _                   -> (ptFlicker pt $ doSound $ dodamage w    , mvPt' 0.98)
   where 
+    rotd = _ptOriginalVel pt
     time = _ptTimer pt
     doSound = soundContinue Flame (V2 x y) fireLoudS (Just 2)
     sp@(V2 x y) = _ptPos pt
     vel = _ptVel pt
     ep = sp +.+ vel
-    mvPt' speed = Just $ pt 
+    mvPt' drag = Just $ pt
-        { _ptTimer = time - 1
+        & ptTimer -~ 1
-        , _ptPos = ep
+        & ptPos .~ ep
-        , _ptCrIgnore = Nothing
+        & ptVel %~ (drag *.*)
-        , _ptVel = speed *.* vel    }
     dodamage = damageInArea closeCrs closeWls pt
     closeWls wl = uncurry segOnCirc (_wlLine wl) ep 5
     closeCrs cr = dist ep (_crPos cr) 
@@ -102,7 +99,6 @@ aStaticBall p = return PtStaticBall
     , _ptVel        = 0
     , _ptColor      = blue
     , _ptPos        = p
-    , _ptCrIgnore   = Nothing
     , _ptWidth      = 3
     , _ptTimer      = 20
     , _ptHitEff     = expireAndDamage $ simpleDam ELECTRICAL 20
@@ -113,22 +109,20 @@ makeFlamelet
     :: Point2       -- ^ Position
     -> Float        -- ^ z position
     -> Point2       -- ^ Velocity
-    -> Maybe Int    -- ^ Ignore creature id
     -> Float        -- ^ Size
     -> Int          -- ^ Timer
     -> World 
     -> World
-makeFlamelet (V2 x y) z vel maycid size time w = w
+makeFlamelet (V2 x y) z vel size time w = w
     & randGen   .~ g
     & instantParticles .:~ PtIncBall 
         { _ptUpdate     = moveFlamelet
         , _ptVel        = vel
         , _ptColor      = red
         , _ptPos        = V2 x y
-        , _ptCrIgnore   = maycid
         , _ptWidth      = size
         , _ptTimer      = time
-        , _ptHitEff     = expireAndDamage $ simpleDam FLAMING 20
+        , _ptHitEff     = expireAndDamage $ simpleDam FLAMING 1
         , _ptZ = z
         , _ptRot = rot
         }
@@ -218,10 +212,9 @@ incBall p = do
         , _ptVel        = 0
         , _ptColor      = red
         , _ptPos        = p
-        , _ptCrIgnore   = Nothing
         , _ptWidth      = 3
         , _ptTimer      = 20
-        , _ptHitEff     = expireAndDamage $ simpleDam FLAMING 20
+        , _ptHitEff     = expireAndDamage $ simpleDam FLAMING 1
         , _ptZ          = 20
         , _ptRot        = rot
         }
@@ -237,5 +230,4 @@ moveFlamelet w pt
     mvPt' = pt 
         & ptTimer    -~ 1
         & ptPos      .~ _ptPos pt +.+ _ptVel pt
-        & ptCrIgnore .~ Nothing
         & ptVel      .*.*~ 0.8

src/Dodge/Zone.hs

@@ -92,7 +92,7 @@ nearSeg f p r w = streamFromZone zn $ zoneOfSeg (_znSize zn) p r
   where
     zn = f w
 
-wlsNearSeg :: Point2 -> Point2 -> World -> Stream (Of Wall) Identity ()
+wlsNearSeg :: Point2 -> Point2 -> World -> StreamOf Wall
 {-# INLINE wlsNearSeg #-}
 wlsNearSeg = nearSeg _wlZoning