mirror of
https://github.com/kennethreitz/context.git
synced 2026-06-05 14:50:19 +00:00
409 lines
12 KiB
LLVM
409 lines
12 KiB
LLVM
/*
|
|
* @progname tinytafel1.ll
|
|
* @version 3.1
|
|
* @author Wetmore, Eggert, Chandler
|
|
* @category
|
|
* @output TinyTafel
|
|
* @description
|
|
|
|
This report will produce a tinytafel report on a person.
|
|
|
|
tinytafel1
|
|
|
|
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.
|
|
Version 3.1 Mark guessed places with "?"
|
|
|
|
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)
|
|
if(person) {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))}
|
|
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))}
|
|
}
|
|
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)}
|
|
if(pl) {set(pl,concat(pl,"?"))}
|
|
}
|
|
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)
|
|
families(person,fam,sp,spi) { /* check on marriage/chidren */
|
|
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 */
|