71 lines
2.4 KiB
Haskell
71 lines
2.4 KiB
Haskell
module Dodge.WorldEvent.Cloud
|
|
where
|
|
|
|
import Dodge.Data
|
|
import Dodge.Base
|
|
|
|
import Geometry
|
|
|
|
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
|
|
theCloud = Cloud { _clID = i
|
|
, _clPos = pos
|
|
, _clVel = (0,0)
|
|
, _clPict = fadeOutPict (-0.5)
|
|
, _clRad = 5
|
|
, _clTimer = 200
|
|
, _clEffect = const id
|
|
}
|
|
|
|
fadeOutPict :: Float -> Cloud -> Picture
|
|
fadeOutPict dpth cl = setLayer 2 . setDepth dpth . color (withAlpha a $ greyN 0.5) $ circleSolid (4 * _clRad cl)
|
|
where a = fromIntegral (_clTimer cl) / 200
|
|
|
|
makeFlamerSmoke :: Point2 -> World -> World
|
|
makeFlamerSmoke pos w = w & clouds %~ IM.insert i theCloud
|
|
where i = newKey $ _clouds w
|
|
theCloud = Cloud { _clID = i
|
|
, _clPos = pos
|
|
, _clVel = (0,0)
|
|
, _clPict = fadeOutPict 0
|
|
, _clRad = 5
|
|
, _clTimer = 200
|
|
, _clEffect = const id
|
|
}
|
|
|
|
spawnSmokeAtCursor :: World -> World
|
|
spawnSmokeAtCursor w = makeSmokeCloud (mouseWorldPos w) w
|