Refactor gun smoke

This commit is contained in:
jgk
2021-03-24 03:28:42 +01:00
parent 48e6779503
commit 9b83afbdd0
2 changed files with 14 additions and 37 deletions
+10 -33
View File
@@ -24,47 +24,24 @@ makeCloudAt rad t drawFunc p w
, _clEffect = const id
}
fadeOutTime :: Color -> Float -> Cloud -> Picture
fadeOutTime col fadet cl = setLayer 2
drawCloudWith :: Float -> Float -> Color -> Cloud -> Picture
drawCloudWith radMult fadet col cl = setLayer 2
. setDepth (-0.5)
. color (withAlpha a col)
$ circleSolid (4 * _clRad cl)
$ circleSolid (radMult * _clRad cl)
where a = min 1 $ fromIntegral (_clTimer cl) / fadet
makeThickSmokeAt :: Point2 -> World -> World
makeThickSmokeAt = makeCloudAt 2 50 (fadeOutTime black 50)
makeThickSmokeAt = makeCloudAt 3 50 (drawCloudWith 4 50 black)
makeThinSmokeAt :: Point2 -> World -> World
makeThinSmokeAt = makeSmokeCloud
makeThinSmokeAt = makeCloudAt 5 400 (drawCloudWith 4 400 (withAlpha 0.05 black))
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
}
makeSmokeCloudAt :: Point2 -> World -> World
makeSmokeCloudAt = makeCloudAt 5 200 (drawCloudWith 4 200 (greyN 0.5))
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
}
makeFlamerSmokeAt :: Point2 -> World -> World
makeFlamerSmokeAt = makeCloudAt 3 200 (drawCloudWith 4 200 (greyN 0.5))
spawnSmokeAtCursor :: World -> World
spawnSmokeAtCursor w = makeSmokeCloud (mouseWorldPos w) w
spawnSmokeAtCursor w = makeSmokeCloudAt (mouseWorldPos w) w