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