#!/usr/bin/perl

# picture scroller
# version 0.2 date 2006-07-23
# Copyright (C) 2006 Stefan Schuermans <1stein@schuermans.info>
# Copyleft: GNU public license - http://www.gnu.org/copyleft/gpl.html
# a blinkenarea.org project

use strict;

print <<EOF;

picture scroller
version 0.2 date 2006-07-23
Copyright (C) 2006 Stefan Schuermans <1stein\@schuermans.info>
Copyleft: GNU public license - http://www.gnu.org/copyleft/gpl.html
a blinkenarea.org project

EOF

# parse parameters
#
if( @ARGV < 4 ) {
	print( "usage $0 <pgm-image> <width> <height> <bml-output> [<interval>]\n\n" );
	exit -1;
}
my $pgm_input = $ARGV[0];
my $width = abs( int( $ARGV[1] ) );
my $height = abs( int( $ARGV[2] ) );
my $bml_output = $ARGV[3];
my $interval = 100;
$interval = abs( int( $ARGV[4] ) ) if( @ARGV >= 5 );

# open PGM file and read header
#
open( PGM, "<$pgm_input" );
my $dump = <PGM>;
$dump = <PGM>;
my $pgm_size = <PGM>;
$dump = <PGM>;
my ($pgm_width, $pgm_height) = $pgm_size =~ /([0-9]+) +([0-9]+)/;
$pgm_width = int( $pgm_width );
$pgm_height = int( $pgm_height );
if( $pgm_width <= 0 || $pgm_height <= 0 ) {
	print( "input is not a valid PGM file saved with GIMP as binary/raw PGM\n\n" );
	exit -1;
}
if( $width > $pgm_width ) {
	print( "PGM file width too small\n\n" );
	exit -1;
}
if( $height > $pgm_height ) {
	print( "PGM file height too small\n\n" );
	exit -1;
}

# read pixel data
#
my $pixels;
binmode( PGM );
read( PGM, $pixels, $pgm_width * $pgm_height );

# close PGM file
#
close( PGM );

# calculate parameters
#
my $frames_x = $pgm_width - $width + 1;
my $frames_y = $pgm_height - $height + 1;
my $frames = $frames_x > $frames_y ? $frames_x : $frames_y;
my $duration = $frames * $interval;

# open BML file and write header
#
open( BML, ">$bml_output" );
print BML <<EOF;
<?xml version="1.0" encoding="UTF-8"?>
<blm width="$width" height="$height" bits="8" channels="1">
  <header>
    <title>generated by scroller from $pgm_input</title>
    <creator>scroller</creator>
    <loop>no</loop>
    <duration>$duration</duration>
  </header>
EOF

# write frames
#
for( my $frame = 0; $frame < $frames; $frame++ ) {
	print( BML "  <frame duration=\"$interval\">\n" );
	my $ofs_y = $frames_y < 2 ? 0 : $frame % (2 * $frames_y - 2);
	$ofs_y = 2 * $frames_y - 2 - $ofs_y if( $ofs_y >= $frames_y );
	my $ofs_x = $frames_x < 2 ? 0: $frame % (2 * $frames_x - 2);
	$ofs_x = 2 * $frames_x - 2 - $ofs_x if( $ofs_x >= $frames_x );
	my $i = $ofs_y * $pgm_width;
	for( my $y = 0; $y < $height; $y++ ) {
		print( BML "    <row>" );
		my $j = $i + $ofs_x;
		for( my $x = 0; $x < $width; $x++ ) {
			my $pixel = substr( $pixels, $j, 1 );
			my $value = unpack( 'C', $pixel );
			printf( BML "%02X", $value );
			$j++;
		}
		print( BML "</row>\n" );
		$i += $pgm_width;
	}
	print( BML "  </frame>\n" );
}

# write footer close BLM file
#
print BML <<EOF;
</blm>
EOF
close( BML );