Remove Smoke datatype

src/Dodge/Base.hs

@@ -58,18 +58,12 @@ halfHeight w = _windowY w / 2
 hasLOS :: Point2 -> Point2 -> World -> Bool
 {-# INLINE hasLOS #-}
 hasLOS p1 p2 w = (not $ collidePointWallsSimple p1 p2 nearbyWalls) 
-                    && (not $ collidePointSmoke p1 p2 nearbySmoke)
     where nearbyWalls = wallsAlongLine p1 p2 w
-          nearbySmoke = _smoke w -- smokeAlongLine p1 p2 w
-
-smokeLOS :: Point2 -> Point2 -> World -> Bool
-smokeLOS p1 p2 w = not $ collidePointSmoke p1 p2 nearbySmoke
-    where nearbySmoke = _smoke w
 
 hasLOSIndirect :: Point2 -> Point2 -> World -> Bool
 hasLOSIndirect p1 p2 w = case collidePointIndirect p1 p2 $ wallsAlongLine p1 p2 w
                          of Just _ -> False
-                            Nothing -> True && smokeLOS p1 p2 w
+                            Nothing -> True
 
 isWalkable :: Point2 -> Point2 -> World -> Bool
 isWalkable p1 p2 w = not $ collidePointWalkable p1 p2 nearbyWalls
@@ -129,24 +123,21 @@ canWalk i j w = not $ collidePointWalkable ipos jpos $ wallsAlongLine ipos jpos
 canSeeIndirect :: Int -> Int -> World -> Bool
 canSeeIndirect i j w = case collidePointIndirect ipos jpos $ wallsAlongLine ipos jpos w
                          of Just _ -> False
-                            Nothing -> True && smokeLOS ipos jpos w
+                            Nothing -> True
     where ipos = _crPos (_creatures w IM.! i)
           jpos = _crPos (_creatures w IM.! j)
     
 canSeeFire :: Point2 -> Point2 -> World -> Bool
 canSeeFire p p' w = (not $ collidePointFireVision p p' $ wallsAlongLine p p' w)
-                    && smokeLOS p p' w
 
 canSeeFireVision :: Int -> Int -> World -> Bool
 canSeeFireVision i j w = (not $ collidePointFireVision ipos jpos $ wallsAlongLine ipos jpos w)
-                            && smokeLOS ipos jpos w
     where ipos = _crPos (_creatures w IM.! i)
           jpos = _crPos (_creatures w IM.! j)
 
 canSeeFireVisionAny :: Int -> Int -> World -> Bool
-canSeeFireVisionAny i j w = (not $ and $ fmap ($ (wallsAlongLine (_crPos icr) (_crPos jcr) w) )
+canSeeFireVisionAny i j w = not $ and $ fmap ($ (wallsAlongLine (_crPos icr) (_crPos jcr) w) )
                                  $ zipWith collidePointFireVision ips jps
-                            ) && smokeLOS (_crPos icr) (_crPos jcr) w
     where icr = _creatures w IM.! i
           jcr = _creatures w IM.! j
           ips = map (\p -> (_crPos icr +.+ _crRad icr *.* p)) [(1,0),(0,1),(-1,0),(0,-1)]
@@ -154,9 +145,8 @@ canSeeFireVisionAny i j w = (not $ and $ fmap ($ (wallsAlongLine (_crPos icr) (_
 
 
 canSeeFireVisionAll :: Int -> Int -> World -> Bool
-canSeeFireVisionAll i j w = (not $ or $ fmap ($ (wallsAlongLine (_crPos icr) (_crPos jcr) w) )
+canSeeFireVisionAll i j w = not $ or $ fmap ($ (wallsAlongLine (_crPos icr) (_crPos jcr) w) )
                                  $ zipWith collidePointFireVision ips jps
-                            ) && smokeLOS (_crPos icr) (_crPos jcr) w
     where icr = _creatures w IM.! i
           jcr = _creatures w IM.! j
           ips = map (\p -> (_crPos icr +.+ _crRad icr *.* p)) [(1,0),(0,1),(-1,0),(0,-1)]
@@ -424,15 +414,6 @@ collidePointFireVision p1 p2 ws =  any ( isJust
                                 Just _  -> not $ _wlIsSeeThrough wl
                                 Nothing -> True
 
-collidePointSmoke :: Point2 -> Point2 -> [Smoke] -> Bool
-collidePointSmoke a b = any $ isJust . uncurry (intersectSegSeg' a b) . smokePerpLine a b
-
-smokePerpLine :: Point2 -> Point2 -> Smoke -> (Point2,Point2)
-smokePerpLine a b sm = (p +.+ orth, p -.- orth)
-    where
-        p = _smPos sm
-        orth = _smRad sm *.* safeNormalizeV (vNormal (a -.- b))
-
 -- shit this is ugly
 lineOfThickness :: Float -> [Point2] -> Picture
 lineOfThickness t = pictures . f

src/Dodge/Critters.hs

@@ -5,9 +5,9 @@ import Dodge.AIs
 import Dodge.CreatureState
 import Dodge.Prototypes
 import Dodge.Base
-import Dodge.Smoke
 import Dodge.Item.Weapon
 import Dodge.Item.Consumable
+import Dodge.WorldEvent.Cloud
 
 import Picture
 import Geometry

src/Dodge/Data.hs

@@ -50,7 +50,6 @@ data World = World
                 , _cloudsZone       :: IM.IntMap (IM.IntMap (IM.IntMap Cloud))
                 , _projectiles      :: IM.IntMap Projectile
                 , _particles'       :: ![Particle']
-                , _smoke            :: [Smoke]
                 , _walls            :: !(IM.IntMap Wall)
                 , _wallsZone        :: (IM.IntMap (IM.IntMap (IM.IntMap Wall)))
                 , _forceFields      :: IM.IntMap ForceField
@@ -497,16 +496,6 @@ data DamageType = Piercing {_dmAmount :: Int , _dmFrom :: Point2 , _dmAt :: Poin
 
 data Either3 a b c = E3x1 a | E3x2 b | E3x3 c
 
-data Smoke = 
-    Smoke
-        { _smPos    :: Point2
-        , _smRad    :: Float
-        , _smColor  :: Color
-        , _smUpdate :: Smoke -> Maybe Smoke
-        , _smPs     :: [Point2]
-        , _smTime   :: Int
-        }
-
 data WLID = WLID { _wlIDx :: Int, _wlIDy :: Int, _wlIDid :: Int}
 
 data Wall 
@@ -637,7 +626,6 @@ makeLenses ''FloorItem
 makeLenses ''Projectile
 makeLenses ''Particle'
 makeLenses ''Wall
-makeLenses ''Smoke
 makeLenses ''ForceField
 makeLenses ''FFState
 makeLenses ''PressPlate

src/Dodge/Prototypes.hs

@@ -219,7 +219,6 @@ basicWorld = World
     , _pathInc = M.empty
     , _windowX = 800
     , _windowY = 840
-    , _smoke = []
     , _mapDisplay = (False, 0.2)
     , _lightSources = IM.empty
     , _tempLightSources = [youLight]

src/Dodge/Rendering.hs

@@ -45,7 +45,6 @@ worldPictures w
                         , map _ptPict' $ _particles' w
                         , map drawWallFloor (wallFloorsToDraw w)
 --                        , map (drawWallFace w) (wallShadowsToDraw w)
-                        , map (drawSmokeShadow w) $ _smoke w
                         , testPic w
                         ]
 
@@ -86,43 +85,6 @@ wallFloorsToDraw w = filter isVisible $ IM.elems $ wallsOnScreen w
 wallsOnScreen :: World -> IM.IntMap Wall
 wallsOnScreen w = wallsNearZones (zoneOfScreen w) w
 
-drawSmokeShadow :: World -> Smoke -> Picture
-drawSmokeShadow w sm@(Smoke {_smPos = p, _smRad = r', _smColor = c, _smPs = ps, _smTime = t}) 
-    = pictures
-        [ onLayerL [74,0] $ color col $
-                             pictures [uncurry translate p $ circle r'
-                                     ,line $ (\(x,y) -> [x,y]) $ smokePerpLine (_cameraPos w) p sm
-                                     ,line [_cameraPos w, mouseWorldPos w]
-                                     ,trap' p
-                                     ]
-        , onLayerL [74] $ color (withAlpha 0.1 c) $ pictures
-               $ concatMap (f . (+.+ p)) p's
-        ]
-    where
-        r = r'/2
-        col | smokeLOS (_cameraPos w) (mouseWorldPos w) w = red
-            | otherwise = green
-        orth p' = r *.* (safeNormalizeV $ vNormal $ p' -.- _cameraCenter w)
-        pa p' = p' +.+ orth p'
-        pb p' = p' -.- orth p'
-        pao p' = pa p' +.+ l *.* safeNormalizeV (pa p' -.- _cameraCenter w)
-        pbo p' = pb p' +.+ l *.* safeNormalizeV (pb p' -.- _cameraCenter w)
-        semiCirc p' = uncurry translate p' $ rotate (0 - (a p')) $ arcSolid 0 180 r
-        a p' = pi - argV (orth p')
-        trap p' = polygon [pa p', pb p', pbo p', pao p']
-        f p' = [semiCirc p', trap p']
-        p's = zipWith (\x p -> rotateV (x * fromIntegral t / 60) p) xs ps
-        xs = concat $ repeat [-1,-0.5,0,0.5,1]
-        l = _windowX w + _windowY w + magV (_cameraPos w -.- _cameraCenter w)
---        cenpic = color (withAlpha 0.5 c) $ pictures $ f p
-        orth' p' = r' *.* (safeNormalizeV $ vNormal $ p' -.- _cameraCenter w)
-        pa' p' = p' +.+ orth' p'
-        pb' p' = p' -.- orth' p'
-        pao' p' = pa' p' +.+ l *.* safeNormalizeV (pa' p' -.- _cameraCenter w)
-        pbo' p' = pb' p' +.+ l *.* safeNormalizeV (pb' p' -.- _cameraCenter w)
-        trap' p' = line [pa' p', pb' p', pbo' p', pao' p',pa' p']
-        semiCirc' p' = uncurry translate p' $ rotate (0 - (a p')) $ arcSolid 0 180 r'
-        
 drawWallFloor :: Wall -> Picture
 drawWallFloor wl = if _wlIsSeeThrough wl
                    then setDepth 0.9 . color c $ polygon [x,x +.+ n2,y+.+n2, y]

src/Dodge/Smoke.hs

@@ -1,33 +0,0 @@
-module Dodge.Smoke where
-
-import Dodge.Data
-import Dodge.Base
-import Dodge.RandomHelp
-import Geometry.Data
-import Picture
-
-import Control.Lens
-import Control.Monad.State
-
-spawnSmokeAt :: Point2 -> World -> World
-spawnSmokeAt p w =
-    w & smoke %~ (:) thesmoke
-      & randGen .~ g
-    where
-        thesmoke = Smoke 
-                        {_smPos = p
-                        ,_smRad = 20
-                        ,_smColor = white
-                        ,_smUpdate = f
-                        ,_smPs = ps
-                        ,_smTime = 500
-                        }
-        f s = case s ^. smPs of
-                [] -> Nothing
-                _  -> case s ^. smTime of
-                        0 -> Just $ s & smPs %~ init
-                        t -> Just $ s & smTime .~ t-1
-        (ps,g) = runState (sequence $ replicate 60 $ randInCirc 20) $ _randGen w
-
-spawnSmokeAtCursor :: World -> World
-spawnSmokeAtCursor w = spawnSmokeAt (mouseWorldPos w) w

src/Dodge/Update.hs

@@ -30,7 +30,6 @@ update w
                      $ updateLightSources
                      $ zoneClouds
                      $ updateClouds
-                     $ updateSmoke
                      $ updateCreatures 
                      $ updateBlocks -- $ zoning 
                      $ updateSeenWalls 
@@ -71,9 +70,6 @@ updateLightSources w = set tempLightSources (catMaybes tlss) w'
 
 updateParticles w = IM.foldr' _ptUpdate w $ _projectiles w
 
-updateSmoke :: World -> World
-updateSmoke w = w & smoke %~ mapMaybe (\s -> _smUpdate s s)
-
 updateParticles' :: World -> World
 updateParticles' w = set particles' (catMaybes ps) w'
     where (w',ps) = mapAccumR (\a b -> _ptUpdate' b a b) w $ _particles' w
@@ -145,7 +141,6 @@ clClSpringVel :: Cloud -> World -> Cloud -> Point2 -> Point2
 clClSpringVel a w b v 
     | ida == idb = v
     | dist pa pb < radDist = v +.+ 0.1 *.* (safeNormalizeV (pa -.- pb))
---    | dist pa pb < radDist = v +.+ 0.1 *.* (safeNormalizeV (pa -.- pb))
     | otherwise = v
     where ida = _clID a
           idb = _clID b

src/Dodge/WorldEvent/Cloud.hs

@@ -39,3 +39,5 @@ makeFlamerSmoke pos w = w & clouds %~ IM.insert i theCloud
                            , _clEffect = const id
                            }
 
+spawnSmokeAtCursor :: World -> World
+spawnSmokeAtCursor w = makeSmokeCloud (mouseWorldPos w) w