{-# LANGUAGE ForeignFunctionInterface, DeriveDataTypeable  #-}

module Bindings.GLPng ( PngInfo(..)
                      , Mipmap(..)
                      , Trans (..)
                      , pngBind
                      ) where

import Data.Generics

import Foreign.C.String (CString, withCString)
import Foreign.C.Types
import Foreign.Marshal.Alloc (alloca)
import Foreign.Ptr
import Foreign.Storable

import Graphics.Rendering.OpenGL.GL.Texturing.Parameters (Repetition(..), Clamping(..), TextureFilter(..), MinificationFilter, MagnificationFilter)


#include <GL/gl.h>
#include <GL/glpng.h>


data PngInfo = PngInfo
    { pngWidth  :: !CUInt
    , pngHeight :: !CUInt
    , pngDepth  :: !CUInt
    , pngAlpha  :: !CUInt
    } deriving (Eq, Ord, Show, Typeable)

instance Storable PngInfo where
    sizeOf _ = (#size pngInfo)
    alignment _ = alignment (undefined :: CUInt)
    
    peek pi = do
      w <- (#peek pngInfo, Width) pi
      h <- (#peek pngInfo, Height) pi
      d <- (#peek pngInfo, Depth) pi
      a <- (#peek pngInfo, Alpha) pi
      
      return (PngInfo w h d a)
    
    poke pi (PngInfo w h d a) = do
                            (#poke pngInfo, Width) pi w
                            (#poke pngInfo, Height) pi h
                            (#poke pngInfo, Depth) pi d
                            (#poke pngInfo, Alpha) pi a
    
    


png_NoMipmap :: CInt
png_NoMipmap = (#const PNG_NOMIPMAP)

png_BuildMipmap :: CInt
png_BuildMipmap = (#const PNG_BUILDMIPMAP)

png_SimpleMipmap :: CInt
png_SimpleMipmap = (#const PNG_SIMPLEMIPMAP)


data Mipmap = NoMipmap | BuildMipmap | SimpleMipmap
            deriving (Eq, Show)

marshalMipmap :: Mipmap -> CInt
marshalMipmap m
    | m == NoMipmap     = png_NoMipmap
    | m == BuildMipmap  = png_BuildMipmap
    | m == SimpleMipmap = png_SimpleMipmap


png_Alpha :: CInt
png_Alpha = (#const PNG_ALPHA)

png_Solid :: CInt
png_Solid = (#const PNG_SOLID)

data Trans = Alpha | Solid
           deriving (Eq, Show)

marshalTrans :: Trans -> CInt
marshalTrans t
    | t == Alpha = png_Alpha
    | t == Solid = png_Solid


magToMin :: MagnificationFilter -> MinificationFilter
magToMin magFilter = (magFilter, Nothing)


gl_NEAREST :: CInt
gl_NEAREST = (#const GL_NEAREST)

gl_LINEAR :: CInt
gl_LINEAR = (#const GL_LINEAR)

gl_NEAREST_MIPMAP_NEAREST :: CInt
gl_NEAREST_MIPMAP_NEAREST = (#const GL_NEAREST_MIPMAP_NEAREST)

gl_LINEAR_MIPMAP_NEAREST :: CInt
gl_LINEAR_MIPMAP_NEAREST = (#const GL_LINEAR_MIPMAP_NEAREST)

gl_NEAREST_MIPMAP_LINEAR :: CInt
gl_NEAREST_MIPMAP_LINEAR = (#const GL_NEAREST_MIPMAP_LINEAR)

gl_LINEAR_MIPMAP_LINEAR :: CInt
gl_LINEAR_MIPMAP_LINEAR = (#const GL_LINEAR_MIPMAP_LINEAR)


marshalMinificationFilter :: MinificationFilter -> CInt
marshalMinificationFilter x = fromIntegral $ case x of
   (Nearest, Nothing     ) -> gl_NEAREST
   (Linear', Nothing     ) -> gl_LINEAR
   (Nearest, Just Nearest) -> gl_NEAREST_MIPMAP_NEAREST
   (Linear', Just Nearest) -> gl_LINEAR_MIPMAP_NEAREST
   (Nearest, Just Linear') -> gl_NEAREST_MIPMAP_LINEAR
   (Linear', Just Linear') -> gl_LINEAR_MIPMAP_LINEAR

marshalMagnificationFilter :: MagnificationFilter -> CInt
marshalMagnificationFilter = marshalMinificationFilter . magToMin


gl_CLAMP :: CInt
gl_CLAMP = (#const GL_CLAMP)

gl_REPEAT :: CInt
gl_REPEAT = (#const GL_REPEAT)

gl_CLAMP_TO_EDGE :: CInt
gl_CLAMP_TO_EDGE = (#const GL_CLAMP_TO_EDGE)

gl_CLAMP_TO_BORDER :: CInt
gl_CLAMP_TO_BORDER = (#const GL_CLAMP_TO_BORDER)

gl_MIRRORED_REPEAT :: CInt
gl_MIRRORED_REPEAT = (#const GL_MIRRORED_REPEAT)


marshalTextureWrapMode :: (Repetition, Clamping) -> CInt
marshalTextureWrapMode x = fromIntegral $ case x of
   (Repeated, Clamp) -> gl_CLAMP
   (Repeated, Repeat) -> gl_REPEAT
   (Repeated, ClampToEdge) -> gl_CLAMP_TO_EDGE
   (Repeated, ClampToBorder) -> gl_CLAMP_TO_BORDER
   (Mirrored, Repeat) -> gl_MIRRORED_REPEAT
   _ -> error ("marshalTextureWrapMode: illegal value " ++ show x)

foreign import ccall unsafe "GL/glpng.h pngBind"
        rawPngBind :: CString -> CInt -> CInt -> Ptr PngInfo -> CInt -> CInt -> CInt -> IO CUInt


pngBind :: String -> Mipmap -> Trans -> (Repetition, Clamping) -> MinificationFilter -> MagnificationFilter -> IO (CUInt, PngInfo)
pngBind name mipmap trans wrapst minfilter magfilter = alloca $ \infop -> withCString name $ \cname -> do
                                                         ret <- rawPngBind cname (marshalMipmap mipmap) (marshalTrans trans) infop (marshalTextureWrapMode wrapst)
                                                                          (marshalMinificationFilter minfilter) (marshalMagnificationFilter magfilter)
                                                         info <- peek infop
                                                         return (ret, info)