/*
tt

Based on tinytafel1 by Tom Wetmore, ttw@cbnewsl.att.com

Version 1,        1991, by Tom Wetmore.
Version 2, 11 Jan 1993, by Jim Eggert, eggertj@ll.mit.edu,
                        added header, trailer, sorting, date fixing,
                        and default moderate interest.  Modified
                        empty surname recognition.
Version 3, Jan 1994, J. F. Chandler, fixed count, enhanced date/place guessing.

This report will produce a tinytafel report on a person.

Output is an ASCII file.  It should be edited to translate any
non-ASCII characters, to shorten long place names (to 14-16
characters), and to indicate interest level after each year:
   [space] No interest (level 0)
   .       Low interest (level 1)
   :       Moderate interest (level 2) (default)
   *       Highest interest (level 3)

You will want to modify the write_tafel_header() procedure to
include your name, address, etc.

Empty surnames or those starting with "_" or " " will not
be written to the report.

See the end of this report for an example of a tinytafel report.
*/

global(tafelset)
global(fdatelist)
global(ldatelist)
global(fplacelist)
global(lplacelist)
global(line_count)

global(fdate)
global(ldate)
global(pdate)
global(fplace)
global(lplace)
global(pplace)
global(sname)
global(datemod) /* value returned by get_modifier */
global(pdmax)
global(pdmin)

/* Assumptions for guessing year of birth */
global(Minpar)  /* assumed minimum age of parenthood */
global(Typicl)  /* typical age for parenthood or marriage */
global(Menopa)  /* assumed maximum age of motherhood */
global(Oldage)  /* assumed age at death */

proc write_tafel_header() {
    forindiset(tafelset,person,index,snum) {set(lines,snum)}
    "N John Q. Public\n"           /* your name, mandatory */
    "A 1234 North Maple\n"         /* address, 0-5 lines */
    "A Homesville, OX 12345-6789\n"
    "A USA\n"
    "T 1 (101) 555-1212\n"         /* telephone number */
    "C 19.2 Baud, Unix System\n"   /* communications */
    "C Send any Email to:  jqpublic@my.node.address\n"
    "B SoftRoots/1-101-555-3434\n" /* BBS system/phone number */
    "D Unix Operating System\n"    /* diskette formats */
    "F LifeLines Genealogy Program for Unix\n"  /* file format */
    "R This is a default header, please ignore.\n"  /* comments */
    "Z " d(lines) "\n"
}

proc main ()
{
    /* Assumptions for guessing year of birth */
    set(Minpar,14)      /* assumed minimum age of parenthood */
    set(Typicl,20)      /* typical age for parenthood or marriage */
    set(Menopa,50)      /* assumed maximum age of motherhood */
    set(Oldage,60)      /* assumed age at death */

    list(plist)
    indiset(tafelset)
    list(fdatelist)
    list(ldatelist)
    list(fplacelist)
    list(lplacelist)
    set(line_count,0)

    getindi(person)
    enqueue(plist, person)
    while (person, dequeue(plist)) {
        call process_line(person, plist)
    }
    namesort(tafelset)
    call write_tafel_header()
    call write_tafelset()
    call write_tafel_trailer()
}

proc write_tafelset() {
    forindiset(tafelset,person,index,snum) {
        soundex(person) " "
        getel(ldatelist,index) ":" /* moderate interest by default */
        getel(fdatelist,index) ":"
        surname(person)
        if (lplace,getel(lplacelist,index)) { "\\" lplace }
        if (fplace,getel(fplacelist,index)) { "/" fplace }
        "\n"
    }
}

proc write_tafel_trailer() {
    "W " date(gettoday()) "\n"
}

proc process_line (person, plist)
{
    call first_in_line(person)
    set(initial,trim(sname,1))
    if (and(and(strcmp(initial, "_"),
                strcmp(initial, " ")),
            strcmp(sname,""))) {
        set(last, 0)
        while (person) {
            print(".")
            if (moth, mother(person)) {
                enqueue(plist, moth)
            }
            set(last, person)
            set(person, father(person))
            if (strcmp(sname, surname(person))) {
                call last_in_line(last)
                call first_in_line(person)
            }
        }
    }
}

proc first_in_line (person)
{
    call set_year_place(person)
    set(fdate, pdate)
    set(pl, pplace)
    if (not(pl)) {      /* try for a supportable guess */
        list(places)
        if(fath,father(person)) {
            if(pl,place(death(fath))) {enqueue(places,save(pl))}
            if(pl,place(birth(fath))) {enqueue(places,save(pl))}
            if(nfamilies(fath)) {
                families(fath,fam,sp,spi) {
                    if(pl,place(marriage(fam))) {enqueue(places,save(pl))}
                }
            }
        }
        if(moth,mother(person)) {
            if(pl,place(death(moth))) {enqueue(places,save(pl))}
            if(pl,place(birth(moth))) {enqueue(places,save(pl))}
        }
        if(nfamilies(person)) {
            families(person,fam,sp,spi) {
                if(pl,place(marriage(fam))) {enqueue(places,save(pl))}
            }
        }
/* the person's place of death is often misleading */
/*      if(pl,place(death(person))) {enqueue(places,save(pl))} */
        set(npl,length(places))
        while (gt(npl,1)) {
            set(pl,dequeue(places))
            set(npl,sub(npl,1))
            set(ind,1)
            while(le(ind,npl)) {
                if(not(strcmp(pl,getel(places,ind)))) {set(npl,neg(1))}
                set(ind,add(ind,1))
            }
        }
        if(ge(npl,0)) {set(pl,0)}
    }
    set(fplace,save(pl))
    set(sname,save(surname(person)))
}

proc last_in_line (person)
{
    call set_year_place(person)
    set(ldate, pdate)
    set(lplace, pplace)
    set(line_count,add(line_count,1))
    addtoset(tafelset,person,line_count)
    if (and(strcmp(ldate,"????"), gt(strcmp(ldate,fdate),0))) {
        print("\nInconsistent dates for surname ")
        print(sname)
    }
    enqueue(ldatelist,save(ldate))
    enqueue(fdatelist,save(fdate))
    enqueue(lplacelist,save(lplace))
    enqueue(fplacelist,save(fplace))
}

/* set global variable datemod to +1 if event's date is marked AFT,
   -1 if marked BEF, and 0 otherwise */

proc get_modifier(event)
{   set (datemod,0)
    if (junk,date(event)) {
        set (junk,trim(junk,3))
        if(not(strcmp(junk,"AFT"))) { set (datemod,1) }
        elsif(not(strcmp(junk,"BEF"))) { set (datemod,neg(1)) }
    }
}

/* get birth-year for given person -- use whatever clues available, in
this order.  The culture-dependent limits are defined in "main".

        1. birth
        2. baptism
        3. birth of older sibling (+2)
        4. birth of younger sibling (-2)
        5. baptism of younger sibling (upper limit only)
        6. birth of parent (+14: lower limit only)
        7. death of parent (upper limit only)
        8. marriage or birth of first child (-20: recursive)
        9. marriage or birth of first child (-14: recursive upper limit)
        9. birth of last child (-50: lower limit only)
        10. death, known to be a parent (-60)
        11. death, not known to be a parent
*/
proc set_year (person)
{   set (maxyr,9999)                    /* set upper bound */
    set (minyr,0)                       /* and lower bound */
    set (guess,0)                       /* clear "best" guess */
    if (yr, year(birth(person))) {      /* solid data */
        call get_modifier(birth(person))
        set (iyr,atoi(yr))
        if(ge(datemod,0)) {set(minyr,iyr)}
        if(le(datemod,0)) {set(maxyr,iyr)}
        if(datemod) {set (yr,0)}
    }
    if (not(yr)) {
        if (yr, year(baptism(person))) {        /* pretty good guess */
            set(iyr,atoi(yr))
            call get_modifier(baptism(person))
            if(and(le(datemod,0),lt(iyr,maxyr))) {set(maxyr,iyr)}
            set (guess, iyr)
        }

        if(sibl,prevsib(person)) {      /* try older sibling */
            if (yr, year(birth(sibl))) {
                call get_modifier(birth(sibl))
                if(ge(datemod,0)) {
                    set (iyr,atoi(yr))
                    if(gt(iyr,minyr)) {set(minyr,iyr)}
                    if(not(or(guess,datemod))) {set(guess,add(iyr,2))}
                }
            }
        }
        if(sibl,nextsib(person)) {      /* try younger sibling */
            if (yr, year(birth(sibl))) {
                call get_modifier(birth(sibl))
                if(le(datemod,0)) {
                    set (iyr,atoi(yr))
                    if(lt(iyr,maxyr)) {set(maxyr,iyr)}
                    if(not(or(guess,datemod))) {set(guess,sub(iyr,2))}
                } else {set(yr,0)}
            }
            if (not(yr)) {
                if (yr, year(baptism(sibl))) {
                    set(iyr,atoi(yr))
                    call get_modifier(baptism(sibl))
                    if(and(le(datemod,0),lt(iyr,maxyr))) {set(maxyr,iyr)}
                }
            }
        }

        if(sp,mother(person)) {         /* set limits from mother */
            if(yr,year(birth(sp))) {
                call get_modifier(birth(sp))
                set(iyr,add(atoi(yr),Minpar))
                if(and(ge(datemod,0),gt(iyr,minyr))) {set(minyr,iyr)}
            }
            if(yr,year(death(sp))) {
                call get_modifier(death(sp))
                set(iyr,atoi(yr))
                if(and(le(datemod,0),lt(iyr,maxyr))) {set(maxyr,iyr)}
            }
        }


        if(sp,father(person)) {         /* set limits from father */
            if(yr,year(birth(sp))) {
                call get_modifier(birth(sp))
                set(iyr,add(atoi(yr),Minpar))
                if(and(ge(datemod,0),gt(iyr,minyr))) {set(minyr,iyr)}
            }
            if(yr,year(death(sp))) {
                call get_modifier(death(sp))
                set(iyr,add(atoi(yr),1))
                if(and(le(datemod,0),lt(iyr,maxyr))) {set(maxyr,iyr)}
            }
        }

        set(maryr,9999)                 /* marriage date or upper limit */
        set(marbest,9999)               /* best guess at marriage date */
        set(lastbirth,0)
        if(nfamilies(person)) {         /* check on marriage/chidren */
            families(person,fam,sp,spi) {
                if(yr, year(marriage(fam))) {
                    call get_modifier(marriage(fam))
                    set(iyr,atoi(yr))   /* go by marriage date */
                    if(and(le(datemod,0),lt(iyr,maryr))) {set(maryr,iyr)}
                    if(and(le(datemod,0),lt(iyr,marbest))) {set(marbest,iyr)}
                }
                if(or(eq(maryr,9999),female(person))) {
                    children (fam,child,famchi) {
                        call set_year(child)    /* recurse on children */
                        if(lt(pdmax,maryr)) {set(maryr,pdmax)}
                        if(strcmp(pdate,"????")) {
                            set(iyr,atoi(pdate))
                            if(lt(iyr,marbest)) {set(marbest,iyr)}
                        }
                        if(gt(pdmin,lastbirth)) {set(lastbirth,pdmin)}
                                        /* get earliest & latest child */
                    }
                }
            }
        }
        if(eq(marbest,9999)) {set(marbest,maryr)}
        if(lt(maryr,9999)) {
            set(iyr,sub(maryr,Minpar))  /* assume biological limit */
            if(lt(iyr,maxyr)) {set(maxyr,iyr)}
            if(not(guess)) {set(guess,sub(marbest,Typicl))}  /* typical age */
        }
        if(gt(lastbirth,0)) {
            set(iyr,sub(lastbirth,Menopa))      /* another biological limit */
            if(gt(iyr,minyr)) {set(minyr,iyr)}
        }
        if (yr, year(death(person))) {call get_modifier(death(person))}
        elsif (yr, year(burial(person))) {call get_modifier(burial(person))}
        if (yr) {
            set (iyr, atoi(yr))
            if(and(le(datemod,0),lt(iyr,maxyr))) {set(maxyr,iyr)}
            if(not(guess)) {                    /* still need a guess? */
                if(nfamilies(person)) {
                    set(guess,sub(iyr,Oldage))} /* died old */
                else {set(guess,iyr)}           /* no family => died young */
            }
        }

        if (gt(guess,maxyr)) { set(guess,maxyr) } /* apply limit, in case... */
        if (lt(guess,minyr)) { set(guess,minyr) }
        if (gt(guess,0)) {set (yr,d(guess))}
    }
    if (not(yr)) { set (yr, "????") }
    set(pdate, save(yr))                /* values returned */
    set(pdmin,minyr)
    set(pdmax,maxyr)
}

proc set_year_place (person)
{
    call set_year (person)
    set(pl, place(birth(person)))
    if (not(pl)) {set(pl, place(baptism(person)))}
    set(pplace, save(pl))
}


/*

Here is an example of a tiny tafel by Cliff Manis.

Note that the "Z" line is the number of actual data lines.

N Alda Clifford Manis
A P. O. Box 33937
A San Antonio
A Texas
A 78265-3937
T 1 (512) 654-9912
C 19.2 Baud, Unix System
C Send any Email to:  cmanis@csoftec.csf.com
D Unix Operating System
F LifeLines Genealogy Program for Unix
Z 16
M520 1939 1939 Manis\Knoxville, Knox Co, TN/Knoxville, Knox Co, TN
M520 1780 1902 Manes\Sevier Co, TN ?/Union Valley, Sevier Co, TN
M520 1770 1770 Maness\Sevier Co, Tennessee ?/Sevier Co, Tennessee ?
M520 1805 1914 Manis\North Carolina ?/Dandridge, Jefferson Co, TN
C536 1820 1869 Canter\VA/Jonesboro, Washington Co, TN
B620 1765 1829 Bowers/TN
N550 1730 1881 Newman\Monroe Co., WV/Jefferson Co, TN
B630 1760 1845 Bird\Frederick Co, VA/Sevier Co, TN
B630 1730 1730 Barth\Germany/Germany
F652 1745 1810 Francis\Augusta Co, VA ?/Rutherford Co, NC
W365 1860 1846 Whitehorn\VA/Washington Co, TN ?
C500 1700 1808 Cowan/TN
C613 1720 1843 Corbett\Scotch-Irish Dec/Jefferson Co, TN
R525 1750 1806 Rankin\Scotland/Jefferson Co., TN
S636 1776 1799 Shrader\Virginia/Sevier Co, TN ?
B300 1772 1772 Boyd\Boyd's Creek, Sevier Co, TN/Boyd's Creek, Sevier Co, TN
W 24 September 1992

*/

/* End of Report */

