#!/usr/bin/perl -w
# NAME: chkdae.pl
# AIM: Load and review a dae file - COLLADA - http://www.collada.org
# COLLADA defines an XML-based schema to make it easy to transport 3D assets between applications 
# 16/05/2013 geoff mclane http://geoffair.net/mperl
use strict;
use warnings;
use File::Basename;  # split path ($name,$dir,$ext) = fileparse($file [, qr/\.[^.]*/] )
use XML::Simple;
use Data::Dumper;
use Cwd;
my $os = $^O;
my $perl_dir = '/home/geoff/bin';
my $PATH_SEP = '/';
my $temp_dir = '/tmp';
if ($os =~ /win/i) {
    $perl_dir = 'C:\GTools\perl';
    $temp_dir = $perl_dir;
    $PATH_SEP = "\\";
}
unshift(@INC, $perl_dir);
require 'lib_utils.pl' or die "Unable to load 'lib_utils.pl' Check paths in \@INC...\n";
# log file stuff
our ($LF);
my $pgmname = $0;
if ($pgmname =~ /(\\|\/)/) {
    my @tmpsp = split(/(\\|\/)/,$pgmname);
    $pgmname = $tmpsp[-1];
}
my $outfile = $temp_dir.$PATH_SEP."temp.$pgmname.txt";
open_log($outfile);

# user variables
my $VERS = "0.0.1 2013-05-16";
my $load_log = 0;
my $in_file = '';
my $verbosity = 0;
my $out_file = '';
my $json_out = $temp_dir.$PATH_SEP."temp.dae.json";
my $ac3d_out = $temp_dir.$PATH_SEP."temp.dae2ac3d.ac";

# ### DEBUG ###
my $debug_on = 1;
my $def_file = 'C:\FG\18\blendac3d\shb\shb3.dae';

### program variables
my @warnings = ();
my $cwd = cwd();

sub VERB1() { return $verbosity >= 1; }
sub VERB2() { return $verbosity >= 2; }
sub VERB5() { return $verbosity >= 5; }
sub VERB9() { return $verbosity >= 9; }

sub show_warnings($) {
    my ($val) = @_;
    if (@warnings) {
        prt( "\nGot ".scalar @warnings." WARNINGS...\n" );
        foreach my $itm (@warnings) {
           prt("$itm\n");
        }
        prt("\n");
    } else {
        prt( "\nNo warnings issued.\n\n" ) if (VERB9());
    }
}

sub pgm_exit($$) {
    my ($val,$msg) = @_;
    if (length($msg)) {
        $msg .= "\n" if (!($msg =~ /\n$/));
        prt($msg);
    }
    show_warnings($val);
    close_log($outfile,$load_log);
    exit($val);
}


sub prtw($) {
   my ($tx) = shift;
   $tx =~ s/\n$//;
   prt("$tx\n");
   push(@warnings,$tx);
}

#=========================
#$VAR1 = {
#          'xmlns' => 'http://www.collada.org/2005/11/COLLADASchema',
#          'library_effects' => {
#                      'effect' => {
#                           'ID8773' => {
# ...
#          'library_visual_scenes' => {
#                       'visual_scene' => {
#                                 'id' => 'ID1',
#                                 'node' => {
#                                    'name' => 'SketchUp',
#                                     'node' => {
#                                         'name' => 'instance_0',
#                                         'id' => 'ID2',
#                                  'instance_node' => {
#                                           'url' => '#ID3'
#                                                      },
#                                   'matrix' => '1 0 0 0 0 1 0 0 0 0 1 0 0 0 0 1'
# ...
#          'library_materials' => {
#                      'material' => {
#                          '__auto_72' => {
#                           'instance_effect' => {
#                                    'url' => '#ID9357'
#                                                },
#                                           'id' => 'ID9356'
#                                         },
# ...
#          'library_nodes' => {
#                     'node' => {
#                   'Component' => {
#                        'id' => 'ID5',
#             'instance_geometry' => [
#                                      {
#                               'url' => '#ID6',
#                               'bind_material' => {
#                               'technique_common' => {
#                                 'instance_material' => {
#                                    'bind_vertex_input' => {
#                                            'input_set' => '0',
#                                       'input_semantic' => 'TEXCOORD',
#                                             'semantic' => 'UVSET0'
#                                                           },
#                                               'target' => '#ID7',
#                                               'symbol' => 'Material2'
#                                                         }
#                                                      }
#                                                   }
#                                                },
#
# ....
#          'version' => '1.4.1',
#          'scene' => {
#                     'instance_visual_scene' => {
#                                                'url' => '#ID1'
#                                              }
#                   },
#          'library_images' => {
#                      'image' => {
#                        'ID9230' => {
#                      'init_from' => 'shb3/__auto_9.jpg'
#                                    },
# ...
#          'library_geometries' => {
#                      'geometry' => {
#                          'ID4971' => {
#                              'mesh' => {
#                            'vertices' => {
#                                 'input' => [
#                                             {
#                                  'source' => '#ID4972',
#                                'semantic' => 'POSITION'
#                                             },
#                                             {
#                                  'source' => '#ID4973',
#                                'semantic' => 'NORMAL'
#                                             }
#                                            ],
#                                      'id' => 'ID4974'
#                                           },
#                                  'source' => {
#                                    'ID4973' => {
#                             'technique_common' => {
#                                        'accessor' => {
#                                          'stride' => '3',
#                                          'source' => '#ID4976',
#                                           'count' => '8',
#                                              'param' => {
#                                                   'Z' => {
#                                                'type' => 'float'
#                                                          },
#                                                   'X' => {
#                                                'type' => 'float'
#                                                          },
#                                                   'Y' => {
#                                                'type' => 'float'
#                                                          }
#                                                        }
#                                                      }
#                                                    },
#                                      'float_array' => {
#                                            'count' => '24',
#                                          'content' => '-1 0 0 -1 0 0 -1 0 0 -1 0 0 1 -0 -0 1 -0 -0 1 -0 -0 1 -0 -0',
#                                               'id' => 'ID4976'
#                                                        }
#                                                     },
#                                            'triangles' => {
#                                              'p' => '0 1 2 1 0 3 3 0 4 4 0 5 5 0 6 5 6 7 8 9 10 9 11 10 10 11 12 12 11 13 13 11 14 15 14 11',
#                                              'count' => '12',
#                                              'input' => {
#                                             'source' => '#ID5244',
#                                           'semantic' => 'VERTEX',
#                                             'offset' => '0'
#                                                        },
#                                          'material' => 'Material2'
#                                                  }
#                                              }
#                                           }
#                                     }
#                                },
# ...
#          'asset' => {
#                     'created' => '2013-05-16T09:44:18Z',
#                     'unit' => {
#                               'name' => 'inch',
#                               'meter' => '0.02539999969303608'
#                             },
#                     'up_axis' => 'Z_UP',
#                     'modified' => '2013-05-16T09:44:18Z',
#                     'contributor' => {
#                                      'authoring_tool' => 'SketchUp 8.0.16846'
#                                    }
#                   }

my %asset_hash = (
    'created' => 1,
       'unit' => 2, # { 'name' => 'inch', 'meter' => '0.02539999969303608' },
    'up_axis' => 1, # 'Z_UP',
   'modified' => 1, # '2013-05-16T09:44:18Z',
 'contributor' => 2 # { 'authoring_tool' => 'SketchUp 8.0.16846' }
);


sub write_floats($) {
    my $rh = shift; # \%floats
    my @arr = sort keys( %{$rh} );
    my $kcnt = scalar @arr;
    my $json = "{\"success\":true,\"source\":\"$pgmname\",\"last_updated\":\"";
    $json .= lu_get_YYYYMMDD_hhmmss_UTC(time())." UTC\",";
    $json .= "\"count\":$kcnt,\"nodes\":[\n";

    my ($key,$rfh,$stride,$count,$rfa,$cnt,$rta,$rhidt);
    $cnt = 0;
    foreach $key (@arr) {
        $rfh = ${$rh}{$key};
        #prt(Dumper($rfh));
        #pgm_exit(1,"");
        $rhidt = ${$rfh}{'idtyp'}; 
        $rfa = ${$rfh}{'verts'};
        $rta = ${$rfh}{'tris'};
        $stride = ${$rfh}{'stride'};
        $count = ${$rfh}{'count'};
        $json .= " {\"id\":\"$key\",";
        $json .= "\"tris\":[";
        $json .= join(",",@{$rta});
        $json .= "],";
        $json .= "\"count\":$count,";
        $json .= "\"stride\":$stride,\n";
        if (defined ${$rhidt}{$key}) {
            $json .= " \"".${$rhidt}{$key}."\":[";
        } else {
            $json .= " \"vertices\":[";
        }
        $json .= join(",",@{$rfa});
        $json .= "]}";
        $cnt++;
        $json .= ',' if ($cnt < $kcnt);
        $json .= "\n";
    }
    $json .= "]}\n";
    write2file($json,$json_out);
    prt("json written to [$json_out]\n");
}

sub mycmp_id_sort {
    my $id1 = substr($a,2);
    my $id2 = substr($b,2);
   return -1 if ($id1 < $id2);
   return  1 if ($id1 > $id2);
   return 0;
}


#  $mesh_hash{$k2}->{idtyp}  = {%hidt}; # sep POSITION and NORMAL
#  $mesh_hash{$k2}->{tris}   = [@art];
#  $mesh_hash{$k2}->{verts}  = [@ar3];
#  $mesh_hash{$k2}->{stride} = $stride;
#  $mesh_hash{$k2}->{count}  = $count;
#  $mesh_hash{$k2}->{order}  = $kcnt;  # simple numeric order

sub write_meshes($) {
    my $rmh = shift; # \%master_hash
    # each 'mesh' is stored by a 'key' like ID10933
    my ($mkey,$rh);
    my ($k2,$v2,$typ,$cnt);
    my @marr = sort mycmp_id_sort keys(%{$rmh});
    $cnt = scalar @marr;
    my ($key,$rfh,$rhidt,$rfa,$rta,$stride,$count);
    my ($msg,@ar2,@arr,$itm,$wrap,$v);
    my $ac3d = "AC3Db\n";
    $ac3d .= "MATERIAL \"DefaultWhite\" rgb 1.0000 1.0000 1.0000  amb 0.2000 0.2000 0.2000  emis 0.0000 0.0000 0.0000  spec 0.5000 0.5000 0.5000  shi 10 trans 0.0000\n";
    $ac3d .= "MATERIAL \"Material\" rgb 0.8000 0.8000 0.8000  amb 1.0000 1.0000 1.0000  emis 0.0000 0.0000 0.0000  spec 0.5000 0.5000 0.5000  shi 50 trans 0.0000\n";
    $ac3d .= "OBJECT world\n";
    $ac3d .= "name \"".$pgmname."_AC3D_gen\"\n";
    $ac3d .= "kids $cnt\n";
    $itm = 0;
    foreach $mkey (@marr) {
        $itm++;
        $msg = "$itm: $mkey: ";
        $ac3d .= "OBJECT poly\n";
        $ac3d .= "name \"$mkey\"\n";
        $ac3d .= "loc 0.0 0.0 0.0\n";
        #$ac3d .= "crease 45.0\n";
        # $master_hash{$key}->{mesh} = {%mesh_hash};
        $rh = ${$rmh}{$mkey}{'mesh'};    # get the mesh hash
        @arr = sort mycmp_id_sort keys(%{$rh});
        # got through the keys for this mesh
        foreach $key (@arr) {
            $msg .= "$key ";
            $rfh = ${$rh}{$key};
            #prt(Dumper($rfh));
            #pgm_exit(1,"");
            $rhidt = ${$rfh}{'idtyp'}; 
            $rfa = ${$rfh}{'verts'};
            $rta = ${$rfh}{'tris'};
            $stride = ${$rfh}{'stride'};
            $count = ${$rfh}{'count'};
            $typ = ${$rhidt}{$key};
            if ((defined $typ) && ($typ eq 'POSITION')) {
                $cnt = scalar @{$rfa};
                $msg .= "POS ".int($cnt / 3)." ";
                $ac3d .= "numvert ".int($cnt / 3)."\n";
                $wrap = 0;
                foreach $v (@{$rfa}) {
                    $ac3d .= $v;
                    $wrap++;
                    if ($wrap == 3) {
                        $ac3d .= "\n";
                        $wrap = 0;
                    } else {
                        $ac3d .= ' ';
                    }
                }
                if ($wrap) {
                    prtw("WARNING: Appears cnt $cnt not divis by 3!\n".
                        "Filling in ".(3 - $wrap)." zero vertice(s) - UGH\n");
                    while ($wrap < 3) {
                        $ac3d .= " 0.0";
                        $wrap++;
                    }
                    $ac3d .= "\n";
                }
                $cnt = scalar @{$rta};
                $ac3d .= "numsurf ".int($cnt / 3)."\n";
                $wrap = 0;
                $msg .= "TRI ".int($cnt / 3)." ";
                foreach $v (@{$rta}) {
                    if ($wrap == 0) {
                        $ac3d .= "SURF 0x10\n";
                        $ac3d .= "mat 1\n";
                        $ac3d .= "refs 3\n";
                    }
                    $ac3d .= "$v 0 0\n";
                    $wrap++;
                    $wrap = 0 if ($wrap == 3);
                }
                if ($wrap) {
                    prtw("WARNING: Appears cnt $cnt not divis by 3!\n".
                        "Filling in ".(3 - $wrap)." zero tris - UGH\n");
                    while ($wrap < 3) {
                        $ac3d .= "0 0 0\n";
                        $wrap++;
                    }
                }
                $ac3d .= "kids 0\n";
            } elsif (defined $typ) {
                $msg .= "Skip $typ ";
            } else {
                $msg .= "NO TYPE! ";
            }
        }
        prt("$msg\n");
    }

    write2file($ac3d,$ac3d_out);
    prt("ac3d written to [$ac3d_out]\n");

}

sub process_in_file($) {
    my ($inf) = @_;
    if (! -f $inf) {
        pgm_exit(1,"ERROR: Unable to 'stat' file [$inf]\n"); 
    }
    my $xml = new XML::Simple; # (ForceArray => 0);
    my $data = $xml->XMLin($inf);
    #prt(Dumper($data));
    #$load_log = 2;
    my ($tmp,$key,$val,$k2,$v2,@arr,@ar2,$cnt,$kcnt,@ar3,$msg,@art);
    my ($stride,$count,$source,$semantic,%hidt,$rt);
    if (defined ${$data}{'asset'}) {
        my $rah = ${$data}{'asset'};
        #prt(Dumper($rah));
        foreach $key (keys %asset_hash) {
            $val = $asset_hash{$key};
            if (defined ${$rah}{$key}) {
                $tmp = ${$rah}{$key};
                if ($val == 1) {
                    prt("$key: $tmp\n");
                } elsif ($val == 2) {
                    foreach $k2 (keys %{$tmp}) {
                        $v2 = ${$tmp}{$k2};
                        prt("$key -> $k2 = $v2\n");
                    }
                }
            }
        }
    }
    my %floats = ();
    my %idtotype = ();
    my %master_hash = ();
    my %mesh_hash = ();
    if (defined ${$data}{'library_geometries'}{'geometry'}) {
        my $rgh = ${$data}{'library_geometries'}{'geometry'};
        #prt(Dumper($rgh));
        @arr = keys %{$rgh};
        $v2 = scalar @arr;
        prt("Found $v2 geometries\n");
        $kcnt = 0;
        foreach $key (@arr) {
            # ok, each 'key' here, like 'ID10933' should have a 'mesh'
            # That 'mesh' is made up of -
            # 'vertices' which will be ID1=NORMAL, ID2=POSITION
            # 'source' where ID1, ID2 will be given as an array
            # 'triangles' sets of 3 giving indexs into NORMAL and POSITIONS
            #
            $val = ${$rgh}{$key};   # extract a geometry
            # prt(Dumper($val)) if ($kcnt == 0);
            $kcnt++;    # simple numeric order...
            $msg = "$kcnt: ";
            %mesh_hash = ();    # restart the 'mesh' hash
            if (defined ${$val}{'mesh'}) {
                my $rmh = ${$val}{'mesh'};
                $msg .= "mesh ";
                @art = ();
                %hidt = ();
                if (defined ${$rmh}{'vertices'}{'input'}) {
                    my $rvina = ${$rmh}{'vertices'}{'input'};
                    $msg .= 'I';
                    foreach $k2 (@{$rvina}) {
                        if ((defined ${$k2}{'source'})&&(defined ${$k2}{'semantic'})) {
                            $source = ${$k2}{'source'};
                            $source =~ s/^\#//;
                            $semantic = ${$k2}{'semantic'};
                            $idtotype{$source} = $semantic;
                            $hidt{$source} = $semantic;
                            $msg .= "$source:".substr($semantic,0,1);
                        } else {
                            $msg .= 'NSrc:Sem?';
                        }
                    }
                }

                if (defined ${$rmh}{'triangles'}) {
                    my $rth = ${$rmh}{'triangles'}; # get ref hash
                    if (defined ${$rth}{'p'}) {
                         $v2 = ${$rth}{'p'};
                         @art = split(/\s+/,$v2);
                         $cnt = scalar @art;
                         $msg .= " T$cnt ";
                    }
                    if (defined ${$rth}{'input'}) {
                        my $rtria = ${$rth}{'input'}; # get array
                        $rt = ref($rtria);
                        if ($rt eq 'ARRAY') {
                            foreach $k2 (@{$rtria}) {
                                if ((defined ${$k2}{'source'})&&(defined ${$k2}{'semantic'})) {
                                    $source = ${$k2}{'source'};
                                    $source =~ s/^\#//;
                                    $semantic = ${$k2}{'semantic'};
                                    $idtotype{$source} = $semantic;
                                    $hidt{$source} = $semantic;
                                }
                            }
                        } elsif ($rt eq 'HASH') {
                            $k2 = $rtria;
                            if ((defined ${$k2}{'source'})&&(defined ${$k2}{'semantic'})) {
                                $source = ${$k2}{'source'};
                                $source =~ s/^\#//;
                                $semantic = ${$k2}{'semantic'};
                                $idtotype{$source} = $semantic;
                                $hidt{$source} = $semantic;
                            }
                        }
                    }

                }
                if (defined ${$rmh}{'source'}) {
                    my $rsh = ${$rmh}{'source'};
                    @ar2 = keys %{$rsh};
                    $cnt = scalar @ar2;
                    $msg .= "-> source cnt $cnt ";
                    foreach $k2 (@ar2) {
                        my $rfah = ${$rsh}{$k2};
                        if (defined ${$rfah}{'technique_common'}{'accessor'}) {
                            my $racch = ${$rfah}{'technique_common'}{'accessor'};
                            if ((defined ${$racch}{'stride'}) && (defined ${$racch}{'count'})) {
                                $count  = ${$racch}{'count'};
                                $stride = ${$racch}{'stride'};
                                $msg .= $count.'x'.$stride.'=';
                            }
                        }
                        if (defined ${$rfah}{'float_array'}) {
                            my $rfa = ${$rfah}{'float_array'};
                            if (defined ${$rfa}{'count'}) {
                                $cnt = ${$rfa}{'count'};
                                if (defined $hidt{$k2}) {
                                    $msg .= "$cnt=".$hidt{$k2}." ";
                                } else {
                                    $msg .= "$cnt $k2 NO DEF? ";
                                }
                            }
                            if (defined ${$rfa}{'content'}) {
                                $v2 = ${$rfa}{'content'}; # get the floats
                                @ar3 = split(/\s+/,$v2);
                                $floats{$k2}->{idtyp}  = {%hidt}; # sep POSITION and NORMAL
                                $floats{$k2}->{tris}   = [@art];
                                $floats{$k2}->{verts}  = [@ar3];
                                $floats{$k2}->{stride} = $stride;
                                $floats{$k2}->{count}  = $count;
                                $floats{$k2}->{order}  = $kcnt;

                                $mesh_hash{$k2}->{idtyp}  = {%hidt}; # sep POSITION and NORMAL
                                $mesh_hash{$k2}->{tris}   = [@art];
                                $mesh_hash{$k2}->{verts}  = [@ar3];
                                $mesh_hash{$k2}->{stride} = $stride;
                                $mesh_hash{$k2}->{count}  = $count;
                                $mesh_hash{$k2}->{order}  = $kcnt;  # simple numeric order
                            }
                        } else {
                            $msg .= "NFA ";
                        }
                    }
                }
            } else {
                $msg .= "NO 'mesh'!";
            }
            $master_hash{$key}->{mesh} = {%mesh_hash};
            prt("$msg\n");
        }
        #$load_log = 2;
    }
    write_floats(\%floats);
    write_meshes(\%master_hash);
}

#########################################
### MAIN ###
parse_args(@ARGV);
process_in_file($in_file);
pgm_exit(0,"");
########################################

sub need_arg {
    my ($arg,@av) = @_;
    pgm_exit(1,"ERROR: [$arg] must have a following argument!\n") if (!@av);
}

sub parse_args {
    my (@av) = @_;
    my ($arg,$sarg);
    while (@av) {
        $arg = $av[0];
        if ($arg =~ /^-/) {
            $sarg = substr($arg,1);
            $sarg = substr($sarg,1) while ($sarg =~ /^-/);
            if (($sarg =~ /^h/i)||($sarg eq '?')) {
                give_help();
                pgm_exit(0,"Help exit(0)");
            } elsif ($sarg =~ /^v/) {
                if ($sarg =~ /^v.*(\d+)$/) {
                    $verbosity = $1;
                } else {
                    while ($sarg =~ /^v/) {
                        $verbosity++;
                        $sarg = substr($sarg,1);
                    }
                }
                prt("Verbosity = $verbosity\n") if (VERB1());
            } elsif ($sarg =~ /^l/) {
                if ($sarg =~ /^ll/) {
                    $load_log = 2;
                } else {
                    $load_log = 1;
                }
                prt("Set to load log at end. ($load_log)\n") if (VERB1());
            } elsif ($sarg =~ /^o/) {
                need_arg(@av);
                shift @av;
                $sarg = $av[0];
                $out_file = $sarg;
                prt("Set out file to [$out_file].\n") if (VERB1());
            } else {
                pgm_exit(1,"ERROR: Invalid argument [$arg]! Try -?\n");
            }
        } else {
            $in_file = $arg;
            prt("Set input to [$in_file]\n") if (VERB1());
        }
        shift @av;
    }

    if ($debug_on) {
        prtw("WARNING: DEBUG is ON!\n");
        if ((length($in_file) ==  0) && $debug_on) {
            $in_file = $def_file;
            prt("Set DEFAULT input to [$in_file]\n");
        }
    }
    if (length($in_file) ==  0) {
        pgm_exit(1,"ERROR: No input files found in command!\n");
    }
    if (! -f $in_file) {
        pgm_exit(1,"ERROR: Unable to find in file [$in_file]! Check name, location...\n");
    }
}

sub give_help {
    prt("$pgmname: version $VERS\n");
    prt("Usage: $pgmname [options] in-file\n");
    prt("Options:\n");
    prt(" --help  (-h or -?) = This help, and exit 0.\n");
    prt(" --verb[n]     (-v) = Bump [or set] verbosity. def=$verbosity\n");
    prt(" --load        (-l) = Load LOG at end. ($outfile)\n");
    prt(" --out <file>  (-o) = Write output to this file.\n");
}

# for an AC3D format reference see ac3dfile.pl

# eof - chkdae.pl