summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJoe Crayne <joe@jerkface.net>2019-05-02 18:31:03 -0400
committerJoe Crayne <joe@jerkface.net>2019-05-02 18:31:03 -0400
commitd78081b4c9486a7b1ef4211a175bf4f32e66d1f8 (patch)
tree7f85342823083e1a7438765178b163dbf6a9edd7
parent44ec6fa45b71d95650d05ea4e16550698ca7fb93 (diff)
Cope with missing skybox.
-rw-r--r--CubeMap.hs14
-rw-r--r--MeshSketch.hs30
2 files changed, 32 insertions, 12 deletions
diff --git a/CubeMap.hs b/CubeMap.hs
index 10ba9e0..cfa6b0d 100644
--- a/CubeMap.hs
+++ b/CubeMap.hs
@@ -18,6 +18,8 @@ import Data.Maybe
18import qualified Data.Vector as V 18import qualified Data.Vector as V
19import System.Directory 19import System.Directory
20import System.FilePath 20import System.FilePath
21import System.IO
22import System.IO.Error
21 23
22image_names_xyz_dir :: [String] 24image_names_xyz_dir :: [String]
23image_names_xyz_dir = 25image_names_xyz_dir =
@@ -72,6 +74,18 @@ loadSkyboxes = do
72 return $ Juicy.decodeImage $ Lazy.toStrict $ fromEntry entry 74 return $ Juicy.decodeImage $ Lazy.toStrict $ fromEntry entry
73 return $ sequence imgs 75 return $ sequence imgs
74 } 76 }
77 `catchIOError` \e -> do
78 hPutStrLn stderr $ unlines
79 [ "Unable to load skybox."
80 , "Download a .zip archive from http://www.humus.name/index.php?page=Textures&start=0"
81 , "and save it into the ./skyboxes directory."
82 ]
83 return Skyboxes
84 { skyboxCount = 1
85 , skyboxNames = ["(null)"]
86 , skyboxLoad = \_ -> do
87 return $ Left (show e)
88 }
75 89
76cubeMesh :: Mesh 90cubeMesh :: Mesh
77cubeMesh = Mesh 91cubeMesh = Mesh
diff --git a/MeshSketch.hs b/MeshSketch.hs
index 02ba53a..440a2f7 100644
--- a/MeshSketch.hs
+++ b/MeshSketch.hs
@@ -132,10 +132,15 @@ uploadState obj glarea storage = do
132 toggle <- mkFullscreenToggle parent 132 toggle <- mkFullscreenToggle parent
133 skyboxes <- loadSkyboxes 133 skyboxes <- loadSkyboxes
134 skybox <- newIORef 0 134 skybox <- newIORef 0
135 Right ts <- skyboxLoad skyboxes 0 135 skybox_id <- skyboxLoad skyboxes 0 >>= \case
136 skybox_id <- uploadCubeMapToGPU ts 136 Right ts -> do
137 LC.updateUniforms storage $ do 137 skybox_id <- uploadCubeMapToGPU ts
138 "CubeMap" @= return skybox_id 138 LC.updateUniforms storage $ do
139 "CubeMap" @= return skybox_id
140 return skybox_id
141 Left msg -> do
142 putStrLn msg
143 return (TextureData 0)
139 skytex <- newIORef skybox_id 144 skytex <- newIORef skybox_id
140 mi <- LC.uploadMeshToGPU cubeMesh 145 mi <- LC.uploadMeshToGPU cubeMesh
141 LC.addMeshToObjectArray storage "SkyCube" [] mi 146 LC.addMeshToObjectArray storage "SkyCube" [] mi
@@ -457,14 +462,15 @@ onEvent w realized ev = do
457 KEY_N -> do 462 KEY_N -> do
458 modifyIORef' (stSkybox st) $ \n -> (n + 1) `mod` (skyboxCount $ stSkyboxes st) 463 modifyIORef' (stSkybox st) $ \n -> (n + 1) `mod` (skyboxCount $ stSkyboxes st)
459 idx <- readIORef (stSkybox st) 464 idx <- readIORef (stSkybox st)
460 Right ts <- skyboxLoad (stSkyboxes st) idx 465 when (skyboxCount (stSkyboxes st) > 1) $ do
461 disposeTexture =<< readIORef (stSkyTexture st) 466 Right ts <- skyboxLoad (stSkyboxes st) idx
462 skybox_id <- uploadCubeMapToGPU ts 467 disposeTexture =<< readIORef (stSkyTexture st)
463 LC.updateUniforms (stStorage realized) $ do 468 skybox_id <- uploadCubeMapToGPU ts
464 "CubeMap" @= return skybox_id 469 LC.updateUniforms (stStorage realized) $ do
465 writeIORef (stSkyTexture st) skybox_id 470 "CubeMap" @= return skybox_id
466 put (skyboxNames (stSkyboxes st) !! idx) 471 writeIORef (stSkyTexture st) skybox_id
467 return () 472 put (skyboxNames (stSkyboxes st) !! idx)
473 return ()
468 KEY_F -> do 474 KEY_F -> do
469 put 'F' 475 put 'F'
470 stFullscreen st 476 stFullscreen st