Paste: collada -- NOT VIAGRA

USING: accessors arrays assocs grouping hashtables kernel
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

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 )
    inputs
    [| input |
        input "source" attr rest vertices first =
        [
            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 ;

:: collada-mesh>model ( mesh-tag -- models )
    mesh-tag "source" tags-named [
        [ "id" attr ]
        [ 
            [ "float_array" tag-named children>string " \t\n" split [ string>number ] map ]
            [ "technique_common" tag-named "accessor" tag-named "stride" attr string>number ] bi group
        ] bi 2array
    ] map >hashtable :> sources

    mesh-tag "vertices" tag-named
    [ "id" attr ] 
    [
        "input" tags-named [
        { "output-attachments" [ drop { T{ color-attachment f 0 } T{ color-attachment f 1 } } ] }
            [ "semantic" attr ] [ "source" attr ] bi 2array
        ] 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 / group [ max-offset 1 + group ] 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 |
                    triangle-index triangle-offset flattened-sources
                    [| index offset source |
                        source offset>> offset = [
                            index source data>> nth
                        ] [ f ] if 
                    ] with with map sift flatten :> blah
                    
                    blah inverse-attribute-buffer at [
                        index-buffer push
                    ] [
                        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
        index-buffer     flatten >uint-array
        flattened-sources [
            {
                [ semantic>> ]
                [ drop float-components ]
                [ data>> first length ]
                [ drop f ]
            } cleave vertex-attribute boa
        ] map
        model boa
    ] map
    
    ;