reports/ 775 145 13 0 6474160152 5523 reports/least_related 464 1762 0 15432 5574334524 10376 /* least_related - a LifeLines relation computing program by Jim Eggert (eggertj@atc.ll.mit.edu) Version 1, 5 June 1994 This program calculates the pair of individuals in a database that are both related to a seed person, but are least related to each other. Note that the pair is really not unique, but this program only produces one pair. If the database contains mutually unrelated partitions, then only the partition containing the seed person is really used. Each computed relation is composed of the minimal combination of parent (fm), sibling (bsS), child (zdC), and spouse (hw) giving the relational path from the "from" person to the "to" person. Each incremental relationship (or hop) is coded as follows, with the capital letters denoting a person of unknown gender: father f mother m parent P (not used) brother b sister s sibling S son z (sorry) daughtr d child C husband h wife w spouse O (sorry again, but usually not possible) The report gives the steps required to go from the first person to the second person. Thus the printout I93 John JONES fmshwz I95 Fred SMITH means that John Jones' father's mother's sister's husband's wife's son is Fred Smith. Notice in this case, the sister's husband's wife is not the same as the sister, and the husband's wife's son is not the same as the husband's son. Thus in more understandable English, John Jones' paternal grandmother's sister's husband's wife's son from another marriage is Fred Smith. The program will do a trivial parsing of the path string. You can change the language_table to have it print in any language you like. */ global(plist) global(hlist) global(mark) global(keys) global(do_names) global(language) global(language_table) global(token) global(untoken) proc include(person,hops,keypath,path,pathend) { if (person) { set(pkey,key(person)) if (not(lookup(mark,pkey))) { enqueue(plist,save(pkey)) enqueue(hlist,hops) insert(mark,save(pkey),save(concat(path,pathend))) insert(keys,save(pkey),save(concat(concat(keypath,"@"),pkey))) } } } proc get_token(input) { /* Parse a token from the input string. Tokens are separated by one or more "@"s. Set global parameter token to the first token string. Set global parameter untoken to the rest of the string after first token. */ /* strip leading @s */ set(untoken,save(input)) set(first_delim,index(untoken,"@",1)) while (eq(first_delim,1)) { set(untoken,save(substring(untoken,2,strlen(untoken)))) set(first_delim,index(untoken,"@",1)) } /* get token and untoken */ if (not(first_delim)) { set(token,save(untoken)) set(untoken,save("")) } else { set(token,save(substring(untoken,1,sub(first_delim,1)))) set(untoken,save( substring(untoken,add(first_delim,1),strlen(untoken)))) } } proc parse_relation(relation,keypath) { if (not(language)) { " " relation if (do_names) { set(untoken,keypath) call get_token(untoken) while(strlen(untoken)) { call get_token(untoken) " " token " " name(indi(token)) } } " " } else { set(charcounter,1) set(untoken,keypath) call get_token(untoken) while (le(charcounter,strlen(relation))) { lookup(language_table,substring(relation,charcounter,charcounter)) if (do_names) { call get_token(untoken) " " token " " name(indi(token)) } set(charcounter,add(charcounter,1)) } " is " } } proc main () { table(mark) table(keys) list(plist) list(hlist) table(language_table) insert(language_table,"f","'s father") insert(language_table,"m","'s mother") insert(language_table,"P","'s parent") insert(language_table,"b","'s brother") insert(language_table,"s","'s sister") insert(language_table,"S","'s sibling") insert(language_table,"z","'s son") insert(language_table,"d","'s daughter") insert(language_table,"C","'s child") insert(language_table,"h","'s husband") insert(language_table,"w","'s wife") insert(language_table,"O","'s spouse") getintmsg(language, "Enter 0 for brief, 1 for English-language relationships:") getintmsg(do_names, "Enter 0 to omit, 1 to output names of all intervening relatives:") getindimsg(from_person, "Enter seed person:") set(dot,"-") set(iterations,2) while (gt(iterations,0)) { table(mark) table(keys) list(plist) list(hlist) set(iterations,sub(iterations,1)) set(from_key,save(key(from_person))) set(hopcount,0) set(prev_hopcount,neg(1)) call include(from_person,hopcount,"","","") while (pkey,dequeue(plist)) { set(person,indi(pkey)) set(hopcount,dequeue(hlist)) set(path,lookup(mark,pkey)) set(keypath,lookup(keys,pkey)) if (ne(hopcount,prev_hopcount)) { print(dot) set(prev_hopcount,hopcount) } set(hopcount,add(hopcount,1)) call include(father(person),hopcount,keypath,path,"f") call include(mother(person),hopcount,keypath,path,"m") children(parents(person),child,cnum) { if (male(child)) { set(pathend,"b") } elsif (female(child)) { set(pathend,"s") } else { set(pathend,"S") } call include(child,hopcount,keypath,path,pathend) } families(person,fam,spouse,pnum) { if (male(spouse)) { set(pathend,"h") } elsif (female(spouse)) { set(pathend,"w") } else { set(pathend,"O") } call include(spouse,hopcount,keypath,path,pathend) children(fam,child,cnum) { if (male(child)) { set(pathend,"z") } elsif (female(child)) { set(pathend,"d") } else { set(pathend,"C") } call include(child,hopcount,keypath,path,pathend) } } } if (eq(iterations,1)) { set(from_person,person) set(first_key,save(key(person))) print("\n") set(dot,"+") } } "Longest relationship chain is from " first_key " " name(indi(first_key)) " to " set(last_key,save(key(person))) last_key " " name(person) "\n" first_key " " name(indi(first_key)) " " if (path,lookup(mark,last_key)) { call parse_relation(save(path),lookup(keys,last_key)) "\n" } } reports/regvital 464 1762 0 33075 5536713660 7406 /* regvital version 1 by Tom Wetmore version 2 by Cliff Manis version 3 by John Chandler, 1994 This program produces a report of all descendents of a given person, and is presently designed for 12 pitch, HP laserjet III, for printing a book about that person. All NOTE and CONT lines are included in the report, along with the vital statistics, occupations, immigrations, attributes, and wills. At the end of the report is a sorted listing of names of everyone mentioned, with reference numbers giving the first occurrences of all the names. This program has paginated output with a footer and header. This report produces a nroff output, and to produce the output, use: nroff filename > filename.out or: troff -t filename | lpr -t */ global(bold) global(idex) global(srcs) global(curref) global(months) global(dtform) global(footn) global(begnote) global(endnote) proc main () { /* Customize the following: */ set(head,"Family History") set(foot,"your name and address or whatever") set(ll,"8.5i") /* line length for headers */ set(dtform,0) /* date format: 0=dmy, 8=ymd, etc. */ set(footn,1) /* if 1, then do footnote-style sources */ set(fancy,0) /* if 1, then do superscript note refs */ set(bold,0) /* if 1, use boldface for names */ list(months) enqueue(months,"Jan") enqueue(months,"Feb") enqueue(months,"Mar") enqueue(months,"Apr") enqueue(months,"May") enqueue(months,"Jun") enqueue(months,"Jul") enqueue(months,"Aug") enqueue(months,"Sep") enqueue(months,"Oct") enqueue(months,"Nov") enqueue(months,"Dec") if(fancy){ set(begnote,"\\u\\s-2") /* or use left-bracket for ASCII version */ set(endnote,"\\s0\\d") /* or use right-bracket */ } else { set(begnote,"[") set(endnote,"]") } dateformat(dtform) if(or(eq(dtform,0),eq(dtform,8))){dayformat(0) monthformat(4)} elsif(eq(dtform,1)){dayformat(2) monthformat(4)} else{dayformat(1) monthformat(1)} getindi(indi) getintmsg(maxgen,"Enter max generations to include (0 if no limit)") set(maxgen,sub(maxgen,1)) set(tday, gettoday()) ".de hd\n" /* header */ ".ev 1\n" ".sp 2\n" ".tl '" head "''%'\n" ".tl ''" stddate(tday) "''\n" "\n" "'sp 3\n" ".ev\n" "..\n" ".de fo\n" /* footer */ ".ev 1\n" ".sp\n" ".tl '" foot "'''\n" ".sp\n" ".ev\n" "'bp\n" "..\n" ".wh 0 hd\n" ".wh -.8i fo\n" ".de CH\n" /* CHild number macro */ ".sp\n" ".in 14n\n" ".ti 0\n" "\\h'5n'\\h'-\\w'\\\\$1'u'\\\\$1\\h'6n'\\h'-\\w'\\\\$2'u'\\\\$2\\h'2n'\n" "..\n" ".de II\n" /* Index Item macro */ ".br\n" "\\\\$1\\h'-\\w'\\\\$1'u'\\h'35n'" "\\\\$2\\h'-\\w'\\\\$2'u'\\h'13n'" "\\\\$3\\h'-\\w'\\\\$3'u'\\h'13n'" "\\\\$4\n" "..\n" ".de IN\n" /* Individual Number macro */ ".sp\n" ".in 0\n" "..\n" ".de GN\n" /* Generation Number macro */ ".br\n" ".ne 2i\n" ".sp 2\n" ".in 0\n" ".ce\n" "..\n" ".de P\n" /* Paragraph macro */ ".sp\n" ".in 0\n" ".ti 5n\n" /* indent 1st line */ "..\n" ".ev 1\n" ".ll " ll nl() /* line length */ ".ev\n" ".po 9\n" /* left margin */ ".ls 1\n" ".na\n" list(ilist) list(glist) table(stab) indiset(idex) enqueue(ilist,indi) enqueue(glist,1) set(curgen,0) set(out,1) set(in,2) if(footn) {list(srcs)} while (indi,dequeue(ilist)) { print("OUT: ") print(d(out)) print(" ") print(name(indi)) print(nl()) set(thisgen,dequeue(glist)) if (ne(curgen,thisgen)) { if(or(lt(maxgen,0),gt(maxgen,1))){".GN\nGENERATION " d(thisgen) "\n\n"} set(curgen,thisgen) } ".IN\n" d(out) ". " insert(stab,save(key(indi)),out) set(curref,out) call longvitals(indi,curgen) addtoset(idex,indi,curref) set(out,add(out,1)) families(indi,fam,spouse,nfam) { ".P\n" if (spouse) { set(sname, save(name(spouse))) } else { set(sname, "_____") } if(eq(0,strcmp("",sname))) { set(sname, "_____") } if (eq(0,nchildren(fam))) { name(indi) " and " sname " had no children.\n" } elsif (and(spouse,lookup(stab,key(spouse)))) { "Children of " name(indi) " and " sname " are shown " "under " sname " (" d(lookup(stab,key(spouse))) ").\n" } else { "Children of " name(indi) " and " sname ":\n" children(fam,child,nchl) { set(haschild,0) families(child,cfam,cspou,ncf) { if (ne(0,nchildren(cfam))) { set(haschild,1) } } if(and(haschild,or(gt(maxgen,curgen),lt(maxgen,0)))) { print("IN: ") print(d(in)) print(" ") print(name(child)) print(nl()) enqueue(ilist,child) enqueue(glist,add(1,curgen)) ".CH " d(in) " " roman(nchl) nl() set (in, add (in, 1)) call shortvitals(child) } else { ".CH " qt() qt() " " roman(nchl) nl() call longvitals(child,0) addtoset(idex,child,curref) } } } } } if(and(footn,length(srcs))){ "\n.in 0\n.sp 2\n---------------\n.sp\nSources of information:\n" forlist(srcs,s,n){ if(gt(n,1)){";\n"} "[" d(n) "] " s } ".\n" } if(or(lt(maxgen,0),gt(maxgen,1))){ print("begin sorting\n") namesort(idex) print("done sorting\n") ".bp\n" ".in 0\n" "Index of Persons in this Report (first occurrence)\n\n" ".II Name Birth Death #\n\n" forindiset(idex,indi,v,n) { ".II " qt()fullname(indi,1,0,30)qt() " " qt()stddate(birth(indi))qt() " " qt()stddate(death(indi))qt() " " d(v) nl() print(".") } nl() print(nl()) }} proc shortvitals(indi){ name(indi) set(b,birth(indi)) set(d,death(indi)) if (and(b,short(b))) { ", b. " short(b) } if (and(d,short(d))) { ", d. " short(d) } nl() } proc longvitals(i,flag){ /* all data and notes for individual */ if(not(footn)) {list(srcs)} if (bold) { "\\f3" } name(i) if (bold) { "\\f1" } set(e,birth(i)) if(and(e,long(e))) { ",\nborn " call displong(e) } if(not(and(e,place(e)))) { set(e,baptism(i)) if(and(e,long(e))) { ",\nbaptized " call displong(e) } } if(eq(flag,1)) { call printparents(i) } ".\n" set(e,death(i)) if(and(e,long(e))) { "Died " call displong(e) ".\n" } if(not(and(e,place(e)))) { set(e,burial(i)) if(and(e,long(e))) {"Buried " call displong(e) ".\n"} } if (eq(1,nspouses(i))) { spouses(i,s,f,n) { if(e,marriage(f)) { "Married" } else { /* "Lived with " */ "Married" } set(nocomma,1) call spousevitals(s,f) } } else { set(j,1) spouses(i,s,f,n) { if(e,marriage(f)) { "Married " ord(j) "," set(j,add(j,1)) } else { "Married" } call spousevitals(s,f) } } fornodes(inode(i), node) { set(ntag, save(tag(node))) if (eq(0,strcmp("FILE", ntag))) { copyfile(value(node)) } elsif (eq(0,strcmp("NOTE", ntag))) { value(node) fornodes(node, subnode) { if (eq(0,strcmp("CONT", tag(subnode)))) { nl() value(subnode) } } call setsrc(node) nl() } elsif (eq(0,strcmp("OCCU", ntag))) { "Occupation: " value(node) call setsrc(node) ".\n" } elsif (eq(0,strcmp("ATTR", ntag))) { "Attributes: " value(node) call setsrc(node) ".\n" } elsif (eq(0,strcmp("IMMI", ntag))) { if(long(node)) { "Immigrated " call displong(node) fornodes(node, subnode) { if(eq(0,strcmp("NOTE",tag(subnode)))) { ",\n" value(subnode) } } ".\n" } } elsif (eq(0,strcmp("WILL", ntag))) { if(long(node)) { "Made a will " call displong(node) ".\n" } } elsif (eq(0,strcmp("PROB", ntag))) { if(long(node)) { "Will proved " call displong(node) ".\n" } } } if(and(not(footn),length(srcs))){ "\nSources of information:\n" forlist(srcs,s,n){ if(gt(n,1)){";\n"} s } ".\n" }} proc displong(e) { /* display full date, place, and age for an event */ /* long(e) */ extractdate(e,da,mo,yr) if(mod,date(e)){ if(or(da,or(mo,yr))){ set(mod,trim(mod,3)) if(eq(0,strcmp(mod,"ABT"))) {"about "} elsif(eq(0,strcmp(mod,"abo"))) {"about "} elsif(eq(0,strcmp(mod,"AFT"))) {"after "} elsif(eq(0,strcmp(mod,"aft"))) {"after "} elsif(eq(0,strcmp(mod,"BEF"))) {"before "} elsif(eq(0,strcmp(mod,"bef"))) {"before "} elsif(eq(0,strcmp(mod,"BET"))) {"beginning "} if(or(eq(1,dtform),le(8,dtform))){ if(yr){ d(yr) if(mo){" "}} if(mo){ getel(months,mo) if(da){" "d(da)}} } else{ if(da){ d(da) if(mo){" "}} if(mo){ getel(months,mo) if(yr){" "}} if(yr){d(yr)} } } else { mod } if(place(e)){ ", "} } if(mod,place(e)) { mod } fornodes(e,subnode) { if(eq(0,strcmp("AGE",tag(subnode)))) { ",\naged " value(subnode) } } call setsrc(e) } proc setsrc(node) { /* collect source reference, if any */ fornodes(node,subnode){ if(eq(0,strcmp("SOUR",tag(subnode)))){ if(n,length(srcs)){ set(i,0) while(lt(i,n)){ set(i,add(i,1)) if(eq(0,strcmp(getel(srcs,i),value(subnode)))){ set(n,i) set(skip,1) } } } if(not(skip)){ enqueue(srcs,save(value(subnode))) set(i,add(n,1)) } if(footn){ if(not(started)){begnote set(started,1)} else{","} d(i)} } } if(started){endnote} } proc spousevitals (sp,fam) { list(names) addtoset(idex,sp,curref) set(e,marriage(fam)) if (and(e,long(e))) { nl() call displong(e) "," } "\n" if (bold) { "\\f3" } if(strcmp("",name(sp))) {name(sp)} else {"_____"} if (bold) { "\\f1" } if(e){ fornodes(e,subnode) { if(eq(0,strcmp("NAME",tag(subnode)))){ extractnames(subnode,names,n,s) if(s) {"\n(under the name " getel(names,s) ")"} } } } set(e,birth(sp)) if(and(e,long(e))) { ",\nborn " call displong(e) } set(e,death(sp)) if(and(e,long(e))) { ",\ndied " call displong(e) } call printparents(sp) } proc printparents(ind) { /* print only if non-blank */ if(dad,father(ind)) {if(ndad,name(dad)) {set(nbld,strcmp("",ndad))}} if(mom,mother(ind)) {if(nmom,name(mom)) {set(nblm,strcmp("",nmom))}} if (or(nbld,nblm)) { ",\n" if (male(ind)) { "son of " } elsif (female(ind)) { "daughter of " } else { "child of " } } if (nbld) { name(dad) } if (and(nbld,nblm)) { "\nand " } if (nblm) { name(mom) } ".\n" if (nbld) { addtoset(idex,dad,curref) } if (nblm) { addtoset(idex,mom,curref) } } /* Sample printout of the report, plus also prints a names index. Manes - Manis - Maness Family History 14 Jan 1993 GENERATION 1 1. William Bowers MANES, born 6 Jan 1868, Hamblen Co, TN ?, died 5 May 1933, Sevier Co, TN. Married 13 Apr 1892, White Pine, TN, Cordelia "Corda" F. CANTER, born 7 Dec 1869, Jonesboro, Washington Co, TN, died 18 Apr 1960, Knoxville, Knox Co, TN, daughter of James H. CANTER and Martha Marie WHITEHORN. He died of pneumonia at his homeplace in Union Valley, Sevier Co, TN He was buried at the Knob Creek Baptist Church cemetery in Sevier County, TN. Children of William Bowers MANES and Cordelia "Corda" F. CANTER: 2 i Nellie V. MANES, b. 1893, TN, d. 1984, TN ii Emery H. MANES, born 24 Oct 1894, White Pine, Jefferson Co, TN, died 26 Jul 1926, Knob Creek, Sevier Co., TN. Died in auto accident, when he and a brother were going in his truck with a load of vegetables, and going to market in Knoxville. He is buried at Knob Creek Cem. Sevier Co, TN. 3 iii Walter C. MANES, b. 1896, TN, d. 1989, TN 4 iv William Lee MANES, b. 1897, TN, d. 1969, TN v George MANES, born 29 Oct 1898, Union Valley, Sevier Co, TN, died 17 Jun 1899, Knob Creek, Sevier Co, TN. Single, died as a infant, and is buried at Knob Creek Cem, Sevier Co, TN. 5 vi Fuller Ruben MANES, b. 1902, TN, d. 1980, TN 6 vii Mabel E. MANES, b. 1905, TN 7 viii Lena G. MANES, b. 1906, TN, d. 1987, TN 8 ix Wade Preston MANES, b. 1910, TN 9 x Newman Clarence MANES, b. 1912, TN //end of sample// */ ll printparents(i) } ".\n" set(e,death(i)) if(and(e,long(e))) { "Died " call displong(e) ".\n" } if(not(and(e,place(e)))) { set(e,burial(i)) if(and(e,long(e))) {"Buried " call displong(e) ".\n"} } if (eq(1,nspouses(i))) { spouses(i,s,f,n) { if(e,marriage(f)) { "Married" } else { /* "Lived with " */ "Married" reports/ps-pedigree/ 775 145 13 0 5727023175 7732 reports/ps-pedigree/ps-pedigree 664 145 13 45723 5516662206 12201 /* * ps-pedigree * * This report generates Multiple linked Pedigree Charts * Each chart is 7 or 8 generations and as a line moves off * a chart the new chart number is referenced. The output * of this report is a POSTSCRIPT file. The text size is very * small but readable (it seams less readable as I age!) on * 8.5x11 paper with 8 generations and larger but somewhat * compressed at 7 generations per chart. And an index of all * persons on the charts is also created. * * Code by Stephen Woodbridge, sew@pcbu.prime.com * Copyright 1992 by Stephen Woodbridge * * This report works only with the LifeLines Genealogy program * * Version one of this report was written in XLISP and this is a * direct translation of that Lisp code. * * --- Version control info --- * * 10/22/92 - First Release 1.0.0 * 10/28/92 - changed box width to expand the text font * added CENTER_LAST global to center names in last boxes * 11/05/92 - Release 1.1.0 Added name sorted index and misc. other * features and enhancements. * * --- Comments about the program --- * * There are lots of global flags that control whether or not aspects * of the output are generated. These are set in "init_globals" and * the comments there will explain them. The title string for the * index is also set here. The program will also generate an index of * just the people in the pedigree OR all people in the database. This * is controlled by the flag INDEX_ALL. * * All global are in capitals. Global constants are set in * init_globals and are not changed as the program runs. The global * variables are used throughout the execution. * There is a global TRACE which will print most proc names as they * are executed. This is helpful in tracking down SEGV crashes. There * is a global LIST which will print the name of each person or a "." * as it is processed. The enqueueing of people to be processed is * done in plot_me. * * You can adjust the margins on the paper. This has the effect of * pushing the plot off the top/bottom/left/right. See M_TOP/M_BOT/ * M_LEFT/M_RIGHT in init_globals. The current setting leaves a * margin at the top for three-hole punching or binding. * * --- Comments about the PostScript output --- * * You can change the paper size without regenerating the output. * The plot will scale to fit the paper. A ledger size paper makes * the plots much easier to read. This can be done by editing line * 66 in the output file. Just above this line are definitions for * "a-size","a4-size" and "b4-size" paper. You can add your own paper * sizes and reference them on line 66. * * Changing the small text font size will not nessasarily change the * output on the paper because I compute an x and y scale factor the * forces the chart into the bounds of the paper. Feel free to * experiment and let me know if you get a good combination. * */ /* global variables */ global(RVAL) /* stack used to return values from procs */ global(ILIST) /* indi's to be done in next depth of charts */ global(NLIST) /* chart num of indi's above */ global(WHICH_CHART) /* table xrefs of indi to chart number */ global(FROM_CHART) global(INDXSET) global(CHART_NO) global(CURRENT_CHART_NO) global(PAGE) /* postscript page number being outputed */ global(PAGE_INDX) /* global constants */ global(M_BOT) global(M_LEFT) global(M_RIGHT) global(M_TOP) global(LF_HGT) global(LF_WDT) global(SF_HGT) global(SF_WDT) global(BOX_H) global(BOX_DH) global(BOX_NC_1) global(BOX_NC_2) global(BOX_W) global(BOX_WW) global(BOX_SP) global(BOX_DW) global(CHART_PREFIX) global(LEN_CHART_PREFIX) global(TEXT_HGT) global(TEXT_WDT) global(INDEX_SIZE) global(INDEX_LPP) global(HEADER_SIZE) global(LINE_COUNT) global(PLOT_INUMS) global(PLOT_DATE) global(CENTER_LAST) global(INDEX_ALL) global(TITLE) global(TRACE) global(LIST) global(PS_HDR_FILE) /* *--------------------------------------------------------* */ proc main () { set(TRACE, 0) /* trace proc calling sequence to trace down SEGV: signal 11 crashes */ set(LIST, 0) /* list names as they are processed */ call init_globals() list(RVAL) list(ILIST) list(NLIST) table(WHICH_CHART) table(FROM_CHART) indiset(INDXSET) getindi(me) /* * The program can make 3 thru n generation charts * but only the 7 and 8 have good aspect ratios that * make them usable. */ getintmsg(max, "Enter max generations per chart [7 or 8]") if (or( eq(max, 7), eq(max, 8))) { getintmsg(dmax, "Enter max depth of charts:") enqueue(ILIST, me) enqueue(NLIST, 1) call plot_init(max, TITLE) set(i, 1) while(le(i, dmax)) { set (jlist, ILIST) set (mlist, NLIST) list(ILIST) list(NLIST) while (me, dequeue (jlist)) { set(cno, dequeue(mlist)) set(CURRENT_CHART_NO, cno) call new_plot_page(cno) call do_ancestors(me, 1, 0, max) call title_chart(cno, me, max) } set(i, add(i, 1)) } call plot_fini() call do_index() call index_fini() } } proc init_globals() { /* initialize global constants */ /* Paper margins for output in points */ set(M_TOP, 27) /* 0.375in*72points/in */ set(M_BOT, 0) set(M_LEFT, 0) set(M_RIGHT, 0) /* Large and small font sizes in points */ set(LF_HGT, 18) set(LF_WDT, 12) set(SF_HGT, 5) set(SF_WDT, 4) /* Size of text in boxes */ set(TEXT_HGT, SF_HGT) set(TEXT_WDT, SF_WDT) /* height of box and vertical spacing */ set(BOX_H, add(1, TEXT_HGT)) set(BOX_DH, add(1, BOX_H)) /* width of boxes in number of characters */ set(BOX_NC_1, 42) set(BOX_NC_2, 30) /* width of boxes and horizontal spacing */ set(BOX_W, mul(BOX_NC_2, TEXT_WDT)) set(BOX_WW, mul(BOX_NC_1, TEXT_WDT)) set(BOX_SP, div( mul(BOX_W, 3), 20)) /* BOX_W*0.15 */ set(BOX_DW, add(BOX_W, BOX_SP)) /* controls for the index */ set(INDEX_SIZE, 8) set(INDEX_LPP, 80) set(HEADER_SIZE, 10) /* controls for what and how the charts appear */ set(CHART_PREFIX, "") /* if CHART_PREFIX=0 then don't number charts */ set(LEN_CHART_PREFIX, 0) set(PLOT_INUMS, 1) /* bool 0=don't plot inums, 1=plot inums */ set(PLOT_DATE, 1) /* bool 0=don't date charts, 1=date charts */ set(CENTER_LAST, 1) /* bool 0=don't center names in last column, 1=center names */ set(INDEX_ALL, 0) /* bool 0=only index names on charts, 1=index all names in database */ /* global variables used to keep track of which chart */ set(CHART_NO, 1) set(CURRENT_CHART_NO, 0) set(PAGE, 0) set(PAGE_INDX, 1) set(PS_HDR_FILE, "ps-pedi.ps") /* PostScript Header file name */ set(TITLE, "Pedigree Index") /* Title string for Index pages */ dayformat(0) monthformat(3) dateformat(0) } proc do_ancestors (me, depth, width, max) { if (TRACE) { print("do_ancestors ") } if (me) { if (LIST) { print(fullname(me,1,0,40)) print(" -") print(key(me)) print(sp()) print(d(depth)) print(sp()) print(d(width)) print(nl()) } else { print(".") } set(my_tag, lookup(WHICH_CHART, key(me))) call plot_me(me, depth, width, max) if ( and( or( eq(1, depth), not(my_tag)), lt(depth, max))) { if (dad, father(me)) { call get_width(1, width) set(nwid, pop(RVAL)) call do_ancestors(dad, add(1, depth), nwid, max) call connect_boxes( me, depth, width, nwid, max) } if (mom, mother(me)) { call get_width(neg(1), width) set(nwid, pop(RVAL)) call do_ancestors(mom, add(1, depth), nwid, max) call connect_boxes( me, depth, width, nwid, max) } } else { call box_org(depth, width, max) call draw_ext(me, pop(RVAL), pop(RVAL), my_tag, eq(depth, max)) } } } proc plot_me (me, depth, width, max) { if (TRACE) { print("plot_me ") } set(last, eq(max, depth)) set(first, eq(1, depth)) set(style, ge(add(1, depth), max)) call box_org(depth, width, max) set(my_x, pop(RVAL)) set(my_y, pop(RVAL)) /* * This if controls whether or not siblings are plotted */ if (first) { call do_sibs(me, my_x, my_y, last) } else { call box_me(me, my_x, my_y, last) } if (not(lookup(WHICH_CHART, key(me)))) { set(ntag, CURRENT_CHART_NO) if (and( last, parents(me))) { set(CHART_NO, add(1, CHART_NO)) set(ntag, CHART_NO) call draw_ext(me, my_x, my_y, ntag, last) enqueue(ILIST, me) enqueue(NLIST, ntag) insert(FROM_CHART, save(d(CHART_NO)), CURRENT_CHART_NO) } insert(WHICH_CHART, save(key(me)), ntag) addtoset(INDXSET, me, ntag) } } proc box_me (me, x, y, last) { if (TRACE) { print("box_me ") } call get_dates(me) call print_name(me, 0) if (PLOT_INUMS) { set(num, save(concat("-", key(me)))) } else { set(num, "") } call draw_box_text(x, y, pop(RVAL), pop(RVAL), num, last) } proc do_sibs (me, x, y, last) { if (TRACE) { print("do_sibs ") } set(nkids, nchildren(parents(me))) set(bdh, mul(2, BOX_DH)) set(sy, div(mul(sub(nkids, 1), bdh), 2)) children( parents(me), child, nchild) { set(yy, add(y, sy)) call box_me(child, x, yy, last) set(sy, sub(sy, bdh)) } } proc do_index() { if (TRACE) { print("do_index ") } print(nl()) print("Collecting Index ...") if (INDEX_ALL) { forindi(me, num) { if (not(lookup(WHICH_CHART, key(me)))) { addtoset(INDXSET, me, 0) } } } print(nl()) print("Sorting Index ...") namesort(INDXSET) print(nl()) print("Outputing Index ") forindiset(INDXSET, me, chart, num) { call index_out(me, chart) print(".") } } /* * -------- Postscript output routines --------- */ proc plot_init (max, title) { if (TRACE) { print("plot_init ") } set(PAGE, 0) copyfile(PS_HDR_FILE) call expt(2, sub(max, 2)) set(h, mul( add( pop(RVAL), 1), mul(2, BOX_DH))) set(w, div( mul( add(max, 1), BOX_W), 2)) set(w, add(w, add( mul(max, BOX_SP), BOX_WW))) if (CHART_PREFIX) { set(w, add(w, mul( add(LEN_CHART_PREFIX, 3), TEXT_WDT))) } "%%BeginSetup" nl() "/pointsize " d(INDEX_SIZE) " def" nl() "/headerpointsize "d(HEADER_SIZE) " def" nl() "/filename (" title ") def" nl() "/noheader false def" nl() "/date (" date(gettoday()) ") def" nl() "/nc-1 " d(BOX_NC_1) " def" nl() "/nc-2 " d(BOX_NC_2) " def" nl() "/margin-l " d(M_LEFT) " def" nl() "/margin-r " d(M_RIGHT) " def" nl() "/margin-t " d(M_TOP) " def" nl() "/margin-b " d(M_BOT) " def" nl() "/width-needed " d(w) " def" nl() "/height-needed " d(h) " def" nl() "/text-wdt " d(TEXT_WDT) " def" nl() "/text-hgt " d(TEXT_HGT) " def" nl() "setup" nl() "/newpagesetup save def" nl() "mark" nl() "%%EndSetup" nl() set(LINE_COUNT, 0) } proc new_plot_page (page_no) { if (TRACE) { print("new_plot_page ") } set(PAGE, add(1, PAGE)) "%%Page: " d(page_no) " " d(PAGE) nl() "mark plotpagesetup" nl() } proc plot_fini () { set(PAGE, add(1, PAGE)) } proc draw_box_text (x, y, name, date, num, last) { if (TRACE) { print("draw_box_text ") } if (last) { "(" name " " date " " num ") " if(CENTER_LAST) { set(t, " ct1") } else { set(t, " t1")} } else { "(" name " " num ") (" date ") " set(t, " t2") } d(x) " " d(y) t nl() } proc draw_ext (me, x, y, chartno, last) { if (TRACE) { print("draw_ext ") } if (parents(me)) { if (last) { set(bw, div(BOX_WW, 2)) } else { set(bw, div(BOX_W, 2)) } "np " d(add(x, bw)) " " d(y) " mto " d(div(BOX_SP, 3)) " 0 rlto drw" nl() if (and( chartno, CHART_PREFIX)) { d( add(x, add(bw, add(TEXT_WDT, div(BOX_SP, 3))))) " " d( sub(y, div(TEXT_HGT, 2))) " mto (" CHART_PREFIX d(chartno) ") show" nl() } } } proc connect_boxes (me, depth, width1, width2, max) { if (TRACE) { print("connect_boxes ") } call box_org(depth, width1, max) set(x1, pop(RVAL)) set(y1, pop(RVAL)) call box_org(add(1, depth), width2, max) set(x2, pop(RVAL)) set(y2, pop(RVAL)) set(dx, div( add(x1, x2), 2)) set(w2, div(BOX_W, 2)) set(w3, div(BOX_WW, 2)) set(dh, 0) set(dw, w2) set(rad, BOX_H) set(style, 0) if (eq(depth, 1)) { set(nkids, nchildren(parents(me))) set(sy, div( mul( sub(nkids, 1), mul(2, BOX_DH)), 2)) if (gt(width2, 0)) { set(y1, add(y1, sy)) } else { set(y1, sub(y1, sy)) } } if (lt(y1, y2)) { set(dh, BOX_H) } else { set(dh, neg(BOX_H)) } if (eq( sub(max, depth), 1)) { set(dw, w3) set(style, 1) set(rad, div(rad, 2)) set(dx, div( sub( add(x1, add(w2, x2)), w3), 2)) } elsif( eq( sub(max, depth), 2)) { set(dw, w2) set(style, 1) } if (style) { d(div(rad, 2)) " gr np " d(add(x1, w2)) " " d(y1) " mto " d(dx) " " d(y1) " " d(dx) " " d(y2) " pto " d(sub(x2, dw)) " " d(y2) " pto lto drw" nl() } else { d(rad) " gr np " d(x1) " " d(add(y1, dh)) " mto " d(x1) " " d(y2) " " d(sub(x2, w2)) " " d(y2) " pto lto drw" nl() } } proc title_chart (chart_no, me, max) { if (TRACE) { print("title_chart ") } if (gt( sub(max, 2), 0)) { set(x, 0) call expt(2, sub(max, 2)) set(y, mul( add( pop(RVAL), 1), mul(2, BOX_DH))) set(w, div( mul( add(max, 1), BOX_W), 2)) set(w, add(w, add( mul(max, BOX_SP), BOX_WW))) if (CHART_PREFIX) { set(w, add(w, mul( add(4, LEN_CHART_PREFIX), TEXT_WDT))) } d(y) " " d(w) " " d(x) " 0 mbox 18 1 rbox" nl() if (PLOT_DATE) { d(add(x, LF_WDT)) " 1.2 mul " d(div(SF_HGT,2)) " mto (" date(gettoday()) ") show" nl() } d(LF_WDT) " " d(LF_HGT) " mfont" nl() call get_dates(me) call print_name(me, 1) d(add(x, mul(2, LF_WDT))) " " d(sub(y, add(LF_HGT, div(LF_HGT, 2)))) " mto (" pop(RVAL) ") show" nl() d(add(x, mul(2, LF_WDT))) " " d(sub(y, add( mul(LF_HGT, 2), div(LF_HGT,2)))) " mto (" pop(RVAL) ") show" nl() if (CHART_PREFIX) { d(add(x, LF_WDT)) " " d(div(LF_HGT,2)) " mto (Chart: " CHART_PREFIX d(chart_no) if (e, lookup(FROM_CHART, d(chart_no))) { " From: " d(e) } ") show" nl() } "cleartomark showpage" nl() "%%EndPage: " d(PAGE) " " d(PAGE) nl() } } /* * -------- Postscript output routines for index --------- */ proc index_fini() { if (TRACE) { print("index_fini ") } "cleartomark showpage" nl() "%%EndPage: " d(PAGE) " " d(PAGE) nl() "%%Trailer" nl() "%%Pages: " d(PAGE) nl() } proc index_out (me, chart) { if (TRACE) { print("index_out ") } set(blanks, " ") if (not(mod(LINE_COUNT, INDEX_LPP))) { "%%Page: " d(PAGE) " " d(PAGE) nl() "mark indexpagesetup " d(PAGE_INDX) " pagesetup" nl() } "(" if (chart) { call rjt(chart, 5) pop(RVAL) } else { " " } " " trim( save( concat( key(me)," ")), 6) call get_dates(me) call print_name(me, 1) " " trim( save( concat(pop(RVAL),blanks)), 50) " " sex(me) " " pop(RVAL) ")l" nl() set(LINE_COUNT, add(LINE_COUNT,1)) if (not(mod(LINE_COUNT, INDEX_LPP))) { "cleartomark showpage" nl() "%%EndPage: " d(PAGE) " " d(PAGE) nl() set(PAGE, add(PAGE, 1)) set(PAGE_INDX, add(PAGE_INDX, 1)) set(LINE_COUNT, 0) } } /* * -------- Utility routines --------- */ proc print_name (me, last) { if (TRACE) { print("print_name ") } call get_title(me) push(RVAL, save(concat(fullname(me, 1, not(last), 45), pop(RVAL)))) } proc get_title (me) { if (TRACE) { print("get_title ") } fornodes(inode(me), node) { if (not(strcmp("TITL", tag(node)))) { set(n, node) } } if (n) { push(RVAL, save(concat(" ", value(n)))) } else { push(RVAL, "") } } proc get_dates (me) { if (TRACE) { print("get_dates ") } if (e, birth(me)) { set(b, save(concat("( ", date(e)))) } else { set(b, "( ") } if (e, death(me)) { set(d, save(concat(" - " , date(e)))) } else { set(d, " - ") } push(RVAL, save(concat(b, concat(d, " )")))) } proc box_org (depth, width, max) { if (TRACE) { print("box_org ") } set(xx, div( mul(BOX_W, 9), 16)) call expt(2, sub(max, 2)) set(yy, mul( add( pop(RVAL), 1), BOX_DH)) if ( eq(depth, 1)) { push(RVAL, yy) push(RVAL, xx) } else { call expt(2, sub(max, depth)) set(dy, mul( pop(RVAL), BOX_DH)) call abs(width) set(y, sub( mul(pop(RVAL), dy), div(dy, 2))) set(dx, add(BOX_SP, div(BOX_W, 2))) set(dd, sub( sub(max, 2), depth)) set(x, 0) if ( eq(dd, neg(1))) { set(dxx, div(BOX_W, 2)) } elsif (eq(dd, neg(2))) { set(dxx, add( div(BOX_W, 2), div(BOX_WW, 2))) } else { set(dxx, 0) } set(x, add(dxx, add(xx, mul(dx, sub(depth, 1))))) if ( lt(width, 0)) { set(y, neg(y)) } push(RVAL, add(yy, y)) push(RVAL, x) } } proc get_width (sign, width) { if (TRACE) { print("get_width ") } if (eq(width, 0)) { push(RVAL, sign) } else { call abs(width) set(awidth, pop(RVAL)) set(s2, div(width, awidth)) if (eq(s2, sign)) { push(RVAL, mul(width, 2)) } else { push(RVAL, mul( sub( mul(awidth, 2), 1), s2)) } } } proc abs (int) { if (TRACE) { print("abs ") } if (lt(int, 0)) { push(RVAL, neg(int)) } else { push(RVAL, int) } } proc rjt(n, w) { if (lt(n, 10)) { set(d, 1) } elsif (lt(n, 100)) { set(d, 2) } elsif (lt(n, 1000)) { set(d, 3) } elsif (lt(n, 10000)) { set(d, 4) } else { set(d, 5) } if (lt(d, w)) { set(pad, save( trim(" ", sub(w, d)))) } else { set(pad, "") } push(RVAL, save( concat(pad, save(d(n))))) } proc expt(x, y) { if (TRACE) { print("expt ") } if (le(y, 0)) { set(result, 1) } else { set(result, x) while (y, sub(y,1)) { set(result, mul(result, x)) } } push(RVAL, result) } ate (" date(gettoday()) ") def" nl() "/nreports/ps-pedigree/ps-pedi.ps 664 145 13 21556 5516662205 11754 %!PS-Adobe-1.0 %%Creater: ps-pedigree %%Title: Ancestry Charts %%Pages: (atend) %%DocumentFonts: Helvetica Courier Courier-Bold %%EndComments /#findfont /findfont load def /findfont { dup #findfont dup /Encoding get 8#340 get /.notdef eq { 12 dict begin /newcodesandnames [ 8#200 /aacute 8#335 /acircumflex 8#336 /adieresis 8#337 /agrave 8#202 /atilde 8#201 /aring 8#340 /ccedilla 8#342 /eacute 8#344 /ecircumflex 8#345 /edieresis 8#346 /egrave 8#203 /iacute 8#347 /icircumflex 8#354 /idieresis 8#204 /igrave 8#205 /ntilde 8#206 /oacute 8#355 /ocircumflex 8#356 /odieresis 8#207 /ograve 8#210 /otilde 8#211 /scaron 8#212 /uacute 8#357 /ucircumflex 8#360 /udieresis 8#362 /ugrave 8#213 /ydieresis 8#214 /zcaron 8#215 /Aacute 8#300 /Acircumflex 8#311 /Adieresis 8#314 /Agrave 8#217 /Atilde 8#216 /Aring 8#321 /Ccedilla 8#322 /Eacute 8#323 /Ecircumflex 8#324 /Edieresis 8#325 /Egrave 8#220 /Iacute 8#326 /Icircumflex 8#327 /Idieresis 8#221 /Igrave 8#222 /Ntilde 8#223 /Oacute 8#330 /Ocircumflex 8#331 /Odieresis 8#224 /Ograve 8#225 /Otilde 8#226 /Scaron 8#227 /Uacute 8#332 /Ucircumflex 8#333 /Udieresis 8#334 /Ugrave 8#230 /Ydieresis 8#231 /Zcaron ] def /basefontdict exch def /newfontname exch def /newfont basefontdict maxlength dict def basefontdict { exch dup /FID ne { dup /Encoding eq { exch 256 array copy } { exch } ifelse newfont 3 1 roll put } { pop pop } ifelse } forall newfont /FontName newfontname put newcodesandnames aload pop newcodesandnames length 2 idiv { newfont /Encoding get 3 1 roll put } repeat newfontname newfont definefont end } { exch pop } ifelse } def /headerpointsize 10 def /font /Courier def /pointsize 10 def /Linespace {/Linespace pointsize 1.1 mul neg dup 3 1 roll def } def /margin 10 def /xoffset .35 def /yoffset -0.30 def /def_yoffset yoffset def /def_xoffset xoffset def /def_pointsize pointsize def /roundpage true def /useclippath true def /pagebbox [0 0 612 792] def /inch {72 mul} bind def /mm {2.8453 mul} bind def /point {72 div} bind def /min {2 copy gt {exch} if pop} bind def /max {2 copy lt {exch} if pop} bind def /rectpath {4 2 roll moveto dup 0 exch rlineto exch 0 rlineto neg 0 exch rlineto closepath } def /a-size {8.5 inch 11 inch} bind def /a4-size {210 mm 297 mm} bind def /b4-size {10.125 inch 14.2 inch} bind def /paper {/paper-x exch def /paper-y exch def} bind def a-size paper /mfont % w h mfont {/fh exch def /fw exch def /Helvetica findfont [fw 0 0 fh 0 0] makefont setfont c-bs-1 c-bs-2 } def /c-bs-1 % calculate box size from current fh fw {[fh 1 add fw nc-1 mul] cvx /box-size-1 exch def} def /c-bs-2 % calculate box size from current fh fw {[fh 2 mul 1 add fw nc-2 mul] cvx /box-size-2 exch def} def /box-it % x y h w box-it {2 copy 6 2 roll box-org box} def /center-up % x y string center-up { dup stringwidth pop % x y string w 3 -1 roll 1 add % x string w y exch 2 div % x string y (w/2) 4 -1 roll exch sub % string y (x-w/2) exch moveto show } def /center-dn % x y string center-dn { dup stringwidth pop % x y string w 3 -1 roll fh sub % x string w (y-fsize) 1 add exch 2 div % x string (y-fsize) (w/2) 4 -1 roll exch sub % string (y-fsize) (x-w/2) exch moveto show } def /bbox % h w x y box % where x y is lower left corner {newpath moveto % h w dup 0 rlineto % h w exch 0 exch rlineto % w neg 0 rlineto closepath 0.3 setlinewidth stroke} def /box % h w x y box % where x y is lower left corner {newpath moveto % h w dup 0 rlineto % h w exch 0 exch rlineto % w neg 0 rlineto closepath 0.1 setlinewidth stroke} def /rbox % [x1 y1 x2 y2 x3 y3 x4 y4] r w rbox {/w exch def /r exch def /a exch def a 0 2 da1 r add newpath moveto a 2 4 da a 4 4 da a 6 2 da1 a 0 2 da a 0 4 da closepath w setlinewidth stroke} def /mbox % h w x y mbox => [x1 y1 x2 y2 x3 y3 x4 y4] {2 copy % h w x y x y 5 index add 2 copy % h w x1 y1 x2 y2 x2 y2 exch 6 index add exch % h w x1 y1 x2 y2 x3 y3 2 copy 9 index sub % h w x1 y1 x2 y2 x3 y3 x4 y4 8 array astore 3 1 roll pop pop} def /box-org % x y h w box-org {2 div % x y h (w/2) exch 2 div exch % x y (h/2) (w/2) 4 -1 roll exch sub % y (h/2) (x-w/2) 3 1 roll sub % (x-w/2) (y-h/2) } def /t2 % text1 text2 x y { 2 copy % text1 text2 x y x y box-size-2 box-it % text1 text2 x y 2 copy 6 -1 roll % text2 x y x y text1 center-up % text2 x y 3 -1 roll % x y text2 center-dn } def /t1 % text x y { 2 copy % text x y x y box-size-1 box-it % text x y box-size-1 box-org exch fw add exch 1 add % text (xorg+fw) yorg moveto show } def /ct1 % text x y { 2 copy box-size-1 box-it % text x y 3 -1 roll % x y text dup stringwidth pop % x y text w 2 div % x y text (w/2) 4 -1 roll exch sub % y text (x-w/2) 3 -1 roll fh 1 sub 2 div sub % text (x-w/2) (y-(fh+1)/2) moveto show } def /da2 { r arcto 4 {pop} repeat} def /da1 {getinterval aload pop} def /da {da1 da2} def /gr {/r exch def} def /pto {2 copy 6 2 roll da2} def /np {newpath} def /mto {moveto} def /rmto {rmoveto} def /lto {lineto} def /rlto {rlineto} def /drw {0.1 setlinewidth stroke} def /plotpagesetup { newpagesetup restore /newpagesetup save def 90 rotate 12 12 translate margin-l paper-y neg margin-b add translate paper-x margin-l margin-r 36 add add sub width-needed div paper-y margin-t margin-b 18 add add sub height-needed div scale text-wdt text-hgt mfont } def /setup { /linespace pointsize pointsize .10 mul add neg def /headerspace headerpointsize headerpointsize .10 mul add 2 linespace mul sub neg def font findfont pointsize scalefont setfont pagedimensions /standard_height 80 def_pointsize def_pointsize .10 mul add mul yoffset inch sub margin 2 div add def /rel_height height def /rel_width 7.5 inch def rel_height standard_height lt { /yoffset yoffset def_yoffset sub margin point 2 div add def }if width rel_width lt { /xoffset xoffset def_xoffset sub margin point 2 div sub def }if } def /indexpagesetup { newpagesetup restore /newpagesetup save def xcenter ycenter translate width 2 div neg height 2 div translate xoffset inch yoffset inch translate margin 2 div dup neg translate 0 headerspace translate } def /pagedimensions { useclippath userdict /gotpagebbox known not and { /pagebbox [clippath pathbbox newpath] def roundpage currentdict /roundpagebbox known and {roundpagebbox} if } if pagebbox aload pop .5 sub 4 -1 roll exch 4 1 roll 4 copy sub /width exch def sub /height exch def add 2 div /xcenter exch def add 2 div /ycenter exch def userdict /gotpagebbox true put } def /page_num_len { % count number of digits of the current page number /digits 1 def /tens 10 def { page tens lt { exit } { /digits digits 1 add def /tens tens 10 mul def } ifelse } loop } def /page_num { % convert page to a string page_num_len page digits string cvs } def /printpage { % stk:int (right justified from this "int" value) page_num stringwidth pop % get length of string sub % calculate white space 0 rmoveto page_num % move over to the right that much 0 setgray show } def /show_simpleheader { currentdict /headerfont known {headerfont findfont headerpointsize scalefont setfont} {/Courier-Bold findfont headerpointsize scalefont setfont} ifelse currentdict /date known { 0 0 moveto date 0 setgray show } if currentdict /filename known { 0 0 moveto filename stringwidth pop 2 div width xoffset inch .5 inch add sub 2 div exch sub 0 rmoveto filename 0 setgray show } if 0 0 moveto width xoffset inch .75 inch add sub printpage } def /pagesetup { /page exch def gsave 0 headerpointsize .10 mul 2 linespace mul sub translate show_simpleheader grestore 0 0 moveto 0 } bind def /l {show Linespace add dup 0 exch moveto} bind def %%EndProlog show } def /bbox % h w x y box % where x y is lower left corner {newpath moveto % h w dup 0 rlineto % h w exch 0 exch rlineto reports/pedtex/ 775 145 13 0 5724044406 7014 reports/pedtex/pedtex.readme 664 145 13 4244 5516662200 11552 From: "(Eric Majani)" Subject: pedtex: generating TeX files for pedigree charts Introducing PEDTEX: a program which generates a TeX file that can then be used to produce a Pedigree Chart in PostScript format. All you need is to have TeX installed on your machine, and three files included here: pedtex, tree.tex, and setup.tex. Good luck! Feel free to ask me questions about pedtex and the \tree, \endtree, \subtree, \endsubtree TeX macros, but please, no questions about TeX. Ask your local TeX wizard for Tex-specific questions. Thanks. ----------------------- Remarks on the use of pedtex ------------------------- 1. You can change the prinindi procedure to anything you like. The example given here is just that, an example. 2. Beware of the use of TeX special characters, and their interpretation by Lifelines (i.e. \' will be changed to /'): however I already found out that \& is not modified by LifeLines. 3. pedtex creates a basic TeX file which can always be modified to suit your tastes, additions of special TeX characters. The nice thing about pedtex is that it puts all the genealogy information from the database. You can therefore include the pedigree chart in a TeX document (if you're writing a book on your family for example). 4. The steps to produce a Postscript file (or a .dvi file for visualization by xdvi for example): 4.1 Make sure the files setup.tex and tree.tex (and pedtex) are in the current directory 4.2 Run lines 4.3 Use the report generation menu and run the pedtex program. Make sure that your output file is of the type: filename.tex The integer to enter is the number of generations desired. 4.4 Quit lines 4.5 Run tex on filename.tex: tex filename 4.6 Run dvips (or xdvi for visualization) on filename.dvi: dvips filename 4.7 Print or visualize the PostScript file filename.ps 5. Do not modify the tree.tex file, unless you are a TeX programming expert 6. The setup.tex file however should be modified to your taste. You should however have no problem with the one I provide (no guarantees though). 7. The files that follow are: tree.tex, setup.tex .llf\ select.lilf]hp-anclf^ps-anc3f_ps-anc5fV common.ll5fapdesc2.r5fUindiv2.rf` INDEX.html_f.messagel ,f .message.html,<fbias13mHfcid\f ps-anc6.llpf familycheckf book-latexreports/pedtex/tree.tex 664 145 13 21767 5516662201 10615 % Tree -- a macro to make aligned (horizontal) trees in TeX % % Input is of the form % \tree % item % \subtree % \leaf{item} % . % . % . % \endsubtree % \subtree % . % . % . % \endsubtree % \endsubtree % \endtree % % Nesting is to any level. \leaf is defined as a subtree of one item: % \def\leaf#1{\subtree#1\endsubtree}. % % A structure: % \subtree % item_part1 % item_part2 % . % . % . % % will print item_part2 directly below item_part1 as a single item % as if they were in a \box. % % The macro is a 3-pass macro. On the first pass it sets up a data % structure from the \subtree ... \endsubtree definitions. On the second pass % it recursively calculates the width of each level of the tree. On the third % pass it sets up the boxes, glue and rules. % % By David Eppstein, TUGboat, vol. 6 (1985), no. 1, pp. 31--35. % Transcribed by Margaret Kromer (peg), Feb., 1986. % % Pass 1 % At the end of pass 1, the tree is coded as a nested collection of \hboxes % and \vboxes. \newbox\treebox\newcount\treeboxcnt \def\tree{\message{Begin tree}\treeboxcnt=1\global\setbox\treebox=\boxtree} \def\subtree{\ettext \advance\treeboxcnt by 1 \boxtree} \def\leaf#1{\subtree#1\endsubtree} \def\endsubtree{\ettext \egroup \advance\treeboxcnt-1{}% \ifnum\treeboxcnt=-1 \treeerrora\fi} \def\endtree{\endsubtree \ifnum\treeboxcnt>0 \treeerrorb\fi% \settreesizes \typesettree \message{-- end tree}} % Error messages for unbalanced tree \def\treeerrora{\errhelp=\treeerrorahelp% \errmessage{Unbalanced tree -- too many endsubtrees}} \newhelp\treeerrorahelp{There are more subtrees closed than opened} \def\treeerrorb{\errhelp=\treeerrorbhelp% \errmessage{Unbalanced tree -- not enough endsubtrees}} \newhelp\treeerrorbhelp{Not all the subtrees of the tree are closed. If you continue, you'll get some mysterious secondary errors.} % Set up \vbox containing root of tree \newif\iftreetext\treetextfalse % Whether still aligning text \def\boxtree{\hbox\bgroup % Start outer box of tree or subtree \baselineskip 2.5ex % Narrow line spacing slightly \tabskip 0pt % No spurious glue in alignment \vbox\bgroup % Start inner text \vbox \treetexttrue % Remember for \ettext \let\par\crcr \obeylines % New line breaks without explicit \cr \halign\bgroup##\hfil\cr} % Start alignment with simple template \def\ettext{\iftreetext % Are we still in inner text \vbox? \crcr\egroup \egroup \fi} % Yes, end alignment and box % Pass 2 % Recursively calculate widths of tree with \setsizes; keep results in % \treesizes; \treewidth contains total width calculated so far. \treeworkbox % is workspace containing subtree being sized. \newbox\treeworkbox \def\cons#1#2{\edef#2{\xmark #1#2}} % Add something to start of list \def\car#1{\expandafter\docar#1\docar} % Take first element of list \def\docar\xmark#1\xmark#2\docar{#1} % ..by ignoring rest in expansion \def\cdr#1{\expandafter\docdr#1\docdr#1}% Similarly, drop first element \def\docdr\xmark#1\xmark#2\docdr#3{\def#3{\xmark #2}} \def\xmark{\noexpand\xmark} % List separator expands to self \def\nil{\xmark} % Empty list is just separator \def\settreesizes{\setbox\treeworkbox=\copy\treebox% \global\let\treesizes\nil \setsizes} \newdimen\treewidth % Width of this part of the tree \def\setsizes{\setbox\treeworkbox=\hbox\bgroup% Get a horiz list as a workspace \unhbox\treeworkbox\unskip % Take tree, unpack it into horiz list \inittreewidth % Get old width at this level \sizesubtrees % Recurse through all subtrees \sizelevel % Now set width from remaining \vbox \egroup} % All done, finish our \hbox \def\inittreewidth{\ifx\treesizes\nil % If this is the first at this level \treewidth=0pt % ..then we have no previous max width \else \treewidth=\car\treesizes % Otherwise take old max level width \global\cdr\treesizes % ..and advance level width storage \fi} % ..in preparation for next level. \def\sizesubtrees{\loop % For each box in horiz list (subtree) \setbox\treeworkbox=\lastbox \unskip % ..pull it off list and flush glue \ifhbox\treeworkbox \setsizes % If hbox, it's a subtree - recurse \repeat} % ..and loop; end loop on tree text \def\sizelevel{% \ifdim\treewidth<\wd\treeworkbox % If greater than previous maximum \treewidth=\wd\treeworkbox \fi % Then set max to new high \global\cons{\the\treewidth}\treesizes}% In either case, put back on list % Pass 3 % Recursively typeset tree with \maketree by adding an \hbox containing % a subtree (in \treebox) to the horizontal list. \newdimen\treeheight % Height of this part of the tree \newif\ifleaf % Tree has no subtrees (is a leaf) \newif\ifbotsub % Bottom subtree of parent \newif\iftopsub % Top subtree of parent \def\typesettree{\medskip\maketree\medskip} % Make whole tree \def\maketree{\hbox{\treewidth=\car\treesizes % Get width at this level \cdr\treesizes % Set up width list for recursion \makesubtreebox\unskip % Set \treebox to text, make subtrees \ifleaf \makeleaf % No subtrees, add glue \else \makeparent \fi}} % Have subtrees, stick them at right {\catcode`@=11 % Be able to use \voidb@x \gdef\makesubtreebox{\unhbox\treebox % Open up tree or subtree \unskip\global\setbox\treebox\lastbox % Pick up very last box \ifvbox\treebox % If we're already at the \vbox \global\leaftrue \let\next\relax % ..then this is a leaf \else \botsubtrue % Otherwise, we have subtrees \setbox\treeworkbox\box\voidb@x % Init stack of processed subs \botsubtrue \let\next\makesubtree % ..and call \maketree on them \fi \next}} % Finish up for whichever it was \def\makesubtree{\setbox1\maketree % Call \maketree on this subtree \unskip\global\setbox\treebox\lastbox % Pick up box before it \treeheight=\ht1 % Get height of subtree we made \advance\treeheight 2ex % Add some room around the edges \ifhbox\treebox \topsubfalse % If picked up box is a \vbox, \else \topsubtrue \fi % ..this is the top, otherwise not \addsubtreebox % Stack subtree with the rest \iftopsub \global\leaffalse % If top, remember not a leaf \let\next\relax \else % ..(after recursion), set return \botsubfalse \let\next\makesubtree % Otherwise, we have more subtrees \fi \next} % Do tail recursion or return \def\addsubtreebox{\setbox\treeworkbox=\vbox{\subtreebox\unvbox\treeworkbox}} \def\subtreebox{\hbox\bgroup % Start \hbox of tree and lines \vbox to \treeheight\bgroup % Start \vbox for vertical rules \ifbotsub \iftopsub \vfil % If both bottom and top subtree \hrule width 0.4pt % ..vertical rule is just a dot \else \treehalfrule \fi \vfil % Bottom gets half-height rule \else \iftopsub \vfil \treehalfrule % Top gets half-height the other way \else \hrule width 0.4pt height \treeheight \fi\fi % Middle, full height \egroup % Finish vertical rule \vbox \treectrbox{\hrule width 1em}\hskip 0.2em\treectrbox{\box1}\egroup} \def\treectrbox#1{\vbox to \treeheight{\vfil #1\vfil}} \def\treehalfrule{\dimen\treeworkbox=\treeheight % Get total height \divide\dimen\treeworkbox 2% \advance\dimen\treeworkbox 0.2pt % Divide by two, add half horiz height \hrule width 0.4pt height \dimen\treeworkbox}% Make a vertical rule that high \def\makeleaf{\box\treebox} % Add leaf box to horiz list \def\makeparent{\ifdim\ht\treebox>% \ht\treeworkbox % If text is higher than subtrees \treeheight=\ht\treebox % ..use that height \else \treeheight=\ht\treeworkbox \fi % Otherwise use height of subtrees \advance\treewidth-\wd\treebox % Take remainder of level width \advance\treewidth 1em % ..after accounting for text and glue \treectrbox{\box\treebox}\hskip 0.2em % Add text, space before connection \treectrbox{\hrule width \treewidth}% \treectrbox{\box\treeworkbox}} % Add \hrule, subs % No idea what \spouse is supposed to do... wasn't included \def\spouse{\bf} les. % % reports/pedtex/pedtex 664 145 13 2260 5516662177 10327 global(depth) global(level) proc main () { getindi(indi) set(prompt,"Enter number of generations desired") getintmsg(depth,prompt) "\\input setup" nl() "\\tree " nl() set(level,1) call pedout(indi) "\\endtree " nl() "\\end " nl() } proc printindi(indi) { "{\\bf " name(indi) "}" nl() if (e, birth(indi)) { " b. " short(e) nl() } if(male(indi)) { spouses(indi,sp,fam,num) { if(e,marriage(fam)) { " m. " short(e) nl() } } } if (e, death(indi)) { " d. " short(e) nl() } } proc pedout(indi) { call printindi(indi) set(level,add(level,1)) if(le(level,depth)) { if (par,father(indi)) { set(fath,father(indi)) "\\subtree " nl() call pedout(fath) "\\endsubtree " nl() } if (par,mother(indi)) { set(moth,mother(indi)) "\\subtree " nl() call pedout(moth) "\\endsubtree " nl() } } set(level,sub(level,1)) } is coded as a nested collection of \hboxes % and \vboxes. \newbox\treebox\newcount\treeboxcnt \def\tree{\message{Begin tree}\treeboxcnt=1\global\setbox\treebox=\boxtree} \def\subtree{\ettext \advance\treeboxcnt by 1 \boxtree} \def\leaf#1{\subtree#1\endsubtree} \def\endsubtree{\ettext \egroup \advance\treeboxcnt-1{}% \ifnureports/pedtex/setup.tex 664 145 13 144 5516662200 10737 \hsize=10in \vsize=7.5in \parindent=20pt \hoffset=-0.8in \voffset=-0.8in \nopagenumbers \input tree nerations desired") getintmsg(depth,prompt) "\\input setup" nl() "\\tree " nl() set(level,1) call pedout(indi) "\\endtree " nl() "\\end " nl() } proc printindi(indi) { "{\\bf " name(indi) "}" nl() if (e, birth(indi)) { " b. " short(e) nl() } if(male(indi)) { spouses(indi,sp,fam,num) { if(e,marriage(fam)reports/tinytafel2 664 145 13 13674 5516662110 7644 /* tinytafel2 Based on tinytafel1 by Tom Wetmore, ttw@cbnewsl.att.com This report works only with the LifeLines Genealogy program 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. 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. This report doesn't do birthyear estimation; it uses other events for the year if birthyear is not available. 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) proc write_tafel_header() { "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(line_count) "\n" } proc main () { 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() } global(fdate) global(ldate) global(pdate) global(fplace) global(lplace) global(pplace) global(sname) 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) call first_in_line(person) } } } } proc first_in_line (person) { call set_year_place(person) set(fdate, pdate) set(fplace, pplace) 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))) { /* reverse order ldate and fdate */ enqueue(ldatelist,save(fdate)) enqueue(fdatelist,save(ldate)) } else { /* normal order ldate and fdate */ enqueue(ldatelist,save(ldate)) enqueue(fdatelist,save(fdate)) } enqueue(lplacelist,save(lplace)) enqueue(fplacelist,save(fplace)) } proc set_year_place (person) { set (yr, year(birth(person))) if (eq(yr, 0)) { set (yr, year(baptism(person))) } if (eq(yr, 0)) { set (yr, year(death(person))) } if (eq(yr, 0)) { set (yr, year(burial(person))) } if (eq(yr, 0)) { set (yr, "????") } set(pdate, save(yr)) set(pl, place(birth(person))) if (eq(pl, 0)) { set(pl, place(baptism(person))) } if (eq(pl, 0)) { set(pl, place(death(person))) } if (eq(pl, 0)) { set(pl, place(burial(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 */ et,person,index,snum) { soundex(person) " " getel(ldreports/verify 664 145 13 53542 6254530162 7066 /* verify - a LifeLines database verification report program by Jim Eggert (eggertj@atc.ll.mit.edu) Version 1, 3 November 1992 (unreleased, first simple try) Version 2, 7 November 1992 (added lots of checks, verbose mode) Version 3, 12 November 1992 (minor bugfix, parameter tuning, added mrbbpm, unkgen, and hommar checks, and more heuristics for birth and marriage years) Version 4, 17 November 1992 (minor bugfix, added femhus, malwif, cbspan, lngwdw, oldunm checks) Version 5, 2 December 1992 (added mmnsnk check, improved morder) Version 6, 26 March 1993 (improved paternity checks, added hermaf check) Version 7, 2 September 1993 (added noprnt check, bug fix for parentless families) Version 8, 2 December 1994 (added mulpar check) Version 9, 28 April 1995 (added nofams check) This LifeLines report program generates a text file which lists exceptions to assertions or checks about the database. There are two forms of the output report, terse or verbose, selectable at runtime. In the terse report, the assertions tested are labeled with a six-character label at the beginning of each line, followed by the instance of the exception. The assertions tested, with the terse syntax of the report output, are of four types, and are listed below. The verbose report is more English-like, and requires less explanation. It contains the same information in the same order as the terse report, with words added to make it read easier. The lines are often longer than 80 characters. Before using this report, you may want to edit the first bunch of set() calls in the main() procedure to adjust the various parameters. Only one individual key is printed out per line, anyone else is given by relation to this first person. All age and date checks use only the year field of the date. Thus they are a bit inaccurate. In particular, any use of ABT (about), BEF (before), AFT (after), split dates, or similar devices will be lost on this program. Sorry. Normal and Irish twins are indistinguishable. For the cspace assertion, intervening children with no known birthyear are treated intelligently. Unknown birthyears and deathyears are assumed equal to the baptism years and burial years, respectively, if those are available. Unknown marriage years are estimated from the children's birth or baptism years. For a large database, this program will likely generate a lot of output. I suggest that you go through this large output once to make sure that everything is correct in the database. After correcting any errors, run this program again, creating a reference report, which will still contain a lot of messages. Then use diff to compare any later reports to the reference report to catch any new errors. You can sort the output report against the first field to sort against the check type. This actually makes the report look nicer too. Then you can sort subsets of the output against other fields to look for the oldest person or the youngest father in the database, for example. Parameters Settable parameters are denoted by _parameter_ in this documentation. These parameters are set in the first few lines of the procedure main(), and can be changed by editing the program before running. Assertions or checks individual checks: person's age at death is older than _oldage_ oldage key name birth death age person is baptized before birth bpbef key person birth baptism person dies before birth dbefb key person birth death person is buried before birth bubefb key person birth burial person dies before baptism dbefbp key person baptism death person is buried before baptism bubfbp key person baptism burial person is buried before death bubefd key person death burial person is baptised after birth year bpspac key person birth baptism person is buried after death year buspac key person death burial person has unkown gender unkgen key person person has ambiguous gender hermaf key person person has multiple parentage mulpar key person familynum familynum person has no family pointers nofams key person marriage checks: person marries before birth unbmar key person birth marriage spouse person marries after death dedmar key person death marriage spouse person has more than _wedder_ spouses wedder key person nspouses person marries someone more than _jundec_ years older jundec key person birth family spouse spouse_birth person marries younger than _yngmar_ yngmar key person age spouse person marries older than _oldmar_ marriage out of order morder key person spouse marriage before birth from previous marriage mrbbpm key person marriage spouse previous_birth homosexual marriage hommar key person marriage spouse person is a female husband femhus key person marriage person is a male wife malwif key person marriage person was a widow(er) longer than _lngwdw_ years lngwdw key person years person lived more than _oldunm_ years and never married oldunm key person years person has multiple marriages, this one with no spouse and no children mmnsnk key person family person has same surname as spouse samnam key person marriage spouse parentage checks: mother has more than _fecmom_ children fecmom key person nkids nfamilies mother is older than _oldmom_ at time of birth of child oldmom key person age familynum childnum child child is born before mother unbmom key person birth familynum childnum child child_birth mother is younger than _yngmom_ yngmom key person age familynum childnum child mother is dead at birth of child dedmom key person death familynum childnum child birth same as above, but for father [fecdad, olddad, unbdad, yngdad, deddad] child doesn't inherit father's surname nonpat key person familynum childnum child children checks: child is born out of order with respect to a previous child corder key person familynum childnum child child_birth prev_child_birth child is born in the same year as a previous child ctwins key person familynum childnum child child_birth child is born more than _cspace_ years after previous child cspace key person familynum childnum child birthspace children's births span more than _cbspan_ years cbspan key person birthspan family checks: family has no parents noprnt fkey firstchild nchildren */ global(birthyear) /* calculated by get_birthyear */ proc get_birthyear(someone) { set(birthyear,0) if (bth,birth(someone)) { extractdate(bth,birthday,birthmonth,birthyear) } if (eq(birthyear,0)) { if (bap,baptism(someone)) { extractdate(bap,bapday,bapmonth,birthyear) } } } proc main () { /* Main settable parameters */ set(oldage,90) /* maximum approximate age */ set(jundec,30) /* maximum husband-wife age difference */ set(yngmar,17) /* minimum age to marry */ set(oldmar,50) /* maximum age to marry */ set(fecmom,11) /* maximum number of children for a woman */ set(oldmom,49) /* maximum age for a woman to bear a child */ set(yngmom,17) /* minimum age for a woman to bear a child */ set(fecdad,15) /* maximum number of children for a man */ set(olddad,65) /* maximum age for a man to father a child */ set(yngdad,18) /* minimum age for a man to father a child */ set(wedder,3) /* maximum number of spouses for a person */ set(cspace,8) /* maximum number of years between children */ set(cbspan,25) /* maximum span of years for all children */ set(nonpat,0) /* 0 = compare child=father surnames by Soundex code, 1 = require strict surname equality */ set(oldunm,99) /* maximum age at death for unmarried person */ set(lngwdw,30) /* maximum number of consecutive years of widowhood */ getintmsg(verbose,"Enter 0 for terse, 1 for verbose output") if (verbose) { set(oldagestr,"Old age ") set(namestr," ") set(bornstr," born ") set(bapstr," baptized ") set(buriedstr," buried ") set(diedstr," died ") set(agestr," age ") set(dbefbstr,"Died before birth ") set(bpbefbstr,"Baptized before birth ") set(bpspacstr,"Baptized late ") set(bubefdstr,"Buried before death ") set(buspacstr,"Buried late ") set(dbefbpstr,"Death before baptism ") set(bubfbpstr,"Buried before baptism ") set(bubefbstr,"Buried before birth ") set(wedderstr,"Married often ") set(marriedstr," married ") set(timesstr," times") set(momstr,"mother ") set(dadstr,"father ") set(oldstr,"Old ") set(unbstr,"Unborn ") set(deadstr,"Dead ") set(yngstr,"Young ") set(fecundstr,"Fecund ") set(hadstr," had ") set(kidsinstr," children in ") set(familystr," family") set(familiesstr," families") set(jundecstr,"June-December marriage ") set(unbmarstr,"Married before birth ") set(dedmarstr,"Married after death ") set(yngmarstr,"Young marriage ") set(oldmarstr,"Old marriage ") set(marriedagestr," married at age ") set(tostr," to ") set(morderstr,"Marriage out of order ") set(familynostr," family ") set(illegstr,"Possible illegitimate birth ") set(corderstr,"Child out of order ") set(childnostr," child ") set(prevbornstr," previous child born ") set(ctwinstr,"Possible twin ") set(cspacestr,"Widely spaced births ") set(laterstr," years later") set(nonpatstr,"Nonpatronymic inheritance ") set(mrbbpmstr,"Marriage before birth from previous family ") set(prevmarbirthstr," previous birth ") set(unkgenstr,"Unknown gender ") set(hermafstr,"Ambiguous gender ") set(mulparstr,"Multiple parentage ") set(nofamsstr,"No family ") set(parentstr,"parent ") set(hommarstr,"Homosexual marriage ") set(femhusstr,"Female husband ") set(malwifstr,"Male wife ") set(cbspanstr,"Widely spanning births ") set(childrenspanstr," children's births span ") set(yearsstr," years") set(oldunmstr,"Old and unmarried ") set(diedunmarriedstr," died unmarried aged ") set(lngwdwstr,"Long widowhood ") set(waswidowstr," was a widow ") set(waswidowerstr," was a widower ") set(beforefamilynostr," before family ") set(mmnsnkstr,"Multiple marriages no spouse no kids ") set(samnamstr,"Husband and wife with same surname ") set(noprntstr,"Family with no parents ") set(firstchildstr," first child ") set(numchildrenstr," of ") set(nl,".\n") } else { set(oldagestr,"oldage ") set(namestr," ") set(bornstr," ") set(bapstr," ") set(buriedstr," ") set(diedstr," ") set(agestr," ") set(dbefbstr, "dbefb ") set(bpbefbstr,"bpbefb ") set(bpspacstr,"bpspac ") set(bubefdstr,"bubefd ") set(buspacstr,"buspac ") set(dbefbpstr,"dbefbp ") set(bubfbpstr,"bubfbp ") set(bubefbstr,"bubefb ") set(wedderstr,"wedder ") set(marriedstr," ") set(timesstr,"") set(momstr,"mom ") set(dadstr,"dad ") set(oldstr,"old") set(unbstr,"unb") set(deadstr,"ded") set(yngstr,"yng") set(fecundstr,"fec") set(hadstr," ") set(kidsinstr," ") set(familystr,"") set(familiesstr,"") set(jundecstr,"jundec ") set(unbmarstr,"unbmar ") set(dedmarstr,"dedmar ") set(yngmarstr,"yngmar ") set(oldmarstr,"oldmar ") set(marriedagestr," ") set(tostr," ") set(morderstr,"morder ") set(familynostr," ") set(illegstr,"illeg ") set(corderstr,"corder ") set(childnostr," ") set(prevbornstr," ") set(ctwinstr,"ctwins ") set(cspacestr,"cspace ") set(laterstr,"") set(nonpatstr,"nonpat ") set(mrbbpmstr,"mrbbpm ") set(prevmarbirthstr," ") set(unkgenstr,"unkgen ") set(hermafstr,"hermaf ") set(mulparstr,"mulpar ") set(nofamsstr,"nofams ") set(parentstr,"par ") set(hommarstr,"hommar ") set(femhusstr,"femhus ") set(malwifstr,"malwif ") set(cbspanstr,"cbspan ") set(childrenspanstr," ") set(yearsstr,"") set(oldunmstr,"oldunm ") set(diedunmarriedstr," ") set(lngwdwstr,"lngwdw ") set(beforefamilynostr,"") set(waswidowstr," ") set(waswidowerstr," ") set(mmnsnkstr,"mmnsnk ") set(samnamstr,"samnam ") set(noprntstr,"noprnt ") set(firstchildstr," ") set(numchildrenstr," ") set(nl,"\n") } forindi(person, number) { set(idstr,save(concat(concat(key(person),namestr), name(person)))) /* individual checks */ set(byear,0) if (bth,birth(person)) { extractdate(bth,bday,bmonth,byear) } set(bapyear,0) if (bap,baptism(person)) { extractdate(bap,bapday,bapmonth,bapyear) } set(dyear,0) if (dth,death(person)) { extractdate(dth,dday,dmonth,dyear) } set(buryear,0) if (bur,burial(person)) { extractdate(bur,burday,burmonth,buryear) } if (and(byear,bapyear)) { if (gt(byear,bapyear)) { bpbefbstr idstr bornstr d(byear) bapstr d(bapyear) nl } if (lt(byear,bapyear)) { bpspacstr idstr bornstr d(byear) bapstr d(bapyear) nl } } if (and(dyear,buryear)) { if (gt(dyear,buryear)) { bubefdstr idstr diedstr d(dyear) buriedstr d(buryear) nl } if (lt(dyear,buryear)) { buspacstr idstr diedstr d(dyear) buriedstr d(buryear) nl } } if (and(dyear,gt(byear,dyear))) { dbefbstr idstr bornstr d(byear) diedstr d(dyear) nl } if (and(dyear,gt(bapyear,dyear))) { dbefbpstr idstr bapstr d(bapyear) diedstr d(dyear) nl } if (and(buryear,gt(bapyear,buryear))) { bubfbpstr idstr bapstr d(bapyear) buriedstr d(buryear) nl } if (and(buryear,gt(byear,buryear))) { bubefbstr idstr bornstr d(byear) buriedstr d(buryear) nl } if (eq(byear,0)) { set(byear,bapyear) } /* guess baptism = birth */ if (eq(dyear,0)) { set(dyear,buryear) } /* guess burial = death */ if (and(byear,dyear)) { set(ageatdeath,sub(dyear,byear)) } else { set(ageatdeath,0) } if (gt(ageatdeath,oldage)) { oldagestr idstr bornstr d(byear) diedstr d(dyear) agestr d(ageatdeath) nl } /* gender checks */ if (female(person)) { set(parstr,momstr) set(oldpar,oldmom) set(yngpar,yngmom) set(fecpar,fecmom) set(waswidstr,waswidowstr) } if (male(person)) { set(parstr,dadstr) set(oldpar,olddad) set(yngpar,yngdad) set(fecpar,fecdad) set(waswidstr,waswidowerstr) } if (not(or(female(person),male(person)))) { unkgenstr idstr nl set(parstr,parentstr) set(oldpar,olddad) set(yngpar,yngdad) set(fecpar,fecdad) set(waswidstr,waswidowstr) } if (and(male(person),female(person))) { hermafstr idstr nl set(parstr,parentstr) set(oldpar,olddad) set(yngpar,yngdad) set(fecpar,fecdad) set(waswidstr,waswidowstr) } /* multiple parentage check */ set(nfamc,0) set(famstr,"") fornodes(inode(person),node) { if (not(strcmp(tag(node),"FAMC"))) { set(nfamc,add(nfamc,1)) if (eq(nfamc,1)) { set(famstr,save(value(node))) } elsif (eq(nfamc,2)) { mulparstr idstr famstr } if (ge(nfamc,2)) { " " value(node) } } } if (gt(nfamc,1)) { nl } /* no families check */ if (and(not(parents(person)), eq(0,nfamilies(person)))) { nofamsstr idstr nl } set(nkids,0) /* marriage checks */ set(nfam,nfamilies(person)) if (gt(nfam,wedder)) { wedderstr idstr marriedstr d(nfam) timesstr nl } if (and(gt(ageatdeath,oldunm),eq(nfam,0))) { oldunmstr idstr diedunmarriedstr d(ageatdeath) yearsstr nl } set(first_cbyear,99999) set(last_cbyear,0) set(prev_cbyear,0) set(prev_cbyfnum,0) set(prev_cbyind,0) set(prev_maryear,0) set(prev_sdyear,0) families(person,fam,spouse,fnum) { if (eq(strcmp(sex(person),sex(spouse)),0)) { hommarstr idstr familynostr d(fnum) namestr name(spouse) nl } if (and(eq(person,husband(fam)),female(person))) { femhusstr idstr familynostr d(fnum) nl } if (and(eq(person,wife(fam)),male(person))) { malwifstr idstr familynostr d(fnum) nl } if (spouse) { if (and(male(person), not(strcmp(surname(person),surname(spouse))))) { samnamstr idstr familynostr d(fnum) namestr name(spouse) nl } } if (and(byear,spouse)) { call get_birthyear(spouse) if (gt(sub(birthyear,byear),jundec)) { jundecstr idstr bornstr d(byear) familynostr d(fnum) namestr name(spouse) bornstr d(birthyear) nl } } set(sdyear,0) if (sdth,death(spouse)) { extractdate(sdth,sdthday,sdmonth,sdyear) } if (eq(sdyear,0)) { if (sbur,burial(spouse)) { extractdate(sbur,sburday,sburmonth,sdyear) } } set(maryear,0) if (mar,marriage(fam)) { extractdate(mar,marday,marmonth,maryear) } if (eq(maryear,0)) { /* estimate marriage year */ children(fam,child,cnum) { if (eq(maryear,0)) { call get_birthyear(child) if (birthyear) { set(maryear,sub(birthyear,cnum)) } } } } if (or(and(maryear,lt(maryear,prev_maryear)), and(sdyear,lt(sdyear,prev_maryear)))) { morderstr idstr tostr name(spouse) nl } if (maryear) { if (byear) { set(marage,sub(maryear,byear)) if (lt(marage,0)) { unbmarstr idstr bornstr d(byear) marriedstr d(maryear) tostr name(spouse) nl } elsif (lt(marage,yngmar)) { yngmarstr idstr marriedagestr d(marage) tostr name(spouse) nl } elsif (gt(marage,oldmar)) { oldmarstr idstr marriedagestr d(marage) tostr name(spouse) nl } } if (and(dyear,gt(maryear,dyear))) { dedmarstr idstr diedstr d(dyear) marriedstr d(maryear) tostr name(spouse) nl } if (gt(prev_cbyear,maryear)) { mrbbpmstr idstr marriedstr d(maryear) tostr name(spouse) prevmarbirthstr d(prev_cbyear) nl } set(prev_maryear,maryear) } else { set(maryear,prev_maryear) } if (and(maryear,prev_sdyear)) { set(wdwyear,sub(maryear,prev_sdyear)) if (gt(wdwyear,lngwdw)) { lngwdwstr idstr waswidstr d(wdwyear) yearsstr beforefamilynostr d(fnum) nl } } if (and(eq(fnum,nfam),and(dyear,sdyear))) { set(wdwyear,sub(dyear,sdyear)) if (gt(wdwyear,lngwdw)) { lngwdwstr idstr waswidstr d(wdwyear) yearsstr nl } } if (and(and(gt(nfam,1),not(spouse)),eq(nchildren(fam),0))) { mmnsnkstr idstr familynostr d(fnum) nl } children(fam,child,cnum) { set(nkids,add(nkids,1)) call get_birthyear(child) set(cbyear,birthyear) if (and(cbyear,lt(cbyear,first_cbyear))) { set(first_cbyear,cbyear) } if (gt(cbyear,last_cbyear)) { set(last_cbyear,cbyear) } /* parentage checks */ if (and(byear,cbyear)) { set(bage,sub(cbyear,byear)) if (gt(bage,oldpar)) { oldstr parstr idstr agestr d(bage) familynostr d(fnum) childnostr d(cnum) namestr name(child) nl } elsif (lt(bage,0)) { unbstr parstr idstr bornstr d(byear) familynostr d(fnum) childnostr d(cnum) namestr name(child) bornstr d(cbyear) nl } elsif (lt(bage,yngpar)) { yngstr parstr idstr agestr d(bage) familynostr d(fnum) childnostr d(cnum) namestr name(child) nl } } if (and(dyear,gt(cbyear,dyear))) { deadstr parstr idstr diedstr d(dyear) familynostr d(fnum) childnostr d(cnum) namestr name(child) bornstr d(cbyear) nl } if (male(person)) { if (or(and(eq(nonpat,0), strcmp(save(soundex(person)), save(soundex(child)))), and(eq(nonpat,1), strcmp(save(surname(person)), save(surname(child)))))) { nonpatstr idstr familynostr d(fnum) childnostr d(cnum) namestr name(child) nl } } /* children checks */ if (cbyear) { set(main_parent,or(female(person),not(wife(fam)))) if (main_parent) { if (gt(maryear,cbyear)) { illegstr idstr familynostr d(fnum) marriedstr d(maryear) childnostr d(cnum) namestr name(child) bornstr d(cbyear) nl } } if (and(prev_cbyear, or(main_parent,ne(fnum,prev_cbyfnum)))) { if (gt(prev_cbyear,cbyear)) { corderstr idstr familynostr d(fnum) childnostr d(cnum) namestr name(child) bornstr d(cbyear) prevbornstr d(prev_cbyear) nl } elsif (eq(cbyear,prev_cbyear)) { ctwinstr idstr familynostr d(fnum) childnostr d(cnum) namestr name(child) bornstr d(cbyear) nl } elsif (gt(cbyear, add(prev_cbyear, mul(cspace,sub(nkids,prev_cbyind))))) { cspacestr idstr familynostr d(fnum) childnostr d(cnum) namestr name(child) bornstr d(sub(cbyear,prev_cbyear)) laterstr nl } } set(prev_cbyear,cbyear) set(prev_cbyind,nkids) set(prev_cbyfnum,fnum) } } } set(prev_sdyear,sdyear) /* other parentage checks */ set(cbdiff,sub(last_cbyear,first_cbyear)) if (gt(cbdiff,cbspan)) { cbspanstr idstr childrenspanstr d(cbdiff) yearsstr nl } if (gt(nkids,fecpar)) { fecundstr parstr idstr hadstr d(nkids) kidsinstr d(nfam) if (eq(nfam,1)) { familystr } else { familiesstr } nl } } /* handle families with no parents */ forfam(fam,fnum) { if (not(or(husband(fam),wife(fam)))) { set(first_cbyear,99999) set(last_cbyear,0) set(prev_cbyear,0) set(prev_cbyind,0) set(prev_maryear,0) set(maryear,0) if (mar,marriage(fam)) { extractdate(mar,marday,marmonth,maryear) } children(fam,child,cnum) { if (eq(cnum,1)) { set(firstchild,child) } call get_birthyear(child) set(cbyear,birthyear) if (and(cbyear,lt(cbyear,first_cbyear))) { set(first_cbyear,cbyear) } if (gt(cbyear,last_cbyear)) { set(last_cbyear,cbyear) } if (cbyear) { if (gt(maryear,cbyear)) { illegstr key(fam) marriedstr d(maryear) childnostr d(cnum) namestr name(child) bornstr d(cbyear) nl } if (prev_cbyear) { if (gt(prev_cbyear,cbyear)) { corderstr key(fam) childnostr d(cnum) namestr name(child) bornstr d(cbyear) prevbornstr d(prev_cbyear) nl } elsif (eq(cbyear,prev_cbyear)) { ctwinstr key(fam) childnostr d(cnum) namestr name(child) bornstr d(cbyear) nl } elsif (gt(cbyear, add(prev_cbyear, mul(cspace,sub(cnum,prev_cbyind))))) { cspacestr key(fam) childnostr d(cnum) namestr name(child) bornstr d(sub(cbyear,prev_cbyear)) laterstr nl } } set(prev_cbyear,cbyear) set(prev_cbyind,cnum) } } set(cbdiff,sub(last_cbyear,first_cbyear)) if (gt(cbdiff,cbspan)) { cbspanstr key(fam) childrenspanstr d(cbdiff) yearsstr nl } noprntstr key(fam) firstchildstr key(firstchild) namestr name(firstchild) numchildrenstr d(cnum) nl } } } mafstr idstr nl set(parstr,parentstr) set(oldpar,olddad) set(yngpar,yngdad) set(fecpar,fecdad) set(waswidstr,waswidowstr) } /* multreports/soundex-isfm 664 145 13 12032 5516662103 10171 /* * soundex-isfm * * Code by Tom Wetmore, ttw@cbnewsl.att.com, 1991 * Modifications by Cliff Manis, cmanis@csoftec.csf.com, 1992 * Modifications by Jim Eggert, atc.ll.mit.edu!eggertj Fri Feb 26 1993 * * This report works only with the LifeLines Genealogy program * * It will produce a report of all the INDI's in the database, * in the format as seen at end of report. May be sorted easily * to see the Father or Mother column sorted report. * * This report can be used to output everyone in the database, * or selected by a single soundex code. The soundex code * can be entered either by knowing the code, or by selecting * an individual and using his/her code. * * The report name come from: isfm (Indi Spouse Father Mother) * It is designed for 16 pitch, HP laserjet III, 132 column, and * also those who have X-Windows, 132 columns video. * * This report produces an ASCII output file. */ proc main () { indiset(idx) getintmsg(smethod, "0=all persons, 1=given Soundex, 2=Soundex of a given person") if (eq(smethod,1)) { getstrmsg(scode, "Enter desired Soundex code (return=any, Z999=unknown)") if (scode) { set(scode,save(upper(scode))) } } elsif (eq(smethod,2)) { getindimsg(person,"Enter name of person with desired Soundex") if (person) { set(scode,save(soundex(person)) ) } } if (scode) { print("Using Soundex code ") print(scode) print("\n") } else { print("Using all persons in database\n") } set(count,0) forindi(indi,n) { set(getit,1) if (scode) { if (strcmp(scode,soundex(indi))) { set(getit,0) } } if (getit) { addtoset(idx,indi,n) if (scode) { set(count,add(count,1)) print(d(count)) print("/") } print(d(n)) print(" ") } } print("\nbegin sorting\n") namesort(idx) print("done sorting\n") col(1) "INDEX OF ALL PERSONS IN DATABASE" if (scode) { " WITH SOUNDEX CODE: " scode } col(1) "Individual" col(34) "Brth" col(39) "Deat" col(44) "First Spouse" col(75) "Father" col(106) "Mother" col(1) "----------------------------------------" "----------------------------------------" "----------------------------------------" forindiset(idx,indi,v,n) { col(1) fullname(indi,1,0,29) col(34) year(birth(indi)) col(39) year(death(indi)) if(gt(nspouses(indi), 0)) { spouses(indi, spou, fam, n) { if (eq(1,n)) { col(44) fullname(spou,1,0,29) } } } if(fath,father(indi)) { col(75) fullname(fath,1,0,29) } if(moth,mother(indi)) { col(106) fullname(moth,1,0,29) } } nl() print(nl()) } /* Sample output of report (132 columns) INDEX OF ALL PERSONS IN DATABASE WITH SOUNDEX CODE: D340 Individual Brth Deat First Spouse Father Mother ------------------------------------------------------------------------------------------------------------------------ DUDLEY, Alexander 1645 DUDLEY, Richard SEAWELL, Mary DUDLEY, Ambrose 1665 DUDLEY, Wife_of Ambrose DUDLEY, Ambrose DUDLEY, Wife_of Col_Ambrose DUDLEY, Ambrose 1649 DUDLEY, Wife_of Col_Ambrose DUDLEY, Richard SEAWELL, Mary DUDLEY, Christopher 1715 1781 DUDLEY, Robert CURTIS, Elizabeth DUDLEY, Dorcas 1704 1765 ROUNTREE, William DUDLEY, Ambrose DUDLEY, Wife_of Ambrose DUDLEY, Edward 1605 1655 PRITCHARD, Elizabeth DUDLEY, James 1645 1741 WELCH, Mary DUDLEY, Richard SEAWELL, Mary DUDLEY, Richard 1623 1687 SEAWELL, Mary DUDLEY, Edward PRITCHARD, Elizabeth DUDLEY, Robert 1647 1701 RANSOM, Elizabeth DUDLEY, Richard SEAWELL, Mary DUDLEY, Robert 1691 1745 CURTIS, Elizabeth DUDLEY, Robert RANSOM, Elizabeth DUDLEY, Wife_of Ambrose 1640 DUDLEY, Ambrose DUDLEY, Wife_of Col_Ambrose 1645 DUDLEY, Ambrose DUDLEY, William 1621 1672 CARY, Elizabeth DUDLEY, Edward PRITCHARD, Elizabeth -- end of sample */ dstr bornstr d(byear) familynostr d(fnum) childnostr d(cnum) namestr name(child) bornstr d(cbyear) nl } elsif (lt(bage,yngpar)) { yngstr parstr idstr agestr d(bage) familynostr d(fnum) childnostr d(cnum) namestr name(child) nl } } if (and(dyear,gt(cbyear,dyear))) { deadstr parstr idstr diedstr d(dyear) familynostr d(fnum) childnostr d(cnum) namestr name(child) bornstr d(cbyear) nl } if (male(person)) { reports/tinytafel1 664 145 13 27067 6254530030 7637 /* 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 */ ueue(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,sreports/timeline2 664 145 13 34220 5516662107 7447 /* * timeline2 - create a timeline of select individuals * * version one: 4 Sept 1993 * version two: 9 Sept 1993 * * Code by James P. Jones, jjones@nas.nasa.gov * * Contains code from: * "famrep4" - By yours truly, jjones@nas.nasa.gov * "tree1" - By yours truly, jjones@nas.nasa.gov * * This report works only with the LifeLines Genealogy program. * * This report creates one of the following timeline charts: * * 1. Ascii timeline graph showing birth, marriage, and death events of * selected individuals; shows which individuals were contemporaies. * * 2. Ascii timeline chart data with the above information for use with * the my timeline generation program or the today program. * * 3. IN PROGRESS (postscript version of #1 above) * * User selects individual to base the chart on; then selects from * the following sets: * * parents, * children, * spouses, * ancestors, * descendents, * everyone * * User selects start date (e.g. 1852) and end date for graph; graph size * (80 or 132 col); and various options regarding who to display. * * Note: If an indi is "alive" for more than MAXAGE years, this is flagged as * "uncertain" with a question mark in graph after MAXAGE years from birth. * One should check these individuals to determine where they are really * that old, or if one can determine an approxmate date of death, etc. * * Additional functionality will be added as soon as LL version 2.3.5 * is released. See comments below for details. * * Sample output (#1 above) follows (start=1800; end=2000; 80 col; sort by * name; show people with dates only): Name 1800 1820 1840 1860 1880 1900 1920 1940 1960 1980 2000 ________________________|____|____|____|____|____|____|____|____|____|____| AUSTIN, George W | B****M************D AUSTIN, Velma Cleo | B***M*M**M**M***M* BLAKE, Nancy Elizabeth | B****M***********D HEFLIN, Wyatt |**************D HUNTER, Rebecca A. | B****M************D JONES, Arvel Fred Jr. | B******M****** JONES, Arvel Fred Sr. | B****M*************D JONES, Charles Columbus | B*******************D JONES, Sarah Frances | B*****D JONES, Wesley | B************************? JORDAN, Mary Cardine | B****D PHIPPEN, Rose Marie | B****M***M** WILDE, Charles | B************************? ____, Sarah A |********************? Scale: 1 point = 4 years Key: B=birthdate, M=marriage, D=deathdate, *=living, ?=uncertainity * * Output from #1 can be sorted using the sort(1) command, for example, the * following command will sort the above output by birthdate: * * sort -t\| +1 filename * * where FILENAME is a file contain the above sample data, would produce: PHIPPEN, Rose Marie | B****M***M** JONES, Arvel Fred Jr. | B******M****** AUSTIN, Velma Cleo | B***M*M**M**M***M* JONES, Arvel Fred Sr. | B****M*************D AUSTIN, George W | B****M************D JONES, Charles Columbus | B*******************D JONES, Sarah Frances | B*****D BLAKE, Nancy Elizabeth | B****M***********D JORDAN, Mary Cardine | B****D JONES, Wesley | B************************? WILDE, Charles | B************************? HUNTER, Rebecca A. | B****M************D ____, Sarah A |********************? HEFLIN, Wyatt |**************D * * */ /* * timeline */ global(startdate) global(enddate) global(curyear) global(linnum) global(linpos) global(offset) global(years) global(scale) global(count) global(indnum) global(showall) global(MAXYEAR) global(MAXAGE) proc main () { set(MAXYEAR, 2020) /* the distant future */ set(MAXAGE, 90) /* if birth/death dates unknown, guess age */ set(indnum,0) set(startdate, 0) set(enddate, 0) set(linnum, 1) set(linpos, 1) list(plist) while (eq(indi, NULL)) { getindi(indi) } while (and(ne(gra,1), ne(gra,2))) { getintmsg(gra,"Select timeline (1) graph, (2) chart:") } set(valid,0) while (eq(valid,0)) { print("Graph (1) parents, (2) children, (3) spouses") print(nl()) print(" (4) ancestors, (5) descendents, (6) everyone") print(nl()) getintmsg(ltype,"Choose subset of individuals: ") if (and(ge(ltype,1), le(ltype,6))) { set (valid, 1) } } while (and(ne(showall,1), ne(showall,2))) { getintmsg(showall,"Include people without dates (1) no, (2) yes: ") } if (eq(gra,1)) { pagemode(1, 200) set(startdate,0) set(enddate,0) while(le(enddate, startdate)) { set(startdate,0) set(enddate,0) while (or(le(startdate,0),gt(startdate,MAXYEAR))) { getintmsg(startdate,"Enter start date for graph, e.g. 1800: ") } while (or(le(enddate,0),gt(startdate,MAXYEAR))) { getintmsg(enddate, "Enter end date for graph, e.g. 1950: ") } if (le(enddate, startdate)) { print("End date exceeds start date. Re-enter dates.") print(nl()) } } while (and(ne(size,1), ne(size,2))) { getintmsg(size,"Select graph size (1) 80 col, (2) 132 col: ") } while (and(ne(order,1), ne(order,2))) { getintmsg(order,"Order by (1) family group, (2) last name: ") } if (eq(size, 1)) { set(offset, sub(80, 26)) } else { set(offset, sub(130, 26)) } set(years, sub(enddate, startdate)) set(scale, div(years, offset)) if (gt(mod(years, offset), 0)) { set(scale, add(scale, 1)) } if (le(scale, 0)) { set(scale, 1) } print("Scale: 1 point = ") print(d(scale)) print(" years") call datelin() pageout() call header() pageout() } indiset(idx) addtoset(idx,indi,n) if (eq(ltype, 1)) { set(idx, parentset(idx)) addtoset(idx,indi,n) } if (eq(ltype, 2)) { set(idx, childset(idx)) addtoset(idx,indi,n) } if (eq(ltype, 3)) { set(idx, spouseset(idx)) addtoset(idx,indi,n) } /* this will work in LL version 2.3.5 ... if (eq(ltype, 4)) { set(idx, siblingset(idx)) addtoset(idx,indi,n) }*/ if (eq(ltype, 4)) { set(idx, ancestorset(idx)) addtoset(idx,indi,n) } if (eq(ltype, 5)) { set(idx, descendentset(idx)) addtoset(idx,indi,n) } if (eq(ltype, 6)) { forindi(indiv,n) { addtoset(idx,indiv,n) } } if (eq(gra,1)) { /* this will work in LL version 2.3.5 ... if (eq(lengthset(idx), 0)) { print("This set contains no individuals, please try again.") print(" ") } else { */ if (eq(order, 2)) { namesort(idx) } forindiset(idx,indiv,v,n) { set(indnum, add(indnum,1)) call graph(indiv) /* outputs a 1 line "page" for each */ } linemode() call printkey() /*}*/ } else { linemode() forindiset(idx,indiv,v,n) { call timeline(indiv) } } } proc datelin() { set(linpos, 10) pos(linnum, linpos) "Name" set(linpos, 25) set(count, mul(scale, 5)) set(curyear, sub(startdate, mod(startdate, count))) while (le(curyear, enddate)) { pos(linnum, linpos) d(curyear) set(curyear, add(curyear,count)) set(linpos, add(linpos, 5)) } set(curyear, sub(curyear,count)) } proc header() { set(tmpyear, sub(startdate, mod(startdate, count))) pos(linnum, 1) "________________________" set(linpos, 25) set(i, 25) while (le(tmpyear, curyear)) { set(j, 0) while (lt(j, count)) { pos(linnum, linpos) if (or(eq(i, 25), eq(mod(i, 5),0))) { "|" } else { if (lt(tmpyear, curyear)) { "_" } } set(j, add(j,scale)) set(linpos, add(linpos, 1)) set(i, add(i,scale)) } set(tmpyear, add(tmpyear,count)) } } proc graph(indi) { set(NOINFO, 0) set(showit, 0) set(linnum, 1) set(linpos, 1) pos(linnum, linpos) if (eq(mod(indnum,10),0)) { print(".") } /* birth event */ set(start, strtoint(year(birth(indi)))) if (eq(start, 0)) { set(start, strtoint(year(baptism(indi)))) } /* marriage event(s) */ list(mlist) spouses(indi, svar, fvar, no) { set(tdate, strtoint(year(marriage(fvar)))) if (ne(tdate,0)) { enqueue(mlist, tdate) } } set(myear, dequeue(mlist)) /* death event */ set(end, strtoint(year(death(indi)))) if (eq(end, 0)) { set(end, strtoint(year(burial(indi)))) } /* do we have enough info to continue? */ set(Bunknown, 0) set(Dunknown, 0) if (and(eq(start, 0),eq(end, 0))) { set(NOINFO,1) } else { if (eq(start, 0)) { set(start,sub(end, MAXAGE)) set(Bunknown, 1) } if (eq(end, 0)) { set(end, add(start, MAXAGE)) set(Dunknown, 1) } } if (or(eq(showall,2),eq(NOINFO,0))) { fullname(indi, 1, 0, 24) set(linpos, 25) } if (eq(NOINFO, 0)) { set(year, startdate) set(loop, 1) set(thisyear, strtoint(year(gettoday()))) if (le(thisyear, enddate)) { set(stopdate, thisyear) } else { set(stopdate, enddate) } set(last, 0) while (le(year, stopdate)) { pos(linnum, linpos) if (lt(year, start)) { if (eq(last,0)) { " " } } if (gt(year, end)) { if (eq(last,0)) { " " } } if (eq(year, start)) { if (eq(Bunknown,1)) { "?" } else { "B" } set(last, 1) } if (eq(year, end)) { if (eq(Dunknown,1)) { "?" } else { "D" } set(last, 1) } if (and(gt(year, start), le(year, end))) { if (eq(year, myear)) { "M" set(last, 1) set(myear, dequeue(mlist)) } } if (and(gt(year, start), lt(year, end))) { if (eq(last,0)) { "*" } } set(year, add(year, 1)) if (eq(loop, scale)) { set(loop, 1) set(last, 0) set(linpos, add(linpos, 1)) } else { set(loop, add(loop, 1)) } } set(showit, 1) } if (or(eq(showall,2),eq(showit,1))) { set(linpos, 25) pos(linnum,linpos) "|" pageout() } } proc printkey() { nl() "Scale: 1 point = " d(scale) if (eq(scale,1)) { " year" } else { " years" } nl() "Key: B=birthdate, M=marriage, D=deathdate, *=living, ?=uncertainity" nl() } proc timeline(indi) { dayformat(1) monthformat(1) dateformat(6) set(tdate, date(birth(indi))) if (strcmp(tdate,NULL)) { "B" stddate(birth(indi)) " " name(indi) nl() } set(tdate, date(baptism(indi))) if (strcmp(tdate,NULL)) { "C" stddate(baptism(indi)) " " name(indi) nl() } spouses(indi, svar, fvar, no) { set(tdate, date(marriage(fvar))) if (strcmp(tdate,NULL)) { "M" stddate(marriage(fvar)) " " if (eq(strcmp(sex(indi), "M"),0)) { name(indi) " to " name(svar) nl() } else { name(svar) " to " name(indi) nl() } } } set(tdate, date(death(indi))) if (strcmp(tdate,NULL)) { "D" stddate(death(indi)) " " name(indi) nl() } set(tdate, date(burial(indi))) if (strcmp(tdate,NULL)) { "F" stddate(burial(indi)) " " name(indi) nl() } } set(offset, sub(80, 26)) } else { set(offset, sub(130, 26)) } set(years, sub(enddate, startdate)) set(scale, div(years, offset)) if (gt(mod(years, offset), 0)) { set(scale, add(scale, 1)) } if (le(scale, 0)) { reports/timeline1 664 145 13 23666 5516662106 7461 /* * timeline1 * * version one: 4 Sept 1993 * * Code by James P. Jones, jjones@nas.nasa.gov * * Contains code from: * "famrep4" - By yours truely, jjones@nas.nasa.gov * "tree1" - By yours truely, jjones@nas.nasa.gov * * This report works only with the LifeLines Genealogy program * * This report creates one of the following timeline charts: * * 1. Ascii timeline showing birth, marriage, and death events of * selected individuals; shows which individuals were contemporaies. * * 2. IN PROGRESS * * User selects individual to base the chart on; then selects from * the following sets: * * parents, * children, * spouses, * ancestors, * descendents, * everyone * * User selects start date (e.g. 1852) and end date for graph; as well as * graph size (80 or 132 col). * * Note: If an indi is "alive" for more than 100 years, this is flagged as * "uncertain", with a question mark in the graph after 100 years from birth. * One should check these individuals to determine where they are really * that old, or if one can determine an approxmate date of death, etc. * * Additional functionality will be added as soon as LL version 2.3.5 * is released. * * Sample output follows (start=1800; end=2000; 80 columns): Name 1800 1820 1840 1860 1880 1900 1920 1940 1960 1980 2000 ________________________|____|____|____|____|____|____|____|____|____|____| AUSTIN, George W B****M************D AUSTIN, Velma Cleo B***M*M**M**M***M* BLAKE, Nancy Elizabeth B****M***********D HEFLIN, Wyatt ***************D HUNTER, Rebecca A. B****M************D JONES, Arvel Fred Jr. B******M****** JONES, Arvel Fred Sr. B****M*************D JONES, Charles Columbus B*******************D JONES, George JONES, Sarah Frances B*****D JONES, Wesley B************************??????????? JORDAN, Mary Cardine B****D PHIPPEN, Rose Marie B****M***M** WILDE, Charles B************************????????????????? ____, Sarah A *********************???????????????????????????? Scale: 1 point = 4 years Key: B=birthdate, M=marriage, D=deathdate, *=living, ?=uncertainity */ global(startdate) global(enddate) global(curyear) global(linnum) global(linpos) global(offset) global(years) global(scale) global(count) proc main () { set(startdate, 0) set(enddate, 0) set(linnum, 1) set(linpos, 1) list(plist) pagemode(1, 200) getindi(indi) while (eq(indi, NULL)) { getindi(indi) } set(valid,0) while (eq(valid,0)) { print("Graph (1) parents, (2) children, (3) spouses") print(nl()) print(" (4) ancestors, (5) descendents, (6) everyone") print(nl()) getintmsg(ltype,"Choose subset of individuals: ") if (and(ge(ltype,1), le(ltype,6))) { set (valid, 1) } } while (le(startdate,0)) { getintmsg(startdate, "Enter start date for graph, e.g. 1852: ") } while (le(enddate,0)) { getintmsg(enddate, "Enter end date for graph, e.g. 1852: ") } while (and(ne(size,1), ne(size,2))) { getintmsg(size,"Select graph size (1) 80 col, (2) 132 col: ") } if (eq(size, 1)) { set(offset, sub(80, 26)) } else { set(offset, sub(130, 26)) } set(years, sub(enddate, startdate)) set(scale, div(years, offset)) if (gt(mod(years, offset), 0)) { set(scale, add(scale, 1)) } if (le(scale, 0)) { set(scale, 1) } /* put at bottom, + key*/ print("Scale: 1 point = ") print(d(scale)) print(" years") call datelin() pageout() call header() pageout() indiset(idx) if (eq(ltype, 1)) { addtoset(idx,indi,n) set(idx, parentset(idx)) } if (eq(ltype, 2)) { addtoset(idx,indi,n) set(idx, childset(idx)) } if (eq(ltype, 3)) { addtoset(idx,indi,n) set(idx, spouseset(idx)) } /*if (eq(ltype, 4)) { addtoset(idx,indi,n) set(idx, siblingset(idx)) }*/ if (eq(ltype, 4)) { addtoset(idx,indi,n) set(idx, ancestorset(idx)) } if (eq(ltype, 5)) { addtoset(idx,indi,n) set(idx, descendentset(idx)) } if (eq(ltype, 6)) { forindi(indiv,n) { addtoset(idx,indiv,n) } } /* lengthset() is not in this version of LL; wait until Ver. 2.3.5 if (eq(lengthset(idx), 0)) { print("This set contains no individuals, please try again.") print(" ") } else { */ namesort(idx) forindiset(idx,indiv,v,n) { call graph(indiv) /* outputs a 1 line "page" for each */ pageout() /* entry on graph */ } linemode() call printkey() /*}*/ } proc datelin() { set(linpos, 10) pos(linnum, linpos) "Name" set(linpos, 25) set(count, mul(scale, 5)) set(curyear, sub(startdate, mod(startdate, count))) while (le(curyear, enddate)) { pos(linnum, linpos) d(curyear) set(curyear, add(curyear,count)) set(linpos, add(linpos, 5)) } set(curyear, sub(curyear,count)) } proc header() { set(tmpyear, sub(startdate, mod(startdate, count))) pos(linnum, 1) "________________________" set(linpos, 25) set(i, 25) while (le(tmpyear, curyear)) { set(j, 0) while (lt(j, count)) { pos(linnum, linpos) if (or(eq(i, 25), eq(mod(i, 5),0))) { "|" } else { if (lt(tmpyear, curyear)) { "_" } } set(j, add(j,scale)) set(linpos, add(linpos, 1)) set(i, add(i,scale)) } set(tmpyear, add(tmpyear,count)) } } proc graph(indi) { set(linnum, 1) set(linpos, 1) pos(linnum, linpos) fullname(indi, 1, 0, 24) set(linpos, 25) print(".") /* birth event */ set(start, strtoint(year(birth(indi)))) if (eq(start, 0)) { set(start, strtoint(year(baptism(indi)))) } if (eq(start, 0)) { set(unknown, 1) } /* marriage event(s) */ list(mlist) spouses(indi, svar, fvar, no) { set(tdate, strtoint(year(marriage(fvar)))) if (ne(tdate,0)) { enqueue(mlist, tdate) } } set(myear, dequeue(mlist)) /* death event */ set(end, strtoint(year(death(indi)))) if (eq(end, 0)) { set(end, strtoint(year(burial(indi)))) } if (eq(end, 0)) { if (not(unknown)) { set(end, add(enddate, 1)) /* assume he is alive */ /*set(start, sub()*/ } } set(year, startdate) set(loop, 1) set(thisyear, strtoint(year(gettoday()))) if (le(thisyear, enddate)) { set(stopdate, thisyear) } else { set(stopdate, enddate) } set(last, 0) while (le(year, stopdate)) { pos(linnum, linpos) if (lt(year, start)) { if (eq(last,0)) { " " } } if (gt(year, end)) { if (eq(last,0)) { " " } } if (eq(year, start)) { "B" set(last, 1) } if (eq(year, end)) { "D" set(last, 1) } if (and(gt(year, start), le(year, end))) { if (eq(year, myear)) { "M" set(last, 1) set(myear, dequeue(mlist)) } } if (and(gt(year, start), lt(year, end))) { if (eq(last,0)) { if (ge(sub(end, start), 100)) { if (le(end,stopdate)) { "*" } else { if (ge(year,add(start,100))) { "?" } else { "*" } } } else { "*" } } } set(year, add(year, 1)) if (eq(loop, scale)) { set(loop, 1) set(last, 0) set(linpos, add(linpos, 1)) } else { set(loop, add(loop, 1)) } } } proc printkey() { nl() "Scale: 1 point = " d(scale) if (eq(scale,1)) { " year" } else { " years" } nl() "Key: B=birthdate, M=marriage, D=deathdate, *=living, ?=uncertainity" nl() } descendentset(idx)) } if (eq(ltype, 6)) { reports/stats 664 145 13 63030 6046160153 6707 /* stats - a LifeLines database statistical extraction report program by Jim Eggert (eggertj@atc.ll.mit.edu) Version 1 (14 Dec 1992) Version 2 (17 Dec 1992) added restrictions, unity, general GEDCOM tag, e, and today Version 3 (20 Dec 1992) added sorting Version 4 (30 Jan 1993) bugfix, modified find_bin to use requeue() Requires LifeLines v2.3.3 or later Version 5 (30 Jun 1993) changed bubblesort to listsort listsort code by John Chandler (JCHBN@CUVMB.CC.COLUMBIA.EDU) Version 6 (2 July 1993) added firstname, changed user interface Version 7 (16 Mar 1995) changed listsort to quicksort, modernized, fixed kids bug, added fage and mage Requires LifeLines v3.0.1 or later Version 8 (4 Sep 1995) added min and max, no printing of bogus 0s Version 9 (29 Sep 1995) fixed minor bugs, added indiset, substrings This LifeLines report program computes mean statistics of various quantities binned over other quantities. The quantities it knows about are ages at and dates of birth, christening, first and last marriage, first and last child's birth, death, burial, and today; the number of children, siblings, and marriages; and sex, surname, first name, soundex, and any simple GEDCOM tag. These can be combined nearly arbitrarily and evaluated over the whole database, or restricted to ancestors or descendants of a chosen individual or to members of a predetermined set. Further restrictions on the individuals included in the statistics can be based on any quantity that the program knows about. The program will optionally print out the names of all the individuals included in the statistics. For example, you can produce statistics of the age at death of as a function of birth year, dage vs byear the number of children of females named Smith as a function of year of first marriage, kids vs myear | sex = F & surname = Smith the number of spouses for male vs female blacksmiths, families vs sex | occu = blacksmith the age at last childbirth as a function of place of marriage. qage vs mplace the names of all Joneses who lived to be greater than 80 unity vs unity | surname = Jones & dage > 80 All this without writing any programs of your own. If a particular statistic for an individual is unavailable, and if the global variable not_strict is nonzero (as it is in the distribution version of this report, then certain guesses are allowed as to the value of that statistic. So far, these guesses are few. Birth year and month are guessed from baptismal date, and death year and month are guessed from burial date. The user is prompted for what quantity to plot vs what to bin over. Each is to be given as a specification string of the form e