Refactored collada loader significantly

basis/collada/collada-docs.factor

@@ -1,7 +1,93 @@
+! Copyright (C) 2010 Erik Charlebois
+! See http://factorcode.org/license.txt for BSD license.
 USING: help.markup help.crossref help.stylesheet help.topics help.syntax
 definitions io prettyprint summary arrays math sequences vocabs strings
-see ;
+see xml.data hashtables ;
 IN: collada
 
 ABOUT: "collada"
 
+ARTICLE: "collada" "Conversion of COLLADA assets"
+"The " { $vocab-link "collada" } " vocabulary implements words for converting COLLADA assets to data suitable for use with OpenGL. See the COLLADA documentation at " { $url "http://collada.org" } "." ;
+
+HELP: model
+{ $class-description "Tuple of a packed attribute buffer, index buffer and vertex format suitable for a single OpenGL draw call." } ;
+
+HELP: source
+{ $class-description "Tuple of a vertex attribute semantic, offset in triangle index buffer and float data for a single vertex attribute." } ;
+
+HELP: up-axis
+{ $description "Dynamically-scoped variable with the up axis of the tags being read." } ;
+
+HELP: unit-ratio
+{ $description "Scaling ratio for the coordinates of the tags being read." } ;
+
+HELP: missing-attr
+{ $description "An error thrown when an attribute is missing from a tag." } ;
+
+HELP: missing-child
+{ $description "An error thrown when a child is missing from a tag." } ;
+
+HELP: string>numbers ( string -- number-seq )
+{ $values { "string" string } { "number-seq" sequence } }
+{ $description "Splits a string on whitespace and converts the elements to a number sequence" } ;
+
+HELP: x-up { $class-description "Right-handed 3D coordinate system where X is up." } ;
+HELP: y-up { $class-description "Right-handed 3D coordinate system where Y is up." } ;
+HELP: z-up { $class-description "Right-handed 3D coordinate system where Z is up." } ;
+
+HELP: >y-up-axis!
+{ $values { "sequence" sequence } { "from-axis" rh-up } { "sequence" sequence } }
+{ $description "Destructively swizzles the first three elements of the input sequence to a right-handed 3D coordinate system where Y is up and returns the modified sequence." } ;
+
+HELP: source>seq
+{ $values { "source-tag" tag } { "up-axis" rh-up } { "scale" number } { "sequence" sequence } }
+{ $description "Convert the " { $emphasis "float_array" } " in a " { $emphasis "source tag" } " to a sequence of number sequences according to the element stride. The values are scaled according to " { $emphasis "scale" } " and swizzled from " { $emphasis "up-axis" } " so that the Y coordinate points up." } ;
+
+HELP: source>pair
+{ $values { "source-tag" tag } { "pair" pair } }
+{ $description "Convert the source tag to an id and number sequence pair." } ;
+
+HELP: mesh>sources
+{ $values { "mesh-tag" tag } { "hashtable" pair } }
+{ $description "Convert the mesh tag's source elements to a hashtable from id to number sequence." } ;
+
+HELP: mesh>vertices
+{ $values { "mesh-tag" tag } { "pair" pair } }
+{ $description "Convert the mesh tag's vertices element to a pair for further lookup in " { $link collect-sources } ". " } ;
+
+HELP: collect-sources
+{ $values { "sources" hashtable } { "vertices" pair } { "inputs" tag sequence } { "soures" sequence } }
+{ $description "Look up the sources for these " { $emphasis "input" } " elements and return a sequence of " { $link source } " tuples." } ;
+
+HELP: group-indices
+{ $values { "index-stride" number } { "triangle-count" number } { indices "sequence" } { "grouped-indices" sequence } }
+{ $description "Groups the index sequence by triangle and then groups each triangle's indices by vertex." } ;
+
+HELP: triangles>numbers
+{ $values { "triangles-tag" tag } { "number-seq" sequence } }
+{ $description "Converts the triangle data in a triangles tag from string form to a sequence of numbers." } ;
+
+HELP: largest-offset+1
+{ $values { "source-seq" sequence } { "largest-offset+1" number } }
+{ $description "Finds the largest offset in the sequence of " { $link source } " tuples and adds 1, which is the index stride for " { $link group-indices } "." } ;
+
+HELP: <model>
+{ $values { "attribute-buffer" sequence } { "index-buffer" sequence } { "sources" sequence } { "model" model } }
+{ $description "Converts the inputs to a form suitable for use with " { $vocab-link "gpu" } " and constructs a " { $link model } "." } ;
+
+HELP: soa>aos
+{ $values { "triangles-indices" sequence } { "sources" sequence } { "attribute-buffer" sequence } { "index-buffer" sequence } }
+{ $description "Swizzles the input sources from a structure of arrays form to an array of structures form and generates a new index buffer." } ;
+
+HELP: triangles>model
+{ $values { "sources" sequence } { "vertices" pair } { "triangles-tag" tag } { "model" model } }
+{ $description "Creates a " { $link model } " tuple from the given triangles tag, source set and vertices pair." } ;
+
+HELP: mesh>triangles
+{ $values { "souces" sequence } { "vertices" pair } { "mesh-tag" tag } { "models" sequence } }
+{ $description "Creates a sequence of models from the triangles in the mesh tag." } ;
+
+HELP: mesh>models
+{ $values { "mesh-tag" tag } { "models" sequence } }
+{ $description "Converts a triangle mesh to a set of models suitable for rendering with OpenGL." } ;

basis/collada/collada.factor

@@ -5,52 +5,45 @@ locals math math.parser sequences sequences.deep
 specialized-arrays.instances.alien.c-types.float
 specialized-arrays.instances.alien.c-types.uint splitting xml
 xml.data xml.traversal math.order
-
+namespaces combinators images gpu.shaders io ;
-combinators
-images
-gpu.shaders
-io prettyprint
-;
 IN: collada
 
 TUPLE: model attribute-buffer index-buffer vertex-format ;
 TUPLE: source semantic offset data ;
 
-:: collect-sources ( sources vertices inputs -- sources )
+SYMBOLS: up-axis unit-ratio ;
-    inputs
+
-    [| input |
+ERROR: missing-attr tag attr ;
-        input "source" attr rest vertices first =
+ERROR: missing-child tag child-name ;
-        [
-            vertices second [| vertex |
-                vertex first
-                input "offset" attr string>number
-                vertex second rest sources at source boa
-            ] map
-        ]
-        [
-            input [ "semantic" attr ]
-                  [ "offset" attr string>number ]
-                  [ "source" attr rest sources at ] tri source boa
-        ] if
-    ] map flatten ;
 
 : string>numbers ( string -- number-seq )
-    " \t\n" split [ string>number ] map ; inline
+    " \t\n" split [ string>number ] map ;
 
-: x/ ( x x -- x ) tag-named ; inline
+: x/ ( tag child-name -- child-tag )
-: x@ ( x x -- x ) attr ; inline
+    [ tag-named ]
-: xt ( x -- x ) children>string ; inline
+    [ rot dup [ drop missing-child ] unless 2nip ]
+    2bi ; inline
 
-: map-tags-named ( tag string quot -- seq )
+: x@ ( tag attr-name -- attr-value )
+    [ attr ]
+    [ rot dup [ drop missing-attr ] unless 2nip ]
+    2bi ; inline
+
+: xt ( tag -- content ) children>string ;
+
+: x* ( tag child-name quot -- seq )
     [ tags-named ] dip map ; inline
 
 SINGLETONS: x-up y-up z-up ;
-GENERIC: up-axis-swizzle! ( from-axis seq -- seq )
+
-M: x-up up-axis-swizzle!
+UNION: rh-up x-up y-up z-up ;
+
+GENERIC: >y-up-axis! ( seq from-axis -- seq )
+M: x-up >y-up-axis!
     drop dup
     [
-        [ 0 swap nth neg ]
+        [ 0 swap nth ]
-        [ 1 swap nth ]
+        [ 1 swap nth neg ]
         [ 2 swap nth ] tri
         swap -rot 
     ] [
@@ -58,13 +51,13 @@ M: x-up up-axis-swizzle!
         [ 1 swap set-nth ]
         [ 0 swap set-nth ] tri
     ] bi ;
-M: y-up up-axis-swizzle! drop ;
+M: y-up >y-up-axis! drop ;
-M: z-up up-axis-swizzle!
+M: z-up >y-up-axis!
     drop dup
     [
         [ 0 swap nth ]
-        [ 1 swap nth ]
+        [ 1 swap nth neg ]
-        [ 2 swap nth neg ] tri
+        [ 2 swap nth ] tri
         swap
     ] [
         [ 2 swap set-nth ]
@@ -72,69 +65,62 @@ M: z-up up-axis-swizzle!
         [ 0 swap set-nth ] tri
     ] bi ;
 
-: source>array ( source-tag up-axis scale -- array )
+: source>seq ( source-tag up-axis scale -- sequence )
     rot
     [ "float_array" x/ xt string>numbers [ * ] with map ]
     [ nip "technique_common" x/ "accessor" x/ "stride" x@ string>number ] 2bi
     <groups>
-    [ swap up-axis-swizzle! ] with map ;
+    [ swap >y-up-axis! ] with map ;
 
-:: collada-mesh>model ( mesh-tag -- models )
+: source>pair ( source-tag -- pair )
-    mesh-tag "source" [
     [ "id" x@ ]
-        [ 
+    [ up-axis get unit-ratio get source>seq ] bi 2array ;
-            [ "float_array" x/ xt string>numbers ]
-            [ "technique_common" x/ "accessor" x/ "stride" x@ string>number ] bi <groups>
-        ] bi 2array
-    ] map-tags-named >hashtable :> sources
 
-    mesh-tag "vertices" tag-named
+: mesh>sources ( mesh-tag -- hashtable )
-    [ "id" attr ] 
+    "source" [ source>pair ] x* >hashtable ;
+
+: mesh>vertices ( mesh-tag -- pair )
+    "vertices" x/
+    [ "id" x@ ]
+    [ "input"
       [
-        "input" tags-named [
+          [ "semantic" x@ ]
-            [ "semantic" attr ] [ "source" attr ] bi 2array
+          [ "source" x@ ] bi 2array
+      ] x*
+    ] bi 2array ;
+
+:: collect-sources ( sources vertices inputs -- sources )
+    inputs
+    [| input |
+        input "source" x@ rest vertices first =
+        [
+            vertices second [| vertex |
+                vertex first
+                input "offset" x@ string>number
+                vertex second rest sources at source boa
             ] map
         ]
-    bi 2array :> vertices
-
-    mesh-tag "triangles" tags-named
-    [| triangle |
-        triangle "count" attr string>number                                        :> count
-        sources vertices triangle "input" tags-named collect-sources               :> flattened-sources
-        triangle "p" tag-named children>string " \t\n" split [ string>number ] map :> indices
-        flattened-sources [ offset>> ] [ max ] map-reduce                          :> max-offset
-        indices dup length count / <groups> [ max-offset 1 + <groups> ] map        :> triangles-indices
-
-        V{ } clone :> index-buffer
-        V{ } clone :> attribute-buffer
-        V{ } clone :> vertex-format
-        H{ } clone :> inverse-attribute-buffer
-        
-        triangles-indices [
         [
-                [| triangle-index triangle-offset |
+            input [ "semantic" x@ ]
-                    triangle-index triangle-offset flattened-sources
+                  [ "offset" x@ string>number ]
-                    [| index offset source |
+                  [ "source" x@ rest sources at ] tri source boa
-                        source offset>> offset = [
+        ] if
-                            index source data>> nth
+    ] map flatten ;
-                        ] [ f ] if 
-                    ] with with map sift flatten :> blah
 
-                    blah inverse-attribute-buffer at [
+: group-indices ( index-stride triangle-count indices -- grouped-indices )
-                        index-buffer push
+    dup length rot / <groups> swap [ <groups> ] curry map ;
-                    ] [
-                        attribute-buffer length
-                        [ blah inverse-attribute-buffer set-at ]
-                        [ index-buffer push ] bi
-                        blah attribute-buffer push
-                    ] if*
-                ] each-index
-            ] each
-        ] each
 
-        attribute-buffer flatten >float-array
+: triangles>numbers ( triangles-tag -- number-seq )
-        index-buffer     flatten >uint-array
+    "p" x/ children>string " \t\n" split [ string>number ] map ;
-        flattened-sources [
+
+: largest-offset+1 ( source-seq -- largest-offset+1 )
+    [ offset>> ] [ max ] map-reduce 1 + ;
+
+: <model> ( attribute-buffer index-buffer sources -- model )
+    [ flatten >float-array ]
+    [ flatten >uint-array ]
+    [
+        [
             {
                 [ semantic>> ]
                 [ drop float-components ]
@@ -142,7 +128,55 @@ M: z-up up-axis-swizzle!
                 [ drop f ]
             } cleave vertex-attribute boa
         ] map
-        model boa
+    ] tri* model boa ;
-    ] map
 
-    ;
+:: soa>aos ( triangles-indices sources -- attribute-buffer index-buffer )
+    V{ } clone :> attribute-buffer
+    V{ } clone :> index-buffer
+    H{ } clone :> inverse-attribute-buffer
+    triangles-indices [
+        [
+            [| triangle-index triangle-offset |
+                triangle-index triangle-offset sources
+                [| index offset source |
+                    source offset>> offset = [
+                        index source data>> nth
+                    ] [ f ] if 
+                ] with with map sift flatten :> attributes
+                
+                attributes inverse-attribute-buffer at [
+                    index-buffer push
+                ] [
+                    attribute-buffer length
+                    [ attributes inverse-attribute-buffer set-at ]
+                    [ index-buffer push ] bi
+                    attributes attribute-buffer push
+                ] if*
+            ] each-index
+        ] each
+    ] each
+    attribute-buffer index-buffer ;
+
+: triangles>model ( sources vertices triangles-tag -- model )
+    [ "input" tags-named collect-sources ] keep swap
+    
+    [
+        largest-offset+1 swap
+        [ "count" x@ string>number ] [ triangles>numbers ] bi
+        group-indices
+    ]
+    [
+        [ soa>aos ] keep <model>
+    ] bi ;
+    
+: mesh>triangles ( sources vertices mesh-tag -- models )
+    "triangles" tags-named [ triangles>model ] with with map ;
+
+: mesh>models ( mesh-tag -- models )
+    [
+        { { up-axis z-up } { unit-ratio 0.5 } } [
+            mesh>sources
+        ] bind
+    ]
+    [ mesh>vertices ]
+    [ mesh>triangles ] tri ;

basis/collada/viewer/viewer.factor

@@ -22,6 +22,7 @@ uniform mat4 mv_matrix, p_matrix;
 uniform vec3 light_position;
 
 attribute vec3 POSITION;
+attribute vec3 NORMAL;
 
 void main()
 {
@@ -33,13 +34,38 @@ void main()
 GLSL-SHADER: collada-fragment-shader fragment-shader
 void main()
 {
-    gl_FragColor = vec4(1.0, 0.0, 0.0, 1.0);
+    gl_FragColor = vec4(1, 1, 0, 1);
 }
 ;
 
 GLSL-PROGRAM: collada-program
     collada-vertex-shader collada-fragment-shader ;
 
+GLSL-SHADER: debug-vertex-shader vertex-shader
+uniform mat4 mv_matrix, p_matrix;
+uniform vec3 light_position;
+
+attribute vec3 POSITION;
+attribute vec3 COLOR;
+varying vec4 color;
+
+void main()
+{
+    gl_Position = p_matrix * mv_matrix * vec4(POSITION, 1.0);
+    color = vec4(COLOR, 1);
+}
+;
+
+GLSL-SHADER: debug-fragment-shader fragment-shader
+varying vec4 color;
+void main()
+{
+    gl_FragColor = color;
+}
+;
+
+GLSL-PROGRAM: debug-program debug-vertex-shader debug-fragment-shader ;
+
 UNIFORM-TUPLE: collada-uniforms < mvp-uniforms
     { "light-position" vec3-uniform  f } ;
 
@@ -53,13 +79,15 @@ TUPLE: collada-world < wasd-world
 
 VERTEX-FORMAT: collada-vertex
     { "POSITION" float-components 3 f }
-    { f          float-components 3 f } ;
+    { "NORMAL"   float-components 3 f } ;
 
-:: mymax ( x y -- x ) x third y third > [ x ] [ y ] if ;
+VERTEX-FORMAT: debug-vertex
+    { "POSITION" float-components 3 f }
+    { "COLOR"    float-components 3 f } ;
 
 : <collada-buffers> ( models -- buffers )
 !    drop
-    ! float-array{ -0.5 0 0 0 0 0 0 1 0 0 0 0 0.5 0 0 0 0 0 }
+!    float-array{ -0.5 0 0 1 0 0 0 1 0 0 1 0 0.5 0 0 0 0 1 }
 !    uint-array{ 0 1 2 }
 !    f model boa 1array
     [
@@ -84,7 +112,9 @@ VERTEX-FORMAT: collada-vertex
     
 : <collada-state> ( -- collada-state )
     collada-state new
-    "C:/Users/erikc/Downloads/mech.dae" file>xml "mesh" deep-tags-named [ collada-mesh>model ] map flatten >>models ;
+    #! "C:/Users/erikc/Downloads/mech.dae"
+    "/Users/erikc/Documents/mech.dae"
+    file>xml "mesh" deep-tags-named [ mesh>models ] map flatten >>models ;
 
 M: collada-world begin-game-world
     init-gpu
@@ -96,8 +126,35 @@ M: collada-world begin-game-world
     { -10000.0 10000.0 10000.0 } ! light position
     collada-uniforms boa ;
 
+: draw-line ( world from to color -- )
+    [ 3 head ] tri@ dup -rot append -rot append swap append >float-array
+    underlying>> stream-upload draw-usage vertex-buffer byte-array>buffer
+    debug-program <program-instance> debug-vertex buffer>vertex-array
+    
+    { 0 1 } >uint-array stream-upload draw-usage index-buffer byte-array>buffer
+    2 '[ _ 0 <buffer-ptr> _ uint-indexes <index-elements> ] call
+    
+    rot <collada-uniforms>
+
+    {
+        { "primitive-mode"     [ 3drop lines-mode ] }
+        { "uniforms"           [ nip nip ] }
+        { "vertex-array"       [ drop drop ] }
+        { "indexes"            [ drop nip ] }
+    } 3<render-set> render ;
+
+: draw-lines ( world lines -- )
+    3 <groups> [ first3 draw-line ] with each ; inline
+
+: draw-axes ( world -- )
+    { { 0 0 0 } { 1 0 0 } { 1 0 0 }
+      { 0 0 0 } { 0 1 0 } { 0 1 0 }
+      { 0 0 0 } { 0 0 1 } { 0 0 1 } } draw-lines ;
+          
 : draw-collada ( world -- )
     GL_COLOR_BUFFER_BIT glClear
+
+    [
         triangle-lines dup t <triangle-state> set-gpu-state
         [ collada>> vertex-arrays>> ]
         [ collada>> index-vectors>> ]
@@ -106,11 +163,16 @@ M: collada-world begin-game-world
         [
             {
                 { "primitive-mode"     [ 3drop triangles-mode ] }
-            { "uniforms"           [ swap drop swap drop ] }
+                { "uniforms"           [ nip nip ] }
                 { "vertex-array"       [ drop drop ] }
-            { "indexes"            [ drop swap drop ] }
+                { "indexes"            [ drop nip ] }
             } 3<render-set> render
-    ] curry 2each ;
+        ] curry 2each
+    ]
+    [
+        draw-axes
+    ]
+    bi ;
 
 M: collada-world draw-world*
     draw-collada ;