module CubeMap ( loadSkyboxes , Skyboxes(..) , cubeMesh ) where import LambdaCube.GL as LC import LambdaCube.GL.Data (uploadCubeMapToGPU) import LambdaCube.GL.Mesh as LC import Codec.Archive.Zip import Codec.Picture as Juicy import Control.Monad import qualified Data.ByteString.Lazy as Lazy import Data.List import qualified Data.Map as Map import Data.Maybe import qualified Data.Vector as V import System.Directory import System.FilePath import System.IO import System.IO.Error image_names_xyz_dir :: [String] image_names_xyz_dir = [ "xforward" , "xreverse" , "yforward" , "yreverse" , "zforward" , "zreverse" ] image_names_np_xyz :: [String] image_names_np_xyz = [ "negx" , "negy" , "negz" , "posx" , "posy" , "posz" ] filterImageNames :: [String] -> [String] filterImageNames fns = map snd $ sortOn fst $ go (zip [0..] image_names_xyz_dir) (zip [1,3,5,0,2,4] image_names_np_xyz) $ sort fns where go ((n,x):xs) ys (fn:fns) | x `isPrefixOf` fn = (n,fn) : go xs ys fns go xs ((n,y):ys) (fn:fns) | y `isPrefixOf` fn = (n,fn) : go xs ys fns go xs ys ( _:fns) = go xs ys fns go xs ys [] = [] data Skyboxes = Skyboxes { skyboxCount :: Int , skyboxNames :: [String] , skyboxLoad :: Int -> IO (Either String [DynamicImage]) } loadSkyboxes :: IO Skyboxes loadSkyboxes = do let dir = "./skyboxes" zips <- sort <$> listDirectory dir let len = length zips return Skyboxes { skyboxCount = len , skyboxNames = zips , skyboxLoad = \n -> do let fn = zips !! mod n len archive <- toArchive <$> Lazy.readFile (dir fn) let es = mapMaybe (`findEntryByPath` archive) $ filterImageNames (filesInArchive archive) imgs <- forM es $ \entry -> do return $ Juicy.decodeImage $ Lazy.toStrict $ fromEntry entry return $ sequence imgs } `catchIOError` \e -> do hPutStrLn stderr $ unlines [ "Unable to load skybox." , "Download a .zip archive from http://www.humus.name/index.php?page=Textures&start=0" , "and save it into the ./skyboxes directory." ] return Skyboxes { skyboxCount = 1 , skyboxNames = ["(null)"] , skyboxLoad = \_ -> do return $ Left (show e) } cubeMesh :: Mesh cubeMesh = Mesh { mAttributes = Map.singleton "position" $ A_V3F $ V.fromList [ V3 1 (-1) (-1) -- 0 , V3 1 (-1) 1 -- 1 , V3 1 1 1 -- 2 , V3 1 1 (-1) -- 3 , V3 (-1) (-1) 1 -- 4 , V3 (-1) (-1) (-1) -- 5 , V3 (-1) 1 (-1) -- 6 , V3 (-1) 1 1 -- 7 ] , mPrimitive = P_TrianglesI $ V.fromList [ 0, 1, 2, 2, 3, 0 -- posx , 4, 5, 6, 6, 7, 4 -- negx , 6, 3, 2, 2, 7, 6 -- posy , 4, 1, 0, 0, 5, 4 -- negy , 1, 4, 7, 7, 2, 1 -- posz , 5, 0, 3, 3, 6, 5 -- negz ] }