The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!perl
# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl test.pl'

# =======================================================================
# The code used in this test script to generate an MNG file
# is a variant of the code from the following source:
#
#   MNGcount Plus Ver.0.02
#      akihiro@ua.airnet.ne.jp
#      http://www5.airnet.ne.jp/dct/
# =======================================================================



#########################

# change 'tests => 1' to 'tests => last_test_to_print';

use strict;
use Test;
BEGIN { plan tests => 52 };
use Graphics::MNG;
ok(1); # If we made it this far, we're ok.

#########################

# Insert your test code below, the Test module is use()ed here so read
# its man page ( perldoc Test ) for help writing this test script.

use Graphics::MNG qw( :util_fns :chunk_names MNG_FUNCTIONINVALID MNG_ACCESS_CHUNKS MNG_STORE_CHUNKS );
ok(1);   # loaded an export-ok constant

use FileHandle;
use Cwd;
use Data::Dumper;
use constant FILENAME  => 'tmpfile1.mng';
use constant CHECKNAME => 'counter.mng';
use constant COUNT     => 'count.txt';

# global variables
my $oldcount = 1003875892;   # has to match test graphic
my $count    = $oldcount+1;


# horizontal or vertical counter?
my $vstyle = 0;

# array of PNG objects to insert into our MNG stream
my @png_objects;
my @count;
my @oldcount;


if ( !MNG_ACCESS_CHUNKS || !MNG_STORE_CHUNKS )
{
   my $msg = <<EOF;
   Your version of libmng is not built with both MNG_ACCESS_CHUNKS
   and MNG_STORE_CHUNKS defined.  This test requires those features.
   Please adjust compiler definitions in Makefile.PL and/or rebuild
   your version of libmng with these options
EOF

   print $msg;
   warn $msg;
   exit(0);
}


# open(STDERR,">log1.txt");
main();
exit(0);


#---------------------------------------------------------------------------
sub max { return $_[0] > $_[1] ? $_[0] : $_[1]; }

#---------------------------------------------------------------------------
sub min { return $_[0] < $_[1] ? $_[0] : $_[1]; }

#---------------------------------------------------------------------------
sub get_filename($)
{
   my ($fn) = @_;
   my ($match) = grep { -r $_ } ( $fn, "t/$fn" );
   return $match || ( -d 't' ? "t/$fn" : $fn );
}


#---------------------------------------------------------------------------
sub get_count($)
{
   my ( $fn ) = @_;
   my $count = 0;
   if( open(CNT, get_filename($fn)) )
   {
      $count = <CNT>;
      close CNT;
   }
   return $count;
}


#---------------------------------------------------------------------------
sub main
{
   my $rv;

   # set up our counts
   $oldcount = get_count(COUNT);
   $count    = $oldcount+1;

   # figure out how many columns we have
   my $row = min(100, length( $count ));

   # get the characters of the numbers into same-sized arrays
   @count    = split('', sprintf("%0${row}d", $count   ) );
   @oldcount = split('', sprintf("%0${row}d", $oldcount) );

   my %hash = map { $_ => 1 } ( @count, @oldcount );

   # sparsly populate our object array
   foreach my $num (keys %hash)
   {
      ( $rv, @png_objects->[$num] ) =
         FileReadChunks(get_filename("$num.png"));
      last unless $rv==MNG_NOERROR;
   }
   ok($rv,MNG_NOERROR,"reading in all PNG files");

   $rv = writefile(FILENAME);
   ok($rv,MNG_NOERROR,"writing the MNG file");

   ($rv) = FileReadChunks(get_filename(FILENAME));
   ok($rv,MNG_NOERROR,"re-read the MNG file");

   $rv = compare_files( FILENAME, CHECKNAME );
   ok($rv,0,"in/out file comparsion");

   # clean up
   unlink( get_filename(FILENAME) );
}


#---------------------------------------------------------------------------
sub compare_files
{
   use FileHandle;
   my ( $f1, $f2 ) = @_;

   return "missing $f1" unless ( -e get_filename($f1) );
   return "missing $f2" unless ( -e get_filename($f2) );

   local ( $/ ) = undef;
   my @data;

   foreach my $fn ( map { get_filename($_) } ( $f1, $f2 ) )
   {
      my $fh = new FileHandle($fn);
      if ( $fh )
      {
         binmode $fh;
         my $data = <$fh>;
         push( @data, $data );
      }
      undef $fh;
   }

   warn("Didn't read both files $f1 and $f2\n") unless ( @data >= 2 );
   warn("Length of $f1 != length of $f2\n")
      if ( length($data[0]) != length($data[1]) );

   my $rv = $data[0] cmp $data[1];
   return $rv;
}


#---------------------------------------------------------------------------
sub writefile
{
   my ($outfile)  = @_;
   my $firstmove  = 0;
   my $object_id  = 0; 
   my $height_all = 0;
   my $width_all  = 0;
   my $rv;
   my $PLTE;
   my $tRNS;


   # get information about the PNG images
   foreach my $obj ( @png_objects )
   {
      next unless defined $obj;
      my $userdata    = $obj->get_userdata();
      my $width_this  = $userdata->{'width'};
      my $height_this = $userdata->{'height'};

      $width_all  = max($width_all,$width_this);
      $height_all = max($height_all,$height_this);

      $PLTE = @{ $userdata->{'PLTE'} || [] }->[-1];
      $tRNS = @{ $userdata->{'tRNS'} || [] }->[-1];
   }

   # now scale these numbers vertically or horizontally
   $height_all *= int @count if( $vstyle );
   $width_all  *= int @count if( !$vstyle );

   # now make the object
   my $obj = new Graphics::MNG();

   # hook up the callbacks
   $rv = $obj->set_userdata( { 'filename' => $outfile,
                               'fh'       => undef,
                               'fperms'   => 'w',
                               'width'    => 0,
                               'height'   => 0,
                             } );
   ok($rv,MNG_NOERROR,"setting userdata");

   $rv = $obj->setcb_openstream   ( \&FileOpenStream );
   ok($rv,MNG_NOERROR,"registering the openstream callback");

   $rv = $obj->setcb_closestream  ( \&FileCloseStream );
   ok($rv,MNG_NOERROR,"registering the closestream callback");

   $rv = $obj->setcb_writedata    ( \&FileWriteData );
   ok($rv,MNG_NOERROR,"registering the filewritedata callback");

   # indicate that we're going to make a new file...
   $rv = $obj->create();
   ok($rv,MNG_NOERROR,"creating the file");

   # now insert the header information
   $rv = $obj->putchunk_info( MNG_UINT_MHDR, { iWidth => $width_all, iHeight => $height_all, iTicks => 30, iSimplicity => 15 } );
   ok($rv,MNG_NOERROR,"writing mhdr"); 

   $rv = $obj->putchunk_info( MNG_UINT_TERM );
   ok($rv,MNG_NOERROR,"writing term"); 


   # if we picked up a palette or transparency information from the PNG files, include it now.
   $rv = $obj->putchunk_info($PLTE) if ( $PLTE );
   ok($rv,MNG_NOERROR,"writing plte"); 
   
   $rv = $obj->putchunk_info($tRNS) if ( $tRNS );
   ok($rv,MNG_NOERROR,"writing trns"); 


   # Add all of the needed numbers (from the PNG files) into this MNG file as objects
   my $xpos   = 0; 
   my $ypos  = 0; 
   foreach my $num ( @count ) {
      $object_id++;
      my $oldnum = $oldcount[ $object_id - 1 ];
      my $numChanged = ($num ne $oldnum) ? 1 : 0;
      my @files = ($oldnum,$num);
      my $tmp;

      # make an image definition for the number(s) to display.
      # if the number will change, also make a definition for the new image.
      for my $changed ( reverse(0..$numChanged) )
      {
         $firstmove ||= $object_id if $changed;

         $rv = $obj->putchunk_info( MNG_UINT_DEFI,
                                    {
                                       iObjectid  => $object_id + $changed*100,
                                       iDonotshow => 1,
                                       iConcrete  => 1,
                                       bHasloca   => MNG_TRUE,
                                       iXlocation => $vstyle ? 0 : $xpos,
                                       iYlocation => $vstyle ? $ypos : 0,
                                    }
                                  );
         ok($rv,MNG_NOERROR,"writing defi chunk"); 

         # this will magically insert all of the chunks
         my $pngfile =  @files->[$changed];
         my ( $rv, $width_this, $height_this ) = insert_chunks($obj, $pngfile);
         ok($rv,MNG_NOERROR,"inserted file $num-$changed"); 

         if ( !$changed )
         {
            $ypos += $height_this if ( $vstyle );
            $xpos += $width_this  if ( !$vstyle );
         }

         last unless $rv==MNG_NOERROR;
      }
   }


   # start a frame, specify no background except for one ahead of the very first image
   $rv = $obj->putchunk_info(MNG_UINT_FRAM, { iMode => 2 } );
   ok($rv,MNG_NOERROR,"writing fram"); 


   # move the "special" images (down) out of the clipping area
   # now they no longer overlap the original numbers
   $rv = $obj->putchunk_info( MNG_UINT_MOVE,
                              {
                                 iFirstid  => 101,
                                 iLastid   => 200,
                                 iMovetype => 1,
                                 iMovex    => $vstyle ? $width_all : 0, 
                                 iMovey    => $vstyle ? 0 : $height_all,
                              }
                            );
   ok($rv,MNG_NOERROR,"writing move"); 


   # show all objects inside of the clipping range
   $rv = $obj->putchunk_info( MNG_UINT_SHOW, { iFirstid => 1, iLastid => 200 } );
   ok($rv,MNG_NOERROR,"writing show"); 


   # now define a loop to execute the animation (length = height in pixels)
   $rv = $obj->putchunk_info( MNG_UINT_LOOP, { iLevel => 1, iRepeat => $vstyle ? $width_all : $height_all } );
   ok($rv,MNG_NOERROR,"writing loop"); 


   # start a frame, do not change framing mode
   $rv = $obj->putchunk_info( MNG_UINT_FRAM );
   ok($rv,MNG_NOERROR,"writing fram"); 


   # =======================================================
   # = this moves the images "up", one pixel at a time.
   # =======================================================

   # move all "source" objects that must change, starting with the first object
   # base movement from parent object, move deltaY=-1
   $rv = $obj->putchunk_info( MNG_UINT_MOVE,
                              {
                                 iFirstid  => $firstmove,
                                 iLastid   => 100,
                                 iMovetype => 1,
                                 iMovex    => $vstyle ? -1 : 0, 
                                 iMovey    => $vstyle ? 0 : -1,
                              } );
   ok($rv,MNG_NOERROR,"writing move"); 


   # move all "dest" objects that must change, starting with the first object
   # base movement from parent object, move deltaY=-1
   $rv = $obj->putchunk_info( MNG_UINT_MOVE,
                              {
                                 iFirstid  => 101,
                                 iLastid   => 200,
                                 iMovetype => 1,
                                 iMovex    => $vstyle ? -1 : 0, 
                                 iMovey    => $vstyle ? 0 : -1,
                              } );
   ok($rv,MNG_NOERROR,"writing move"); 


   # =======================================================
   # show all objects inside of the clipping range
   $rv = $obj->putchunk_info( MNG_UINT_SHOW, { iFirstid => 1, iLastid => 200 } );
   ok($rv,MNG_NOERROR,"writing show"); 

   # end the loop (at depth level 1)
   $rv = $obj->putchunk_info( MNG_UINT_ENDL, { iLevel => 1 } );
   ok($rv,MNG_NOERROR,"writing endl"); 

   # provide an end chunk
   $rv = $obj->putchunk_info( MNG_UINT_MEND );
   ok($rv,MNG_NOERROR,"writing mend"); 

   # now put it all together
   $rv = $obj->write();
   ok($rv,MNG_NOERROR,"writing file");

   return $rv;
}



#---------------------------------------------------------------------------
sub insert_chunks
{  # PNG Mode
   my ( $obj, $file ) = @_;
   my $rv = MNG_NOERROR;

   my $userdata = @png_objects->[$file]->get_userdata();
   my $chunks = $userdata->{'chunks'};

   foreach my $chunk ( @$chunks )
   {
      $rv = $obj->putchunk_info($chunk);
      warn("putchunk_info() failed ($rv)\n") unless defined $rv && $rv==MNG_NOERROR;
      last unless $rv==MNG_NOERROR;
   }

   my $width_this  = $userdata->{'width'};
   my $height_this = $userdata->{'height'};

   return ( $rv, $width_this, $height_this );
}