graphics-formats-collada 0.1.0 → 0.2.0

raw patch · 5 files changed

+34/−16 lines, 5 files

Files

• Graphics/Formats/Collada.hs +1/−1
• Graphics/Formats/Collada/Objects.hs +15/−4
• Graphics/Formats/Collada/Render.hs +8/−4
• graphics-formats-collada.cabal +1/−1
• sample.hs +9/−6

@@ -16,7 +16,7 @@ load config contents = do     case parseCollada contents of         Nothing -> fail "Parse error"-        Just (mainid, dict) -> compile dict (textureLoader config) mainid+        Just model -> compile (textureLoader config) model  defaultConfig :: Config defaultConfig = Config {

@@ -1,6 +1,6 @@ module Graphics.Formats.Collada.Objects     ( Dict, ID-    , Object(..), Matrix(..)+    , Model(..), Object(..), Matrix(..)     , Accessor(..), Input(..), InputSemantic(..), Primitive(..)     , Mesh(..), Parameter(..), Technique(..)     , ColorOrTexture(..), Node(..), NodeRef(..), NodeInstance(..)@@ -24,6 +24,12 @@ type Dict = Map.Map ID Object type ID = String +data Model+    = Model { modelScale :: GL.GLfloat+            , modelScene :: ID+            , modelDict :: Dict+            }+ data Object     = OVisualScene [NodeRef]     | OFloatArray [GL.GLfloat]@@ -102,11 +108,16 @@     = MaterialBinding String ID String String -- symbol target semantic input_semantic     deriving Show -parseCollada :: String -> Maybe (ID, Dict)+parseCollada :: String -> Maybe Model parseCollada = listToMaybe . LA.runLA (mainA <<< X.parseXmlDoc <<^ (\x -> ("<stdin>", x))) -mainA :: LA.LA X.XmlTree (ID, Dict)-mainA = mainScene &&& (Map.unions .< X.multi objects) <<< X.hasName "COLLADA"+mainA :: LA.LA X.XmlTree Model+mainA = massage ^<< mainScale &&& mainScene &&& (Map.unions .< X.multi objects) <<< X.hasName "COLLADA"+    where+    massage (x,(y,z)) = Model x y z++mainScale :: LA.LA X.XmlTree GL.GLfloat+mainScale = read ^<< X.getAttrValue0 "meter" <<< child (X.hasName "unit") <<< child (X.hasName "asset")  infixr 1 .< (.<) = flip (X.>.)

@@ -67,11 +67,15 @@ loadTexture :: String -> CompileM GL.TextureObject loadTexture s = CompileM $ liftIO . ($ s) =<< asks envLoader -compile :: O.Dict -> (String -> IO (GL.TextureObject)) -> O.ID -> IO (IO ())-compile dict loader mainid = do-    runDrawM <$> evalStateT (runReaderT (runCompileM (compileVisualScene mainid)) initEnv) Map.empty+compile :: (String -> IO (GL.TextureObject)) -> O.Model -> IO (IO ())+compile loader model = do+    scale . runDrawM <$> evalStateT (runReaderT (runCompileM (compileVisualScene (O.modelScene model))) initEnv) Map.empty     where-    initEnv = CompileEnv { envDict = dict, envBindings = Map.empty, envLoader = loader }+    initEnv = CompileEnv { envDict = O.modelDict model, envBindings = Map.empty, envLoader = loader }++    scale action = GL.preservingMatrix $ do+        let s = O.modelScale model in GL.scale s s s+        action  compileArray :: O.ID -> CompileM (Ptr GL.GLfloat) compileArray = cached go

@@ -7,7 +7,7 @@ -- The package version. See the Haskell package versioning policy -- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for -- standards guiding when and how versions should be incremented.-Version:             0.1.0+Version:             0.2.0  -- A short (one-line) description of the package. Synopsis:            Load 3D geometry in the COLLADA format

@@ -33,22 +33,25 @@     action <- Collada.load Collada.defaultConfig =<< getContents     putStrLn "Done" +    GL.matrixMode GL.$= GL.Projection+    GL.loadIdentity+    GLU.perspective 45 1 1 1000+    GL.matrixMode GL.$= GL.Modelview 0+    GL.loadIdentity+     GL.lighting GL.$= GL.Enabled     GL.light (GL.Light 0) GL.$= GL.Enabled-    GL.position (GL.Light 0) GL.$= GL.Vertex4 0 0 0 1+    GL.position (GL.Light 0) GL.$= GL.Vertex4 0 0 10 1     GL.depthFunc GL.$= Nothing     GL.depthFunc GL.$= Just GL.Lequal     GL.depthMask GL.$= GL.Enabled+    GL.normalize GL.$= GL.Enabled      GLUT.displayCallback GLUT.$= (do         GL.clearColor GL.$= GL.Color4 0 0 0 0         GL.clear [GL.ColorBuffer, GL.DepthBuffer]         GL.preservingMatrix $ do-            GL.matrixMode GL.$= GL.Projection             GL.loadIdentity-            GLU.perspective 45 1 1 10000-            GL.matrixMode GL.$= GL.Modelview 0-            GL.loadIdentity             GLU.lookAt (uncurry3 GL.Vertex3 eye) (uncurry3 GL.Vertex3 object) (uncurry3 GL.Vector3 up)             GL.renderPrimitive GL.Lines $ do                 vertex (-200) 0 0@@ -62,7 +65,7 @@     GLUT.mainLoop      where-    eye = (200, 200, 200)+    eye = (10, 10, 10)     object = (0, 0, 0)     up = normalized $ (object ^-^ eye) `cross` ((object ^-^ eye) `cross` (0,0,-1))     cross (bx,by,bz) (cx,cy,cz) = (by*cz - cy*bz, bz*cx - bx*cz, bx*cy - by*cx)