Raincat-1.1.1: src/Rain/Rain.hs
module Rain.Rain
(updateRain,
drawRain,
rainRect,
rainPoly) where
import System.Random
import Graphics.Rendering.OpenGL
import World.World
import Panels.MainPanel
import Nxt.Types
import Items.Items
import Level.Level
import Settings.RainSettings as RainSettings
import Settings.WorldSettings as WorldSettings
import Nxt.Graphics
-- updateRain
updateRain :: WorldState -> IO [Vector2d]
updateRain worldState = do
let rain = raindrops (mainPanel worldState)
(cameraX, cameraY) = cameraPos (mainPanel worldState)
let fallenRain = fallRain rain cameraY
let spawnList = [(1.0 - cameraX)..(maxWorldX - cameraX)]
let xPos = [x::Double | x <- spawnList, ceiling x `mod` rainSpacing == 0]
gen <- newStdGen
let lvlHeight = fromIntegral(levelHeight $ curLevel worldState)::Double
let yPos = randomRs (lvlHeight - rainHeight - cameraY, lvlHeight - cameraY) gen
let rainPositions = zip xPos yPos
newRainSeq <- mapM createNewRain rainPositions
let newRain = concat newRainSeq
let totalRain = newRain ++ fallenRain
let rainPolyCol = collideRainPoly totalRain (polySurfaces (mainPanel worldState))
let rectSurfaces' = map itemRect (tarpList (mainPanel worldState))
++
map itemRect (corkList (mainPanel worldState))
++
rectSurfaces (mainPanel worldState)
let rainRectCol = collideRainRect rainPolyCol rectSurfaces'
return rainRectCol
-- createNewRain
createNewRain :: Vector2d -> IO [Vector2d]
createNewRain rainPos = do
raindropDiceRoll <- getStdRandom $ randomR (0::Int, rainSpawnChance)
return [rainPos | raindropDiceRoll == 0]
-- fallRain
fallRain :: [Vector2d] -> Double -> [Vector2d]
fallRain [] _ = []
fallRain ((raindropX, raindropY) : rain) cameraY
| raindropY > (-cameraY) = (raindropX, raindropY - rainFallSpeed) : fallRain rain cameraY
| otherwise = fallRain rain cameraY
-- drawRain
drawRain :: [Vector2d] -> IO ()
drawRain [] = return ()
drawRain ((raindropX, raindropY) : rain) = do
renderPrimitive Quads $ do
mapM_ color rainColor
mapM_ vertex (raindropVertices raindropX raindropY)
drawRain rain
-- raindropVertices
raindropVertices :: Double -> Double -> [Vertex3 GLdouble]
raindropVertices x y =
[Vertex3 x' y' 0.0,
Vertex3 (x' + rainWidth') y' 0.0,
Vertex3 (x' + rainWidth') (y' + rainHeight') 0.0,
Vertex3 x' (y' + rainHeight') 0.0]
where x' = toGLdouble x
y' = toGLdouble y
rainWidth' = toGLdouble rainWidth
rainHeight' = toGLdouble rainHeight
-- rainPoly
rainPoly :: Vector2d -> Nxt.Types.Poly
rainPoly (raindropX, raindropY) =
Poly 3 [(raindropX,raindropY),
(raindropX+RainSettings.rainWidth,raindropY),
(raindropX+RainSettings.rainWidth,raindropY+RainSettings.rainHeight)]
-- collideRainPoly
collideRainPoly :: [Vector2d] -> [Nxt.Types.Poly] -> [Vector2d]
collideRainPoly [] _ = []
collideRainPoly (raindrop:rain) polys =
if foldr (\poly -> (polyIntersect poly (rainPoly raindrop) ||)) False polys
then
collideRainPoly rain polys
else
raindrop : collideRainPoly rain polys
-- rainRect
rainRect :: Vector2d -> Nxt.Types.Rect
rainRect (raindropX, raindropY) =
Rect raindropX raindropY RainSettings.rainWidth RainSettings.rainHeight
-- collideRainRect
collideRainRect :: [Vector2d] -> [Nxt.Types.Rect] -> [Vector2d]
collideRainRect [] _ = []
collideRainRect (raindrop:rain) rects =
if foldr ((||) . rectIntersect (rainRect raindrop)) False rects
then
collideRainRect rain rects
else
raindrop : collideRainRect rain rects