Gunsmoke as clouds

2021-03-24 03:02:39 +01:00
parent 03587a7906
commit 48e6779503
4 changed files with 53 additions and 72 deletions
@@ -81,7 +81,7 @@ data World = World
                , _tempLightSources :: ![TempLightSource]
                , _closeActiveObjects :: [Either FloorItem Button]
                , _remap            :: Keycode -> Keycode
-                } --deriving (Show)
+                } 

 data Corpse = Corpse
                { _cpPos :: Point2
@@ -468,14 +468,13 @@ type HitEffect = Particle' -> [(Point2, (Either3 Creature Wall ForceField))] ->
                    -> (World,Maybe Particle')


-data Projectile = 
-    Projectile { _ptPos :: Point2
-             , _ptStartPos :: Point2
-             , _ptVel :: Point2
-             , _ptPict :: Picture
-             , _ptID :: Int
-             , _ptUpdate :: World -> World
-             }
+data Projectile = Projectile    { _ptPos :: Point2
+                                , _ptStartPos :: Point2
+                                , _ptVel :: Point2
+                                , _ptPict :: Picture
+                                , _ptID :: Int
+                                , _ptUpdate :: World -> World
+                                }

 data DamageType = Piercing {_dmAmount :: Int , _dmFrom :: Point2 , _dmAt :: Point2 , _dmTo :: Point2 }
                | Blunt    {_dmAmount :: Int , _dmFrom :: Point2 , _dmAt :: Point2 , _dmTo :: Point2 } 
@@ -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
@@ -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
@@ -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