#!/usr/bin/perl

# blinken movie converter: blinkenconv
# version 0.2.0 date 2004-11-06
# Copyright 2004: Stefan Schuermans <1stein@schuermans.info>
# Copyleft: GNU public license - http://www.gnu.org/copyleft/gpl.html

use strict;

print <<EOF;
blinken movie converter: blinkenconv
version 0.2.0 date 2004-11-06
Copyright 2004: Stefan Schuermans <1stein\@schuermans.info>
Copyleft: GNU public license - http://www.gnu.org/copyleft/gpl.html

EOF

if (@ARGV < 1) {
  print <<EOF;
syntax: blinkenconv [<options>] <input-file> <output-file>

options: --in-(blm|bmm|bml|bbm):   assume (blm|bmm|bml|bbm) input file
         --out-(blm|bmm|bml|bbm):  generate (blm|bmm|bml|bbm) output file
         --print:                  print movie after reading it

example: ./blinkenkenconv movie.blm movie.bml
EOF
  exit;
}

$| = 1; # enable autoflush



# process parameters
my $arg;
my $in_fmt = "";
my $out_fmt = "";
my $in_file = "";
my $out_file = "";
my $print_movie = 0;

for ($arg = 0; $arg < @ARGV; $arg++) {

  # input file type
  if ($ARGV[$arg] =~ m/--in-(blm|bmm|bml|bbm)/) {
    $in_fmt = $1;
  }

  # output file type
  elsif ($ARGV[$arg] =~ m/--out-(blm|bmm|bml|bbm)/) {
    $out_fmt = $1;
  }

  # print movie
  elsif ($ARGV[$arg] eq '--print') {
    $print_movie = 1;
  }

  # unknown option
  elsif (substr($ARGV[$arg], 0, 1) eq "-") {
    die "unknown option: " . $ARGV[$arg] . "\n";
  }

  # input file
  elsif ($in_file eq "") {
    $in_file = $ARGV[$arg];
  }

  # output file
  elsif ($out_file eq "") {
    $out_file = $ARGV[$arg];
  }

  # parameter error
  else {
    die "parameter error: " . $ARGV[$arg] . "\n";
  }

} # for ($arg ...

die "parameter error: input file missing" if ($in_file eq "");



my ($dims, $infos, $delays, $frames);
my $i;

# read input file
($dims, $infos, $delays, $frames) = read_b ($in_file, $in_fmt);

# print movie
print_movie ($dims, $infos, $delays, $frames) if ($print_movie);

# write output file
write_b ($out_file, $out_fmt, $dims, $infos, $delays, $frames) if ($out_file ne "");

# end of main program



# read a blinken file
# tries to identifiy the file type
# calls the appropriate function to read the file
# usage: ($dims, $infos, $delays, $frames) = read_b($file, $fmt);
sub read_b {
  my $file = shift;
  my $fmt = shift;
  my $magic;
  my $line;

  # known formats
  return read_blm ($file) if ($fmt eq "blm");
  return read_bmm ($file) if ($fmt eq "bmm");
  return read_bml ($file) if ($fmt eq "bml");
  return read_bbm ($file) if ($fmt eq "bbm");

  # try to guess format
  open (F, $file) or die "read_b: can't open input file \"$file\": $!\n";
  binmode F;
  read (F, $magic, 4);
  if ($magic eq pack ('CCCC', 0x23, 0x54, 0x26, 0x66)) {
    close F;
    return read_bbm ($file);
  }
  close F;
  open (F, $file) or die "read_b: can't open input file \"$file\": $!\n";
  while ($line = <F>) {
    chomp $line;
    chomp $line;
    if ($line =~ / *# *BlinkenLights Movie/i) {
      close F;
      return read_blm ($file);
    }
    if ($line =~ / *# *BlinkenMini Movie/i) {
      close F;
      return read_bmm ($file);
    }
    if ($line =~ /<blm[> ]/i) {
      close F;
      return read_bml ($file);
    }
  }
  close F;
  die "read_b: unknown file format in input file \"$file\"\n";
}

# read a blm file
# usage: ($dims, $infos, $delays, $frames) = read_blm($file);
sub read_blm {
  my $file = shift;
  my @dims = ();
  my @infos = ();
  my @delays = ();
  my @frames = ();
  my $line_no;
  my $line;
  my @values;
  open (F, $file) or die "read_blm: can't open input file \"$file\": $!\n";
  print "reading blm \"$file\" ";
  $line_no = 0;  
  foreach $line (<F>) {
    chomp $line;
    chomp $line;
    $line_no++;
    if ($line =~ /^ *# *BlinkenLights Movie *([0-9]+)x([0-9]+) *$/i) {
      if (@dims > 0) {
        print "\n";
        die "read_blm: \"$file\" (line $line_no) contains multiple movie dimension specifications\n";
      }
      if ($1 < 1 || $1 > 1000 || $2 < 1 || $2 > 1000) {
        print "\n";
        die "read_blm: \"$file\" (line $line_no) contains invalid movie dimensions ($2x$1)\n";
      }
      @dims = ($2, $1, 1); # height, width, channels
    }
    if ($line =~ m/^ *# ([A-Za-z0-9]+)( = |: )(.*)$/) {
      push (@infos, [($1, $3)]);
    }
    $line =~ s/#.*//;
    next unless $line =~ /\S+/;
    if (@dims == 0) {
      print "\n";
      die "read_blm: \"$file\" does not contain movie dimensions in header line\n";
    }
    if ($line =~ /^\@(\d+)/) {
      if (@delays > 0 && @{$frames[$#delays]} != $dims[0]) {
        print "\n";
        die "read_blm: \"$file\" (line $line_no): frame ".@delays." does not contain ".$dims[0]." rows\n";
      }
      push (@delays, bound ($1, 1, 60000));
      print ".";
      next;
    }
    if (@delays == 0) {
      print "\n";
      die "read_blm: \"$file\" (line $line_no): found pixel data before start of first frame\n";
    }
    @values = split(undef,$line);
    $_ = pack ('C', int ($_) ? 0xFF : 0x00) foreach (@values);
    push (@{$frames[$#delays]}, [@values]); 
    if (@values != $dims[1]) {
      print "\n";
      die "read_blm: \"$file\" (line $line_no): row ".@{$frames[$#delays]}." of frame ".@delays." does not contain ".$dims[1]." pixels\n";
    }
  }
  if (@{$frames[$#delays]} != $dims[0]) {
    print "\n";
    die "read_blm: \"$file\" (line $line_no): frame ".@delays." does not contain ".$dims[0]." rows\n";
  }
  close F;
  print "\n";
  return ([@dims], [@infos], [@delays], [@frames]);
}

# read a bmm file
# usage: ($dims, $infos, $delays, $frames) = read_bmm($file);
sub read_bmm {
  my $file = shift;
  my @dims = ();
  my @infos = ();
  my @delays = ();
  my @frames = ();
  my $line_no;
  my $line;
  my @values;
  open (F, $file) or die "read_bmm: can't open input file \"$file\": $!\n";
  print "reading bmm \"$file\" ";
  $line_no = 0;  
  foreach $line (<F>) {
    chomp $line;
    chomp $line;
    $line_no++;
    if ($line =~ /^ *# *BlinkenMini Movie *([0-9]+)x([0-9]+) *$/i) {
      if (@dims > 0) {
        print "\n";
        die "read_bmm: \"$file\" (line $line_no) contains multiple movie dimension specifications\n";
      }
      if ($1 < 1 || $1 > 1000 || $2 < 1 || $2 > 1000) {
        print "\n";
        die "read_bmm: \"$file\" (line $line_no) contains invalid movie dimensions ($2x$1)\n";
      }
      @dims = ($2, $1, 1); # height, width, channels
    }
    if ($line =~ m/^ *# ([A-Za-z0-9]+)( = |: )(.*)$/) {
      push (@infos, [($1, $3)]);
    }
    $line =~ s/#.*//;
    next unless $line =~ /\S+/;
    if (@dims == 0) {
      print "\n";
      die "read_bmm: \"$file\" does not contain movie dimensions in header line\n";
    }
    if ($line =~ /^\@(\d+)/) {
      if (@delays > 0 && @{$frames[$#delays]} != $dims[0]) {
        print "\n";
        die "read_bmm: \"$file\" (line $line_no): frame ".@delays." does not contain ".$dims[0]." rows\n";
      }
      push (@delays, bound ($1, 1, 60000));
      print ".";
      next;
    }
    if (@delays == 0) {
      print "\n";
      die "read_bmm: \"$file\" (line $line_no): found pixel data before start of first frame\n";
    }
    @values = split(/[ \t]+/,$line);
    $_ = pack ('C', abs (substr ($_, 0, 1) eq "0" ? int (oct $_) : int ($_)) & 0xFF) foreach (@values);
    push (@{$frames[$#delays]}, [@values]); 
    if (@values != $dims[1]) {
      print "\n";
      die "read_bmm: \"$file\" (line $line_no): row ".@{$frames[$#delays]}." of frame ".@delays." does not contain ".$dims[1]." pixels\n";
    }
  }
  if (@{$frames[$#delays]} != $dims[0]) {
    print "\n";
    die "read_bmm: \"$file\" (line $line_no): frame ".@delays." does not contain ".$dims[0]." rows\n";
  }
  close F;
  print "\n";
  return ([@dims], [@infos], [@delays], [@frames]);
}

# read a bml file
# usage: ($dims, $infos, $delays, $frames) = read_bml($file);
sub read_bml {
  my $file = shift;
  my @infos = ();
  my @delays = ();
  my @frames = ();
  my $width = 0;
  my $height = 0;
  my $bits = 0;
  my $channels = 0;
  my $line_no;
  my $line;
  my $desc;
  my $pixel;
  open (F, $file) or die "read_bml: can't open input file \"$file\": $!\n";
  print "reading bml \"$file\" ";
  $line_no = 0;
  foreach $line (<F>) {
    while ($line ne "") {
      $line_no++;
      if ($line =~ s/^[^<]*<blm([^>]*)>//) {
        my $blm = $1;
        if ($blm =~ /width="?([0-9]*)"?/) {
          $width = $1;
          die "read_bml: \"$file\" (line $line_no): invalid width $width\n" if ($width < 1 || $width > 1000);
        }
        if ($blm =~ /height="?([0-9]*)"?/) {
          $height = $1;
          die "read_bml: \"$file\" (line $line_no): invalid height $height\n" if ($height < 1 || $height > 1000);
        }
        if ($blm =~ /bits="?([0-9]*)"?/) {
          $bits = $1;
          die "read_bml: \"$file\" (line $line_no): invalid number of bits $bits\n" if ($bits < 1 || $bits > 8);
        }
        if ($blm =~ /channels="?([0-9]*)"?/) {
          $channels = $1;
          die "read_bml: \"$file\" (line $line_no): invalid number of channels $channels\n" if ($channels < 1 || $channels > 20);
        }
      }
      elsif ($line =~ s/^[^<]*<title>([^<]*)<\/title>//) {
        push (@infos, [("title", $1)]);
      }
      elsif ($line =~ s/^[^<]*<description>([^<]*)<\/description>//) {
        $desc = $1;
        if ($desc =~ m/^([A-Za-z0-9]+)( = |: )(.*)$/) {
          push (@infos, [($1, $3)]);
        }
        else {
          push (@infos, [("description", $desc)]);
        }
      }
      elsif ($line =~ s/^[^<]*<creator>([^<]*)<\/creator>//) {
        push (@infos, [("creator", $1)]);
      }
      elsif ($line =~ s/^[^<]*<author>([^<]*)<\/author>//) {
        push (@infos, [("author", $1)]);
      }
      elsif ($line =~ s/^[^<]*<email>([^<]*)<\/email>//) {
        push (@infos, [("email", $1)]);
      }
      elsif ($line =~ s/^[^<]*<url>([^<]*)<\/url>//) {
        push (@infos, [("url", $1)]);
      }
      elsif ($line =~ s/^[^<]*<frame([^>]*)>//) {
        my $frm = $1;
        my $duration = 1000;
        if ($frm =~ /duration="?([0-9]*)"?/) {
          $duration = bound ($1, 1, 60000);
        }
        if (@delays > 0 && @{$frames[$#delays]} != $height) {
          print "\n";
          die "read_bml: \"$file\" (line $line_no): frame ".@delays." does not contain ".$height." rows\n";
        }
        push (@delays, $duration);
        print ".";
      }
      elsif ($line =~ s/^[^<]*<row>([^<]*)<\/row>//) {
        my $row = $1;
        if ($height == 0 || $width == 0 || $channels == 0 || $bits == 0) {
          print "\n";
          die "read_bml: \"$file\" (line $line_no) contains pixel data before dimension information\n";
        }
        if (@delays == 0) {
          print "\n";
          die "read_bmm: \"$file\" (line $line_no): found pixel data before start of first frame\n";
        }
        $row =~ s/[^0-9A-Fa-f]//g;
        my $chrs = int (($bits + 3) / 4);
        my $maxval = ((1 << $bits) - 1) * $channels;
        my @values = ();
        my $i;
        my $v;
        while (length ($row) >= $chrs * $channels)
        {
          $pixel = "";
          for ($i = 0; $i < $channels; $i++) {
            $row =~ s/([0-9A-Fa-f]{$chrs})//;
            $pixel .= pack ('C', abs (int ((hex $1) * 0xFF / $maxval)) & 0xFF);
          }
          push (@values, $pixel);
        }
        push (@{$frames[$#delays]}, [@values]); 
        if (@values != $width) {
          print "\n";
          die "read_bml: \"$file\" (line $line_no): row ".@{$frames[$#delays]}." of frame ".@delays." does not contain $width pixels\n";
        }
      }
      elsif ($line =~ s/^[^<]*<[^>]*>//) { }
      else { $line = ""; }
    }
  }
  if (@{$frames[$#delays]} != $height) {
    print "\n";
    die "read_bml: \"$file\" (line $line_no): frame ".@delays." does not contain ".$height." rows\n";
  }
  close F;
  print "\n";
  return ([($height, $width, $channels)], [@infos], [@delays], [@frames]);
}

# read a bbm file
# usage: ($dims, $infos, $delays, $frames) = read_bbm($file);
sub read_bbm {
  my $file = shift;
  my @infos = ();
  my @delays = ();
  my @frames = ();
  my $width = 0;
  my $height = 0;
  my $channels = 0;
  my $maxval = 0;
  my ($framecnt, $duration, $frameptr);
  my ($magic, $v, $cnt, $data, $delay, $x, $y);
  my @vv;
  my @frame;
  my @row;
  # open file
  open (F, $file) or die "read_bbm: can't open input file \"$file\": $!\n";
  binmode F;
  print "reading bml \"$file\" ";
  # read header
  read (F, $magic, 4) or die "read_bbm: \"$file\" does not contain a correct header\n"; # magic
  if ($magic ne pack ('CCCC', 0x23, 0x54, 0x26, 0x66)) {
    die "read_bbm: \"$file\" does not contain the bbm magic\n";
  }
  read (F, $v, 2) or die "read_bbm: \"$file\" does not contain a correct header\n"; # height
  @vv = unpack ('CC', $v);
  $height = $vv[0] << 8 | $vv[1];
  die "read_bbm: \"$file\" contains invalid height $height\n" if ($height < 1 || $height > 1000);
  read (F, $v, 2) or die "read_bbm: \"$file\" does not contain a correct header\n"; # width
  @vv = unpack ('CC', $v);
  $width = $vv[0] << 8 | $vv[1];
  die "read_bbm: \"$file\" contains invalid width $width\n" if ($width < 1 || $width > 1000);
  read (F, $v, 2) or die "read_bbm: \"$file\" does not contain a correct header\n"; # channels
  @vv = unpack ('CC', $v);
  $channels = $vv[0] << 8 | $vv[1];
  die "read_bbm: \"$file\" contains invalid number of channels $channels\n" if ($channels < 1 || $channels > 20);
  read (F, $v, 2) or die "read_bbm: \"$file\" does not contain a correct header\n"; # maxval
  @vv = unpack ('CC', $v);
  $maxval = $vv[0] << 8 | $vv[1];
  die "read_bbm: \"$file\" contains invalid maximum value $maxval\n" if ($maxval < 1 || $maxval > 255);
  read (F, $v, 4) or die "read_bbm: \"$file\" does not contain a correct header\n"; # framecnt
  @vv = unpack ('CCCC', $v);
  $framecnt = $vv[0] << 24 | $vv[1] << 16 | $vv[2] << 8 | $vv[3];
  read (F, $v, 4) or die "read_bbm: \"$file\" does not contain a correct header\n"; # duration
  @vv = unpack ('CCCC', $v);
  $duration = $vv[0] << 24 | $vv[1] << 16 | $vv[2] << 8 | $vv[3];
  read (F, $v, 4) or die "read_bbm: \"$file\" does not contain a correct header\n"; # frameptr
  @vv = unpack ('CCCC', $v);
  $frameptr = $vv[0] << 24 | $vv[1] << 16 | $vv[2] << 8 | $vv[3];
  if ($frameptr < 24) {
    die "read_bbm: \"$file\" contains an invalid frame pointer\n";
  }
  # additional headers
  $cnt = $frameptr - 24;
  while ($cnt >= 6) {
    read (F, $magic, 4) or die "read_bbm: \"$file\" is truncated before start of pixel data\n";
    read (F, $v, 2) or die "read_bbm: \"$file\" is truncated before start of pixel data\n";
    @vv = unpack ('CC', $v);
    $v = $vv[0] << 8 | $vv[1];
    die "read_bbm: \"$file\" contains an invalid additional header length\n" if ($v < 6);
    if( $v > $cnt ) {
      die "read_bbm: \"$file\": frame pointer points into additonal header\n";
    }
    read (F, $data, $v - 6) or die "read_bbm: \"$file\" is truncated before start of pixel data\n";
    $cnt -= $v;
    # info header
    if ($magic eq "info" && $data =~ /([^\0]*)\0([^\0]*)\0/) {
      push (@infos, [($1, $2)]);
    }
    # frame start marker
    if ($magic eq "frms") {
      die "read_bbm: \"$file\" contains frame start marker within additional headers\n";
    }
  }
  # frame start marker
  read (F, $v, 4) or die "read_bbm: \"$file\" does not contain a frame start marker\n";
  die "read_bbm: \"$file\" contains an invalid frame start marker\n" if ($v ne "frms");
  # frames
  while (1) {
    # duration
    read (F, $v, 2) or last; # exit loop at EOF
    @vv = unpack ('CC', $v);
    $delay = $vv[0] << 8 | $vv[1];
    # frame data
    @frame = ();
    for ($y = 0; $y < $height; $y++) {
      @row = ();
      for ($x = 0; $x < $width; $x++) {
        read (F, $v, $channels) or last; # exit loop at EOF
        push (@row, $v);
      }
      push (@frame, [@row]);
    }
    # add frame
    push (@delays, $delay);
    print ".";
    push (@frames, [@frame]); 
  }
  # close file
  close F;
  print "\n";
  return ([($height, $width, $channels)], [@infos], [@delays], [@frames]);
}



# print a movie
# usage: print_movie ($dims, $infos, $delays, $frames)
sub print_movie {
  my $dims = shift;
  my $infos = shift;
  my $delays = shift;
  my $frames = shift;
  my $i;
  print "dimensions=" . @{$dims}[1] . "x" . @{$dims}[0] . "-" . @{$dims}[2] . "\n";
  foreach (@{$infos}) {
    print @{$_}[0] . ": " . @{$_}[1] . "\n";
  }
  for ($i = 0; $i < @{$delays}; $i++) {
    print "frame ".$i.": ".@{$delays}[$i]." ms\n";
    print_frame (@{$frames}[$i]);
    print "\n";
  }
}

# print a frame
# usage: print_frame ($frame)
sub print_frame {
  my $frame = shift;
  my $v;
  foreach (@{$frame}) {
    foreach (@{$_}) {
      $v = 0;
      $v += unpack ('C', $_) foreach (split(undef, $_));
      $v /= length ($_);
      printf substr (' .,:;-+/*%@#8&$§', $v >> 4, 1);
    }
    print "\n";
  }
}



# write a blinken file
# tries to guess the file type from the extension
# calls the appropriate function to write the file
# usage: write_b ($file, $fmt, $dims, $infos, $delays, $frames)
sub write_b {
  my $file = shift;
  my $fmt = shift;
  my $dims = shift;
  my $infos = shift;
  my $delays = shift;
  my $frames = shift;

  # known formats
  return write_blm ($file, $dims, $infos, $delays, $frames) if ($fmt eq "blm");
  return write_bmm ($file, $dims, $infos, $delays, $frames) if ($fmt eq "bmm");
  return write_bml ($file, $dims, $infos, $delays, $frames) if ($fmt eq "bml");
  return write_bbm ($file, $dims, $infos, $delays, $frames) if ($fmt eq "bbm");

  # try to guess file type
  return write_blm ($file, $dims, $infos, $delays, $frames) if ($file =~ /\.blm$/);
  return write_bmm ($file, $dims, $infos, $delays, $frames) if ($file =~ /\.bmm$/);
  return write_bml ($file, $dims, $infos, $delays, $frames) if ($file =~ /\.bml$/);
  return write_bbm ($file, $dims, $infos, $delays, $frames) if ($file =~ /\.bbm$/);

  # format is unknown
  die "write_b: unknown file format for output file \"$file\"\n";
}

# write a blm file
# usage: write_blm ($file, $dims, $infos, $delays, $frames)
sub write_blm {
  my $file = shift;
  my $dims = shift;
  my $infos = shift;
  my $delays = shift;
  my $frames = shift;
  my ($i, $v, $frame, $row, $pixel);
  open (F, ">" . $file) or die "write_blm: can't open output file \"$file\": $!\n";
  print "writing blm \"$file\" ";
  print F "# BlinkenLights Movie " . @{$dims}[1] . "x" . @{$dims}[0] . "\n";
  foreach (@{$infos}) {
    print F "# " . @{$_}[0] . " = " . @{$_}[1] . "\n";
  }
  for ($i = 0; $i < @{$delays}; $i++) {
    print ".";
    print F "\n@" . @{$delays}[$i] . "\n";
    $frame = @{$frames}[$i];
    foreach $row (@{$frame}) {
      foreach $pixel (@{$row}) {
        $v = 0;
        $v += unpack ('C', $_) foreach (split(undef, $pixel));
        $v /= length ($pixel);
        print F $v >= 0x80 ? "1" : "0";
      }
      print F "\n";
    }
  }
  close F;
  print "\n";
}

# write a bmm file
# usage: write_bmm ($file, $dims, $infos, $delays, $frames)
sub write_bmm {
  my $file = shift;
  my $dims = shift;
  my $infos = shift;
  my $delays = shift;
  my $frames = shift;
  my ($i, $v, $frame, $row, $pixel);
  open (F, ">" . $file) or die "write_bmm: can't open output file \"$file\": $!\n";
  print "writing bmm \"$file\" ";
  print F "# BlinkenMini Movie " . @{$dims}[1] . "x" . @{$dims}[0] . "\n";
  foreach (@{$infos}) {
    print F "# " . @{$_}[0] . " = " . @{$_}[1] . "\n";
  }
  for ($i = 0; $i < @{$delays}; $i++) {
    print ".";
    print F "\n@" . @{$delays}[$i] . "\n";
    $frame = @{$frames}[$i];
    foreach $row (@{$frame}) {
      foreach $pixel (@{$row}) {
        $v = 0;
        $v += unpack ('C', $_) foreach (split(undef, $pixel));
        $v /= length ($pixel);
        printf F "0x%02X ", $v;
      }
      print F "\n";
    }
  }
  close F;
  print "\n";
}

# write a bml file
# usage: write_bml ($file, $dims, $infos, $delays, $frames)
sub write_bml {
  my $file = shift;
  my $dims = shift;
  my $infos = shift;
  my $delays = shift;
  my $frames = shift;
  my ($type, $info, $i, $v, $frame, $row, $pixel);
  open (F, ">" . $file) or die "write_bml: can't open output file \"$file\": $!\n";
  print "writing bml \"$file\" ";
  print F "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n";
  print F "<blm width=\"" . @{$dims}[1] . "\" height=\"" . @{$dims}[0] . "\" bits=\"8\" channels=\"" . @{$dims}[2] . "\">\n";
  print F "\t<header>\n";
  foreach (@{$infos}) {
    $type = @{$_}[0];
    $info = @{$_}[1];
    if ($type eq "title") {
      print F "\t\t<title>$info</title>\n";
    }
    elsif ($type eq "description") {
      print F "\t\t<description>$info</description>\n";
    }
    elsif ($type eq "creator") {
      print F "\t\t<creator>$info</creator>\n";
    }
    elsif ($type eq "author") {
      print F "\t\t<author>$info</author>\n";
    }
    elsif ($type eq "email") {
      print F "\t\t<email>$info</email>\n";
    }
    elsif ($type eq "url") {
      print F "\t\t<url>$info</url>\n";
    }
    else {
      print F "\t\t<description>".$type.": ".$info."</description>\n";
    }
  }
  print F "\t</header>\n";
  for ($i = 0; $i < @{$delays}; $i++) {
    print ".";
    print F "\n\t<frame duration=\"" . @{$delays}[$i] . "\">\n";
    $frame = @{$frames}[$i];
    foreach $row (@{$frame}) {
      print F "\t\t<row>";
      foreach $pixel (@{$row}) {
        printf F "%02X", unpack ('C', $_) foreach (split(undef, $pixel));
      }
      print F "</row>\n";
    }
    print F "\t</frame>\n";
  }
  print F "</blm>\n";
  close F;
  print "\n";
}

# write a bbm file
# usage: write_bbm ($file, $dims, $infos, $delays, $frames)
sub write_bbm {
  my $file = shift;
  my $dims = shift;
  my $infos = shift;
  my $delays = shift;
  my $frames = shift;
  my ($i, $v, $frame, $row, $pixel);
  open (F, ">" . $file) or die "write_bbm: can't open output file \"$file\": $!\n";
  binmode F;
  print "writing bbm \"$file\" ";
  print F pack ('CCCC', 0x23, 0x54, 0x26, 0x66); # magic
  print F pack ('CC', (@{$dims}[0] >> 8) & 0xFF, @{$dims}[0] & 0xFF); # height
  print F pack ('CC', (@{$dims}[1] >> 8) & 0xFF, @{$dims}[1] & 0xFF); # width
  print F pack ('CC', (@{$dims}[2] >> 8) & 0xFF, @{$dims}[2] & 0xFF); # channels
  print F pack ('CC', 0x00, 0xFF); # maxval
  print F pack ('CCCC', (@{$delays} >> 24) & 0xFF, (@{$delays} >> 16) & 0xFF, (@{$delays} >> 8) & 0xFF, @{$delays} & 0xFF); # framecnt
  $v = 0; # duration
  $v += $_ foreach (@{$delays});
  print F pack ('CCCC', ($v >> 24) & 0xFF, ($v >> 16) & 0xFF, ($v >> 8) & 0xFF, $v & 0xFF);
  $v = 24; # frameptr
  $v += 8 + length (@{$_}[0]) + length (@{$_}[1]) foreach (@{$infos});
  print F pack ('CCCC', ($v >> 24) & 0xFF, ($v >> 16) & 0xFF, ($v >> 8) & 0xFF, $v & 0xFF);
  foreach (@{$infos}) { # info headers
    $v = @{$_}[0] . "\0" . @{$_}[1] . "\0";
    $i = 6 + length ($v);
    print F "info" . pack ('CC', ($i >> 8) & 0xFF, $i & 0xFF) . $v;
  }
  print F "frms"; # frame start marker
  for ($i = 0; $i < @{$delays}; $i++) { # frames
    print ".";
    print F pack ('CC', (@{$delays}[$i] >> 8) & 0xFF, @{$delays}[$i] & 0xFF); # duration
    $frame = @{$frames}[$i]; #pixels
    foreach $row (@{$frame}) {
      foreach $pixel (@{$row}) {
        printf F $pixel;
      }
    }
  }
  close F;
  print "\n";
}



# bound a value
# usage: $val = bound ($val, $lower, $upper);
sub bound {
  my ($val, $lower, $upper) = @_;
  return min (max ($val, $lower), $upper);
}

# minimum value
# usage: $min = min ($a, $b, ...);
sub min {
  my $val = shift;
  foreach (@_) {
    $val = $_ if ($_ < $val);
  }
  return $val;
}

# maximum value
# usage: $max = max ($a, $b, ...);
sub max {
  my $val = shift;
  foreach (@_) {
    $val = $_ if ($_ > $val);
  }
  return $val;
}