module Graphics.LambdaCube.Technique where

import Graphics.LambdaCube.GpuProgram
import Graphics.LambdaCube.Pass
import Graphics.LambdaCube.RenderSystemCapabilities
import Graphics.LambdaCube.Texture

data IlluminationPassesState
    = IPS_COMPILE_DISABLED
    | IPS_NOT_COMPILED
    | IPS_COMPILED
    deriving Eq

data IncludeOrExclude
    = INCLUDE -- ^ Inclusive - only support if present
    | EXCLUDE -- ^ Exclusive - do not support if present
    deriving Eq

data GPUVendorRule
    = GPUVendorRule
    { gvrVendor           :: GPUVendor
    , gvrIncludeOrExclude :: IncludeOrExclude
    }
    deriving Eq

data GPUDeviceNameRule
    = GPUDeviceNameRule
    { gdrDevicePattern    :: String
    , gdrIncludeOrExclude :: IncludeOrExclude
    , gdrCaseSensitive    :: Bool
    }
    deriving Eq

data (Texture t, LinkedGpuProgram lp) => Technique t lp
    = Technique
    { tchPasses             :: [Pass t lp]           -- ^ List of primary passes
    , tchLodIndex           :: Int              -- ^ LOD level
    , tchSchemeIndex        :: Int              -- ^ Scheme index, derived from scheme name but the names are held on MaterialManager, for speed an index is used here.
    , tchName               :: String           -- ^ optional name for the technique
    , tchGPUVendorRules     :: [GPUVendorRule]
    , tchGPUDeviceNameRules :: [GPUDeviceNameRule]
    }