{-# LANGUAGE MultiParamTypeClasses, NamedFieldPuns #-} module Graphics.LambdaCube.RenderSystem.GL.RenderSystem where import Control.Monad import Data.IORef import Data.IntMap ((!)) import Data.Maybe import Data.Word import Foreign import Foreign.C.String import qualified Data.IntMap as IntMap import qualified Data.Set as Set import Graphics.Rendering.OpenGL.Raw.Core31 import qualified Graphics.Rendering.OpenGL.Raw.ARB as ARB import qualified Graphics.Rendering.OpenGL.Raw.EXT as EXT import qualified Graphics.Rendering.OpenGL.Raw.ARB.Compatibility as Compat import Graphics.LambdaCube.BlendMode import Graphics.LambdaCube.Common import Graphics.LambdaCube.HardwareIndexBuffer import Graphics.LambdaCube.HardwareVertexBuffer import Graphics.LambdaCube.Light import Graphics.LambdaCube.RenderOperation import Graphics.LambdaCube.RenderSystem import Graphics.LambdaCube.RenderSystem.GL.Capabilities import Graphics.LambdaCube.RenderSystem.GL.GpuProgram import Graphics.LambdaCube.RenderSystem.GL.IndexBuffer import Graphics.LambdaCube.RenderSystem.GL.OcclusionQuery import Graphics.LambdaCube.RenderSystem.GL.Texture import Graphics.LambdaCube.RenderSystem.GL.Utils import Graphics.LambdaCube.RenderSystem.GL.VertexBuffer import Graphics.LambdaCube.RenderSystemCapabilities import Graphics.LambdaCube.Texture import Graphics.LambdaCube.TextureUnitState import Graphics.LambdaCube.Types import Graphics.LambdaCube.VertexIndexData data GLState = GLState { stLight :: (Proj4,[(Proj4,Light)]) , stSurface :: (FloatType4,FloatType4,FloatType4,FloatType4,FloatType,TrackVertexColourType) } mkGLState :: IO (IORef GLState) mkGLState = do let st = GLState { stLight = (idmtx,[]) , stSurface = (c,c,c,c,0,TrackVertexColourType False False False False) } c = (0,0,0,0) newIORef st instance Eq Proj4 where a == b = fromProjective a == fromProjective b data GLRenderSystem = GLRenderSystem { glrsWorldMatrix :: IORef Proj4 , glrsViewMatrix :: IORef Proj4 , glrsCapabilities :: RenderSystemCapabilities , glrsState :: IORef GLState } mkGLRenderSystem :: IO GLRenderSystem mkGLRenderSystem = do worldMat <- newIORef $ idmtx viewMat <- newIORef $ idmtx cap <- mkGLCapabilities glState <- mkGLState -- Initialize OpenGL {- glExtensions :: GettableStateVar [String] glExtensions = makeGettableStateVar (fmap words $ getString gl_EXTENSIONS) getString :: GLenum -> IO String getString n = glGetString n >>= maybeNullPtr (return "") (peekCString . castPtr) maybeNullPtr :: b -> (Ptr a -> b) -> Ptr a -> b maybeNullPtr n f ptr | ptr == nullPtr = n | otherwise = f ptr -} (major,minor) <- getGLVersion extSList <- getGLExtensions -- setup capabilities let ext = Set.fromList extSList glVer a b = major > a || (major >= a && minor >= b) supports s = Set.member s ext f = fromIntegral when (glVer 1 2) $ do -- Set nicer lighting model -- d3d9 has this by default Compat.glLightModeli Compat.gl_LIGHT_MODEL_COLOR_CONTROL $ f Compat.gl_SEPARATE_SPECULAR_COLOR Compat.glLightModeli Compat.gl_LIGHT_MODEL_LOCAL_VIEWER 1 when (glVer 1 4) $ do glEnable Compat.gl_COLOR_SUM glDisable gl_DITHER -- Check for FSAA when (supports "GL_ARB_multisample") $ do fsaa <- getInteger ARB.gl_SAMPLE_BUFFERS when (fsaa > 0) $ do glEnable ARB.gl_MULTISAMPLE putStrLn $ "Render System " ++ "Using FSAA from GL_ARB_multisample extension." return $ GLRenderSystem { glrsWorldMatrix = worldMat , glrsViewMatrix = viewMat , glrsCapabilities = cap , glrsState = glState } glWithFrameBuffer :: Int -> Int -> Int -> Int -> (Ptr Word8 -> IO ()) -> IO () glWithFrameBuffer x y w h fn = allocaBytes (w*h*4) $ \p -> do glReadPixels (fromIntegral x) (fromIntegral y) (fromIntegral w) (fromIntegral h) gl_RGBA gl_UNSIGNED_BYTE $ castPtr p fn p {- copyTexImage2D :: Maybe CubeMapTarget -> Level -> PixelInternalFormat -> Position -> TextureSize2D -> Border -> IO () copyTexImage2D mbCubeMap level int (Position x y) (TextureSize2D w h) border = glCopyTexImage2D (maybe (marshalTextureTarget Texture2D) marshalCubeMapTarget mbCubeMap) level (marshalPixelInternalFormat' int) x y w h border -} glDirtyHackCopyTexImage :: GLTexture -> Int -> Int -> Int -> Int -> IO () 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 -} glActiveTexture $ fromIntegral gl_TEXTURE0 --glEnable gl_TEXTURE_2D glBindTexture gl_TEXTURE_2D $ gltxTextureObject tex -- only hint code: glCopyTexImage2D(GL_TEXTURE_2D, 0, GL_LUMINANCE, 0, 0, 128, 128, 0); glCopyTexImage2D gl_TEXTURE_2D 0 gl_RGBA (fromIntegral x) (fromIntegral y) (fromIntegral w) (fromIntegral h) 0 instance RenderSystem GLRenderSystem GLVertexBuffer GLIndexBuffer GLOcclusionQuery GLTexture GLGpuProgram GLLinkedGpuProgram where withFrameBuffer _ = glWithFrameBuffer 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 setDepthBufferCheckEnabled _ = glSetDepthBufferCheckEnabled setDepthBufferWriteEnabled _ = glSetDepthBufferWriteEnabled setDepthBufferFunction _ = glSetDepthBufferFunction --FIXME setColourBufferWriteEnabled _ = glSetColourBufferWriteEnabled setSurfaceParams = glSetSurfaceParams setLightingEnabled _ = glSetLightingEnabled useLights = glUseLights 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 prepareRender _ = glPrepareRender finishRender _ = glFinishRender glPrepareRender :: IO () glPrepareRender = do Compat.glColor3f 1 1 1 glEnable gl_SCISSOR_TEST glFinishRender :: IO () glFinishRender = do Compat.glColor3f 1 1 1 glDisable gl_SCISSOR_TEST glSetDepthBias :: FloatType -> FloatType -> IO () glSetDepthBias constantBias slopeScaleBias = case constantBias /= 0 || slopeScaleBias /= 0 of True -> do glEnable gl_POLYGON_OFFSET_FILL glEnable gl_POLYGON_OFFSET_POINT glEnable gl_POLYGON_OFFSET_LINE glPolygonOffset (realToFrac (-slopeScaleBias)) (realToFrac (-constantBias)) False -> do glDisable gl_POLYGON_OFFSET_FILL glDisable gl_POLYGON_OFFSET_POINT glDisable gl_POLYGON_OFFSET_LINE glSetViewport :: Int -> Int -> Int -> Int -> IO () glSetViewport x y w h = do let x' = fromIntegral x y' = fromIntegral y w' = fromIntegral w h' = fromIntegral h glViewport x' y' w' h' glScissor x' y' w' h' -- Configure the viewport clipping glSetPolygonMode :: PolygonMode -> IO () glSetPolygonMode pm = case pm of PM_POINTS -> polygonMode gl_POINT PM_WIREFRAME -> polygonMode gl_LINE PM_SOLID -> polygonMode gl_FILL where polygonMode m = do glPolygonMode gl_FRONT m glPolygonMode gl_BACK m -- TODO: handle double type, currently it supports Float only glSetupMatrix :: Proj4 -> Proj4 -> IO () glSetupMatrix vm wm = do Compat.glMatrixMode Compat.gl_MODELVIEW with (wm .*. vm) $ \mp -> do Compat.glLoadMatrixf $ castPtr mp glSetWorldMatrix :: GLRenderSystem -> Proj4 -> IO () glSetWorldMatrix rs wm = do writeIORef (glrsWorldMatrix rs) wm viewMat <- readIORef $ glrsViewMatrix rs glSetupMatrix viewMat wm glSetViewMatrix :: GLRenderSystem -> Proj4 -> IO () glSetViewMatrix rs vm = do writeIORef (glrsViewMatrix rs) vm worldMat <- readIORef $ glrsWorldMatrix rs glSetupMatrix vm worldMat glSetProjectionMatrix :: Mat4 -> IO () glSetProjectionMatrix pm = do Compat.glMatrixMode Compat.gl_PROJECTION with pm $ \pp -> do Compat.glLoadMatrixf $ castPtr pp glClearFrameBuffer :: FrameBufferType -> FloatType4 -> FloatType -> Word16 -> IO () glClearFrameBuffer buffers colour depth stencil = do tmpColorMask <- getBoolean4 gl_COLOR_WRITEMASK tmpDepthMask <- getBoolean gl_DEPTH_WRITEMASK tmpStencilMask <- getInteger gl_STENCIL_WRITEMASK tmpScissor <- getInteger4 gl_SCISSOR_BOX when (fbtColour buffers) $ do let (r',g',b',a') = colour (r,g,b,a) = (f r',f g',f b',f a') f :: FloatType -> GLclampf f = realToFrac glColorMask 1 1 1 1 glClearColor r g b a when (fbtDepth buffers) $ do let f :: FloatType -> GLclampd f = realToFrac glDepthMask $ fromIntegral gl_TRUE glClearDepth $ f depth when (fbtStencil buffers) $ do let f :: Word16 -> GLint f = fromIntegral glStencilMask 0xFFFFFFFF glClearStencil $ f stencil let f = fromIntegral (x,y,w,h) <- getInteger4 gl_VIEWPORT glScissor x y (f w) (f h) -- HINT: workaround for a mesa gma bug when (fbtColour buffers) $ glClear $ fromIntegral gl_COLOR_BUFFER_BIT when (fbtDepth buffers) $ glClear $ fromIntegral gl_DEPTH_BUFFER_BIT when (fbtStencil buffers) $ glClear $ fromIntegral gl_STENCIL_BUFFER_BIT --GL.clear $ map fst $ filter (\(_,b) -> b) $ zip [GL.ColorBuffer, GL.DepthBuffer, GL.StencilBuffer] [fbtColour buffers, fbtDepth buffers, fbtStencil buffers] let uncurry4 mf (a,b,c,d) = mf (fromIntegral a) (fromIntegral b) (fromIntegral c) (fromIntegral d) uncurry4b mf (a,b,c,d) = mf (a) (b) (c) (d) uncurry4 glScissor tmpScissor glDepthMask $ fromIntegral tmpDepthMask uncurry4b glColorMask tmpColorMask glStencilMask $ fromIntegral tmpStencilMask glBindGeometry :: (Texture t) => RenderOperation GLVertexBuffer GLIndexBuffer -> [TextureUnitState t] -> 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 $ Compat.glClientActiveTexture gl_TEXTURE0 -- bind index data and call draw operation case roIndexData ro of Just indexData -> glBindBuffer gl_ELEMENT_ARRAY_BUFFER $ glibBufferObject $ idIndexBuffer indexData Nothing -> return () return () glUnBindGeometry :: RenderSystemCapabilities -> RenderOperation GLVertexBuffer GLIndexBuffer -> IO () glUnBindGeometry rsc _ro = do let multitexturing = True -- 1 < (rscNumTextureUnits rcap) f = fromIntegral Compat.glDisableClientState Compat.gl_VERTEX_ARRAY -- 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 Compat.glClientActiveTexture $ fromIntegral gl_TEXTURE0 + f stage Compat.glDisableClientState Compat.gl_TEXTURE_COORD_ARRAY Compat.glClientActiveTexture gl_TEXTURE0 False -> Compat.glDisableClientState Compat.gl_TEXTURE_COORD_ARRAY Compat.glDisableClientState Compat.gl_NORMAL_ARRAY Compat.glDisableClientState Compat.gl_COLOR_ARRAY Compat.glDisableClientState Compat.gl_SECONDARY_COLOR_ARRAY -- unbind any custom attributes -- unbind buffers glBindBuffer gl_ELEMENT_ARRAY_BUFFER 0 glBindBuffer gl_ARRAY_BUFFER 0 return () -- _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: 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_LINE_STRIP OT_TRIANGLE_LIST -> gl_TRIANGLES OT_TRIANGLE_STRIP -> gl_TRIANGLE_STRIP OT_TRIANGLE_FAN -> gl_TRIANGLE_FAN -- bind index data and call draw operation case roIndexData ro of Just indexData -> do let indexBuffer = idIndexBuffer indexData dp = if 0 /= 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_UNSIGNED_SHORT else gl_UNSIGNED_INT --putStrLn $ "glDrawElements (VBI) buf ptr: " ++ show dp ++ " data ptr: " ++ show pBufferData glDrawElements primType (fromIntegral (idIndexCount indexData)) indexType pBufferData Nothing -> do --putStrLn $ "glDrawArrays (VBI)" glDrawArrays primType 0 (fromIntegral (vdVertexCount vertexData)) bindElement :: (Texture t, HardwareIndexBuffer ib) => RenderOperation GLVertexBuffer ib -> [TextureUnitState t] -> VertexElement -> IO () 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 0 -> do return $ fromMaybe (error "fromJust 8") $ glvbShadowBuffer vertexBuffer b -> do glBindBuffer gl_ARRAY_BUFFER b return nullPtr let pBufferData = plusPtr dp $ vdVertexStart vertexData * getVertexSize vertexBuffer + veOffset elem sem = veSemantic elem isCustomAttrib = False bindWith t = t (fromIntegral . getTypeCount . veType $ elem) (getGLType . veType $ elem) (fromIntegral . getVertexSize $ vertexBuffer) pBufferData bindWith' t = t (getGLType . veType $ elem) (fromIntegral . getVertexSize $ vertexBuffer) pBufferData --putStrLn $ show sem ++ " (VBO) buf ptr: " ++ show dp ++ " data ptr: " ++ show pBufferData --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 = fromIntegral . getFixedAttributeIndex sem $ veIndex elem normalised = case veType elem of VET_COLOUR_ABGR -> gl_TRUE VET_COLOUR_ARGB -> gl_TRUE _ -> gl_FALSE glVertexAttribPointer attrib (fromIntegral . getTypeCount . veType $ elem) (getGLType . veType $ elem) (fromIntegral normalised) (fromIntegral . getVertexSize $ vertexBuffer) pBufferData glEnableVertexAttribArray attrib --attribsBound.push_back(attrib); False -> case sem of -- fixed-function & builtin attribute support VES_POSITION -> bindWith Compat.glVertexPointer >> Compat.glEnableClientState Compat.gl_VERTEX_ARRAY VES_NORMAL -> bindWith' Compat.glNormalPointer >> Compat.glEnableClientState Compat.gl_NORMAL_ARRAY VES_DIFFUSE -> bindWith Compat.glColorPointer >> Compat.glEnableClientState Compat.gl_COLOR_ARRAY VES_SPECULAR -> bindWith Compat.glSecondaryColorPointer >> Compat.glEnableClientState Compat.gl_SECONDARY_COLOR_ARRAY VES_TEXTURE_COORDINATES -> do -- TODO let idx = veIndex elem tus = map fst $ filter (\(_,a)-> idx==a) $ zip [0 :: Int ..] $ map tusTextureCoordSetIndex tl forM_ tus $ \tidx -> do --print $ "bind stage="++show tidx ++ " texcoord="++show idx Compat.glClientActiveTexture $ fromIntegral gl_TEXTURE0 + fromIntegral tidx bindWith Compat.glTexCoordPointer >> Compat.glEnableClientState Compat.gl_TEXTURE_COORD_ARRAY _ -> error "bindElement" glSetShadingType :: ShadeOptions -> IO () glSetShadingType so = case so of SO_FLAT -> Compat.glShadeModel Compat.gl_FLAT _ -> Compat.glShadeModel Compat.gl_SMOOTH glSetAlphaRejectSettings :: RenderSystemCapabilities -> CompareFunction -> Int -> Bool -> IO () glSetAlphaRejectSettings rsc func value alphaToCoverage = do let caps = rscCapabilities rsc f = fromIntegral :: Int -> GLclampf case func == CMPF_ALWAYS_PASS of { True -> do glDisable Compat.gl_ALPHA_TEST when (Set.member RSC_ALPHA_TO_COVERAGE caps) $ glDisable gl_SAMPLE_ALPHA_TO_COVERAGE ; False -> do glEnable Compat.gl_ALPHA_TEST Compat.glAlphaFunc (convertCompareFunction func) (f value / 255) when (Set.member RSC_ALPHA_TO_COVERAGE caps) $ case alphaToCoverage of True -> glEnable gl_SAMPLE_ALPHA_TO_COVERAGE False -> glDisable gl_SAMPLE_ALPHA_TO_COVERAGE } glSetDepthBufferCheckEnabled :: Bool -> IO () glSetDepthBufferCheckEnabled enabled = case enabled of { True -> glClearDepth 1 >> glEnable gl_DEPTH_TEST ; False -> glDisable gl_DEPTH_TEST } glSetDepthBufferWriteEnabled :: Bool -> IO () glSetDepthBufferWriteEnabled enabled = case enabled of { True -> glDepthMask $ fromIntegral gl_TRUE ; False -> glDepthMask $ fromIntegral gl_FALSE } glSetDepthBufferFunction :: CompareFunction -> IO () glSetDepthBufferFunction func = glDepthFunc $ convertCompareFunction func glSetPointSpritesEnabled :: RenderSystemCapabilities -> Bool -> IO () glSetPointSpritesEnabled rsc enabled = when (Set.member RSC_POINT_SPRITES $ rscCapabilities rsc) $ do case enabled of { True -> glEnable Compat.gl_POINT_SPRITE ; False -> glDisable Compat.gl_POINT_SPRITE } let en = if enabled then gl_TRUE else gl_FALSE -- Set sprite texture coord generation -- Don't offer this as an option since D3D links it to sprite enabled forM_ [0..rscNumTextureUnits rsc] $ \i -> do glActiveTexture $ fromIntegral gl_TEXTURE0 + fromIntegral i Compat.glTexEnvi Compat.gl_POINT_SPRITE Compat.gl_COORD_REPLACE $ fromIntegral en glActiveTexture $ fromIntegral gl_TEXTURE0 glSetSceneBlending :: SceneBlendFactor -> SceneBlendFactor -> SceneBlendOperation -> IO () glSetSceneBlending sourceFactor destFactor op = do case sourceFactor == SBF_ONE && destFactor == SBF_ZERO of { True -> glDisable gl_BLEND ; False -> do glEnable gl_BLEND glBlendFunc (getBlendMode sourceFactor) (getBlendMode destFactor) } glBlendEquation $ getBlendEquation op glSetSurfaceParams :: GLRenderSystem -> FloatType4 -> FloatType4 -> FloatType4 -> FloatType4 -> FloatType -> TrackVertexColourType -> IO () glSetSurfaceParams rs ambient diffuse specular emissive shininess tc@(TrackVertexColourType a d s e) = do st@GLState { stSurface } <- readIORef $ glrsState rs let newSt = (ambient, diffuse, specular, emissive, shininess, tc) when (stSurface /= newSt) $ do writeIORef (glrsState rs) $ st { stSurface = newSt } -- 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) -> glDisable Compat.gl_COLOR_MATERIAL (True,True,_,_) -> glEnable Compat.gl_COLOR_MATERIAL >> Compat.glColorMaterial gl_FRONT_AND_BACK Compat.gl_AMBIENT_AND_DIFFUSE (True,False,_,_) -> glEnable Compat.gl_COLOR_MATERIAL >> Compat.glColorMaterial gl_FRONT_AND_BACK Compat.gl_AMBIENT (_,True,_,_) -> glEnable Compat.gl_COLOR_MATERIAL >> Compat.glColorMaterial gl_FRONT_AND_BACK Compat.gl_DIFFUSE (_,_,True,_) -> glEnable Compat.gl_COLOR_MATERIAL >> Compat.glColorMaterial gl_FRONT_AND_BACK Compat.gl_SPECULAR (_,_,_,True) -> glEnable Compat.gl_COLOR_MATERIAL >> Compat.glColorMaterial gl_FRONT_AND_BACK Compat.gl_EMISSION let f = realToFrac c (r,g,b,a') = [f r, f g, f b, f a'] withArray (c diffuse) $ \p -> Compat.glMaterialfv gl_FRONT_AND_BACK Compat.gl_DIFFUSE p withArray (c ambient) $ \p -> Compat.glMaterialfv gl_FRONT_AND_BACK Compat.gl_AMBIENT p withArray (c specular) $ \p -> Compat.glMaterialfv gl_FRONT_AND_BACK Compat.gl_SPECULAR p withArray (c emissive) $ \p -> Compat.glMaterialfv gl_FRONT_AND_BACK Compat.gl_EMISSION p Compat.glMaterialf gl_FRONT_AND_BACK Compat.gl_SHININESS $ f shininess glSetLightingEnabled :: Bool -> IO () glSetLightingEnabled enabled = case enabled of True -> glEnable Compat.gl_LIGHTING False -> glDisable Compat.gl_LIGHTING glSetFog :: FogMode -> FloatType4 -> FloatType -> FloatType -> FloatType -> IO () glSetFog mode (r,g,b,a) density start end = case mode of FOG_NONE -> glDisable Compat.gl_FOG FOG_EXP -> setFog $ fromIntegral Compat.gl_EXP FOG_EXP2 -> setFog $ fromIntegral Compat.gl_EXP2 FOG_LINEAR-> setFog $ fromIntegral gl_LINEAR where f = realToFrac setFog fm = withArray [r,g,b,a] $ \p -> do glEnable Compat.gl_FOG Compat.glFogi Compat.gl_FOG_MODE fm Compat.glFogfv Compat.gl_FOG_COLOR $ castPtr p Compat.glFogf Compat.gl_FOG_DENSITY $ f density Compat.glFogf Compat.gl_FOG_START $ f start Compat.glFogf Compat.gl_FOG_END $ f end glSetSeparateSceneBlending :: SceneBlendFactor -> SceneBlendFactor -> SceneBlendFactor -> SceneBlendFactor -> SceneBlendOperation -> SceneBlendOperation -> IO () glSetSeparateSceneBlending sourceFactor destFactor sourceFactorAlpha destFactorAlpha op alphaOp = do case sourceFactor == SBF_ONE && destFactor == SBF_ZERO && sourceFactorAlpha == SBF_ONE && destFactorAlpha == SBF_ZERO of True -> glDisable gl_BLEND False -> do let f = getBlendMode glEnable gl_BLEND glBlendFuncSeparate (f sourceFactor) (f sourceFactorAlpha) (f destFactor) (f destFactorAlpha) glBlendEquationSeparate (getBlendEquation op) (getBlendEquation alphaOp) glSetPointParameters :: (RenderSystem rs vb ib q t p lp) => rs -> FloatType -> Bool -> FloatType -> FloatType -> FloatType -> FloatType -> FloatType -> IO () glSetPointParameters rs size attenuationEnabled constant linear quadratic minSize maxSize = do let rsc = getCapabilities rs caps = rscCapabilities rsc f = realToFrac (size',_minSize',_maxSize',val') <- case attenuationEnabled of True -> do when (Set.member RSC_VERTEX_PROGRAM caps) $ glEnable gl_VERTEX_PROGRAM_POINT_SIZE let correction = 0.005 return (size,minSize,if maxSize == 0 then rscMaxPointSize rsc else maxSize,[f $ constant,f $ linear * correction,f $ quadratic * correction,1]) False -> do when (Set.member RSC_VERTEX_PROGRAM caps) $ glDisable gl_VERTEX_PROGRAM_POINT_SIZE return (size,minSize,if maxSize == 0 then rscMaxPointSize rsc else maxSize,[1,0,0,1]) --no scaling required -- GL has no disabled flag for this so just set to constant glPointSize $ f size' withArray val' $ \val -> case Set.member RSC_POINT_EXTENDED_PARAMETERS caps of True -> do glPointParameterfv Compat.gl_POINT_DISTANCE_ATTENUATION val glPointParameterf Compat.gl_POINT_SIZE_MIN $ f minSize glPointParameterf Compat.gl_POINT_SIZE_MAX $ f maxSize False -> case Set.member RSC_POINT_EXTENDED_PARAMETERS_ARB caps of True -> do ARB.glPointParameterfv Compat.gl_POINT_DISTANCE_ATTENUATION val ARB.glPointParameterf Compat.gl_POINT_SIZE_MIN $ f minSize ARB.glPointParameterf Compat.gl_POINT_SIZE_MAX $ f maxSize False -> case Set.member RSC_POINT_EXTENDED_PARAMETERS_EXT caps of True -> do EXT.glPointParameterfv Compat.gl_POINT_DISTANCE_ATTENUATION val EXT.glPointParameterf Compat.gl_POINT_SIZE_MIN $ f minSize EXT.glPointParameterf Compat.gl_POINT_SIZE_MAX $ f maxSize False -> return () glSetActiveTextureUnit :: Int -> IO () glSetActiveTextureUnit stage = do let f = fromIntegral glActiveTexture $ fromIntegral $ gl_TEXTURE0 + f stage glSetTexture :: Maybe GLTexture -> IO () glSetTexture tex = do glDisable gl_TEXTURE_1D glBindTexture gl_TEXTURE_1D 0 glDisable gl_TEXTURE_2D glBindTexture gl_TEXTURE_2D 0 glDisable gl_TEXTURE_3D glBindTexture gl_TEXTURE_3D 0 glDisable gl_TEXTURE_CUBE_MAP glBindTexture gl_TEXTURE_CUBE_MAP 0 case tex of Just t -> do --TEMP CODE let target = getGLTextureTarget $ txTextureType t glEnable target glBindTexture target $ gltxTextureObject t Nothing -> return () --TODO glUseLights :: GLRenderSystem -> [(Proj4,Light)] -> IO () glUseLights rs lights = do viewMat <- readIORef $ glrsViewMatrix rs worldMat <- readIORef $ glrsWorldMatrix rs st@GLState { stLight } <- readIORef $ glrsState rs when (stLight /= (worldMat, lights)) $ do writeIORef (glrsState rs) $ st { stLight = (worldMat,lights) } glSetupMatrix viewMat idmtx -- disable unused lights forM_ [length lights..7] $ \i -> glDisable $ Compat.gl_LIGHT0 + fromIntegral i forM_ (zip [0..] $ take 8 lights) $ \(i,(mt,lt)) -> do let gl_index = Compat.gl_LIGHT0 + i rad2deg = 180 / pi f = realToFrac c (r,g,b,a) = [f r, f g, f b, f a] pos1 = _4 $ fromProjective mt --pos0 = extendZero $ (trim pos1 :: Vec3) :: Vec4 case lgType lt of LT_SPOTLIGHT -> do Compat.glLightf gl_index Compat.gl_SPOT_CUTOFF $ realToFrac $ 0.5 * rad2deg * lgSpotOuter lt Compat.glLightf gl_index Compat.gl_SPOT_EXPONENT $ realToFrac $ lgSpotFalloff lt _ -> Compat.glLightf gl_index Compat.gl_SPOT_CUTOFF 180 withArray (c $ lgDiffuse lt) $ \p -> Compat.glLightfv gl_index Compat.gl_DIFFUSE p withArray (c $ lgSpecular lt) $ \p -> Compat.glLightfv gl_index Compat.gl_SPECULAR p -- Disable ambient light for movables withArray [0,0,0,1] $ \p -> Compat.glLightfv gl_index Compat.gl_AMBIENT p -- Set position / direction let pos = if lgType lt == LT_DIRECTIONAL then neg dir4 else pos1 dir4 = (extendZero $ lgDirection lt :: Vec4) .* (fromProjective mt) --putStrLn $ show (lgType lt) ++ " glPos: " ++ show pos --putStrLn $ " glMat: " ++ show mt with pos $ \p -> Compat.glLightfv gl_index Compat.gl_POSITION $ castPtr p -- Set spotlight direction when (lgType lt == LT_SPOTLIGHT) $ with dir4 $ \p -> Compat.glLightfv gl_index Compat.gl_SPOT_DIRECTION $ castPtr p -- Attenuation Compat.glLightf gl_index Compat.gl_CONSTANT_ATTENUATION $ realToFrac $ lgAttenuationConst lt Compat.glLightf gl_index Compat.gl_LINEAR_ATTENUATION $ realToFrac $ lgAttenuationLinear lt Compat.glLightf gl_index Compat.gl_QUADRATIC_ATTENUATION $ realToFrac $ lgAttenuationQuad lt -- Enable in the scene --putStrLn $ "setup light " ++ show i ++ " pos: " ++ show pos glEnable gl_index glSetupMatrix viewMat worldMat glSetTextureAddressingMode :: TextureType -> UVWAddressingMode -> IO () glSetTextureAddressingMode texTarget (UVWAddressingMode u v w) = do let target = getGLTextureTarget texTarget glTexParameteri target gl_TEXTURE_WRAP_S $ fromIntegral $ getTextureAddressingMode u glTexParameteri target gl_TEXTURE_WRAP_T $ fromIntegral $ getTextureAddressingMode v glTexParameteri target gl_TEXTURE_WRAP_R $ fromIntegral $ getTextureAddressingMode w glSetTextureBorderColour :: TextureType -> FloatType4 -> IO () glSetTextureBorderColour texTarget (r,g,b,a) = withArray [r,g,b,a] $ \p -> do let target = getGLTextureTarget texTarget glTexParameterfv target gl_TEXTURE_BORDER_COLOR $ castPtr p glSetTextureUnitFiltering :: TextureType -> FilterOptions -> FilterOptions -> FilterOptions -> IO () 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 -> FO_LINEAR FO_LINEAR -> FO_LINEAR FO_POINT -> FO_POINT FO_NONE -> FO_POINT mip = case mipFilter of FO_ANISOTROPIC -> Just FO_LINEAR FO_LINEAR -> Just FO_LINEAR FO_POINT -> Just FO_POINT FO_NONE -> Nothing min'' = case (min',mip) of (FO_POINT, Nothing) -> gl_NEAREST (FO_LINEAR, Nothing) -> gl_LINEAR (FO_POINT, Just FO_POINT) -> gl_NEAREST_MIPMAP_NEAREST (FO_LINEAR, Just FO_POINT) -> gl_LINEAR_MIPMAP_NEAREST (FO_POINT, Just FO_LINEAR) -> gl_NEAREST_MIPMAP_LINEAR (FO_LINEAR, Just FO_LINEAR) -> gl_LINEAR_MIPMAP_LINEAR _ -> error "glSetTextureUnitFiltering" glTexParameteri target gl_TEXTURE_MAG_FILTER $ fromIntegral mag glTexParameteri target gl_TEXTURE_MIN_FILTER $ fromIntegral min'' glSetTextureLayerAnisotropy :: TextureType -> Int -> IO () glSetTextureLayerAnisotropy texTarget maxAnisotropy = do largest_supported_anisotropy <- alloca $ \p-> do glGetFloatv EXT.gl_MAX_TEXTURE_MAX_ANISOTROPY p peek p let target = getGLTextureTarget texTarget maxAnisotropy' = if fromIntegral maxAnisotropy > largest_supported_anisotropy then largest_supported_anisotropy else fromIntegral maxAnisotropy glTexParameterf target EXT.gl_TEXTURE_MAX_ANISOTROPY maxAnisotropy' glSetTextureMipmapBias :: FloatType -> IO () glSetTextureMipmapBias bias = do Compat.glTexEnvf EXT.gl_TEXTURE_FILTER_CONTROL EXT.gl_TEXTURE_LOD_BIAS $ realToFrac bias {- doc: http://www.informit.com/articles/article.aspx?p=770639&seqNum=6 FIXME: Test this code -} glSetTextureBlendMode :: RenderSystemCapabilities -> LayerBlendModeEx -> LayerBlendModeEx -> IO () 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 src2Fun m = do Compat.glTexEnvi Compat.gl_TEXTURE_ENV Compat.gl_SOURCE2_RGB m Compat.glTexEnvi Compat.gl_TEXTURE_ENV Compat.gl_SOURCE2_ALPHA m cf (r,g,b,a) = [f r, f g, f b, f a] alphaCol (r,g,b,_) a = cf (r, g, b, a) -- Color blending Compat.glTexEnvi Compat.gl_TEXTURE_ENV Compat.gl_TEXTURE_ENV_MODE $ fromIntegral Compat.gl_COMBINE Compat.glTexEnvi Compat.gl_TEXTURE_ENV Compat.gl_COMBINE_RGB $ fromIntegral ccmd Compat.glTexEnvi Compat.gl_TEXTURE_ENV Compat.gl_SOURCE0_RGB $ fromIntegral csrc1op Compat.glTexEnvi Compat.gl_TEXTURE_ENV Compat.gl_SOURCE1_RGB $ fromIntegral csrc2op Compat.glTexEnvi Compat.gl_TEXTURE_ENV Compat.gl_SOURCE2_RGB $ fromIntegral Compat.gl_CONSTANT case lbOperation colorbm of LBX_BLEND_DIFFUSE_COLOUR -> src2Fun $ fromIntegral Compat.gl_PRIMARY_COLOR LBX_BLEND_DIFFUSE_ALPHA -> src2Fun $ fromIntegral Compat.gl_PRIMARY_COLOR LBX_BLEND_TEXTURE_ALPHA -> src2Fun $ fromIntegral gl_TEXTURE LBX_BLEND_CURRENT_ALPHA -> src2Fun $ fromIntegral Compat.gl_PREVIOUS LBX_BLEND_MANUAL -> withArray [0, 0, 0, realToFrac $ lbFactor colorbm] $ \p -> Compat.glTexEnvfv Compat.gl_TEXTURE_ENV Compat.gl_TEXTURE_ENV_COLOR p LBX_MODULATE_X2 -> Compat.glTexEnvi Compat.gl_TEXTURE_ENV Compat.gl_RGB_SCALE 2 LBX_MODULATE_X4 -> Compat.glTexEnvi Compat.gl_TEXTURE_ENV Compat.gl_RGB_SCALE 4 _ -> Compat.glTexEnvi Compat.gl_TEXTURE_ENV Compat.gl_RGB_SCALE 1 Compat.glTexEnvi Compat.gl_TEXTURE_ENV Compat.gl_OPERAND0_RGB $ fromIntegral gl_SRC_COLOR Compat.glTexEnvi Compat.gl_TEXTURE_ENV Compat.gl_OPERAND1_RGB $ fromIntegral gl_SRC_COLOR case lbOperation colorbm of LBX_BLEND_DIFFUSE_COLOUR -> Compat.glTexEnvi Compat.gl_TEXTURE_ENV Compat.gl_OPERAND2_RGB $ fromIntegral gl_SRC_COLOR _ -> Compat.glTexEnvi Compat.gl_TEXTURE_ENV Compat.gl_OPERAND2_RGB $ fromIntegral gl_SRC_ALPHA Compat.glTexEnvi Compat.gl_TEXTURE_ENV Compat.gl_OPERAND0_ALPHA $ fromIntegral gl_SRC_ALPHA Compat.glTexEnvi Compat.gl_TEXTURE_ENV Compat.gl_OPERAND1_ALPHA $ fromIntegral gl_SRC_ALPHA Compat.glTexEnvi Compat.gl_TEXTURE_ENV Compat.gl_OPERAND2_ALPHA $ fromIntegral gl_SRC_ALPHA when (lbSource1 colorbm == LBS_MANUAL) $ withArray (cf $ lbColourArg1 colorbm) $ \p -> Compat.glTexEnvfv Compat.gl_TEXTURE_ENV Compat.gl_TEXTURE_ENV_COLOR p when (lbSource2 colorbm == LBS_MANUAL) $ withArray (cf $ lbColourArg2 colorbm) $ \p -> Compat.glTexEnvfv Compat.gl_TEXTURE_ENV Compat.gl_TEXTURE_ENV_COLOR p -- Alpha blending Compat.glTexEnvi Compat.gl_TEXTURE_ENV Compat.gl_TEXTURE_ENV_MODE $ fromIntegral Compat.gl_COMBINE Compat.glTexEnvi Compat.gl_TEXTURE_ENV Compat.gl_COMBINE_ALPHA $ fromIntegral acmd Compat.glTexEnvi Compat.gl_TEXTURE_ENV Compat.gl_SOURCE0_ALPHA $ fromIntegral asrc1op Compat.glTexEnvi Compat.gl_TEXTURE_ENV Compat.gl_SOURCE1_ALPHA $ fromIntegral asrc2op Compat.glTexEnvi Compat.gl_TEXTURE_ENV Compat.gl_SOURCE2_ALPHA $ fromIntegral Compat.gl_CONSTANT case lbOperation alphabm of LBX_BLEND_DIFFUSE_COLOUR -> src2Fun $ fromIntegral Compat.gl_PRIMARY_COLOR LBX_BLEND_DIFFUSE_ALPHA -> src2Fun $ fromIntegral Compat.gl_PRIMARY_COLOR LBX_BLEND_TEXTURE_ALPHA -> src2Fun $ fromIntegral gl_TEXTURE LBX_BLEND_CURRENT_ALPHA -> src2Fun $ fromIntegral Compat.gl_PREVIOUS LBX_BLEND_MANUAL -> withArray [0, 0, 0, realToFrac $ lbFactor alphabm] $ \p -> Compat.glTexEnvfv Compat.gl_TEXTURE_ENV Compat.gl_TEXTURE_ENV_COLOR p LBX_MODULATE_X2 -> Compat.glTexEnvi Compat.gl_TEXTURE_ENV Compat.gl_ALPHA_SCALE 2 LBX_MODULATE_X4 -> Compat.glTexEnvi Compat.gl_TEXTURE_ENV Compat.gl_ALPHA_SCALE 4 _ -> Compat.glTexEnvi Compat.gl_TEXTURE_ENV Compat.gl_ALPHA_SCALE 1 Compat.glTexEnvi Compat.gl_TEXTURE_ENV Compat.gl_OPERAND0_ALPHA $ fromIntegral gl_SRC_ALPHA Compat.glTexEnvi Compat.gl_TEXTURE_ENV Compat.gl_OPERAND1_ALPHA $ fromIntegral gl_SRC_ALPHA Compat.glTexEnvi Compat.gl_TEXTURE_ENV Compat.gl_OPERAND2_ALPHA $ fromIntegral gl_SRC_ALPHA when (lbSource1 alphabm == LBS_MANUAL) $ withArray (alphaCol (lbColourArg1 colorbm) (lbAlphaArg1 alphabm)) $ \p -> Compat.glTexEnvfv Compat.gl_TEXTURE_ENV Compat.gl_TEXTURE_ENV_COLOR p when (lbSource2 alphabm == LBS_MANUAL) $ withArray (alphaCol (lbColourArg2 colorbm) (lbAlphaArg2 alphabm)) $ \p -> Compat.glTexEnvfv Compat.gl_TEXTURE_ENV Compat.gl_TEXTURE_ENV_COLOR p glSetCullingMode :: CullingMode -> IO () glSetCullingMode mode = case mode of CULL_NONE -> glDisable gl_CULL_FACE CULL_CLOCKWISE -> glEnable gl_CULL_FACE >> glCullFace gl_BACK CULL_ANTICLOCKWISE -> glEnable gl_CULL_FACE >> glCullFace gl_FRONT glSetColourBufferWriteEnabled :: Bool -> Bool -> Bool -> Bool -> IO () glSetColourBufferWriteEnabled r g b a = do let f = fromBool glColorMask (f r) (f g) (f b) (f a) glBindLinkedGpuProgram :: GLLinkedGpuProgram -> IO () glBindLinkedGpuProgram lp = do let p = gllgpProgramObject lp withGLString :: String -> (Ptr GLchar -> IO a) -> IO a withGLString s act = withCAString s $ act . castPtr glUseProgram p --TEMP CODE loc_tex0 <- withGLString "tex0" $ glGetUniformLocation p loc_tex1 <- withGLString "tex1" $ glGetUniformLocation p glUniform1i loc_tex0 0 glUniform1i loc_tex1 1 glUnBindLinkedGpuProgram :: IO () glUnBindLinkedGpuProgram = glUseProgram 0 glSetTextureMatrix :: Proj4 -> IO () glSetTextureMatrix xform = do Compat.glMatrixMode gl_TEXTURE with xform $ \p -> do Compat.glLoadMatrixf $ castPtr p glSetTextureCoordCalculation :: TexCoordCalcMethod -> IO () glSetTextureCoordCalculation m = case m of TEXCALC_NONE -> do glDisable Compat.gl_TEXTURE_GEN_S glDisable Compat.gl_TEXTURE_GEN_T glDisable Compat.gl_TEXTURE_GEN_R glDisable Compat.gl_TEXTURE_GEN_Q TEXCALC_ENVIRONMENT_MAP -> do Compat.glTexGeni Compat.gl_S Compat.gl_TEXTURE_GEN_MODE $ fromIntegral Compat.gl_SPHERE_MAP Compat.glTexGeni Compat.gl_T Compat.gl_TEXTURE_GEN_MODE $ fromIntegral Compat.gl_SPHERE_MAP glEnable Compat.gl_TEXTURE_GEN_S glEnable Compat.gl_TEXTURE_GEN_T glDisable Compat.gl_TEXTURE_GEN_R glDisable Compat.gl_TEXTURE_GEN_Q TEXCALC_ENVIRONMENT_MAP_PLANAR -> do Compat.glTexGeni Compat.gl_S Compat.gl_TEXTURE_GEN_MODE $ fromIntegral Compat.gl_SPHERE_MAP Compat.glTexGeni Compat.gl_T Compat.gl_TEXTURE_GEN_MODE $ fromIntegral Compat.gl_SPHERE_MAP glEnable Compat.gl_TEXTURE_GEN_S glEnable Compat.gl_TEXTURE_GEN_T glDisable Compat.gl_TEXTURE_GEN_R glDisable Compat.gl_TEXTURE_GEN_Q TEXCALC_ENVIRONMENT_MAP_REFLECTION -> do Compat.glTexGeni Compat.gl_S Compat.gl_TEXTURE_GEN_MODE $ fromIntegral Compat.gl_REFLECTION_MAP Compat.glTexGeni Compat.gl_T Compat.gl_TEXTURE_GEN_MODE $ fromIntegral Compat.gl_REFLECTION_MAP Compat.glTexGeni Compat.gl_R Compat.gl_TEXTURE_GEN_MODE $ fromIntegral Compat.gl_REFLECTION_MAP glEnable Compat.gl_TEXTURE_GEN_S glEnable Compat.gl_TEXTURE_GEN_T glEnable Compat.gl_TEXTURE_GEN_R glDisable Compat.gl_TEXTURE_GEN_Q TEXCALC_ENVIRONMENT_MAP_NORMAL -> do Compat.glTexGeni Compat.gl_S Compat.gl_TEXTURE_GEN_MODE $ fromIntegral Compat.gl_NORMAL_MAP Compat.glTexGeni Compat.gl_T Compat.gl_TEXTURE_GEN_MODE $ fromIntegral Compat.gl_NORMAL_MAP Compat.glTexGeni Compat.gl_R Compat.gl_TEXTURE_GEN_MODE $ fromIntegral Compat.gl_NORMAL_MAP glEnable Compat.gl_TEXTURE_GEN_S glEnable Compat.gl_TEXTURE_GEN_T glEnable Compat.gl_TEXTURE_GEN_R glDisable Compat.gl_TEXTURE_GEN_Q TEXCALC_PROJECTIVE_TEXTURE -> do Compat.glTexGeni Compat.gl_S Compat.gl_TEXTURE_GEN_MODE $ fromIntegral Compat.gl_EYE_LINEAR Compat.glTexGeni Compat.gl_T Compat.gl_TEXTURE_GEN_MODE $ fromIntegral Compat.gl_EYE_LINEAR Compat.glTexGeni Compat.gl_R Compat.gl_TEXTURE_GEN_MODE $ fromIntegral Compat.gl_EYE_LINEAR Compat.glTexGeni Compat.gl_Q Compat.gl_TEXTURE_GEN_MODE $ fromIntegral Compat.gl_EYE_LINEAR withArray [1, 0, 0, 0] $ \p -> Compat.glTexGenfv Compat.gl_S Compat.gl_EYE_PLANE p withArray [0, 1, 0, 0] $ \p -> Compat.glTexGenfv Compat.gl_T Compat.gl_EYE_PLANE p withArray [0, 0, 1, 0] $ \p -> Compat.glTexGenfv Compat.gl_R Compat.gl_EYE_PLANE p withArray [0, 0, 0, 1] $ \p -> Compat.glTexGenfv Compat.gl_Q Compat.gl_EYE_PLANE p glEnable Compat.gl_TEXTURE_GEN_S glEnable Compat.gl_TEXTURE_GEN_T glEnable Compat.gl_TEXTURE_GEN_R glEnable Compat.gl_TEXTURE_GEN_Q