77 lines
2.1 KiB
Haskell
77 lines
2.1 KiB
Haskell
module Dodge.WorldEvent.Cloud
|
|
( makeFlamerSmokeAt
|
|
, smokeCloudAt
|
|
, makeThinSmokeAt
|
|
, makeThickSmokeAt
|
|
, shellTrailCloud
|
|
, spawnSmokeAtCursor
|
|
, makeStartCloudAt
|
|
) where
|
|
import Dodge.Data
|
|
import Dodge.Base
|
|
import Geometry.Data
|
|
import Picture
|
|
|
|
import Control.Lens
|
|
import System.Random
|
|
|
|
makeCloudAt
|
|
:: (Cloud -> Picture) -- ^ draw function
|
|
-> Float -- ^ radius
|
|
-> Int -- ^ timer
|
|
-> Float -- ^ resting altitude
|
|
-> Point3 -- start position
|
|
-> World
|
|
-> World
|
|
makeCloudAt drawFunc rad t alt p = clouds %~ (theCloud :)
|
|
where
|
|
theCloud = Cloud
|
|
{ _clPos = p
|
|
, _clVel = V3 0 0 0
|
|
, _clPict = drawFunc
|
|
, _clRad = rad
|
|
, _clAlt = alt
|
|
, _clTimer = t
|
|
, _clType = SmokeCloud
|
|
, _clEffect = const id
|
|
}
|
|
|
|
smokeCloudAt
|
|
:: Color
|
|
-> Float -- ^ radius
|
|
-> Int -- ^ timer
|
|
-> Float -- ^ resting altitude
|
|
-> Point3 -- start position
|
|
-> World
|
|
-> World
|
|
smokeCloudAt col = makeCloudAt (drawCloudWith (4/3) 800 col)
|
|
|
|
drawCloudWith :: Float -> Float -> Color -> Cloud -> Picture
|
|
drawCloudWith radMult fadet col cl = setLayer 2
|
|
. setDepth 25
|
|
$ circleSolidCol (withAlpha 0 col) (withAlpha a col) (radMult * _clRad cl)
|
|
where
|
|
a = min 1 $ fromIntegral (_clTimer cl) / fadet
|
|
|
|
makeThickSmokeAt :: Point3 -> World -> World
|
|
makeThickSmokeAt = makeCloudAt (drawCloudWith 4 50 black) 3 50 30
|
|
|
|
makeThinSmokeAt :: Point3 -> World -> World
|
|
makeThinSmokeAt = makeCloudAt (drawCloudWith 4 400 (withAlpha 0.05 black)) 5 400 50
|
|
|
|
makeStartCloudAt :: Point3 -> World -> World
|
|
makeStartCloudAt = makeCloudAt (drawCloudWith 2 800 white) 10 400 5
|
|
|
|
shellTrailCloud :: Point3 -> World -> World
|
|
shellTrailCloud = makeCloudAt (drawCloudWith (4/3) 800 (greyN 0.5)) 15 400 40
|
|
|
|
makeFlamerSmokeAt :: Point3 -> World -> World
|
|
makeFlamerSmokeAt p w = makeCloudAt (drawCloudWith 4 300 (greyN x)) 6 200 40 p w
|
|
where
|
|
x = fst $ randomR (0.5,0.8) (_randGen w)
|
|
|
|
spawnSmokeAtCursor :: World -> World
|
|
spawnSmokeAtCursor w = shellTrailCloud (V3 x y 20) w
|
|
where
|
|
V2 x y = mouseWorldPos w
|