home *** CD-ROM | disk | FTP | other *** search
/ The Datafile PD-CD 5 / DATAFILE_PDCD5.iso / utilities / f / family / !FamTools / AncGed (.txt) < prev    next >
RISC OS BBC BASIC V Source  |  1995-02-01  |  13KB  |  602 lines
  1.  > AncGed
  2. !Version$="1.01 (01 Feb 1995)"
  3.  You may copy this program freely as long as you
  4.  don't charge for it and this notice is retained.
  5.  Denis Howe <dbh@doc.ic.ac.uk> +44 (81) 450 9448
  6.  1.00 (07 Jun 1994) DBH Written
  7.  1.01 (01 Feb 1995) DBH Don't bomb on unexpected values.
  8. $;" @ ";
  9.  Get input file name from command line
  10.  "OS_GetEnv" 
  11.  Cmd$
  12. Cmd$,"-quit")
  13.  I%=0 
  14.  1,"Can't find arguments!"
  15. Cmd$," ",I%+6)
  16.  IF I%=0 OSCLI "AncGed ADFS::HD.$.Ancestry.Turner":QUIT
  17.  I%=0 
  18.  1,"Usage: AncGed <Ancestry file>"
  19. InFile$=
  20. Cmd$,I%+1)
  21. OutFile$=InFile$+"G"
  22. Load(InFile$)
  23. Out(OutFile$)
  24.  ======================================================================
  25. Load(InFile$)
  26.  F%,ext%
  27. (InFile$)
  28.  F%=0 
  29.  1,"Can't read '"+InFile$+"'"
  30. ext%=
  31.  D%+ext%>=
  32. ceiling 
  33.  1,"No room"
  34. ("Load "+InFile$+" "+
  35.  ?D%<>
  36.  D%?1<>
  37.  1,"Not an Ancestry file"
  38. *,N%=
  39. bb(D%+3)  :
  40.  number of basic records
  41. +/M%=
  42. bb(D%+5)  :
  43.  number of marriage records
  44. ,4X%=
  45. bb(D%+7)  :
  46.  number of deleted basic records
  47. -7E%=
  48. bb(D%+9)  :
  49.  number of deleted marriage records
  50. Out(OutFile$)
  51.  MODE 0:VDU 14
  52.  26,12
  53. ;N%;" basic records"
  54. ;M%;" marriage records"
  55. ;X%;" deleted basic records"
  56. ;E%;" deleted marriage records"'
  57. (OutFile$)
  58. $+" @ "+
  59.  Write GEDCOM header
  60. #F%,"0 HEAD"
  61. #F%,"1 SOUR Converted from Acorn Archimedes !Ancestry format"
  62. #F%,"2 NAME AncGed"
  63. #F%,"3 VERS "+Version$
  64. #F%,"2 CORP Denis Howe" :
  65.  Author of source software
  66. #F%,"3 ADDR <dbh@doc.ic.ac.uk>"
  67. #F%,"4 CONT 48 Anson Rd., London NW2 3UU, UK"
  68. #F%,"4 PHON +44 (81) 450 9448"
  69. #F%,"2 DATA "+InFile$
  70. #F%,"1 DATE "+
  71. $,5,11)
  72. #F%,"1 GEDC"
  73. #F%,"2 VERS 5.3"
  74.  Process individual and marriage records
  75.  R%=1 
  76. Individual(R%):
  77.  R%=1 
  78. Marriage(R%):
  79.  GEDCOM trailer
  80. #F%,"0 TRLR"
  81.  "SetType "+OutFile$+" GEDCOM"
  82.  "Done"
  83.  =======================================================================
  84.  Process individual record R%
  85. Individual(R%)
  86.  A%,chn%,st$,sx$,SpouseRec%
  87. bad(R%)
  88.  Check for status Z (zapped, ie. deleted)
  89. st(A%):
  90.  st$="Z" 
  91.  "Record: ";R%
  92. #F%,"0 @I"+
  93.  R%+"@ INDI"
  94. name$=
  95. Name(A%)
  96.  "Name:   ";name$
  97. #F%,"1 NAME "+name$
  98. sx(A%)
  99.  "Sex:    ";sx$
  100. #F%,"1 SEX "+sx$
  101. dob$=
  102. Date(A%,dobo%)
  103. pob$=
  104. pob(A%)
  105. Print("Birth:  ",dob$)
  106.  dob$>"" 
  107.  pob$>"" 
  108. #F%,"1 BIRT"
  109.  dob$>"" 
  110. #F%,"2 DATE "+dob$
  111. Print("        ",pob$)
  112.  pob$>"" 
  113. #F%,"2 PLAC "+pob$
  114. dod$=
  115. Date(A%,dodo%)
  116. pod$=
  117. pod(A%)
  118.  dob$>"" 
  119.  pod$>"" 
  120. #F%,"1 DEAT"
  121.  dod$>"" 
  122. #F%,"2 DATE "+dod$
  123. Print("Death:  ",dod$)
  124. Print("        ",pod$)
  125.  pod$>"" 
  126. #F%,"2 PLAC "+pod$
  127. mgs%=
  128. mgs(A%) :
  129.  marriages
  130. #F%,"1 NMR "+
  131.  mgs%
  132. nchi%=
  133. kds(A%)
  134. #F%,"1 NCHI "+
  135.  nchi%
  136. fmg(A%) :
  137.  1st marr.
  138.  "Marr:   ";mg%
  139. #F%,"1 FAMS @F"+
  140.  mg%+"@"
  141.  sx$="M" mg%=
  142. mad(mg%)) 
  143.  mg%=
  144. mad(mg%)) 
  145. 7pa%=
  146. pa(A%):
  147.  pa%<>&FFFF 
  148.  "Father: ";
  149. RecName(pa%)
  150. 7ma%=
  151. ma(A%):
  152.  pa%<>&FFFF 
  153.  "Mother: ";
  154. RecName(ma%)
  155. famc%=
  156. FamC(pa%,ma%,R%)
  157.  famc% 
  158.  "FamC:   ";famc%
  159. #F%,"1 FAMC @F"+
  160.  famc%+"@"
  161.  Other Ancestry fields could be converted to NOTEs.
  162.  st$ 
  163.  "S":
  164. "Single"
  165.  "M":
  166. "Married"
  167.  "D":
  168. "Divorced"
  169.  "W":
  170. "Widowed"
  171.  "X":
  172. "X (Dead?)"
  173.  "" :
  174. "Status: '";st$;"' !!!":
  175. Pause
  176.  ===================================================================
  177.  Process marriage record R%
  178. Marriage(R%)
  179.  MAd%,ch%,Flag%
  180. MAd%=
  181. mad(R%)
  182.  Check for deleted marriage.
  183. Flag%=
  184. mf1(MAd%)
  185.  Flag%=255 
  186.  "Marriage: ";R%
  187.  Show unusual flags.
  188.  Flag%<>0 
  189.  "Flag 1: ";Flag%;" !!!":
  190. Pause
  191. Flag%=
  192. mf2(MAd%)
  193.  Flag%<>0 
  194.  "Flag 2: ";Flag%;" !!!":
  195. Pause
  196. #F%,"0 @F"+
  197.  R%+"@ FAM"
  198. husrec%=
  199. hb(MAd%)
  200.  "Husband:  ";
  201. RecName(husrec%)
  202. #F%,"1 HUSB @I"+
  203.  husrec%+"@"
  204. wifrec%=
  205. wf(MAd%)
  206.  "Wife:     ";
  207. RecName(wifrec%)
  208. #F%,"1 WIFE @I"+
  209.  wifrec%+"@"
  210. ech(MAd%)
  211.   ChAd%=
  212. bad(ch%)
  213.  "Child:    ";
  214. Name(ChAd%)
  215. #F%,"1 CHIL @I"+
  216.  ch%+"@"
  217.   ch%=
  218. nys(ChAd%)
  219. dom$=
  220. Date(MAd%,domo%)
  221. Print("        Married: ",dom$)
  222. pom$=
  223. pom(MAd%)
  224. Print("        Place:   ",pom$)
  225.  dom$>"" 
  226.  pom$>"" 
  227. #F%,"1 MARR"
  228.  dom$>"" 
  229. #F%,"2 DATE "+dom$
  230.  pom$>"" 
  231. #F%,"2 PLAC "+pom$
  232. tp(MAd%)
  233.  tp$="" 
  234.   "        Type:    NULL"
  235.  tp$<>"M" 
  236. "        Type:    ";tp$
  237. doe$=
  238. Date(MAd%,doeo%)
  239. Print("        Ended:   ",doe$)
  240. rfe$=
  241. rfe(MAd%):DvEvTg$=""
  242.  rfe$ 
  243.  "HD":r$="Husband died"
  244.  "WD":r$="Wife died"
  245.  "AN":r$="Anulled":DvEvTg$="ANUL"
  246.  "DV":r$="Divorced":DvEvTg$="DIV"
  247.  r$="<"+rfe$+"> !!!":
  248. Pause
  249. "        Ended:   ";r$
  250.  DvEvTg$>"" 
  251. #F%,"1 "+DvEvTg$
  252.  doe$>"" 
  253. #F%,"2 DATE "+doe$
  254. chn%=
  255. chn(MAd%)
  256.  "Children: ";chn%
  257. #F%,"1 NCHI "+
  258.  chn%
  259.  ======================================================================
  260. FamC(husrec%,wifrec%,chirec%)
  261.  R%:R%=
  262. Parent(husrec%,hnmo%,chirec%)
  263.  R%=0 R%=
  264. Parent(wifrec%,wnmo%,chirec%)
  265. Parent(parrec%,nmo%,chirec%)
  266.  marrec%,mad%
  267.  parrec%=&FFFF 
  268. marrec%=
  269. bad(parrec%))
  270.  marrec%
  271.   mad%=
  272. mad(marrec%)
  273. ChiOfMar(mad%,chirec%) 
  274. =marrec%
  275.   marrec%=
  276. bb(mad%+nmo%)
  277. ChiOfMar(mad%,chirec%)
  278.  crec%
  279. crec%=
  280. ech(mad%)
  281.  crec%
  282.  crec%=chirec% 
  283.   crec%=
  284. bad(crec%))
  285.  ======================================================================
  286. Print(Head$,Val$)
  287.  Val$>"" 
  288.  Head$+Val$
  289. btab%=1  :
  290.  basic records
  291.  mtab%=2  :
  292.  marriage records
  293. ntab%=3  :
  294.  names
  295. stab%=4  :
  296.  surnames
  297. ttab%=5  :
  298.  titles
  299. ptab%=6  :
  300.  places
  301. wtab%=7  :
  302.  word
  303. itab%=8  :
  304.  integer
  305. etab%=9  :
  306.  extract
  307. 4tables%=9                    :
  308.  Number of tables
  309. 9program%=160000              :
  310.  allowance for program
  311. ;variables%=160000            :
  312.  allowance for variables
  313. 7stack%=10000                 :
  314.  allowance for stack
  315. +program%+variables%  :
  316.  start of data block
  317. AP%=D%+16                     :
  318.  start of table offset storage
  319. 8S%=D%+100                    :
  320.  start of first table
  321. <C%=D%-100                    :
  322.  start of working storage
  323. :L%=40                        :
  324.  Length of basic record
  325. =W%=32                        :
  326.  Length of marriage record
  327.  offsets for basic record
  328. sno% = 0  :
  329.  surname
  330. fno% = 2  :
  331.  forename
  332. bno% = 4  :
  333.  bynames
  334. sxo% = 6  :
  335. sto% = 7  :
  336.  status
  337. tlo% = 8  :
  338.  title
  339. dobo%=10  :
  340.  date of birth
  341. pobo%=15  :
  342.  place of birth
  343. dodo%=17  :
  344.  date of death
  345. podo%=22  :
  346.  place of death
  347. pao% =24  :
  348.  father
  349. mao% =26  :
  350.  mother
  351. sbso%=28  :
  352.  siblings
  353. #neso%=29  :
  354.  next elder sibling
  355. %nyso%=31  :
  356.  next younger sibling
  357. mgso%=33  :
  358.  marriages
  359. fmgo%=34  :
  360.  first marriage
  361. kdso%=36  :
  362.  kids
  363. 'bf1o%=37  :
  364.  basic flag 1 - deleted
  365. bf2o%=38  :
  366.  basic flag 2
  367. bf3o%=39  :
  368.  basic flag 3
  369.  offsets for marriage record
  370. $!domo%= 0  :
  371.  date of marriage
  372. %%tpo% = 5  :
  373.  type of relationship
  374. &(doeo%= 6  :
  375.  date of end of marriage
  376. '+rfeo%=11  :
  377.  reason for end of marriage
  378. ("pomo%=13  :
  379.  place of marriage
  380. hbo% =15  :
  381.  husband
  382. wfo% =17  :
  383.  wife
  384. chno%=19  :
  385.  children
  386. echo%=20  :
  387.  eldest child
  388. -(hnmo%=22  :
  389.  husband's next marriage
  390. .,hpmo%=24  :
  391.  husband's previous marriage
  392. /%wnmo%=26  :
  393.  wife's next marriage
  394. 0)wpmo%=28  :
  395.  wife's previous marriage
  396. 1 mf1o%=30  :
  397.  marriage flag 1
  398. 2 mf2o%=31  :
  399.  marriage flag 2
  400. 40hdo%=70  :
  401.  offset for heading in data block
  402.  Initialise table offsets to zero.
  403. 7    a%=P%
  404.  J%=1 
  405.  tables%+1:!a%=0:a%+=4:
  406.  Month$(12)
  407. ;WMonth$()="","Jan","Feb","Mar","Apr","May","Jun","Jul","Aug","Sep","Oct","Nov","Dec"
  408.  ======================================================================
  409.  Name from a record.
  410. RecName(R%)
  411.  R%=&FFFF 
  412. ="None" 
  413. Name(
  414. bad(R%))
  415.  Name at a record address.  Combine first names,
  416.  surname, 'bynames' and title into one string.
  417. Name(Ad%)
  418.  Name$,Nick$,Title$
  419. J$Name$=
  420. fn(Ad%)+" /"+
  421. sn(Ad%)+"/"
  422. K3Nick$=
  423. bn(Ad%):
  424.  Nick$>"" Name$+=" ("+Nick$+")"
  425. L2Title$=
  426. tl(Ad%):
  427.  Title$>"" Name$+=", "+Title$
  428. =Name$
  429.  Date string from a record address.
  430. Date(ad%,O%)
  431.  date%,code%,d$,r$
  432. date%=ad%!O%
  433.  date%=0 
  434. code%=ad%!(O%+4)
  435. (1E9+date%),8)
  436. d$,2)+
  437. d$,5,2)+
  438. d$,4)
  439. X    r$=""
  440.  I%=1 
  441.  code% 
  442.  256>>I% r$+="?" 
  443.  r$+=
  444. d$,I%,1)
  445. r$,2)+" "+
  446. Month(
  447. r$,3,2))+" "+
  448. r$,4)
  449. Month(N$)
  450.  M%:M%=
  451. =Month$(M%) 
  452.  =====================================================================
  453.  Start address of table t%.  1 <= t% <= tables%+1
  454. tad(t%)=S% + P%!((t%-1)<<2)
  455.  Address of basic record R%.
  456. bad(R%)=S%+(R%-1)*L%
  457.  address of marriage record R%
  458. mad(R%)=
  459. tad(mtab%)+(R%-1)*W%
  460.  peek two-byte number at address a%, MSB first.
  461. bb(a%)=?a%*256+a%?1
  462. head=
  463. tad(tables%+1)
  464. ceiling=
  465. -stack%
  466.  ======================================================================
  467.  Functions to peek basic records
  468. sn(a%)=$(
  469. tad(stab%)+
  470. bb(a%+sno%))   :
  471.  surname
  472. fn(a%)=$(
  473. tad(ntab%)+
  474. bb(a%+fno%))   :
  475.  forenames
  476. bn(a%)=$(
  477. tad(ntab%)+
  478. bb(a%+bno%))   :
  479.  bynames
  480. sx(a%):
  481.  c%                         :
  482. c%=a%?sxo%:
  483.  c%=0
  484. st(a%):
  485.  c%                         :
  486.  status
  487. c%=a%?sto%:
  488.  c%=