/*
   Family Tree Rexx Script FTX

   Copyright (C) 1996 by <Peter Gervai>

   Please send comments to
   Grin at 2:370/15@fidonet or grin@lifeforce.fido.hu

   <
   English:   Prints descendants of the actual person in hierarchical fashion.      :English
   Deutsch:   Gibt die Nachfahren der aktuellen Person in hierarchischer Weise aus. :Deutsch
   Nederlands:Print de nakomelingen van de actuele persoon op hi‰rarchische wijze.  :Nederlands
   Fran‡ais:  Imprime de maniŠre hi‚rarchique, la descendance de la personne
              s‚lectionn‚e.                                                         :Fran‡ais
   >

   Long name is <
                 English:    List Descendants         :English
                 Deutsch:    Auflisten der Nachfahren :Deutsch
                 Nederlands: List Descendants         :Nederlands
                 Fran‡ais:   Imprime la descendance   :Fran‡ais
                >
*/

call InitLanguage

/*
 * Global variables (for EXPOSE in procedures)
 */
globals = 'cr msg.'
cr = '0d0a'x

/*
 * start
 */
title = msg.Header.LANG getName()',' getFirstName()

say title
say copies('=',length(title))

call DoStack('PP')
call DEmitPerson 1

say msg.Finish.LANG
exit;

/*
 * recursive function
 */
DEmitPerson: procedure expose (globals); parse arg level
  /* pull actual person */
  if DoStack('pP')=0 then perror(msg.Error.LANG)
  de.husband = copies(' ',level) || getName()',' getFirstName()'('getBirthDate()'/'getDeathDate()')'
  call charout ,de.husband

  de.count = 1
  /* check families */
  res = SelectFamily(de.count)
  do while res\=0
    /* print wife */
    call DoStack('PP')
    res = SelectPerson('p')
    if de.count=1 then
      call charout ,' +' getName()',' getFirstName()'('getBirthDate()'/'getDeathDate()')'cr
    else
      call charout ,de.husband '+' getName()',' getFirstName()'('getBirthDate()'/'getDeathDate()')'cr
    call DoStack('pP')

    /* examine children */
    call DoStack('PP')                            /* original person */
    de.childcount = 1
    res = SelectPerson(de.childcount)
    do while res\=0
    /* print children's tree */
      call DoStack('PF')                          /* save family because SelectPerson(<count>) needs it! */
      call DoStack('PP')                          /* push child for recursion (routine pops it) */
      call DEmitPerson level+2                    /* print child's tree (indent2) */
      de.childcount = de.childcount + 1
      call DoStack('pP')                          /* pop original person... */
      call DoStack('PP')                          /* ...and push again... */
      call DoStack('pF')                          /* original family */
      res = SelectPerson(de.childcount)           /* ...just for get his next child */
    end

    call DoStack('pP')                            /* original person */
    de.count = de.count + 1                       /* next family */
    res = SelectFamily(de.count)
  end
  if de.count=1 then call charout ,cr
return


/******************************************************************
 *
 * Language init
 *
 */
InitLanguage:

   /* Calculate Language Index */
   lang='E'                              /* Default -> [E]nglish */
   IF getLanguage()='Deutsch' THEN       /* Deutsch -> [G]erman */
      lang='G'
   IF getLanguage()='Nederlands' THEN    /* Nederlands -> [D]utch */
      lang='D'
   IF getLanguage()='Fran‡ais' THEN      /* Fran‡ais -> [F]rench */
      lang='F'

   /* [E]nglish Messages */
   msg.Header.E = 'Descendants of'
   msg.Finish.E = '===Finished==='
   msg.Error.E  = 'SCRIPT ERROR: Empty Stack!'

   /* [G]erman Messages */
   msg.Header.G = 'Nachfahren von'
   msg.Finish.G = '===Beendet==='
   msg.Error.G  = 'SCRIPT FEHLER: Leerer Stack!'

   /* [D]utch Messages */
   msg.Header.E = 'Afstammelingen af'
   msg.Finish.E = '===Klaar==='
   msg.Error.E  = 'SCRIPT FOUT: Empty Stack!'

   /* [F]rench Messages */
   msg.Header.F = "Descendants de"
   msg.Finish.F = "===Termin‚==="
   msg.Error.F  = "ERREUR SCRIPT: Pile Vide!"

   /* Done */
   RETURN
