/*
desc-henry - a LifeLines descendants listing program using Henry codes
        by Jim Eggert (eggertj@atc.ll.mit.edu)
        Versions 1-3 1992
        Version 4,  7 Jan 1993 (added generation limit)
        Version 5, 22 Dec 1993 (added header, trailer, and optional keys)

This program prints out a descendants report, assigning a modified
Henry code to the individuals.  The chosen ancestor, and all of
his/her spouses, descendants, and descendants' spouses are included in
the report.  Each is assigned a code specified by
        spousecode = descendantcode.sn
        descendantcode = descendantcode.c | root

where root is a string assigned by the user to the common ancestor for
the report (usually 1), descendantcode.c is the code for the c'th
child of the person whose code is descendantcode, and
descendantcode.sn is the code for the n'th spouse of the person whose
code is descendantcode.  If there is only one spouse, the index 1 is
omitted.

Thus if the common ancestor's root code is 1, then his spouse would be 1.s1,
his children would be 1.1, 1.2, 1.3, etc.  His children's spouses might be
1.1.s, 1.2.s1, 1.2.s2, etc.  His grandchildren might be 1.2.1, 1.2.2, etc.

The Henry code is printed before the name in the report, resulting in
automatic indentation by generation.  The root code is user selectable
so that you can have arbitrary Henry code prefixes:
        root = 1        root = John Jones
        1.3.1.2         John Jones.3.1.2
or so that you can print partial reports starting with anyone you like:
        root = 1        root = 1.4.1.3.5
        1.3.1.2         1.4.1.3.5.3.1.2
I use the latter feature because my database indicates that person X
was not a descendant of Y, but I want to rig up a report which indicates
X is to be included in Y's descendancy.  I make two reports, one of Y's
real descendancy, and the second of X's giving X the number he would
have in Y's descendancy.  Then I need merely edit the two files to
achieve the desired result.

The user can select whether no dates, simple dates (birth - death), or
dates and places (birth, baptism, death, burial, one per line) are to
be printed.  Also top-level notes can be optionally printed.  The
program only understands PAF-like events and notes.  Printing simple
dates and no notes gives a useful one-line-per-person outline.

The user can also elect to limit the number of generations to be printed
out.  Selecting 0 means all generations will be printed out.

The user can also elect to include keys for each individual in the report.

The report will include a header and a trailer.  You may easily modify the
do_header() and do_trailer() procedures to alter or eliminate these if
you wish.

*/

global(do_notes)
global(do_dates)
global(do_keys)
global(generations)

proc main ()
{
        dayformat(1)
        monthformat(4)
        getintmsg(do_dates,
          "Enter 0 for no dates, 1 for dates, 2 for dates+places")
        getintmsg(do_notes,"Enter 0 for no notes, 1 for notes")
        getintmsg(do_keys,"Enter 0 for no keys, 1 for keys")
        getindimsg(indi_root,
          "Enter individual for report generation")
        getstrmsg(root,
          "Enter Henry code string for individual (usually 1)")
        list(henry_list)
        push(henry_list,save(root))
        getintmsg(generations,"Enter number of generations (0=all)")
        call do_header(indi_root)
        call desc_sub(indi_root,henry_list)
        call do_trailer(indi_root)
}

proc do_header(indi_root)
{
        "desc-henry:  Descendant report for " fullname(indi_root,0,1,80)
        if (do_keys) { " (" key(indi_root) ")" }
        "\nGenerated by the LifeLines Genealogical System on "
        stddate(gettoday()) ".\n\n"
}

proc do_trailer(indi_root)
{
        "\nEnd of Report\n"
}

proc do_name(indi_node,henry_list,marr)
{
        forlist(henry_list,l,li) { l "." }
        " "
        if (indi_node) { fullname(indi_node,0,1,80) } else { "<SPOUSE>" }
        if (and(indi_node,eq(do_keys,1))) { " (" key(indi_node) ")" }
        if (and(indi_node,eq(do_dates,1))) {
                " ("
                set(e,birth(indi_node))
                if (and(e,date(e))) { date(e) }
                else {
                        set(e,baptism(indi_node))
                        if (and(e,date(e))) { "bap." date(e) }
                }
                " - "
                set(e,death(indi_node))
                if (and(e,date(e))) { date(e) }
                else {
                        set(e,burial(indi_node))
                        if (and(e,date(e))) { "bur." date(e) }
                }
                ")"
        }
        "\n"
        if (eq(do_dates,2)) {
                if (indi_node) {
                        if (e,birth(indi_node))   { "     b: " long(e) "\n" }
                        if (e,baptism(indi_node)) { "   bap: " long(e) "\n" }
                }
                if (marr)                         { "     m: " long(marr) "\n"}
                if (indi_node) {
                        if (e,death(indi_node))   { "     d: " long(e) "\n" }
                        if (e,burial(indi_node))  { "   bur: " long(e) "\n" }
                }
        }
        if (and(indi_node,eq(do_notes,1))) {
                fornodes(inode(indi_node), node) {
                        if (eq(0,strcmp("FILE", tag(node)))) {
                                copyfile(value(node)) }
                        elsif (eq(0,strcmp("NOTE", tag(node)))) {
                                "     " value(node) "\n"
                                fornodes(node, subnode) {
                                if (eq(0,strcmp("CONT", tag(subnode)))) {
                                "     " value(subnode) "\n" }
                                        }
                                }
                        }
                fornodes(inode(indi_node), node) {
                        if (eq(0,strcmp("REFN", tag(node)))) {
                                "     SOURCE: " value(node) "\n"
                        }
                }
        }
        if (or(eq(do_dates,2),eq(do_notes,1))) { "\n" }
}

proc desc_sub(indi_node,henry_list)
{
        call do_name(indi_node,henry_list,set(junk,0))
        set(nfam,nfamilies(indi_node))
        set(chi,0)
        families(indi_node,fam,sp,spi) {
                if (gt(nfam,1)) { push(henry_list,save(concat("s",d(spi)))) }
                else { push(henry_list,"s") }
                call do_name(sp,henry_list,marriage(fam))
                set(junk,pop(henry_list))
                if (or(eq(generations,0),
                       lt(length(henry_list),generations))) {
                        children (fam,ch,famchi) {
                                set(chi,add(1,chi))
                                push(henry_list,save(d(chi)))
                                call desc_sub(ch,henry_list)
                                set(junk,pop(henry_list))
                        }
                }
        }
}
