#!/usr/bin/perl -w
#
# Plop - print labels on printer
# $Id:$
# (C) 2002 Henk Kloepping, Ben Mesman
#
# Create a (series of) sheet(s) with address labels from
# a text file.
#
# Syntax: plop3 [-h] [-r] [-n <sheetnumber>] [inputfile] 

#
# --- Declarations ---
#

use strict;
use Getopt::Std;
use English;

my $usage = "
Plop3 will print addresses on a labelsheet.

Usage: $PROGRAM_NAME [-h] [-r] [-n #] [<file>]

Options:
    -h    help, print this help
    -r    raster, print the raster
    -n #  print only sheet number #

If <file> is omitted, addresses are taken from stdin.
";
my %opt;
my $options = "hrn:";

my $line_height = 13; # lineheight in points
my $max_lines = 7;    # maximum number of lines per label
my $sep;              # field delimiter for the inputfile
my $push_down;        # top margin in the label
my $push_right;       # left margin
my $cols;             # number of label columns
my @col;              # starting position of each column (in points)
my $rows;             # number of rows
my @row;              # starting position of each row
my $lps;              # number of Labels Per Sheet
my $sheet = 0;        # sheet number to print (0 will print all sheets)
my $first_label = 0;  # (calculated) first label to print (if sheet!=0)
my $last_label = 0;
my $page = 1;         # page counter
my $raster = 0;       # print (1) or don't print (0) the raster
my $result;

sub parse_config;
sub print_header;
sub print_page_header;
sub print_page_footer;
sub print_footer;
sub raster;

#
# --- Initialisation ---
#

# check the command-line options
$result = getopts($options, \%opt);
if (!$result)
{
    print STDERR $usage;
    exit 1;
}
if (defined $opt{'h'})
{
    print $usage;
    exit 0;
}
if (defined $opt{'r'}) { $raster = 1; }
if (defined $opt{'n'}) { $sheet = $opt{'n'}; }

&parse_config();

if ($sheet != 0)
{
    $first_label = 1 + $lps * ($sheet - 1);
    $last_label = $lps * $sheet;
    print STDERR "labels $first_label, $last_label\n";
}

#
# --- The actual work ---
#

&print_header;
&print_page_header;

my $label = 0;
my $count = 0;
while (<>)
{
    next if /^\s*$/;
    next if /^\s*#/;

    $label++;
    if ($last_label != 0)
    {
	next if ($label < $first_label);
	last if ($label > $last_label);
    }
    $count++;
    if ($count > $lps)
    {
	&print_page_footer;
	&print_page_header;
	$count -= $lps;
    }

    chomp;
    # split the line on the seperator, but only if not preceded by a '+'
    # otherwise you can't use any of the special characters (see below)
    my @line = split /(?<!\+)$sep/, $_, $max_lines;
    my $top = $row[(($count - 1) / 3)];
    my $left = $col[(($count - 1) % 3)];

    for (my $i = 0; $i < @line; $i++)
    {
	# first see if we have special characters
	$line[$i] =~ s/\\\+\\/\) show \(+\) show \(/g;    # \+\ plus
	$line[$i] =~ s/s\+s/\) show \(\\373\) show \(/g;  # s+s ringeless
	$line[$i] =~ s/~\+\"/\) show \(\\272\) show \(/g; # ~+" hi-double
	$line[$i] =~ s/_\+\"/\) show \(\\271\) show \(/g; # _+" low-double
	$line[$i] =~ s/(.)\+\"/\) show \($1\) umlaut show \(/g; # x umlaut
	$line[$i] =~ s/(.)\+;/\) show \($1\) cedille show \(/g; # x cedille
	$line[$i] =~ s/(.)\+~/\) show \($1\) tilde show \(/g;   # x tilde
	$line[$i] =~ s/(.)\+\//\) show \($1\) aigu show \(/g;   # x aigu
	$line[$i] =~ s/(.)\+\\/\) show \($1\) grave show \(/g;  # x grave
	$line[$i] =~ s/(.)\+\^/\) show \($1\) caret show \(/g;  # x caret
	$line[$i] =~ s/(.)\+o/\) show \($1\) ohje show \(/g;    # x o

	# print the resulting line
	printf "%d %d moveto (%s) show\n", $left + $push_right,
               $top - ($i+1) * $line_height - $push_down, $line[$i];
    }
}

&print_page_footer;
&print_footer;

exit 0;

#
# --- Functions ---
#

# function to find and parse the configfile
sub parse_config
{
    my $labels_h;
    my $labels_v;
    my $tmp;

    # try several locations for the configfile
    my @conf = ("/etc/plop3.rc", "$ENV{'HOME'}/.plop3rc", "plop3.rc");
    my $found = 0;
    while ($tmp = pop @conf)
    {
	print STDERR "trying $tmp\n";
	if (open CFG, "<$tmp") { $found = 1; last; }
    }
    die "cannot find configuration file\n" if ($found == 0);

    while (<CFG>)
    {
	next if /^\s*$/;
	next if m"^\s*#";
	chomp;
	if (/^\s*SEP\s*=\s*(.*)\s*$/) { $sep = $1; }
	elsif (/^\s*PUSH_DOWN\s*=\s*(.*)\s*$/) { $push_down = $1; }
	elsif (/^\s*PUSH_RIGHT\s*=\s*(.*)\s*$/) { $push_right = $1; }
	elsif (/^\s*LABELS_H\s*=\s*(.*)\s*$/) { $labels_h = $1; }
	elsif (/^\s*LABELS_V\s*=\s*(.*)\s*$/) { $labels_v = $1; }
	else { die "Error in configuration file\n"; }
    }

    if (! defined $sep) { $sep = ","; }
    if (! defined $push_down) { $push_down = 5; }
    if (! defined $push_right) { $push_right = 5; }
    if (!((defined $labels_h) && (defined $labels_v)))
    {
	# can't do anything without a sheet definition
	die "Labelsheet undefined (LABELS_H and LABELS_V)\n";
    }

    ($cols, @col) = split /,/, $labels_h;
    ($rows, @row) = split /,/, $labels_v;

    # check if the sheet definition is sane
    if ($cols != @col) { die "error in LABELS_H\n"; }
    if ($rows != @row) { die "error in LABELS_V\n"; }

    $lps = $cols * $rows;

    close CFG;
}

sub print_header
{
    my (undef,undef,undef,$day,$month,$year,undef,undef,undef) = localtime;
    my $date = sprintf "%d %d %d", $day, $month, $year;

    print <<EOF;
%!PS-Adobe-1.0
% Created by $PROGRAM_NAME on $date
% A4 594 x 842 high

/Time-Roman findfont
12 scalefont
setfont

/mix {

    % mix the characters on stack and print them in the
    % current position. This requires a lot of stack fumbling,
    % probably this code could be optimised further. 
   
    %-- command           %-- leaves stack (top of stack left):  

    dup                   % char1 char1 char2 
    stringwidth           % y1 x1 char1 char2
    pop                   % x1 char1 char2
    3 2 roll              % char2 x1 char1 
    dup                   % char2 char2 x1 char1 
    stringwidth           % y2 x2 char2 x1 char1 
    pop                   % x2 char2 x1 char1 
    3 2 roll              % x1 x2 char2 char1 
    dup                   % x1 x1 x2 char2 char1
    3 2 roll              % x2 x1 x1 char2 char1
    dup                   % x2 x2 x1 x1 char2 char1
    3 2 roll              % x1 x2 x2 x1 char2 char1
    exch                  % x2 x1 x2 x1 char2 char1
    gt                    % x1gtx2 x2 x1 char2 char1
    {
      exch                % x1 x2 2 1
      4 2 roll            % 2 1 x1 x2
      exch                % 1 2 x1 x2
      4 2 roll            % x1 x2 1 2
    } if
    %
    % now on stack: widest_size smallest_size widest smallest 
    %
    currentpoint          % current_y current_x ws ss w s
    4 -2 roll             % ws ss current_y current_x w s
    exch sub              % ws-ss current_y current_x w s 
    2 div                 % delta current_y current_x w s
    3 2 roll              % current_x delta current_y w s 
    dup                   % current_x current_x delta current_y w s
    3 2 roll              % current_x delta current_x current_y w s
    add                   % x4s current_x current_y w s
    3 2 roll              % current_y x4s current_x w s
    dup                   % current_y current_y x4s current_x w s
    4 -3 roll             % current_y x4s current_x current_y w s 
    moveto                % current_x current_y w s
    4 -1 roll             % s current_x current_y w
    show                  % current_x current_y w
    exch moveto           % w
} def

/cedille { (\313) mix } def
/tilde   { (\304) mix } def
/umlaut  { (\310) mix } def 
/aigu    { (\302) mix } def
/grave   { (\301) mix } def
/caret   { (\303) mix } def
/ohje    { (\312) mix } def
EOF
}

sub print_page_header
{
    print "%%Page: $page $page\n";
    if ($raster == 1) { &raster(); }
}

sub print_page_footer
{
    print "showpage\n";
    $page++;
}

sub print_footer
{
    # nothing to do here really
    print "%%EOF\n";
}

# this will print the raster as defined by the configfile
sub raster
{
    my $i;
    my $j;

    # print the function to create finelined crosses in current posistion
    print <<EOC;
/cross { % draws finelined cross with center in current position
    -6 0 rmoveto   
    12 0 rlineto
    -6 -6 rmoveto
     0 12 rlineto 
   .5 setlinewidth
   stroke
} def
EOC

    # print the rasterpoints
    for ($i = 0; $i < $cols; $i++)
    {
	for ($j = 0; $j < $rows; $j++)
	{
	    print "$col[$i] $row[$j] moveto cross\n";
	}
    }

    # guess and print the right and bottom rasterpoints
    my $guess_col = ($col[$cols-1] - $col[0]) / ($cols - 1) * $cols + $col[0];
    my $guess_row = ($row[$rows-1] - $row[0]) / ($rows - 1) * $rows + $row[0];
    for ($i = 0; $i < $rows; $i++)
    {
	print "$guess_col $row[$i] moveto cross\n";
    }
    for ($i = 0; $i < $cols; $i++)
    {
	print "$col[$i] $guess_row moveto cross\n";
    }
    print "$guess_col $guess_row moveto cross\n";
}
