proc main ()
{
dayformat(1)
monthformat(4)
set(root,"1")
list(abo_list)
push(abo_list,save(root))
call do_header()
forindi (person,ipers) {
if (and(not(father(person)),not(mother(person)),
eq(0,strcmp("Barbenoire",surname(person))))) {
/* les Barbenoire sans pere ni mere */
call arbre(person,abo_list)
}
}
call do_trailer()
}
proc do_header()
{
"\n"
"
\n"
"Familles Barbenoire de France\n"
"\n"
"Generated by the LifeLines Genealogical System on " stddate(gettoday()) "\n"
"
"
"\n"
}
proc arbre (indi_root,abo_list)
{
fornodes(inode(indi_root),node) {
if (eq(0,strcmp("_HTML",tag(node)))) {
value(node) "\n \n"
}
}
"\n\n"
call do_name(indi_root,abo_list)
"
\n
\n \n"
call desc_sub(indi_root,abo_list)
"
\n"
}
proc do_trailer()
{
""
"
"
"
"
"\n"
"\n"
"\n"
}
func lieudate(ev)
{
if (ne(0,strcmp(place(ev),""))) {
set(ld,concat(short(ev)," ",long(ev)))
set(pv,index(ld,", ",1))
set(dv,index(ld,", ",2))
return(substring(ld,add(pv,2),sub(dv,1)))
}
else {
return(date(ev))
}
}
func daterepu(unode,ev)
{
fornodes(unode,node) {
if (eq(0,strcmp(ev,tag(node)))) {
fornodes(node,cnode) {
if (eq(0,strcmp("DATE",tag(cnode)))) {
fornodes(cnode,ccnode) {
if (eq(0,strcmp("_REPU",tag(ccnode)))) {
return(value(ccnode))
}
}
}
}
}
}
return("")
}
proc do_name(person,abo_list)
{
set(h,"")
forlist(abo_list,l,li)
{ set(h,save(concat(h,l))) }
"" h " | \n"
"" fullname(person,0,1,80) " | \n"
"° "
if (e,birth(person)) {
lieudate(e)
set(repu,daterepu(inode(person),"BIRT"))
if (ne(0,strcmp("",repu))) { " (" repu ")\n" }
}
" | \n "
if (e,death(person)) {
lieudate(e)
set(repu,daterepu(inode(person),"DEAT"))
if (ne(0,strcmp("",repu))) { " (" repu ")\n" }
}
" | \n"
if(ne(0,nfamilies(person))) {
families(person,fam,sp,spi) {
if (ne(1,spi)) { " \n" }
"x "
if(marriage(fam)) {
lieudate(marriage(fam)) " "
set(repu,daterepu(fnode(fam),"MARR"))
if (ne(0,strcmp("",repu))) { " (" repu ")\n" }
}
if (sp) { fullname(sp,0,1,80) }
else { "?" }
if (male(person)) {
set(nc,nchildren(fam))
if (nc)
{ " (" d(nc) " enfant" if (gt(nc,1)) { "s" } ")"
}
}
}
" | \n"
}
fornodes(inode(person),node) {
if (eq(0,strcmp("OCCU",tag(node)))) {
"" value(node) " | \n"
}
}
}
func desc_code(number)
{
set(num,d(number))
if (eq(1,strlen(num)))
{ return(num) }
else
{ return(concat("-",num,"-")) }
}
proc desc_sub(person,abo_list)
{
set(chi,0)
families(person,fam,sp,spi) {
if (and(ne(0,nchildren(fam)),
or(male(person),
and(not(male(person)),
ne(0,strcmp("Barbenoire",surname(sp)))
)
)
)
) {
"\n"
"Descendance de " fullname(person,0,1,80)
if (sp) {
" et " fullname(sp,0,1,80) }
"\n"
children (fam,ch,famchi) {
incr(chi)
push(abo_list,save(desc_code(chi)))
"\n"
call do_name(ch,abo_list)
"
\n"
set(junk,pop(abo_list))
}
"
\n \n"
}
}
set(chi,0)
families(person,fam,sp,spi) {
if (and(ne(0,nchildren(fam)),
or(male(person),
and(not(male(person)),
ne(0,strcmp("Barbenoire",surname(sp)))
)
)
)
) {
children (fam,ch,famchi) {
incr(chi)
push(abo_list,save(desc_code(chi)))
call desc_sub(ch,abo_list)
set(junk,pop(abo_list))
}
}
}
}