summaryrefslogtreecommitdiff
path: root/CubeMap.hs
diff options
context:
space:
mode:
Diffstat (limited to 'CubeMap.hs')
-rw-r--r--CubeMap.hs72
1 files changed, 72 insertions, 0 deletions
diff --git a/CubeMap.hs b/CubeMap.hs
new file mode 100644
index 0000000..337881f
--- /dev/null
+++ b/CubeMap.hs
@@ -0,0 +1,72 @@
1module CubeMap
2 ( loadSkyboxes
3 , Skyboxes(..)
4 ) where
5
6import LambdaCube.GL as LC
7import LambdaCube.GL.Mesh as LC
8import LambdaCube.GL.Data (uploadCubeMapToGPU)
9
10import Data.Maybe
11import Control.Monad
12import Data.List
13import System.Directory
14import System.FilePath
15import Codec.Archive.Zip
16import qualified Data.ByteString.Lazy as Lazy
17import Codec.Picture as Juicy
18
19image_names_xyz_dir :: [String]
20image_names_xyz_dir =
21 [ "xforward"
22 , "xreverse"
23 , "yforward"
24 , "yreverse"
25 , "zforward"
26 , "zreverse" ]
27
28image_names_np_xyz :: [String]
29image_names_np_xyz =
30 [ "negx"
31 , "negy"
32 , "negz"
33 , "posx"
34 , "posy"
35 , "posz" ]
36
37
38filterImageNames :: [String] -> [String]
39filterImageNames fns = map snd $ sortOn fst
40 $ go (zip [0..] image_names_xyz_dir)
41 (zip [1,3,5,0,2,4] image_names_np_xyz)
42 $ sort fns
43 where
44 go ((n,x):xs) ys (fn:fns) | x `isPrefixOf` fn = (n,fn) : go xs ys fns
45 go xs ((n,y):ys) (fn:fns) | y `isPrefixOf` fn = (n,fn) : go xs ys fns
46 go xs ys ( _:fns) = go xs ys fns
47 go xs ys [] = []
48
49
50data Skyboxes = Skyboxes
51 { skyboxCount :: Int
52 , skyboxNames :: [String]
53 , skyboxLoad :: Int -> IO (Either String [DynamicImage])
54 }
55
56loadSkyboxes :: IO Skyboxes
57loadSkyboxes = do
58 let dir = "./skyboxes"
59 zips <- listDirectory dir
60 let len = length zips
61 return Skyboxes
62 { skyboxCount = len
63 , skyboxNames = zips
64 , skyboxLoad = \n -> do
65 let fn = zips !! mod n len
66 archive <- toArchive <$> Lazy.readFile (dir </> fn)
67 let es = mapMaybe (`findEntryByPath` archive) $ filterImageNames (filesInArchive archive)
68 imgs <- forM es $ \entry -> do
69 return $ Juicy.decodeImage $ Lazy.toStrict $ fromEntry entry
70 return $ sequence imgs
71 }
72