module Graphics.Rendering.OpenGL.GL.Fog (
fog,
FogMode(..), fogMode,
fogColor, fogIndex,
FogCoordSrc(..), fogCoordSrc,
FogDistanceMode(..), fogDistanceMode
) where
import Data.StateVar
import Foreign.Marshal.Utils
import Foreign.Ptr
import Graphics.Rendering.OpenGL.GL.Capability
import Graphics.Rendering.OpenGL.GL.QueryUtils
import Graphics.Rendering.OpenGL.GL.VertexSpec
import Graphics.GL
fog :: StateVar Capability
fog = makeCapability CapFog
data FogParameter =
FogIndex
| FogDensity
| FogStart
| FogEnd
| FogMode
| FogColor
| FogCoordSrc
| FogDistanceMode
marshalFogParameter :: FogParameter -> GLenum
marshalFogParameter x = case x of
FogIndex -> GL_FOG_INDEX
FogDensity -> GL_FOG_DENSITY
FogStart -> GL_FOG_START
FogEnd -> GL_FOG_END
FogMode -> GL_FOG_MODE
FogColor -> GL_FOG_COLOR
FogCoordSrc -> GL_FOG_COORD_SRC
FogDistanceMode -> GL_FOG_DISTANCE_MODE_NV
data FogMode' =
Linear'
| Exp'
| Exp2'
marshalFogMode' :: FogMode' -> GLint
marshalFogMode' x = fromIntegral $ case x of
Linear' -> GL_LINEAR
Exp' -> GL_EXP
Exp2' -> GL_EXP2
unmarshalFogMode' :: GLint -> FogMode'
unmarshalFogMode' x
| y == GL_LINEAR = Linear'
| y == GL_EXP = Exp'
| y == GL_EXP2 = Exp2'
| otherwise = error ("unmarshalFogMode': illegal value " ++ show x)
where y = fromIntegral x
data FogMode =
Linear GLfloat GLfloat
| Exp GLfloat
| Exp2 GLfloat
deriving ( Eq, Ord, Show )
fogMode :: StateVar FogMode
fogMode = makeStateVar getFogMode setFogMode
getFogMode :: IO FogMode
getFogMode = do
mode <- getInteger1 unmarshalFogMode' GetFogMode
case mode of
Linear' -> do
start <- getFloat1 id GetFogStart
end <- getFloat1 id GetFogEnd
return $ Linear start end
Exp' -> getFloat1 Exp GetFogDensity
Exp2' -> getFloat1 Exp2 GetFogDensity
setFogMode :: FogMode -> IO ()
setFogMode (Linear start end) = do
fogi FogMode (marshalFogMode' Linear')
fogf FogStart start
fogf FogEnd end
setFogMode (Exp density) = do
fogi FogMode (marshalFogMode' Exp')
fogf FogDensity density
setFogMode (Exp2 density) = do
fogi FogMode (marshalFogMode' Exp2')
fogf FogDensity density
fogi :: FogParameter -> GLint -> IO ()
fogi = glFogi . marshalFogParameter
fogf :: FogParameter -> GLfloat -> IO ()
fogf = glFogf . marshalFogParameter
fogfv :: FogParameter -> Ptr (Color4 GLfloat) -> IO ()
fogfv param ptr = glFogfv (marshalFogParameter param) (castPtr ptr)
fogColor :: StateVar (Color4 GLclampf)
fogColor =
makeStateVar
(getClampf4 Color4 GetFogColor)
(\c -> with c $ (fogfv FogColor . castPtr))
fogIndex :: StateVar (Index1 GLint)
fogIndex =
makeStateVar
(getInteger1 Index1 GetFogIndex)
(\(Index1 i) -> fogi FogIndex i)
data FogCoordSrc =
FogCoord
| FragmentDepth
deriving ( Eq, Ord, Show )
marshalFogCoordSrc :: FogCoordSrc -> GLint
marshalFogCoordSrc x = fromIntegral $ case x of
FogCoord -> GL_FOG_COORD
FragmentDepth -> GL_FRAGMENT_DEPTH
unmarshalFogCoordSrc :: GLint -> FogCoordSrc
unmarshalFogCoordSrc x
| y == GL_FOG_COORD = FogCoord
| y == GL_FRAGMENT_DEPTH = FragmentDepth
| otherwise = error ("unmarshalFogCoordSrc: illegal value " ++ show x)
where y = fromIntegral x
fogCoordSrc :: StateVar FogCoordSrc
fogCoordSrc =
makeStateVar
(getInteger1 unmarshalFogCoordSrc GetFogCoordSrc)
(fogi FogCoordSrc . marshalFogCoordSrc)
data FogDistanceMode =
EyeRadial
| EyePlaneSigned
| EyePlaneAbsolute
deriving ( Eq, Ord, Show )
marshalFogDistanceMode :: FogDistanceMode -> GLint
marshalFogDistanceMode x = fromIntegral $ case x of
EyeRadial -> GL_EYE_RADIAL_NV
EyePlaneSigned -> GL_EYE_PLANE
EyePlaneAbsolute -> GL_EYE_PLANE_ABSOLUTE_NV
unmarshalFogDistanceMode :: GLint -> FogDistanceMode
unmarshalFogDistanceMode x
| y == GL_EYE_RADIAL_NV = EyeRadial
| y == GL_EYE_PLANE = EyePlaneSigned
| y == GL_EYE_PLANE_ABSOLUTE_NV = EyePlaneAbsolute
| otherwise = error ("unmarshalFogDistanceMode: illegal value " ++ show x)
where y = fromIntegral x
fogDistanceMode :: StateVar FogDistanceMode
fogDistanceMode =
makeStateVar
(getInteger1 unmarshalFogDistanceMode GetFogDistanceMode)
(fogi FogDistanceMode . marshalFogDistanceMode)