module Graphics.LambdaCube.RenderSystem.GL.Utils where
import Data.Bits
import Data.Char
import qualified Data.Set as Set
import Foreign
import Foreign.C.String
import Graphics.Rendering.OpenGL.Raw.Core31
import qualified Graphics.Rendering.OpenGL.Raw.ARB.Compatibility as Compat
import qualified Graphics.Rendering.OpenGL.Raw.ARB as ARB
import qualified Graphics.Rendering.OpenGL.Raw.EXT as EXT
import Graphics.LambdaCube.BlendMode
import Graphics.LambdaCube.Common
import Graphics.LambdaCube.HardwareBuffer
import Graphics.LambdaCube.HardwareVertexBuffer
import Graphics.LambdaCube.PixelFormat
import Graphics.LambdaCube.RenderSystemCapabilities
import Graphics.LambdaCube.Texture
import Graphics.LambdaCube.TextureUnitState
peek4 :: Storable a => (a -> a -> a -> a -> b) -> Ptr a -> IO b
peek4 f = peek4M $ \x y z w -> return (f x y z w)
peek4M :: Storable a => (a -> a -> a -> a -> IO b) -> Ptr a -> IO b
peek4M f ptr = do
x <- peekElemOff ptr 0
y <- peekElemOff ptr 1
z <- peekElemOff ptr 2
w <- peekElemOff ptr 3
f x y z w
getFloat :: GLenum -> IO GLfloat
getFloat n = alloca $ \i -> do
glGetFloatv n i
peek i
getInteger :: GLenum -> IO GLint
getInteger n = alloca $ \i -> do
glGetIntegerv n i
peek i
getBoolean :: GLenum -> IO GLboolean
getBoolean n = alloca $ \i -> do
glGetBooleanv n i
peek i
getBoolean4 :: GLenum -> IO (GLboolean, GLboolean, GLboolean, GLboolean)
getBoolean4 n = allocaArray 4 $ \buf -> do
glGetBooleanv n buf
peek4 (,,,) buf
getInteger4 :: GLenum -> IO (GLint, GLint, GLint, GLint)
getInteger4 n = allocaArray 4 $ \buf -> do
glGetIntegerv n buf
peek4 (,,,) buf
getString :: GLenum -> IO String
getString n = glGetString n >>= maybeNullPtr (return "") (peekCString . castPtr)
where
maybeNullPtr :: b -> (Ptr a -> b) -> Ptr a -> b
maybeNullPtr n f ptr | ptr == nullPtr = n
| otherwise = f ptr
getGLExtensions :: IO [String]
getGLExtensions = fmap words $ getString gl_EXTENSIONS
getGLVersion :: IO (Int, Int)
getGLVersion = fmap parse $ getString gl_VERSION
where
defaultVersion = (1, 1)
parse str = case span isDigit str of
(major@(_:_), '.':rest) ->
case span isDigit rest of
(minor@(_:_), _) -> (read major, read minor)
_ -> defaultVersion
_ -> defaultVersion
getGLUsage :: Usage -> GLenum
getGLUsage usage = case usage of
HBU_STATIC -> gl_STATIC_DRAW
HBU_STATIC_WRITE_ONLY -> gl_STATIC_DRAW
HBU_DYNAMIC -> gl_DYNAMIC_DRAW
HBU_DYNAMIC_WRITE_ONLY -> gl_DYNAMIC_DRAW
HBU_DYNAMIC_WRITE_ONLY_DISCARDABLE -> gl_STREAM_DRAW
_ -> gl_DYNAMIC_DRAW
getGLType :: VertexElementType -> GLenum
getGLType t = case t of
VET_FLOAT1 -> gl_FLOAT
VET_FLOAT2 -> gl_FLOAT
VET_FLOAT3 -> gl_FLOAT
VET_FLOAT4 -> gl_FLOAT
VET_SHORT1 -> gl_SHORT
VET_SHORT2 -> gl_SHORT
VET_SHORT3 -> gl_SHORT
VET_SHORT4 -> gl_SHORT
VET_COLOUR_ABGR -> gl_UNSIGNED_BYTE
VET_COLOUR_ARGB -> gl_UNSIGNED_BYTE
VET_UBYTE4 -> gl_UNSIGNED_BYTE
getGLTextureTarget :: TextureType -> GLenum
getGLTextureTarget textureType = case textureType of
TEX_TYPE_1D -> gl_TEXTURE_1D
TEX_TYPE_2D -> gl_TEXTURE_2D
TEX_TYPE_3D -> gl_TEXTURE_3D
TEX_TYPE_CUBE_MAP -> gl_TEXTURE_CUBE_MAP
optionalPO2 :: RenderSystemCapabilities -> Int -> Int
optionalPO2 rcaps value = case Set.member RSC_NON_POWER_OF_2_TEXTURES (rscCapabilities rcaps) of
True -> value
False -> 2 ^ (1 + log2 (value1))
where
log2 :: Int -> Int
log2 n = case n of
0 -> 1
_ -> 1 + log2 (shiftR n 1)
getMaxMipmaps :: Int -> Int -> Int -> PixelFormat -> GLint
getMaxMipmaps width height depth _format = maximum [f width, f height, f depth]
where
bits :: Double -> Double
bits = logBase 2
f x = floor $ bits $ fromIntegral x
getNativeFormat :: TextureType -> PixelFormat -> Bool -> PixelFormat
getNativeFormat _ttype _format _isTarget = PF_R8G8B8
getClosestGLInternalFormat :: PixelFormat -> Bool -> GLint
getClosestGLInternalFormat mFormat hwGamma = fromIntegral $ case mFormat of
PF_L8 -> Compat.gl_LUMINANCE8
PF_L16 -> Compat.gl_LUMINANCE16
PF_A8 -> Compat.gl_ALPHA8
PF_A4L4 -> Compat.gl_LUMINANCE4_ALPHA4
PF_BYTE_LA -> Compat.gl_LUMINANCE8_ALPHA8
PF_R3G3B2 -> gl_R3_G3_B2
PF_A1R5G5B5 -> gl_RGB5_A1
PF_R5G6B5 -> gl_RGB5
PF_B5G6R5 -> gl_RGB5
PF_A4R4G4B4 -> gl_RGBA4
PF_R8G8B8 -> if hwGamma then gl_SRGB8 else gl_RGB8
PF_B8G8R8 -> if hwGamma then gl_SRGB8 else gl_RGB8
PF_X8B8G8R8 -> if hwGamma then gl_SRGB8 else gl_RGB8
PF_X8R8G8B8 -> if hwGamma then gl_SRGB8 else gl_RGB8
PF_A8R8G8B8 -> if hwGamma then gl_SRGB8_ALPHA8 else gl_RGBA8
PF_B8G8R8A8 -> if hwGamma then gl_SRGB8_ALPHA8 else gl_RGBA8
PF_A2R10G10B10 -> gl_RGB10_A2
PF_A2B10G10R10 -> gl_RGB10_A2
PF_FLOAT16_R -> ARB.gl_LUMINANCE16F
PF_FLOAT16_RGB -> ARB.gl_RGB16F
PF_FLOAT16_GR -> ARB.gl_LUMINANCE_ALPHA16F
PF_FLOAT16_RGBA -> ARB.gl_RGBA16F
PF_FLOAT32_R -> ARB.gl_LUMINANCE32F
PF_FLOAT32_GR -> ARB.gl_LUMINANCE_ALPHA32F
PF_FLOAT32_RGB -> ARB.gl_RGB32F
PF_FLOAT32_RGBA -> ARB.gl_RGBA32F
PF_SHORT_RGBA -> gl_RGBA16
PF_SHORT_RGB -> gl_RGB16
PF_SHORT_GR -> Compat.gl_LUMINANCE16_ALPHA16
PF_DXT1 -> if hwGamma then EXT.gl_COMPRESSED_SRGB_ALPHA_S3TC_DXT1 else EXT.gl_COMPRESSED_RGBA_S3TC_DXT1
PF_DXT3 -> if hwGamma then EXT.gl_COMPRESSED_SRGB_ALPHA_S3TC_DXT3 else EXT.gl_COMPRESSED_RGBA_S3TC_DXT3
PF_DXT5 -> if hwGamma then EXT.gl_COMPRESSED_SRGB_ALPHA_S3TC_DXT5 else EXT.gl_COMPRESSED_RGBA_S3TC_DXT5
_ -> if hwGamma then gl_SRGB8 else gl_RGBA8
getBlendMode :: SceneBlendFactor -> GLenum
getBlendMode blend = case blend of
SBF_ONE -> gl_ONE
SBF_ZERO -> gl_ZERO
SBF_DEST_COLOUR -> gl_DST_COLOR
SBF_SOURCE_COLOUR -> gl_SRC_COLOR
SBF_ONE_MINUS_DEST_COLOUR -> gl_ONE_MINUS_DST_COLOR
SBF_ONE_MINUS_SOURCE_COLOUR -> gl_ONE_MINUS_SRC_COLOR
SBF_DEST_ALPHA -> gl_DST_ALPHA
SBF_SOURCE_ALPHA -> gl_SRC_ALPHA
SBF_ONE_MINUS_DEST_ALPHA -> gl_ONE_MINUS_DST_ALPHA
SBF_ONE_MINUS_SOURCE_ALPHA -> gl_ONE_MINUS_SRC_ALPHA
getBlendEquation :: SceneBlendOperation -> GLenum
getBlendEquation op = case op of
SBO_ADD -> gl_FUNC_ADD
SBO_SUBTRACT -> gl_FUNC_SUBTRACT
SBO_REVERSE_SUBTRACT -> gl_FUNC_REVERSE_SUBTRACT
SBO_MIN -> gl_MIN
SBO_MAX -> gl_MAX
getTextureAddressingMode :: TextureAddressingMode -> GLenum
getTextureAddressingMode tam = case tam of
TAM_WRAP -> gl_REPEAT
TAM_MIRROR -> gl_MIRRORED_REPEAT
TAM_CLAMP -> gl_CLAMP_TO_EDGE
TAM_BORDER -> gl_CLAMP_TO_BORDER
getLayerBlendSource :: LayerBlendSource -> GLenum
getLayerBlendSource src = case src of
LBS_CURRENT -> Compat.gl_PREVIOUS
LBS_TEXTURE -> gl_TEXTURE
LBS_MANUAL -> Compat.gl_CONSTANT
LBS_DIFFUSE -> Compat.gl_PRIMARY_COLOR
LBS_SPECULAR -> Compat.gl_PRIMARY_COLOR
getTextureCombineFunction :: Bool -> LayerBlendOperationEx -> GLenum
getTextureCombineFunction hasDot3 op = case op of
LBX_SOURCE1 -> gl_REPLACE
LBX_SOURCE2 -> gl_REPLACE
LBX_MODULATE -> Compat.gl_MODULATE
LBX_MODULATE_X2 -> Compat.gl_MODULATE
LBX_MODULATE_X4 -> Compat.gl_MODULATE
LBX_ADD -> Compat.gl_ADD
LBX_ADD_SIGNED -> Compat.gl_ADD_SIGNED
LBX_ADD_SMOOTH -> Compat.gl_INTERPOLATE
LBX_SUBTRACT -> Compat.gl_SUBTRACT
LBX_BLEND_DIFFUSE_COLOUR -> Compat.gl_INTERPOLATE
LBX_BLEND_DIFFUSE_ALPHA -> Compat.gl_INTERPOLATE
LBX_BLEND_TEXTURE_ALPHA -> Compat.gl_INTERPOLATE
LBX_BLEND_CURRENT_ALPHA -> Compat.gl_INTERPOLATE
LBX_BLEND_MANUAL -> Compat.gl_INTERPOLATE
LBX_DOTPRODUCT -> if hasDot3 then Compat.gl_DOT3_RGB else Compat.gl_MODULATE
convertCompareFunction :: CompareFunction -> GLenum
convertCompareFunction f = case f of
CMPF_ALWAYS_FAIL -> gl_NEVER
CMPF_ALWAYS_PASS -> gl_ALWAYS
CMPF_LESS -> gl_LESS
CMPF_LESS_EQUAL -> gl_LEQUAL
CMPF_EQUAL -> gl_EQUAL
CMPF_NOT_EQUAL -> gl_NOTEQUAL
CMPF_GREATER_EQUAL -> gl_GEQUAL
CMPF_GREATER -> gl_GREATER