Person ( ¶ ) ( ® ) (List of Persons.)
Born: birthdate * birthplace
Died: deathdate + deathplace . Buried: burialplace
List of Persons in data base.
malePerson * birthdate + deathdate Father_//\_Mother
femalePerson * birthdate + deathdate Father_//\_Mother
Immediate Family of Person
Father_//\_Mother & mdate @ mplace
| ¶
|_____ sibling1 * sibling1birthdate + sibling1deathdate
|_____ siblingN * siblingNbirthdate + siblingNdeathdate
|
Person_//\_Spouse1 & m1date @ m1place
| | | ¶ ®
| | |_____ m1child1 * m1child1birthdate + m1child1birthdate
| | |_____ m1childN * m1childNbirthdate + m1childNbirthdate
| |
| |_//\_Spouse2 & m2date @ m2place
| | ¶
| |_____ m2child1 * m2child1birthdate + m2child1birthdate
| |_____ m2childN * m2childNbirthdate + m2child2birthdate
|
|_//\_SpouseN & mNdate @ mNplace
| ¶
|_____ mNchild1 * mNchild1birthdate + mNchild1birthdate
|_____ mNchildN * mNchildNbirthdate + mNchildNbirthdate
Ancestors of Person
,-GreatGrandFather (FFF) * birthdate + deathdate
,-GrandFather (FF) * birthdate + deathdate
| `-GreatGrandMother (FFM) * birthdate + deathdate
,-Father (F) * birthdate + deathdate
| | ,-GreatGrandFather (FMF) * birthdate + deathdate
| `-GrandMother (FM) * birthdate + deathdate
| `-GreatGrandMother (FMM) * birthdate + deathdate
Person * birthdate + deathdate
| ,-GreatGrandFather (MFF) * birthdate + deathdate
| ,-GrandFather (MF) * birthdate + deathdate
| | `-GreatGrandMother (MFM) * birthdate + deathdate
`-Mother (M) * birthdate + deathdate
| ,-GreatGrandFather (MMF) * birthdate + deathdate
`-GrandMother (MM) * birthdate + deathdate
`-GreatGrandMother (MMM) * birthdate + deathdate
a template to represent Genealogy data in HTML hypertext.
* replace all ocurrences of each appropriate ITEM with ACTUAL DATA
e.g. search-replace-all Person with: My Name
e.g. query-search-replace Mother with: My Mother's Name
* judiciously edit .htm file names in anchors
* add/remove lines for children, siblings, spouses as necessary
############### end genealogytemplate.html ###################################
* In an HTML file (maybe HOME PAGE) have an anchor pointing to GenealogyFile:
* ( see the hint at the end of a NORMAL run )
_____________________________________________________________________________
* The PN{IRN}.DBNAME files are used to generate the "more info" " ¶ " files.
* Whenever the PN{IRN}.DBNAME is changed or replaced, the corresponding " ¶ "
* "more info " file will be updated if 'rx Scion2html.rexx {IRN}' is re-run.
* PP & FP Notes: (personal & family pictures; picture albums " ® ")
* ScionGenealogist names pictures as;
* PP{IRN}.DBNAME (personal) and FP{mFGRN}.DBNAME (family)
* {P|F}P{IRN|mFGRN}.DBNAME now used as pictures & links.
* GfxCon is used to copy/reduce jpegs from {P|F}P{IRN|mFGRN}.DBNAME
* reductions are anchors pointing to html's for pictures albums
* reductions in pictures albums are anchors pointing to pictures
* picture albums will not be overwritten; they may be updated with
* additional pictures; links to other pictures, etc.
* Whenever picture {P|F}P{IRN|mFGRN}.DBNAME is changed or replaced,
* the corresponding jpegs will be updated
* {P|F}P{IRN|mFGRN}.DBNAME may be any legal GfxCon input picture FORMAT
* (ILBM,RGB8,PCX,BMP,RLE8,TIFF,Targa,LBM,RGBN,IMG,RLE4,GIF,JPEG,RGB-Raw)
*/
IF GeneralPrefix = "" then GeneralPrefix = "GENEAFI"
/* add libraries */
libs = 'rexxsupport.library rexxarplib.library'
DO i = 1 TO Words(libs)
lib = Word(libs,i)
IF ~Show('Lib',lib) THEN DO
IF EXISTS('LIBS:'lib) then call addlib lib, 0, -30
ELSE DO
'message "===> cannot find' lib 'in LIBS:"'
EXIT 10
END
END
END i
DoPictures = EXISTS("Sys:Tools/GfxCon")
IF ~DoPictures THEN DO
SAY ' '
say 'GfxCon not found in Sys:Tools - unable to include pictures'
END
Address "SCIONGEN" /* Point at Scion Genealogist port */
options RESULTS
P1 = ""
IF Show(p,'SCIONGEN') THEN DO
'GETDBNAME' /* Issue GET DB NAME command to Scion Genealogist */
DBNAME = RESULT
END
PARSE ARG target
target = Upper(strip(target,,'"')) /* just in case, remove errant quotes */
DO WHILE target = '' | target = '?' | target = 'INFO' | target = 'HELP'
SAY ' '
SAY ' please send comments, questions to: ipolyi@pat.mdc.com'
SAY ' or:'
SAY ' Scion2html.rexx © Harold H. Ipolyi '
SAY ' P.O.Box 891206 '
SAY ' Houston, Tx 77289-1206 '
SAY ' _________________________________________________________'
SAY ' / \'
SAY ' [re]create html hypertext from ScionGenealogist data base '
SAY ' \_________________________________________________________/'
SAY ' '
SAY ' Usage: start Scion & load a genealogy database;'
SAY ' '
SAY ' back on WB, start a Shell;'
SAY ' '
SAY ' assign Genealogy: {Volume:Directory} (of Genealogy data base)'
SAY ' '
SAY ' cd to a target directory; i.e. wherein directory of html''s will/does exist'
SAY ' '
SAY ' execute:'
SAY ' '
SAY ' rx Scion2html.rexx Normal -> recreates all .htm files'
SAY ' or:'
SAY ' rx Scion2html.rexx IRN -> specific person''s P{IRN}.htm file'
SAY ' '
IF DBNAME = "DBNAME" THEN EXIT
/* EXIT
END
*/
SAY ' Enter "Normal" to recreate all P#.htm files; or'
SAY ' '
SAY ' a 'DBNAME' Scion data base "IRN" to recreate a specific P{IRN}.htm file.'
SAY ' '
PULL target
target = Upper(strip(target,,'"')) /* just in case, remove errant quotes */
END
IF target = '' | target = 'Q' | target = 'EXIT' | target = 'QUIT' THEN
EXIT
IF ~Show(p,'SCIONGEN') THEN DO
SAY ' '
SAY ' Cannot proceed because ScionGenealogist is NOT currently running:'
SAY ' '
SAY ' Please start Scion, load desired data base, then try again...'
SAY ' '
EXIT
END
IF target = 'N' THEN
target = 'NORMAL'
IF target = 'T' THEN
target = 'TEST'
/* SAY target */
'GETPROGVERSION'
VERSION = RESULT
IF VERSION < 3.13 THEN DO
SAY ' '
say ' Requires VERSION = 3.13 or greater'
SAY ' '
EXIT
END
/* ??? GETDBDIRPATH ??? of Scion data base */
SAY ' '
Say ' Testing: is data base assignment of Genealogy:'DBNAME' visible?'
SAY ' '
PRAGMA('w','n')
IF ~Exists("Genealogy:"DBNAME) THEN DO
SAY ' Genealogy:'DBNAME' not found,'
SAY ' '
SAY " Please create an assign to directory containing data base "DBNAME":"
SAY ' '
SAY ' assign Genealogy: {Volume:Directory}'
SAY ' '
EXIT
END
PRAGMA('w','w')
Gdir = DBNAME'G'
Tdir = DBNAME'T'
IF ~Makedir(Gdir) THEN DO
SAY ' '
SAY ' ===> unable to create directory: 'Gdir
SAY ' '
EXIT
END
IF ~Makedir(Tdir) THEN DO
SAY ' '
SAY ' ===> unable to create directory: 'Tdir
SAY ' '
EXIT
END
'GETTOTALIRN' /* Issue command to Scion Genealogist */
TOTALIRN = RESULT
Say "Number of people in database " DBNAME " = " TOTALIRN
SAY ' '
'GETPERSLABEL' 1
PERSLABEL1 = RESULT
'GETPERSLABEL' 2
PERSLABEL2 = RESULT
'GETPERSLABEL' 3
PERSLABEL3 = RESULT
'GETFAMLABEL' 1
FAMLABEL1 = RESULT
'GETFAMLABEL' 2
FAMLABEL2 = RESULT
IF IsNumeric(target) THEN
DO
Say 'Processing person ' target ' of ' TOTALIRN ' in database ' DBNAME
IF target <= TOTALIRN THEN DO
Open('GenealogyText',Tdir'/G'target,'w')
CALL MakeOne(target,0)
Close('GenealogyText')
END
END
ELSE DO
target = Upper(target)
IF target = "TEST" THEN DO
DO i = 1 TO 7
Open('GenealogyText',Tdir'/G'i,'w')
CALL MakeOne(i,0)
Close('GenealogyText')
END
END
ELSE DO
Say "Processing all " TOTALIRN " persons in database " DBNAME
/* GENEAFIL.htm is a Scion data base IRN order list of all persons in
html format:
person * birthdate + deathdate (()) father //\ mother */
Say 'file name: 'Gdir'/'GeneralPrefix'L.htm for: List of Persons.'
Open('GenealogyFile',Gdir'/'GeneralPrefix'L.htm','w')
WriteLn('GenealogyFile','')
WriteLn('GenealogyFile','List of Persons. ')
WriteLn('GenealogyFile','List of Persons in data base "'DBNAME'". 'Time()' - 'Date()'
')
WriteLn('GenealogyFile','')
Open('GenealogyText',Tdir'/GenealogyOf'DBNAME,'w')
WriteLn('GenealogyText','Genealogy Data Base "'GetLastName(DBNAME)'"')
WriteLn('GenealogyText','')
WriteLn('GenealogyText','-----------------------------------------------------------')
WriteLn('GenealogyText','')
DO i = 1 TO TOTALIRN
CALL MakeOne(i,1)
END
WriteLn('GenealogyFile','
')
WriteLn('GenealogyFile','
')
WriteCh('GenealogyFile','')
WriteCh('GenealogyFile','Amiga® ')
'GETPROGVERSION'
VERSION = RESULT
WriteCh('GenealogyFile','(Scion')
IF VERSION > 0 THEN WriteCh('GenealogyFile','V'VERSION)
WriteLn('GenealogyFile',' © Robbie J Akins) ')
if DoPictures THEN DO
WriteCh('GenealogyFile','(GfxCon © Dirk Farin) ')
END
WriteCh('GenealogyFile','(Scion2html.rexx © ')
WriteCh('GenealogyFile','Harold Ipolyi)')
WriteCh('GenealogyFile','
')
WriteLn('GenealogyFile','')
END
Say ' '
ThisPath = PRAGMA('d')
IF Substr(ThisPath,Length(ThisPath),Length(ThisPath)) ~= ":" THEN ThisPath = ThisPath'/'
Say ' ---------------------------------------------------------------------'
Say ' If you have not already done so, add the following anchor pointing to'
Say ' "'GetLastName(DBNAME)' Genealogy" to a html file (maybe HOME PAGE): '
Say ' ---------------------------------------------------------------------'
Say ' 'GetLastName(DBNAME)' Genealogy'
Say ' ---------------------------------------------------------------------'
Say ' and maybe:'
Say ' ---------------------------------------------------------------------'
IF GeneralPrefix = "GENEAFI" THEN
Say ' Genealogy of 'P1''
ELSE
Say ' Genealogy of 'P1''
Say ' ---------------------------------------------------------------------'
END
SAY ' '
Say 'Scion2html.rexx completed normally'
EXIT
/*************************************************************************/
MakeOne: PROCEDURE EXPOSE target Thumbnail Thumbformat P1 DBNAME GeneralPrefix Gdir Tdir DoPictures FAMLABEL1 FAMLABEL2 PERSLABEL1 PERSLABEL2 PERSLABEL3
PARSE ARG ScionIRN, EndOfFile
'EXISTPERSON' ScionIRN
/**/
if RESULT = 'YES' THEN DO
/**/
IF GeneralPrefix = "GENEAFI" THEN DO
PersonPrefix = "P" /* Person file name prefix */
FamilyPrefix = "F" /* Family file name prefix */
END
ELSE DO
PersonPrefix = GeneralPrefix"P" /* Person file name prefix */
FamilyPrefix = GeneralPrefix"F" /* Family file name prefix */
END
IF FamilyPrefix = PersonPrefix THEN DO
say ' FamilyPrefix MUST NOT EQUAL PersonPrefix'
say ' 'FamilyPrefix' 'PersonPrefix
EXIT
END
HasFileFATHER = 0
HasFileMOTHER = 0
HasMOTHER = 0
HasFATHER = 0
HasPARENTS = 0
HasCHILDREN = 0
DoGenText = 0
'GETPARENTS' ScionIRN
PARENTS = RESULT
tPARENTSt = 't'PARENTS't'
/* Say 'PARENTS = 'PARENTS tPARENTSt ??? EXISTPARENTS IRN ??? */
IF tPARENTSt ~= 'tt' THEN HasPARENTS = 1
'GETMARRIAGE' ScionIRN 0 /* ??? GETTOTMARRIAGES IRN ??? */
MARRIAGE = RESULT
tMARRIAGESt = 't'MARRIAGE't'
/* Say 'MARRIAGES = 'MARRIAGE tMARRIAGESt */
IF tMARRIAGESt ~= 'tMARRIAGEt' THEN DO
mFGRN = MARRIAGE
'GETCHILD' mFGRN 0 /* ??? GETTOTCHILDREN FGRN ??? */
'EXISTPERSON' RESULT
if RESULT = 'YES' then HasCHILDREN = 1
END
/*
Say 'PARENTS = 'PARENTS tPARENTSt 'MARRIAGES = 'MARRIAGES tMARRIAGESt 'HasPARENTS = 'HasPARENTS 'HasCHILDREN = 'HasCHILDREN
*/
IF ( HasPARENTS + HasCHILDREN ) = 1 THEN DoGenText = 1
/**/
'GETLASTNAME' ScionIRN
LASTNAME = GetLastName(RESULT)
'GETFIRSTNAME' ScionIRN
FIRSTNAME = RESULT
'GETSEX' ScionIRN
GENDER = translate(RESULT,xrange('a','z'),xrange('A','Z'))
thelastname = LASTNAME
thegender = GENDER
FULLNAME = GetFullName(FIRSTNAME)
IF ScionIRN = 1 THEN P1 = FULLNAME
MFULLNAME = MGetFullName(FIRSTNAME)
PFULLNAME = PGetFullName(FIRSTNAME)
'GETBIRTHDATE' ScionIRN
BIRTHDATE = RESULT
'GETBIRTHPLACE' ScionIRN
BIRTHPLACE = RESULT
'GETDEATHDATE' ScionIRN
DEATHDATE = RESULT
'GETDEATHPLACE' ScionIRN
DEATHPLACE = RESULT
'GETBURIALPLACE' ScionIRN
BURIALPLACE = RESULT
'GETPERSUSER1' ScionIRN
PERSUSER1 = CheckForReplacement(RESULT)
PERSUSERn1 = CheckForNAReplacement(RESULT)
'GETPERSUSER2' ScionIRN
PERSUSER2 = CheckForReplacement(RESULT)
PERSUSERn2 = CheckForNAReplacement(RESULT)
'GETPERSUSER3' ScionIRN
PERSUSER3 = CheckForReplacement(RESULT)
PERSUSERn3 = CheckForNAReplacement(RESULT)
ValidInfo = 0
IF LASTNAME ~= "" | PERSUSER1 ~= "" | PERSUSER2 ~= "" | PERSUSER3 ~= "" | BIRTHDATE ~= "" | BIRTHPLACE ~= "" | DEATHDATE ~= "" | DEATHPLACE ~= "" | BURIALPLACE ~= "" THEN ValidInfo = 1
/**/
IF ~ValidInfo THEN DO
Say "Person " ScionIRN"'s lacking information; no new html file being created!"
RETURN
END
IF target ~= "NORMAL" | ValidInfo | LASTNAME ~= "" THEN DoGenText = 1
PfilN = PersonPrefix || ScionIRN
/**/
dPfilN = Gdir'/'PfilN
Say ''
Say 'html: 'dPfilN'.htm for: 'FULLNAME' {'ScionIRN'}'
Open('PERSONFILE',dPfilN'.htm','w')
WriteLn('PERSONFILE','')
WriteLn('PERSONFILE',''FULLNAME' Data Sheet ')
WriteLn('PERSONFILE','')
/**/
IF Exists('Genealogy:PP'ScionIRN'.'DBNAME) & DoPictures THEN DO
/**/
IF AgeTest('Genealogy:PP'ScionIRN'.'DBNAME, dPfilN'.jpg') THEN DO
Delete(dPfilN'.gif')
END
/**/
WriteCh('PERSONFILE',' 
')
END
/**/
/* WriteCh('PERSONFILE',''MFULLNAME) */
WriteCh('PERSONFILE',MFULLNAME)
/**/
IF Exists('Genealogy:PN'ScionIRN'.'DBNAME) THEN DO
IF AgeTest('Genealogy:PN'ScionIRN'.'DBNAME, dPfilN'I.htm') THEN DO
Say 'Writing info ¶ file 'dPfilN'I.htm'
Open('PNDBNAME','Genealogy:PN'ScionIRN'.'DBNAME,'r')
Open('PERSONI',dPfilN'I.htm','w')
WriteLn('PERSONI','')
WriteLn('PERSONI',''FULLNAME' Information ')
WriteCh('PERSONI',''MFULLNAME)
WriteCh('PERSONI',' Information. (')
/* WriteLn('PERSONI','List of persons.)
') */
WriteLn('PERSONI','List of persons.)')
IF DoGenText THEN WriteLn('GenealogyText',PFULLNAME' Information.')
DO While ~EOF('PNDBNAME')
line = ReadLn('PNDBNAME')
WriteLn('PERSONI',CheckForReplacement(line))
IF DoGenText THEN WriteLn('GenealogyText',CheckForNAReplacement(line))
END
Close('PNDBNAME')
IF DoGenText THEN WriteLn('GenealogyText',' ')
WriteLn('PERSONI','')
Close('PERSONI')
END
WriteCh('PERSONFILE',' ( ¶ )')
END
/**/
IF Exists('Genealogy:PP'ScionIRN'.'DBNAME) & DoPictures THEN DO
/**/
IF ~Exists(dPfilN'.jpg') THEN DO
Say 'Creating picture 'dPfilN'.jpg'
/*
Say 'Sys:Tools/GfxCon Genealogy:PP'ScionIRN'.'DBNAME' TO 'dPfilN'.jpg FORMAT JPEG QUALITY 100'
*/
address command 'Sys:Tools/GfxCon Genealogy:PP'ScionIRN'.'DBNAME' TO 'dPfilN'.jpg FORMAT JPEG QUALITY 100'
END
IF Exists(dPfilN'.gif') THEN DO
Say ' ~ image 'dPfilN'.gif ...OK... '
END
ELSE DO
Say 'Creating image 'dPfilN'.gif'
/*
Say 'Sys:Tools/GfxCon Genealogy:PP'ScionIRN'.'DBNAME' TO 'dPfilN'.gif FORMAT 'Thumbformat' BOXFIT 'Thumbnail' 'Thumbnail
*/
address command 'Sys:Tools/GfxCon Genealogy:PP'ScionIRN'.'DBNAME' TO 'dPfilN'.gif FORMAT 'Thumbformat' BOXFIT 'Thumbnail' 'Thumbnail
END
WriteCh('PERSONFILE',' ( ® )')
IF Exists(dPfilN'A.htm') THEN DO
Say ' ~ picture album 'dPfilN'A.htm ...OK... '
END
ELSE DO
Say 'Creating picture album ® 'dPfilN'A.htm'
Open('PERSONP',dPfilN'A.htm','w')
WriteLn('PERSONP','')
WriteLn('PERSONP',''FULLNAME' Picture Album ')
WriteCh('PERSONP',MFULLNAME' . ')
WriteCh('PERSONP','')
WriteLn('PERSONP','')
WriteLn('PERSONP',' . Picture Album
')
WriteCH('PERSONP','another JPEG picture 
WriteLn('PERSONP',PfilN'A1.gif)
anchored by image')
WriteLn('PERSONP',' created by:
GfxCon 'dPfilN'A1.jpg TO 'dPfilN'A1.gif FORMAT ')
WriteLn('PERSONP',Thumbformat' BOXFIT 'Thumbnail' 'Thumbnail'
')
WriteLn('PERSONP','Edit 'dPfilN'A.htm to add more pictures to the Picture Album')
WriteCH('PERSONP','CAUTION: deleting Directory: 'Gdir' destroys all Picture ')
WriteLn('PERSONP',' Album modifications. YOUR WORK WILL BE LOST!
')
WriteLn('PERSONP','')
Close('PERSONP')
END
END
/**/
WriteLn('PERSONFILE',' (List of persons.
)')
IF DoGenText THEN DO
IF target ~= "NORMAL" THEN Say 'Printable file: 'Tdir'/G'ScionIRN' for 'FULLNAME' {'ScionIRN'}'
WriteLn('GenealogyText','')
WriteLn('GenealogyText','-----------------------------------------------------------')
WriteLn('GenealogyText','')
WriteLn('GenealogyText',PFULLNAME' Data Sheet')
END
IF BIRTHDATE || BIRTHPLACE ~= "" THEN DO
WriteCh('PERSONFILE','Born: ')
IF BIRTHDATE ~= "" THEN WriteCh('PERSONFILE',BIRTHDATE)
IF BIRTHPLACE ~= "" THEN WriteCh('PERSONFILE',' * 'BIRTHPLACE)
WriteLn('PERSONFILE','')
IF BIRTHDATE ~= "" THEN IF DoGenText THEN WriteCh('GenealogyText','Born: 'BIRTHDATE)
IF BIRTHPLACE ~= "" THEN IF DoGenText THEN WriteCh('GenealogyText',' * 'BIRTHPLACE)
IF DoGenText THEN WriteLn('GenealogyText','')
END
IF DEATHDATE ~= "" THEN DO
WriteCh('PERSONFILE','Died: 'DEATHDATE' + 'DEATHPLACE)
IF DoGenText THEN WriteCh('GenealogyText','Died: 'DEATHDATE' + 'DEATHPLACE)
IF BURIALPLACE ~= "" THEN DO
WriteCh('PERSONFILE',' . Buried: 'BURIALPLACE)
IF DoGenText THEN WriteCh('GenealogyText',' . Buried: 'BURIALPLACE)
END
WriteLn('PERSONFILE','')
IF DoGenText THEN WriteLn('GenealogyText','')
END
ELSE DO
IF DEATHPLACE ~= "" THEN DO
WriteLn('PERSONFILE',DEATHPLACE)
IF DoGenText THEN WriteLn('GenealogyText',DEATHPLACE)
END
IF BURIALPLACE ~= "" THEN DO
WriteLn('PERSONFILE',BURIALPLACE)
IF DoGenText THEN WriteLn('GenealogyText',BURIALPLACE)
END
END
IF PERSUSER1 ~= "" THEN DO
WriteLn('PERSONFILE',PERSLABEL1': 'PERSUSER1)
IF DoGenText THEN WriteLn('GenealogyText',PERSLABEL1': 'PERSUSERn1)
END
IF PERSUSER2 ~= "" THEN DO
WriteLn('PERSONFILE',PERSLABEL2': 'PERSUSER2)
IF DoGenText THEN WriteLn('GenealogyText',PERSLABEL2': 'PERSUSERn2)
END
IF PERSUSER3 ~= "" THEN DO
WriteLn('PERSONFILE',PERSLABEL3': 'PERSUSER3)
IF DoGenText THEN WriteLn('GenealogyText',PERSLABEL3': 'PERSUSERn3)
END
/* end of personal data; start family tree segment */
/* WriteLn('PERSONFILE','') */
WriteLn('PERSONFILE','
')
IF DoGenText THEN DO
WriteLn('GenealogyText','')
WriteLn('GenealogyText','-----------------------------------------------------------')
WriteLn('GenealogyText','')
END
WriteCh('PERSONFILE','Immediate Family of 'MFULLNAME)
WriteLn('PERSONFILE',' ( Parents, Siblings, Spouse, and Children )')
IF DoGenText THEN DO
WriteLn('GenealogyText','Immediate Family of 'PFULLNAME)
WriteLn('GenealogyText',' ( Parents, Siblings, Spouse, and Children )')
END
/**/
IF HasPARENTS THEN DO
'GETPRINCIPAL' PARENTS
PRINCIPAL = RESULT
'GETSPOUSE' PARENTS
SPOUSE = RESULT
'GETMARRYDATE' PARENTS
PARENTSMARRIAGEDATE = RESULT
'GETMARRYPLACE' PARENTS
PARENTSmFGRNPLACE = RESULT
'GETFAMUSER1' PARENTS
PARENTSmFGRNCELEBRANT = CheckForReplacement(RESULT)
PARENTSnmFGRNCELEBRANT = CheckForNAReplacement(RESULT)
'GETFAMUSER2' PARENTS
PARENTSmFGRNCOMMENT = CheckForReplacement(RESULT)
PARENTSnmFGRNCOMMENT = CheckForNAReplacement(RESULT)
'GETSEX' PRINCIPAL
IF RESULT = 'M' THEN
DO
FATHERScionIRN = PRINCIPAL
MOTHERScionIRN = SPOUSE
END
ELSE
DO
FATHERScionIRN = SPOUSE
MOTHERScionIRN = PRINCIPAL
END
'GETLASTNAME' FATHERScionIRN
FATHERLASTNAME = GetLastName(RESULT)
'GETFIRSTNAME' FATHERScionIRN
FATHERFIRSTNAME = RESULT
IF FATHERFIRSTNAME ~= "" | FATHERLASTNAME ~= "" THEN HasFATHER = 1
thelastname = FATHERLASTNAME
thegender = "m"
FATHERFULLNAME = GetFullName(FATHERFIRSTNAME)
MFATHERFULLNAME = MGetFullName(FATHERFIRSTNAME)
PFATHERFULLNAME = PGetFullName(FATHERFIRSTNAME)
'GETBIRTHDATE' FATHERScionIRN
FATHERBIRTHDATE = RESULT
'GETLASTNAME' MOTHERScionIRN
MOTHERLASTNAME = GetLastName(RESULT)
'GETFIRSTNAME' MOTHERScionIRN
MOTHERFIRSTNAME = RESULT
IF MOTHERFIRSTNAME ~= "" | MOTHERLASTNAME ~= "" THEN HasMOTHER = 1
thelastname = MOTHERLASTNAME
thegender = "f"
MOTHERFULLNAME = GetFullName(MOTHERFIRSTNAME)
MMOTHERFULLNAME = MGetFullName(MOTHERFIRSTNAME)
PMOTHERFULLNAME = PGetFullName(MOTHERFIRSTNAME)
'GETBIRTHDATE' MOTHERScionIRN
MOTHERBIRTHDATE = RESULT
/**/
IF FATHERLASTNAME ~= "" THEN DO
HasFileFATHER = 1
FATHERFILENAME = PersonPrefix || FATHERScionIRN
END
/**/
IF MOTHERLASTNAME ~= "" THEN DO
HasFileMOTHER = 1
MOTHERFILENAME = PersonPrefix || MOTHERScionIRN
END
/**/
WriteCh('PERSONFILE',' ')
IF HasFileFATHER THEN WriteCh('PERSONFILE','')
WriteCh('PERSONFILE',MFATHERFULLNAME)
IF HasFileFATHER THEN WriteCh('PERSONFILE',' //\ ')
IF HasFileMOTHER THEN WriteCh('PERSONFILE','')
WriteCh('PERSONFILE',MMOTHERFULLNAME)
IF HasFileMOTHER THEN WriteCh('PERSONFILE','')
/**/
IF PARENTSMARRIAGEDATE ~= "" THEN
WriteCh('PERSONFILE',' & 'PARENTSMARRIAGEDATE)
IF PARENTSmFGRNPLACE ~= "" THEN
WriteCh('PERSONFILE',' @ 'PARENTSmFGRNPLACE)
/**/
WriteLn('PERSONFILE','')
IF DoGenText THEN DO
WriteCh('GenealogyText',' 'PFATHERFULLNAME' //\ 'PMOTHERFULLNAME)
IF PARENTSMARRIAGEDATE ~= "" THEN WriteCh('GenealogyText',' & 'PARENTSMARRIAGEDATE)
IF PARENTSmFGRNPLACE ~= "" THEN WriteCh('GenealogyText',' @ 'PARENTSmFGRNPLACE)
WriteLn('GenealogyText','')
END
spcs = ' |'
DO i = 0 TO Length(FATHERFULLNAME)
spcs = spcs' ' /* ??? GETFAMLBL1 ??? */
END /* ??? GETFAMLBL2 ??? */
/**/
Minfo = Exists('Genealogy:FN'PARENTS'.'DBNAME)
IF PARENTSmFGRNCELEBRANT ~= '' | Minfo THEN DO
WriteCh('PERSONFILE',spcs)
IF Minfo THEN
WriteCh('PERSONFILE','( ¶ ) ')
IF PARENTSmFGRNCELEBRANT ~= '' THEN DO
WriteCh('PERSONFILE',FAMLABEL1': 'PARENTSmFGRNCELEBRANT)
IF DoGenText THEN WriteLn('GenealogyText',spcs||FAMLABEL1': 'PARENTSnmFGRNCELEBRANT)
END
WriteLn('PERSONFILE','')
END
IF PARENTSmFGRNCOMMENT ~= '' THEN DO
WriteLn('PERSONFILE',spcs' 'FAMLABEL2': 'PARENTSmFGRNCOMMENT)
IF DoGenText THEN WriteLn('GenealogyText',spcs' 'FAMLABEL2': 'PARENTSnmFGRNCOMMENT)
END
DO i = 0 TO 39 /* ??? GETTOTCHILDREN FGRN ??? */
'GETCHILD' PARENTS i
PARENTSc = RESULT
'GETFIRSTNAME' PARENTSc
PARENTScFIRSTNAME = RESULT
/**/
IF PARENTScFIRSTNAME ~= "" THEN DO
IF PARENTSc ~= ScionIRN THEN DO
'GETLASTNAME' PARENTSc
PARENTScLASTNAME = GetLastName(RESULT)
'GETFIRSTNAME' PARENTSc
PARENTScFIRSTNAME = RESULT
'GETSEX' PARENTSc
PARENTScGENDER = translate(RESULT,xrange('a','z'),xrange('A','Z'))
thelastname = PARENTScLASTNAME
thegender = PARENTScGENDER
PARENTScFULLNAME = GetFullName(PARENTScFIRSTNAME)
MPARENTScFULLNAME = MGetFullName(PARENTScFIRSTNAME)
PPARENTScFULLNAME = PGetFullName(PARENTScFIRSTNAME)
'GETBIRTHDATE' PARENTSc
PARENTScBIRTHDATE = RESULT
'GETDEATHDATE' PARENTSc
PARENTScDEATHDATE = RESULT
/**/
PARENTScFILENAME = PersonPrefix || PARENTSc
/**/
WriteCh('PERSONFILE',' |_____ ')
/**/
IF PARENTScLASTNAME ~= FATHERLASTNAME THEN
WriteCh('PERSONFILE',MPARENTScFULLNAME)
ELSE DO
IF PARENTScGENDER = "m" THEN WriteCh('PERSONFILE',''PARENTScFIRSTNAME'')
IF PARENTScGENDER = "f" THEN WriteCh('PERSONFILE',''PARENTScFIRSTNAME'')
END
/**/
WriteCh('PERSONFILE',' ')
/**/
IF PARENTScBIRTHDATE ~= "" THEN
WriteCh('PERSONFILE',' * 'PARENTScBIRTHDATE)
/**/
IF PARENTScDEATHDATE ~= "" THEN
WriteCh('PERSONFILE',' + 'PARENTScDEATHDATE)
/**/
WriteLn('PERSONFILE','')
IF DoGenText THEN DO
WriteCh('GenealogyText',' |_____ 'PPARENTScFULLNAME)
IF PARENTScBIRTHDATE ~= "" THEN WriteCh('GenealogyText',' * 'PARENTScBIRTHDATE)
IF PARENTScDEATHDATE ~= "" THEN WriteCh('GenealogyText',' + 'PARENTScDEATHDATE)
WriteLn('GenealogyText','')
END
END
END
END
END
END
/* end of parents, siblings segment; start marriages segment */
vert.0 = ''
vert.1 = ' |'
DO i = 0 TO 39 /* ??? GETTOTMARRIAGES IRN ??? */
'GETMARRIAGE' ScionIRN i
MARRIAGE = RESULT /* use: 'EXISTFAMILY' */
IF MARRIAGE > -1 THEN DO
MARRIAGES = i
j = i + 1
vert.j = vert.i vert.1
END
END
tMARRIAGESt = 't'MARRIAGES't'
/* Say 'MARRIAGES = 'MARRIAGES tMARRIAGESt */
IF tMARRIAGESt ~= 'tMARRIAGESt' THEN DO
WriteLn('PERSONFILE',' |')
IF DoGenText THEN WriteLn('GenealogyText',' |')
DO i = 0 TO MARRIAGES
'GETMARRIAGE' ScionIRN i
mFGRN = RESULT
IF mFGRN ~= "" THEN DO
ki = MARRIAGES - i + 1
IF ki ~= MARRIAGES + 1 THEN DO
WriteLn('PERSONFILE',vert.ki)
IF DoGenText THEN WriteLn('GenealogyText',vert.ki)
END
j = MARRIAGES + 1 - i
'GETSPOUSE' mFGRN
SPOUSE = RESULT
IF SPOUSE = ScionIRN THEN DO
'GETPRINCIPAL' mFGRN
SPOUSE = RESULT
END
'GETLASTNAME' SPOUSE
SPOUSELASTNAME = GetLastName(RESULT)
'GETFIRSTNAME' SPOUSE
SPOUSEFIRSTNAME = RESULT
thelastname = SPOUSELASTNAME
'GETSEX' SPOUSE
thegender = translate(RESULT,xrange('a','z'),xrange('A','Z'))
SPOUSEFULLNAME = GetFullName(SPOUSEFIRSTNAME)
MSPOUSEFULLNAME = MGetFullName(SPOUSEFIRSTNAME)
PSPOUSEFULLNAME = PGetFullName(SPOUSEFIRSTNAME)
'GETBIRTHDATE' SPOUSE
SPOUSEBIRTHDATE = RESULT
'GETMARRYDATE' mFGRN
MARRIAGEDATE = RESULT
'GETMARRYPLACE' mFGRN
mFGRNPLACE = RESULT
'GETFAMUSER1' mFGRN
MARRIAGECELEBRANT = CheckForReplacement(RESULT)
MARRIAGEnCELEBRANT = CheckForNAReplacement(RESULT)
'GETFAMUSER2' mFGRN
MARRIAGECOMMENT = CheckForReplacement(RESULT)
MARRIAGEnCOMMENT = CheckForNAReplacement(RESULT)
/**/
SPOUSEFILENAME = PersonPrefix || SPOUSE
/**/
IF i = 0 THEN DO
WriteCh('PERSONFILE',' 'MFULLNAME' //\ ')
IF SPOUSELASTNAME ~= "" THEN WriteCh('PERSONFILE','')
WriteCh('PERSONFILE',MSPOUSEFULLNAME)
IF SPOUSELASTNAME ~= "" THEN WriteCh('PERSONFILE','')
IF DoGenText THEN DO
WriteCh('GenealogyText',' 'PFULLNAME' //\ 'PSPOUSEFULLNAME)
IF MARRIAGEDATE ~= "" THEN WriteCh('GenealogyText',' & 'MARRIAGEDATE)
IF mFGRNPLACE ~= "" THEN WriteCh('GenealogyText',' @ 'mFGRNPLACE)
WriteLn('GenealogyText','')
END
END
ELSE DO
WriteCh('PERSONFILE',vert.j'_ //\ ')
IF SPOUSELASTNAME ~= "" THEN WriteCh('PERSONFILE','')
WriteCh('PERSONFILE',MSPOUSEFULLNAME)
IF SPOUSELASTNAME ~= "" THEN WriteCh('PERSONFILE','')
IF DoGenText THEN DO
WriteCh('GenealogyText',vert.j'_ //\ 'PSPOUSEFULLNAME)
IF MARRIAGEDATE ~= "" THEN WriteCh('GenealogyText',' & 'MARRIAGEDATE)
IF mFGRNPLACE ~= "" THEN WriteCh('GenealogyText',' @ 'mFGRNPLACE)
WriteLn('GenealogyText','')
END
END
IF MARRIAGEDATE ~= "" THEN WriteCh('PERSONFILE',' & 'MARRIAGEDATE)
IF mFGRNPLACE ~= "" THEN WriteCh('PERSONFILE',' @ 'mFGRNPLACE)
WriteLn('PERSONFILE','')
jk = MARRIAGES - i
spcs = vert.jk' | '
/**/
FfilN = Gdir'/'FamilyPrefix || mFGRN
Minfo = 0
IF Exists('Genealogy:FN'mFGRN'.'DBNAME) THEN DO
Minfo = 1
/**/
IF AgeTest('Genealogy:FN'mFGRN'.'DBNAME,FfilN'I.htm') THEN DO
Say 'Writing info ¶ file 'FfilN'I.htm'
Open('FNDBNAME','Genealogy:FN'mFGRN'.'DBNAME,'r')
Open('FAMILYI',FfilN'I.htm','w')
WriteLn('FAMILYI','')
WriteCh('FAMILYI',''MFULLNAME' //\ ')
WriteLn('FAMILYI',MSPOUSEFULLNAME' Family Information ')
/**/
IF Exists('Genealogy:FP'mFGRN'.'DBNAME) & DoPictures THEN DO
WriteCh('FAMILYI','
')
END
/**/
WriteCh('FAMILYI','Family of 'MFULLNAME' //\ ')
WriteCh('FAMILYI',MSPOUSEFULLNAME)
/**/
IF Exists('Genealogy:FP'mFGRN'.'DBNAME) & DoPictures THEN DO
WriteCh('FAMILYI',' ( ® ) ')
END
/**/
WriteCh('FAMILYI',' (')
WriteLn('FAMILYI','List of persons.)
')
DO While ~EOF('FNDBNAME')
line = ReadLn('FNDBNAME')
WriteLn('FAMILYI',CheckForReplacement(line))
IF DoGenText THEN WriteLn('GenealogyText',spcs' 'CheckForNAReplacement(line))
END
Close('FNDBNAME')
WriteLn('FAMILYI','')
Close('FAMILYI')
END
END
/**/
Palbum = 0
IF Exists('Genealogy:FP'mFGRN'.'DBNAME) & DoPictures THEN DO
/**/
Palbum = 1
IF AgeTest('Genealogy:FP'mFGRN'.'DBNAME,FfilN'.jpg') THEN DO
Delete(FfilN'.gif')
END
/**/
IF ~Exists(FfilN'.jpg') THEN DO
Say 'Creating picture 'FfilN'.jpg'
/*
Say 'Sys:Tools/GfxCon Genealogy:FP'mFGRN'.'DBNAME' TO 'FfilN'.jpg FORMAT JPEG QUALITY 100'
*/
address command 'Sys:Tools/GfxCon Genealogy:FP'mFGRN'.'DBNAME' TO 'FfilN'.jpg FORMAT JPEG QUALITY 100'
END
IF Exists(FfilN'.gif') THEN DO
Say ' ~ image 'FfilN'.gif ...OK... '
END
ELSE DO
Say 'Creating image 'FfilN'.gif'
/*
Say 'Sys:Tools/GfxCon Genealogy:FP'mFGRN'.'DBNAME' TO 'FfilN'.gif FORMAT 'Thumbformat' BOXFIT 'Thumbnail' 'Thumbnail
*/
address command 'Sys:Tools/GfxCon Genealogy:FP'mFGRN'.'DBNAME' TO 'FfilN'.gif FORMAT 'Thumbformat' BOXFIT 'Thumbnail' 'Thumbnail
END
IF Exists(FfilN'A.htm') THEN DO
Say ' ~ picture album 'FfilN'A.htm ...OK... '
END
ELSE DO
Say 'Creating picture album ® 'FfilN'A.htm'
Open('FAMILYP',FfilN'A.htm','w')
WriteLn('FAMILYP','')
WriteCh('FAMILYP',''MFULLNAME' //\ ')
WriteCh('FAMILYP',MSPOUSEFULLNAME)
WriteLn('FAMILYP',' Family Picture Album ')
WriteCh('FAMILYP',MFULLNAME' //\ ')
WriteCh('FAMILYP',MSPOUSEFULLNAME)
WriteCh('FAMILYP',' Family . ')
WriteCh('FAMILYP','')
WriteCh('FAMILYP','')
WriteLn('FAMILYP',' . ®
')
WriteCH('FAMILYP','another JPEG picture 
WriteLn('FAMILYP',FamilyPrefix || mFGRN'A1.gif)
anchored by image')
WriteLn('FAMILYP',' created by:GfxCon 'FfilN'A1.jpg TO 'FfilN'A1.gif FORMAT ')
WriteLn('FAMILYP',Thumbformat' BOXFIT 'Thumbnail' 'Thumbnail'
')
WriteLn('FAMILYP','Edit 'FfilN'A.htm to add more pictures to the Picture Album ')
WriteCH('FAMILYP','CAUTION: deleting Directory: 'Gdir' destroys all Picture ')
WriteLn('FAMILYP',' Album modifications. YOUR WORK WILL BE LOST!')
WriteLn('FAMILYP','')
Close('FAMILYP')
END
END
/**/
IF MARRIAGECELEBRANT ~= '' | Minfo | Palbum THEN DO
WriteCh('PERSONFILE',spcs)
IF Minfo THEN
WriteCh('PERSONFILE','( ¶ ) ')
/**/
IF Exists('Genealogy:FP'mFGRN'.'DBNAME) & DoPictures THEN DO
WriteCh('PERSONFILE',' ( ® ) ')
END
/**/
IF MARRIAGECELEBRANT ~= '' THEN DO
WriteCh('PERSONFILE',FAMLABEL1': 'MARRIAGECELEBRANT)
IF DoGenText THEN WriteLn('GenealogyText',spcs||FAMLABEL1': 'MARRIAGEnCELEBRANT)
END
WriteLn('PERSONFILE','')
END
IF MARRIAGECOMMENT ~= '' THEN DO
WriteLn('PERSONFILE',spcs' 'FAMLABEL2': 'MARRIAGECOMMENT)
IF DoGenText THEN WriteLn('GenealogyText',spcs' 'FAMLABEL2': 'MARRIAGEnCOMMENT)
END
/*********************************************************************************/
DO k = 0 TO 39 /* ??? GETTOTCHILDREN FGRN ??? */
'GETCHILD' mFGRN k
mFGRNc = RESULT
'GETFIRSTNAME' mFGRNc
mFGRNcFIRSTNAME = RESULT
/**/
IF mFGRNcFIRSTNAME ~= "" THEN DO
HasCHILDREN = 1
'GETLASTNAME' mFGRNc
mFGRNcLASTNAME = GetLastName(RESULT)
'GETFIRSTNAME' mFGRNc
mFGRNcFIRSTNAME = RESULT
'GETSEX' mFGRNc
mFGRNcGENDER = translate(RESULT,xrange('a','z'),xrange('A','Z'))
thelastname = mFGRNcLASTNAME
thegender = mFGRNcGENDER
mFGRNcFULLNAME = GetFullName(mFGRNcFIRSTNAME)
MmFGRNcFULLNAME = MGetFullName(mFGRNcFIRSTNAME)
PmFGRNcFULLNAME = PGetFullName(mFGRNcFIRSTNAME)
'GETBIRTHDATE' mFGRNc
mFGRNcBIRTHDATE = RESULT
'GETDEATHDATE' mFGRNc
mFGRNcDEATHDATE = RESULT
/**/
mFGRNcFILENAME = PersonPrefix || mFGRNc
jk = MARRIAGES - i
WriteCh('PERSONFILE',vert.jk' |_____ ')
/**/
IF mFGRNcLASTNAME ~= LASTNAME THEN WriteCh('PERSONFILE',MmFGRNcFULLNAME)
ELSE DO
IF mFGRNcGENDER = "m" THEN WriteCh('PERSONFILE',''mFGRNcFIRSTNAME'')
IF mFGRNcGENDER = "f" THEN WriteCh('PERSONFILE',''mFGRNcFIRSTNAME'')
END
WriteCh('PERSONFILE',' ')
/**/
IF mFGRNcBIRTHDATE ~= "" THEN WriteCh('PERSONFILE',' * 'mFGRNcBIRTHDATE)
/**/
IF mFGRNcDEATHDATE ~= "" THEN WriteCh('PERSONFILE',' + 'mFGRNcDEATHDATE)
Writeln('PERSONFILE','')
IF DoGenText THEN DO
WriteCh('GenealogyText',vert.jk' |_____ 'PmFGRNcFULLNAME)
IF mFGRNcBIRTHDATE ~= "" THEN WriteCh('GenealogyText',' * 'mFGRNcBIRTHDATE)
IF mFGRNcDEATHDATE ~= "" THEN WriteCh('GenealogyText',' + 'mFGRNcDEATHDATE)
WriteLn('GenealogyText','')
END
END
END
END
/*********************************************************************************/
END
END
ELSE DO
WriteLn('PERSONFILE',' |')
IF DoGenText THEN WriteLn('GenealogyText',' |')
WriteLn('PERSONFILE',' 'MFULLNAME)
IF DoGenText THEN WriteLn('GenealogyText',' 'PFULLNAME)
END
/* WriteLn('PERSONFILE','
') */
IF HasPARENTS THEN DO
say ' Ancestors...'
WriteLn('PERSONFILE','
')
/* WriteLn('PERSONFILE','') */
IF DoGenText THEN DO
WriteLn('GenealogyText','')
WriteLn('GenealogyText','-----------------------------------------------------------')
WriteLn('GenealogyText','')
END
WriteLn('PERSONFILE','Ancestors')
IF DoGenText THEN WriteLn('GenealogyText',' Ancestors')
IF DoGenText THEN WriteLn('GenealogyText','')
Paternal(ScionIRN,' ')
WriteCh('PERSONFILE',MFULLNAME)
IF BIRTHDATE ~= "" THEN WriteCh('PERSONFILE',' * 'BIRTHDATE)
IF DEATHDATE ~= "" THEN WriteCh('PERSONFILE',' + 'DEATHDATE)
WriteLn('PERSONFILE','')
IF DoGenText THEN DO
WriteCh('GenealogyText',PFULLNAME)
IF BIRTHDATE ~= "" THEN WriteCh('GenealogyText',' * 'BIRTHDATE)
IF DEATHDATE ~= "" THEN WriteCh('GenealogyText',' + 'DEATHDATE)
WriteLn('GenealogyText','')
END
Maternal(ScionIRN,' ')
/* WriteLn('PERSONFILE',' ') */
END
/* ELSE */
IF HasCHILDREN THEN DO
say ' Descendants...'
WriteLn('PERSONFILE','
')
/* WriteLn('PERSONFILE','') */
IF DoGenText THEN DO
WriteLn('GenealogyText','')
WriteLn('GenealogyText','-----------------------------------------------------------')
WriteLn('GenealogyText','')
WriteLn('GenealogyText',' Descendants')
WriteLn('GenealogyText','')
END
indent = " "
WriteLn('PERSONFILE','Descendants')
WriteCh('PERSONFILE',indent||MFULLNAME)
IF BIRTHDATE ~= "" THEN WriteCh('PERSONFILE',' * 'BIRTHDATE)
IF DEATHDATE ~= "" THEN WriteCh('PERSONFILE',' + 'DEATHDATE)
WriteLn('PERSONFILE','')
IF DoGenText THEN DO
WriteCh('GenealogyText',indent || PFULLNAME)
IF BIRTHDATE ~= "" THEN WriteCh('GenealogyText',' * 'BIRTHDATE)
IF DEATHDATE ~= "" THEN WriteCh('GenealogyText',' + 'DEATHDATE)
WriteLn('GenealogyText','')
END
marriagesANDchildren(ScionIRN,indent)
END
/*©*/
WriteLn('PERSONFILE',' ')
WriteLn('PERSONFILE','')
Close('PERSONFILE')
IF EndOfFile & DoGenText THEN WriteLn('GenealogyText',' ')
IF target = "NORMAL" & ValidInfo THEN DO
WriteCh('GenealogyFile','')
WriteCh('GenealogyFile',MFULLNAME)
WriteCh('GenealogyFile','')
IF BIRTHDATE ~= "" THEN WriteCh('GenealogyFile',' *'BIRTHDATE)
IF DEATHDATE ~= "" THEN WriteCh('GenealogyFile',' +'DEATHDATE)
/*********************************************************************************/
IF HasFATHER THEN DO
WriteCh('GenealogyFile',' (()) ')
IF HasFileFATHER THEN WriteCh('GenealogyFile','')
WriteCh('GenealogyFile',' 'MFATHERFULLNAME)
IF HasFileFATHER THEN WriteCh('GenealogyFile','')
IF HasMOTHER THEN DO
IF HasFATHER THEN WriteCh('GenealogyFile',' //\ ')
IF HasFileMOTHER THEN WriteCh('GenealogyFile','')
WriteCh('GenealogyFile',MMOTHERFULLNAME)
IF HasFileMOTHER THEN WriteCh('GenealogyFile','')
END
END
/*********************************************************************************/
WriteLn('GenealogyFile','
') /* do not close, we have many more to go. */
END
RETURN
IsNumeric: PROCEDURE
PARSE ARG str
RETURN DataType(str, 'W')
/* create a file name short but unique */
FilName: PROCEDURE
PARSE ARG finm lanm bdate
RETURN Space(substr(finm,1,2) substr(lanm,1,4) bdate)
/******************************** Makedir **********************************/
/* Makedir - If a directory under the given name already exists, or can be
created, return 1, otherwise return 0. Though this function works
correctly under Workbench 1.3, it has the same effect as the existing
MAKEDIR; hence it is useful only under 2.0.
*/
Makedir: procedure
ds = statef(arg(1))
if ds='' then
result = 'MAKEDIR'(arg(1))
else
result = left(ds,3) = 'DIR'
return result
CheckForReplacement: PROCEDURE EXPOSE PersonPrefix
PARSE ARG line "<" last
IF last = "" THEN RETURN CheckReplacement(line)
RIRN = GetRIRN(last || ".")
IF RIRN = 0 THEN RETURN line || "<" || last
last = CheckForReplacement(last) /* recursion */
lastend = GetEnd(last || ".")
'GETLASTNAME' RIRN
RIRNLASTNAME = GetLastName(RESULT)
'GETFIRSTNAME' RIRN
RIRNFIRSTNAME = RESULT
thelastname = RIRNLASTNAME
'GETBIRTHDATE' RIRN
RIRNBIRTHDATE = RESULT
'GETSEX' RIRN
IF translate(RESULT,xrange('a','z'),xrange('A','Z')) = "m" THEN
RIRNFULLNAME = '' || GetFullName(RIRNFIRSTNAME) || ''
ELSE
RIRNFULLNAME = '' || GetFullName(RIRNFIRSTNAME) || ''
IF RIRNLASTNAME = "" THEN
RETURN line || RIRNFULLNAME || lastend
RIRNFILENAME = PersonPrefix || RIRN
RETURN line || ''RIRNFULLNAME'' || lastend
CheckReplacement: PROCEDURE EXPOSE PersonPrefix
PARSE ARG line "[" last
IF last = "" THEN RETURN line
RIRN = GetaRIRN(last || ".")
IF RIRN = 0 THEN RETURN line || "[" || last
last = CheckForReplacement(last) /* recursion */
lastend = GetaEnd(last || ".")
'GETLASTNAME' RIRN
RIRNLASTNAME = GetLastName(RESULT)
'GETFIRSTNAME' RIRN
RIRNFIRSTNAME = RESULT
thelastname = RIRNLASTNAME
'GETBIRTHDATE' RIRN
RIRNBIRTHDATE = RESULT
'GETSEX' RIRN
IF translate(RESULT,xrange('a','z'),xrange('A','Z')) = "m" THEN
RIRNFULLNAME = '' || GetFullName(RIRNFIRSTNAME) || ''
ELSE
RIRNFULLNAME = '' || GetFullName(RIRNFIRSTNAME) || ''
IF RIRNLASTNAME = "" THEN
RETURN line || RIRNFULLNAME || lastend
RIRNFILENAME = PersonPrefix || RIRN
RETURN line || ''RIRNFULLNAME'' || lastend
CheckForNAReplacement: PROCEDURE EXPOSE PersonPrefix
PARSE ARG line "<" last
IF last = "" THEN RETURN CheckNAReplacement(line)
RIRN = GetRIRN(last || ".")
IF RIRN = 0 THEN RETURN line || "<" || last
last = CheckForNAReplacement(last) /* recursion */
lastend = GetEnd(last || ".")
'GETLASTNAME' RIRN
RIRNLASTNAME = GetLastName(RESULT)
'GETFIRSTNAME' RIRN
RIRNFIRSTNAME = RESULT
thelastname = RIRNLASTNAME
'GETBIRTHDATE' RIRN
RIRNBIRTHDATE = RESULT
'GETSEX' RIRN
GENDER = translate(RESULT,xrange('a','z'),xrange('A','Z'))
/* thelastname = GetFullName(RIRNLASTNAME) */
thegender = GENDER
IF thegender = "m" THEN
RIRNFULLNAME = '[1m' || GetFullName(RIRNFIRSTNAME) || '[22m'
ELSE
RIRNFULLNAME = '[3m' || GetFullName(RIRNFIRSTNAME) || '[23m'
RETURN line || RIRNFULLNAME lastend
CheckNAReplacement: PROCEDURE EXPOSE PersonPrefix
PARSE ARG line "[" last
IF last = "" THEN RETURN line
RIRN = GetaRIRN(last || ".")
IF RIRN = 0 THEN RETURN line || "[" || last
last = CheckForNAReplacement(last) /* recursion */
lastend = GetaEnd(last || ".")
'GETLASTNAME' RIRN
RIRNLASTNAME = GetLastName(RESULT)
'GETFIRSTNAME' RIRN
RIRNFIRSTNAME = RESULT
thelastname = RIRNLASTNAME
'GETBIRTHDATE' RIRN
RIRNBIRTHDATE = RESULT
'GETSEX' RIRN
GENDER = translate(RESULT,xrange('a','z'),xrange('A','Z'))
/* thelastname = GetFullName(RIRNLASTNAME) */
thegender = GENDER
IF thegender = "m" THEN
RIRNFULLNAME = '[1m' || GetFullName(RIRNFIRSTNAME) || '[22m'
ELSE
RIRNFULLNAME = '[3m' || GetFullName(RIRNFIRSTNAME) || '[23m'
RETURN line || RIRNFULLNAME lastend
Paternal: PROCEDURE EXPOSE DoGenText PersonPrefix DBNAME
PARSE ARG irn, indent
'GETPARENTS' irn
PARENTS = RESULT
'GETPRINCIPAL' PARENTS
PRINCIPAL = RESULT
'GETSPOUSE' PARENTS
SPOUSE = RESULT
'GETSEX' PRINCIPAL
IF RESULT = 'M' THEN DO
FIRN = PRINCIPAL
MIRN = SPOUSE
END
ELSE DO
FIRN = SPOUSE
MIRN = PRINCIPAL
END
pirn = FIRN
IF 't'pirn't' ~= 'tt' THEN DO
Paternal(pirn,indent' ')
'GETLASTNAME' pirn
pirnLASTNAME = GetLastName(RESULT)
thelastname = pirnLASTNAME
'GETFIRSTNAME' pirn
pirnFIRSTNAME = RESULT
pirnFULLNAME = GetFullName(pirnFIRSTNAME)
'GETBIRTHDATE' pirn
pirnBIRTHDATE = RESULT
IF pirnLASTNAME ~= "" THEN
pirnPfilN = PersonPrefix || pirn
WriteCh('PERSONFILE',indent' ,-')
IF pirnLASTNAME ~= "" THEN WriteCh('PERSONFILE','')
WriteCh('PERSONFILE',''pirnFULLNAME'')
IF EXISTS('Genealogy:PN'pirn'.'DBNAME) THEN WriteCh('PERSONFILE',' (¶)')
IF EXISTS('Genealogy:PP'pirn'.'DBNAME) THEN WriteCh('PERSONFILE',' (®)')
IF pirnLASTNAME ~= "" THEN WriteCh('PERSONFILE','')
IF pirnBIRTHDATE ~= "" THEN WriteCh('PERSONFILE',' * 'pirnBIRTHDATE)
'GETDEATHDATE' pirn
pirnDEATHDATE = RESULT
IF pirnDEATHDATE ~= "" THEN WriteCh('PERSONFILE',' + 'pirnDEATHDATE)
WriteLn('PERSONFILE','')
IF DoGenText THEN DO
WriteCh('GenealogyText',indent' ,-[1m'pirnFULLNAME)
IF pirnBIRTHDATE ~= "" THEN WriteCh('GenealogyText',' * 'pirnBIRTHDATE)
IF pirnDEATHDATE ~= "" THEN WriteCh('GenealogyText',' + 'pirnDEATHDATE)
WriteLn('GenealogyText','[22m')
END
Maternal(pirn,indent'| ')
END
RETURN 0
Maternal: PROCEDURE EXPOSE DoGenText PersonPrefix DBNAME
PARSE ARG irn, indent
'GETPARENTS' irn
PARENTS = RESULT
'GETPRINCIPAL' PARENTS
PRINCIPAL = RESULT
'GETSPOUSE' PARENTS
SPOUSE = RESULT
'GETSEX' PRINCIPAL
IF RESULT = 'M' THEN DO
FIRN = PRINCIPAL
MIRN = SPOUSE
END
ELSE DO
FIRN = SPOUSE
MIRN = PRINCIPAL
END
pirn = MIRN
IF 't'pirn't' ~= 'tt' THEN DO
Paternal(pirn,indent'| ')
'GETLASTNAME' pirn
pirnLASTNAME = GetLastName(RESULT)
thelastname = pirnLASTNAME
'GETFIRSTNAME' pirn
pirnFIRSTNAME = RESULT
pirnFULLNAME = GetFullName(pirnFIRSTNAME)
'GETBIRTHDATE' pirn
pirnBIRTHDATE = RESULT
IF pirnLASTNAME ~= "" THEN
pirnPfilN = PersonPrefix || pirn
WriteCh('PERSONFILE',indent' `-')
IF pirnLASTNAME ~= "" THEN WriteCh('PERSONFILE','')
WriteCh('PERSONFILE',''pirnFULLNAME'')
IF EXISTS('Genealogy:PN'pirn'.'DBNAME) THEN WriteCh('PERSONFILE',' (¶)')
IF EXISTS('Genealogy:PP'pirn'.'DBNAME) THEN WriteCh('PERSONFILE',' (®)')
IF pirnLASTNAME ~= "" THEN WriteCh('PERSONFILE','')
IF pirnBIRTHDATE ~= "" THEN WriteCh('PERSONFILE',' * 'pirnBIRTHDATE)
'GETDEATHDATE' pirn
pirnDEATHDATE = RESULT
IF pirnDEATHDATE ~= "" THEN WriteCh('PERSONFILE',' + 'pirnDEATHDATE)
WriteLn('PERSONFILE','')
IF DoGenText THEN DO
WriteCh('GenealogyText',indent' `-[3m'pirnFULLNAME)
IF pirnBIRTHDATE ~= "" THEN WriteCh('GenealogyText',' * 'pirnBIRTHDATE)
IF pirnDEATHDATE ~= "" THEN WriteCh('GenealogyText',' + 'pirnDEATHDATE)
WriteLn('GenealogyText','[23m')
END
Maternal(pirn,indent' ')
END
RETURN 0
marriagesANDchildren: PROCEDURE EXPOSE DoGenText PersonPrefix DBNAME
PARSE ARG ScionIRN,indent
DO i = 0 TO 39 /* ??? GETTOTMARRIAGES IRN ??? */
'GETMARRIAGE' ScionIRN i
MARRIAGE = RESULT
IF MARRIAGE > -1 THEN DO
MARRIAGES = i
END
END
tMARRIAGESt = 't'MARRIAGES't'
/* Say 'MARRIAGES = 'MARRIAGES tMARRIAGESt */
IF tMARRIAGESt ~= 'tMARRIAGESt' THEN DO
DO i = 0 TO MARRIAGES
'GETMARRIAGE' ScionIRN i
mFGRN = RESULT
IF mFGRN ~= "" THEN DO
'GETSPOUSE' mFGRN
SPOUSE = RESULT
IF SPOUSE = ScionIRN THEN
DO
'GETPRINCIPAL' mFGRN
SPOUSE = RESULT
END
'GETLASTNAME' SPOUSE
SPOUSELASTNAME = GetLastName(RESULT)
'GETFIRSTNAME' SPOUSE
SPOUSEFIRSTNAME = RESULT
thelastname = SPOUSELASTNAME
'GETSEX' SPOUSE
thegender = translate(RESULT,xrange('a','z'),xrange('A','Z'))
SPOUSEFULLNAME = GetFullName(SPOUSEFIRSTNAME)
IF SPOUSEFULLNAME ~= "" THEN DO
MSPOUSEFULLNAME = MGetFullName(SPOUSEFIRSTNAME)
PSPOUSEFULLNAME = PGetFullName(SPOUSEFIRSTNAME)
'GETBIRTHDATE' SPOUSE
SPOUSEBIRTHDATE = RESULT
'GETDEATHDATE' SPOUSE
SPOUSEDEATHDATE = RESULT
SPOUSEFILENAME = PersonPrefix || SPOUSE
WriteCH('PERSONFILE',indent'&_')
IF SPOUSELASTNAME ~= "" THEN
WriteCh('PERSONFILE','')
WriteCh('PERSONFILE',MSPOUSEFULLNAME)
IF EXISTS('Genealogy:PN'SPOUSE'.'DBNAME) THEN WriteCh('PERSONFILE',' (¶)')
IF EXISTS('Genealogy:PP'SPOUSE'.'DBNAME) THEN WriteCh('PERSONFILE',' (®)')
IF SPOUSELASTNAME ~= "" THEN WriteCh('PERSONFILE','')
IF SPOUSEBIRTHDATE ~= "" THEN
WriteCh('PERSONFILE',' * 'SPOUSEBIRTHDATE)
IF SPOUSEDEATHDATE ~= "" THEN
WriteCh('PERSONFILE',' + 'SPOUSEDEATHDATE)
IF DoGenText THEN DO
WriteCh('GenealogyText',indent'&_'PSPOUSEFULLNAME)
IF SPOUSEBIRTHDATE ~= "" THEN
WriteCh('GenealogyText',' * 'SPOUSEBIRTHDATE)
IF SPOUSEDEATHDATE ~= "" THEN
WriteCh('GenealogyText',' + 'SPOUSEDEATHDATE)
WriteLn('GenealogyText','')
END
WriteLn('PERSONFILE','')
/*
END
ELSE DO
WriteLn('PERSONFILE',indent'&_?')
WriteLn('GenealogyText',indent'&_?')
*/
END
indent2 = indent || " | "
DO k = 0 TO 39 /* ??? GETTOTCHILDREN FGRN ??? */
'GETCHILD' mFGRN k
mFGRNc = RESULT
'GETFIRSTNAME' mFGRNc
mFGRNcFIRSTNAME = RESULT
/**/
IF mFGRNcFIRSTNAME ~= "" THEN DO
'GETLASTNAME' mFGRNc
mFGRNcLASTNAME = GetLastName(RESULT)
'GETFIRSTNAME' mFGRNc
mFGRNcFIRSTNAME = RESULT
'GETSEX' mFGRNc
mFGRNcGENDER = translate(RESULT,xrange('a','z'),xrange('A','Z'))
thelastname = mFGRNcLASTNAME
thegender = mFGRNcGENDER
mFGRNcFULLNAME = GetFullName(mFGRNcFIRSTNAME)
MmFGRNcFULLNAME = MGetFullName(mFGRNcFIRSTNAME)
PmFGRNcFULLNAME = PGetFullName(mFGRNcFIRSTNAME)
'GETBIRTHDATE' mFGRNc
mFGRNcBIRTHDATE = RESULT
'GETDEATHDATE' mFGRNc
mFGRNcDEATHDATE = RESULT
/**/
mFGRNcFILENAME = PersonPrefix || mFGRNc
/**/
WriteCh('PERSONFILE',indent2||''MmFGRNcFULLNAME)
IF EXISTS('Genealogy:PN'mFGRNc'.'DBNAME) THEN WriteCh('PERSONFILE',' (¶)')
IF EXISTS('Genealogy:PP'mFGRNc'.'DBNAME) THEN WriteCh('PERSONFILE',' (®)')
WriteCh('PERSONFILE',' ')
/**/
IF mFGRNcBIRTHDATE ~= "" THEN WriteCh('PERSONFILE',' * 'mFGRNcBIRTHDATE)
/**/
IF mFGRNcDEATHDATE ~= "" THEN WriteCh('PERSONFILE',' + 'mFGRNcDEATHDATE)
Writeln('PERSONFILE','')
IF DoGenText THEN DO
WriteCh('GenealogyText',indent2||PmFGRNcFULLNAME)
IF mFGRNcBIRTHDATE ~= "" THEN WriteCh('GenealogyText',' * 'mFGRNcBIRTHDATE)
IF mFGRNcDEATHDATE ~= "" THEN WriteCh('GenealogyText',' + 'mFGRNcDEATHDATE)
WriteLn('GenealogyText','')
END
/**********************/
marriagesANDchildren(mFGRNc,indent2)
END
END
END
END
END
RETURN 0
GetRIRN: PROCEDURE
PARSE ARG numb ">" last
IF last = "" THEN RETURN 0
IF IsNumeric(numb) THEN RETURN numb
RETURN 0
GetaRIRN: PROCEDURE
PARSE ARG numb "]" last
IF last = "" THEN RETURN 0
IF IsNumeric(numb) THEN RETURN numb
RETURN 0
GetEnd: PROCEDURE
PARSE ARG line ">" last
IF last = "" THEN RETURN substr(line,1,length(line)-1)
RETURN substr(last,1,length(last)-1)
GetaEnd: PROCEDURE
PARSE ARG line "]" last
IF last = "" THEN RETURN substr(line,1,length(line)-1)
RETURN substr(last,1,length(last)-1)
GetLength: PROCEDURE
PARSE UPPER ARG names
nonletters = length(compress(names, xrange('A','Z')))
RETURN Length(names) - nonletters * 4 / 10
/* create a full name from first, last, and honorifics parts */
GetFullName: PROCEDURE EXPOSE thelastname
PARSE ARG firstnames "," hon
IF hon = "" THEN DO
IF length(firstnames) > 2 THEN
IF substr(firstnames,length(firstnames)-1,length(firstnames)) = "V." THEN
firstnames = substr(firstnames,1,length(firstnames)-2) || "v."
RETURN firstnames thelastname
END
RETURN firstnames Space(thelastname) || ","hon
MGetFullName: PROCEDURE EXPOSE thelastname thegender
PARSE ARG firstnames "," hon
gchar = "B"
IF thegender = "f" THEN gchar = "I"
IF hon = "" THEN DO
IF length(firstnames) > 2 THEN
IF substr(firstnames,length(firstnames)-1,length(firstnames)) = "V." THEN
firstnames = substr(firstnames,1,length(firstnames)-2) || "v."
RETURN "<"gchar">"firstnames thelastname""
END
RETURN "<"gchar">"firstnames Space(thelastname) || ","hon""
PGetFullName: PROCEDURE EXPOSE thelastname thegender
PARSE ARG firstnames "," hon
schar = "1"
uchar = "2"
IF thegender = "f" THEN DO
schar = "3"
uchar = "3"
END
IF hon = "" THEN DO
IF length(firstnames) > 2 THEN
IF substr(firstnames,length(firstnames)-1,length(firstnames)) = "V." THEN
firstnames = substr(firstnames,1,length(firstnames)-2) || "v."
RETURN "["schar"m"firstnames thelastname"[2"uchar"m"
END
RETURN "["schar"m"firstnames Space(thelastname) || ","hon"[2"uchar"m"
AgeTest: PROCEDURE
PARSE ARG DBFile, HTMFile
IF Exists(DBFile) THEN DO
IF Exists(HTMFile) THEN DO
Parse value StateF(DBFile) with type size blk bits DBday DBmin DBtick com
Parse value StateF(HTMFile) with type size blk bits HTMday HTMmin HTMtick com
/* Say DBFile DBday DBmin DBtick HTMFile HTMday HTMmin HTMtick */
IF ( DBday > HTMday ) | ( DBday = HTMday & DBmin > HTMmin ) THEN DO
Delete(HTMFile)
Say DBFile 'is newer; removing 'HTMFile
RETURN 1
END
ELSE DO
Say ' ~ 'HTMFile' ...OK... '
RETURN 0
END
RETURN 1
END
RETURN 1
END
/* Capitalize last name; also handle special cases! */
/* End users must customize this code to avoid trashy output */
GetLastName: PROCEDURE
PARSE ARG str
IF str = "BAUER-GAUSS" THEN RETURN "Bauer-Gauss"
IF str = "DE IPOLYI" THEN RETURN "deIpolyi"
IF str = "DEIPOLYI" THEN RETURN "deIpolyi"
IF str = "MC GRADY" THEN RETURN "McGrady"
IF str = "KIS RED" THEN RETURN "KisRed"
IF str = "ROTH-HACKENSCHMIDT" THEN RETURN "Roth-Hackenschmidt"
IF str = "SCHüCH-GLICKHFELDEN" THEN RETURN "Schüch-Glickhfelden"
ELSE
DO
spart = translate(substr(str,2,length(str)),xrange('a','z'),xrange('A','Z'))
END
RETURN substr(str,1,1)Space(spart)
')
WriteLn('PERSONP',' . Picture Album
