From d78081b4c9486a7b1ef4211a175bf4f32e66d1f8 Mon Sep 17 00:00:00 2001
From: Joe Crayne <joe@jerkface.net>
Date: Thu, 2 May 2019 18:31:03 -0400
Subject: Cope with missing skybox.

---
 CubeMap.hs    | 14 ++++++++++++++
 MeshSketch.hs | 30 ++++++++++++++++++------------
 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
 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 =
@@ -72,6 +74,18 @@ loadSkyboxes = 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
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
     toggle <- mkFullscreenToggle parent
     skyboxes <- loadSkyboxes
     skybox <- newIORef 0
-    Right ts <- skyboxLoad skyboxes 0
-    skybox_id <- uploadCubeMapToGPU ts
-    LC.updateUniforms storage $ do
-       "CubeMap" @= return skybox_id
+    skybox_id <- skyboxLoad skyboxes 0 >>= \case
+        Right ts -> do
+            skybox_id <- uploadCubeMapToGPU ts
+            LC.updateUniforms storage $ do
+               "CubeMap" @= return skybox_id
+            return skybox_id
+        Left msg -> do
+            putStrLn msg
+            return (TextureData 0)
     skytex <- newIORef skybox_id
     mi <- LC.uploadMeshToGPU cubeMesh
     LC.addMeshToObjectArray storage "SkyCube" [] mi
@@ -457,14 +462,15 @@ onEvent w realized ev = do
                 KEY_N -> do
                     modifyIORef' (stSkybox st) $ \n -> (n + 1) `mod` (skyboxCount $ stSkyboxes st)
                     idx <- readIORef (stSkybox st)
-                    Right ts <- skyboxLoad (stSkyboxes st) idx
-                    disposeTexture =<< readIORef (stSkyTexture st)
-                    skybox_id <- uploadCubeMapToGPU ts
-                    LC.updateUniforms (stStorage realized) $ do
-                        "CubeMap" @= return skybox_id
-                    writeIORef (stSkyTexture st) skybox_id
-                    put (skyboxNames (stSkyboxes st) !! idx)
-                    return ()
+                    when (skyboxCount (stSkyboxes st) > 1) $ do
+                        Right ts <- skyboxLoad (stSkyboxes st) idx
+                        disposeTexture =<< readIORef (stSkyTexture st)
+                        skybox_id <- uploadCubeMapToGPU ts
+                        LC.updateUniforms (stStorage realized) $ do
+                            "CubeMap" @= return skybox_id
+                        writeIORef (stSkyTexture st) skybox_id
+                        put (skyboxNames (stSkyboxes st) !! idx)
+                        return ()
                 KEY_F -> do
                     put 'F'
                     stFullscreen st
-- 
cgit v1.2.3