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
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
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
case takeExtension n of
".material" -> do
putStrLn $ "ResourceLibrary " ++ "load: " ++ n
f <- loadFun n
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
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]
}
}