module Graphics.LambdaCube.RenderSystem.GL.GLTexture where

import qualified Data.Set as Set
import Data.Maybe
import Control.Monad
import Foreign.Ptr

import Graphics.Rendering.OpenGL (($=))
import qualified Graphics.Rendering.OpenGL as GL
import System.Log.Logger

import Graphics.LambdaCube.Types
import Graphics.LambdaCube.PixelFormat
import Graphics.LambdaCube.Texture
import Graphics.LambdaCube.Image
import Graphics.LambdaCube.HardwareBuffer
import Graphics.LambdaCube.RenderSystemCapabilities
import Graphics.LambdaCube.RenderSystem.GL.GLUtils

data GLTexture
    = GLTexture
    { gltxName                      :: String
    , gltxWidth                     :: Int
    , gltxHeight                    :: Int
    , gltxDepth                     :: Int
    , gltxNumRequestedMipmaps       :: TextureMipmap
    , gltxNumMipmaps                :: Int
    , gltxMipmapsHardwareGenerated  :: Bool
    , gltxGamma                     :: FloatType
    , gltxHwGamma                   :: Bool
    , gltxFSAA                      :: Int
    , gltxFSAAHint                  :: String
    , gltxTextureType               :: TextureType
    , gltxFormat                    :: PixelFormat
    , gltxUsage                     :: TextureUsage
    , gltxSrcFormat                 :: PixelFormat
    , gltxSrcWidth                  :: Int
    , gltxSrcHeight                 :: Int
    , gltxSrcDepth                  :: Int

    , gltxDesiredFormat             :: PixelFormat
    , gltxDesiredIntegerBitDepth    :: Int
    , gltxDesiredFloatBitDepth      :: Int
    , gltxTreatLuminanceAsAlpha     :: Bool
    
    , gltxTextureObject             :: GL.TextureObject
    }

instance Eq GLTexture where
    (==) a b    = gltxTextureObject a == gltxTextureObject b

instance HardwareBuffer GLTexture

instance Texture GLTexture where
    txName                      = gltxName
    txWidth                     = gltxWidth
    txHeight                    = gltxHeight
    txDepth                     = gltxDepth
    txNumRequestedMipmaps       = gltxNumRequestedMipmaps
    txNumMipmaps                = gltxNumMipmaps
    txMipmapsHardwareGenerated  = gltxMipmapsHardwareGenerated
    txGamma                     = gltxGamma
    txHwGamma                   = gltxHwGamma
    txFSAA                      = gltxFSAA
    txFSAAHint                  = gltxFSAAHint
    txTextureType               = gltxTextureType
    txFormat                    = gltxFormat
--    txUsage                     = gltxUsage
    txSrcFormat                 = gltxSrcFormat
    txSrcWidth                  = gltxSrcWidth
    txSrcHeight                 = gltxSrcHeight
    txSrcDepth                  = gltxSrcDepth

    txDesiredFormat             = gltxDesiredFormat
    txDesiredIntegerBitDepth    = gltxDesiredIntegerBitDepth
    txDesiredFloatBitDepth      = gltxDesiredFloatBitDepth
    txTreatLuminanceAsAlpha     = gltxTreatLuminanceAsAlpha

{-
    virtual TexturePtr createManual(const String & name, const String& group,
        TextureType texType, uint width, uint height, uint depth, 
		int num_mips, PixelFormat format, int usage = TU_DEFAULT, ManualResourceLoader* loader = 0,
		bool hwGammaCorrection = false, uint fsaa = 0, const String& fsaaHint = StringUtil::BLANK);
-}
--createTexture                   :: a -> String -> TextureType -> Int -> Int -> Int -> Int -> PixelFormat -> TextueUsage -> Bool -> Int -> String -> IO t
{-
        virtual TexturePtr createManual(const String & name, const String& group,
            TextureType texType, uint width, uint height, uint depth, 
			int num_mips, PixelFormat format, int usage = TU_DEFAULT, ManualResourceLoader* loader = 0,
			bool hwGammaCorrection = false, uint fsaa = 0, const String& fsaaHint = StringUtil::BLANK);
            TextureUsage = bufferUsage::Usage, autoMipmap::Bool, isTarget::Bool
    createTexture                   :: a -> String -> TextureType -> Int -> Int -> Int -> Int -> PixelFormat -> Usage -> Bool -> Bool -> Bool -> Int -> String -> IO t
-}
mkGLTexture :: RenderSystemCapabilities -> String -> TextureType -> Int -> Int -> Int -> TextureMipmap -> PixelFormat -> TextureUsage -> Bool -> Int -> String -> Maybe [Image] -> IO GLTexture
--FIXME: image parameter is temporary!!!!
mkGLTexture rcaps name texType width height depth numMips format usage hwGammaCorrection fsaa fsaaHint mimage = do
    let caps = rscCapabilities rcaps
    debugM "createTexture" $ "create " ++ show texType ++ " texture: " ++ name
    
    when (texType == TEX_TYPE_3D && Set.notMember RSC_TEXTURE_3D caps) $ error "3D Textures not supported before OpenGL 1.2"

    (major,minor) <- GL.get $ GL.majorMinor GL.glVersion

    let glVer a b   = major > a || (major >= a && minor >= b)
        texTarget   = (getGLTextureTarget texType)
        -- Convert to nearest power-of-two size if required
        mWidth      = optionalPO2 rcaps width
        mHeight     = optionalPO2 rcaps height
        mDepth      = optionalPO2 rcaps depth

        -- Adjust format if required
        mFormat     = getNativeFormat texType format False -- TODO

        -- Check requested number of mipmaps
        maxMips     = getMaxMipmaps mWidth mHeight mDepth mFormat
        mNumMipmaps = maxMips -- TODO min maxMips numMips

    -- Generate texture name
    [mTextureID] <- GL.genObjectNames 1 

    -- Set texture type
    GL.textureBinding texTarget $= Just mTextureID
    
    -- This needs to be set otherwise the texture doesn't get rendered
    when (glVer 1 2) $ GL.textureLevelRange texTarget $= (0,fromIntegral mNumMipmaps)
    
    -- Set some misc default parameters so NVidia won't complain, these can of course be changed later
    GL.textureFilter texTarget $= ((GL.Nearest,Nothing),GL.Nearest)

    when (glVer 1 2) $ do
        GL.textureWrapMode texTarget GL.S $= (GL.Repeated, GL.ClampToEdge)
        GL.textureWrapMode texTarget GL.T $= (GL.Repeated, GL.ClampToEdge)

    -- If we can do automip generation and the user desires this, do so
    let mMipmapsHardwareGenerated = Set.member RSC_AUTOMIPMAP caps
    -- FIXME
    {-
		// NVIDIA 175.16 drivers break hardware mip generation for non-compressed
		// textures - disable until fixed
		// Leave hardware gen on compressed textures since that's the only way we
		// can realistically do it since GLU doesn't support DXT
		// However DON'T do this on Apple, their drivers aren't subject to this
		// problem yet and in fact software generation appears to cause a crash 
		// in some cases which I've yet to track down
if OGRE_PLATFORM != OGRE_PLATFORM_APPLE
		if (Root::getSingleton().getRenderSystem()->getCapabilities()->getVendor() == GPU_NVIDIA
			&& !PixelUtil::isCompressed(mFormat))
		{
			mMipmapsHardwareGenerated = false;
		}
endif
    -}
--TODO
    let moreMips = case numMips of
            { MIP_UNLIMITED -> True
            ; MIP_DEFAULT   -> True -- TODO
            ; MIP_NUMBER n  -> n > 0
            }

    when (tuAutoMipmap usage && moreMips && mMipmapsHardwareGenerated) $ GL.generateMipmap texTarget $= GL.Enabled

    -- Allocate internal buffer so that glTexSubImageXD can be used
    -- Internal format
    let format' = getClosestGLInternalFormat mFormat hwGammaCorrection
        isCompressed _ = False -- TODO
    case isCompressed mFormat of
        { True  -> do
        {-
			// Compressed formats
			size_t size = PixelUtil::getMemorySize(mWidth, mHeight, mDepth, mFormat);
			// Provide temporary buffer filled with zeroes as glCompressedTexImageXD does not
			// accept a 0 pointer like normal glTexImageXD
			// Run through this process for every mipmap to pregenerate mipmap piramid
			uint8 *tmpdata = new uint8[size];
			memset(tmpdata, 0, size);
			
			for(size_t mip=0; mip<=mNumMipmaps; mip++)
			{
				size = PixelUtil::getMemorySize(width, height, depth, mFormat);
				switch(mTextureType)
				{
					case TEX_TYPE_1D:
						glCompressedTexImage1DARB(GL_TEXTURE_1D, mip, format', 
							width, 0, 
							size, tmpdata);
						break;
					case TEX_TYPE_2D:
						glCompressedTexImage2DARB(GL_TEXTURE_2D, mip, format',
							width, height, 0, 
							size, tmpdata);
						break;
					case TEX_TYPE_3D:
						glCompressedTexImage3DARB(GL_TEXTURE_3D, mip, format',
							width, height, depth, 0, 
							size, tmpdata);
						break;
					case TEX_TYPE_CUBE_MAP:
						for(int face=0; face<6; face++) {
							glCompressedTexImage2DARB(GL_TEXTURE_CUBE_MAP_POSITIVE_X + face, mip, format',
								width, height, 0, 
								size, tmpdata);
						}
						break;
				};
				if(width>1)		width = width/2;
				if(height>1)	height = height/2;
				if(depth>1)		depth = depth/2;
			}
			delete [] tmpdata;
        -}
            
            -- Compressed formats
            -- Provide temporary buffer filled with zeroes as glCompressedTexImageXD does not
            -- accept a 0 pointer like normal glTexImageXD
            -- TODO: support compressed textures
            {-
            let setMip tmpdata (w,h,d) mip = do
                    -- compressedTexImage1D :: Proxy -> Level -> TextureSize1D -> Border -> CompressedPixelData a -> IO ()
                    -- CompressedPixelData !CompressedTextureFormat GLsizei (Ptr a)
                    let size = getMemorySize w h d mFormat
                    case texType of
                        { TEX_TYPE_1D       -> GL.compressedTexImage1D GL.NoProxy mip (GL.TextureSize1D w) 0 (GL.CompressedPixelData (CompressedTextureFormat ) size tmpdata)
                        ; TEX_TYPE_2D       -> 
                        ; TEX_TYPE_3D       -> 
                        ; TEX_TYPE_CUBE_MAP -> do
                        }
                    return (max 1 (w `div` 2), max 1 (h `div` 2), max 1 (d `div` 2))
                setMips :: Ptr Word8 -> IO ()
                setMips tmpdata = do
                    pokeArray tmpdata $ replicate size 0
                    -- Run through this process for every mipmap to pregenerate mipmap piramid
                    foldM_ (setMip tmpdata) (mWidth,mHeight,mDepth) [0..mNumMipmaps]
            allocaArray (getMemorySize mWidth mHeight mDepth mFormat) setMips
            -}
            return ()
        ; False -> do
            let setMip (w,h,d) mip = do
                    -- Normal formats
                    case texType of
                        { TEX_TYPE_1D       -> GL.texImage1D GL.NoProxy mip format' (GL.TextureSize1D w) 0 (GL.PixelData GL.RGBA GL.UnsignedByte nullPtr)
                        ; TEX_TYPE_2D       -> GL.texImage2D Nothing GL.NoProxy mip format' (GL.TextureSize2D w h) 0 (GL.PixelData GL.RGBA GL.UnsignedByte nullPtr)
                        ; TEX_TYPE_3D       -> GL.texImage3D GL.NoProxy mip format' (GL.TextureSize3D w h d) 0 (GL.PixelData GL.RGBA GL.UnsignedByte nullPtr)
                        ; TEX_TYPE_CUBE_MAP -> do
                            GL.texImage2D (Just GL.TextureCubeMapPositiveX) GL.NoProxy mip format' (GL.TextureSize2D w h) 0 (GL.PixelData GL.RGBA GL.UnsignedByte nullPtr)
                            GL.texImage2D (Just GL.TextureCubeMapNegativeX) GL.NoProxy mip format' (GL.TextureSize2D w h) 0 (GL.PixelData GL.RGBA GL.UnsignedByte nullPtr)
                            GL.texImage2D (Just GL.TextureCubeMapPositiveY) GL.NoProxy mip format' (GL.TextureSize2D w h) 0 (GL.PixelData GL.RGBA GL.UnsignedByte nullPtr)
                            GL.texImage2D (Just GL.TextureCubeMapNegativeY) GL.NoProxy mip format' (GL.TextureSize2D w h) 0 (GL.PixelData GL.RGBA GL.UnsignedByte nullPtr)
                            GL.texImage2D (Just GL.TextureCubeMapPositiveZ) GL.NoProxy mip format' (GL.TextureSize2D w h) 0 (GL.PixelData GL.RGBA GL.UnsignedByte nullPtr)
                            GL.texImage2D (Just GL.TextureCubeMapNegativeZ) GL.NoProxy mip format' (GL.TextureSize2D w h) 0 (GL.PixelData GL.RGBA GL.UnsignedByte nullPtr)
                        }
                    return (max 1 (w `div` 2), max 1 (h `div` 2), max 1 (d `div` 2))
                f = fromIntegral
            -- Run through this process to pregenerate mipmap piramid
            foldM_ setMip (f mWidth,f mHeight,f mDepth) [0..(fromIntegral mNumMipmaps)]
        }

    -- TODO
    -- TEMP CODE
    when (isJust mimage) $ do
        let images = fromJust mimage
            imInfo i = (fmt,f w,f h)
              where
                f   = fromIntegral
                fmt = case imFormat i of
                    { PF_L8         -> GL.Luminance
                    ; PF_BYTE_LA    -> GL.LuminanceAlpha
                    ; PF_R8G8B8     -> GL.RGB
                    ; PF_R8G8B8A8   -> GL.RGBA
                    }
                w   = imWidth i
                h   = imHeight i
            upload2D target i = do
                let (fmt,w,h) = imInfo i
                debugM "createTexture" $ "upload2d: " ++ imName i
                GL.texImage2D target GL.NoProxy 0 format' (GL.TextureSize2D w h) 0 (GL.PixelData fmt GL.UnsignedByte $ imData i)
                
        errl <- GL.get GL.errors
        unless (null errl) $ debugM "createTexture" $ "glerrors: \"" ++ concat [show c ++ " - " ++ m ++ "\n" | GL.Error c m <- errl] ++ "\""
        case texType of
            { TEX_TYPE_1D       -> do
                let (fmt,w,h) = imInfo image
                    image     = head images  
                GL.texImage1D GL.NoProxy 0 format' (GL.TextureSize1D w) 0 (GL.PixelData fmt GL.UnsignedByte $ imData image)
            ; TEX_TYPE_2D       -> upload2D Nothing $ head images
            ; TEX_TYPE_CUBE_MAP -> mapM_ (uncurry upload2D) $ zip [ Just GL.TextureCubeMapPositiveZ -- front
                                                                  , Just GL.TextureCubeMapNegativeZ -- back
                                                                  , Just GL.TextureCubeMapPositiveY -- up
                                                                  , Just GL.TextureCubeMapNegativeY -- down
                                                                  , Just GL.TextureCubeMapNegativeX -- left
                                                                  , Just GL.TextureCubeMapPositiveX -- right
                                                                  ] images
            ; _ -> return ()
            }            
    --_createSurfaceList();

    -- Get final internal format
    -- TODO
    --mFormat = getBuffer(0,0)->getFormat();
    debugM "createTexture" $ "created texture: " ++ name
    return GLTexture
        { gltxName                      = name
        , gltxWidth                     = 0 --TODO
        , gltxHeight                    = 0 --TODO
        , gltxDepth                     = 0 --TODO
        , gltxNumRequestedMipmaps       = MIP_DEFAULT --TODO
        , gltxNumMipmaps                = 0 --TODO
        , gltxMipmapsHardwareGenerated  = True --TODO
        , gltxGamma                     = 0 --TODO
        , gltxHwGamma                   = True --TODO
        , gltxFSAA                      = 0 --TODO
        , gltxFSAAHint                  = "" --TODO
        , gltxTextureType               = texType
        , gltxFormat                    = PF_R8G8B8 -- TODO
        , gltxUsage                     = TextureUsage HBU_WRITE_ONLY False False-- TODO
        , gltxSrcFormat                 = PF_R8G8B8 -- TODO
        , gltxSrcWidth                  = 0 --TODO
        , gltxSrcHeight                 = 0 --TODO
        , gltxSrcDepth                  = 0 --TODO
    
        , gltxDesiredFormat             = PF_R8G8B8 --TODO
        , gltxDesiredIntegerBitDepth    = 0 --TODO
        , gltxDesiredFloatBitDepth      = 0 --TODO
        , gltxTreatLuminanceAsAlpha     = True --TODO
        
        , gltxTextureObject             = mTextureID
        }
{-
	void GLTexture::_createSurfaceList()
	{
		mSurfaceList.clear();
		
		// For all faces and mipmaps, store surfaces as HardwarePixelBufferSharedPtr
		bool wantGeneratedMips = (mUsage & TU_AUTOMIPMAP)!=0;
		
		// Do mipmapping in software? (uses GLU) For some cards, this is still needed. Of course,
		// only when mipmap generation is desired.
		bool doSoftware = wantGeneratedMips && !mMipmapsHardwareGenerated && getNumMipmaps(); 
		
		for(size_t face=0; face<getNumFaces(); face++)
		{
			for(size_t mip=0; mip<=getNumMipmaps(); mip++)
			{
                GLHardwarePixelBuffer *buf = new GLTextureBuffer(mName, getGLTextureTarget(), mTextureID, face, mip,
						static_cast<HardwareBuffer::Usage>(mUsage), doSoftware && mip==0, mHwGamma, mFSAA);
				mSurfaceList.push_back(HardwarePixelBufferSharedPtr(buf));
                
                /// Check for error
                if(buf->getWidth()==0 || buf->getHeight()==0 || buf->getDepth()==0)
                {
                    OGRE_EXCEPT(
                        Exception::ERR_RENDERINGAPI_ERROR, 
                        "Zero sized texture surface on texture "+getName()+
                            " face "+StringConverter::toString(face)+
                            " mipmap "+StringConverter::toString(mip)+
                            ". Probably, the GL driver refused to create the texture.", 
                            "GLTexture::_createSurfaceList");
                }
			}
		}
	}
-}