#!/usr/local/bin/perl

use strict;
my $version = q($Id: makecard,v 0.14 1999/08/15 08:10:39 nagoya Exp $);
my $usage = <<'USAGE';
makecard - Create multi image PS file from EPS file
You can use the script to make business card, for example.

usage: makecard [switches] < IN_FILE > OUT_FILE
swtiches are:
-help
-debug                   debug option
-showframe               print frame of each internal images
-ox=<ox> -oy=<oy>
-width=<W> -height=<H>
-xtimes=<xtimes> -ytimes=<ytimes>

Example:
  ------------------------------------------ Paper
 | <ytimes>=2                               |
 |     --------- --------- ---------        |
 |    |         |         |         |       |
 |    |  Image  |  Image  |  Image  |       |
 |    |         |         |         |       |
 |    |         |         |         |       |
 |     --------- --------- ---------        |
 |    |         |         |         |       |
 |    |  Image  |  Image  |  Image  |       |
 | <H>|         |         |         |       |
 |    |  <W>    |         |         |       |
 |    *--------- --------- ---------        |
 |   (<ox>,<oy>)                <xtimes>=3  |
 |                                          |
 *------------------------------------------
(0,0)
USAGE

my %db;
parse_commandline_options(\%db);
read_source(\%db);
compute_constants(\%db);
print_prologue(\%db);
print_script(\%db);
print_epilogue(\%db);

sub parse_commandline_options {
     my ($d, $i) = @_;
     for (@ARGV) {
	  if (/^-help/o) {
	       printf STDERR $usage;
	       exit 0;
	  } elsif (/^-([a-z]+)$/o) {
	       $d->{"opt:$1"} = 1;
	  } elsif (/^-no-([a-z]+)$/o) {
	       $d->{"opt:$1"} = 0;
	  } elsif (/^-([a-z]+)=([\d\.]+[a-z]+)$/o) {
	       $d->{"opt:$1"} = to_point($2);
	  } elsif (/^-([a-z]+)=(\S+)$/o) {
	       $d->{"opt:$1"} = $2;
	  } else {
	       printf STDERR $usage;
	       exit -1;
	  }
     }
}

# Scale chenge function
sub to_point {
     $_[0] =~ /^\s*(\d+)([a-z]*)\s*$/o
	  || die "Invalid arguments $_, stopped at";
     $2 eq 'cm' and return $1 * 72.0 / 2.54; # cm -> pt
     $2 eq 'mm' and return $1 * 72.0 / 25.4; # mm -> pt
     $2 eq 'in' and return $1 / 72.0; # in -> pt
     $2 eq 'pt' and return $1;	# pt -> pt
     return $1;	# guess implicit scale unit is 'pt'
}

# Read original source from stdin
sub read_source {
     my ($d) = @_;
     @{$d->{'Source'}} = ();
     # Read header and store DSC comment values
     while (<STDIN>) {
	  if (/%%EndComments/o) {
	       push @{$d->{'Source'}}, $_;
	       last;
	  } elsif (/%%([A-z]+): (.*)$/o) {
	       $d->{"DSC-comment:$1"} = $2;
	  }
	  push @{$d->{'Source'}}, $_;
     }
     push @{$d->{'Source'}}, <STDIN>;
}

# Compute some constants which used after steps.
sub compute_constants {
     my ($d) = @_;

     # Check Bounding box for original source
     ($d->{'x1'}, $d->{'y1'}, $d->{'x2'}, $d->{'y2'})
	  = ($d->{'DSC-comment:BoundingBox'} =~ /(\d+)/go);

     # offset-[xy] used centering for original image
     my($w, $h) = ($d->{'x2'} - $d->{'x1'}, $d->{'y2'} - $d->{'y1'});
     $d->{'offset-x'} = ($d->{'opt:width'} - $w) / 2.0;
     $d->{'offset-y'} = ($d->{'opt:height'} - $h) / 2.0;

     if ($d->{'option'}{'debug'}) {
	  printf STDERR "Value of interenal variables are:\n";
	  for (qw(debug showframe ox oy width height
		  xtimes ytimes x1 y1 x2 y2 offset-x offset-y)
	      ) {
	       printf STDERR "%s = %d\n", $_, $db{$_};
	  }
     }
}

# Print prologue for PoscScript code
sub print_prologue {
     my ($d) = @_;
     my $bx = $d->{'opt:ox'} + $d->{'opt:width'} * $d->{'opt:xtimes'};
     my $by = $d->{'opt:oy'} + $d->{'opt:height'} * $d->{'opt:ytimes'};
     my $date  = `date`;
     print<<"EOT";
%!PS-Adobe-3.0 (?)
%%BoundingBox: $d->{'opt:ox'} $d->{'opt:oy'} $bx $by
%%Title: ???
%%CreationDate: $date
%%Creater: $version

%%Pages: 1
%%PageBoundingBox: $d->{'opt:ox'} $d->{'opt:oy'} $bx $by

$d->{'opt:ox'} $d->{'opt:oy'} translate
EOT
     # map frame on paper
     if ($d->{'opt:showframe'}) {
	  print <<"MAKEBOX";
/MakeBox {
	newpath
	0 0 moveto
	$d->{'opt:width'} 0 lineto
	$d->{'opt:width'} $d->{'opt:height'} lineto
	0 $d->{'opt:height'} lineto
	0 0 lineto
	closepath
	stroke
} bind def
MAKEBOX
     }
}    

# Print script for PoscScript code
sub print_script {
     my ($d) = @_;
     my $x = $d->{'offset-x'} - $d->{'x1'};
     my $y = $d->{'offset-y'} - $d->{'y1'};
     my $Makebox = $d->{'opt:showframe'} ? 'MakeBox' : '';

     for my $i (0 .. $d->{'opt:xtimes'}-1) {
	  my $w = $d->{'opt:width'} * $i;
	  for my $j (0 .. $d->{'opt:ytimes'}-1) {
	       my $h = $d->{'opt:height'} * $j;
	       print <<"EOT";
gsave
%%SubPageBegin: $i $j
$w $h translate
$Makebox
$x $y translate
%% Original Source Begin
@{$d->{'Source'}}
%% Original Source End
grestore
%%SubPageEnd
EOT
	  }
     }
}

# Print epilogue for PoscScript code
sub print_epilogue {
     print <<"EOT";
showpage

%%EOF
EOT
}