~ubuntu-branches/ubuntu/trusty/lifelines/trusty

« back to all changes in this revision

Viewing changes to reports/all_anc_lines.ll

  • Committer: Bazaar Package Importer
  • Author(s): Felipe Augusto van de Wiel (faw)
  • Date: 2007-05-23 23:49:53 UTC
  • mfrom: (3.1.3 edgy)
  • Revision ID: james.westby@ubuntu.com-20070523234953-ogno9rnbmth61i7p
Tags: 3.0.50-2etch1
* Changing docs/ll-reportmanual.xml and docs/ll-userguide.xml to fix
  documentation build problems (Closes: #418347).

* lifelines-reports
  - Adding a dependency to lifelines >= 3.0.50 to prevent file conflict.
    (Closes: #405500).

* Updating French translation. Thanks to Bernard Adrian. (Closes: #356671).

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
/*
 
2
 * @progname    all_anc_lines.ll
 
3
 * @version     2
 
4
 * @author      Tom Wetmore
 
5
 * @category
 
6
 * @output      Text
 
7
 * @description
 
8
 *
 
9
 * report all ancestral lines in a Register-like format
 
10
 *
 
11
 
 
12
   all_anc_lines  -- Shows all ancestral lines of a specified person using
 
13
   a pseudo-Register format.  The paternal line of the person is shown
 
14
   first; then the paternal line of his/her mother; then the paternal line
 
15
   of his/her paternal grandmother; and so on, in a depth-first manner.
 
16
 
 
17
   A new feature was added to follow maternal lines also.
 
18
 
 
19
   Future option -- breadth first versus depth first coverage -- easy to
 
20
   implement by changing the algorithm that builds dlist from a stack to a
 
21
   queue.
 
22
 
 
23
   by Tom Wetmore, ttw@beltway.att.com
 
24
   version 1, 14 Nov 1995
 
25
   version 2, 23 Nov 1995
 
26
*/
 
27
 
 
28
global(mlist)   /* list of pending key persons */
 
29
global(glist)   /* generations of pending key persons */
 
30
global(stable)  /* table of seen key persons */
 
31
global(dlist)   /* list of final key persons */
 
32
global(hlist)   /* list of final generations */
 
33
global(ilist)   /* list of isolated persons */
 
34
global(pat)
 
35
global(depth)
 
36
global(ftable)  /* list of shown families */
 
37
global(ptable)  /* table of printed persons */
 
38
 
 
39
proc main ()
 
40
{
 
41
        getindi(i, "Enter person whose full registry ancestry is wanted.")
 
42
        if (i) {
 
43
                list(menu)
 
44
                enqueue(menu, "Follow paternal lines; or")
 
45
                enqueue(menu, "Follow maternal lines.")
 
46
                set(m, menuchoose(menu, "Select whether to:"))
 
47
                if (eq(1, m)) { set(pat, 1) }
 
48
                else          { set(pat, 0) }
 
49
                list(menu)
 
50
/*
 
51
                enqueue(menu, "Output lines depth-first; or")
 
52
                enqueue(menu, "Output lines breadth-first.")
 
53
                set(m, menuchoose(menu, "Select whether to:"))
 
54
                if (eq(1, m)) { set(depth, 1) }
 
55
                else          { set(depth, 0) }
 
56
*/
 
57
                list(mlist)
 
58
                list(glist)
 
59
                table(stable)
 
60
                list(dlist)
 
61
                list(hlist)
 
62
                list(ilist)
 
63
                table(ftable)
 
64
                table(ptable)
 
65
                call doit(i)
 
66
        } else {
 
67
                print("Program not run.")
 
68
        }
 
69
}
 
70
 
 
71
proc doit (i)
 
72
{
 
73
        call makedlist(i)
 
74
        call genreport()
 
75
}
 
76
 
 
77
proc makedlist (i)
 
78
{
 
79
        enqueue(mlist, i)
 
80
        enqueue(glist, 1)
 
81
        while (p, dequeue(mlist)) {
 
82
                set(g, dequeue(glist))
 
83
                enqueue(dlist, p)
 
84
                enqueue(hlist, g)
 
85
                while (p) {
 
86
                        set(g, add(g, 1))
 
87
                        if (pat) {
 
88
                                if (m, mother(p)) {
 
89
                                        if (not(lookup(stable, key(m)))) {
 
90
                                                insert(stable, save(key(m)), 1)
 
91
                                                enqueue(mlist, m)
 
92
                                                enqueue(glist, g)
 
93
                                        }
 
94
                                }
 
95
                                set(p, father(p))
 
96
                        } else {
 
97
                                if (f, father(p)) {
 
98
                                        if (not(lookup(stable, key(f)))) {
 
99
                                                insert(stable, save(key(f)), 1)
 
100
                                                enqueue(mlist, f)
 
101
                                                enqueue(glist, g)
 
102
                                        }
 
103
                                }
 
104
                                set(p, mother(p))
 
105
                        }
 
106
                }
 
107
        }
 
108
}
 
109
 
 
110
proc genreport ()
 
111
{
 
112
        call nroffhead()
 
113
        forlist (dlist, p, n) {
 
114
                set(g, dequeue(hlist))
 
115
                if (not(lookup(ptable, key(p)))) {
 
116
                        if (pat) { set(q, father(p)) }
 
117
                        else     { set(q, mother(p)) }
 
118
                        if (q) {
 
119
                                call showline(p, g)
 
120
                        } else {
 
121
                                insert (ptable, save(key(p)), 1)
 
122
                                enqueue(ilist, p)
 
123
                        }
 
124
                }
 
125
        }
 
126
        forlist (ilist, p, n) {
 
127
                "ISOLATED PERSON " name(p) "\n"
 
128
        }
 
129
}
 
130
 
 
131
proc showline (p, g)
 
132
{
 
133
        if (pat) {
 
134
                call showsurnames(p)
 
135
                /*".NL\nPATERNAL LINE OF " upper(name(p)) "\n\n"*/
 
136
                print(surname(p), "  ")
 
137
        } else {
 
138
                ".NL\nMATERNAL LINE OF " upper(name(p)) "\n\n"
 
139
        }
 
140
        list(alist)
 
141
        if (pat) {
 
142
                while (f, father(p)) {
 
143
                        push(alist, p)
 
144
                        set(p, f)
 
145
                        set(g, add(g, 1))
 
146
                }
 
147
        } else {
 
148
                while (m, mother(p)) {
 
149
                        push(alist, p)
 
150
                        set(p, m)
 
151
                        set(g, add(g, 1))
 
152
                }
 
153
        }
 
154
        push(alist, p)
 
155
        set(a, pop(alist))
 
156
        while (a) {
 
157
                set(b, pop(alist))
 
158
                call dotwo(a, b, g)
 
159
                set(a, b)
 
160
                set(g, sub(g, 1))
 
161
        }
 
162
}
 
163
 
 
164
proc dotwo (a, b, g)
 
165
{
 
166
        /*".GN\nGENERATION " d(g) "\n\n"*/
 
167
        ".IN\n" d(g) ". "
 
168
        call longvitals(a)      /* show main line person */
 
169
        insert(ptable, save(key(a)), 1)
 
170
 
 
171
        if (pat) { set(c, mother(b)) }
 
172
        else     { set(c, father(b)) }
 
173
        if (pat) { set(d, father(c)) }
 
174
        else     { set(d, mother(c)) }
 
175
 
 
176
        if (and(c, not(d))) {
 
177
                call gammavitals(c, a)
 
178
                insert(ptable, save(key(c)), 1)
 
179
        }
 
180
 
 
181
        call dochildren(a, b)
 
182
        if (and(c, not(d))) {
 
183
                call gammachildren(c)
 
184
        }
 
185
}
 
186
 
 
187
proc nroffhead ()
 
188
{
 
189
    ".de hd\n'sp .8i\n..\n"
 
190
    ".de fo\n'bp\n..\n"
 
191
    ".wh 0 hd\n.wh -.8i fo\n"
 
192
    ".de CH\n"
 
193
    ".sp\n"
 
194
    ".in 11n\n"
 
195
    ".ti 0\n"
 
196
    "\\h'3n'\\h'-\\w'\\\\$1'u'\\\\$1\\h'6n'\\h'-\\w'\\\\$2'u'\\\\$2\\h'1n'\n"
 
197
    "..\n"
 
198
 
 
199
    ".de IN\n.sp\n.in 0\n..\n"
 
200
    ".de NL\n.br\n.ne 2i\n.sp 2\n.in 0\n.ce\n..\n"
 
201
    ".de GN\n.br\n.ne 2i\n.sp 2\n.in 0\n.ce\n..\n"
 
202
    ".de P\n.sp\n.in 0\n.ti 5\n..\n"
 
203
    ".po 5\n"
 
204
    ".ll 7i\n"
 
205
    ".ls 1\n"
 
206
    ".na\n"
 
207
}
 
208
 
 
209
proc dochildren (i, c)
 
210
{
 
211
        if (c) { set(ckey, save(key(c))) }
 
212
        else   { set(ckey, "JUNK") }
 
213
        families (i, f, s, n) {
 
214
            ".P\n"
 
215
            if (s) { set(sname, save(name(s))) }
 
216
            else        { set(sname, "(_____)") }
 
217
            if (eq(0, nchildren(f))) {
 
218
                name(i) " and " sname
 
219
                " had no children.\n"
 
220
            } elsif (lookup(ftable, key(f))) {
 
221
                "Children of " name(i) " and " sname
 
222
                " listed under " sname ".\n"
 
223
/*
 
224
                children(f, k, m) {
 
225
                   if (not(strcmp(key(k), ckey))) {
 
226
                        ".CH (+) " roman(m) "\n"
 
227
                        call shortvitals(k)
 
228
                    } else {
 
229
                        ".CH \"\" " roman(m) "\n"
 
230
                        call shortvitals(k)
 
231
                    }
 
232
 
 
233
                }
 
234
*/
 
235
            } else {
 
236
                "Children of " name(i) " and " sname ":\n"
 
237
                children(f, k, m) {
 
238
                   if (not(strcmp(key(k), ckey))) {
 
239
                        /*print(name(k), "\n")*/
 
240
                        ".CH (+) " roman(m) "\n"
 
241
                        call shortvitals(k)
 
242
                    } else {
 
243
                        ".CH \"\" " roman(m) "\n"
 
244
                        call middlevitals(k)
 
245
                    }
 
246
                }
 
247
                insert(ftable, save(key(f)), 1)
 
248
            }
 
249
        }
 
250
}
 
251
 
 
252
proc shortvitals (i)
 
253
{
 
254
        name(i)
 
255
        set(b, birth(i))
 
256
        set(d, death(i))
 
257
        if (and(b, short(b))) { ", b. " short(b) }
 
258
        if (and(d, short(d))) { ", d. " short(d) }
 
259
        ".\n"
 
260
}
 
261
 
 
262
proc middlevitals (i)
 
263
{
 
264
        name(i) ".\n"
 
265
        set(e, birth(i))
 
266
        if(and(e,long(e))) { "Born " long(e) ".\n" }
 
267
        if (eq(1, nspouses(i))) {
 
268
                spouses(i, s, f, n) {
 
269
                        "Married"
 
270
                        call spousevitals(s, f)
 
271
                }
 
272
        } else {
 
273
                spouses(i, s, f, n) {
 
274
                        "Married " ord(n) ","
 
275
                        call spousevitals(s, f)
 
276
                }
 
277
        }
 
278
        set(e, death(i))
 
279
        if(and(e, long(e))) { "Died " long(e) ".\n" }
 
280
        set(p, 0)
 
281
}
 
282
 
 
283
proc longvitals (i)
 
284
{
 
285
        name(i) ".\n"
 
286
        set(e, birth(i))
 
287
        if(and(e,long(e))) { "Born " long(e) ".\n" }
 
288
        if (eq(1, nspouses(i))) {
 
289
                spouses(i, s, f, n) {
 
290
                        "Married"
 
291
                        call spousevitals(s, f)
 
292
                }
 
293
        } else {
 
294
                spouses(i, s, f, n) {
 
295
                        "Married " ord(n) ","
 
296
                        call spousevitals(s, f)
 
297
                }
 
298
        }
 
299
        set(e, death(i))
 
300
        if(and(e, long(e))) { "Died " long(e) ".\n" }
 
301
        set(p, 0)
 
302
        fornotes(inode(i), n) {
 
303
                if (not(p)) { ".P\n" set(p, 1) }
 
304
                n "\n"
 
305
        }
 
306
}
 
307
 
 
308
proc spousevitals (s, f)
 
309
{
 
310
        set(e, marriage(f))
 
311
        if (and(e, long(e))) { "\n" long(e) "," }
 
312
        "\n" name(s)
 
313
        set(e, birth(s))
 
314
        if (and(e, long(e)))  { ",\nborn " long(e) }
 
315
        set(e, death(s))
 
316
        if (and(e, long(e)))  { ",\ndied " long(e) }
 
317
        set(d, father(s))
 
318
        set(m, mother(s))
 
319
        if (or(d, m)) {
 
320
                ",\n"
 
321
                if (male(s))      { "son of " }
 
322
                elsif (female(s)) { "daughter of " }
 
323
                else              { "child of " }
 
324
        }
 
325
        if (d)         { name(d) }
 
326
        if (and(d, m)) { "\nand " }
 
327
        if (m)         { name(m) }
 
328
        ".\n"
 
329
}
 
330
 
 
331
proc gammavitals(a, c)
 
332
{
 
333
        set(n, nfamilies(a))
 
334
        set(m, mother(a))
 
335
        set(d, father(a))
 
336
        if (or(gt(n, 1), or(m, d))) {
 
337
                ".P\n" name(a) ", "
 
338
                if (or(d, m)) {
 
339
                        if (male(a))      { "son of " }
 
340
                        elsif (female(a)) { "daughter of " }
 
341
                        else              { "child of " }
 
342
                }
 
343
                if (d)         { name(d) }
 
344
                if (and(d, m)) { "\nand " }
 
345
                if (m)         { name(m) }
 
346
                if (or(d, m)) { ",\n" }
 
347
                if (gt(n, 1)) {
 
348
                        if (eq(1, nspouses(a))) {
 
349
                                spouses(a, s, f, n) {
 
350
                                        "Married "
 
351
                                        if (eqstr(key(c), key(s))) {
 
352
                                                name(s) ".\n"
 
353
                                        } else {
 
354
                                                call spousevitals(s, f)
 
355
                                        }
 
356
                                }
 
357
                        } else {
 
358
                                spouses(a, s, f, n) {
 
359
                                        "Married " ord(n) ","
 
360
                                        if (eqstr(key(c), key(s))) {
 
361
                                                name(s) ".\n"
 
362
                                        } else {
 
363
                                                call spousevitals(s, f)
 
364
                                        }
 
365
                                }
 
366
                        }
 
367
                ".\n"
 
368
                }
 
369
        }
 
370
}
 
371
proc gammachildren (p)
 
372
{
 
373
        families (p, f, s, n) {
 
374
                if (not(lookup(ftable, key(f)))) {
 
375
                        ".P\n"
 
376
                        if (s) { set(sname, save(name(s))) }
 
377
                        else   { set(sname, "(_____)") }
 
378
                        if (eq(0, nchildren(f))) {
 
379
                                name(p) " and " sname " had no children.\n"
 
380
                        } else {
 
381
                                "Children of " name(p) " and " sname ":\n"
 
382
                                children(f, k, m) {
 
383
                                        ".CH \"\" " roman(m) "\n"
 
384
                                        call middlevitals(k)
 
385
                                }
 
386
                        }
 
387
                }
 
388
        }
 
389
}
 
390
 
 
391
proc showsurnames(p)
 
392
{
 
393
        /*".NL\nPATERNAL LINE OF " upper(name(p)) "\n\n"*/
 
394
        ".NL\n"
 
395
        list(snames)
 
396
        table(stable)
 
397
        while (p) {
 
398
                if (not(lookup(stable, surname(p)))) {
 
399
                        enqueue(snames, save(surname(p)))
 
400
                        insert(stable, save(surname(p)), 1)
 
401
                }
 
402
                set(p, father(p))
 
403
        }
 
404
        set(c, "")
 
405
        forlist (snames, s, n) {
 
406
                c upper(s)
 
407
                set(c, ", ")
 
408
        }
 
409
        "\n"
 
410
}