62 lines
1.9 KiB
Haskell
62 lines
1.9 KiB
Haskell
{-# LANGUAGE LambdaCase #-}
|
|
|
|
module Shader.Poke.Cloud (pokeCloud) where
|
|
|
|
import Dodge.Data.Material
|
|
import Color
|
|
import Control.Lens
|
|
import qualified Data.Vector.Unboxed as UV
|
|
import Dodge.Data.Cloud
|
|
import Foreign
|
|
import Geometry
|
|
import Graphics.GL.Core45
|
|
|
|
pokeCloud :: Ptr Float -> Ptr GLushort -> (Int, Int) -> Cloud -> IO (Int, Int)
|
|
pokeCloud vptr iptr (nv, ni) cl = do
|
|
UV.imapM_ (pokeCloudVerx vptr cl nv) $ UV.fromList [(1, 1), (-1, 1), (-1, -1), (1, -1)]
|
|
UV.imapM_ (pokeCloudIndex iptr nv ni) $ UV.fromList [0, 1, 2, 2, 0, 3]
|
|
return (nv + 4, ni + 6)
|
|
|
|
pokeCloudVerx :: Ptr Float -> Cloud -> Int -> Int -> (Float, Float) -> IO ()
|
|
{-# INLINE pokeCloudVerx #-}
|
|
pokeCloudVerx ptr cl nv i (dx, dy) =
|
|
UV.imapM_ (pokeCloudFloat ptr (nv + i)) $
|
|
UV.fromList
|
|
[x, y, cz, 1, r, g, b, a, cx, cy, cz, rad, dx, dy, 0, 0]
|
|
where
|
|
V3 cx cy cz = _clPos cl
|
|
V2 x y = V2 cx cy - rad *.* V2 dx dy
|
|
--CloudColor fadet col = _clPict cl
|
|
-- CloudColor fadet = _clPict cl
|
|
(rad, V4 r g b a') = (20, clColor $ cl ^. clType)
|
|
-- (rad,V4 r g b a') = (_clRad cl*rad', col)
|
|
a = a' * min 1 (fromIntegral (_clTimer cl) / 100)
|
|
|
|
clColor :: CloudType -> Color
|
|
clColor = \case
|
|
FlamerSmokeCloud -> greyN 0.7
|
|
RocketCloud -> greyN 0.5
|
|
CryoReleaseCloud -> white
|
|
GasCloud -> green
|
|
Dust mt -> materialColor mt
|
|
|
|
materialColor :: Material -> Color
|
|
materialColor = \case
|
|
Wood -> dark yellow
|
|
Dirt -> dark $ dark orange
|
|
Stone -> greyN 0.5
|
|
Glass -> white
|
|
Metal -> orange
|
|
Crystal -> green
|
|
Flesh -> red
|
|
Electronics-> greyN 0.2
|
|
|
|
|
|
pokeCloudFloat :: Ptr Float -> Int -> Int -> Float -> IO ()
|
|
{-# INLINE pokeCloudFloat #-}
|
|
pokeCloudFloat ptr nv i = pokeElemOff ptr (nv * 16 + i)
|
|
|
|
pokeCloudIndex :: Ptr GLushort -> Int -> Int -> Int -> Int -> IO ()
|
|
{-# INLINE pokeCloudIndex #-}
|
|
pokeCloudIndex ptr nv ni ioff voff = pokeElemOff ptr (ni + ioff) (fromIntegral $ nv + voff)
|