#!/usr/local/bin/perl -w

# This program was generated by lines2perl, which is part of Gedcom.pm.
# Gedcom.pm is Copyright 1999-2001, Paul Johnson (pjcj@cpan.org)
# Version 1.09 - 12th February 2001

# Gedcom.pm is free.  It is licensed under the same terms as Perl itself.

# The latest version of Gedcom.pm should be available from my homepage:
# http://www.pjcj.net

use strict;

require 5.005;

use diagnostics;
use integer;

use Getopt::Long;

use Gedcom::LifeLines 1.09;

my $Ged;                                                         # Gedcom object
my %Opts;                                                              # options
my $_Traverse_sub;                                     # subroutine for traverse

sub out  { print  STDERR @_ unless $Opts{quiet} }
sub outf { printf STDERR @_ unless $Opts{quiet} }

sub initialise ()
{
  die "usage: $0 -gedcom_file file.ged\n"
    unless GetOptions(\%Opts,
                      "gedcom_file=s",
                      "quiet!",
                      "validate!",
                     ) and defined $Opts{gedcom_file};
  local $SIG{__WARN__} = sub { out "\n@_" };
  out "reading...";
  $Ged = Gedcom->new
  (
    gedcom_file  => $Opts{gedcom_file},
    callback     => sub { out "." }
  );
  if ($Opts{validate})
  {
    out "\nvalidating...";
    my %x;
    my $vcb = sub
    {
     my ($r) = @_;
     my $t = $r->{xref};
     out "." if $t && !$x{$t}++;
    };
    $Ged->validate($vcb);
  }
  out "\n";
  set_ged($Ged);
}

$SIG{__WARN__} = sub
{
  out $_[0] unless $_[0] =~ /^Use of uninitialized value/
};

# /*
#  *   ps-pedigree
#  *
#  *   This report generates Multiple linked Pedigree Charts
#  *   Each chart is 7 or 8 generations and as a line moves off
#  *   a chart the new chart number is referenced. The output
#  *   of this report is a POSTSCRIPT file. The text size is very
#  *   small but readable (it seams less readable as I age!) on
#  *   8.5x11 paper with 8 generations and larger but somewhat
#  *   compressed at 7 generations per chart. And an index of all
#  *   persons on the charts is also created.
#  *
#  *   Code by Stephen Woodbridge,  woodbri@swoodbridge.com
#  *   Copyright 1992 by Stephen Woodbridge
#  *
#  *   This report works only with the LifeLines Genealogy program
#  *
#  *   Version one of this report was written in XLISP and this is a
#  *   direct translation of that Lisp code.
#  *
#  *   --- Version control info ---
#  *
#  *   10/22/92 - First Release 1.0.0
#  *   10/28/92 - changed box width to expand the text font
#  *              added CENTER_LAST global to center names in last boxes
#  *   11/05/92 - Release 1.1.0 Added name sorted index and misc. other
#  *              features and enhancements.
#  *
#  *   --- Comments about the program ---
#  *
#  *   There are lots of global flags that control whether or not aspects
#  *   of the output are generated. These are set in "init_globals" and
#  *   the comments there will explain them.  The title string for the
#  *   index is also set here. The program will also generate an index of
#  *   just the people in the pedigree OR all people in the database. This
#  *   is controlled by the flag INDEX_ALL.
#  *
#  *   All global are in capitals. Global constants are set in
#  *   init_globals  and are not changed as the program runs. The global
#  *   variables are used throughout the execution.
#  *   There is a global TRACE which will print most proc names as they
#  *   are executed. This is helpful in tracking down SEGV crashes. There
#  *   is a global LIST which will print the name of each person or a "."
#  *   as it is processed. The enqueueing of people to be processed is
#  *   done in plot_me.
#  *
#  *   You can adjust the margins on the paper. This has the effect of
#  *   pushing the plot off the top/bottom/left/right. See M_TOP/M_BOT/
#  *   M_LEFT/M_RIGHT in  init_globals.  The current setting leaves a
#  *   margin at the top for three-hole punching or binding.
#  *
#  *   --- Comments about the PostScript output ---
#  *
#  *   You can change the paper size without regenerating the output.
#  *   The plot will scale to fit the paper. A ledger size paper makes
#  *   the plots much easier to read. This can be done by editing line
#  *   66 in the output file. Just above this line are definitions for
#  *   "a-size","a4-size" and "b4-size" paper. You can add your own paper
#  *   sizes  and reference them on line 66.
#  *
#  *   Changing the small text font size will not nessasarily change the
#  *   output on the paper because I compute an x and y scale factor the
#  *   forces the chart into the bounds of the paper. Feel free to
#  *   experiment and let me know if you get a good combination.
#  *
#  */
# /* global variables */
my $RVAL;
# /*  stack used to return values from procs */
my $ILIST;
# /*  indi's to be done in next depth of charts */
my $NLIST;
# /*  chart num of indi's above */
my $WHICH_CHART;
# /*  table xrefs of indi to chart number */
my $FROM_CHART;
my $INDXSET;
my $CHART_NO;
my $CURRENT_CHART_NO;
my $PAGE;
# /*  postscript page number being outputed */
my $PAGE_INDX;
# /* global constants */
my $M_BOT;
my $M_LEFT;
my $M_RIGHT;
my $M_TOP;
my $LF_HGT;
my $LF_WDT;
my $SF_HGT;
my $SF_WDT;
my $BOX_H;
my $BOX_DH;
my $BOX_NC_1;
my $BOX_NC_2;
my $BOX_W;
my $BOX_WW;
my $BOX_SP;
my $BOX_DW;
my $CHART_PREFIX;
my $LEN_CHART_PREFIX;
my $TEXT_HGT;
my $TEXT_WDT;
my $INDEX_SIZE;
my $INDEX_LPP;
my $HEADER_SIZE;
my $LINE_COUNT;
my $PLOT_INUMS;
my $PLOT_DATE;
my $CENTER_LAST;
my $INDEX_ALL;
my $TITLE;
my $TRACE;
my $LIST;
my $PS_HDR_FILE;
# /*
#  *--------------------------------------------------------*
#  */
sub main ()
{
  my $cno;
  my $dmax;
  my $i;
  my $jlist;
  my $le;
  my $max;
  my $me;
  my $mlist;
  my $or;
  $TRACE = 0;
  # /* trace proc calling sequence to trace down
  #                         SEGV: signal 11 crashes */
  #
  #
  $LIST = 0;
  # /* list names as they are processed */
  #
  #
  display &init_globals();
  $RVAL = [];
  $ILIST = [];
  $NLIST = [];
  $WHICH_CHART = {};
  $FROM_CHART = {};
  $INDXSET = [];
  display &getindi($me);
  # /*
  #      *  The program can make 3 thru n generation charts
  #      *  but only the 7 and 8 have good aspect ratios that
  #      *  make them usable.
  #      */
  #
  display &getintmsg($max, "Enter max generations per chart [7 or 8]");
  if ((($max == 7) || ($max == 8)))
  {
    display &getintmsg($dmax, "Enter max depth of charts:");
    push @$ILIST, $me;
    push @$NLIST, 1;
    display &plot_init($max, $TITLE);
    $i = 1;
    while (($i <= $dmax))
    {
      $jlist = $ILIST;
      $mlist = $NLIST;
      $ILIST = [];
      $NLIST = [];
      while ($me = (shift @$jlist))
      {
        $cno = (shift @$mlist);
        $CURRENT_CHART_NO = $cno;
        display &new_plot_page($cno);
        display &do_ancestors($me, 1, 0, $max);
        display &title_chart($cno, $me, $max);
      }
      $i = ($i + 1);
    }
    display &plot_fini();
    display &do_index();
    display &index_fini();
  }
  undef
}

sub init_globals ()
{
  # /* initialize global constants */
  #
  #
  # /* Paper margins for output in points */
  #
  $M_TOP = 27;
  # /* 0.375in*72points/in */
  #
  $M_BOT = 0;
  $M_LEFT = 0;
  $M_RIGHT = 0;
  # /* Large and small font sizes in points */
  #
  $LF_HGT = 18;
  $LF_WDT = 12;
  $SF_HGT = 5;
  $SF_WDT = 4;
  # /* Size of text in boxes */
  #
  $TEXT_HGT = $SF_HGT;
  $TEXT_WDT = $SF_WDT;
  # /* height of box and vertical spacing */
  #
  $BOX_H = (1 + $TEXT_HGT);
  $BOX_DH = (1 + $BOX_H);
  # /*  width of boxes in number of characters  */
  #
  $BOX_NC_1 = 42;
  $BOX_NC_2 = 30;
  # /*  width of boxes and horizontal spacing  */
  #
  $BOX_W = ($BOX_NC_2 * $TEXT_WDT);
  $BOX_WW = ($BOX_NC_1 * $TEXT_WDT);
  $BOX_SP = (($BOX_W * 3) / 20);
  # /* BOX_W*0.15 */
  #
  $BOX_DW = ($BOX_W + $BOX_SP);
  # /*  controls for the index  */
  #
  $INDEX_SIZE = 8;
  $INDEX_LPP = 80;
  $HEADER_SIZE = 10;
  # /*  controls for what and how the charts appear */
  #
  $CHART_PREFIX = "";
  # /* if CHART_PREFIX=0 then don't number charts */
  #
  $LEN_CHART_PREFIX = 0;
  $PLOT_INUMS = 1;
  # /* bool 0=don't plot inums, 1=plot inums */
  #
  $PLOT_DATE = 1;
  # /* bool 0=don't date charts, 1=date charts */
  #
  $CENTER_LAST = 1;
  # /* bool 0=don't center names in last column,
  #                                   1=center names */
  #
  $INDEX_ALL = 0;
  # /* bool 0=only index names on charts,
  #                                   1=index all names in database */
  #
  #
  # /* global variables used to keep track of which chart */
  #
  #
  $CHART_NO = 1;
  $CURRENT_CHART_NO = 0;
  $PAGE = 0;
  $PAGE_INDX = 1;
  $PS_HDR_FILE = "ps-pedi.ps";
  # /* PostScript Header file name */
  #
  #
  $TITLE = "Pedigree Index";
  # /* Title string for Index pages */
  #
  #
  display &dayformat(0);
  display &monthformat(3);
  display &dateformat(0);
  undef
}

sub do_ancestors ($$$$)
{
  my($me, $depth, $width, $max) = @_;
  my $and;
  my $dad;
  my $mom;
  my $my_tag;
  my $nwid;
  if ($TRACE)
  {
    display &print("do_ancestors ");
  }
  if ($me)
  {
    if ($LIST)
    {
      display &print(&fullname($me, 1, 0, 40));
      display &print(" -");
      display &print(&key($me));
      display &print(&sp());
      display &print(&d($depth));
      display &print(&sp());
      display &print(&d($width));
      display &print(&nl());
    }
    else
    {
      display &print(".");
    }
    $my_tag = $WHICH_CHART->{&key($me)};
    display &plot_me($me, $depth, $width, $max);
    if ((((1 == $depth) || (! $my_tag)) && ($depth < $max)))
    {
      if ($dad = &father($me))
      {
        display &get_width(1, $width);
        $nwid = (pop @$RVAL);
        display &do_ancestors($dad, (1 + $depth), $nwid, $max);
        display &connect_boxes($me, $depth, $width, $nwid, $max);
      }
      if ($mom = &mother($me))
      {
        display &get_width((- 1), $width);
        $nwid = (pop @$RVAL);
        display &do_ancestors($mom, (1 + $depth), $nwid, $max);
        display &connect_boxes($me, $depth, $width, $nwid, $max);
      }
    }
    else
    {
      display &box_org($depth, $width, $max);
      display &draw_ext($me, (pop @$RVAL), (pop @$RVAL), $my_tag, ($depth == $max));
    }
  }
  undef
}

sub plot_me ($$$$)
{
  my($me, $depth, $width, $max) = @_;
  my $and;
  my $first;
  my $last;
  my $my_x;
  my $my_y;
  my $not;
  my $ntag;
  my $style;
  if ($TRACE)
  {
    display &print("plot_me ");
  }
  $last = ($max == $depth);
  $first = (1 == $depth);
  $style = ((1 + $depth) >= $max);
  display &box_org($depth, $width, $max);
  $my_x = (pop @$RVAL);
  $my_y = (pop @$RVAL);
  # /*
  #      * This if controls whether or not siblings are plotted
  #      */
  #
  if ($first)
  {
    display &do_sibs($me, $my_x, $my_y, $last);
  }
  else
  {
    display &box_me($me, $my_x, $my_y, $last);
  }
  if ((! $WHICH_CHART->{&key($me)}))
  {
    $ntag = $CURRENT_CHART_NO;
    if (($last && &parents($me)))
    {
      $CHART_NO = (1 + $CHART_NO);
      $ntag = $CHART_NO;
      display &draw_ext($me, $my_x, $my_y, $ntag, $last);
      push @$ILIST, $me;
      push @$NLIST, $ntag;
      $FROM_CHART->{&save(&d($CHART_NO))} = $CURRENT_CHART_NO;
    }
    $WHICH_CHART->{&save(&key($me))} = $ntag;
    display &addtoset($INDXSET, $me, $ntag);
  }
  undef
}

sub box_me ($$$$)
{
  my($me, $x, $y, $last) = @_;
  my $num;
  if ($TRACE)
  {
    display &print("box_me ");
  }
  display &get_dates($me);
  display &print_name($me, 0);
  if ($PLOT_INUMS)
  {
    $num = &save(&concat("-", &key($me)));
  }
  else
  {
    $num = "";
  }
  display &draw_box_text($x, $y, (pop @$RVAL), (pop @$RVAL), $num, $last);
  undef
}

sub do_sibs ($$$$)
{
  my($me, $x, $y, $last) = @_;
  my $bdh;
  my $child;
  my $nchild;
  my $nkids;
  my $sy;
  my $yy;
  if ($TRACE)
  {
    display &print("do_sibs ");
  }
  $nkids = &nchildren(&parents($me));
  $bdh = (2 * $BOX_DH);
  $sy = ((($nkids - 1) * $bdh) / 2);
  $nchild = 0;
  for $child (&parents($me)->children)
  {
    $nchild++;
      $yy = ($y + $sy);
      display &box_me($child, $x, $yy, $last);
      $sy = ($sy - $bdh);
  }
  undef
}

sub do_index ()
{
  my $chart;
  my $me;
  my $not;
  my $num;
  if ($TRACE)
  {
    display &print("do_index ");
  }
  display &print(&nl());
  display &print("Collecting Index ...");
  if ($INDEX_ALL)
  {
    $num = 0;
    for $me ($Ged->individuals)
    {
      $num++;
      if ((! $WHICH_CHART->{&key($me)}))
      {
        display &addtoset($INDXSET, $me, 0);
      }
    }
  }
  display &print(&nl());
  display &print("Sorting Index ...");
  display &namesort($INDXSET);
  display &print(&nl());
  display &print("Outputing Index ");
  $num = 0;
  for (@{$INDXSET})
  {
    ($me, $chart) = @$_;
    $num++;
    display &index_out($me, $chart);
    display &print(".");
  }
  undef
}

# /*
#  *             --------  Postscript output routines ---------
#  */
sub plot_init ($$)
{
  my($max, $title) = @_;
  my $h;
  my $w;
  if ($TRACE)
  {
    display &print("plot_init ");
  }
  $PAGE = 0;
  display &copyfile($PS_HDR_FILE);
  display &expt(2, ($max - 2));
  $h = (((pop @$RVAL) + 1) * (2 * $BOX_DH));
  $w = ((($max + 1) * $BOX_W) / 2);
  $w = ($w + (($max * $BOX_SP) + $BOX_WW));
  if ($CHART_PREFIX)
  {
    $w = ($w + (($LEN_CHART_PREFIX + 3) * $TEXT_WDT));
  }
  display "%%BeginSetup";
  display &nl();
  display "/pointsize ";
  display &d($INDEX_SIZE);
  display " def";
  display &nl();
  display "/headerpointsize ";
  display &d($HEADER_SIZE);
  display " def";
  display &nl();
  display "/filename (";
  display $title;
  display ") def";
  display &nl();
  display "/noheader false def";
  display &nl();
  display "/date (";
  display &date(&gettoday());
  display ") def";
  display &nl();
  display "/nc-1 ";
  display &d($BOX_NC_1);
  display " def";
  display &nl();
  display "/nc-2 ";
  display &d($BOX_NC_2);
  display " def";
  display &nl();
  display "/margin-l ";
  display &d($M_LEFT);
  display " def";
  display &nl();
  display "/margin-r ";
  display &d($M_RIGHT);
  display " def";
  display &nl();
  display "/margin-t ";
  display &d($M_TOP);
  display " def";
  display &nl();
  display "/margin-b ";
  display &d($M_BOT);
  display " def";
  display &nl();
  display "/width-needed ";
  display &d($w);
  display " def";
  display &nl();
  display "/height-needed ";
  display &d($h);
  display " def";
  display &nl();
  display "/text-wdt ";
  display &d($TEXT_WDT);
  display " def";
  display &nl();
  display "/text-hgt ";
  display &d($TEXT_HGT);
  display " def";
  display &nl();
  display "setup";
  display &nl();
  display "/newpagesetup save def";
  display &nl();
  display "mark";
  display &nl();
  display "%%EndSetup";
  display &nl();
  $LINE_COUNT = 0;
  undef
}

sub new_plot_page ($)
{
  my($page_no) = @_;
  if ($TRACE)
  {
    display &print("new_plot_page ");
  }
  $PAGE = (1 + $PAGE);
  display "%%Page: ";
  display &d($page_no);
  display " ";
  display &d($PAGE);
  display &nl();
  display "mark plotpagesetup";
  display &nl();
  undef
}

sub plot_fini ()
{
  $PAGE = (1 + $PAGE);
  undef
}

sub draw_box_text ($$$$$$)
{
  my($x, $y, $name, $date, $num, $last) = @_;
  my $t;
  if ($TRACE)
  {
    display &print("draw_box_text ");
  }
  if ($last)
  {
    display "(";
    display $name;
    display " ";
    display $date;
    display "  ";
    display $num;
    display ") ";
    if ($CENTER_LAST)
    {
      $t = " ct1";
    }
    else
    {
      $t = " t1";
    }
  }
  else
  {
    display "(";
    display $name;
    display "  ";
    display $num;
    display ") (";
    display $date;
    display ") ";
    $t = " t2";
  }
  display &d($x);
  display " ";
  display &d($y);
  display $t;
  display &nl();
  undef
}

sub draw_ext ($$$$$)
{
  my($me, $x, $y, $chartno, $last) = @_;
  my $and;
  my $bw;
  my $parents;
  if ($TRACE)
  {
    display &print("draw_ext ");
  }
  if (&parents($me))
  {
    if ($last)
    {
      $bw = ($BOX_WW / 2);
    }
    else
    {
      $bw = ($BOX_W / 2);
    }
    display "np ";
    display &d(($x + $bw));
    display " ";
    display &d($y);
    display " mto ";
    display &d(($BOX_SP / 3));
    display " 0 rlto drw";
    display &nl();
    if (($chartno && $CHART_PREFIX))
    {
      display &d(($x + ($bw + ($TEXT_WDT + ($BOX_SP / 3)))));
      display " ";
      display &d(($y - ($TEXT_HGT / 2)));
      display " mto (";
      display $CHART_PREFIX;
      display &d($chartno);
      display ") show";
      display &nl();
    }
  }
  undef
}

sub connect_boxes ($$$$$)
{
  my($me, $depth, $width1, $width2, $max) = @_;
  my $dh;
  my $dw;
  my $dx;
  my $eq;
  my $gt;
  my $lt;
  my $nkids;
  my $rad;
  my $style;
  my $sy;
  my $w2;
  my $w3;
  my $x1;
  my $x2;
  my $y1;
  my $y2;
  if ($TRACE)
  {
    display &print("connect_boxes ");
  }
  display &box_org($depth, $width1, $max);
  $x1 = (pop @$RVAL);
  $y1 = (pop @$RVAL);
  display &box_org((1 + $depth), $width2, $max);
  $x2 = (pop @$RVAL);
  $y2 = (pop @$RVAL);
  $dx = (($x1 + $x2) / 2);
  $w2 = ($BOX_W / 2);
  $w3 = ($BOX_WW / 2);
  $dh = 0;
  $dw = $w2;
  $rad = $BOX_H;
  $style = 0;
  if (($depth == 1))
  {
    $nkids = &nchildren(&parents($me));
    $sy = ((($nkids - 1) * (2 * $BOX_DH)) / 2);
    if (($width2 > 0))
    {
      $y1 = ($y1 + $sy);
    }
    else
    {
      $y1 = ($y1 - $sy);
    }
  }
  if (($y1 < $y2))
  {
    $dh = $BOX_H;
  }
  else
  {
    $dh = (- $BOX_H);
  }
  if ((($max - $depth) == 1))
  {
    $dw = $w3;
    $style = 1;
    $rad = ($rad / 2);
    $dx = ((($x1 + ($w2 + $x2)) - $w3) / 2);
  }
  elsif ((($max - $depth) == 2))
  {
    $dw = $w2;
    $style = 1;
  }
  if ($style)
  {
    display &d(($rad / 2));
    display " gr np ";
    display &d(($x1 + $w2));
    display " ";
    display &d($y1);
    display " mto ";
    display &d($dx);
    display " ";
    display &d($y1);
    display " ";
    display &d($dx);
    display " ";
    display &d($y2);
    display " pto ";
    display &d(($x2 - $dw));
    display " ";
    display &d($y2);
    display " pto lto drw";
    display &nl();
  }
  else
  {
    display &d($rad);
    display " gr np ";
    display &d($x1);
    display " ";
    display &d(($y1 + $dh));
    display " mto ";
    display &d($x1);
    display " ";
    display &d($y2);
    display " ";
    display &d(($x2 - $w2));
    display " ";
    display &d($y2);
    display " pto lto drw";
    display &nl();
  }
  undef
}

sub title_chart ($$$)
{
  my($chart_no, $me, $max) = @_;
  my $e;
  my $gt;
  my $w;
  my $x;
  my $y;
  if ($TRACE)
  {
    display &print("title_chart ");
  }
  if ((($max - 2) > 0))
  {
    $x = 0;
    display &expt(2, ($max - 2));
    $y = (((pop @$RVAL) + 1) * (2 * $BOX_DH));
    $w = ((($max + 1) * $BOX_W) / 2);
    $w = ($w + (($max * $BOX_SP) + $BOX_WW));
    if ($CHART_PREFIX)
    {
      $w = ($w + ((4 + $LEN_CHART_PREFIX) * $TEXT_WDT));
    }
    display &d($y);
    display " ";
    display &d($w);
    display " ";
    display &d($x);
    display " 0 mbox 18 1 rbox";
    display &nl();
    if ($PLOT_DATE)
    {
      display &d(($x + $LF_WDT));
      display " 1.2 mul ";
      display &d(($SF_HGT / 2));
      display " mto (";
      display &date(&gettoday());
      display ") show";
      display &nl();
    }
    display &d($LF_WDT);
    display " ";
    display &d($LF_HGT);
    display " mfont";
    display &nl();
    display &get_dates($me);
    display &print_name($me, 1);
    display &d(($x + (2 * $LF_WDT)));
    display " ";
    display &d(($y - ($LF_HGT + ($LF_HGT / 2))));
    display " mto (";
    display (pop @$RVAL);
    display ") show";
    display &nl();
    display &d(($x + (2 * $LF_WDT)));
    display " ";
    display &d(($y - (($LF_HGT * 2) + ($LF_HGT / 2))));
    display " mto (";
    display (pop @$RVAL);
    display ") show";
    display &nl();
    if ($CHART_PREFIX)
    {
      display &d(($x + $LF_WDT));
      display " ";
      display &d(($LF_HGT / 2));
      display " mto (Chart: ";
      display $CHART_PREFIX;
      display &d($chart_no);
      if ($e = $FROM_CHART->{&d($chart_no)})
      {
        display "  From: ";
        display &d($e);
      }
      display ") show";
      display &nl();
    }
    display "cleartomark showpage";
    display &nl();
    display "%%EndPage: ";
    display &d($PAGE);
    display " ";
    display &d($PAGE);
    display &nl();
  }
  undef
}

# /*
#  *             --------  Postscript output routines for index ---------
#  */
sub index_fini ()
{
  if ($TRACE)
  {
    display &print("index_fini ");
  }
  display "cleartomark showpage";
  display &nl();
  display "%%EndPage: ";
  display &d($PAGE);
  display " ";
  display &d($PAGE);
  display &nl();
  display "%%Trailer";
  display &nl();
  display "%%Pages: ";
  display &d($PAGE);
  display &nl();
  undef
}

sub index_out ($$)
{
  my($me, $chart) = @_;
  my $blanks;
  my $not;
  if ($TRACE)
  {
    display &print("index_out ");
  }
  $blanks = "                                                  ";
  if ((! ($LINE_COUNT % $INDEX_LPP)))
  {
    display "%%Page: ";
    display &d($PAGE);
    display " ";
    display &d($PAGE);
    display &nl();
    display "mark indexpagesetup ";
    display &d($PAGE_INDX);
    display " pagesetup";
    display &nl();
  }
  display "(";
  if ($chart)
  {
    display &rjt($chart, 5);
    display (pop @$RVAL);
  }
  else
  {
    display "    ";
  }
  display "  ";
  display &trim(&save(&concat(&key($me), "      ")), 6);
  display &get_dates($me);
  display &print_name($me, 1);
  display "  ";
  display &trim(&save(&concat((pop @$RVAL), $blanks)), 50);
  display " ";
  display &sex($me);
  display " ";
  display (pop @$RVAL);
  display ")l";
  display &nl();
  $LINE_COUNT = ($LINE_COUNT + 1);
  if ((! ($LINE_COUNT % $INDEX_LPP)))
  {
    display "cleartomark showpage";
    display &nl();
    display "%%EndPage: ";
    display &d($PAGE);
    display " ";
    display &d($PAGE);
    display &nl();
    $PAGE = ($PAGE + 1);
    $PAGE_INDX = ($PAGE_INDX + 1);
    $LINE_COUNT = 0;
  }
  undef
}

# /*
#  *             --------  Utility routines ---------
#  */
sub print_name ($$)
{
  my($me, $last) = @_;
  if ($TRACE)
  {
    display &print("print_name ");
  }
  display &get_title($me);
  push @$RVAL, &save(&concat(&fullname($me, 1, (! $last), 45), (pop @$RVAL)));
  undef
}

sub get_title ($)
{
  my($me) = @_;
  my $n;
  my $node;
  my $not;
  if ($TRACE)
  {
    display &print("get_title ");
  }
  for $node (@{&inode($me)->_items})
  {
    if ((! &strcmp("TITL", &tag($node))))
    {
      $n = $node;
    }
  }
  if ($n)
  {
    push @$RVAL, &save(&concat(" ", &value($n)));
  }
  else
  {
    push @$RVAL, "";
  }
  undef
}

sub get_dates ($)
{
  my($me) = @_;
  my $b;
  my $d;
  my $e;
  if ($TRACE)
  {
    display &print("get_dates ");
  }
  if ($e = &birth($me))
  {
    $b = &save(&concat("( ", &date($e)));
  }
  else
  {
    $b = "( ";
  }
  if ($e = &death($me))
  {
    $d = &save(&concat(" - ", &date($e)));
  }
  else
  {
    $d = " - ";
  }
  push @$RVAL, &save(&concat($b, &concat($d, " )")));
  undef
}

sub box_org ($$$)
{
  my($depth, $width, $max) = @_;
  my $dd;
  my $dx;
  my $dxx;
  my $dy;
  my $eq;
  my $lt;
  my $x;
  my $xx;
  my $y;
  my $yy;
  if ($TRACE)
  {
    display &print("box_org ");
  }
  $xx = (($BOX_W * 9) / 16);
  display &expt(2, ($max - 2));
  $yy = (((pop @$RVAL) + 1) * $BOX_DH);
  if (($depth == 1))
  {
    push @$RVAL, $yy;
    push @$RVAL, $xx;
  }
  else
  {
    display &expt(2, ($max - $depth));
    $dy = ((pop @$RVAL) * $BOX_DH);
    display &abs($width);
    $y = (((pop @$RVAL) * $dy) - ($dy / 2));
    $dx = ($BOX_SP + ($BOX_W / 2));
    $dd = (($max - 2) - $depth);
    $x = 0;
    if (($dd == (- 1)))
    {
      $dxx = ($BOX_W / 2);
    }
    elsif (($dd == (- 2)))
    {
      $dxx = (($BOX_W / 2) + ($BOX_WW / 2));
    }
    else
    {
      $dxx = 0;
    }
    $x = ($dxx + ($xx + ($dx * ($depth - 1))));
    if (($width < 0))
    {
      $y = (- $y);
    }
    push @$RVAL, ($yy + $y);
    push @$RVAL, $x;
  }
  undef
}

sub get_width ($$)
{
  my($sign, $width) = @_;
  my $awidth;
  my $eq;
  my $s2;
  if ($TRACE)
  {
    display &print("get_width ");
  }
  if (($width == 0))
  {
    push @$RVAL, $sign;
  }
  else
  {
    display &abs($width);
    $awidth = (pop @$RVAL);
    $s2 = ($width / $awidth);
    if (($s2 == $sign))
    {
      push @$RVAL, ($width * 2);
    }
    else
    {
      push @$RVAL, ((($awidth * 2) - 1) * $s2);
    }
  }
  undef
}

sub abs ($)
{
  my($int) = @_;
  my $lt;
  if ($TRACE)
  {
    display &print("abs ");
  }
  if (($int < 0))
  {
    push @$RVAL, (- $int);
  }
  else
  {
    push @$RVAL, $int;
  }
  undef
}

sub rjt ($$)
{
  my($n, $w) = @_;
  my $d;
  my $lt;
  my $pad;
  if (($n < 10))
  {
    $d = 1;
  }
  elsif (($n < 100))
  {
    $d = 2;
  }
  elsif (($n < 1000))
  {
    $d = 3;
  }
  elsif (($n < 10000))
  {
    $d = 4;
  }
  else
  {
    $d = 5;
  }
  if (($d < $w))
  {
    $pad = &save(&trim("      ", ($w - $d)));
  }
  else
  {
    $pad = "";
  }
  push @$RVAL, &save(&concat($pad, &save(&d($n))));
  undef
}

sub expt ($$)
{
  my($x, $y) = @_;
  my $le;
  my $result;
  if ($TRACE)
  {
    display &print("expt ");
  }
  if (($y <= 0))
  {
    $result = 1;
  }
  else
  {
    $result = $x;
    while ($y = ($y - 1))
    {
      $result = ($result * $x);
    }
  }
  push @$RVAL, $result;
  undef
}


initialise();
main();
flush();
0

__END__

Original LifeLines program follows:

/*
 *   ps-pedigree
 *
 *   This report generates Multiple linked Pedigree Charts
 *   Each chart is 7 or 8 generations and as a line moves off
 *   a chart the new chart number is referenced. The output
 *   of this report is a POSTSCRIPT file. The text size is very
 *   small but readable (it seams less readable as I age!) on
 *   8.5x11 paper with 8 generations and larger but somewhat
 *   compressed at 7 generations per chart. And an index of all
 *   persons on the charts is also created.
 *
 *   Code by Stephen Woodbridge,  woodbri@swoodbridge.com
 *   Copyright 1992 by Stephen Woodbridge
 *
 *   This report works only with the LifeLines Genealogy program
 *
 *   Version one of this report was written in XLISP and this is a
 *   direct translation of that Lisp code.
 *
 *   --- Version control info ---
 *
 *   10/22/92 - First Release 1.0.0
 *   10/28/92 - changed box width to expand the text font
 *              added CENTER_LAST global to center names in last boxes
 *   11/05/92 - Release 1.1.0 Added name sorted index and misc. other
 *              features and enhancements.
 *
 *   --- Comments about the program ---
 *
 *   There are lots of global flags that control whether or not aspects
 *   of the output are generated. These are set in "init_globals" and
 *   the comments there will explain them.  The title string for the
 *   index is also set here. The program will also generate an index of
 *   just the people in the pedigree OR all people in the database. This
 *   is controlled by the flag INDEX_ALL.
 *
 *   All global are in capitals. Global constants are set in
 *   init_globals  and are not changed as the program runs. The global
 *   variables are used throughout the execution.
 *   There is a global TRACE which will print most proc names as they
 *   are executed. This is helpful in tracking down SEGV crashes. There
 *   is a global LIST which will print the name of each person or a "."
 *   as it is processed. The enqueueing of people to be processed is
 *   done in plot_me.
 *
 *   You can adjust the margins on the paper. This has the effect of
 *   pushing the plot off the top/bottom/left/right. See M_TOP/M_BOT/
 *   M_LEFT/M_RIGHT in  init_globals.  The current setting leaves a
 *   margin at the top for three-hole punching or binding.
 *
 *   --- Comments about the PostScript output ---
 *
 *   You can change the paper size without regenerating the output.
 *   The plot will scale to fit the paper. A ledger size paper makes
 *   the plots much easier to read. This can be done by editing line
 *   66 in the output file. Just above this line are definitions for
 *   "a-size","a4-size" and "b4-size" paper. You can add your own paper
 *   sizes  and reference them on line 66.
 *
 *   Changing the small text font size will not nessasarily change the
 *   output on the paper because I compute an x and y scale factor the
 *   forces the chart into the bounds of the paper. Feel free to
 *   experiment and let me know if you get a good combination.
 *
 */

/* global variables */

global(RVAL)        /*  stack used to return values from procs */
global(ILIST)        /*  indi's to be done in next depth of charts */
global(NLIST)        /*  chart num of indi's above */
global(WHICH_CHART)    /*  table xrefs of indi to chart number */
global(FROM_CHART)
global(INDXSET)

global(CHART_NO)
global(CURRENT_CHART_NO)
global(PAGE)        /*  postscript page number being outputed */
global(PAGE_INDX)

/* global constants */

global(M_BOT)
global(M_LEFT)
global(M_RIGHT)
global(M_TOP)

global(LF_HGT)
global(LF_WDT)
global(SF_HGT)
global(SF_WDT)

global(BOX_H)
global(BOX_DH)

global(BOX_NC_1)
global(BOX_NC_2)

global(BOX_W)
global(BOX_WW)
global(BOX_SP)
global(BOX_DW)

global(CHART_PREFIX)
global(LEN_CHART_PREFIX)

global(TEXT_HGT)
global(TEXT_WDT)

global(INDEX_SIZE)
global(INDEX_LPP)
global(HEADER_SIZE)

global(LINE_COUNT)

global(PLOT_INUMS)
global(PLOT_DATE)
global(CENTER_LAST)
global(INDEX_ALL)
global(TITLE)

global(TRACE)
global(LIST)
global(PS_HDR_FILE)

/*
 *--------------------------------------------------------*
 */

proc main ()
{
    set(TRACE, 0)    /* trace proc calling sequence to trace down
                        SEGV: signal 11 crashes */

    set(LIST, 0)    /* list names as they are processed */

    call init_globals()

    list(RVAL)
    list(ILIST)
    list(NLIST)
    table(WHICH_CHART)
    table(FROM_CHART)
    indiset(INDXSET)

    getindi(me)

    /*
     *  The program can make 3 thru n generation charts
     *  but only the 7 and 8 have good aspect ratios that
     *  make them usable.
     */
    getintmsg(max, "Enter max generations per chart [7 or 8]")
    if (or( eq(max, 7), eq(max, 8)))
    {
        getintmsg(dmax, "Enter max depth of charts:")

        enqueue(ILIST, me)
        enqueue(NLIST, 1)

        call plot_init(max, TITLE)
        set(i, 1)
        while(le(i, dmax))
        {
            set (jlist, ILIST)
            set (mlist, NLIST)
            list(ILIST)
            list(NLIST)
            while (me, dequeue (jlist))
            {
                set(cno, dequeue(mlist))
                set(CURRENT_CHART_NO, cno)
                call new_plot_page(cno)
                call do_ancestors(me, 1, 0, max)
                call title_chart(cno, me, max)
            }
            set(i, add(i, 1))
        }
        call plot_fini()

        call do_index()
        call index_fini()
    }
}

proc init_globals()
{
    /* initialize global constants */

            /* Paper margins for output in points */
    set(M_TOP, 27)    /* 0.375in*72points/in */
    set(M_BOT, 0)
    set(M_LEFT, 0)
    set(M_RIGHT, 0)

            /* Large and small font sizes in points */
    set(LF_HGT, 18)
    set(LF_WDT, 12)
    set(SF_HGT, 5)
    set(SF_WDT, 4)

            /* Size of text in boxes */
    set(TEXT_HGT, SF_HGT)
    set(TEXT_WDT, SF_WDT)

            /* height of box and vertical spacing */
    set(BOX_H, add(1, TEXT_HGT))
    set(BOX_DH, add(1, BOX_H))

            /*  width of boxes in number of characters  */
    set(BOX_NC_1, 42)
    set(BOX_NC_2, 30)

            /*  width of boxes and horizontal spacing  */
    set(BOX_W, mul(BOX_NC_2, TEXT_WDT))
    set(BOX_WW, mul(BOX_NC_1, TEXT_WDT))
    set(BOX_SP, div( mul(BOX_W, 3), 20))    /* BOX_W*0.15 */
    set(BOX_DW, add(BOX_W, BOX_SP))

            /*  controls for the index  */
    set(INDEX_SIZE, 8)
    set(INDEX_LPP, 80)
    set(HEADER_SIZE, 10)

            /*  controls for what and how the charts appear */
    set(CHART_PREFIX, "")    /* if CHART_PREFIX=0 then don't number charts */
    set(LEN_CHART_PREFIX, 0)
    set(PLOT_INUMS, 1)    /* bool 0=don't plot inums, 1=plot inums */
    set(PLOT_DATE, 1)     /* bool 0=don't date charts, 1=date charts */
    set(CENTER_LAST, 1)   /* bool 0=don't center names in last column,
                                  1=center names */
    set(INDEX_ALL, 0)     /* bool 0=only index names on charts,
                                  1=index all names in database */

    /* global variables used to keep track of which chart */

    set(CHART_NO, 1)
    set(CURRENT_CHART_NO, 0)
    set(PAGE, 0)
    set(PAGE_INDX, 1)

    set(PS_HDR_FILE, "ps-pedi.ps")   /* PostScript Header file name */

    set(TITLE, "Pedigree Index")     /* Title string for Index pages */

    dayformat(0)
    monthformat(3)
    dateformat(0)
}

proc do_ancestors (me, depth, width, max)
{
if (TRACE) { print("do_ancestors ") }
    if (me)
    {
        if (LIST) {
            print(fullname(me,1,0,40)) print(" -")
            print(key(me)) print(sp()) print(d(depth))
            print(sp()) print(d(width)) print(nl())
        } else
            { print(".") }

        set(my_tag, lookup(WHICH_CHART, key(me)))
        call plot_me(me, depth, width, max)
        if ( and( or( eq(1, depth), not(my_tag)), lt(depth, max)))
        {
            if (dad, father(me))
            {
                call get_width(1, width)
                set(nwid, pop(RVAL))
                call do_ancestors(dad, add(1, depth), nwid, max)
                call connect_boxes( me, depth, width, nwid, max)
            }
            if (mom, mother(me))
            {
                call get_width(neg(1), width)
                set(nwid, pop(RVAL))
                call do_ancestors(mom, add(1, depth), nwid, max)
                call connect_boxes( me, depth, width, nwid, max)
            }
        }
        else
        {
            call box_org(depth, width, max)
            call draw_ext(me, pop(RVAL), pop(RVAL), my_tag, eq(depth, max))
        }
    }
}

proc plot_me (me, depth, width, max)
{
if (TRACE) { print("plot_me ") }
    set(last, eq(max, depth))
    set(first, eq(1, depth))
    set(style, ge(add(1, depth), max))
    call box_org(depth, width, max)
    set(my_x, pop(RVAL))
    set(my_y, pop(RVAL))
    /*
     * This if controls whether or not siblings are plotted
     */
    if (first) { call do_sibs(me, my_x, my_y, last) }
        else { call box_me(me, my_x, my_y, last) }

    if (not(lookup(WHICH_CHART, key(me))))
    {
        set(ntag, CURRENT_CHART_NO)
        if (and( last, parents(me)))
        {
            set(CHART_NO, add(1, CHART_NO))
            set(ntag, CHART_NO)
            call draw_ext(me, my_x, my_y, ntag, last)
            enqueue(ILIST, me)
            enqueue(NLIST, ntag)
            insert(FROM_CHART, save(d(CHART_NO)), CURRENT_CHART_NO)
        }
        insert(WHICH_CHART, save(key(me)), ntag)
        addtoset(INDXSET, me, ntag)
    }
}

proc box_me (me, x, y, last)
{
if (TRACE) { print("box_me ") }
    call get_dates(me)
    call print_name(me, 0)
    if (PLOT_INUMS) { set(num, save(concat("-", key(me)))) }
        else { set(num, "") }
    call draw_box_text(x, y, pop(RVAL), pop(RVAL), num, last)
}

proc do_sibs (me, x, y, last)
{
if (TRACE) { print("do_sibs ") }
    set(nkids, nchildren(parents(me)))
    set(bdh, mul(2, BOX_DH))
    set(sy, div(mul(sub(nkids, 1), bdh), 2))
    children( parents(me), child, nchild)
    {
        set(yy, add(y, sy))
        call box_me(child, x, yy, last)
        set(sy, sub(sy, bdh))
    }
}

proc do_index()
{
if (TRACE) { print("do_index ") }
    print(nl()) print("Collecting Index ...")
    if (INDEX_ALL)
    {
        forindi(me, num)
        {
            if (not(lookup(WHICH_CHART, key(me)))) { addtoset(INDXSET, me, 0) }
        }
    }
    print(nl()) print("Sorting Index ...")
    namesort(INDXSET)
    print(nl()) print("Outputing Index ")
    forindiset(INDXSET, me, chart, num)
        { call index_out(me, chart) print(".") }
}

/*
 *             --------  Postscript output routines ---------
 */

proc plot_init (max, title)
{
if (TRACE) { print("plot_init ") }
    set(PAGE, 0)
    copyfile(PS_HDR_FILE)
    call expt(2, sub(max, 2))
    set(h, mul( add( pop(RVAL), 1), mul(2, BOX_DH)))
    set(w, div( mul( add(max, 1), BOX_W), 2))
    set(w, add(w, add( mul(max, BOX_SP), BOX_WW)))
    if (CHART_PREFIX)
        { set(w, add(w, mul( add(LEN_CHART_PREFIX, 3), TEXT_WDT))) }

    "%%BeginSetup" nl()

    "/pointsize " d(INDEX_SIZE) " def" nl()
    "/headerpointsize "d(HEADER_SIZE) " def" nl()
    "/filename (" title ") def" nl()
    "/noheader false def" nl()
    "/date (" date(gettoday()) ") def" nl()

    "/nc-1 " d(BOX_NC_1) " def" nl()
    "/nc-2 " d(BOX_NC_2) " def" nl()
    "/margin-l " d(M_LEFT) " def" nl()
    "/margin-r " d(M_RIGHT) " def" nl()
    "/margin-t " d(M_TOP) " def" nl()
    "/margin-b " d(M_BOT) " def" nl()
    "/width-needed " d(w) " def" nl()
    "/height-needed " d(h) " def" nl()
    "/text-wdt " d(TEXT_WDT) " def" nl()
    "/text-hgt " d(TEXT_HGT) " def" nl()
    "setup" nl()
    "/newpagesetup save def" nl()
    "mark" nl()

    "%%EndSetup" nl()

    set(LINE_COUNT, 0)
}


proc new_plot_page (page_no)
{
if (TRACE) { print("new_plot_page ") }
    set(PAGE, add(1, PAGE))
    "%%Page: " d(page_no) " " d(PAGE) nl() "mark plotpagesetup" nl()
}

proc plot_fini ()
{
    set(PAGE, add(1, PAGE))
}

proc draw_box_text (x, y, name, date, num, last)
{
if (TRACE) { print("draw_box_text ") }
    if (last)
        { "(" name " " date "  " num ") "
          if(CENTER_LAST) { set(t, " ct1") } else { set(t, " t1")}
        }
    else
        { "(" name "  " num ") (" date ") " set(t, " t2") }
    d(x) " " d(y) t nl()
}

proc draw_ext (me, x, y, chartno, last)
{
if (TRACE) { print("draw_ext ") }
    if (parents(me))
    {
        if (last) { set(bw, div(BOX_WW, 2)) }
            else { set(bw, div(BOX_W, 2)) }
        "np " d(add(x, bw)) " " d(y)
        " mto " d(div(BOX_SP, 3)) " 0 rlto drw" nl()
        if (and( chartno, CHART_PREFIX))
        {
            d( add(x, add(bw, add(TEXT_WDT, div(BOX_SP, 3))))) " "
            d( sub(y, div(TEXT_HGT, 2))) " mto ("
            CHART_PREFIX d(chartno) ") show" nl()
        }
    }
}

proc connect_boxes (me, depth, width1, width2, max)
{
if (TRACE) { print("connect_boxes ") }
    call box_org(depth, width1, max)
        set(x1, pop(RVAL))
        set(y1, pop(RVAL))
    call box_org(add(1, depth), width2, max)
        set(x2, pop(RVAL))
        set(y2, pop(RVAL))
    set(dx, div( add(x1, x2), 2))
    set(w2, div(BOX_W, 2))
    set(w3, div(BOX_WW, 2))
    set(dh, 0)
    set(dw, w2)
    set(rad, BOX_H)
    set(style, 0)
    if (eq(depth, 1))
    {
        set(nkids, nchildren(parents(me)))
        set(sy, div( mul( sub(nkids, 1), mul(2, BOX_DH)), 2))
        if (gt(width2, 0))
            { set(y1, add(y1, sy)) } else { set(y1, sub(y1, sy)) }
    }
    if (lt(y1, y2))
        { set(dh, BOX_H) } else { set(dh, neg(BOX_H)) }
    if (eq( sub(max, depth), 1))
    {
        set(dw, w3)
        set(style, 1)
        set(rad, div(rad, 2))
        set(dx, div( sub( add(x1, add(w2, x2)), w3), 2))
    }
    elsif( eq( sub(max, depth), 2))
    {
        set(dw, w2)
        set(style, 1)
    }
    if (style)
    {
        d(div(rad, 2)) " gr np " d(add(x1, w2)) " " d(y1) " mto "
        d(dx) " " d(y1) " " d(dx) " " d(y2) " pto "
        d(sub(x2, dw)) " " d(y2) " pto lto drw" nl()
    }
    else
    {
        d(rad) " gr np " d(x1) " " d(add(y1, dh)) " mto "
        d(x1) " " d(y2) " " d(sub(x2, w2)) " " d(y2) " pto lto drw" nl()
    }
}

proc title_chart (chart_no, me, max)
{
if (TRACE) { print("title_chart ") }
    if (gt( sub(max, 2), 0))
    {
        set(x, 0)
        call expt(2, sub(max, 2))
        set(y, mul( add( pop(RVAL), 1), mul(2, BOX_DH)))
        set(w, div( mul( add(max, 1), BOX_W), 2))
        set(w, add(w, add( mul(max, BOX_SP), BOX_WW)))
        if (CHART_PREFIX)
            { set(w, add(w, mul( add(4, LEN_CHART_PREFIX), TEXT_WDT))) }
        d(y) " " d(w) " " d(x) " 0 mbox 18 1 rbox" nl()
        if (PLOT_DATE)
        {
            d(add(x, LF_WDT)) " 1.2 mul " d(div(SF_HGT,2)) " mto ("
            date(gettoday()) ") show" nl()
        }
        d(LF_WDT) " " d(LF_HGT) " mfont" nl()
        call get_dates(me)
        call print_name(me, 1)
        d(add(x, mul(2, LF_WDT))) " "
            d(sub(y, add(LF_HGT, div(LF_HGT, 2)))) " mto ("
            pop(RVAL) ") show" nl()
        d(add(x, mul(2, LF_WDT))) " "
            d(sub(y, add( mul(LF_HGT, 2), div(LF_HGT,2)))) " mto ("
            pop(RVAL) ") show" nl()
        if (CHART_PREFIX)
        {
            d(add(x, LF_WDT)) " " d(div(LF_HGT,2)) " mto (Chart: "
            CHART_PREFIX d(chart_no)
            if (e, lookup(FROM_CHART, d(chart_no)))
                { "  From: " d(e) }
            ") show" nl()
        }
        "cleartomark showpage" nl()
        "%%EndPage: " d(PAGE) " " d(PAGE) nl()
    }
}

/*
 *             --------  Postscript output routines for index ---------
 */

proc index_fini()
{
if (TRACE) { print("index_fini ") }
    "cleartomark showpage" nl()
    "%%EndPage: " d(PAGE) " " d(PAGE) nl()
    "%%Trailer" nl()
    "%%Pages: " d(PAGE) nl()
}

proc index_out (me, chart)
{
if (TRACE) { print("index_out ") }
    set(blanks, "                                                  ")
    if (not(mod(LINE_COUNT, INDEX_LPP)))
    {
        "%%Page: " d(PAGE) " " d(PAGE) nl()
        "mark indexpagesetup " d(PAGE_INDX) " pagesetup"  nl()
    }

    "("
    if (chart) { call rjt(chart, 5) pop(RVAL) } else { "    " }
    "  " trim( save( concat( key(me),"      ")), 6)
    call get_dates(me)
    call print_name(me, 1)
    "  " trim( save( concat(pop(RVAL),blanks)), 50) " " sex(me)
    " " pop(RVAL) ")l" nl()

    set(LINE_COUNT, add(LINE_COUNT,1))
    if (not(mod(LINE_COUNT, INDEX_LPP)))
    {
        "cleartomark showpage" nl()
        "%%EndPage: " d(PAGE) " " d(PAGE) nl()
        set(PAGE, add(PAGE, 1))
        set(PAGE_INDX, add(PAGE_INDX, 1))
        set(LINE_COUNT, 0)
    }
}

/*
 *             --------  Utility routines ---------
 */

proc print_name (me, last)
{
if (TRACE) { print("print_name ") }
    call get_title(me)
    push(RVAL, save(concat(fullname(me, 1, not(last), 45), pop(RVAL))))
}

proc get_title (me)
{
if (TRACE) { print("get_title ") }
    fornodes(inode(me), node)
    {
        if (not(strcmp("TITL", tag(node)))) { set(n, node) }
    }
    if (n) { push(RVAL, save(concat(" ", value(n)))) }
        else { push(RVAL, "") }
}

proc get_dates (me)
{
if (TRACE) { print("get_dates ") }
    if (e, birth(me)) { set(b, save(concat("( ", date(e)))) }
        else { set(b, "( ") }
    if (e, death(me)) { set(d, save(concat(" - " , date(e)))) }
        else { set(d, " - ") }
    push(RVAL, save(concat(b, concat(d, " )"))))
}

proc box_org (depth, width, max)
{
if (TRACE) { print("box_org ") }
    set(xx, div( mul(BOX_W, 9), 16))
    call expt(2, sub(max, 2))
    set(yy, mul( add( pop(RVAL), 1), BOX_DH))
    if ( eq(depth, 1))
        { push(RVAL, yy) push(RVAL, xx) }
    else
    {
        call expt(2, sub(max, depth))
        set(dy, mul( pop(RVAL), BOX_DH))
        call abs(width)
        set(y, sub( mul(pop(RVAL), dy), div(dy, 2)))
        set(dx, add(BOX_SP, div(BOX_W, 2)))
        set(dd, sub( sub(max, 2), depth))
        set(x, 0)
        if ( eq(dd, neg(1)))
            { set(dxx, div(BOX_W, 2)) }
        elsif (eq(dd, neg(2)))
            { set(dxx, add( div(BOX_W, 2), div(BOX_WW, 2))) }
        else
            { set(dxx, 0) }
        set(x, add(dxx, add(xx, mul(dx, sub(depth, 1)))))
        if ( lt(width, 0)) { set(y, neg(y)) }
        push(RVAL, add(yy, y))
        push(RVAL, x)
    }
}

proc get_width (sign, width)
{
if (TRACE) { print("get_width ") }
    if (eq(width, 0))
        { push(RVAL, sign) }
    else
    {
        call abs(width)
        set(awidth, pop(RVAL))
        set(s2, div(width, awidth))
        if (eq(s2, sign))
            { push(RVAL, mul(width, 2)) }
        else
            { push(RVAL, mul( sub( mul(awidth, 2), 1), s2)) }
    }
}

proc abs (int)
{
if (TRACE) { print("abs ") }
    if (lt(int, 0))
        { push(RVAL, neg(int)) }
    else
        { push(RVAL, int) }
}

proc rjt(n, w)
{
    if (lt(n, 10)) { set(d, 1) }
    elsif (lt(n, 100)) { set(d, 2) }
    elsif (lt(n, 1000)) { set(d, 3) }
    elsif (lt(n, 10000)) { set(d, 4) }
    else  { set(d, 5) }
    if (lt(d, w))
        { set(pad, save( trim("      ", sub(w, d)))) }
    else
        { set(pad, "") }
    push(RVAL, save( concat(pad, save(d(n)))))
}

proc expt(x, y)
{
if (TRACE) { print("expt ") }
    if (le(y, 0)) { set(result, 1) }
    else
    {
        set(result, x)
        while (y, sub(y,1))
            { set(result, mul(result, x)) }
    }
    push(RVAL, result)
}