Cleanup warnings

src/Dodge/WorldEvent/Bullet.hs

@@ -4,20 +4,16 @@ Bullet update.
 module Dodge.WorldEvent.Bullet
     where
 import Dodge.Data
-import Dodge.Base
-
+--import Dodge.Base
 import Dodge.WorldEvent.ThingsHit
-
-import Picture
+--import Picture
 import Geometry
 
 import Control.Lens
-
-import Data.Maybe
-import Data.List
-import Data.Function (on)
-import Data.Bifunctor
-import qualified Data.IntMap.Strict as IM
+--import Data.Maybe
+--import Data.List
+--import Data.Bifunctor
+--import qualified Data.IntMap.Strict as IM
 
 {-
 Update for a generic bullet.
@@ -32,9 +28,7 @@ mvGenBullet' w bt
     | otherwise = hiteff bt (thingsHitExceptCr mcr p (p +.+ vel) w) w
   where 
     mcr     = _btPassThrough' bt
-    col     = _btColor' bt
     (p:ps)  = _btTrail' bt
     vel     = _btVel' bt
     hiteff  = _btHitEffect' bt
-    wth     = _btWidth' bt
     t       = _btTimer' bt

src/Dodge/WorldEvent/Cloud.hs

@@ -3,9 +3,7 @@ module Dodge.WorldEvent.Cloud
 
 import Dodge.Data
 import Dodge.Base
-
-import Geometry
-
+--import Geometry
 import Picture
 
 import Control.Lens

src/Dodge/WorldEvent/DamageBlock.hs

@@ -0,0 +1,16 @@
+module Dodge.WorldEvent.DamageBlock
+    ( damageBlocksBy
+    )
+    where
+import Dodge.Data
+
+import Data.Maybe
+import Control.Lens
+{- | Given a wall, if it is a damageable block
+ - then damage it and connecting walls by a certain amount.  -}
+damageBlocksBy :: Int -> Wall -> World -> World
+{-# INLINE damageBlocksBy #-}
+damageBlocksBy x wall w
+        | isJust (wall ^? blHP) = foldr (\j -> walls . ix j . blHP -~ x) w (_blIDs wall)
+        | otherwise = w
+

src/Dodge/WorldEvent/Explosion.hs

@@ -3,7 +3,6 @@ Explosions: creation of shockwave and particles at a given point.
  -}
 module Dodge.WorldEvent.Explosion
   where
-
 import Dodge.Data
 import Dodge.Base
 import Dodge.WorldEvent.SpawnParticle
@@ -16,7 +15,7 @@ import Picture
 
 import Control.Monad.State
 import Data.List
-import Data.Maybe
+--import Data.Maybe
 import System.Random
 import qualified Data.IntMap.Strict as IM
 import Control.Lens
@@ -78,6 +77,6 @@ makeExplosionAt p w
     times = randomRs (20,25) $ _randGen w
     mF q v size time = makeFlameletTimed q v Nothing size time
     newFs = zipWith4 mF fPs (fmap (3 *.*) fVs') sizes times
-    addFlames w = foldr ($) w newFs
+    addFlames w' = foldr ($) w' newFs
     pushAgainstWalls q = maybe q (uncurry (+.+)) $ reflectPointWalls p q $ wallsNearPoint q w
 

src/Dodge/WorldEvent/Flash.hs

@@ -11,18 +11,15 @@ flicker : potentially long, moving, abrupt changes in alpha
 module Dodge.WorldEvent.Flash
     where
 import Dodge.Data
-import Dodge.Base
+--import Dodge.Base
 import Dodge.Picture
 import Dodge.LightSources
-
 import Dodge.WorldEvent.ThingsHit
 import Dodge.WorldEvent.HelperParticle
-
 import Picture
 import Geometry
 
 import Data.Maybe (maybeToList)
-
 import Control.Lens
 
 glareAt :: Int -> Float -> Float -> Color -> Int -> Float -> Point2 -> World -> World
@@ -70,12 +67,13 @@ lowLightPic :: Float -> Float -> Color -> (Point2, Point2) -> World -> Picture
 lowLightPic len wdth col (a,b) w = case thingsHit a b w of
         ((p, E3x2 wall):_) 
             -> setCol . lineOfThickness wdth $ [alongSegBy len p wa, alongSegBy len p wb]
-                where x = len *.* normalizeV (wa -.- wb)
-                      (wa,wb) = _wlLine wall
+              where 
+                (wa,wb) = _wlLine wall
         ((p, E3x1 cr):_) 
             -> setCol . uncurry translate cp . rotate (-0.25 * pi + argV (p -.- cp))
                     $ thickArc 0 (pi/2) (_crRad cr) wdth
-                where cp = _crPos cr
+              where 
+                cp = _crPos cr
         _   -> blank
   where setCol = color col . setDepth (-0.5) . setLayer 2
 
@@ -93,6 +91,7 @@ explosionFlashAt p =  over tempLightSources ((:) $ tLightFade 20 150 intensityFu
             | x < 10 = 1 / (10 - fromIntegral x)
             | otherwise = 1
 
+flameGlareAt :: Point2 -> World -> World
 flameGlareAt = glareAt 1 10 5 (withAlpha 0.05 orange) 8 40
 
 lowLightDirected :: Color -> Point2 -> Point2 -> [Float] -> World -> World

src/Dodge/WorldEvent/HelperParticle.hs

@@ -1,14 +1,9 @@
-{-
-Helper functions for particles.
--}
+{- Helper functions for particles.  -}
 module Dodge.WorldEvent.HelperParticle
     where
-
 import Dodge.Data
 
-{-
-A simple timer update for particles.
--}
+{- A simple timer update for particles.  -}
 ptTimer' :: Int -> World -> Particle -> (World, Maybe Particle)
-ptTimer' 0 w pt = (w, Nothing)
+ptTimer' 0 w _ = (w, Nothing)
 ptTimer' n w pt = (w, Just $ pt {_ptUpdate' = ptTimer' (n-1)})

src/Dodge/WorldEvent/HitEffect.hs

@@ -2,21 +2,25 @@ module Dodge.WorldEvent.HitEffect
     where
 import Dodge.Data
 import Dodge.Creature.State.Data
-
 import Geometry
 
 import Data.Bifunctor
 import Data.Maybe
-
 import Control.Lens
 
 type HitCreatureEffect   = Particle -> Point2 -> Creature   -> World -> World
 type HitWallEffect       = Particle -> Point2 -> Wall       -> World -> World
 type HitForceFieldEffect = Particle -> Point2 -> ForceField -> World -> World
 
-passThroughAll :: HitCreatureEffect -> HitWallEffect -> HitForceFieldEffect ->
-     Particle -> [(Point2, Either3 Creature Wall ForceField)] -> World -> (World, Maybe Particle)
-passThroughAll crEff wlEff ffEff pt hitThings w = (w, mvPt)
+passThroughAll 
+    :: HitCreatureEffect 
+    -> HitWallEffect 
+    -> HitForceFieldEffect 
+    -> Particle 
+    -> [(Point2, Either3 Creature Wall ForceField)] -- ^ hit things
+    -> World 
+    -> (World, Maybe Particle)
+passThroughAll _ _ _ pt _ w = (w, mvPt)
   where 
     mvPt = Just $ pt & btTrail' .~ (newP : trl)
                      & btTimer' %~ (\t -> t - 1)
@@ -24,24 +28,38 @@ passThroughAll crEff wlEff ffEff pt hitThings w = (w, mvPt)
     trl = _btTrail' pt
     newP = head trl +.+ _btVel' pt
 
-destroyOnImpact :: HitCreatureEffect -> HitWallEffect -> HitForceFieldEffect ->
-     Particle -> [(Point2, Either3 Creature Wall ForceField)] -> World -> (World, Maybe Particle)
+destroyOnImpact 
+    :: HitCreatureEffect 
+    -> HitWallEffect 
+    -> HitForceFieldEffect 
+    -> Particle 
+    -> [(Point2, Either3 Creature Wall ForceField)] 
+    -> World 
+    -> (World, Maybe Particle)
 destroyOnImpact crEff wlEff ffEff pt hitThings w = case hitThings of
         []              -> (              w, mvPt)
         ((p,E3x1 cr):_) -> (crEff pt p cr w, destroyAt p)
         ((p,E3x2 wl):_) -> (wlEff pt p wl w, destroyAt p)
         ((p,E3x3 ff):_) -> (ffEff pt p ff w, destroyAt p)
-    where destroyAt hitp = Just $ pt & btTrail' .~ (hitp : trl)
-                                     & btTimer' .~ 3
-          mvPt = Just $ pt & btTrail' .~ (newP : trl)
-                           & btTimer' %~ (\t -> t - 1)
-                           & btPassThrough' .~ Nothing
-          trl = _btTrail' pt
-          wth = _btWidth' pt
-          newP = head trl +.+ _btVel' pt
+  where 
+    destroyAt hitp = Just $ pt 
+        & btTrail' .~ (hitp : trl)
+        & btTimer' .~ 3
+    mvPt = Just $ pt 
+        & btTrail' .~ (newP : trl)
+        & btTimer' %~ (\t -> t - 1)
+        & btPassThrough' .~ Nothing
+    trl = _btTrail' pt
+    newP = head trl +.+ _btVel' pt
 
-penWalls :: HitCreatureEffect -> HitWallEffect -> HitForceFieldEffect ->
-     Particle -> [(Point2, Either3 Creature Wall ForceField)] -> World -> (World, Maybe Particle)
+penWalls 
+    :: HitCreatureEffect 
+    -> HitWallEffect 
+    -> HitForceFieldEffect 
+    -> Particle 
+    -> [(Point2, Either3 Creature Wall ForceField)] 
+    -> World 
+    -> (World, Maybe Particle)
 penWalls crEff wlEff ffEff pt hitThings w = case hitThings of
         []              -> (              w, mvPt)
         ((p,E3x1 cr):_)  -> (crEff pt p cr w, destroyAt p)
@@ -49,19 +67,23 @@ penWalls crEff wlEff ffEff pt hitThings w = case hitThings of
         ((p,E3x2 wl):hs) | isJust (wl ^? blHP) 
                                      -> first (wlEff pt p wl) $ penWalls crEff wlEff ffEff pt hs w
         ((p,E3x2 wl):_)  | otherwise -> (wlEff pt p wl w, destroyAt p)
-    where destroyAt hitp = Just $ pt & btTrail' .~ (hitp : trl)
-                                     & btTimer' .~ 3
-          mvPt = Just $ pt & btTrail' .~ (newP : trl)
-                           & btTimer' %~ (\t -> t - 1)
-                           & btPassThrough' .~ Nothing
-          trl = _btTrail' pt
-          wth = _btWidth' pt
-          newP = head trl +.+ _btVel' pt
+  where 
+    destroyAt hitp = Just $ pt 
+        & btTrail' .~ (hitp : trl)
+        & btTimer' .~ 3
+    mvPt = Just $ pt 
+        & btTrail' .~ (newP : trl)
+        & btTimer' %~ (\t -> t - 1)
+        & btPassThrough' .~ Nothing
+    trl = _btTrail' pt
+    newP = head trl +.+ _btVel' pt
 
 doFlameDam :: Int -> Particle -> Point2 -> Creature -> World -> World
 doFlameDam amount pt p cr = over (creatures . ix (_crID cr) . crState . crDamage)
-                                 ((:) $ Flaming amount sp p ep)
-        where sp = _btPos' pt
-              ep = sp +.+ _btVel' pt
+    ((:) $ Flaming amount sp p ep)
+  where 
+    sp = _btPos' pt
+    ep = sp +.+ _btVel' pt
 
+noEff :: a -> b -> c -> d -> d
 noEff _ _ _ = id

src/Dodge/WorldEvent/Shockwave.hs

@@ -4,6 +4,7 @@ module Dodge.WorldEvent.Shockwave
     )
   where
 import Dodge.Data
+import Dodge.WorldEvent.DamageBlock
 import Dodge.Creature.State.Data
 import Dodge.Base
 import Dodge.Picture.Layer
@@ -72,14 +73,8 @@ 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 damageBlocks) hitBlocks
+    dams = over creatures (IM.map damCr) . flip (IM.foldr (damageBlocksBy 1)) hitBlocks
     hitBlocks = wallsOnCirc p rad $ wallsNearPoint p w 
-    damageBlocks wall w
-      = case wall ^? blHP of 
-          Just hp -> foldr (\j -> over (walls . ix j . blHP) (\y -> y - 1)) 
-                           w 
-                           (_blIDs wall)
-          _ -> w
     damCr cr | _crID cr `elem` is = cr
              | dist (_crPos cr) p < rad + _crRad cr 
                           = over (crState . crDamage) 
@@ -100,7 +95,7 @@ inverseShockwaveAt
     -> Float    -- Push amount parameter
     -> World 
     -> World
-inverseShockwaveAt p rad dam push pushexp = over particles (theShockwave :)
+inverseShockwaveAt p rad _ push pushexp = over particles (theShockwave :)
   where 
     theShockwave = Particle
         { _ptDraw = const blank
@@ -124,14 +119,8 @@ moveInverseShockWave t p r push pushexp w pt
                           $ color cyan $ thickCircle rad thickness)
     rad = r - (4/40) * r * fromIntegral (10 - t)
     thickness = fromIntegral (10 - t) **2 * rad / 40
-    dams = over creatures (IM.map damCr) . flip (foldr damageBlocks) hitBlocks
+    dams = over creatures (IM.map damCr) . flip (foldr (damageBlocksBy 1)) hitBlocks
     hitBlocks = wallsOnCirc p rad $ wallsNearPoint p w 
-    damageBlocks wall w
-      = case wall ^? blHP of 
-          Just hp -> foldr (\j -> over (walls . ix j . blHP) (\y -> y - 1)) 
-                           w 
-                           (_blIDs wall)
-          _ -> w
     damCr cr | dist (_crPos cr) p < rad + _crRad cr 
                           = over (crState . crDamage) 
                                  ((:) $ PushDam 1 (25 *.* safeNormalizeV (p -.- _crPos cr)))

src/Dodge/WorldEvent/Sound.hs

@@ -1,8 +1,6 @@
 module Dodge.WorldEvent.Sound
   where
 import Dodge.Data
-import Geometry.Data (Point2)
-
 import Dodge.SoundLogic
 import System.Random
 

src/Dodge/WorldEvent/SpawnParticle.hs

@@ -12,7 +12,6 @@ import Dodge.WorldEvent.HitEffect
 import Dodge.WorldEvent.ThingsHit
 import Dodge.WorldEvent.Cloud
 import Dodge.WorldEvent.Flash
-import Dodge.WorldEvent.HelperParticle
 import Dodge.WorldEvent.Bullet
 import Dodge.SoundLogic
 import Dodge.RandomHelp
@@ -98,7 +97,7 @@ moveFlame
 moveFlame rotd w pt 
     | time <= 0 = (smokeGen w, Nothing)
     | otherwise = case thingsHitExceptCr (_btPassThrough' pt) sp ep w of
-            ((p,E3x1 cr):_)       -> (soundAndGlare damcrs        , mvPt')
+            ((_,E3x1 _):_)       -> (soundAndGlare damcrs        , mvPt')
             (thing@(p,E3x2 wl):_) -> (fst $ hiteff [thing] damcrs , rfl wl p)
             _                     -> (soundAndGlare damcrs        , mvPt)
   where 
@@ -198,12 +197,8 @@ drawFlamelet rot pt = setLayer 1 $ pictures [pic , piu , pi2 , glow]
     sc = (*) 2 $ log $ 1 + fromIntegral time / 20
     s1 = (*) 2 $ log $ 2 + fromIntegral time / 40
     s2 = 0.5 * (sc + s1)
-    thepicture = pictures [pic , piu , pi2 , glow]
-
-{-
-Update of a flamelet.
-Applies movement and attaches damage to nearby creatures.
- -}
+{- Update of a flamelet.
+Applies movement and attaches damage to nearby creatures.  -}
 moveFlamelet :: World -> Particle -> (World, Maybe Particle)
 moveFlamelet w pt 
     | _btTimer' pt <= 0 = (     w, Nothing)
@@ -297,11 +292,10 @@ moveTeslaArc p d i w =
     f1 (E3x1 cr) = Just $ _crID cr
     f1 _         = Nothing
     hitCrs       = mapMaybe f1 $ take 14 $ crsLightChain p d 0 w
-    damCrs i = over (creatures . ix i . crHP) (\hp -> hp - 5)
+    damCrs cid = over (creatures . ix cid . crHP) (\hp -> hp - 5)
     f2 0 = cyan
     f2 1 = azure
     f2 _ = white
-    sID  = newProjectileKey w
     q1 = last $ init ps'
     q2 = last ps'
     hitWall = reflectPointWalls q1 ((2 *.* q2) -.- q1) $ wallsNearPoint q1 w
@@ -372,13 +366,11 @@ crOrWallSensitive p dir wlAttract w =
     g (E3x2 p1)  = 100 + dist p p1 -- tweak makes it more likely to hit crs first
     --g (E3x2 p1)  = dist p p1 - 100 -- tweak makes it more likely to hit walls first
     g (E3x1 cr1) = dist p $ _crPos cr1
+    g _ = 0
     (arcLen,_) = randomR (25,50) $ _randGen w
 -- BUG: can hit crs through walls
-
-{-
-Finds whether a creature or wall is in front of a given point and direction.
-Evaluates to a creature as an 'E3x1' or a wall as an 'E3x2'.
- -}
+{- Finds whether a creature or wall is in front of a given point and direction.
+Evaluates to a creature as an 'E3x1' or a wall as an 'E3x2'.  -}
 crOrWall :: Point2 -> Float -> World -> Either3 Creature Point2 Point2
 crOrWall p dir w = fromMaybe (E3x3 $ p +.+ rotateV dir (arcLen,0))
                         $ listToMaybe $ sortBy (compare `on` g)
@@ -400,8 +392,8 @@ crOrWall p dir w = fromMaybe (E3x3 $ p +.+ rotateV dir (arcLen,0))
     g (E3x2 p1)  = 100 + dist p p1 -- tweak makes it more likely to hit crs first
     --g (E3x2 p1)  = dist p p1 - 100 -- tweak makes it more likely to hit walls first
     g (E3x1 cr1) = dist p $ _crPos cr1
+    g _ = 0
     (arcLen,_) = randomR (25,50) $ _randGen w
-
 -- | Create a spark. 
 -- If the spark is created by another Particle, it cannot be directly added to
 -- the list, hence the redirect through worldEvents.
@@ -409,7 +401,7 @@ createSpark :: Int -> Int -> Point2 -> Float -> Maybe Int -> World -> World
 createSpark time colid pos dir maycid w 
     = w & worldEvents %~ ( (over particles (spark :) . sparkFlashAt pos') . )
   where 
-    spark = Bul'  
+    spark = Bul'
         { _ptDraw = drawBul
         , _ptUpdate' = mvGenBullet'
         , _btVel' = rotateV dir (5,0)
@@ -428,4 +420,6 @@ createSpark time colid pos dir maycid w
         ep = sp +.+ _btVel' bt
 
 drawBul :: Particle -> Picture
-drawBul pt = setLayer 1 . color white $ thickLine (take 2 $ _btTrail' pt) (_btWidth' pt)
+drawBul pt = setLayer 1 . color thecolor $ thickLine (take 2 $ _btTrail' pt) (_btWidth' pt)
+  where
+    thecolor = _btColor' pt

src/Dodge/WorldEvent/ThingsHit.hs

@@ -10,7 +10,6 @@ import Geometry
 import qualified Data.IntMap.Strict as IM
 import Data.List
 import Data.Maybe
-import Data.Function (on)
 {- List those objects that appear on a line.  -}
 thingsHit 
     :: Point2    -- ^ Line start point
@@ -19,7 +18,7 @@ thingsHit
     -> [(Point2, Either3 Creature Wall ForceField)]
 thingsHit sp ep w 
     | sp == ep  = []
-    | otherwise = sortBy (compare `on` dist sp . fst) (crs ++ walls ++ ffs)
+    | otherwise = sortOn (dist sp . fst) (crs ++ wls ++ ffs)
   where 
     hitCrs = IM.elems 
         $ IM.filter (\cr -> circOnSeg sp ep (_crPos cr) (_crRad cr))
@@ -33,8 +32,8 @@ thingsHit sp ep w
     f i m = case IM.lookup i m of 
         Just val -> val
         _        -> IM.empty
-    walls = zip (map (fromJust . hitPoint) hitWls) (map E3x2 hitWls)
-    hitPoint w = uncurry (intersectSegSeg' sp ep) (_wlLine w)
+    wls = zip (map (fromJust . hitPoint) hitWls) (map E3x2 hitWls)
+    hitPoint w' = uncurry (intersectSegSeg' sp ep) (_wlLine w')
     hitFFs   = mapMaybe (collidePointFF sp ep (_randGen w)) (IM.elems $ _forceFields w)
     ffs = map (\(p,(_,i)) -> (p, E3x3 $ _forceFields w IM.! i)) hitFFs
 {- List objects that appear on a line.
@@ -66,7 +65,7 @@ thingsHitExceptCrLongLine (Just cid) sp ep = filter crNotCid . thingsHitLongLine
 thingsHitLongLine :: Point2 -> Point2 -> World -> [(Point2, Either3 Creature Wall ForceField)]
 thingsHitLongLine sp ep w 
     | sp == ep  = []
-    | otherwise = sortOn (dist sp . fst) (crs ++  walls ++ ffs)
+    | otherwise = sortOn (dist sp . fst) (crs ++  wls ++ ffs)
   where 
     crs  = zip crPs (map E3x1 hitCrs)
     hitCrs = IM.elems 
@@ -74,7 +73,7 @@ thingsHitLongLine sp ep w
         $ _creatures w
     --   $ creaturesAlongLine sp ep w
     crPs = map (\cr -> ssaTriPoint ep (_crPos cr) sp (_crRad cr)) hitCrs
-    walls = zip (map (fromJust . hitPoint) hitWls) (map E3x2 hitWls)
+    wls = zip (map (fromJust . hitPoint) hitWls) (map E3x2 hitWls)
     hitWls = wallsOnLine sp ep $ wallsAlongLine sp ep w
     hitPoint wl = uncurry (intersectSegSeg' sp ep) (_wlLine wl)
     hitFFs = mapMaybe (collidePointFF sp ep (_randGen w)) (IM.elems $ _forceFields w)