summaryrefslogtreecommitdiff
path: root/CubeMap.hs
blob: e71892a5144f82d917939e94a3b1b2479ac58fff (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
module CubeMap
    ( loadSkyboxes
    , Skyboxes(..)
    , cubeMesh
    ) where

import LambdaCube.GL as LC
import LambdaCube.GL.Data (uploadCubeMapToGPU)
import LambdaCube.GL.Mesh as LC

import Control.DeepSeq
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
                putStrLn $ "Loading skybox " ++ show n ++ ": " ++ fn ++ "..."
                archive <- toArchive <$> Lazy.readFile (dir </> fn)
                let es = mapMaybe (`findEntryByPath` archive) $ filterImageNames (filesInArchive archive)
                imgs <- fmap sequence $ forM es $ \entry -> do
                    return $ Juicy.decodeImage $ Lazy.toStrict $ fromEntry entry
                deepseq imgs $ putStrLn $ "Finished loading skybox " ++ show n ++ ": " ++ fn ++ "."
                return imgs
        }
    `catchIOError` \e -> do
        hPutStrLn stderr $ unlines
            [ "Unable to load skybox."
            , "Download one of the .zip archive at 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
            ]
        }