diff options
-rw-r--r-- | CubeMap.hs | 14 | ||||
-rw-r--r-- | MeshSketch.hs | 30 |
2 files changed, 32 insertions, 12 deletions
@@ -18,6 +18,8 @@ import Data.Maybe | |||
18 | import qualified Data.Vector as V | 18 | import qualified Data.Vector as V |
19 | import System.Directory | 19 | import System.Directory |
20 | import System.FilePath | 20 | import System.FilePath |
21 | import System.IO | ||
22 | import System.IO.Error | ||
21 | 23 | ||
22 | image_names_xyz_dir :: [String] | 24 | image_names_xyz_dir :: [String] |
23 | image_names_xyz_dir = | 25 | image_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 | ||
76 | cubeMesh :: Mesh | 90 | cubeMesh :: Mesh |
77 | cubeMesh = Mesh | 91 | 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 | |||
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 |