#!/usr/local/bin/perl -w-- # -*- perl -*-
#
# $Id: tape-insert,v 1.2 1994/09/10 18:56:46 qjb Exp $
# $Source: /home/qjb/scripts/RCS/tape-insert,v $
# $Author: qjb $
#
# Read in a description of what should go on in a cassette tape insert
# and generate postscript code to print two per page with the given
# input.  The format of the input is
#   -TITLE-
#   Line 1
#   Line 2
#   -UPPER-
#   Side A
#     Bla bla bla
#     Bla bla bla
#     Bla bla bla
#   -LOWER-
#     Bla bla bla
#     Bla bla bla
#     Bla bla bla
#
# The -TITLE-, -UPPER-, and -LOWER- fields must be left-justified and have
# no trailing spaces.  There is no comment character.  Blank lines are NOT
# ignored but instead result in a half-line skip in the output.
# A special case input line is of the form
#   string//1//2//3//4
# When a string is of this form, the // is taken as a field separator.
# The first field is printed.  Then, the output backspaces over the width
# of the second field, prints the third field, etc.  This makes it possible
# to put accents in the output.  For example, to print the name Ce'sar Franck,
# you would use the line
#   Ce//\302//\302sar Franck
# where \302 should be replaced with the actual \302 binary character.
#

# This code, from the perl manual page, forces this to be run by perl from 
# perl, sh, or csh.  It must be first.
eval '(exit $?0)' && eval 'exec /usr/local/bin/perl -S $0 ${1+"$@"}'
& eval 'exec /usr/local/bin/perl -S $0 $argv:q'
    if 0;

$whoami = ($0 =~ m,([^/]*)$,) ? $1 : $0;

$prolog = "/home/ejb/lib/postscript/tape-insert.ps";

open(PROLOG, "<$prolog") || die "$whoami: can't open $prolog: $!\n";
while (<PROLOG>)
{
    print;
    last if (m/INSERT USER DEFINITIONS HERE/);
}
print "\n";

$st_outer = 0;
$st_title = 1;
$st_upper = 2;
$st_lower = 3;

$state = $st_outer;

while (<>)
{
    chop;

    (m/^-TITLE-$/) && do { ($state = $st_title); next; };
    (m/^-UPPER-$/) && do { ($state = $st_upper); next; };
    (m/^-LOWER-$/) && do { ($state = $st_lower); next; };

    ($state == $st_title) && push(@title, $_);
    ($state == $st_upper) && push(@upper, $_);
    ($state == $st_lower) && push(@lower, $_);
}

&output("title", @title);
&output("upper-fold", @upper);
&output("lower-fold", @lower);

sub output {
    local($var, @lines) = @_;
    local($line, $field, @fields);

    print "/" . $var . " [\n";
    foreach $line (@lines)
    {
	if ($line =~ m/^\s*$/)
	{
	    print "  /blank\n";
	}
	elsif ($line =~ m,//,)
	{
	    @fields = split('//', $line);
	    print "  [ ";
	    
	    foreach $field (@fields)
	    {
		print &fixline($field) . " "
	    }
	    print "]\n";
	}
	else
	{
	    print "  " . &fixline($line) . "\n";
	}
    }

    print "] def\n\n";
}

sub fixline {
    local($line) = @_;

    $line =~ s/\\/\\\\/g;
    $line =~ s/\(/\\\(/g;
    $line =~ s/\)/\\\)/g;
    "(" . $line . ")";
}

while (<PROLOG>)
{
    last if (m/END OF USER DEFINITIONS/);
}

print;
while (<PROLOG>)
{
    print;
}