File: line.ll

package info (click to toggle)
lifelines 3.0.50-2
  • links: PTS
  • area: main
  • in suites: etch-m68k
  • size: 11,140 kB
  • ctags: 6,517
  • sloc: ansic: 57,468; xml: 8,014; sh: 4,255; makefile: 848; yacc: 601; perl: 170; sed: 16
file content (148 lines) | stat: -rw-r--r-- 3,806 bytes parent folder | download | duplicates (5)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
/*
 * @progname       line.ll
 * @version        1
 * @author         J.F. Chandler
 * @category       
 * @output         Text
 * @description
 *
displays the descendancy line(s) from one person to another.
This program assumes no individual has more than one set of parents.

Algorithm partly borrowed from TTW's cousins program.

Version 1 - 1998 Apr 22 - J.F. Chandler

  This program requires version 3 of LifeLines.
*/

global(link1)   /* table of links back one person */
global(link2)   /* table of alternate links */
global(elist)   /* list of chain ends */
global(dots)    /* person counter */

proc main () {
getindimsg(from,"Which ancestor?")
set(to,0)
if(from) {
        getindimsg(to,"Which descendant?")
}
if(not(and(from,to))) {
        print("Not found\n")
        return()
}
set(fkey,save(key(from)))
set(tkey,save(key(to)))
"Descendancy line from " name(indi(fkey)) "\nto " name(indi(tkey)) ":\n"
print("Searching for the line(s) from:\n",name(from)," to ",name(to))
print(".\n\nThis may take a while -- ")
print("each dot is 25 persons considered.\n")

table(link1)
table(link2)
list(elist)

set(dots,0)
set(found,0)
set(gen,0)
set(maxgen,0)

/* Link the ancestor to self (unique marker), and add as the first
entry in the list of chain ends.  A "zero" person in the list marks
the end of a generation. */

insert(link1,fkey,fkey)
enqueue(elist,fkey)
enqueue(elist,0)

/* Iterate through the list of chain ends, removing them one by one;
link their children back to them; add the children to the chain end
list; check each iteration to see if the target person has been found
through both parents; if so quit the iteration; also quit three
generations after finding through either parent.  */

while(gt(length(elist),1)) {
        set(key,dequeue(elist))
        if(not(key)) {
                set(gen,add(1,gen))
                if(eq(gen,maxgen)) { break() }
                enqueue(elist,0)
                continue()
        }
        set(indi,indi(key))
        families(indi,fam,sp,n1) {
                children(fam,child,n2) {
                        call include(key,child)
                }
        }
        if(not(found)) {
                if(lookup(link1,tkey)) {
                        set(found,1)
                        set(maxgen,add(3,gen))
                }
        } elsif(lookup(link2,tkey)) { break() }
}

/* Quit if the "from" is not an ancestor of the "to" person. */

if(not(found)) {
        print("\nThere is no such line.")
        "There is no such line.\n"
        return()
}

set(gen,1)
"\nWorking back:\n\n1. " call do_person(indi(tkey))
call printrest(tkey,gen)
}

/* Recursively print the rest of the line back to the source.
If the current person is linked through both parents, also print
the alternate line starting from here. */

proc printrest(key,gen) {
set(gen,add(1,gen))
set(new,lookup(link1,key))
if(eq(0,strcmp(key,new))) { return() }
d(gen) ". " call do_person(father(indi(key)))
"    & " call do_person(mother(indi(key)))
if(alt,save(lookup(link2,key))) { "* " }        /* mark a branch point */
call printrest(new,gen)
if(alt) {
        nl()
        call printrest(alt,gen)
}}

/* Link a new child (indi) back to a parent (key).
If the new child has already been linked once, use alternate table.
A truly new child is added to the list of chain ends */

proc include(key,indi) {

set(dots,add(dots,1))
if(eq(25,dots)) {
        set(dots,0)
        print(".")
}

set(new,save(key(indi)))
if(lookup(link1,key(indi))) {
        insert(link2,new,key)
} else {
        insert(link1,new,key)
        enqueue(elist,new)
}}

/* Print name and dates for a given person */

proc do_person(p) {
name(p) " ("
set(e,birth(p))
if(not(e)) {set(e,baptism(p))}
if(e) {date(e)}
" - "
set(e,death(p))
if(not(e)) {set(e,burial(p))}
if(e) {date(e)}
")\n"
}