home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
ftp.cs.arizona.edu
/
ftp.cs.arizona.edu.tar
/
ftp.cs.arizona.edu
/
icon
/
historic
/
v941.tgz
/
icon.v941src.tar
/
icon.v941src
/
ipl
/
progs
/
geddump.icn
< prev
next >
Wrap
Text File
|
2000-07-29
|
3KB
|
124 lines
############################################################################
#
# 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