Cleanup

src/Dodge/Item/Weapon.hs

@@ -798,11 +798,6 @@ moveRemoteBomb itid time pID w
     updatePicture = 
         set (props . ix pID . prDraw)
             (\_ -> (,) mempty $ onLayer PtLayer $ uncurryV translate newPos $ remoteBombPic time)
-        . lowLightDirected 
-            (withAlpha 0.1 red) 
-            newPos 
-            (50 *.* unitVectorAtAngle (negate $ degToRad (10 * fromIntegral time)))
-            [-0.2,-0.15,-0.1,-0.05,0,0.05,0.1,0.15,0.2]
 
 
 setRemoteBombScope :: Int -> Prop -> World -> World

src/Dodge/Item/Weapon/Laser.hs

@@ -25,7 +25,7 @@ import qualified Data.Sequence as Seq
 --import qualified Data.IntMap.Strict as IM
 
 aLaser :: Creature -> World -> World
-aLaser cr w = over particles (makeLaserAt phaseV pos dir : ) w
+aLaser cr = particles %~ (makeLaserAt phaseV pos dir : )
   where 
     pos = _crPos cr +.+ ((_crRad cr +3) *.* unitVectorAtAngle dir) 
     dir = _crDir cr

src/Dodge/LightSources/Lamp.hs

@@ -30,9 +30,9 @@ colorLightAt col pos i =
        ,_lsPict = lightSourcePicture
        }
 lightSourcePicture :: LightSource -> Picture
-lightSourcePicture ls = setLayer 1 . translate3 (_lsPos ls) . color col $ circleSolid 3
+lightSourcePicture ls = setLayer 1 . translate3 (_lsPos ls) . color col $ circleSolid 4
   where
-    col = V4 r g b 1
+    col = V4 r g b 2
     V3 r g b = _lsIntensity ls
 
 lightAt :: Point3 -> Int -> LightSource

src/Dodge/WorldEvent/Cloud.hs

@@ -1,11 +1,16 @@
 module Dodge.WorldEvent.Cloud
-    where
+    ( makeFlamerSmokeAt
-
+    , smokeCloudAt
+    , makeThinSmokeAt
+    , makeThickSmokeAt
+    , shellTrailCloud
+    , spawnSmokeAtCursor
+    , makeStartCloudAt
+    ) where
 import Dodge.Data
 import Dodge.Base
 import Geometry.Data
 import Picture
---import qualified IntMapHelp as IM
 
 import Control.Lens
 
@@ -17,7 +22,7 @@ makeCloudAt
     -> Point3   -- start position
     -> World 
     -> World
-makeCloudAt drawFunc rad t alt p w = w & clouds %~ (theCloud :)
+makeCloudAt drawFunc rad t alt p = clouds %~ (theCloud :)
   where 
     theCloud = Cloud 
         { _clPos = p
@@ -41,8 +46,7 @@ smokeCloudAt
 smokeCloudAt col = makeCloudAt (drawCloudWith (4/3) 800 col)
 
 drawCloudWith :: Float -> Float -> Color -> Cloud -> Picture
-drawCloudWith radMult fadet col cl 
+drawCloudWith radMult fadet col cl = setLayer 2 
-    = setLayer 2 
     . setDepth 25
     $ circleSolidCol (withAlpha 0 col) (withAlpha a col) (radMult * _clRad cl)
   where 
@@ -55,11 +59,9 @@ makeThinSmokeAt :: Point3 -> World -> World
 makeThinSmokeAt = makeCloudAt (drawCloudWith 4 400 (withAlpha 0.05 black)) 5 400 50
 
 makeStartCloudAt :: Point3 -> World -> World
---makeSmokeCloudAt = makeCloudAt 10 200 (drawCloudWith 2 200 (greyN 0.5))
 makeStartCloudAt = makeCloudAt (drawCloudWith 2 800 white) 10 400 5
 
 shellTrailCloud :: Point3 -> World -> World
-----makeSmokeCloudAt = makeCloudAt 10 200 (drawCloudWith 2 200 (greyN 0.5))
 shellTrailCloud = makeCloudAt (drawCloudWith (4/3) 800 (greyN 0.5)) 15 400 40
 
 makeFlamerSmokeAt :: Float -> Point3 -> World -> World

src/Dodge/WorldEvent/DamageBlock.hs

@@ -1,5 +1,6 @@
 module Dodge.WorldEvent.DamageBlock
-    where
+    ( damageBlocksBy
+    ) where
 import Dodge.Data
 
 import Control.Lens

src/Dodge/WorldEvent/Explosion.hs

@@ -2,7 +2,11 @@
 Explosions: creation of shockwave and particles at a given point.
  -}
 module Dodge.WorldEvent.Explosion
-  where
+    ( makeExplosionAt
+    , makeFlameExplosionAt
+    , makePoisonExplosionAt
+    , makeTeslaExplosionAt
+    ) where
 import Dodge.Data
 import Dodge.Data.SoundOrigin
 import Dodge.Default

src/Dodge/WorldEvent/Flash.hs

@@ -13,21 +13,15 @@ module Dodge.WorldEvent.Flash
     , explosionFlashAt
     , laserGunFlashAt
     , teslaGunFlashAt
-    , lowLightDirected
-    , flareCircleAt
     , muzFlareAt
     )
     where
 import Dodge.Data
---import Dodge.Base
-import Dodge.Picture
 import Dodge.LightSources.Lamp
-import Dodge.WorldEvent.ThingsHit
 import Dodge.WorldEvent.HelperParticle
 import Picture
 import Geometry
 
-import Data.Maybe (maybeToList)
 import Control.Lens
 import System.Random
 
@@ -39,37 +33,10 @@ teslaGunFlashAt = flareCircleAt cyan 0.7
 laserGunFlashAt :: Point3 -> World -> World
 laserGunFlashAt = flareCircleAt yellow 0.2
 
-glareLine' :: Int -> Float -> Float -> Color -> Point2 -> Point2 -> World -> World
-glareLine' t len wdth col a b w = w & particles %~ (maybeToList linePt ++)
-  where 
-    linePt :: Maybe Particle
-    linePt = glareBetween t len wdth col a b w
-
-glareBetween :: Int -> Float -> Float -> Color -> Point2 -> Point2 -> World -> Maybe Particle
-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')
-    }
-
-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 
-                (wa,wb) = _wlLine wall
-        ((p, E3x1 cr):_) 
-            -> setCol . uncurryV translate cp . rotate (-0.25 * pi + argV (p -.- cp))
-                    $ thickArc 0 (pi/2) (_crRad cr) wdth
-              where 
-                cp = _crPos cr
-        _   -> blank
-  where setCol = color col . setDepth (-0.5) . setLayer 2
-
 muzFlareAt :: Color -> Point3 -> Float -> World -> World
-muzFlareAt col tranv dir w = w & particles %~ (theFlareCircle :)
+muzFlareAt col tranv dir w = w & particles %~ (theFlare :)
   where
-    theFlareCircle = Particle
+    theFlare = Particle
         { _ptDraw = const $ setLayer 1 . translate3 tranv $ theShape
         , _ptUpdate = ptSimpleTime 2
         }
@@ -84,21 +51,17 @@ flareCircleAt :: Color -> Float -> Point3 -> World -> World
 flareCircleAt col alphax tranv = particles %~ (theFlareCircle :)
   where
     theFlareCircle = Particle
-        { _ptDraw = const $ setLayer 2 . translate3 tranv
+        { _ptDraw = const . setLayer 1 . translate3 tranv
                             $ circleSolidCol (withAlpha alphax col) (withAlpha 0 col) 30
         , _ptUpdate = ptSimpleTime 1
         }
 
 explosionFlashAt :: Point2 -> World -> World
-explosionFlashAt p =  over tempLightSources ((:) $ tLightTimedIntensity 20 150 intensityFunc p)
+explosionFlashAt p = tempLightSources %~ (tLightTimedIntensity 20 150 intensityFunc p :)
   where 
     intensityFunc x 
         | x < 10 = 1 / (10 - fromIntegral x)
         | otherwise = 1
 
-lowLightDirected :: Color -> Point2 -> Point2 -> [Float] -> World -> World
-lowLightDirected col a b angles w
-    = foldr (\angle w' -> glareLine' 2 10 5 col a (a +.+ rotateV angle b) w') w angles
-
 sparkFlashAt :: Point2 -> World -> World
 sparkFlashAt _ = id

src/Dodge/WorldEvent/HitEffect.hs

@@ -1,4 +1,9 @@
 module Dodge.WorldEvent.HitEffect
+    ( destroyOnImpact
+    , doFlameDam
+    , noEff
+    , penWalls
+    )
     where
 import Dodge.Data
 import Dodge.Data.DamageType
@@ -13,21 +18,21 @@ type HitCreatureEffect   = Particle -> Point2 -> Creature   -> World -> World
 type HitWallEffect       = Particle -> Point2 -> Wall       -> World -> World
 type HitForceFieldEffect = Particle -> Point2 -> ForceField -> World -> World
 
-passThroughAll 
+--passThroughAll 
-    :: HitCreatureEffect 
+--    :: HitCreatureEffect 
-    -> HitWallEffect 
+--    -> HitWallEffect 
-    -> HitForceFieldEffect 
+--    -> HitForceFieldEffect 
-    -> Particle 
+--    -> Particle 
-    -> [(Point2, Either3 Creature Wall ForceField)] -- ^ hit things
+--    -> [(Point2, Either3 Creature Wall ForceField)] -- ^ hit things
-    -> World 
+--    -> World 
-    -> (World, Maybe Particle)
+--    -> (World, Maybe Particle)
-passThroughAll _ _ _ pt _ w = (w, mvPt)
+--passThroughAll _ _ _ pt _ w = (w, mvPt)
-  where 
+--  where 
-    mvPt = Just $ pt & btTrail' .~ (newP : trl)
+--    mvPt = Just $ pt & btTrail' .~ (newP : trl)
-                     & btTimer' %~ (\t -> t - 1)
+--                     & btTimer' %~ (\t -> t - 1)
-                     & btPassThrough' .~ Nothing
+--                     & btPassThrough' .~ Nothing
-    trl = _btTrail' pt
+--    trl = _btTrail' pt
-    newP = head trl +.+ _btVel' pt
+--    newP = head trl +.+ _btVel' pt
 
 destroyOnImpact 
     :: HitCreatureEffect 
@@ -38,20 +43,23 @@ destroyOnImpact
     -> World 
     -> (World, Maybe Particle)
 destroyOnImpact crEff wlEff ffEff pt hitThings w = case hitThings of
-        []              -> (              w, mvPt)
+        []              -> (              w, mvPt pt)
-        ((p,E3x1 cr):_) -> (crEff pt p cr w, destroyAt p)
+        ((p,E3x1 cr):_) -> (crEff pt p cr w, destroyAt p pt)
-        ((p,E3x2 wl):_) -> (wlEff pt p wl w, destroyAt p)
+        ((p,E3x2 wl):_) -> (wlEff pt p wl w, destroyAt p pt)
-        ((p,E3x3 ff):_) -> (ffEff pt p ff w, destroyAt p)
+        ((p,E3x3 ff):_) -> (ffEff pt p ff w, destroyAt p pt)
-  where 
+
-    destroyAt hitp = Just $ pt 
+mvPt :: Particle -> Maybe Particle
-        & btTrail' .~ (hitp : trl)
+mvPt pt = Just $ pt
-        & btTimer' .~ 3
+    & btTrail' %~ f
-    mvPt = Just $ pt 
+    & btTimer' -~ 1
-        & btTrail' .~ (newP : trl)
-        & btTimer' %~ (\t -> t - 1)
     & btPassThrough' .~ Nothing
-    trl = _btTrail' pt
+  where
-    newP = head trl +.+ _btVel' pt
+    f trl = head trl +.+ _btVel' pt : trl
+
+destroyAt :: Point2 -> Particle -> Maybe Particle
+destroyAt hitp pt = Just $ pt 
+    & btTrail' %~ (hitp :)
+    & btTimer' %~ (\t -> min 3 (t-1))
 
 penWalls 
     :: HitCreatureEffect 
@@ -62,26 +70,16 @@ penWalls
     -> World 
     -> (World, Maybe Particle)
 penWalls crEff wlEff ffEff pt hitThings w = case hitThings of
-        []              -> (              w, mvPt)
+        []              -> (              w, mvPt pt)
-        ((p,E3x1 cr):_)  -> (crEff pt p cr w, destroyAt p)
+        ((p,E3x1 cr):_) -> (crEff pt p cr w, destroyAt p pt)
-        ((p,E3x3 ff):_)  -> (ffEff pt p ff w, destroyAt p)
+        ((p,E3x3 ff):_) -> (ffEff pt p ff w, destroyAt p pt)
         ((p,E3x2 wl):hs) | isJust (wl ^? wlBlockID) 
                         -> first (wlEff pt p wl) $ penWalls crEff wlEff ffEff pt hs w
-        ((p,E3x2 wl):_)  | otherwise -> (wlEff pt p wl w, destroyAt p)
+        ((p,E3x2 wl):_) -> (wlEff pt p wl w, destroyAt p 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)
+doFlameDam amount pt p cr = creatures . ix (_crID cr) . crState . crDamage %~
-    ((:) $ Flaming amount sp p ep)
+    (Flaming amount sp p ep :)
   where 
     sp = _btPos' pt
     ep = sp +.+ _btVel' pt