1/*
2 * @progname       rfc.ll
3 * @version        1995-09-08
4 * @author         Paul B. McBride (pbm%cybvax0@uunet.uu.net)
5 * @category
6 * @output         Text
7 * @description
8
9                   Royalty For Commoners format report
10
11Requirements:
12        LifeLines 3.0.2 or later (I hope)
13        sour.li - SOUR processing subroutine library
14
15Background:
16
17This report program generates a report in a format similar to that
18used in the book "Royalty for Commoners", Stuart, 1992, which attempts
19to list all of the "known" ancestors of John of Gaunt. In this book
20the furtherest back generation has the highest number, and there is
21an attempt to keep generation numbers relatively consistant in different
22lines.
23
24The format is similar to that used in "Ancestral Roots of Certain
25American colonists who came to America before 1700", Weis, 1992, except
26that here the earliest generation in a line is generation number 1.
27
28I also use this report program to generate a report for a range of
29people between an ancestor and a descendant when exchanging info
30with other people.
31
32Prompts:
33
34        Identify the ancestor (Optional)
35
36                If you want a complete report of all of the ancestors
37                of a person, or if you don't want a complete
38                report, but the earliest ancestor has the same
39                surname as the descendant, then just press return
40
41        Identify the descendant
42
43                If you didn't enter the ancestor, then you must enter
44                the descendant to get a report.
45
46        All ancestors (1 = yes, 0 = no)
47
48                If you haven't entered the ancestor, then you will
49                be asked this question. If you answer 0 (no), then
50                the program will use the earliest ancestor in the
51                paternal line.
52
53        Number of Generations
54
55                If you haven't entered the descendant, then the program
56                will look for a descendant this many generations below.
57
58        First Generation Number (default is 1)
59
60                If you want generations to count upward as in "Anceatral
61                Roots..." then enter 1.
62
63                If you want generations to count downward as in "Royalty
64                for Commoners", an educated guess is necessary here,
65                or you may end up with negative generation numbers.
66                An ancestorset() will be generated. This will contain
67                minimum generation numbers. The generation number
68                in the ancestor set will be used to adjust the generation
69                number upward if you enter a number which is too small,
70                but this may not be sufficient. For my database, I needed
71                to increase that number by 10.
72
73        Generations count downward (1) or upward (0)
74
75                You are only asked this question if the first generation
76                number is greater than 1.
77
78Tags processed by the report
79
80        tag     prefix
81
82        TITL
83        NOTE
84        BIRT    b.
85        CHR     bp.
86        DEAT    d.
87        BUR     bur.
88        LIVE    lv.
89        RESI    r.
90
91SOUR record processing
92
93        Source references are accumulated for each line and the
94        REFN's are reported at the end of the line.
95        At the end of the report all of the REFN's are listed
96        along with the source details. See my SOUR routine
97        library (sour.li) for more info.
98
99Future Development:
100
101        - rather than specifying a single descendant, allow entry of
102          a group of descendants.
103        - allow optional reporting of more SOUR detail associated with tags.
104        - sort aliases
105        - sort reference keys
106
107Edit History:
108
10908-sep-95 Paul B. McBride (pbm%cybvax0@uunet.uu.net)
110*/
111
112include("sour.li")
113
114global(atable)
115global(xtable)
116global(aset)
117global(xlen)
118global(nalist)
119global(nilist)
120global(aliascnt)
121global(indicnt)
122
123global(allsour_table)
124global(allsour_list)
125
126global(allanc)
127global(part)
128global(gnum)
129global(tset)
130
131proc main ()
132{
133      table(allsour_table)
134      list(allsour_list)
135
136      indiset(iset)
137      indiset(tset)
138      indiset(uset)
139      indiset(aset)
140      table(atable)
141      table(xtable)
142      list(nalist)
143      list(nilist)
144      set(xlen, 0)
145      set(aliascnt, 0)
146      set(indicnt, 0)
147
148      getindimsg(ancestor, "Identify the ancestor (Optional)")
149      if(ancestor) {
150        getindimsg(descendant,"Identify the descendant (Optional)")
151      }
152      else {
153        getindimsg(descendant,"Identify the descendant (Required)")
154      }
155      set(allanc, 0)
156      if(and(ne(descendant,0),eq(ancestor,0))) {
157        getintmsg(allanc, "All Ancestors? (1 = yes, 0 = no)")
158        set(ancestor, descendant)
159        while(fath, father(ancestor)) {
160          set(ancestor, fath)
161        }
162      }
163      if(and(eq(descendant,0),ne(ancestor,0))) {
164        getintmsg(gcount, "Number of Generations")
165        set(descendant, ancestor)
166        while(gcount, sub(gcount,1)) {
167            set(cindi, 0)
168            set(dindi, 0)
169            families(descendant, fam, sps,  fnum) {
170                if(gt(nchildren(fam),0)) {
171                   children(fam, child, cnum) {
172                     if(eq(cindi, 0)) { set(cindi, child) }
173                     families(child, chfam, chsps,  chfnum) {
174                       if(gt(nchildren(chfam),0)) {
175                         set(dindi, child)
176                         break()
177                       }
178                     }
179                     if(ne(dindi, 0)) { break() }
180                   }
181                }
182                if(ne(dindi, 0)) { break() }
183            }
184            if(dindi) { set(descendant, dindi) }
185            elsif (cindi) {
186                set(descendant, cindi)
187                break()
188            }
189            else { break() }
190        }
191      }
192      if(and(ne(ancestor, 0),ne(descendant,0))) {
193        getintmsg(gnum, "First Generation Number (default is 1)")
194        if(le(gnum,0)) { set(gnum,1) }
195        set(down, 0)
196        if(gt(gnum,1)) {
197          getintmsg(down, "Generations count downward (1) or upward (0)")
198        }
199        set(firstgen, gnum)
200        if(descendant) {
201          /* output a line so that output file prompt will appear before
202             the ancestor set is generated because it can take a long
203             time.
204           */
205          if(allanc) {
206            print("All Ancestors of ", name(descendant), nl())
207            "All Ancestors of " name(descendant) nl()
208          }
209          else {
210            print("Descendants of ", name(ancestor),
211                " who are ancestors of ", name(descendant), nl())
212            "Descendants of " call titledname(ancestor) nl()
213            "  who are ancestors of " call titledname(descendant) nl()
214          }
215          /* find all the people of interest */
216          print("Finding Ancestors... ")
217          addtoset(iset, descendant, 0)
218          set(tset, ancestorset(iset))
219          deletefromset(iset, descendant, 1)
220          print(d(lengthset(tset)), nl())
221
222          if(allanc) {
223            set(uset, tset)
224          }
225          else {
226            print("Finding Descendants... ")
227            addtoset(iset, ancestor, 0)
228            set(uset, descendantset(iset))
229            deletefromset(iset, ancestor, 1)
230            print(d(lengthset(uset)), nl())
231          }
232          set(aset, intersect(tset, uset))
233          addtoset(aset, ancestor, 0)
234          addtoset(aset, descendant, 0)
235          print("Generating Report for ",
236                d(lengthset(aset)), " people")
237
238          list(ilist)
239          list(alist)
240          list(plist)
241          list(glist)
242
243          set(part, 0)
244          set(acount, 0)
245
246         while(1) {
247          if(allanc) {
248            set(maxgen, 0)
249            set(ancestor, 0)
250            forindiset(tset, indi, ival, icnt) {
251              if(or(eq(maxgen, 0),gt(ival,maxgen))) {
252                set(maxgen, ival)
253                set(ancestor, indi)
254              }
255            }
256            if(eq(ancestor, 0)) { break() }
257
258            if(and(ne(down,0), le(firstgen, maxgen))) {
259              set(firstgen, add(maxgen, 1))
260            }
261            set(gnum, findgen(ancestor, down, firstgen, eq(acount,0)))
262            print(nl(), name(ancestor), " ", d(add(part,1)),"-",d(gnum),". ",
263                  d(lengthset(tset)), " remaining")
264          }
265          enqueue(alist, ancestor)
266          enqueue(plist, 0)
267          enqueue(glist, gnum)
268          set(acount, add(acount, 1))
269          while(aindi, dequeue(alist)) {
270           print(".")
271           nl()
272           call sour_init()
273           set(pnum, dequeue(plist))
274           set(part, add(part, 1))
275           set(gnum, dequeue(glist))
276           "Line " d(part)
277           if(pnum) {
278             " from Line " d(pnum) " above."
279           }
280           /* if we are doing all of the ancestors, then start each line
281              as far back as possible..
282            */
283           if(allanc) {
284             set(changed, 0)
285             while(1) {
286               if(fath, father(aindi)) {
287                 if(lookup(atable, key(fath))) { break() }
288                 if(moth, mother(aindi)) {
289                   if(eq(lookup(atable, key(moth)),0)) {
290                     if(and(eq(father(fath),0),eq(mother(fath),0))) {
291                       if(or(ne(father(moth),0),ne(mother(moth),0))) {
292                         set(fath, moth)
293                       }
294                     }
295                   }
296                 }
297                 set(tindi, aindi)
298                 set(aindi, fath)
299               }
300               elsif(moth, mother(aindi)) {
301                 if(lookup(atable, key(moth))) { break() }
302                 set(tindi, aindi)
303                 set(aindi, moth)
304               }
305               else { break() }
306               print("+")
307               if(eq(changed, 0)) {
308                  set(changed, 1)
309                  " [" name(tindi) " " d(pnum) "-" d(gnum) "]"
310               }
311               if(down) { set(gnum, add(gnum,1)) }
312               else     { set(gnum, sub(gnum,1)) }
313             }
314           }
315           nl() nl()
316           enqueue(ilist, aindi)
317           while(indi, dequeue(ilist)) {
318            /* upper(roman(gnum)) */
319            call addtoindex(indi, part, gnum)
320            if(allanc) { deletefromset(tset, indi, 1) }
321            d(gnum) ". " call titledname(indi) nl()
322            set(tnum, lookup(atable, key(indi)))
323            if(ne(tnum,0)) {
324              "   [See Line " d(div(tnum,1000))
325                  " Generation " d(mod(tnum,1000)) " above]" nl()
326              continue()
327            }
328            insert(atable, save(key(indi)), add(mul(part,1000), gnum))
329            call sour_addind(indi)
330            call allnotes(indi, 8)
331            call allplaces(indi, 5)
332            /* set(bdate, "")
333             * set(ddate, "")
334             * if (eb, birth(indi)) { set(bdate,save(long(eb))) }
335             * if (ed, death(indi)) { set(ddate,save(long(ed))) }
336             * set(prefix, "    ")
337             * if (strlen(bdate)) { prefix "b. " bdate nl() }
338             * if (strlen(ddate)) { prefix "d. " ddate nl() }
339             */
340            set(desc, 0)
341            set(nfam, nfamilies(indi))
342            families(indi, fam, sps,  fnum) {
343                if(sps) {
344                   call sour_addind(sps)
345                   call addtoindex(sps, part, gnum)
346                   if(allanc) { deletefromset(tset, sps, 1) }
347                   if(eq(nfam,1)) { "    m. " }
348                   else           { "    m(" d(fnum) ") " }
349                   call titledname(sps)
350                   if (e, marriage(fam)) { " " long(e) }
351                   nl()
352                   set(bdate, "")
353                   set(ddate, "")
354                   if (eb, birth(sps)) { set(bdate,save(long(eb))) }
355                   if (ed, death(sps)) { set(ddate,save(long(ed))) }
356                   set(prefix, "       ")
357                   if (strlen(bdate)) { prefix "b. " bdate nl() }
358                   if (strlen(ddate)) { prefix "d. " ddate nl() }
359                   set(findi, father(sps))
360                   set(mindi, mother(sps))
361                   if(or(findi, mindi)) {
362                     "       "
363                     if(male(sps)) { "son of " }
364                     else { "daughter of " }
365                     if(findi) {
366                       call addtoindex(findi, part, gnum)
367                       if(allanc) { deletefromset(tset, findi, 1) }
368                       call titledname(findi)
369                       call simplefam(findi, ne(mindi,0))
370                       if(mindi) { " and " }
371                     }
372                     if(mindi) {
373                       call addtoindex(mindi, part, gnum)
374                       if(allanc) { deletefromset(tset, mindi, 1) }
375                       call titledname(mindi)
376                       call simplefam(mindi, 0)
377                     }
378                     nl()
379                   }
380                }
381                if(gt(nchildren(fam),0)) {
382                   if(eq(nfam,1)) { "    ch:   " }
383                   else           { "    ch(" d(fnum) ") " }
384                   set(needindent, 0)
385                   children(fam, child, cnum) {
386                        set(altdesc,0)
387                        set(mcnum,mod(sub(cnum,1),4))
388                        if(gt(cnum,1)) {
389                           if(eq(mcnum,0)) { set(needindent,1) }
390                        }
391                        if(needindent) {
392                            "," nl() "          "
393                            set(needindent,0)
394                        }
395                        else {
396                          if(gt(mcnum,0)) { ", "}
397                        }
398                        /* mark each child which is an ancestor with a "*",
399                           but only use the first at the next generation.
400                         */
401                        set(seeabove, 0)
402                        if(eq(child,descendant)) {
403                              "*"
404                              set(seeabove, lookup(atable, key(child)))
405                              if(eq(seeabove, 0)) {
406                                if(eq(desc,0)) {
407                                  enqueue(ilist, child)
408                                  set(desc,1)
409                                }
410                              }
411                        }
412                        else {
413                           addtoset(iset, child, 0)
414                           set(jset, intersect(aset, iset))
415                           if(ne(lengthset(jset),0)) {
416                              "*"
417                              set(seeabove, lookup(atable, key(child)))
418                              if(eq(seeabove,0)) {
419                                if(eq(desc,0)) {
420                                  enqueue(ilist, child)
421                                  set(desc,1)
422                                }
423                                else {
424                                  set(altdesc,1)
425                                }
426                              }
427                             deletefromset(jset, child, 1)
428                           }
429                           deletefromset(iset, child, 1)
430                           /*
431                            forindiset(aset, ancestor, junkval, junknum) {
432                            if(eq(child, ancestor)) {
433                              "*"
434                              if(eq(desc,0)) {
435                                enqueue(ilist, child)
436                                set(desc,1)
437                              }
438                              else {
439                                set(altdesc,1)
440                              }
441                              break()
442                            }
443                            }
444                           */
445                        }
446                        if(ne(strcmp(surname(child),
447                                     surname(father(child))),0)) {
448                               name(child)
449                        }
450                        else { givens(child) }
451                        if(seeabove) {
452                          call addtoindex(child, part, gnum)
453                          " [See Line " d(div(seeabove,1000))
454                          " Generation " d(mod(seeabove,1000)) " above]"
455                          set(needindent, 1)
456                        }
457                        if(eq(altdesc,1)) {
458                          if(down) { set(tnum, sub(gnum, 1)) }
459                          else     { set(tnum, add(gnum, 1)) }
460                          enqueue(alist, child)
461                          enqueue(plist, part)
462                          enqueue(glist, tnum)
463                          set(acount, add(acount,1))
464                          " [See Line " d(acount)
465                          " Generation " d(tnum) " below]"
466                          set(needindent, 1)
467                        }
468                   }
469                   nl()
470                }
471            }
472            if(down) { set(gnum, sub(gnum, 1)) }
473            else     { set(gnum, add(gnum, 1)) }
474          }
475          if(sour_exists()) {
476            nl() "References: "
477            call sour_see(",", 70, 13)
478            call sour_save(allsour_table, allsour_list)
479            nl()
480          }
481         }
482         if(eq(allanc,0)) { break() }
483         }
484        }
485        /* list all references */
486        call sour_restore(allsour_table, allsour_list)
487        if(sour_exists()) {
488            nl() "Key to References:" nl() nl()
489            call sour_ref(10)
490        }
491        /* generate an index */
492        call reportindex()
493        call reportalias()
494      }
495}
496
497/* report the index */
498
499proc reportindex()
500{
501        print(nl(), "Index: ", d(lengthset(aset)), " people, ")
502        print(d(xlen), " entries...")
503        nl() "Index" nl() nl()
504        namesort(aset)
505        forindiset(aset, indi, ival, inum) {
506          if(xref, lookup(xtable, key(indi))) {
507            surname(indi) ", " givens(indi)
508            col(30) key(indi)
509            col(40) xref nl()
510          }
511        }
512}
513
514/* add to the index */
515
516proc addtoindex(indi, part, gnum)
517{
518        if(xref, lookup(xtable, key(indi))) {
519          set(xref, save(concat(xref, ",", save(d(part)), "-", save(d(gnum)))))
520        }
521        else {
522          set(xref, save(d(part)))
523          set(xref, save(concat(xref, "-", save(d(gnum)))))
524          set(xlen, add(xlen, 1))
525        }
526        insert(xtable, save(key(indi)), xref)
527}
528
529/* report all of a person's titles */
530
531proc titles(i)
532{
533        fornodes (inode(i), n) {
534                if (eqstr(tag(n), "TITL")) {
535                        value(n) " "
536                }
537        }
538}
539
540proc titledname(i)
541{
542        fornodes (inode(i), n) {
543                if (eqstr(tag(n), "TITL")) {
544                  if(or(eqstr(value(n), "Sir"),
545                        eqstr(value(n),"Rev."))) {
546                        value(n) " "
547                  }
548                }
549        }
550        name(i)
551        fornodes (inode(i), n) {
552                if (eqstr(tag(n), "TITL")) {
553                  if(not(or(eqstr(value(n), "Sir"),
554                        eqstr(value(n),"Rev.")))) {
555                        " " value(n)
556                  }
557                }
558        }
559}
560
561/* report all places */
562
563proc allplaces(person, colnum)
564{
565      traverse(inode(person), node, lev) {
566        set(prefix, "")
567        if (eqstr(tag(node),"RESI")) { set(prefix, "r. ") }
568        elsif (eqstr(tag(node),"LIVE")) { set(prefix, "lv. ") }
569        elsif (eqstr(tag(node),"BIRT")) { set(prefix, "b. ") }
570        elsif (eqstr(tag(node),"CHR")) { set(prefix, "bp. ") }
571        elsif (eqstr(tag(node),"DEAT")) { set(prefix, "d. ") }
572        elsif (eqstr(tag(node),"BURI")) { set(prefix, "bur. ") }
573        if(gt(strlen(prefix), 0)) {
574           set(edate,save(long(node)))
575           if (strlen(edate)) {
576               if(gt(colnum, 0)) { col(colnum) }
577               prefix edate nl()
578           }
579        }
580     }
581}
582
583/* report all notes */
584
585proc allnotes(person, colnum)
586{
587        fornodes(inode(person), node) {
588                if (eq(0,strcmp("NOTE", tag(node)))) {
589                        if(gt(colnum, 0)) { col(colnum) }
590                        value(node) nl()
591                        fornodes(node, subnode) {
592                                if (eq(0,strcmp("CONT", tag(subnode)))) {
593                                        if(gt(colnum, 0)) { col(colnum) }
594                                        value(subnode) nl()
595                                }
596                        }
597                }
598        }
599}
600
601/* report aliases */
602
603proc reportalias()
604{
605        print(nl(), "Aliases...")
606        nl() "Alias" col(30) "Key" col(40) "Name" nl() nl()
607
608        /* assume that the set is already sorted. see reportindex() */
609
610        forindiset(aset, indi, ival, inum) {
611          set(count, 0)
612          fornodes(inode(indi), subnode){
613            if(eqstr(tag(subnode), "NAME")){
614              incr(count)
615              if(ge(count, 2)){
616                list(np)
617                extractnames(subnode, np, nc, sc)
618                /* process the surname first */
619                if(sc) {
620                   set(sn, getel(np, sc))
621                   if(eq(strlen(sn), 0)) { "____," }
622                   else { sn "," }
623                }
624                else   { "____," }
625                /* process the rest of the name */
626                forlist(np, v, i) {
627                  if(ne(i, sc)) { " " v }
628                }
629                col(30) key(indi)
630                col(40)
631                surname(indi) ", " givens(indi)
632                nl()
633              }
634            }
635          }
636        }
637}
638
639/* output the parents of a person if it is a simple family where the
640   father and mother have only one family and this is their only
641   child, and their parents are not known.
642 */
643
644proc simplefam(indi, indent)
645{
646        set(findi, father(indi))
647        set(mindi, mother(indi))
648        set(simple, or(ne(findi,0), ne(mindi,0)))
649        if(simple) {
650          if(findi) {
651            if(or(father(findi), mother(findi))) { set(simple,0) }
652            elsif(ne(nfamilies(findi),1)) { set(simple,0) }
653            else {
654              families(findi, fam, sps, fnum) {
655                if(ne(nchildren(fam),1)) { set(simple, 0) }
656              }
657            }
658          }
659        }
660        if(simple) {
661          if(mindi) {
662            if(or(father(mindi), mother(mindi))) { set(simple,0) }
663            elsif(ne(nfamilies(mindi),1)) { set(simple,0) }
664            else {
665              families(mindi, fam, sps, fnum) {
666                if(ne(nchildren(fam),1)) { set(simple, 0) }
667              }
668            }
669          }
670        }
671        if(simple) {
672          nl() "            ["
673          if(male(indi)) { "son of " }
674          else { "daughter of " }
675          if(findi) {
676            call addtoindex(findi, part, gnum)
677            if(allanc) { deletefromset(tset, findi, 1) }
678            call titledname(findi)
679            if(mindi) { nl() "                 and " }
680          }
681          if(mindi) {
682            call addtoindex(mindi, part, gnum)
683            if(allanc) { deletefromset(tset, mindi, 1) }
684            call titledname(mindi)
685          }
686          "]"
687          if(indent) { nl() "       " }
688        }
689}
690
691/* find the generation number for an individual */
692
693func findgen(aindi, down, maxgen, first)
694{
695        list(tilist)
696        indiset(tiset)
697        indiset(tjset)
698
699        enqueue(tilist, aindi)
700        set(gnum, 0)
701        set(tnum, 0)
702        if(eq(first,0)) {
703           while(indi, dequeue(tilist)) {
704            set(tnum, lookup(atable, key(indi)))
705            if(ne(tnum,0)) {
706                  call dumpindi("person", indi, tnum, gnum)
707                  set(tnum, mod(tnum,1000))
708                  break()
709            }
710            set(desc, 0)
711            families(indi, fam, sps,  fnum) {
712                if(sps) {
713                  set(tnum, lookup(atable, key(sps)))
714                  if(ne(tnum,0)) {
715                    call dumpindi("spouse", sps, tnum, gnum)
716                    set(tnum, mod(tnum,1000))
717                    break()
718                  }
719                }
720                if(gt(nchildren(fam),0)) {
721                   children(fam, child, cnum) {
722                        set(tnum, lookup(atable, key(child)))
723                        if(ne(tnum,0)) {
724                          set(gnum, add(gnum, 1))
725                          call dumpindi("child", child, tnum, gnum)
726                          set(tnum, mod(tnum,1000))
727                          break()
728                        }
729                        if(eq(desc,0)) {
730                          addtoset(tiset, child, 0)
731                          set(tjset, intersect(aset, tiset))
732                          deletefromset(tiset, child, 1)
733                          if(ne(lengthset(tjset),0)) {
734                            deletefromset(tjset, child, 1)
735                            set(desc, 1)
736                            enqueue(tilist, child)
737                          }
738                        }
739                   }
740                }
741                if(tnum) { break() }
742            }
743            if (tnum) { break() }
744            set(gnum, add(gnum, 1))
745          }
746        }
747        set(ngen, 0)
748        if(tnum) {
749          if(down) {
750            set(ngen, add(tnum, gnum))
751          }
752          else {
753            set(ngen, sub(tnum, gnum))
754          }
755        }
756        if(down) {
757          set(ogen, maxgen)
758        }
759        else {
760          set(ogen, 1)
761        }
762        if(eq(ngen, 0)) { set(ngen, ogen) }
763        return(ngen)
764}
765
766/* dump a previously referenced individual to show basis of generation
767   number of new line
768 */
769
770proc dumpindi(type, indi, tnum, gnum)
771{
772        nl()
773        "...The generation numbers of the next line are based on " type nl()
774        "   " name(indi)
775        " " d(div(tnum,1000)) "-" d(mod(tnum,1000))
776        " " d(gnum) " generations below" nl()
777}
778