> AncGed
!Version$="1.01 (01 Feb 1995)"
 You may copy this program freely as long as you
 don't charge for it and this notice is retained.
 Denis Howe <dbh@doc.ic.ac.uk> +44 (81) 450 9448
 1.00 (07 Jun 1994) DBH Written
 1.01 (01 Feb 1995) DBH Don't bomb on unexpected values.
$;" @ ";
 Get input file name from command line
 "OS_GetEnv" 
 Cmd$
Cmd$,"-quit")
 I%=0 
 1,"Can't find arguments!"
Cmd$," ",I%+6)
 IF I%=0 OSCLI "AncGed ADFS::HD.$.Ancestry.Turner":QUIT
 I%=0 
 1,"Usage: AncGed <Ancestry file>"
InFile$=
Cmd$,I%+1)
OutFile$=InFile$+"G"
Load(InFile$)
Out(OutFile$)
 ======================================================================
Load(InFile$)
 F%,ext%
(InFile$)
 F%=0 
 1,"Can't read '"+InFile$+"'"
ext%=
 D%+ext%>=
ceiling 
 1,"No room"
("Load "+InFile$+" "+
 ?D%<>
 D%?1<>
 1,"Not an Ancestry file"
*,N%=
bb(D%+3)  :
 number of basic records
+/M%=
bb(D%+5)  :
 number of marriage records
,4X%=
bb(D%+7)  :
 number of deleted basic records
-7E%=
bb(D%+9)  :
 number of deleted marriage records
Out(OutFile$)
 MODE 0:VDU 14
 26,12
;N%;" basic records"
;M%;" marriage records"
;X%;" deleted basic records"
;E%;" deleted marriage records"'
(OutFile$)
$+" @ "+
 Write GEDCOM header
#F%,"0 HEAD"
#F%,"1 SOUR Converted from Acorn Archimedes !Ancestry format"
#F%,"2 NAME AncGed"
#F%,"3 VERS "+Version$
#F%,"2 CORP Denis Howe" :
 Author of source software
#F%,"3 ADDR <dbh@doc.ic.ac.uk>"
#F%,"4 CONT 48 Anson Rd., London NW2 3UU, UK"
#F%,"4 PHON +44 (81) 450 9448"
#F%,"2 DATA "+InFile$
#F%,"1 DATE "+
$,5,11)
#F%,"1 GEDC"
#F%,"2 VERS 5.3"
 Process individual and marriage records
 R%=1 
Individual(R%):
 R%=1 
Marriage(R%):
 GEDCOM trailer
#F%,"0 TRLR"
 "SetType "+OutFile$+" GEDCOM"
 "Done"
 =======================================================================
 Process individual record R%
Individual(R%)
 A%,chn%,st$,sx$,SpouseRec%
bad(R%)
 Check for status Z (zapped, ie. deleted)
st(A%):
 st$="Z" 
 "Record: ";R%
#F%,"0 @I"+
 R%+"@ INDI"
name$=
Name(A%)
 "Name:   ";name$
#F%,"1 NAME "+name$
sx(A%)
 "Sex:    ";sx$
#F%,"1 SEX "+sx$
dob$=
Date(A%,dobo%)
pob$=
pob(A%)
Print("Birth:  ",dob$)
 dob$>"" 
 pob$>"" 
#F%,"1 BIRT"
 dob$>"" 
#F%,"2 DATE "+dob$
Print("        ",pob$)
 pob$>"" 
#F%,"2 PLAC "+pob$
dod$=
Date(A%,dodo%)
pod$=
pod(A%)
 dob$>"" 
 pod$>"" 
#F%,"1 DEAT"
 dod$>"" 
#F%,"2 DATE "+dod$
Print("Death:  ",dod$)
Print("        ",pod$)
 pod$>"" 
#F%,"2 PLAC "+pod$
mgs%=
mgs(A%) :
 marriages
#F%,"1 NMR "+
 mgs%
nchi%=
kds(A%)
#F%,"1 NCHI "+
 nchi%
fmg(A%) :
 1st marr.
 "Marr:   ";mg%
#F%,"1 FAMS @F"+
 mg%+"@"
 sx$="M" mg%=
mad(mg%)) 
 mg%=
mad(mg%)) 
7pa%=
pa(A%):
 pa%<>&FFFF 
 "Father: ";
RecName(pa%)
7ma%=
ma(A%):
 pa%<>&FFFF 
 "Mother: ";
RecName(ma%)
famc%=
FamC(pa%,ma%,R%)
 famc% 
 "FamC:   ";famc%
#F%,"1 FAMC @F"+
 famc%+"@"
 Other Ancestry fields could be converted to NOTEs.
 st$ 
 "S":
"Single"
 "M":
"Married"
 "D":
"Divorced"
 "W":
"Widowed"
 "X":
"X (Dead?)"
 "" :
"Status: '";st$;"' !!!":
Pause
 ===================================================================
 Process marriage record R%
Marriage(R%)
 MAd%,ch%,Flag%
MAd%=
mad(R%)
 Check for deleted marriage.
Flag%=
mf1(MAd%)
 Flag%=255 
 "Marriage: ";R%
 Show unusual flags.
 Flag%<>0 
 "Flag 1: ";Flag%;" !!!":
Pause
Flag%=
mf2(MAd%)
 Flag%<>0 
 "Flag 2: ";Flag%;" !!!":
Pause
#F%,"0 @F"+
 R%+"@ FAM"
husrec%=
hb(MAd%)
 "Husband:  ";
RecName(husrec%)
#F%,"1 HUSB @I"+
 husrec%+"@"
wifrec%=
wf(MAd%)
 "Wife:     ";
RecName(wifrec%)
#F%,"1 WIFE @I"+
 wifrec%+"@"
ech(MAd%)
  ChAd%=
bad(ch%)
 "Child:    ";
Name(ChAd%)
#F%,"1 CHIL @I"+
 ch%+"@"
  ch%=
nys(ChAd%)
dom$=
Date(MAd%,domo%)
Print("        Married: ",dom$)
pom$=
pom(MAd%)
Print("        Place:   ",pom$)
 dom$>"" 
 pom$>"" 
#F%,"1 MARR"
 dom$>"" 
#F%,"2 DATE "+dom$
 pom$>"" 
#F%,"2 PLAC "+pom$
tp(MAd%)
 tp$="" 
  "        Type:    NULL"
 tp$<>"M" 
"        Type:    ";tp$
doe$=
Date(MAd%,doeo%)
Print("        Ended:   ",doe$)
rfe$=
rfe(MAd%):DvEvTg$=""
 rfe$ 
 "HD":r$="Husband died"
 "WD":r$="Wife died"
 "AN":r$="Anulled":DvEvTg$="ANUL"
 "DV":r$="Divorced":DvEvTg$="DIV"
 r$="<"+rfe$+"> !!!":
Pause
"        Ended:   ";r$
 DvEvTg$>"" 
#F%,"1 "+DvEvTg$
 doe$>"" 
#F%,"2 DATE "+doe$
chn%=
chn(MAd%)
 "Children: ";chn%
#F%,"1 NCHI "+
 chn%
 ======================================================================
FamC(husrec%,wifrec%,chirec%)
 R%:R%=
Parent(husrec%,hnmo%,chirec%)
 R%=0 R%=
Parent(wifrec%,wnmo%,chirec%)
Parent(parrec%,nmo%,chirec%)
 marrec%,mad%
 parrec%=&FFFF 
marrec%=
bad(parrec%))
 marrec%
  mad%=
mad(marrec%)
ChiOfMar(mad%,chirec%) 
=marrec%
  marrec%=
bb(mad%+nmo%)
ChiOfMar(mad%,chirec%)
 crec%
crec%=
ech(mad%)
 crec%
 crec%=chirec% 
  crec%=
bad(crec%))
 ======================================================================
Print(Head$,Val$)
 Val$>"" 
 Head$+Val$
btab%=1  :
 basic records
 mtab%=2  :
 marriage records
ntab%=3  :
 names
stab%=4  :
 surnames
ttab%=5  :
 titles
ptab%=6  :
 places
wtab%=7  :
 word
itab%=8  :
 integer
etab%=9  :
 extract
4tables%=9                    :
 Number of tables
9program%=160000              :
 allowance for program
;variables%=160000            :
 allowance for variables
7stack%=10000                 :
 allowance for stack
+program%+variables%  :
 start of data block
AP%=D%+16                     :
 start of table offset storage
8S%=D%+100                    :
 start of first table
<C%=D%-100                    :
 start of working storage
:L%=40                        :
 Length of basic record
=W%=32                        :
 Length of marriage record
 offsets for basic record
sno% = 0  :
 surname
fno% = 2  :
 forename
bno% = 4  :
 bynames
sxo% = 6  :
sto% = 7  :
 status
tlo% = 8  :
 title
dobo%=10  :
 date of birth
pobo%=15  :
 place of birth
dodo%=17  :
 date of death
podo%=22  :
 place of death
pao% =24  :
 father
mao% =26  :
 mother
sbso%=28  :
 siblings
#neso%=29  :
 next elder sibling
%nyso%=31  :
 next younger sibling
mgso%=33  :
 marriages
fmgo%=34  :
 first marriage
kdso%=36  :
 kids
'bf1o%=37  :
 basic flag 1 - deleted
bf2o%=38  :
 basic flag 2
bf3o%=39  :
 basic flag 3
 offsets for marriage record
$!domo%= 0  :
 date of marriage
%%tpo% = 5  :
 type of relationship
&(doeo%= 6  :
 date of end of marriage
'+rfeo%=11  :
 reason for end of marriage
("pomo%=13  :
 place of marriage
hbo% =15  :
 husband
wfo% =17  :
 wife
chno%=19  :
 children
echo%=20  :
 eldest child
-(hnmo%=22  :
 husband's next marriage
.,hpmo%=24  :
 husband's previous marriage
/%wnmo%=26  :
 wife's next marriage
0)wpmo%=28  :
 wife's previous marriage
1 mf1o%=30  :
 marriage flag 1
2 mf2o%=31  :
 marriage flag 2
40hdo%=70  :
 offset for heading in data block
 Initialise table offsets to zero.
7	a%=P%
 J%=1 
 tables%+1:!a%=0:a%+=4:
 Month$(12)
;WMonth$()="","Jan","Feb","Mar","Apr","May","Jun","Jul","Aug","Sep","Oct","Nov","Dec"
 ======================================================================
 Name from a record.
RecName(R%)
 R%=&FFFF 
="None" 
Name(
bad(R%))
 Name at a record address.  Combine first names,
 surname, 'bynames' and title into one string.
Name(Ad%)
 Name$,Nick$,Title$
J$Name$=
fn(Ad%)+" /"+
sn(Ad%)+"/"
K3Nick$=
bn(Ad%):
 Nick$>"" Name$+=" ("+Nick$+")"
L2Title$=
tl(Ad%):
 Title$>"" Name$+=", "+Title$
=Name$
 Date string from a record address.
Date(ad%,O%)
 date%,code%,d$,r$
date%=ad%!O%
 date%=0 
code%=ad%!(O%+4)
(1E9+date%),8)
d$,2)+
d$,5,2)+
d$,4)
X	r$=""
 I%=1 
 code% 
 256>>I% r$+="?" 
 r$+=
d$,I%,1)
r$,2)+" "+
Month(
r$,3,2))+" "+
r$,4)
Month(N$)
 M%:M%=
=Month$(M%) 
 =====================================================================
 Start address of table t%.  1 <= t% <= tables%+1
tad(t%)=S% + P%!((t%-1)<<2)
 Address of basic record R%.
bad(R%)=S%+(R%-1)*L%
 address of marriage record R%
mad(R%)=
tad(mtab%)+(R%-1)*W%
 peek two-byte number at address a%, MSB first.
bb(a%)=?a%*256+a%?1
head=
tad(tables%+1)
ceiling=
-stack%
 ======================================================================
 Functions to peek basic records
sn(a%)=$(
tad(stab%)+
bb(a%+sno%))   :
 surname
fn(a%)=$(
tad(ntab%)+
bb(a%+fno%))   :
 forenames
bn(a%)=$(
tad(ntab%)+
bb(a%+bno%))   :
 bynames
sx(a%):
 c%                         :
c%=a%?sxo%:
 c%=0
st(a%):
 c%                         :
 status
c%=a%?sto%:
 c%=0
tl(a%):=$(
tad(ttab%)+
bb(a%+tlo%))  :
 title
dob(a%):=a%!dobo%                      :
 date of birth
yob(a%):=(a%!dobo%)
10000            :
 year of birth
cob(a%):=a%?(dobo%+4)                  :
 code of birth
pob(a%):=$(
tad(ptab%)+
bb(a%+pobo%)):
 place of birth
dod(a%):=a%!dodo%                      :
 date of death
yod(a%):=(a%!dodo%)
10000            :
 year of death
cod(a%):=a%?(dodo%+4)                  :
 code of death
pod(a%):=$(
tad(ptab%)+
bb(a%+podo%)):
 place of death
pa(a%):=
bb(a%+pao%)                  :
 rec-father
ma(a%):=
bb(a%+mao%)                  :
 rec-mother
sbs(a%):=a%?sbso%                      :
 siblings
nes(a%):=
bb(a%+neso%)                :
 rec-next elder sib
nys(a%):=
bb(a%+nyso%)                :
 rec-next younger sib
mgs(a%):=a%?mgso%                      :
 marriages
fmg(a%):=
bb(a%+fmgo%)                :
 rec-first marr
kds(a%):=a%?kdso%                      :
 kids
bf1(a%):=a%?bf1o%                      :
 basic rec-flag 1
bf2(a%):=a%?bf2o%                      :
 basic rec-flag 2
bf3(a%):=a%?bf3o%                      :
 basic rec-flag 3
 functions to peek marriage records
dom(a%):=a%!domo%                      :
 date of marr
yom(a%):=(a%!domo%)
10000            :
 year of marr
com(a%):=a%?(domo%+4)                  :
 code of marr
tp(a%):
 c%                         :
 type of relationship
c%=a%?tpo%:
 c%=0
doe(a%):=a%!doeo%                      :
 date of end of marr
yoe(a%):=(a%!doeo%)
10000            :
 year of end of marr
coe(a%):=a%?(doeo%+4)                  :
 code of end of marr
rfe(a%):
 s%,n%,r$
$s%=a%?rfeo%:
 s% r$=
 r$=""
!n%=a%?(rfeo%+1):
 n% r$+=
pom(a%):=$(
tad(ptab%)+
bb(a%+pomo%)):
 place of marr
hb(a%):=
bb(a%+hbo%)                  :
 rec-husband
wf(a%):=
bb(a%+wfo%)                  :
 rec-wife
chn(a%):=a%?(chno%)                    :
 children of this marr
ech(a%):=
bb(a%+echo%)                :
 rec-eldest child
hnm(a%):=
bb(a%+hnmo%)                :
 rec-husband's next marr
hpm(a%):=
bb(a%+hpmo%)                :
 rec-husband's prev marr
wnm(a%):=
bb(a%+wnmo%)                :
 rec-wife's next marr
wpm(a%):=
bb(a%+wpmo%)                :
 rec-wife's prev marr
mf1(a%):=a%?mf1o%                      :
 marriage rec-flag 1
mf2(a%):=a%?mf2o%                      :
 marriage rec-flag 2
Pause
(100)