Working cloud shadows (slow)

src/Dodge/WorldEvent/Cloud.hs

@@ -9,14 +9,22 @@ import Picture
 
 import Control.Lens
 
-makeCloudAt :: Float -> Int -> (Cloud -> Picture) -> Point2 -> World -> World
-makeCloudAt rad t drawFunc p w = w & clouds %~ (theCloud :)
+makeCloudAt 
+    :: Float    -- ^ radius
+    -> Int      -- ^ timer
+    -> Float    -- ^ resting altitude
+    -> (Cloud -> Picture) -- ^ draw function
+    -> Point3   -- start position
+    -> World 
+    -> World
+makeCloudAt rad t alt drawFunc p w = w & clouds %~ (theCloud :)
   where 
     theCloud = Cloud 
         { _clPos = p
-        , _clVel = V2 0 0
+        , _clVel = V3 0 0 0
         , _clPict = drawFunc
         , _clRad = rad
+        , _clAlt = alt
         , _clTimer = t
         , _clType = SmokeCloud
         , _clEffect = const id
@@ -30,22 +38,24 @@ drawCloudWith radMult fadet col cl
   where 
     a = min 1 $ fromIntegral (_clTimer cl) / fadet
 
-makeThickSmokeAt :: Point2 -> World -> World
-makeThickSmokeAt = makeCloudAt 3 50 (drawCloudWith 4 50 black)
+makeThickSmokeAt :: Point3 -> World -> World
+makeThickSmokeAt = makeCloudAt 3 50 30 (drawCloudWith 4 50 black)
 
-makeThinSmokeAt :: Point2 -> World -> World
-makeThinSmokeAt = makeCloudAt 5 400 (drawCloudWith 4 400 (withAlpha 0.05 black))
+makeThinSmokeAt :: Point3 -> World -> World
+makeThinSmokeAt = makeCloudAt 5 400 50 (drawCloudWith 4 400 (withAlpha 0.05 black))
 
-makeStartCloudAt :: Point2 -> World -> World
+makeStartCloudAt :: Point3 -> World -> World
 --makeSmokeCloudAt = makeCloudAt 10 200 (drawCloudWith 2 200 (greyN 0.5))
-makeStartCloudAt = makeCloudAt 10 400 (drawCloudWith 2 800 white)
+makeStartCloudAt = makeCloudAt 10 400 5 (drawCloudWith 2 800 white)
 
-makeSmokeCloudAt :: Point2 -> World -> World
+makeSmokeCloudAt :: Point3 -> World -> World
 --makeSmokeCloudAt = makeCloudAt 10 200 (drawCloudWith 2 200 (greyN 0.5))
-makeSmokeCloudAt = makeCloudAt 15 400 (drawCloudWith (4/3) 800 (greyN 0.5))
+makeSmokeCloudAt = makeCloudAt 15 400 40 (drawCloudWith (4/3) 800 (greyN 0.5))
 
-makeFlamerSmokeAt :: Float -> Point2 -> World -> World
-makeFlamerSmokeAt x = makeCloudAt 6 200 (drawCloudWith 4 300 (greyN x))
+makeFlamerSmokeAt :: Float -> Point3 -> World -> World
+makeFlamerSmokeAt x = makeCloudAt 6 200 40 (drawCloudWith 4 300 (greyN x))
 
 spawnSmokeAtCursor :: World -> World
-spawnSmokeAtCursor w = makeSmokeCloudAt (mouseWorldPos w) w
+spawnSmokeAtCursor w = makeSmokeCloudAt (V3 x y 20) w
+  where
+    V2 x y = mouseWorldPos w

src/Dodge/WorldEvent/SpawnParticle.hs

@@ -23,6 +23,7 @@ import Dodge.RandomHelp
 --import Dodge.Debug
 import Picture
 import Geometry
+import Geometry.Vector3D
 --import Geometry.Data
 import qualified IntMapHelp as IM
 
@@ -132,7 +133,7 @@ moveFlame rotd w pt
     reflV wall = (0.3 *.* reflectIn (uncurry (-.-) . swap $ _wlLine wall) vel )
         +.+ (0.2 *.* vel)
     smokeCol = fst $ randomR (0.2,0.5) (_randGen w)
-    smokeGen = makeFlamerSmokeAt smokeCol ep
+    smokeGen = makeFlamerSmokeAt smokeCol (addZ 20 ep)
 
 makeFlameletTimed 
     :: Point2       -- ^ Position
@@ -279,11 +280,12 @@ makeGasCloud pos vel w = w
     & randGen   .~ g
   where 
     theCloud = Cloud 
-        {  _clPos = pos
-        , _clVel = vel
+        {  _clPos = addZ 20 pos
+        , _clVel = addZ 0 vel
         , _clPict = \_ -> setLayer 2 . setDepth 30 $ color (withAlpha 0.05 col) 
                                           $ circleSolid 20
         , _clRad = 10
+        , _clAlt = 25
         , _clTimer = 400
         , _clType = GasCloud
         , _clEffect = cloudPoisonDamage
@@ -296,8 +298,8 @@ Attach poison cloud damage to creatures near cloud.
 cloudPoisonDamage :: Cloud -> World -> World
 cloudPoisonDamage c w = w & creatures %~ flip (foldr (IM.adjust doDam)) damagedCrs
   where 
-    damagedCrs = IM.keys $ IM.filter f $ creaturesNearPoint (_clPos c) w
-    f cr = dist (_crPos cr) (_clPos c) < _crRad cr + _clRad c + 10
+    damagedCrs = IM.keys $ IM.filter f $ creaturesNearPoint (stripZ $ _clPos c) w
+    f cr = dist3 (addZ 20 $ _crPos cr) (_clPos c) < _crRad cr + _clRad c + 10
     doDam cr = cr & crState . crDamage %~ (:) (PoisonDam 1)
 makeTeslaArcAt :: Point2 -> Float -> Particle
 makeTeslaArcAt pos dir = LinearParticle