diff --git a/src/Dodge/Base.hs b/src/Dodge/Base.hs index 2aa872c8e..01acaf4b7 100644 --- a/src/Dodge/Base.hs +++ b/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 diff --git a/src/Dodge/Critters.hs b/src/Dodge/Critters.hs index 3f1bdcc3c..ff73debb6 100644 --- a/src/Dodge/Critters.hs +++ b/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 diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 0d5aa5401..e03ff91f5 100644 --- a/src/Dodge/Data.hs +++ b/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 diff --git a/src/Dodge/Prototypes.hs b/src/Dodge/Prototypes.hs index df8050b11..ce84840b0 100644 --- a/src/Dodge/Prototypes.hs +++ b/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] diff --git a/src/Dodge/Rendering.hs b/src/Dodge/Rendering.hs index f2c7ad233..ef884787e 100644 --- a/src/Dodge/Rendering.hs +++ b/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] diff --git a/src/Dodge/Smoke.hs b/src/Dodge/Smoke.hs deleted file mode 100644 index b1a23a8dd..000000000 --- a/src/Dodge/Smoke.hs +++ /dev/null @@ -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 diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index 1125ac027..3c6986af7 100644 --- a/src/Dodge/Update.hs +++ b/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 diff --git a/src/Dodge/WorldEvent/Cloud.hs b/src/Dodge/WorldEvent/Cloud.hs index 59c09d83f..1de6e78cf 100644 --- a/src/Dodge/WorldEvent/Cloud.hs +++ 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