{-# 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::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(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(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(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(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); } -}