2
* @progname all_anc_lines.ll
9
* report all ancestral lines in a Register-like format
12
all_anc_lines -- Shows all ancestral lines of a specified person using
13
a pseudo-Register format. The paternal line of the person is shown
14
first; then the paternal line of his/her mother; then the paternal line
15
of his/her paternal grandmother; and so on, in a depth-first manner.
17
A new feature was added to follow maternal lines also.
19
Future option -- breadth first versus depth first coverage -- easy to
20
implement by changing the algorithm that builds dlist from a stack to a
23
by Tom Wetmore, ttw@beltway.att.com
24
version 1, 14 Nov 1995
25
version 2, 23 Nov 1995
28
global(mlist) /* list of pending key persons */
29
global(glist) /* generations of pending key persons */
30
global(stable) /* table of seen key persons */
31
global(dlist) /* list of final key persons */
32
global(hlist) /* list of final generations */
33
global(ilist) /* list of isolated persons */
36
global(ftable) /* list of shown families */
37
global(ptable) /* table of printed persons */
41
getindi(i, "Enter person whose full registry ancestry is wanted.")
44
enqueue(menu, "Follow paternal lines; or")
45
enqueue(menu, "Follow maternal lines.")
46
set(m, menuchoose(menu, "Select whether to:"))
47
if (eq(1, m)) { set(pat, 1) }
51
enqueue(menu, "Output lines depth-first; or")
52
enqueue(menu, "Output lines breadth-first.")
53
set(m, menuchoose(menu, "Select whether to:"))
54
if (eq(1, m)) { set(depth, 1) }
55
else { set(depth, 0) }
67
print("Program not run.")
81
while (p, dequeue(mlist)) {
82
set(g, dequeue(glist))
89
if (not(lookup(stable, key(m)))) {
90
insert(stable, save(key(m)), 1)
98
if (not(lookup(stable, key(f)))) {
99
insert(stable, save(key(f)), 1)
113
forlist (dlist, p, n) {
114
set(g, dequeue(hlist))
115
if (not(lookup(ptable, key(p)))) {
116
if (pat) { set(q, father(p)) }
117
else { set(q, mother(p)) }
121
insert (ptable, save(key(p)), 1)
126
forlist (ilist, p, n) {
127
"ISOLATED PERSON " name(p) "\n"
135
/*".NL\nPATERNAL LINE OF " upper(name(p)) "\n\n"*/
136
print(surname(p), " ")
138
".NL\nMATERNAL LINE OF " upper(name(p)) "\n\n"
142
while (f, father(p)) {
148
while (m, mother(p)) {
166
/*".GN\nGENERATION " d(g) "\n\n"*/
168
call longvitals(a) /* show main line person */
169
insert(ptable, save(key(a)), 1)
171
if (pat) { set(c, mother(b)) }
172
else { set(c, father(b)) }
173
if (pat) { set(d, father(c)) }
174
else { set(d, mother(c)) }
176
if (and(c, not(d))) {
177
call gammavitals(c, a)
178
insert(ptable, save(key(c)), 1)
181
call dochildren(a, b)
182
if (and(c, not(d))) {
183
call gammachildren(c)
189
".de hd\n'sp .8i\n..\n"
191
".wh 0 hd\n.wh -.8i fo\n"
196
"\\h'3n'\\h'-\\w'\\\\$1'u'\\\\$1\\h'6n'\\h'-\\w'\\\\$2'u'\\\\$2\\h'1n'\n"
199
".de IN\n.sp\n.in 0\n..\n"
200
".de NL\n.br\n.ne 2i\n.sp 2\n.in 0\n.ce\n..\n"
201
".de GN\n.br\n.ne 2i\n.sp 2\n.in 0\n.ce\n..\n"
202
".de P\n.sp\n.in 0\n.ti 5\n..\n"
209
proc dochildren (i, c)
211
if (c) { set(ckey, save(key(c))) }
212
else { set(ckey, "JUNK") }
213
families (i, f, s, n) {
215
if (s) { set(sname, save(name(s))) }
216
else { set(sname, "(_____)") }
217
if (eq(0, nchildren(f))) {
218
name(i) " and " sname
219
" had no children.\n"
220
} elsif (lookup(ftable, key(f))) {
221
"Children of " name(i) " and " sname
222
" listed under " sname ".\n"
225
if (not(strcmp(key(k), ckey))) {
226
".CH (+) " roman(m) "\n"
229
".CH \"\" " roman(m) "\n"
236
"Children of " name(i) " and " sname ":\n"
238
if (not(strcmp(key(k), ckey))) {
239
/*print(name(k), "\n")*/
240
".CH (+) " roman(m) "\n"
243
".CH \"\" " roman(m) "\n"
247
insert(ftable, save(key(f)), 1)
257
if (and(b, short(b))) { ", b. " short(b) }
258
if (and(d, short(d))) { ", d. " short(d) }
262
proc middlevitals (i)
266
if(and(e,long(e))) { "Born " long(e) ".\n" }
267
if (eq(1, nspouses(i))) {
268
spouses(i, s, f, n) {
270
call spousevitals(s, f)
273
spouses(i, s, f, n) {
274
"Married " ord(n) ","
275
call spousevitals(s, f)
279
if(and(e, long(e))) { "Died " long(e) ".\n" }
287
if(and(e,long(e))) { "Born " long(e) ".\n" }
288
if (eq(1, nspouses(i))) {
289
spouses(i, s, f, n) {
291
call spousevitals(s, f)
294
spouses(i, s, f, n) {
295
"Married " ord(n) ","
296
call spousevitals(s, f)
300
if(and(e, long(e))) { "Died " long(e) ".\n" }
302
fornotes(inode(i), n) {
303
if (not(p)) { ".P\n" set(p, 1) }
308
proc spousevitals (s, f)
311
if (and(e, long(e))) { "\n" long(e) "," }
314
if (and(e, long(e))) { ",\nborn " long(e) }
316
if (and(e, long(e))) { ",\ndied " long(e) }
321
if (male(s)) { "son of " }
322
elsif (female(s)) { "daughter of " }
326
if (and(d, m)) { "\nand " }
331
proc gammavitals(a, c)
336
if (or(gt(n, 1), or(m, d))) {
339
if (male(a)) { "son of " }
340
elsif (female(a)) { "daughter of " }
344
if (and(d, m)) { "\nand " }
346
if (or(d, m)) { ",\n" }
348
if (eq(1, nspouses(a))) {
349
spouses(a, s, f, n) {
351
if (eqstr(key(c), key(s))) {
354
call spousevitals(s, f)
358
spouses(a, s, f, n) {
359
"Married " ord(n) ","
360
if (eqstr(key(c), key(s))) {
363
call spousevitals(s, f)
371
proc gammachildren (p)
373
families (p, f, s, n) {
374
if (not(lookup(ftable, key(f)))) {
376
if (s) { set(sname, save(name(s))) }
377
else { set(sname, "(_____)") }
378
if (eq(0, nchildren(f))) {
379
name(p) " and " sname " had no children.\n"
381
"Children of " name(p) " and " sname ":\n"
383
".CH \"\" " roman(m) "\n"
393
/*".NL\nPATERNAL LINE OF " upper(name(p)) "\n\n"*/
398
if (not(lookup(stable, surname(p)))) {
399
enqueue(snames, save(surname(p)))
400
insert(stable, save(surname(p)), 1)
405
forlist (snames, s, n) {