diff options
Diffstat (limited to 'MeshSketch.hs')
-rw-r--r-- | MeshSketch.hs | 23 |
1 files changed, 21 insertions, 2 deletions
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' |