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
|
############################################################################
#
# File: geddump.icn
#
# Subject: Program to dump contents of GEDCOM file
#
# Author: Gregg M. Townsend
#
# Date: July 3, 1998
#
############################################################################
#
# This file is in the public domain.
#
############################################################################
#
# usage: geddump [file]
#
# This program prints the genealogical information contained
# in a GEDCOM file. Individuals are printed alphabetically,
# with sequence numbers to assist cross-referencing.
#
# Marriages are noted for both partners. Children are listed
# under the father, or under the mother if no father is known.
#
############################################################################
#
# Links: gedcom
#
############################################################################
link gedcom
record person(n, k, r) # number, sort key, gedrec node
global ptab # person number table, indexed by gedrec node
procedure main(args)
local f, g, i, n, p, r, plist, fam, husb, sp, b, d, byr, dyr
if *args > 0 then
f := open(args[1]) | stop("can't open ", args[1])
else
f := &input
g := gedload(f)
close(f)
plist := []
ptab := table()
every r := !g.ind do
put(plist, ptab[r] := person(0, sortkey(r), r))
plist := sortf(plist, 2)
n := 0
every (!plist).n := (n +:= 1)
every p := !plist do {
b := gedsub(p.r, "BIRT") | &null
d := gedsub(p.r, "DEAT") | &null
write()
writes("[", p.n, "] ", gedlnf(p.r))
byr := gedyear(\b) | &null
dyr := gedyear(\d) | &null
if \byr | \dyr then
writes(" (", byr, " - ", dyr, ")")
write()
if fam := gedref(p.r, "FAMC") then {
refto("father", gedref(fam, "HUSB"))
refto("mother", gedref(fam, "WIFE"))
}
event("b.", \b)
r := &null
every fam := gedref(p.r, "FAMS") do { # for every family
r := event("m.", gedsub(fam, "MARR"))
r := refto(" husb", p.r ~=== gedref(fam, "HUSB"))
r := refto(" wife", p.r ~=== gedref(fam, "WIFE"))
# if had earlier kids and did not indicate remarriage, do so now
if \r then
write(" m.")
# print children under husband, or under wife if no husband
if (p.r === gedref(fam, "HUSB")) | (not gedref(fam, "HUSB")) then {
every r := gedref(fam, "CHIL") do {
case (gedval(r, "SEX") | "") of {
"M": refto(" son", r)
"F": refto(" dau", r)
default: refto(" child", r)
}
}
}
}
event("d.", \d)
}
end
procedure event(label, r)
local date, place
date := ("" ~== geddate(r))
place := ("" ~== gedval(r, "PLAC"))
if /place then
write(" ", label, " ", \date)
else
write(" ", label, " ", \date | " ", " ", place)
return
end
procedure refto(label, r)
write(" ", label, " [", ptab[r].n, "] ", gedfnf(r))
return
end
procedure sortkey(r)
return map(gedlnf(r))
end
|
