############################################################################
#
#	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
