packages feed

lambdacube-engine-0.1.1: Graphics/LambdaCube/RenderSystem/GL/GLRenderSystem.hs

{-# LANGUAGE MultiParamTypeClasses #-}
module Graphics.LambdaCube.RenderSystem.GL.GLRenderSystem where

import Data.IntMap ((!))
import qualified Data.Map as Map
import qualified Data.IntMap as IntMap
import qualified Data.Set as Set
import Data.IORef
import Data.Word
import Data.Maybe
import Control.Monad
import Foreign.C.Types
import Foreign.Ptr

import Graphics.Rendering.OpenGL (($=))
import qualified Graphics.Rendering.OpenGL as GL

import Graphics.LambdaCube.Types
import Graphics.LambdaCube.Common
import Graphics.LambdaCube.Math
import Graphics.LambdaCube.BlendMode
import Graphics.LambdaCube.HardwareBuffer
import Graphics.LambdaCube.HardwareVertexBuffer
import Graphics.LambdaCube.HardwareIndexBuffer
import Graphics.LambdaCube.VertexIndexData
import Graphics.LambdaCube.RenderOperation
import Graphics.LambdaCube.Texture
import Graphics.LambdaCube.TextureUnitState
import Graphics.LambdaCube.GpuProgram
import Graphics.LambdaCube.RenderSystemCapabilities
import Graphics.LambdaCube.RenderSystem
import Graphics.LambdaCube.RenderSystem.GL.GLGpuProgram
import Graphics.LambdaCube.RenderSystem.GL.GLTexture
import Graphics.LambdaCube.RenderSystem.GL.GLVertexBuffer
import Graphics.LambdaCube.RenderSystem.GL.GLIndexBuffer
import Graphics.LambdaCube.RenderSystem.GL.GLOcclusionQuery
import Graphics.LambdaCube.RenderSystem.GL.GLUtils
import Graphics.LambdaCube.RenderSystem.GL.GLCapabilities

data GLRenderSystem
    = GLRenderSystem
    { glrsWorldMatrix   :: IORef (GL.GLmatrix GL.GLfloat)
    , glrsViewMatrix    :: IORef (GL.GLmatrix GL.GLfloat)
    , glrsCapabilities  :: RenderSystemCapabilities
    }

mkGLRenderSystem = do
    mat <- toGLMatrix $ scal 1
    worldMat <- newIORef mat
    viewMat <- newIORef mat
    cap <- mkGLCapabilities

    -- Initialize OpenGL
    extSList    <- GL.get GL.glExtensions
    (major,minor) <- GL.get $ GL.majorMinor GL.glVersion
    -- setup capabilities
    let ext = Set.fromList extSList
        glVer a b = major > a || (major >= a && minor >= b)
        supports s = Set.member s ext

    when (glVer 1 2) $ do
        -- Set nicer lighting model -- d3d9 has this by default
        GL.lightModelColorControl $= GL.SeparateSpecularColor
        GL.lightModelLocalViewer $= GL.Enabled

    when (glVer 1 4) $ do
        GL.colorSum $= GL.Enabled
        GL.dither $= GL.Disabled

    -- Check for FSAA
    when (supports "GL_ARB_multisample") $ do
        fsaa <- GL.get GL.sampleBuffers
        when (fsaa > 0) $ 
            GL.multisample $= GL.Enabled

    return $ GLRenderSystem
        { glrsWorldMatrix   = worldMat
        , glrsViewMatrix    = viewMat
        , glrsCapabilities  = cap
        }

glDirtyHackCopyTexImage tex x y w h = do
    GL.textureBinding GL.Texture2D $= (Just $ gltxTextureObject tex)
            -- only hint code: glCopyTexImage2D(GL_TEXTURE_2D, 0, GL_LUMINANCE, 0, 0, 128, 128, 0);
    GL.copyTexImage2D Nothing 0 GL.RGBA' (GL.Position (fromIntegral x) (fromIntegral y)) (GL.TextureSize2D (fromIntegral w) (fromIntegral h)) 0
    

instance RenderSystem GLRenderSystem GLVertexBuffer GLIndexBuffer GLOcclusionQuery GLTexture GLGpuProgram GLLinkedGpuProgram where
    dirtyHackCopyTexImage _         = glDirtyHackCopyTexImage
    getName _                       = "OpenGL Rendering Subsystem"
    getCapabilities                 = glrsCapabilities
    createVertexBuffer              = mkGLVertexBuffer
    createIndexBuffer               = mkGLIndexBuffer
    createOcclusionQuery _          = mkGLOcclusionQuery
    createTexture rs                = mkGLTexture (glrsCapabilities rs)
    createGpuProgram _              = mkGLGpuProgram
    createLinkedGpuProgram _        = mkGLLinkedGpuProgram
    bindLinkedGpuProgram _          = glBindLinkedGpuProgram
    unbindLinkedGpuProgram _        = glUnBindLinkedGpuProgram
    render _                        = glRender
    bindGeometry _                  = glBindGeometry
    unbindGeometry rs               = glUnBindGeometry (glrsCapabilities rs)
    setViewport _ x y w h           = glSetViewport x y w h
    setPolygonMode _ pm             = glSetPolygonMode pm
    setWorldMatrix                  = glSetWorldMatrix
    setViewMatrix                   = glSetViewMatrix
    setProjectionMatrix _ m         = glSetProjectionMatrix m
    clearFrameBuffer _ b c d s      = glClearFrameBuffer b c d s
    setShadingType _                = glSetShadingType
    setCullingMode _                = glSetCullingMode
    setAlphaRejectSettings rs       = glSetAlphaRejectSettings (glrsCapabilities rs)
    setDepthBias _                  = glSetDepthBias
    setDepthBufferWriteEnabled _    = glSetDepthBufferWriteEnabled
    setDepthBufferFunction _        = glSetDepthBufferFunction  --FIXME
    setColourBufferWriteEnabled _   = glSetColourBufferWriteEnabled
    setSurfaceParams _              = glSetSurfaceParams
    setLightingEnabled _            = glSetLightingEnabled
    setFog _                        = glSetFog
    setSceneBlending _              = glSetSceneBlending
    setSeparateSceneBlending _      = glSetSeparateSceneBlending
    setPointParameters              = glSetPointParameters
    setPointSpritesEnabled rs       = glSetPointSpritesEnabled (glrsCapabilities rs)
    setActiveTextureUnit _          = glSetActiveTextureUnit
    setTexture _                    = glSetTexture
    setTextureAddressingMode _      = glSetTextureAddressingMode
    setTextureUnitFiltering _       = glSetTextureUnitFiltering
    setTextureLayerAnisotropy _     = glSetTextureLayerAnisotropy
    setTextureMipmapBias _          = glSetTextureMipmapBias
    setTextureMatrix _              = glSetTextureMatrix
    setTextureBorderColour _        = glSetTextureBorderColour
    setTextureCoordCalculation _    = glSetTextureCoordCalculation
    setTextureBlendMode rs          = glSetTextureBlendMode (glrsCapabilities rs)
    getMinimumDepthInputValue _     = -1
    getMaximumDepthInputValue _     = 1

    
glSetDepthBias constantBias slopeScaleBias = case constantBias /= 0 || slopeScaleBias /= 0 of
    { True  -> do
        GL.polygonOffsetFill    $= GL.Enabled
        GL.polygonOffsetPoint   $= GL.Enabled
        GL.polygonOffsetLine    $= GL.Enabled
        GL.polygonOffset        $= (realToFrac (-slopeScaleBias), realToFrac (-constantBias))
    ; False -> do
        GL.polygonOffsetFill    $= GL.Disabled
        GL.polygonOffsetPoint   $= GL.Disabled
        GL.polygonOffsetLine    $= GL.Disabled
    }

glSetViewport x y w h = do
    let x' = fromIntegral x
        y' = fromIntegral y
        w' = fromIntegral w
        h' = fromIntegral h
    GL.viewport $= (GL.Position x' y', GL.Size w' h')
    GL.scissor $= Just (GL.Position x' y', GL.Size w' h') -- Configure the viewport clipping

glSetPolygonMode pm = case pm of
    { PM_POINTS     -> GL.polygonMode $= (GL.Point,GL.Point)
    ; PM_WIREFRAME  -> GL.polygonMode $= (GL.Line,GL.Line)
    ; PM_SOLID      -> GL.polygonMode $= (GL.Fill,GL.Fill)
    }

glSetWorldMatrix rs m = do
    worldMat <- toGLMatrix m
    writeIORef (glrsWorldMatrix rs) worldMat
    viewMat <- readIORef $ glrsViewMatrix rs
    GL.matrixMode $= (GL.Modelview 0)
    GL.matrix (Just (GL.Modelview 0)) $= viewMat
    GL.multMatrix worldMat

glSetViewMatrix rs m = do
    viewMat <- toGLMatrix m
    writeIORef (glrsViewMatrix rs) viewMat
    worldMat <- readIORef $ glrsWorldMatrix rs
    GL.matrixMode $= (GL.Modelview 0)
    GL.matrix (Just (GL.Modelview 0)) $= viewMat
    GL.multMatrix worldMat

glSetProjectionMatrix m = do
    mat <- toGLMatrix m
    GL.matrix (Just GL.Projection) $= mat

glClearFrameBuffer buffers colour depth stencil = do
    tmpColorMask    <- GL.get GL.colorMask
    tmpDepthMask    <- GL.get GL.depthMask
    tmpStencilMask  <- GL.get GL.stencilMask
    tmpScissor      <- GL.get GL.scissor
    
    when (fbtColour buffers) $ do
        let (r',g',b',a')   = colour
            (r,g,b,a)       = (f r',f g',f b',f a')
            f               :: FloatType -> GL.GLclampf
            f               = realToFrac
        GL.colorMask $= GL.Color4 GL.Enabled GL.Enabled GL.Enabled GL.Enabled
        GL.clearColor $= GL.Color4 r g b a

    when (fbtDepth buffers) $ do
        let f :: FloatType -> GL.GLclampd
            f  = realToFrac
        GL.depthMask $= GL.Enabled
        GL.clearDepth $= f depth
        
    when (fbtStencil buffers) $ do
        let f :: Word16 -> GL.GLint
            f  = fromIntegral
        GL.stencilMask $= (maxBound::GL.GLuint)
        GL.clearStencil $= f stencil
    
    view <- GL.get GL.viewport
    GL.scissor $= Just view

    -- HINT: workaround for a mesa gma bug
    when (fbtColour buffers) $ GL.clear [GL.ColorBuffer]
    when (fbtDepth buffers) $ GL.clear [GL.DepthBuffer]
    when (fbtStencil buffers) $ GL.clear [GL.StencilBuffer]
    --GL.clear $ map fst $ filter (\(_,b) -> b) $ zip [GL.ColorBuffer, GL.DepthBuffer, GL.StencilBuffer] [fbtColour buffers, fbtDepth buffers, fbtStencil buffers]
    
    GL.scissor $= tmpScissor

    GL.depthMask    $= tmpDepthMask
    GL.colorMask    $= tmpColorMask
    GL.stencilMask  $= tmpStencilMask
    

--glBindGeometry :: (HardwareVertexBuffer vb, HardwareIndexBuffer ib) => RenderOperation vb ib -> IO ()
--glBindGeometry :: RenderOperation GLVertexBuffer GLIndexBuffer -> IO ()
glBindGeometry ro tl = do
    let multitexturing  = True -- 1 < (rscNumTextureUnits rcap)
        vertexData      = roVertexData ro
        decl            = vdVertexDeclaration vertexData
        checkBinding e  = case vdVertexBufferBinding vertexData of
                            VertexBufferBinding bm -> veSource e `IntMap.member` bm
    --  bind vertex elements
    mapM_ (bindElement ro tl) $ filter checkBinding $ vdElementList decl

    when multitexturing $ GL.clientActiveTexture $= GL.TextureUnit 0
    --  bind index data and call draw operation
    case roIndexData ro of 
        { Just indexData    -> do
            let indexBuffer = idIndexBuffer indexData
            GL.bindBuffer GL.ElementArrayBuffer $= glibBufferObject indexBuffer
        ; Nothing           -> return ()
        }

--glUnBindGeometry :: RenderOperation GLVertexBuffer GLIndexBuffer -> IO ()
glUnBindGeometry rsc ro = do
    let multitexturing  = True -- 1 < (rscNumTextureUnits rcap)
        f :: Int -> GL.GLuint
        f = fromIntegral
    
    GL.clientState  GL.VertexArray $= GL.Disabled

    -- only valid up to GL_MAX_TEXTURE_UNITS, which is recorded in mFixedFunctionTextureUnits
    case multitexturing of
        { True  -> do
            forM_ [0..(rscNumTextureUnits rsc - 1)] $ \stage -> do
                GL.clientActiveTexture $= (GL.TextureUnit $ f stage)
                GL.clientState GL.TextureCoordArray $= GL.Disabled
            GL.clientActiveTexture $= GL.TextureUnit 0
        ; False -> GL.clientState GL.TextureCoordArray $= GL.Disabled
        }
    GL.clientState GL.NormalArray           $= GL.Disabled
    GL.clientState GL.ColorArray            $= GL.Disabled
    GL.clientState GL.SecondaryColorArray   $= GL.Disabled

    -- unbind any custom attributes
    {-
    for (vector<GLuint>::type::iterator ai = attribsBound.begin(); ai != attribsBound.end(); ++ai)
    {
    	glDisableVertexAttribArrayARB(*ai); 
    }
    -}
    
    -- unbind buffers
    GL.bindBuffer GL.ElementArrayBuffer $= Nothing
    GL.bindBuffer GL.ArrayBuffer $= Nothing

-- _render :: RenderSystemCapabilities -> RenderOperation -> IO ()
--glRender :: Int -> GLRenderState -> RenderOperation -> IO GLRenderState
--glRender :: (HardwareVertexBuffer vb, HardwareIndexBuffer ib) => Int -> RenderOperation vb ib -> IO ()
glRender :: RenderOperation GLVertexBuffer GLIndexBuffer -> IO ()
glRender ro = do
    -- TODO:
    --  calculate statistics
    {-
        -- Update stats
        size_t val;

        if (op.useIndexes)
            val = op.indexData->indexCount;
        else
            val = op.vertexData->vertexCount;

        -- account for a pass having multiple iterations
        if (mCurrentPassIterationCount > 1)
            val *= mCurrentPassIterationCount;
		mCurrentPassIterationNum = 0;

        switch(op.operationType)
        {
		case RenderOperation::OT_TRIANGLE_LIST:
            mFaceCount += val / 3;
            break;
        case RenderOperation::OT_TRIANGLE_STRIP:
        case RenderOperation::OT_TRIANGLE_FAN:
            mFaceCount += val - 2;
            break;
	    case RenderOperation::OT_POINT_LIST:
	    case RenderOperation::OT_LINE_LIST:
	    case RenderOperation::OT_LINE_STRIP:
	        break;
	    }

        mVertexCount += op.vertexData->vertexCount;
        mBatchCount += mCurrentPassIterationCount;

		-- sort out clip planes
		-- have to do it here in case of matrix issues
		if (mClipPlanesDirty)
		{
			setClipPlanesImpl(mClipPlanes);
			mClipPlanesDirty = false;
		}
    -}
        -- TODO
    let vertexData      = roVertexData ro
        multitexturing  = True -- 1 < (rscNumTextureUnits rcap)
        --Use adjacency if there is a geometry program and it requested adjacency info
        -- TODO
        --bool useAdjacency = (mGeometryProgramBound && mCurrentGeometryProgram->isAdjacencyInfoRequired());
        primType        = case roOperationType ro of -- Find the correct type to render
            { OT_POINT_LIST     -> GL.Points
            ; OT_LINE_LIST      -> GL.Lines
            ; OT_LINE_STRIP     -> GL.LineStrip
            ; OT_TRIANGLE_LIST  -> GL.Triangles
            ; OT_TRIANGLE_STRIP -> GL.TriangleStrip
            ; OT_TRIANGLE_FAN   -> GL.TriangleFan
            }
        {-
		GLint primType;
		switch (op.operationType)
		{
		case RenderOperation::OT_POINT_LIST:
			primType = GL_POINTS;
			break;
		case RenderOperation::OT_LINE_LIST:
			primType = useAdjacency ? GL_LINES_ADJACENCY_EXT : GL_LINES;
			break;
		case RenderOperation::OT_LINE_STRIP:
			primType = useAdjacency ? GL_LINE_STRIP_ADJACENCY_EXT : GL_LINE_STRIP;
			break;
		default:
		case RenderOperation::OT_TRIANGLE_LIST:
			primType = useAdjacency ? GL_TRIANGLES_ADJACENCY_EXT : GL_TRIANGLES;
			break;
		case RenderOperation::OT_TRIANGLE_STRIP:
			primType = useAdjacency ? GL_TRIANGLE_STRIP_ADJACENCY_EXT : GL_TRIANGLE_STRIP;
			break;
		case RenderOperation::OT_TRIANGLE_FAN:
			primType = GL_TRIANGLE_FAN;
			break;
		}
        -}
    
    --  bind index data and call draw operation
    case roIndexData ro of 
    { Just indexData  -> do
        let indexBuffer = idIndexBuffer indexData
            dp          = if isJust $ glibBufferObject indexBuffer then nullPtr else fromMaybe (error "fromJust 7") $ glibShadowBuffer indexBuffer
            pBufferData = plusPtr dp $ idIndexStart indexData * getIndexSize indexBuffer
            indexType   = if getIndexType indexBuffer == IT_16BIT then GL.UnsignedShort else GL.UnsignedInt
        GL.drawElements primType (fromIntegral (idIndexCount indexData)) indexType pBufferData
    ; Nothing -> do
        GL.drawArrays primType 0 (fromIntegral (vdVertexCount vertexData))
    }
    
--    GL.color $ GL.Color4 1 1 1 (1 :: GL.GLfloat)
--    GL.secondaryColor $ GL.Color3 0 0 (0 :: GL.GLfloat)
    return ()
{-
    bool RenderSystem::updatePassIterationRenderState(void)
    {
        if (mCurrentPassIterationCount <= 1)
            return false;

        --mCurrentPassIterationCount;
		++mCurrentPassIterationNum;
        if (!mActiveVertexGpuProgramParameters.isNull())
        {
            mActiveVertexGpuProgramParameters->incPassIterationNumber();
            bindGpuProgramPassIterationParameters(GPT_VERTEX_PROGRAM);
        }
        if (!mActiveGeometryGpuProgramParameters.isNull())
        {
            mActiveGeometryGpuProgramParameters->incPassIterationNumber();
            bindGpuProgramPassIterationParameters(GPT_GEOMETRY_PROGRAM);
        }
        if (!mActiveFragmentGpuProgramParameters.isNull())
        {
            mActiveFragmentGpuProgramParameters->incPassIterationNumber();
            bindGpuProgramPassIterationParameters(GPT_FRAGMENT_PROGRAM);
        }
        return true;
    }

-}

bindElement rop tl elem = do
    let vertexData      = roVertexData $ rop

    case vdVertexBufferBinding vertexData of
        VertexBufferBinding bm -> let vertexBuffer = bm ! (veSource elem) in do
            dp <- case glvbBufferObject vertexBuffer of
                { Just b    -> do
                    GL.bindBuffer GL.ArrayBuffer $= Just b
                    return nullPtr  
                ; Nothing   -> return $ fromMaybe (error "fromJust 8") $ glvbShadowBuffer vertexBuffer
                }
            let pBufferData     = plusPtr dp $ vdVertexStart vertexData * getVertexSize vertexBuffer + veOffset elem
                sem             = veSemantic elem
                isCustomAttrib  = False
                bindArray t     = do
                    GL.arrayPointer t $= GL.VertexArrayDescriptor (fromIntegral . getTypeCount . veType $ elem) (getGLType . veType $ elem) (fromIntegral . getVertexSize $ vertexBuffer) pBufferData
                    GL.clientState  t $= GL.Enabled
                {-
                		if (mCurrentVertexProgram)
                			isCustomAttrib = mCurrentVertexProgram->isAttributeValid(sem, elem->getIndex());
                -}
            --bind vertexBuffer
            case isCustomAttrib of
                { True  -> do
                            -- Custom attribute support
                            -- tangents, binormals, blendweights etc always via this route
                            -- builtins may be done this way too
                            let attrib = GL.AttribLocation . fromIntegral . getFixedAttributeIndex sem $ veIndex elem
                            GL.vertexAttribPointer attrib $= (GL.KeepIntegral,GL.VertexArrayDescriptor (fromIntegral . getTypeCount . veType $ elem) (getGLType . veType $ elem) (fromIntegral . getVertexSize $ vertexBuffer) pBufferData)
                            GL.vertexAttribArray attrib $= GL.Enabled
                            --attribsBound.push_back(attrib);
                ; False -> case sem of -- fixed-function & builtin attribute support
                            { VES_POSITION              -> bindArray GL.VertexArray
                            ; VES_NORMAL                -> bindArray GL.NormalArray
                            ; VES_DIFFUSE               -> bindArray GL.ColorArray
                            ; VES_SPECULAR              -> bindArray GL.SecondaryColorArray
                            ; VES_TEXTURE_COORDINATES   -> do
                            -- TODO
                                let idx = veIndex elem
                                    tus = map fst $ filter (\(_,a)-> idx==a) $ zip [0..] $ map tusTextureCoordSetIndex tl
                                    f :: Int -> GL.GLuint
                                    f = fromIntegral
                                forM_ tus $ \tidx -> do
                                    --print $ "bind stage="++show tidx ++ " texcoord="++show idx
                                    GL.clientActiveTexture $= (GL.TextureUnit $ f tidx)
                                    bindArray GL.TextureCoordArray
                            -- TEMP CODE
{-          
                				if (mCurrentVertexProgram)
                				{
                					-- Programmable pipeline - direct UV assignment
                					glClientActiveTextureARB(GL_TEXTURE0 + elem->getIndex());
                					glTexCoordPointer(
                						VertexElement::getTypeCount(elem->getType()), 
                						GLBufferManager::getGLType(elem->getType()),
                						static_cast<GLsizei>(vertexBuffer->getVertexSize()), 
                						pBufferData);
                					glEnableClientState( GL_TEXTURE_COORD_ARRAY );
                				}
                				else
                				{
                					-- fixed function matching to units based on tex_coord_set
                					for (i = 0; i < mDisabledTexUnitsFrom; i++)
                					{
                						-- Only set this texture unit's texcoord pointer if it
                						-- is supposed to be using this element's index
                						if (mTextureCoordIndex[i] == elem->getIndex() && i < mFixedFunctionTextureUnits)
                						{
                							if (multitexturing)
                							glClientActiveTextureARB(GL_TEXTURE0 + i);
                							glTexCoordPointer(
                								VertexElement::getTypeCount(elem->getType()), 
                								GLBufferManager::getGLType(elem->getType()),
                								static_cast<GLsizei>(vertexBuffer->getVertexSize()), 
                								pBufferData);
                							glEnableClientState( GL_TEXTURE_COORD_ARRAY );
                						}
                					}
                				}
-}            
                            }
                }


glSetShadingType so = case so of
    { SO_FLAT   -> GL.shadeModel $= GL.Flat
    ; _         -> GL.shadeModel $= GL.Smooth
    }

glSetAlphaRejectSettings rsc func value alphaToCoverage = do
    let caps    = rscCapabilities rsc
        f       :: Int -> GL.GLclampf
        f       = fromIntegral
    case func == CMPF_ALWAYS_PASS of
        { True  -> do
            GL.alphaFunc $= Nothing
            GL.sampleAlphaToCoverage $= GL.Disabled
        ; False -> do
            GL.alphaFunc $= Just (convertCompareFunction func, f value / 255)
            let f x = case x of
                    { True  -> GL.Enabled
                    ; False -> GL.Disabled
                    } 
            when (Set.member RSC_ALPHA_TO_COVERAGE caps) $ 
                GL.sampleAlphaToCoverage $= f alphaToCoverage
        }

glSetDepthBufferWriteEnabled enabled = case enabled of
    { True  -> GL.depthMask $= GL.Enabled
    ; False -> GL.depthMask $= GL.Disabled
    }

glSetDepthBufferFunction enabled func = do
    GL.depthFunc $= if enabled then Just $ convertCompareFunction func else Nothing
--FIXME: gl haskell binding has unified api for depthFunc 
--glSetDepthBufferCheckEnabled enabled = case enabled of 

glSetPointSpritesEnabled rsc enabled = do
    case enabled of
        { True  -> GL.pointSprite $= GL.Enabled
        ; False -> GL.pointSprite $= GL.Disabled
        }
    --FIXME: Haskell GL bininding does not support these
    {-
    let maxTex    = rscNumTextureUnits rsc
    a <- GL.get GL.activeTexture
    -- Set sprite texture coord generation
    -- Don't offer this as an option since D3D links it to sprite enabled
    for (ushort i = 0; i < mFixedFunctionTextureUnits; ++i)
    {
        activateGLTextureUnit(i);
        glTexEnvi(GL_POINT_SPRITE, GL_COORD_REPLACE, 
            enabled ? GL_TRUE : GL_FALSE);
    }
    GL.activeTexture $= a
    -}

glSetSceneBlending sourceFactor destFactor op = do
    case sourceFactor == SBF_ONE && destFactor == SBF_ZERO of
        { True  -> GL.blend $= GL.Disabled
        ; False -> do
            GL.blend $= GL.Enabled
            GL.blendFunc $= (getBlendMode sourceFactor, getBlendMode destFactor)
        }
    GL.blendEquation $= getBlendEquation op
    -- FIXME
    {-
		if(GLEW_VERSION_1_4 || GLEW_ARB_imaging)
        {
			glBlendEquation(func);
		}
		else if(GLEW_EXT_blend_minmax && (func == GL_MIN || func == GL_MAX))
        {
			glBlendEquationEXT(func);
		}
    -}

glSetSurfaceParams ambient diffuse specular emissive shininess (TrackVertexColourType a d s e) = do
    -- Track vertex colour
    -- There are actually 15 different combinations for tracking, of which
    -- GL only supports the most used 5. This means that we have to do some
    -- magic to find the best match. NOTE: 
    --  GL_AMBIENT_AND_DIFFUSE != GL_AMBIENT | GL__DIFFUSE
    case (a,d,s,e) of
        { (False,False,False,False) -> GL.colorMaterial $= Nothing
        ; (True,True,_,_)           -> GL.colorMaterial $= Just (GL.FrontAndBack,GL.AmbientAndDiffuse)
        ; (True,False,_,_)          -> GL.colorMaterial $= Just (GL.FrontAndBack,GL.Ambient)
        ; (_,True,_,_)              -> GL.colorMaterial $= Just (GL.FrontAndBack,GL.Diffuse)
        ; (_,_,True,_)              -> GL.colorMaterial $= Just (GL.FrontAndBack,GL.Specular)
        ; (_,_,_,True)              -> GL.colorMaterial $= Just (GL.FrontAndBack,GL.Emission)
        }        
    let f           = realToFrac
        c (r,g,b,a) = GL.Color4 (f r) (f g) (f b) (f a)
    GL.materialDiffuse   GL.FrontAndBack $= c diffuse
    GL.materialAmbient   GL.FrontAndBack $= c ambient
    GL.materialSpecular  GL.FrontAndBack $= c specular
    GL.materialEmission  GL.FrontAndBack $= c emissive
    GL.materialShininess GL.FrontAndBack $= f shininess

glSetLightingEnabled enabled = case enabled of
    { True  -> GL.lighting $= GL.Enabled
    ; False -> GL.lighting $= GL.Disabled
    }

glSetFog mode colour density start end = do
    let c (r,g,b,a) = GL.Color4 (realToFrac r) (realToFrac g) (realToFrac b) (realToFrac a)
    case mode of
        { FOG_NONE  -> do
            GL.fog      $= GL.Disabled
        ; FOG_EXP   -> do
            GL.fog      $= GL.Enabled
            GL.fogMode  $= (GL.Exp $ realToFrac density)
            GL.fogColor $= c colour
        ; FOG_EXP2  -> do
            GL.fog      $= GL.Enabled
            GL.fogMode  $= (GL.Exp2 $ realToFrac density)
            GL.fogColor $= c colour
        ; FOG_LINEAR-> do
            GL.fog      $= GL.Enabled
            GL.fogMode  $= (GL.Linear (realToFrac start) (realToFrac end))
            GL.fogColor $= c colour
        }

glSetSeparateSceneBlending sourceFactor destFactor sourceFactorAlpha destFactorAlpha op alphaOp = do
    case sourceFactor == SBF_ONE && destFactor == SBF_ZERO && 
            sourceFactorAlpha == SBF_ONE && destFactorAlpha == SBF_ZERO of
        { True  -> GL.blend $= GL.Disabled
        ; False -> do
            let f = getBlendMode
            GL.blend $= GL.Enabled
            GL.blendFuncSeparate $= ((f sourceFactor, f sourceFactorAlpha), (f destFactor, f destFactorAlpha))
        }
    GL.blendEquationSeparate $= (getBlendEquation op, getBlendEquation alphaOp)
--FIXME: gl binding does not access these
{-
		if(GLEW_VERSION_2_0) {
			glBlendEquationSeparate(func, alphaFunc);
		}
		else if(GLEW_EXT_blend_equation_separate) {
			glBlendEquationSeparateEXT(func, alphaFunc);
		}
-}

glSetPointParameters rs size attenuationEnabled constant linear quadratic minSize maxSize = do
    let rsc     = getCapabilities rs
        caps    = rscCapabilities rsc
    (size',minSize',maxSize',constant',linear',quadratic') <- case attenuationEnabled of
        { True  -> do
            -- Point size is still calculated in pixels even when attenuation is
            -- enabled, which is pretty awkward, since you typically want a viewport
            -- independent size if you're looking for attenuation.
            -- So, scale the point size up by viewport size (this is equivalent to
            -- what D3D does as standard)

            -- TODO
        {-
			size = size * mActiveViewport->getActualHeight();
			minSize = minSize * mActiveViewport->getActualHeight();
			if (maxSize == 0.0f)
				maxSize = mCurrentCapabilities->getMaxPointSize(); // pixels
			else
				maxSize = maxSize * mActiveViewport->getActualHeight();
        -}
            when (Set.member RSC_VERTEX_PROGRAM caps) $ GL.vertexProgramPointSize $= GL.Enabled
            -- XXX: why do I need this for results to be consistent with D3D?
            -- Equations are supposedly the same once you factor in vp height
            let correction = 0.005
            return (size,minSize,if maxSize == 0 then rscMaxPointSize rsc else maxSize,constant,linear * correction,quadratic * correction)
        ; False -> do
            when (Set.member RSC_VERTEX_PROGRAM caps) $ GL.vertexProgramPointSize $= GL.Disabled
            return (size,minSize,if maxSize == 0 then rscMaxPointSize rsc else maxSize,constant,linear,quadratic)
        }
    --no scaling required
    -- GL has no disabled flag for this so just set to constant
    let f = realToFrac
    GL.pointSize $= f size'
    GL.pointDistanceAttenuation $= (f constant',f linear',f quadratic')
    GL.pointSizeRange $= (f minSize',f maxSize')
    -- FIXME: gl binding handles this
    {-
		if (mCurrentCapabilities->hasCapability(RSC_POINT_EXTENDED_PARAMETERS))
		{
			glPointParameterfv(GL_POINT_DISTANCE_ATTENUATION, val);
			glPointParameterf(GL_POINT_SIZE_MIN, minSize);
			glPointParameterf(GL_POINT_SIZE_MAX, maxSize);
		} 
		else if (mCurrentCapabilities->hasCapability(RSC_POINT_EXTENDED_PARAMETERS_ARB))
		{
			glPointParameterfvARB(GL_POINT_DISTANCE_ATTENUATION, val);
			glPointParameterfARB(GL_POINT_SIZE_MIN, minSize);
			glPointParameterfARB(GL_POINT_SIZE_MAX, maxSize);
		} 
		else if (mCurrentCapabilities->hasCapability(RSC_POINT_EXTENDED_PARAMETERS_EXT))
		{
			glPointParameterfvEXT(GL_POINT_DISTANCE_ATTENUATION, val);
			glPointParameterfEXT(GL_POINT_SIZE_MIN, minSize);
			glPointParameterfEXT(GL_POINT_SIZE_MAX, maxSize);
		}
    -}
    return ()

glSetActiveTextureUnit stage = do
    let f :: Int -> GL.GLuint
        f = fromIntegral
    GL.activeTexture $= GL.TextureUnit (f stage)
{-
			if (GLEW_VERSION_1_2 && unit < getCapabilities()->getNumTextureUnits())
			{
				glActiveTextureARB(GL_TEXTURE0 + unit);
				mActiveTextureUnit = unit;
				return true;
			}
			else if (!unit)
			{
				// always ok to use the first unit
				return true;
			}
			else
			{
				return false;
			}
-}    

glSetTexture tex = case tex of
    { Just t    -> do
        --TEMP CODE
        GL.texture GL.Texture1D $= GL.Disabled
        GL.textureBinding GL.Texture1D $= Nothing

        GL.texture GL.Texture2D $= GL.Disabled
        GL.textureBinding GL.Texture2D $= Nothing

        GL.texture GL.Texture3D $= GL.Disabled
        GL.textureBinding GL.Texture3D $= Nothing

        GL.texture GL.TextureCubeMap $= GL.Disabled
        GL.textureBinding GL.TextureCubeMap $= Nothing

        let target = getGLTextureTarget $ txTextureType t
        GL.texture target $= GL.Enabled
        GL.textureBinding target $= (Just $ gltxTextureObject t)
    ; Nothing   -> do
        --TODO
        GL.texture GL.Texture1D $= GL.Disabled
        GL.textureBinding GL.Texture1D $= Nothing

        GL.texture GL.Texture2D $= GL.Disabled
        GL.textureBinding GL.Texture2D $= Nothing

        GL.texture GL.Texture3D $= GL.Disabled
        GL.textureBinding GL.Texture3D $= Nothing

        GL.texture GL.TextureCubeMap $= GL.Disabled
        GL.textureBinding GL.TextureCubeMap $= Nothing
    }
        
{-
	void GLRenderSystem::_setTexture(size_t stage, bool enabled, const TexturePtr &texPtr)
	{
		GLTexturePtr tex = texPtr;

		GLenum lastTextureType = mTextureTypes[stage];

		if (!activateGLTextureUnit(stage))
			return;

		if (enabled)
		{
			if (!tex.isNull())
			{
				// note used
				tex->touch();
				mTextureTypes[stage] = tex->getGLTextureTarget();
			}
			else
				// assume 2D
				mTextureTypes[stage] = GL_TEXTURE_2D;

			if(lastTextureType != mTextureTypes[stage] && lastTextureType != 0)
			{
				if (stage < mFixedFunctionTextureUnits)
				{
					glDisable( lastTextureType );
				}
			}

			if (stage < mFixedFunctionTextureUnits)
			{
				glEnable( mTextureTypes[stage] );
			}

			if(!tex.isNull())
				glBindTexture( mTextureTypes[stage], tex->getGLID() );
			else
				glBindTexture( mTextureTypes[stage], static_cast<GLTextureManager*>(mTextureManager)->getWarningTextureID() );
		}
		else
		{
			if (stage < mFixedFunctionTextureUnits)
			{
				if (lastTextureType != 0)
				{
					glDisable( mTextureTypes[stage] );
				}
				glTexEnvf(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE);
			}
			// bind zero texture
			glBindTexture(GL_TEXTURE_2D, 0); 
		}

		activateGLTextureUnit(0);
	}

	void GLRenderSystem::_setTextureCoordSet(size_t stage, size_t index)
	{
		mTextureCoordIndex[stage] = index;
	}
-}
{-
	void GLRenderSystem::_useLights(const LightList& lights, unsigned short limit)
	{
		// Save previous modelview
		glMatrixMode(GL_MODELVIEW);
		glPushMatrix();
		// just load view matrix (identity world)
		GLfloat mat[16];
		makeGLMatrix(mat, mViewMatrix);
		glLoadMatrixf(mat);

		LightList::const_iterator i, iend;
		iend = lights.end();
		unsigned short num = 0;
		for (i = lights.begin(); i != iend && num < limit; ++i, ++num)
		{
			setGLLight(num, *i);
			mLights[num] = *i;
		}
		// Disable extra lights
		for (; num < mCurrentLights; ++num)
		{
			setGLLight(num, NULL);
			mLights[num] = NULL;
		}
		mCurrentLights = std::min(limit, static_cast<unsigned short>(lights.size()));

		setLights();

		// restore previous
		glPopMatrix();

	}

	void GLRenderSystem::setGLLight(size_t index, Light* lt)
	{
		GLenum gl_index = GL_LIGHT0 + index;

		if (!lt)
		{
			// Disable in the scene
			glDisable(gl_index);
		}
		else
		{
			switch (lt->getType())
			{
			case Light::LT_SPOTLIGHT:
				glLightf( gl_index, GL_SPOT_CUTOFF, 0.5f * lt->getSpotlightOuterAngle().valueDegrees() );
				glLightf(gl_index, GL_SPOT_EXPONENT, lt->getSpotlightFalloff());
				break;
			default:
				glLightf( gl_index, GL_SPOT_CUTOFF, 180.0 );
				break;
			}

			// Color
			ColourValue col;
			col = lt->getDiffuseColour();


			GLfloat f4vals[4] = {col.r, col.g, col.b, col.a};
			glLightfv(gl_index, GL_DIFFUSE, f4vals);

			col = lt->getSpecularColour();
			f4vals[0] = col.r;
			f4vals[1] = col.g;
			f4vals[2] = col.b;
			f4vals[3] = col.a;
			glLightfv(gl_index, GL_SPECULAR, f4vals);


			// Disable ambient light for movables;
			f4vals[0] = 0;
			f4vals[1] = 0;
			f4vals[2] = 0;
			f4vals[3] = 1;
			glLightfv(gl_index, GL_AMBIENT, f4vals);

			setGLLightPositionDirection(lt, gl_index);


			// Attenuation
			glLightf(gl_index, GL_CONSTANT_ATTENUATION, lt->getAttenuationConstant());
			glLightf(gl_index, GL_LINEAR_ATTENUATION, lt->getAttenuationLinear());
			glLightf(gl_index, GL_QUADRATIC_ATTENUATION, lt->getAttenuationQuadric());
			// Enable in the scene
			glEnable(gl_index);

		}

	}

	void GLRenderSystem::setLights()
	{
		for (size_t i = 0; i < MAX_LIGHTS; ++i)
		{
			if (mLights[i] != NULL)
			{
				Light* lt = mLights[i];
				setGLLightPositionDirection(lt, GL_LIGHT0 + i);
			}
		}
	}

	void GLRenderSystem::setGLLightPositionDirection(Light* lt, GLenum lightindex)
	{
		// Set position / direction
		Vector4 vec;
		// Use general 4D vector which is the same as GL's approach
		vec = lt->getAs4DVector(true);

#if OGRE_DOUBLE_PRECISION
		// Must convert to float*
		float tmp[4] = {vec.x, vec.y, vec.z, vec.w};
		glLightfv(lightindex, GL_POSITION, tmp);
#else
		glLightfv(lightindex, GL_POSITION, vec.ptr());
#endif
		// Set spotlight direction
		if (lt->getType() == Light::LT_SPOTLIGHT)
		{
			vec = lt->getDerivedDirection();
			vec.w = 0.0; 
#if OGRE_DOUBLE_PRECISION
			// Must convert to float*
			float tmp2[4] = {vec.x, vec.y, vec.z, vec.w};
			glLightfv(lightindex, GL_SPOT_DIRECTION, tmp2);
#else
			glLightfv(lightindex, GL_SPOT_DIRECTION, vec.ptr());
#endif
		}
	}
-}

glSetTextureAddressingMode texTarget (UVWAddressingMode u v w) = do
    let target = getGLTextureTarget texTarget
    GL.textureWrapMode target GL.S $= getTextureAddressingMode u
    GL.textureWrapMode target GL.T $= getTextureAddressingMode v
    GL.textureWrapMode target GL.R $= getTextureAddressingMode w

glSetTextureBorderColour texTarget (r,g,b,a) = do
    let target = getGLTextureTarget texTarget
        f = realToFrac
    GL.textureBorderColor target $= GL.Color4 (f r) (f g) (f b) (f a)

glSetTextureUnitFiltering texTarget minFilter magFilter mipFilter = do
    let target  = getGLTextureTarget texTarget
        mag     = case magFilter of
            { FO_ANISOTROPIC    -> GL.Linear'
            ; FO_LINEAR         -> GL.Linear'
            ; FO_POINT          -> GL.Nearest
            ; FO_NONE           -> GL.Nearest
            }
        min     = case minFilter of
            { FO_ANISOTROPIC    -> GL.Linear'
            ; FO_LINEAR         -> GL.Linear'
            ; FO_POINT          -> GL.Nearest
            ; FO_NONE           -> GL.Nearest
            }
        mip     = case mipFilter of
            { FO_ANISOTROPIC    -> Just GL.Linear'
            ; FO_LINEAR         -> Just GL.Linear'
            ; FO_POINT          -> Just GL.Nearest
            ; FO_NONE           -> Nothing
            }
    GL.textureFilter target $= ((min,mip),mag)

glSetTextureLayerAnisotropy texTarget maxAnisotropy = do
    let target = getGLTextureTarget texTarget
    maxSupportedAnisotropy <- GL.get GL.maxTextureMaxAnisotropy
    GL.textureMaxAnisotropy target $= (min (realToFrac maxAnisotropy) (realToFrac maxSupportedAnisotropy))

glSetTextureMipmapBias bias = do
    GL.textureUnitLODBias $= realToFrac bias

{-
    = LayerBlendModeEx
    { lbBlendType  :: LayerBlendType        -- ^ The type of blending (colour or alpha)
    , lbOperation  :: LayerBlendOperationEx -- ^ The operation to be applied
    , lbSource1    :: LayerBlendSource      -- ^ The first source of colour/alpha
    , lbSource2    :: LayerBlendSource      -- ^ The second source of colour/alpha
    , lbColourArg1 :: ColourValue           -- ^ Manual colour value for manual source1
    , lbColourArg2 :: ColourValue           -- ^ Manual colour value for manual source2
    , lbAlphaArg1  :: FloatType             -- ^ Manual alpha value for manual source1
    , lbAlphaArg2  :: FloatType             -- ^ Manual alpha value for manual source2
    , lbFactor     :: FloatType             -- ^ Manual blending factor
    }

doc: http://www.informit.com/articles/article.aspx?p=770639&seqNum=6
FIXME: Test this code
-}
glSetTextureBlendMode rsc colorbm alphabm = do
    let caps    = rscCapabilities rsc
        hasDot3 = Set.member RSC_DOT3 caps
        csrc1op = getLayerBlendSource $ lbSource1 colorbm
        csrc2op = getLayerBlendSource $ lbSource2 colorbm
        ccmd    = getTextureCombineFunction hasDot3 $ lbOperation colorbm
        asrc1op = getLayerBlendSource $ lbSource1 alphabm
        asrc2op = getLayerBlendSource $ lbSource2 alphabm
        acmd    = getTextureCombineFunction hasDot3 $ lbOperation alphabm
        f       = realToFrac

    GL.textureFunction $= GL.Combine
    GL.combineRGB $= ccmd
    GL.argRGB GL.Arg0 $= GL.Arg GL.SrcColor csrc1op
    GL.argRGB GL.Arg1 $= GL.Arg GL.SrcColor csrc2op
    GL.argRGB GL.Arg2 $= GL.Arg GL.SrcColor GL.Constant
    GL.combineAlpha $= acmd
    GL.argAlpha GL.Arg0 $= GL.Arg GL.SrcAlpha asrc1op
    GL.argAlpha GL.Arg1 $= GL.Arg GL.SrcAlpha asrc2op
    GL.argAlpha GL.Arg2 $= GL.Arg GL.SrcAlpha GL.Constant

    let argf bm cv1 cv2 = do
            case lbOperation bm of
                { LBX_BLEND_DIFFUSE_COLOUR  -> do
                    GL.argRGB   GL.Arg2 $= GL.Arg GL.SrcColor GL.PrimaryColor
                    GL.argAlpha GL.Arg2 $= GL.Arg GL.SrcAlpha GL.PrimaryColor
                ; LBX_BLEND_DIFFUSE_ALPHA   -> do
                    GL.argRGB   GL.Arg2 $= GL.Arg GL.SrcAlpha GL.PrimaryColor
                    GL.argAlpha GL.Arg2 $= GL.Arg GL.SrcAlpha GL.PrimaryColor
                ; LBX_BLEND_TEXTURE_ALPHA   -> do
                    GL.argRGB   GL.Arg2 $= GL.Arg GL.SrcAlpha GL.CurrentUnit
                    GL.argAlpha GL.Arg2 $= GL.Arg GL.SrcAlpha GL.CurrentUnit
                ; LBX_BLEND_CURRENT_ALPHA   -> do
                    GL.argRGB   GL.Arg2 $= GL.Arg GL.SrcAlpha GL.Previous
                    GL.argAlpha GL.Arg2 $= GL.Arg GL.SrcAlpha GL.Previous
                ; LBX_BLEND_MANUAL          -> do
                    GL.constantColor    $= GL.Color4 0 0 0 (f $ lbFactor bm)
                ; _                         -> return ()
                }

            when (LBS_MANUAL == lbSource1 bm) $ 
                GL.constantColor    $= cv1
                
            when (LBS_MANUAL == lbSource2 bm) $
                GL.constantColor    $= cv2

        (cr1,cg1,cb1,ca1)   = lbColourArg1 colorbm
        (cr2,cg2,cb2,ca2)   = lbColourArg2 colorbm
        cf r g b a          = GL.Color4 (f r) (f g) (f b) (f a)
        aa1                 = lbAlphaArg1 alphabm
        aa2                 = lbAlphaArg2 alphabm
    argf colorbm (cf cr1 cg1 cb1 ca1) (cf cr2 cg2 cb2 ca2)
    argf alphabm (cf cr1 cg1 cb1 aa1) (cf cr2 cg2 cb2 aa2)

    case lbOperation colorbm of
        { LBX_MODULATE_X2   ->  GL.rgbScale $= 2
        ; LBX_MODULATE_X4   ->  GL.rgbScale $= 4
        ; _                 ->  GL.rgbScale $= 1
        }

    case lbOperation alphabm of
        { LBX_MODULATE_X2   ->  GL.alphaScale $= 2
        ; LBX_MODULATE_X4   ->  GL.alphaScale $= 4
        ; _                 ->  GL.alphaScale $= 1
        }

glSetCullingMode mode = case mode of
    { CULL_NONE             -> GL.cullFace $= Nothing
    ; CULL_CLOCKWISE        -> GL.cullFace $= (Just GL.Back)
    ; CULL_ANTICLOCKWISE    -> GL.cullFace $= (Just GL.Front)
    }

glSetColourBufferWriteEnabled r g b a = do
    let f x = case x of
            { True  -> GL.Enabled
            ; False -> GL.Disabled
            } 
    GL.colorMask $= GL.Color4 (f r) (f g) (f b) (f a)

glBindLinkedGpuProgram lp = do
    GL.currentProgram $= Just (gllgpProgramObject lp)
    --TEMP CODE
    let p = gllgpProgramObject lp
    loc_tex0 <- GL.get (GL.uniformLocation p "tex0") 
    loc_tex1 <- GL.get (GL.uniformLocation p "tex1")
    (GL.uniform loc_tex0) GL.$=! (GL.Index1 (0::GL.GLint))
    (GL.uniform loc_tex1) GL.$=! (GL.Index1 (1::GL.GLint))

glUnBindLinkedGpuProgram = do
    GL.currentProgram $= Nothing

{-
	void GLRenderSystem::unbindGpuProgram(GpuProgramType gptype)
	{

		if (gptype == GPT_VERTEX_PROGRAM && mCurrentVertexProgram)
		{
			mActiveVertexGpuProgramParameters.setNull();
			mCurrentVertexProgram->unbindProgram();
			mCurrentVertexProgram = 0;
		}
		else if (gptype == GPT_GEOMETRY_PROGRAM && mCurrentGeometryProgram)
		{
			mActiveGeometryGpuProgramParameters.setNull();
			mCurrentGeometryProgram->unbindProgram();
			mCurrentGeometryProgram = 0;
		}
		else if (gptype == GPT_FRAGMENT_PROGRAM && mCurrentFragmentProgram)
		{
			mActiveFragmentGpuProgramParameters.setNull();
			mCurrentFragmentProgram->unbindProgram();
			mCurrentFragmentProgram = 0;
		}
		RenderSystem::unbindGpuProgram(gptype);

	}

	void RenderSystem::unbindGpuProgram(GpuProgramType gptype)
	{
	    switch(gptype)
	    {
        case GPT_VERTEX_PROGRAM:
			// mark clip planes dirty if changed (programmable can change space)
			if (mVertexProgramBound && !mClipPlanes.empty())
				mClipPlanesDirty = true;
            mVertexProgramBound = false;
	        break;
        case GPT_GEOMETRY_PROGRAM:
			mGeometryProgramBound = false;
			break;
        case GPT_FRAGMENT_PROGRAM:
            mFragmentProgramBound = false;
	        break;
	    }
	}
-}

--glSetTextureMatrix :: Matrix4 -> IO ()
glSetTextureMatrix xform = do
    mat <- toGLMatrix xform
    GL.matrix (Just GL.Texture) $= mat
    
{-
	void GLRenderSystem::_setTextureMatrix(size_t stage, const Matrix4& xform)
	{
		if (stage >= mFixedFunctionTextureUnits)
		{
			// Can't do this
			return;
		}

		GLfloat mat[16];
		makeGLMatrix(mat, xform);

		if (!activateGLTextureUnit(stage))
			return;
		glMatrixMode(GL_TEXTURE);

		// Load this matrix in
		glLoadMatrixf(mat);

		if (mUseAutoTextureMatrix)
		{
			// Concat auto matrix
			glMultMatrixf(mAutoTextureMatrix);
		}

		glMatrixMode(GL_MODELVIEW);
		activateGLTextureUnit(0);
	}
-}

-- glSetTextureCoordCalculation :: TexCoordCalcMethod -> IO ()
glSetTextureCoordCalculation m = case m of
    { TEXCALC_NONE -> do
        GL.textureGenMode GL.S $= Nothing
        GL.textureGenMode GL.T $= Nothing
        GL.textureGenMode GL.R $= Nothing
        GL.textureGenMode GL.Q $= Nothing
        
    ; TEXCALC_ENVIRONMENT_MAP   -> do
        GL.textureGenMode GL.S $= Just GL.SphereMap
        GL.textureGenMode GL.T $= Just GL.SphereMap
        GL.textureGenMode GL.R $= Nothing
        GL.textureGenMode GL.Q $= Nothing
        -- TODO
        {-
		// Need to use a texture matrix to flip the spheremap
		mUseAutoTextureMatrix = true;
		memset(mAutoTextureMatrix, 0, sizeof(GLfloat)*16);
		mAutoTextureMatrix[0] = mAutoTextureMatrix[10] = mAutoTextureMatrix[15] = 1.0f;
		mAutoTextureMatrix[5] = -1.0f;
        -}
        
    ; TEXCALC_ENVIRONMENT_MAP_PLANAR -> do
        GL.textureGenMode GL.S $= Just GL.SphereMap
        GL.textureGenMode GL.T $= Just GL.SphereMap
        GL.textureGenMode GL.R $= Nothing
        GL.textureGenMode GL.Q $= Nothing
        
    ; TEXCALC_ENVIRONMENT_MAP_REFLECTION -> do
        GL.textureGenMode GL.S $= Just GL.ReflectionMap
        GL.textureGenMode GL.T $= Just GL.ReflectionMap
        GL.textureGenMode GL.R $= Just GL.ReflectionMap
        GL.textureGenMode GL.Q $= Nothing
        {-
		// We need an extra texture matrix here
		// This sets the texture matrix to be the inverse of the view matrix
		mUseAutoTextureMatrix = true;
		makeGLMatrix( M, mViewMatrix);

		// Transpose 3x3 in order to invert matrix (rotation)
		// Note that we need to invert the Z _before_ the rotation
		// No idea why we have to invert the Z at all, but reflection is wrong without it
		mAutoTextureMatrix[0] = M[0]; mAutoTextureMatrix[1] = M[4]; mAutoTextureMatrix[2] = -M[8];
		mAutoTextureMatrix[4] = M[1]; mAutoTextureMatrix[5] = M[5]; mAutoTextureMatrix[6] = -M[9];
		mAutoTextureMatrix[8] = M[2]; mAutoTextureMatrix[9] = M[6]; mAutoTextureMatrix[10] = -M[10];
		mAutoTextureMatrix[3] = mAutoTextureMatrix[7] = mAutoTextureMatrix[11] = 0.0f;
		mAutoTextureMatrix[12] = mAutoTextureMatrix[13] = mAutoTextureMatrix[14] = 0.0f;
		mAutoTextureMatrix[15] = 1.0f;
        -}
        
    ; TEXCALC_ENVIRONMENT_MAP_NORMAL -> do
        GL.textureGenMode GL.S $= Just GL.NormalMap
        GL.textureGenMode GL.T $= Just GL.NormalMap
        GL.textureGenMode GL.R $= Just GL.NormalMap
        GL.textureGenMode GL.Q $= Nothing

    ; TEXCALC_PROJECTIVE_TEXTURE -> do
        GL.textureGenMode GL.S $= Just (GL.EyeLinear $ GL.Plane 1 0 0 0)
        GL.textureGenMode GL.T $= Just (GL.EyeLinear $ GL.Plane 0 1 0 0)
        GL.textureGenMode GL.R $= Just (GL.EyeLinear $ GL.Plane 0 0 1 0)
        GL.textureGenMode GL.Q $= Just (GL.EyeLinear $ GL.Plane 0 0 0 1)
        {-
		mUseAutoTextureMatrix = true;

		// Set scale and translation matrix for projective textures
		projectionBias = Matrix4::CLIPSPACE2DTOIMAGESPACE;

		projectionBias = projectionBias * frustum->getProjectionMatrix();
		if(mTexProjRelative)
		{
			Matrix4 viewMatrix;
			frustum->calcViewMatrixRelative(mTexProjRelativeOrigin, viewMatrix);
			projectionBias = projectionBias * viewMatrix;
		}
		else
		{
			projectionBias = projectionBias * frustum->getViewMatrix();
		}
		projectionBias = projectionBias * mWorldMatrix;

		makeGLMatrix(mAutoTextureMatrix, projectionBias);
        -}
    }

{-
	void GLRenderSystem::_setTextureCoordCalculation(size_t stage, TexCoordCalcMethod m, 
		const Frustum* frustum)
	{
		if (stage >= mFixedFunctionTextureUnits)
		{
			// Can't do this
			return;
		}


		GLfloat M[16];
		Matrix4 projectionBias;

		// Default to no extra auto texture matrix
		mUseAutoTextureMatrix = false;

		GLfloat eyePlaneS[] = {1.0, 0.0, 0.0, 0.0};
		GLfloat eyePlaneT[] = {0.0, 1.0, 0.0, 0.0};
		GLfloat eyePlaneR[] = {0.0, 0.0, 1.0, 0.0};
		GLfloat eyePlaneQ[] = {0.0, 0.0, 0.0, 1.0};

		if (!activateGLTextureUnit(stage))
			return;

		switch( m )
		{
		case TEXCALC_NONE:
			glDisable( GL_TEXTURE_GEN_S );
			glDisable( GL_TEXTURE_GEN_T );
			glDisable( GL_TEXTURE_GEN_R );
			glDisable( GL_TEXTURE_GEN_Q );
			break;

		case TEXCALC_ENVIRONMENT_MAP:
			glTexGeni( GL_S, GL_TEXTURE_GEN_MODE, GL_SPHERE_MAP );
			glTexGeni( GL_T, GL_TEXTURE_GEN_MODE, GL_SPHERE_MAP );

			glEnable( GL_TEXTURE_GEN_S );
			glEnable( GL_TEXTURE_GEN_T );
			glDisable( GL_TEXTURE_GEN_R );
			glDisable( GL_TEXTURE_GEN_Q );

			// Need to use a texture matrix to flip the spheremap
			mUseAutoTextureMatrix = true;
			memset(mAutoTextureMatrix, 0, sizeof(GLfloat)*16);
			mAutoTextureMatrix[0] = mAutoTextureMatrix[10] = mAutoTextureMatrix[15] = 1.0f;
			mAutoTextureMatrix[5] = -1.0f;

			break;

		case TEXCALC_ENVIRONMENT_MAP_PLANAR:            
			// XXX This doesn't seem right?!
#ifdef GL_VERSION_1_3
			glTexGeni( GL_S, GL_TEXTURE_GEN_MODE, GL_REFLECTION_MAP );
			glTexGeni( GL_T, GL_TEXTURE_GEN_MODE, GL_REFLECTION_MAP );
			glTexGeni( GL_R, GL_TEXTURE_GEN_MODE, GL_REFLECTION_MAP );

			glEnable( GL_TEXTURE_GEN_S );
			glEnable( GL_TEXTURE_GEN_T );
			glEnable( GL_TEXTURE_GEN_R );
			glDisable( GL_TEXTURE_GEN_Q );
#else
			glTexGeni( GL_S, GL_TEXTURE_GEN_MODE, GL_SPHERE_MAP );
			glTexGeni( GL_T, GL_TEXTURE_GEN_MODE, GL_SPHERE_MAP );

			glEnable( GL_TEXTURE_GEN_S );
			glEnable( GL_TEXTURE_GEN_T );
			glDisable( GL_TEXTURE_GEN_R );
			glDisable( GL_TEXTURE_GEN_Q );
#endif
			break;
		case TEXCALC_ENVIRONMENT_MAP_REFLECTION:

			glTexGeni( GL_S, GL_TEXTURE_GEN_MODE, GL_REFLECTION_MAP );
			glTexGeni( GL_T, GL_TEXTURE_GEN_MODE, GL_REFLECTION_MAP );
			glTexGeni( GL_R, GL_TEXTURE_GEN_MODE, GL_REFLECTION_MAP );

			glEnable( GL_TEXTURE_GEN_S );
			glEnable( GL_TEXTURE_GEN_T );
			glEnable( GL_TEXTURE_GEN_R );
			glDisable( GL_TEXTURE_GEN_Q );

			// We need an extra texture matrix here
			// This sets the texture matrix to be the inverse of the view matrix
			mUseAutoTextureMatrix = true;
			makeGLMatrix( M, mViewMatrix);

			// Transpose 3x3 in order to invert matrix (rotation)
			// Note that we need to invert the Z _before_ the rotation
			// No idea why we have to invert the Z at all, but reflection is wrong without it
			mAutoTextureMatrix[0] = M[0]; mAutoTextureMatrix[1] = M[4]; mAutoTextureMatrix[2] = -M[8];
			mAutoTextureMatrix[4] = M[1]; mAutoTextureMatrix[5] = M[5]; mAutoTextureMatrix[6] = -M[9];
			mAutoTextureMatrix[8] = M[2]; mAutoTextureMatrix[9] = M[6]; mAutoTextureMatrix[10] = -M[10];
			mAutoTextureMatrix[3] = mAutoTextureMatrix[7] = mAutoTextureMatrix[11] = 0.0f;
			mAutoTextureMatrix[12] = mAutoTextureMatrix[13] = mAutoTextureMatrix[14] = 0.0f;
			mAutoTextureMatrix[15] = 1.0f;

			break;
		case TEXCALC_ENVIRONMENT_MAP_NORMAL:
			glTexGeni( GL_S, GL_TEXTURE_GEN_MODE, GL_NORMAL_MAP );
			glTexGeni( GL_T, GL_TEXTURE_GEN_MODE, GL_NORMAL_MAP );
			glTexGeni( GL_R, GL_TEXTURE_GEN_MODE, GL_NORMAL_MAP );

			glEnable( GL_TEXTURE_GEN_S );
			glEnable( GL_TEXTURE_GEN_T );
			glEnable( GL_TEXTURE_GEN_R );
			glDisable( GL_TEXTURE_GEN_Q );
			break;
		case TEXCALC_PROJECTIVE_TEXTURE:
			glTexGeni(GL_S, GL_TEXTURE_GEN_MODE, GL_EYE_LINEAR);
			glTexGeni(GL_T, GL_TEXTURE_GEN_MODE, GL_EYE_LINEAR);
			glTexGeni(GL_R, GL_TEXTURE_GEN_MODE, GL_EYE_LINEAR);
			glTexGeni(GL_Q, GL_TEXTURE_GEN_MODE, GL_EYE_LINEAR);
			glTexGenfv(GL_S, GL_EYE_PLANE, eyePlaneS);
			glTexGenfv(GL_T, GL_EYE_PLANE, eyePlaneT);
			glTexGenfv(GL_R, GL_EYE_PLANE, eyePlaneR);
			glTexGenfv(GL_Q, GL_EYE_PLANE, eyePlaneQ);
			glEnable(GL_TEXTURE_GEN_S);
			glEnable(GL_TEXTURE_GEN_T);
			glEnable(GL_TEXTURE_GEN_R);
			glEnable(GL_TEXTURE_GEN_Q);

			mUseAutoTextureMatrix = true;

			// Set scale and translation matrix for projective textures
			projectionBias = Matrix4::CLIPSPACE2DTOIMAGESPACE;

			projectionBias = projectionBias * frustum->getProjectionMatrix();
			if(mTexProjRelative)
			{
				Matrix4 viewMatrix;
				frustum->calcViewMatrixRelative(mTexProjRelativeOrigin, viewMatrix);
				projectionBias = projectionBias * viewMatrix;
			}
			else
			{
				projectionBias = projectionBias * frustum->getViewMatrix();
			}
			projectionBias = projectionBias * mWorldMatrix;

			makeGLMatrix(mAutoTextureMatrix, projectionBias);
			break;
		default:
			break;
		}
		activateGLTextureUnit(0);
	}
-}