Refactor inverse shockwave

src/Dodge/Creature/Action.hs

@@ -171,7 +171,7 @@ blinkAction cr w
     . over radDistortion (distortionBulge ++)
     . set (creatures . ix cid . crPos) p3
     . blinkShockwave cid p3
-    $ inverseShockwaveAt cpos 40 2 2 2 w
+    $ inverseShockwaveAt cpos 40 2 2 w
   where
     distR = 120
     distortionBulge = 

src/Dodge/Data.hs

@@ -402,18 +402,18 @@ Update themselves, perhaps with side effects.  -}
 data Particle
     = Particle
         { _ptDraw :: Particle -> Picture
-        , _ptUpdate' :: World -> Particle -> (World, Maybe Particle)
+        , _ptUpdate :: World -> Particle -> (World, Maybe Particle)
         }
     | LinearParticle 
         { _ptDraw :: Particle -> Picture
-        , _ptUpdate' :: World -> Particle -> (World, Maybe Particle)
+        , _ptUpdate :: World -> Particle -> (World, Maybe Particle)
         , _ptPoints :: [Point2]
         , _ptTimer :: Int
         , _ptColor :: Color
         }
     | BulletPt  
         { _ptDraw :: Particle -> Picture
-        , _ptUpdate' :: World -> Particle -> (World, Maybe Particle)
+        , _ptUpdate :: World -> Particle -> (World, Maybe Particle)
         , _btVel' :: Point2
         , _btColor' :: Color
         , _btTrail' :: [Point2]
@@ -424,7 +424,7 @@ data Particle
         }
     | PtZ  
         { _ptDraw :: Particle -> Picture
-        , _ptUpdate' :: World -> Particle -> (World, Maybe Particle)
+        , _ptUpdate :: World -> Particle -> (World, Maybe Particle)
         , _btVel' :: Point2
         , _btColor' :: Color
         , _btPos' :: Point2
@@ -436,7 +436,7 @@ data Particle
         }
     | Shockwave' 
         { _ptDraw       :: Particle -> Picture
-        , _ptUpdate'    :: World -> Particle -> (World, Maybe Particle)
+        , _ptUpdate    :: World -> Particle -> (World, Maybe Particle)
         , _btColor'     :: Color
         , _btPos'       :: Point2
         , _btRad'       :: Float

src/Dodge/Item/Weapon/Decoration.hs

@@ -21,7 +21,7 @@ makeLaserScope p ep relFrac = Particle
         ,lineAlphaThick 0.2 1.5
         ,lineAlphaThick 0.1 2
         ]
-    ,_ptUpdate' = \w pt -> (w, Just $ pt & ptUpdate' .~ \w' _ -> (w',Nothing))
+    ,_ptUpdate = \w pt -> (w, Just $ pt & ptUpdate .~ \w' _ -> (w',Nothing))
     }
   where
     lineAlphaThick a w = 

src/Dodge/Item/Weapon/Grenade.hs

@@ -21,7 +21,7 @@ moveGrenade :: Prop -> World -> World
 moveGrenade pj w
     | _pjTimer pj <= 0 = w 
         & props %~ IM.delete pID 
-        & (_pjPayload pj) (_pjPos (_props w IM.! pID)) 
+        & _pjPayload pj (_pjPos (_props w IM.! pID)) 
     | otherwise = case collideCircWalls oldPos newPos 4 $ wallsNearPoint newPos w of
         Nothing -> w & props . ix pID %~ normalUpdate
         Just (p,v)  -> w

src/Dodge/Item/Weapon/Laser.hs

@@ -44,7 +44,7 @@ charToPhaseV _ = error "Trying to set an undefined phaseV"
 makeLaserAt :: Float -> Point2 -> Float -> Particle
 makeLaserAt phaseV pos dir = Particle
     { _ptDraw = const blank
-    , _ptUpdate' = moveLaser phaseV pos dir
+    , _ptUpdate = moveLaser phaseV pos dir
     }
 
 moveLaser 
@@ -56,7 +56,7 @@ moveLaser
     -> (World, Maybe Particle)
 moveLaser phaseV pos dir w pt
     = ( set randGen g $ hitEffect w
-      , Just pt {_ptDraw = const pic ,_ptUpdate' = ptTimer' 0 }
+      , Just pt {_ptDraw = const pic ,_ptUpdate = ptTimer' 0 }
       )
   where 
     xp = pos +.+ 800 *.* unitVectorAtAngle dir

src/Dodge/Item/Weapon/UseEffect.hs

@@ -28,7 +28,7 @@ aRadarPulse cr = over particles (radarPulseAt (_crPos cr) :)
 blipAt :: Point2 -> Color -> Int -> Particle
 blipAt p col i = Particle
     {_ptDraw = const blank
-    ,_ptUpdate' = mvBlip p col i i
+    ,_ptUpdate = mvBlip p col i i
     }
 mvBlip :: Point2 -> Color 
     -> Int  -- ^ Max possible timer value
@@ -37,7 +37,7 @@ mvBlip :: Point2 -> Color
 mvBlip _ _   _    0 w _ = (w, Nothing)
 mvBlip p col maxt t w pt = 
     (w
-    , Just $ pt & ptUpdate' .~ mvBlip p col maxt (t-1)
+    , Just $ pt & ptUpdate .~ mvBlip p col maxt (t-1)
         & ptDraw .~ ( const 
             . setDepth (-0.5)
             . setLayer 1
@@ -47,7 +47,7 @@ mvBlip p col maxt t w pt =
     )
 {- | An outwardly increasing circle that draws creatures, even those behind walls.  -}
 sonarPulseAt :: Point2 -> Particle
-sonarPulseAt p = Particle { _ptDraw = const blank , _ptUpdate' = mvSonar 100 p }
+sonarPulseAt p = Particle { _ptDraw = const blank , _ptUpdate = mvSonar 100 p }
 
 mvSonar 
     :: Int      -- ^ Timer
@@ -55,7 +55,7 @@ mvSonar
     -> World -> Particle -> (World, Maybe Particle)
 mvSonar 0 _ w _  = (w, Nothing)
 mvSonar x p w pt = (w, Just $ pt {_ptDraw = const pic
-                              ,_ptUpdate' = mvSonar (x-1) p
+                              ,_ptUpdate = mvSonar (x-1) p
                               }
                    )
   where 
@@ -77,7 +77,7 @@ An outwardly increasing circle that displays walls, even those behind other wall
 radarPulseAt :: Point2 -> Particle
 radarPulseAt p = Particle
     { _ptDraw = const blank
-    , _ptUpdate' = mvRadar 50 p
+    , _ptUpdate = mvRadar 50 p
     }
 mvRadar 
     :: Int      -- ^ Timer
@@ -86,7 +86,7 @@ mvRadar
 mvRadar 0 _ w _  = (w, Nothing)
 mvRadar x p w pt = 
     ( putBlips w
-    , Just $ pt {_ptDraw = const pic ,_ptUpdate' = mvRadar (x-1) p }
+    , Just $ pt {_ptDraw = const pic ,_ptUpdate = mvRadar (x-1) p }
     )
   where 
     pic = onLayerL [levLayer ShadowLayer, 1] $ pictures sweepPics

src/Dodge/Particle/Bullet/Spawn.hs

@@ -18,7 +18,7 @@ aGenBulAt
     -> Particle
 aGenBulAt maycid pos vel hiteff width = BulletPt
     { _ptDraw = drawBul
-    , _ptUpdate' = mvGenBullet
+    , _ptUpdate = mvGenBullet
     , _btVel' = vel
     , _btColor' = V4 2 2 2 2
     , _btTrail' = [pos]
@@ -37,7 +37,7 @@ aDelayedBulAt
     -> Particle
 aDelayedBulAt vfact maycid pos vel hiteff width = BulletPt
     { _ptDraw = drawBul
-    , _ptUpdate' = \w -> resetVel . mvGenBullet w
+    , _ptUpdate = \w -> resetVel . mvGenBullet w
     , _btVel' = vfact *.* vel
     , _btColor' = V4 2 2 2 2
     , _btTrail' = [pos]
@@ -47,7 +47,7 @@ aDelayedBulAt vfact maycid pos vel hiteff width = BulletPt
     , _btHitEffect' = hiteff
     }
   where
-    resetVel = second $ fmap $ (ptUpdate' .~ mvGenBullet) . (btVel' .~ vel)
+    resetVel = second $ fmap $ (ptUpdate .~ mvGenBullet) . (btVel' .~ vel)
 
 aCurveBulAt 
     :: Maybe Int -- ^ Pass-through creature id
@@ -60,7 +60,7 @@ aCurveBulAt
     -> Particle
 aCurveBulAt maycid col pos control targ hiteff width = BulletPt
     { _ptDraw = drawBul
-    , _ptUpdate' = \w -> mvGenBullet w . setVel
+    , _ptUpdate = \w -> mvGenBullet w . setVel
     , _btVel' = V2 0 0
     , _btColor' = col
     , _btTrail' = [pos]

src/Dodge/Render/Shape.hs

@@ -12,8 +12,8 @@ import Dodge.Render.ShapePicture
 import qualified Data.IntMap as IM
 worldShape :: World -> Shape
 worldShape w = _foregroundShape w 
-    <> foldMap (crShape w) (IM.elems $ IM.filter (pointIsClose . _crPos) (_creatures w))
+    <> foldMap (crShape w) (IM.filter (pointIsClose . _crPos) (_creatures w))
-    <> (foldMap (_spShape . floorItemSPic) $ IM.elems $ IM.filter (pointIsClose . _flItPos) $ _floorItems w)
+    <> foldMap (_spShape . floorItemSPic) (IM.filter (pointIsClose . _flItPos) $ _floorItems w)
     <> foldMap (_spShape . dbArg _prDraw) (IM.filter (pointIsClose . _pjPos) $ _props w)
   where
     pointIsClose p = dist camCen p < winSize

src/Dodge/Update.hs

@@ -129,7 +129,7 @@ Apply internal particle updates, delete 'Nothing's.  -}
 updateParticles :: World -> World
 updateParticles w = set particles (catMaybes ps) w'
   where 
-    (w',ps) = mapAccumR (\a b -> _ptUpdate' b a b) w $ _particles w
+    (w',ps) = mapAccumR (\a b -> _ptUpdate b a b) w $ _particles w
 
 -- Note that this updates the randgen
 updateCreatures :: World -> World

src/Dodge/WorldEvent.hs

@@ -36,7 +36,7 @@ createBarrelSpark pos dir maycid time colid w
   where 
     spark = BulletPt  
         { _ptDraw = drawBul
-        , _ptUpdate' = mvGenBullet
+        , _ptUpdate = mvGenBullet
         , _btVel' = rotateV dir (V2 5 0)
         , _btColor' = numColor colid
         , _btTrail' = [pos]

src/Dodge/WorldEvent/Flash.hs

@@ -60,7 +60,7 @@ glareBetween :: Int -> Float -> Float -> Color -> Point2 -> Point2 -> World -> M
 glareBetween 0 _   _    _   _ _ _ = Nothing
 glareBetween t len wdth col a b w = Just $ Particle 
     {_ptDraw = const $ lowLightPic len wdth col (a,b) w
-    ,_ptUpdate' = \ w' _ -> (w',glareBetween (t-1) len wdth col a b w')
+    ,_ptUpdate = \ w' _ -> (w',glareBetween (t-1) len wdth col a b w')
     }
 
 lowLightPic :: Float -> Float -> Color -> (Point2, Point2) -> World -> Picture
@@ -81,7 +81,7 @@ flashFlareAt :: Color -> Float -> Point2 -> Particle
 flashFlareAt col alphax (V2 x y) = Particle
     { _ptDraw = const $ setLayer 2 . setDepth (-0.9) . translate x y 
                         $ circleSolidCol (withAlpha 0 col) (withAlpha alphax col) 30
-    , _ptUpdate' = ptTimer' 1
+    , _ptUpdate = ptTimer' 1
     }
 
 explosionFlashAt :: Point2 -> World -> World
@@ -109,7 +109,7 @@ muzzleFlashPt (V2 x y) = Particle
                     . setLayer 2
                     . translate x y 
                     $ circleSolidCol (withAlpha 0 white) (withAlpha 0.2 white) 20
-    , _ptUpdate' = ptTimer' 1
+    , _ptUpdate = ptTimer' 1
     }
 
 laserScopeTargetGlow :: Color -> Point2 -> World -> World

src/Dodge/WorldEvent/HelperParticle.hs

@@ -6,4 +6,4 @@ import Dodge.Data
 {- A simple timer update for particles.  -}
 ptTimer' :: Int -> World -> Particle -> (World, Maybe Particle)
 ptTimer' 0 w _ = (w, Nothing)
-ptTimer' n w pt = (w, Just $ pt {_ptUpdate' = ptTimer' (n-1)})
+ptTimer' n w pt = (w, Just $ pt {_ptUpdate = ptTimer' (n-1)})

src/Dodge/WorldEvent/Shockwave.hs

@@ -27,46 +27,36 @@ makeShockwaveAt
     -> World
 makeShockwaveAt is p rad dam push col = over particles (theShockwave :)
   where 
-    theShockwave = shockwaveAt is p rad dam push col 10
+    theShockwave = Shockwave'
-
-shockwaveAt 
-    :: [Int]    -- ^ IDs of invulnerable creatures.
-    ->  Point2 -> Float -> Int -> Float -> Color -> Int -> Particle
-shockwaveAt is p rad dam push col maxtime
-    = Shockwave'
         { _ptDraw       = drawShockwave
-        , _ptUpdate'    = mvShockwave is
+        , _ptUpdate     = mvShockwave is
         , _btColor'     = col
         , _btPos'       = p
         , _btRad'       = rad
         , _btDam'       = dam
         , _btPush'      = push
-        , _btMaxTime'   = maxtime
+        , _btMaxTime'   = 10
-        , _btTimer'     = maxtime
+        , _btTimer'     = 10
         }
-
+{- Shockwave picture.  -}
-{-
-Shockwave picture.
--}
 drawShockwave :: Particle -> Picture
-drawShockwave pt = pic 
+drawShockwave pt = setDepth 20 
+    . setLayer 1 
+    . uncurryV translate (_btPos' pt) 
+    . color (_btColor' pt) 
+    $ thickCircle rad thickness
   where
-    pic = setDepth 20 . setLayer 1 . uncurryV translate p 
-                          $ color (_btColor' pt) $ thickCircle rad thickness
-    p    = _btPos' pt
     r    = _btRad' pt
     thickness = tFraction**2 * r 
     rad = r - (3/4) * r * tFraction
-    tFraction = fromIntegral t / fromIntegral (_btMaxTime' pt)
+    tFraction = fromIntegral (_btTimer' pt) / fromIntegral (_btMaxTime' pt)
-    t    = _btTimer' pt
 
 mvShockwave
     :: [Int]    -- ^ IDs of invulnerable creatures.
     -> World -> Particle -> (World, Maybe Particle)
 mvShockwave is w pt 
-    | _btTimer' pt <= 0 = (w, Nothing)
+    | _btTimer' pt <= 0 = (       w , Nothing)
-    | otherwise
+    | otherwise         = (doDams w , Just $ pt & btTimer' -~ 1)
-        = (dams w , Just $ set btTimer' (t - 1) pt) --  $ set ptDraw (const pic) pt)
   where 
     r    = _btRad' pt
     p    = _btPos' pt
@@ -75,56 +65,59 @@ mvShockwave is w pt
     t    = _btTimer' pt
     tFraction = fromIntegral t / fromIntegral (_btMaxTime' pt)
     rad = r - (3/4) * r * tFraction
-    dams = over creatures (IM.map damCr) . flip (IM.foldr (damageBlocksBy 1)) hitBlocks
+    doDams = over creatures (IM.map damCr) . flip (IM.foldl' (flip $ damageBlocksBy 1)) hitBlocks
     hitBlocks = wallsOnCirc p rad $ wallsNearPoint p w 
-    damCr cr | _crID cr `elem` is = cr
+    damCr cr 
-             | dist (_crPos cr) p < rad + _crRad cr 
+        | _crID cr `elem` is || dist (_crPos cr) p >= rad + _crRad cr  = cr
-                          = over (crState . crDamage) 
+        | otherwise = cr & crState . crDamage %~
-                                 ((:) $ PushDam dam (25 * push *.* safeNormalizeV (_crPos cr -.- p)))
+            (PushDam dam (25 * push *.* safeNormalizeV (_crPos cr -.- p)) : )
-                                 cr
+{- Create a shockwave going from an outside circle into a center point.  -}
-             | otherwise  = cr
-
--------------------------------------------------
-
-{-
-Create a shockwave going from an outside circle into a center point.
- -}
 inverseShockwaveAt 
     :: Point2   -- Center position
     -> Float    -- Radius
     -> Int      -- Damage
     -> Float    -- Push amount
-    -> Float    -- Push amount parameter
     -> World 
     -> World
-inverseShockwaveAt p rad _ push pushexp = over particles (theShockwave :)
+inverseShockwaveAt p rad dam push = over particles (theShockwave :)
   where 
-    theShockwave = Particle
+    theShockwave = Shockwave'
-        { _ptDraw = const blank
+        { _ptDraw = drawInverseShockwave
-        , _ptUpdate' = moveInverseShockWave 10 p rad push pushexp
+        , _ptUpdate = moveInverseShockwave
+        , _btColor'     = cyan
+        , _btPos'       = p
+        , _btRad'       = rad
+        , _btDam'       = dam
+        , _btPush'      = push
+        , _btMaxTime'   = 10
+        , _btTimer'     = 10
         }
-moveInverseShockWave 
+moveInverseShockwave 
-    :: Int      -- ^ Timer
+    :: World
-    -> Point2   -- ^ Center position
-    -> Float    -- ^ Radius
-    -> Float    -- ^ Push amount
-    -> Float    -- ^ Push amount parameter
-    -> World
     -> Particle 
     -> (World, Maybe Particle)
-moveInverseShockWave 0 _ _ _    _       w _  = (w, Nothing)
+moveInverseShockwave w pt 
-moveInverseShockWave t p r push pushexp w pt 
+    | t <= 0    = (     w, Nothing)
-    = (dams w, Just $ newupdate $ newpic pt )
+    | otherwise = (dams w, Just $ btTimer' -~ 1 $ pt )
   where 
-    newupdate = set ptUpdate' $ moveInverseShockWave (t-1) p r push pushexp
+    p = _btPos' pt
-    newpic = set ptDraw (const $ onLayer PtLayer $ uncurryV translate p 
+    r = _btRad' pt
-                          $ color cyan $ thickCircle rad thickness)
+    t = _btTimer' pt
-    rad = r - (4/40) * r * fromIntegral (10 - t)
+    rad = r - 0.1 * r * fromIntegral (10 - t)
-    thickness = fromIntegral (10 - t) **2 * rad / 40
     dams = over creatures (IM.map damCr) . flip (foldr (damageBlocksBy 1)) hitBlocks
     hitBlocks = wallsOnCirc p rad $ wallsNearPoint p w 
-    damCr cr | dist (_crPos cr) p < rad + _crRad cr 
+    damCr cr 
-                          = over (crState . crDamage) 
+        | dist (_crPos cr) p >= rad + _crRad cr = cr
-                                 ((:) $ PushDam 1 (25 *.* safeNormalizeV (p -.- _crPos cr)))
+        | otherwise = cr & crState . crDamage %~
-                                 cr
+            (PushDam 1 (25 *.* safeNormalizeV (p -.- _crPos cr)) :)
-             | otherwise  = cr
+
+drawInverseShockwave :: Particle -> Picture
+drawInverseShockwave  pt 
+    = setLayer 1 $ onLayer PtLayer $ uncurryV translate p 
+                          $ color cyan $ thickCircle rad thickness
+  where
+    p = _btPos' pt
+    r = _btRad' pt
+    t = _btTimer' pt
+    rad = r - 0.1 * r * fromIntegral (10 - t)
+    thickness = fromIntegral (10 - t) **2 * rad / 40

src/Dodge/WorldEvent/SpawnParticle.hs

@@ -44,7 +44,7 @@ aFlameParticle
     -> Particle
 aFlameParticle t pos vel maycid = PtZ
     { _ptDraw         = drawFlame vel
-    , _ptUpdate'      = moveFlame vel
+    , _ptUpdate      = moveFlame vel
     , _btVel'         = vel
     , _btColor'       = red
     , _btPos'         = pos
@@ -152,7 +152,7 @@ makeFlameletTimed (V2 x y) z vel maycid size time w = w
   where   
     theFlamelet = PtZ 
         { _ptDraw         = drawFlameletZ rot
-        , _ptUpdate'      = moveFlamelet
+        , _ptUpdate      = moveFlamelet
         , _btVel'         = vel
         , _btColor'       = red
         , _btPos'         = V2 x y
@@ -307,7 +307,7 @@ makeTeslaArcAt :: Color -> Point2 -> Float -> Particle
 makeTeslaArcAt col pos dir = LinearParticle
     { _ptPoints = [pos]
     , _ptDraw = drawTeslaArc
-    , _ptUpdate' = moveTeslaArc pos dir
+    , _ptUpdate = moveTeslaArc pos dir
     , _ptTimer = 2
     , _ptColor = brightX 100 1.5 col
     }
@@ -460,7 +460,7 @@ createSparkCol time col pos dir w
   where 
     spark = BulletPt
         { _ptDraw = drawBul
-        , _ptUpdate' = mvGenBullet
+        , _ptUpdate = mvGenBullet
         , _btVel' = rotateV dir (V2 5 0)
         , _btColor' = col
         , _btTrail' = [pos]

src/Loop.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE TupleSections #-}
+--{-# LANGUAGE TupleSections #-}
 {- |
 Module      : Loop
 Description : Simple game loop