-- #hide
--------------------------------------------------------------------------------
-- |
-- Module      :  Graphics.Rendering.OGL.GL.Texturing.TexParameter
-- Copyright   :  (c) Sven Panne 2002-2006
-- License     :  BSD-style (see the file libraries/OpenGL/LICENSE)
-- 
-- Maintainer  :  sven.panne@aedion.de
-- Stability   :  stable
-- Portability :  portable
--
-- This is a purely internal module for getting\/setting texture parameters.
--
--------------------------------------------------------------------------------

module Graphics.Rendering.OGL.GL.Texturing.TexParameter (
   TexParameter(..), texParami, texParamf, texParamC4f, getTexParameteri,
   combineTexParams, combineTexParamsMaybe
) where

import Control.Monad ( liftM2 )
import Foreign.Marshal.Alloc ( alloca )
import Foreign.Marshal.Utils ( with )
import Foreign.Storable ( Storable )
import Foreign.Ptr ( Ptr )
import Graphics.Rendering.OGL.Monad
import Graphics.Rendering.OGL.GL.BasicTypes (
   GLint, GLenum, GLfloat, Capability(..) )
import Graphics.Rendering.OGL.GL.PeekPoke ( peek1 )
import Graphics.Rendering.OGL.GL.StateVar (
   getIO, ($$=), StateVar, makeStateVar )
import Graphics.Rendering.OGL.GL.Texturing.TextureTarget (
   TextureTarget(..), marshalTextureTarget )
import Graphics.Rendering.OGL.GL.VertexSpec( Color4(..) )

--------------------------------------------------------------------------------

data TexParameter =
     TextureMinFilter
   | TextureMagFilter
   | TextureWrapS
   | TextureWrapT
   | TextureWrapR
   | TextureBorderColor
   | TextureMinLOD
   | TextureMaxLOD
   | TextureBaseLevel
   | TextureMaxLevel
   | TexturePriority
   | TextureMaxAnisotropy
   | TextureCompare
   | TextureCompareOperator
   | TextureCompareFailValue
   | GenerateMipmap
   | TextureCompareMode
   | TextureCompareFunc
   | DepthTextureMode
   | TextureLODBias
   | TextureResident

marshalTexParameter :: TexParameter -> GLenum
marshalTexParameter x = case x of
   TextureMinFilter -> 0x2801
   TextureMagFilter -> 0x2800
   TextureWrapS -> 0x2802
   TextureWrapT -> 0x2803
   TextureWrapR -> 0x8072
   TextureBorderColor -> 0x1004
   TextureMinLOD -> 0x813A
   TextureMaxLOD -> 0x813B
   TextureBaseLevel -> 0x813C
   TextureMaxLevel -> 0x813D
   TexturePriority -> 0x8066
   TextureMaxAnisotropy -> 0x84FE
   TextureCompare -> 0x819A
   TextureCompareOperator -> 0x819B
   TextureCompareFailValue -> 0x80BF
   GenerateMipmap -> 0x8191
   TextureCompareMode -> 0x884C
   TextureCompareFunc -> 0x884D
   DepthTextureMode -> 0x884B
   TextureLODBias -> 0x8501
   TextureResident -> 0x8067

--------------------------------------------------------------------------------

texParameter :: (GLenum -> GLenum -> b -> IO ())
             -> (a -> (b -> IO ()) -> IO ())
             -> TextureTarget -> TexParameter -> a -> IO ()
texParameter glTexParameter marshalAct t p x =
   marshalAct x $
      glTexParameter (marshalTextureTarget t) (marshalTexParameter p)

foreign import CALLCONV unsafe "glTexParameteri"
   glTexParameteri :: GLenum -> GLenum ->  GLint -> IO ()

foreign import CALLCONV unsafe "glTexParameterf"
   glTexParameterf :: GLenum -> GLenum ->  GLfloat -> IO ()

foreign import CALLCONV unsafe "glTexParameterfv"
   glTexParameterC4f :: GLenum -> GLenum -> Ptr (Color4 GLfloat) -> IO ()

--------------------------------------------------------------------------------

getTexParameter :: Storable b
                => (GLenum -> GLenum -> Ptr b -> IO ())
                -> (b -> a)
                -> TextureTarget -> TexParameter -> IO a
getTexParameter glGetTexParameter unmarshal t p =
   alloca $ \buf -> do
     glGetTexParameter (marshalTextureTarget t) (marshalTexParameter p) buf
     peek1 unmarshal buf

foreign import CALLCONV unsafe "glGetTexParameteriv"
   glGetTexParameteriv :: GLenum -> GLenum -> Ptr GLint -> IO ()

foreign import CALLCONV unsafe "glGetTexParameterfv"
   glGetTexParameterfv :: GLenum -> GLenum -> Ptr GLfloat -> IO ()

foreign import CALLCONV unsafe "glGetTexParameterfv"
   glGetTexParameterC4f :: GLenum -> GLenum -> Ptr (Color4 GLfloat) -> IO ()

--------------------------------------------------------------------------------

m2a :: (a -> b) -> a -> (b -> IO ()) -> IO ()
m2a marshal x act = act (marshal x)

texParami ::
   (GLint -> a) -> (a -> GLint) -> TexParameter -> TextureTarget -> StateVar a
texParami unmarshal marshal p t =
   makeStateVar
      (getTexParameter glGetTexParameteriv unmarshal     t p)
      (texParameter    glTexParameteri     (m2a marshal) t p)

texParamf ::
   (GLfloat -> a) -> (a -> GLfloat) -> TexParameter -> TextureTarget -> StateVar a
texParamf unmarshal marshal p t =
   makeStateVar
      (getTexParameter glGetTexParameterfv unmarshal     t p)
      (texParameter    glTexParameterf     (m2a marshal) t p)

texParamC4f :: TexParameter -> TextureTarget -> StateVar (Color4 GLfloat)
texParamC4f p t =
   makeStateVar
      (getTexParameter glGetTexParameterC4f id   t p)
      (texParameter    glTexParameterC4f    with t p)

getTexParameteri :: (GLint -> a) -> TextureTarget -> TexParameter -> GL a
getTexParameteri a b c = liftIO $ getTexParameter glGetTexParameteriv a b c

--------------------------------------------------------------------------------

combineTexParams :: (TextureTarget -> StateVar a)
                 -> (TextureTarget -> StateVar b)
                 -> (TextureTarget -> StateVar (a,b))
combineTexParams v w t =
   makeStateVar
      (liftM2 (,) (getIO (v t)) (getIO (w t)))
      (\(x,y) -> do v t $$= x; w t $$= y)

combineTexParamsMaybe :: (TextureTarget -> StateVar Capability)
                      -> (TextureTarget -> StateVar a)
                      -> (TextureTarget -> StateVar (Maybe a))
combineTexParamsMaybe enab val t =
   makeStateVar
      (do tcm <- getIO (enab t)
          case tcm of
             Disabled -> return Nothing
             Enabled -> fmap Just $ getIO (val t))
      (maybe (enab t $$= Disabled)
             (\tcf -> do val t $$= tcf
                         enab t $$= Enabled))