/*
 *   famrep1
 *
 *   Code by James P. Jones, jjones@nas.nasa.gov
 *
 *   This report works only with the LifeLines Genealogy program
 *
 *   version one of this report was written by James P. Jones, 28 Sep 1992
 *
 *   Family Group Sheet report program, with in-line source references.
 *
 *   I use:     tbl fam.out | xroff -me -tstdout | ipr -Pim7 -D"jobheader off"
 *   Can use:   tbl fam.out | xroff -me -PprinterName
 */

global(sourcelist)			/* list of all sources used */
global(sourcestr)

proc main ()
{
    monthformat(4)
    dateformat(0)
    set(TRUE, 1)
    set(FALSE, 0)
    list(sourcelist)
    getindi(indi)			/* select individual for report */
    set(i, nspouses(indi))
    spouses(indi, svar, fvar, no) {	/* display spouses */
        if (gt(i, 1)) {
	    if (gt(no, 4)) {		/* leave space for prompt */
		print(nl())
		print(nl())
		print(nl())
		print(nl())
	    }
	    print(d(no))
	    print(". ")
	    print(fullname(svar,TRUE,FALSE,50))
	    print(nl())
	}
    }
    if (gt(i, 1)) {			/* select a spouse */
	getintmsg(num, "Choose which spouse for Family Report: ")
    }
    else { 
	set(num, 1)
    }
    spouses(indi, svar, fvar, no) {
        if (eq(no, num)) {
	    if (eq(strcmp(sex(indi), "F"), 0)) {
	        set(tmp, indi)		/* Check sex of individual,*/ 
	        set(indi, svar)		/* if Female, replace with */
	        set(svar, tmp)		/* information on husband. */
	        set(i, nspouses(indi))	/* Easier if assume head-  */
	        set(num, 1)		/* of-household is male... */
                if (gt(i, 1)) {
	            spouses(indi, tmps, tmpf, no) {
	                if (eq(name(svar), name(tmps))) { 
			    set(num, no)
	                }
	            }
                }
	    }
	    call doform(indi, svar, fvar, i, num)
	}
    }
    call printsources(sourcelist)
    print("Report Done, ")
}

/* Produce the Family Group Sheet form.
 */
proc doform(indi, svar, fvar, numsp, cursp)
{
    ".po 0.8i" nl()
    ".ll 6.8i" nl()
    ".pl +1.5i" nl()
    ".nf" nl()
    ".ps 16" nl()
    ".(b C" nl()
    if (e, surname(indi)) { upper(surname(indi)) }
    "\0FAMILY\0GROUP\0SHEET" nl()
    ".ps 10" nl()
    "Compiled by: \fIJames\0Patton\0Jones\fR\0on\0\fI"
    stddate(gettoday())
    "\fR" nl()
    ".vs 10" nl()
    "\fI619\0West\0Remington\0Drive,\0Sunnyvale,\0CA\094087\fR" nl()
    "\fIPhone:\0408.739.4556\0\0\0E-mail:\0jjones@nas.nasa.gov\fR" nl()
    ".)b" nl()
    ".ps 8" nl()
    ".TS" nl()
    "tab(+) expand box;" nl()
    "l s s." nl()
    "Husband's Full Name:\0\fI"
    if (e, name(indi)) { name(indi) "\fR" nl() }
    else { "\fR" }
    "_" nl()
    ".T&" nl()
    "l | l | l." nl()
    "Husband's Data+Day Month Year+City,\0\0Town or Place\0\0County or Province\0\0State or Country" nl()
    "_" nl()
    "\0Birth+\fI"
    set(aday, birth(indi))
    if (e, stddate(aday)) { stddate(aday) }
    "+"
    if (e, place(aday)) { place(aday) } "\fR"
    if (aday) { call dosource(aday) } nl()  	/* note: first call to source */
    "_" nl()
    "\0Christened+\fI"
    set(aday, baptism(indi))
    if (e, stddate(aday)) { stddate(aday) }
    "+"
    if (e, place(aday)) { place(aday) } "\fR"
    if (aday) { call dosource(aday) } nl()
    "_" nl()
    "\0Married+\fI"
    set(aday, marriage(fvar))
    if (e, stddate(aday)) { stddate(aday) }
    "+"
    if (e, place(aday)) { place(aday) } "\fR"
    if (aday) { call dosource(aday) } nl()
    "_" nl()
    "\0Death+\fI"
    set(aday, death(indi))
    if (e, stddate(aday)) { stddate(aday) }
    "+"
    if (e, place(aday)) { place(aday) } "\fR"
    if (aday) { call dosource(aday) } nl()
    "_" nl()
    "\0Burial+\fI"
    set(aday, burial(indi))
    if (e, stddate(aday)) { stddate(aday) }
    "+"
    if (e, place(aday)) { place(aday) } "\fR"
    if (aday) { call dosource(aday) } nl()
    "=" nl()
    ".T&" nl()
    "l | l s." nl()
    "\0Father's Name:+\fI"
    if (e, name(father(indi))) { name(father(indi)) "\fR" nl() }
    else { "\fR" nl() }
    "_" nl()
    "\0Mother's Maiden Name:+\fI"
    if (e, name(mother(indi))) { name(mother(indi)) "\fR" nl() }
    else { "\fR" nl() }
    "_" nl()
    "\0Other Wives:\fI"
    set(f, 0)
    set(spstr, save(name(wife(fvar))))
    spouses(indi, wifenm, tmpfvar, no) {
        set(wstr, save(name(wifenm)))
	if (ne(strcmp(spstr, wstr), 0)) {
            "\fI+"
            name(wifenm)
	    "\fR" nl()
	    set(f,1)
        }
    }
    if (eq(f, 0)) { "\fR" nl() }
    "_" nl()
    ".T&" nl()
    "l s s s." nl()
    " " nl()
    "Wife's Full Maiden Name:\0\fI"
    if (e, name(svar)) { name(svar) }
    "\fR" nl()
    "_" nl()
    ".T&" nl()
    "l | l | l." nl()
    "Wife's Data   +Day Month Year+City,\0\0Town or Place\0\0County or Province\0\0State or Country" nl()
    "_" nl()
    "\0Birth+\fI"
    set(aday, birth(svar))
    if (e, stddate(aday)) { stddate(aday) }
    "+"
    if (e, place(aday)) { place(aday) } "\fR"
    if (aday) { call dosource(aday) } nl()
    "_" nl()
    "\0Christened+\fI"
    set(aday, baptism(svar))
    if (e, stddate(aday)) { stddate(aday) }
    "+"
    if (e, place(aday)) { place(aday) } "\fR"
    if (aday) { call dosource(aday) } nl()
    "_" nl()
    "\0Death+\fI"
    set(aday, death(svar))
    if (e, stddate(aday)) { stddate(aday) }
    "+"
    if (e, place(aday)) { place(aday) } "\fR"
    if (aday) { call dosource(aday) } nl()
    "_" nl()
    "\0Burial+\fI"
    set(aday, burial(svar))
    if (e, stddate(aday)) { stddate(aday) }
    "+"
    if (e, place(aday)) { place(aday) } "\fR"
    if (aday) { call dosource(aday) } nl()
    "=" nl()
    ".T&" nl()
    "l | l s." nl()
    "\0Father's Name:+\fI"
    if (e, name(father(svar))) { name(father(svar)) "\fR" nl() }
    else { "\fR" nl() }
    "_" nl()
    "\0Mother's Maiden Name:+\fI"
    if (e, name(mother(svar))) { name(mother(svar)) "\fR" nl() }
    else { "\fR" nl() }
    "_" nl()
    "\0Other Husbands:\fI"
    set(f, 0)
    set(spstr, save(name(indi)))
    spouses(svar, hubby, tmpfvar, no) {
        set(hstr, save(name(hubby)))
	if (ne(strcmp(spstr, hstr), 0)) {
            "\fI+"
            name(hubby)
	    "\fR" nl()
	    set(f,1)
        }
    }
    if (eq(f, 0)) { "\fR" nl() }
    "_" nl()
    ".TE" nl()
						/* now for the children... */
    ".TS" nl()
    "tab(+) expand box;" nl()
    "l | l | l | l | l." nl()
    "Children's Full Names+Sex+Children's Data+Day Month Year+"
    "City, Town or Place County or Province State or Country" nl()
    "_" nl()

    children(fvar, cvar, no) {
	if (or(eq(no, 4), eq(no, 12))) {	/* If 4th or 12th kid, start  */
            ".TE" nl() 				/* a new page. There was an   */
	    ".bp" nl()				/* old woman, who lived in a  */
            ".TS" nl()			     /* shoe, she had so many kids... */
            "tab(+) expand box;" nl()
            "l | l | l | l | l." nl()
            "Children's Full Names+Sex+Children's Data+Day Month Year+"
	    "City, Town or Place County or Province State or Country" nl()
            "_" nl()
	}
        "T{" nl()
	"\fI("
	d(no)
	") "
	if (e, name(cvar)) { name(cvar) }
	"\fR" nl()
        "T}+\fI"
	sex(cvar)
	"\fR+Birth+\fI"
        set(aday, birth(cvar))
        if (e, stddate(aday)) { stddate(aday) }
	"+"
        if (e, place(aday)) { place(aday) } "\fR"
        if (aday) { call dosource(aday) } nl()
        "_" nl()
        "\^+\^+Death+\fI"
        set(aday, death(cvar))
        if (e, stddate(aday)) { stddate(aday) }
        "+"
        if (e, place(aday)) { place(aday) } "\fR"
        if (aday) { call dosource(aday) } nl()
        "_" nl()
        "\^+\^+Burial+\fI"
        set(aday, burial(cvar))
        if (e, stddate(aday)) { stddate(aday) }
        "+"
        if (e, place(aday)) { place(aday) } "\fR"
        if (aday) { call dosource(aday) } nl()
        "_" nl()

	families(cvar, cfvar, csvar, no) {		/* spouses */
            "\^+\^+Marriage+\fI"
            set(aday, marriage(cfvar))
            if (e, stddate(aday)) { stddate(aday) }
	    "+"
	    if (e, name(csvar)) { name(csvar) }
            if (aday) { call dosource(aday) }
            "\fR" nl()
            "_" nl()
	}
	"=" nl()
    }
    ".TE" nl() 
}


/* Short macro procedure to combine SOURCE and SOURCENUM calls, to shorten
 * above report code.
 */
proc dosource(eventnode)
{
    call source(eventnode)		/* get source of data */
    if (sourcestr) {			/* if source not NULL */
        call sourcenum()		/* print source number */ 
    }
}

/* Retrieve source from a given event (EVENTNODE), and save it in the global
 * string SOURCESTR.
 */
proc source(eventnode)
{
    traverse(eventnode, node, lev) {
       if (eq(strcmp(tag(node), "SOUR"), 0)) {
           set(sourcestr, value(node))
       }
    }
}

/* Create a "List of Sources" table for the report; in the report itself,
 * print only a footnote number, and later the list these number refer to
 * can be printed (via PRINTSOURCES).
 */
proc sourcenum()
{
    set(found,0)
    forlist(sourcelist, item, i) {
	if (eq(strcmp(item, sourcestr), 0)) {	/* if source in list */
	    " \s7(" d(i) ")\s8"                 /* print out source index */
	    set(found, 1)
	}
    }
    if (not(eq(found, 1))) {
	push(sourcelist, sourcestr)		/* otherwise add it to list */
	" \s7(" d(add(i,1)) ")\s8"		/* and print source index */
    }
}

/* Print a list of all the sources refered to in the document. The numbers
 * preceeding each source entry are what the in-line references refer to.
 */
proc printsources(slist)
{
    if (not(empty(slist))) {
        ".(b C" nl()
        "LIST OF SOURCES REFERENCED IN THIS REPORT" nl()
        ".)b" nl()
        nl()
        nl()
        forlist(slist, item, i) {
	    "(" d(i) ")  " item nl()
        }
    }
}

/* End of Report */