Gunsmoke as clouds

src/Dodge/Data.hs

@@ -81,7 +81,7 @@ data World = World
                 , _tempLightSources :: ![TempLightSource]
                 , _closeActiveObjects :: [Either FloorItem Button]
                 , _remap            :: Keycode -> Keycode
-                } --deriving (Show)
+                } 
 
 data Corpse = Corpse
                 { _cpPos :: Point2
@@ -468,8 +468,7 @@ type HitEffect = Particle' -> [(Point2, (Either3 Creature Wall ForceField))] ->
                     -> (World,Maybe Particle')
 
 
-data Projectile = 
+data Projectile = Projectile    { _ptPos :: Point2
-    Projectile { _ptPos :: Point2
                                 , _ptStartPos :: Point2
                                 , _ptVel :: Point2
                                 , _ptPict :: Picture

src/Dodge/Item/Weapon.hs

@@ -1131,69 +1131,6 @@ rateIncAB startRate fastRate shooteff1 shooteff2 cid w
             reloadCondition = _wpLoadedAmmo item == 0
 
 
-withThinSmoke :: (Int -> World -> World) -> Int -> World -> World
-withThinSmoke eff cid w = eff cid $ foldr ($) w smokeGen
-    where
-          cr = _creatures w IM.! cid
-          dir = _crDir cr
-          pos = _crPos cr +.+ ((_crRad cr +0.5) *.* unitVectorAtAngle dir)
-          (vs,_) = runState ((sequence . repeat . randInCirc) 0.4) $ _randGen w
-          (sps,_) = runState ((sequence . repeat . randInCirc) 8) $ _randGen w
-          ts = randomRs (250,1000) $ _randGen w
-          ss = take 3 $ randomRs (10,20) $ _randGen w
-          smokeGen = zipWith4 (\ v s t sp -> makeThinSmokeAt (greyN 0.1) v s t (pos +.+ sp))
-                        vs ss ts sps
-
-withThickSmoke :: (Int -> World -> World) -> Int -> World -> World
-withThickSmoke eff cid w = eff cid $ foldr ($) w smokeGen
-    where
-          cr = _creatures w IM.! cid
-          dir = _crDir cr
-          pos = _crPos cr +.+ ((_crRad cr +0.5) *.* unitVectorAtAngle dir)
-          (vs,_) = runState ((sequence . repeat . randInCirc) 0.4) $ _randGen w
-          (sps,_) = runState ((sequence . repeat . randInCirc) 8) $ _randGen w
-          ts = randomRs (18,20) $ _randGen w
-          ss = take 20 $ randomRs (0.1,1) $ _randGen w
-          smokeGen = zipWith4 (\ v s t sp -> makeColorSmokeAt (greyN 0.1) v s t (pos +.+ sp))
-                        vs ss ts sps
-
-
-makeThinSmokeAt :: Color -> Point2 -> Float -> Int -> Point2 -> World -> World
-makeThinSmokeAt col vel scal time p w = over projectiles (IM.insert n smP) w
-    where n = newProjectileKey w
-          smP = Projectile
-                { _ptPos = p
-                , _ptStartPos = p
-                , _ptVel = vel
-                , _ptPict = onLayer PtLayer $ uncurry translate p $ color col $ circleSolid 1
-                , _ptID = n
-                , _ptUpdate = moveThinSmoke col scal time n
-                }
-
-moveThinSmoke :: Color -> Float -> Int -> Int -> World -> World
-moveThinSmoke col scal time i w
-    | time > 0 
-        = set (projectiles . ix i . ptPict) pic 
-            . set (projectiles . ix i . ptUpdate) (moveThinSmoke col scal (time-1) i)
-            . set (projectiles . ix i . ptPos) newPos
-            . setVel
-            $ w
-    | time > -10 
-        = set (projectiles . ix i . ptPict) pi1 
-            . set (projectiles . ix i . ptUpdate) (moveThinSmoke col scal (time-1) i)
-            . set (projectiles . ix i . ptPos) newPos
-            . setVel
-            $ w
-    | otherwise 
-        = over projectiles (IM.delete i) w
-    where oldPos = _ptPos $ _projectiles w IM.! i
-          newPos = oldPos +.+ (_ptVel $ _projectiles w IM.! i)
-          setVel = over (projectiles . ix i . ptVel) $ (*.*) 0.99
-          pic = onLayer PtLayer $ uncurry translate newPos $ color (withAlpha 0.1 col) $ circleSolid scal
-          pi1 = onLayer PtLayer $ uncurry translate newPos 
-                    $ color (withAlpha (0.1 + fromIntegral time /100) col) 
-                    $ circleSolid $ scal
-
 makeLaserAt :: Float -> Point2 -> Float -> Maybe Int -> Particle'
 makeLaserAt phaseV pos dir mcid = Particle'
     { _ptPict' = blank

src/Dodge/Item/Weapon/TriggerType.hs

@@ -4,6 +4,7 @@ import Dodge.Data
 import Dodge.SoundLogic
 import Dodge.CreatureAction (reloadWeapon)
 import Dodge.WorldEvent (muzzleFlashAt,tempLightForAt)
+import Dodge.WorldEvent.Cloud
 import Dodge.RandomHelp
 
 import Dodge.Item.Weapon.Bullet
@@ -18,6 +19,23 @@ import Control.Monad.State
 import Data.Maybe
 import qualified Data.IntMap.Strict as IM
 
+withThinSmoke :: (Int -> World -> World) -> Int -> World -> World
+withThinSmoke eff cid w = eff cid . foldr makeThinSmokeAt w $ map (+.+ pos) ps
+    where
+          cr = _creatures w IM.! cid
+          dir = _crDir cr
+          pos = _crPos cr +.+ ((_crRad cr +0.5) *.* unitVectorAtAngle dir)
+          ps = (sequence . replicate 5 . randInCirc) 8 & evalState $ _randGen w
+
+withThickSmoke :: (Int -> World -> World) -> Int -> World -> World
+withThickSmoke eff cid w = eff cid . foldr makeThickSmokeAt w $ map (+.+ pos) ps
+    where
+          cr = _creatures w IM.! cid
+          dir = _crDir cr
+          pos = _crPos cr +.+ ((_crRad cr +15) *.* unitVectorAtAngle dir)
+          ps = (sequence . replicate 20 . randInCirc) 8 & evalState $ _randGen w
+
+
 withWarmUp :: Int -> (Int -> World -> World) -> Int -> World -> World
 withWarmUp t f cid w 
             | reloadCondition = fromMaybe w $ reloadWeapon cid w

src/Dodge/WorldEvent/Cloud.hs

@@ -11,6 +11,33 @@ import Picture
 import Control.Lens
 import qualified Data.IntMap as IM
 
+makeCloudAt :: Float -> Int -> (Cloud -> Picture) -> Point2 -> World -> World
+makeCloudAt rad t drawFunc p w 
+        = w & clouds %~ IM.insert i theCloud
+    where i = newKey $ _clouds w
+          theCloud = Cloud { _clID = i
+                           , _clPos = p
+                           , _clVel = (0,0)
+                           , _clPict = drawFunc
+                           , _clRad = rad
+                           , _clTimer = t
+                           , _clEffect = const id
+                           }
+
+fadeOutTime :: Color -> Float -> Cloud -> Picture
+fadeOutTime col fadet cl = setLayer 2 
+                            . setDepth (-0.5)
+                            . color (withAlpha a col) 
+                            $ circleSolid (4 * _clRad cl)
+    where a = min 1 $ fromIntegral (_clTimer cl) / fadet
+
+
+makeThickSmokeAt :: Point2 -> World -> World
+makeThickSmokeAt = makeCloudAt 2 50 (fadeOutTime black 50)
+
+makeThinSmokeAt :: Point2 -> World -> World
+makeThinSmokeAt = makeSmokeCloud
+
 makeSmokeCloud :: Point2 -> World -> World
 makeSmokeCloud pos w = w & clouds %~ IM.insert i theCloud
     where i = newKey $ _clouds w