module Graphics.LambdaCube.RenderSystem.GL.GLCapabilities where import Data.Set (Set) import qualified Data.Set as Set import Graphics.Rendering.OpenGL (($=)) import qualified Graphics.Rendering.OpenGL as GL import Graphics.LambdaCube.Types import Graphics.LambdaCube.RenderSystemCapabilities {- vendor, renderer, glVersion, glExtensions, shadingLanguageVersion, majorMinor, contextProfile vendor :: GettableStateVar String renderer :: GettableStateVar String glVersion :: GettableStateVar String glExtensions :: GettableStateVar [String] shadingLanguageVersion :: GettableStateVar String = DriverVersion { dvMajor :: Int , dvMinor :: Int , dvRelease :: Int , dvBuild :: Int } -} --mkRenderSystemCapabilities :: IO RenderSystemCapabilities mkGLCapabilities = do vendorS <- GL.get GL.vendor versionS <- GL.get GL.glVersion extSList <- GL.get GL.glExtensions shLngVerS <- GL.get GL.shadingLanguageVersion -- setup driver version {- StringVector tokens = StringUtil::split(mGLSupport->getGLVersion(), "."); if (!tokens.empty()) { mDriverVersion.major = StringConverter::parseInt(tokens[0]); if (tokens.size() > 1) mDriverVersion.minor = StringConverter::parseInt(tokens[1]); if (tokens.size() > 2) mDriverVersion.release = StringConverter::parseInt(tokens[2]); } mDriverVersion.build = 0; -} -- setup device name deviceName <- GL.get GL.renderer {- const char* deviceName = (const char*)glGetString(GL_RENDERER); rsc->setDeviceName(deviceName); -} -- setup vendor let v = words vendorS vendorName = if elem "NVIDIA" v then GPU_NVIDIA else if elem "ATI" v then GPU_ATI else if elem "Intel" v then GPU_INTEL else if elem "S3" v then GPU_S3 else if elem "Matrox" v then GPU_MATROX else if elem "3DLabs" v then GPU_3DLABS else if elem "SiS" v then GPU_SIS else GPU_UNKNOWN (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 driverVersion = DriverVersion major minor 0 0 -- TODO caps0 = [ RSC_FIXED_FUNCTION -- Supports fixed-function , RSC_SCISSOR_TEST -- Scissor test is standard in GL 1.2 (is it emulated on some cards though?) , RSC_USER_CLIP_PLANES -- As are user clipping planes , RSC_VERTEX_FORMAT_UBYTE4 -- UBYTE4 always supported , RSC_INFINITE_FAR_PLANE -- Infinite far plane always supported , RSC_TEXTURE_3D -- 3D textures should be supported by GL 1.2, which is our minimum version ] -- Check for hardware mipmapping support. caps1 = if not (glVer 1 4 || supports "GL_SGIS_generate_mipmap") then [] else [RSC_AUTOMIPMAP] -- FIXME {- case vendorName of { GPU_ATI -> [] -- Apple & Linux ATI drivers have faults in hardware mipmap generation -- The Intel 915G frequently corrupts textures when using hardware mip generation -- I'm not currently sure how many generations of hardware this affects, -- so for now, be safe. ; GPU_INTEL -> [] ; GPU_SIS -> [] -- SiS chipsets also seem to have problems with this ; _ -> [RSC_AUTOMIPMAP] } -} -- Check for blending support caps2 = if (glVer 1 3 || supports "GL_ARB_texture_env_combine" || supports "GL_EXT_texture_env_combine") then [RSC_BLENDING] else [] -- Check for Multitexturing support and set number of texture units numTexUnits <- case glVer 1 3 || supports "GL_ARB_multitexture" of { True -> do GL.TextureUnit mtu <- GL.get GL.maxTextureUnit mtimu <- case supports "GL_ARB_fragment_program" of { True -> do -- Also check GL_MAX_TEXTURE_IMAGE_UNITS_ARB since NV at least -- only increased this on the FX/6x00 series GL.get GL.maxTextureImageUnits ; False -> return 0 } -- FIXME: enable at becoming hgl binding return mtimu -- $ max mtu (fromIntegral mtimu) ; False -> return 1 } -- Check for Anisotropy support let caps3 = if (supports "GL_EXT_texture_filter_anisotropic") then [RSC_ANISOTROPY] else [] -- Check for DOT3 support caps4 = if (glVer 1 3 || supports "GL_ARB_texture_env_dot3" || supports "GL_EXT_texture_env_dot3") then [RSC_DOT3] else [] -- Check for cube mapping caps5 = if (glVer 1 3 || supports "GL_ARB_texture_cube_map" || supports "GL_EXT_texture_cube_map") then [RSC_CUBEMAPPING] else [] -- Point sprites caps6 = if (glVer 2 0 || supports "GL_ARB_point_sprite") then [RSC_POINT_SPRITES] else [] -- Check for point parameters caps7 = if (glVer 1 4) then [RSC_POINT_EXTENDED_PARAMETERS] else [] caps8 = if (supports "GL_ARB_point_parameters") then [RSC_POINT_EXTENDED_PARAMETERS_ARB] else [] caps9 = if (supports "GL_EXT_point_parameters") then [RSC_POINT_EXTENDED_PARAMETERS_EXT] else [] -- Check for hardware stencil support and set bit depth stencilBits <- GL.get GL.stencilBits let caps10 = if stencilBits > 0 then [RSC_HWSTENCIL] else [] caps11 = if not (glVer 1 5 || supports "GL_ARB_vertex_buffer_object") then [] else [RSC_VBO] ++ (if not (supports "GL_ARB_vertex_buffer_object") then [RSC_GL1_5_NOVBO] else []) -- TODO: haskell gl binding does not support query for GL_MAX_PROGRAM_LOCAL_PARAMETERS_ARB {- if(GLEW_ARB_vertex_program) { rsc->setCapability(RSC_VERTEX_PROGRAM); // Vertex Program Properties rsc->setVertexProgramConstantBoolCount(0); rsc->setVertexProgramConstantIntCount(0); GLint floatConstantCount; glGetProgramivARB(GL_VERTEX_PROGRAM_ARB, GL_MAX_PROGRAM_LOCAL_PARAMETERS_ARB, &floatConstantCount); rsc->setVertexProgramConstantFloatCount(floatConstantCount); rsc->addShaderProfile("arbvp1"); if (GLEW_NV_vertex_program2_option) { rsc->addShaderProfile("vp30"); } if (GLEW_NV_vertex_program3) { rsc->addShaderProfile("vp40"); } if (GLEW_NV_vertex_program4) { rsc->addShaderProfile("gp4vp"); rsc->addShaderProfile("gpu_vp"); } } -} (prof1,caps12) = if supports "GL_NV_register_combiners2" && supports "GL_NV_texture_shader" then (["fp20"],[RSC_FRAGMENT_PROGRAM]) else ([],[]) -- check for ATI fragment shader support -- no boolean params allowed -- no integer params allowed -- only 8 Vector4 constant floats supported (prof2,caps13,fragConstBool,fragConstInt,fragConstFloat) = if supports "GL_ATI_fragment_shader" then (["ps_1_4","ps_1_3","ps_1_2","ps_1_1"],[RSC_FRAGMENT_PROGRAM],0,0,8) else ([],[],0,0,0) -- TODO ------------------------------------------------------------------------------ {- (prof,cap,fragConstBool,fragConstInt,fragConstFloat) <- case supports "GL_ARB_fragment_program" of { True -> do -- Fragment Program Properties return ([],[RSC_FRAGMENT_PROGRAM],0,0,) ; False -> ([],[],0,0,0) } -} {- if (GLEW_ARB_fragment_program) { rsc->setCapability(RSC_FRAGMENT_PROGRAM); // Fragment Program Properties rsc->setFragmentProgramConstantBoolCount(0); rsc->setFragmentProgramConstantIntCount(0); GLint floatConstantCount; glGetProgramivARB(GL_FRAGMENT_PROGRAM_ARB, GL_MAX_PROGRAM_LOCAL_PARAMETERS_ARB, &floatConstantCount); rsc->setFragmentProgramConstantFloatCount(floatConstantCount); rsc->addShaderProfile("arbfp1"); if (GLEW_NV_fragment_program_option) { rsc->addShaderProfile("fp30"); } if (GLEW_NV_fragment_program2) { rsc->addShaderProfile("fp40"); } } -} ------------------------------------------------------------------------------ -- Check if GLSL is supported prof3 = if glVer 2 0 || (supports "GL_ARB_shading_language_100" && supports "GL_ARB_shader_objects" && supports "GL_ARB_fragment_shader" && supports "GL_ARB_vertex_shader") then ["glsl"] else [] -- TODO -------------------------------------------------------------------------------------- -- Check if geometry shaders are supported {- (cap,prof,boolC,intC,floatC,outVertN) <- case glVer 2 0 && supports "GL_EXT_geometry_shader4" of { True -> do return ([RSC_GEOMETRY_PROGRAM],["nvgp4","gpu_gp","gp4gp"],0,0,) ; False -> return ([],[],0,0,0,0) } -} {- // Check if geometry shaders are supported if (GLEW_VERSION_2_0 && GLEW_EXT_geometry_shader4) { rsc->setCapability(RSC_GEOMETRY_PROGRAM); rsc->addShaderProfile("nvgp4"); //Also add the CG profiles rsc->addShaderProfile("gpu_gp"); rsc->addShaderProfile("gp4gp"); rsc->setGeometryProgramConstantBoolCount(0); rsc->setGeometryProgramConstantIntCount(0); GLint floatConstantCount; glGetProgramivARB(GL_GEOMETRY_PROGRAM_NV, GL_MAX_PROGRAM_LOCAL_PARAMETERS_ARB, &floatConstantCount); rsc->setGeometryProgramConstantFloatCount(floatConstantCount); GLint maxOutputVertices; glGetIntegerv(GL_MAX_GEOMETRY_OUTPUT_VERTICES_EXT,&maxOutputVertices); rsc->setGeometryProgramNumOutputVertices(maxOutputVertices); } -} -------------------------------------------------------------------------------------- -- Check if render to vertex buffer (transform feedback in OpenGL) caps14 = if (glVer 2 0 && supports "GL_NV_transform_feedback") then [RSC_HWRENDER_TO_VERTEX_BUFFER] else [] -- Check for texture compression caps15 = if not (glVer 1 3 || supports "GL_ARB_texture_compression") then [] else [RSC_TEXTURE_COMPRESSION] -- Check for dxt compression -------------------------------------------------------------------------------- {- FIXME: we should disable DXT on (apple && ati && ppc) -- if defined(__APPLE__) && defined(__PPC__) -- // Apple on ATI & PPC has errors in DXT -- if (mGLSupport->getGLVendor().find("ATI") == std::string::npos) -- endif -} -------------------------------------------------------------------------------- ++ (if supports "GL_EXT_texture_compression_s3tc" then [RSC_TEXTURE_COMPRESSION_DXT] else []) -- Check for vtc compression ++ (if supports "GL_NV_texture_compression_vtc" then [RSC_TEXTURE_COMPRESSION_VTC] else []) -- 2-sided stencil? caps16 = if (glVer 2 0 || supports "GL_EXT_stencil_two_side") then [RSC_TWO_SIDED_STENCIL] else [] caps17 = if (glVer 1 4 || supports "GL_EXT_stencil_wrap") then [RSC_STENCIL_WRAP] else [] -- Check for hardware occlusion support caps18 = case glVer 1 5 || supports "GL_ARB_occlusion_query" of -- Some buggy driver claim that it is GL 1.5 compliant and not support ARB_occlusion_query { True -> [RSC_HWOCCLUSION] ++ (if not (supports "GL_ARB_occlusion_query") then [RSC_GL1_5_NOHWOCCLUSION] else []) -- Support NV extension too for old hardware ; False -> if supports "GL_NV_occlusion_query" then [RSC_HWOCCLUSION] else [] } -- Check for non-power-of-2 texture support caps19 = if (supports "GL_ARB_texture_non_power_of_two") then [RSC_NON_POWER_OF_2_TEXTURES] else [] -- Check for Float textures caps20 = if (supports "GL_ATI_texture_float" || supports "GL_ARB_texture_float") then [RSC_TEXTURE_FLOAT] else [] -- Check for framebuffer object extension (numMTR,caps21) <- case supports "GL_EXT_framebuffer_object" of { True -> do -- Probe number of draw buffers -- Only makes sense with FBO support, so probe here (n,c) <- case glVer 2 0 || supports "GL_ARB_draw_buffers" || supports "GL_ATI_draw_buffers" of { True -> do m <- GL.get GL.maxDrawBuffers -- Before GL version 2.0, we need to get one of the extensions let cp = case (glVer 2 0, supports "GL_ARB_draw_buffers", supports "GL_ATI_draw_buffers") of { (False,True,True) -> [RSC_FBO_ARB,RSC_FBO_ATI] ; (False,True,False) -> [RSC_FBO_ARB] ; (False,False,True) -> [RSC_FBO_ATI] ; _ -> [] } -- Set FBO flag for all 3 'subtypes' return (m,[RSC_MRT_DIFFERENT_BIT_DEPTHS,RSC_FBO] ++ cp) ; False -> return (0,[]) } return (n,RSC_HWRENDER_TO_TEXTURE:c) ; False -> do -- TODO ---------------------------------------------- {- // Check GLSupport for PBuffer support if(mGLSupport->supportsPBuffers()) { // Use PBuffers rsc->setCapability(RSC_HWRENDER_TO_TEXTURE); rsc->setCapability(RSC_PBUFFER); } -} ---------------------------------------------- return (0,[]) } ------------------------------------------------------ -- FIXE: haskell gl binding does not have query for GL_POINT_SIZE_RANGE -- Point size (_,maxPointSize) <- GL.get GL.pointSizeRange {- if (GLEW_VERSION_1_4) { float ps; glGetFloatv(GL_POINT_SIZE_MAX, &ps); rsc->setMaxPointSize(ps); } else { GLint vSize[2]; glGetIntegerv(GL_POINT_SIZE_RANGE,vSize); rsc->setMaxPointSize(vSize[1]); } -} -- Point size: Ends here ------------------------------------------------------ -- Vertex texture fetching (numVertTexUnits,caps22,vertTexUnitsShared) <- case supports "GL_ARB_vertex_shader" of { True -> do vunits <- GL.get GL.maxVertexTextureImageUnits -- GL always shares vertex and fragment texture units (for now?) return (vunits,if vunits > 0 then [RSC_VERTEX_TEXTURE_FETCH] else [], True) ; False -> return (0,[],False) } -- Mipmap LOD biasing? let caps23 = if (glVer 1 4 || supports "GL_EXT_texture_lod_bias") then [RSC_MIPMAP_LOD_BIAS] else [] -- Alpha to coverage? -- Alpha to coverage always 'supported' when MSAA is available -- although card may ignore it if it doesn't specifically support A2C caps24 = if (supports "GL_ARB_multisample") then [RSC_ALPHA_TO_COVERAGE] else [] -- Advanced blending operations caps25 = if (glVer 2 0) then [RSC_ADVANCED_BLEND_OPERATIONS] else [] return RenderSystemCapabilities { rscDriverVersion = driverVersion , rscVendor = vendorName -- , rscNumWorldMatrices :: Int -- ^ The number of world matrices available , rscNumTextureUnits = fromIntegral numTexUnits , rscStencilBufferBitDepth = fromIntegral stencilBits -- , rscNumVertexBlendMatrices :: Int , rscCapabilities = Set.fromList $ caps0 ++ caps1 ++ caps2 ++ caps3 ++ caps4 ++ caps5 ++ caps6 ++ caps7 ++ caps8 ++ caps9 ++ caps10 ++ caps11 ++ caps12 ++ caps13 ++ caps14 ++ caps15 ++ caps16 ++ caps17 ++ caps18 ++ caps19 ++ caps20 ++ caps21 ++ caps22 ++ caps23 ++ caps24 ++ caps25 , rscDeviceName = deviceName , rscRenderSystemName = "OpenGL Rendering Subsystem" -- TODO , rscVertexProgramConstantFloatCount = undefined , rscVertexProgramConstantIntCount = undefined , rscVertexProgramConstantBoolCount = undefined , rscGeometryProgramConstantFloatCount = undefined , rscGeometryProgramConstantIntCount = undefined , rscGeometryProgramConstantBoolCount = undefined , rscFragmentProgramConstantFloatCount = fragConstFloat , rscFragmentProgramConstantIntCount = fragConstInt , rscFragmentProgramConstantBoolCount = fragConstBool , rscNumMultiRenderTargets = fromIntegral numMTR , rscMaxPointSize = realToFrac maxPointSize , rscNonPOW2TexturesLimited = False , rscNumVertexTextureUnits = fromIntegral numVertTexUnits , rscVertexTextureUnitsShared = vertTexUnitsShared -- TODO , rscGeometryProgramNumOutputVertices = undefined , rscSupportedShaderProfiles = Set.fromList $ prof1 ++ prof2 ++ prof3 }