home *** CD-ROM | disk | FTP | other *** search
/ The Datafile PD-CD 5 / DATAFILE_PDCD5.iso / utilities / f / family / !Family / !RunImSrc (.txt) < prev    next >
RISC OS BBC BASIC V Source  |  1997-06-09  |  84KB  |  3,340 lines
  1.  This program is Copyright 1993, 1997 Denis Howe.  You may
  2.  distribute verbatim or modified copies of this program
  3.  provided each such copy is distributed with a copyright
  4.  notice and distribution conditions identical to these.
  5.  Please send me a copy of any changes you make and
  6.  update the modification history at the end of !Help.
  7.  Denis Howe <dbh@doc.ic.ac.uk>
  8. Task$    = "Family"
  9. #Purpose$ = "Family tree editor"
  10. "Author$  = "
  11.  1993 Denis Howe"
  12. #Version$ = "2.17 (09 Jun 1997)"
  13.  Initialise some variables for PROCError & PROCQuit
  14. :Task%=0:Modified%=
  15. :Font%=0:ExtEdJob%=0
  16. Error:
  17.  ================== User-customisable variables ===================
  18.  Maximum completions to show in Comp window
  19. MaxComp%=25
  20.  Maximum spouses in divorce menu
  21. MaxSpouse%=10
  22.  Maximum depth of tree displayed
  23. MaxGen%=20
  24.  Maximum GEDCOM structure depth
  25. MaxLevel%=20
  26. MTLoad("<Family$Dir>.Messages")
  27.  Allocate the heap by lowering HIMEM below the WimpSlot,
  28.  making sure there are VarSize% bytes left above
  29.  END for further variables, DIMs and strings.
  30. (.VarSize%=40000:Heap%=
  31. +VarSize%:HeapEnd%=
  32.  Heap%>=HeapEnd% 
  33. MT("NR")
  34. =Heap%                   :
  35.  Can't do this in a PROC
  36. +7Heap%=
  37.                    :
  38.  Read back actual value
  39. Init                      :
  40.  Misc one-off initialisation
  41. CrMenu                    :
  42.  Create menus
  43. InitTags                  :
  44.  Set up GEDCOM tags structures
  45.  PROCSyntax                :REM Load GEDCOM syntax description
  46. Reset                     :
  47.  Reset heap and database
  48. Args                      :
  49.  Check for cmd line args
  50.  ========================== Main loop =============================
  51. Error            :
  52.  Falls back into poll loop
  53. CheckFree
  54. Modified
  55.  Force% 
  56. Force         :
  57.  Update display
  58.  "Wimp_Poll",&1831,b% 
  59. Redraw
  60.  "Wimp_OpenWindow",,b%
  61.  "Wimp_CloseWindow",,b%
  62. @.    
  63.  !b%=MainWH% 
  64. Close(NoteWH%):
  65. OpenDir
  66. DragDone
  67. Buttons(!b%,b%!4,b%!8,b%!12,b%!16)
  68. Key(!b%,b%!4,b%!24)
  69. MenuClick(b%!0,b%!4,b%!8,b%!12)
  70.  17,18:
  71. Receive(b%!0,b%!4,b%!8,b%!16)
  72. RcvAck(b%!0,b%!4,b%!16)
  73.  ===================== GEDCOM access functions ====================
  74.  Return an object's value after stripping the reference flag
  75. Val(O%)=O%!ObVal% 
  76.  ObRef%
  77.  Create a new object with Tag% and Value%
  78. Object(Tag%,Value%)
  79. Alloc(ObSize%)
  80. U=O%!ObTag%=Tag%:O%!ObVal%=Value%:O%!ObSubs%=0:O%!ObNext%=0
  81.  Convert null pointer to empty string
  82. Null(P%)
  83.  Return a string to print O%'s value - either
  84.  its string value or a cross-reference Id.
  85. PrintStr(O%)
  86.  V%:V%=O%!ObVal%
  87.  ObRef% 
  88. Id(V% 
  89.  ObRef%)
  90. Null(V%)
  91.  Get the string value of O%'s first sub-object
  92.  with Tag% or "" if there is no such value
  93. GetStr(O%,Tag%)=
  94. Null(
  95. GetVal(O%,Tag%))
  96.  Return the value of object O%'s first sub-object
  97.  with Tag% or 0 if there is no such object
  98. GetVal(O%,Tag%)
  99.  S%:S%=0
  100. GetSub(O%,Tag%,S%) S%=
  101. Val(S%)
  102.  If S%=0 return O%'s first sub-object
  103.  with Tag% else return the next one
  104. GetSub(O%,Tag%,
  105.  O%=0 
  106.  1,"FNGetSub"
  107.  S% S%=S%!ObNext% 
  108.  S%=O%!ObSubs%
  109.  S%!ObTag%=Tag% 
  110.   S%=S%!ObNext%
  111.  Ensure that O% has a sub-object with Tag% and Val$ or none
  112.  if Val$="".  If Single% then overwrite any exiting Tag% sub-
  113.  object otherwise add a new one.  Deallocate any previous value.
  114. SetStr(O%,Tag%,Val$,Single%)
  115.  O$,V%,S%
  116.  O%=0 
  117.  1,"PROCSetStr"
  118.  Val$="" 
  119. DelTag(O%,Tag%):
  120. GetSub(O%,Tag%,S%)
  121. 1  V%=S%!ObVal%:
  122.  (V% 
  123.  ObRef%)=0 
  124.  $V%=Val$ 
  125.  Single% 
  126. )    
  127. Free(V%):S%!ObVal%=
  128. String(Val$)
  129.     Modified%=
  130.         
  131. Tail(O%)=
  132. Object(Tag%,
  133. String(Val$))
  134. Modified%=
  135.  Ensure that O% has a sub-object with Tag% and Val%. 
  136.  Single% => overwrite any existing Tag% sub-object
  137.  else add a new one.  Don't deallocate referend of
  138.  any previous value (which may not be a pointer).
  139. SetSub(O%,Tag%,Val%,Single%)
  140.  O%=0 
  141.  1,"PROCSetSub"
  142. GetSub(O%,Tag%,S%)
  143.  S%!ObVal%=Val% 
  144.  Single% 
  145.  S%!ObVal%=Val%:Modified%=
  146. Tail(O%)=
  147. Object(Tag%,Val%)
  148. Modified%=
  149.  Return the address of the last ObNext% in P%'s sub-object list
  150. Tail(P%)
  151. )P%=P%+ObSubs%:
  152.  !P%:P%=!P%+ObNext%:
  153.  ======================= Remove, Delete, Kill =====================
  154.  Remove => unlink the object from some given place but don't free it.
  155.  Delete => remove it and free it and its string value.
  156.  Kill   => delete it and remove any cross-references to it.
  157.  Delete object Victim%, its sub-objects and all cross-references to
  158.  it from other objects.  Also remove objects which are only referred
  159.  to from Victim%.  These may be shared so we have to traverse the
  160.  whole database several times to determine what's still live.
  161. Kill(Victim%)
  162.  Victim%=0 
  163. Mark(Victim%)
  164. Scan(Root%):
  165. Modified%=
  166. :Force%=1
  167.  Mark object O% and its sub-objects by setting the
  168.  Dead% bit in their tag pointers (not their tag flags)
  169. Mark(O%)
  170. O%!ObTag%=O%!ObTag% 
  171.  Dead%
  172. 1O%=O%!ObSubs%:
  173. Mark(O%):O%=O%!ObNext%:
  174.  Mark as dead any sub-object of O% which is a cross-reference
  175.  to a dead object.  Recurse on its sub-objects.  If any
  176.  sub-object is marked as dead, free it and remove it from the 
  177.  list.  If a FAM object is left with less than 2 sub-objects
  178.  then remove it.  Return Dead% if any object died.
  179. Scan(O%)
  180.  D%,P%,S%,V%
  181. P%=O%+ObTag%:V%=O%!ObVal%
  182.  ObRef% 
  183.   V%=V% 
  184.  ObRef%
  185.  Dead x-ref - mark O% dead
  186.  V%!ObTag% 
  187.  Dead% !P%=!P% 
  188.  Dead%
  189.  D%=!P% 
  190.  Dead%:P%=O%+ObSubs%
  191.   S%=!P%:D%=D% 
  192. Scan(S%)
  193.  S%!ObTag% 
  194.  Dead% 
  195. FreeOb(S%)
  196.     !P%=S%!ObNext%
  197.  P%=S%+ObNext%
  198. P%=O%+ObTag%
  199.  (!P% 
  200.  Dead%)=FamTg% 
  201.   S%=O%!ObSubs%
  202.  S%!ObNext% 
  203.  !P%=!P% 
  204.  Dead%:D%=Dead%
  205.  Free object O% and its value (if a string) but not its sub-
  206.  objects.  If it's a display structure pointer, free the name.
  207. FreeOb(O%)
  208.  V%:V%=O%!ObVal%
  209.  (O%!ObTag% 
  210.  Dead%)=DispTg% 
  211. Free(V%!DSName%)
  212.  (V% 
  213.  ObRef%)=0 
  214. Free(V%)
  215. Free(O%)
  216.  Remove O%'s first sub-object with Tag% and Val% but don't free it
  217. RemSub(O%,Tag%,Val%)
  218.  O%=0 
  219.  Val%=0 
  220.  1,"PROCRemSub"
  221. P%=O%+ObSubs%
  222.   O%=!P%
  223.  O%!ObTag%=Tag% 
  224. 6    
  225. Val(O%)=Val% 
  226.  !P%=O%!ObNext%:Modified%=
  227.   P%=O%+ObNext%
  228.  Remove S% from O%'s sub-object list
  229. RemSubObj(O%,S%)
  230. O%=O%+ObSubs%
  231.  !O%=S% 
  232.  !O%=S%!ObNext%:
  233.   O%=!O%+ObNext%
  234.  Remove all O%'s sub-objects with Tag%
  235. DelTag(O%,Tag%)
  236.  O%=0 
  237.  1,"PROCDelTag"
  238. P%=O%+ObSubs%
  239.   O%=!P%
  240.  O%!ObTag%=Tag% 
  241. "    !P%=O%!ObNext%:
  242. DelObj(O%)
  243.     P%=O%+ObNext%
  244.  Remove object O% and its sub-objects
  245. DelObj(O%)
  246. FreeOb(O%)
  247. 3O%=O%!ObSubs%:
  248. DelObj(O%):O%=O%!ObNext%:
  249.  =========================== Display ==============================
  250.  Wimp requests redraw
  251. Redraw
  252.  XW%,YW%,M%,P%,WH%
  253.  "Wimp_RedrawWindow",,b% 
  254. $9WH%=!b%:XW%=b%!4-b%!20:YW%=b%!16-b%!24 :
  255.  Work origin
  256.  WH%=MainWH% 
  257.  TopChil%=0 
  258.  WH% 
  259.  MainWH%:
  260. Display(b%!28-XW%,b%!32-YW%,b%!36-XW%,b%!40-YW%,OutScreen%)
  261.  CompWH%:
  262. DrawComp(XW%,YW%)
  263.  NoteWH%:
  264. DrawNote(XW%,YW%)
  265.  ObEdWH%:
  266. DrawObEd(XW%,YW%,b%!32,b%!40)
  267.  1,"PROCRedraw"
  268.  "Wimp_GetRectangle",,b% 
  269.  Something in the main window has changed.
  270.  Recalculate all positions and the extent.
  271. Force
  272.  F%,O%,X%,Y%
  273. UseFont%=ScreenUseFont%
  274. CalcAll
  275. Close(MainWH%)
  276.  yMax%>yMin% 
  277. ;,  b%!0=(xMin%-32) 
  278.  7:b%!4=yMin% 
  279. <0  b%!8=(xMax%+7) 
  280.  7:b%!12=(yMax%+7) 
  281.  "Wimp_SetExtent",MainWH%,b%
  282. ?-b%!0=MainWH%:
  283.  "Wimp_GetWindowState",,b%
  284.  Force%>1 
  285.  TopChil%>0 
  286.  Find the Chil object pointing to Person%
  287.   F%=0:O%=0
  288. GetSub(Person%,FamcTg%,F%) 
  289.     F%=
  290. Val(F%):X%=0
  291. E.    
  292. GetSub(F%,ChilTg%,O%) X%=
  293. Val(O%)
  294.  O%=0 
  295.  X%=Person%
  296.  O%=0 O%=TopChil%
  297. GetPos(O%,X%,Y%)  :
  298.  Scroll to show Person%
  299.   b%!20=X%-(b%!12-b%!4) 
  300.   b%!24=Y%+(b%!16-b%!8) 
  301.  b%!8-=Infinity%:b%!12+=Infinity% :REM Max window down right
  302.  "Wimp_OpenWindow",,b%
  303. Force%=0
  304.  Ensure menu on top if open
  305.  Menu% 
  306.  "Wimp_CreateMenu",,Menu%,MenuX%,MenuY%
  307.  Get the display position of a CHIL object.  A CHIL's 
  308.  first subobject always points to its display structure.
  309. GetPos(C%,
  310.  C%=0 
  311.  1,"PROCGetPos"
  312. C%=C%!ObSubs%
  313. C%=C%!ObVal%
  314. X%=C%!DSx%:Y%=C%!DSy%
  315. Name(P%)=
  316. GetStr(P%,NameTg%)
  317.  If N$ contains two '/'s return the string between them.
  318.  Otherwise return the last word preceded by a space or nothing if
  319.  no such word.  Ignore anything after a non-initial '(' or '['.
  320. FamName(N$)
  321.  B%,E%,S%
  322.  N$="" 
  323.  Check for GEDCOM family name between '/'s
  324. N$,"/")
  325.  S% S%+=1:E%=
  326. N$,"/",S%):
  327. N$,S%,E%-S%)
  328. j&B%=
  329. N$,"(",2):
  330.  B%=0 B%=
  331. N$,"[",2)
  332.  B% N$=
  333. N$,B%-1)
  334. N$,1)=" ":N$=
  335. (N$)-1):
  336. N$," "):
  337.  S% N$=
  338. N$,S%+1):B%=
  339.  S%=0
  340.  Return P%'s dates string.  Show "?" for missing d.o.b.
  341.  but nothing for death (would suggest person is dead).
  342. Dates(P%)
  343.  D$,W$
  344. Birth(P%)
  345.  D$>"" W$=
  346. Year(D$) 
  347.  W$="?"
  348. W$+=" -"
  349. Death(P%)
  350.  D$>"" W$+=" "+
  351. Year(D$)
  352.  Return date from last group of digits to end
  353. Year(D$)
  354.  ShowYearOnly% 
  355.  E%>1
  356. Digit(
  357. D$,E%,1)) 
  358. %    
  359.  E%-=1:
  360. Digit(
  361. D$,E%,1))
  362.     =
  363. D$,E%+1)
  364.   E%-=1
  365. Alpha(C$)
  366.  C%:C%=
  367. (C$) 
  368. =C%>=
  369.  C%<=
  370. Digit(C$)=C$>="0" 
  371.  C$<="9"
  372.  ===================== Calculate positions ========================
  373.  Calculate work coords of Person%'s family.
  374.  Set global work area (xMin%,yMin%) to (xMax%,yMax%).
  375.  Global UseFont% determines string widths.
  376. CalcAll
  377.  DS%,H%,I%,P%,S%,Y0%
  378.  "Font_SetFont",Font%      :
  379.  Affects widths
  380. HGap%=
  381. Width("XX")            :
  382.  Horiz. space between adjacent people
  383.  UseFont% 
  384.  "Font_ReadInfo",Font% 
  385. ,,Y0%,,H%:H%-=Y0% 
  386.  H%=CharH%
  387. LineHeight%=H%+8
  388. 1xMin%=0:yMin%=0:xMax%=MinW%:yMax%=0:xMax%()=0
  389.  Person%=0 TopChil%=0:
  390.  Error here (e.g. out of memory) is fatal
  391.  Fake a CHIL object to point to the person at the top of
  392.  the tree.  Attach the top level display structure to it.
  393. ,TopChil%=
  394. Object(ChilTg%,
  395. Fore(Person%))
  396. DStruct(TopChil%)
  397. S%=TopChil%:P%=0
  398.  S%>1
  399.  S%!ObTag% 
  400.  HusbTg%,WifeTg%,ChilTg%
  401. D    DS%=
  402. DStruct(S%)       :
  403.  Give every member a display struct
  404. 6    DS%!DSx%=Infinity%      :
  405.  Everyone off screen
  406.     DS%!DSy%=-Infinity%
  407.   S%=S%!ObNext%
  408.  S%=0
  409. 7    
  410. GetSub(Root%,FamTg%,P%) S%=P%!ObSubs% 
  411.  S%=1
  412.  "Hourglass_On"
  413. Calc(TopChil%,0,0,z,xMin%,xMax%)
  414.  "Hourglass_Off"
  415. Max(xMax%,MinW%)
  416. xMax%+=20
  417.  Calculate position of person pointed to by Chil%, his
  418.  spouses and descendants.  Y% is his top.  Return his
  419.  centre and left and right of everything below him.
  420. Calc(Chil%,Y%,Gen%,
  421.  XLT%,
  422.  XRT%)
  423.  DS%,Done%,I%,FO%,P%,SN%,W%,X1%,XF%,XR%,XLF%,XRF%,OxMax%(),N$
  424.  OxMax%(MaxGen%)
  425. Val(Chil%):
  426.  P%=0 
  427.  1,"PROCCalc"
  428. DS%=ObVal%!(Chil%!ObSubs%)
  429.  DS%!DSy%>Y% X%=xMax%(Gen%):XLT%=X%:XRT%=X%:
  430. DS%!DSy%=Y%-LineHeight%
  431. ShowName(P%,Gen%=0)
  432. Free(DS%!DSName%):DS%!DSName%=
  433. String(N$)
  434. Width(N$)
  435.  ShowDates% 
  436. Max(W%,
  437. Width(
  438. Dates(P%))):Y%-=LineHeight%
  439. #Y%-=4*LineHeight%:
  440.  W% W%+=Gap%
  441. Min(yMin%,Y%)
  442. FI%=0:FO%=0                    :
  443.  1st of >1 spouses is #1 else no #
  444. GetSub(P%,FamsTg%,FO%) 
  445. GetSub(P%,FamsTg%,FO%) I%=1
  446. DS%!DSSpNum%=I%
  447. OxMax%()=xMax%():Done%=
  448.  If no families place against border.
  449. @  X%=OxMax%(Gen%):XR%=X%+W%   :
  450.  P%'s borders if no families
  451.   XLT%=X%:XRT%=XR%
  452. =  X%+=W% 
  453.  2                :
  454.  P%'s centre if no families
  455.   X1%=0:XF%=X1%:FO%=0
  456. GetSub(P%,FamsTg%,FO%)
  457. 4    
  458. CalcFam(P%,
  459. Val(FO%),Y%,Gen%,XF%,XLF%,XRF%)
  460. '    
  461.  X1%=0 X1%=XF%:
  462. Min(XLT%,XLF%)
  463. Max(XRT%,XRF%)
  464.  X1% 
  465. 1    XF%=(X1%+XF%) 
  466.  2:Done%=XF%>=X% 
  467.  Done%
  468.  Done% 
  469. <      
  470.  If families to right of P%, centre over families
  471.       X%=XF%:XR%=XF%+W% 
  472.         
  473. H      
  474.  If P% to right of families, shift descendants' borders right
  475. "      xMax%()=OxMax%():X%-=XF%
  476. -      
  477.  I%=Gen% 
  478.  MaxGen%:xMax%(I%)+=X%:
  479.         
  480.  Done%
  481. Max(xMax%(Gen%),XR%)
  482. 1DS%!DSx%=X%:DS%!DSxmin%=XLT%:DS%!DSxmax%=XRT%
  483.  Calculate positions of Top%'s spouse in Fam% and
  484.  their kids.  Return centre of spouse and left
  485.  and right of spouse/kids.  Y% is top of kids.
  486. CalcFam(Top%,Fam%,Y%,Gen%,
  487.  XLT%,
  488.  XRT%)
  489.  Spouse%,CO%,Done%,DS%,I%,N$,W%,X1%,XC%,XR%,XLF%,XRF%,OxMax%()
  490.  OxMax%(MaxGen%)
  491. Spouse%=0
  492. GetSub(Fam%,HusbTg%,Spouse%) 
  493. Val(Spouse%)=Top% Spouse%=0:z=
  494. GetSub(Fam%,WifeTg%,Spouse%)
  495.  Spouse% N$=
  496. Name(
  497. Val(Spouse%))
  498. Width(N$)+Gap%
  499. OxMax%()=xMax%():Done%=
  500. 3  X%=xMax%(Gen%):XR%=X%+W%    :
  501.  Wife's borders
  502.   XLT%=X%:XRT%=XR%
  503. <  X%+=W% 
  504.  2                :
  505.  Centre of wife if no kids
  506.   X1%=0:CO%=0
  507.  Gen%<MaxGen% 
  508. $    
  509. GetSub(Fam%,ChilTg%,CO%)
  510. ,      
  511. Calc(CO%,Y%,Gen%+1,XC%,XLF%,XRF%)
  512. )      
  513.  X1%=0 X1%=XC%:
  514. Min(XLT%,XLF%)
  515.       
  516. Max(XRT%,XRF%)
  517.         
  518.  X1% 
  519. 1    XC%=(X1%+XC%) 
  520.  2       :
  521.  Centre of kids
  522.     Done%=XC%>=X% 
  523.  Done%
  524.  Done% 
  525. <      
  526.  If kids to right of wife - centre wife over kids
  527.       X%=XC%:XR%=X%+W% 
  528.         
  529. D      
  530.  Wife to right of kids - shift descendants' borders right
  531. "      xMax%()=OxMax%():X%-=XC%
  532. /      
  533.  I%=Gen%+1 
  534.  MaxGen%:xMax%(I%)+=X%:
  535.         
  536.                         :
  537.  No kids
  538.  Spouse%=0 X%=0
  539.  Done%
  540. xMax%(Gen%)=XR%
  541.  Spouse%=0 
  542. DDS%=ObVal%!(Spouse%!ObSubs%):DS%!DSx%=X%:DS%!DSy%=Y%+LineHeight%
  543. Free(DS%!DSName%):DS%!DSName%=
  544. String(N$)
  545. ShowName(P%,ShowFam%)
  546.  I%,J%,F$,G$,N$
  547.  P%=0 
  548.  1,"FNShowName"
  549. Name(P%)
  550.  ShowFamilyName% 
  551.  ShowFam% 
  552.  Hide family name if same as father's and father visible
  553. " F$=
  554. FamName(N$):
  555.  F$="" 
  556. Father(P%):
  557.  I%=0 
  558. $'G$=
  559. FamName(
  560. Name(I%)):
  561.  G$="" 
  562.  G$<>F$ 
  563. &'J%=0:
  564.  I%=J%:J%=
  565. N$,F$,I%+1):
  566.  J%=0
  567. '%J%=I%+
  568. (F$):
  569. N$,J%,1)="/" J%+=1
  570. N$,I%-2)+
  571. N$,J%)
  572. Width(S$)
  573.  UseFont% 
  574. =CharW%*
  575.  "Font_StringWidth",,S$,Infinity%,Infinity%,-1,Infinity% 
  576.  mPtPerOS%
  577.  ========================= Display tree ===========================
  578.  Display tree starting at person pointed to by TopChil% at pre-
  579.  calculated work coords.  xMin%..yMax% is visible work rectangle. 
  580.  Globals XW%,YW% contain the screen coords of the work area origin
  581.  which is added to work coords for plotting.  These routines
  582.  are used for screen display (OutputTo%=OutScreen%, printing
  583.  (OutputTo%=OutPrint%), and for making DrawFiles (OutputTo%=OutDraw%).
  584. Display(xMin%,yMin%,xMax%,yMax%,OutputTo%)
  585.  OutputTo%=OutPrint% 
  586. Colour(Black%)
  587. DisplayIndi(TopChil%,-LineHeight%,xMin%,yMin%-LineHeight%,xMax%,yMax%)
  588. DisplayIndi(Chil%,Y%,xMin%,yMin%,xMax%,yMax%)
  589.  CO%,DS%,F%,FO%,H%,P%,S%,SL%,SN%,SP%,SR%,XP%,YP%,X1%,XM%,N$
  590. Val(Chil%)
  591. ACDS%=ObVal%!(Chil%!ObSubs%)    :
  592.  First subobj is display struct
  593.  DS%!DSxmin%>=xMax% 
  594.  DS%!DSxmax%<=xMin% 
  595. XP%=DS%!DSx%:YP%=DS%!DSy%
  596.  YP%<=yMin% 
  597.  YP%<>Y% 
  598. G2Y%-=4*LineHeight%:
  599.  ShowDates% Y%-=LineHeight%
  600. H8SN%=DS%!DSSpNum%              :
  601.  1 => Number spouses
  602.  OutputTo%<>OutPrint% 
  603. SexColour(P%)
  604. Centre($(DS%!DSName%),XP%,YP%,
  605.  OutputTo%<>OutPrint% 
  606. Colour(Black%):FontCol%=Black%
  607.  ShowDates% 
  608. Centre(
  609. Dates(P%),XP%,YP%-LineHeight%,
  610. H%=LineHeight% 
  611.  2-4:FO%=0
  612. GetSub(P%,FamsTg%,FO%)
  613. O&  F%=
  614. Val(FO%):X1%=Infinity%:CO%=0
  615. GetSub(F%,ChilTg%,CO%)
  616. GetPos(CO%,XP%,YP%)
  617. R:    YP%+=YW%+LineHeight%      :
  618.  YP% now screen coords
  619.  OutputTo%=OutDraw% 
  620. T7      
  621. dw_line(XW%+XP%,YP%,XW%+XP%,YP%-H%,FontCol%)
  622. U        
  623. V:      
  624.  XW%+XP%,YP%:
  625.  BY 0,-H% :
  626.  Vertical above child
  627. W        
  628.  X1%=Infinity% X1%=XP%
  629. Y4    
  630. DisplayIndi(CO%,Y%,xMin%,yMin%,xMax%,yMax%)
  631.  X1%<>Infinity% 
  632. \C    XM%=(X1%+XP%) 
  633.  2                 :
  634.  Between first and last
  635.  OutputTo%=OutDraw% 
  636. ^4      
  637. dw_line(XW%+XM%,YP%,XW%+XM%,YP%+H%,Fore%)
  638. _1      
  639. dw_line(XW%+X1%,YP%,XW%+XP%,YP%,Fore%)
  640. `        
  641.       X1%+=XW%:XP%+=XW%
  642. b"      
  643.  OutputTo%=OutScreen% 
  644. c#        
  645.  Avoid 16-bit overflow
  646. d;        
  647.  X1%<-10000 X1%=-10000 
  648.  X1%>10000 X1%=10000
  649. e;        
  650.  XP%<-10000 XP%=-10000 
  651.  XP%>10000 XP%=10000
  652.       
  653. g:      
  654.  XW%+XM%,YP%:
  655.  BY 0,H% :
  656.  Vertical below spouse
  657. h2      
  658.  X1%,YP%,XP%,YP%          :
  659.  Horizontal
  660. i        
  661.  Find other parent in P%'s FAMS F%
  662.   SR%=0
  663. GetSub(F%,HusbTg%,SR%) 
  664.     SP%=
  665. Val(SR%)
  666. o>    
  667.  SP%=P% SR%=0:
  668. GetSub(F%,WifeTg%,SR%) SP%=
  669. Val(SR%)
  670.   S%=
  671.  SR% 
  672. s9    SL%=0:
  673. Spouses(SP%,SL%)=0 
  674.  1,"PROCDisplayIndi"
  675. t-    DS%=ObVal%!(SR%!ObSubs%):XM%=DS%!DSx%
  676. u.    S%=
  677. Father(SP%):
  678.  S%=0 S%=
  679. Mother(SP%)
  680. v.    
  681.  OutputTo%<>OutPrint% 
  682. SexColour(SP%)
  683. w7    
  684. Centre($(DS%!DSName%),XM%,Y%+2*LineHeight%,S%)
  685. x>    
  686.  OutputTo%<>OutPrint% 
  687. Colour(Black%):FontCol%=Black%
  688. y:    S%=
  689. Spouses(SP%,SL%)     :
  690.  SP% has other spouses?
  691. {$  N$="=":
  692.  SN% N$+=
  693. (SN%):SN%+=1
  694. Centre(N$,XM%,Y%+3*LineHeight%,S%)
  695. Centre(S$,X%,Y%,Plus%)
  696.  W%:W%=
  697. Width(S$)>>1
  698. X%+=XW%-W%:Y%+=YW%
  699.  UseFont% 
  700.  OutputTo%=OutDraw% 
  701.  Plus% S$+="
  702. +    
  703. dw_text(X%,Y%,PtSize%,FontCol%,S$)
  704.  Screen or printer
  705. #    
  706.  Avoid PLOT coord overflow
  707. 3    
  708.  X%<-10000 X%=-10000 
  709.  X%>10000 X%=10000
  710. -    
  711.  Plus% S$+=
  712. (11)+
  713. (16)+
  714. (0)+"+"
  715. =    
  716.  "Font_Paint",Font%,S$,&310,X%,Y%-LineHeight% 
  717.  X%,Y%+12:
  718.  Plus% 
  719.  BY 0,10:
  720.  Set the foreground colour and font for system
  721.  font, lines and outline fonts.  Fore% is &BBGGRR00.
  722. Colour(Fore%)
  723.  Set GCOL for system font and lines
  724.  "ColourTrans_SetGCOL",Fore%,,,0
  725.  "ColourTrans_SetGCOL",White%,,,1<<7 :
  726.  Background
  727.  Set font and font colours in case using outline fonts
  728.  "Font_SetFont",Font%
  729.  "ColourTrans_SetFontColours",Font%,White%,Fore%,14
  730. SexColour(P%)
  731. Sex(P%) 
  732.  "M" :
  733. Colour(Blue%):FontCol%=Blue%
  734.  "F" :
  735. Colour(Red%):FontCol%=Red%
  736. Colour(Green%):FontCol%=Green%
  737.  A%,B%)
  738.  B%<A% A%=B%
  739.  A%,B%)
  740.  B%>A% A%=B%
  741.  ============================= WIMP ===============================
  742.  Load a template and create the window.  The block is
  743.  loaded at b%+4 so it can be used for Wimp_OpenWindow.
  744. GetTem($mess%)
  745.  "Wimp_LoadTemplate",,b%+4,ind%,indend%,-1,mess% 
  746. ,,ind%
  747.  b%!(4+64)=Sprites%        :REM User sprite area
  748.  "Wimp_CreateWindow",,b%+4 
  749.  Open window on top
  750. Open(!b%)
  751.  "Wimp_GetWindowState",,b%
  752. %b%!28=-1:
  753.  "Wimp_OpenWindow",,b%
  754. Close(!b%)
  755.  "Wimp_CloseWindow",,b%
  756.  Set work area extent and visible area.  Top left is work origin.
  757.  Bring window to front if Front%.
  758. Extent(WH%,Width%,Height%,Front%)
  759.  Depth%
  760.  Front% Depth%=-1 
  761.  !b%=WH%:
  762.  "Wimp_GetWindowState",,b%:Depth%=b%!28
  763. Close(WH%)                :
  764.  Force redraw
  765. ;b%!0=0:b%!4=-Height% 
  766.  7:b%!8=(Width%+7)
  767.  7:b%!12=0
  768.  "Wimp_SetExtent",WH%,b%
  769.  Resize visible area bottom right to work area
  770. =!b%=WH%:b%!12=b%!4+Width%:b%!8=b%!16-Height%:b%!28=Depth%
  771.  "Wimp_OpenWindow",,b%
  772.  Redraw icon given window and icon handles and selection state
  773. SelIcon(b%!0,b%!4,On%)
  774. %b%!8=(1<<21) 
  775.  On%<>0:b%!12=1<<21
  776.  "Wimp_SetIconState",,b%
  777.  Is icon selected?
  778. SelIcon(b%!0,b%!4)
  779.  "Wimp_GetIconState",,b%
  780. =(b%!24 
  781.  1<<21)<>0
  782.  Return the address of the indirected text of WH's icon IH.
  783.  Also the address of an indirected sprite.
  784. IcTxt(b%!0,b%!4) :
  785.  WH, IH
  786.  "Wimp_GetIconState",,b%
  787. =b%!28
  788. Caret(WH%,IH%,End%)
  789.  End% L%=
  790. IcTxt(WH%,IH%)) 
  791.  L%=0
  792.  "Wimp_SetCaretPosition",WH%,IH%,,,-1,L%
  793. SelIcon(WH%,IH%,
  794. )    :
  795.  Redraw icon
  796. Key(WH%,IH%,Key%)
  797.  Key% 
  798.  Print%:
  799. Print
  800.  F1%   :
  801. Complete(WH%,IH%)
  802.  F3%   :
  803. MouseMenu(SaveWH%)          :
  804.  F3 Save
  805.  F5%   :
  806. MouseMenu(GotoWH%)          :
  807.  F5 Goto
  808.  CtrlC%:
  809. EditChild(Person%)          :
  810.  ^C adds child
  811.  CtrlE%:
  812. EditPerson(Person%)         :
  813.  ^E edits current
  814.  CtrlS%:
  815.  WH%=EditWH% 
  816. Edit(0,Key%) :
  817.  ^S toggles sex
  818.  Return passed as key event.  Note any K command in the validation
  819.  string prevents CR being passed.  Kt only passes it for the last icon.
  820.  CR%,UpArrow%,DownArrow%:
  821.  WH%>0 
  822. Buttons(0,0,Key%,WH%,IH%)
  823.  Tab%  :
  824. Key(WH%,IH%,DownArrow%)
  825.  ShfTab%:
  826. Key(WH%,IH%,UpArrow%)
  827.  CtrlQ%:
  828.  "Wimp_ProcessKey",Key%
  829.  Mouse event @ X,Y or key press
  830. Buttons(X%,Y%,But%,WH%,IH%)
  831.  But%=2 
  832.  WH%<0 
  833.  IH%<0 
  834. OpenMenu(X%,Y%,WH%):
  835.  WH% 
  836.  -2                       :
  837.  Icon bar
  838.  Person% 
  839. Open(NoteWH%)
  840. Open(MainWH%)
  841.  CompWH%:
  842. Comp(Y%)
  843.  EditWH%:
  844. Edit(IH%,But%)
  845.  GotoWH%,MarryWH%
  846.  IH%=GoIcOK%,But%=CR%
  847. (    P%=
  848. Find($
  849. IcTxt(WH%,GoIcName%))
  850. :      
  851.  WH%=GotoWH% 
  852. Goto(P%) 
  853. Marry(MenuPerson%,P%)
  854.         
  855.  IH%=GoIcCur%
  856. -    $
  857. IcTxt(WH%,GoIcName%)=
  858. Name(Person%)
  859. Caret(WH%,GoIcName%,
  860.         
  861.  IH%=GoIcCan%:But%=4
  862.  MainWH%
  863.   P%=
  864. Near(X%,Y%):
  865.  P%=0 
  866.  But%=1 
  867. EditPerson(P%) 
  868. Goto(P%)
  869.  ModsWH%
  870.  IH% 
  871.  MoIcDisc%
  872.     Modified%=
  873.  ToDo$ 
  874.  ".Q":
  875.  ".R":
  876. Reset
  877. Load(ToDo$,
  878. &        
  879.  MoIcSave%:
  880. MouseMenu(SaveWH%):
  881.   But%=4
  882.  NoteWH%:
  883. EditNotes
  884.  SaveWH%,RepoWH%,DrawWH%:
  885. Save(WH%,IH%,But%)
  886.  ObEdWH%:
  887. ObEdClick(Y%)
  888.  WH% 
  889.  GotoWH%,InfoWH%,MarryWH%,ModsWH%
  890.  But%<>1 
  891. Close(WH%):
  892.  "Wimp_CreateMenu",,-1:Menu%=0
  893.  Open a filer window on the directory of TreeFile$
  894.  if it includes one and the ADJUST botton is pressed.
  895. OpenDir
  896.  I%,P%,D$
  897.  "Wimp_GetPointerInfo",,b%:
  898.  b%!8<>1 
  899. I%=1:P%=0
  900. TreeFile$,".",I%+1):
  901.  I% P%=I%
  902.  I%=0
  903.  P%=0 
  904. TreeFile$,P%-1)
  905. ?2b%!20=0:b%!24=0:
  906. Send(OpenDir,D$,17,b%,0,0,28)
  907. GetVar(Var$)
  908.  Len%
  909.  "XOS_ReadVarVal",Var$,b%,blen% 
  910. ,,Len%
  911. b%?Len%=CR%:=$b%
  912.  Return the zero-terminated string at S% as a Basic string
  913. GetZStr(S%)
  914.  P%:P%=S%
  915.  ?P%:P%+=1:
  916. $P%=""
  917.  ========================= Initialisation =========================
  918. D("")
  919. S4Infinity%=999999              :
  920.  Well off screen
  921. TFCharW%=16:CharH%=32           :
  922.  System character size in OS units
  923. UGMinW%=600                     :
  924.  Min width of main window work area
  925. V6Hash%=0                       :
  926.  No hash table yet
  927. Modified%=
  928. X5ModifiedShown%=
  929.  Modified%  :
  930.  Force title redraw
  931. Y7LF%=10:CR%=13:CtrlC%=3:CtrlE%=5:CtrlQ%=17:CtrlS%=19
  932. Z%Space%=
  933. " ":LPar%=
  934. "(":LBra%=
  935. [*Print%=&180:F1%=&181:F3%=&183:F5%=&185
  936. \+Tab%=&18A:DownArrow%=&18E:UpArrow%=&18F
  937. ShfTab%=&19A
  938. ^ CR4$=
  939.  CR%+
  940.  CR%+
  941.  CR%+
  942.  Palette entries &BBGGRR00
  943. a;Black%=0:White%=&FFFFFF00     :
  944.  foreground, background
  945. b3Red%=&0000FF00:Green%=&00FF0000:Blue%=&FF000000
  946.  WIMP Messages
  947. Quit=0
  948. f@DataSave=1:DataSaveAck=2:DataLoad=3:DataLoadAck=4:DataOpen=5
  949. g:PreQuit=8:OpenDir=&400:HelpRequest=&502:HelpReply=&503
  950. MenusDeleted=&400C9
  951.  External edit messages
  952. k2EditRq=&45D80:EditAck=&45D81:EditReturn=&45D82
  953. l(EditAbort=&45D83:EditDataSave=&45D84
  954. ExtEdJob%=0
  955. blen%=2048:messlen%=400
  956.  b% blen%:
  957.  ind% 2600,indend% -1,mess% messlen%
  958. q9$b%="TASK":
  959.  "Wimp_Initialise",200,!b%,Task$ 
  960. ,Task%
  961.  Files and filetypes
  962.  "OS_FSControl",31,"GEDCOM" 
  963. ,,TreeType%
  964.  "OS_FSControl",31,"Text" 
  965. ,,TextType%
  966.  "OS_FSControl",31,"DrawFile" 
  967. ,,DrawType%
  968. x"ReportType%=TextType% 
  969.  &10000
  970. SaveType%=0
  971. TreeLeaf$="Tree"
  972. NoteLeaf$="Notes"
  973. |4NoteFile$=
  974. GetVar("Wimp$ScrapDir")+"."+NoteLeaf$
  975. ReportLeaf$="Report"
  976. DrawLeaf$="DrawFile"
  977. Scrap$="<Wimp$Scrap>"
  978. #OptFile$="<Family$Dir>.Choices"
  979. LoadOpts
  980.  Load sprites into user sprite area used by FNGetTem
  981.  LOCAL SpriteFile$
  982.  SpriteFile$="<Family$Dir>.Sprites"
  983.  Len%=FNFileLen(SpriteFile$)+4 :REM Add room for sprite area size.
  984.  DIM Sprites% Len%
  985.  Sprites%!0=Len%:Sprites%!8=16
  986.  SYS "OS_SpriteOp",256+9,Sprites%              :REM Init area.
  987.  SYS "OS_SpriteOp",256+10,Sprites%,SpriteFile$ :REM Load.
  988.  Create windows
  989.  "Wimp_OpenTemplate",,"<Family$Dir>.Templates"
  990. CompWH%=
  991. GetTem("Comp")
  992. A$(b%+76)="GEDCOM Edit":
  993.  "Wimp_CreateWindow",,b%+4 
  994.  ObEdWH%
  995. EditWH%=
  996. GetTem("Edit")
  997. CEdIcName%=0:EdIcBorn%=1:EdIcDied%=2:EdIcFather%=3:EdIcMother%=4
  998. 2EdIcMale%=5:EdIcFemale%=6:EdIcCan%=7:EdIcOK%=8
  999. GGotoWH%=
  1000. GetTem("Goto"):GoIcName%=0:GoIcCan%=1:GoIcCur%=2:GoIcOK%=3
  1001. @$(b%+4+72)=
  1002. MT("MT"):
  1003.  "Wimp_CreateWindow",,b%+4 
  1004.  MarryWH%
  1005. InfoWH%=
  1006. GetTem("Info")
  1007. $b%!(4+88+20)=Task$
  1008. $b%!(4+88+32+20)=Purpose$
  1009. $b%!(4+88+64+20)=Author$
  1010. $b%!(4+88+96+20)=Version$
  1011. MainWH%=
  1012. GetTem("Main")
  1013. >ModsWH%=
  1014. GetTem("Mods"):MoIcDisc%=0:MoIcCan%=1:MoIcSave%=2
  1015. ,NoteWH%=
  1016. GetTem("Note"):NoteTitle%=b%!76
  1017. SaveWH%=
  1018. GetTem("Save")
  1019. 2SaIcFile%=0:SaIcSprite%=1:SaIcOK%=2:SaIcCan%=3
  1020. RepoWH%=
  1021. GetTem("Repo")
  1022. DrawWH%=
  1023. GetTem("Draw")
  1024.  "Wimp_CloseTemplate"
  1025. Open(MainWH%)
  1026.  BarIcText% 10,BarIcValid% 20
  1027. b%!0=-1:b%!4=0:b%!8=0
  1028. %b%!12=68:b%!16=68:b%!20=&1700310B
  1029. /b%!24=BarIcText%:b%!28=BarIcValid%:b%!32=10
  1030. $BarIcText%=""
  1031. $BarIcValid%="S!"+Task$+
  1032.  "Wimp_CreateIcon",,b% 
  1033.  BarIc%
  1034.  Comp%(MaxComp%)
  1035.  Database structures
  1036. 5ObTag%=0:ObVal%=4:ObSubs%=8:ObNext%=12:ObSize%=16
  1037.  IdNext%=0:IdObj%=4:IdName%=8
  1038. IObRef%=1                      :
  1039.  Flag set in ObVal if it's an obj ref
  1040. J                              :
  1041.  (but not a display structure pointer)
  1042.  Display structure
  1043.  xMax%(MaxGen%) :
  1044.  Current right edge of tree at each level
  1045. 4DSx%=0:DSy%=4                 :
  1046.  Person's centre
  1047. >DSxmin%=8:DSxmax%=12          :
  1048.  Person+descendants extent
  1049. 6DSSpNum%=16                   :
  1050.  Spouses numbered?
  1051. >DSName%=20                    :
  1052.  Pointer to displayed name
  1053. DSSize%=24
  1054.  Output types
  1055. 'OutScreen%=1:OutPrint%=2:OutDraw%=3
  1056.  ===================== Menus & dialog boxes =======================
  1057.  Create menus
  1058. CrMenu
  1059. (DivorceM%=
  1060. InitMenu("Di",MaxSpouse%)
  1061. OPersM%=
  1062. Menu("Pe","Ed   ^E:EditWH%,Mr:MarryWH%,Di:DivorceM%,Ci...^C,Ol,Rm")
  1063. 0PersNameLen%=128:
  1064.  PersNameBuf% PersNameLen%
  1065. hMainM%=
  1066. Menu("Fa","Pe:PersM%#IPersNameBuf%:PersNameLen%,GE:,Go  F5:GotoWH%,Sa   F3:SaveWH%,Qu   ^Q")
  1067.  Font list is set by PROCShowOpts
  1068. /FontSizeLen%=10:
  1069.  FontSizeBuf% FontSizeLen%
  1070. <FontSizeM%=
  1071. Menu("FS",":-1#WIFontSizeBuf%:FontSizeLen%")
  1072. /FontM%=
  1073. Menu("Fo","Na,Si:FontSizeM%,OS,PR")
  1074. !ShowM%=
  1075. Menu("Sh","FN,Da,YO")
  1076. 2DrawScaleLen%=15:
  1077.  DrawScaleBuf% DrawScaleLen%
  1078. ?DrawScaleM%=
  1079. Menu("Sc",":-1#WIDrawScaleBuf%:DrawScaleLen%")
  1080. 2DrawWidthLen%=15:
  1081.  DrawWidthBuf% DrawWidthLen%
  1082. ?DrawWidthM%=
  1083. Menu("LW",":-1#WIDrawWidthBuf%:DrawWidthLen%")
  1084. 6DrawM%=
  1085. Menu("Dr","Sc:DrawScaleM%,LW:DrawWidthM%")
  1086. 8OptM%=
  1087. Menu("Co","Fo:FontM%,Sh:ShowM%,Dr:DrawM%,Sa")
  1088. _BarM%=
  1089. Menu("Fa","In:InfoWH%,Pr,Co:OptM%,Rs,Rp:RepoWH%,Dr:DrawWH%,Sa   F3:SaveWH%,Qu   ^Q")
  1090. 1Menu%=0                      :
  1091.  None open yet
  1092.  Display the appropriate menu for a click in WH%
  1093. OpenMenu(X%,Y%,WH%)
  1094.  I%,M$
  1095.  WH%=MainWH% Menu%=MainM% 
  1096.  Menu%=BarM%
  1097.  Menu%=MainM% 
  1098.   MenuPerson%=
  1099. Near(X%,Y%)
  1100.  En/disable entries in Person menu
  1101.  I%=1 
  1102. Shade(PersM%,I%,MenuPerson%=0):
  1103.  MenuPerson% 
  1104. SetEdit(MenuPerson%)
  1105. SpouseMenu
  1106.     M$=
  1107. Name(MenuPerson%)
  1108. %    
  1109. SelIcon(EditWH%,EdIcMale%,
  1110.     M$=
  1111. MT("Pe")
  1112. &  $PersNameBuf%=M$:$PersM%=
  1113. M$,11)
  1114. IcTxt(GotoWH%,GoIcName%)=""
  1115. ShowOpts
  1116. MenuX%=X%-64:MenuY%=Y%
  1117.  WH%<0 
  1118. B  MenuY%=96:I%=Menu%+4        :
  1119.  Count items for icon bar menu
  1120.  I%+=24:MenuY%+=44::
  1121.  !I% 
  1122.  "Wimp_CreateMenu",,Menu%,MenuX%,MenuY%
  1123.  Open a window as a menu, canceling any menus currently open
  1124. MouseMenu(WH%)
  1125.  X%,Y%
  1126.  WH% 
  1127.  SaveWH%:X%=-240:Y%=230
  1128.  GotoWH%:X%=-270:Y%=128
  1129.  EditWH%:X%=-430:Y%=472
  1130.  ModsWH%:X%=-530:Y%=140
  1131.  "Wimp_GetPointerInfo",,b%
  1132. *Menu%=WH%:MenuX%=!b%+X%:MenuY%=b%!4+Y%
  1133.  "Wimp_CreateMenu",,Menu%,MenuX%,MenuY%
  1134.  Set up edit dialog box to edit person P%
  1135. SetEdit(P%)
  1136. IcTxt(EditWH%,EdIcName%)=
  1137. Name(P%)
  1138.   S$=
  1139. Sex(P%)
  1140. SelIcon(EditWH%,EdIcMale%,S$="M")
  1141. SelIcon(EditWH%,EdIcFemale%,S$="F")
  1142. IcTxt(EditWH%,EdIcFather%)=
  1143. Name(
  1144. Father(P%))
  1145. IcTxt(EditWH%,EdIcMother%)=
  1146. Name(
  1147. Mother(P%))
  1148. IcTxt(EditWH%,EdIcBorn%)=
  1149. Birth(P%)
  1150. IcTxt(EditWH%,EdIcDied%)=
  1151. Death(P%)
  1152. IcTxt(EditWH%,EdIcName%)=""
  1153. SelIcon(EditWH%,EdIcMale%,
  1154. SelIcon(EditWH%,EdIcFemale%,
  1155. IcTxt(EditWH%,EdIcFather%)=""
  1156. IcTxt(EditWH%,EdIcMother%)=""
  1157. IcTxt(EditWH%,EdIcBorn%)=""
  1158.  #  $
  1159. IcTxt(EditWH%,EdIcDied%)=""
  1160.  Set up spouse menus
  1161. SpouseMenu
  1162.  L%,N%,P%,S%,SN%,SL%,W%
  1163. IcTxt(MarryWH%,GoIcName%)="" :
  1164.  Clear marry buf
  1165. N%=0:P%=DivorceM%+28:W%=140
  1166. *&SL%=0:S%=
  1167. Spouses(MenuPerson%,SL%)
  1168.  N%<MaxSpouse%
  1169.   SN%=
  1170. GetVal(S%,NameTg%)
  1171.  SN% 
  1172. .6    !P%=0:P%!4=-1             :
  1173.  Not last, submenu
  1174. //    P%!8=&7000121             :
  1175.  Indirected
  1176. 07    P%!12=SN%:P%!16=-1        :
  1177.  String, Validation
  1178. 1,    L%=
  1179. ($SN%)+1:P%!20=L%:
  1180. Max(W%,16*L%)
  1181.     P%+=24:N%+=1
  1182. 4"  S%=
  1183. Spouses(MenuPerson%,SL%)
  1184.  N% P%!-24=1<<7
  1185. Shade(PersM%,2,N%=0)      :
  1186.  En/disable divorce entry
  1187. 85DivorceM%!16=W%               :
  1188.  Reset menu width
  1189.  Process a menu choice
  1190. MenuClick(Choice0%,Choice1%,Choice2%,Choice3%)
  1191.  But%,S%,N%
  1192.  "Wimp_GetPointerInfo",,mess%:But%=mess%!8
  1193.  Menu%=MainM% Choice0%+=100
  1194.  Choice0% 
  1195. Print
  1196. SetOpts(Choice1%,Choice2%,Choice3%,But%) :
  1197.  Choices
  1198. Mods(".R") 
  1199. Reset
  1200. Save(RepoWH%,SaIcOK%,4)
  1201. Save(DrawWH%,SaIcOK%,4)
  1202.  6,103:
  1203. Save(SaveWH%,SaIcOK%,4)
  1204.  7,104:
  1205.  100                     :
  1206.  Person submenu
  1207.  Choice1% 
  1208.  -1,0:
  1209. MouseMenu(EditWH%)
  1210.  2                      :
  1211.  Divorce
  1212.  Choice2%>-1 
  1213. N:      N%=DivorceM%!(28+24*Choice2%+12) :
  1214.  Name in menu
  1215. O+      S%=
  1216. Look($N%):
  1217.  S%=0 
  1218.  1,"Spouse"
  1219. P"      
  1220. Divorce(MenuPerson%,S%)
  1221. Q        
  1222. EditChild(MenuPerson%)
  1223. Older
  1224. Kill(MenuPerson%):
  1225.  Person%=MenuPerson% 
  1226. Goto(0)
  1227.  101:
  1228. ObjEdit
  1229.  102:
  1230. MouseMenu(GotoWH%)
  1231.  But%=1 
  1232.  Menu%=BarM% 
  1233. ShowOpts :
  1234.  Update ticks on choices
  1235.  "Wimp_CreateMenu",,Menu%,MenuX%,MenuY%
  1236.   Menu%=0
  1237.  E$ = "<Item>,<Item>,.."
  1238.  <Item> = "<String>:[<Sub_val>[#<Flags>]]"
  1239.  No <Sub_val> => -1
  1240.  Flags = I<ptr>:<len> => indirected (must be last flag)
  1241.          W => writable
  1242. Menu(Title$,E$)
  1243.  I%,M%,N%,Width%
  1244. i-I%=1:N%=0:
  1245.  N%+=1:I%=
  1246. E$,",",I%+1):
  1247.  I%=0
  1248. InitMenu(Title$,N%)
  1249. I%=M%+4:Width%=8
  1250. m   I%+=24:E$=
  1251. MenuItem(I%,E$)
  1252.  I%!8 
  1253.  1<<8 N%=
  1254. ($(I%!12)) 
  1255. ($(I%+12))
  1256. Max(Width%,N%)
  1257.  E$=""
  1258. q-!I%=!I% 
  1259.  1<<7               :
  1260.  Last item
  1261. M%!16=(Width%+1)*CharW%
  1262. InitMenu(Title$,Entries%)
  1263.  M% 28+24*Entries%
  1264. MT(Title$)
  1265. y#M%?12=7:M%?13=2:M%?14=7:M%?15=0
  1266. M%!16=160:M%!20=44:M%!24=0
  1267. MenuItem(I%,E$)
  1268.  Rest$,S$,P%,S%
  1269.  this-entry "," other-entries
  1270. E$+",",",",S%):Rest$=
  1271. E$,S%+1):E$=
  1272. E$,S%-1)
  1273.  String-to-display ":" submenu
  1274. E$+":",":")
  1275. E$,S%-1)
  1276.  Translate 2 char message token at start of string
  1277.  S$>"" S$=
  1278. S$,2))+
  1279. S$,3)
  1280. E$,S%+1):
  1281.  E$="" E$="-1"
  1282. "!I%=0:I%!4=
  1283. (E$):I%!8=&7000021
  1284.  sub-val "#" options
  1285. P%=0:E$=
  1286. E$+"#","#")+1)
  1287.  E$>""                   :
  1288.  Optional flags
  1289. E$,1) 
  1290.  "I"                    :
  1291.  Indirect
  1292.     I%!8=I%!8 
  1293.  1<<8
  1294. -    S%=
  1295. E$,":")          :
  1296.  After pointer
  1297. )    P%=
  1298. E$,2,S%-2))  :
  1299.  Buf pointer
  1300.     I%!12=P%:I%!16=-1
  1301. %    I%!20=
  1302. E$,S%+1)) :
  1303.  Buf len
  1304. 2    E$=""                     :
  1305.  no more flags
  1306.  "W":!I%=!I% 
  1307.  1<<2    :
  1308.  Writeable
  1309.   E$=
  1310. E$,2)
  1311.  P%=0 
  1312. :  P%=I%+12:S%=
  1313. (S$)+1       :
  1314.  Long string => indirect
  1315.  S%>12 
  1316.  P% S%
  1317. 3    I%!8=I%!8 
  1318.  1<<8:I%!12=P%:I%!16=-1:I%!20=S%
  1319. $P%=S$
  1320. =Rest$
  1321.  (Un)Shade menu entry
  1322. Shade(Menu%,Entry%,Shade%)
  1323.  B%:B%=1<<22
  1324. /Menu%+=28+24*Entry%+8         :
  1325.  Menu flags
  1326. &!Menu%=!Menu% 
  1327.  Shade% 
  1328.  (Un)Tick menu entry
  1329. SelEntry(Menu%,Entry%,Tick%)
  1330. Menu%+=28+24*Entry%
  1331. (!Menu%=!Menu% 
  1332.  (Tick%<>0) 
  1333.  ============================= Edit ===============================
  1334. Goto(P%)
  1335. Person%=P%
  1336. GForce%=2                      :
  1337.  Scroll window to centre new person
  1338.  Force note window and title
  1339.  P% $NoteTitle%=
  1340. Name(P%):
  1341. OpenNotes 
  1342. Close(NoteWH%)
  1343.  Create a level 0 NOTE object giving the current person's name
  1344. SetPerson
  1345.  Mod%,N%,O%,P%
  1346.  Kill any old person note
  1347. P%=Root%+ObSubs%
  1348.   O%=!P%:N%=O%+ObNext%
  1349.  O%!ObTag%=NoteTg% 
  1350.  O%!ObVal% 
  1351. '      
  1352. $(O%!ObVal%),6)="Person" 
  1353.         
  1354. Free(O%!ObVal%)
  1355.         !P%=!N%:N%=P%
  1356.       
  1357.         
  1358.   P%=N%
  1359. @Mod%=Modified%                :
  1360.  Preserve modification state
  1361.  Person% 
  1362. SetStr(Root%,NoteTg%,"Person "+
  1363. Name(Person%),
  1364. Modified%=Mod%
  1365.  Return the person near screen X%,Y%.  Try the dummy CHIL
  1366.  at the top of the tree first, then each member of each FAM.
  1367. Near(X%,Y%)
  1368.  B%,D%,DS%,BD%,F%,S%,R%
  1369. >R%=1.5*LineHeight%            :
  1370.  Distance from name centre
  1371. ,!b%=MainWH%:
  1372.  "Wimp_GetWindowState",,b%
  1373. @X%-=(b%!4-b%!20):Y%-=(b%!16-b%!24) :
  1374.  convert to work coords
  1375.  B%=0:BD%=Infinity%
  1376. F%=0:S%=TopChil%
  1377.  S%>1
  1378.  S%!ObTag% 
  1379.  HusbTg%,WifeTg%,ChilTg%
  1380.     DS%=ObVal%!(S%!ObSubs%)
  1381. (    D%=
  1382. (X%-DS%!DSx%)+
  1383. (Y%-DS%!DSy%)
  1384.      
  1385.  IF D%<BD% B%=S%:BD%=D%
  1386.  D%<R% 
  1387. Val(S%)
  1388.   S%=S%!ObNext%
  1389.  S%=0
  1390. 7    
  1391. GetSub(Root%,FamTg%,F%) S%=F%!ObSubs% 
  1392.  S%=1
  1393.  IF B% B%=FNVal(B%)
  1394.  Open an Edit window for person P% (may be 0)
  1395. EditPerson(P%)
  1396. MenuPerson%=P%
  1397. SetEdit(P%)
  1398. MouseMenu(EditWH%)
  1399.  Mouse or key in edit window.  Note CR is handled wrongly if there
  1400.  is any K command in a validation string.  Do K stuff here instead.
  1401. Edit(Ic%,But%)
  1402.  S%,M%
  1403.  Ic%=EdIcCan% 
  1404. Close(EditWH%)
  1405.  "Wimp_CreateMenu",,-1
  1406.   Menu%=0
  1407.  But% 
  1408.  UpArrow%
  1409. ,  S%=(Ic%+EdIcMother%) 
  1410.  (EdIcMother%+1)
  1411. Caret(EditWH%,S%,
  1412.  DownArrow%
  1413. "  S%=(Ic%+1) 
  1414.  (EdIcMother%+1)
  1415. Caret(EditWH%,S%,
  1416.  CR%:Ic%=EdIcOK%
  1417.  CtrlS%
  1418.     $  M%=
  1419. SelIcon(EditWH%,EdIcMale%)
  1420. SelIcon(EditWH%,EdIcMale%,
  1421. SelIcon(EditWH%,EdIcFemale%,M%)
  1422.  Ic%<>EdIcOK% 
  1423. Edited
  1424. Close(EditWH%)
  1425.  "Wimp_CreateMenu",,-1:Menu%=0
  1426.  Person% Force%=1 
  1427. Goto(MenuPerson%)
  1428.  Set edited details
  1429. Edited
  1430.  N$,Sex$
  1431. !N$=$
  1432. IcTxt(EditWH%,EdIcName%)
  1433.  N$="" 
  1434. MT("NN")
  1435.  MenuPerson% 
  1436. Name(MenuPerson%)<>N$ 
  1437. !    
  1438.  Name changed - reinsert
  1439. )    
  1440. SetStr(MenuPerson%,NameTg%,N$,
  1441. %    
  1442. RemSubObj(Root%,MenuPerson%)
  1443. Insert(MenuPerson%)
  1444.   MenuPerson%=
  1445. Find(N$)
  1446. EventDate(MenuPerson%,BirtTg%,$
  1447. IcTxt(EditWH%,EdIcBorn%))
  1448. EventDate(MenuPerson%,DeatTg%,$
  1449. IcTxt(EditWH%,EdIcDied%))
  1450. &BN$=$
  1451. IcTxt(EditWH%,EdIcFather%):
  1452. Father(MenuPerson%,
  1453. Find(N$))
  1454. 'BN$=$
  1455. IcTxt(EditWH%,EdIcMother%):
  1456. Mother(MenuPerson%,
  1457. Find(N$))
  1458. SelIcon(EditWH%,EdIcMale%)  :Sex$="M"
  1459. SelIcon(EditWH%,EdIcFemale%):Sex$="F"
  1460.                           :Sex$=""
  1461. Sex(MenuPerson%,Sex$)
  1462.  Set the DATE of P%'s Tag% event to Val$
  1463. EventDate(P%,Tag%,Val$)
  1464.  P%=0 
  1465.  1,"PROCEventDate"
  1466.  Val$>"" 
  1467. SetSub(P%,Tag%,0,
  1468. GetSub(P%,Tag%,E%) 
  1469. SetStr(E%,DateTg%,Val$,
  1470. Father(P%)=
  1471. Parent(P%,HusbTg%)
  1472. Mother(P%)=
  1473. Parent(P%,WifeTg%)
  1474.  Get the family pointed to by P%'s FAMC sub-object.  Return
  1475.  the person pointed to by its Tag% sub-object or 0 if none.
  1476. Parent(P%,Tag%)
  1477.  P%=0 
  1478.  Tag%=0 
  1479.  1,"FNParent"
  1480. B2P%=
  1481. GetVal(P%,FamcTg%):
  1482. GetVal(P%,Tag%)
  1483.  Return P%'s father, mother, self or 0.
  1484. Fore(P%)
  1485.  P%=0 
  1486. Father(P%):
  1487. Mother(P%):
  1488. Birth(P%)=
  1489. Date(P%,BirtTg%)
  1490. Death(P%)=
  1491. Date(P%,DeatTg%)
  1492.  Return the value string for the DATE sub-object
  1493.  of P%'s event sub-object with Tag%
  1494. Date(P%,Tag%)
  1495.  P%=0 
  1496.  1,"FNDate"
  1497. X4E%=0:
  1498. GetSub(P%,Tag%,E%) 
  1499. GetStr(E%,DateTg%)
  1500. Sex(P%,S$)
  1501.  P%=0 
  1502.  1,"PROCSex"
  1503. SetStr(P%,SexTg%,S$,
  1504. Sex(P%)=
  1505. GetStr(P%,SexTg%)
  1506. MaleFemale(
  1507.  Him%,
  1508.  Her%)
  1509. Sex(Him%)="F" 
  1510. Sex(Her%)="M" 
  1511.  Him%,Her%
  1512.  Him% 
  1513. Sex(Him%,"M")
  1514.  Her% 
  1515. Sex(Her%,"F")
  1516.  Swap MenuPerson% with his earlier sibling
  1517. Older
  1518.  F%,P%,Old%,C%
  1519. l#F%=
  1520. GetVal(MenuPerson%,FamcTg%)
  1521.   Old%=0:P%=F%+ObSubs%
  1522.     C%=!P%
  1523.  C%!ObTag%=ChilTg% 
  1524. r"      
  1525. Val(C%)=MenuPerson% 
  1526.         F%=0
  1527. tB        
  1528.  Old% 
  1529.  Old%!ObVal%,C%!ObVal%:Modified%=
  1530. :Force%=1:
  1531.       
  1532.       Old%=C%
  1533. w        
  1534.     P%=C%+ObNext%
  1535. Name(MenuPerson%)+" "+
  1536. MT("NE")
  1537.  Fill in edit box for a new person whose parent is Dad% (may be female).
  1538.  If he has one spouse assume she is the child's other parent.
  1539.  If the child's father is known initialise his family name.
  1540. EditChild(Dad%)
  1541.  L%,Mum%,F$
  1542.  Dad%=0 
  1543. EditPerson(0):
  1544. :L%=0:Mum%=
  1545. Spouses(Dad%,L%):
  1546. Spouses(Dad%,L%) Mum%=0
  1547. MaleFemale(Dad%,Mum%)
  1548. ;F$="":
  1549.  Dad% F$=
  1550. FamName(
  1551. Name(Dad%)):
  1552.  F$>"" F$=" "+F$
  1553. IcTxt(EditWH%,EdIcName%)=F$
  1554. SelIcon(EditWH%,EdIcMale%,
  1555.  Default male.
  1556. SelIcon(EditWH%,EdIcFemale%,
  1557. IcTxt(EditWH%,EdIcFather%)=
  1558. Name(Dad%)
  1559. IcTxt(EditWH%,EdIcMother%)=
  1560. Name(Mum%)
  1561. IcTxt(EditWH%,EdIcBorn%)=""
  1562. IcTxt(EditWH%,EdIcDied%)=""
  1563. Open(EditWH%)
  1564. Caret(EditWH%,EdIcName%,
  1565.  Caret at start
  1566. HMenuPerson%=0                 :
  1567.  Create new person if edit completed
  1568. Father(C%,P%)
  1569. ChkSex(P%,"M","Ml")
  1570. Parent(C%,P%,HusbTg%)
  1571. Mother(C%,P%)
  1572. ChkSex(P%,"F","Fe")
  1573. Parent(C%,P%,WifeTg%)
  1574. ChkSex(P%,Gender$,GT$)
  1575.  P%=0 
  1576. Sex(P%) 
  1577.  Gender$
  1578. Sex(P%,Gender$)
  1579. Name(P%)+" "+
  1580. MT("IN")+" "+
  1581. MT(GT$)
  1582.  Set C%'s Tag% parent to P%
  1583. Parent(C%,P%,Tag%)
  1584.  Dad%,Mum%,F%,O%
  1585.  C%=0 
  1586.  1,"PROCParent"
  1587. GetVal(C%,FamcTg%):Dad%=0:Mum%=0
  1588.  ove C% from current family unless the parent is already there
  1589. GetVal(F%,Tag%)=P% 
  1590. 7  Dad%=
  1591. GetVal(F%,HusbTg%):Mum%=
  1592. GetVal(F%,WifeTg%)
  1593. RemSub(F%,ChilTg%,C%)
  1594. ChkFam(F%)
  1595.  C% now an orphan.  Set new parent.
  1596.  Tag%=HusbTg% Dad%=P% 
  1597.  Mum%=P%
  1598.  Dad%=0 
  1599.  Mum%=0 
  1600.  See if Dad has a family with Mum (either may be 0)
  1601.  Dad% 
  1602.   O%=0
  1603. GetSub(Dad%,FamsTg%,O%) 
  1604.  F%=0
  1605. 4    F%=
  1606. Val(O%):
  1607. GetVal(F%,WifeTg%)<>Mum% F%=0
  1608.  See if Mum has a family with Dad
  1609.  Mum% 
  1610.  F%=0 
  1611.   O%=0
  1612. GetSub(Mum%,FamsTg%,O%) 
  1613.  F%=0
  1614. 4    F%=
  1615. Val(O%):
  1616. GetVal(F%,HusbTg%)<>Dad% F%=0
  1617.  F%=0 F%=
  1618. NewFam(Dad%,Mum%)
  1619. SetSub(C%,FamcTg%,F% 
  1620.  ObRef%,
  1621. SetSub(F%,ChilTg%,C% 
  1622.  ObRef%,
  1623. ChkFam(F%)
  1624. Modified%=
  1625. :Force%=1
  1626.  ==================== Individuals & families ======================
  1627.  Look up name N$ and return person if found, else 0
  1628. Look(N$)
  1629.  H%,P%
  1630. Hash(N$):P%=Hash%!H%:
  1631. Name(P%)=N$ 
  1632. GetSub(Root%,IndiTg%,P%)
  1633. Name(P%)=N$ Hash%!H%=P%:=P%
  1634.  Find an existing person named N$ or create a new one
  1635. Find(N$)
  1636.  N$="" 
  1637. Look(N$)
  1638.  P%=0 P%=
  1639. NewIndi(N$):
  1640. Insert(P%) :
  1641.  Sort into Root%'s list
  1642. InitHash
  1643. 1HashSize%=1<<12:HashMask%=(HashSize%-1) 
  1644.  Hash%=0 
  1645.  Hash% HashSize%
  1646.  H%=0 
  1647.  HashSize%-1 
  1648.  4:Hash%!H%=0:
  1649. Hash($b%)
  1650.  I%,H%:H%=0
  1651.  I%=0 
  1652.  9:H%+=H%+b%?I%:
  1653.  HashMask%
  1654. NewIndi(N$)
  1655. Object(IndiTg%,0)
  1656. SetStr(P%,NameTg%,N$,
  1657.  N$>"" Hash%!
  1658. Hash(N$)=P%
  1659. Modified%=
  1660. :Force%=1
  1661.  Every FAM member's first sub-object is a display structure
  1662. DStruct(P%)
  1663.  D%,O%,S%
  1664. S%=P%!ObSubs%
  1665.  S%!ObTag%=DispTg% 
  1666. =S%!ObVal%
  1667. Alloc(DSSize%):D%!DSName%=0
  1668. Object(DispTg%,D%)
  1669. P%!ObSubs%=O%:O%!ObNext%=S%
  1670.  Create a new family with Dad% and Mum%.  Link it to them and v.v.
  1671. NewFam(Dad%,Mum%)
  1672. Object(FamTg%,0)
  1673. Tail(Root%)=F%
  1674.  Dad% 
  1675. SetSub(F%,HusbTg%,Dad% 
  1676.  ObRef%,
  1677. SetSub(Dad%,FamsTg%,F% 
  1678.  ObRef%,
  1679.  Mum% 
  1680. SetSub(F%,WifeTg%,Mum% 
  1681.  ObRef%,
  1682. SetSub(Mum%,FamsTg%,F% 
  1683.  ObRef%,
  1684.  Add O% as an INDI just before the first INDI
  1685.  sub-object of root with a name after O%'s
  1686. Insert(O%)
  1687. Position(O%)
  1688. O%!ObNext%=!P%
  1689. !P%=O%
  1690. Position(O%)
  1691.  P%,N$,NO$,F$,FO$
  1692. #NO$=
  1693. Name(O%):FO$=
  1694. FamName(NO$)
  1695. P%=Root%+ObSubs%
  1696.   O%=!P%
  1697.  O%!ObTag%=IndiTg% 
  1698. $    N$=
  1699. Name(O%):F$=
  1700. FamName(N$)
  1701.  F$>FO$ 
  1702.  F$=FO$ 
  1703.  N$>NO$ 
  1704.   P%=O%+ObNext%
  1705.  If family F% has < 2 members, unlink it & kill it
  1706. ChkFam(F%)
  1707.  M%,N%
  1708.  F%=0 
  1709.  1,"PROCChkFam"
  1710. S%=F%!ObSubs%:N%=0
  1711.  N%<2
  1712.  S%!ObTag% 
  1713.  ChilTg%,HusbTg%,WifeTg%:N%+=1
  1714.   S%=S%!ObNext%
  1715.  N%<2 
  1716. Kill(F%)
  1717.  ============================= Notes ==============================
  1718.  Return Person%'s first or next CONT or NOTE sub-object.
  1719.  Call with N%=0 for first.  Result also returned in O%.
  1720. GetNote(
  1721.  O%=N% O%=0
  1722. <)  O%=
  1723. GetSub(N%,ContTg%,O%):
  1724. >&O%=
  1725. GetSub(Person%,NoteTg%,N%):=O%
  1726. OpenNotes
  1727.  Lines%,N%,O%
  1728. Lines%=0:N%=0
  1729. GetNote(N%,O%):Lines%+=1:
  1730. D+!b%=NoteWH%:
  1731.  "Wimp_GetWindowInfo",,b%
  1732. Extent(NoteWH%,b%!52-b%!44,(Lines%+1)*(CharH%+4),
  1733.  Draw Person's first NOTE object and any CONT sub-objects
  1734. DrawNote(X%,Y%)
  1735.  N%,O%
  1736.  Person%=0 
  1737. X%+=8:Y%-=8:N%=0
  1738. GetNote(N%,O%)
  1739.  O%!ObVal% 
  1740.  X%,Y%:
  1741.  $(O%!ObVal%);
  1742.   Y%-=CharH%+4
  1743.  Broadcast a request for an external edit of P%'s
  1744.  notes.  Should get EditAck reply or EditRq bounce.
  1745. EditNotes
  1746.  I%,N$
  1747.  Person%=0 
  1748.  1,"PROCEditNotes"
  1749. mess%!20=TextType%
  1750. [@mess%!24=1                    :
  1751.  Arbitrary client job handle
  1752. \6mess%!28=1                    :
  1753.  Continue editing?
  1754.  Tidy name for use as job parent Id
  1755. Name(Person%)
  1756.  N$>"" 
  1757. Alpha(N$) N$=
  1758. N$,2):
  1759.  I%<=
  1760. Alpha(
  1761. N$,I%)) I%+=1 
  1762. N$,I%-1)+
  1763. N$,I%+1)
  1764. d($(mess%+32)=
  1765. N$,19)+
  1766.  Parent ID.
  1767. Send(EditRq,NoteLeaf$,18,mess%,0,0,52)
  1768. WriteNotes(F$)        :
  1769.  Write notes to a file
  1770. WriteNotesFile(F%,"")
  1771. SetFileType(F$,TextType%)
  1772. WriteNotesFile(F%,Prefix$)
  1773.  O%,N%:N%=0
  1774. GetNote(N%,O%)
  1775. #F%,Prefix$+
  1776. Null(O%!ObVal%)
  1777.  Read notes for the current person from a file
  1778. LoadNotes(F$)
  1779.  F%,P%
  1780. {)F%=
  1781. (F$):
  1782.  F%=0 
  1783. MT("CR")+" "+F$
  1784.  Person%=0 
  1785. MT("NP")
  1786.  Delete all Person's existing note sub-objects
  1787. DelTag(Person%,NoteTg%)
  1788. Tail(Person%)
  1789. 7  !P%=
  1790. Object(NoteTg%,
  1791. String(
  1792. #F%)):P%=!P%+ObSubs%
  1793. 7  !P%=
  1794. Object(ContTg%,
  1795. String(
  1796. #F%)):P%=!P%+ObNext%
  1797.  F$=NoteFile$ 
  1798.  F$=Scrap$ 
  1799. DelFile(NoteFile$) :
  1800.  Delete scrap file.
  1801. OpenNotes
  1802. Modified%=
  1803.  =========================== Spouses ==============================
  1804.  Return P%'s first spouse if F%=0 else return next
  1805.  spouse.  Update F% to P%'s FAMS.  Return 0 when no
  1806.  more spouses.  Ignore families with unknown spouse.
  1807. Spouses(P%,
  1808.  H%,W%,FO%
  1809.  P%=0 
  1810.  1,"FNSpouses 1"
  1811. GetSub(P%,FamsTg%,F%)
  1812.   FO%=
  1813. Val(F%)
  1814.   H%=
  1815. GetVal(FO%,HusbTg%)
  1816.   W%=
  1817. GetVal(FO%,WifeTg%)
  1818.  1,"FNSpouses 2"
  1819.  Ensure that there is a family with parents Mum% and Dad%
  1820. Marry(Dad%,Mum%)
  1821.  F%,O%,H%,W%
  1822.  Dad%=0 
  1823.  Mum%=0 
  1824. MaleFemale(Dad%,Mum%)     :
  1825.  Ensure Dad% is male
  1826. 9O%=0:H%=-1:W%=-1              :
  1827.  Dad already married?
  1828. GetSub(Dad%,FamsTg%,O%)
  1829. ?  F%=
  1830. Val(O%):H%=
  1831. GetVal(F%,HusbTg%):W%=
  1832. GetVal(F%,WifeTg%)
  1833.  H%=Dad% 
  1834.  W%=Mum% 
  1835.  F%=0 
  1836. 9  O%=0:H%=-1:W%=-1            :
  1837.  Mum already married?
  1838. GetSub(Mum%,FamsTg%,O%)
  1839. A    F%=
  1840. Val(O%):H%=
  1841. GetVal(F%,HusbTg%):W%=
  1842. GetVal(F%,WifeTg%)
  1843.  H%=Dad% 
  1844.  W%=Mum% 
  1845.  Add new spouse to arbitrary existing single-parent family if any
  1846.  H%=0:
  1847. SetSub(F%,HusbTg%,Dad% 
  1848.  ObRef%,
  1849. SetSub(Dad%,FamsTg%,F% 
  1850.  ObRef%,
  1851.  W%=0:
  1852. SetSub(F%,WifeTg%,Mum% 
  1853.  ObRef%,
  1854. SetSub(Mum%,FamsTg%,F% 
  1855.  ObRef%,
  1856. NewFam(Dad%,Mum%)
  1857. Modified%=
  1858. :Force%=1
  1859.  Remove mother from family in which Dad%
  1860.  and Mum% are parents if neither is null
  1861. Divorce(Dad%,Mum%)
  1862.  F%,O%
  1863.  Dad%=0 
  1864.  Mum%=0 
  1865. MaleFemale(Dad%,Mum%)
  1866. GetSub(Dad%,FamsTg%,O%)
  1867.   F%=
  1868. Val(O%)
  1869. GetVal(F%,WifeTg%)=Mum% 
  1870.      
  1871. RemSub(F%,WifeTg%,Mum%)
  1872.      
  1873. RemSub(Mum%,FamsTg%,F%)
  1874. ChkFam(F%)
  1875.     Modified%=
  1876. :Force%=1
  1877.         
  1878. Name(Dad%)+" "+
  1879. MT("NM")+" "+
  1880. Name(Mum%)
  1881. OppSex(P%)
  1882. Sex(P%) 
  1883.  "M":="F"
  1884.  "F":="M"
  1885.  ======================== Name completion =========================
  1886.  Try to complete the name in an icon.  Set WHComp%
  1887.  and IHComp% to the icon we are completing.
  1888. Complete(WH%,IH%)
  1889.  A%,ReqSex$:ReqSex$=""
  1890.  WH% 
  1891.  EditWH%
  1892.  IH% 
  1893.  EdIcFather%:ReqSex$="M"
  1894.  EdIcMother%:ReqSex$="F"
  1895.  EdIcName%
  1896.  Only for mother, father, name.
  1897.  MarryWH%:ReqSex$=
  1898. OppSex(MenuPerson%)
  1899.  GotoWH%
  1900. IcTxt(WH%,IH%)
  1901. Complete($A%,ReqSex$)
  1902. Caret(WH%,IH%,
  1903. WHComp%=WH%:IHComp%=IH%
  1904.  Return longest unambiguous completion of N$ with given
  1905.  sex.  If > 1 match, open the pick window else close it.
  1906. Complete(N$,ReqSex$)
  1907.  Len%,P%,Prefix$,PN$,LowN$
  1908. LowN$=
  1909. Lower(N$)
  1910. #NComp%=0:Prefix$="*":Len%=
  1911. GetSub(Root%,IndiTg%,P%)
  1912.  ReqSex$="" 
  1913. Sex(P%)=ReqSex$ 
  1914.     PN$=
  1915. Name(P%)
  1916. $    
  1917. Lower(
  1918. PN$,Len%))=LowN$ 
  1919. 7      
  1920.  NComp%<=MaxComp% Comp%(NComp%)=P%:NComp%+=1
  1921. <      Prefix$=
  1922. Common(Prefix$,PN$) :
  1923.  Max shared prefix.
  1924.         
  1925.  NComp%=0 
  1926.  NComp%>1 
  1927. OpenComp 
  1928. Close(CompWH%)
  1929.  Prefix$="" 
  1930.  Prefix$="*" 
  1931. =Prefix$
  1932.  Return longest common prefix
  1933. Common(P$,N$)
  1934.  P$="*" 
  1935. Lower(P$)
  1936. Lower(N$) 
  1937. +L%=1:
  1938. P$,L%)=
  1939. Lower(
  1940. N$,L%)):L%+=1:
  1941. N$,L%-1)
  1942. OpenComp
  1943.  I%,M%:M%=0
  1944.  I%=0 
  1945.  NComp%-1
  1946. Max(M%,
  1947. Name(Comp%(I%))))
  1948. !I%=NComp%:
  1949.  I%>MaxComp% I%+=1
  1950. Extent(CompWH%,(M%+2)*CharW%,I%*CharH%+16,
  1951. DrawComp(XW%,YW%)
  1952.  I%=0 
  1953.  NComp%-1
  1954.  XW%+8,YW%-8-CharH%*I%:
  1955. Name(Comp%(I%))
  1956.  NComp%>MaxComp% 
  1957.  XW%+8,YW%-8-CharH%*NComp%:
  1958.  "..."
  1959.  Click in completion list.  Set text in icon being completed.
  1960. Comp(Y%)
  1961.  I%,YW%,IH%,WH%
  1962. &,!b%=CompWH%:
  1963.  "Wimp_GetWindowState",,b%
  1964. YW%=b%!16-b%!24
  1965. I%=(YW%-8-Y%) 
  1966.  CharH%
  1967.  I%>=NComp% 
  1968.  Set text in icon.  Ensure window open and redraw icon
  1969. IcTxt(WHComp%,IHComp%)=
  1970. Name(Comp%(I%))
  1971. Close(CompWH%)
  1972. Open(WHComp%):
  1973. Caret(WHComp%,IHComp%,
  1974.  =========================== Messages =============================
  1975.  Received a type 17 or 18 message.  The message is at b%.
  1976. Receive(Size%,SrcTask%,HisRef%,Action%)
  1977.  P%,Type%,F$
  1978.  Ignore own messages.
  1979.  SrcTask%=Task% 
  1980.  PROCD("Rec &"+STR$~Action%)
  1981.  Action% 
  1982.  Quit:Modified%=
  1983.  PreQuit
  1984.  Modified% 
  1985. NotOK(
  1986. MT("UC")) 
  1987. >1    b%!12=HisRef%:
  1988.  "Wimp_SendMessage",19,b%
  1989.  DataSave,EditDataSave
  1990.  He has data for us.  Tell him where to stick it.  Notes might be
  1991.  considered 'safe' but that confuses !Zap so say they're unsafe.
  1992.   b%!36=-1
  1993. Send(DataSaveAck,Scrap$,17,b%,SrcTask%,HisRef%,44)
  1994.  DataSaveAck              :
  1995.  He says where to save data
  1996.  "Wimp_CreateMenu",,-1:Menu%=0
  1997.   F$=
  1998. GetZStr(b%+44)
  1999. SaveType(F$,b%!36>=0)
  2000.  Tell him to load data from file.  Rest of mess set up from our
  2001.  DataSave.  This should be sent as type 18 (recorded) but StrongEd
  2002.  doesn't seem to reply soon enough.
  2003. Send(DataLoad,F$,17,mess%,SrcTask%,HisRef%,44)
  2004.  DataLoad                 :
  2005.  He wants us to load a file
  2006.   Type%=b%!40
  2007.   F$=
  2008. GetZStr(b%+44)
  2009.  "Wimp_GetPointerInfo",,b%
  2010. Load(F$,b%!12=-2)       :
  2011.  Reset for drag to icon bar
  2012.  Tell him we got it.  StrongED is logical but non-standard
  2013.  because it looks at b%!36 from DataLoadAck instead of DataSaveAck.
  2014. T:  b%!36=-1                    :
  2015.  For naughty StrongED.
  2016. Send(DataLoadAck,F$,17,b%,SrcTask%,HisRef%,44)
  2017.  F$=Scrap$ 
  2018. DelFile(Scrap$)
  2019.  Type%=TextType% 
  2020. ExtEdAbort
  2021.  DataOpen                 :
  2022.  Load a Filer_Run file
  2023.  b%!40<>TreeType% 
  2024.   F$=
  2025. GetZStr(b%+44)
  2026.  Acknowledge DataOpen now in case load fails
  2027. \E  b%!36=-1                    :
  2028.  For naughty StrongED (see above)
  2029. Send(DataLoadAck,F$,17,b%,SrcTask%,HisRef%,44)
  2030. Load(F$,
  2031. )           :
  2032.  Reset for DataOpen
  2033.  DataLoadAck              :
  2034.  He has loaded & deleted data
  2035.  EditAck                  :
  2036.  External edit request accepted
  2037.   ExtEdJob%=b%!24
  2038. b/  mess%!20=ExtEdJob%          :
  2039.  Job handle
  2040. c8  mess%!36=0                  :
  2041.  Estimated data size
  2042.   mess%!40=TextType%
  2043. Send(EditDataSave,NoteLeaf$,18,mess%,SrcTask%,HisRef%,44)
  2044. f<  SaveType%=TextType%         :
  2045.  ember what we're saving
  2046.  HelpRequest
  2047.   F$=
  2048. Help(b%!32,b%!36)
  2049.  F$>"" 
  2050. Send(HelpReply,F$,17,b%,SrcTask%,HisRef%,20)
  2051.  MenusDeleted
  2052.   Menu%=0
  2053.  Received a type 19 (acknowledge) message (in b%).  If it appears to
  2054.  come from this task then it is an unanswered type 18 (recorded).
  2055. RcvAck(Size%,SrcTask%,Action%)
  2056.  P%,Type%,F$
  2057.  SrcTask%<>Task% 
  2058.  It's one of mine
  2059.  Action% 
  2060.  EditRq                   :
  2061.  Unanswered External edit request
  2062. WriteNotes(NoteFile$)
  2063.  "Filer_Run "+NoteFile$ :
  2064.  Hope an editor will catch it
  2065.  OTHERWISE PROCD("Ack "+STR$~Action%)
  2066.  Send a message containing a string
  2067. Send(Action%,String$,N%,Buf%,Dest%,Ref%,Offset%)
  2068. Buf%!12=Ref%
  2069. Buf%!16=Action%
  2070. MessStr(Buf%,Offset%,String$)
  2071.  "Wimp_SendMessage",N%,Buf%,Dest%
  2072.  Insert String$ at Offset% in message in Buf%.  Set message length.
  2073. MessStr(Buf%,Offset%,String$)
  2074. $(Buf%+Offset%)=String$+
  2075. &!Buf%=(Offset%+4+
  2076. (String$)) 
  2077.  Close any external edit job
  2078. ExtEdAbort
  2079.  ExtEdJob%=0 
  2080. +mess%!12=0                    :
  2081.  My ref
  2082. mess%!16=EditAbort
  2083. -mess%!20=0                    :
  2084.  Reserved
  2085. mess%!24=ExtEdJob%
  2086. mess%!0=28
  2087.  "Wimp_SendMessage",17,mess%,SrcTask%
  2088. =ExtEdJob%=0                   :
  2089.  No current external edit
  2090. Help(WH%,IH%)
  2091. MHelp(WH%,IH%)
  2092.  T$>"" T$=
  2093. MT(T$)
  2094. MHelp(WH%,IH%)
  2095.  WH% 
  2096.  -2:="H01"
  2097.  MainWH%:="H02"
  2098.  NoteWH%:="H03"
  2099.  CompWH%:="H04"
  2100.  InfoWH%:="H05"
  2101.  EditWH%
  2102.  IH% 
  2103.  EdIcName%:="H06"
  2104.  EdIcBorn%:="H07"
  2105.  EdIcDied%:="H08"
  2106.  EdIcFather%:="H09"
  2107.  EdIcMother%:="H10"
  2108.  EdIcMale%:="H11"
  2109.  EdIcFemale%:="H12"
  2110.  EdIcCan%:="H13"
  2111.  EdIcOK%:="H14"
  2112.  GotoWH%
  2113.  IH% 
  2114.  GoIcName%:="H15"
  2115.  GoIcCan%:="H16"
  2116.  GoIcCur%:="H25"
  2117.  GoIcOK%:="H17"
  2118.  MarryWH%
  2119.  IH% 
  2120.  GoIcName%:="H18"
  2121.  GoIcCan%:="H19"
  2122.  GoIcCur%:="H25"
  2123.  GoIcOK%:="H20"
  2124.  ModsWH%
  2125.  IH% 
  2126.  MoIcDisc%:="H29"
  2127.  MoIcCan%:="H30"
  2128.  MoIcSave%:="H31"
  2129.  RepoWH%
  2130.  IH% 
  2131.  SaIcFile%:="H28"
  2132.  SaIcSprite%:="H26"
  2133.  SaIcOK%:="H27"
  2134.  SaIcCan%:="H24"
  2135.  SaveWH%
  2136.  IH% 
  2137.  SaIcFile%:="H21"
  2138.  SaIcSprite%:="H22"
  2139.  SaIcOK%:="H23"
  2140.  SaIcCan%:="H24"
  2141.  DrawWH%
  2142.  IH% 
  2143.  SaIcFile%:="H32"
  2144.  SaIcSprite%:="H33"
  2145.  SaIcOK%:="H34"
  2146.  SaIcCan%:="H24"
  2147.  ============================= Load ===============================
  2148.  Check the command line for file to load (and print)
  2149.  I%,PrintIt%
  2150.  "OS_GetEnv" 
  2151. $b%,"-quit")
  2152.  I%=0 
  2153. 6I%=b%+I%+5:
  2154.  ?I%=Space% I%+=1:
  2155.  Find prog name
  2156.  ?I%>Space% I%+=1:
  2157.             :
  2158.  Skip prog name
  2159.  ?I%=Space% I%+=1:
  2160.             :
  2161.  Find start of arg
  2162. PrintIt%=
  2163. $I%,6)="-print"
  2164.  PrintIt% 
  2165. 4  I%+=6:
  2166.  ?I%=Space% I%+=1:
  2167.     :
  2168.  After -print
  2169.  ?I%<=Space% 
  2170. Load($I%,
  2171.  PrintIt% 
  2172. Print
  2173. Load(F$,Reset%)
  2174.  F%,T%
  2175.  "OS_File",17,F$ 
  2176.  F%,,T%:T%=T%>>8 
  2177.  &FFF
  2178.  F%<>1 
  2179. MT("NF")+": '"+F$+"'"
  2180.  T%=TextType% 
  2181. LoadNotes(F$):
  2182.  Reset% 
  2183. Mods(F$) 
  2184.  T%<>TreeType% 
  2185. NotOK(
  2186. MT("UF")) 
  2187. MT("CR")+" '"+F$+"'"
  2188. (F$):
  2189.  F%=0 
  2190.  -1,"dummy"
  2191. LoadError(F%,F$)
  2192.  Reset% 
  2193. Reset 
  2194.  Reset%=Root%!ObSubs%=0
  2195. GForce%=2                      :
  2196.  Main win to be redrawn & recentred
  2197.  "Hourglass_On"
  2198. Escape(
  2199. LoadGed(F%,Reset%)
  2200. Escape(
  2201.  "Hourglass_Off"
  2202.  Reset% 
  2203. SetFile(F$) 
  2204.  Modified%=
  2205. Goto(Person%)             :
  2206.  Set current person
  2207. LoadError(F%,F$)
  2208. Escape(
  2209. Reset
  2210. MT("BF")+": '"+F$+"' ("+
  2211. $+")"
  2212. Escape(On%)
  2213.  "OS_Byte",229,On%=0
  2214.  ============================= Save ===============================
  2215.  Save, Draw or Report chosen in the menu or dbox event
  2216. Save(WH%,IH%,But%)
  2217.  IB%,X0%,Y0%,P%,LP%,F$
  2218. IcTxt(WH%,SaIcFile%):F$=$P%:LP%=P%
  2219.  ?P%>31
  2220.  ?P%=
  2221. "." LP%=P%+1
  2222.   P%+=1
  2223. :$P%=""
  2224.  ember what we're saving
  2225.  WH%=SaveWH% SaveType%=TreeType% 
  2226.  WH%=RepoWH% SaveType%=ReportType% 
  2227.  SaveType%=DrawType%
  2228.  IH%=SaIcFile% 
  2229.  But%=CR% IH%=SaIcOK%
  2230.  IH% 
  2231.  SaIcCan%:
  2232. Close(WH%):
  2233.  "Wimp_CreateMenu",,-1:Menu%=0
  2234.  SaIcSprite%:
  2235.  But%>=16 SaveLeaf$=$LP%:
  2236. StartDrag(WH%)
  2237.  SaIcOK%
  2238.  F$=Scrap$ 
  2239. F$,".") 
  2240.      
  2241. SaveType(F$,
  2242.      
  2243. MouseMenu(WH%)
  2244.  Start dragging file sprite
  2245. StartDrag(WH%)
  2246. 5'!b%=WH%:
  2247.  "Wimp_GetWindowInfo",,b%
  2248. 6;IB%=b%+4+88+32*SaIcSprite%    :
  2249.  File sprite icon block
  2250. 70X0%=b%!4-b%!20:Y0%=b%!16-b%!24:
  2251.  Work origin
  2252. 8.b%!4=5                        :
  2253.  Fixed box
  2254. 9:b%!8=X0%+!IB%:b%!12=Y0%+IB%!4 :
  2255.  Screen coords of icon
  2256. b%!16=X0%+IB%!8
  2257. b%!20=Y0%+IB%!12
  2258. <+b%!24=0:b%!28=0               :
  2259.  Limits
  2260. =#b%!32=Infinity%:b%!36=Infinity%
  2261.  "Wimp_DragBox",,b%
  2262.  Drag for save done.  Send DataSave msg.
  2263. DragDone
  2264.  "Wimp_GetPointerInfo",,b%
  2265. E+mess%!12=0                    :
  2266.  My ref
  2267. F?mess%!16=DataSave             :
  2268.  I've got some data for you
  2269. G:mess%!20=b%!12:mess%!24=b%!16 :
  2270.  Window & icon handles
  2271. H(mess%!28=!b%:mess%!32=b%!4    :
  2272. I.mess%!36=0                    :
  2273.  File size
  2274. J.mess%!40=SaveType%            :
  2275.  File type
  2276. MessStr(mess%,44,SaveLeaf$)
  2277.  "Wimp_SendMessage",18,mess%,b%!12,b%!16
  2278.  Call the right routine to write the curent filetype
  2279. SaveType(F$,Safe%)
  2280.  SaveType% 
  2281.  TreeType%  :
  2282. SaveAs(F$,Safe%)
  2283.  TextType%  :
  2284. WriteNotes(F$)
  2285.  ReportType%:
  2286. Report(F$)
  2287.  DrawType%  :
  2288. WriteDraw(F$)
  2289.        :
  2290.  1,"PROCSaveType"
  2291.  "Wimp_CreateMenu",,-1:Menu%=0
  2292.  Save data to a temporary file in case write fails then rename as F$
  2293. SaveAs(F$,Safe%)
  2294.  F%,Temp$:Temp$=F$
  2295. SetPerson                 :
  2296.  Note current person
  2297. SetHeadTrlr
  2298.  F$<>Scrap$ 
  2299. Temp$,1)="="
  2300. MT("CC")+" ("+
  2301. $+")"
  2302. (Temp$)
  2303.  #F%:
  2304. MT("SF")+" ("+
  2305. $+")"
  2306.  "Hourglass_On"
  2307. Escape(
  2308. SaveSubs(F%,Root%,0)
  2309. Escape(
  2310.  "Hourglass_Off"
  2311.  Temp$<>F$ 
  2312. MT("CN")+" '"+F$+"' ("+
  2313. $+")"
  2314. DelFile(F$)             :
  2315.  Remove old F$
  2316.  "OS_FSControl",25,Temp$,F$ :
  2317.  Rename
  2318. SetFileType(F$,TreeType%)
  2319.  Safe% 
  2320. SetFile(F$)
  2321.  Set up HEAD and TRLR objects, preserving modification
  2322. SetHeadTrlr
  2323.  H%,Mod%,S%
  2324. Mod%=Modified%:H%=0
  2325. GetSub(Root%,HeadTg%,H%)=0 
  2326.   H%=
  2327. Object(HeadTg%,0)
  2328.   H%!ObNext%=Root%!ObSubs%
  2329.   Root%!ObSubs%=H%
  2330. SetStr(H%,SourTg%,"Acorn Archimedes !"+Task$,
  2331. =  S%=0:
  2332. SetStr(
  2333. GetSub(H%,SourTg%,S%),VersTg%,Version$,
  2334. SetSub(H%,GedcTg%,0,
  2335. :  S%=0:
  2336. SetStr(
  2337. GetSub(H%,GedcTg%,S%),VersTg%,"5.3",
  2338. DelTag(Root%,TrlrTg%)        :
  2339.  Kill old trailer
  2340. SetSub(Root%,TrlrTg%,0,
  2341.  Ensure last
  2342. Modified%=Mod%
  2343. SaveSubs(F%,O%,Level%)
  2344. S%=O%!ObSubs%
  2345. SaveObj(F%,S%,Level%)
  2346. SaveSubs(F%,S%,Level%+1)
  2347.   S%=S%!ObNext%
  2348. SaveObj(F%,O%,Level%)
  2349.  T%,Val$
  2350. ,T%=O%!ObTag%:
  2351.  T%?TagFlags% 
  2352.  ProgTag% 
  2353. (Level%)+" ";
  2354.  Level%=0 
  2355. Id(O%)+" ";
  2356. TagStr(T%);
  2357. /Val$=
  2358. PrintStr(O%):
  2359.  Val$>"" 
  2360. #F%," "+Val$;
  2361. #F%,""
  2362. SetFile(F$)           :
  2363.  Now editing unmodified tree file F$
  2364.  Scrap$:
  2365.  ""    :TreeFile$="<"+
  2366. MT("UT")+">":F$=TreeLeaf$
  2367.   :TreeFile$=F$
  2368. IcTxt(SaveWH%,SaIcFile%)=F$
  2369. Modified%=
  2370. 8ModifiedShown%=
  2371.  Modified% :
  2372.  Force title bar redraw
  2373.  Write a report to text file F$
  2374. Report(F$)
  2375. MT("CC")+" ("+
  2376. $+")"
  2377.  #F%:
  2378. MT("SF")+" ("+
  2379. $+")"
  2380.  "Hourglass_On"
  2381. Escape(
  2382. WriteReport(F%)
  2383. Escape(
  2384.  "Hourglass_Off"
  2385. SetFileType(F$,ReportType%)
  2386.  F$<>Scrap$ $
  2387. IcTxt(RepoWH%,SaIcFile%)=F$
  2388. WriteReport(F%)
  2389.  CO%,FO%,Fam%,R%,S%
  2390.  Person%,ShowYearOnly%   :
  2391.  Override globals
  2392. ShowYearOnly%=
  2393. #F%,TreeFile$
  2394. Person%=0
  2395. GetSub(Root%,IndiTg%,Person%)
  2396. #F%,""
  2397. Name(Person%)+"  ("+
  2398. Dates(Person%)+")"
  2399. :  R%=
  2400. Father(Person%):
  2401. #F%,"  Father: "+
  2402. Name(R%)
  2403. :  R%=
  2404. Mother(Person%):
  2405. #F%,"  Mother: "+
  2406. Name(R%)
  2407.   Fam%=0
  2408. GetSub(Person%,FamsTg%,Fam%)
  2409.     FO%=
  2410. Val(Fam%)
  2411.     S%=
  2412. GetVal(FO%,HusbTg%)
  2413. 7    
  2414.  S%<>Person% 
  2415. #F%,"  Husband: "+
  2416. Name(S%)
  2417.     S%=
  2418. GetVal(FO%,WifeTg%)
  2419. 4    
  2420.  S%<>Person% 
  2421. #F%,"  Wife: "+
  2422. Name(S%)
  2423.     CO%=0
  2424. #    
  2425. GetSub(FO%,ChilTg%,CO%)
  2426. .      
  2427.  #F%,"    Child: "+
  2428. Name(
  2429. Val(CO%))
  2430.         
  2431. WriteNotesFile(F%,"  ")
  2432.  ======================== File Operations =========================
  2433. Modified              :
  2434.  Reflect modification in title bar
  2435.  ModifiedShown%=Modified% 
  2436.  Redraw title bar
  2437. %T$=TreeFile$:
  2438.  Modified% T$+=" *"
  2439. 4!b%=MainWH%:
  2440.  "Wimp_GetWindowInfo",,b% :
  2441.  blk@4
  2442. $b%!76=T$
  2443.  b%!32 
  2444.  1<<16 
  2445.  "Wimp_ForceRedraw",-1,b%!4,b%!16,b%!12,b%!16+44
  2446. ModifiedShown%=Modified%
  2447.  Return the length of File$ or -1 if not found
  2448. FileLen(File$)
  2449.  Found%,L%
  2450.  "OS_File",17,File$ 
  2451.  Found%,,,,L%
  2452.  Found%=1 
  2453. SetFileType(File$,Type%)
  2454.  "OS_File",18,File$,Type%
  2455.  Delete file F$ if it exists
  2456. DelFile(F$)
  2457.  "OS_File",6,F$
  2458.  ============================ GEDCOM ==============================
  2459.  Root% points to a level -1 pseudo-object.   Each object has a tag,
  2460.  a value, and a list of sub-objects.  Object values are initially
  2461.  pointers to strings but GEDCOM cross-references (Ids) are replaced
  2462.  by pointers to the referenced objects with the ObRef% bit set.
  2463.  Ids% points to a list of Ids.  Each Id has a pointer to the
  2464.  next Id, a pointer to the object it stands for, and a name.
  2465.  (Re)initialise everything, free all heap
  2466. Reset
  2467. SetFile("")
  2468. IcTxt(RepoWH%,SaIcFile%)=ReportLeaf$
  2469. IcTxt(DrawWH%,SaIcFile%)=DrawLeaf$
  2470. SetEdit(0)
  2471. ResetHeap
  2472.         CFontM%!32=-1                  :
  2473.  Font menu heap pointer invalid
  2474. Close(NoteWH%)
  2475. NoteBuf%=0
  2476. InitHash :
  2477.  Hash table for looking up names
  2478. Root%=
  2479. Object(RootTg%,0)
  2480. Person%=0
  2481. Force%=1
  2482.  Load objects from a file and build a heirarchy under R%.  If loading
  2483.  into an empty database (Reset%<>0) then R% is Root% otherwise add
  2484.  the new objects under a temporary root R% and then merge into Root%.
  2485. LoadGed(F%,Reset%)
  2486.  Id%,Id$,Level%,O%,R%,SubTl%(),Tag$,Value$,T%
  2487.  Where to hang next object at each level.  Root object is level -1.
  2488.  SubTl%(MaxLevel%):SubTl%()=0
  2489. CIds%=0                        :
  2490.  No inter-file cross references
  2491.  Reset% R%=Root% 
  2492. Object(RootTg%,0)
  2493. SubTl%(0)=
  2494. Tail(R%)
  2495.  Skip to header
  2496. #F%="0 HEAD" 
  2497. #F%=0 
  2498. #F%=O%
  2499.     !)  
  2500. GedLine(F%,Level%,Id$,Tag$,Value$)
  2501.  Level%>=0 
  2502.     #.    O%=
  2503. Object(
  2504. Tag(Tag$),
  2505. String(Value$))
  2506.     $6    SubTl%(Level%+1)=O%+ObSubs%:SubTl%(Level%+2)=0
  2507.     %8    T%=SubTl%(Level%):
  2508.  T%=0 
  2509. MT("BL")+": "+$b%
  2510.     &(    !T%=O%:SubTl%(Level%)=O%+ObNext%
  2511.  Id$>"" 
  2512.     (9      Id%=
  2513. Alloc(IdName%+
  2514. (Id$)+1):$(Id%+IdName%)=Id$
  2515.     )1      Id%!IdNext%=Ids%:Id%!IdObj%=O%:Ids%=Id%
  2516.     *        
  2517. XRef(R%)
  2518.  Ids%:
  2519. Free(Ids%):Ids%=Ids%!IdNext%:
  2520.  Free ids
  2521.  Reset% 
  2522. Merge(R%):
  2523. Free(R%)
  2524. FindPerson
  2525.  Merge New%'s sub-objects into Root%'s.  INDIs
  2526.  are sorted in by name, others are appended.
  2527. Merge(New%)
  2528.  E%,O%,N%,P%
  2529.  Find tail of Root%'s subs
  2530. Tail(Root%)
  2531. O%=New%!ObSubs%
  2532.   N%=O%!ObNext%
  2533.     =2  
  2534.  O%!ObTag%=IndiTg% P%=
  2535. Position(O%) 
  2536.  P%=E%
  2537.   O%!ObNext%=!P%:!P%=O%
  2538.  P%=E% E%=O%+ObNext%
  2539.   O%=N%
  2540. GedLine(F%,
  2541.  Level%,
  2542.  Id$,
  2543.  Tag$,
  2544.  Value$)
  2545.  I%,P%
  2546. #F%:P%=b%
  2547. White(?P%):P%+=1:
  2548.  ?P%=CR% Level%=-1:
  2549.  Ignore empty line
  2550.     I/Level%=
  2551. ($P%)               :
  2552.  Level number
  2553.  Level%=0 
  2554.     K-  
  2555. Digit($P%) 
  2556. MT("ML")+": "+$b%
  2557.     L/  
  2558.  "Hourglass_Percentage",100*
  2559.  Level%>MaxLevel% 
  2560. MT("BL")+": "+$b%
  2561.  Strip trailing spaces
  2562.     P2I%=P%+
  2563. ($P%)-1:
  2564. White(?I%):I%-=1:
  2565. :I%?1=CR%
  2566.     Q/I%=
  2567. $P%," "):
  2568.  I%=0 
  2569. MT("MG")+": "+$b%
  2570.     R5P%+=I%                        :
  2571.  Optional xref id
  2572.  ?P%=
  2573.   P%+=1:I%=
  2574. $P%,"@")
  2575.     U$  
  2576.  I%=0 
  2577. MT("BC")+": "+$b%
  2578.   Id$=
  2579. $P%,I%-1)
  2580.     W5  P%+=I%                      :
  2581.  After trailing @
  2582.  Id$=""
  2583.  ?P%=Space% P%+=1           :
  2584.  (Not really) optional delimiter
  2585.     [4I%=
  2586. $P%," ")             :
  2587.  Delimiter after tag?
  2588.  I% Tag$=
  2589. $P%,I%-1) 
  2590.  Tag$=$P%:I%=
  2591. (Tag$)
  2592.     ]8Value$=$(P%+I%)               :
  2593.  Optional line items
  2594. White(C%)=C%=Tab% 
  2595.  C%=LF% 
  2596.  C%=Space%
  2597. Lower($mess%)
  2598.  P%:P%=mess%
  2599.  ?P%<>CR%
  2600.  ?P%>=
  2601.  ?P%<=
  2602. "z" ?P%=?P% 
  2603.     f    P%+=1
  2604. =$mess%
  2605.  Convert a pointer to a cross-ref id.
  2606.  Just use its word offset into the heap.
  2607. Id(V%)="@"+
  2608. ((V%-Heap%)>>2)+"@"
  2609.  Set Person% to the person named in a level 0 NOTE or the last INDI
  2610. FindPerson
  2611.  O%,Val$
  2612. O%=Root%!ObSubs%
  2613.  O%!ObTag% 
  2614.  IndiTg%:Person%=O%
  2615.  NoteTg%
  2616.     Val$=
  2617. Null(O%!ObVal%)
  2618.     y5    
  2619. Val$,6)="Person" Person%=
  2620. Find(
  2621. Val$,8)):
  2622.   O%=O%!ObNext%
  2623.  Call PROCDeref for O% and its sub-objects recursively
  2624. XRef(O%)
  2625. Deref(O%)
  2626. 1O%=O%!ObSubs%:
  2627. XRef(O%):O%=O%!ObNext%:
  2628.  If O%'s value string is a GEDCOM pointer @id@ then
  2629.  replace it with a pointer to the object with that Id.
  2630. Deref(O%)
  2631.  S$,Val%,Target%
  2632. Val%=O%!ObVal%:
  2633.  Val%=0 
  2634.  ?Val%<>
  2635. S$=$(Val%+1)
  2636. S$,1)<>"@" 
  2637.  Target%=
  2638. IdObj(
  2639. (S$)-1))
  2640.  Target%=0 
  2641.  1,"Bad cross-reference "+$Val%
  2642. Free(Val%)
  2643. 5O%!ObVal%=Target% 
  2644.  ObRef%   :
  2645.  Flag as reference
  2646.  Return the object with Id$
  2647. IdObj(Id$)
  2648.  I%:I%=Ids%
  2649.  Id$="" 
  2650.  1,"FNIdObj"
  2651.  $(I%+IdName%)=Id$ 
  2652. =I%!IdObj%
  2653.   I%=I%!IdNext%
  2654. Error:=0
  2655. MT("BC")+": "+Id$
  2656.  ========================= GEDCOM edit ============================
  2657.  Create a window to display and edit all GEDCOM fields.
  2658.  (Under construction).  
  2659. ObjEdit
  2660. +!b%=ObEdWH%:
  2661.  "Wimp_GetWindowInfo",,b%
  2662. /y%=b%!56                      :
  2663.  Work max y
  2664. OERecurse(Root%,-1,0,y%,-Infinity%,-Infinity%)
  2665. b%!48=y%-8
  2666.  "Wimp_DeleteWindow",,b%
  2667.  "Wimp_CreateWindow",,b%+4 
  2668.  ObEdWH%
  2669. Open(ObEdWH%)
  2670. DrawObEd(XW%,YW%,YMin%,YMax%)
  2671. YW%-=8
  2672. OERecurse(Root%,-1,XW%+8,YW%,YMin%-CharH%,YMax%+CharH%)
  2673. ObEdClick(Y%)
  2674.  YW%,S%
  2675. ,!b%=ObEdWH%:
  2676.  "Wimp_GetWindowState",,b%
  2677. YW%=b%!16-b%!24
  2678. OERecurse(Root%,-1,0,YW%,Y%+8,-Infinity%)
  2679.  S%=0 
  2680.  ?? PROCD(FNTagStr(S%!ObTag%))
  2681.  If YW%<YMax% then draw object S%.  Update YW%.
  2682.  If YW%<Ymin% then return S% else recurse on S%'s
  2683.  subobjects.  Return 0 to continue the recusion.
  2684. OERecurse(S%,Depth%,XW%,
  2685.  YW%,YMin%,YMax%)
  2686.  F%,T%,X%,L$
  2687.  T%=S%!ObTag%:F%=T%?TagFlags%
  2688.  S%<>Root% 
  2689.  ProgTag% 
  2690.  YW%<YMax% 
  2691.  XW%>=0 X%=XW%:
  2692.  Depth%>0 X%+=2*Depth%*CharW%
  2693.  Depth%=0 
  2694.  X%,YW%:
  2695. Id(S%);
  2696.  X%+8*CharW%,YW%:
  2697. TagStr(T%);" ";
  2698. PrintStr(S%)
  2699.  YW%-=CharH%:
  2700.  YW%<YMin% 
  2701. S%=S%!ObSubs%
  2702. >  X%=
  2703. OERecurse(S%,Depth%+1,XW%,YW%,YMin%,YMax%):
  2704.   S%=S%!ObNext%
  2705.  ============================= Tags ===============================
  2706.  Return the (new) tag with name T$
  2707. Tag(T$)
  2708.  T%:T%=Tags%
  2709.  $(T%+TagName%)=T$ 
  2710.   T%=T%!TagNext%
  2711. MkTag(T$)
  2712. MkTag(T$)
  2713.  T% TagName%+
  2714. (T$)+1
  2715. T%?TagFlags%=0
  2716. T%!TagNext%=Tags%
  2717. $(T%+TagName%)=T$
  2718. Tags%=T%
  2719. TagStr(T%)=$(T%+TagName%)
  2720.  Initialise tags structures and linked list
  2721. InitTags
  2722.  A tag is a pointer to a structure consisting of
  2723. 5TagNext% =0                   :
  2724.  Next tag pointer
  2725. C                              :
  2726.  Other fields, e.g. help string
  2727. .TagFlags%=4                   :
  2728.  Flag byte
  2729. CTagName% =5                   :
  2730.  Variable length, CR terminated
  2731. 9Tags%=0                       :
  2732.  Pointer to first tag
  2733.  Tag flags
  2734. DProgTag%=1                    :
  2735.  Program only object - not saved
  2736.  Flag for PROCMark, PROCScan stored in object's tag pointer
  2737. Dead%=1
  2738.  Create tags used explicitly by code
  2739. HeadTg%=
  2740. MkTag("HEAD")
  2741. SourTg%=
  2742. MkTag("SOUR")
  2743. VersTg%=
  2744. MkTag("VERS")
  2745. GedcTg%=
  2746. MkTag("GEDC")
  2747. TrlrTg%=
  2748. MkTag("TRLR")
  2749. IndiTg%=
  2750. MkTag("INDI")
  2751. NameTg%=
  2752. MkTag("NAME")
  2753. SexTg%= 
  2754. MkTag("SEX" )
  2755. DateTg%=
  2756. MkTag("DATE")
  2757. BirtTg%=
  2758. MkTag("BIRT")
  2759. DeatTg%=
  2760. MkTag("DEAT")
  2761. FamTg%= 
  2762. MkTag("FAM" )
  2763. NoteTg%=
  2764. MkTag("NOTE")
  2765. ContTg%=
  2766. MkTag("CONT")
  2767. FamsTg%=
  2768. MkTag("FAMS")
  2769. FamcTg%=
  2770. MkTag("FAMC")
  2771. HusbTg%=
  2772. MkTag("HUSB")
  2773. WifeTg%=
  2774. MkTag("WIFE")
  2775. ChilTg%=
  2776. MkTag("CHIL")
  2777.  ProgTag% objects are for internal use only
  2778. 6RootTg%=
  2779. MkTag("root"):RootTg%?TagFlags%+=ProgTag%
  2780.  Display structure pointer
  2781. 6DispTg%=
  2782. MkTag("disp"):DispTg%?TagFlags%+=ProgTag%
  2783.  ============================ Syntax ==============================
  2784.  Load GEDCOM syntax description ??
  2785. Syntax
  2786.  F%,F$
  2787. F$="<Family$Dir>.GEDSyn"
  2788. (F$):
  2789.  F%=0 
  2790. MT("CR")+" "+F$
  2791.   $b%=
  2792.  ?b% 
  2793. "#",CR%:
  2794.  Ignore comments and blank lines
  2795.  Print name
  2796.  Help string
  2797.  sub-objects
  2798.  ============================= Print ==============================
  2799. Print
  2800.  F%,OldJob%,Page%,More%,x%,y%,dx%,dy%,N%
  2801.  Left%,Bottom%,Right%,Top%,Height%,Width%
  2802.  Following locals override PROCdisplay global work origin
  2803.  XW%,YW%:XW%=0:YW%=0
  2804.  Error handler must be local so we can restore the old one
  2805.  Person%=0 
  2806. MT("NP")
  2807. OldJob%=-1:F%=0
  2808. PrintErr
  2809. ("Printer:")
  2810.  "PDriver_SelectJob",F%,"Tree" 
  2811.  OldJob%
  2812.  "PDriver_Info" 
  2813. ,,,N%
  2814.  1<<29 
  2815.  "PDriver_DeclareFont",,Font$
  2816.  "PDriver_DeclareFont"
  2817.  Get printable paper area limits in millipoints
  2818.  "PDriver_PageSize" 
  2819. ,,,Left%,Bottom%,Right%,Top%
  2820.  Size in OS units.  1 OS unit = 400 millipoints = 1/180".
  2821. @HWidth%=(Right%-Left%) 
  2822.  mPtPerOS%:Height%=(Top%-Bottom%) 
  2823.  mPtPerOS%
  2824.  Rotate% 
  2825.  Width%,Height%
  2826. BAUseFont%=
  2827. CalcAll     :
  2828.  Recalculate positions for printing
  2829. CBForce%=1                      :
  2830.  Set to recalculate for screen
  2831. D@Page%=1                       :
  2832.  Identify rectangle to print
  2833.  Work area is (0,yMin%)..(xMax%,0).  Allow overlap between pages
  2834. F N%=(xMax%+Width%-1) 
  2835.  Width%
  2836.  N%>1 dx%=(xMax%-Width%) 
  2837.  (N%-1) 
  2838.  dx%=Width%
  2839. H#N%=(-yMin%+Height%-1) 
  2840.  Height%
  2841.  N%>1 dy%=(-yMin%-Height%) 
  2842.  (N%-1) 
  2843.  dy%=Height%
  2844.  "Hourglass_On"
  2845.  y%=yMin% 
  2846.  0-Height% 
  2847.  dy%:
  2848.  x%=0 
  2849.  xMax%-Width% 
  2850.  Set work rectangle to print at b% in OS units.  Top left = (0,0).
  2851. M5  b%!0=x%:b%!4=y%:b%!8=x%+Width%:b%!12=y%+Height%
  2852.  Set transform table at b%+16.  x'=(ax+cy)>>16  y'=(bx+dy)>>16
  2853.  Print position of transformed bottom left at b%+32 in millipoints.
  2854.  Seascape (clockwise) is more natural than landscape (anticlockwise)
  2855.  for continuous paper since x=0 will be at the top.
  2856.  Rotate% 
  2857. SH    b%!16=0:b%!20=-1<<16:b%!24=1<<16:b%!28=0  :
  2858.  Seascape x'=y y'=-x
  2859. TH    b%!32=Left%:b%!36=Top%                    :
  2860.  Rotate 90 clockwise
  2861. VI    b%!16=1<<16:b%!20=0:b%!24=0:b%!28=1<<16   :
  2862.  Portrait  x'=x  y'=y
  2863. W@    b%!32=Left%:b%!36=Bottom%                 :
  2864.  No rotation
  2865.  "PDriver_GiveRectangle",Page%,b%,b%+16,b%+32,White%
  2866.  "PDriver_DrawPage",1,b%,Page%,
  2867. (x%)+","+
  2868.  More%
  2869.  More%
  2870. \L    
  2871. Display(b%!0,b%!4,b%!8,b%!12,OutPrint%) :
  2872.  b% is work rect to print
  2873. ]-    
  2874.  "PDriver_GetRectangle",,b% 
  2875.  More%
  2876.   Page%+=1
  2877.  "Hourglass_Off"
  2878.  "PDriver_EndJob",F%
  2879.  "PDriver_SelectJob",OldJob%
  2880. PrintErr
  2881.  OldJob%>=0 
  2882.  "PDriver_AbortJob",F%
  2883.  "PDriver_SelectJob",OldJob%
  2884.  "Hourglass_Smash"
  2885.  ========================= Write Draw file ========================
  2886. WriteDraw(F$)
  2887.  XW%,YW%                 :
  2888.  Override PROCdisplay global work origin
  2889.  "Hourglass_On"
  2890. dw_open(F$)               :
  2891.  open draw file
  2892. dw_font(Font$)            :
  2893.  set up font
  2894. x@UseFont%=
  2895. CalcAll     :
  2896.  Recalculate positions for drawing
  2897. yBForce%=1                      :
  2898.  Set to recalculate for screen
  2899.  Draw with bottom left = 0,0 in infinite clip rectangle
  2900. XW%=-xMin%:YW%=-yMin%
  2901. Display(-Infinity%,-Infinity%,Infinity%,Infinity%,OutDraw%)
  2902. dw_close
  2903.  F$<>Scrap$ $
  2904. IcTxt(DrawWH%,SaIcFile%)=F$
  2905.  "Hourglass_Off"
  2906.  Open draw file and initialise variables
  2907. dw_open(fnam$)
  2908.  dw_fh%=
  2909. (fnam$):
  2910.  dw_fh%=0 
  2911. dw_file$=fnam$
  2912.  Initialise bounding box and font
  2913. (dw_xmn%=Infinity%:dw_xmx%=-Infinity%
  2914. (dw_ymn%=Infinity%:dw_ymx%=-Infinity%
  2915. 0dw_ft%=0                      :
  2916.  System font
  2917.  Write header
  2918. #dw_fh%,"Draw";:
  2919. dw_word(201):
  2920. dw_word(0)
  2921. #dw_fh%,"Family      ";   :
  2922.  Name must be 12 characters
  2923. #dw_fh%=40                 :
  2924.  Skip bounding box for now
  2925.  Terminate and close file
  2926. dw_close
  2927.  dw_fh%=0 
  2928. #dw_fh%=24                 :
  2929.  Output bounding box
  2930. dw_cd(dw_xmn%,dw_ymn%):
  2931. dw_cd(dw_xmx%,dw_ymx%)
  2932. #dw_fh%:dw_fh%=0         :
  2933.  Close draw file
  2934. SetFileType(dw_file$, DrawType%)
  2935.  Make font object
  2936. dw_font(font$)
  2937.  dw_fh%=0 
  2938. dw_word(0)                  :
  2939.  Object type 0
  2940. dw_word((
  2941. (font$)+13)
  2942.  Length
  2943. dw_ft%=1
  2944. #dw_fh%,dw_ft%
  2945. dw_string(font$)
  2946.  Draw some text
  2947. dw_text(x1%,y1%,size%,colour%,text$)
  2948.  dw_fh%=0 
  2949.  "Font_SetFont",Font%
  2950.  "Font_StringBBox",,text$ 
  2951. ,xx1%,yy1%,xx2%,yy2%
  2952. Ax2%=x1%+(xx2%-xx1%)
  2953.  mPtPerOS%:y2%=y1%+(yy2%-yy1%)
  2954.  mPtPerOS%
  2955. dw_word(1)                :
  2956.  Object type 1
  2957. dw_word((
  2958. (text$)+56)
  2959.  Length
  2960. dw_bx                     :
  2961.  4 words of bounding box
  2962. dw_word(colour%)          :
  2963.  Text colour
  2964. dw_word(&FFFFFF00)        :
  2965.  Background colour
  2966. dw_word(dw_ft%)           :
  2967.  Font
  2968. dw_word(size%*640*DrawScale):
  2969.  Nominal size of font
  2970. dw_word(size%*640*DrawScale)
  2971. dw_cd(x1%,y1%)            :
  2972.  Start coords
  2973. dw_string(text$)
  2974.  Output a null-terminated string.  Pad to word boundary.
  2975. dw_string(S$)
  2976. #dw_fh%,S$;
  2977.  P%:P%=
  2978. #dw_fh% 
  2979. #dw_fh%,0:P%+=1:
  2980.  P%=4
  2981.  Draw a line
  2982. dw_line(x1%,y1%,x2%,y2%,colour%)
  2983.  dw_fh%=0 
  2984. dw_word(2)                :
  2985.  Object type 2
  2986. dw_word(68)               :
  2987.  Length
  2988. dw_bx                     :
  2989.  4 words of bounding box
  2990. dw_word(-1)               :
  2991.  No fill
  2992. dw_word(colour%)
  2993. dw_word(DrawWidth%)
  2994. dw_word(0)                :
  2995.  Style
  2996. dw_word(2)                :
  2997.  Move
  2998. dw_cd(x1%,y1%)            :
  2999.  Start coords
  3000. dw_word(8)                :
  3001.  DRAW
  3002. dw_cd(x2%,y2%)            :
  3003.  Start coords
  3004. dw_word(0)                :
  3005.  End path
  3006.  Output bounding box x1%,y1% - x2%,y2%
  3007. dw_bx
  3008.  xx1%,yy1%,xx2%,yy2%
  3009. 'xx1%=x1%:yy1%=y1%:xx2%=x2%:yy2%=y2%
  3010.  xx1%>xx2% 
  3011.  xx1%,xx2%
  3012.  yy1%>yy2% 
  3013.  yy1%,yy2%
  3014. dw_cd(xx1%,yy1%):
  3015. dw_cd(xx2%,yy2%)
  3016.  Update overall box
  3017. Min(dw_xmn%,xx1%):
  3018. Min(dw_ymn%,yy1%)
  3019. Max(dw_xmx%,xx2%):
  3020. Max(dw_ymx%,yy2%)
  3021.  Output coordinate pair.  Convert from OS
  3022.  coords (1/180") to draw units (1/(180*256)").
  3023. dw_cd(X%,Y%)
  3024. dw_word((X%<<8)*DrawScale):
  3025. dw_word((Y%<<8)*DrawScale)
  3026.  Output word
  3027. dw_word(word%)
  3028. #dw_fh%,word%:
  3029. #dw_fh%,word%>>8
  3030. #dw_fh%,word%>>16:
  3031. #dw_fh%,word%>>24
  3032.  ==================== Low-level memory allocation =================
  3033.  Free% points after last block allocated or at lowest freed.  Block
  3034.  starts with 4-byte count of following bytes.  Count is multiple
  3035.  of 4.  Bit 0 => block in use.  Coalesce as much as possible on
  3036.  allocation.  Only zero size block is last block.  Musn't leave a
  3037.  zero size block when allocating part of a block.  HeapFree% is
  3038.  total free space including count words of free blocks.
  3039. ResetHeap
  3040. HeapSize%=HeapEnd%-Heap%
  3041. 6HeapLow%=0.05*HeapSize%       :
  3042.  Warn if less free
  3043. >!Heap%=HeapSize%-8            :
  3044.  8 bytes = two count words
  3045. ?Heap%!(HeapSize%-4)=0         :
  3046.  End marker: no bytes, free
  3047. Free%=Heap%
  3048. HeapFree%=HeapSize%
  3049. @HeapWarn%=HeapLow%            :
  3050.  Warn if less than this free
  3051. Alloc(W%)
  3052.  E%,N%,S%,B%
  3053.  W%=0 
  3054. W%=(W%+3) 
  3055. B%=Free%
  3056. 3  S%=!B% 
  3057.  1             :
  3058.  Size of cur block
  3059.  S%=0 
  3060. MT("OM")
  3061.     0  N%=B%+4+S%                   :
  3062.  Next block
  3063.  (!B% 
  3064.  1)>0           :B%=N%:S%=0
  3065.  (!N% 
  3066.  1)=0 
  3067.  !N%<>0:!B%+=!N%+4:S%=0
  3068.  S%<W%                   :B%=N%
  3069.  S%=W%                   :Free%=N%
  3070.  S%>W%                   :E%=S%-W%-4
  3071. 1    
  3072.  E% Free%=B%+4+W%:!Free%=E% 
  3073.  B%=N%:S%=0
  3074.  S%>=W%
  3075. !B%=W% 
  3076. HeapFree%-=W%+4
  3077.     =B%+4
  3078.  Free block at A%.  Freeing any number of
  3079.  objects will not disturb their contents.
  3080. Free(A%)
  3081.  A%=0 
  3082.     A%-=4
  3083.  (!A% 
  3084.  1)=0 
  3085.  1,"PROCFree not heap"
  3086.  (!A% 
  3087.  1)=0 
  3088.  1,"PROCFree size 0"
  3089. !A%-=1
  3090.  A%<Free% Free%=A%
  3091. HeapFree%+=!A%
  3092.  Free old block O% and copy (some of)
  3093.  its contents to a new one of size S%
  3094.  DEF PROCRealloc(RETURN O%,S%)
  3095.  LOCAL I%,N%
  3096.  S%=(S%+3) AND NOT 3
  3097.  N%=FNAlloc(S%)
  3098.  IF O%=0 O%=N%:ENDPROC
  3099.  PROCMin(S%,FNSize(O%))
  3100.  FOR I%=0 TO S%-1 STEP 4:N%!I%=O%!I%:NEXT
  3101.  PROCFree(O%)
  3102.  O%=N%
  3103.  ENDPROC
  3104.  Make a heap copy of string S$.  An empty string
  3105.  is not stored, it is replaced by null pointers.
  3106. String(S$)
  3107.  S$="" 
  3108. Alloc(
  3109. (S$)+1)
  3110. $A%=S$
  3111.  DEF FNSize(A%)
  3112.  IF A%=0 ERROR 1,"FNSize"
  3113.  =A%!-4 AND NOT 1
  3114. CheckFree
  3115. (HeapFree% 
  3116.  1024)
  3117.  $BarIcText%<>K$ 
  3118. D(  b%!0=-1:b%!4=BarIc%:b%!8=0:b%!12=0
  3119.   $BarIcText%="    "
  3120.  "Wimp_SetIconState",,b%
  3121.   $BarIcText%=K$
  3122.  "Wimp_SetIconState",,b%
  3123.  HeapFree%>HeapWarn% 
  3124. K<HeapWarn%=-1 :
  3125.  Inhibit warning until next PROCResetHeap
  3126. MT("MW")
  3127.  ============================ Choices =============================
  3128.  Set default choices and load from file
  3129. LoadOpts
  3130.  F%,L$,K$,V$
  3131.  Font$,PtSize% is the font used for printing
  3132. V@Font$="Trinity.Medium":PtSize%=10   :
  3133.  Like Postscript Times
  3134.  Font$="System.Fixed":PtSize%=12 :REM Looks just like system font
  3135.  Should the above font be used on screen as well?
  3136. ScreenUseFont%=
  3137.  Should person's family name be shown if same as father's?
  3138. ShowFamilyName%=
  3139.  Should dates be shown?
  3140. ShowDates%=
  3141.  Should only year be shown?
  3142. ShowYearOnly%=
  3143.  Print rotated?
  3144. Rotate%=
  3145.  Draw scale
  3146. DrawScale=1.0
  3147.  Draw line width
  3148. DrawWidth%=4
  3149. (OptFile$)
  3150.     L$=
  3151. KeyVal(L$,K$,V$)
  3152. m#    
  3153.  "Font"          :Font$=V$
  3154. n(    
  3155.  "PointSize"     :PtSize%=
  3156. o/    
  3157.  "ScreenUseFont" :ScreenUseFont%=
  3158. p0    
  3159.  "ShowFamilyName":ShowFamilyName%=
  3160. q+    
  3161.  "ShowDates"     :ShowDates%=
  3162. r.    
  3163.  "ShowYearOnly"  :ShowYearOnly%=
  3164. s=    
  3165.  Accept "Landscape" for v2.02 backward compatibility
  3166. t,    
  3167.  "Landscape","Rotate":Rotate%=
  3168. u*    
  3169.  "DrawScale"     :DrawScale=
  3170. v+    
  3171.  "DrawWidth"     :DrawWidth%=
  3172. w        
  3173. FindFont(Font$,PtSize%)
  3174. KeyVal(Line$,
  3175.  Key$,
  3176.  Val$)
  3177. Line$,":")
  3178. Key$=
  3179. Line$,I%-1)
  3180.  I%=0 
  3181. Key$," ") Key$="":Val$="":
  3182.  I%+=1:
  3183. Line$,I%,1)<>" "
  3184. Val$=
  3185. Line$,I%)
  3186. SaveOpts
  3187. (OptFile$)
  3188. #F%,"Font:"+Font$
  3189. #F%,"PointSize:"+
  3190.  PtSize%
  3191. #F%,"ScreenUseFont:"+
  3192.  ScreenUseFont%
  3193. #F%,"ShowFamilyName:"+
  3194.  ShowFamilyName%
  3195. #F%,"ShowDates:"+
  3196.  ShowDates%
  3197. #F%,"ShowYearOnly:"+
  3198.  ShowYearOnly%
  3199. #F%,"Rotate:"+
  3200.  Rotate%
  3201. #F%,"DrawScale:"+
  3202.  DrawScale
  3203. #F%,"DrawWidth:"+
  3204.  DrawWidth%
  3205.  Set up choices menu
  3206. ShowOpts
  3207.  M%,MenuLen%,IndLen%
  3208.  "Font_ListFonts",,,1<<19 
  3209.  1<<21 
  3210. ,,,MenuLen%,,IndLen%
  3211.  FontM%!32 points to font name submenu+indirect data if > 0
  3212. !M%=FontM%!32:
  3213.  M%>0 
  3214. Free(M%)
  3215. Alloc(MenuLen%+IndLen%)
  3216.  "Font_ListFonts",,M%,1<<19 
  3217.  1<<21,MenuLen%,M%+MenuLen%,IndLen%,Font$
  3218. FontM%!32=M%
  3219. $FontSizeBuf%=
  3220. (PtSize%)+
  3221. SelEntry(FontM%,2,ScreenUseFont%)
  3222. SelEntry(FontM%,3,Rotate%)
  3223. SelEntry(ShowM%,0,ShowFamilyName%)
  3224. SelEntry(ShowM%,1,ShowDates%)
  3225. SelEntry(ShowM%,2,ShowYearOnly%)
  3226. "$DrawScaleBuf%=
  3227. (DrawScale)+
  3228. #$DrawWidthBuf%=
  3229. (DrawWidth%)+
  3230.  Event in choices menu
  3231. SetOpts(Choice1%,Choice2%,Choice3%,But%)
  3232.  F%,F$
  3233.  Choice1% 
  3234.  0                        :
  3235.  Font
  3236.  Choice2% 
  3237.  Decode font id into mess% and copy to F$
  3238. K         
  3239.  "Font_DecodeMenu",,FontM%!32,b%+12,mess%,messlen% 
  3240. ,,,F$,F%
  3241. 0         
  3242. FindFont(F$,PtSize%):Force%=1
  3243.  1:F%=
  3244. ($FontSizeBuf%)
  3245. )         
  3246. FindFont(Font$,F%):Force%=1
  3247.  2:ScreenUseFont%=
  3248.  ScreenUseFont%
  3249.          Force%=1
  3250.  3:Rotate%=
  3251.  Rotate%
  3252.  1                        :
  3253.  Show
  3254.  Choice2% 
  3255.  0:ShowFamilyName%=
  3256.  ShowFamilyName%
  3257.  1:ShowDates%=
  3258.  ShowDates%
  3259.  2:ShowYearOnly%=
  3260.  ShowYearOnly%
  3261.   Force%=1
  3262.  2                        :
  3263.  Draw
  3264.  Choice2% 
  3265.  0:DrawScale=
  3266. ($DrawScaleBuf%)
  3267.  1:DrawWidth%=
  3268. ($DrawWidthBuf%)
  3269. SaveOpts
  3270. FindFont(F$,S%)
  3271.  O%:O%=Font%
  3272.  "Font_ReadScaleFactor" 
  3273. ,mPtPerOS%
  3274.  "Font_FindFont",,F$,16*S%,16*S% 
  3275.  Font%
  3276.  "Font_LoseFont",O%
  3277. Font$=F$:PtSize%=S%
  3278.  ========================== MessageTrans ==========================
  3279. MTLoad(MTFile$)
  3280.  MTB%
  3281.  "OS_Module",6,,,17+
  3282. (MTFile$) 
  3283. ,,MTFile% :
  3284.  Allocate RMA
  3285. $(MTFile%+16)=MTFile$
  3286.  MTB% 
  3287. FileLen(MTFile$)
  3288.  "MessageTrans_OpenFile",MTFile%,MTFile%+16,MTB%
  3289.  Look up a token in the Messages file.  No substitution allowed.
  3290. MT(Tok$)
  3291.  L%,R%
  3292.  "MessageTrans_Lookup",MTFile%,Tok$ 
  3293. ,,R%,L%
  3294. $(R%+L%)=""
  3295.  ========================== Quit & error ==========================
  3296. Mods(".Q") 
  3297. ExtEdAbort
  3298.  Font% 
  3299.  "Font_LoseFont",Font%
  3300.  Task% $b%="TASK":
  3301.  "Wimp_CloseDown",Task%,!b%
  3302.  Errors < 0 are expected - retain error handler and return.
  3303.  Error 0 is untrappable so won't be passed here.
  3304.  Errors > 0 are fatal - cancel error handler and quit.
  3305. Error
  3306.  At$,R%
  3307. >0 At$=" at line "+
  3308. +"!" 
  3309.  At$=""
  3310. :$(b%+4)=
  3311. $+At$+
  3312.  "Wimp_ReportError",b%,(
  3313.  1,Task$ 
  3314.  R%=2 
  3315. NotOK(Query$)
  3316. "!mess%=-1:$(mess%+4)=Query$+
  3317.  "Wimp_ReportError",mess%,&13,Task$ 
  3318. 2=R%=2                         :
  3319.  Cancel button
  3320.  If data modified open the "modified data" dbox
  3321.  and suspend the current load, reset or quit.
  3322.  Remember what to do if the user hits "Discard".
  3323. Mods(F$)
  3324.  Modified% ToDo$=F$:
  3325. MouseMenu(ModsWH%)
  3326. =Modified%
  3327. D(A$)
  3328.  B%,J%
  3329.  A$="" Debug%=0:
  3330.  "PDriver_SelectJob",0,0 
  3331.  4,26:
  3332. 0,1);A$;".":
  3333.  "PDriver_SelectJob",J%
  3334. Debug%=(Debug%+1) 
  3335.  "Hourglass_Smash":
  3336.  "OS_Confirm"
  3337.  z%,z%,B%:
  3338.  B%=0
  3339.  z=INKEY(100)
  3340.