module Graphics.LambdaCube.Common where

-- | Comparison functions used for the depth/stencil buffer operations
-- and others.
data CompareFunction
    = CMPF_ALWAYS_FAIL
    | CMPF_ALWAYS_PASS
    | CMPF_LESS
    | CMPF_LESS_EQUAL
    | CMPF_EQUAL
    | CMPF_NOT_EQUAL
    | CMPF_GREATER_EQUAL
    | CMPF_GREATER
    deriving (Eq,Ord,Show)

-- | High-level filtering options providing shortcuts to settings the
-- minification, magnification and mip filters.
data TextureFilterOptions
    = TFO_NONE        -- ^ Equal to: min=FO_POINT, mag=FO_POINT, mip=FO_NONE
    | TFO_BILINEAR    -- ^ Equal to: min=FO_LINEAR, mag=FO_LINEAR, mip=FO_POINT
    | TFO_TRILINEAR   -- ^ Equal to: min=FO_LINEAR, mag=FO_LINEAR, mip=FO_LINEAR
    | TFO_ANISOTROPIC -- ^ Equal to: min=FO_ANISOTROPIC, max=FO_ANISOTROPIC, mip=FO_LINEAR
    deriving (Eq,Ord)

data FilterType
    = FT_MIN -- ^ The filter used when shrinking a texture
    | FT_MAG -- ^ The filter used when magnifying a texture
    | FT_MIP -- ^ The filter used when determining the mipmap
    deriving (Eq,Ord)

-- | Filtering options for textures / mipmaps.
data FilterOptions
    = FO_NONE        -- ^ No filtering, used for FILT_MIP to turn off mipmapping
    | FO_POINT       -- ^ Use the closest pixel
    | FO_LINEAR      -- ^ Average of a 2x2 pixel area, denotes bilinear for MIN and MAG, trilinear for MIP
    | FO_ANISOTROPIC -- ^ Similar to FO_LINEAR, but compensates for the angle of the texture plane
    deriving (Eq,Ord)

-- | Light shading modes.
data ShadeOptions
    = SO_FLAT
    | SO_GOURAUD
    | SO_PHONG
    deriving (Eq,Ord)

-- | Fog modes.
data FogMode
    = FOG_NONE      -- ^ No fog. Duh.
    | FOG_EXP       -- ^ Fog density increases  exponentially from the camera (fog = 1/e^(distance * density))
    | FOG_EXP2      -- ^ Fog density increases at the square of FOG_EXP, i.e. even quicker (fog = 1/e^(distance * density)^2)
    | FOG_LINEAR    -- ^ Fog density increases linearly between the start and end distances
    deriving (Eq,Ord)

-- | Hardware culling modes based on vertex winding. This setting applies to how the hardware API culls triangles it is sent.
data CullingMode
    = CULL_NONE             -- ^ Hardware never culls triangles and renders everything it receives.
    | CULL_CLOCKWISE        -- ^ Hardware culls triangles whose vertices are listed clockwise in the view (default).
    | CULL_ANTICLOCKWISE    -- ^ Hardware culls triangles whose vertices are listed anticlockwise in the view.
    deriving (Eq,Ord)

-- | Manual culling modes based on vertex normals.
data ManualCullingMode
    = MANUAL_CULL_NONE  -- ^ No culling so everything is sent to the hardware.
    | MANUAL_CULL_BACK  -- ^ Cull triangles whose normal is pointing away from the camera (default).
    | MANUAL_CULL_FRONT -- ^ Cull triangles whose normal is pointing towards the camera.
    deriving (Eq,Ord)

data WaveformType
    = WFT_SINE             -- ^ Standard sine wave which smoothly changes from low to high and back again.
    | WFT_TRIANGLE         -- ^ An angular wave with a constant increase / decrease speed with pointed peaks.
    | WFT_SQUARE           -- ^ Half of the time is spent at the min, half at the max with instant transition between.
    | WFT_SAWTOOTH         -- ^ Gradual steady increase from min to max over the period with an instant return to min at the end.
    | WFT_INVERSE_SAWTOOTH -- ^ Gradual steady decrease from max to min over the period, with an instant return to max at the end.
    | WFT_PWM              -- ^ Pulse Width Modulation. Works like WFT_SQUARE, except the high to low transition is controlled by duty cycle.
                           --  With a duty cycle of 50% (0.5) will give the same output as WFT_SQUARE.
    deriving (Eq,Ord)

-- | The polygon mode to use when rasterising.
data PolygonMode
    = PM_POINTS     -- ^ Only points are rendered.
    | PM_WIREFRAME  -- ^ Wireframe models are rendered.
    | PM_SOLID      -- ^ Solid polygons are rendered.
    deriving (Eq,Ord)

data TrackVertexColourType
    = TrackVertexColourType
    { tvcAmbient  :: Bool
    , tvcDiffuse  :: Bool
    , tvcSpecular :: Bool
    , tvcEmissive :: Bool
    }
    deriving (Eq,Ord)

-- | Sort mode for billboard-set and particle-system
data SortMode
    = SM_DIRECTION -- ^ Sort by direction of the camera
    | SM_DISTANCE  -- ^ Sort by distance from the camera
    deriving (Eq,Ord)

data FrameBufferType
    = FrameBufferType
    { fbtColour  :: Bool
    , fbtDepth   :: Bool
    , fbtStencil :: Bool
    }
    deriving (Eq,Ord)