module Graphics.LambdaCube.RenderSystem.GL.Capabilities where

import qualified Data.Set as Set

import Graphics.Rendering.OpenGL.Raw.Core31
import qualified Graphics.Rendering.OpenGL.Raw.ARB.Compatibility as Compat

import Graphics.LambdaCube.RenderSystemCapabilities
import Graphics.LambdaCube.RenderSystem.GL.Utils

mkGLCapabilities :: IO RenderSystemCapabilities
mkGLCapabilities = do
    vendorS     <- getString gl_VENDOR
    extSList    <- getGLExtensions
    -- setup device name
    deviceName <- getString gl_RENDERER
    -- 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) <- getGLVersion
    -- setup capabilities
    let ext = Set.fromList extSList
        glVer a b = major > a || (major >= a && minor >= b)
        supports s = Set.member s ext
        driverVersion = DriverVersion (fromIntegral major) (fromIntegral 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
          --mtu <- getInteger Compat.gl_MAX_TEXTURE_UNITS
          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
                  getInteger gl_MAX_TEXTURE_IMAGE_UNITS
              ; 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 <- getInteger Compat.gl_STENCIL_BITS
    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
        (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)
        -- 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 []
        -- 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
            ++ (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 <- getInteger gl_MAX_DRAW_BUFFERS
                -- 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
          return (0,[])
        ------------------------------------------------------
        -- FIXE: haskell gl binding does not have query for GL_POINT_SIZE_RANGE
        -- Point size
    maxPointSize <- getFloat Compat.gl_POINT_SIZE_MAX
        -- Vertex texture fetching
    (numVertTexUnits,caps22,vertTexUnitsShared) <- case supports "GL_ARB_vertex_shader" of
        True  -> do
          vunits <- getInteger gl_MAX_VERTEX_TEXTURE_IMAGE_UNITS
          -- 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
        }