77 lines
2.0 KiB
Haskell
77 lines
2.0 KiB
Haskell
module Dodge.WorldEvent.Cloud (
|
|
makeFlamerSmokeAt,
|
|
smokeCloudAt,
|
|
makeThinSmokeAt,
|
|
makeThickSmokeAt,
|
|
shellTrailCloud,
|
|
spawnSmokeAtCursor,
|
|
makeStartCloudAt,
|
|
) where
|
|
|
|
import Dodge.Base
|
|
import Dodge.Data.World
|
|
import Geometry.Data
|
|
import LensHelp
|
|
import Picture
|
|
import System.Random
|
|
|
|
makeCloudAt ::
|
|
CloudDraw ->
|
|
-- | radius
|
|
Float ->
|
|
-- | timer
|
|
Int ->
|
|
-- | resting altitude
|
|
Float ->
|
|
Point3 -> -- start position
|
|
World ->
|
|
World
|
|
makeCloudAt drawFunc rad t alt p =
|
|
cWorld . lWorld . clouds
|
|
.:~ Cloud
|
|
{ _clPos = p
|
|
, _clVel = V3 0 0 0
|
|
, _clPict = drawFunc
|
|
, _clRad = rad
|
|
, _clAlt = alt
|
|
, _clTimer = t
|
|
, _clType = SmokeCloud
|
|
}
|
|
|
|
smokeCloudAt ::
|
|
Color ->
|
|
-- | radius
|
|
Float ->
|
|
-- | timer
|
|
Int ->
|
|
-- | resting altitude
|
|
Float ->
|
|
Point3 -> -- start position
|
|
World ->
|
|
World
|
|
smokeCloudAt col = makeCloudAt (CloudColor (4 / 3) 800 col)
|
|
|
|
makeThickSmokeAt :: Point3 -> World -> World
|
|
makeThickSmokeAt = makeCloudAt (CloudColor 4 50 black) 3 50 30
|
|
|
|
makeThinSmokeAt :: Point3 -> World -> World
|
|
makeThinSmokeAt = makeCloudAt (CloudColor 4 400 (withAlpha 0.05 black)) 5 400 50
|
|
|
|
makeStartCloudAt :: Point3 -> World -> World
|
|
--makeStartCloudAt = makeCloudAt (CloudColor 2 800 white) 10 400 5
|
|
--makeStartCloudAt = makeCloudAt (CloudColor 2 200 white) 10 400 50
|
|
makeStartCloudAt = makeCloudAt (CloudColor 2 200 white) 10 400 50
|
|
|
|
shellTrailCloud :: Int -> Float -> Point3 -> World -> World
|
|
shellTrailCloud age fadet = makeCloudAt (CloudColor (3/2) fadet (greyN 0.5)) 15 age 30
|
|
|
|
makeFlamerSmokeAt :: Point3 -> World -> World
|
|
makeFlamerSmokeAt p w = makeCloudAt (CloudColor 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 400 100 (V3 x y 20) w
|
|
where
|
|
V2 x y = mouseWorldPos (w ^. input) (w ^. cWorld . cwCam)
|