module Graphics.LambdaCube.Resource where

import Control.Monad
import Control.Monad.Trans
import System.Directory
import System.FilePath
import Data.List
import qualified Data.Map as Map
import Data.Maybe
import Control.Applicative

import Codec.Archive.Zip
import qualified Data.ByteString.Internal as SB
import qualified Data.ByteString.Lazy as LB

import Graphics.LambdaCube.Compositor
import Graphics.LambdaCube.GpuProgram
import Graphics.LambdaCube.Loader.CompositorScript
import Graphics.LambdaCube.Loader.MaterialScript
import Graphics.LambdaCube.Loader.ResourceScript
import Graphics.LambdaCube.Material
import Graphics.LambdaCube.RenderSystem
import Graphics.LambdaCube.Texture
import Graphics.LambdaCube.Utility
import Graphics.LambdaCube.World

-- load resources into resource library (initResources :: [ResourceGroup] -> ResourceLibrary)

{-
    Stores data about:
      - loaded meshes (name)
      - loaded and compiled materials (name)
-}

-- TODO: load all available materials
-- scan path tree searching for *.material files
data (Texture t, GpuProgram p, LinkedGpuProgram lp) => ResourceItem t p lp
    = RI_Material   (String,Material t lp)
    | RI_GpuProgram (String,GpuProgramDescriptor p)
    | RI_Compositor (String,Compositor t lp)

addConfig :: RenderSystem r vb ib q t p lp => FilePath -> LCM (World r vb ib q t p lp) e ()
addConfig cfgFile = do
    Just rp <- liftIO $ loadResourcesCfg cfgFile
    addResourceLibrary rp

-- TODO: LCMify

-- | Add a resource library (essentially a collection of paths) to the
-- current set of search paths stored in the world.
addResourceLibrary :: RenderSystem r vb ib q t p lp => [ResourceGroup] -> LCM (World r vb ib q t p lp) e ()
addResourceLibrary resPath = do
    world <- peekLCM
    let res = wrResource world
        loadResGrp s (_,l) = foldM' loadRes s l
        loadRes l (PathZip,n) = do
            ok <- doesFileExist n
            case ok of
                True  -> do
                    a <- toArchive <$> LB.readFile n
                    foldM' (loadItem (\fn -> return $ fromEntry $ fromJust $ findEntryByPath fn a)) l $ filesInArchive a
                False -> return l
        loadRes l (PathDir,n) = do
            ok <- doesDirectoryExist n
            case ok of
                True  -> do
                    c <- getDirectoryContents n
                    foldM' (loadItem (\fn -> LB.readFile $ n ++ "/" ++ fn)) l c
                False -> return l
        loadItem loadFun l n = do
            --parseMaterial -> Maybe (mats,verts,frags)
            case takeExtension n of
                ".material" -> do
                    putStrLn $ "ResourceLibrary " ++ "load: " ++ n
                    f <- loadFun n -- FIXME: this is temporary solution
                    mb <- parseMaterial n $ map SB.w2c $ LB.unpack f
                    case mb of
                        Nothing   -> do
                            putStrLn $ "ResourceLibrary " ++ "Syntax error in file " ++ n
                            return l
                        Just (ml,vpl,fpl) -> do
                            let ms = [RI_Material (mtName m,m) | m <- ml]
                                vs = [RI_GpuProgram (gpdName m,m) | m <- vpl]
                                fs = [RI_GpuProgram (gpdName m,m) | m <- fpl]
                            return $ l ++ ms ++ vs ++ fs
                ".compositor" -> do
                    putStrLn $ "ResourceLibrary " ++ "load: " ++ n
                    f <- loadFun n -- FIXME: this is temporary solution
                    mb <- parseCompositor n $ map SB.w2c $ LB.unpack f
                    case mb of
                        Nothing   -> do
                            putStrLn $ "ResourceLibrary " ++ "Syntax error in file " ++ n
                            return l
                        Just cl -> do
                            return $ l ++ [RI_Compositor (cmpName m,m) | m <- cl]
                _ -> return l
        insertList = foldl' (flip (uncurry Map.insert))
    l <- liftIO $ foldM' loadResGrp [] resPath
    pokeLCM $ world
        { wrResource = res
              { rlResourceGroups = resPath ++ rlResourceGroups res
              , rlMaterialMap    = insertList (rlMaterialMap res)   [m | (RI_Material m) <- l]
              , rlGpuProgramMap  = insertList (rlGpuProgramMap res) [m | (RI_GpuProgram m) <- l]
              , rlCompositorMap  = insertList (rlCompositorMap res) [m | (RI_Compositor m) <- l]
              }
        }