package Local::CALbits; 

# CALbits
# A module to assist the importing and exporting of CAL3D data files as
# used by the IMVU chat system.
# 
# Expect this module to change as further information becomes available.
#
# Implemented:
#
# Version 0.02
# Identical to 0.01 but gains a description in comments at the head of the file
# Version 0.01
# Uses the XML::Structured importer
# Importing and parsing file into a data structure
# Importing and parsing string into data structure
# Exporting data structure as a string
#
# Not implemented:
#
# Using XML::SAX directly
# Using XML::Parser directly
# Parsing numeric content
# Parsing translations and rotations: It is assumed that a future version would convert "0 0 0 1" into
# an array reference: [0,0,0,1] and convert the corresponding array ref back to a string
# Morph extensions to the XMF file format (no data is available)
# quaternion rotation library functions
# 
use strict;

require Exporter;
use vars       qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);

# set the version for version checking
$VERSION     = 0.02;

@ISA         = qw(Exporter);

@EXPORT      = qw( );
%EXPORT_TAGS = ( all => [qw($dtd_head $dtd_xsf $dtd_xaf $dtd_xpf $dtd_xmf $dtd_xrf $dtd_bork %dtd_tags %dtd_list CALout CALin)],
                 standard => [qw($dtd_head $dtd_bork %dtd_tags %dtd_list CALout CALin)]);     # eg: TAG => [ qw!name1 name2! ],

# your exported package globals go here,
# as well as any optionally exported functions
@EXPORT_OK   = qw($dtd_head $dtd_xsf $dtd_xaf $dtd_xpf $dtd_xmf $dtd_xrf $dtd_bork %dtd_tags %dtd_list CALout CALin);

use vars qw($dtd_head $dtd_xsf $dtd_xaf $dtd_xpf $dtd_xmf $dtd_xrf $dtd_bork %dtd_tags %dtd_list);
# non-exported package globals go here
use vars      qw( );

# initialize package globals, first exported ones


use XML::Structured;


# define the dtd for each type of file

# the CAL3D formats aren't strictly valid XML however taken seperately the
# header and content of the file are two seperate valid XML documents
# so we trick the parser into separating them by adding an outer tag pair
# '<BORK>,</BORK>' enclosing the whole file.

# header DTD, this describes the header record
$dtd_head = [ 'HEADER' => 'MAGIC','VERSION' ];
# xsf file DTD, this describes the various fields of the file
$dtd_xsf = [
        'SKELETON' =>
            'VERSION',
            'NUMBONES',
            'SCENEAMBIENTCOLOR',
            [[ 'BONE' =>
                'ID',
                'NAME',
                'NUMCHILDS',
                [],
                'TRANSLATION',
                'ROTATION',
                'LOCALTRANSLATION',
                'LOCALROTATION',
		'PARENTID',
                [ 'CHILDID' ],
            ]],
    ];

$dtd_xaf = [
        'ANIMATION' =>
            'VERSION',
            'NUMTRACKS',
            'DURATION',
            [[ 'TRACK' =>
                'BONEID',
                'TRANSLATIONREQUIRED',
                'TRANSLATIONISDYNAMIC',
                'HIGHRANGEREQUIRED',
                'NUMKEYFRAMES',
                [[ 'KEYFRAME' =>
                    'TIME',
                    [],
                    'TRANSLATION',
                    'ROTATION'
                ]],
            ]],
    ];
$dtd_xpf = [
        'MORPH' =>
            'VERSION',
            'NUMTRACKS',
            'DURATION',
            [[ 'TRACK' =>
                'NUMKEYFRAMES',
                'MORPHNAME',
                [[ 'KEYFRAME' =>
                    'TIME',
                    [],
                    'WEIGHT'
                ]],
            ]],
    ];

$dtd_xmf = [
        'MESH' =>
            'VERSION',
            'NUMSUBMESH',
            [['SUBMESH' =>
                'NUMVERTICES',
                'NUMFACES',
                'MATERIAL',
                'NUMLODSTEPS',
                'NUMSPRINGS',
                'NUMTEXCOORDS',
                [['VERTEX' =>
                    'ID',
                    'NUMINFLUENCES',
                    [],
                    'POS',
                    'NORM',
		    'COLOR',
                    'COLLAPSEID',
                    'COLLAPSECOUNT',
                    [ 'TEXCOORD' ],
                    [[ 'INFLUENCE' =>
                        'ID',
                        '_content'
		    ]],
                ]],
                [[ 'FACE' =>
                    'VERTEXID'
                ]],
            ]],
    ];

$dtd_xrf = [
        'MATERIAL' =>
           'VERSION',
           'NUMMAPS',
           [],
           'AMBIENT',
           'DIFFUSE',
           'SPECULAR',
           'SHININESS',
           [[ 'MAP' =>
              'TYPE',
              '_content'
           ]],
        ];  

# combine all the dtds into one super-dtd called 'BORK'

$dtd_bork= [ 'BORK' => $dtd_head,$dtd_xsf,$dtd_xaf,$dtd_xpf,$dtd_xmf,$dtd_xrf,'_content'];


# a hash to map the header "magic" field to the appropriate DTD    
%dtd_list=('XSF' => $dtd_xsf,
	       'XAF' => $dtd_xaf,
	       'XPF' => $dtd_xpf,
	       'XMF' => $dtd_xmf,
               'XRF' => $dtd_xrf);
%dtd_tags=('SKELETON'  => 'XSF',
                'ANIMATION' => 'XAF',
                'MORPH'     => 'XPF',
                'MESH'      => 'XMF',
                'MATERIAL'  => 'XRF'  );


# then the others (which are still accessible as $Some::Module::stuff)

# all file-scoped lexicals must be created before
# the functions below that use them.

# file-private lexicals go here

# here's a file-private function as a closure,
# callable as &$priv_func.
#my $priv_func = sub {
    # stuff goes here.
#};
sub CALin
{
  my $rawdata=shift;
  my $dtd_ref=shift;
  if (ref($rawdata))
  {
    if (ref($rawdata) eq 'SCALAR')
    {
      $rawdata=$$rawdata;
    }
    elsif (ref($rawdata) eq 'ARRAY')
    {
      $rawdata=join('',@$rawdata); 
    }
    else
# at this point we're going to assume a filehandle was passed
# filehandles should test as "GLOB" but cgi filehandles test as
# "Fh" instead which is a special object type that functions as
# a filehandle but returns the remote filename in scalar context
    {
      $rawdata = do { local( $/ ) ; <$rawdata> } or 
        carp('There was a problem reading your file');
    }
  }
  unless (ref($dtd_ref) eq 'ARRAY')
  {
    $dtd_ref=$dtd_bork;
  }
  return XMLin($dtd_ref,"<BORK>$rawdata</BORK>");
}


sub CALout
{
  my $data=shift;
  my $rawdata; 
  if ($$data{"HEADER"})
  {
    $rawdata= XMLout($dtd_head, $$data{"HEADER"});
  }
  foreach my $tag (keys %$data)
  {
    if ($dtd_tags{$tag})
    {
      $rawdata .= XMLout($dtd_list{$dtd_tags{$tag}}, $$data{$tag});
    }
  }

  # bodge to strip unwanted newlines and whitespace from INFLUENCE and MAP tags
  $rawdata =~ s/(<INFLUENCE\s[^>]+>)\n\s*(\S*)\n\s*(<\/INFLUENCE>)/$1$2$3/g;
  $rawdata =~ s/(<MAP\s[^>]+>)\n\s*(\S*)\n\s*(<\/MAP>)/$1$2$3/g;

  # bodge all the newlines into MS CR/LF pairs
  $rawdata =~ s/\n/\x0d\x0a/g;
  return $rawdata;

}

# make all your functions, whether exported or not;
# remember to put something interesting in the {} stubs
#sub func1      { .... }    # no prototype
#sub func2()    { .... }    # proto'd void
#sub func3($$)  { .... }    # proto'd to 2 scalars

# this one isn't auto-exported, but could be called!
#sub func4(\%)  { .... }    # proto'd to 1 hash ref

END { }       # module clean-up code here (global destructor)

1;