diff options
author | Joe Crayne <joe@jerkface.net> | 2019-06-18 19:07:49 -0400 |
---|---|---|
committer | Joe Crayne <joe@jerkface.net> | 2019-06-18 19:16:30 -0400 |
commit | 4e615656484dfe4347b0a2ccbdf38c2e609162df (patch) | |
tree | 35f3357c4b19a120aa90afa00b950b1e0c75ca1c | |
parent | 811dec27f1ca7eedca4dc25c100da51659639c8f (diff) |
More verbose file loading.
-rw-r--r-- | CubeMap.hs | 9 | ||||
-rw-r--r-- | MeshSketch.hs | 23 | ||||
-rw-r--r-- | lambda-gtk.cabal | 2 |
3 files changed, 28 insertions, 6 deletions
@@ -8,6 +8,7 @@ import LambdaCube.GL as LC | |||
8 | import LambdaCube.GL.Data (uploadCubeMapToGPU) | 8 | import LambdaCube.GL.Data (uploadCubeMapToGPU) |
9 | import LambdaCube.GL.Mesh as LC | 9 | import LambdaCube.GL.Mesh as LC |
10 | 10 | ||
11 | import Control.DeepSeq | ||
11 | import Codec.Archive.Zip | 12 | import Codec.Archive.Zip |
12 | import Codec.Picture as Juicy | 13 | import Codec.Picture as Juicy |
13 | import Control.Monad | 14 | import Control.Monad |
@@ -68,16 +69,18 @@ loadSkyboxes = do | |||
68 | , skyboxNames = zips | 69 | , skyboxNames = zips |
69 | , skyboxLoad = \n -> do | 70 | , skyboxLoad = \n -> do |
70 | let fn = zips !! mod n len | 71 | let fn = zips !! mod n len |
72 | putStrLn $ "Loading skybox " ++ show n ++ ": " ++ fn ++ "..." | ||
71 | archive <- toArchive <$> Lazy.readFile (dir </> fn) | 73 | archive <- toArchive <$> Lazy.readFile (dir </> fn) |
72 | let es = mapMaybe (`findEntryByPath` archive) $ filterImageNames (filesInArchive archive) | 74 | let es = mapMaybe (`findEntryByPath` archive) $ filterImageNames (filesInArchive archive) |
73 | imgs <- forM es $ \entry -> do | 75 | imgs <- fmap sequence $ forM es $ \entry -> do |
74 | return $ Juicy.decodeImage $ Lazy.toStrict $ fromEntry entry | 76 | return $ Juicy.decodeImage $ Lazy.toStrict $ fromEntry entry |
75 | return $ sequence imgs | 77 | deepseq imgs $ putStrLn $ "Finished loading skybox " ++ show n ++ ": " ++ fn ++ "." |
78 | return imgs | ||
76 | } | 79 | } |
77 | `catchIOError` \e -> do | 80 | `catchIOError` \e -> do |
78 | hPutStrLn stderr $ unlines | 81 | hPutStrLn stderr $ unlines |
79 | [ "Unable to load skybox." | 82 | [ "Unable to load skybox." |
80 | , "Download a .zip archive from http://www.humus.name/index.php?page=Textures&start=0" | 83 | , "Download one of the .zip archive at http://www.humus.name/index.php?page=Textures&start=0" |
81 | , "and save it into the ./skyboxes directory." | 84 | , "and save it into the ./skyboxes directory." |
82 | ] | 85 | ] |
83 | return Skyboxes | 86 | return Skyboxes |
diff --git a/MeshSketch.hs b/MeshSketch.hs index 167a5fd..8c18b67 100644 --- a/MeshSketch.hs +++ b/MeshSketch.hs | |||
@@ -52,6 +52,8 @@ import qualified Graphics.Rendering.OpenGL as GL | |||
52 | import Data.Char | 52 | import Data.Char |
53 | import Text.Printf | 53 | import Text.Printf |
54 | import qualified Foreign.C.Types | 54 | import qualified Foreign.C.Types |
55 | import System.FilePath | ||
56 | import System.Directory | ||
55 | 57 | ||
56 | import CubeMap | 58 | import CubeMap |
57 | import GLWidget (nullableContext, withCurrentGL) | 59 | import GLWidget (nullableContext, withCurrentGL) |
@@ -178,9 +180,10 @@ uploadState :: MeshData -> MeshSketch -> GLStorage -> IO State | |||
178 | uploadState obj mm storage = do | 180 | uploadState obj mm storage = do |
179 | let glarea = mmWidget mm | 181 | let glarea = mmWidget mm |
180 | -- load OBJ geometry and material descriptions | 182 | -- load OBJ geometry and material descriptions |
181 | let workarea = BoundingBox (-1.5) (1.5) (-1.5) 1.5 (-1.5) (1.5) | 183 | let workarea = BoundingBox (-2.5) (2.5) (-2.5) 2.5 (-2.5) (2.5) |
182 | mtlLib = snd obj | 184 | mtlLib = snd obj |
183 | (objMesh,objscale) <- uploadOBJToGPU (Just workarea) obj | 185 | (objMesh,objscale) <- uploadOBJToGPU (Just workarea) obj |
186 | putStrLn $ "Using object scale:\n" ++ show objscale | ||
184 | -- load materials textures | 187 | -- load materials textures |
185 | gpuMtlLib <- uploadMtlLib mtlLib | 188 | gpuMtlLib <- uploadMtlLib mtlLib |
186 | -- add OBJ to pipeline input | 189 | -- add OBJ to pipeline input |
@@ -310,14 +313,27 @@ data Realized = Realized | |||
310 | , stSigs :: [SignalHandlerId] -- Signals attached by onRealize. | 313 | , stSigs :: [SignalHandlerId] -- Signals attached by onRealize. |
311 | } | 314 | } |
312 | 315 | ||
316 | findModule :: FilePath -> IO FilePath | ||
317 | findModule fn = do | ||
318 | let checkPath action next = do | ||
319 | path <- action | ||
320 | let f = path </> fn | ||
321 | found <- doesFileExist f | ||
322 | if found then return f | ||
323 | else next | ||
324 | foldr checkPath (return fn) [getExecutablePath,getCurrentDirectory] | ||
325 | |||
313 | new :: IO Gtk.Paned | 326 | new :: IO Gtk.Paned |
314 | new = do | 327 | new = do |
315 | putStrLn "new!" | 328 | putStrLn "new!" |
316 | m <- do | 329 | m <- do |
317 | objName <- head . (++ ["cube.obj"]) <$> getArgs | 330 | objName <- head . (++ ["cube.obj"]) <$> getArgs |
331 | putStrLn $ "Loading object "++objName++"..." | ||
318 | mobj <- loadOBJ objName | 332 | mobj <- loadOBJ objName |
333 | putStrLn $ "Finisehd loading object "++objName++"." | ||
319 | -- mpipeline <- (\s -> return (Right (DynamicPipeline savedPipeline (makeSchema s)))) $ do | 334 | -- mpipeline <- (\s -> return (Right (DynamicPipeline savedPipeline (makeSchema s)))) $ do |
320 | mpipeline <- loadPipeline "hello_obj2.json" $ do | 335 | ppath <- findModule "hello_obj2.json" |
336 | mpipeline <- loadPipeline ppath $ do | ||
321 | defObjectArray "SkyCube" Triangles $ do | 337 | defObjectArray "SkyCube" Triangles $ do |
322 | "position" @: Attribute_V3F | 338 | "position" @: Attribute_V3F |
323 | defObjectArray "objects" Triangles $ do | 339 | defObjectArray "objects" Triangles $ do |
@@ -870,6 +886,9 @@ onEvent mm realized ev = do | |||
870 | "CubeMap" @= return skybox_id | 886 | "CubeMap" @= return skybox_id |
871 | writeIORef (stSkyTexture st) skybox_id | 887 | writeIORef (stSkyTexture st) skybox_id |
872 | put (skyboxNames (stSkyboxes st) !! idx) | 888 | put (skyboxNames (stSkyboxes st) !! idx) |
889 | mwin <- widgetGetWindow w | ||
890 | forM_ mwin $ \win -> | ||
891 | windowInvalidateRect win Nothing False | ||
873 | return () | 892 | return () |
874 | KEY_F -> do | 893 | KEY_F -> do |
875 | put 'F' | 894 | put 'F' |
diff --git a/lambda-gtk.cabal b/lambda-gtk.cabal index 08e9ff2..24340d8 100644 --- a/lambda-gtk.cabal +++ b/lambda-gtk.cabal | |||
@@ -55,7 +55,7 @@ executable meshsketch | |||
55 | other-extensions: OverloadedLabels, OverloadedLists, OverloadedStrings | 55 | other-extensions: OverloadedLabels, OverloadedLists, OverloadedStrings |
56 | build-depends: base, containers >=0.5 && <0.6, bytestring >=0.10 && <0.11, | 56 | build-depends: base, containers >=0.5 && <0.6, bytestring >=0.10 && <0.11, |
57 | vector, aeson, JuicyPixels, text, contravariant, hmatrix, | 57 | vector, aeson, JuicyPixels, text, contravariant, hmatrix, |
58 | zip-archive, filepath, directory, dependent-sum, pretty-show, | 58 | zip-archive, filepath, directory, dependent-sum, pretty-show, deepseq, |
59 | -- todo: factor this next dependency into patch against lambdacube-gl | 59 | -- todo: factor this next dependency into patch against lambdacube-gl |
60 | OpenGLRaw, | 60 | OpenGLRaw, |
61 | -- writer monad | 61 | -- writer monad |