1/*
2 * @progname    eol.ll
3 * @version     4 of 1995-01
4 * @author      Tom Wetmore and John Chandler
5 * @category
6 * @output      Text, 80 cols
7 * @description
8 *
9Say you want to know who all of your end-of-line ancestors are, that
10is, your direct ancestors whose parents you have not yet discovered;
11these are the people most of us spend most of our time on researching.
12Here is a program that will produce the list.  Any ancestor will be
13listed at most once, even in cases where lines cross.  Each person
14is shown with date and place of birth and death -- a "guess" is made
15for the year of birth if it is not known.
16
17Set the Do_all variable to 1 if you want the end-of-line list to
18include even persons with an unknown surname.
19
20This program shares the birth-guessing subroutine with tinytafel.
21*/
22
23global(plist)
24global(abbvtab)
25
26/* Global definitions for birth-guessing subroutine */
27global(pdate)
28global(pplace)
29global(datemod) /* value returned by get_modifier */
30global(pdmax)
31global(pdmin)
32
33/* Assumptions for guessing year of birth */
34global(Minpar)	/* assumed minimum age of parenthood */
35global(Typicl)	/* typical age for parenthood or marriage */
36global(Menopa)	/* assumed maximum age of motherhood */
37global(Oldage)	/* assumed age at death */
38
39proc main () {
40	set(Do_all,0)	/* if 0, then ignore surnameless persons */
41
42	/* Assumptions for guessing year of birth */
43	set(Minpar,14)	/* assumed minimum age of parenthood */
44	set(Typicl,20)	/* typical age for parenthood or marriage */
45	set(Menopa,50)	/* assumed maximum age of motherhood */
46	set(Oldage,60)	/* assumed age at death */
47
48	list(ilist)
49	list(plist)
50	list(pnlist)
51	table(seen)
52	table(abbvtab)
53	indiset(set)
54	getindi(indi)
55	monthformat(4)
56	"END OF LINE ANCESTORS OF " fullname(indi,1,1,30) "\n\n"
57	call setupabbvtab()
58	enqueue(ilist, indi)
59	while(indi, dequeue(ilist)) {
60		set(show, 1)
61		if (par, father(indi)) {
62			set(do_this,Do_all)
63			if(not(Do_all)) {
64				extractnames (inode(par),pnlist,n,s)
65				set(do_this, strcmp(getel(pnlist,s),""))
66			}
67			if(do_this) {
68				enqueue(ilist, par)
69				set(show, 0)
70			}
71		}
72		if (par, mother(indi)) {
73			set(do_this,Do_all)
74			if(not(Do_all)) {
75				extractnames (inode(par),pnlist,n,s)
76				set(do_this, strcmp(getel(pnlist,s),""))
77			}
78			if(do_this) {
79				enqueue(ilist, par)
80				set(show, 0)
81			}
82		}
83		if (show) {
84			set(pkey, key(indi))
85			if(not(lookup(seen,pkey))) {
86				insert(seen,pkey,1)
87				addtoset(set, indi, pkey)
88			}
89		}
90	}
91	namesort(set)
92	forindiset (set, indi, val, num) {
93		col(1) fullname(indi,1,0,27)
94		call set_year_place(indi)
95		call showevent(29, birth(indi), pdate, pplace)
96		call showevent(55, death(indi), 0, 0)
97		nl()
98	}
99}
100
101proc showevent (column, event, apdate, applace)
102{
103	col(column)
104	set(column, add(column, 12))
105	if(year(event)) {
106		stddate(event) sp()
107	}
108	elsif(apdate) { "      c" apdate " " }
109	extractplaces(event, plist, num)
110	if (and(applace,eq(num,0))) {
111		call extractstr(applace,plist)
112		set(num,length(plist))
113	}
114	if (gt(num, 0)) {
115		col(column)
116		set(last, getel(plist, num))
117		if (yes, lookup(abbvtab, last)) {
118			set(last, yes)
119		}
120		trim(last, 10)
121	}
122}
123
124proc extractstr (string,list) {
125	list(list)
126	call ext_step(list,string,1,strlen(string),0)
127}
128proc ext_step(list,string,start,len,nth) {
129	if(gt(start,len)) {return()}
130	set(nth,add(1,nth))
131	if (not(strcmp(substring(string,start,start)," "))) {
132		set(start,add(1,start))
133	}
134	set(end, sub(index(string, ",", nth),1))
135	if(lt(end,0)) {set(end,len)}
136	enqueue (list, substring(string,start,end))
137	if (lt(end,len)) {call ext_step(list,string,add(end,2),len,nth)}
138}
139
140proc setupabbvtab ()
141{
142	insert(abbvtab, "Connecticut", "CT")
143	insert(abbvtab, "Connecticut Colony", "CT")
144	insert(abbvtab, "New Haven Colony", "CT")
145	insert(abbvtab, "Massachusetts", "MA")
146	insert(abbvtab, "Plymouth Colony", "MA")
147	insert(abbvtab, "New York", "NY")
148	insert(abbvtab, "England", "ENG")
149	insert(abbvtab, "Holland", "HOL")
150	insert(abbvtab, "Maryland", "MD")
151	insert(abbvtab, "Wales", "WLS")
152	insert(abbvtab, "Isle of Man", "IOM")
153	insert(abbvtab, "Nova Scotia", "NS")
154	insert(abbvtab, "Ireland", "IRE")
155	insert(abbvtab, "Rhode Island", "RI")
156	insert(abbvtab, "prob England", "ENG?")
157}
158
159/* set global variable datemod to +1 if event's date is marked AFT,
160   -1 if marked BEF, and 0 otherwise */
161
162proc get_modifier(event)
163{   set (datemod,0)
164    if (junk,date(event)) {
165	set (junk,trim(junk,3))
166	if(not(strcmp(junk,"AFT"))) { set (datemod,1) }
167	elsif(not(strcmp(junk,"BEF"))) { set (datemod,neg(1)) }
168    }
169}
170
171/* get birth-year for given person -- use whatever clues available, in
172this order.  The culture-dependent limits are defined in "main".
173
174	1. birth
175	2. baptism
176	3. birth of older sibling (+2)
177	4. birth of younger sibling (-2)
178	5. baptism of younger sibling (upper limit only)
179	6. birth of parent (+14: lower limit only)
180	7. death of parent (upper limit only)
181	8. marriage or birth of first child (-20: recursive)
182	9. marriage or birth of first child (-14: recursive upper limit)
183	9. birth of last child (-50: lower limit only)
184	10. death, known to be a parent (-60)
185	11. death, not known to be a parent
186*/
187proc set_year (person)
188{   set (maxyr,9999)			/* set upper bound */
189    set (minyr,0)			/* and lower bound */
190    set (guess,0)			/* clear "best" guess */
191    if (yr, year(birth(person))) {	/* solid data */
192	call get_modifier(birth(person))
193	set (iyr,atoi(yr))
194	if(ge(datemod,0)) {set(minyr,iyr)}
195	if(le(datemod,0)) {set(maxyr,iyr)}
196	if(datemod) {set (yr,0)}
197    }
198    if (not(yr)) {
199	if (yr, year(baptism(person))) {	/* pretty good guess */
200	    set(iyr,atoi(yr))
201	    call get_modifier(baptism(person))
202	    if(and(le(datemod,0),lt(iyr,maxyr))) {set(maxyr,iyr)}
203	    set (guess, iyr)
204	}
205
206	if(sibl,prevsib(person)) {	/* try older sibling */
207	    if (yr, year(birth(sibl))) {
208		call get_modifier(birth(sibl))
209		if(ge(datemod,0)) {
210		    set (iyr,atoi(yr))
211		    if(gt(iyr,minyr)) {set(minyr,iyr)}
212		    if(not(or(guess,datemod))) {set(guess,add(iyr,2))}
213		}
214	    }
215	}
216	if(sibl,nextsib(person)) {	/* try younger sibling */
217	    if (yr, year(birth(sibl))) {
218		call get_modifier(birth(sibl))
219		if(le(datemod,0)) {
220		    set (iyr,atoi(yr))
221		    if(lt(iyr,maxyr)) {set(maxyr,iyr)}
222		    if(not(or(guess,datemod))) {set(guess,sub(iyr,2))}
223		} else {set(yr,0)}
224	    }
225	    if (not(yr)) {
226		if (yr, year(baptism(sibl))) {
227		    set(iyr,atoi(yr))
228		    call get_modifier(baptism(sibl))
229		    if(and(le(datemod,0),lt(iyr,maxyr))) {set(maxyr,iyr)}
230		}
231	    }
232	}
233
234	if(sp,mother(person)) {		/* set limits from mother */
235	    if(yr,year(birth(sp))) {
236		call get_modifier(birth(sp))
237		set(iyr,add(atoi(yr),Minpar))
238		if(and(ge(datemod,0),gt(iyr,minyr))) {set(minyr,iyr)}
239	    }
240	    if(yr,year(death(sp))) {
241		call get_modifier(death(sp))
242		set(iyr,atoi(yr))
243		if(and(le(datemod,0),lt(iyr,maxyr))) {set(maxyr,iyr)}
244	    }
245	}
246
247
248	if(sp,father(person)) {		/* set limits from father */
249	    if(yr,year(birth(sp))) {
250		call get_modifier(birth(sp))
251		set(iyr,add(atoi(yr),Minpar))
252		if(and(ge(datemod,0),gt(iyr,minyr))) {set(minyr,iyr)}
253	    }
254	    if(yr,year(death(sp))) {
255		call get_modifier(death(sp))
256		set(iyr,add(atoi(yr),1))
257		if(and(le(datemod,0),lt(iyr,maxyr))) {set(maxyr,iyr)}
258	    }
259	}
260
261	set(maryr,9999)			/* marriage date or upper limit */
262	set(marbest,9999)		/* best guess at marriage date */
263	set(lastbirth,0)
264	families(person,fam,sp,spi) {	/* check on marriage/chidren */
265	    if(yr, year(marriage(fam))) {
266	        call get_modifier(marriage(fam))
267	        set(iyr,atoi(yr))	/* go by marriage date */
268	        if(and(le(datemod,0),lt(iyr,maryr))) {set(maryr,iyr)}
269	        if(and(le(datemod,0),lt(iyr,marbest))) {set(marbest,iyr)}
270	    }
271	    if(or(eq(maryr,9999),female(person))) {
272	        children (fam,child,famchi) {
273	    	call set_year(child)	/* recurse on children */
274	    	if(lt(pdmax,maryr)) {set(maryr,pdmax)}
275	    	if(strcmp(pdate,"????")) {
276	    	    set(iyr,atoi(pdate))
277	    	    if(lt(iyr,marbest)) {set(marbest,iyr)}
278	    	}
279	    	if(gt(pdmin,lastbirth)) {set(lastbirth,pdmin)}
280	    			/* get earliest & latest child */
281	        }
282	    }
283	}
284	if(eq(marbest,9999)) {set(marbest,maryr)}
285	if(lt(maryr,9999)) {
286	    set(iyr,sub(maryr,Minpar))	/* assume biological limit */
287	    if(lt(iyr,maxyr)) {set(maxyr,iyr)}
288	    if(not(guess)) {set(guess,sub(marbest,Typicl))}  /* typical age */
289	}
290	if(gt(lastbirth,0)) {
291	    set(iyr,sub(lastbirth,Menopa))	/* another biological limit */
292	    if(gt(iyr,minyr)) {set(minyr,iyr)}
293	}
294	if (yr, year(death(person))) {call get_modifier(death(person))}
295	elsif (yr, year(burial(person))) {call get_modifier(burial(person))}
296	if (yr) {
297	    set (iyr, atoi(yr))
298	    if(and(le(datemod,0),lt(iyr,maxyr))) {set(maxyr,iyr)}
299	    if(not(guess)) {			/* still need a guess? */
300		if(nfamilies(person)) {
301		    set(guess,sub(iyr,Oldage))} /* died old */
302		else {set(guess,iyr)}		/* no family => died young */
303	    }
304	}
305
306	if (gt(guess,maxyr)) { set(guess,maxyr) } /* apply limit, in case... */
307	if (lt(guess,minyr)) { set(guess,minyr) }
308	if (gt(guess,0)) {set (yr,d(guess))}
309    }
310    if (not(yr)) { set (yr, "????") }
311    set(pdate, yr)		/* values returned */
312    set(pdmin,minyr)
313    set(pdmax,maxyr)
314}
315
316proc set_year_place (person)
317{
318    call set_year (person)
319    set(pl, place(birth(person)))
320    if (not(pl)) {set(pl, place(baptism(person)))}
321    set(pplace, pl)
322}
323