/*
**  ps-anc5, 19 Feb 1996, enhanced by Phil Stringer (P.Stringer@mcc.ac.uk)
**           - all comments/bugs should now go to Phil Stringer
**  ps-anc, 9 September 1994, by Fred Wheeler (wheeler@ipl.rpi.edu)
**
**  BRIEF DESCRIPTION
**
**  This LifeLines report program generates Postscript ancestral and
**  descendant charts.  The ancestral charts can include the siblings
**  of all direct ancestors (aunts, uncles, great-aunts, great-uncles,
**  etc.).  A multi-page poster chart can also be generated.  The
**  chart format is based on the program GedChart, by Tom Blumer.
**
**  The Postscript file created can be sent to any size printer; it
**  will automatically adapt the size of the chart.  I send the same
**  file to A-size (8.5 by 11) and B-size (11 by 17) printers.
**
**  After you use this program a few times, you should edit the
**  function interrogate_user().  This is the first function after
**  these comments and the global variable declarations.  This
**  function is set up to make it easy for you to configure what
**  questions this program should ask you each time and what default
**  values it should use for questions not asked.
**
**  Please contact me if you like this program, find any bugs, have
**  any bug fixes, or want to suggest improvements.  I am also always
**  on the lookout for better ancestral/descendant chart generating
**  programs.  If you know of a program that generates charts which
**  you like better than those generated by this program, please drop
**  me a line.
**
**  This report program works with the LifeLines Genealogical database
**  program only.  (see ftp://ftp.cac.psu.edu/pub/genealogy/lines/*)
**
**  CHANGE LOG
**
**  Changes since version 1:
**    Completely new descendant chart in addition to ancestral chart
**    Multi-page poster option
**    Multi-page charts scaled correctly (thanks to broman@Np.nosc.mil)
**    Maximum name length configurable by user (fixes long squashed names)
**    Option to supress siblings of later generations in ancestral charts
**    Checks that user selects a valid person (bug fix)
**    Can make a guess at whether a title is a prefix of suffix type
**    Use of titles is configurable (prefix, suffix, guess, none)
**    Birth/death/marriage date styles are configurable (may include place)
**    Corner message is slightly smaller, and chart will not overlap it
**    Marriage date is printed before death date
**
**  CREDITS
**
**  Code improvements received from:
**    Vincent Broman (broman@Np.nosc.mil)
**
**  Helpful comments received from:
**    Vincent Broman (broman@Np.nosc.mil)
**    Frank H. Flaesland (phranx@imr.no)
**    Linda Wilson (lwilson@mcc.com)
**    Stacy Johnson (sjohnson@oucsace.cs.ohiou.edu)
**    John F. Chandler (jchbn@cuvmb.cc.columbia.edu)
**    Susan Radel
**
**  Changes since version 2:
**    Birth/death/marriage date style addition (full date with short place).
**    Examples for including other fonts.
**    Option for bold lines/text for direct line of ascent.
**    Option to start on right or left of page.
**    Option for landscape or portrait format.
**    Small additional space between border and text to improve appearance.
**    Now fills the page if max generations > actual generations.
**    With multi-page output generations are multiple of x-pages to prevent
**      text split over sheets.
**    Option to show aunts/uncles from parents multiple marriages.
**
**  Changes since version 3:
**    Border enhanced at the corners.
**    Chart title font changed.
**    Lines now used to join families rather than being used as a framework.
**    Names now adjacent to line or halfway between if in 2 families.
**    Descendant chart has reduced lines and is more tree like
**
**  Changes since version 4:
**    Enhanced descendant chart
**    Automatic choice of chart type if no children or no ancestors
**    Multi page landscape bug fixed
**    Enhancements to user option specification
**    Character set enhanced to iso-8859-1
**    Additional titles
**
**  CREDITS
**
**  Code improvements received from:
**    Phil Stringer (p.stringer@mcc.ac.uk)
**
**  ABOUT GEDCHART (a different program)
**
**  This program includes postscript code written by Tom Blumer
**  (blumer@ptltd.com).  It is used here with his permission.  This
**  postscript code is from Tom Blumer's GedChart package.  The report
**  is very much like that generated by GedChart using the -Sa or -Sd
**  option.
**
**  GedChart is DOS program that generates ancestral and descendant
**  charts like this report program, and also fan charts.  GedChart
**  works directly from a GEDCOM file and is completely independent of
**  LifeLines.  It is currently up to version 1.6, which is a beta
**  version that may lead to a commercial product.  You can find
**  GedChart at ftp:oak.oakland.edu/pub/msdos/genealgy/gedcht16.zip
**
*/

global (high_pos_gen)         /* array, highest so far in each generation */
global (high_pos_all)         /* highest position so far for any generation */
global (high_depth)           /* highest depth so far */

global (name_height)          /* height of name text on chart */
global (date_height)          /* height of birth/death/marriage date text */

global (no_parent_extra)      /* constant, extra vert. line when no parent */

/* variables prompted from or configured by the user */

global (chart_type)           /* int, 0: ancestral, 1: descendant */
global (root_person)          /* indi, person for whom to generate the chart */
global (font_name)            /* string, name of font */
global (max_depth)            /* int, maximum number of generations */
global (chart_label)          /* string, label for corner of chart */
global (color_chart)          /* boolean, is chart in color */
global (multi_page)           /* boolean, is chart many page poster type */
global (x_pages)              /* int, number of horizontal pages */
global (y_pages)              /* int, number of vertical pages */
global (name_letters)         /* int, maximum number of letters in a name */
global (title_method)         /* int, code for how to insert titles */
global (depth_siblings)       /* int, number of generations to show siblings */
global (dateplace_birth)      /* int, date style for birth/death/marriage */
global (dateplace_death)
global (dateplace_marriage)
global (bold_chart)           /* int, direct line in bold 0: no, 1: yes */
global (mirror_chart)         /* int, root person on right 0: no, 1: yes */
global (half_sib)             /* int, show half-siblings 0: no, 1: yes */
global (portrait)             /* int, 0: landscape, 1: portrait */

/* variables to return values from procedures to make them functions */
global (do_anc_stack)         /* stack, function do_anc is recursive */
global (person_height_return)
global (is_prefix_title_return)
global (dateplace_return)

/* these three constants define how close branches of the tree can get */
global (branch_dist_prev)     /* minimum distance from previous generation */
global (branch_dist_same)     /* minimum distance from same generation */
global (branch_dist_next)     /* minimum distance from next generation */

/* stacks for storing the information for each person on the chart */
/* see proc's enqueue_person and dequeue_all_persons */

global (plist_person)  /* the person (to extract name, birth, death) */
global (plist_depth)   /* generation depth */
global (plist_pos)     /* vertical position */
global (plist_line)    /* 0,1 boolean, is direct ancestor? */
global (plist_mdate)   /* marriage date */
global (plist_anc)    /* 0,1 boolean, person has ancestor? */
global (plist_des)    /* 0,1 boolean, person has descendant? */

/* stacks for storing the information for each vertical line on the chart */
/* see proc's enqueue_vertical and dequeue_all_verticals */

global (llist_depth)   /* generation depth */
global (llist_low)     /* starting point */
global (llist_high)    /* finishing point */
global (llist_dash)    /* dashed lines */

/*
**  function: interrogate_user
**
**  This function is designed to be modified by the user.  It asks
**  many questions about how to configure the charts.  If your answer
**  to one of the questions is always the same, you can easily
**  hardwire your answer here so that you are never asked again.
**
**  An 'if' statement is wrapped around each question.  The 'if (1)'
**  can be changed to an 'if (0)' to make the program use the default
**  value defined in the 'else' clause instead of asking every time.
**
*/

func interrogate_user ()
{

/*
**  QUESTION: Who is the root person?
**
**  This question should always be asked, unless you always use the same
**  person, which is not likely.  If you do set a default, it is a string
**  representation of that persons number.
**
*/

  if (1)  {
    set (root_person, 0)
    while ( not (root_person) )  {
      getindimsg (root_person, "Identify root person for chart")
    }
  }  else  {
    set (root_person, indi ("1"))
  }

/*
**  QUESTION: What type of chart?
**
**  This should always be asked, unless you never use one of the two
**  types of charts. If there is only one type of chart possible e.g.
**  the person has no children, or no ancestors then the question
**  isn't asked.
**
*/
  if (1)  {
    indiset(pset)
    addtoset(pset,root_person,1)
    if (eq( lengthset(childset(pset)), 0) ) {
      print ("Printing ancestor chart as ", name(root_person), " has no known children.", nl())
      set (chart_type, 0)
    } elsif (eq( lengthset(parentset(pset)), 0) ) {
        print ("Printing descendant chart as ", name(root_person), " no known ancestors.", nl())
        set (chart_type, 1)
    } else {
        getintmsg (chart_type, "Enter 0 for ancestral, 1 for descendant chart")
    }
  } else {
     set (chart_type, 1)
  }


/*
**  QUESTION: How many generations should be shown?
**
**  If there are less than this, then the page is filled anyway,
**  so you only need to ask if you want a restricted number.
**
*/

  if (0)  {
    getintmsg (max_depth, "Maximum number of generations")
  }  else  {
    set (max_depth, 99)
  }

/*
**  QUESTION: How many generations should show siblings?
**
**  If you want to show siblings in all generations, set this default to 999.
**  This question is only asked for ancestral charts.
**
*/

  if (eq (chart_type, 0))  {

    if (0)  {
      getintmsg (depth_siblings, "How many generations to show siblings")
    }  else  {
      set (depth_siblings, 999)
    }

  }

/*
**  QUESTION: What message should be shown in the corner of the chart?
**
**  I suggest not asking this question, and setting a default credit with
**  your name.  The advantage of this is that you can have the date
**  automatically inserted.
**
*/

  if (0)  {
    getstrmsg (chart_label, "Label for corner of chart (your name, date)")
    set (chart_label, save (chart_label))
  }  else  {
    dayformat (2)
    monthformat (4)
    dateformat (0)
    set (chart_label,
      concat (save (stddate (gettoday ())),
        "    produced by Phil Stringer, 40 Broomfields, Denton, Manchester M34 3TH.    Tel: 0161 320 6530"))
  }

/*
**  QUESTION: What font should be used?
**
**  Because it is such a pain to enter a font name, and a spelling mistake
**  will get you an ugly default font, this should be set to a default.  I
**  suggest one of: Times-Roman, NewCenturySchlbk-Roman, or ZapfChancery.
**  Search the Postscript code at bottom of this file for a longer list.
**
*/

  if (0)  {
    getstrmsg (font_name,
      "Font (Times-Roman, NewCenturySchlbk-Roman, ZapfChancery, etc.")
    set (font_name, save (font_name))
  }  else  {
    set (font_name, "ZapfChancery-MediumItalic")
   /* set (font_name, "Times-Roman")*/
  }

/*
**  QUESTION: Should color be used?
**
**  If you don't have access to a color printer, you should probably turn
**  off this question.
**
*/

  if (0)  {
    getintmsg (color_chart, "Enter 0 for black/white, 1 for color")
  }  else  {
    set (color_chart, 1)
  }

/*
**  QUESTION: Do you want multi-page poster output, and select orientation.
**
**  So that I am not hassled with this question everytime I run this
**  program, I turn this question off, but change the default on the
**  special occasion that I want a poster chart.
**
*/

  if (1)  {
    list(options)
    setel(options,1,"Single page, in portrait")
    setel(options,2,"Single page, in landscape")
    setel(options,3,"Multi page, using portrait sheets of paper")
    setel(options,4,"Multi page, using landscape sheets of paper")
    set(mc, menuchoose(options, "Select chart type:"))
    if (eq(0,mc)) {
      return(0)
    } elsif (eq(1,mc)) {
      set (multi_page, 0)
      set (portrait, 1)
      print("Single page - portrait", nl())
    } elsif (eq(2,mc)) {
      set (multi_page, 0)
      set (portrait, 0)
    } elsif (eq(3,mc)) {
      set (multi_page, 1)
      set (portrait, 1)
    } else {
      set (multi_page, 1)
      set (portrait, 0)
    }
}

/*
**  QUESTION: How many pages make up the poster?
**
**  You will probably want to always ask this question.  This question is
**  asked if a poster chart is requested.
**
*/

  if (multi_page)  {
    if (1)  {
        getintmsg (x_pages, "Number of horizontal pages on finished chart")
        getintmsg (y_pages, "Number of vertical pages on finished chart")
    } else {
      set (x_pages, 3)
      set (y_pages, 3)
    }
  }  else  {
    set (x_pages, 1)
    set (y_pages, 1)
  }

/*
**  QUESTION: How should titles be used?
**
**  I would leave this default set to 'guess' (3), or 'none' (0), if you
**  don't want the titles.  If find a title that is guessed incorrectly,
**  please send an e-mail to wheeler@ipl.rpi.edu.
**
*/

  if (0)  {
    getintmsg (title_method, "Title method (0:none,1:prefix,2:suffix,3:guess)")
  }  else  {
    set (title_method, 3)
  }

/*
**  QUESTION: What is the maximum length for names?
**
**  It is best to just set a default maximum name length.  If you want
**  to always show the complete name, just set the default to 999.
**
*/

  if (0)  {
    getintmsg (name_letters, "Maximum name length")
  }  else  {
    set (name_letters, 40)
  }

/*
**  QUESTION: How should dates/places of birth/death/marriage be shown?
**
**  This is actually three questions, or the same question for birth
**  death and marriage dates.  The codes cause the dates to be printed
**  as follows.
**
**      0: do not show date
**      1: full date only
**         [ LifeLines date() function ]
**      2: date and place, just year and State/Country
**         [ LifeLines short() function ]
**      3: full date and full place, can get very long and thus smushed
**         [ LifeLines long() function ]
**
*/

  if (0)  {
    set (dateplace_birth, 99)
    while (or (lt (dateplace_birth, 0), ge (dateplace_birth, 4)))  {
      getintmsg (dateplace_birth,
                 "Birth date style (0:no,1:date,2:short,3:long)")
    }
    set (dateplace_death, 99)
    while (or (lt (dateplace_death, 0), ge (dateplace_death, 4)))  {
      getintmsg (dateplace_death,
                 "Death date style (0:no,1:date,2:short,3:long)")
    }
    set (dateplace_marriage, 99)
    while (or (lt (dateplace_marriage, 0), ge (dateplace_marriage, 4)))  {
      getintmsg (dateplace_marriage,
                 "Marriage date style (0:no,1:date,2:short,3:long)")
    }
  }  else  {
    set (dateplace_birth, 4)
    set (dateplace_death, 4)
    set (dateplace_marriage, 4)
  }

/*
**  QUESTION: Should the direct line of descent be put in bold?
**
**  Puts the text and lines for the direct line in bold.
**
*/

  if (0)  {
    getintmsg (bold_chart, "Enter 1 for bold direct line, 0 for all the same")
  }  else  {
    set (bold_chart, 1)
  }

/*
**  QUESTION: Should the selected person be on the left or right of the page?
**
*/

  if (0)  {
    getintmsg (mirror_chart, "Enter 0 to start on left of paper, 1 to start on right")
  } else {
    if (chart_type) {
      /* Descendant chart */
      set (mirror_chart, 0)
    } else {
      set (mirror_chart, 1)
    }
  }

/*
**  QUESTION: Should half siblings be shown?
**
**  In the ancestral report, if a parent has had multiple marriages
**  this determines whether the children of these marriages are shown
**  in the aunts/uncles. They ar placed above the father or below the
**  mother with a thin vertical line in the aunt/uncle colour.
**
*/

  if (0)  {
    getintmsg (half_sib, "Enter 1 to show half brothers/sisters, 0 to omit them")
  } else {
     set (half_sib, 1)
  }

/*
**  END OF QUESTIONS
**
*/

  return(1)
}

/*
**  procedure: main
**
**  The main procedure.
**
*/

proc main ()
{

  /* set constants */

  set (name_height, 1250)          /* height to allow for name text */
  set (date_height, 750)           /* height to allow for date text */

  set (branch_dist_prev, 1000)     /* previous generation */
  set (branch_dist_same, 1250)     /* same generation */
  set (branch_dist_next, 1000)     /* next generation */

  set (no_parent_extra, 500)       /* a little extra line when no parent */

  /* initialize other global variables and declare global stacks */

  set (high_pos_all, 0)

  list (high_pos_gen)
  list (do_anc_stack)

  list (plist_person)
  list (plist_depth)
  list (plist_pos)
  list (plist_line)
  list (plist_mdate)
  list (plist_anc)
  list (plist_des)

  list (llist_depth)
  list (llist_low)
  list (llist_high)
  list (llist_dash)

  if (interrogate_user()) {

  /* convert the numerical response for color to string, "true" or "false" */

  if (eq (color_chart, 0))  {
    set (color_true_false, "false")
  }  else  {
    set (color_true_false, "true")
  }

  /* start iteration that creates the chart */

  if (eq (chart_type, 0))  {
    call do_anc (root_person, 1, 0, 0, 0)
  }  else  {
    call do_des (root_person, 1, 0, 0, 1)
  }

  /* Ensure that the vertical columns do not cross a page edge, as its hard to fit
   * the text into a perfect line! */

  set (hd,mul(div(high_depth,x_pages),x_pages))
  if (gt(high_depth,hd)) {
        set(high_depth,add(hd,x_pages))
  }

  /* put the pieces together to make the output file */

  set (xi, 1)
  while ( le (xi, x_pages))  {
    set (yi, 1)
    while ( le (yi, y_pages))  {

      call print_header (font_name, high_depth, high_pos_all, color_true_false,
                         chart_label, xi, x_pages, yi, y_pages)
      call dequeue_all_persons ()
      call dequeue_all_verticals ()
      "showpage" nl()

      set (yi, add (yi, 1))
    }
    set (xi, add (xi, 1))
  }
  }

}

/*
**  procedure: do_anc
**
**  A recursive function to position persons on an ancestral chart.
**  First, a recursive call is made to put the father on the chart.
**  Where he is put on the chart determines the minimum position for
**  the mother.  Once the father and mother are put on the chart, the
**  siblings are put on the chart.
**
**  The position of the person is returned via the global stack
**  do_anc_stack.  A stack is necessary since this procedure is
**  reentrant.
**
*/

proc do_anc (person, depth, min_pos_arg, marriage_date, des)
{
  set(anc, 0)
  /* don't want to modify procedure argument variable, so copy it */

  set (min_pos, min_pos_arg)

  /* make sure minimum position is greater than zero */

  if (lt (min_pos, 0))  {
    set (min_pos, 0)
  }

  /* make we will not overlap the another branch at the younger generation */

  if (gt (depth, 1))  {
    if (high, getel (high_pos_gen, sub (depth, 1)))  {
      if (lt (min_pos, add (high, branch_dist_prev)))  {
        set (min_pos, add (high, branch_dist_prev))
      }
    }
  }

  /* make we will not overlap the another branch at the same generation */

  if (high, getel (high_pos_gen, depth))  {
    if (lt (min_pos, add (high, branch_dist_same)))  {
      set (min_pos, add (high, branch_dist_same))
    }
  }

  /* make we will not overlap the another branch at the older generation */

  if (lt (depth, max_depth))  {
    if (high, getel (high_pos_gen, add (depth, 1)))  {
      if (lt (min_pos, add (high, branch_dist_next)))  {
        set (min_pos, add (high, branch_dist_next))
      }
    }
  }

  /* See if father had any other children by a different mother
   * and add up the space to show them */

  set (fam, parents (person))
  set (famkey,key(fam))
  set(fhsize, 0)
  set(dhs,0)
  if (and(half_sib,father(person))) {
    set(anc, 1)
    if ( gt (nfamilies(father(person)),1)) {
      families(father(person),fv,sv,nf) {
        if (ne(famkey,key(fv))) {
          children (fv, child, un) {

            set(dhs,1)

            /* increment position by height of person plus the spacer */

            call person_height (child)
            set (fhsize, add (fhsize, person_height_return))
          }
        }
      }
    }
  }

  /* do father if he exists and is not too deep */

  /* update the highest position array, or set it for the first time */
  /* to save space for these other children */

  if (high, getel (high_pos_gen, depth))  {
    if (lt (high, add(high,fhsize)))  {
      setel (high_pos_gen, depth, add(high,fhsize))
    }
  }  else  {
    setel (high_pos_gen, depth, fhsize)
  }

  set (dad_min_pos, sub (min_pos, name_height))
  set (dad_pos, dad_min_pos)
  set (did_dad, 0)                     /* boolean, is dad on the chart */

  if (lt (depth, max_depth))  {
    if (par, father (person))  {
      set(anc, 1)
      call dateplace (marriage (parents (person)), dateplace_marriage)
      if (dateplace_return)  {
        call do_anc (par, add (depth, 1), dad_min_pos, dateplace_return, 1)
      }  else  {
        call do_anc (par, add (depth, 1), dad_min_pos, 0, 1)
      }
      set (dad_pos, pop (do_anc_stack))
      set (did_dad, 1)
    }
  }

  if (lt (min_pos, add (dad_pos, name_height)))  {
    set (min_pos, add (dad_pos, name_height))
  }

  /* If father had any other kids by a different mother print them*/

  set(pos,sub(dad_pos, fhsize))
  set(sdhs, pos)
  if (dhs) {
    families(father(person),fv,sv,nf) {
      if (ne(famkey,key(fv))) {
        children (fv, child, un) {
          call enqueue_person (child, depth, pos, 0, 0, 1, 0)

          /* increment position by height of person plus the spacer */

          call person_height (child)
          set (pos, add (pos, person_height_return))
        }
      }
    }
    call enqueue_vertical (depth, sdhs, pos, 1) /* Draw th line */
  }

  /* figure out number of siblings and total sibling height */
  /* done differently, depending on whether the parents family exists */

  if ( and ( fam, le (depth, depth_siblings) ) )  {

    set (sibling_height, 0)
    children (fam, child, unused_number)  {
      call person_height (child)
      set (sibling_height, add (sibling_height, person_height_return))
    }
    set (num_siblings, nchildren (fam))

  }  else  {

    call person_height (child)
    set (sibling_height, person_height_return)
    set (num_siblings, 1)

  }

  /* add extra width for marriage date of male ancestor, if it is known */

  if (marriage_date)  {
    set (sibling_height, add (sibling_height, date_height))
  }

  /* do mother if she exists and is not too deep */

  set (mom_min_pos, add (add (dad_pos, name_height), sibling_height))
  set (mom_min_pos,sub(mom_min_pos,250))
  set (mom_pos, mom_min_pos)
  set (did_mom, 0)                     /* boolean, is mom on the chart */

  if (lt (depth, max_depth))  {
    if (par, mother (person))  {
      set(anc, 1)
      call do_anc (par, add (depth, 1), mom_min_pos, 0, 1)
      set (mom_pos, pop (do_anc_stack))
      set (did_mom, 1)
    }
  }

  /* find the spacer needed to line up siblings between mother and father */

  set (delta, sub (mom_pos, add (dad_pos, name_height)))
  set (extra, sub (delta, sibling_height))
  set (spacer, div (extra, add (num_siblings, 1)))

  set (pos, add (dad_pos, name_height))
  set (pos, add (pos, spacer))

  /* position siblings, differently depending on whether parents exist */

  if (fam, parents (person))  {

    if ( le (depth, depth_siblings))  {

      children (fam, child, number)  {

        /* if this is the ancestor, return the position and use marriage */

        if (eq (child, person))  {
          call enqueue_person (child, depth, pos, 1, marriage_date, 1, des)
          push (do_anc_stack, pos)
        }  else  {
          call enqueue_person (child, depth, pos, 0, 0, 1, 0)
        }

        /* store the positions of the first and last children */

        if (eq (number, 1))  {
          set (first_pos, pos)
        }
        if (eq (number, nchildren (fam)))  {
          set (last_pos, pos)
        }

        /* increment position by height of person plus the spacer */

        call person_height (child)
        set (pos, add (pos, person_height_return))
        if (and (eq (child, person), marriage_date))  {
          set (pos, add (pos, date_height))
        }
        set (pos, add (pos, spacer))
      }

    }  else  {

      call enqueue_person (person, depth, pos, 1, marriage_date, anc, des)
      push (do_anc_stack, pos)

      /* this may cause a line of zero length to be drawn */
      set (first_pos, pos)
      set (last_pos, pos)

      /* increment position by height of person plus the spacer */

      call person_height (person)
      set (pos, add (pos, person_height_return))
      if (marriage_date)  {
        set (pos, add (pos, date_height))
      }
      set (pos, add (pos, spacer))
    }

    /* if father is on the chart, he determines the vertical line start */
    /* otherwise, the oldest sibling does */

    if (eq (did_dad, 1))  {
      set (line_start, dad_pos)
    }  else  {
      set (line_start, sub (first_pos, no_parent_extra))
    }

    /* note: line_start may be < 0, that is OK */

    /* if mother is on the chart, she determines the vertical line end */
    /* otherwise, the youngest sibling does */

    if (eq (did_mom, 1))  {
      set (line_end, mom_pos)
    }  else  {
      set (line_end, add (last_pos, no_parent_extra))
    }
    /* set(line_end, sub(line_end,250)) */

    /* print vert. line if mother, father or any siblings are on the chart */

    if (or (or (did_mom, did_dad), gt (nchildren (fam), 1)))  {
      call enqueue_vertical (depth, line_start, line_end, 0)
      /* update highest overall position */
      if (lt (high_pos_all, add (line_end, name_height)))  {
        set (high_pos_all, add (line_end, name_height))
      }
    }

  }  else  {

    /* else, if the person has no visible siblings */

    call enqueue_person (person, depth, pos, 1, marriage_date, anc, des)
    push (do_anc_stack, pos)

    /* increment position by height of person plus the spacer */

    call person_height (person)
    set (pos, add (pos, person_height_return))
    if (marriage_date)  {
      set (pos, add (pos, date_height))
    }
    set (pos, add (pos, spacer))
  }

  /* See if mother had any other children by a different father */

  set(smhs, pos)
  set(dhs,0)
  set(pos, add (pos,branch_dist_next))
  if (and(half_sib,did_mom)) {
    if ( gt (nfamilies(mother(person)),1)) {
      families(mother(person),fv,sv,nf) {
        if (ne(famkey,key(fv))) {
          children (fv, child, un) {

            set(dhs,1)
            call enqueue_person (child, depth, pos, 0, 0, 1, 0)

            /* increment position by height of person plus the spacer */

            call person_height (child)
            set (pos, add (pos, person_height_return))
          }
        }
      }
    }
  }

  /* If there were any more children on the mothers side draw the vert line */

  if (dhs) {
    call enqueue_vertical (depth, smhs, sub(pos,name_height), 1)
    set(pos,add(pos,no_parent_extra))
  }

  /* update the highest position array, or set it for the first time */

  if (high, getel (high_pos_gen, depth))  {
    if (lt (high, pos))  {
      setel (high_pos_gen, depth, pos)
    }
  }  else  {
    setel (high_pos_gen, depth, pos)
  }

  /* update the overall highest position */

  if (lt (high_pos_all, pos))  {
    set (high_pos_all, pos)
  }

  /* update the overall highest depth */

  if (lt (high_depth, depth))  {
    set (high_depth, depth)
  }
}

/*
**  procedure: do_des
**
**  A recursive function to position persons on a descendant chart.
**
**  Descendant charts are harder to make look neat, as ancestor charts
**  branch from the ends of a family group, whilst descendant charts can
**  branch from any child. A person's family can either branch up to the
**  top of the page or down to the bottom. So to get a spreading chart the
**  first half of a family branch up, and the rest branch down.
**
**  As a child's own family affects the position of his/her siblings, then
**  those higher on the page may need to move down. At the moment this is done
**  for the parent or spouse (branch down or up) but not for siblings without
**  children. An improvement could therfore be made by stacking such individuals
**  then printing as required. However it gets more complicated with spouses and
**  multiple families.
**
**  A simpler enhancement required is to position a person with no spouse halfway
**  between the children when branching up as is already done when branching
**  down.
*/

proc do_des (person, depth, min_pos_arg, anc, branch_up)
{
  if (branch_up) {
    set (branch_down,0)
  } else {
    set (branch_down,1)
  }
  set(des, 0)
  if( ne(nfamilies(person),0) ) {
    set(des, 1)
  }
  /* don't want to modify procedure argument variable, so copy it */

  set (min_pos, min_pos_arg)

  /* make sure we will not overlap the another branch at the same generation */

  if (high, getel (high_pos_gen, depth))  {
    if (lt (min_pos, high))  {
      set (min_pos, high)
    }
  }
  if (lt (min_pos, branch_dist_same))  {
    set (min_pos, branch_dist_same)
  }

  set (make_line, 0)
  set (pos, min_pos)
  set (had_kids, 0)
  set (known_spouse, 0)

  set (start_pos,pos)
  if (and(nspouses(person),branch_down)) {
    call person_height (person)
    set (pos, add (pos, person_height_return))
  }
  set (ffcp, pos)


  families (person, fam, spouse, fn)  {
    set (make_line, 1)
/*    if (eq (fn, 1))  {
      set (line_top, pos)
    }*/
    if (branch_up)  {
      call dateplace (marriage (fam), dateplace_marriage)
      set (mdate, dateplace_return)
      set (start_fam, pos)
      if (spouse) {
        set (pos, add(pos,name_height))
      }
    }
    set (change_point, div (add(1,nchildren(fam)), 2))
    if (lt (depth, max_depth))  {
      children (fam, child, cn)  {
        set (had_kids, 1)
        if ( and(and(and(eq(1,cn),eq(1,fn)),eq(1,nfamilies(person))),eq(1,nchildren(fam))) ) {
          call do_des (child, add (depth, 1), pos, 1, branch_up)
        } else {
          if ( gt (cn, change_point)) {
            call do_des (child, add (depth, 1), pos, 1, 0)
          } else {
            call do_des (child, add (depth, 1), pos, 1, 1)
          }
        }
        set (pos, pop (do_anc_stack))
        if (eq (1,cn)) {
          if (branch_down) {
            set (start_fam, pos)
          } else {
            if (spouse) {
              set (start_fam, sub(pos,name_height))
            } else {
              set (start_fam, pos)
            }
          }
          if (eq (1, fn)) {
            set (ffcp, pos)
            set (line_top, start_fam)
          }
        }
      }
      if (nchildren(fam)) {
        set(nd, add(depth,1))
        set(ov, getel(high_pos_gen,nd))
        setel(high_pos_gen, nd, add(ov,branch_dist_same))
      }
    }
    if (branch_up) {
      if (spouse)  {
        set (known_spouse, 1)
/*      if (had_kids) {
          set (nms, sub (start_fam, name_height))
        } else {*/
          set (nms, start_fam)
/*      }*/
        if (eq (1,fn)) {
          set (line_top, nms)
        }
        call enqueue_person (spouse, depth, nms, 0, mdate, 0, 1)
        call person_height (person)
        set (nms, add (nms, person_height_return))
        if (mdate)  {
          set (nms, add (nms, date_height))
        }
        if (gt (nms, pos)) {
          set(pos, nms)
        }
      }
      set (line_bot, pos)
    } else {
      call dateplace (marriage (fam), dateplace_marriage)
      set (mdate, dateplace_return)
      if (spouse)  {
        set (known_spouse, 1)
        if (had_kids) {
          set (pos, add (pos, name_height))
        }
        call enqueue_person (spouse, depth, pos, 0, mdate, 0, 1)
        set (line_bot, pos)
        call person_height (spouse)
        set (pos, add (pos, person_height_return))
        if (mdate)  {
          set (pos, add (pos, date_height))
        }
      } else {
        set (line_bot, pos)
      }
    }
  }

  if (branch_up)  {
    if (had_kids) {
      set (pos, add (pos, name_height))
    }
    if (and (had_kids, not (known_spouse))) {
      set (nmp, add (line_top, div (sub(line_bot, line_top), 2)))
      call enqueue_person (person, depth, nmp, 1, 0, anc, des)
      call enqueue_person (person, depth, nmp, 1, 0, anc, des)
      push (do_anc_stack, nmp)
      set (nmp, add (nmp, person_height_return))
      if (gt (nmp, pos)) {
        set(pos, nmp)
      }
    } else {
      call enqueue_person (person, depth, pos, 1, 0, anc, des)
      push (do_anc_stack, pos)
      set (line_bot, pos)
      call person_height (person)
      set (pos, add (pos, person_height_return))
    }
  } else {
    call person_height (person)
    if (and (had_kids, known_spouse)) {
      set (nmp, sub (ffcp, person_height_return))
    } else {
      set (nmp, start_pos)
    }
    set (line_top, nmp)
    if (and (had_kids, not (known_spouse))) {
      set (nmp, add (line_top, div (sub(line_bot, line_top), 2)))
    }
    call enqueue_person (person, depth, nmp, 1, 0, anc, des)
    push (do_anc_stack, nmp)
    set (nmp, add (nmp, person_height_return))
    if (gt (nmp, pos)) {
      set(pos, nmp)
    }
  }

  /* update the highest position array, or set it for the first time */

  if (high, getel (high_pos_gen, depth))  {
    if (lt (high, pos))  {
      setel (high_pos_gen, depth, pos)
    }
  }  else  {
    setel (high_pos_gen, depth, pos)
  }

  /* update the overall highest position */

  if (lt (high_pos_all, pos))  {
    set (high_pos_all, pos)
  }

   /* update the overall highest depth */

  if (lt (high_depth, depth))  {
    set (high_depth, depth)
  }

  if (make_line)  {
    call enqueue_vertical (depth, line_top, line_bot, 0)
  }
}

/*
**  procedure: dateplace
**
**  Get the date of an event in the appropriate style (which may include
**  the place.  Return via global variable.
**
*/

proc dateplace (ev, style)
{
  if (eq (style, 0))  {
    set (dateplace_return, 0)
  }
  if (eq (style, 1))  {
    set (dateplace_return, save (date (ev)))
  }
  if (eq (style, 2))  {
    set (dateplace_return, save (short (ev)))
  }
  if (eq (style, 3))  {
    set (dateplace_return, save (long (ev)))
  }
  if (eq (style, 4))  {
        if (long(ev)) {
                if (place(ev)) {
                        list(pl)
                        extractplaces(ev,pl,np)
                        set(where,concat(", ",dequeue(pl)))
                        set (dateplace_return, save (concat(date (ev), where)))
                } else {
                        set (dateplace_return, save (date (ev)))
                }
        } else {
                set (dateplace_return, 0)
        }
  }
  if (ge (style, 5))  {
    print ("error: invalid date style code")
  }
}

/*
**  procedure: person_height
**
**  Return the height of a single persons entry.  Only the name, and
**  birth and death dates are considered.  The name is assumed to be in
**  the database, the dates are checked for.  The marriage date is not
**  checked for here.  It is more tricky since it is only put below the
**  father's name and you have to make sure you have the date from the
**  right marriage.
**
**  The height of the person is returned via the global variable
**  person_height_return.  This global variable is used since LifeLines
**  does not yet provide user-defined functions.
**
*/

proc person_height (person)
{
  /* determine height of person and put in global var person_height_return */

  set (person_height_return, name_height)

  call dateplace (birth (person), dateplace_birth)
  if (dateplace_return)  {
    set (person_height_return, add (person_height_return, date_height))
  }

  call dateplace (death (person), dateplace_death)
  if (dateplace_return)  {
    set (person_height_return, add (person_height_return, date_height))
  }
}

/*
**  procedure: is_prefix_title
**
**  Decide if the given title is a prefix type title.  Returns boolean
**  response in global variable is_prefix_title_return.
**
*/

proc is_prefix_title (t)
{
  set (is_prefix_title_return, 0)

  if (index (t, "Arch", 1))    { set (is_prefix_title_return, 1) }
  if (index (t, "Baron", 1))   { set (is_prefix_title_return, 1) }
  if (index (t, "Bish", 1))    { set (is_prefix_title_return, 1) }
  if (index (t, "Brot", 1))    { set (is_prefix_title_return, 1) }
  if (index (t, "Card", 1))    { set (is_prefix_title_return, 1) }
  if (index (t, "Canon", 1))  { set (is_prefix_title_return, 1) }
  if (index (t, "Cong", 1))    { set (is_prefix_title_return, 1) }
  if (index (t, "Deacon", 1))  { set (is_prefix_title_return, 1) }
  if (index (t, "Dr", 1))      { set (is_prefix_title_return, 1) }
  if (index (t, "Duke", 1))    { set (is_prefix_title_return, 1) }
  if (index (t, "Father", 1))  { set (is_prefix_title_return, 1) }
  if (index (t, "Fr", 1))      { set (is_prefix_title_return, 1) }
  if (index (t, "Hon", 1))     { set (is_prefix_title_return, 1) }
  if (index (t, "Judge", 1))   { set (is_prefix_title_return, 1) }
  if (index (t, "King", 1))    { set (is_prefix_title_return, 1) }
  if (index (t, "Lady", 1))    { set (is_prefix_title_return, 1) }
  if (index (t, "Lord", 1))    { set (is_prefix_title_return, 1) }
  if (index (t, "Miss", 1))    { set (is_prefix_title_return, 1) }
  if (index (t, "Mons", 1))    { set (is_prefix_title_return, 1) }
  if (index (t, "Mr", 1))      { set (is_prefix_title_return, 1) }
  if (index (t, "Mrs", 1))     { set (is_prefix_title_return, 1) }
  if (index (t, "Ms", 1))      { set (is_prefix_title_return, 1) }
  if (index (t, "Msgr", 1))    { set (is_prefix_title_return, 1) }
  if (index (t, "Pope", 1))    { set (is_prefix_title_return, 1) }
  if (index (t, "Pres", 1))    { set (is_prefix_title_return, 1) }
  if (index (t, "Princ", 1))   { set (is_prefix_title_return, 1) }
  if (index (t, "Prof", 1))    { set (is_prefix_title_return, 1) }
  if (index (t, "Queen", 1))   { set (is_prefix_title_return, 1) }
  if (index (t, "Rabbi", 1))     { set (is_prefix_title_return, 1) }
  if (index (t, "Rav", 1))     { set (is_prefix_title_return, 1) }
  if (index (t, "Rep", 1))     { set (is_prefix_title_return, 1) }
  if (index (t, "Sen", 1))     { set (is_prefix_title_return, 1) }
  if (index (t, "Sir", 1))    { set (is_prefix_title_return, 1) }
  if (index (t, "Sis", 1))     { set (is_prefix_title_return, 1) }
}

/*
**  procedure: enqueue_person
**
**  Store the data for a person in the global lists.  It will be
**  printed later.
**
*/

proc enqueue_person (person, depth, pos, line, mdate, anc, des)
{
  enqueue (plist_person, person)
  enqueue (plist_depth,  depth)
  enqueue (plist_pos,    pos)
  enqueue (plist_line,   line)
  enqueue (plist_mdate,  mdate)
  enqueue (plist_anc,    anc)
  enqueue (plist_des,    des)
}

/*
**  procedure: dequeue_all_persons
**
**  Dequeue and print all persons stored in the global lists.  The
**  lines are stored in a second queue as they are printed and then
**  placed back in the original, global, queue.
**
*/

proc dequeue_all_persons ()
{
  list (tlist_person)
  list (tlist_depth)
  list (tlist_pos)
  list (tlist_line)
  list (tlist_mdate)
  list (tlist_anc)
  list (tlist_des)

  while (person, dequeue (plist_person))  {
    set (depth,  dequeue (plist_depth))
    set (pos,    dequeue (plist_pos))
    set (line,   dequeue (plist_line))
    set (mdate,  dequeue (plist_mdate))
    set (anc,    dequeue (plist_anc))
    set (des,    dequeue (plist_des))

    call print_person (person, depth, pos, line, mdate, anc, des)

    enqueue (tlist_person, person)
    enqueue (tlist_depth,  depth)
    enqueue (tlist_pos,    pos)
    enqueue (tlist_line,   line)
    enqueue (tlist_mdate,  mdate)
    enqueue (tlist_anc,    anc)
    enqueue (tlist_des,    des)
  }

  while (person, dequeue (tlist_person))  {
    set (depth,  dequeue (tlist_depth))
    set (pos,    dequeue (tlist_pos))
    set (line,   dequeue (tlist_line))
    set (mdate,  dequeue (tlist_mdate))
    set (anc,    dequeue (tlist_anc))
    set (des,    dequeue (tlist_des))

    enqueue (plist_person, person)
    enqueue (plist_depth,  depth)
    enqueue (plist_pos,    pos)
    enqueue (plist_line,   line)
    enqueue (plist_mdate,  mdate)
    enqueue (plist_anc,    anc)
    enqueue (plist_des,    des)
  }
}

/*
**  procedure: print_person
**
**  Print a line of data for a person in postscript format.  Each line
**  printed is essentially a call to a postscript function defined in the
**  header.
**
*/

proc print_person (person, depth, pos, line, mdate, anc, des)
{

  if (eq (title_method, 0))  {
    set (prefix_title, 0)
    set (suffix_title, 0)
  }
  if (eq (title_method, 1))  {
    set (prefix_title, title (person))
    set (suffix_title, 0)
  }
  if (eq (title_method, 2))  {
    set (prefix_title, 0)
    set (suffix_title, title (person))
  }
  if (eq (title_method, 3))  {
    set (prefix_title, 0)
    set (suffix_title, 0)
    if (t, title (person))  {
      call is_prefix_title (t)
      if (is_prefix_title_return)  {
        set (prefix_title, t)
      }  else  {
        set (suffix_title, t)
      }
    }
  }

  set (nlet, name_letters)
  if (prefix_title)  {
    set (nlet, sub (nlet, strlen (prefix_title)))
  }
  if (suffix_title)  {
    set (nlet, sub (nlet, strlen (suffix_title)))
  }

  /* print name and title, if it exists */
  "("
  if (prefix_title)  {
    prefix_title " "
  }
  fullname (person, 0, 1, nlet)
  if (suffix_title)  {
    " " suffix_title
  }
  ")"

  /* print birth date, if it exists */
  call dateplace (birth (person), dateplace_birth)
  if (dateplace_return)  {
    " (b. " dateplace_return ")"
  }  else  {
    " ()"
  }

  /* print marriage date, if it exists */
  if (mdate)  {
    " (m. " mdate ")"
  }  else  {
    " ()"
  }

  /* optional special tagged note, not used yet */
  " ()"

  /* print death date, if it exists */
  call dateplace (death (person), dateplace_death)
  if (dateplace_return)  {
    " (d. " dateplace_return ")"
  }  else  {
    " ()"
  }

  /* print generation, 0=youngest */
  " " d (sub (depth, 1))

  /* print vertical position */
  " " call print_thousandths (pos)

  /* extra height, not used or understood */
  " 1"

  /* 1=direct ancestor, 0=sibling */
  " " d (line)

  /* duplicate individual, not used */
  " 0"

  /* person has ancestors */
  " " d(anc)

  /* person has descendants*/
  " " d(des)

  /* call postscript function to process and print this data */
  " i"

  nl()
}

/*
**  procedure: enqueue_vertical
**
**  Enqueue the data for a single vertical line onto the global lists.
**
*/

proc enqueue_vertical (depth, low, high, dash)
{
  enqueue (llist_depth,  depth)
  enqueue (llist_low,    sub(low,500))
  enqueue (llist_high,   sub(high,500))
  enqueue (llist_dash,   dash)
}

/*
**  procedure: dequeue_all_verticals
**
**  Dequeue and print all vertical lines.  The lines are stored in a
**  second queue as they are printed and then placed back in the
**  original, global, queue.
**
*/

proc dequeue_all_verticals ()
{
  list (tlist_depth)
  list (tlist_low)
  list (tlist_high)
  list (tlist_dash)

  while (depth,  dequeue (llist_depth))  {
    set (low,    dequeue (llist_low))
    set (high,   dequeue (llist_high))
    set (dash,   dequeue (llist_dash))

    call print_vertical (depth, low, high, dash)

    enqueue (tlist_depth, depth)
    enqueue (tlist_low,   low)
    enqueue (tlist_high,  high)
    enqueue (tlist_dash,  dash)
  }

  while (depth,  dequeue (tlist_depth))  {
    set (low,    dequeue (tlist_low))
    set (high,   dequeue (tlist_high))
    set (dash,   dequeue (tlist_dash))

    enqueue (llist_depth, depth)
    enqueue (llist_low,   low)
    enqueue (llist_high,  high)
    enqueue (llist_dash,  dash)
  }
}

/*
**  procedure: print_vertical
**
**  Print a single vertical line to link a married couple or siblings.
**
*/

proc print_vertical (depth, low, high, dash)
{
  d (sub (depth, 1))
  " " call print_thousandths (low)
  " " call print_thousandths (high)
  " " d(dash)
  " l" nl()
}

/*
**  procedure: print_thousandths
**
**  Since LifeLines does not offer a floating point type, decimal
**  computation is done using integers that represent thousands.  This
**  procedure converts a number in thousandths to decimal notation and
**  prints it.  The length of the decimal part is checked to make sure
**  it is padded with zeros correctly.
**
*/

proc print_thousandths (n_arg)
{

  /* don't want to modify proc argument, so copy it */
  set (n, n_arg)

  if (lt (n, 0))  {
    "-"
    set (n, neg (n))
  }

  d (div (n, 1000)) "."

  set (t, d (mod (n, 1000)))
  if (eq (strlen (t), 1))  {
    "00" t
  }
  if (eq (strlen (t), 2))  {
    "0" t
  }
  if (eq (strlen (t), 3))  {
    t
  }

}

/*
**  procedure: print_header
**
**  Arguments:
**    fn:  font name
**    md:  maximum level, integer
**    mp:  maximum position, integer in thousandths
**    ctf: color true/false, string "true" or "false"
**    cl:  chart label, string
**    xi:  which horizontal page
**    xn:  number of horizontal pages
**    yi:  which vertical page
**    yn:  number of vertical pages
**
**  Print the initial postscript code.  This code will likely be the
**  bulk of the output file.  It prints the border, defines postscript
**  functions for printing peoples names, dates and the lines on the
**  chart, and more.  It will be followed by the data.
**
**  This postscript code was written by Thomas P. Blumer (blumer@ptltd.com).
**  The only modification is where data from the arguments is inserted.
**
*/

proc print_header (fn, ml, mp, ctf, cl, xi, xn, yi, yn)
{
  "%!PS-Adobe-2.0 EPSF-1.2" nl()
  "%%BoundingBox:0 0 612 792" nl()
  "/#copies 1 def" nl()
  "/xpages " d (xn) " def" nl()
  "/ypages " d (yn) " def" nl()
  "/xpage " d (xi) " def" nl()
  "/ypage " d (yi) " def" nl()
  "/maxlevel " d (ml) " def" nl()
  "/mirror " if (mirror_chart) { "true" } else { "false" } " def" nl()
  "/maxpos " call print_thousandths (mp)  nl()
  "0.02 ypages div 1.0 add mul def" nl()
  "/color " ctf " def" nl()
  "/bold " if (bold_chart) { "true" } else { "false" } " def" nl()
  "/portrait " if (portrait) { "true" } else { "false" } " def" nl()
  "/indent 3.00 def" nl()
  "/linwidf 1.000 def" nl()
  "/font_adjust 1.000 def" nl()
  "/offset_name 0.000 def" nl()
  "% Put PostScript code here to print a label on the chart" nl()
  "/inch {72 mul} def" nl()
  "/chart_label {" nl()
  "     .30 inch .15 inch moveto" nl()
  "     /Helvetica-Narrow findfont 7 scalefont setfont" nl()
  "     (" cl ") show" nl()
  "} def" nl()
  "/lr 0 def /lg 1 def /lb 1 def" nl()
  "/Lr 0 def /Lg 0 def /Lb 1 def" nl()
  "/tr 0 def /tg 0 def /tb 0 def" nl()
  "/Tr 0 def /Tg 0 def /Tb 0 def" nl()
  "/lmr 0 def /lmg 1 def /lmb 1 def" nl()
  "/Lmr 0 def /Lmg 0 def /Lmb 1 def" nl()
  "/tmr 0 def /tmg 0 def /tmb 0 def" nl()
  "/Tmr 0 def /Tmg 0 def /Tmb 0 def" nl()
  "/fontname /" fn " def" nl()
  "/encvec [" nl()
  "16#80 /Ccedilla" nl()
  "16#81 /udieresis" nl()
  "16#82 /eacute" nl()
  "16#83 /acircumflex" nl()
  "16#84 /adieresis" nl()
  "16#85 /agrave" nl()
  "16#86 /aring" nl()
  "16#87 /ccedilla" nl()
  "16#88 /ecircumflex" nl()
  "16#89 /edieresis" nl()
  "16#8a /egrave" nl()
  "16#8b /idieresis" nl()
  "16#8c /icircumflex" nl()
  "16#8d /igrave" nl()
  "16#8e /Adieresis" nl()
  "16#8f /Aring" nl()
/*---  "16#90 /Eacute" nl()
  "16#91 /ae" nl()
  "16#92 /AE" nl()
  "16#93 /ocircumflex" nl()
  "16#94 /odieresis" nl()
  "16#95 /ograve" nl()
  "16#96 /ucircumflex" nl()
  "16#97 /ugrave" nl()
  "16#98 /ydieresis" nl()
  "16#99 /Odieresis" nl()
  "16#9a /Udieresis" nl()
  "16#9b /cent" nl()
  "16#9c /sterling" nl()
  "16#9d /yen" nl()
  "16#9f /florin" nl() ---*/
  "16#90 /dotlessi" nl()
  "16#91 /grave" nl()
  "16#92 /acute" nl()
  "16#93 /circumflex" nl()
  "16#94 /tilde" nl()
  "16#95 /macron" nl()
  "16#96 /breve" nl()
  "16#97 /dotaccent" nl()
  "16#98 /dieresis" nl()
  "16#99 /.notdef" nl()
  "16#9a /ring" nl()
  "16#9b /cedilla" nl()
  "16#9c /.notdef" nl()
  "16#9d /hungarumlaut" nl()
  "16#9e /ogonek" nl()
  "16#9f /caron" nl()
  "16#a0 /space" nl()
/*----  "16#a0 /aacute" nl()
  "16#a1 /iacute" nl()
  "16#a2 /oacute" nl()
  "16#a3 /uacute" nl()
  "16#a4 /ntilde" nl()
  "16#a5 /Ntilde" nl()
  "16#a6 /ordfeminine" nl()
  "16#a7 /ordmasculine" nl()
  "16#a8 /questiondown" nl()
  "16#aa /logicalnot" nl()
  "16#ab /onehalf" nl()
  "16#ac /onequarter" nl()
  "16#ad /exclamdown" nl()
  "16#ae /guillemotleft" nl()
  "16#af /guillemotright" nl() -----*/
  "16#a1 /exclamdown" nl()
  "16#a2 /cent" nl()
  "16#a3 /sterling" nl()
  "16#a4 /currency" nl()
  "16#a5 /yen" nl()
  "16#a6 /brokenbar" nl()
  "16#a7 /section" nl()
  "16#a8 /dieresis" nl()
  "16#a9 /copyright" nl()
  "16#aa /ordfeminine" nl()
  "16#ab /guillemotleft" nl()
  "16#ac /logicalnot" nl()
  "16#ad /hyphen" nl()
  "16#ae /registered" nl()
  "16#af /macron" nl()
  "16#b0 /degree" nl()
  "16#b1 /plusminus" nl()
  "16#b2 /twosuperior" nl()
  "16#b3 /threesuperior" nl()
  "16#b4 /acute" nl()
  "16#b5 /mu" nl()
  "16#b6 /paragraph" nl()
  "16#b7 /periodcentered" nl()
  "16#b8 /cedilla" nl()
  "16#b9 /onesuperior" nl()
  "16#ba /ordmasculine" nl()
  "16#bb /guillemotright" nl()
  "16#bc /onequarter" nl()
  "16#bd /onehalf" nl()
  "16#be /threequarters" nl()
  "16#bf /questiondown" nl()
  "16#c0 /Agrave" nl()
  "16#c1 /Aacute" nl()
  "16#c2 /Acircumflex" nl()
  "16#c3 /Atilde" nl()
  "16#c4 /Adieresis" nl()
  "16#c5 /Aring" nl()
  "16#c6 /AE" nl()
  "16#c7 /Ccedilla" nl()
  "16#c8 /Egrave" nl()
  "16#c9 /Eacute" nl()
  "16#ca /Ecircumflex" nl()
  "16#cb /Edieresis" nl()
  "16#cc /Igrave" nl()
  "16#cd /Iacute" nl()
  "16#ce /Icircumflex" nl()
  "16#cf /Idieresis" nl()
  "16#d0 /Eth" nl()
  "16#d1 /Ntilde" nl()
  "16#d2 /Ograve" nl()
  "16#d3 /Oacute" nl()
  "16#d4 /Ocircumflex" nl()
  "16#d5 /Otilde" nl()
  "16#d6 /Odieresis" nl()
  "16#d7 /multiply" nl()
  "16#d8 /Oslash" nl()
  "16#d9 /Ugrave" nl()
  "16#da /Uacute" nl()
  "16#db /Ucircumflex" nl()
  "16#dc /Udieresis" nl()
  "16#dd /Yacute" nl()
  "16#de /Thorn" nl()
  "16#df /germandbls" nl()
  "16#e0 /agrave" nl()
  "16#e1 /aacute" nl()
  "16#e2 /acircumflex" nl()
  "16#e3 /atilde" nl()
  "16#e4 /adieresis" nl()
  "16#e5 /aring" nl()
  "16#e6 /ae" nl()
  "16#e7 /ccedilla" nl()
  "16#e8 /egrave" nl()
  "16#e9 /eacute" nl()
  "16#ea /ecircumflex" nl()
  "16#eb /edieresis" nl()
  "16#ec /igrave" nl()
  "16#ed /iacute" nl()
  "16#ee /icircumflex" nl()
  "16#ef /idieresis" nl()
  "16#f0 /eth" nl()
  "16#f1 /ntilde" nl()
  "16#f2 /ograve" nl()
  "16#f3 /oacute" nl()
  "16#f4 /ocircumflex" nl()
  "16#f5 /otilde" nl()
  "16#f6 /odieresis" nl()
  "16#f7 /divide" nl()
  "16#f8 /oslash" nl()
  "16#f9 /ugrave" nl()
  "16#fa /uacute" nl()
  "16#fb /ucircumflex" nl()
  "16#fc /udieresis" nl()
  "16#fd /yacute" nl()
  "16#fe /thorn" nl()
  "16#ff /ydieresis" nl()
/*  "16#f8 /degree" nl()
  "16#f9 /bullet" nl()
  "16#fa /periodcentered" nl()*/
  "] def" nl()
  "% Copyright (c) 1991-1993 Thomas P. Blumer.  All Rights Reserved." nl()
  "% Permission granted to use in LifeLines report generation." nl()
  "/border true def" nl()
  nl()
  "color {" nl()
  "     /setcmykcolor where { pop" nl()
  "             Tr Tg Tb add add 0 eq {" nl()
  "                     /Tk 1 def" nl()
  "             } {" nl()
  "                     /Tk 0 def" nl()
  "                     /Tr 1 Tr sub def /Tg 1 Tg sub def /Tb 1 Tb sub def" nl()
  "             } ifelse" nl()
  nl()
  "             tr tg tb add add 0 eq {" nl()
  "                     /tk 1 def" nl()
  "             } {" nl()
  "                     /tk 0 def" nl()
  "                     /tr 1 tr sub def /tg 1 tg sub def /tb 1 tb sub def" nl()
  "             } ifelse" nl()
  nl()
  "             Lr Lg Lb add add 0 eq {" nl()
  "                     /Lk 1 def" nl()
  "             } {" nl()
  "                     /Lk 0 def" nl()
  "                     /Lr 1 Lr sub def /Lg 1 Lg sub def /Lb 1 Lb sub def" nl()
  "             } ifelse" nl()
  nl()
  "             lr lg lb add add 0 eq {" nl()
  "                     /lk 1 def" nl()
  "             } {" nl()
  "                     /lk 0 def" nl()
  "                     /lr 1 lr sub def /lg 1 lg sub def /lb 1 lb sub def" nl()
  "             } ifelse" nl()
  nl()
  "             /textcolr0 {Tr Tg Tb Tk setcmykcolor} bind def % direct ancestor name" nl()
  "             /textcolr1 {tr tg tb tk setcmykcolor} bind def % indirect names" nl()
  "             /lincolr0 {Lr Lg Lb Lk setcmykcolor} bind def  % direct ancestor lines" nl()
  "             /lincolr1 {lr lg lb lk setcmykcolor} bind def  % indirect lines" nl()
  "     } {" nl()
  "             /textcolr0 {Tr Tg Tb setrgbcolor} bind def % direct ancestor name" nl()
  "             /textcolr1 {tr tg tb setrgbcolor} bind def % indirect names" nl()
  "             /lincolr0 {Lr Lg Lb setrgbcolor} bind def  % direct ancestor lines" nl()
  "             /lincolr1 {lr lg lb setrgbcolor} bind def  % indirect lines" nl()
  "     } ifelse" nl()
  "} {" nl()
  "     /textcolr0 {} bind def" nl()
  "     /textcolr1 {} bind def" nl()
  "     /lincolr0 {} bind def" nl()
  "     /lincolr1 {} bind def" nl()
  "} ifelse" nl()
  nl()
  "% table of how to get bold fonts" nl()
  "/bolddict 25 dict def" nl()
  "bolddict begin" nl()
  nl()
  "% default table entry is that boldfontname = fontname" nl()
  "fontname fontname def" nl()
  nl()
  "/Courier /Courier-Bold def" nl()
  "/Courier-Oblique /Courier-BoldOblique def" nl()
  "/Times-Roman /Times-Bold def" nl()
  "/Times-Italic /Times-BoldItalic def" nl()
  "/Helvetica /Helvetica-Bold def" nl()
  "/Helvetica-Oblique /Helvetica-BoldOblique def" nl()
  "/Bookman-Light /Bookman-Demi def" nl()
  "/Bookman-LightItalic /Bookman-DemiItalic def" nl()
  "/Palatino-Roman /Palatino-Bold def" nl()
  "/Palatino-Italic /Palatino-BoldItalic def" nl()
  "/AvantGarde-Book /AvantGarde-Demi def" nl()
  "/AvantGarde-BookOblique /AvantGarde-DemiOblique def" nl()
  "/Helvetica-Narrow /Helvetica-Narrow-Bold def" nl()
  "/Helvetica-Narrow-Oblique /Helvetica-Narrow-BoldOblique def" nl()
  "/Helvetica-Condensed /Helvetica-Condensed-Bold def" nl()
  "/Helvetica-Condensed-Oblique /Helvetica-Condensed-BoldObl def" nl()
  "/NewCenturySchlbk-Roman /NewCenturySchlbk-Bold def" nl()
  "/NewCenturySchlbk-Italic /NewCenturySchlbk-BoldItalic def" nl()
  "/ZapfChancery /ZapfChancery-Bold def" nl()
  "end" nl()
  nl()
  "/boldfontname fontname def" nl()
  "/boldfontname bolddict fontname get def" nl()
  nl()
  "% get printable area" nl()
  "clippath pathbbox newpath" nl()
  "/ury exch def /urx exch def" nl()
  "/lly exch def /llx exch def" nl()
  nl()
  "% adjust for PacificPage cartridge" nl()
  "statusdict /product known {" nl()
  "     statusdict begin product end (PacificPage) eq" nl()
  "     version (4.06) eq and {" nl()
  "             /lly lly 5 add def" nl()
  "             /ury ury 10 sub def" nl()
  "     } if" nl()
  "} if" nl()
  nl()
  "% set portrait mode, get width and height" nl()
  "/wp urx llx sub def" nl()
  "/hp ury lly sub def" nl()
  "/w wp xpages mul def" nl()
  "/h hp ypages mul def" nl()
  "portrait {" nl()
  "       % portrait mode" nl()
  "       llx lly translate" nl()
  "  } {" nl()
  "       % landscape mode" nl()
  "       /tmp hp def" nl()
  "       /hp wp def" nl()
  "       /wp tmp def" nl()
  "       /tmp h def" nl()
  "       /h w def" nl()
  "       /w tmp def" nl()
  "       urx lly translate 90 rotate" nl()
  "} ifelse" nl()
  nl()
  "% multi page output" nl()
  "xpages 1 ne ypages 1 ne or {" nl()
  "     portrait {" nl()
  "       1 xpage sub wp mul  1 ypage sub hp mul  translate" nl()
  "     } {" nl()
  "       1 ypage sub wp mul  1 xpage sub hp mul  translate" nl()
  "     } ifelse" nl()
  "} if" nl()
  nl()
  "% decorative border" nl()
  "border {" nl()
  "     /bwid1 2.5 def" nl()
  "     /gapwid 1.5 def" nl()
  "     /bwid2 0.7 def" nl()
  "     /bgap 10 def" nl()
  "     /tw 7.2 def" nl()
  "     /rect {" nl()
  "             /rh exch def" nl()
  "             /rw exch def" nl()
  "             moveto" nl()
  "             rw 0 rlineto" nl()
  "             0 rh rlineto" nl()
  "             rw neg 0 rlineto" nl()
  "             closepath stroke" nl()
  "     } def" nl()
  "     /rectt {" nl()
  "             /rh exch def" nl()
  "             /rw exch def" nl()
  "             /rhs rh tw sub tw sub def" nl()
  "             /rws rw tw sub tw sub def" nl()
  "             moveto" nl()
  "             0 tw rmoveto" nl()
  "             tw 0 rlineto" nl()
  "             0 tw neg rlineto" nl()
  "             rws 0 rlineto" nl()
  "             0 tw rlineto" nl()
  "             tw 0 rlineto" nl()
  "             0 rhs rlineto" nl()
  "             tw neg 0 rlineto" nl()
  "             0 tw rlineto" nl()
  "             rws neg 0 rlineto" nl()
  "             0 tw neg rlineto" nl()
  "             tw neg 0 rlineto" nl()
  "             closepath stroke" nl()
  "     } def" nl()
  nl()
  "     bwid1 setlinewidth" nl()
  "     lincolr0" nl()
  "     bwid1 2 div  dup  w bwid1 sub  h bwid1 sub  rectt" nl()
  nl()
  "     bwid2 setlinewidth" nl()
  "     bwid1 gapwid bwid2 2 div add add  dup" nl()
  "     w bwid1 2 mul sub gapwid 2 mul sub bwid2 sub " nl()
  "     h bwid1 2 mul sub gapwid 2 mul sub bwid2 sub rect" nl()
  nl()
  "     % cut the border out of the imageable area" nl()
  "     /tmp bwid1 gapwid bwid2 bgap add add add def" nl()
  "     tmp tmp translate" nl()
  "     /w w tmp 2 mul sub def" nl()
  "     /h h tmp 2 mul sub def" nl()
  "} if" nl()
  nl()
  "% for multi page: only label bottom left page" nl()
  "/chart_label where xpage 1 eq ypage 1 eq and and {" nl()
  "     pop" nl()
  "     gsave" nl()
  "     % set up coordinate system for custom chart label" nl()
  "     clippath pathbbox newpath pop pop translate" nl()
  "     chart_label" nl()
  "     grestore" nl()
  "} if" nl()
  nl()
  "% Reencode the font so that we can use the IBMPC set of international chars" nl()
  "/encdict 12 dict def" nl()
  "/reenc {" nl()
  "     encdict begin" nl()
  "     /newenc exch def" nl()
  "     /nfont exch def" nl()
  "     /ofont exch def" nl()
  "     /ofontdict ofont findfont def" nl()
  "     /newfont ofontdict maxlength 1 add dict def" nl()
  "     ofontdict {" nl()
  "             exch dup /FID ne {" nl()
  "                     dup /Encoding eq" nl()
  "                      {exch dup length array copy newfont 3 1 roll put}" nl()
  "                      {exch newfont 3 1 roll put} ifelse" nl()
  "             }" nl()
  "             {pop pop}" nl()
  "             ifelse" nl()
  "     } forall" nl()
  "     newfont /Fontname nfont put" nl()
  "     newenc aload pop" nl()
  "     newenc length 2 idiv" nl()
  "     { newfont /Encoding get 3 1 roll put}" nl()
  "     repeat" nl()
  "     nfont newfont definefont pop" nl()
  "     end" nl()
  "} def" nl()
  nl()
  "fontname /gedfont encvec reenc" nl()
  "/fontname /gedfont def" nl()
  "boldfontname /boldgedfont encvec reenc" nl()
  "/boldfontname /boldgedfont def" nl()
  "% end font reencoding" nl()
  nl()
  "/rl w maxlevel div def" nl()
  "/posunit h maxpos div def" nl()
  nl()
  "/posname 1.0 def" nl()
  "/posdate 0.75 def" nl()
  "/posmarg 0.3 def" nl()
  "/posbase posname posmarg 2 div add def" nl()
  nl()
  "/top h posunit posbase mul sub def" nl()
  nl()
  "% calculate base font size from segment length" nl()
  "/fntsize rl 9.0 div def" nl()
  nl()
  "% space for one individual" nl()
  "fntsize posunit gt {" nl()
  "     /fntsize posunit def" nl()
  "} if" nl()
  nl()
  "% font adjustment" nl()
  "/fntsize fntsize font_adjust mul def" nl()
  nl()
  "% font for birth/death dates" nl()
  "/fntsize2 fntsize posdate mul def" nl()
  nl()
  "fontname findfont fntsize scalefont setfont" nl()
  "/space ( ) stringwidth pop def" nl()
  nl()
  "% calc line width from segment length - .24 pts = 1 pixel" nl()
  "/linwid fntsize .1 mul .6 mul def" nl()
  "/linwid linwid linwidf mul def" nl()
  "linwid setlinewidth" nl()
  "/namey0 linwid fntsize 16.0 div add offset_name add def" nl()
  nl()
  "/dashwid rl 72 div def" nl()
  nl()
  "2 setlinecap" nl()
  nl()
  "% name string length for all generations" nl()
  "/len1 rl space indent 1 add mul sub def" nl()
  nl()
  "% show string given as argument" nl()
  "% select font size so that string fits in available length" nl()
  "/wshow {" nl()
  "     /s exch def" nl()
  "     /len exch def" nl()
  "     /fntsiz exch def" nl()
  "     bold direct and {" nl()
  "             boldfontname findfont fntsiz scalefont setfont" nl()
  "     } {" nl()
  "             fontname findfont fntsiz scalefont setfont" nl()
  "     } ifelse" nl()
  "     s stringwidth pop dup len lt {" nl()
  "             pop" nl()
  "     } {" nl()
  "             % compute new font size for exact fit" nl()
  "             len exch div fntsiz mul /fsize exch def" nl()
  "             bold direct and {" nl()
  "                     boldfontname findfont fsize scalefont setfont" nl()
  "             } {" nl()
  "                     fontname findfont fsize scalefont setfont" nl()
  "             } ifelse" nl()
  "     } ifelse" nl()
  "     direct {textcolr0} {textcolr1} ifelse" nl()
  "     s show" nl()
  "} bind def" nl()
  nl()
  "% give length of string given as argument" nl()
  "% select font size so that string fits in available length" nl()
  "/wlen {" nl()
  "     /s exch def" nl()
  "     /len exch def" nl()
  "     /fntsiz exch def" nl()
  "     bold direct and {" nl()
  "             boldfontname findfont fntsiz scalefont setfont" nl()
  "     } {" nl()
  "             fontname findfont fntsiz scalefont setfont" nl()
  "     } ifelse" nl()
  "     s stringwidth pop dup len lt {" nl()
  "             pop" nl()
  "     } {" nl()
  "             % compute new font size for exact fit" nl()
  "             len exch div fntsiz mul /fsize exch def" nl()
  "             bold direct and {" nl()
  "                     boldfontname findfont fsize scalefont setfont" nl()
  "             } {" nl()
  "                     fontname findfont fsize scalefont setfont" nl()
  "             } ifelse" nl()
  "     } ifelse" nl()
  "     s stringwidth pop dup" nl()
  "     pop" nl()
  "} bind def" nl()
  nl()
  "% called once for each individual on chart" nl()
  "/i {" nl()
  "     /des exch 1 eq def      % true if person has descendants" nl()
  "     /anc exch 1 eq def      % true if person has ancestors" nl()
  "     /duplic exch 1 eq def   % true for duplicate individual" nl()
  "     /direct exch 1 eq def   % true for direct ancestor, false for indirect" nl()
  "     /xhgt exch def          % extra height - not used here" nl()
  "     /pos exch def           % vertical position" nl()
  "     /level exch def         % generation level, 0 = youngest" nl()
  "     /marriage exch def      % marriage date" nl()
  "     /tagnote exch def       % tagged note from PAF" nl()
  "     /death exch def         % death date" nl()
  "     /birth exch def         % birth date" nl()
  "     /name exch def          % name" nl()
  nl()
  "     % x1 = left edge, x2 = right edge" nl()
  "     mirror {" nl()
  "             /x1 maxlevel level sub 1 sub rl mul def" nl()
  "             /x x1 space indent mul add def" nl()
  "     } {" nl()
  "             /x1 level rl mul def" nl()
  "             /x x1 space indent mul add def" nl()
  "     } ifelse" nl()
  "     /x2 x1 rl add def" nl()
  nl()
  "     % Column positions" nl()
  "     % x1=left x=start of text x2=right" nl()
  nl()
  "     /y top pos posunit mul sub def" nl()
  "     /y2 top pos 0.5 sub posunit mul sub def" nl()
  nl()
  "     lincolr0" nl()
  nl()
  "     /namey namey0 def" nl()
  nl()
  "     % Calcuate the printed length of the name" nl()
  "     fntsize len1 name wlen" nl()
  "     /lname exch def" nl()
  nl()
  "     % Find the size of the longest text string" nl()
  "     /ls lname def" nl()
  "     birth length 0 gt {" nl()
  "       fntsize2 len1 birth wlen" nl()
  "       /lb exch def" nl()
  "       lb ls gt {/ls lb def} if" nl()
  "     } if" nl()
  "     death length 0 gt {" nl()
  "       fntsize2 len1 death wlen" nl()
  "       /ld exch def" nl()
  "       ld ls gt {/ls ld def} if" nl()
  "     } if" nl()
  "     marriage length 0 gt {" nl()
  "       fntsize2 len1 marriage wlen" nl()
  "       /lm exch def" nl()
  "       lm ls gt {/ls lm def} if" nl()
  "     } if" nl()
  nl()
  "     anc not {" nl()
  "       /x x2 ls sub rl 0.05 mul sub space sub def" nl()
  "     } if" nl()
  "     des not {" nl()
  "       /x x1 rl 0.05 mul add space add def" nl()
  "     } if" nl()
  "     anc des and {" nl()
  "       /sr x2 x1 sub ls sub def" nl()
  "       /x sr 2 div space sub x1 add def" nl()
  "     } if" nl()
  nl()
  "     direct {" nl()
  "             bold {linwid 2.0 mul setlinewidth /namey namey linwid add def} if" nl()
  "             duplic {[dashwid dup currentlinewidth add] 0 setdash} if" nl()
  "             anc {x1 y2 moveto x space sub y2 lineto stroke} if" nl()
  "             des {x lname add space add y2 moveto x2 y2 lineto stroke} if" nl()
  "             duplic {[] 0 setdash} if" nl()
  "             bold {linwid setlinewidth} if" nl()
  "             % print name" nl()
  "             x y namey add moveto" nl()
  "             fntsize len1 name wshow" nl()
  "     } {" nl()
  "             duplic {[dashwid dup currentlinewidth add] 0 setdash} if" nl()
  "             mirror {" nl()
  "                     x1 y2 moveto x y2 lineto stroke" nl()
  "                     % print name" nl()
  "                     x y namey add moveto" nl()
  "                     fntsize len1 name wshow" nl()
  "             } {" nl()
  "                     x lname add space add y2 moveto x2 y2 lineto stroke" nl()
  "                     % print name" nl()
  "                     x y namey add moveto" nl()
  "                     fntsize len1 name wshow" nl()
  "             } ifelse" nl()
  "             duplic {[] 0 setdash} if" nl()
  "     } ifelse" nl()
  nl()
  "     % print birth/death" nl()
  "     birth length 0 gt {" nl()
  "             /y y fntsize2 sub def" nl()
  "             x y moveto" nl()
  "             fntsize2 len1 birth wshow" nl()
  "     } if" nl()
  "     death length 0 gt {" nl()
  "             /y y fntsize2 sub def" nl()
  "             x y moveto" nl()
  "             fntsize2 len1 death wshow" nl()
  "     } if" nl()
  "     marriage length 0 gt {" nl()
  "             /y y fntsize2 sub def" nl()
  "             x y moveto" nl()
  "             fntsize2 len1 marriage wshow" nl()
  "     } if" nl()
  "} bind def" nl()
  nl()
  "/l {" nl()
  "     /indirect exch 1 eq def" nl()
  "     /parent exch def" nl()
  "     /pos exch def" nl()
  "     /level exch def" nl()
  nl()
  "     mirror {" nl()
  "             /x maxlevel level sub 1 sub rl mul def" nl()
  "     } {" nl()
  "             /x level 1 add rl mul def" nl()
  "     } ifelse" nl()
  "     /y1 top pos posunit mul sub def" nl()
  "     /y2 top parent posunit mul sub def" nl()
  "     indirect {lincolr1} {lincolr0} ifelse" nl()
  "     bold indirect not and {linwid 2.0 mul setlinewidth} if" nl()
  "     x y1 moveto x y2 lineto stroke" nl()
  "     bold indirect not and {linwid setlinewidth} if" nl()
  "} bind def" nl()
}