home *** CD-ROM | disk | FTP | other *** search
/ RISC DISC 1 / RISC_DISC_1.iso / pd_share / apps / powerbase / !Powerbase / !RunImage (.txt) < prev    next >
Encoding:
RISC OS BBC BASIC V Source  |  1994-09-17  |  242.3 KB  |  11,119 lines

  1.  ><PBase$Dir>.!RunImage
  2.  !RunImage for !Powerbase database
  3.  D.L. & S.R. Haslam
  4.  Heap Manager (module + BASIC)
  5.  S.R. Haslam
  6.  Interface Manager (v.2)
  7.  Simon Huntingdon
  8. !version$="5.07 (12-Sep-1994)"
  9. ,intversion$="Interface Manager (v.2.00)"
  10.  "OS_Byte",202,0,255 
  11.  ,kbdstatus%
  12.  fatal_err%=255:moan_err%=254
  13. present%=
  14. ,"L0 error: "+
  15. $+" during initialisation at line "+
  16. setup
  17.  buff%>endbuff% 
  18.  0,"No room for defs."
  19.  menu_ptr%>men_end% 
  20.  0,"No room for menus"
  21. wimp_error(
  22.  "OS_GetEnv" 
  23.  ComString$
  24. ComString$,"-database") 
  25. 4  File$=
  26. ComString$,
  27. ComString$,"-database")+10)
  28.  "OS_GSTrans",File$,
  29. 13),255 
  30.  ,File$,L%
  31.   File$=
  32. File$,L%)
  33. get_it_in(File$)
  34. wimp_error(
  35.  quit%
  36. close_down
  37.  "OS_Byte",229,1:
  38.  "OS_Byte",124
  39.  "Wimp_Poll",mask%,block% 
  40.  reason%
  41.  "Interface_Poll",reason%,,mytask%
  42.  reason% 
  43.  autosave%>0 
  44.  Access%=
  45. check_save(saveint%*6000)
  46.  Imp_wait% 
  47.  merging% 
  48. start_merge
  49.  flash%>0 
  50. flash(mainW%,field%(flash%))
  51. redraw(!block%)
  52.  "Wimp_OpenWindow",,block%
  53. perform_close(!block%)
  54. hourglass(
  55. hourglass(
  56. mouse(block%!0,block%!4,block%!8,block%!12,block%!16)
  57. end_drag(Start%,End%)
  58. process_key
  59. menu_select
  60. set_keyboard(!block%,block%!4)
  61.  17,18:
  62.  "Impulse_Decode",reason%,block%,,,,methodtable%,mytask% 
  63.  reason%,,,,,token%,params%,object%
  64.  reason%>=&200 
  65.  reason% 
  66. ;M      
  67.  &200,&201:
  68.  token%<>-1 
  69. Impulse_command(token%,params%,object%)
  70. </      
  71.  &202:
  72. Impulse_reply(token%,params%)
  73. =.      
  74.  &203:
  75. Impulse_send(token%,object%)
  76. >9      
  77.  &204:
  78. Impulse_receive(token%,params%,object%)
  79. ?        
  80. message
  81. not_acknowledged
  82. hourglass(on%)
  83.  (indexing% 
  84.  printing%) 
  85.  !block%=keypadW% 
  86.  on% 
  87.  "Hourglass_On" 
  88.  "Hourglass_Off"
  89. flash(wi%,ic%)
  90.  time%
  91.  "OS_ReadMonotonicTime" 
  92.  time%
  93.  (time% 
  94.  50)=0 
  95. invert(wi%,ic%)
  96.  Shutdown routines ---------------------------------------------------
  97. close_down
  98. :$block%="TASK":
  99.  "Wimp_CloseDown",mytask%,!block%:
  100.  "Interface_CloseDown",mytask%,!block%:
  101. ,"L0 error: "+
  102. $+" during closedown at line "+
  103.  "Hourglass_Smash"
  104. exit(0)
  105.  "Interface_CloseDown",mytask%
  106.  "Impulse_CloseDown",mytask%
  107. $block%="TASK"
  108.  "Wimp_CloseDown",mytask%,!block%
  109.  "OS_Byte",202,kbdstatus%
  110. exit(exittype%)
  111.  flag%
  112.  "Hourglass_Smash"
  113.  present%=7 
  114. check_change
  115.  exittype% 
  116.  warn% 
  117.  ram% 
  118.  flag%=
  119. confirm(
  120. msg(63)) 
  121.  flag%=
  122.  warn% 
  123.  flag%=
  124. confirm(
  125. msg(62)) 
  126.  flag%=
  127.  flag%=
  128. close_files
  129.  exittype%=0 
  130.  design% 
  131. save_form($database%+".Form")
  132.  link$(0)="LOADED" 
  133. o     lk=
  134. ($database%+".Link")
  135.  F%=1 
  136.  fields%
  137.       
  138. #lk,link$(F%)
  139.  calc$(0)="LOADED" 
  140. u     cl=
  141. ($database%+".Calc")
  142.  F%=1 
  143.  fields%
  144.       
  145. #cl,calc$(F%)
  146.  key%=0 
  147.  Keys%
  148. date(key%)
  149.  key%
  150.  Access%=
  151.  present%=7 
  152. mouse(0,0,4,keypadW%,19)
  153. close_log("<Log$Dir>.Log")
  154. hide_windows
  155. delete_icons(mainW%,0)
  156. delete_icons(datadicW%,0)
  157. delete_icons(pselectW%,1)
  158. delete_icons(keypadW%,37)
  159. recover_memory
  160. init_vars
  161.  I%=0 
  162.  MaxTabs%
  163.   printrel$(I%)=""
  164. field$()=""
  165. $Password%=""
  166. present%=
  167. exit%=
  168. lit(menu%(0),1,
  169. lit(menu%(0),2,
  170. lit(menu%(0),3,
  171. lit(menu%(0),4,
  172. lit(menu%(2),1,
  173. ):ptr%=menu%(2)+52:ptr%!4=-1
  174. lit(menu%(6),6,
  175. lit(menu%(6),7,
  176. lit(menu%(6),8,
  177. set_auto(
  178. set_autobalance(
  179. tick(menu%(2),3,
  180. tick(menu%(2),4,
  181. $dbase%="No data"
  182. $database%="No data"
  183. redraw_icon(-2,pbaseicon%)
  184. delete_icons(wi%,ic%)
  185. !block%=wi%:block%!4=ic%
  186.  "Wimp_DeleteIcon",,block%
  187.   ic%+=1:block%!4=ic%
  188.  "Wimp_GetIconState",,block%
  189.  ((block%!24) 
  190.  (1<<23))>0
  191. close_files
  192. close_file(lk):link$()=""
  193. close_file(cl):calc$()=""
  194. close_file(dbasehandle%)
  195. close_file(csvhandle%)
  196. close_file(texthandle%)
  197. close_file(text%)
  198. close_file(toobighandle%)
  199. close_file(F)
  200. close_file(FH%)
  201. close_file(V)
  202. close_file(
  203.  filehandle%)
  204.  filehandle%>0 
  205. #filehandle%
  206.   filehandle%=0
  207. recover_memory
  208. scrap_sliding_block(headanchor%)
  209. scrap_sliding_block(undoanchor%)
  210. scrap_sliding_block(lineanchor%)
  211. scrap_sliding_block(textanchor%)
  212. scrap_sliding_block(formanchor%)
  213. scrap_sliding_block(selanchor%)
  214. scrap_sliding_block(tempanchor%)
  215. scrap_sliding_block(balanchor%)
  216. scrap_sliding_block(flaganchor%)
  217. scrap_sliding_block(transanchor%)
  218. scrap_sliding_block(sprsanchor%)
  219. scrap_sliding_block(recanchor%)
  220. scrap_sliding_block(saveanchor%)
  221. scrap_sliding_block(logoanchor%)
  222. scrap_sliding_block(fieldmenuanchor%)
  223. scrap_sliding_block(tablemenuanchor%)
  224.  I%=0 
  225.  MaxTabs%
  226. scrap_sliding_block(tabanchor%(I%))
  227.  I%=0 
  228.  MaxKeys%+1
  229. scrap_sliding_block(keyanchor%(I%))
  230.  I%=1 
  231.  fields%
  232.  chartype%(I%)=40 
  233. scrap_sliding_block(Rf%(I%))
  234.  Error handling ------------------------------------------------------
  235. wimp_error(return%,err%,erl%,err$)
  236.  type%,result%
  237. close_down:
  238. ,"L0 error: "+
  239. $+" during error handler at line "+
  240.  "Wimp_CommandWindow",-1
  241. *block%!8=0:block%!12=wi%:block%!16=ic%
  242.  "Interface_SlabButton",,block%
  243. block%!0=err%
  244.  return% 
  245.  err%<>fatal_err% 
  246.  err%=moan_err% 
  247. <      type%=&11:
  248.  OK button and no "Error from" in title
  249. )      type%=3:
  250.  OK and Cancel buttons
  251. A      err$+=" @ "+
  252. (erl%)+" (OK to continue, Cancel to quit)"
  253.    type%=2:
  254.  Cancel buttom
  255. ;   err$+=" @ "+
  256. (erl%)+" (Powerbase must quit at once)"
  257. $(block%+4)=err$+
  258.  "Wimp_ReportError",block%,type%,"Powerbase" 
  259.  ,result%
  260.  result=1 means OK selected, 2 means Cancel selected
  261.  result%=2 
  262. close_down
  263. softerror(E$,E%)
  264. $(block%+4)=
  265. msg(E%)+E$
  266. !block%=255
  267.  "Wimp_ReportError",block%,&11,"Report from Powerbase"
  268. msg(E%)
  269. errorblock%=errormsg%
  270.  E%>1
  271. $  errorblock%+=
  272. ($errorblock%)+1
  273.   E%-=1
  274. $errorblock%,4)
  275.  Program initialisation ----------------------------------------------
  276. setup
  277.  F,A%,I%,J%,V%,valid$
  278. ("<Pbase$Dir>.Resources.Config")
  279. MaxFields%=
  280.  MaxFields%>127 
  281.  fatal_err%,
  282. msg(61)
  283. MaxKeys%=
  284. MaxTabs%=
  285. #F)-1
  286. datesep$=
  287. #F,1)
  288. timesep$=
  289. #F,1)
  290. #F:P%=
  291. S$," "):kill%=
  292. S$,P%-1)="YES")
  293. #F:P%=
  294. S$," "):commoncase%=(
  295. S$,P%-1)="YES")
  296. #F:P%=
  297. S$," "):common%=(
  298. S$,P%-1)="YES")
  299. #F:P%=
  300. S$," "):leftmenu%=(
  301. S$,P%-1)="YES")
  302. #F:P%=
  303. S$," "):
  304. S$,P%-1)="YES" 
  305.  caps%=128 
  306.  caps%=16
  307. winback%=
  308. #F:P%=
  309. S$," "):mergewith$=
  310. S$,P%-1)
  311. #F:P%=
  312. S$," "):blankrec%=(
  313. S$,P%-1)="YES")
  314. close_file(F)
  315. dim_arrays(MaxFields%,MaxKeys%,MaxTabs%)
  316. init_vars
  317.  ------------------ Initialise Wimp ----------------------------
  318. $block%="TASK"
  319. mask%=(1<<11)
  320.  "Wimp_Initialise",200,!block%,"Powerbase" 
  321.  version%,mytask%
  322.  version%>=316 
  323.  RISCOS3=
  324.  RISCOS3=
  325.  "Impulse_Initialise",003,mytask%,"Powerbase",-1
  326.  "Interface_Initialise",mytask%
  327. #Mpbaseicon%=
  328. create_icon(-1,0,-16,144,110,&1700312B,"",dbase%,psprite%,10)
  329.  --------- Set up Heap Manager. Load error messages -----------
  330. initheaps(128,128)
  331.  "OS_File",5,"<PBase$Dir>.Resources.Messages" 
  332.  ,,,,len%
  333. ''errormsg%=
  334. create_fixed_block(len%)
  335.  "OS_File",255,"<PBase$Dir>.Resources.Messages",errormsg%
  336.  I%=0 
  337.  len%
  338.  errormsg%?I%=10 
  339.  errormsg%?I%=13
  340. getscreensize(ScreenWidth%,ScreenHeight%)
  341.  "OS_Byte",135 
  342. ,,mode%
  343.  mode% 
  344.  12,15,16,17,35,36:f$="Sprites"
  345. :f$="Sprites22"
  346.  "OS_File",5,"<PBase$Dir>.Resources."+f$ 
  347.  ,,,,len%
  348. 3(sprites%=
  349. create_fixed_block(len%+4)
  350. !sprites%=len%+4
  351.  "OS_File",255,"<PBase$Dir>.Resources."+f$,sprites%+4
  352. 6&undoanchor%=
  353. create_anchor("Undo")
  354. 7)headanchor%=
  355. create_anchor("Heading")
  356. 8*lineanchor%=
  357. create_anchor("TextLine")
  358. 9&textanchor%=
  359. create_anchor("Text")
  360. :&formanchor%=
  361. create_anchor("Form")
  362. ;.sprsanchor%=
  363. create_anchor("DbaseSprites")
  364. <&tempanchor%=
  365. create_anchor("Temp")
  366. =(balanchor%=
  367. create_anchor("Balance")
  368. >'flaganchor%=
  369. create_anchor("Flags")
  370. ?/transanchor%=
  371. create_anchor("DataTransfer")
  372. @)selanchor%=
  373. create_anchor("PrintSel")
  374. A*recanchor%=
  375. create_anchor("RecordNum")
  376. B,saveanchor%=
  377. create_anchor("SaveBuffer")
  378. C&logoanchor%=
  379. create_anchor("Logo")
  380. D0fieldmenuanchor%=
  381. create_anchor("FieldMenu")
  382. E0tablemenuanchor%=
  383. create_anchor("TableMenu")
  384.  I%=0 
  385.  MaxKeys%+1
  386. G3   keyanchor%(I%)=
  387. create_anchor("Key #"+
  388. (I%))
  389.  I%=0 
  390.  MaxTabs%
  391. J6   tabanchor%(I%)=
  392. create_anchor("VTable #"+
  393. (I%))
  394.  --------------- Read validation strings etc -----------------------
  395. ("<Pbase$Dir>.Resources.ValStrings")
  396. vstrings%=
  397.  vname$(vstrings%),valid%(vstrings%),rvalid%(vstrings%),hvalid%(vstrings%)
  398.  I%=0 
  399.  vstrings%
  400.   vname$(I%)=
  401. #V,4)
  402.   valid$=
  403. (valid$)+1:$V%=valid$:valid%(I%)=V%
  404. (valid$)+1:$V%=valid$:rvalid%(I%)=V%
  405. (valid$)+16:$V%=valid$+";Pptr_hand,12,8":hvalid%(I%)=V%
  406. close_file(V)
  407.  ---------------------------------------------------------------
  408.  Method structure
  409.  PASS=0 
  410. P%=methodtable%
  411.   [OPT PASS
  412.         equd    0
  413. ^)        
  414. method(0,1,"GetPathname","")
  415. _'        
  416. method(0,2,"Selection","")
  417. `(        
  418. method(0,3,"ParseQuery","")
  419. a'        
  420. method(0,4,"GetRecord","")
  421. b'        
  422. method(0,5,"PutRecord","")
  423. c(        
  424. method(0,6,"ExpandCode","")
  425. d&        
  426. method(0,7,"GetField","")
  427. e)        
  428. method(0,8,"GetExpanded","")
  429. f         
  430. method(-1,-1,"","")
  431.  PASS
  432. create_windows
  433. make_menus
  434. set_auto(
  435. set_autobalance(
  436. get_choices("<Pbase$Dir>.Resources.Choices")
  437. method(Flags,Token,Method$,Syntax$)
  438. [OPT PASS
  439.         equd    Flags
  440.         equd    Token
  441. u         equs    Method$+
  442. v         equs    Syntax$+
  443.         align
  444. y    =PASS
  445. dim_arrays(F%,K%,T%)
  446.  desc%(F%),Tag$(F%),field%(F%),F$(F%),Rf%(F%),len%(F%),maxlen%(F%),chartype%(F%),fix%(F%),link$(F%),calc$(F%),Tab%(F%),field$(F%),cfield$(F%),update$(F%)
  447.  Date%(5),Index$(K%+1),KL%(K%+1),KF%(K%+1,1),KW%(K%+1,3),key$(K%+1),case%(K%+1),incspace%(K%+1),WD%(3),Ext%(10)
  448.  Label$(10,2)
  449.  Sum(30,5)
  450.  key 256,date% 6,calcrow% F%
  451.  menu%(22),choice$(4)
  452.  table$(T%+1),tabfieldlen%(9),fcol%(6),ncol%(6)
  453.  rel%(6)
  454.  buttonfield%(22)
  455. MC%=30:
  456.  L%(MC%)
  457.  -------------------- Allocate buffers ------------------------------
  458. (indirectionmem%=&7000:menumem%=&1400
  459.  Mi% 20,Mo% 20
  460.  block% &1000,savebuff% &100,choices% &100
  461.  buff% indirectionmem%:endbuff%=buff%+indirectionmem%
  462.  menblk% menumem%:men_end%=menblk%+menumem%:menu_ptr%=menblk%
  463.  hand% 16:$hand%="Pptr_hand,12,8"
  464.  paint% 8:$paint%="file_ff9"
  465.  writep% 16:$writep%="Pptr_write,4,4"
  466.  tick% 12:$tick%="Snull,yes"
  467.  dbase% 10:$dbase%="No data"
  468.  psprite% 15:$psprite%="S!Powerbase"
  469.  menspr% 15,mentxt% 1:$menspr%="Smenu;Z0":$mentxt%=""
  470.  winspr% 15,wintxt% 1:$winspr%="Swindow;Z0":$wintxt%=""
  471.  methodtable% 256
  472.  ------------- Indirection addresses for Heap Manager ---------------
  473.  keyanchor%(K%+1)
  474.  tabanchor%(T%)
  475.  printrel$(T%)
  476.  box% 16,box2% 16,matrix% 16,origin% 8
  477. init_vars
  478. $getrec%=213:ClientSearch$="TRUE"
  479. >Imp_wait%=
  480. :Impref%=-1:merging%=
  481. :mergenum%=0:document$=""
  482. -mergetag%=214:transtag%=215:printtag%=216
  483. >flash%=
  484. :dup%=
  485. :filter%=
  486. :logosloaded%=
  487. :logging%=
  488. :acl%=
  489. 5accessbutton%=0:stop%=
  490. :customise%=
  491. :tablemenu%=0
  492. &displayed%=-1:scratchpad$="":k$=""
  493. TSearch$="TRUE":Filter$="TRUE":searchformula$="ALL":REC%=-1:usekey%=-1:useval$=""
  494. Sreal$="":visible$="":reform$="":val$="":calcfield%=0:savefunc$="":savetofile%=
  495. 5password$="":pw%=0:myref%=-1:Type%=0:fieldtype%=1
  496. 4printing%=
  497. :indexing%=
  498. :validate%=
  499. :relations%=
  500. ;delwarn%=
  501. :autosave%=
  502. :export%=
  503. :csvconv%=
  504. :saveint%=10
  505. &autobalance%=0:balint%=25:added%=0
  506. .present%=0:fields%=0:template%=0:adjust%=
  507. (Listed%=
  508. :writingcsv%=
  509. :calcerror%=
  510. tlk=0:cl=0:V=0:F=0:FH%=0:dbasehandle%=0:csvhandle%=0:texthandle%=0:text%=0:toobighandle%=0:loghandle%=0:handle%=0
  511. $date%=
  512. "movetype%=8:movetype$="Move 
  513. hquit%=
  514. :exit%=
  515. :matching%=
  516. :newrec%=
  517. :val%=
  518. :ram%=
  519. :Access%=
  520. :Modify%=
  521. :warn%=
  522. :design%=
  523. :newtree%=
  524. /LenLine%=0:Count%=0:Start%=0:End%=0:Fptr%=0
  525. 4Fieldnumber%=0:calclink%=0:Keyfld0%=0:Keyfld1%=0
  526. BLastTable%=-1:Tablenumber%=-1:TabsLoaded$="Tables":table$()=""
  527. 5Rows%=0:TabFields%=0:Rec%=0:Match_tag%=1:fast%=10
  528. ?keylimit%=1:keylen%=1:LH%=90:file%=0:key%=0:top=8*file%+LH%
  529. +keyfunc$="":fieldfunc$="":Keys%=0:RU%=0
  530. 1printorder$="":Form$="":ImpCom$="":margin$=""
  531. uon$=
  532. (27)+
  533. (%10001000)
  534. ,Filename$="":extrakeys$="":extratabs$=""
  535. 2months$="JanFebMarAprMayJunJulAugSepOctNovDec"
  536. pitch$=
  537. (31)+"9001"
  538.  Window handling -----------------------------------------------------
  539. create_windows
  540.  "Wimp_OpenTemplate",,"<Pbase$Dir>.Resources.Templates"
  541. 'infoW%=
  542. new_window("info",sprites%)
  543. text(infoW%,7)=version$
  544. text(infoW%,8)=intversion$
  545. <keypadW%=
  546. new_window("keypad",sprites%):Title%=block%!72
  547. zsavesubW%=
  548. new_window("savesub",sprites%):SubName%=
  549. text(savesubW%,3):SubSprite%=
  550. val(savesubW%,1):SubTitle%=block%!72
  551. UsaveW%=
  552. new_window("save",1):SaveName%=
  553. text(saveW%,0):SaveSprite%=
  554. val(saveW%,1)
  555. AdatadicW%=
  556. new_window("datadic",sprites%):TabTitle%=block%!72
  557. xaccessW%=
  558. new_window("access",sprites%):UserID%=
  559. text(accessW%,0):Password%=
  560. text(accessW%,1):AccessTitle%=block%!72
  561. qpassW%=
  562. new_window("password",sprites%):Read%=
  563. text(passW%,2):Write%=
  564. text(passW%,3):Manager%=
  565. text(passW%,5)
  566. (aclW%=
  567. new_window("aclist",sprites%)
  568. :mainW%=
  569. new_window("main",sprites%):RecInfo%=block%!72
  570. ?keyW%=
  571. new_window("changekey",sprites%):KeyTitle%=block%!72
  572. 1F1dkey%=
  573. text(keyW%,0):F2dkey%=
  574. text(keyW%,1)
  575.  Wkey%(3)
  576.  word%=0 
  577. '  Wkey%(word%)=
  578. text(keyW%,word%+2)
  579.  word%
  580. /Lkey%=
  581. text(keyW%,26):KeyNo%=
  582. text(keyW%,6)
  583. BchangeW%=
  584. new_window("change",sprites%):ChangeTitle%=block%!72
  585. 'moveW%=
  586. new_window("move",sprites%)
  587. )tableW%=
  588. new_window("table",sprites%)
  589. linkW%=
  590. new_window("link",sprites%):LinkTitle%=block%!72:Tablename%=
  591. text(linkW%,0):fieldnum%=
  592. text(linkW%,2):expand%=
  593. text(linkW%,10)
  594. VmiscW%=
  595. new_window("misc",sprites%):database%=
  596. text(miscW%,1):$database%="No data"
  597.  ic%=2 
  598. $  Date%(ic%-2)=
  599. text(miscW%,ic%)
  600. Oused%=
  601. text(miscW%,17):filesize%=
  602. text(miscW%,18):percent%=
  603. text(miscW%,14)
  604. )printW%=
  605. new_window("print",sprites%)
  606. )matchW%=
  607. new_window("match",sprites%)
  608. 'listW%=
  609. new_window("list",sprites%)
  610. XcreateW%=
  611. new_window("create",sprites%):FtitleText%=block%!72:$FtitleText%="Field 0"
  612. DescText%=
  613. text(createW%,4):TagText%=
  614. text(createW%,5):LenText%=
  615. text(createW%,6):ValText%=
  616. text(createW%,28):InsText%=
  617. text(createW%,26):Fixpt%=
  618. text(createW%,13):$Fixpt%="2"
  619. ;mintext%=
  620. text(createW%,15):maxtext%=
  621. text(createW%,25)
  622. dboxX%=
  623. text(createW%,7):boxY%=
  624. text(createW%,8):boxW%=
  625. text(createW%,9):boxH%=
  626. text(createW%,10)
  627. ArelateW%=
  628. new_window("relation",sprites%):RelTitle%=block%!72
  629. @reformW%=
  630. new_window("reform",sprites%):RefmTitle%=block%!72
  631. &colW%=
  632. new_window("cols",sprites%)
  633. VcalcW%=
  634. new_window("calc",sprites%):CalcForm%=
  635. text(calcW%,0):CalcTitle%=block%!72
  636. )labelW%=
  637. new_window("label",sprites%)
  638. -pselectW%=
  639. new_window("pselect",sprites%)
  640. _mergeW%=
  641. new_window("merge",sprites%):ImpulseApp%=
  642. text(mergeW%,16):$ImpulseApp%=mergewith$
  643. PsizeW%=
  644. new_window("size",sprites%):Records%=
  645. text(sizeW%,1):$Records%="100"
  646. .Increment%=
  647. text(sizeW%,3):$Increment%="0"
  648. =csvW%=
  649. new_window("csvfile",sprites%):CSVTitle%=block%!72
  650.  "Wimp_CloseTemplate"
  651.  common% 
  652. commonbuffers
  653. commonbuffers
  654. common(keypadW%,29,matchW%,0)
  655. common(moveW%,7,matchW%,0)
  656. common(changeW%,3,matchW%,0)
  657. common(savesubW%,0,matchW%,0)
  658. common(mergeW%,3,matchW%,0)
  659. common(wi%,ic%,wic%,icc%)
  660. Formula%=
  661. text(wic%,icc%)
  662. ;!block%=wi%:block%!4=ic%:
  663.  "Wimp_GetIconState",,block%
  664.  "Wimp_DeleteIcon",,block%
  665. #block%!28=Formula%:block%!4=wi%
  666.  "Wimp_CreateIcon",,block%+4 
  667.  handle%
  668. commoncase(wi%,ic%)
  669.  commoncase% 
  670. selected(wi%,ic%)
  671. set_icon(matchW%,16,on%)
  672. set_icon(keypadW%,32,on%)
  673. set_icon(moveW%,9,on%)
  674. set_icon(changeW%,5,on%)
  675. set_icon(savesubW%,5,on%)
  676. set_icon(mergeW%,12,on%)
  677. new_window(name$,sp%)
  678.  handle%
  679.  "Wimp_LoadTemplate",,block%,buff%,endbuff%,-1,name$,0 
  680.  ,,buff%
  681.  name$="main" 
  682.  block%?35=winback%
  683. block%!64=sp%
  684.  "Wimp_CreateWindow",,block% 
  685.  handle%
  686. =handle%
  687. show_windows
  688. open_window(mainW%)
  689.  (present% 
  690.  7)=7 
  691. selected(passW%,9) 
  692. 9    !block%=keypadW%:
  693.  "Wimp_GetWindowState",,block%
  694. 5    block%!12=block%!4+660:block%!8=block%!16-328
  695. ,    block%!20=0:block%!24=0:block%!28=-1
  696. $    
  697.  "Wimp_OpenWindow",,block%
  698.   addr=
  699. moveto(key%,top,1)
  700.  Listed% 
  701. open_window(listW%)
  702. show_keypad
  703. selected(passW%,9) 
  704. $7  !block%=keypadW%:
  705.  "Wimp_GetWindowState",,block%
  706.   block%!28=-1
  707.  "Wimp_OpenWindow",,block%
  708. open_window(whandle%)
  709. block%!0=whandle%
  710.  "Wimp_GetWindowState",,block%
  711. block%!28=-1
  712.  "Wimp_OpenWindow",,block%
  713. set_height(handle%,height%)
  714. 24!block%=handle%:
  715.  "Wimp_GetWindowState",,block%
  716. block%!16=block%!8+height%
  717.  "Wimp_OpenWindow",,block%
  718. perform_close(wi%)
  719.  wi% 
  720.  mainW%:
  721. close_window(keypadW%)
  722.  matchW%:matching%=
  723.  calcW%:calclink%=0
  724.  keyW%:
  725.   design%=
  726. :newtree%=
  727.   !block%=0:block%!4=-700
  728.   block%!8=506:block%!12=0
  729.  "Wimp_SetExtent",keyW%,block%
  730.   !block%=keyW%
  731.  mergeW%:
  732.  "Impulse_SendMessage",&200,":"+mergewith$+"."+document$+" Edit On",,,,-1,mytask%
  733.   merging%=
  734. close_window(wi%)
  735. hide_windows
  736. perform_close(mainW%)
  737. perform_close(keypadW%)
  738. perform_close(datadicW%)
  739. perform_close(listW%)
  740. perform_close(matchW%)
  741. perform_close(relateW%)
  742. perform_close(keyW%)
  743. perform_close(reformW%)
  744. perform_close(calcW%)
  745. perform_close(mergeW%)
  746. perform_close(csvW%)
  747. perform_close(passW%)
  748. close_window(whandle%)
  749. !block%=whandle%
  750.  "Wimp_CloseWindow",,block%
  751. redraw(handle%)
  752. (margin$)
  753. !block%=handle%
  754.  "Wimp_RedrawWindow",,block% 
  755.  more%
  756. get_origin(block%,x0%,y0%)
  757.  more%
  758. draw(x0%,y0%)
  759.  handle%<>datadicW% 
  760.  "Interface_Render3dWindow",,block%
  761.  "Wimp_GetRectangle",,block% 
  762.  more%
  763. get_origin(block%,
  764.  x0%,
  765.  y0%)
  766. x0%=block%!4-block%!20
  767. y0%=block%!16-block%!24
  768. draw(x0%,y0%)
  769.  TextPtr%,y1%,y2%,I%,chars%
  770.  handle% 
  771.  listW%
  772.   y1%=-(block%!40-y0%)
  773.   y2%=-(block%!32-y0%)
  774.   y1%=y1% 
  775.  32+1
  776.   y2%=y2% 
  777.  32+1
  778. w.  TextPtr%=(!textanchor%)+(y1%-1)*LenLine%
  779.  y2%>Count% 
  780.  y2%=Count%
  781.  I%=y1% 
  782. draw_line(I%)
  783.     TextPtr%+=LenLine%
  784. draw_line(Line%)
  785.  x0%,y0%-(Line%-1)*32-4
  786.  TextPtr%?L%=12 
  787.  "OS_WriteN",TextPtr%,LenLine%
  788.  Menu handling -------------------------------------------------------
  789. make_menus
  790. menu%(10)=
  791. create_menu(menu_ptr%,260,"Field,Index field...,Analyse months,Global changes>"+
  792. (changeW%)+",Link to table...,Combine fields>"+
  793. (calcW%)+",Start editing,Clear contents,Warn of delete,Save contents>"+
  794. (saveW%)+",Undo changes")
  795. Omenic%=menu%(10)+28+(1*24):AnalyseFunc%=menic%!12:menic%!16=-1:menic%!20=14
  796. Lmenic%=menu%(10)+28+(4*24):CalcFunc%=menic%!12:menic%!16=-1:menic%!20=14
  797. ?menu%(13)=
  798. create_menu(menu_ptr%,120,"Interval:,"+
  799. 13,"0"))
  800. menic%=menu%(13)+28
  801. >Interval%=menic%!12:menic%!16=buff%:$buff%="A0-9":buff%+=5
  802. 0?menic%=?menic% 
  803.  (1<<2):$Interval%="10 min"
  804. smenu%(12)=
  805. create_menu(menu_ptr%,160,"Save indices,Automatic>"+
  806. (menu%(13))+",Warning>"+
  807. (menu%(13))+",Manual")
  808. menu%(2)=
  809. create_menu(menu_ptr%,265,"Validation,Create table...,~Display table,Show table files,Validate input,Show relations")
  810. tick(menu%(2),3,
  811. tick(menu%(10),7,
  812. menu%(7)=
  813. create_menu(menu_ptr%,260,"Misc.,Batch delete!"+
  814. (moveW%)+",Set passwords...,Colours!"+
  815. (colW%)+",Save indices>"+
  816. (menu%(12))+",Edit template")
  817. Nmenu%(15)=
  818. create_menu(menu_ptr%,90,"Separator,Comma,TAB,CR,LF,"+
  819. 13,"0"))
  820. menic%=menu%(15)+28+(4*24)
  821. -Delim%=menic%!12:menic%!16=-1:menic%!20=3
  822. '?menic%=?menic% 
  823.  (1<<2):$Delim%=""
  824. ]menu%(20)=
  825. create_menu(menu_ptr%,90,"Terminator,CR,LF,LF CR,CR LF,CR CR,LF LF,"+
  826. 13,"0"))
  827. menic%=menu%(20)+28+(6*24)
  828. .Termin%=menic%!12:menic%!16=-1:menic%!20=3
  829. (?menic%=?menic% 
  830.  (1<<2):$Termin%=""
  831. string$="Print,Match,Show resources,Show jobs done,Options...,Save options!"+
  832. (saveW%)+",Save query!"+
  833. (saveW%)+",~Numeric fields>"+
  834. (pselectW%)+",~Save selection!"+
  835. (saveW%)+",~Clear selection"
  836. >menu%(6)=
  837. create_menu(menu_ptr%,260,string$+",Select all")
  838. zstring$="Powerbase,Information!"+
  839. (miscW%)+",Field: ''>"+
  840. (menu%(10))+",Print>"+
  841. (menu%(6))+",Validation>"+
  842. (menu%(2))
  843. string2$=",Current key...,Miscellaneous>"+
  844. (menu%(7))+",Show keypad,Export subset!"+
  845. (savesubW%)+",Export CSV!"+
  846. (savesubW%)+",CSV options...,Save choices,Undo changes,Help"
  847. 9menu%(1)=
  848. create_menu(menu_ptr%,236,string$+string2$)
  849. #Fieldpos%=menu%(1)+28+(1*24)+12
  850. Jmenu%(4)=
  851. create_menu(menu_ptr%,200,"Print tree,Totals only,Complete")
  852. <menu%(22)=
  853. create_menu(menu_ptr%,120,"Every:,"+
  854. 13,"0"))
  855. menic%=menu%(22)+28
  856. ;Every%=menic%!12:menic%!16=buff%:$buff%="A0-9":buff%+=5
  857. .?menic%=?menic% 
  858.  (1<<2):$Every%="25 recs"
  859. Umenu%(21)=
  860. create_menu(menu_ptr%,160,"Balance,Right now,Automatic>"+
  861. (menu%(22)))
  862. menu%(3)=
  863. create_menu(menu_ptr%,300,"Utilities,New primary key...,Adjust format,New record format,Merge database,~Change length>"+
  864. (sizeW%)+",Balance index>"+
  865. (menu%(21))+",Print index>"+
  866. (menu%(4))+",Find duplicates,Warn of duplicates")
  867. menu%(0)=
  868. create_menu(menu_ptr%,266,"\Powerbase,Information>"+
  869. (infoW%)+",New database!"+
  870. (saveW%)+",~Utilities>"+
  871. (menu%(3))+",~Close database,~Abandon database,Save choices,Default choices,Help,Quit")
  872. menu%(9)=
  873. create_menu(menu_ptr%,270,"New database,Design field...,~_Default database,~Save form file!"+
  874. (saveW%)+",~Database size>"+
  875. (sizeW%)+",~Primary key...,~Quit design")
  876. jmenu%(17)=
  877. create_menu(menu_ptr%,200,"Table,Clear,Save!"+
  878. (saveW%)+",Print,Sort,Undo change,Undo all")
  879. Vmenu%(18)=
  880. create_menu(menu_ptr%,250,"List,Save as text!"+
  881. (saveW%)+",Sort,Scrap")
  882. menu$="Data"
  883.  I%=0 
  884.   menu$+=","+vname$(I%)
  885. Bmenu%(8)=
  886. create_menu(menu_ptr%,200,menu$):
  887. tick(menu%(8),1,
  888. menu$="External"
  889.  I%=36 
  890.   menu$+=","+vname$(I%)
  891. Dmenu%(11)=
  892. create_menu(menu_ptr%,180,menu$):
  893. tick(menu%(11),0,
  894. menu$="Check box"
  895.  I%=41 
  896.   menu$+=","+vname$(I%)
  897. Dmenu%(14)=
  898. create_menu(menu_ptr%,180,menu$):
  899. tick(menu%(14),0,
  900. menu$="Stamp"
  901.  I%=46 
  902.   menu$+=","+vname$(I%)
  903. Dmenu%(16)=
  904. create_menu(menu_ptr%,250,menu$):
  905. tick(menu%(16),0,
  906. menu$="Button"
  907.  I%=9 
  908.   menu$+=","+vname$(I%)
  909. Dmenu%(19)=
  910. create_menu(menu_ptr%,270,menu$):
  911. tick(menu%(19),0,
  912. ybar%=96+9*44
  913. field_menu(N%)
  914.  F%,P%,L%,D$,F$,icptr%,textptr%
  915. extend_named_sliding_block(fieldmenuanchor%,N%*41+30)
  916. 5icptr%=!fieldmenuanchor%:textptr%=icptr%+N%*24+28
  917. $icptr%="Field list"
  918. Zicptr%?12=7:icptr%?13=2:icptr%?14=7:icptr%?15=0:icptr%!16=270:icptr%!20=44:icptr%!24=0
  919. icptr%+=28
  920.  F%=1 
  921. "  F$=
  922. (F%):F$=
  923. (F$)," ")+F$
  924. 7  D$=
  925. text(mainW%,desc%(F%)),7):D$+=
  926. (D$)," ")
  927. &  F$+=" "+D$+" "+Tag$(F%):L%=
  928. \  !icptr%=0:icptr%!4=-1:icptr%!8=&7000121:icptr%!12=textptr%:icptr%!16=-1:icptr%!20=L%+1
  929. !  $textptr%=F$:textptr%+=L%+1
  930.   icptr%+=24
  931. icptr%!-24=icptr%!-24 
  932. =!fieldmenuanchor%
  933. create_menu(
  934.  menu%,width%,list$)
  935.  start%,choice$,entries%,item%,P%,Q%,S%,shaded%
  936. start%=menu%
  937. list$,1)="\" 
  938.  (RISCOS3=
  939.  leftmenu%=
  940.  list$=
  941. list$,2)
  942. list$,",")
  943. $menu%=
  944. list$,P%-1)
  945. menu%?12=7:menu%?13=2
  946. menu%?14=7:menu%?15=0
  947. *menu%!16=width%:menu%!20=44:menu%!24=0
  948. item%=menu%+28
  949. list$+=","
  950. entries%=0
  951.   Q%=P%+1
  952.   P%=
  953. list$,",",Q%)
  954.  P%>0 
  955.     !item%=0:shaded%=0
  956.      choice$=
  957. list$,Q%,P%-Q%)
  958. ?    
  959. choice$,1)="~" 
  960.  choice$=
  961. choice$,2):shaded%=(1<<22)
  962. A    
  963. choice$,1)="_" 
  964.  choice$=
  965. choice$,2):?item%=?item% 
  966.     S%=
  967. choice$,"!")
  968. 5    
  969.  S%>0 
  970.  ?item%=?item% 
  971. choice$,S%,1)=">"
  972.     S%=
  973. choice$,">")
  974.  S%=0 
  975.       item%!4=-1
  976.       
  977. #      item%!4=
  978. choice$,S%+1))
  979.        choice$=
  980. choice$,S%-1)
  981.         
  982. (choice$)<=12 
  983.       $(item%+12)=choice$
  984.       item%!8=&7000021
  985.       
  986.       L%=
  987. (choice$)+1
  988. I      item%!12=buff%:$buff%=choice$:buff%+=L%:item%!16=-1:item%!20=L%
  989.       item%!8=&7000121
  990.         
  991. !    item%!8=item%!8 
  992.  shaded%
  993.     item%+=24
  994.     entries%+=1
  995.  P%=0
  996. item%!-24=item%!-24 
  997. menu%=item%
  998.  menu%>men_end% 
  999.  0,"Not enough room for menus (internal error code 50)"
  1000. =start%
  1001. tick(menu%,item%,on%)
  1002. item%=menu%+28+item%*24
  1003.  on% 
  1004. :?item%=?item% 
  1005. :?item%=?item% 
  1006. tick_one(menu%,first%,last%,item%)
  1007.  I%=first% 
  1008.  last%
  1009. tick(menu%,I%,(I%=item%))
  1010. ticked(menu%,item%)
  1011. item%=menu%+28+item%*24
  1012.  (?item% 
  1013. lit(menu%,item%,on%)
  1014. item%=menu%+28+item%*24
  1015.  on% 
  1016. : item%!8=item%!8 
  1017.  (1<<22)
  1018. : item%!8=item%!8 
  1019.  (1<<22)
  1020. show_menu(menu%,x%,y%)
  1021. ()menuhandle%=menu%:menux%=x%:menuy%=y%
  1022.  "Wimp_CreateMenu",,menu%,x%,y%
  1023.  Icon handling -------------------------------------------------------
  1024. create_icon(whandle%,xmin%,ymin%,width%,height%,iconflags%,text$,d1%,d2%,d3%)
  1025.  handle%
  1026. block%!0=whandle%
  1027. 1!block%!4=xmin%:block%!8=ymin%
  1028. 22block%!12=xmin%+width%:block%!16=ymin%+height%
  1029. block%!20=iconflags%
  1030.  d1%=0 
  1031.   $(block%+24)=text$
  1032.   block%!24=d1%
  1033.   block%!28=d2%
  1034.   block%!32=d3%
  1035.  "Wimp_CreateIcon",,block% 
  1036.  handle%
  1037. =handle%
  1038. redraw_icon(wi%,ic%)
  1039. !block%=wi%:block%!4=ic%
  1040. block%!8=0:block%!12=0
  1041.  "Wimp_SetIconState",,block%
  1042. B*block%!8=0:block%!12=wi%:block%!16=ic%
  1043. icon_bit(bit%,wi%,ic%,on%)
  1044. !block%=wi%
  1045. block%!4=ic%
  1046.  on% 
  1047. :block%!8=0:block%!12=1<<bit%
  1048. :block%!8=1<<bit%:block%!12=1<<bit%
  1049.  "Wimp_SetIconState",,block%
  1050. select(wi%,ic%)
  1051. !block%=wi%:block%!4=ic%
  1052. Q"block%!8=1<<21:block%!12=1<<21
  1053.  "Wimp_SetIconState",,block%
  1054. deselect(wi%,ic%)
  1055. !block%=wi%:block%!4=ic%
  1056. W block%!8=0:block%!12=(1<<21)
  1057.  "Wimp_SetIconState",,block%
  1058. invert(wi%,ic%)
  1059. selected(wi%,ic%) 
  1060. deselect(wi%,ic%) 
  1061. select(wi%,ic%)
  1062. set_icon(wi%,ic%,on%)
  1063.  on% 
  1064. select(wi%,ic%) 
  1065. deselect(wi%,ic%)
  1066. selected(wi%,ic%)
  1067. !block%=wi%:block%!4=ic%
  1068.  "Wimp_GetIconState",,block%
  1069. =((block%!24) 
  1070.  (1<<21))>0
  1071. shaded(wi%,ic%)
  1072. !block%=wi%:block%!4=ic%
  1073.  "Wimp_GetIconState",,block%
  1074. =((block%!24) 
  1075.  (1<<22))>0
  1076. selected_esg(wi%,esg%)
  1077.  "Wimp_WhichIcon",wi%,block%,&003F0000,&00200000+(esg%<<16)
  1078. =!block%
  1079. next_writeable(wi%,ic%,d%,r%)
  1080.  P%,E%,next%
  1081.  "Wimp_WhichIcon",wi%,block%,&00C0E000,(14<<12)
  1082.   E%+=4
  1083.  block%!E%=-1
  1084.  block%!P%<>ic% 
  1085.  P%<E%
  1086.   P%+=4
  1087.  P%=E% 
  1088.  P%-=4
  1089.  r%=1 
  1090.  P%+4=E% 
  1091.  0:P%=E%
  1092.  2:P%=-4
  1093. :P%+=4*d%
  1094.  E%:next%=!block%
  1095.  -4:next%=block%!(E%-4)
  1096. :next%=block%!P%
  1097. set_caret(wi%,next%)
  1098. text(wi%,ic%)
  1099. !block%=wi%:block%!4=ic%
  1100.  "Wimp_GetIconState",,block%
  1101. =block%!28
  1102. val(wi%,ic%)
  1103. !block%=wi%:block%!4=ic%
  1104.  "Wimp_GetIconState",,block%
  1105. =block%!32
  1106. text_length(wi%,ic%)
  1107. !block%=wi%:block%!4=ic%
  1108.  "Wimp_GetIconState",,block%
  1109. ($(block%!28))
  1110. set_caret(handle%,ic%)
  1111.  ic%=-1 
  1112.  "Wimp_SetCaretPosition",handle%,ic%
  1113.  "Wimp_SetCaretPosition",handle%,ic%,0,0,-1,
  1114. text_length(handle%,ic%)
  1115. alter_flags(dfg%,ffg%,bfg%)
  1116.  ic%,F%
  1117. !block%=mainW%
  1118.  ic%=0 
  1119.  fields%*2-1
  1120.   F%=(ic%+1) 
  1121. 1  block%!4=ic%:
  1122.  "Wimp_GetIconState",,block%
  1123.  (ic% 
  1124.  2)=1 
  1125.  chartype%(F%) 
  1126. U      
  1127.  0,1,2,3,4,5,6,7,8,40,46,47,48,49,50,51,52,53,54,55,56,57,58:block%!8=ffg%
  1128. '      
  1129.  39:block%!8=ffg%:len%(F%)=0
  1130. B      
  1131.  logosloaded% 
  1132.  block%!8=&0000611E 
  1133.  block%!8=ffg%
  1134.       
  1135. :block%!8=bfg%
  1136.         
  1137.  block%!8=dfg%
  1138.   block%!12=&FFFFFFFF
  1139.  "Wimp_SetIconState",,block%
  1140. limit_actions(off%)
  1141. icon_bit(22,keypadW%,ic%,off%)
  1142.  buttonfield%(ic%)>0 
  1143. icon_bit(22,mainW%,field%(buttonfield%(ic%)),off%)
  1144.  ic%=-1
  1145. lit(menu%(10),0,off%)
  1146. lit(menu%(10),1,off%)
  1147. lit(menu%(10),2,off%)
  1148.  12,14,15,16,17,18,20,21,22,-1
  1149. identify_field(ic%)
  1150. .Fieldnumber%=0:Fieldname$="":TextLength%=0
  1151.  (ic% 
  1152.  2)=1 
  1153. !  !block%=mainW%:block%!4=ic%
  1154.  "Wimp_GetIconState",,block%
  1155.   TextLength%=block%!36-1
  1156.   Fieldnumber%=(ic%+1) 
  1157. 3  Fieldname$=$
  1158. text(mainW%,desc%(Fieldnumber%))
  1159.  Fieldname$="" 
  1160.  Fieldname$=Tag$(Fieldnumber%)
  1161.  validate% 
  1162. $    
  1163.  chartype%(Fieldnumber%) 
  1164. /      
  1165.  Leave keyboard status unchanged
  1166. &      
  1167.  2,4:
  1168.  "OS_Byte",202,0,239
  1169. #      
  1170.  "OS_Byte",202,16,111
  1171.         
  1172.  "OS_Byte",118
  1173. first_field
  1174.  I%+=1
  1175.  (len%(I%)>0 
  1176.  chartype%(I%)<6) 
  1177.  I%>fields%
  1178.  I%>fields% 
  1179.  Mouse_click processing ----------------------------------------------
  1180. mouse(x%,y%,b%,wi%,ic%)
  1181. oldx%=x%:oldy%=y%
  1182. Cblock%!0=x%:block%!4=y%:block%!8=b%:block%!12=wi%:block%!16=ic%
  1183.  (b% 
  1184.  2)<>2 
  1185.  (design% 
  1186.  (wi%=mainW%)) 
  1187.  "Interface_SlabButton",,block%
  1188.  wi% 
  1189. iconbar_click
  1190.  accessW%:accessbutton%=ic%
  1191.  aclW%:
  1192.  mainW%:
  1193. main_click
  1194.  keypadW%:
  1195. keypad_click(wi%,ic%,b%)
  1196.  saveW%,savesubW%:
  1197. save_click(wi%,ic%,b%)
  1198.  keyW%:
  1199. key_click
  1200.  tableW%:
  1201. create_table
  1202.  linkW%:
  1203. link_to_table
  1204.  passW%:
  1205. passwords
  1206.  printW%:
  1207. print_click
  1208.  matchW%:
  1209. match_click(b%,wi%,ic%)
  1210.  createW%:
  1211. create_click
  1212.  datadicW%:
  1213. datadic_click
  1214.  changeW%:
  1215. change_click
  1216.  moveW%:
  1217. move_click
  1218.  listW%:
  1219. list_click(x%,y%,b%,wi%)
  1220.  colW%:
  1221. set_colours
  1222.  calcW%:
  1223.  ic%=1 
  1224. calc_formula($CalcForm%)
  1225.  labelW%:
  1226.  ic% 
  1227. ;    
  1228. icon_bit(22,labelW%,12,
  1229. selected(labelW%,11))
  1230. %    
  1231.  "Wimp_CreateMenu",,-1
  1232.  mergeW%:
  1233. merge_click
  1234.  sizeW%:
  1235. size_click
  1236.  csvW%:
  1237. csv_click
  1238.  pselectW%,relateW%,reformW%,infoW%,miscW%:
  1239.  ### No action on these ###
  1240. special_click
  1241. *block%!8=0:block%!12=wi%:block%!16=ic%
  1242.  "Interface_SlabButton",,block%
  1243. change_click
  1244.  (b% 
  1245.  %111)=4 
  1246.  ic% 
  1247. changes(key%)
  1248.      
  1249. commoncase(wi%,ic%)
  1250. move_click
  1251.  (b% 
  1252.  %111)=4 
  1253.  ic% 
  1254. clear
  1255.      
  1256. commoncase(wi%,ic%)
  1257. csv_click
  1258.  (b% 
  1259.  %111) 
  1260.  2,4:
  1261.  ic% 
  1262. 0    
  1263. show_menu(menu%(15),oldx%+32,oldy%)
  1264. 0    
  1265. show_menu(menu%(20),oldx%+32,oldy%)
  1266.  (b% 
  1267.  %111) 
  1268.  ic% 
  1269. %6    
  1270. icon_bit(22,csvW%,4,(
  1271. selected(csvW%,1)))
  1272. &*    
  1273. convert_csv($
  1274. text(csvW%,13))
  1275. '!    
  1276. close_window(csvW%)
  1277. merge_click
  1278.  (b% 
  1279.  %111)=4 
  1280.  z%=1 
  1281.  z%=-1
  1282.  ic% 
  1283.  4:ClientPtr%=
  1284. merge_next(ClientPtr%,z%)
  1285.  9:ClientPtr%=
  1286. merge_next(ClientPtr%,-z%)
  1287.  11:ClientPtr%=
  1288. merge_next(top,z%)
  1289.  10:ClientPtr%=
  1290. merge_next(top,-z%)
  1291. commoncase(wi%,ic%)
  1292.  "Impulse_SendMessage",&201,":"+mergewith$+"."+document$+" Print",,,,printtag%,mytask%
  1293.   mergewith$=$ImpulseApp%
  1294.  "Impulse_SendMessage",&200,":"+mergewith$+"."+document$+" Edit Off",,,,-1,mytask%
  1295.   mergenum%=0
  1296. :C  ClientSearch$=
  1297. parse($
  1298. text(mergeW%,3),
  1299. selected(mergeW%,12))
  1300. ;#  ClientPtr%=
  1301. merge_next(top,1)
  1302. perform_close(mergeW%)
  1303. size_click
  1304. ($Records%)<=0:
  1305. softerror("",71)
  1306. D,  $Records%="100":
  1307. redraw_icon(sizeW%,1)
  1308. ($Increment%)<0
  1309. softerror("",72)
  1310. G-  $Increment%="25":
  1311. redraw_icon(sizeW%,3)
  1312.  present%=7 
  1313. change_length(
  1314. ($Records%),
  1315.  "Wimp_CreateMenu",,-1
  1316. datadic_click
  1317.  ic%>=0 
  1318.  tablefield%=(ic% 
  1319.  (TabFields%+1)) 
  1320.  tablefield%=0
  1321.  %111 
  1322. R8  !block%=datadicW%:
  1323.  "Wimp_GetWindowState",,block%
  1324.  "Wimp_SetCaretPosition",datadicW%,ic%,x%-block%!4+block%!20,y%,-1,-1
  1325. show_menu(menu%(17),x%-64,y%-20)
  1326. invert(wi%,tablefield%)
  1327.   field$=
  1328. (tablefield%)
  1329. selected(wi%,tablefield%) 
  1330. Y'    printrel$(Tablenumber%)+=field$
  1331. Z        
  1332. [+    P%=
  1333. printrel$(Tablenumber%),field$)
  1334. \]    printrel$(Tablenumber%)=
  1335. printrel$(Tablenumber%),P%-1)+
  1336. printrel$(Tablenumber%),P%+1)
  1337. list_click(x%,y%,b%,wi%)
  1338.  (b% 
  1339.  %111) 
  1340.  2:mousex%=x%:
  1341. show_menu(menu%(18),x%-64,y%-20)
  1342.   !block%=wi%
  1343.  "Wimp_GetWindowState",,block%
  1344. h,  line%=(block%!16-block%!24-y%+32) 
  1345. i*  column%=(x%-block%!4+block%!20) 
  1346.   RecPtr%=!recanchor%
  1347.   R%=RecPtr%!(line%*4)
  1348.   E%=
  1349. (Form$) 
  1350.  R%>=0 
  1351. n&    addr=
  1352. find("#"+
  1353. (R%),key%,1,
  1354.  format$ 
  1355.       
  1356.  "horiz","table"
  1357.       
  1358.         N%+=1
  1359. s&      
  1360.  Tab%(N%)>column%+1 
  1361.  N%=E%
  1362. t$      F%=
  1363. fnum(
  1364. Form$,N%*2-1,2))
  1365.       
  1366.  "vert":
  1367.       
  1368.         N%+=1:line%-=1
  1369. x)      
  1370.  RecPtr%!(line%*4)<>R% 
  1371.  N%=E%
  1372. y$      F%=
  1373. fnum(
  1374. Form$,N%*2-1,2))
  1375. z"      
  1376.  "tree":F%=KF%(tkey%,0)
  1377.       
  1378.  "dup":F%=KF%(0,0)
  1379. |        
  1380. };    
  1381.  chartype%(F%)<=10 
  1382. set_caret(mainW%,field%(F%))
  1383.     Fieldnumber%=F%
  1384. match_click(b%,wi%,ic%)
  1385.  not%,and%,or%
  1386.  b%=2 
  1387. show_menu(menu%(1),x%-64,y%-20):
  1388. selected_esg(printW%,4) 
  1389.  38:reportdest$="Window"
  1390.  39:reportdest$="File"
  1391.  41:reportdest$="Printer"
  1392.  ic% 
  1393. commoncase(wi%,ic%)
  1394. selected(wi%,27) 
  1395. text(wi%,25)="Number found" 
  1396. text(wi%,25)="Time taken"
  1397. redraw_icon(wi%,25)
  1398. M  searchformula$=$
  1399. text(wi%,0):
  1400.  searchformula$="" 
  1401.  searchformula$="ALL"
  1402. D  Search$=
  1403. parse(searchformula$,
  1404. selected(wi%,16)):displayed%=-1
  1405.  Search$<>"FALSE" 
  1406.     $
  1407. text(wi%,14)=""
  1408. redraw_icon(wi%,14)
  1409. ?    $SaveName%=$database%+".PrintJobs."+
  1410. searchformula$,10)
  1411.  reportdest$ 
  1412.       
  1413.  "Window","Printer":
  1414. $      
  1415. do_it(Search$,displayed%)
  1416.       
  1417.  "File":
  1418.       savefunc$="Save list"
  1419. 4      $SaveSprite%="sfile_fff;Pptr_hand,12,8;B3"
  1420. 6      !block%=wi%:
  1421.  "Wimp_GetWindowState",,block%
  1422. ,      xmin%=block%!4+200:ymax%=block%!16
  1423. 9      !block%=saveW%:
  1424.  "Wimp_GetWindowState",,block%
  1425. ;      block%!12=xmin%+block%!12-block%!4:block%!4=xmin%
  1426. ;      block%!8=ymax%-block%!16+block%!8:block%!16=ymax%
  1427. 3      block%!28=-1:
  1428.  "Wimp_OpenWindow",,block%
  1429.       
  1430. set_caret(saveW%,0)
  1431.         
  1432.  (b% 
  1433.  %111)=4 
  1434. selected(wi%,27) 
  1435. close_window(wi%):
  1436. set_caret(mainW%,-1)
  1437.  21,22:
  1438.  (b% 
  1439.  %111)=4 
  1440.  z%=1 
  1441.  (b% 
  1442.  %111)=1 
  1443.  z%=-1
  1444.  ic%=21 
  1445.  Match_tag%+=z% 
  1446.  Match_tag%-=z%
  1447.  Match_tag%>fields% 
  1448.  Match_tag%=1
  1449.  Match_tag%<1 
  1450.  Match_tag%=fields%
  1451. text(wi%,3)=Tag$(Match_tag%)
  1452. redraw_icon(wi%,3)
  1453. tick_one(fieldmenu%,0,fields%-1,Match_tag%-1)
  1454. show_menu(fieldmenu%,oldx%+32,oldy%)
  1455.   op%=
  1456. selected_esg(wi%,1)
  1457.  op% 
  1458.  5:op$="="
  1459.  6:op$="{"
  1460.  7:op$="<"
  1461.  8:op$=">"
  1462.  15:op$="<>"
  1463.  18:op$=">="
  1464.  19:op$="<="
  1465.  20:op$="}{"
  1466. ,  not%=
  1467. selected(wi%,4):
  1468. deselect(wi%,4)
  1469. .  and%=
  1470. selected(wi%,12):
  1471. deselect(wi%,12)
  1472. -  or%=
  1473. selected(wi%,13):
  1474. deselect(wi%,13)
  1475.   tag$=$
  1476. text(wi%,3)
  1477.   contents$=$
  1478. text(wi%,9)
  1479.   new$=tag$+op$+contents$
  1480.  not% 
  1481.  new$="NOT ("+new$+")"
  1482.  and% 
  1483.  new$+=" AND "
  1484.  or% 
  1485.  new$+=" OR "
  1486. text(wi%,0)=$
  1487. text(wi%,0)+new$:
  1488. redraw_icon(wi%,0)
  1489. text(wi%,9)="":
  1490. redraw_icon(wi%,9)
  1491. 1  $SaveName%=$database%+".PrintJobs."+key$(0)
  1492. do_it("",REC%)
  1493.  (b% 
  1494.  %111)=4 
  1495. selected(wi%,27) 
  1496. close_window(wi%):
  1497. set_caret(mainW%,-1)
  1498.  28:$
  1499. text(wi%,0)=searchformula$:
  1500. redraw_icon(wi%,0):
  1501. set_caret(wi%,0)
  1502. iconbar_click
  1503.  %111 
  1504. selected(passW%,12) 
  1505. close_window(saveW%)
  1506. (    
  1507. show_menu(menu%(0),x%-64,ybar%)
  1508.  $dbase%="No data" 
  1509.     $SaveName%="!DataBase"
  1510. 2    $SaveSprite%="snew_appl;Pptr_hand,12,8;B3"
  1511.     savefunc$=choice$(1)
  1512. 1    
  1513.  "Wimp_CreateMenu",,saveW%,x%-50,y%+300
  1514. show_windows
  1515. main_click
  1516.  P%,F%,H$,L%,T%,N$,field$
  1517.  present%=7 
  1518.  adjust%=
  1519. validate(Fieldnumber%,T%,N$)=
  1520. update_calcs(Fieldnumber%)
  1521.  flash% 
  1522. deselect(mainW%,field%(flash%)):flash%=
  1523.  present% 
  1524.  0,3:
  1525. design_field
  1526. first_field>0 
  1527. default_key
  1528. design_field
  1529.  5,7:
  1530.  adjust% 
  1531. design_field
  1532.         
  1533. identify_field(ic%)
  1534. &    
  1535.  relations%=
  1536. relations(
  1537.  2047 
  1538.       
  1539.       
  1540. close_window(saveW%)
  1541. ,      
  1542. selected(passW%,11) 
  1543.  Modify% 
  1544.         
  1545. set_up_field_menu
  1546. ,        
  1547. show_menu(menu%(1),x%-64,y%-20)
  1548.       
  1549.       
  1550. &      
  1551.  chartype%(Fieldnumber%) 
  1552.         
  1553.  41,42,43,44,45:
  1554.         
  1555. invert(wi%,ic%)
  1556. (        col%=
  1557. get_icon_cols(wi%,ic%)
  1558. 4        col%=((col%>>4) 
  1559.  (col%<<4)) 
  1560.  %11111111
  1561. (        
  1562. set_icon_cols(wi%,ic%,col%)
  1563. %        boxon%=((col% 
  1564.  %1111)<2)
  1565. %        
  1566. update_selection(boxon%)
  1567.       
  1568.       
  1569. &      
  1570.  chartype%(Fieldnumber%) 
  1571. 9        
  1572. filter(mainW%,field%(buttonfield%(22)))
  1573.         
  1574.  41,42,43,44,45:
  1575.         
  1576. (-2) 
  1577. )          
  1578. invert(wi%,ic%):
  1579. enter_tag
  1580.           
  1581. S          
  1582. selected(wi%,ic%) 
  1583.  $Rf%(Fieldnumber%)=" " 
  1584.  $Rf%(Fieldnumber%)=""
  1585.         
  1586.         
  1587. relations(
  1588.       
  1589.       
  1590.  256:
  1591. &      
  1592.  chartype%(Fieldnumber%) 
  1593. J        
  1594.  0,1,2,3,4,5,6,7,8,36,39,46,47,48,49,50,51,52,53,54,55,56,57:
  1595.         
  1596. invert(wi%,ic%)
  1597. 1        
  1598. update_selection(
  1599. selected(wi%,ic%))
  1600. }        
  1601.  9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30:
  1602. keypad_click(wi%,chartype%(Fieldnumber%)-9,1)
  1603.       
  1604.       
  1605.  1024:
  1606.       
  1607. (-2) 
  1608. 2        block%!8=0:block%!12=wi%:block%!16=ic%
  1609. -        
  1610.  "Interface_SlabButton",,block%
  1611.         
  1612. enter_tag
  1613.         
  1614. (        
  1615.  chartype%(Fieldnumber%) 
  1616.           
  1617.  0,1,2,3,4,5,8:
  1618.            
  1619.  Fieldnumber%>0 
  1620. ?            !block%=mainW%:
  1621.  "Wimp_GetWindowState",,block%
  1622. `            
  1623.  Access% 
  1624.  "Wimp_SetCaretPosition",mainW%,ic%,x%-block%!4+block%!20,y%,-1,-1
  1625.           
  1626. {          
  1627. link$(Fieldnumber%),1)="@" 
  1628.  "OS_CLI","Filer_OpenDir "+
  1629. link$(Fieldnumber%),2) 
  1630. softerror("",91)
  1631.  I          
  1632.  36,37,38:
  1633. edit_blob(Fieldnumber%,chartype%(Fieldnumber%))
  1634.           
  1635.  9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30:
  1636. keypad_click(wi%,chartype%(Fieldnumber%)-9,4)
  1637.           
  1638. match
  1639.           
  1640. exit(0)
  1641.           
  1642.  34:quit%=
  1643.         
  1644.       
  1645. '        
  1646. enter_tag
  1647.  "Wimp_GetCaretPosition",,block%
  1648. wi%=!block%:ic%=block%!4
  1649.  wi% 
  1650.  matchW%:
  1651.  ic%<>0 
  1652.  wi%=0
  1653.  keypadW%:
  1654.  ic%<>29 
  1655.  wi%=0
  1656.  mergeW%:
  1657.  ic%<>3 
  1658.  wi%=0
  1659. :wi%=0
  1660.  wi%<>0 
  1661. 6)  $
  1662. text(wi%,ic%)+=Tag$(Fieldnumber%)
  1663. set_caret(wi%,ic%)
  1664. redraw_icon(wi%,ic%)
  1665. set_up_field_menu
  1666.  I%,tabmen%
  1667. tabmen%=(LastTable%<>-1)
  1668.  tabmen% 
  1669. tick_one(tablemenu%,0,LastTable%,LastTable%+1)
  1670.  Fieldnumber%>0 
  1671. lit(menu%(1),1,
  1672.   $AnalyseFunc%="Analyse"
  1673. C-  $Fieldpos%="Field: "+Tag$(Fieldnumber%)
  1674.   $LinkTitle%=Fieldname$
  1675. E'  $CalcForm%=Tag$(Fieldnumber%)+"="
  1676.  I%=0 
  1677. lit(menu%(10),I%,
  1678. I   V%=chartype%(Fieldnumber%)
  1679.  5,50,51:
  1680. L&    isadate%=
  1681. lit(menu%(10),1,
  1682. M&    $AnalyseFunc%="Analyse months"
  1683. :isadate%=
  1684. is_a_key(Fieldnumber%)>=0 
  1685. lit(menu%(10),1,
  1686. R_    
  1687.  isadate%=
  1688. selected(mainW%,field%(Fieldnumber%)) 
  1689.  $AnalyseFunc%="Analyse index"
  1690.  0,1,2,3,4,5:
  1691. V!    
  1692. lit(menu%(10),0,Access%)
  1693. W!    
  1694. lit(menu%(10),2,Access%)
  1695. X+    
  1696. lit(menu%(10),3,Access% 
  1697.  tabmen%)
  1698. Y!    
  1699. lit(menu%(10),4,Modify%)
  1700. Z!    
  1701. lit(menu%(10),5,Access%)
  1702. [4    Keyfld0%=Fieldnumber%:Keyfld1%=0:$F2dkey%=""
  1703. \#    $F1dkey%=Tag$(Fieldnumber%)
  1704. ](    keylimit%=TextLength%:$KeyNo%=""
  1705. ^!    WD%()=0:keylen%=keylimit%
  1706.     $Lkey%=
  1707. (keylimit%)
  1708.  J%=0 
  1709.       $Wkey%(J%)=
  1710. (WD%(J%))
  1711. c*    $ChangeTitle%="Field: "+Fieldname$
  1712.     $
  1713. text(changeW%,1)=""
  1714. e+    
  1715.  common% 
  1716. text(changeW%,3)=""
  1717. link_status
  1718. h!    
  1719. lit(menu%(10),4,Modify%)
  1720. i+    
  1721. lit(menu%(10),3,Access% 
  1722.  tabmen%)
  1723. j!    
  1724. lit(menu%(10),2,Access%)
  1725. k$    
  1726. calc_link("Calculations",6)
  1727. link_status
  1728. n!    
  1729. lit(menu%(10),4,Modify%)
  1730. o+    
  1731. lit(menu%(10),3,Access% 
  1732.  tabmen%)
  1733. p!    
  1734. lit(menu%(10),2,Access%)
  1735. q&    
  1736. calc_link("Combine fields",7)
  1737. link_status
  1738. s.    
  1739.  46,47,48,49,50,51,52,53,54,55,56,57:
  1740.  V%=47 
  1741. u#      
  1742. lit(menu%(10),4,Modify%)
  1743. v)      
  1744. calc_link("Set base value",47)
  1745. w        
  1746. x!    
  1747. lit(menu%(10),0,Access%)
  1748. y4    Keyfld0%=Fieldnumber%:Keyfld1%=0:$F2dkey%=""
  1749. zt    
  1750.  Fieldname$<>Tag$(Fieldnumber%) 
  1751.  $F1dkey%=
  1752. Fieldname$,8)+" ("+Tag$(Fieldnumber%)+")" 
  1753.  $F1dkey%=Fieldname$
  1754. {(    keylimit%=TextLength%:$KeyNo%=""
  1755. |!    WD%()=0:keylen%=keylimit%
  1756.     $Lkey%=
  1757. (keylimit%)
  1758.  J%=0 
  1759.       $Wkey%(J%)=
  1760. (WD%(J%))
  1761.  36,39:
  1762. D    
  1763. blob_path(
  1764. ,$database%,REC%,Fieldnumber%,V%,object$)>=0 
  1765. #      
  1766. lit(menu%(10),6,Access%)
  1767.       
  1768. lit(menu%(10),7,
  1769.       
  1770. lit(menu%(10),8,
  1771.       $SaveName%="TextFile"
  1772. 4      $SaveSprite%="sfile_fff;Pptr_hand,12,8;B3"
  1773.       savefunc$="Save text"
  1774.         
  1775.  37,40:
  1776. D    
  1777. blob_path(
  1778. ,$database%,REC%,Fieldnumber%,V%,object$)>=0 
  1779. #      
  1780. lit(menu%(10),6,Access%)
  1781.       
  1782. lit(menu%(10),7,
  1783.       
  1784. lit(menu%(10),8,
  1785.       $SaveName%="Sprite"
  1786. 4      $SaveSprite%="sfile_ff9;Pptr_hand,12,8;B3"
  1787. !      savefunc$="Save sprite"
  1788.         
  1789. D    
  1790. blob_path(
  1791. ,$database%,REC%,Fieldnumber%,V%,object$)>=0 
  1792. #      
  1793. lit(menu%(10),6,Access%)
  1794.       
  1795. lit(menu%(10),7,
  1796.       
  1797. lit(menu%(10),8,
  1798.       $SaveName%="DrawFile"
  1799. 4      $SaveSprite%="sfile_aff;Pptr_hand,12,8;B3"
  1800.       savefunc$="Save draw"
  1801.         
  1802. lit(menu%(1),1,
  1803. ):$Fieldpos%="Field: ''"
  1804. update_selection(add%)
  1805.  P%,SP%,F%,SF%
  1806. "F%=Fieldnumber%:SF%=(F% 
  1807.  128)
  1808. -field$=
  1809. ~(F%):
  1810.  F%<16 
  1811.  field$="0"+field$
  1812. 2sfield$=
  1813. ~(SF%):
  1814.  SF%<16 
  1815.  sfield$="0"+sfield$
  1816.  add% 
  1817. (-1) 
  1818.  printorder$+=sfield$ 
  1819.  printorder$+=field$
  1820. enable_row(calcrow%?Fieldnumber%,
  1821. lit(menu%(6),7,
  1822. lit(menu%(6),8,
  1823. $    P%=
  1824. printorder$,field$,P%+1)
  1825.  ((P%-1) 
  1826.  2)=0 
  1827.  P%=0
  1828.  P%>0 
  1829. 9    printorder$=
  1830. printorder$,P%-1)+
  1831. printorder$,P%+2)
  1832. ,    
  1833. enable_row(calcrow%?Fieldnumber%,
  1834.         
  1835.         
  1836. )      SP%=
  1837. printorder$,sfield$,SP%+1)
  1838. !    
  1839.  ((SP%-1) 
  1840.  2)=0 
  1841.  SP%=0
  1842.  SP%>0 
  1843. =      printorder$=
  1844. printorder$,SP%-1)+
  1845. printorder$,SP%+2)
  1846. .      
  1847. enable_row(calcrow%?Fieldnumber%,
  1848.         
  1849.  printorder$="" 
  1850. lit(menu%(6),7,
  1851. lit(menu%(6),8,
  1852. print_click
  1853.  (b% 
  1854.  %111) 
  1855. selected(printW%,26) 
  1856. show_menu(labelW%,x%-500,y%+200)
  1857.  1,4:
  1858.  ic% 
  1859.  23,24,25:
  1860. 6    
  1861. icon_bit(22,printW%,15,
  1862. selected(printW%,25))
  1863. 6    
  1864. icon_bit(22,printW%,45,
  1865. selected(printW%,25))
  1866. 6    
  1867. icon_bit(22,printW%,15,
  1868. selected(printW%,25))
  1869. 6    
  1870. icon_bit(22,printW%,45,
  1871. selected(printW%,25))
  1872. )    
  1873. show_menu(labelW%,x%-500,y%+200)
  1874. =    
  1875. load_options("<Pbase$Dir>.Resources.PrintOpts")
  1876. close_window(printW%)
  1877. 6    
  1878.  (b% 
  1879.  %111)=1 
  1880. open_window(matchW%):
  1881. match
  1882. keypad_click(wi%,ic%,b%)
  1883.  handle%,icon%,T%,N$,date$
  1884. close_window(relateW%)
  1885.  flash% 
  1886. deselect(mainW%,field%(flash%)):flash%=
  1887.  ic%<>12 
  1888. validate(Fieldnumber%,T%,N$)=
  1889. update_calcs(Fieldnumber%)
  1890.  (b% 
  1891.  %111) 
  1892.  1,4:
  1893.  (b% 
  1894.  %111)=4 
  1895.  z%=1 
  1896.  z%=-1
  1897.  ic% 
  1898. ,    
  1899. scan(z%,
  1900. text(keypadW%,23)))
  1901.  1:stop%=
  1902. %    
  1903.  2:addr=
  1904. moveto(key%,top,z%)
  1905. &    
  1906.  3:addr=
  1907. moveto(key%,top,-z%)
  1908. &    
  1909.  4:addr=
  1910. moveto(key%,addr,z%)
  1911. '    
  1912.  5:addr=
  1913. moveto(key%,addr,-z%)
  1914. (    
  1915.  6:addr=
  1916. fast_wind(top,addr,z%)
  1917. )    
  1918.  7:addr=
  1919. fast_wind(top,addr,-z%)
  1920. key_select(z%)
  1921. key_select(-z%)
  1922. subfile(z%)
  1923. subfile(-z%)
  1924. -    
  1925. rotate:addr=
  1926. moveto(key%,top,1)
  1927. "    
  1928. allow_search(wi%,z%)
  1929. display(key%,-1)
  1930. #    
  1931.  15:addr=
  1932. shift(z%,key%,0)
  1933. (-1) 
  1934. *      addr=
  1935. find("#"+
  1936. (REC%),key%,0,
  1937.       
  1938. display(key%,addr)
  1939.         
  1940. $    
  1941.  16:addr=
  1942. shift(-z%,key%,0)
  1943. (-1) 
  1944. *      addr=
  1945. find("#"+
  1946. (REC%),key%,0,
  1947.       
  1948. display(key%,addr)
  1949.         
  1950. 6    
  1951.  17:addr=
  1952. shift(0,key%,1):
  1953. display(key%,addr)
  1954. val_help
  1955. 6    
  1956. check_change:
  1957. save_keys:
  1958. save_all_tables
  1959. store
  1960. retrieve
  1961. !    
  1962. filter(keypadW%,22)
  1963.     S$=$
  1964. text(keypadW%,27)
  1965. #    
  1966.  chartype%(KF%(key%,0)) 
  1967.       
  1968.  5,50,51:
  1969. ?      
  1970. check_date(S$,1,date$)=
  1971. reverse_date(date$)
  1972.         
  1973. 6    
  1974.  S$<>"" 
  1975.  addr=
  1976. find(
  1977. S$,KL%(key%)),key%,1,
  1978.  z%=1 
  1979. !      
  1980. selected(passW%,9) 
  1981. =        !block%=keypadW%:
  1982.  "Wimp_GetWindowState",,block%
  1983. 9        block%!12=block%!4+660:block%!16=block%!8+328
  1984.     #        block%!20=0:block%!24=0
  1985. (        
  1986.  "Wimp_OpenWindow",,block%
  1987. %        
  1988. close_window(keypadW%)
  1989.       
  1990.         
  1991. #    
  1992. text(keypadW%,29)<>"" 
  1993. D      Filter$=
  1994. parse($
  1995. text(keypadW%,29),
  1996. selected(keypadW%,32))
  1997.       filter%=
  1998. #      addr=
  1999. moveto(key%,top,z%)
  2000.       
  2001.  filter%=
  2002.         
  2003. !    
  2004. commoncase(wi%,ic%)
  2005. H    
  2006.  "OS_Byte",202,0,239:
  2007. show_menu(specmenu%,oldx%+32,oldy%)
  2008. $    
  2009. open_window(specialW%)
  2010. scan(z%,s%)
  2011. stop%=
  2012.    addr=
  2013. moveto(key%,addr,z%)
  2014.   K%=
  2015.  stop%
  2016. store
  2017.  wi%,ic%
  2018.  "Wimp_GetCaretPosition",,block%
  2019. wi%=!block%:ic%=block%!4
  2020.  wi%=mainW% 
  2021.  scratchpad$=$
  2022. text(wi%,ic%)
  2023. retrieve
  2024.  wi%,ic%,field%
  2025.  "Wimp_GetCaretPosition",,block%
  2026. wi%=!block%:ic%=block%!4
  2027.  scratchpad$<>"" 
  2028.  wi%=mainW% 
  2029.   field%=
  2030. get_field(ic%)
  2031. 20  $
  2032. text(wi%,ic%)=
  2033. scratchpad$,len%(field%))
  2034. redraw_icon(wi%,ic%)
  2035.  ### Binary Large Objects (B.L.O.B.s) ###
  2036. blob_path(create%,f$,R%,F%,V%,
  2037.  O$,main$,level1$,level2$,d%,L%
  2038.  36,39:O$=".Memo"
  2039.  37,40:O$=".Sprite"
  2040.  38:O$=".Draw"
  2041. main$=f$+O$+
  2042. A"level1$=main$+"."+
  2043.  4900)
  2044. B"level2$=level1$+"."+
  2045. b$=level2$+"."+
  2046.  "OS_File",5,b$ 
  2047.  d%,,,,L%
  2048.  d%=0 
  2049.  create%=
  2050.  "OS_File",8,main$
  2051.  "OS_File",8,level1$
  2052.  "OS_File",8,level2$
  2053.  d%=1 
  2054. load_blob(f$,R%,F%,V%)
  2055.  L%,b$
  2056. N#L%=
  2057. blob_path(
  2058. ,f$,R%,F%,V%,b$)
  2059.  L%>=0 
  2060. extend_named_sliding_block(tempanchor%,L%+1)
  2061.  "OS_File",255,b$,!tempanchor%
  2062. blob_to_file(F,L%)
  2063.  L%>0 
  2064.  "OS_GBPB",2,F,!tempanchor%,L%
  2065. copy_blob(source$,dest$,RS%,RD%,FS%,FD%,V%)
  2066.  L%,Z%,bs$,bd$
  2067. [+L%=
  2068. blob_path(
  2069. ,source$,RS%,FS%,V%,bs$)
  2070.  L%>0 
  2071. ]+  Z%=
  2072. blob_path(
  2073. ,dest$,RD%,FD%,V%,bd$)
  2074.  "OS_CLI","Copy "+bs$+" "+bd$+" ~C~V~Q"
  2075. delete_blob(F%,F$,wi%,ic%)
  2076.  flag%
  2077.  delwarn%=
  2078.  "OS_CLI","Delete "+F$:flag%=
  2079. confirm("Delete object? Are you sure?") 
  2080. g(    
  2081.  "OS_CLI","Delete "+F$:flag%=
  2082.  flag% 
  2083.  chartype%(F%) 
  2084. l)    
  2085.  36:$
  2086. val(wi%,ic%)="Z0;Ssm!edit"
  2087. m*    
  2088.  37:$
  2089. val(wi%,ic%)="Z0;Ssm!paint"
  2090. n)    
  2091.  38:$
  2092. val(wi%,ic%)="Z0;Ssm!draw"
  2093.  39:$
  2094. text(wi%,ic%)=""
  2095. redraw_icon(wi%,ic%)
  2096. set_blob_sprite(R%,F%,V%)
  2097.  L%,b$,sprite$
  2098.  R%=RA% 
  2099.  L%=-1 
  2100. blob_path(
  2101. ,$database%,R%,F%,V%,b$)
  2102.  L%>=0 
  2103.  sprite$="small_fff" 
  2104.  sprite$="sm!edit"
  2105.  L%>=0 
  2106.  sprite$="small_ff9" 
  2107.  sprite$="sm!paint"
  2108.  L%>=0 
  2109.  sprite$="small_aff" 
  2110.  sprite$="sm!draw"
  2111. val(mainW%,field%(F%))="Z0;Pptr_ext,8,4;S"+sprite$
  2112. redraw_icon(mainW%,field%(F%))
  2113. edit_blob(F%,V%)
  2114.  wi%,ic%,b$,O$,val$
  2115. check_change
  2116. wi%=mainW%:ic%=field%(F%)
  2117.  36:O$="Memo":val$="Z0;Ssmall_fff":ftype%=&fff
  2118.  37:O$="Sprite":val$="Z0;Ssmall_ff9":ftype%=&ff9
  2119.  38:O$="Draw":val$="Z0;Ssmall_aff":ftype%=&aff
  2120. blob_path(
  2121. ,$database%,REC%,F%,V%,b$)<0 
  2122. val(wi%,ic%)=val$
  2123.  "OS_CLI","Copy <PBase$Dir>.Resources.Objects."+O$+" "+b$+" ~C~V"
  2124. redraw_icon(wi%,ic%)
  2125. 4block%!0=256:block%!12=0:block%!16=5:block%!20=0
  2126. 3block%!24=0:block%!28=0:block%!32=0:block%!36=0
  2127. )block%!40=ftype%:$(block%+44)=b$+
  2128.  "Wimp_SendMessage",18,block%,0
  2129. transfer_blob(wi%,ic%,file$,ft%)
  2130.  F%,V%,L%,W%,b$
  2131.  wi%<>mainW% 
  2132. check_change
  2133. #F%=(ic%+1) 
  2134.  2:V%=chartype%(F%)
  2135.  ft%=-1 
  2136.  link$(F%)="@"+file$:link$(0)="LOADED"
  2137.  ft%=&fff 
  2138. install_blob:$
  2139. val(wi%,ic%)="Z0;Ssmall_fff"
  2140.  ft%=&ff9 
  2141. install_blob:$
  2142. val(wi%,ic%)="Z0;Ssmall_ff9"
  2143.  ft%=&aff 
  2144. install_blob:$
  2145. val(wi%,ic%)="Z0;Ssmall_aff"
  2146.  ft%=&fff 
  2147. install_blob:
  2148. show_text_block(F%)
  2149.  ft%=&ff9 
  2150. install_blob:
  2151. show_picture(F%)
  2152. redraw_icon(wi%,ic%)
  2153. install_blob
  2154. blob_path(
  2155. ,$database%,REC%,F%,V%,b$)
  2156.  "OS_CLI","Remove "+b$
  2157.  "OS_CLI","Copy "+file$+" "+b$+" ~C~V"
  2158. show_text_block(F%)
  2159.  F,b$,I%,L%,base%
  2160.  F%=0 
  2161. base%=Rf%(F%)
  2162. blob_path(
  2163. ,$database%,REC%,F%,39,b$)
  2164.  L%>0 
  2165.  L%>len%(F%) 
  2166.  L%=len%(F%)
  2167.  ### Load only as much of file as we can display ###
  2168. >  F=
  2169. (b$):
  2170.  F>0 
  2171.  "OS_GBPB",4,F,base%,L%:
  2172. close_file(F)
  2173.  ### Replace any characters<32 by spaces - but ONLY for display ###
  2174.  I%=0 
  2175.  L%-1
  2176. #    
  2177.  base%?I%<32 
  2178.  base%?I%=32
  2179.   base%?L%=10
  2180.  $base%=""
  2181. show_picture(F%)
  2182.  F,f$,I%,max%,len%,x%,y%,w%,h%
  2183.  F%=0 
  2184. /len%=
  2185. blob_path(
  2186. ,$database%,REC%,F%,40,f$)
  2187. E!block%=mainW%:block%!4=field%(F%):
  2188.  "Wimp_GetIconState",,block%
  2189. <x%=block%!8:y%=block%!12:w%=block%!16-x%:h%=block%!20-y%
  2190.  "Wimp_DeleteIcon",,block%
  2191.  len%>=0 
  2192. extend_named_sliding_block(Rf%(F%),len%+4):base%=!Rf%(F%)
  2193. /  !base%=len%+4:
  2194.  "OS_File",255,f$,base%+4
  2195. O  field%(F%)=
  2196. create_icon(mainW%,x%,y%,w%,h%,&0700A53E,"",base%+16,base%,0)
  2197. K  field%(F%)=
  2198. create_icon(mainW%,x%,y%,w%,h%,&0700A53E,"",paint%,1,384)
  2199. filter(wi%,ic%)
  2200.  h%,ox%,oy%
  2201.  wi% 
  2202.  keypadW%:h%=530:ox%=0:oy%=0
  2203.  mainW%:h%=200:ox%=0:oy%=-330
  2204. selected(wi%,ic%) 
  2205. 7  !block%=keypadW%:
  2206.  "Wimp_GetWindowState",,block%
  2207. 2  block%!12=block%!4+660:block%!8=block%!16-h%
  2208. !  block%!20=ox%:block%!24=oy%
  2209.  "Wimp_OpenWindow",,block%
  2210.  common% 
  2211. text(keypadW%,29)=""
  2212. set_caret(keypadW%,29)
  2213. text(keypadW%,29)<>"" 
  2214. B    Filter$=
  2215. parse($
  2216. text(keypadW%,29),
  2217. selected(keypadW%,32))
  2218.     filter%=
  2219. !    addr=
  2220. moveto(key%,top,z%)
  2221.  filter%=
  2222.  wi%=keypadW% 
  2223. 9    !block%=keypadW%:
  2224.  "Wimp_GetWindowState",,block%
  2225. 5    block%!12=block%!4+660:block%!8=block%!16-330
  2226.     block%!20=0:block%!24=0
  2227. $    
  2228.  "Wimp_OpenWindow",,block%
  2229. !    
  2230. close_window(keypadW%)
  2231.   filter%=
  2232. fast_wind(T%,P%,D%)
  2233.  fast%=
  2234. text(keypadW%,23))
  2235. D%=(D%+1) 
  2236.  P%<>T% 
  2237.  I%<fast%
  2238.  filter% 
  2239. next_match(P%,D%,Filter$) 
  2240. neighbour(key%,P%,D%)
  2241.   I%+=1
  2242.  P%=T% 
  2243.  filter% 
  2244.  7:P%=
  2245. neighbour(key%,P%,1-D%)
  2246. display(key%,P%)
  2247. subfile(dir%)
  2248. file%+=dir%
  2249.  file%=6 
  2250.  file%=0
  2251.  file%=-1 
  2252.  file%=5
  2253. top=8*file%+LH%
  2254. addr=
  2255. moveto(key%,top,1)
  2256. allow_search(wi%,e%)
  2257.  w%,ox%,oy%
  2258. select(keypadW%,24):
  2259. deselect(keypadW%,25)
  2260. select(keypadW%,25):
  2261. deselect(keypadW%,24)
  2262. deselect(keypadW%,22)
  2263.  buttonfield%(22)>0 
  2264. deselect(mainW%,field%(buttonfield%(22)))
  2265. filter%=
  2266. text(keypadW%,27)="":$
  2267. text(keypadW%,36)=""
  2268. text(keypadW%,33)=Index$(key%)
  2269.  wi% 
  2270.  keypadW%:w%=1000:ox%=0:oy%=0
  2271.  mainW%:w%=340:ox%=660:oy%=0
  2272. 5!block%=keypadW%:
  2273.  "Wimp_GetWindowState",,block%
  2274. 0block%!12=block%!4+w%:block%!8=block%!16-328
  2275. block%!20=ox%:block%!24=oy%
  2276.  "Wimp_OpenWindow",,block%
  2277. set_caret(keypadW%,27)
  2278. val_help
  2279.  name$
  2280.  Fieldnumber%>0 
  2281. !  name$=
  2282. link$(Fieldnumber%))
  2283. (name$)<58 
  2284. (name$)<>-1 
  2285.  name$=
  2286. name$,2)
  2287.  '  Tablenumber%=
  2288. table_number(name$)
  2289.  Tablenumber%<>-1 
  2290. show_table(Tablenumber%)
  2291. val_on_off
  2292. validate%=
  2293.  validate%
  2294. tick(menu%(2),3,validate%)
  2295.  I%=1 
  2296.  validate% 
  2297. +$    
  2298. :$valid%(I%)=$rvalid%(I%)
  2299. ,(    
  2300. :$valid%(I%)="Pptr_write,4,4"
  2301. save_click(wi%,ic%,b%)
  2302.  p$,H$
  2303. butt%=(b% 
  2304.  %111)
  2305.  wi% 
  2306.  saveW%:
  2307.   Filename$=$SaveName%
  2308.  savefunc$ 
  2309.  "New database":
  2310.     Type%=0
  2311. :6    
  2312. Filename$,1)<>"!" 
  2313.  Filename$="!"+Filename$
  2314. ;5    Filename$=
  2315. Filename$,10):$SaveName%=Filename$
  2316.  "Save as text":
  2317.     Type%=&fff
  2318. >7    Start%=!textanchor%:End%=Start%+Count%*LenLine%
  2319.     $Start%=pitch$
  2320.  "Save list":
  2321. A     Type%=&fff:savetofile%=
  2322.  "Save text":
  2323.     Type%=&fff:
  2324. D=    len%=
  2325. blob_path(
  2326. ,$database%,REC%,Fieldnumber%,36,f$)
  2327. E7    
  2328. extend_named_sliding_block(saveanchor%,len%+1)
  2329. F(    
  2330.  "OS_File",255,f$,!saveanchor%
  2331. G,    Start%=!saveanchor%:End%=Start%+len%
  2332.  "Save sprite":
  2333.     Type%=&ff9
  2334. J=    len%=
  2335. blob_path(
  2336. ,$database%,REC%,Fieldnumber%,37,f$)
  2337. K7    
  2338. extend_named_sliding_block(saveanchor%,len%+1)
  2339. L(    
  2340.  "OS_File",255,f$,!saveanchor%
  2341. M,    Start%=!saveanchor%:End%=Start%+len%
  2342.  "Save draw":
  2343.     Type%=&aff
  2344. P=    len%=
  2345. blob_path(
  2346. ,$database%,REC%,Fieldnumber%,38,f$)
  2347. Q7    
  2348. extend_named_sliding_block(saveanchor%,len%+1)
  2349. R(    
  2350.  "OS_File",255,f$,!saveanchor%
  2351. S,    Start%=!saveanchor%:End%=Start%+len%
  2352.  "Save options":
  2353.     Type%=&7f5
  2354.  "Save query":
  2355. WC    Start%=
  2356. text(matchW%,0):End%=Start%+
  2357. ($Start%)+1:Type%=&7f4
  2358.  "Save selection":
  2359. Y1    P%=savebuff%:$P%=printorder$:P%+=
  2360. ($P%)+1
  2361.  T%=0 
  2362.  LastTable%
  2363. ['     $P%=printrel$(T%):P%+=
  2364. ($P%)+1
  2365. ]>    Start%=savebuff%:End%=Start%+P%-savebuff%+1:Type%=&7F3
  2366.  "Save table":
  2367. _G    $TabTitle%=
  2368. table_info(T%,Rows%,TabFields%,Rec%,tabfieldlen%())
  2369. `D    Start%=!tabanchor%(T%):End%=Start%+160+Rows%*Rec%:Type%=&7f1
  2370.  "Save form file":
  2371.     Type%=&7f2
  2372. lit(menu%(9),3,
  2373. lit(menu%(9),4,
  2374. e3    
  2375.  adjust%=
  2376. first_field>0 
  2377. default_key
  2378.  savesubW%:
  2379.  savefunc$ 
  2380.  "Export subset":
  2381. j#    Filename$=$SubName%:Type%=0
  2382.  "Export CSV":
  2383. l&    Filename$=$SubName%:Type%=&dfe
  2384.  ic% 
  2385.  (b% 
  2386.  %11110000)>0 
  2387. init_drag(wi%,ic%,5)
  2388. Filename$,".")>0 
  2389. tY    
  2390.  butt%<>2 
  2391. save(Filename$,Type%,Start%,End%):
  2392. write_log(-1,Filename$+" saved")
  2393. u,    
  2394.  butt%=4 
  2395.  "Wimp_CreateMenu",,-1
  2396. softerror("",33)
  2397.  butt%=2 
  2398.  butt%=4 
  2399. show_menu(menu%(15),x%-64,y%-20)
  2400.  butt%=2 
  2401.  butt%=4 
  2402. show_menu(menu%(20),x%-64,y%-20)
  2403. commoncase(wi%,ic%)
  2404. key_click
  2405.  %111 
  2406.  4:z%=1
  2407.  1:z%=-1
  2408.  ic% 
  2409. kcycle(Keyfld0%,F1dkey%,0,z%)
  2410. kcycle(Keyfld0%,F1dkey%,0,-z%)
  2411. kcycle(Keyfld1%,F2dkey%,1,z%)
  2412. kcycle(Keyfld1%,F2dkey%,1,-z%)
  2413. tick_one(fieldmenu%,0,fields%-1,Keyfld0%-1)
  2414. show_menu(fieldmenu%,oldx%+32,oldy%):fieldfunc$="first"
  2415. tick_one(fieldmenu%,0,fields%-1,Keyfld1%-1)
  2416. show_menu(fieldmenu%,oldx%+32,oldy%):fieldfunc$="second"
  2417. shade_key_icons(
  2418. selected(keyW%,24),
  2419. selected(keyW%,24),
  2420. selected(keyW%,24) 
  2421. set_caret(keyW%,26) 
  2422. set_caret(keyW%,2)
  2423.  keyfunc$<>"Current key" 
  2424. /    keylimit%=len%(Keyfld0%)+len%(Keyfld1%)
  2425.  J%=0 
  2426.       WD%(J%)=
  2427. ($Wkey%(J%))
  2428. 9    keylen%=
  2429. (WD%()):
  2430.  keylen%=0 
  2431.  keylen%=
  2432. ($Lkey%)
  2433. /      
  2434.  keylen%>keylimit%:
  2435. softerror("",26)
  2436. (      
  2437.  keylen%=0:
  2438. softerror("",105)
  2439.       
  2440.       
  2441.  keyfunc$ 
  2442.         
  2443.  "Primary key":
  2444.         key%=0
  2445.         
  2446. copy_keydata(key%)
  2447. *        RA%=
  2448. ($Records%):f$=$database%
  2449. &        
  2450. make_empty_index(RA%,0,
  2451. *        
  2452. save_recs(f$+".Database",RA%)
  2453. !        present%=7:
  2454. save_keys
  2455. $        design%=
  2456. get_it_in(f$)
  2457. 0        
  2458.  "New primary key":
  2459. new_tree(file%)
  2460. )        
  2461.  "Index field":
  2462. create_index
  2463.       
  2464.         
  2465.   keyfunc$=""
  2466. close_window(keyW%)
  2467. shade_key_icons(con%,wd%,len%,case%)
  2468. icon_bit(22,keyW%,20,case%)
  2469. icon_bit(22,keyW%,26,len%)
  2470.  I%=16 
  2471. icon_bit(22,keyW%,I%,con%)
  2472. icon_bit(22,keyW%,7,con%)
  2473. icon_bit(22,keyW%,21,con%)
  2474. icon_bit(22,keyW%,22,con%)
  2475. icon_bit(22,keyW%,24,con%)
  2476. icon_bit(22,keyW%,28,con%)
  2477.  I%=2 
  2478. icon_bit(22,keyW%,I%,wd%)
  2479. kcycle(
  2480.  F%,T%,icon%,z%)
  2481. F%+=z%
  2482.  F%>fields% 
  2483.  F%=0
  2484.  F%<0 
  2485.  F%=fields%
  2486.  F%>0 
  2487.  $T%=Tag$(F%) 
  2488.  $T%=""
  2489. redraw_icon(keyW%,icon%)
  2490. tick_one(fieldmenu%,0,fields%-1,F%-1)
  2491. copy_keydata(key%)
  2492. -KF%(key%,0)=Keyfld0%:KF%(key%,1)=Keyfld1%
  2493. KL%(key%)=keylen%
  2494.  J%=0 
  2495.   KW%(key%,J%)=WD%(J%)
  2496. #case%(key%)=
  2497. selected(keyW%,20)
  2498. set_keydata(key%)
  2499.  J%,S$
  2500. -Keyfld0%=KF%(key%,0):Keyfld1%=KF%(key%,1)
  2501. $F1dkey%=Tag$(Keyfld0%)
  2502.  KF%(key%,1)>0 
  2503.  $F2dkey%=Tag$(Keyfld1%) 
  2504.  $F2dkey%=""
  2505. 'keylen%=KL%(key%):$Lkey%=
  2506. (keylen%)
  2507.  J%=0 
  2508. 0  WD%(J%)=KW%(key%,J%):$Wkey%(J%)=
  2509. (WD%(J%))
  2510. $KeyNo%=
  2511. (key%)
  2512. set_icon(keyW%,20,case%(key%))
  2513. set_icon(keyW%,24,
  2514. (WD%())=0)
  2515. set_icon(keyW%,28,incspace%(key%))
  2516. key_select(D%)
  2517. colour(key%,2)
  2518.  +1:key%=(key%+1) 
  2519.  (Keys%+1)
  2520.  -1:key%-=1:
  2521.  key%<0 
  2522.  key%=Keys%
  2523. colour(key%,1)
  2524. set_keydata(key%)
  2525. text(keypadW%,33)=Index$(key%):
  2526. redraw_icon(keypadW%,33)
  2527. top=8*file%+LH%
  2528. addr=
  2529. moveto(key%,top,1)
  2530. set_colours
  2531.  ic% 
  2532.  0,1,2,3,4,5,6:
  2533.   col%=ncol%(ic%)
  2534.    fb%=
  2535. selected_esg(colW%,2)
  2536.  fb% 
  2537. #    
  2538.  11:col%=(col% 
  2539.  &F):fb%=1
  2540. (    
  2541.  12:col%=((col%>>4) 
  2542.  &F):fb%=0
  2543.  %111 
  2544. "    col%-=1:
  2545.  col%<0 
  2546.  col%=15
  2547. $    
  2548. dcolour(colW%,ic%,col%,fb%)
  2549.     col%=(col%+1) 
  2550. $    
  2551. dcolour(colW%,ic%,col%,fb%)
  2552. *  ncol%(ic%)=
  2553. get_icon_cols(colW%,ic%)
  2554.  9,10:
  2555.   fcol%()=ncol%()
  2556.  I%=0 
  2557.  Keys%
  2558. colour(I%,2)
  2559. colour(0,0)
  2560. colour(key%,1)
  2561.  I%=1 
  2562.  fields%
  2563.     D    
  2564.  link$(I%)<>"" 
  2565. set_icon_cols(mainW%,field%(I%),ncol%(6))
  2566.  ic%=10 
  2567. write_colours
  2568.  "Wimp_CreateMenu",,-1
  2569. read_colours("<Pbase$Dir>.Resources.Colours")
  2570.  I%=0 
  2571. *    
  2572. set_icon_cols(colW%,I%,ncol%(I%))
  2573. create_click
  2574.  Calc$
  2575. butt%=(b% 
  2576.  %111)
  2577.  butt% 
  2578.  2,4:
  2579.  ic%=36 
  2580. show_menu(menu%(menunumber%),oldx%+32,oldy%)
  2581.  butt%=4 
  2582.  z%=1 
  2583.  butt%=1 
  2584.  z%=-1 
  2585.  ic% 
  2586. set_limits(0,0,8,8)
  2587. set_limits(36,36,40,11)
  2588. set_limits(9,9,35,19)
  2589. set_limits(41,41,45,14)
  2590. set_limits(46,46,59,16)
  2591. change_type(z%,menunumber%)
  2592. change_type(-z%,menunumber%)
  2593. create_field(
  2594. ($InsText%),posx%,posy%,Calc$)
  2595. remove_field(Fieldnumber%,
  2596. ,Calc$)
  2597. create_field(Fieldnumber%,posx%,posy%,Calc$)
  2598. remove_field(Fieldnumber%,
  2599. ,Calc$)
  2600. icon_bit(22,createW%,13,(
  2601. selected(createW%,14)))
  2602.   F%=
  2603. ($InsText%)
  2604.  F%>0 
  2605.  F%<=fields% 
  2606. -(    
  2607.  F%<Fieldnumber% 
  2608.  Z%=-1 
  2609.  Z%=1
  2610. .(    
  2611. re_sequence(Fieldnumber%,F%,Z%)
  2612. close_window(createW%)
  2613. swap_fields(Fieldnumber%,
  2614. ($InsText%))
  2615. update_box
  2616.  (present% 
  2617.  4)=0 
  2618. lit(menu%(9),1,(fields%>0))
  2619.  ic% 
  2620.  18,29,30:
  2621.  butt%=4 
  2622. close_window(createW%)
  2623. 9        
  2624. :#    
  2625. icon_bit(22,createW%,18,
  2626. ;+    
  2627. icon_bit(22,createW%,30,
  2628.  adjust%)
  2629. <#    
  2630. icon_bit(22,createW%,29,
  2631.     Fieldnumber%=fields%
  2632. update_box
  2633.  fieldtype% 
  2634.  0,1,2,3,4,5,6,7,46,47:
  2635.  adjust% 
  2636. icon_bit(22,createW%,6,
  2637. icon_bit(22,createW%,6,
  2638. icon_bit(22,createW%,14,(fieldtype%=3 
  2639.  fieldtype%=6))
  2640. icon_bit(22,createW%,13,(fieldtype%=3 
  2641.  fieldtype%=6) 
  2642. selected(createW%,14))
  2643. icon_bit(22,createW%,15,(fieldtype%=3 
  2644.  fieldtype%=47))
  2645. icon_bit(22,createW%,25,(fieldtype%=3))
  2646. icon_bit(22,createW%,26,
  2647.  adjust%)
  2648.  adjust% 
  2649. lit(menu%(9),2,(fields%>0))
  2650. M $ValText%=vname$(fieldtype%)
  2651. redraw_icon(createW%,28)
  2652. set_limits(t%,f%,l%,m%)
  2653. fieldtype%=t%
  2654. firsttype%=f%
  2655. lasttype%=l%
  2656. menunumber%=m%
  2657. tick_one(menu%(m%),0,l%-f%,t%-f%)
  2658. update_box
  2659. change_type(d%,m%)
  2660.  1:fieldtype%+=1
  2661.  fieldtype%>lasttype% 
  2662.  fieldtype%=firsttype%
  2663.  -1:fieldtype%-=1
  2664.  fieldtype%<firsttype% 
  2665.  fieldtype%=lasttype%
  2666. tick_one(menu%(m%),0,lasttype%-firsttype%,fieldtype%-firsttype%)
  2667. update_box
  2668. passwords
  2669.  ic% 
  2670.  $Write%="" 
  2671.  $Write%=$Read%
  2672.  $Manager%="" 
  2673.  $Manager%=$Write%
  2674. k   F=
  2675. ($database%+".Colours")
  2676. #F=35
  2677. m"  S$=
  2678. encrypt($Read%,
  2679. #F,S$
  2680. n#  S$=
  2681. encrypt($Write%,
  2682. #F,S$
  2683. o%  S$=
  2684. encrypt($Manager%,
  2685. #F,S$
  2686.  I%=9 
  2687. q     
  2688. selected(passW%,I%)
  2689. close_file(F)
  2690. lit(menu%(1),6,
  2691. selected(passW%,9))
  2692. lit(menu%(1),7,
  2693. selected(passW%,13))
  2694. lit(menu%(1),8,
  2695. selected(passW%,13))
  2696. lit(menu%(1),2,
  2697. selected(passW%,14))
  2698. lit(menu%(3),8,
  2699. selected(passW%,15))
  2700. selected(passW%,9) 
  2701. close_window(keypadW%)
  2702. |        
  2703. }9    !block%=keypadW%:
  2704.  "Wimp_GetWindowState",,block%
  2705. ~5    block%!12=block%!4+660:block%!8=block%!16-328
  2706.     block%!20=0:block%!24=0
  2707. $    
  2708.  "Wimp_OpenWindow",,block%
  2709. close_window(passW%)
  2710.   warn%=
  2711. selected(passW%,16) 
  2712. $    
  2713. open_log("<Log$Dir>.Log",
  2714. %    
  2715. close_log("<Log$Dir>.Log")
  2716. selected(passW%,16) 
  2717. write_log(-1,"Logging disabled")
  2718. text(aclW%,0)="":$
  2719. text(aclW%,1)=""
  2720. open_window(aclW%):
  2721. set_caret(aclW%,0)
  2722.  F,id$,p$,p%,ptr%,user$,passwd$
  2723.  (b% 
  2724.  %111) 
  2725.  ic% 
  2726. !    
  2727. close_window(aclW%)
  2728. 5    
  2729. text(aclW%,0)<>"" 
  2730. text(aclW%,1)<>"" 
  2731. .      
  2732. text(aclW%,1)=$
  2733. text(aclW%,12) 
  2734. 1        user$=
  2735. encrypt(
  2736. text(aclW%,0)),
  2737. 3        passwd$=
  2738. encrypt(
  2739. text(aclW%,1)),
  2740.         
  2741.  acl% 
  2742. "          F=
  2743. ("<Acl$Dir>.acl")
  2744.           
  2745.             ptr%=
  2746.             
  2747. #F,id$,p$,p%
  2748. "            found%=(id$=user$)
  2749.           
  2750.  found% 
  2751. 2          
  2752.  found% 
  2753. #F=ptr%:
  2754. (id$),"Z")
  2755.           
  2756. $          
  2757. ("<Acl$Dir>.acl")
  2758.           acl%=
  2759.         
  2760. 6        
  2761. #F,user$,passwd$,
  2762. selected_esg(aclW%,1)-3
  2763.         
  2764. close_file(F)
  2765.         
  2766.  (b% 
  2767.  %111)=1 
  2768. 3          $
  2769. text(aclW%,0)="":$
  2770. text(aclW%,1)=""
  2771. 9          
  2772. redraw_icon(aclW%,0):
  2773. redraw_icon(aclW%,1)
  2774. !          
  2775. set_caret(aclW%,0)
  2776. $          
  2777. close_window(aclW%)
  2778.         
  2779.         
  2780.         
  2781. softerror("",108)
  2782. 2        $
  2783. text(aclW%,1)="":$
  2784. text(aclW%,12)=""
  2785. 8        
  2786. redraw_icon(aclW%,1):
  2787. redraw_icon(aclW%,12)
  2788.          
  2789. set_caret(aclW%,1) 
  2790.       
  2791.         
  2792. open_log(f$,resume%)
  2793.  "OS_File",5,f$ 
  2794.  d%=1 
  2795.   loghandle%=
  2796. #loghandle%=
  2797. #loghandle%
  2798.  resume% 
  2799. #loghandle%,"Logging resumed "+
  2800. #loghandle%,"Log opened "+
  2801. #loghandle%,"Database: "+$database%
  2802.   loghandle%=
  2803. #loghandle%,"Log started "+
  2804. #loghandle%,"Database: "+$database%
  2805.  acl% 
  2806. #loghandle%,"User: "+user$
  2807. #loghandle%,"Password level used: "+
  2808. (pw%)
  2809. #loghandle%,
  2810. 35,"-")
  2811. close_file(loghandle%)
  2812. logging%=
  2813. close_log(f$)
  2814.  logging% 
  2815.   loghandle%=
  2816. #loghandle%=
  2817. #loghandle%
  2818. #loghandle%,
  2819. 35,"-")
  2820. #loghandle%,"Log closed "+
  2821. #loghandle%,
  2822. 35,"=")
  2823. close_file(loghandle%)
  2824.  "OS_File",18,f$,&fff
  2825.   logging%=
  2826. write_log(record%,S$)
  2827.  loghandle%
  2828.  logging% 
  2829. #  loghandle%=
  2830. ("<Log$Dir>.Log")
  2831. #loghandle%=
  2832. #loghandle%
  2833.  record%>=0 
  2834. #loghandle%,"    [Record number: "+
  2835. (record%)+"]"
  2836. #loghandle%,"    "+S$
  2837. close_file(loghandle%)
  2838. count(key%,
  2839.  RU%)
  2840.  zero%,file%,top,sum%
  2841.     RU%=0
  2842.  file%=0 
  2843.   top=8*file%+LH%
  2844. "  sum%=
  2845. count_recs(key%,zero%)
  2846.   RU%+=sum%
  2847. text(miscW%,file%+22)=
  2848. (sum%)
  2849.  file%
  2850. count_recs(key%,
  2851.  ptr%)
  2852.  P%,count%,S%,R%,S$,k$
  2853.  "Hourglass_On"
  2854. neighbour(key%,top,1)
  2855.  P%<>top
  2856.   count%+=1
  2857.  ptr%>0 
  2858.     R%=
  2859. rec_no(k$,key%,P%)
  2860. #    
  2861.  R%>highest% 
  2862.  highest%=R%
  2863. 1    !ptr%=R%:$(ptr%+4)=k$:ptr%+=4+KL%(key%)+1
  2864.     flagptr%?R%=0
  2865.   P%=
  2866. neighbour(key%,P%,1)
  2867.  "Hourglass_Off"
  2868. =count%
  2869. analyse(func%)
  2870.  L%,P%,S%,S$,K$,k$,ptr%,pos%,N%,values%,key%
  2871.  S$(),N%()
  2872. read_print_options
  2873.  func%<0 
  2874.  L%=6 
  2875.  key%=func%:L%=KL%(key%)
  2876.  L%>8 
  2877.  Tab%(0)=Lmargin%+L%+6 
  2878.  Tab%(0)=Lmargin%+14
  2879. Tab%(1)=Tab%(0)+6
  2880.  func%<0 
  2881. :  Title$="Analysis of date field: "+Tag$(Fieldnumber%)
  2882.         5  Heading$=
  2883. pad(margin$+"Month",Tab%(0))+"Number"
  2884. B  $SaveName%=$database%+".PrintJobs.DateAn"+Tag$(Fieldnumber%)
  2885. /  Title$="Analysis of index: "+Index$(key%)
  2886. 8  Heading$=
  2887. pad(margin$+"Contents",Tab%(0))+"Number"
  2888. A  $SaveName%=$database%+".PrintJobs.IndAn"+Tag$(Fieldnumber%)
  2889. Title1$=
  2890. LenLine%=
  2891. (Heading$)+2
  2892. extend_named_sliding_block(lineanchor%,LenLine%+4)
  2893. extend_named_sliding_block(headanchor%,LenLine%+4):pos%=!headanchor%
  2894. heap_store(headanchor%,LenLine%,0,pos%,0,Heading$)
  2895. reportdest$="Window"
  2896. close_window(datadicW%)
  2897. Count%=0
  2898. list_head(0)
  2899.  "Hourglass_On"
  2900.  func%<0 
  2901. analyse_date 
  2902. analyse_index
  2903.  "Hourglass_Off"
  2904. rule_off(45)
  2905. ;Line$=
  2906. pad(margin$+"Total",Tab%(0))+
  2907. justify(
  2908. (N%),1,0)
  2909. @$(!lineanchor%)=Line$:
  2910. list_line(-1,lineanchor%,
  2911. (Line$),32)
  2912. rule_off(45)
  2913. screen_list
  2914. analyse_index
  2915. K$="***"
  2916. neighbour(key%,top,1)
  2917.  P%<>top
  2918.     R%=
  2919. rec_no(k$,key%,P%)
  2920.     (#    
  2921.  k$<>K$ 
  2922.  values%+=1:K$=k$
  2923.     )     P%=
  2924. neighbour(key%,P%,1)
  2925.  S$(values%),N%(values%)
  2926. K$="***"
  2927. neighbour(key%,top,1)
  2928.  P%<>top
  2929.     R%=
  2930. rec_no(k$,key%,P%)
  2931.     0E    
  2932.  k$<>K$ 
  2933.  ptr%+=1:K$=k$:S$(ptr%)=K$:N%(ptr%)=1 
  2934.  N%(ptr%)+=1
  2935.     1     P%=
  2936. neighbour(key%,P%,1)
  2937.  I%=1 
  2938.  ptr%
  2939.     4I  S$=S$(I%):
  2940.  S$="" 
  2941.  S$="<null>" 
  2942.  isadate% 
  2943. reverse_date(S$)
  2944.     5H  Line$=margin$+S$:Line$=
  2945. pad(Line$,Tab%(0))+
  2946. justify(
  2947. (N%(I%)),1,0)
  2948.     6B  $(!lineanchor%)=Line$:
  2949. list_line(-1,lineanchor%,
  2950. (Line$),32)
  2951.   N%+=N%(I%)
  2952. analyse_date
  2953.  S$(12),N%(12)
  2954.     =YS$()="<null>","Jan","Feb","Mar","Apr","May","Jun","Jul","Aug","Sep","Oct","Nov","Dec"
  2955.     >*dbasehandle%=
  2956. ($database%+".Database")
  2957. neighbour(key%,top,1)
  2958.  P%<>top
  2959.   R%=
  2960. rec_no(k$,key%,P%)
  2961.     B#  
  2962. readsmarray(dbasehandle%,R%)
  2963.   S$=F$(Fieldnumber%)
  2964.  S$<>"" 
  2965.     M%=
  2966. S$,4,2))
  2967.     N%(M%)+=1
  2968.  N%(0)+=1
  2969.   P%=
  2970. neighbour(key%,P%,1)
  2971. close_file(dbasehandle%)
  2972.  I%=0 
  2973.     ML  Line$=margin$+S$(I%):Line$=
  2974. pad(Line$,Tab%(0))+
  2975. justify(
  2976. (N%(I%)),1,0)
  2977.     NB  $(!lineanchor%)=Line$:
  2978. list_line(-1,lineanchor%,
  2979. (Line$),32)
  2980.   N%+=N%(I%)
  2981. update_stats
  2982. $filesize%=
  2983. (RA%)
  2984. $Records%=
  2985. (RA%)
  2986. $used%=
  2987. (RU%)
  2988.     W#$percent%=
  2989. (RU%*100/RA%))+"%"
  2990.  Keypress processing --------------------------------------------------
  2991. set_keyboard(wi%,ic%)
  2992.  validate% 
  2993.  wi% 
  2994.  mainW%:
  2995.     `!  
  2996.  chartype%((ic%+1) 
  2997.     a-    
  2998.  Leave keyboard status unchanged
  2999.     b$    
  3000.  2,4:
  3001.  "OS_Byte",202,0,239
  3002.     c!    
  3003.  "OS_Byte",202,16,111
  3004.     e'  
  3005.  accessW%:
  3006.  "OS_Byte",202,0,239
  3007.     f"  
  3008.  "OS_Byte",202,caps%,111
  3009.  "OS_Byte",118
  3010. process_key
  3011.  printing% 
  3012.  indexing% 
  3013.  T%,N$
  3014.  "Wimp_GetCaretPosition",,block%
  3015.     o4wi%=block%!0:ic%=block%!4:key_pressed%=block%!24
  3016.  wi% 
  3017.  mainW%:
  3018. main_press
  3019.  keypadW%:
  3020. keypad_press
  3021.  passW%:
  3022. dbox_press(4)
  3023.  aclW%:
  3024. dbox_press(9)
  3025.  changeW%:
  3026. dbox_press(4)
  3027.  tableW%:
  3028. dbox_press(26)
  3029.  saveW%:
  3030. dbox_press(2)
  3031.     x   
  3032.  datadicW%:
  3033. datadic_press
  3034.  printW%:
  3035. dbox_press(20)
  3036.  labelW%:
  3037. dbox_press(15)
  3038.  createW%:
  3039. create_press
  3040.  accessW%:
  3041. dbox_press(3)
  3042.  keyW%:
  3043. dbox_press(7)
  3044.     ~   
  3045.  savesubW%:
  3046. dbox_press(2)
  3047.  matchW%:
  3048. match_press
  3049.  moveW%:
  3050. dbox_press(8)
  3051.  calcW%:
  3052. dbox_press(1)
  3053.  mergeW%:
  3054. dbox_press(7)
  3055.  sizeW%:
  3056. dbox_press(4)
  3057.  csvW%:
  3058. dbox_press(9)
  3059. keypad_press
  3060.  key_pressed%=13 
  3061.  ic% 
  3062. !    
  3063. mouse(0,0,4,wi%,28)
  3064. !    
  3065. mouse(0,0,4,wi%,30)
  3066.  "Wimp_ProcessKey",key_pressed%
  3067. main_press
  3068. selected(passW%,10) 
  3069.  "Wimp_ProcessKey",key_pressed%:
  3070.  icon%
  3071.  flash% 
  3072. deselect(mainW%,field%(flash%)):flash%=
  3073.  key_pressed%<>392 
  3074. validate(Fieldnumber%,T%,N$)=
  3075. update_calcs(Fieldnumber%)
  3076.  key_pressed% 
  3077.  394:
  3078. show_keypad
  3079.  wi% 
  3080.  mainW%:
  3081. "      
  3082.  Fieldnumber%=fields% 
  3083. #        
  3084. close_window(relateW%)
  3085.         
  3086. display(key%,-1)
  3087.         
  3088.         
  3089. E          Fieldnumber%+=1:
  3090.  Fieldnumber%>fields% 
  3091.  Fieldnumber%=1
  3092. (          c%=chartype%(Fieldnumber%)
  3093. 2        
  3094.  len%(Fieldnumber%)>0 
  3095.  (c%<6 
  3096.  c%=8)
  3097. &        icon%=field%(Fieldnumber%)
  3098. $        
  3099. set_caret(mainW%,icon%)
  3100. *        
  3101.  relations%=
  3102. relations(
  3103.       
  3104.  398:
  3105. ?    Fieldnumber%+=1:
  3106.  Fieldnumber%>fields% 
  3107.  Fieldnumber%=1
  3108. "    c%=chartype%(Fieldnumber%)
  3109.  len%(Fieldnumber%)>0 
  3110.  (c%<6 
  3111.  c%=8)
  3112.    icon%=field%(Fieldnumber%)
  3113. set_caret(mainW%,icon%)
  3114.  relations%=
  3115. relations(
  3116.  399:
  3117. ?    Fieldnumber%-=1:
  3118.  Fieldnumber%<1 
  3119.  Fieldnumber%=fields%
  3120. "    c%=chartype%(Fieldnumber%)
  3121.  len%(Fieldnumber%)>0 
  3122.  (c%<6 
  3123.  c%=8)
  3124.    icon%=field%(Fieldnumber%)
  3125. set_caret(mainW%,icon%)
  3126.  relations%=
  3127. relations(
  3128.  389:
  3129.  Access% 
  3130. show_menu(changeW%,500,600)
  3131.  405:
  3132. (printorder$)=2 
  3133. B    Fieldnumber%=
  3134. fnum(printorder$):V%=chartype%(Fieldnumber%)
  3135.       
  3136.  36,39:
  3137. F      
  3138. blob_path(
  3139. ,$database%,REC%,Fieldnumber%,V%,object$)>=0 
  3140.         
  3141. set_up_field_menu
  3142. &        
  3143. show_menu(saveW%,500,600)
  3144.       
  3145.         
  3146.  408:
  3147. val_on_off
  3148.  387:
  3149. mouse(0,0,4,keypadW%,2)
  3150.  403:
  3151. mouse(0,0,4,keypadW%,3)
  3152.  386:
  3153. mouse(0,0,4,keypadW%,4)
  3154.  402:
  3155. mouse(0,0,4,keypadW%,5)
  3156.  391:
  3157. mouse(0,0,4,keypadW%,6)
  3158.  407:
  3159. mouse(0,0,4,keypadW%,7)
  3160.  393:
  3161. mouse(0,0,4,keypadW%,8)
  3162.  409:
  3163. mouse(0,0,4,keypadW%,9)
  3164.  388:
  3165. mouse(0,0,4,keypadW%,10)
  3166.  404:
  3167. mouse(0,0,4,keypadW%,11)
  3168.  420:
  3169. mouse(0,0,4,keypadW%,12)
  3170.  385:
  3171. mouse(0,0,4,keypadW%,13)
  3172.  401:
  3173. mouse(0,0,1,keypadW%,13)
  3174.  458:
  3175. mouse(0,0,4,keypadW%,14)
  3176.  390:
  3177. mouse(0,0,4,keypadW%,15)
  3178.  406:
  3179. mouse(0,0,4,keypadW%,16)
  3180.  422:
  3181. mouse(0,0,4,keypadW%,17)
  3182.  392:
  3183. mouse(0,0,4,keypadW%,18)
  3184.  384:
  3185. print_this
  3186.  400:
  3187. match
  3188.  416:
  3189. open_window(printW%)
  3190.  "Wimp_ProcessKey",key_pressed%
  3191.  validate% 
  3192.  chartype%(Fieldnumber%) 
  3193. -    
  3194.  Leave keyboard status unchanged
  3195. $    
  3196.  2,4:
  3197.  "OS_Byte",202,0,239
  3198. !    
  3199.  "OS_Byte",202,16,111
  3200.  "OS_Byte",118
  3201.  "OS_Byte",15,0
  3202. dbox_press(ok%)
  3203.  key_pressed% 
  3204. next_writeable(wi%,ic%,1,1)=
  3205. mouse(0,0,4,wi%,ok%)
  3206. close_window(wi%):
  3207. set_caret(mainW%,-1)
  3208.  398:f%=
  3209. next_writeable(wi%,ic%,1,0)
  3210.  399:f%=
  3211. next_writeable(wi%,ic%,-1,0)
  3212.  "Wimp_ProcessKey",key_pressed%
  3213. datadic_press
  3214.  icons%
  3215. icons%=Rows%*(TabFields%+1)
  3216.  key_pressed% 
  3217.  ic%<icons%-1 
  3218. set_caret(datadicW%,ic%+1)
  3219.  398:
  3220.  ic%<icons%-TabFields%-1 
  3221. set_caret(datadicW%,ic%+TabFields%+1)
  3222.  399:
  3223.  ic%>=TabFields%+1 
  3224. set_caret(datadicW%,ic%-TabFields%-1)
  3225.  "Wimp_ProcessKey",key_pressed%
  3226. create_press
  3227. shaded(wi%,29):
  3228. shaded(wi%,18) 
  3229. dbox_press(18)
  3230. shaded(wi%,29) 
  3231. dbox_press(29)
  3232. match_press
  3233.  key_pressed% 
  3234. mouse(0,0,4,matchW%,1)
  3235. close_window(matchW%):
  3236.  "Wimp_SetCaretPosition",mainW%,-1
  3237.  384:
  3238. print_this
  3239.  "Wimp_ProcessKey",key_pressed%
  3240. menu_select
  3241.  handle%,P%,Q%,I%
  3242. &choice1%=!block%:choice2%=block%!4
  3243. (choice3%=block%!8:choice4%=block%!12
  3244.  "Wimp_DecodeMenu",,menuhandle%,block%,choices%
  3245.  I%=1 
  3246.   Q%=
  3247. $choices%,".",P%+1)
  3248. &  choice$(I%)=
  3249. $choices%,P%,Q%-P%)
  3250.   P%=Q%+1
  3251.  "Wimp_GetPointerInfo",,block%
  3252. redo%=block%!8=1
  3253.  menuhandle% 
  3254.  menu%(0):
  3255.  choice$(1) 
  3256.  8    
  3257.  "Help":
  3258.  "Wimp_StartTask","<Pbase$Dir>.!Help"
  3259. !G    
  3260.  "Save choices":
  3261. save_choices("<Pbase$Dir>.Resources.Choices")
  3262. "J    
  3263.  "Default choices":
  3264. get_choices("<Pbase$Dir>.Resources.Defaults")
  3265.  "Utilities":
  3266.  choice$(2) 
  3267.       
  3268.  "New primary key":
  3269.       $KeyTitle%=choice$(2)
  3270. '-      keyfunc$=choice$(2):
  3271. set_keydata(0)
  3272. (I      
  3273. shade_key_icons(
  3274. selected(keyW%,24),
  3275. selected(keyW%,24),
  3276.       
  3277.  (present% 
  3278.  2)=2 
  3279. */        
  3280. select(keyW%,8):
  3281. deselect(keyW%,9)
  3282. +;        
  3283. icon_bit(22,keyW%,8,
  3284. icon_bit(22,keyW%,9,
  3285.         
  3286. -/        
  3287. select(keyW%,9):
  3288. deselect(keyW%,8)
  3289. .;        
  3290. icon_bit(22,keyW%,8,
  3291. icon_bit(22,keyW%,9,
  3292.       
  3293. 0       
  3294. set_height(keyW%,700)
  3295. 1J      
  3296. selected(keyW%,24):
  3297. set_caret(keyW%,26) 
  3298. set_caret(keyW%,2)
  3299. 2       
  3300.  "New record format":
  3301. 3!      
  3302. close_window(reformW%)
  3303. 4       
  3304. confirm(
  3305. msg(28)) 
  3306.         reform$="Reformat"
  3307. 6.        $RefmTitle%="Change record format"
  3308. 7%        
  3309. set_height(reformW%,220)
  3310.       
  3311.       
  3312.  "Adjust format":
  3313.       
  3314. adjust_on(
  3315.       
  3316. open_window(mainW%)
  3317.       
  3318. display(key%,-1)
  3319. =5      
  3320. alter_flags(&17016731,&07006535,&1700653B)
  3321.       
  3322.  "Merge database":
  3323. ?!      
  3324. close_window(reformW%)
  3325.       reform$="Merge"
  3326. A&      $RefmTitle%="Merge database"
  3327. B#      
  3328. set_height(reformW%,360)
  3329.       
  3330.  "Balance index":
  3331.       
  3332.  choice$(3) 
  3333.         
  3334.  "Automatic":
  3335.         
  3336.  choice4%=0 
  3337. G!          
  3338. set_autobalance(
  3339. H8          
  3340. set_autobalance(
  3341. ticked(menu%(21),0))
  3342.         
  3343. J(        
  3344.  "Right now":
  3345. balance(key%)
  3346.       
  3347.       
  3348.  "Print index":
  3349.       
  3350.  choice$(3) 
  3351.         
  3352.  "Complete":
  3353. O)        
  3354. print_tree(key%,file%,"ALL")
  3355.         
  3356.  "Totals only":
  3357. Q,        
  3358. print_tree(key%,file%,"TOTALS")
  3359.       
  3360. S5      
  3361.  "Find duplicates":
  3362. duplicates(key%,file%)
  3363. TC      
  3364.  "Warn of duplicates":dup%=
  3365.  dup%:
  3366. tick(menu%(3),8,dup%)
  3367. U        
  3368. V#    
  3369.  "Close database":
  3370. exit(0)
  3371. W%    
  3372.  "Abandon database":
  3373. exit(1)
  3374.  "Quit":quit%=
  3375.  menu%(1):
  3376.  choice$(1) 
  3377.  "CSV options"
  3378.     $CSVTitle%=choice$(1)
  3379. icon_bit(22,csvW%,0,
  3380. _6    !block%=csvW%:
  3381.  "Wimp_GetWindowState",,block%
  3382. `-    block%!4=oldx%:block%!12=block%!4+390
  3383. a8    block%!8=200:block%!16=block%!8+420:block%!28=-1
  3384. b$    
  3385.  "Wimp_OpenWindow",,block%
  3386.  "Miscellaneous":
  3387.  choice$(2) 
  3388. e0      
  3389.  "Set passwords":
  3390. open_window(passW%)
  3391. f9      
  3392.  "Edit template":template%=1:
  3393. display(key%,-1)
  3394. g0      
  3395.  "Save indices":
  3396. set_auto(2-choice3%)
  3397. h        
  3398.  "Current key":
  3399. j1    $KeyTitle%=choice$(1):keyfunc$=choice$(1)
  3400. set_keydata(key%)
  3401. l8    
  3402. shade_key_icons(
  3403. set_height(keyW%,590)
  3404.  "Print":
  3405.  choice$(2) 
  3406.       
  3407.  "Match":
  3408. match
  3409. p'      
  3410.  "Show resources":*Resources
  3411. qB      
  3412.  "Options":
  3413. open_window(printW%):
  3414. set_caret(printW%,16)
  3415.       
  3416.  "Save options":
  3417. s5      $SaveName%=$database%+".PrintRes.PrintOpts"
  3418. t6      savefunc$=choice$(2):
  3419. save_click(saveW%,2,4)
  3420.       
  3421.  "Save query":
  3422. v1      $SaveName%=$database%+".PrintRes.Query"
  3423. w6      savefunc$=choice$(2):
  3424. save_click(saveW%,2,4)
  3425.       
  3426.  "Save selection":
  3427. y5      $SaveName%=$database%+".PrintRes.Selection"
  3428. z6      savefunc$=choice$(2):
  3429. save_click(saveW%,2,4)
  3430. {&      
  3431.  "Show jobs done":*JobsDone
  3432. |.      
  3433.  "Clear selection":
  3434. clear_selection
  3435. }$      
  3436.  "Select all":
  3437. select_all
  3438.       
  3439. match
  3440.         
  3441.  "Validation":
  3442.  choice$(2) 
  3443. F      
  3444.  "Create table":
  3445. open_window(tableW%):
  3446. set_caret(tableW%,0)
  3447.       
  3448.  "Display table":
  3449.       
  3450.  choice3%>=0 
  3451. !        Tablenumber%=choice3%
  3452. %        
  3453. show_table(Tablenumber%)
  3454.       
  3455. &      
  3456.  "Show table files":*Tables
  3457. (      
  3458.  "Validate input":
  3459. val_on_off
  3460. Q      
  3461.  "Show relations":relations%=
  3462.  relations%:
  3463. tick(menu%(2),4,relations%)
  3464.         
  3465. $    
  3466.  "Show keypad":
  3467. show_keypad
  3468. =    
  3469.  "Save choices":
  3470. save_choices($database%+".Choices")
  3471. %    
  3472.  "Undo changes":
  3473. restore_rec
  3474. 8    
  3475.  "Help":
  3476.  "Wimp_StartTask","<Pbase$Dir>.!Help"
  3477.  choice$(2) 
  3478.       
  3479.  "Index field":
  3480. 3      $KeyTitle%=choice$(2):keyfunc$=choice$(2)
  3481. /      
  3482. deselect(keyW%,20):
  3483. select(keyW%,24)
  3484. #      
  3485. shade_key_icons(
  3486.        
  3487. set_height(keyW%,590)
  3488. J      
  3489. selected(keyW%,24):
  3490. set_caret(keyW%,26) 
  3491. set_caret(keyW%,2)
  3492. =      
  3493.  "Analyse index":
  3494. analyse(
  3495. is_a_key(Fieldnumber%))
  3496. )      
  3497.  "Analyse months":
  3498. analyse(-1)
  3499. 0      
  3500.  "Link to table":
  3501. open_window(linkW%)
  3502.       
  3503.  "Start editing":
  3504. )      starthere%=field%(Fieldnumber%)
  3505. 3      
  3506.  Access% 
  3507. set_caret(mainW%,starthere%)
  3508. [      
  3509.  "Clear contents":
  3510. delete_blob(Fieldnumber%,object$,mainW%,field%(Fieldnumber%))
  3511. (      
  3512.  chartype%(Fieldnumber%)=40 
  3513. Q        
  3514. show_picture(Fieldnumber%):
  3515. redraw_icon(mainW%,field%(Fieldnumber%))
  3516.       
  3517. 0      
  3518.  "Warn of delete":delwarn%=
  3519.  delwarn%
  3520. %      
  3521. tick(menu%(10),7,delwarn%)
  3522. 7      
  3523.  "Undo changes":
  3524. restore(Fieldnumber%,"",-1)
  3525.         
  3526.  menu%(9):
  3527.  choice$(1) 
  3528. F    
  3529.  "Design field":
  3530. open_window(createW%):
  3531. set_caret(createW%,4)
  3532.  "Save form file":
  3533. %    $SaveName%=$database%+".Form"
  3534. 4    savefunc$=choice$(1):
  3535. save_click(saveW%,2,4)
  3536.  "Default database":
  3537. &    
  3538. save_form($database%+".Form")
  3539. get_it_in($database%)
  3540. first_field>0 
  3541.       
  3542. default_key
  3543. %      
  3544. defaults($database%,100,0)
  3545.       
  3546. softerror("",35)
  3547.         
  3548.  "Primary key":
  3549.     $KeyTitle%=choice$(1)
  3550.     keyfunc$=choice$(1)
  3551. "    case%(0)=
  3552. set_keydata(0)
  3553. -    
  3554. deselect(keyW%,20):
  3555. select(keyW%,24)
  3556. !    
  3557. shade_key_icons(
  3558. set_height(keyW%,590)
  3559. H    
  3560. selected(keyW%,24):
  3561. set_caret(keyW%,26) 
  3562. set_caret(keyW%,2)
  3563.  "Quit design":
  3564. adjust_on(
  3565. &    
  3566. save_form($database%+".Form")
  3567. get_it_in($database%)
  3568.  menu%(17):
  3569. "  T%=
  3570. table_number($menu%(17))
  3571.  choice$(1) 
  3572.  "Save":
  3573. 6    $SaveName%=$database%+".ValTables."+table$(T%)
  3574. 6    savefunc$="Save table":
  3575. save_click(saveW%,2,4)
  3576. "    
  3577.  "Clear":
  3578. clear_table(T%)
  3579. "    
  3580.  "Print":
  3581. print_table(T%)
  3582. ,    
  3583.  "Sort":
  3584. sort_table(T%,tablefield%)
  3585. /    
  3586.  "Undo all":
  3587. restore_table(T%,tablen%)
  3588. )    
  3589.  "Undo change":
  3590. restore_tabfield
  3591.  menu%(18):
  3592.  choice$(1) 
  3593.  "Save as text":
  3594. 4    savefunc$=choice$(1):
  3595. save_click(saveW%,2,4)
  3596.  "Sort":
  3597. sort_list
  3598.  "Scrap":
  3599. lose_list
  3600.  menu%(15):
  3601.  choice$(1) 
  3602.  "Comma":sep$=","
  3603.  "TAB":sep$=
  3604.  "CR":sep$=
  3605.  "LF":sep$=
  3606.  sep$=$Delim%
  3607. tick_one(menuhandle%,0,3,choice1%)
  3608. text(csvW%,14)=choice$(1)
  3609. redraw_icon(csvW%,14)
  3610.  menu%(20):
  3611.  choice$(1) 
  3612.  "CR":term$=
  3613.  "LF":term$=
  3614. #    
  3615.  "CR LF":term$=
  3616. (13)+
  3617. #    
  3618.  "LF CR":term$=
  3619. (10)+
  3620. #    
  3621.  "CR CR":term$=
  3622. (13)+
  3623. #    
  3624.  "LF LF":term$=
  3625. (10)+
  3626. :term$=$Termin%
  3627. tick_one(menuhandle%,0,5,choice1%)
  3628. text(csvW%,15)=choice$(1)
  3629. redraw_icon(csvW%,15)
  3630.  menu%(8),menu%(11),menu%(14),menu%(16),menu%(19):
  3631. $  fieldtype%=firsttype%+choice1%
  3632. tick_one(menuhandle%,0,lasttype%-firsttype%,choice1%)
  3633. update_box
  3634.  tablemenu%:
  3635.   Tablenumber%=choice1%
  3636. &  $Tablename%=table$(Tablenumber%)
  3637. tick_one(menuhandle%,0,LastTable%,choice1%)
  3638. redraw_icon(linkW%,0)
  3639.  fieldmenu%:
  3640.  fieldfunc$ 
  3641.  "match":
  3642.     Match_tag%=choice1%+1
  3643. B    $
  3644. text(matchW%,3)=Tag$(Match_tag%):
  3645. redraw_icon(matchW%,3)
  3646. 2    
  3647. tick_one(fieldmenu%,0,fields%-1,choice1%)
  3648.  "first":
  3649. #    
  3650.  keyfunc$<>"Current key" 
  3651. *      
  3652. ticked(fieldmenu%,choice1%) 
  3653. 8        Keyfld0%=0:$F1dkey%="":
  3654. redraw_icon(keyW%,0)
  3655. (        
  3656. tick(fieldmenu%,choice1%,
  3657.         
  3658.         Keyfld0%=choice1%+1
  3659. 9        $F1dkey%=Tag$(Keyfld0%):
  3660. redraw_icon(keyW%,0)
  3661. 6        
  3662. tick_one(fieldmenu%,0,fields%-1,choice1%)
  3663.       
  3664.         
  3665.  "second":
  3666. #    
  3667.  keyfunc$<>"Current key" 
  3668.     *      
  3669. ticked(fieldmenu%,choice1%) 
  3670. 8        Keyfld1%=0:$F2dkey%="":
  3671. redraw_icon(keyW%,1)
  3672. (        
  3673. tick(fieldmenu%,choice1%,
  3674.         
  3675.         Keyfld1%=choice1%+1
  3676. 9        $F2dkey%=Tag$(Keyfld1%):
  3677. redraw_icon(keyW%,1)
  3678. 6        
  3679. tick_one(fieldmenu%,0,fields%-1,choice1%)
  3680.       
  3681.         
  3682. special_select
  3683.  quit% 
  3684.  redo% 
  3685. show_menu(menuhandle%,menux%,menuy%)
  3686. init_drag(wi%,ic%,dragtype%)
  3687. getscreensize(W%,H%)
  3688. !block%=wi%
  3689.  "Wimp_GetWindowState",,block%
  3690. ysize%=block%!16-block%!8
  3691. x%=block%!4-block%!20
  3692. y%=block%!16-block%!24
  3693. block%!4=ic%
  3694.  "Wimp_GetIconState",,block%
  3695. block%!8+=x%:minx%=block%!8
  3696. %!block%!12+=y%:miny%=block%!12
  3697. &!block%!16+=x%:maxx%=block%!16
  3698. '!block%!20+=y%:maxy%=block%!20
  3699.  dragtype%=6 
  3700. )5  block%!24=2*minx%-maxx%:block%!36=2*maxy%-miny%
  3701.  block%!24=0:block%!36=H%
  3702. block%!28=0
  3703. block%!32=W%
  3704. !block%=0
  3705. block%!4=dragtype%
  3706. dragging%=
  3707.  wi% 
  3708.  saveW%,savesubW%:
  3709.  RISCOS3 
  3710. 4M    
  3711.  wi%=saveW% 
  3712.  sprite$=
  3713. $SaveSprite%,2,8) 
  3714.  sprite$=
  3715. $SubSprite%,2,8)
  3716. 55    
  3717.  "DragASprite_Start",&C5,1,sprite$,block%+8
  3718. 6#    
  3719.  "Wimp_DragBox",,block%
  3720.  "Wimp_DragBox",,block%
  3721.  wi%=mainW% 
  3722.  ficon%=ic%
  3723. end_drag(start%,end%)
  3724.  wi%,ic%
  3725. dragging%=
  3726. datasize%=end%-start%
  3727.  "Wimp_GetPointerInfo",,block%
  3728. wi%=block%!12:ic%=block%!16
  3729. D7block%!32=block%!4:block%!28=block%!0:block%!24=ic%
  3730. block%!20=wi%:block%!16=1
  3731. F3block%!12=0:block%!36=datasize%:block%!40=Type%
  3732.  design% 
  3733. adjust_field(dragbutt%)
  3734.  Filename$<>"" 
  3735.  wi%<>mainW% 
  3736. K%    $(block%+44)=
  3737. leaf(Filename$)
  3738.     !block%=60
  3739. M/    
  3740.  "Wimp_SendMessage",17,block%,wi%,ic%
  3741.     ramptr%=start%
  3742. O     
  3743.  "Wimp_CreateMenu",,-1
  3744. encrypt(S$,Z%)
  3745.  I%,R%
  3746. (-12817)
  3747.  I%=1 
  3748.   R%=
  3749. (58)-1
  3750.  R%=58-R%
  3751. S$,I%,1)=
  3752. S$,I%,1))-65+R%) 
  3753.  58+65)
  3754. leaf(s$)
  3755. s2$=""
  3756. s$)<>"." 
  3757.  s$<>""
  3758.   s2$=
  3759. s$)+s2$
  3760.   s$=
  3761. dbasepath$=
  3762.  Message handling ----------------------------------------------------
  3763. not_acknowledged
  3764.  block%!16 
  3765.  DataOpen failed, so run file
  3766.  block%!8=Impref% 
  3767.  Imp_wait%=
  3768.  "Wimp_StartTask",$(block%+44)
  3769.  RAMTransmit failed
  3770.  merging% 
  3771.  moan_err%,
  3772. msg(39)
  3773.  DataLoad failed, so delete scrapfile (if ours)
  3774.  block%!8=myref% 
  3775.  "OS_File",6,block+44
  3776.  moan_err%,
  3777. msg(39)
  3778.  &80142:
  3779.  moan_err%,
  3780. msg(90)
  3781. message
  3782.  task%,ref%,myref%
  3783. | task%=block%!4:ref%=block%!8
  3784.  block%!16 
  3785.  0:quit%=
  3786.  ### DataSave ###
  3787.  task%<>mytask% 
  3788.  present%=7 
  3789.     datasize%=block%!36
  3790.  block%!40 
  3791.        
  3792.  &fff,&ff9,&aff,&dfe:
  3793.       myref%=ref%
  3794. >      block%!0=256:block%!12=ref%:block%!16=2:block%!36=-1
  3795. *      $(block%+44)="<Wimp$Scrap>"+
  3796. /      
  3797.  "Wimp_SendMessage",17,block%,task%
  3798.         
  3799.  ### DataSaveAck ###
  3800. save(
  3801. getstr(block%+44),Type%,Start%,End%):
  3802. write_log(-1,
  3803. getstr(block%+44)+" saved")
  3804. 8  myref%=ref%:block%!12=ref%:block%!16=3:!block%=256
  3805.  "Wimp_SendMessage",18,block%,task%
  3806.  "Wimp_CreateMenu",,-1
  3807.  ### DataLoad ###
  3808. ,  myref%=block%!12:f$=
  3809. getstr(block%+44)
  3810. get_it_in(f$)
  3811.  myref%<>0 
  3812.  "OS_CLI","Remove <Wimp$Scrap>"
  3813.  ### DataLoadAck ###
  3814.  block%!12=Impref% 
  3815.  merging% 
  3816. start_merge
  3817.  ### DataOpen - response to file double click ###
  3818.  block%!40 
  3819.  &7f1,&7f3,&7f4,&7f5:
  3820.  present%=7 
  3821. 0      block%!0=20:block%!12=ref%:block%!16=4
  3822. )      
  3823.  "Wimp_SendMessage",17,block%
  3824. (      
  3825. get_it_in(
  3826. getstr(block%+44))
  3827.         
  3828.  &2000:
  3829.  kill% 
  3830.  present%=0 
  3831. 2      
  3832.  ### Is it a Powerbase application? ###
  3833. *      f$=
  3834. getstr(block%+44)+".Colours"
  3835. '      
  3836.  "OS_File",5,f$ 
  3837.  d%,,type%
  3838. !      type%=(type%>>8) 
  3839.  &fff
  3840.       
  3841.  d%=1 
  3842.  type%=&ffd 
  3843. 2        block%!0=20:block%!12=ref%:block%!16=4
  3844. +        
  3845.  "Wimp_SendMessage",17,block%
  3846. *        
  3847. get_it_in(
  3848. getstr(block%+44))
  3849.       
  3850.         
  3851.  savefunc$<>"Save list" 
  3852.  savefunc$<>"Export CSV" 
  3853. ram_transmit
  3854.  10: 
  3855.  ### Desktop boot file
  3856. F    
  3857.  "OS_GSTrans","Run <PBase$Dir>",block%+&100,&f00 
  3858.  ,bootcmd$
  3859. #block%!20,bootcmd$
  3860.  &502:
  3861. help_message(block%!32,block%!36)
  3862.  &400C2:
  3863. getscreensize(ScreenWidth%,ScreenHeight%)
  3864.  &400C0:
  3865. message_menu_select
  3866.  &80140:
  3867.  ### PrintFile - ignore ###
  3868. ram_transmit
  3869.  datasize%>block%!24 
  3870.  tosend%=block%!24 
  3871.  tosend%=datasize%
  3872.  "Wimp_TransferBlock",mytask%,ramptr%,block%!4,block%!20,tosend%
  3873. block%!24=tosend%
  3874. datasize%-=tosend%
  3875. ramptr%+=tosend%
  3876. block%!12=block%!8
  3877. block%!16=7
  3878.  "Wimp_SendMessage",18+(datasize%=0),block%,block%!4
  3879. message_menu_select
  3880.  P%,Q%,I%
  3881. keyfunc$="":savefunc$=""
  3882. 5handle%=block%!20:xmin%=block%!24:ymax%=block%!28
  3883.  "Wimp_DecodeMenu",,menuhandle%,block%+32,choices%
  3884.  I%=1 
  3885.   Q%=
  3886. $choices%,".",P%+1)
  3887. &  choice$(I%)=
  3888. $choices%,P%,Q%-P%)
  3889.   P%=Q%+1
  3890.  menuhandle% 
  3891.  menu%(0):
  3892.  choice$(1) 
  3893.  "New database":
  3894.     $SaveName%="!DataBase"
  3895. 2    $SaveSprite%="snew_appl;Pptr_hand,12,8;B3"
  3896.     savefunc$=choice$(1)
  3897.  menu%(1):
  3898.  choice$(1) 
  3899. 6    
  3900.  "Information":
  3901. count(key%,RU%):
  3902. update_stats
  3903.  "Print":
  3904.  choice$(2) 
  3905.       
  3906.  "Save options":
  3907. 5      $SaveName%=$database%+".PrintRes.PrintOpts"
  3908. 4      $SaveSprite%="sfile_7f5;Pptr_hand,12,8;B3"
  3909.       
  3910.  "Save query":
  3911. 1      $SaveName%=$database%+".PrintRes.Query"
  3912. 4      $SaveSprite%="sfile_7f4;Pptr_hand,12,8;B3"
  3913.       
  3914.  "Save selection":
  3915. 5      $SaveName%=$database%+".PrintRes.Selection"
  3916. 4      $SaveSprite%="sfile_7f3;Pptr_hand,12,8;B3"
  3917.         
  3918.     savefunc$=choice$(2)
  3919.  "Miscellaneous":
  3920.  choice$(2) 
  3921.       
  3922.  "Batch delete":
  3923. C      
  3924. select(moveW%,2):
  3925. deselect(moveW%,1):
  3926. deselect(moveW%,0)
  3927. +      
  3928.  common% 
  3929. text(moveW%,7)=""
  3930.       
  3931.  "Colours":
  3932.       ncol%()=fcol%()
  3933.       
  3934.  I%=0 
  3935. .        
  3936. set_icon_cols(colW%,I%,ncol%(I%))
  3937.       
  3938. 8      !block%=colW%:
  3939.  "Wimp_GetWindowState",,block%
  3940. #      width%=block%!12-block%!4
  3941. /      block%!4=xmin%:block%!12=xmin%+width%
  3942. 0      block%!8=ymax%-height%:block%!16=ymax%
  3943.         
  3944.  "Export subset":
  3945. A    export%=
  3946. :$SubTitle%="Export subset":savefunc$=choice$(1)
  3947. V    $SubName%=$database%+".PrintJobs.!Subset":
  3948.  common% 
  3949. text(savesubW%,0)=""
  3950. 1    $SubSprite%="snew_appl;Pptr_hand,12,8;B3"
  3951.  "Export CSV":
  3952. 9    $SubTitle%="Export CSV file":savefunc$=choice$(1)
  3953. :    
  3954.  sep$="," 
  3955.  t$="dfe":f$="CSV" 
  3956.  t$="fff":f$="Sep"
  3957. Y    $SubName%=$database%+".PrintJobs."+f$+"file":
  3958.  common% 
  3959. text(savesubW%,0)=""
  3960. 4    $SubSprite%="sfile_"+t$+";Pptr_hand,12,8;B3"
  3961.  menu%(9):
  3962.  choice$(1) 
  3963.  "Save form file":
  3964. %    $SaveName%=$database%+".Form"
  3965. 2    $SaveSprite%="sfile_7f2;Pptr_hand,12,8;B3"
  3966.     savefunc$=choice$(1)
  3967.  menu%(17):
  3968.  choice$(1) 
  3969.  "Save":
  3970. &    T%=
  3971. table_number($menuhandle%)
  3972. 6    $SaveName%=$database%+".ValTables."+table$(T%)
  3973. 2    $SaveSprite%="sfile_7f1;Pptr_hand,12,8;B3"
  3974.     savefunc$="Save table"
  3975.  menu%(18):
  3976.  choice$(1) 
  3977.  "Save as text":
  3978. 2    $SaveSprite%="sfile_fff;Pptr_hand,12,8;B3"
  3979.   savefunc$=choice$(1)
  3980.  "Wimp_CreateSubMenu",,handle%,xmin%,ymax%
  3981. help_message(wi%,ic%)
  3982.  wi% 
  3983. send_help(75)
  3984.  infoW%:
  3985. send_help(76)
  3986.  miscW%:
  3987. send_help(77)
  3988.  mainW%:
  3989.  design% 
  3990.  ic%>=0 
  3991.     F%=(ic%+1) 
  3992.  chartype%(F%) 
  3993. A      
  3994.  0,1,2,3,4,5,6,7,8,36,39,41,42,43,44,45:
  3995. send_help(78)
  3996. +      
  3997.  "Interface_SendHelp",,block%
  3998.          
  3999.  pselectW%:
  4000. send_help(79)
  4001.  relateW%:
  4002. send_help(80)
  4003.  listW%:
  4004. send_help(81)
  4005.  datadicW%:
  4006. send_help(82)
  4007.  saveW%:
  4008. send_help(83)
  4009.  savesubW%:
  4010. send_help(84)
  4011.  accessW%:
  4012. send_help(85)
  4013.  mergeW%:
  4014. send_help(86)
  4015.  "Interface_SendHelp",,block%
  4016. send_help(M%)
  4017. !block%=256
  4018. block%!12=ref%
  4019. block%!16=&503
  4020. $(block%+20)=
  4021. msg(M%)
  4022.  "Wimp_SendMessage",17,block%,block%!4
  4023.  File saving --------------------------------------------------------
  4024. save_all_tables
  4025.  "Hourglass_On"
  4026.  T%<=LastTable%
  4027. =,  f$=$database%+".ValTables."+table$(T%)
  4028. >E  $TabTitle%=
  4029. table_info(T%,Rows%,TabFields%,Rec%,tabfieldlen%())
  4030. ?7  Start%=!tabanchor%(T%):End%=Start%+160+Rows%*Rec%
  4031. save(f$,&7f1,Start%,End%)
  4032.   T%+=1
  4033.  "Hourglass_Percentage",T%*100 
  4034.  (LastTable%+1)
  4035.  "Hourglass_Off"
  4036. save_options
  4037.  F,I%,ic%
  4038.  I%=1 
  4039. selected(printW%,ic%)
  4040.  I%=1 
  4041. text(printW%,ic%)
  4042.  I%=1 
  4043. selected(printW%,ic%)
  4044.  I%=1 
  4045. selected(labelW%,ic%)
  4046.  I%=1 
  4047. text(labelW%,ic%)
  4048.  I%=1 
  4049. selected(labelW%,ic%)
  4050. close_file(F)
  4051.  "OS_File",18,f$,&7f5
  4052.  1,2,4,6,7,8,23,24,25,26,38,39,41:REM Radio buttons
  4053.  15,16,17,18,30,32,34,43,45:REM Writable fields
  4054.  10,11,12,19,29,40,42:REM Option switches
  4055.  In Label Definition window
  4056.  0,1,2:REM Radio buttons
  4057.  4,6,10,12,17:REM Writeable fields
  4058.  11,13,16:REM Option switches
  4059. save(f$,ft%,start%,end%)
  4060.  ft% 
  4061.   leaf$=
  4062. leaf(f$)
  4063. leaf$,1)<>"!" 
  4064.  leaf$="!"+leaf$
  4065. u"  f$=dbasepath$+"."+
  4066. leaf$,10)
  4067.  "OS_File",8,f$:
  4068.  Create new database directory
  4069.  "OS_File",8,f$+".Indices"
  4070.  "OS_File",8,f$+".ValTables"
  4071.  "OS_File",8,f$+".PrintRes"
  4072.  "OS_File",8,f$+".PrintJobs"
  4073.  "OS_CLI","Copy <PBase$Dir>.Resources.Temp.!Run "+f$+".!Run ~C~V"
  4074.  "OS_CLI","Copy <PBase$Dir>.Resources.Temp.!Boot "+f$+".!Boot ~C~V"
  4075.  "OS_CLI","Copy <PBase$Dir>.Resources.chkspr "+f$+".chkspr ~C~V"
  4076.  "OS_CLI","Copy <PBase$Dir>.Resources.Colours "+f$+".Colours ~C~V"
  4077. copy_database_spritefile(f$,
  4078. leaf(f$))
  4079. $    
  4080.  export%:
  4081. export_subset(f$)
  4082.  csvconv%:
  4083.  !formanchor%=0 
  4084. 4      
  4085. extend_named_sliding_block(formanchor%,0)
  4086.       Fptr%=!formanchor%
  4087. "      fields%=0:Fieldnumber%=0
  4088. "      fields%=
  4089. get_form(Fptr%)
  4090.         
  4091. lit(menu%(0),1,
  4092. get_it_in(f$)
  4093. open_window(mainW%)
  4094.  !formanchor%=0 
  4095. 4      
  4096. extend_named_sliding_block(formanchor%,0)
  4097.       Fptr%=!formanchor%
  4098. "      fields%=0:Fieldnumber%=0
  4099.         
  4100. close_window(saveW%)
  4101.  &7f2:
  4102. save_form(f$):
  4103. get_it_in($database%)
  4104.  &7f5:
  4105. save_options
  4106.  &dfe:
  4107. write_csv(f$,$
  4108. text(savesubW%,0),
  4109. selected(savesubW%,5))
  4110.  savetofile%:
  4111.     texthandle%=
  4112. "    
  4113. do_it(Search$,displayed%)
  4114. +    
  4115.  "OS_File",10,f$,ft%,,start%,end%
  4116. )    
  4117. scrap_sliding_block(saveanchor%)
  4118. warn%=
  4119. getstr(p%)
  4120.  ?p%>31
  4121.   p$+=
  4122. (?p%)
  4123.   p%+=1
  4124.  Validation tables ----------------------------------------------------
  4125. create_table
  4126.  I%,title$,Rec%,L%
  4127. Iname$=$
  4128. text(tableW%,0):L%=
  4129. (name$):
  4130.  name$="" 
  4131. softerror("",103):
  4132. ?Rows%=
  4133. text(tableW%,1)):
  4134.  Rows%=0 
  4135. softerror("",104):
  4136. #TabFields%=
  4137. text(tableW%,2))
  4138.  %111 
  4139.  ic% 
  4140.  LastTable%=MaxTabs% 
  4141. &      
  4142. softerror(
  4143. (MaxTabs%+1),32)
  4144.       
  4145.       LastTable%+=1
  4146. !      Tablenumber%=LastTable%
  4147. "      table$(LastTable%)=name$
  4148.       
  4149.  I%=0 
  4150.  TabFields%
  4151. 6        tabfieldlen%(I%)=
  4152. text(tableW%,I%*2+4))
  4153. $        Rec%+=tabfieldlen%(I%)+1
  4154.       
  4155.        tablen%=160+Rows%*Rec%
  4156. O      
  4157. create_named_sliding_block(tabanchor%(LastTable%),(tablen%+3) 
  4158. )      tabptr%=!tabanchor%(LastTable%)
  4159. 2      $tabptr%=
  4160. (Rows%):tabptr%+=
  4161. ($tabptr%)+1
  4162. 7      $tabptr%=
  4163. (TabFields%):tabptr%+=
  4164. ($tabptr%)+1
  4165.       
  4166.  I%=0 
  4167.  TabFields%
  4168. ?        $tabptr%=
  4169. (tabfieldlen%(I%)):tabptr%+=
  4170. ($tabptr%)+1
  4171. (        head$=$
  4172. text(tableW%,I%*2+3)
  4173. ;        title$+=head$+
  4174. tabfieldlen%(I%)-
  4175. (head$)+2," ")
  4176.       
  4177. =      $tabptr%=title$:tabptr%=!tabanchor%(LastTable%)+160
  4178.       
  4179.  row%=1 
  4180.  Rows%
  4181.         
  4182.  I%=0 
  4183.  TabFields%
  4184. 5          $tabptr%="":tabptr%+=tabfieldlen%(I%)+1
  4185.         
  4186.       
  4187.  row%
  4188. !      
  4189. show_table(LastTable%)
  4190. !      Tablenumber%=LastTable%
  4191.        TabsLoaded$+=","+name$
  4192. !      
  4193.  !tablemenuanchor%=0 
  4194. H        
  4195. extend_named_sliding_block(tablemenuanchor%,MaxTabs%*35+65)
  4196. i        tablemenu%=!tablemenuanchor%:tableiconptr%=tablemenu%:tabletextptr%=tablemenu%+MaxTabs%*24+52
  4197. #        $tableiconptr%="Tables"
  4198.         tableiconptr%?12=7:tableiconptr%?13=2:tableiconptr%?14=7:tableiconptr%?15=0:tableiconptr%!16=140:tableiconptr%!20=44:tableiconptr%!24=0
  4199.         tableiconptr%+=28
  4200. A        ptr%=menu%(2)+52:ptr%!4=tablemenu%:
  4201. lit(menu%(2),1,
  4202.         !tableiconptr%=128
  4203. C        
  4204.  !tableiconptr%=0:tableiconptr%+=24:!tableiconptr%=128
  4205.       
  4206. ~      tableiconptr%!4=-1:tableiconptr%!8=&7000121:tableiconptr%!12=tabletextptr%:tableiconptr%!16=-1:tableiconptr%!20=L%+1
  4207. 2      $tabletextptr%=name$:tabletextptr%+=L%+1
  4208.         
  4209. close_window(tableW%)
  4210. clear_table(T%)
  4211. confirm(
  4212. msg(47))=
  4213.  R%,F%,ind%,Rows%,TabFields%,start%,Rec%
  4214. table_info(T%,Rows%,TabFields%,Rec%,tabfieldlen%())
  4215. #start%=!tabanchor%(T%)+160-Rec%
  4216.  R%=1 
  4217.  Rows%
  4218.   ind%=start%+R%*Rec%
  4219.  F%=0 
  4220.  TabFields%
  4221. )    $ind%="":ind%+=tabfieldlen%(F%)+1
  4222. redraw(datadicW%)
  4223. show_table(T%)
  4224.  ind%,start%,iflags%,I%,pos%,p$
  4225.  T%<0 
  4226. delete_icons(datadicW%,0)
  4227. name$=table$(T%)
  4228. $Tablename%=name$
  4229. $menu%(17)=name$
  4230.  "SlidingHeap_DescribeBlock",slidingheapbase%,tabanchor%(T%) 
  4231.  ,,tablen%
  4232. extend_named_sliding_block(undoanchor%,tablen%+1)
  4233.  "Wimp_TransferBlock",mytask%,!tabanchor%(T%),mytask%,!undoanchor%,tablen%+1
  4234. C$TabTitle%=
  4235. table_info(T%,Rows%,TabFields%,Rec%,tabfieldlen%())
  4236. ind%=!tabanchor%(T%)+160
  4237. iflags%=&07003531
  4238.  "Hourglass_On"
  4239.  row%=1 
  4240.  Rows%
  4241.   pos%=80
  4242.  I%=0 
  4243.  TabFields%
  4244. v    R%=
  4245. create_icon(datadicW%,pos%,-row%*36,(tabfieldlen%(I%)+1)*16,32,iflags%,"",ind%,writep%,tabfieldlen%(I%)+1)
  4246. %    pos%+=(tabfieldlen%(I%)+2)*16
  4247.      ind%+=tabfieldlen%(I%)+1
  4248.  "Hourglass_Percentage",row%*100 
  4249.  Rows%
  4250.  row%
  4251.  "Hourglass_Off"
  4252. p$=printrel$(T%)
  4253.  p$<>"" 
  4254.  I%=1 
  4255. '    
  4256. select(datadicW%,
  4257. p$,I%,1)))
  4258. "!block%=0:block%!4=-Rows%*36-4
  4259. %block%!8=(Rec%+10)*16:block%!12=0
  4260.  "Wimp_SetExtent",datadicW%,block%
  4261. !block%=datadicW%
  4262.  "Wimp_GetWindowState",,block%
  4263. #block%!12=block%!4+(Rec%+10)*16
  4264.  Rows%<20 
  4265. #  block%!16=block%!8+Rows%*36+4
  4266.    block%!16=block%!8+36*20+4
  4267.  "Wimp_OpenWindow",,block%
  4268. redraw(datadicW%)
  4269.  Access% 
  4270. set_caret(datadicW%,0)
  4271. restore_table(T%,L%)
  4272.  "Wimp_TransferBlock",mytask%,!undoanchor%,mytask%,!tabanchor%(T%),L%+1
  4273. redraw(datadicW%)
  4274. restore_tabfield
  4275.  source%,dest%
  4276.  "Wimp_GetCaretPosition",,block%:wi%=!block%:ic%=block%!4
  4277.  wi%=datadicW% 
  4278. +   dest%=
  4279. text(datadicW%,ic%)
  4280. ,:  source%=!undoanchor%+dest%-!tabanchor%(Tablenumber%)
  4281.   $dest%=$source%
  4282. redraw_icon(datadicW%,ic%)
  4283. sort_table(T%,field%)
  4284.  tablen%,ind%,Rec%,Rows%,row%,TabFields%,pos%,dest%
  4285. 4?title$=
  4286. table_info(T%,Rows%,TabFields%,Rec%,tabfieldlen%())
  4287. 5,pos%=
  4288. table_field(field%,tabfieldlen%())
  4289. 6&ind%=!tabanchor%(T%)+160-Rec%+pos%
  4290.  row%=0 
  4291.  Rows%-1
  4292.   ind%+=Rec%
  4293.   block%!(row%*4)=ind%
  4294.  $ind%="" 
  4295.  $ind%="~"
  4296.  row%
  4297.  "OS_HeapSort",Rows%,block%,4
  4298. extend_named_sliding_block(tempanchor%,Rows%*Rec%)
  4299. dest%=!tempanchor%-Rec%
  4300.  row%=0 
  4301.  Rows%-1
  4302. @&  ind%=block%!(row%*4):dest%+=Rec%
  4303.  $ind%="~" 
  4304.  $ind%=""
  4305.  "Wimp_TransferBlock",mytask%,ind%-pos%,mytask%,dest%,Rec%
  4306.  row%
  4307.  "Wimp_TransferBlock",mytask%,!tempanchor%,mytask%,!tabanchor%(T%)+160,Rows%*Rec%
  4308. scrap_sliding_block(tempanchor%)
  4309. redraw(datadicW%)
  4310. print_table(T%)
  4311.  printing% 
  4312.  indexing% 
  4313.  start%,ptr%,Line$,title$,rowsused%
  4314. L=$SaveName%=$database%+".PrintJobs."+
  4315. "Tab"+table$(T%),10)
  4316. read_print_options
  4317. format$="horiz"
  4318. O?title$=
  4319. table_info(T%,Rows%,TabFields%,Rec%,tabfieldlen%())
  4320. P!LenLine%=Lmargin%+
  4321. (title$)+2
  4322. Q0Heading$=margin$+title$+
  4323. Rec%-
  4324. (title$)," ")
  4325. extend_named_sliding_block(lineanchor%,LenLine%+4)
  4326. extend_named_sliding_block(headanchor%,LenLine%+4):pos%=!headanchor%
  4327. heap_store(headanchor%,LenLine%,0,pos%,0,Heading$)
  4328. Title$="Validation table"
  4329. Title1$=table$(T%)
  4330. Title2$=""
  4331. reportdest$="Window"
  4332. close_window(datadicW%)
  4333. Count%=0
  4334. list_head(0)
  4335.  "Hourglass_On"
  4336.  I%=1 
  4337.  Rows%
  4338. ^%  start%=!tabanchor%(T%)+160-Rec%
  4339.   Line$=margin$
  4340.   ptr%=start%+I%*Rec%
  4341.  J%=0 
  4342.  TabFields%
  4343. bD    
  4344.  $ptr%<>"" 
  4345.  Line$+=$ptr%+
  4346. tabfieldlen%(J%)-
  4347. ($ptr%)+2," ")
  4348. c     ptr%+=tabfieldlen%(J%)+1
  4349.  Line$<>margin$ 
  4350.     rowsused%+=1
  4351. gD    $(!lineanchor%)=Line$:
  4352. list_line(-1,lineanchor%,
  4353. (Line$),32)
  4354.  "Hourglass_Percentage",I%*100 
  4355.  Rows%
  4356.  "Hourglass_Off"
  4357. rule_off(45)
  4358. S$=margin$+
  4359. (Rows%)+" rows"
  4360. n:$(!lineanchor%)=S$:
  4361. list_line(-1,lineanchor%,
  4362. (S$),32)
  4363. o#S$=margin$+
  4364. (rowsused%)+" used"
  4365. p:$(!lineanchor%)=S$:
  4366. list_line(-1,lineanchor%,
  4367. (S$),32)
  4368. rule_off(45)
  4369. screen_list
  4370. pitch$=
  4371. pitch("0")
  4372. lit(menu%(18),1,
  4373. write_log(-1,"Table printed: "+table$(T%))
  4374. table_number(N$)
  4375.  T%,P%
  4376.  N$="" 
  4377. {    T%=-1
  4378.   T%+=1
  4379.  table$(T%)=N$ 
  4380.  T%>LastTable%
  4381.  T%>LastTable% 
  4382. table_info(T%,
  4383.  RL%,L%())
  4384.  P%,I%
  4385. P%=!tabanchor%(T%)
  4386. ($P%):P%+=
  4387. ($P%)+1
  4388. ($P%):P%+=
  4389. ($P%)+1
  4390.     RL%=0
  4391.  I%=0 
  4392.    L%(I%)=
  4393. ($P%):P%+=
  4394. ($P%)+1
  4395.   RL%+=L%(I%)+1
  4396. table_field(F%,L%())
  4397.  I%,P%
  4398.  I%<F%
  4399.   P%+=L%(I%)+1
  4400.   I%+=1
  4401. load_table(f$)
  4402.  pos%,name$,d%,L%
  4403. Tablenumber%=-1
  4404. name$=
  4405. leaf(f$):L%=
  4406. (name$)
  4407. TabsLoaded$,name$)>0 
  4408.  "OS_File",5,f$ 
  4409.  d%,,,,tablen%
  4410.  LastTable%=MaxTabs% 
  4411. extratabs$,name$)=0 
  4412.  extratabs$+=name$+","
  4413.   LastTable%+=1
  4414. create_named_sliding_block(tabanchor%(LastTable%),(tablen%+3) 
  4415.  "OS_File",255,f$,!tabanchor%(LastTable%)
  4416.   table$(LastTable%)=name$
  4417.   Tablenumber%=LastTable%
  4418.   TabsLoaded$+=","+name$
  4419.  !tablemenuanchor%=0 
  4420. D    
  4421. extend_named_sliding_block(tablemenuanchor%,MaxTabs%*35+65)
  4422. e    tablemenu%=!tablemenuanchor%:tableiconptr%=tablemenu%:tabletextptr%=tablemenu%+MaxTabs%*24+52
  4423.     $tableiconptr%="Tables"
  4424.     tableiconptr%?12=7:tableiconptr%?13=2:tableiconptr%?14=7:tableiconptr%?15=0:tableiconptr%!16=140:tableiconptr%!20=44:tableiconptr%!24=0
  4425.     tableiconptr%+=28
  4426. =    ptr%=menu%(2)+52:ptr%!4=tablemenu%:
  4427. lit(menu%(2),1,
  4428.     !tableiconptr%=128
  4429. ?    
  4430.  !tableiconptr%=0:tableiconptr%+=24:!tableiconptr%=128
  4431. z  tableiconptr%!4=-1:tableiconptr%!8=&7000121:tableiconptr%!12=tabletextptr%:tableiconptr%!16=-1:tableiconptr%!20=L%+1
  4432. .  $tabletextptr%=name$:tabletextptr%+=L%+1
  4433. link_to_table
  4434.  icon%
  4435.  %111 
  4436.  2,4:
  4437.  ic%=13 
  4438. 7    
  4439. tick_one(tablemenu%,0,LastTable%,Tablenumber%)
  4440. -    
  4441. show_menu(tablemenu%,oldx%+32,oldy%)
  4442.  %111 
  4443.  1,4:
  4444.  (b% 
  4445.  %111)=4 
  4446.  z%=1 
  4447.  z%=-1
  4448.  ic% 
  4449. tcycle(z%)
  4450. tcycle(-z%)
  4451. !    
  4452. fcycle(z%,fieldnum%)
  4453. "    
  4454. fcycle(-z%,fieldnum%)
  4455.      
  4456. fcycle(z%,expand%)
  4457. !    
  4458. fcycle(-z%,expand%)
  4459.  icon%=10 
  4460. 8      
  4461. icon_bit(22,linkW%,icon%,
  4462. selected(linkW%,9))
  4463.  icon%
  4464. "    icon%=field%(Fieldnumber%)
  4465. 1    
  4466. selected(linkW%,4) 
  4467.  $Tablename%<>"" 
  4468. 4      link$(Fieldnumber%)=$Tablename%+$fieldnum%
  4469. /      
  4470. set_icon_cols(mainW%,icon%,fcol%(6))
  4471. R      
  4472. selected(linkW%,9) 
  4473.  link$(Fieldnumber%)=$expand%+link$(Fieldnumber%)
  4474.       
  4475.        link$(Fieldnumber%)=""
  4476. (      
  4477. set_icon_cols(mainW%,icon%,7)
  4478.         
  4479.     link$(0)="LOADED"
  4480. /    
  4481.  (b% 
  4482.  %111)=4 
  4483. close_window(linkW%)
  4484. tcycle(z%)
  4485.  LastTable%=-1 
  4486. Tablenumber%+=z%
  4487.  Tablenumber%>LastTable% 
  4488.  Tablenumber%=0
  4489.  Tablenumber%<0 
  4490.  Tablenumber%=LastTable%
  4491. $$Tablename%=table$(Tablenumber%)
  4492. redraw_icon(linkW%,0)
  4493. fcycle(z%,column%)
  4494. table_info(Tablenumber%,Rows%,TabFields%,Rec%,tabfieldlen%())
  4495. field%=
  4496. ($column%)
  4497. field%+=z%
  4498.  field%>TabFields% 
  4499.  field%=0
  4500.  field%<0 
  4501.  field%=TabFields%
  4502. $column%=
  4503. (field%)
  4504. redraw_icon(linkW%,2)
  4505. redraw_icon(linkW%,10)
  4506. link_status
  4507.  name$,name1$,field$,expand$,ic%
  4508. name$=link$(Fieldnumber%)
  4509. (name$)<58 
  4510. (name$)<>-1 
  4511.  expand$=
  4512. name$,1):name$=
  4513. name$,2)
  4514. !field$=
  4515. name$):name1$=
  4516. name$)
  4517.  (name1$<>"" 
  4518. TabsLoaded$,name1$)>0) 
  4519. ;  $Tablename%=name1$:$fieldnum%=field$:$expand%=expand$
  4520. (  Tablenumber%=
  4521. table_number(name1$)
  4522. select(linkW%,4)
  4523.   Tablenumber%=0
  4524. &  $Tablename%=table$(Tablenumber%)
  4525. deselect(linkW%,4):$fieldnum%="0"
  4526.  expand$<>"" 
  4527. select(linkW%,9):$expand%=expand$
  4528. deselect(linkW%,9):$expand%="0"
  4529.  ic%=10 
  4530. icon_bit(22,linkW%,ic%,
  4531. selected(linkW%,9))
  4532. redraw_icon(linkW%,0):
  4533. redraw_icon(linkW%,2):
  4534. redraw_icon(linkW%,10)
  4535.  End of Validation table routines ------------------------------------
  4536. changes(key%)
  4537.  M$,K%,index%
  4538. <Search$=
  4539. parse($
  4540. text(changeW%,3),
  4541. selected(changeW%,5))
  4542. New$=$
  4543. text(changeW%,1)
  4544.  New$="" 
  4545.  n$="<null>" 
  4546.  n$=New$
  4547.  New$<>"" 
  4548. "+-*/",
  4549. New$,1))>0 
  4550.   numeric%=
  4551.  numeric%=
  4552. is_a_key(Fieldnumber%)
  4553.  K%=key% 
  4554. softerror("",12):
  4555.  "Wimp_CreateMenu",,-1:
  4556.  K%>=0 
  4557. msg(107) 
  4558.  M$=""
  4559. Title$,". "):Title$=
  4560. Title$,P%+2)
  4561.  Title$<>"All records" 
  4562.  Title$=" when "+Title$ 
  4563.  Title$=" for "+Title$
  4564. 8Title$="Change "+Fieldname$+" to "+n$+Title$+". "+M$
  4565. confirm(Title$)=
  4566. '  subtotal%=
  4567. count_recs(key%,zero%)
  4568.  "Hourglass_On"
  4569. ,  dbasehandle%=
  4570. ($database%+".Database")
  4571.   P%=
  4572. neighbour(key%,top,1)
  4573. scan_file("P%<>top",key%,5)
  4574. close_file(dbasehandle%)
  4575.   $Date%(file%)=
  4576.   date%?file%=1
  4577. display(key%,addr)
  4578.  "Hourglass_Off"
  4579.  K%>=0 
  4580.  index%=K% 
  4581.  Keys%-1
  4582. $!      Index$(K%)=Index$(K%+1)
  4583.  index%
  4584. &/    
  4585. scrap_sliding_block(keyanchor%(Keys%))
  4586.     Index$(Keys%)=""
  4587.     Keys%-=1
  4588. write_log(-1,Title$)
  4589.  "Wimp_CreateMenu",,-1
  4590. is_a_key(F%)
  4591.  key%,flag%
  4592. flag%=-1
  4593.  key%=0 
  4594.  Keys%
  4595.  KF%(key%,0)=F% 
  4596.  KF%(key%,1)=F% 
  4597.  flag%=key%
  4598.  key%
  4599. =flag%
  4600. read(N%,K%,R%,f$)
  4601.  I%,key%,dbasehandle%
  4602. 9"dbasehandle%=
  4603. (f$+".Database")
  4604. :%$Rf%(0)="":field$(0)="":key$()=""
  4605. #dbasehandle%=
  4606. (R%)*Length%
  4607.  I%=1 
  4608.   field$(I%)=
  4609. #dbasehandle%
  4610.  chartype%(I%)<>40 
  4611.  chartype%(I%)<>59 
  4612.  $Rf%(I%)=field$(I%)
  4613.  chartype%(I%) 
  4614. @8    
  4615.  36,37,38:
  4616. set_blob_sprite(R%,I%,chartype%(I%))
  4617. A!    
  4618. show_text_block(I%)
  4619. show_picture(I%)
  4620.  41,42,43,44,45:
  4621. DT    
  4622.  field$(I%)=" " 
  4623. select(mainW%,field%(I%)) 
  4624. deselect(mainW%,field%(I%))
  4625. E,    
  4626.  R%=RA% 
  4627.  $Rf%(I%)=
  4628. (nextrec%)
  4629. F9    
  4630.  R%=RA% 
  4631. split_link(I%,R$,V$):$Rf%(I%)=R$
  4632. G'    
  4633.  R%=RA% 
  4634.  $Rf%(I%)=
  4635. H(    
  4636.  R%=RA% 
  4637.  $Rf%(I%)=
  4638. $,15)
  4639. I1    
  4640.  R%=RA% 
  4641.  $Rf%(I%)=
  4642. convert_date(2)
  4643. J1    
  4644.  R%=RA% 
  4645.  $Rf%(I%)=
  4646. convert_date(4)
  4647. K#    
  4648.  R%=RA% 
  4649.  $Rf%(I%)=
  4650. L'    
  4651.  R%=RA% 
  4652.  $Rf%(I%)=
  4653. M)    
  4654.  R%=RA% 
  4655.  $Rf%(I%)=
  4656. $,5,2)
  4657. N)    
  4658.  R%=RA% 
  4659.  $Rf%(I%)=
  4660. $,8,3)
  4661. OJ    
  4662.  R%=RA% 
  4663. $,8,3):P%=
  4664. months$,M$):$Rf%(I%)=
  4665. ((P%+2) 
  4666. P*    
  4667.  R%=RA% 
  4668.  $Rf%(I%)=
  4669. $,12,4)
  4670.  key%=0 
  4671.  Keys%
  4672.     key$(key%)=
  4673. key(key%)
  4674.  key%
  4675. close_file(dbasehandle%)
  4676. cfield$()=field$()
  4677. update_calcs(N%)
  4678.  design% 
  4679.  $Rf%(N%)=cfield$(N%) 
  4680.  I%,C%,L%,F,F$,Form$,S$,SF$
  4681. Form$=update$(N%)
  4682.  Form$=0 
  4683. calc_error:
  4684.  I%=1 
  4685. (Form$)-1 
  4686.  F%<>N% 
  4687.     F%=
  4688. fnum(
  4689. Form$,I%,2))
  4690. g&    
  4691. split_link(F%,real$,visible$)
  4692.  chartype%(F%) 
  4693.       
  4694. j@      F=
  4695. (real$):F$=
  4696.  fix%(F%)>0 
  4697. fix_point(F$,F%)
  4698.       
  4699.       F$=
  4700. (real$)
  4701. m9      
  4702.  N%=0 
  4703. expand(F$,link$(F%),L%,SF$):F$=SF$
  4704. n        
  4705. o\    
  4706. (F$)<=len%(F%) 
  4707.  $Rf%(F%)=F$:cfield$(N%)=$Rf%(N%):
  4708. redraw_icon(mainW%,field%(F%))
  4709. update_calcs(F%)
  4710. calc_error
  4711.  ### Division by zero. Ignore ###
  4712. softerror(calc$(I%),73)
  4713. check_change
  4714.  F%,flag%
  4715.  F%<fields% 
  4716.  flag%=
  4717.   F%+=1
  4718.  chartype%(F%) 
  4719.  0,1,2,3,4,5,6,7,8:
  4720.  ?Rf%(F%)=32
  4721.       $Rf%(F%)=$(Rf%(F%)+1)
  4722.         
  4723.  chartype%(F%) 
  4724. +    
  4725.  0,1,2,3,4,5,6,7,8,41,42,43,44,45:
  4726. (    
  4727.  $Rf%(F%)<>field$(F%) 
  4728.  flag%=
  4729.  flag% 
  4730. write(fields%,key%):warn%=
  4731. write(N%,k%)
  4732.  key%,newrec%,dontalter%
  4733.  Access% 
  4734. softerror("",14):
  4735. close_file(dbasehandle%)
  4736.  template%=2 
  4737. write_dbase(RA%,N%,
  4738. ):template%=0:
  4739. PRI$=
  4740. key(0)
  4741.  PRI$="" 
  4742.  key$(0) 
  4743.  key%=0 
  4744.  Keys%
  4745.     KEY$=
  4746. key(key%)
  4747. $    kl%=
  4748. (KEY$):val$=
  4749. type(key%)
  4750. insert(KEY$,key%)
  4751.  KEY$<>"*Failed*" 
  4752. #      key$(key%)=KEY$:newrec%=
  4753. $      
  4754.  k%=key% 
  4755.  addr=nextfree%
  4756.       
  4757.  dontalter%=
  4758.         
  4759.  key%
  4760.  key%=0 
  4761.  Keys%
  4762.     KEY$=
  4763. key(key%)
  4764.  KEY$<>key$(key%) 
  4765.       
  4766.  key%=0 
  4767. $        
  4768. confirm(
  4769. msg(48))=
  4770. *          kl%=
  4771. (KEY$):val$=
  4772. type(key%)
  4773.            
  4774. delete(key$(0),0)
  4775.           
  4776. insert(KEY$,0)
  4777.           key$(0)=KEY$
  4778.           
  4779.  k%=0 
  4780.  addr=F%
  4781.           
  4782. '          dontalter%=
  4783. restore_rec
  4784.         
  4785.         
  4786.         
  4787.  dontalter%=
  4788. 0          kl%=
  4789. (key$(key%)):val$=
  4790. type(key%)
  4791. &          
  4792. delete(key$(key%),key%)
  4793.           kl%=
  4794. (KEY$)
  4795.            
  4796. insert(KEY$,key%)
  4797.           key$(key%)=KEY$
  4798. !          
  4799.  k%=key% 
  4800.  addr=F%
  4801.         
  4802.       
  4803.         
  4804.  key%
  4805.  dontalter% 
  4806. $Date%(file%)=
  4807. date%?file%=1
  4808.  newtree% 
  4809. write_dbase(REC%,N%,
  4810.  newrec% 
  4811.  autobalance% 
  4812.   added%+=1
  4813.  added%=balint% 
  4814.  key%=0 
  4815.  Keys%
  4816.       
  4817. balance(key%)
  4818.  key%
  4819.     added%=0
  4820. write_dbase(R%,N%,logchanges%)
  4821.  I%,F$,dbasehandle%,flag%
  4822. *dbasehandle%=
  4823. ($database%+".Database")
  4824. #dbasehandle%=R%*Length%
  4825.  logchanges% 
  4826.  newrec% 
  4827. ]    
  4828. write_log(R%,"New record: Subfile "+
  4829. (file%)+"  "+$Rf%(KF%(0,0))+" "+$Rf%(KF%(0,1)))
  4830. *    
  4831. write_log(R%,logentry$):flag%=
  4832.  I%=1 
  4833.  chartype%(I%) 
  4834.  39,40:F$=""
  4835. T    
  4836.  47:F$=$Rf%(I%):
  4837. split_link(I%,R$,V$):S%=
  4838. (R$):S%+=1:calc$(I%)=V$+"|"+
  4839.  58:F$=
  4840. :F$=$Rf%(I%)
  4841. #dbasehandle%,F$
  4842.  flag%=
  4843.  F$<>field$(I%) 
  4844. %    
  4845.  F$="" 
  4846.  D$="<null>" 
  4847.  D$=F$
  4848. 5    
  4849.  field$(I%)="" 
  4850.  S$="<null>" 
  4851.  S$=field$(I%)
  4852. 3    
  4853. write_log(-1,Tag$(I%)+": "+S$+" ---> "+D$)
  4854.   field$(I%)=F$
  4855. close_file(dbasehandle%)
  4856. split_link(F%,
  4857.  L$,P%,F
  4858. L$=calc$(F%)
  4859. L$,1)="#":
  4860. /  P%=
  4861. L$,"#",2):V$=
  4862. L$,P%+1):R$=
  4863. L$,2,P%-2)
  4864. L$,"|")>0:
  4865. +  P%=
  4866. L$,"|"):V$=
  4867. L$,P%-1):R$=
  4868. L$,P%+1)
  4869. :R$="":V$=""
  4870. key(key%)
  4871. key2(key%,0)
  4872. key2(key%,loc%)
  4873.  I%,N%,P%,S%,S$,T$,f0%,f1%,L%,C$,n%,t$
  4874. (P%=1:f0%=KF%(key%,0):f1%=KF%(key%,1)
  4875.  loc% 
  4876.    S$=$Rf%(f0%)+" "+$Rf%(f1%)
  4877.   S$=F$(f0%)+" "+F$(f1%)
  4878.  S$=" " 
  4879. S$)<>" " 
  4880.  S$+=" "
  4881.  I%=0 
  4882.   L%+=KW%(key%,I%)
  4883.  L%>0 
  4884.  I%=0 
  4885.     N%=KW%(key%,I%)
  4886.  N%<>0 
  4887.  P%<>
  4888. (S$) 
  4889.       S%=
  4890. S$," ",P%+1)
  4891. '      
  4892.  S%-P%<N% 
  4893.  n%=S%-P% 
  4894.  n%=N%
  4895.       t$=
  4896. S$,P%,n%)
  4897. 2      
  4898.  incspace%(key%)=
  4899.  t$+=
  4900. (t$)," ")
  4901.       T$+=t$
  4902.       P%=S%+1
  4903.         
  4904.     C$=
  4905. S$,1):S$=
  4906. S$,2)
  4907. .    
  4908.  C$<>" " 
  4909.  incspace%(key%)=
  4910.  T$+=C$
  4911. (T$)=KL%(key%) 
  4912.  C$=""
  4913. KL%(key%)-
  4914. (T$),"#")
  4915.  chartype%(f0%) 
  4916.  5,51,52:T$=
  4917. reverse_date(T$)
  4918.  case%(key%) 
  4919. u(T$)
  4920. u(N$)
  4921.  I%,B%
  4922. $key=N$
  4923.  I%=0 
  4924. (N$)-1
  4925.   B%=key?I%
  4926.  B%>96 
  4927.  B%<123 
  4928.  key?I%=B% 
  4929. $    =$key
  4930.  Y$,M$,D$,M%,date$
  4931. $,14,2)
  4932. $,5,2)
  4933. $,8,3)
  4934. +:M%=(
  4935. "JanFebMarAprMayJunJulAugSepOctNovDec",M$)+2) 
  4936.  M%<10 
  4937.  M$="0"+
  4938. (M%) 
  4939. date$=D$+"-"+M$+"-"+Y$
  4940. =date$
  4941. date(key%)
  4942.  !keyanchor%(key%)=0 
  4943.  I%=0 
  4944.  date%?I%=1 
  4945. 5)    $(!keyanchor%(key%)+8+9*I%)=
  4946.     $Date%(I%)=
  4947. check_date(D$,place%,
  4948.  date$)
  4949.  I%,D%,M%,Y%,L%,P%,Q%,U$,d$,m$,y$
  4950.  L%=0 
  4951.  I%=1 
  4952.   C$=
  4953. D$,I%,1)
  4954.  C$<"0" 
  4955.  C$>"9" 
  4956.  P%=0 
  4957.  P%=I% 
  4958.  Q%=I%
  4959.  P%=0 
  4960.  Q%=0 
  4961. restore(Fieldnumber%," (day, month & year must be separated by non-numeral)",4):=
  4962. D$,P%-1))
  4963. D$,P%+1,Q%-P%-1))
  4964. D$,Q%+1))
  4965.  Y%<0 
  4966.  D%<1 
  4967. restore(Fieldnumber%,"",4):=
  4968.  M%<1 
  4969.  M%>12 
  4970. restore(Fieldnumber%," (month out of range)",4):=
  4971.  400=0:U$="312931303130313130313031"
  4972.  100<>0 
  4973.  4=0:U$="312931303130313130313031"
  4974. :U$="312831303130313130313031"
  4975. U$,2*M%-1,2)
  4976. (DM$) 
  4977. restore(Fieldnumber%," (day out of range - max="+DM$+")",4):=
  4978. R"d$=
  4979. (D%):
  4980. (d$)=1 
  4981.  d$="0"+d$
  4982. S"m$=
  4983. (M%):
  4984. (m$)=1 
  4985.  m$="0"+m$
  4986. T"y$=
  4987. (Y%):
  4988. (y$)=1 
  4989.  y$="0"+y$
  4990. (y$)<>2 
  4991. (y$)<>4 
  4992. restore(Fieldnumber%," (year not 2 or 4 digits)",4):=
  4993. (y$)=4 
  4994.  len%(Fieldnumber%)<10 
  4995. y$,2)
  4996. W$date$=d$+datesep$+m$+datesep$+y$
  4997.  place%=0 
  4998. (date$)>len%(Fieldnumber%) 
  4999. restore(Fieldnumber%," (too long for field)",4):=
  5000.  place% 
  5001. [H  $Rf%(Fieldnumber%)=date$:
  5002. redraw_icon(mainW%,field%(Fieldnumber%))
  5003. ]9  $
  5004. text(keypadW%,27)=date$:
  5005. redraw_icon(keypadW%,27)
  5006. convert_date(L%)
  5007.  d$,m$,y$,M$,M%
  5008. $,5,2)
  5009. $,8,3)
  5010. months$,M$)
  5011. M%=(P%+2) 
  5012. g m$=
  5013. (M%):
  5014.  M%<10 
  5015.  m$="0"+m$
  5016. $,16-L%,L%)
  5017. =d$+datesep$+m$+datesep$+y$
  5018. reverse_date(K$)
  5019.  sep$
  5020. (K$) 
  5021.   sep$=
  5022. K$,3,1)
  5023. p.  K$=
  5024. K$,2)+sep$+
  5025. K$,4,2)+sep$+
  5026. K$,2) 
  5027. (K$)<100 
  5028.     sep$=
  5029. K$,3,1)
  5030. t+    K$=
  5031. K$,4)+sep$+
  5032. K$,4,2)+sep$+
  5033. K$,2)
  5034. u        
  5035.     sep$=
  5036. K$,5,1)
  5037. w+    K$=
  5038. K$,2)+sep$+
  5039. K$,6,2)+sep$+
  5040. K$,4)
  5041. seconds(time$,place%)
  5042.  I%,L%,P%,Q%,H%,M%,S%,secs%,h$,m$,s$,C$
  5043. (time$)
  5044.  L%=0 
  5045.  I%=1 
  5046.   C$=
  5047. time$,I%,1)
  5048.  C$<"0" 
  5049.  C$>"9" 
  5050.  P%=0 
  5051.  P%=I% 
  5052.  Q%=I%
  5053.  P%=0 
  5054.  Q%=0 
  5055. restore(Fieldnumber%," (hours, minutes and seconds must be separated by a non-numeral).",94):=-1
  5056. time$,P%-1)):
  5057.  H%<0 
  5058.  H%>23 
  5059. restore(Fieldnumber%," (hours out of range).",94):=-1
  5060. time$,P%+1,Q%-P%-1)):
  5061.  M%<0 
  5062.  M%>59 
  5063. restore(Fieldnumber%," (minutes out of range).",94):=-1
  5064. time$,Q%+1)):
  5065.  S%<0 
  5066.  S%>59 
  5067. restore(Fieldnumber%," (seconds out of range).",94):=-1
  5068. (H%):
  5069. (h$)=1 
  5070.  h$="0"+h$
  5071. (M%):
  5072. (m$)=1 
  5073.  m$="0"+m$
  5074. (S%):
  5075. (s$)=1 
  5076.  s$="0"+s$
  5077. $time$=h$+timesep$+m$+timesep$+s$
  5078. secs%=H%*3600+M%*60+S%
  5079.  place%=0 
  5080.  $Rf%(Fieldnumber%)=time$:
  5081. redraw_icon(mainW%,field%(Fieldnumber%))
  5082. =secs%
  5083. time(secs%)
  5084.  H%,M%,S%,h$,m$,s$
  5085. &H%=secs% 
  5086.  3600:secs%=secs% 
  5087.  3600
  5088. M%=secs% 
  5089. S%=secs% 
  5090. (H%):
  5091. (h$)=1 
  5092.  h$="0"+h$
  5093. (M%):
  5094. (m$)=1 
  5095.  m$="0"+m$
  5096. (S%):
  5097. (s$)=1 
  5098.  s$="0"+s$
  5099. =h$+timesep$+m$+timesep$+s$
  5100. validate(F%,
  5101.  TabFields%,
  5102.  name$)
  5103.  validate% 
  5104.  row%,field%,Rows%,Rec%,ind%,eind%,pos%,start%,rel%,exp%,epos%,date$
  5105.  fix%(F%)>0 
  5106.  $Rf%(F%)=
  5107. fix_point($Rf%(F%),F%):
  5108. redraw_icon(mainW%,field%(F%))
  5109.  chartype%(F%)=3 
  5110. check_val(calc$(F%),$Rf%(F%))
  5111.  chartype%(F%)=5 
  5112. check_date($Rf%(F%),0,date$)
  5113.  chartype%(F%)=8 
  5114. seconds($Rf%(F%),0)>=0)
  5115.  $Rf%(F%)=field$(F%) 
  5116.  TabFields%=0 
  5117. 3name$=link$(F%):Tablenumber%=-1:rel%=TabFields%
  5118.  name$="" 
  5119. name$,1)="#" 
  5120. #field%=
  5121. name$)):name$=
  5122. name$)
  5123. Hexp%=-1:
  5124. (name$)<58 
  5125. (name$)<>-1 
  5126.  exp%=
  5127. (name$):name$=
  5128. name$,2)
  5129. table_number(name$):
  5130.  T%<0 
  5131. table_info(T%,Rows%,TabFields%,Rec%,tabfieldlen%())
  5132. ,pos%=
  5133. table_field(field%,tabfieldlen%())
  5134.  exp%<0 
  5135.  epos%=pos% 
  5136.  epos%=
  5137. table_field(exp%,tabfieldlen%())
  5138. #start%=!tabanchor%(T%)+160-Rec%
  5139. 'ind%=start%+pos%:eind%=start%+epos%
  5140.  row%+=1
  5141.   ind%+=Rec%:eind%+=Rec%
  5142.  row%>Rows% 
  5143.  $ind%=$Rf%(F%) 
  5144.  $eind%=$Rf%(F%)
  5145.  row%>Rows% 
  5146.  rel%=0 
  5147. restore(F%," ("+name$+")",5):=
  5148.  row%>Rows% 
  5149. ind%=start%+row%*Rec%
  5150.  I%=0 
  5151.  TabFields%
  5152. ,  rel%(I%)=ind%:ind%+=tabfieldlen%(I%)+1
  5153.  exp%>=0 
  5154.  expand$=$eind%:
  5155. (expand$)<=len%(F%) 
  5156.  $Rf%(F%)=expand$:
  5157. redraw_icon(mainW%,field%(F%))
  5158.     =row%
  5159. check_val(C$,N$)
  5160.  min$,max$,P%,V,ok%
  5161.     ok%=
  5162.  N$="" 
  5163.  C$<>"" 
  5164.   P%=
  5165. C$,"|")
  5166.  P%>0 
  5167.     min$=
  5168. C$,P%-1)
  5169.     max$=
  5170. C$,P%+1)
  5171. H    
  5172.  min$<>"" 
  5173. (min$) 
  5174.  ok%=
  5175. restore(F%," (min="+min$+")",58)
  5176. H    
  5177.  max$<>"" 
  5178. (max$) 
  5179.  ok%=
  5180. restore(F%," (max="+max$+")",59)
  5181. restore_rec
  5182.  F%=1 
  5183.  fields%
  5184.  field$(F%)<>$Rf%(F%) 
  5185.     $Rf%(F%)=field$(F%)
  5186. '    
  5187. redraw_icon(mainW%,field%(F%))
  5188. restore(F%,E$,E%)
  5189.  E%>=0 
  5190. softerror(E$,E%)
  5191. $Rf%(F%)=field$(F%)
  5192. redraw_icon(mainW%,field%(F%))
  5193. set_caret(mainW%,field%(F%))
  5194. relations(menu%)
  5195.  F%,I%,W%,L%,N$,row%,col%,flags%
  5196.     F%=-1
  5197. &row%=
  5198. validate(Fieldnumber%,F%,N$)
  5199. !col%=
  5200. link$(Fieldnumber%)))
  5201.  row%>0 
  5202. delete_icons(relateW%,0)
  5203.  I%=0 
  5204. 7    
  5205.  I%=col% 
  5206.  flags%=&0B000531 
  5207.  flags%=&07000531
  5208.     L%=
  5209. ($rel%(I%))
  5210. T    R%=
  5211. create_icon(relateW%,0,-I%*36-36,L%*16+16,32,flags%,"",rel%(I%),-1,L%+1)
  5212.  L%>W% 
  5213.  W%=L%
  5214.   $RelTitle%=N$
  5215.  menu% 
  5216.     xmax%=x%-32:ymax%=y%
  5217.         
  5218. 9    !block%=keypadW%:
  5219.  "Wimp_GetWindowState",,block%
  5220. )    xmax%=block%!12+2:ymax%=block%!16
  5221. 7  !block%=relateW%:
  5222.  "Wimp_GetWindowState",,block%
  5223. &  width%=W%*16+16:height%=F%*36+36
  5224. +  block%!4=xmax%:block%!12=xmax%+width%
  5225. ,  block%!8=ymax%-height%:block%!16=ymax%
  5226.   block%!28=-1
  5227.  menu% 
  5228. $    
  5229.  "Wimp_OpenWindow",,block%
  5230. /    
  5231.  "Wimp_CreateMenu",,relateW%,x%-32,y%
  5232.         
  5233. $    
  5234.  "Wimp_OpenWindow",,block%
  5235. redraw(relateW%)
  5236. close_window(relateW%)
  5237. fix_point(F$,F%)
  5238.  F$="" 
  5239. @%=&01020009+fix%(F%)*256
  5240. (F$))
  5241. @%=&90A
  5242. F$,len%(F%))
  5243. moveto(key%,P%,D%)
  5244. D%=(D%+1) 
  5245.  filter% 
  5246. #  P%=
  5247. next_match(P%,D%,Filter$)
  5248.   P%=
  5249. neighbour(key%,P%,D%)
  5250.  P%=top 
  5251.  7:P%=
  5252. neighbour(key%,P%,D%)
  5253. display(key%,P%)
  5254. next_match(P%,D%,S$)
  5255.  REC%
  5256. *dbasehandle%=
  5257. ($database%+".Database")
  5258.   P%=
  5259. neighbour(key%,P%,D%)
  5260.  P%<>top 
  5261.      REC%=
  5262. rec_no(k$,key%,P%)
  5263. '    
  5264. readsmarray(dbasehandle%,REC%)
  5265. (S$)=
  5266.  P%=top
  5267.  P%=top 
  5268. softerror("",38)
  5269. close_file(dbasehandle%)
  5270. display(key%,P%)
  5271. check_change
  5272.  template%=1 
  5273.  template%=2 
  5274.  template%=0
  5275.  I%,L%,S%,S$,k$,ok%,nextrec%
  5276. $   keybase%=!keyanchor%(key%)
  5277.   avail%=!keybase%
  5278. &,  nextrec%=!(keybase%+avail%+8+KL%(0)+1)
  5279. (:    
  5280.  !(keybase%+avail%)>0,template%=2,design%=
  5281. :ok%=
  5282.     incr%=
  5283. ($Increment%)
  5284.  incr%>0 
  5285. ,+      
  5286. change_length(RA%+incr%,
  5287. ):ok%=
  5288.       
  5289. softerror("",2)
  5290. .        
  5291.  ok% 
  5292. 2:      
  5293.  design%:$RecInfo%="Make adjustments to fields"
  5294. 3a      
  5295.  template%=2:$RecInfo%="Enter data which you want to appear by default on new records"
  5296. 4U      
  5297. :REC%=nextrec%:$RecInfo%="Subfile="+
  5298. (file%)+". Record="+
  5299. (REC%)+". (New)"
  5300. 5        
  5301. 6'    
  5302. read(fields%,
  5303. ,RA%,$database%)
  5304.  top:
  5305. 9   keybase%=!keyanchor%(key%)
  5306.   avail%=!keybase%
  5307. ;(  REC%=!(keybase%+avail%+8+KL%(0)+1)
  5308. read(fields%,
  5309. ,RA%,$database%)
  5310. =#  $RecInfo%="Subfile="+
  5311. (file%)
  5312.  7:$RecInfo%="Subfile="+
  5313. (file%)+". Record="+
  5314. (REC%)+". (New)"
  5315.   REC%=
  5316. rec_no(k$,key%,P%)
  5317. read(fields%,
  5318. ,REC%,$database%)
  5319.   key$(key%)=k$
  5320. k$)="#"
  5321.     k$=
  5322. FC  $RecInfo%="Subfile="+
  5323. (file%)+". Record="+
  5324. (REC%)+". Key="+k$
  5325. H&L%=
  5326. text_length(mainW%,starthere%)
  5327.  Access% 
  5328. set_caret(mainW%,starthere%)
  5329. identify_field(starthere%)
  5330. update_calcs(0)
  5331. LHlogentry$="Subfile "+
  5332. (file%)+"  "+$Rf%(KF%(0,0))+" "+$Rf%(KF%(0,1))
  5333. redraw(mainW%)
  5334.  -------------------- Icon colours -------------------------------
  5335. colour(key%,type%)
  5336. change_field_cols(key%,type%,0)
  5337.  KF%(key%,1)>0 
  5338. change_field_cols(key%,type%,1)
  5339. change_field_cols(key%,type%,fld%)
  5340. col%=fcol%(type%*2)
  5341.  type%=0 
  5342.  key%>0 
  5343.  (key%=0 
  5344.  fcol%(0)=&17) 
  5345. set_icon_cols(mainW%,desc%(KF%(key%,fld%)),col%)
  5346. col%=fcol%(type%*2+1)
  5347. \7col2%=
  5348. get_icon_cols(mainW%,field%(KF%(key%,fld%)))
  5349.  (col2% 
  5350.  %1111)<>fcol%(6) 
  5351.  type%=0 
  5352.  key%>0 
  5353.  (key%=0 
  5354.  fcol%(1)=&07) 
  5355. set_icon_cols(mainW%,field%(KF%(key%,fld%)),col%)
  5356. get_icon_cols(wi%,ic%)
  5357. c;!block%=wi%:block%!4=ic%:
  5358.  "Wimp_GetIconState",,block%
  5359. =block%?27
  5360. set_icon_cols(wi%,ic%,col%)
  5361. gD!block%=wi%:block%!4=ic%:block%!8=(col%<<24):block%!12=&FF000000
  5362.  "Wimp_SetIconState",,block%
  5363. dcolour(wi%,ic%,col%,fb%)
  5364. l;!block%=wi%:block%!4=ic%:
  5365.  "Wimp_GetIconState",,block%
  5366.  fb% 
  5367.  0:block%!8=col%<<28:block%!12=&F0000000
  5368.  1:block%!8=col%<<24:block%!12=&0F000000
  5369.  "Wimp_SetIconState",,block%
  5370. read_colours(f$)
  5371.  ic%=0 
  5372. #F,fcol%(ic%)
  5373. ncol%()=fcol%()
  5374. close_file(F)
  5375. write_colours
  5376. ($database%+".Colours")
  5377.  ic%=0 
  5378. #F,fcol%(ic%)
  5379. close_file(F)
  5380. find(S$,key%,m%,disp%)
  5381.  P%,F%,H%,num%,abort%,cond$
  5382.  case%(key%) 
  5383. u(S$)
  5384. S$,1)="#" 
  5385. check_change
  5386.   REC%=
  5387. S$,2))
  5388.  REC%>=0 
  5389.  REC%<RA% 
  5390. (    
  5391. read(fields%,
  5392. ,REC%,$database%)
  5393. !    S$=key$(key%):H%=1:num%=
  5394. 3    
  5395. select(keypadW%,25):
  5396. deselect(keypadW%,24)
  5397. -    
  5398. softerror(" ("+S$+")",56):abort%=
  5399.  abort% 
  5400. =addr
  5401. val$=
  5402. type(key%)
  5403.  val$="VAL" 
  5404.   kl%=KL%(key%)
  5405.   S$=
  5406. stripspaces(S$)
  5407.   kl%=
  5408. search(S$,key%,1+H%)
  5409.  P%<0 
  5410. selected(keypadW%,25) 
  5411.   F%=file%
  5412.     file%=(file%+1) 
  5413.     top=8*file%+LH%
  5414.      P%=
  5415. search(S$,key%,1+H%)
  5416.  P%>0 
  5417.  file%=F%
  5418.  val$="VAL" 
  5419.  cond$="VAL($(!keyanchor%(key%)+P%+8))=VAL(S$)" 
  5420.  cond$="LEFT$($(!keyanchor%(key%)+P%+8),kl%)=S$"
  5421. matches%=0
  5422.  P%>=0 
  5423.  num%:RecF%=
  5424. :addr=P%
  5425.  P%>=0:RecF%=
  5426. (cond$)
  5427.      P%=
  5428. neighbour(key%,P%,0)
  5429. \  P%=
  5430. neighbour(key%,P%,1):addr=P%:
  5431.  ### Scan back to FIRST match & point addr at it ###
  5432. (cond$)
  5433.     matches%+=1
  5434.      P%=
  5435. neighbour(key%,P%,1)
  5436.  num%:
  5437. softerror(" (#"+
  5438. (REC%)+")",55)
  5439.  7:flash%=KF%(key%,0):addr=
  5440. text(keypadW%,36)=
  5441. (matches%)+" found":
  5442. redraw_icon(keypadW%,36)
  5443.  disp% 
  5444. display(key%,addr)
  5445.     =addr
  5446. get_it_in(filename$)
  5447.  "OS_File",5,filename$ 
  5448.  d%,,ftype%
  5449. 9ftype%=(ftype%>>8) 
  5450.  &fff:wi%=block%!20:ic%=block%!24
  5451.  ftype% 
  5452.  &7f1:
  5453.  LastTable%=MaxTabs% 
  5454. softerror(
  5455. (MaxTabs%+1),32) 
  5456. load_table(filename$):
  5457. show_table(Tablenumber%)
  5458.  &7f3:
  5459. load_selection(filename$)
  5460.  &7f4:
  5461. load_query(filename$)
  5462.  &7f5:
  5463. load_options(filename$)
  5464.  &dfe:
  5465. start_import("CSV",block%!20)
  5466.  &ff9,&aff:
  5467. transfer_blob(block%!20,block%!24,filename$,ftype%)
  5468.  &bc5:
  5469. ready_to_merge
  5470.  &fff:
  5471. /  F=
  5472. (filename$):header$=
  5473. close_file(F)
  5474.  wi% 
  5475.  mainW%,-1:
  5476. (      
  5477.  header$="!SCRIPT POWERBASE":
  5478. /      
  5479.  present%=7:
  5480. execute_file(filename$)
  5481. F      
  5482.  ic%>0:
  5483. transfer_blob(block%!20,block%!24,filename$,ftype%)
  5484. %      
  5485. start_import("text",wi%)
  5486.         
  5487. &    
  5488.  customise% 
  5489. special_drop
  5490.  wi% 
  5491.  reformW%:
  5492.  reform$ 
  5493. 1      
  5494.  "Merge":
  5495. merge_files(filename$,file%)
  5496. +      
  5497.  "Reformat":
  5498. reformat(filename$)
  5499.         
  5500.  d%=2 
  5501. #      
  5502. leaf(filename$),1) 
  5503.         
  5504.  "!":
  5505. 3        
  5506.  ### Is it an Impression document? ###
  5507. 5        
  5508.  "OS_File",5,filename$+".!DocData" 
  5509.         
  5510.  d%=1 
  5511.           
  5512. ready_to_merge
  5513.           
  5514. 6          
  5515.  ### Is it a Powerbase application? ###
  5516. =          
  5517.  "OS_File",5,filename$+".Colours" 
  5518.  d%,,type%
  5519. %          type%=(type%>>8) 
  5520.  &fff
  5521. #          
  5522.  d%=1 
  5523.  type%=&ffd 
  5524. '            
  5525.  present%>0 
  5526. exit(0)
  5527. (            $Title%=
  5528. leaf(filename$)
  5529. &            
  5530. open_files(filename$)
  5531.           
  5532.         
  5533.         
  5534. 7        
  5535.  ### It's an ordinary directory folder ###
  5536. <        
  5537. transfer_blob(block%!20,block%!24,filename$,-1)
  5538.       
  5539.         
  5540. ready_to_merge
  5541.  present%=7 
  5542.    document$=
  5543. leaf(filename$)
  5544. document$,1)="!" 
  5545.  document$=
  5546. document$,2)
  5547. 6  block%!0=256:block%!12=0:block%!16=5:block%!20=0
  5548. 5  block%!24=0:block%!28=0:block%!32=0:block%!36=0
  5549. ,  block%!40=&2000:$(block%+44)=filename$
  5550.  "Wimp_SendMessage",18,block%,0
  5551.   Impref%=block%!8
  5552. softerror("" ,106)
  5553. open_files(f$)
  5554.  I%,J%,F%,A$
  5555.  "OS_File",5,f$+".!Paths" 
  5556.  d%=0 
  5557.  "OS_CLI","Set Acl$Dir "+f$
  5558.  "OS_CLI","Set Log$Dir "+f$
  5559.  "OS_FSControl",4,f$+".!Paths"
  5560.  "OS_File",5,f$+".Dbase" 
  5561.  d%=1 
  5562.  fatal_err%,
  5563. msg(42)
  5564.  "OS_File",5,f$+".Database" 
  5565.  d%=1 
  5566.  present%=present% 
  5567.  "OS_File",5,f$+".PrimaryKey" 
  5568.  d%=1 
  5569.  present%=present% 
  5570.  "OS_File",5,f$+".Form" 
  5571.  d%=1 
  5572.  present%=present% 
  5573.  "OS_File",5,f$+".UsrSprites" 
  5574.  d%,,,,len%
  5575.  d%=1 
  5576. create_named_sliding_block(logoanchor%,len%+8)
  5577. &  base%=!logoanchor%:!base%=len%+4
  5578.  "OS_File",255,f$+".UsrSprites",base%+4
  5579.   logosloaded%=
  5580. $database%=f$
  5581.  present% 
  5582.  0,1,5:Access%=
  5583. :Modify%=
  5584. resume_opening
  5585. access(f$) 
  5586. resume_opening
  5587. wimp_error(
  5588. ,254,0,
  5589. msg(24))
  5590. access(f$)
  5591.  L%,P%,keybase%,login%
  5592. (f$+".Colours")
  5593.  F=0 
  5594.  fatal_err%,f$+"."+
  5595. msg(18)
  5596. #F=35
  5597. #F,S$:$Read%=
  5598. encrypt(S$,
  5599. #F,S$:$Write%=
  5600. encrypt(S$,
  5601. #F,S$:$Manager%=
  5602. encrypt(S$,
  5603.  I%=9 
  5604. select(passW%,I%)
  5605. deselect(passW%,16)
  5606.  I%<17 
  5607. #F,Z%:
  5608. set_icon(passW%,I%,Z%)
  5609.   I%+=1
  5610. close_file(F)
  5611.  $Manager%="" 
  5612.  Access%=
  5613. :Modify%=
  5614.  "OS_File",5,"<Acl$Dir>.acl" 
  5615.  d%:acl%=(d%=1)
  5616. 29$AccessTitle%="!Powerbase opening "+
  5617. leaf($database%)
  5618. 35!block%=accessW%:
  5619.  "Wimp_GetWindowState",,block%
  5620.  acl% 
  5621. 5*  block%!16=block%!8+310:block%!24=110
  5622.   refuse$="Access denied" 
  5623. 8(  block%!16=block%!8+200:block%!24=0
  5624. 9"  refuse$="Password not known"
  5625. ;#block%!4=(ScreenWidth% 
  5626.  2)-250
  5627.  "Wimp_OpenWindow",,block%
  5628. =5!block%=accessW%:
  5629.  "Wimp_GetWindowState",,block%
  5630.  block%!4,block%!8,block%!12-block%!4,block%!16-block%!8
  5631. @(  cancel%=
  5632. :login%=
  5633. :accessbutton%=0
  5634.   $Password%="":$UserID%=""
  5635. redraw_icon(accessW%,1):
  5636. redraw_icon(accessW%,0)
  5637. C0  $
  5638. text(accessW%,5)="Type in your password"
  5639.  acl% 
  5640. set_caret(accessW%,0) 
  5641. set_caret(accessW%,1)
  5642.  accessbutton%>0
  5643.  accessbutton% 
  5644. IA    
  5645.  2:cancel%=
  5646.  "OS_Byte",202,caps%,111:
  5647.  "OS_Byte",118
  5648. K3    password$=
  5649. u($Password%):user$=
  5650. u($UserID%)
  5651.  acl% 
  5652.       F=
  5653. ("<Acl$Dir>.acl")
  5654.       
  5655. O!        
  5656. #F,id$,personal$,pw%
  5657. PX        
  5658.  id$=
  5659. encrypt(user$,
  5660.  personal$=
  5661. encrypt(password$,
  5662.  pw%>0 
  5663.  login%=
  5664.       
  5665.  login% 
  5666.       
  5667. close_file(F)
  5668.       
  5669.       
  5670.  password$ 
  5671. U&        
  5672.  $Manager%:pw%=3:login%=
  5673. V$        
  5674.  $Write%:pw%=2:login%=
  5675. W#        
  5676.  $Read%:pw%=1:login%=
  5677.       
  5678. Y        
  5679.  (login% 
  5680.  cancel%) 
  5681. ]"    $
  5682. text(accessW%,5)=refuse$
  5683. ^!    
  5684. dcolour(accessW%,5,11,1)
  5685.     delay%=
  5686. `        
  5687.       
  5688. >delay%
  5689. c     
  5690. dcolour(accessW%,5,7,1)
  5691.  login% 
  5692.  cancel%
  5693.  login% 
  5694.  Access%=(pw%>1):Modify%=(pw%>2)
  5695. close_window(accessW%)
  5696. getscreensize(W%,H%)
  5697.  0,0,W%,H%
  5698. =login%
  5699. resume_opening
  5700.  "Hourglass_On"
  5701. selected(passW%,16) 
  5702. open_log("<Log$Dir>.Log",
  5703.  "OS_File",5,f$+".UserFuncs" 
  5704.  d%=1 
  5705.  f$+".UserFuncs"
  5706. read_colours($database%+".Colours")
  5707.  "OS_File",5,f$+".PrintRes.PrintOpts" 
  5708.  d%=1 
  5709. load_options(f$+".PrintRes.PrintOpts")
  5710. load_options("<Pbase$Dir>.Resources.PrintOpts")
  5711. f$,3)="RAM" 
  5712.  ram%=
  5713.  "OS_CLI","Set Alias$Tables Filer_OpenDir "+$database%+".ValTables"
  5714.  "OS_CLI","Set Alias$Resources Filer_OpenDir "+$database%+".PrintRes"
  5715.  "OS_CLI","Set Alias$JobsDone Filer_OpenDir "+$database%+".PrintJobs"
  5716. lit(menu%(0),1,
  5717. lit(menu%(0),3,
  5718. lit(menu%(0),4,
  5719. lit(menu%(1),6,
  5720. selected(passW%,9))
  5721. lit(menu%(3),8,
  5722. selected(passW%,15))
  5723. lit(menu%(7),0,Access%)
  5724. lit(menu%(7),1,Modify%)
  5725. lit(menu%(7),2,Access%)
  5726. lit(menu%(7),3,Access%)
  5727. lit(menu%(7),4,Access%)
  5728. lit(menu%(2),0,Access%)
  5729. lit(menu%(0),2,Modify%)
  5730. lit(menu%(10),0,Access%)
  5731. lit(menu%(10),2,Access%)
  5732. lit(menu%(10),3,Access%)
  5733. lit(menu%(13),0,Access%)
  5734. lit(menu%(17),0,Access%)
  5735. lit(menu%(3),0,((present% 
  5736.  4)>0))
  5737. lit(menu%(9),1,((present% 
  5738.  4)=0))
  5739.  I%=1 
  5740. lit(menu%(3),I%,(present%=7))
  5741. limit_actions(Access%)
  5742.  present%<4 
  5743.  design%=
  5744.  present%=5 
  5745. adjust_on(
  5746. lit(menu%(9),5,
  5747. fields%=
  5748. get_form(Fptr%)
  5749.  fields%>0 
  5750. %  starthere%=field%(
  5751. first_field)
  5752. %  fieldmenu%=
  5753. field_menu(fields%)
  5754. create_named_sliding_block(transanchor%,Length%+1)
  5755.  adjust% 
  5756. lit(menu%(9),2,(fields%>0))
  5757. load_calcs
  5758.  present% 
  5759. -  $RecInfo%="No record design exists yet"
  5760.  I%=1 
  5761. lit(menu%(9),I%,
  5762. open_window(mainW%)
  5763.  !formanchor%=0 
  5764. 2    
  5765. extend_named_sliding_block(formanchor%,0)
  5766.     Fptr%=!formanchor%
  5767.      fields%=0:Fieldnumber%=0
  5768. 8  $RecInfo%="Record design exists, but no datafiles"
  5769. first_field>0 
  5770. lit(menu%(9),3,
  5771. lit(menu%(9),4,
  5772. open_window(mainW%)
  5773. 6  $RecInfo%="No primary key index file exists yet"
  5774.  "OS_File",5,$database%+".Database" 
  5775.  ,,,,len%
  5776. -  RA%=(len% 
  5777.  Length%)-1:$Records%=
  5778. (RA%)
  5779. first_field>0 
  5780. open_window(mainW%)
  5781. lit(menu%(1),7,
  5782. selected(passW%,13))
  5783. lit(menu%(1),8,
  5784. selected(passW%,13))
  5785. lit(menu%(1),2,
  5786. selected(passW%,14))
  5787.  "OS_File",5,$database%+".Database" 
  5788.  ,,,,len%
  5789. -  RA%=(len% 
  5790.  Length%)-1:$Records%=
  5791. (RA%)
  5792. open_index($database%+".PrimaryKey",0,
  5793. $  key%=0:file%=0:top=8*file%+LH%
  5794. set_keydata(key%)
  5795. l  keybase%=!keyanchor%(0):
  5796.  keybase%!4<=100 
  5797.  keybase%!4>0 
  5798.  $Increment%=
  5799. (keybase%!4) 
  5800.  $Increment%="0"
  5801. ,  f$=$database%+".Indices":R4%=0:Keys%=0
  5802.  R4%<>-1
  5803.     Keys%+=1
  5804. 5    
  5805.  "OS_GBPB",9,f$,block%,1,R4%,11 
  5806.  ,,K$,,R4%
  5807. C    
  5808.  R4%<>-1 
  5809. open_index(f$+"."+K$,Keys%,
  5810. colour(Keys%,2)
  5811.   Keys%-=1
  5812.  extrakeys$<>"" 
  5813. softerror(
  5814. extrakeys$),96)
  5815. colour(0,0):
  5816. colour(0,1)
  5817. get_tables
  5818.   key%=0
  5819. count(key%,RU%):
  5820. update_stats
  5821. show_windows
  5822.  "Hourglass_Off"
  5823. $dbase%=
  5824. $Title%,2)
  5825. redraw_icon(-2,pbaseicon%)
  5826. f$=$database%+".Choices"
  5827.  "OS_File",5,f$ 
  5828.  d%=1 
  5829. get_choices(f$)
  5830.  "OS_File",5,$database%+".Special" 
  5831.  d%=1 
  5832.  $database%+".Special":
  5833. customise
  5834. val(keypadW%,17)
  5835. $,5,6)="01 Apr" 
  5836. $,17,2)<"12" 
  5837. !  S$="Stoilet"+
  5838. $block%!32,8)
  5839.  S$="Sdelete"+
  5840. $block%!32,8)
  5841. val(keypadW%,17)=S$
  5842. get_choices(f$)
  5843.  F,S$,C$,P%
  5844. 2  S$=
  5845. #F:P%=
  5846. S$," "):C$=
  5847. S$,P%+1):S$=
  5848. S$,P%-1)
  5849. D    
  5850.  "Validate":validate%=(C$="ON"):
  5851. tick(menu%(2),3,validate%)
  5852. G    
  5853.  "Relations":relations%=(C$="ON"):
  5854. tick(menu%(2),4,relations%)
  5855. B    
  5856.  "Warning":delwarn%=(C$="ON"):
  5857. tick(menu%(10),7,delwarn%)
  5858.  "Autosave":
  5859. C$,4) 
  5860. .      
  5861.  "OFF ":mode%=0:$Interval%="10 min"
  5862. ,      
  5863.  "WARN":mode%=1:$Interval%=
  5864. C$,5)
  5865. ,      
  5866.  "AUTO":mode%=2:$Interval%=
  5867. C$,5)
  5868.         
  5869. set_auto(mode%)
  5870.  "Autobalance":
  5871. C$,4) 
  5872. &      
  5873.  "OFF ":
  5874. set_autobalance(
  5875. 5      
  5876.  "AUTO":$Every%=
  5877. C$,5):
  5878. set_autobalance(
  5879.         
  5880.  "Separator":
  5881.     $Delim%=""
  5882. !      
  5883.  "Comma":sep$=",":P%=0
  5884.        
  5885.  "TAB":sep$=
  5886. (9):P%=1
  5887.        
  5888.  "CR":sep$=
  5889. (13):P%=2
  5890.        
  5891.  "LF":sep$=
  5892. (10):P%=3
  5893. #      
  5894.  $Delim%=C$:sep$=C$:P%=4
  5895.         
  5896. #    
  5897. tick_one(menu%(15),0,3,P%)
  5898. 2    $
  5899. text(csvW%,14)=C$:
  5900. redraw_icon(csvW%,14)
  5901.  "Terminator":
  5902.     $Termin%=""
  5903. !      
  5904.  "CR":term$=
  5905. (13):P%=0
  5906. !      
  5907.  "LF":term$=
  5908. (10):P%=1
  5909. *      
  5910.  "CR LF":term$=
  5911. (13)+
  5912. (10):P%=2
  5913. *      
  5914.  "LF CR":term$=
  5915. (10)+
  5916. (13):P%=3
  5917. *      
  5918.  "CR CR":term$=
  5919. (13)+
  5920. (13):P%=4
  5921.     *      
  5922.  "LF LF":term$=
  5923. (10)+
  5924. (10):P%=5
  5925. &      
  5926. : $Termin%=C$:term$=C$:P%=6
  5927.         
  5928. #    
  5929. tick_one(menu%(20),0,5,P%)
  5930. 2    $
  5931. text(csvW%,15)=C$:
  5932. redraw_icon(csvW%,15)
  5933. -    
  5934.  "Quotes":
  5935. set_icon(csvW%,0,C$="ON")
  5936. -    
  5937.  "Header":
  5938. set_icon(csvW%,1,C$="ON")
  5939. -    
  5940.  "Blanks":
  5941. set_icon(csvW%,2,C$="ON")
  5942. *    
  5943.  "Key":
  5944. set_icon(csvW%,3,C$="ON")
  5945. B    
  5946.  "Data":
  5947. set_icon(csvW%,4,(C$="ON" 
  5948. selected(csvW%,1)))
  5949. /    
  5950.  "Display":
  5951. set_icon(csvW%,11,C$="ON")
  5952. -    
  5953.  "Strip":
  5954. set_icon(csvW%,16,C$="ON")
  5955.  "CaseSpecific":
  5956. '    
  5957. set_icon(matchW%,16,(C$="ON"))
  5958. (    
  5959. set_icon(savesubW%,5,(C$="ON"))
  5960. '    
  5961. set_icon(changeW%,5,(C$="ON"))
  5962. %    
  5963. set_icon(moveW%,9,(C$="ON"))
  5964. '    
  5965. set_icon(mergeW%,12,(C$="ON"))
  5966. (    
  5967. set_icon(keypadW%,32,(C$="ON"))
  5968.  "Duplication":
  5969. -    dup%=(C$="ON"):
  5970. tick(menu%(3),8,dup%)
  5971. icon_bit(22,csvW%,4,(
  5972. selected(csvW%,1)))
  5973. close_file(F)
  5974. save_choices(f$)
  5975.  F,C$
  5976.  validate%=
  5977.  C$="ON" 
  5978.  C$="OFF"
  5979. #F,"Validate "+C$
  5980.  relations%=
  5981.  C$="ON" 
  5982.  C$="OFF"
  5983. #F,"Relations "+C$
  5984.  delwarn%=
  5985.  C$="ON" 
  5986.  C$="OFF"
  5987. #F,"Warning "+C$
  5988.  autosave% 
  5989.  0:C$="OFF "
  5990.  1:C$="WARN"+$Interval%
  5991.  2:C$="AUTO"+$Interval%
  5992. #F,"Autosave "+C$
  5993.  autobalance% 
  5994.  0:C$="OFF "
  5995.  1:C$="AUTO"+$Every%
  5996. #F,"Autobalance "+C$
  5997. selected(csvW%,0) 
  5998.  C$="ON" 
  5999.  C$="OFF"
  6000. #F,"Quotes "+C$
  6001. selected(csvW%,1) 
  6002.  C$="ON" 
  6003.  C$="OFF"
  6004. #F,"Header "+C$
  6005. selected(csvW%,2) 
  6006.  C$="ON" 
  6007.  C$="OFF"
  6008. #F,"Blanks "+C$
  6009. selected(csvW%,3) 
  6010.  C$="ON" 
  6011.  C$="OFF"
  6012. #F,"Key "+C$
  6013. selected(csvW%,4) 
  6014.  C$="ON" 
  6015.  C$="OFF"
  6016. #F,"Data "+C$
  6017.  sep$ 
  6018.  ",":C$="Comma"
  6019. (9):C$="TAB"
  6020. (10):C$="LF"
  6021. (13):C$="CR"
  6022. :C$=sep$
  6023. #F,"Separator "+C$
  6024.  term$ 
  6025. (13):C$="CR"
  6026. (10):C$="LF"
  6027. (13)+
  6028. (10):C$="CR LF"
  6029. (10)+
  6030. (13):C$="LF CR"
  6031. (13)+
  6032. (13):C$="CR CR"
  6033. (10)+
  6034. (10):C$="LF LF"
  6035. :C$=term$
  6036. #F,"Terminator "+C$
  6037. selected(csvW%,11) 
  6038.  C$="ON" 
  6039.  C$="OFF"
  6040. #F,"Display "+C$
  6041. selected(csvW%,16) 
  6042.  C$="ON" 
  6043.  C$="OFF"
  6044. #F,"Strip "+C$
  6045. selected(matchW%,16),
  6046. selected(savesubW%,5),
  6047. selected(changeW%,5),
  6048. selected(moveW%,9),
  6049. selected(mergeW%,12),
  6050. selected(keypadW%,32):C$="ON"
  6051. :C$="OFF"
  6052. #F,"CaseSpecific "+C$
  6053.  dup% 
  6054.  C$="ON" 
  6055.  C$="OFF"
  6056. #F,"Duplication "+C$
  6057. close_file(F)
  6058.  "OS_File",18,f$,&fff
  6059. open_index(f$,key%,merge%)
  6060.  keybase%,I%
  6061.  key%>MaxKeys% 
  6062.  merge% 
  6063.  extrakeys$+=
  6064. leaf(f$)+",":Keys%-=1:
  6065.  keyanchor%(key%) 
  6066. scrap_sliding_block(keyanchor%(key%))
  6067.  "OS_File",5,f$ 
  6068.  ,,,,len%
  6069. create_named_sliding_block(keyanchor%(key%),len%)
  6070.  "OS_File",255,f$,!keyanchor%(key%)
  6071. Index$(key%)=
  6072. leaf(f$)
  6073. keybase%=!keyanchor%(key%)
  6074.  key%=0 
  6075.  I%=0 
  6076. n%    $Date%(I%)=$(keybase%+8+9*I%)
  6077. KF%(key%,0)=keybase%!62
  6078. KF%(key%,1)=keybase%!66
  6079. KL%(key%)=keybase%?70
  6080. t!case%(key%)=(keybase%?71=255)
  6081. u%incspace%(key%)=(keybase%?72=255)
  6082.  keybase%!62>0 
  6083.  ### Old key structure applies ###
  6084.   KF%(key%,0)=keybase%!62
  6085.   KF%(key%,1)=keybase%!66
  6086.  I%=0 
  6087. {(    KW%(key%,I%)=!(keybase%+74+I%*4)
  6088.   words%=
  6089.  I%=0 
  6090.     W%=!(keybase%+74+I%*4)
  6091.     chars%=W% 
  6092. 1    word%=(W%>>16) 
  6093.  255:
  6094.  word%>0 
  6095.  words%=
  6096.     field%=(W%>>24) 
  6097.     KW%(key%,I%)=chars%
  6098. .    
  6099.  I%=0 
  6100.  field%>0 
  6101.  KF%(key%,0)=field%
  6102. .    
  6103.  I%=1 
  6104.  field%>0 
  6105.  KF%(key%,1)=field%
  6106.  words% 
  6107.  KW%(key%,0)=0
  6108. get_tables
  6109.  lk,F%,d%,R4%,f$,name$
  6110. $f$=$database%+".ValTables":R4%=0
  6111.  "OS_File",5,$database%+".Tables" 
  6112.  d%=2 
  6113.  fatal_err%,
  6114. msg(18)
  6115. close_file(lk):
  6116. wimp_error(
  6117. ($database%+".Link")
  6118.  lk>0 
  6119.   !block%=mainW%
  6120.     F%+=1
  6121. #lk,link$(F%)
  6122.     name$=
  6123. link$(F%))
  6124. name$,1)<>"@" 
  6125.       
  6126.  name$<>"" 
  6127. +        
  6128. (name$)<58 
  6129.  name$=
  6130. name$,2)
  6131. 6        
  6132. set_icon_cols(mainW%,field%(F%),fcol%(6))
  6133. .        
  6134.  d%=0 
  6135. load_table(f$+"."+name$)
  6136.       
  6137.         
  6138.   link$(0)="LOADED"
  6139. close_file(lk)
  6140.  ### Force loading of unlinked but flagged tables ###
  6141.  R4%<>-1
  6142.  "OS_GBPB",9,f$,block%,1,R4%,11 
  6143.  ,,name$,,R4%
  6144.  R4%<>-1 
  6145. name$)="!" 
  6146. load_table(f$+"."+name$)
  6147.  extratabs$<>"" 
  6148. softerror(
  6149. extratabs$),97)
  6150. load_calcs
  6151.  F%,F1%,P%,calc$
  6152. update$()=""
  6153. ($database%+".Calc")
  6154.  cl>0 
  6155. +    F%+=1:F$=
  6156. ~(F%):
  6157.  F%<16 
  6158.  F$="0"+F$
  6159. "    
  6160. #cl,calc$:calc$(F%)=calc$
  6161.  chartype%(F%) 
  6162.       
  6163.  6,7:
  6164.       
  6165. !        P%=
  6166. calc$,"$Rf%(",P%)
  6167. ?        
  6168.  P%>0 
  6169.  F1%=
  6170. calc$,P%+5)):update$(F1%)+=F$:P%+=5
  6171.       
  6172.  P%=0
  6173.       
  6174.          P%=
  6175. calc$,"FNn(",P%)
  6176. ?        
  6177.  P%>0 
  6178.  F1%=
  6179. calc$,P%+4)):update$(F1%)+=F$:P%+=4
  6180.       
  6181.  P%=0
  6182. .      
  6183. calc$,"TIME$")>0 
  6184.  update$(0)+=F$
  6185.         
  6186.   calc$(0)="LOADED"
  6187. close_file(cl)
  6188. get_form(
  6189.  Fptr%)
  6190.  F,L%,N%,I%,V%,x%,y%,xlim%,ylim%,text%
  6191. buttonfield%()=0
  6192.  design% 
  6193.  dflg%=(winback%<<28)+&7016731:dval%=hand%:func%=1 
  6194.  dflg%=(winback%<<28)+&7010731:dval%=-1:func%=0
  6195. ($database%+".Form")
  6196.  F>0 
  6197. #F,N%
  6198.  N%>127 
  6199.  fatal_err%,
  6200. msg(98)
  6201. 2  formlen%=&100:forminc%=formlen%:form_incs%=0
  6202. extend_named_sliding_block(formanchor%,formlen%)
  6203. 9  Fptr%=!formanchor%:Rf%(0)=Fptr%:$Rf%(0)="":Fptr%+=1
  6204.   Length%=0
  6205.  I%=1 
  6206. @    
  6207. #F,Desc$,Tag$(I%),xd%,yd%,xf%,yf%,len%,char%,fix%,bbox%
  6208. /      
  6209.  bbox%=0 
  6210.  len%=0:width%=0:height%=0
  6211. 0      
  6212.  bbox%=0:width%=len%*16+16:height%=48
  6213. 6      
  6214.  bbox%<&10000:width%=bbox%*16+16:height%=48
  6215. 2      
  6216. :width%=bbox% 
  6217.  &FFFF:height%=bbox%>>16
  6218.         
  6219.  design% 
  6220.       
  6221.  char% 
  6222. 1        
  6223.  0,1,2,3,4,5,6,7,8,39,40:fval%=hand%
  6224. "        
  6225. :fval%=hvalid%(char%)
  6226.       
  6227.       
  6228.       
  6229. =        
  6230.  char%>8 
  6231.  char%<32:fval%=
  6232. val(keypadW%,char%-9)
  6233. !        
  6234. :fval%=valid%(char%)
  6235.       
  6236.         
  6237. "    x%=xf%+width%+32:y%=yf%-16
  6238.  x%>xlim% 
  6239.  xlim%=x%
  6240.  y%<ylim% 
  6241.  ylim%=y%
  6242. '    y%=yd%-16:
  6243.  y%<ylim% 
  6244.  ylim%=y%
  6245.     Length%+=len%+1
  6246. F    
  6247.  design%=
  6248.  char%=39 
  6249.  len%=(height% 
  6250.  40)*((width% 
  6251.  16)-4)
  6252. 7    len%(I%)=len%:chartype%(I%)=char%:fix%(I%)=fix%
  6253.     L%=
  6254. (Desc$)
  6255. 1    
  6256.  Fptr%-!formanchor%+L%+len%+2>formlen% 
  6257. *      form_incs%+=1:formlen%+=forminc%
  6258. ;      
  6259. extend_named_sliding_block(formanchor%,formlen%)
  6260.         
  6261.     $Fptr%=Desc$
  6262. S    desc%(I%)=
  6263. create_icon(mainW%,xd%,yd%,L%*16+8,48,dflg%,"",Fptr%,dval%,L%+1)
  6264. -    Fptr%+=L%+1:Rf%(I%)=Fptr%:$Rf%(I%)=""
  6265. 0    
  6266. icon_design(char%,func%,width%,height%)
  6267. H    
  6268.  char%=59 
  6269.  fval%=!logoanchor%:$Fptr%=Tag$(I%):len%=
  6270. (Tag$(I%))
  6271. \    field%(I%)=
  6272. create_icon(mainW%,xf%,yf%,width%,height%,iflags%,"",Fptr%,fval%,len%+1)
  6273.  char% 
  6274. h      
  6275.  9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31:buttonfield%(char%-9)=I%
  6276. 6      
  6277.  40:Rf%(I%)=
  6278. create_anchor("Picture"+
  6279. (I%))
  6280. ?      
  6281.  3,6,46,47,54,56,57:
  6282. icon_bit(9,mainW%,field%(I%),
  6283.         
  6284.     Fptr%+=len%+1
  6285. close_file(F)
  6286. extend_named_sliding_block(formanchor%,Fptr%-!formanchor%):form_incs%+=1
  6287. setup_select(N%)
  6288.  N%=0
  6289.  (present% 
  6290.  4)=0 
  6291.  xlim%=1279:ylim%=-1023
  6292. !block%=0:block%!4=ylim%
  6293. block%!8=xlim%:block%!12=0
  6294.  "Wimp_SetExtent",mainW%,block%
  6295. !block%=mainW%
  6296.  "Wimp_GetWindowState",,block%
  6297. block%!4=0
  6298.  ylim%>-840 
  6299.  block%!8=900+ylim% 
  6300.  block%!8=184
  6301.  xlim%<1240 
  6302.  block%!12=xlim% 
  6303.  block%!12=1240
  6304. block%!16=900
  6305.  "Wimp_OpenWindow",,block%
  6306. setup_select(fields%)
  6307.  S$,I%,J%,Fptr%,rows%
  6308. &selectlen%=&200:selinc%=selectlen%
  6309. create_named_sliding_block(selanchor%,selectlen%)
  6310. Fptr%=!selanchor%
  6311.  I%=1 
  6312.  fields%
  6313.  Fptr%-!selanchor%+144>selectlen% 
  6314.     selectlen%+=selinc%
  6315. :    
  6316. extend_named_sliding_block(selanchor%,selectlen%)
  6317.  chartype%(I%) 
  6318.  3,6,8,46,47,54,56,57:
  6319. #    rows%+=1:
  6320. lit(menu%(6),6,
  6321. W    handle%=
  6322. create_icon(pselectW%,16,-rows%*48-56,240,48,&17000531,"",Fptr%,-1,15)
  6323.  #    S$=$
  6324. text(mainW%,desc%(I%))
  6325. !7    
  6326. (S$)>8 
  6327. S$,8)+"  " 
  6328.  S$+=
  6329. (S$)," ")
  6330. "-    $Fptr%=S$+Tag$(I%):Fptr%+=
  6331. ($Fptr%)+1
  6332.  J%=0 
  6333. $a      handle%=
  6334. create_icon(pselectW%,278+J%*80,-rows%*48-52,44,44,&0740B13B,"",Fptr%,tick%,1)
  6335.       $Fptr%="":Fptr%+=1
  6336.     calcrow%?I%=rows%
  6337. :calcrow%?I%=0
  6338. +#!block%=0:block%!4=-rows%*48-56
  6339. block%!8=700:block%!12=0
  6340.  "Wimp_SetExtent",pselectW%,block%
  6341. enable_row(R%,on%)
  6342.  R%>0 
  6343.  I%=R%*7-5 
  6344.  R%*7
  6345. 4&    
  6346. icon_bit(22,pselectW%,I%,on%)
  6347. save_form(f$)
  6348.  F,I%,xd%,yd%,xf%,yf%,w%,h%,bbox%,type%
  6349.  fields%=0 
  6350. Length%=0
  6351. !block%=mainW%
  6352. #F,fields%
  6353.  I%=1 
  6354.  fields%
  6355. A(  dicon%=desc%(I%):ficon%=field%(I%)
  6356. B4  block%!4=dicon%:
  6357.  "Wimp_GetIconState",,block%
  6358. C   xd%=block%!8:yd%=block%!12
  6359.   Desc$=$(block%!28)
  6360. E4  block%!4=ficon%:
  6361.  "Wimp_GetIconState",,block%
  6362. F   xf%=block%!8:yf%=block%!12
  6363. G2  w%=block%!16-block%!8:h%=block%!20-block%!12
  6364.   bbox%=(h%<<16)+w%
  6365. #F,Desc$,Tag$(I%),xd%,yd%,xf%,yf%,len%(I%),chartype%(I%),fix%(I%),bbox%
  6366.   Length%+=len%(I%)+1
  6367. KA  field$(I%)="":
  6368.  Rf%(I%)>0 
  6369.  chartype%(I%)<>40 
  6370.  $Rf%(I%)=""
  6371. close_file(F)
  6372.  "OS_File",18,f$,&7f2
  6373. lit(menu%(0),3,
  6374. lit(menu%(0),4,
  6375. make_empty_index(RA%,key%,Z%)
  6376.  I%,K%,P%,KLM%,S$
  6377.  "Hourglass_On"
  6378. KL%(key%),".")
  6379. KLM%=KL%(key%)+13
  6380. P%=LH%+48+(RA%+1)*KLM%
  6381. create_named_sliding_block(keyanchor%(key%),P%)
  6382. keybase%=!keyanchor%(key%)
  6383. keybase%!0=138
  6384. keybase%!4=
  6385. ($Increment%)
  6386. $date%=
  6387. (1)):
  6388. date(key%)
  6389. keybase%!62=KF%(key%,0)
  6390. keybase%!66=KF%(key%,1)
  6391. keybase%?70=KL%(key%)
  6392. selected(keyW%,20) 
  6393.  keybase%?71=255:case%(key%)=
  6394. selected(keyW%,28) 
  6395.  keybase%?72=255:incspace%(key%)=
  6396. keybase%?73=0
  6397.  I%=0 
  6398. e(  !(keybase%+74+(I%*4))=KW%(key%,I%)
  6399.  I%=0 
  6400.   P%=I%*8+LH%
  6401.   !(keybase%+P%)=-P%
  6402.   !(keybase%+P%+4)=P%
  6403. P%=!keybase%
  6404.  I%=0 
  6405.  RA%-1
  6406.  "Hourglass_Percentage",(I%*100) 
  6407.   !(keybase%+P%)=P%+KLM%
  6408.   !(keybase%+P%+4)=0
  6409.   $(keybase%+P%+8)=S$
  6410. r#  !(keybase%+P%+KL%(key%)+9)=I%
  6411.   P%+=KLM%
  6412. !(keybase%+P%)=0
  6413. !(keybase%+P%+4)=0
  6414. $(keybase%+P%+8)=S$
  6415. x !(keybase%+P%+KL%(key%)+9)=0
  6416.  "Hourglass_Off"
  6417. save_recs(f$,RA%)
  6418.  dbasehandle%,I%,J%,rec$
  6419. rec$=
  6420. fields%-1,
  6421. (10))
  6422.  "Hourglass_On"
  6423. dbasehandle%=
  6424.  I%=0 
  6425. #dbasehandle%=I%*Length%
  6426. #dbasehandle%,rec$
  6427.  "Hourglass_Percentage",(I%*100) 
  6428. #dbasehandle%=(RA%+1)*Length%
  6429. close_file(dbasehandle%)
  6430.  "OS_File",18,f$,&7f2
  6431.  "Hourglass_Off"
  6432. clear
  6433.  REC%,action$,ex%,ptr%
  6434. 8Search$=
  6435. parse($
  6436. text(moveW%,7),
  6437. selected(moveW%,9))
  6438.  "Wimp_WhichIcon",moveW%,block%,&003F0000,&00210000
  6439. movetype%=!block%-1
  6440. Title$,". ")+2:Title$=
  6441. Title$,P%)
  6442.  Title$<>"All records" 
  6443.  Title$=" when "+Title$ 
  6444.  Title$=" "+Title$
  6445. 9action$=
  6446. "Move 
  6447. DeleteMove 
  6448. ",movetype%*6+7,6)+Title$
  6449. confirm(action$) 
  6450.  "Hourglass_On"
  6451. *dbasehandle%=
  6452. ($database%+".Database")
  6453. earmark
  6454. close_file(dbasehandle%)
  6455. ptr%=!tempanchor%
  6456. %subtotal%=
  6457. count_recs(key%,zero%)
  6458.  REC%=0 
  6459.  RA%-1
  6460. <  ex%+=1:
  6461.  "Hourglass_Percentage",(ex%*100) 
  6462.  subtotal%
  6463.  ptr%?REC%=255 
  6464. (    
  6465. read(fields%,
  6466. ,REC%,$database%)
  6467. %    addr=
  6468. shift(movetype%,key%,0)
  6469.  REC%
  6470. scrap_sliding_block(tempanchor%)
  6471.  "Hourglass_Off"
  6472.  "Wimp_CreateMenu",,-1
  6473. addr=
  6474. moveto(key%,top,1)
  6475. export_subset(f$)
  6476.  I%,F,R%,recs%,ptr%,count%,subtotal%,blobs%,ex%,Z%,len%,source$,dest$,O$
  6477.  "OS_CLI","Copy "+$database%+".Form "+f$+".Form ~C~V"
  6478.  link$(0)="LOADED" 
  6479.  "OS_CLI","Copy "+$database%+".Link "+f$+".Link ~C~V"
  6480.  calc$(0)="LOADED" 
  6481.  "OS_CLI","Copy "+$database%+".Calc "+f$+".Calc ~C~V"
  6482.  "OS_CLI","Copy "+$database%+".ValTables "+f$+".Valtables ~C~VR"
  6483.  "OS_CLI","Copy "+$database%+".Colours "+f$+".Colours ~CF~V"
  6484.  "OS_File",5,$database%+".UserFuncs" 
  6485.  d%=1 
  6486.  "OS_CLI","Copy "+$database%+".UserFuncs "+f$+".UserFuncs ~CF~V"
  6487.  "OS_File",5,$database%+".UsrSprites" 
  6488.  d%=1 
  6489.  "OS_CLI","Copy "+$database%+".UsrSprites "+f$+".UsrSprites ~CF~V"
  6490.  "Hourglass_On"
  6491. "blobs%=
  6492. find_blobs($database%)
  6493. >Search$=
  6494. parse($
  6495. text(savesubW%,0),
  6496. selected(savesubW%,5))
  6497. *dbasehandle%=
  6498. ($database%+".Database")
  6499. earmark
  6500. (f$+".Database")
  6501. ptr%=!tempanchor%
  6502. %subtotal%=
  6503. count_recs(key%,zero%)
  6504.  I%=0 
  6505.  RA%-1
  6506.  ptr%?I%=255 
  6507.     ex%=-1
  6508.  ex%<blobs%
  6509.       ex%+=1:F%=Ext%(ex%)
  6510. @      
  6511. copy_blob($database%,f$,I%,recs%,F%,F%,chartype%(F%))
  6512.         
  6513. <    
  6514. readsmarray(dbasehandle%,I%):
  6515. writesmarray(F,recs%)
  6516.     count%+=1
  6517. :    
  6518.  "Hourglass_Percentage",(count%*100) 
  6519.  subtotal%
  6520. scrap_sliding_block(tempanchor%)
  6521. =F$()="":
  6522. writesmarray(F,recs%):
  6523. #F=Length%*recs%:recs%-=1
  6524.  K%=0 
  6525.  Keys%
  6526. ,  KL%(MaxKeys%+1)=KL%(K%):val$=
  6527. type(K%)
  6528. !  KF%(MaxKeys%+1,0)=KF%(K%,0)
  6529. !  KF%(MaxKeys%+1,1)=KF%(K%,1)
  6530.  I%=0 
  6531. %    KW%(MaxKeys%+1,I%)=KW%(K%,I%)
  6532. make_empty_index(recs%,MaxKeys%+1,
  6533.  REC%=0 
  6534.  recs%-1
  6535. readsmarray(F,REC%)
  6536.     KEY$=
  6537. key2(K%,1)
  6538.      
  6539. insert(KEY$,MaxKeys%+1)
  6540. 4    
  6541.  "Hourglass_Percentage",(REC%*100) 
  6542.  recs%
  6543.  REC%
  6544. &  keybase%=!keyanchor%(MaxKeys%+1)
  6545.  "SlidingHeap_DescribeBlock",slidingheapbase%,keyanchor%(MaxKeys%+1) 
  6546.  ,,filelength%
  6547.  K%>0 
  6548.  index$="Indices." 
  6549.  index$=""
  6550.  "OS_File",10,f$+"."+index$+Index$(K%),&7f0,,keybase%,keybase%+filelength%
  6551. scrap_sliding_block(keyanchor%(MaxKeys%+1))
  6552. close_file(F)
  6553. close_file(dbasehandle%)
  6554.  "OS_File",18,f$+".Database",&7f2
  6555. export%=
  6556.  "Hourglass_Off"
  6557. find_blobs(f$)
  6558.  N%,R4%,S$
  6559.     N%=-1
  6560.  R4%<>-1
  6561.  "OS_GBPB",9,f$,block%,1,R4%,11 
  6562.  ,,S$,,R4%
  6563. S$,4) 
  6564. )    
  6565.  "Memo":N%+=1:Ext%(N%)=
  6566. S$,5))
  6567. )    
  6568.  "Draw":N%+=1:Ext%(N%)=
  6569. S$,5))
  6570. )    
  6571.  "Spri":N%+=1:Ext%(N%)=
  6572. S$,7))
  6573. earmark
  6574.  I%,P%
  6575.  tempanchor% 
  6576. scrap_sliding_block(tempanchor%)
  6577. create_named_sliding_block(tempanchor%,RA%)
  6578. ptr%=!tempanchor%
  6579.  I%=0 
  6580.  RA%-1
  6581.   ptr%?I%=0
  6582. neighbour(key%,top,1)
  6583. scan_file("P%<>top",key%,2)
  6584. rotate
  6585.  Access% 
  6586. confirm(
  6587. msg(49))=
  6588.  keybase%
  6589.  I%,L%,Z%,Q%,R%,S%,key%
  6590.  key%=0 
  6591.  Keys%
  6592.    keybase%=!keyanchor%(key%)
  6593.   S%=LH%+40
  6594.   Z%=keybase%!S%
  6595.  I%=S%-8 
  6596.  S%-40 
  6597. )    L%=keybase%!I%:R%=keybase%!(I%+4)
  6598. =    
  6599.  L%>0 
  6600.  keybase%!(I%+8)=L% 
  6601.  keybase%!(I%+8)=-(I%+8)
  6602.  Z%>0 
  6603.  keybase%!(S%-40)=Z% 
  6604.  keybase%!(S%-40)=-(S%-40)
  6605.  I%=S%-40 
  6606.     Q%=I%-8
  6607.  Q%=S%-48 
  6608.  Q%=S%
  6609. !    PR%=
  6610. neighbour(key%,I%,0)
  6611. !    SU%=
  6612. neighbour(key%,I%,1)
  6613. '    
  6614.  PR%>S% 
  6615.  keybase%!(PR%+4)=-I%
  6616. #    
  6617.  SU%>S% 
  6618.  keybase%!SU%=-I%
  6619.  key%
  6620. $date%=
  6621. warn%=
  6622. write_log(-1,"Subfiles rotated")
  6623. create_index
  6624.  indexing% 
  6625.  printing% 
  6626.  Keys%=MaxKeys% 
  6627. softerror(
  6628. (Keys%),95):
  6629.  file%,top,P%,KEY$,REC%,val$,zero%,abort%,replace%
  6630. newkey%=0
  6631. ;f$=Tag$(Keyfld0%):
  6632.  Keyfld1%>0 
  6633.  f$+="+"+Tag$(Keyfld1%)
  6634.   newkey%+=1
  6635.  Index$(newkey%)=f$ 
  6636.  newkey%>Keys%
  6637.  newkey%<=Keys%:
  6638. $     
  6639. confirm(
  6640. msg(50))=
  6641. %3      
  6642. scrap_sliding_block(keyanchor%(newkey%))
  6643.       replace%=
  6644.       
  6645.  abort%=
  6646. (        
  6647.  Keys%>MaxKeys%:Keys%-=1:
  6648. softerror("",31):abort%=
  6649. :Keys%=newkey%
  6650.  abort% 
  6651. -*block%!8=0:block%!12=keyW%:block%!16=7
  6652.  "Interface_SlabButton",,block%
  6653. copy_keydata(newkey%)
  6654. Index$(newkey%)=f$
  6655. 1-f$=$database%+".Indices."+Index$(newkey%)
  6656. make_empty_index(RA%,newkey%,
  6657. lit(menu%(0),2,
  6658. limit_actions(
  6659. abort_index(f$):
  6660. 7*dbasehandle%=
  6661. ($database%+".Database")
  6662. indexing%=
  6663. :Search$="TRUE"
  6664. update_stats
  6665.  file%=0 
  6666.   top=file%*8+LH%
  6667.   P%=
  6668. neighbour(key%,top,1)
  6669.   val$=
  6670. type(newkey%)
  6671.  "Hourglass_On"
  6672. scan_file("P%<>top",key%,4)
  6673.  file%
  6674. end_index
  6675. colour(newkey%,2)
  6676. warn%=
  6677. write_log(-1,"Index "+Index$(newkey%)+" created")
  6678. abort_index(f$)
  6679. end_index
  6680.  replace% 
  6681. open_index(f$,newkey%,
  6682.  index%=newkey% 
  6683.  Keys%
  6684. N)    Index$(newkey%)=Index$(newkey%+1)
  6685.  index%
  6686. scrap_sliding_block(keyanchor%(newkey%))
  6687.   Keys%-=1
  6688.   newkey%=0
  6689. softerror("",43)
  6690. wimp_error(
  6691. end_index
  6692.  "Hourglass_Smash"
  6693. indexing%=
  6694. limit_actions(Access%)
  6695.  "Wimp_CreateMenu",,-1
  6696. lit(menu%(0),2,Modify%)
  6697. close_file(dbasehandle%)
  6698. shift(t%,k%,m%)
  6699.  a%,key%,fi%,I%,F$,action$
  6700.  Access% 
  6701. =addr
  6702.  REC%=RA% 
  6703. =addr
  6704.  t%=0 
  6705.  m%=1 
  6706. confirm(
  6707. msg(51))=
  6708. =addr
  6709.  key%=0 
  6710.  Keys%
  6711. i2  N$=
  6712. key(key%):kl%=KL%(key%):val$=
  6713. type(key%)
  6714. delete(N$,key%)
  6715.  N$="*Failed*" 
  6716. =addr
  6717.  key%=k% 
  6718.  a%=SU%
  6719.  t%=1 
  6720.  fi%=(file%+1) 
  6721.  t%=-1 
  6722.  fi%=(file%-1-6*(file%=0))
  6723.   top=8*fi%+LH%
  6724.  I%=1 
  6725.  fields%
  6726.       V%=chartype%(I%)
  6727.       
  6728.         
  6729.  36,39:
  6730. vR        
  6731. blob_path(
  6732. ,$database%,REC%,I%,V%,F$)>=0 
  6733.  "OS_CLI","Delete "+F$
  6734.         
  6735.  9,37:
  6736. xR        
  6737. blob_path(
  6738. ,$database%,REC%,I%,V%,F$)>=0 
  6739.  "OS_CLI","Delete "+F$
  6740.         
  6741. zR        
  6742. blob_path(
  6743. ,$database%,REC%,I%,V%,F$)>=0 
  6744.  "OS_CLI","Delete "+F$
  6745.       
  6746. ~6    
  6747. insert(N$,key%):date%?fi%=1:$Date%(fi%)=
  6748.   top=8*file%+LH%
  6749.   date%?file%=1
  6750.   $Date%(file%)=
  6751.  key%
  6752.  blankrec%=
  6753.  I%=1 
  6754.  fields%
  6755.       $Rf%(I%)=""
  6756. $    
  6757. write_dbase(REC%,fields%,
  6758. &    action$=" Deleted and blanked"
  6759.  action$=" Deleted"
  6760. :action$=" ===> subfile "+
  6761. (fi%)
  6762. write_log(REC%,logentry$+action$)
  6763. warn%=
  6764. type(key%)
  6765.  F%,V$
  6766.  key%>=0 
  6767.  F%=KF%(key%,0) 
  6768.  F%=-key%
  6769.  chartype%(F%) 
  6770.  3,6,46,47,54,56,57:V$="VAL"
  6771. confirm(string$)
  6772. !block%=255
  6773. $(block%+4)=string$
  6774.  "Wimp_ReportError",block%,(1<<0)+(1<<1)+(1<<4),"Powerbase: please confirm:" 
  6775.  ,result%
  6776. =result%=1
  6777. getscreensize(
  6778.  S_Width%,
  6779.  S_Height%)
  6780.  H1%,V1%,H2%,V2%,End%
  6781. $H1%=0:V1%=4:H2%=8:V2%=12:End%=16
  6782. 9Mi%!H1%=4:Mi%!V1%=5:Mi%!H2%=11:Mi%!V2%=12:Mi%!End%=-1
  6783.  "OS_ReadVduVariables",Mi%,Mo%
  6784. )S_Width%=(1<<(Mo%!H1%))*((Mo%!H2%)+1)
  6785. *S_Height%=(1<<(Mo%!V1%))*((Mo%!V2%)+1)
  6786. match
  6787. check_change
  6788.  common% 
  6789. text(matchW%,0)=""
  6790. redraw_icon(matchW%,0)
  6791. open_window(matchW%)
  6792. set_caret(matchW%,0)
  6793. text(matchW%,3)=Tag$(Match_tag%)
  6794. tick_one(fieldmenu%,0,fields%-1,Match_tag%-1)
  6795. redraw_icon(matchW%,3)
  6796. text(matchW%,14)=""
  6797. redraw_icon(matchW%,14)
  6798. selected(matchW%,27) 
  6799. text(matchW%,25)="Number found" 
  6800. text(matchW%,25)="Time taken"
  6801. redraw_icon(matchW%,25)
  6802. "fieldfunc$="match":matching%=
  6803.  List printing -----------------------------------------------------
  6804. print_this
  6805. %f$=$database%+".PrintRes.Default"
  6806.  "OS_File",5,f$ 
  6807.  d%,,type%
  6808.  d%=1 
  6809.  type%=&7f3 
  6810. load_selection(f$)
  6811. !old%=
  6812. selected_esg(printW%,3)
  6813. deselect(printW%,old%)
  6814. select(printW%,24)
  6815. mouse(0,0,4,matchW%,24)
  6816. clear_selection
  6817. deselect(printW%,24)
  6818. select(printW%,old%)
  6819. do_it(Search$,displayed%)
  6820.  printing% 
  6821.  zero%,P%,rec%,REC%,copy%
  6822. lit(menu%(18),1,
  6823. Form$=printorder$
  6824.  Form$="" 
  6825.  W%=0 
  6826.  KF%(0,W%)>0 
  6827. :      F$=
  6828. ~(KF%(0,W%)):
  6829. (F$)=1 
  6830.  F$="0"+F$:Form$+=F$
  6831. }      
  6832. selected(matchW%,27) 
  6833. select(mainW%,field%(KF%(0,W%))):printorder$+=F$:
  6834. lit(menu%(6),7,
  6835. lit(menu%(6),8,
  6836.         
  6837. #Heading$="":Hlongest%=0:Sum()=0
  6838.  I%=1 
  6839.   Sum(I%,5)=10^30
  6840. +Count%=0:examined%=0:printed%=0:sums%=0
  6841. read_print_options
  6842. selected(printW%,40) 
  6843. find_max_lengths(displayed%) 
  6844.  maxlen%()=len%()
  6845. LenLine%=
  6846. include_fields
  6847. ,numfirst%=
  6848. margin_warn:
  6849.  numfirst%<0 
  6850. list_head(0)
  6851.  "Wimp_GetPointerInfo",,block%
  6852. limit_actions(
  6853. lit(menu%(0),2,0)
  6854. printing%=
  6855.  "OS_ReadMonotonicTime" 
  6856.  stime%
  6857. abort_printing:
  6858. *dbasehandle%=
  6859. ($database%+".Database")
  6860.  "Hourglass_On"
  6861.  displayed%>=0:
  6862. readsmarray(dbasehandle%,displayed%)
  6863.  format$="label" 
  6864.  copy%=1 
  6865.  labcopies%
  6866. #      
  6867. print_record(displayed%)
  6868.  copy%
  6869. #    
  6870. print_record(displayed%)
  6871.  usekey%=-1 
  6872. selected(matchW%,23)=
  6873. <  P%=
  6874. neighbour(key%,top,1):
  6875. scan_file("P%<>top",key%,1)
  6876. #  P%=
  6877. search(useval$,usekey%,1)
  6878.  P%>=0 
  6879.  k$=useval$:
  6880. scan_file("P%<>top AND k$=useval$",usekey%,1)
  6881. end_printing
  6882. abort_printing
  6883. end_printing
  6884. softerror("",29)
  6885. wimp_error(
  6886. end_printing
  6887.  time%
  6888.  format$="label" 
  6889.  thislab%>0 
  6890. print_labels
  6891.  "OS_ReadMonotonicTime" 
  6892.  etime%
  6893. time%=etime%-stime%
  6894. selected(matchW%,27) 
  6895. text(matchW%,14)=
  6896. (printed%) 
  6897. text(matchW%,14)=
  6898. (time% 
  6899.  100)+"."+
  6900. (time% 
  6901.  100)+" sec"
  6902. redraw_icon(matchW%,14)
  6903.  "Hourglass_Smash"
  6904.  format$<>"label" 
  6905.  displayed%=-1 
  6906. total_list
  6907.  reportdest$ 
  6908.  "Window":
  6909. selected(matchW%,27) 
  6910. screen_list
  6911. extend_named_sliding_block(textanchor%,Count%*LenLine%)
  6912.  "File":
  6913. close_file(texthandle%):
  6914.  "OS_File",18,f$,&fff
  6915. close_window(saveW%)
  6916.  "Printer":
  6917. extend_named_sliding_block(textanchor%,Count%*LenLine%)
  6918. B  Start%=!textanchor%:End%=Start%+Count%*LenLine%+1:Type%=&fff
  6919. )  $Start%=pitch$:?(End%-1)=0:?End%=12
  6920. ;  block%!0=256:block%!12=0:block%!16=&80142:block%!20=0
  6921. D  block%!24=0:block%!28=0:block%!32=0:block%!36=0:block%!40=&fff
  6922.   $(block%+44)="List"
  6923.  "Wimp_SendMessage",18,block%,0
  6924. printing%=
  6925. :savetofile%=
  6926. lit(menu%(0),2,Modify%)
  6927. limit_actions(Access%)
  6928. close_file(dbasehandle%)
  6929. write_log(-1,"List printed: "+searchformula$)
  6930. find_max_lengths(displayed%)
  6931.  P%,k$
  6932. end_find_max:
  6933. maxlen%()=0
  6934. **dbasehandle%=
  6935. ($database%+".Database")
  6936.  "Hourglass_On"
  6937.  "Hourglass_LEDs",%11
  6938.  displayed%>=0 
  6939. readsmarray(dbasehandle%,displayed%)
  6940. get_lengths
  6941.  usekey%=-1 
  6942. selected(matchW%,23)=
  6943. 2!    P%=
  6944. neighbour(key%,top,1)
  6945. 3$    
  6946. scan_file("P%<>top",key%,0)
  6947. 4        
  6948. 5%    P%=
  6949. search(useval$,usekey%,1)
  6950.  P%>=0 
  6951.       k$=useval$
  6952. 88      
  6953. scan_file("P%<>top AND k$=useval$",usekey%,0)
  6954. 9        
  6955.  "Hourglass_LEDs",%00
  6956.  "Hourglass_Off"
  6957. close_file(dbasehandle%)
  6958. get_lengths
  6959.  I%,L%,F%,l%,F$
  6960. I%=-1:L%=
  6961. (Form$)-1
  6962.  I%<L%
  6963. E5  I%+=2:F%=
  6964. fnum(
  6965. Form$,I%,2)):F$=F$(F%):l%=
  6966.  l%>maxlen%(F%) 
  6967.  maxlen%(F%)=l%
  6968. end_find_max
  6969.  "Hourglass_Smash"
  6970. close_file(dbasehandle%)
  6971. maxlen%()=len%()
  6972. softerror("",70)
  6973. wimp_error(
  6974. print_record(REC%)
  6975.  I%,F%,N%,Z%,F$,SF$,Tab%,n$,y$,base%,pos%
  6976.  format$<>"label" 
  6977.  printed%+=1
  6978. selected(matchW%,27) 
  6979. X-thisrow%=-1:base%=!lineanchor%:pos%=base%
  6980. heap_store(lineanchor%,LenLine%,0,pos%,0,margin$)
  6981.  I%=1 
  6982. (Form$)-1 
  6983.   F%=
  6984. fnum(
  6985. Form$,I%,2))
  6986.  format$="label" 
  6987.  newline%=
  6988.  newline%
  6989.   N%+=1
  6990.  0:F$=
  6991. (REC%)
  6992. a!    
  6993. selected(printW%,11) 
  6994. b/      F$=
  6995. expand(F$(F%),link$(F%),Len%,SF$)
  6996.       
  6997. d#      F$=F$(F%):Len%=len%(F%)+2
  6998.       
  6999.  chartype%(F%) 
  7000.         
  7001.  41,42,43,44,45:
  7002. g         Z%=
  7003. no_yes(F%,n$,y$)
  7004. h$        
  7005.  F$=" " 
  7006.  F$=y$ 
  7007.  F$=n$
  7008. i#        
  7009.  3,6,8,46,47,54,56,57:
  7010. j/        
  7011. sums(F$,calcrow%?F%,chartype%(F%))
  7012.         
  7013.  format$="vert" 
  7014. l(          F$=
  7015. len%(F%)-
  7016. (F$)," ")+F$
  7017. m'          
  7018. justify(F$,N%,N%-1)
  7019.         
  7020.       
  7021. p        
  7022. selected(printW%,12) 
  7023. u(F$)
  7024.  chartype%(F%) 
  7025.  37:F$="<Sprite>"
  7026.  38:F$="<Drawfile>"
  7027.  format$ 
  7028.  "horiz","table":
  7029. y>    
  7030. heap_store(lineanchor%,LenLine%,0,pos%,0,
  7031. tab(F$,N%))
  7032.  "vert":
  7033. {R    
  7034. selected(printW%,2) 
  7035.  Head$=$
  7036. text(mainW%,(desc%(F%))) 
  7037.  Head$=Tag$(F%)
  7038. |8    Head$=margin$+
  7039. Tab%(1)-
  7040. (Head$)," ")+Head$+" : "
  7041. }@    hdlen%=
  7042. (Head$):H$=
  7043. hdlen%," "):datlen%=
  7044. (F$):pos%=base%
  7045.  chartype%(F%) 
  7046. /      
  7047.  36,39:
  7048. print_memo(REC%,F%,Head$,F$)
  7049.       
  7050. :      
  7051. heap_store(lineanchor%,LenLine%,0,pos%,0,Head$)
  7052. %      
  7053.  hdlen%+datlen%<LenLine% 
  7054. 9        
  7055. heap_store(lineanchor%,LenLine%,0,pos%,0,F$)
  7056. :        
  7057. list_line(REC%,lineanchor%,hdlen%+datlen%,32)
  7058.         
  7059. A        L%=LenLine%-hdlen%-1:F$+=" ":H$=
  7060. hdlen%," "):first%=
  7061.         
  7062. (F$)>L%
  7063.           p%=1:q%=1
  7064.           
  7065.             p%=
  7066. F$," ",q%)
  7067. "            
  7068.  p%<=L% 
  7069.  q%=p%+1
  7070.           
  7071.  p%>L%
  7072. %          s$=
  7073. F$,q%-2):F$=
  7074. F$,q%)
  7075. #          
  7076.  first% 
  7077.  s$=H$+s$
  7078. ;          
  7079. heap_store(lineanchor%,LenLine%,0,pos%,0,s$)
  7080. :          
  7081. list_line(REC%,lineanchor%,hdlen%+
  7082. (s$),32)
  7083. !          pos%=base%:first%=
  7084.         
  7085.         pos%=base%:
  7086. <        
  7087. heap_store(lineanchor%,LenLine%,0,pos%,0,H$+F$)
  7088. 8        
  7089. list_line(REC%,lineanchor%,hdlen%+
  7090. (F$),32)
  7091.       
  7092.         
  7093. #    
  7094. extra_lines(linefeed%-1,0)
  7095.  "label":
  7096.  newline% 
  7097. n      
  7098.  (F$<>"" 
  7099. selected(labelW%,16)=
  7100.  thisrow%<=labrepl% 
  7101.  thisrow%+=1:Label$(thisrow%,thislab%)=F$
  7102.       
  7103. /      Label$(thisrow%,thislab%)+=spacer$+F$
  7104.         
  7105.  format$ 
  7106.  "horiz":
  7107. list_line(REC%,lineanchor%,pos%-base%,32)
  7108. extra_lines(linefeed%-1,0)
  7109.  "vert":
  7110. rule_off(45)
  7111.  "table":
  7112.   colpos%=pos%-base%
  7113. heap_store(lineanchor%,LenLine%,0,pos%,0,column$)
  7114. list_line(REC%,lineanchor%,pos%-base%,32)
  7115. extra_lines(linefeed%-1,colpos%)
  7116.  "label":
  7117. ,  Label$(labrepl%+1,thislab%)=
  7118. key2(0,1)
  7119. 3  thislab%+=1:
  7120.  thislab%>labup% 
  7121. print_labels
  7122.  format$<>"label" 
  7123.  (printed% 
  7124.  LinesPerPage%)=0 
  7125. selected(printW%,10)=
  7126.  displayed%=-1 
  7127. N    $(!lineanchor%)=margin$+
  7128. (12):
  7129. list_line(-1,lineanchor%,Lmargin%+1,32)
  7130. >    
  7131. list_head(1)::
  7132. lit(menu%(18),1,
  7133. selected(printW%,10))
  7134. extra_lines(ex%,tab%)
  7135.  base%,pos%
  7136.  ex%>0
  7137.  tab% 
  7138. rule_off(32)
  7139. %    base%=!lineanchor%:pos%=base%
  7140.  I%=0 
  7141.  tab%-1
  7142.       pos%?I%=32
  7143.     pos%+=tab%
  7144. :    
  7145. heap_store(lineanchor%,LenLine%,0,pos%,0,column$)
  7146. 2    
  7147. list_line(REC%,lineanchor%,pos%-base%,32)
  7148.   ex%-=1
  7149. print_memo(R%,F%,margin$,F$)
  7150.  text%,B%,F$,sp%,L%,rem$,base%,pos%,Line$,first%
  7151. blob_path(
  7152. ,$database%,R%,F%,36,F$)>=0 
  7153. !  base%=!lineanchor%:first%=
  7154.   text%=
  7155. #text%
  7156. &    Line$=margin$+rem$:L%=
  7157. (Line$)
  7158.         
  7159.       B%=
  7160. #text%
  7161.       Line$+=
  7162. (B%):L%+=1
  7163.       
  7164.  B%=32 
  7165.  sp%=L%
  7166. )    
  7167.  B%=10 
  7168.  L%=LenLine%-3 
  7169. #text%
  7170. '      
  7171.  B%=10:rem$="":Line$=
  7172. Line$)
  7173.       
  7174. #text%:rem$=""
  7175. 2      
  7176. :rem$=
  7177. Line$,sp%+1):Line$=
  7178. Line$,sp%-1)
  7179.         
  7180.     pos%=base%
  7181. 8    
  7182. heap_store(lineanchor%,LenLine%,0,pos%,0,Line$)
  7183. 0    
  7184. list_line(REC%,lineanchor%,
  7185. (Line$),32)
  7186. 4    
  7187.  first% 
  7188.  margin$=
  7189. (margin$)," "):first%=
  7190. close_file(text%)
  7191. inmemo(F%,s$)
  7192.  len%,found%,line$,base%,ptr%,case%
  7193. *len%=
  7194. load_blob($database%,REC%,F%,36)
  7195.  len%>0 
  7196. !  case%=
  7197. selected(matchW%,16)
  7198.    base%=!tempanchor%:ptr%=-1
  7199.     line$=""
  7200.         
  7201. &      ptr%+=1:line$+=
  7202. (base%?ptr%)
  7203. "    
  7204. (line$)>250 
  7205.  ptr%=len%
  7206. #    
  7207.  case% 
  7208.  line$=
  7209. u(line$)
  7210. !    
  7211. line$,s$)>0 
  7212.  found%=
  7213.  ptr%=len%
  7214. =found%
  7215. print_labels
  7216.  I%,Line$,S$,linesprinted%,pos%
  7217.  I%=0 
  7218.  labrepl%-1
  7219.   Line$=margin$
  7220.  K%=0 
  7221.  thislab%-1
  7222.     S$=Label$(I%,K%)
  7223. !    
  7224. selected(labelW%,11) 
  7225. 9      
  7226.  I%=labsubst% 
  7227.  S$="" 
  7228.  S$=Label$(labrepl%,K%)
  7229.         
  7230. 9    
  7231.  K%=thislab%-1 
  7232.  W%=longestfield% 
  7233.  W%=labwidth%
  7234. (S$)>W% 
  7235. S$,W%)
  7236.      Line$+=S$+
  7237. (S$)," ")
  7238.   pos%=!lineanchor%
  7239. heap_store(lineanchor%,LenLine%,0,pos%,0,Line$)
  7240. list_line(REC%,lineanchor%,
  7241. (Line$),32)
  7242.   linesprinted%+=1
  7243. selected(labelW%,13) 
  7244. rule_off(32)
  7245.   Line$=margin$
  7246.  K%=0 
  7247.  thislab%-1
  7248. (    S$="("+Label$(labrepl%+1,K%)+")"
  7249. 1    
  7250.  K%=thislab%-1 
  7251. (S$) 
  7252.  W%=labwidth%
  7253.      Line$+=S$+
  7254. (S$)," ")
  7255.   pos%=!lineanchor%
  7256. heap_store(lineanchor%,LenLine%,0,pos%,0,Line$)
  7257. list_line(REC%,lineanchor%,
  7258. (Line$),32)
  7259.   linesprinted%+=1
  7260. rows_printed%+=1
  7261.  rows_printed%=labrows% 
  7262. L  $(!lineanchor%)=margin$+
  7263. (12):
  7264. list_line(-1,lineanchor%,Lmargin%+1,32)
  7265. list_head(1)
  7266.   rows_printed%=0
  7267.  linesprinted%<labdepth%
  7268. rule_off(32)
  7269.     linesprinted%+=1
  7270. &thislab%=0:thisrow%=-1:Label$()=""
  7271. read_print_options
  7272. thislab%=0:LinesPerPage%=0
  7273.  usekey%=-1 
  7274.  S$=Index$(key%) 
  7275.  S$=Index$(usekey%)+" index"
  7276. Title1$="Ordered by "+S$
  7277. selected(printW%,19) 
  7278.  Title1$+=" ("+
  7279. $+")"
  7280. Title2$=$
  7281. text(printW%,18)
  7282. selected_esg(printW%,2) 
  7283.  4:cpi%=5:p$="3"
  7284.  7:cpi%=10:p$="0"
  7285.  8:cpi%=12:p$="1"
  7286.  6:cpi%=17:p$="2"
  7287. pitch$=
  7288. pitch(p$)
  7289. 03Lmargin%=
  7290. text(printW%,30)):Tab%(0)=Lmargin%
  7291. margin$=
  7292. Lmargin%," ")
  7293. 2"Tmargin%=
  7294. text(printW%,32))
  7295. 3#TextLine%=
  7296. text(printW%,34))
  7297. 4#linefeed%=
  7298. text(printW%,17))
  7299. 5#colwidth%=
  7300. text(printW%,45))
  7301. 6*s$=$
  7302. text(printW%,43):s%=
  7303. (s$):c$=
  7304.  s%=0:spacer$=s$
  7305.  c$<"0" 
  7306.  c$>"9":spacer$=
  7307. s%,c$)
  7308. :spacer$=
  7309. s%," ")
  7310.  linefeed%=0 
  7311.  linefeed%=1:$
  7312. text(printW%,17)=
  7313. (linefeed%)
  7314. =%pagelength%=
  7315. text(printW%,16))
  7316.  pagelength%=0 
  7317.  pagelength%=70:$
  7318. text(printW%,16)=
  7319. (pagelength%)
  7320. selected_esg(printW%,3) 
  7321.   format$="horiz"
  7322. B9  LinesPerPage%=(pagelength%-Tmargin%-15) 
  7323.  linefeed%
  7324.  24:format$="vert"
  7325. DJ  LinesPerPage%=(pagelength%-Tmargin%-15) 
  7326.  (linefeed%*(
  7327. (Form$) 
  7328.   format$="table"
  7329. G$  columns%=
  7330. text(printW%,15))
  7331. H0  column$=
  7332. columns%,"|"+
  7333. colwidth%," "))+"|"
  7334. I9  LinesPerPage%=(pagelength%-Tmargin%-15) 
  7335.  linefeed%
  7336.   format$="label"
  7337. L)  labwidth%=
  7338. text(labelW%,4))*cpi%
  7339. M&  labdepth%=
  7340. text(labelW%,6))*6
  7341. N1  labrows%=(pagelength%-Tmargin%) 
  7342.  labdepth%
  7343.   rows_printed%=0
  7344. PA  labup%=
  7345. selected_esg(labelW%,1):
  7346.  ### Value is 0,1 or 2 ###
  7347. Q$  labrepl%=
  7348. text(labelW%,10))
  7349. R'  labsubst%=
  7350. text(labelW%,12))-1
  7351. S&  labcopies%=
  7352. text(labelW%,17))
  7353. T%  Title$="":Title1$="":Title2$=""
  7354. selected_esg(printW%,4) 
  7355.  38:reportdest$="Window"
  7356.  39:reportdest$="File"
  7357.  41:reportdest$="Printer"
  7358.  LinesPerPage%=0 
  7359.  LinesPerPage%=1
  7360. pitch(p$)
  7361. selected(printW%,42) 
  7362. (31)+"9"+p$+"01" 
  7363. list_head(place%)
  7364.  place%=0 
  7365.  reportdest$ 
  7366.  "Window","Printer":
  7367.     RU%=
  7368. ($used%)
  7369. fO    
  7370.  RU%<5 
  7371.  textblocksize%=5*LenLine% 
  7372.  textblocksize%=(RU% 
  7373.  5)*LenLine%
  7374. g$    textblockinc%=textblocksize%
  7375. h?    
  7376. extend_named_sliding_block(textanchor%,textblocksize%)
  7377.     TextPtr%=!textanchor%
  7378.     recblocksize%=400
  7379. k=    
  7380. extend_named_sliding_block(recanchor%,recblocksize%)
  7381. l%    
  7382.  "File":
  7383. #texthandle%,pitch$
  7384. extra_lines(Tmargin%,0)
  7385.  displayed%=-1 
  7386. send_title(Title$)
  7387. send_title(Title1$)
  7388. send_title(Title2$)
  7389.  format$ 
  7390.  "horiz":
  7391. selected(printW%,29) 
  7392. yV    
  7393. selected(printW%,42) 
  7394.  $(!lineanchor%)=uon$:
  7395. list_line(-1,lineanchor%,2,32)
  7396. z.    
  7397. list_line(-1,headanchor%,LenLine%,32)
  7398. rule_off(45)
  7399. }.    
  7400. list_line(-1,headanchor%,LenLine%,32)
  7401. rule_off(45)
  7402.  "table":
  7403. rule_off(32):$(TextPtr%-3)=uon$
  7404. rule_off(32)
  7405. list_line(-1,headanchor%,LenLine%,32)
  7406. rule_off(32)
  7407.  "vert":
  7408. rule_off(45)
  7409. header_lines%=Count%
  7410. list_line(REC%,anchor%,length%,char%)
  7411. Count%+=1
  7412.  reportdest$ 
  7413.  "Window","Printer":
  7414. pad_line(LenLine%-length%-1,char%)
  7415. heap_store(textanchor%,textblocksize%,textblockinc%,TextPtr%,LenLine%,"")
  7416.  "Wimp_TransferBlock",mytask%,!anchor%,mytask%,TextPtr%,LenLine%
  7417.  Count%*4>=recblocksize% 
  7418.     recblocksize%+=400
  7419. =    
  7420. extend_named_sliding_block(recanchor%,recblocksize%)
  7421. "  !(!recanchor%+Count%*4)=REC%
  7422.   TextPtr%+=LenLine%
  7423.  "File":
  7424. pad_line(LenLine%-length%-1,char%)
  7425.  "OS_GBPB",2,texthandle%,!anchor%,LenLine%
  7426. pad_line(bytes%,char%)
  7427.  base%,ptr%,I%
  7428. /base%=!anchor%:ptr%=base%+LenLine%-bytes%-1
  7429.  bytes%>0 
  7430.  I%=0 
  7431.  bytes%-2
  7432.     ptr%?I%=char%
  7433. ptr%?(bytes%-1)=32
  7434. ptr%?bytes%=10
  7435. rule_off(char%)
  7436.  base%
  7437. base%=!lineanchor%
  7438. $base%=margin$
  7439. list_line(-1,lineanchor%,Lmargin%,char%)
  7440. total_list
  7441.  C%,L%,base%,pos%,L$
  7442. #L$=margin$+"Total "+
  7443. (printed%)
  7444. !base%=!lineanchor%:pos%=base%
  7445.  format$ 
  7446.  "horiz":
  7447. selected(printW%,29) 
  7448. rule_off(45)
  7449. ctotals(numfirst%)
  7450. (L$)>LenLine%-2 
  7451.  L$=margin$+
  7452. (printed%)
  7453. heap_store(lineanchor%,LenLine%,0,pos%,0,L$)
  7454. list_line(REC%,lineanchor%,pos%-base%,32)
  7455. selected(printW%,29) 
  7456. rule_off(45)
  7457.  "table":
  7458. rule_off(32)
  7459. extra_lines(linefeed%,colpos%)
  7460. ctotals(numfirst%)
  7461. (L$)>LenLine%-2 
  7462.  L$=margin$+
  7463. (printed%)
  7464. heap_store(lineanchor%,LenLine%,0,pos%,0,L$)
  7465. list_line(REC%,lineanchor%,pos%-base%,32)
  7466. selected(printW%,29) 
  7467. rule_off(45)
  7468.  "vert":
  7469. (L$)>LenLine%-2 
  7470.  L$=margin$+
  7471. (printed%)
  7472. heap_store(lineanchor%,LenLine%,0,pos%,0,L$)
  7473. list_line(REC%,lineanchor%,pos%-base%,32)
  7474. selected(printW%,29) 
  7475. rule_off(45)
  7476. lit(menu%(6),7,
  7477. send_title(T$)
  7478.  C$,L$,P%,L%
  7479.  T$="" 
  7480. L%=LenLine%-Lmargin%-1
  7481. (T$)>=L%
  7482.   P%=
  7483.     P%-=1:C$=
  7484. T$,P%,1)
  7485. "= ,.;:",C$)>0 
  7486.  P%<L%) 
  7487.  P%=0
  7488.  P%=0 
  7489. '    L$=margin$+
  7490. T$,L%-1):T$=
  7491. T$,L%)
  7492. )    
  7493.  L$=margin$+
  7494. T$,P%):T$=
  7495. T$,P%+1)
  7496.   $(!lineanchor%)=L$
  7497. list_line(-1,lineanchor%,
  7498. (L$),32)
  7499. $(!lineanchor%)=margin$+T$
  7500. list_line(-1,lineanchor%,Lmargin%+
  7501. (T$),32)
  7502. screen_list
  7503. !!block%=0:block%!4=-Count%*32
  7504. (block%!8=(LenLine%-1)*16:block%!12=0
  7505.  "Wimp_SetExtent",listW%,block%
  7506. !block%=listW%
  7507.  "Wimp_GetWindowState",,block%
  7508. ;x%=(block%!12+block%!4) 
  7509.  2:y%=(block%!16+block%!8) 
  7510. "block%!12=block%!4+LenLine%*16
  7511.  Count%<28 
  7512. "  block%!16=block%!8+Count%*32
  7513.   block%!16=block%!8+32*28
  7514.  "Wimp_CloseWindow",,block%
  7515. open_window(listW%)
  7516. Listed%=
  7517. show_menu(menu%(18),x%,y%)
  7518. sort_list
  7519.  I%,N%,E%
  7520. (Form$) 
  7521. !block%=listW%
  7522.  "Wimp_GetWindowState",,block%
  7523. -column%=(mousex%-block%!4+block%!20) 
  7524.   N%+=1
  7525.  Tab%(N%)>column%+1 
  7526.  N%=E%
  7527.     N%-=1
  7528. >ind%=!textanchor%+LenLine%*header_lines%+Tab%(N%)-LenLine%
  7529.  I%=0 
  7530.  printed%-1
  7531.   ind%+=LenLine%
  7532.   block%!(I%*4)=ind%
  7533.  "OS_HeapSort",printed%,block%,4
  7534. extend_named_sliding_block(tempanchor%,printed%*LenLine%)
  7535. 3dest%=!tempanchor%-LenLine%:recptr%=!recanchor%
  7536.  I%=0 
  7537.  printed%-1
  7538.   recptr%!(I%*4)=-1
  7539.     (  ind%=block%!(I%*4):dest%+=LenLine%
  7540.  "Wimp_TransferBlock",mytask%,ind%-Tab%(N%),mytask%,dest%,LenLine%
  7541.  "Wimp_TransferBlock",mytask%,!tempanchor%,mytask%,!textanchor%+LenLine%*header_lines%,printed%*LenLine%
  7542. scrap_sliding_block(tempanchor%)
  7543. redraw(listW%)
  7544. lose_list
  7545. close_window(listW%)
  7546. scrap_sliding_block(textanchor%)
  7547. scrap_sliding_block(recanchor%)
  7548. Listed%=
  7549. parse(S$,case%)
  7550.  val%,I%,P%,F%,f%,t%,flag%,left%,right%,search$,field$,op$,bo$,target$,targ$,f$,t$,E$,E1$,TitFd$,TitTg$,simple%,date$,SF$
  7551. usekey%=-1:useval$=""
  7552.  S$="" 
  7553. u(S$)="ALL" 
  7554.  Title$=
  7555. leaf($database%),2)+". All records":="TRUE"
  7556. simple%=
  7557. simple(S$)
  7558. S$+=" ":Title$=""
  7559. (S$)>0
  7560.   W$=
  7561. word(S$," ")
  7562.  W$="NOT" 
  7563. S$,1)<>"(" 
  7564.  moan_err%,
  7565. msg(60)
  7566. strip_brackets
  7567. (W$)>0 
  7568. #*    flag%=
  7569. :TitFd$="":TitTg$="":op$=""
  7570. %5      
  7571.  "AND","OR","NOT":E$=W$:Title$+=" "+E$+" "
  7572. &+      
  7573.  "&":E$="AND":Title$+=" "+E$+" "
  7574.       
  7575.       E$=""
  7576.       
  7577. split
  7578.       
  7579. (field$)>0
  7580. +$        f$=
  7581. word(field$,","))
  7582.         f%=
  7583. field(f$,
  7584.         f$="F$("+
  7585. (f%)+")"
  7586. .(        
  7587.  case% 
  7588.  f$="FNu("+f$+")"
  7589. /%        
  7590.  val% 
  7591.  f$="VAL("+f$+")"
  7592.         
  7593.  chartype%(f%) 
  7594. 13          
  7595.  5,51,52:f$="FNreverse_date("+f$+")"
  7596.         
  7597.         targ$=target$
  7598.         
  7599. (targ$)>0
  7600. 5'          t$=
  7601. word(targ$,","):u$=t$
  7602. 6B          
  7603.  flag% 
  7604.  TitTg$+=
  7605. expand(t$,link$(f%),L%,SF$)+","
  7606. 7           
  7607.  chartype%(f%) 
  7608. 80            
  7609.  41,42,43,44,45:t$=
  7610. pos_neg(t$)
  7611.             
  7612.  5,51,52:
  7613. :K            
  7614. check_date(t$,2,date$)=
  7615. reverse_date(date$):u$=t$
  7616.           
  7617.           t$=""""+t$+""""
  7618. ='          
  7619.  val% 
  7620.  t$="VAL("+t$+")"
  7621.           
  7622.  f%=0 
  7623.             
  7624.  op$ 
  7625. @;              
  7626.  "{","=":E1$="FNany("+t$+","""+op$+""")"
  7627. A.              
  7628.  "}{":
  7629.  moan_err%,
  7630. msg(100)
  7631. B.              
  7632.  "<>":
  7633.  moan_err%,
  7634. msg(101)
  7635. C7              
  7636.  moan_err%,""""+op$+""""+
  7637. msg(102)
  7638.             
  7639.             
  7640.             
  7641.  op$ 
  7642.               
  7643.  "{":
  7644. H$              
  7645.  chartype%(f%) 
  7646. IC                
  7647.  36,39:E1$=" FNinmemo("+
  7648. (f%)+","+t$+")=TRUE "
  7649. J2                
  7650. :E1$="INSTR("+f$+","+t$+")>0"
  7651.               
  7652.               
  7653.  "}{":
  7654. M$              
  7655.  chartype%(f%) 
  7656. ND                
  7657.  36,39:E1$=" FNinmemo("+
  7658. (f%)+","+t$+")=FALSE "
  7659. O2                
  7660. :E1$="INSTR("+f$+","+t$+")=0"
  7661.               
  7662.               
  7663.  "=":
  7664.               E1$=f$+op$+t$
  7665. S,              
  7666.  simple%=
  7667.  usekey%=-1 
  7668. T+                foundkey%=
  7669. is_a_key(f%)
  7670. U@                
  7671.  foundkey%>=0 
  7672.  KL%(foundkey%)=len%(f%) 
  7673. V2                  usekey%=foundkey%:useval$=u$
  7674.                 
  7675.               
  7676. Y!              
  7677. :E1$=f$+op$+t$
  7678.             
  7679.           
  7680. \@          
  7681. (E$)+
  7682. (E1$)>255 
  7683.  moan_err%,
  7684. msg(6) 
  7685.  E$+=E1$
  7686. ]@          
  7687. (E$)+
  7688. (bo$)>255 
  7689.  moan_err%,
  7690. msg(6) 
  7691.  E$+=bo$
  7692.         
  7693.         flag%=
  7694.       
  7695.       E$=
  7696. (E$)-
  7697. (bo$))
  7698.       
  7699. E$,bo$)>0 
  7700. c=        
  7701. (E$)>253 
  7702.  moan_err%,
  7703. msg(6) 
  7704.  E$="("+E$+")"
  7705.       
  7706. e        
  7707. add_brackets
  7708.   E$+=" "
  7709. (search$)+
  7710. (E$)>255 
  7711.  moan_err%,
  7712. msg(6)
  7713.  search$+=E$
  7714. build_title
  7715. o,Title$=
  7716. leaf($database%),2)+". "+Title$
  7717.  usekey%>=0 
  7718. q*  kl%=KL%(usekey%):val$=
  7719. type(usekey%)
  7720. deselect(matchW%,23):
  7721. deselect(savesubW%,6)
  7722. =search$
  7723. pos_neg(s$)
  7724.  "+","y","Y","*","
  7725. ","T","t":s$=" "
  7726.  "-","n","N","x","X","F","f":s$=""
  7727. simple(S$)
  7728. S$,"=")>0 
  7729. S$,",")=0 
  7730. S$,"-")=0 
  7731. S$,"OR")=0 
  7732. S$,"NOT")=0) 
  7733. word(
  7734.  S$,sep$)
  7735.  P%,W$,Q1%,Q2%
  7736. '  Q1%=
  7737. S$,""""):Q2%=
  7738. S$,"""",Q1%+1)
  7739.   P%=
  7740. S$,sep$,P%)
  7741. -    
  7742.  (P%>Q1% 
  7743.  P%<Q2%),(P%>Q2% 
  7744.  Q2%>0):
  7745. 5    S$=
  7746. S$,Q1%-1)+
  7747. S$,Q1%+1,Q2%-Q1%-1)+
  7748. S$,Q2%+1)
  7749. 9    P%=Q2%-2:
  7750.  ### S$ is now 2 characters shorter ###
  7751. )    
  7752.  Q1%>0 
  7753.  Q2%=0:
  7754. softerror("",93)
  7755.      S$=
  7756. S$,Q1%-1)+
  7757. S$,Q1%+1)
  7758.  Q1%+Q2%=0 
  7759.  P%<Q1%
  7760. S$,P%-1)
  7761. S$,P%+1)
  7762. any(targ$,op$)
  7763.  F%,found%,case%,F$
  7764. case%=
  7765. selected(matchW%,16)
  7766.   F%+=1:F$=F$(F%)
  7767.  case% 
  7768. u(F$)
  7769.  op$ 
  7770.  "{":
  7771.  chartype%(F%) 
  7772.       
  7773.  36,39:
  7774. (      
  7775. inmemo(F%,targ$) 
  7776.  found%=
  7777. %      
  7778. F$,targ$)>0 
  7779.  found%=
  7780.         
  7781. #    
  7782.  "=":
  7783.  F$=targ$ 
  7784.  found%=
  7785.  found% 
  7786.  F%=fields%
  7787. =found%
  7788. split
  7789.  X$,Q%,I%
  7790. 8X$=">=>=,<=<=,<>,}{,>=,<=,==,>>,<<,{{,=,<,>,{,":P%=0
  7791. (X$)>0 
  7792.  P%=0
  7793. ,  Q%=
  7794. X$,","):op$=
  7795. X$,Q%-1):X$=
  7796. X$,Q%+1)
  7797.   P%=
  7798. W$,op$)
  7799.  P%>0 
  7800.   field$=
  7801. W$,P%-1)
  7802.    target$=
  7803. W$,P%+
  7804. (op$))+","
  7805.  case% 
  7806.  target$=
  7807. u(target$)
  7808.   field$=
  7809. exp_field
  7810.  op$ 
  7811.  "<>","}{":bo$="AND"
  7812.  "<=",">=":bo$="OR"
  7813.  "<=<=",">=>=":
  7814.     op$=
  7815. op$,2):bo$="AND"
  7816.  "==","<<",">>","{{":
  7817.     op$=
  7818. op$,1):bo$="AND"
  7819. :bo$="OR"
  7820.  moan_err%,
  7821. msg(40)
  7822. exp_field
  7823.  P%,I%,F1%,F2%,F$
  7824. field$,"-")
  7825.  P%=0 
  7826.   F$=field$+","
  7827. !  F1%=
  7828. field(
  7829. field$,P%-1),
  7830. !  F2%=
  7831. field(
  7832. field$,P%+1),
  7833.  F1%>F2% 
  7834.  F1%,F2%
  7835.  I%=F1% 
  7836.     F$+=Tag$(I%)+","
  7837. fnum(S$)
  7838. ("&"+S$)
  7839. newline%=((N% 
  7840.  128)>0)
  7841. =(N% 
  7842.  127)
  7843. field(f$,Z%)
  7844.  I%,F%,desc$
  7845.  f$="@" 
  7846.  TitFd$="Any field ":=0
  7847. val%=
  7848. f$,1)="[" 
  7849. f$)="]" 
  7850. f$),2):val%=
  7851.  I%<fields%
  7852.   I%+=1
  7853. u(Tag$(I%))=
  7854. u(f$) 
  7855.  F%=I%
  7856.  F%>0 
  7857. $  desc$=$
  7858. text(mainW%,desc%(F%))
  7859.  desc$<>"" 
  7860.  TitFd$+=desc$+"," 
  7861.  TitFd$+=f$+","
  7862.  F%=0 
  7863.  moan_err%,
  7864. msg(8)+" ("+f$+")"+
  7865.  chartype%(F%) 
  7866.  3,6,46,47,54,56,57:val%=
  7867. find_fields(S$,sep$,
  7868.  length%)
  7869.  f$,F$,C$,P%,Q%,F%
  7870. Q%=1:length%=0
  7871.   P%=
  7872. S$,sep$,Q%)
  7873.  P%>0 
  7874. S$,Q%,P%-Q%)
  7875.   F%=
  7876. field(f$,
  7877.   length%+=len%(F%)+1
  7878.   F$=
  7879. ~(F%)
  7880. (F$)=1 
  7881.  F$="0"+F$
  7882.   C$+=F$
  7883.   Q%=P%+1
  7884. length%+=
  7885. (RA%))+1
  7886. strip_brackets
  7887. W$,1)="("
  7888.   left%+=1:W$=
  7889. W$,2)
  7890. W$)=")"
  7891.   right%+=1:W$=
  7892. add_brackets
  7893.  left%>0
  7894.   E$="("+E$:left%-=1
  7895.  right%>0
  7896.   E$+=")":right%-=1
  7897. build_title
  7898.  change%
  7899. #TitFd$=
  7900. TitFd$):TitTg$=
  7901. TitTg$)
  7902. TitFd$,",")>0 
  7903.  bo$ 
  7904. &    
  7905.  "OR":TitFd$="One of:"+TitFd$
  7906.  "AND":
  7907.  op$ 
  7908. ;      
  7909.  "<>":TitFd$="None of:"+TitFd$:op$="=":change%=
  7910. ;      
  7911.  "}{":TitFd$="None of:"+TitFd$:op$="{":change%=
  7912. #      
  7913. :TitFd$="All of:"+TitFd$
  7914.         
  7915. TitTg$,",")>0 
  7916.  bo$ 
  7917. &    
  7918.  "OR":TitTg$="One of:"+TitTg$
  7919.  "AND":
  7920.  op$ 
  7921. 1      
  7922.  "<>":TitTg$="None of:"+TitTg$:op$="="
  7923. 1      
  7924.  "}{":TitTg$="None of:"+TitTg$:op$="{"
  7925. I      
  7926.  change% 
  7927.  TitTg$="Any of:"+TitTg$ 
  7928.  TitTg$="All of:"+TitTg$
  7929.         
  7930.  op$ 
  7931.  "{":op$=" contains "
  7932.  "}{":op$=" does not contain "
  7933. Title$+=TitFd$+op$+TitTg$
  7934. expand(string$,table$,
  7935.  ExpLen%,
  7936.  subst$)
  7937.  p$,s$,start%,F%,I%,T%,ind%,row%,Rec%,Rows%,TabFields%,field%,sfield%,pos%,spos%
  7938. subst$=string$
  7939.  table$="" 
  7940.  ExpLen%=0:=string$:
  7941.  ### Not linked ###
  7942. *&field%=
  7943. table$)):table$=
  7944. table$)
  7945. (table$)<58 
  7946. (table$)<>-1 
  7947.  sfield%=
  7948. (table$):table$=
  7949. table$,2) 
  7950.  sfield%=-1
  7951. table_number(table$)
  7952.  T%<0 
  7953.  ExpLen%=0:=string$:
  7954.  ### Table not found ###
  7955. p$=printrel$(T%)
  7956. /;T$=
  7957. table_info(T%,Rows%,TabFields%,Rec%,tabfieldlen%())
  7958. 0,pos%=
  7959. table_field(field%,tabfieldlen%())
  7960.  sfield%>=0 
  7961.  spos%=
  7962. table_field(sfield%,tabfieldlen%())
  7963.  p$<>"" 
  7964.   ExpLen%=0
  7965.  I%=1 
  7966.     F%=
  7967. p$,I%,1))
  7968. 6#    ExpLen%+=tabfieldlen%(F%)+2
  7969.   ExpLen%-=2
  7970.  ExpLen%=tabfieldlen%(1)
  7971. ;4start%=!tabanchor%(T%)+160-Rec%:ind%=start%+pos%
  7972.   row%+=1:ind%+=Rec%
  7973.  row%>Rows% 
  7974.  $ind%=string$
  7975.  row%>Rows% 
  7976.  subst$="":=string$:
  7977.  ## String not in table ###
  7978. @=ind%=start%+row%*Rec%:
  7979.  sfield%>=0 
  7980.  subst$=$(ind%+spos%)
  7981.  p$<>"" 
  7982.  I%=1 
  7983.     F%=
  7984. p$,I%,1))
  7985. D,    pos%=
  7986. table_field(F%,tabfieldlen%())
  7987. E4    s$+=
  7988. pad($(ind%+pos%),tabfieldlen%(F%))+"  "
  7989.   s$=
  7990.  ind%+=tabfieldlen%(0)+1:s$=$ind%:
  7991.  ### Return 2nd field ###
  7992. n(F%)
  7993.  T%,row%,ind%,start%,Rows%,Rec%,TabFields%,pos%,valpos%,N%,field%,name$,table$,S$
  7994.  link$(F%)="" 
  7995. S$=$Rf%(F%)
  7996. name$=link$(F%)
  7997. Q$field%=
  7998. name$)):table$=
  7999. name$)
  8000. (table$)<58 
  8001. (table$)<>-1 
  8002.  table$=
  8003. table$,2)
  8004. S/table%=
  8005. table_number(table$):
  8006.  table%<0 
  8007. T?T$=
  8008. table_info(table%,Rows%,TabFields%,Rec%,tabfieldlen%())
  8009.  TabFields%=field% 
  8010. softerror("",54):=0
  8011. V,pos%=
  8012. table_field(field%,tabfieldlen%())
  8013. W1valpos%=
  8014. table_field(field%+1,tabfieldlen%())
  8015. X'start%=!tabanchor%(table%)+160-Rec%
  8016.  row%+=1
  8017. Z   ind%=start%+row%*Rec%+pos%
  8018.  row%>Rows% 
  8019.  S$=$ind%
  8020.  row%<=Rows% 
  8021. ]#  ind%=start%+row%*Rec%+valpos%
  8022.   N%=
  8023. ($ind%)
  8024.  N%=0
  8025. pad(s$,L%)
  8026. (s$)<L%
  8027.   s$+=" "
  8028. include_fields
  8029.  Hdlen%,Datlen%,hlm%,dlm%,I%,F%,f$,Head$,limit%,pad%,col%,fail%,n$,y$,SF$,memo%,base%,pos%,blocksize%,blockinc%
  8030. k'blocksize%=256:blockinc%=blocksize%
  8031. extend_named_sliding_block(headanchor%,blocksize%)
  8032. m!base%=!headanchor%:pos%=base%
  8033. heap_store(headanchor%,blocksize%,blockinc%,pos%,0,margin$)
  8034. selected(matchW%,29) 
  8035.  Form$="00"+Form$
  8036.  I%=1 
  8037. (Form$)-1 
  8038.   F%=
  8039. fnum(
  8040. Form$,I%,2))
  8041.  chartype%(F%) 
  8042. s0    
  8043.  36,39:dlm%=TextLine%:memo%=
  8044. set_vert
  8045.  41,42,43,44,45:
  8046. u!    Datlen%=
  8047. no_yes(F%,n$,y$)
  8048. vE    
  8049.  ### Get data length for strings printed for check boxes ###
  8050. selected(printW%,11) 
  8051. y/    f$=
  8052. expand("@#*",link$(F%),Datlen%,SF$)
  8053. z)    
  8054.  Datlen%=0 
  8055.  Datlen%=maxlen%(F%)
  8056. {        
  8057.     Datlen%=maxlen%(F%)
  8058. selected(printW%,2) 
  8059.  Head$=$
  8060. text(mainW%,(desc%(F%))) 
  8061.  Head$=Tag$(F%)
  8062.  F%=0 
  8063.  Head$="RECORD":Datlen%=6
  8064.  Datlen%>dlm% 
  8065.  dlm%=Datlen%
  8066.   Hdlen%=
  8067. (Head$)
  8068.  Hdlen%>hlm% 
  8069.  hlm%=Hdlen%
  8070.  format$ 
  8071.  "horiz","table":
  8072. -    pad%=Datlen%-Hdlen%:
  8073.  pad%<0 
  8074.  pad%=0
  8075.  chartype%(F%) 
  8076. c      
  8077.  3,6,46,47,54,56,57:
  8078. selected(printW%,11) 
  8079.  Head$+=
  8080. pad%," ") 
  8081.  Head$=
  8082. pad%," ")+Head$
  8083. A      
  8084.  ### Right justify numbers unless Expand option on ###
  8085.       
  8086. :Head$+=
  8087. pad%," ")
  8088.         
  8089. J    
  8090. heap_store(headanchor%,blocksize%,blockinc%,pos%,0,Head$+spacer$)
  8091. #    Tab%((I%+1) 
  8092.  2)=pos%-base%
  8093.  format$ 
  8094.  "horiz":L%=pos%-base%+2
  8095.  "vert":L%=TextLine%+5:Tab%(1)=hlm%
  8096.  "table":
  8097.   col%=
  8098. (column$)
  8099. heap_store(headanchor%,blocksize%,blockinc%,pos%,0,column$+" ")
  8100.   ?pos%=10:L%=pos%-base%+1
  8101.  "label":
  8102.   longestfield%=dlm%
  8103. )  L%=labup%*labwidth%+dlm%+Lmargin%+1
  8104. extend_named_sliding_block(lineanchor%,L%+8)
  8105. no_yes(F%,
  8106.  no$,
  8107.  yes$)
  8108.  P%,V$,L%
  8109. val(mainW%,field%(F%))
  8110. V$,"Q")
  8111.  P%>0 
  8112.   V$=
  8113. V$,P%+1)
  8114.   P%=
  8115. V$,",")
  8116.   no$=
  8117. V$,P%-1)
  8118.   yes$=
  8119. V$,P%+1)
  8120.  no$="N":yes$="Y"
  8121. (no$)
  8122. (yes$)>L% 
  8123. (yes$)
  8124. heap_store(anchor%,
  8125.  size%,inc%,
  8126.  ptr%,L%,string$)
  8127.  string$<>"" 
  8128. (string$)
  8129.  ptr%-!anchor%+L%+1>size% 
  8130.   size%+=inc%
  8131. extend_named_sliding_block(anchor%,size%)
  8132.  string$<>"" 
  8133.  $ptr%=string$:ptr%+=L%:?ptr%=10
  8134. set_vert
  8135. deselect(printW%,23)
  8136. deselect(printW%,25)
  8137. deselect(printW%,26)
  8138. select(printW%,24)
  8139. format$="vert"
  8140. ?LinesPerPage%=(pagelength%-10) 
  8141.  (linefeed%*(
  8142. (Form$) 
  8143.  LinesPerPage%=0 
  8144.  LinesPerPage%=1
  8145. load_selection(f$)
  8146.  F%,I%,T%,F
  8147. printorder$=
  8148.     T%=-1
  8149.   T%+=1
  8150.   printrel$(T%)=
  8151. close_file(F)
  8152.  F%=1 
  8153.  fields%
  8154.  chartype%(F%)>40 
  8155. .    col%=
  8156. get_icon_cols(mainW%,field%(F%))
  8157. E    
  8158.  (col% 
  8159.  %1111)<2 
  8160.  col%=((col%>>4) 
  8161.  (col%<<4)) 
  8162.  %11111111
  8163. .    
  8164. set_icon_cols(mainW%,field%(F%),col%)
  8165. &    
  8166. deselect(mainW%,field%(F%))
  8167.  I%=1 
  8168. (printorder$)-1 
  8169. "  F%=
  8170. fnum(
  8171. printorder$,I%,2))
  8172.  chartype%(F%)>40 
  8173. .    col%=
  8174. get_icon_cols(mainW%,field%(F%))
  8175. 0    col%=((col%>>4) 
  8176.  (col%<<4)) 
  8177.  %11111111
  8178. .    
  8179. set_icon_cols(mainW%,field%(F%),col%)
  8180. $    
  8181. select(mainW%,field%(F%))
  8182. lit(menu%(6),7,
  8183. lit(menu%(6),8,
  8184. select_all
  8185.  F%,T%,F$
  8186. printorder$=""
  8187.  F%=1 
  8188.  fields%
  8189.  chartype%(F%) 
  8190.  41,42,43,44,45:
  8191. .    col%=
  8192. get_icon_cols(mainW%,field%(F%))
  8193. F    
  8194.  (col% 
  8195.  %1111)>=2 
  8196.  col%=((col%>>4) 
  8197.  (col%<<4)) 
  8198.  %11111111
  8199. .    
  8200. set_icon_cols(mainW%,field%(F%),col%)
  8201. '    F$=
  8202. ~(F%):
  8203. (F$)=1 
  8204.  F$="0"+F$
  8205.     printorder$+=F$
  8206.  0,1,2,4,5,7,8:
  8207.  len%(F%)>0 
  8208. )      F$=
  8209. ~(F%):
  8210. (F$)=1 
  8211.  F$="0"+F$
  8212.       printorder$+=F$
  8213. $      
  8214. select(mainW%,field%(F%))
  8215.         
  8216. (    
  8217.  36,39,48,49,50,51,52,53,55,58:
  8218. '    F$=
  8219. ~(F%):
  8220. (F$)=1 
  8221.  F$="0"+F$
  8222.     printorder$+=F$
  8223. "    
  8224. select(mainW%,field%(F%))
  8225.  3,6,46,47,54,56,57:
  8226. '    F$=
  8227. ~(F%):
  8228. (F$)=1 
  8229.  F$="0"+F$
  8230.     printorder$+=F$
  8231. "    
  8232. select(mainW%,field%(F%))
  8233. "    
  8234. enable_row(calcrow%?F%,
  8235. lit(menu%(6),7,
  8236. lit(menu%(6),8,
  8237. clear_selection
  8238.  F%,T%
  8239.  F%=1 
  8240.  fields%
  8241.  chartype%(F%) 
  8242.  41,42,43,44,45:
  8243. .    col%=
  8244. get_icon_cols(mainW%,field%(F%))
  8245. E    
  8246.  (col% 
  8247.  %1111)<2 
  8248.  col%=((col%>>4) 
  8249.  (col%<<4)) 
  8250.  %11111111
  8251. .    
  8252. set_icon_cols(mainW%,field%(F%),col%)
  8253. V    
  8254.  3,6,8,46,47,54,56,57:
  8255. enable_row(calcrow%?F%,
  8256. deselect(mainW%,field%(F%))
  8257. &    
  8258. deselect(mainW%,field%(F%))
  8259. printorder$=""
  8260.  T%=0 
  8261.  LastTable%
  8262.   printrel$(T%)=""
  8263. lit(menu%(6),7,
  8264. lit(menu%(6),8,
  8265. load_query(f$)
  8266.  F%,I%,Q$
  8267. selected(keypadW%,22) 
  8268.  "OS_File",255,f$,
  8269. text(keypadW%,29)
  8270. set_caret(keypadW%,29)
  8271. redraw_icon(keypadW%,29)
  8272.  "OS_File",255,f$,
  8273. text(matchW%,0)
  8274. open_window(matchW%)
  8275. set_caret(matchW%,0)
  8276. redraw_icon(matchW%,0)
  8277. load_options(f$)
  8278.  F,I%,set%,ic%
  8279. end_load:
  8280.  I%=1 
  8281. #F,set%:
  8282. set_icon(printW%,ic%,set%)
  8283.  I%=1 
  8284. text(printW%,ic%)
  8285. redraw_icon(printW%,ic%)
  8286.  I%=1 
  8287. #F,set%:
  8288. set_icon(printW%,ic%,set%)
  8289.  I%=1 
  8290. #F,set%:
  8291. set_icon(labelW%,ic%,set%)
  8292.  I%=1 
  8293. text(labelW%,ic%)
  8294.  I%=1 
  8295. #F,set%:
  8296. set_icon(labelW%,ic%,set%)
  8297. close_file(F)
  8298. icon_bit(22,printW%,15,
  8299. selected(printW%,25))
  8300. icon_bit(22,printW%,45,
  8301. selected(printW%,25))
  8302. icon_bit(22,labelW%,12,
  8303. selected(labelW%,11))
  8304.  1,2,4,6,7,8,23,24,25,26,38,39,41:REM Radio buttons
  8305.  15,16,17,18,30,32,34,43,45:REM Writable fields
  8306.  10,11,12,19,29,40,42:REM Option switches
  8307.  In Label Definition window
  8308.  0,1,2:REM Radio buttons
  8309.  4,6,10,12,17:REM Writable fields
  8310.  11,13,16:REM Option switches
  8311. end_load
  8312. close_file(F)
  8313.  222:
  8314. wimp_error(
  8315. ,fatal_err%,
  8316. ,f$+" not found")
  8317.  6,223:
  8318.  ### 6="Type mismatch", 223="End of file" ###
  8319. wimp_error(
  8320. ,moan_err%,
  8321. ,f$+" is too old and is being deleted")
  8322.  "OS_CLI","Delete "+f$
  8323. leaf(f$)="PrintOpts" 
  8324. load_options("<Pbase$Dir>.Resources.PrintOpts")
  8325. wimp_error(
  8326. ,moan_err%,
  8327. design_field
  8328.  w%,h%
  8329. posx%=x%:posy%=y%
  8330. ^3!block%=mainW%:
  8331.  "Wimp_GetWindowState",,block%
  8332. x%+=block%!20-block%!4
  8333. y%+=block%!24-block%!16
  8334.  %1111111 
  8335.  (ic% 
  8336.  2)=1 
  8337.  drag%=6:dragbutt%=16 
  8338.  drag%=5:dragbutt%=64
  8339. init_drag(mainW%,ic%,drag%)
  8340.   $InsText%=""
  8341. deselect(createW%,
  8342. selected_esg(createW%,1))
  8343.  ic%>=0 
  8344. lit(menu%(9),0,
  8345. jB    !block%=mainW%:block%!4=ic%:
  8346.  "Wimp_GetIconState",,block%
  8347. kM    x%=block%!8:y%=block%!12:w%=block%!16-block%!8:h%=block%!20-block%!12
  8348. l$    Fieldnumber%=
  8349. get_field(ic%)
  8350. m%    type%=chartype%(Fieldnumber%)
  8351.  type% 
  8352.       
  8353.  0,1,2,3,4,5,6,7,8:
  8354.       
  8355. select(createW%,21)
  8356.       
  8357. set_limits(0,0,8,8)
  8358.       
  8359.  36,37,38,39,40:
  8360.       
  8361. select(createW%,22)
  8362. t"      
  8363. set_limits(36,36,40,11)
  8364.       
  8365.  41,42,43,44,45:
  8366.       
  8367. select(createW%,24)
  8368. w"      
  8369. set_limits(41,41,45,14)
  8370. x6      
  8371.  46,47,48,49,50,51,52,53,54,55,56,57,58,59:
  8372.       
  8373. select(createW%,35)
  8374. z"      
  8375. set_limits(46,46,59,16)
  8376.       
  8377.       
  8378. select(createW%,23)
  8379. }       
  8380. set_limits(9,9,35,19)
  8381. ~        
  8382.     fieldtype%=type%
  8383. R    
  8384. tick_one(menu%(menunumber%),0,lasttype%-firsttype%,fieldtype%-firsttype%)
  8385. 4    $FtitleText%="Modify field "+
  8386. (Fieldnumber%)
  8387. 5    $DescText%=$
  8388. text(mainW%,desc%(Fieldnumber%))
  8389. $    $TagText%=Tag$(Fieldnumber%)
  8390. '    $LenText%=
  8391. (len%(Fieldnumber%))
  8392. $    $ValText%=vname$(fieldtype%)
  8393. l    
  8394.  fix%(Fieldnumber%)>0 
  8395.  $Fixpt%=
  8396. (fix%(Fieldnumber%)):
  8397. select(createW%,14) 
  8398. deselect(createW%,14)
  8399. :    
  8400. icon_bit(22,createW%,13,(
  8401. selected(createW%,14)))
  8402. ?    
  8403. icon_bit(22,createW%,14,(fieldtype%=3 
  8404.  fieldtype%=6))
  8405. #    
  8406. icon_bit(22,createW%,18,
  8407. [    
  8408. icon_bit(22,createW%,6,(fieldtype%<9 
  8409.  fieldtype%=46 
  8410.  fieldtype%=47) 
  8411.  adjust%)
  8412. +    
  8413. icon_bit(22,createW%,30,
  8414.  adjust%)
  8415. #    
  8416. icon_bit(22,createW%,29,
  8417. @    
  8418. icon_bit(22,createW%,15,(fieldtype%=3 
  8419.  fieldtype%=47))
  8420. 0    
  8421. icon_bit(22,createW%,25,(fieldtype%=3))
  8422. *    C$=calc$(Fieldnumber%):P%=
  8423. C$,"|")
  8424. 8    
  8425.  P%>0 
  8426.  $mintext%=
  8427. C$,P%-1):$maxtext%=
  8428. C$,P%+1)
  8429.  I%=21 
  8430. -      
  8431. icon_bit(22,createW%,I%,
  8432.  adjust%)
  8433. +    
  8434. icon_bit(22,createW%,35,
  8435.  adjust%)
  8436. +    
  8437. icon_bit(22,createW%,39,
  8438.  adjust%)
  8439. +    
  8440. icon_bit(22,createW%,40,
  8441.  adjust%)
  8442.         
  8443. "    
  8444. lit(menu%(9),0,
  8445.  adjust%)
  8446. select(createW%,21)
  8447. set_limits(0,0,8,8)
  8448. .    $FtitleText%="New field "+
  8449. (fields%+1)
  8450. /    $DescText%="":$TagText%="":$LenText%=""
  8451. -    $Fixpt%="2":$mintext%="":$maxtext%=""
  8452. deselect(createW%,14)
  8453. #    
  8454. icon_bit(22,createW%,13,
  8455. #    
  8456. icon_bit(22,createW%,14,
  8457. #    
  8458. icon_bit(22,createW%,15,
  8459. #    
  8460. icon_bit(22,createW%,25,
  8461. #    
  8462. icon_bit(22,createW%,29,
  8463. #    
  8464. icon_bit(22,createW%,30,
  8465. #    
  8466. icon_bit(22,createW%,39,
  8467. #    
  8468. icon_bit(22,createW%,40,
  8469. +    
  8470. icon_bit(22,createW%,18,
  8471.  adjust%)
  8472. 9  $boxX%=
  8473. (x%):$boxY%=
  8474. (y%):$boxW%=
  8475. (w%):$boxH%=
  8476. close_window(createW%)
  8477. show_menu(menu%(9),posx%-64,posy%-20)
  8478. init_drag(mainW%,ic%,5):dragbutt%=64
  8479. remove_field(Field%,con%,
  8480.  Calc$)
  8481.  con% 
  8482. confirm(
  8483. msg(53))=
  8484. )!block%=mainW%:block%!4=desc%(Field%)
  8485.  "Wimp_GetIconState",,block%
  8486. "posx%=block%!8:posy%=block%!12
  8487.  "Wimp_DeleteIcon",,block%
  8488. 8block%!4=field%(Field%):
  8489.  "Wimp_DeleteIcon",,block%
  8490. fields%-=1
  8491. Calc$=calc$(Field%)
  8492.  F%=Field% 
  8493.  fields%
  8494.   desc%(F%)=desc%(F%+1):field%(F%)=field%(F%+1):Tag$(F%)=Tag$(F%+1):len%(F%)=len%(F%+1):chartype%(F%)=chartype%(F%+1):fix%(F%)=fix%(F%+1):calc$(F%)=calc$(F%+1)
  8495. !block%=mainW%
  8496.  "Wimp_GetWindowState",,block%
  8497. ;posx%-=block%!20-block%!4:posy%-=block%!24-block%!16-48
  8498.  "Wimp_ForceRedraw",-1,block%!4,block%!8,block%!12,block%!16
  8499. create_field(Before%,x%,y%,Calc$)
  8500.  Desc%,Field%,F%,tag$,Len%,Char%,F%,L%,LF%,x%,y%,width%,height%
  8501.  fields%=MaxFields% 
  8502. softerror(
  8503. (MaxFields%),23):
  8504.  $DescText%="" 
  8505.  $TagText%="" 
  8506.  fieldtype%<=8 
  8507. ($DescText%):LF%=
  8508. ($LenText%)
  8509.  LF%>246 
  8510. softerror("",64):
  8511. ($boxX%):y%=
  8512. ($boxY%):width%=
  8513. ($boxW%):height%=
  8514. ($boxH%)
  8515.  fieldtype% 
  8516.  39,40,59:
  8517.   LF%=0
  8518.  width%=0 
  8519.  width%=48
  8520.  height%=0 
  8521.  height%=48
  8522.  41,42,43,44,45:LF%=1
  8523.  8,48,50:LF%=8
  8524.  49:LF%=15
  8525.  51:LF%=10
  8526.  52,58:LF%=24
  8527.  53,55:LF%=3
  8528.  54,56:LF%=2
  8529.  57:LF%=4
  8530.  LF%>0 
  8531.  $TagText%="" 
  8532. softerror("",16):
  8533.  F%+=1
  8534.  $TagText%=Tag$(F%) 
  8535.  F%>fields%
  8536.  F%<=fields% 
  8537.  $TagText%<>"" 
  8538. softerror("",20):
  8539. 8fields%+=1:Tag$(fields%)=$TagText%:len%(fields%)=LF%
  8540.  width%=0 
  8541.  $TagText%<>"" 
  8542.  len%(fields%)<70 
  8543.  width%=len%(fields%)*16+16 
  8544.  width%=70*16+16
  8545.  height%=0 
  8546.  width%>0 
  8547.  height%=48
  8548. !chartype%(fields%)=fieldtype%
  8549. selected(createW%,14) 
  8550.  fix%(fields%)=
  8551. ($Fixpt%) 
  8552.  fix%(fields%)=0
  8553. extend_named_sliding_block(formanchor%,Fptr%-!formanchor%+L%+6)
  8554. kdesc%(fields%)=
  8555. create_icon(mainW%,x%-L%*16-16,y%,L%*16+8,48,(winback%<<28)+&7016731,"",Fptr%,hand%,L%)
  8556. !$Fptr%=$DescText%:Fptr%+=L%+1
  8557. $Fptr%=""
  8558.  fieldtype% 
  8559.   min$=$
  8560. text(createW%,15)
  8561.   max$=$
  8562. text(createW%,25)
  8563.  min$<>"" 
  8564.  max$<>"" 
  8565.  calc$(fields%)=min$+"|"+max$:calc$(0)="LOADED"
  8566. 3  min$=$
  8567. text(createW%,15):
  8568.  min$="" 
  8569.  min$="0"
  8570. 4  calc$(fields%)=min$+"|"+min$:calc$(0)="LOADED"
  8571.  fieldtype% 
  8572.  0,1,2,3,4,5,6,7,8,39,40,46,47,48,49,50,51,52,53,54,55,56,57:valptr%=hand%
  8573. :valptr%=hvalid%(fieldtype%)
  8574. icon_design(fieldtype%,1,width%,height%)
  8575. Xfield%(fields%)=
  8576. create_icon(mainW%,x%,y%,width%,height%,iflags%,"",Fptr%,valptr%,4)
  8577.  fieldtype%=40 
  8578.  Rf%(fields%)=
  8579. create_anchor("Picture"+
  8580. (fields%))
  8581. Fptr%+=5
  8582. redraw_icon(mainW%,desc%(fields%)):
  8583. redraw_icon(mainW%,field%(fields%))
  8584.  Before%<fields% 
  8585.  Before%>0 
  8586. re_sequence(fields%,Before%,-1)
  8587. adjust_field(b%)
  8588.  Dptr%,Fptr%
  8589.  "Wimp_GetPointerInfo",,block%
  8590.  newx%=!block%:newy%=block%!4
  8591. #Fieldnumber%=
  8592. get_field(ficon%)
  8593.  (ficon% 
  8594.  2)=0 
  8595. C  !block%=mainW%:block%!4=ficon%:
  8596.  "Wimp_GetIconState",,block%
  8597. .  Dptr%=block%!28:Desc$=$Dptr%:L%=
  8598. (Desc$)
  8599.  "Wimp_DeleteIcon",,block%
  8600.  "Wimp_GetWindowState",,block%
  8601. -  x%=block%!20-block%!4+newx%-oldx%+minx%
  8602. .  y%=block%!24-block%!16+miny%+newy%-oldy%
  8603. [  desc%(Fieldnumber%)=
  8604. create_icon(mainW%,x%,y%,L%*16+8,48,&17016731,"",Dptr%,hand%,L%)
  8605. C  !block%=mainW%:block%!4=ficon%:
  8606.  "Wimp_GetIconState",,block%
  8607.   Fptr%=block%!28
  8608. $    
  8609.  "Wimp_DeleteIcon",,block%
  8610. (    
  8611.  "Wimp_GetWindowState",,block%
  8612. #    x%=block%!20-block%!4+minx%
  8613. 0    y%=block%!24-block%!16+miny%+newy%-oldy%
  8614. F    width%=maxx%-minx%+newx%-oldx%:height%=maxy%-miny%+oldy%-newy%
  8615. G    !block%=mainW%:block%!4=ficon%-1:
  8616.  "Wimp_GetIconState",,block%
  8617. 0    Dptr%=block%!28:Desc$=$Dptr%:L%=
  8618. (Desc$)
  8619. $    
  8620.  "Wimp_DeleteIcon",,block%
  8621. C    !block%=mainW%:block%!4=ficon%:
  8622.  "Wimp_DeleteIcon",,block%
  8623. (    
  8624.  "Wimp_GetWindowState",,block%
  8625. 8    x%=block%!20-block%!4+newx%-oldx%+minx%-L%*16-16
  8626. 0    y%=block%!24-block%!16+miny%+newy%-oldy%
  8627. k    desc%(Fieldnumber%)=
  8628. create_icon(mainW%,x%,y%,L%*16+8,48,(winback%<<28)+&7016731,"",Dptr%,hand%,L%)
  8629. (    
  8630.  "Wimp_GetWindowState",,block%
  8631. /    x%=block%!20-block%!4+newx%-oldx%+minx%
  8632. 0    y%=block%!24-block%!16+miny%+newy%-oldy%
  8633. .    width%=maxx%-minx%:height%=maxy%-miny%
  8634. !(  fieldtype%=chartype%(Fieldnumber%)
  8635.  fieldtype% 
  8636. #V    
  8637.  0,1,2,3,4,5,6,7,8,39,40,46,47,48,49,50,51,52,53,54,55,56,57,58:valptr%=hand%
  8638. $!    
  8639.  59:valptr%=!logoanchor%
  8640. %%    
  8641. :valptr%=hvalid%(fieldtype%)
  8642. icon_design(fieldtype%,1,width%,height%)
  8643. (_  field%(Fieldnumber%)=
  8644. create_icon(mainW%,x%,y%,width%,height%,iflags%,"",Fptr%,valptr%,4)
  8645.  fieldtype%=40 
  8646.  Rf%(Fieldnumber%)=
  8647. create_anchor("Picture"+
  8648. (Fieldnumber%))
  8649. +@$boxX%=
  8650. (x%):$boxY%=
  8651. (y%):$boxW%=
  8652. (width%):$boxH%=
  8653. (height%)
  8654. !block%=mainW%
  8655.  "Wimp_GetWindowState",,block%
  8656.  "Wimp_ForceRedraw",-1,block%!4,block%!8,block%!12,block%!16
  8657. swap_fields(F1%,F2%)
  8658.  F2%>0 
  8659.  F2%<=fields% 
  8660.  desc%(F1%),desc%(F2%)
  8661.  Tag$(F1%),Tag$(F2%)
  8662.  field%(F1%),field%(F2%)
  8663.  len%(F1%),len%(F2%)
  8664.  chartype%(F1%),chartype%(F2%)
  8665.  fix%(F1%),fix%(F2%)
  8666.  calc$(F1%),calc$(F2%)
  8667. close_window(createW%)
  8668. re_sequence(F1%,F2%,Z%)
  8669. ?wD%=desc%(F1%):T$=Tag$(F1%):F%=field%(F1%):L%=len%(F1%):C%=chartype%(F1%):f%=fix%(F1%):
  8670.  Calc$="" 
  8671.  Calc$=calc$(F1%)
  8672.  I%=F1%+Z% 
  8673.  F2% 
  8674.   desc%(I%-Z%)=desc%(I%):Tag$(I%-Z%)=Tag$(I%):field%(I%-Z%)=field%(I%):len%(I%-Z%)=len%(I%):chartype%(I%-Z%)=chartype%(I%):fix%(I%-Z%)=fix%(I%):calc$(I%-Z%)=calc$(I%)
  8675. Cjdesc%(F2%)=D%:Tag$(F2%)=T$:field%(F2%)=F%:len%(F2%)=L%:chartype%(F2%)=C%:fix%(F2%)=f%:calc$(F2%)=Calc$
  8676. icon_design(char%,func%,
  8677.  func% 
  8678.  0:bfg%=&1700A53B:ffg%=&0700A535:
  8679.  logosloaded% 
  8680.  lfg%=&0000011A 
  8681.  lfg%=ffg%
  8682.  1:bfg%=&1700653B:ffg%=&07006535:
  8683.  logosloaded% 
  8684.  lfg%=&0000611E 
  8685.  lfg%=ffg%
  8686.  char% 
  8687.  9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30:
  8688. MF  !block%=keypadW%:block%!4=char%-9:
  8689.  "Wimp_GetIconState",,block%
  8690. N?  w%=block%!16-block%!8:h%=block%!20-block%!12:iflags%=bfg%
  8691.  32,33,34:w%=112:h%=44:iflags%=bfg%
  8692.  35:w%=80:h%=64:iflags%=bfg%
  8693.  31:w%=44:h%=44:iflags%=&1700B53B
  8694.  36,37,38:w%=48:h%=44:iflags%=bfg%
  8695.  39:iflags%=ffg%
  8696.  func%=0 
  8697.  iflags%=&0700A53E 
  8698.  iflags%=ffg%
  8699.  41,42,43,44,45:w%=52:h%=52:iflags%=&1700B53B
  8700.  59:iflags%=lfg%
  8701. :iflags%=ffg%
  8702.  w%=0 
  8703.  h%=0 
  8704.  iflags%=&00000000
  8705. get_field(ic%)
  8706.  F%+=1
  8707.  field%(F%)=ic% 
  8708.  desc%(F%)=ic%
  8709. adjust_on(on%)
  8710. design%=on%:adjust%=on%
  8711. lit(menu%(9),5,on%)
  8712. lit(menu%(9),1,
  8713.  on%)
  8714. lit(menu%(9),2,
  8715.  on%)
  8716. lit(menu%(9),3,
  8717.  on%)
  8718. lit(menu%(9),4,
  8719.  on%)
  8720. icon_bit(22,createW%,6,
  8721.  on%)
  8722. change_length(NL%,msg%)
  8723.  EX%,klm%,S$,N%
  8724. EX%=NL%-RA%
  8725.  EX%=0 
  8726. p*dbasehandle%=
  8727. ($database%+".Database")
  8728. readsmarray(dbasehandle%,RA%)
  8729.  msg%:
  8730. extend_dbase
  8731.  (EX%>0):
  8732. confirm("Extend file from "+
  8733. (RA%)+" to "+
  8734. (NL%)+" records")=
  8735. extend_dbase
  8736.  (EX%<0):
  8737. confirm("Shorten file from "+
  8738. (RA%)+" to "+
  8739. (NL%)+" records")=
  8740. shorten_dbase
  8741. $Records%=
  8742. (RA%):N%=RA%
  8743. writesmarray(dbasehandle%,N%)
  8744. close_file(dbasehandle%)
  8745.  msg% 
  8746.  addr=
  8747. moveto(key%,top,1)
  8748. extend_dbase
  8749.  end%,P%,I%,key%,keybase%,KLM%,S$
  8750.  key%=0 
  8751.  Keys%
  8752.   S$=
  8753. KL%(key%),".")
  8754.   KLM%=KL%(key%)+13
  8755.   P%=LH%+48+(NL%+1)*KLM%
  8756. extend_named_sliding_block(keyanchor%(key%),P%)
  8757.    keybase%=!keyanchor%(key%)
  8758.   P%=LH%+48+RA%*KLM%
  8759.  I%=RA% 
  8760.  EX%+RA%-1
  8761.     !(keybase%+P%)=P%+KLM%
  8762.     !(keybase%+P%+4)=0
  8763.     $(keybase%+P%+8)=S$
  8764. %    !(keybase%+P%+KL%(key%)+9)=I%
  8765.     P%+=KLM%
  8766.   !(keybase%+P%)=0
  8767.   !(keybase%+P%+4)=0
  8768.   $(keybase%+P%+8)=S$
  8769. "  !(keybase%+P%+KL%(key%)+9)=0
  8770.  key%
  8771. end%=
  8772. #dbasehandle%
  8773.  I%=0 
  8774.  EX%-1
  8775. #dbasehandle%=end%+I%*Length%
  8776.  J%=1 
  8777.  fields%
  8778. #dbasehandle%,""
  8779. #dbasehandle%=end%+EX%*Length%
  8780. RA%=NL%
  8781. shorten_dbase
  8782.  P%,L%,R%,s$,key%,keybase%,S$
  8783.  key%=0 
  8784.  Keys%
  8785.   S$=
  8786. KL%(key%),".")
  8787.   KLM%=KL%(key%)+13
  8788.    keybase%=!keyanchor%(key%)
  8789. $  s$=$(keybase%+LH%+56+NL%*KLM%)
  8790.  s$<>S$ 
  8791. confirm(
  8792. msg(52))=
  8793.   P%=LH%+48+NL%*KLM%
  8794.   !(keybase%+P%)=0
  8795.   !(keybase%+P%+4)=0
  8796.   $(keybase%+P%+8)=S$
  8797. "  !(keybase%+P%+KL%(key%)+9)=0
  8798.  key%
  8799. #dbasehandle%=Length%*(NL%+1)
  8800. RA%=NL%
  8801. copy_database_spritefile(path$,leaf$)
  8802.  sprites%
  8803. create_named_sliding_block(sprsanchor%,1024)
  8804.  ### This is a temporary sprite area used simply to hold ###
  8805.  ### the sprite 'new_appl' whilst it is renamed and saved ###
  8806. sprites%=!sprsanchor%
  8807. !sprites%=1024
  8808. sprites%!8=16
  8809.  ### Initialise sprite area ###
  8810.  "OS_SpriteOp",&109,sprites%
  8811.  ### Load !Sprites file from Resources ###
  8812.  "OS_SpriteOp",&10A,sprites%,"<PBase$Dir>.Resources.Temp.!Sprites"
  8813.  ### Rename sprite 'new_appl' to new database name ###
  8814.  "OS_SpriteOp",&11A,sprites%,"new_appl",leaf$
  8815.  ### Save spritefile (with renamed new_appl) as !Sprites ###
  8816.  "OS_SpriteOp",&10C,sprites%,path$+".!Sprites"
  8817.  ### Do same for hi-res sprite ###
  8818.  "OS_SpriteOp",&109,sprites%
  8819.  "OS_SpriteOp",&10A,sprites%,"<PBase$Dir>.Resources.Temp.!Sprites22"
  8820.  "OS_SpriteOp",&11A,sprites%,"new_appl",leaf$
  8821.  "OS_SpriteOp",&10C,sprites%,path$+".!Sprites22"
  8822. scrap_sliding_block(sprsanchor%)
  8823. defaults(f$,N%,key%)
  8824. $Records%=
  8825. make_empty_index(N%,key%,
  8826. save_recs(f$+".Database",N%)
  8827. present%=7:
  8828. save_keys
  8829. design%=
  8830. get_it_in(f$)
  8831. lit(menu%(0),2,
  8832. default_key
  8833. first_field
  8834.  chartype%(F%)=3:KL%(0)=len%(F%)
  8835.  len%(F%)>3:KL%(0)=4
  8836. :KL%(0)=len%(F%)
  8837. Index$(0)="PrimaryKey"
  8838. key%=0
  8839. (KW%()=0:KF%(key%,0)=F%:KF%(key%,1)=0
  8840. set_keydata(key%)
  8841. new_tree(f%)
  8842.  REC%,I%,ptr%,file%,old$
  8843. old$="Length: "+
  8844. (KL%(0))+", Field(s): "+Tag$(KF%(0,0))+" "+Tag$(KF%(0,1))+", Chars: "+
  8845. (KW%(0,0))+","+
  8846. (KW%(0,1))+","+
  8847. (KW%(0,2))+","+
  8848. (KW%(0,3))
  8849. selected(keyW%,9):s%=
  8850. selected(keyW%,8)
  8851.  f%=0
  8852. M$="Build index with "
  8853.  M$+="records in same subfiles" 
  8854.  M$+="all records in subfile "+
  8855. M$+=" of current database"
  8856.  M$+=", also restoring 'deleted' records."
  8857.  M$+=" WARNING! Other indices will need rebuilding!"
  8858. confirm(M$)=
  8859. mark_files(0,RA%,
  8860.  d%,s%,f%)
  8861. copy_keydata(0)
  8862.  RA%=VAL($Records%)
  8863.  "OS_File",5,$database%+".Database" 
  8864.  ,,,,len%
  8865. RA%=(len% 
  8866.  Length%)-1
  8867. scrap_sliding_block(keyanchor%(0))
  8868. make_empty_index(RA%,0,
  8869. close_window(keyW%)
  8870. redraw(keypadW%)
  8871. ptr%=!tempanchor%
  8872. poll:
  8873.  "Hourglass_On"
  8874. *dbasehandle%=
  8875. ($database%+".Database")
  8876.  REC%=0 
  8877.  RA%-1
  8878.   file%=ptr%?REC%
  8879.  file%<>255 
  8880.     top=8*file%+LH%
  8881. '    
  8882. readsmarray(dbasehandle%,REC%)
  8883.     KEY$=
  8884. key2(0,1)
  8885.      kl%=KL%(0):val$=
  8886. type(0)
  8887. $    
  8888.  KEY$<>"" 
  8889. insert(KEY$,0)
  8890.  "Hourglass_Percentage",(REC%*100) 
  8891.  REC%
  8892. close_file(dbasehandle%)
  8893. "newtree%=
  8894. :design%=
  8895. :adjust%=
  8896. scrap_sliding_block(tempanchor%)
  8897. Index$(0)="PrimaryKey"
  8898.  "Hourglass_Off"
  8899. present%=7
  8900. write_log(-1,"Primary key altered. Previous structure was: "+old$)
  8901.  "Wimp_CreateMenu",,-1
  8902. *block%!8=0:block%!12=wi%:block%!16=ic%
  8903.  "Interface_SlabButton",,block%
  8904. get_it_in($database%)
  8905. reformat(f$)
  8906.  I%,F,REC%,dfields%,DLength%,chdd,z%,blobs%,ex%
  8907.  DTag$(),F%(),F1%(),L%(),l$(),c$()
  8908. F$(0)=""
  8909.  "OS_File",5,f$+".Form" 
  8910.  z%<>1:
  8911. softerror("",19)
  8912.  f$=$database%:
  8913. softerror("",36)
  8914. $  blobs%=
  8915. find_blobs($database%)
  8916. (f$+".Form")
  8917. #F,dfields%
  8918.  DTag$(dfields%),F%(dfields%),F1%(fields%),L%(dfields%),l$(dfields%),c$(dfields%)
  8919.  I%=1 
  8920.  dfields%
  8921. F    
  8922. #F,Desc$,DTag$(I%),xd%,yd%,xf%,yf%,L%(I%),char%,extra%,extra%
  8923.     DLength%+=L%(I%)+1
  8924.   chdd=
  8925. (f$+".Database")
  8926. compare
  8927.  "Hourglass_On"
  8928.  REC%=0 
  8929. #chdd=REC%*DLength%
  8930. ((    
  8931. read(fields%,
  8932. ,REC%,$database%)
  8933.  I%=1 
  8934.  dfields%
  8935.       S$=field$(F%(I%))
  8936. +)      
  8937. (S$)>L%(I%) 
  8938. S$,L%(I%))
  8939.       
  8940. #chdd,S$
  8941.     ex%=-1
  8942.  ex%<blobs%
  8943.       ex%+=1:F%=Ext%(ex%)
  8944. 1F      
  8945. copy_blob($database%,f$,REC%,REC%,F%,F1%(F%),chartype%(F%))
  8946. 2        
  8947. 32    
  8948.  "Hourglass_Percentage",(REC%*100) 
  8949.  REC%
  8950.  "Hourglass_Off"
  8951. close_file(chdd)
  8952.  "OS_File",18,f$+".Database",&7f2
  8953.  "OS_CLI","Copy "+$database%+".PrimaryKey "+f$+".PrimaryKey ~C~V"
  8954.  "OS_CLI","Copy "+$database%+".Colours "+f$+".Colours ~C~V"
  8955.  "OS_CLI","Copy "+$database%+".ValTables "+f$+".ValTables ~CR~V"
  8956.  "OS_CLI","Copy "+$database%+".Indices "+f$+".Indices ~CR~V"
  8957.  "OS_CLI","Copy "+$database%+".PrintRes "+f$+".PrintRes ~CR~V"
  8958.  link$(0)="LOADED" 
  8959.     lk=
  8960. (f$+".Link")
  8961.  F%=1 
  8962.  dfields%
  8963.       
  8964. #lk,l$(F%)
  8965. close_file(lk)
  8966.  calc$(0)="LOADED" 
  8967.     cl=
  8968. (f$+".Calc")
  8969.  F%=1 
  8970.  dfields%
  8971.       
  8972. #cl,c$(F%)
  8973. close_file(cl)
  8974. close_window(reformW%)
  8975. reform$=""
  8976. write_log(-1,"Record structure changed")
  8977. compare
  8978.  source%,dest%
  8979.  dest%=1 
  8980.  dfields%
  8981.   source%=fields%+1
  8982.     source%-=1
  8983.  source%=0 
  8984.  Tag$(source%)=DTag$(dest%)
  8985. X*  F%(dest%)=source%:F1%(source%)=dest%
  8986.  source%>0 
  8987. Z     l$(dest%)=link$(source%)
  8988. [     c$(dest%)=calc$(source%)
  8989.  dest%
  8990. merge_files(f$,fi%)
  8991.  Rec%,ptr%,file%,d%,s%,z%,RUM%,RAM%,NL%,ex%,blobs%
  8992.  "OS_File",5,f$+".Database" 
  8993.  z%<>1:
  8994. softerror("",29)
  8995.  f$=$database%:
  8996. softerror("",15)
  8997. identical:
  8998. softerror("",21)
  8999. h7  s%=
  9000. selected(reformW%,2):d%=
  9001. selected(reformW%,3)
  9002.  fi%=0
  9003.   M$="Merge "+f$+" with "
  9004.  M$+="corresponding subfiles" 
  9005.  M$+="subfile "+
  9006. (fi%)
  9007. l   M$+=" of current database"
  9008.  M$+=", also restoring deleted records"
  9009.  M$+=". WARNING! Indices will need rebuilding!"
  9010. confirm(M$)=
  9011. p0    
  9012.  "OS_File",5,f$+".Database" 
  9013.  ,,,,len%
  9014.     RAM%=(len% 
  9015.  Length%)-1
  9016. rI    
  9017.  ### Load primary key of file to be merged into a spare slot ###
  9018. s2    
  9019. open_index(f$+".PrimaryKey",MaxKeys%+1,
  9020. t@    
  9021.  ### Mark which subfile each new record is to go in ###
  9022. u0    
  9023. mark_files(MaxKeys%+1,RAM%,
  9024.  d%,s%,fi%)
  9025. v(    keybase%=!keyanchor%(MaxKeys%+1)
  9026. wF    
  9027.  ### Count how many record actually used in fiel to merge ###
  9028. x-    
  9029. count(MaxKeys%+1,RUM%):
  9030. count(0,RU%)
  9031.     NL%=RU%+RUM%
  9032.  "Hourglass_On"
  9033. {O    
  9034.  ### Expand existing file if new length (NL%) exceeds availability ###
  9035. |)    
  9036.  NL%>RA% 
  9037. change_length(NL%,
  9038. }&    blobs%=
  9039. find_blobs($database%)
  9040.     ptr%=!tempanchor%
  9041.  Rec%=0 
  9042.  RAM%-1
  9043.       file%=ptr%?Rec%
  9044.       
  9045.  file%<>255 
  9046.         top=8*file%+LH%
  9047. $        
  9048. read(fields%,
  9049. ,Rec%,f$)
  9050.          
  9051. write(fields%,key%)
  9052.         ex%=-1
  9053.         
  9054.  ex%<blobs%
  9055. !          ex%+=1:F%=Ext%(ex%)
  9056. E          
  9057. copy_blob(f$,$database%,Rec%,REC%,F%,F%,chartype%(F%))
  9058.         
  9059. 7        
  9060.  "Hourglass_Percentage",(Rec%*100) 
  9061.  RUM%
  9062.       
  9063.  Rec%
  9064.  "Hourglass_Off"
  9065. close_window(reformW%)
  9066. )    
  9067. scrap_sliding_block(tempanchor%)
  9068. 4    
  9069. scrap_sliding_block(keyanchor%(MaxKeys%+1))
  9070. !    file%=fi%:top=8*file%+LH%
  9071.      addr=
  9072. moveto(key%,top,1)
  9073. reform$=""
  9074. write_log(-1,"Records merged from "+f$)
  9075. identical
  9076.  I%,F,dfields%,different%
  9077. (f$+".Form")
  9078. #F,dfields%
  9079.  dfields%<>fields% 
  9080.  different%=
  9081.  I%<fields% 
  9082.  different%
  9083.   I%+=1
  9084. #F,Desc$,Tag$,xd%,yd%,xf%,yf%,len%,char%,extra%,extra%
  9085.  len%<>len%(I%) 
  9086.  different%=
  9087.  different%
  9088. mark_files(key%,RA%,d%,s%,f%)
  9089.  P%,I%,M,file%,top,ptr%
  9090. create_named_sliding_block(tempanchor%,RA%+1)
  9091.  "Hourglass_On"
  9092. ptr%=!tempanchor%
  9093.  I%=0 
  9094.  RA%-1
  9095.   ptr%?I%=d%
  9096.  file%=0 
  9097.     top=8*file%+LH%
  9098. !    P%=
  9099. neighbour(key%,top,1)
  9100.  P%<>top
  9101.        S%=
  9102. rec_no(k$,key%,P%)
  9103. +      
  9104.  ptr%?S%=file% 
  9105.  ptr%?S%=f%
  9106. "      P%=
  9107. neighbour(key%,P%,1)
  9108.         
  9109.  file%
  9110.  "Hourglass_Off"
  9111. print_tree(key%,file%,PR$)
  9112.  L%(),COL%,levels%,depth%
  9113. E$SaveName%=$database%+".PrintJobs.Tree"+
  9114. Index$(key%),5)+
  9115. (file%)
  9116. read_print_options
  9117. reportdest$="Window"
  9118. keybase%=!keyanchor%(key%)
  9119. P%=!(keybase%+top)
  9120.  "Hourglass_On"
  9121. traverse(P%,
  9122. levels%=depth%-2:COL%=0
  9123.  L%(levels%)
  9124. tree_heading
  9125. P%=!(keybase%+top)
  9126. traverse(P%,
  9127. H$=" No. nodes     1"
  9128. H1$=" Max nodes     1"
  9129.  L%=1 
  9130.  levels%
  9131.  L%<40 
  9132.     L$=
  9133. (L%(L%))
  9134.     L$=
  9135. (L$)," ")+L$
  9136.     M$=
  9137. (2^L%)
  9138. 0    
  9139. (M$)>5 
  9140.  M$=BL$ 
  9141. (M$)," ")+M$
  9142.     H$+=L$:H1$+=M$
  9143. rule_off(45)
  9144. :$(!lineanchor%)=H$:
  9145. list_line(-1,lineanchor%,
  9146. (H$),32)
  9147. <$(!lineanchor%)=H1$:
  9148. list_line(-1,lineanchor%,
  9149. (H1$),32)
  9150. <$(!lineanchor%)=LH$:
  9151. list_line(-1,lineanchor%,
  9152. (LH$),32)
  9153. rule_off(45)
  9154.  "Hourglass_Off"
  9155. format$="tree":tkey%=key%
  9156. screen_list
  9157. pitch$=
  9158. pitch("2")
  9159. lit(menu%(18),1,
  9160. write_log(-1,"Tree printed: subfile:"+
  9161. (file%)+", key:"+
  9162. (key%)+", "+Index$(key%))
  9163. tree_heading
  9164.  zero%,len%
  9165. 6," ")
  9166. LH$=" Level No.  Root"
  9167.  L%=1 
  9168.  levels%
  9169.   L$=
  9170.  L%<10 
  9171.  L$="0"+L$
  9172.  L%<40 
  9173.     LH$+="    "+L$
  9174.     len%=
  9175. (LH$)
  9176. U$=" "+
  9177. len%-1,"-")
  9178. LenLine%=len%+4
  9179. Count%=0
  9180. "count%=
  9181. count_recs(key%,zero%)
  9182. Dtextblocksize%=(count%+11)*LenLine%:textblockinc%=textblocksize%
  9183. extend_named_sliding_block(textanchor%,textblocksize%)
  9184. extend_named_sliding_block(lineanchor%,LenLine%+4)
  9185. TextPtr%=!textanchor%
  9186. recblocksize%=400
  9187. extend_named_sliding_block(recanchor%,recblocksize%)
  9188. rule_off(32)
  9189. rule_off(45)
  9190. send_title("Tree Analysis (subfile:"+
  9191. (file%)+", key:"+
  9192. (key%)+", "+Index$(key%)+")")
  9193. rule_off(32)
  9194. <$(!lineanchor%)=LH$:
  9195. list_line(-1,lineanchor%,
  9196. (LH$),32)
  9197. rule_off(45)
  9198. traverse(P%,Z%)
  9199.  string$
  9200. COL%=COL%+1
  9201.  COL%>depth% 
  9202.  depth%=COL%
  9203.  P%<0 
  9204. L%=!(keybase%+P%)
  9205. R%=!(keybase%+P%+4)
  9206. S$=$(keybase%+P%+8)
  9207.  S$="" 
  9208.  S$="<null>"
  9209. S$)="#"
  9210.   S$=
  9211. %rec%=!(keybase%+P%+8+KL%(key%)+1)
  9212.   L%(COL%-1)=L%(COL%-1)+1
  9213.  PR$="ALL" 
  9214.  COL%<=40 
  9215. *      string$=
  9216. COL%*6+10-
  9217. (S$)," ")+S$
  9218. L      $(!lineanchor%)=string$:
  9219. list_line(rec%,lineanchor%,
  9220. (string$),32)
  9221.       
  9222. 1      string$=" "+S$+" (level "+
  9223. (COL%-1)+")"
  9224. L      $(!lineanchor%)=string$:
  9225. list_line(rec%,lineanchor%,
  9226. (string$),32)
  9227.         
  9228. traverse(L%,Z%)
  9229. COL%=COL%-1
  9230. L%=!(keybase%+P%)
  9231. R%=!(keybase%+P%+4)
  9232. S$=$(keybase%+P%+8)
  9233. %rec%=!(keybase%+P%+8+KL%(key%)+1)
  9234. traverse(R%,Z%)
  9235. COL%=COL%-1
  9236. balance(key%)
  9237.  recptr%,top,file%,flagptr%,balptr%,I%,N%,A%,max%,done%,highest%,avail%,seglen%
  9238.  recs%(),ptr%()
  9239.  recs%(5),ptr%(5)
  9240. newtree%=
  9241. seglen%=KL%(key%)+5
  9242. extend_named_sliding_block(recanchor%,seglen%*RA%)
  9243. create_named_sliding_block(balanchor%,seglen%*RA%)
  9244. create_named_sliding_block(flaganchor%,RA%)
  9245. ,Arecptr%=!recanchor%:flagptr%=!flaganchor%:balptr%=!balanchor%
  9246.  I%=0 
  9247.  RA%-1
  9248.   flagptr%?I%=255
  9249.  Bytes are changed from 255 to 0 where records are in use
  9250.  "Hourglass_On"
  9251.  file%=0 
  9252.   ptr%(file%)=recptr%
  9253.   top=8*file%+LH%
  9254. 5.  recs%(file%)=
  9255. count_recs(key%,recptr%)-1
  9256.   max%+=recs%(file%)+1
  9257.  file%
  9258. make_empty_index(RA%,key%,
  9259.  "Hourglass_LEDs",%11
  9260.  file%=0 
  9261.   top=8*file%+LH%
  9262.  recs%(file%)>=0 
  9263.     recptr%=ptr%(file%)
  9264.     N%=1
  9265. ?        
  9266.       N%=N%+N%
  9267.  N%>recs%(file%)+2
  9268.     step%=N%
  9269.     N%=(N% 
  9270.  2)-1
  9271.     start%=N%
  9272.     C%=0
  9273. F        
  9274.       start%=start% 
  9275.       end%=N%-start%-1
  9276.       step%=step% 
  9277. J$      
  9278.  I%=start% 
  9279.  end% 
  9280.  step%
  9281. K9        A%=recptr%+seglen%*(I%*(recs%(file%)+1) 
  9282. L=        balptr%!C%=!A%:$(balptr%+C%+4)=$(A%+4):!A%=-!A%-1
  9283.         C%+=seglen%
  9284.       
  9285.  step%=2
  9286. P&    kl%=KL%(key%):val$=
  9287. type(key%)
  9288. Q%    
  9289.  I%=0 
  9290.  C%-seglen% 
  9291.  seglen%
  9292. R.      REC%=balptr%!I%:KEY$=$(balptr%+I%+4)
  9293.       
  9294. insert(KEY$,key%)
  9295.       done%+=1
  9296. U6      
  9297.  "Hourglass_Percentage",(done%*100) 
  9298.  max%
  9299.  I%=0 
  9300.  recs%(file%)
  9301. X#      REC%=recptr%!(seglen%*I%)
  9302.       
  9303.  REC%>=0 
  9304. Z(        KEY$=$(recptr%+seglen%*I%+4)
  9305.         
  9306. insert(KEY$,key%)
  9307.         done%+=1
  9308. ]8        
  9309.  "Hourglass_Percentage",(done%*100) 
  9310.  max%
  9311.       
  9312.  file%
  9313.  "Hourglass_LEDs",%00
  9314. keybase%=!keyanchor%(key%)
  9315. nodesize%=8+KL%(key%)+1+4
  9316. avail%=!keybase%
  9317.  I%=0 
  9318.  highest%
  9319.  flagptr%?I%=255 
  9320. h+    !(keybase%+avail%+8+KL%(key%)+1)=I%
  9321.     avail%+=nodesize%
  9322.  "Hourglass_Off"
  9323. scrap_sliding_block(balanchor%)
  9324. scrap_sliding_block(recanchor%)
  9325. scrap_sliding_block(flaganchor%)
  9326. save_keys
  9327. newtree%=
  9328. write_log(-1,"Index "+Index$(key%)+" balanced")
  9329. duplicates(dkey%,dfile%)
  9330.  P$,S$,RP$,RS$,daddr,dtop,RP%,RS%,count%,examined%
  9331. abort_dup:
  9332. yE$SaveName%=$database%+".PrintJobs.Dupl"+
  9333. Index$(key%),5)+
  9334. (file%)
  9335. z"count%=
  9336. count_recs(key%,zero%)
  9337. read_print_options
  9338. |Breportdest$="Window":format$="dup":Count%=0:LenLine%=KL%(0)+23
  9339. }<textblocksize%=100*LenLine%:textblockinc%=textblocksize%
  9340. extend_named_sliding_block(textanchor%,textblocksize%)
  9341. extend_named_sliding_block(lineanchor%,LenLine%+4)
  9342. TextPtr%=!textanchor%
  9343. recblocksize%=400
  9344. extend_named_sliding_block(recanchor%,recblocksize%)
  9345. close_window(datadicW%)
  9346. rule_off(32)
  9347. aline$=" Duplicated primary keys":$(!lineanchor%)=line$:
  9348. list_line(-1,lineanchor%,
  9349. (line$),32)
  9350. rule_off(45)
  9351. dtop=8*dfile%+LH%
  9352. "daddr=
  9353. neighbour(dkey%,dtop,1)
  9354.  "Hourglass_On"
  9355.  daddr<>dtop
  9356.  "OS_Byte",229,0
  9357. S  S$=$(!keyanchor%(dkey%)+daddr+8):RS%=!(!keyanchor%(dkey%)+daddr+9+KL%(dkey%))
  9358. ;  RS$=
  9359. (RS%):RS$=" Record No."+
  9360. (RS$)," ")+RS$+"   "
  9361.  S$=P$ 
  9362.     line$=RP$+P$
  9363. E    $(!lineanchor%)=line$:
  9364. list_line(RP%,lineanchor%,
  9365. (line$),32)
  9366.     line$=RS$+S$
  9367. E    $(!lineanchor%)=line$:
  9368. list_line(RS%,lineanchor%,
  9369. (line$),32)
  9370.   P$=S$:RP%=RS%:RP$=RS$
  9371.   examined%+=1
  9372.  "Hourglass_Percentage",examined%*100 
  9373.  count%
  9374. %  daddr=
  9375. neighbour(dkey%,daddr,1)
  9376. rule_off(32)
  9377.  "Hourglass_Off"
  9378. screen_list
  9379. abort_dup
  9380.  "Hourglass_Off"
  9381. screen_list
  9382. softerror("",67)
  9383. wimp_error(
  9384. stripspaces(s$)
  9385. s$)=" "
  9386.   s$=
  9387.  >RAMtree
  9388.  Index handling ------------------------------------------------------
  9389. neighbour(key%,addr%,d%)
  9390.  R%,S%,p%,keybase%
  9391. keybase%=!keyanchor%(key%)
  9392. p%=d%*4
  9393. R%=!(keybase%+addr%+p%)
  9394.  R%<0 
  9395.  =-R%
  9396. p%=4-p%
  9397.   addr%=R%
  9398.   S%=!(keybase%+addr%+p%)
  9399.  S%>0 
  9400.  R%=S%
  9401.  S%<=0
  9402. rec_no(
  9403.  k$,key%,addr%)
  9404. #k$=$(!keyanchor%(key%)+addr%+8)
  9405. -=!(!keyanchor%(key%)+addr%+8+KL%(key%)+1)
  9406. scan_file(c$,key%,action%)
  9407.  REC%,examined%,subtotal%,X%,Y%,n$,copy%
  9408. n$="0123456789."
  9409. %subtotal%=
  9410. count_recs(key%,zero%)
  9411. (c$)=
  9412.  "OS_Byte",229,0
  9413.   REC%=
  9414. rec_no(k$,key%,P%)
  9415. readsmarray(dbasehandle%,REC%)
  9416.   examined%+=1
  9417. (Search$)=
  9418.  action% 
  9419.       
  9420. get_lengths
  9421.       
  9422.       
  9423.  format$="label" 
  9424. "        
  9425.  copy%=1 
  9426.  labcopies%
  9427. !          
  9428. print_record(REC%)
  9429.         
  9430.  copy%
  9431. !        
  9432. print_record(REC%)
  9433.       
  9434. -      
  9435.  2:ptr%?REC%=255:
  9436.  ### earmark ###
  9437. .      
  9438. write_csv_rec(REC%):
  9439. poll:
  9440. 9      
  9441.  4:KEY$=
  9442. key2(newkey%,1):
  9443. insert(KEY$,newkey%)
  9444.        
  9445.  ### create index ###
  9446.       
  9447.       S$=F$(Fieldnumber%)
  9448.       
  9449.  numeric% 
  9450.         X%=0:Y%=0
  9451.         
  9452.  X%+=1
  9453. )        
  9454. (S$) 
  9455. S$,X%,1))>0
  9456.         
  9457.  X%<=
  9458. (S$) 
  9459.           Y%=X%
  9460.           
  9461.  Y%+=1
  9462. +          
  9463. (S$) 
  9464. S$,Y%,1))=0
  9465.         
  9466. 9        S$=
  9467. S$,X%-1)+
  9468. S$,X%,Y%-X%)+New$))+
  9469. S$,Y%)
  9470.         
  9471.  S$=New$
  9472.       
  9473.       
  9474. (S$)>TextLength% 
  9475.         
  9476. softerror("",10)
  9477.         
  9478.         F$(Fieldnumber%)=S$
  9479. ,        
  9480. writesmarray(dbasehandle%,REC%)
  9481.       
  9482. !      
  9483.  ### global change ###
  9484.         
  9485.   P%=
  9486. neighbour(key%,P%,1)
  9487.  "Hourglass_Percentage",(examined%*100) 
  9488.  subtotal%
  9489. search(S$,key%,M%)
  9490.  P%,found%,info$,keybase%,rec%
  9491. keybase%=!keyanchor%(key%)
  9492. Z%=0:P%=top:ident%=
  9493.   L%=P%
  9494.   P%=!(keybase%+L%+Z%)
  9495.  P%<=0 
  9496.  P%=-L%:found%=
  9497.   info$=$(keybase%+P%+8)
  9498.   rec%=
  9499. rec_no(k$,key%,P%)
  9500. (val$+"(S$)="+val$+"LEFT$(info$,kl%)") 
  9501.       
  9502.  0:ident%=(key%=0)
  9503.       
  9504.  1:found%=
  9505. $      
  9506.  rec%=REC% 
  9507.  found%=
  9508.         
  9509.  found% 
  9510.  Z%=-
  9511. (val$+"(S$)>="+val$+"(info$)")*4
  9512.  found%
  9513.  ### M%=0 - Find leaf position at which to insert ###
  9514.  ### M%=1 - Find first match in tree (if there is one) ###
  9515.  ### M%=2 - Find exact matching record, checking for record no. ###
  9516. insert(
  9517.  S$,key%)
  9518.  P%,avail%,kl%,keybase%,abort%
  9519. keybase%=!keyanchor%(key%)
  9520. kl%=KL%(key%)
  9521. search(S$,key%,0)
  9522.  ident% 
  9523. !    
  9524. selected(passW%,15):
  9525. +    
  9526. softerror(" ("+S$+")",37):abort%=
  9527. >    
  9528.  dup% 
  9529. confirm(
  9530. msg(45)+" ("+S$+")") 
  9531.  abort%=
  9532.  abort% 
  9533.  S$="*Failed*":
  9534. nextfree%=!keybase%
  9535.  !(keybase%+nextfree%)<=0 
  9536.   incr%=
  9537. ($Increment%)
  9538.  incr%>0 
  9539. "#    
  9540. change_length(RA%+incr%,
  9541.  S$="*Failed*"
  9542.  S$="*Failed*" 
  9543. softerror("",2):
  9544. ' avail%=!(keybase%+nextfree%)
  9545. (.!(keybase%+nextfree%+Z%)=!(keybase%+P%+Z%)
  9546. )$!(keybase%+nextfree%+(4-Z%))=-P%
  9547. $(keybase%+nextfree%+8)=S$
  9548. +,!(keybase%+nextfree%+8+KL%(key%)+1)=REC%
  9549. !(keybase%+P%+Z%)=nextfree%
  9550. !keybase%=avail%
  9551.  key%=0 
  9552.  RU%+=1
  9553. delete(
  9554.  S$,key%)
  9555.  P%,A%,kl%,keybase%
  9556. keybase%=!keyanchor%(key%)
  9557. A%=!keybase%
  9558. kl%=KL%(key%)
  9559. search(S$,key%,2)
  9560.  P%<0 
  9561. softerror(" ("+S$+": "+Index$(key%)+" index)",1):S$="*Failed*":
  9562. neighbour(key%,P%,0)
  9563. neighbour(key%,P%,1)
  9564. :'!(keybase%+L%+Z%)=!(keybase%+P%+Z%)
  9565. ;    Q%=P%
  9566. ZL%=4-Z%
  9567. P1%=!(keybase%+P%+ZL%)
  9568.  P1%>0 
  9569.   info$=$(keybase%+P1%+8)
  9570.   P%=-
  9571. search(info$,key%,0)
  9572.   !(keybase%+P%+Z%)=P1%
  9573.  !(keybase%+PR%+4)<=0 
  9574.  !(keybase%+PR%+4)=-SU%
  9575.  !(keybase%+SU%+0)<=0 
  9576.  !(keybase%+SU%+0)=-PR%
  9577. !(keybase%+Q%)=A%
  9578. !keybase%=Q%
  9579.  key%=0 
  9580.  RU%-=1
  9581. save_keys
  9582.  keyN%
  9583.  present%<>7 
  9584.  "Hourglass_On"
  9585. N5keybase%=!keyanchor%(0):keybase%!4=
  9586. ($Increment%)
  9587.  !keyanchor%(keyN%)>0
  9588. P!  keybase%=!keyanchor%(keyN%)
  9589.   keybase%?73=0
  9590.  "SlidingHeap_DescribeBlock",slidingheapbase%,keyanchor%(keyN%) 
  9591.  ,,filelength%
  9592.  keyN% 
  9593.  index$="Indices." 
  9594.  index$=""
  9595.  "OS_File",10,$database%+"."+index$+Index$(keyN%),&7F0,,keybase%,keybase%+filelength%
  9596.   keyN%+=1
  9597.  "Hourglass_Percentage",keyN%*100 
  9598.  (Keys%+1)
  9599.  "Hourglass_Off"
  9600. readsmarray(filehandle%,REC%)
  9601.  loop%
  9602. #filehandle%=REC%*Length%
  9603.  loop%=1 
  9604.  fields%
  9605.   F$(loop%)=
  9606. #filehandle%
  9607.  loop%
  9608. writesmarray(F,
  9609.  loop%,F$,L%
  9610. #F=R%*Length%
  9611.  loop%=1 
  9612.  fields%
  9613. g!  F$=F$(loop%):L%=len%(loop%)
  9614. (F$)<=L% 
  9615. #F,F$ 
  9616. L%,"!")
  9617.  loop%
  9618. j    R%+=1
  9619. check_save(T%)
  9620.  time%
  9621.  "OS_ReadMonotonicTime" 
  9622.  time%
  9623.  (time% 
  9624.  T%)<10 
  9625.  buttonfield%(19)>0 
  9626.  wi%=mainW%:ic%=buttonfield%(19) 
  9627.  wi%=keypadW%:ic%=19
  9628.  autosave% 
  9629.     delay%=
  9630.  loop%=0 
  9631.       delay%+=50
  9632. w0      block%!8=1:block%!12=wi%:block%!16=ic%
  9633. x+      
  9634.  "Interface_SlabButton",,block%
  9635.       
  9636. >delay%
  9637.       
  9638.  1,-15,180,5
  9639.       block%!8=0
  9640. |+      
  9641.  "Interface_SlabButton",,block%
  9642.       delay%+=50
  9643.       
  9644. >delay%
  9645.  loop%
  9646. !    
  9647. mouse(0,0,4,wi%,ic%)
  9648. set_auto(mode%)
  9649. tick_one(menu%(12),0,2,2-mode%)
  9650. autosave%=mode%
  9651. 8saveint%=
  9652. ($Interval%):$Interval%=
  9653. (saveint%)+" min"
  9654. set_autobalance(status%)
  9655. tick(menu%(21),0,status%)
  9656. autobalance%=status%
  9657.  autobalance% 
  9658.  $Every%="25 recs"
  9659. :balint%=
  9660. ($Every%):$Every%=
  9661. (balint%)+" recs":added%=0
  9662.  Calculations ---------------------------------------------------------
  9663. calc_link(T$,type%)
  9664.  ### Sets up calculation formula window & menu entry ###
  9665. $CalcFunc%=T$
  9666. )$CalcTitle%=T$:calclink%=Fieldnumber%
  9667. split_link(calclink%,real$,visible$)
  9668.  type% 
  9669.  6,7:$CalcForm%=Tag$(calclink%)+"="+visible$
  9670.   $CalcForm%=visible$
  9671. icon_bit(22,calcW%,2,off%)
  9672. deselect(calcW%,2)
  9673. calc_formula(S$)
  9674.  ### Parses calculation formula (S$) & builds calc$(I%) ###
  9675.  I%,P%,t$,s$,C$,time%
  9676. ~(calclink%):
  9677.  calclink%<16 
  9678.  C$="0"+C$
  9679.  $CalcFunc%="Set base value" 
  9680.  S$="" 
  9681.  S$="0"
  9682.    calc$(calclink%)=S$+"|"+S$
  9683.   calc$(0)="LOADED"
  9684. *  P%=
  9685. S$,"="):S$=
  9686. S$,P%+1):visible$=S$
  9687.  I%=1 
  9688.  fields%
  9689.     t$=Tag$(I%)
  9690.  t$<>"" 
  9691.       P%=0
  9692.       
  9693.         P%=
  9694. S$,t$,P%+1)
  9695.         
  9696.  P%>0 
  9697.            
  9698.  chartype%(I%) 
  9699. >            
  9700.  3,6,46,47,54,56,57:s$="VAL($Rf%("+
  9701. (I%)+"))"
  9702. =            
  9703.  8:s$="FNseconds($Rf%("+
  9704. (I%)+"),1)":time%=
  9705.             
  9706. )            
  9707.  chartype%(calclink%) 
  9708. )              
  9709.  6:s$="FNn("+
  9710. (I%)+")"
  9711. *              
  9712.  7:s$="$Rf%("+
  9713. (I%)+")"
  9714.             
  9715.           
  9716. +          S$=
  9717. S$,P%-1)+s$+
  9718. S$,P%+
  9719. (t$))
  9720.           update$(I%)+=C$
  9721.         
  9722.       
  9723.  P%=0
  9724.         
  9725. visible$,"TIME$")>0 
  9726.  update$(0)+=C$
  9727.  time%=
  9728.  chartype%(calclink%)=7 
  9729.  S$="FNtime("+S$+")"
  9730. (S$)+
  9731. (visible$)+2<256 
  9732. ,    calc$(calclink%)="#"+S$+"#"+visible$
  9733.     calc$(0)="LOADED"
  9734. 7    
  9735. selected(calcW%,2) 
  9736. recalculate(calclink%)
  9737. softerror("",44)
  9738. calclink%=0
  9739.  (b% 
  9740.  %111)=4 
  9741.  "Wimp_CreateMenu",,-1
  9742. recalculate(F%)
  9743.  F,I%,R%,k$,P%,real$,visible$,subtotal%,zero%,examined%
  9744. split_link(F%,real$,visible$)
  9745. confirm("Recalculate "+Tag$(F%)+"="+visible$+" for existing records?")=
  9746. %subtotal%=
  9747. count_recs(key%,zero%)
  9748.  "Hourglass_On"
  9749. *dbasehandle%=
  9750. ($database%+".Database")
  9751. neighbour(key%,top,1)
  9752.  P%<>top
  9753.   R%=
  9754. rec_no(k$,key%,P%)
  9755. readsmarray(dbasehandle%,R%)
  9756.  I%=1 
  9757.  fields%
  9758.     $Rf%(I%)=F$(I%)
  9759.  chartype%(F%) 
  9760.     F=
  9761. (real$):F$=
  9762. +    
  9763.  fix%(F%)>0 
  9764. fix_point(F$,F%)
  9765. (    
  9766. softerror(real$,73):
  9767.     F$=
  9768. (real$)
  9769. (F$)<=len%(F%) 
  9770.  F$(F%)=F$
  9771. writesmarray(dbasehandle%,R%)
  9772.   P%=
  9773. neighbour(key%,P%,1)
  9774.   examined%+=1
  9775.  "Hourglass_Percentage",examined%*100 
  9776.  subtotal%
  9777.  "Hourglass_Off"
  9778. close_file(dbasehandle%)
  9779.  I%=1 
  9780.  fields%
  9781.   $Rf%(I%)=field$(I%)
  9782. display(key%,addr)
  9783. sums(
  9784.  F$,F%,type%)
  9785.  F$<>"" 
  9786.  type% 
  9787.  8:V=
  9788. seconds(F$,1)
  9789.   Sum(F%,0)+=1
  9790.   Sum(F%,1)+=V
  9791.   Sum(F%,3)+=V*V
  9792.  V>Sum(F%,4) 
  9793.  Sum(F%,4)=V
  9794.  V<Sum(F%,5) 
  9795.  Sum(F%,5)=V
  9796. ctotals(flag%)
  9797.  F%,I%,J%,N%,R%,S%,base%,pos%,F$
  9798.  S$(),f%()
  9799.  S$(5),f%(5)
  9800. base%=!lineanchor%
  9801.     3S$()="Items","Sum","Mean","St.Dev.","Max","Min"
  9802.  I%=1 
  9803. (Form$)-1 
  9804.   F%=
  9805. fnum(
  9806. Form$,I%,2))
  9807.   R%=calcrow%?F%
  9808.  chartype%(F%) 
  9809.  3,6,8,46,47,54,56,57:
  9810.  Sum(R%,0)>0 
  9811. '      Sum(R%,2)=Sum(R%,1)/Sum(R%,0)
  9812. 6      Sum(R%,3)=
  9813. (Sum(R%,3)/Sum(R%,0)-Sum(R%,2)^2)
  9814.         
  9815. '    
  9816.  Sum(R%,5)=10^30 
  9817.  Sum(R%,5)=0
  9818.  J%=0 
  9819.   pos%=base%
  9820.  flag%>0 
  9821. >    N%=0:start%=1:F$=
  9822. Lmargin%-
  9823. (S$(J%))-1," ")+S$(J%)+" "
  9824.  N%=1:start%=3
  9825. &    L%=Tab%(1)-Lmargin%-
  9826. (spacer$)
  9827. N    
  9828.  L%>=7 
  9829.  F$=margin$+
  9830. tab(S$(J%),N%) 
  9831.  F$=margin$+
  9832. S$(J%),L%),N%)
  9833. heap_store(lineanchor%,LenLine%,0,pos%,0,F$)
  9834. (Form$)>2 
  9835.  start%=1 
  9836.  $    
  9837.  I%=start% 
  9838. (Form$)-1 
  9839. !&      F%=
  9840. fnum(
  9841. Form$,I%,2)):F$=""
  9842.       N%+=1
  9843.       
  9844.  chartype%(F%) 
  9845. $#        
  9846.  3,6,8,46,47,54,56,57:
  9847.         R%=calcrow%?F%
  9848. &Q        
  9849.  chartype%(F%)=8 
  9850.  result$=
  9851. time(Sum(R%,J%)) 
  9852.  result$=
  9853. (Sum(R%,J%))
  9854. 'T        
  9855. selected(pselectW%,R%*7-5+J%) 
  9856. justify(result$,N%,N%-1):f%(J%)=1
  9857.       
  9858. )@      
  9859. heap_store(lineanchor%,LenLine%,0,pos%,0,
  9860. tab(F$,N%))
  9861. +=    
  9862.  f%(J%)=1 
  9863. list_line(-1,lineanchor%,pos%-base%,32)
  9864. (f%())>0 
  9865. rule_off(45)
  9866. margin_warn
  9867.  f%,F%,R%,J%
  9868. fnum(
  9869. Form$,2))
  9870.  chartype%(F%) 
  9871.  3,6,46,47,54,56,57:
  9872.   R%=calcrow%?F%
  9873.  J%=0 
  9874. 8.    
  9875. selected(pselectW%,R%*5-J%) 
  9876.  f%=F%
  9877.  f%>0 
  9878.  Lmargin%<9 
  9879. softerror(" ("+Tag$(f%)+").",92):=-1
  9880. tab(F$,N%)
  9881. (F$)+
  9882. (spacer$)
  9883.  Tab%(N%)-Tab%(N%-1)-L%<=0 
  9884. =F$+spacer$
  9885. B,=F$+
  9886. Tab%(N%)-Tab%(N%-1)-L%," ")+spacer$
  9887. justify(f$,x%,x1%)
  9888. F$L%=Tab%(x%)-Tab%(x1%)-
  9889. (spacer$)
  9890. (f$)>L% 
  9891.   f$=
  9892. f$,L%)
  9893. (f$)," ")+f$
  9894. f$)="." 
  9895.  f$=" "+
  9896. execute_file(f$)
  9897.  F,P%,name$,command$,finished%,firstquery%,state%
  9898. confirm(
  9899. msg(68)) 
  9900. selected(printW%,39) 
  9901.  reportdest$="File" 
  9902.  reportdest$="Window"
  9903.  Script file signature
  9904. junk$=
  9905. abort_script:
  9906.  finished%)
  9907.  "OS_Byte",229,0
  9908.   line$=
  9909.   space%=
  9910. line$," ")
  9911.  space%=0 
  9912.  command$=line$:params$="" 
  9913.  command$=
  9914. line$,space%-1):params$=
  9915. line$,space%+1):state%=(params$="ON")
  9916.  command$ 
  9917.  "!COMMENT":
  9918.  "!SCRIPT":
  9919.     ImpCom$=""
  9920.  params$="END" 
  9921.       finished%=
  9922. b:      
  9923. execute_file($database%+".PrintRes."+params$)
  9924. c        
  9925.  "!DELETE":
  9926.  present%=7 
  9927.       RecF%=
  9928. g0      
  9929.  params$="" 
  9930.  key$=
  9931.  key$=params$
  9932. h5      
  9933. select(keypadW%,25):
  9934. deselect(keypadW%,24)
  9935. i       addr=
  9936. find(key$,0,0,
  9937.       
  9938.  RecF%=
  9939.         addr=
  9940. shift(0,0,0)
  9941. l$        addr=
  9942. moveto(key%,top,1)
  9943.       
  9944. n        
  9945.  "!INSERT":
  9946.  present%=7 
  9947.       subfile%=
  9948. (params$)
  9949. r)      
  9950. read(fields%,
  9951. ,RA%,$database%)
  9952.       
  9953.  loop%=1 
  9954.  fields%
  9955. t)        $Rf%(loop%)=
  9956. #F,len%(loop%))
  9957.       
  9958.       
  9959. write(fields%,key%)
  9960. w        
  9961.  "!QUERY":
  9962.  params$<>"" 
  9963.       P%=
  9964. params$,",")
  9965. {6      formula$=
  9966. params$,P%+1):name$=
  9967. params$,P%-1)
  9968. |0      f$=$database%+".PrintJobs."+
  9969. name$,10)
  9970. }$      Search$=
  9971. parse(formula$,
  9972. ~$      $
  9973. text(matchW%,0)=formula$
  9974. !      
  9975. redraw_icon(matchW%,0)
  9976.       
  9977.  "Hourglass_On"
  9978.       
  9979.  reportdest$ 
  9980. $        
  9981.  "Window":$SaveName%=f$
  9982. &        
  9983.  "File":texthandle%=
  9984.         
  9985.  ImpCom$<>"" 
  9986.           
  9987. -            
  9988.  firstquery%=
  9989. :firstquery%=
  9990. '            
  9991. #texthandle%,ImpCom$
  9992.           
  9993.         
  9994.       
  9995.       
  9996. do_it(Search$,-1)
  9997.         
  9998.  "!CSV":
  9999.     P%=
  10000. params$,",")
  10001. 4    formula$=
  10002. params$,P%+1):name$=
  10003. params$,P%-1)
  10004. .    f$=$database%+".PrintJobs."+
  10005. name$,10)
  10006. 6    
  10007. write_csv(f$,formula$,
  10008. selected(savesubW%,5))
  10009.  "!SELECTION":
  10010.  params$<>"" 
  10011. 3      filename$=$database%+".PrintRes."+params$
  10012. -      
  10013.  "OS_File",5,filename$ 
  10014.  ,,ftype%
  10015. #      ftype%=(ftype%>>8) 
  10016.  &FFF
  10017. 4      
  10018.  ftype%=&7F3 
  10019. load_selection(filename$)
  10020.       
  10021. clear_selection
  10022.         
  10023.  "!PRINTOPTS":
  10024.  params$<>"" 
  10025. 3      filename$=$database%+".PrintRes."+params$
  10026. -      
  10027.  "OS_File",5,filename$ 
  10028.  ,,ftype%
  10029. #      ftype%=(ftype%>>8) 
  10030.  &FFF
  10031. 2      
  10032.  ftype%=&7F5 
  10033. load_options(filename$)
  10034. <      
  10035. load_options("<Pbase$Dir>.Resources.PrintOpts")
  10036.         
  10037.  "!CASE":
  10038. B    
  10039. set_icon(matchW%,16,state%):
  10040. set_icon(savesubW%,5,state%)
  10041.  "!INDEX":
  10042. B    
  10043. set_icon(matchW%,23,state%):
  10044. set_icon(savesubW%,6,state%)
  10045. 0    
  10046.  "!EXPAND":
  10047. set_icon(printW%,11,state%)
  10048. .    
  10049.  "!DATE":
  10050. set_icon(printW%,19,state%)
  10051. /    
  10052.  "!UPPER":
  10053. set_icon(printW%,12,state%)
  10054. /    
  10055.  "!FIRST":
  10056. set_icon(printW%,10,state%)
  10057. 3    
  10058.  "!UNDERLINE":
  10059. set_icon(printW%,29,state%)
  10060. 0    
  10061.  "!SHRINK":
  10062. set_icon(printW%,40,state%)
  10063. -    
  10064.  "!TITLE":$
  10065. text(printW%,18)=params$
  10066. ,    
  10067.  "!PAGE":$
  10068. text(printW%,16)=params$
  10069. 1    
  10070.  "!LINESPACE":$
  10071. text(printW%,17)=params$
  10072. /    
  10073.  "!LMARGIN":$
  10074. text(printW%,30)=params$
  10075. /    
  10076.  "!TMARGIN":$
  10077. text(printW%,32)=params$
  10078. .    
  10079.  "!SPACER":$
  10080. text(printW%,43)=params$
  10081. 0    
  10082.  "!COLWIDTH":$
  10083. text(printW%,45)=params$
  10084.  "!HEADINGS":
  10085. u(params$) 
  10086. 7      
  10087.  "D":
  10088. select(printW%,2):
  10089. deselect(printW%,1)
  10090. 3      
  10091. select(printW%,1):
  10092. deselect(printW%,2)
  10093.         
  10094.  "!PITCH":
  10095. 3    
  10096. deselect(printW%,
  10097. selected_esg(printW%,2))
  10098. (params$) 
  10099.        
  10100. select(printW%,4)
  10101. !      
  10102. select(printW%,7)
  10103. !      
  10104. select(printW%,8)
  10105.       
  10106. select(printW%,6)
  10107.         
  10108.  "!FORMAT":
  10109. 3    
  10110. deselect(printW%,
  10111. selected_esg(printW%,3))
  10112. "    
  10113. icon_bit(22,printW%,15,
  10114. M    P%=
  10115. params$," "):
  10116.  P%>0 
  10117.  cols$=
  10118. params$,P%+1):params$=
  10119. params$,P%-1)
  10120.  params$ 
  10121. *      
  10122.  "VERTICAL":
  10123. select(printW%,24)
  10124. '      
  10125.  "TABLE":
  10126. select(printW%,25)
  10127. "      $
  10128. text(printW%,15)=cols$
  10129. $      
  10130. icon_bit(22,printW%,15,
  10131. '      
  10132.  "LABEL":
  10133. select(printW%,26)
  10134.       
  10135. select(printW%,23)
  10136.         
  10137.  "!DESTINATION":
  10138. 3    
  10139. deselect(printW%,
  10140. selected_esg(printW%,4))
  10141.  params$ 
  10142. 9      
  10143.  "FILE":
  10144. select(printW%,39):reportdest$="File"
  10145. ?      
  10146.  "PRINTER":
  10147. select(printW%,41):reportdest$="Printer"
  10148. #      
  10149.  "CSV":reportdest$="csv"
  10150. 4      
  10151. select(printW%,38):reportdest$="Window"
  10152.         
  10153.  "!LABEL":
  10154.     params$+=","
  10155.  I%=1 
  10156.       P%=
  10157. params$,",")
  10158. 4      par$=
  10159. params$,P%-1):params$=
  10160. params$,P%+1)
  10161.       
  10162.         
  10163. 7        
  10164. deselect(labelW%,
  10165. selected_esg(labelW%,1))
  10166.         
  10167.  par$ 
  10168. &          
  10169.  "1":
  10170. select(labelW%,0)
  10171. &          
  10172.  "2":
  10173. select(labelW%,1)
  10174. "          
  10175. select(labelW%,2)
  10176.         
  10177. &        
  10178. text(labelW%,4)=par$
  10179. &        
  10180. text(labelW%,6)=par$
  10181. '        
  10182. text(labelW%,10)=par$
  10183. '        
  10184. text(labelW%,12)=par$
  10185. ,        
  10186. set_icon(labelW%,11,(par$<>""))
  10187. :        
  10188. icon_bit(22,labelW%,12,
  10189. selected(labelW%,11))
  10190. 5        
  10191. set_icon(labelW%,13,(
  10192. u(par$)="ON"))
  10193. 5        
  10194. set_icon(labelW%,16,(
  10195. u(par$)="ON"))
  10196.       
  10197.  "!IMPRESSION":
  10198.     P%=
  10199. params$," ")
  10200.  P%>0 
  10201. 9      ImpCom$=
  10202. params$,P%-1):modifier$=
  10203. params$,P%+1)
  10204.       
  10205. u(modifier$) 
  10206. '        
  10207.  "NOT FIRST":firstquery%=
  10208.       
  10209.       
  10210.  ImpCom$=params$
  10211.         
  10212.         
  10213. softerror("",46)
  10214.     finished%=
  10215.  "Hourglass_Smash"
  10216. close_file(F)
  10217. abort_script
  10218. close_file(F)
  10219. softerror("",57)
  10220. wimp_error(
  10221.  "Impulse" handling -----------------------------------------------
  10222. Impulse_command(token%,params%,object%)
  10223. 4param$=
  10224. getstr(params%):object$=
  10225. getstr(object%)
  10226.  object$="" 
  10227.  object$=
  10228. leaf($database%)
  10229.  token% 
  10230.  ### GetPathname. Returns full pathname of object ###
  10231. leaf($database%) 
  10232.  object$:
  10233. <    
  10234.  "Impulse_SendMessage",&202,$database%,,,,,mytask%
  10235.  "No data":
  10236. D    
  10237.  "Impulse_SendMessage",&202,"No database open",,,,,mytask%
  10238. T    
  10239.  "Impulse_SendMessage",&202,"Current database is not "+object$,,,,,mytask%
  10240.  ### Selection. Returns maximum data length ###
  10241.   ClientSep$=
  10242. param$,1)
  10243. ?  ClientForm$=
  10244. find_fields(param$,ClientSep$,ClientLength%)
  10245. extend_named_sliding_block(transanchor%,ClientLength%+1)
  10246.  "Impulse_SendMessage",&202,
  10247. (ClientLength%),,,,,mytask%
  10248.  ### ParseQuery. Returns title generated by FNparse ###
  10249. $  ClientSearch$=
  10250. parse(param$,
  10251.  "Impulse_SendMessage",&202,Title$,,,,,mytask%
  10252.  ### GetRecord. Returns data specified in Selection according to criteria specified in ParseQuery ###
  10253. <  datalength%=
  10254. prepare_next_record(param$,!transanchor%)
  10255.  "Impulse_SendMessage",&202,"Ready to receive?",-1,,,transtag%,mytask%,Length%
  10256.  ### PutRecord ###
  10257.  "Impulse_SendMessage",&201,"GetRecord",,,,getrec%,mytask%
  10258.  ### ExpandCode ###
  10259.   P%=
  10260. param$," ")
  10261. %.  code$=
  10262. param$,P%-1):table$=
  10263. param$,P%+1)
  10264.  "Impulse_SendMessage",&202,
  10265. expand(code$,table$,L%,SF$),,,,,mytask%
  10266.  7,8:
  10267.  ### GetField, GetExpanded ###
  10268.  params%<>-1 
  10269. )D    datalength%=
  10270. prepare_next_field(token%,param$,!transanchor%)
  10271. *\    
  10272.  "Impulse_SendMessage",&202,"Ready to receive?",-1,,,transtag%,mytask%,datalength%
  10273. +2    
  10274.  Max. length for a Powerbase field is 246
  10275. Impulse_reply(replytag%,reply%)
  10276. abort_merge:
  10277. reply$=
  10278. getstr(reply%)
  10279.  replytag% 
  10280.  getrec%:
  10281.  ### Reply to GetRecord command. ###
  10282.  "Impulse_FetchData",!transanchor%,Length%,,,,,mytask%
  10283.  mergetag%:
  10284.  ### Merging application replies when all data in document merged ###
  10285. selected(mergeW%,6) 
  10286.  "Impulse_SendMessage",&201,":"+mergewith$+"."+document$+" Print",,,,printtag%,mytask%
  10287.  printtag%:
  10288.  ### Merging application has printed the current document ###
  10289.  "OS_Byte",229,0
  10290. >2  mergenum%+=1:$
  10291. text(mergeW%,14)=
  10292. (mergenum%)
  10293. redraw_icon(mergeW%,14)
  10294. selected(mergeW%,6) 
  10295.  ClientPtr%<>top 
  10296. A,    ClientPtr%=
  10297. merge_next(ClientPtr%,1)
  10298. deselect(mergeW%,6)
  10299. abort_merge
  10300. close_file(dbasehandle%)
  10301. ClientPtr%=top
  10302. deselect(mergeW%,6)
  10303. perform_close(mergeW%)
  10304. softerror("",27)
  10305. wimp_error(
  10306. Impulse_send(tag%,maxsize%)
  10307.  "Impulse_TransmitData",!transanchor%,datalength%,,,,,mytask%
  10308. datalength%=0
  10309. Impulse_receive(replytag%,expected%,received%)
  10310.  I%,F%,P%
  10311. transbuff%=!transanchor%
  10312. transbuff%?received%=13
  10313. data$=$transbuff%
  10314.  ### Acknowledge data received (get reason code 19 otherwise!) ###
  10315.  "Impulse_SendMessage",&202,,,,,replytag%,mytask%
  10316.  data$<>"" 
  10317.   P%=
  10318. data$,"#")
  10319.   REC%=
  10320. data$,P%-1))
  10321.   data$=
  10322. data$,P%+1)
  10323.  REC%=-1 
  10324.  REC%=RA%
  10325. read(fields%,REC%<>RA%,REC%,$database%)
  10326.  I%=1 
  10327. (ClientForm$) 
  10328. f$    F%=
  10329. fnum(
  10330. ClientForm$,I%,2))
  10331. g<    
  10332.  data$<>"" 
  10333.  $Rf%(F%)=
  10334. get_string(data$,ClientSep$)
  10335. write(fields%,key%)
  10336.  received%=0 
  10337.  "Impulse_SendMessage",&201,"GetRecord",,,,getrec%,mytask%
  10338. get_string(
  10339.  S$,sep$)
  10340.  P%,F$
  10341. S$,sep$)
  10342.  P%>0 
  10343.   F$=
  10344. S$,P%-1)
  10345.   S$=
  10346. S$,P%+1)
  10347. stripspaces(F$)
  10348. prepare_next_record(key$,transbuff%)
  10349.  ok%,I%,F%,P%
  10350.  dbasehandle%=0 
  10351. z,  dbasehandle%=
  10352. ($database%+".Database")
  10353. {'  ClientPtr%=
  10354. neighbour(key%,top,1)
  10355. P%=transbuff%
  10356.  key$ 
  10357.  "***":
  10358. close_file(dbasehandle%)
  10359.   $P%=key$:P%+=
  10360. ($P%)+1
  10361.  ok%=
  10362.  ClientPtr%<>top
  10363. (    REC%=
  10364. rec_no(k$,key%,ClientPtr%)
  10365. '    
  10366. readsmarray(dbasehandle%,REC%)
  10367. (ClientSearch$)=
  10368. $      $P%=
  10369. (REC%)+"#":P%+=
  10370. ($P%)
  10371. %      
  10372.  I%=1 
  10373. (ClientForm$) 
  10374. (        F%=
  10375. fnum(
  10376. ClientForm$,I%,2))
  10377. ,        $P%=F$(F%)+ClientSep$:P%+=
  10378. ($P%)
  10379.       
  10380.       $P%+=ClientSep$:P%+=1
  10381.       ok%=
  10382.         
  10383. 0    ClientPtr%=
  10384. neighbour(key%,ClientPtr%,1)
  10385.  P%=transbuff% 
  10386. close_file(dbasehandle%)
  10387. "  val$=
  10388. type(key%):kl%=
  10389. (key$)
  10390. %  ClientPtr%=
  10391. search(key$,key%,1)
  10392.  ClientPtr%>=0 
  10393. (    REC%=
  10394. rec_no(k$,key%,ClientPtr%)
  10395. '    
  10396. readsmarray(dbasehandle%,REC%)
  10397. "    $P%=
  10398. (REC%)+"#":P%+=
  10399. ($P%)
  10400. #    
  10401.  I%=1 
  10402. (ClientForm$) 
  10403. &      F%=
  10404. fnum(
  10405. ClientForm$,I%,2))
  10406. *      $P%=F$(F%)+ClientSep$:P%+=
  10407. ($P%)
  10408.     $P%+=ClientSep$:P%+=1
  10409. =P%-transbuff%
  10410. prepare_next_field(method%,S$,transbuff%)
  10411.  L%,F%,P%,len%,T$,F$,V%,R%,b$,k$,SF$
  10412.  token% 
  10413. &  F%=
  10414. field(S$,
  10415. ):V%=chartype%(F%)
  10416. C    
  10417.  0,1,2,3,4,5,6,7,8,46,47,48,49,50,51,52,53,54,55,56,57,58:
  10418.     L%=
  10419. (F$(F%))
  10420. D    
  10421. extend_named_sliding_block(transanchor%,(L%+4) 
  10422.  &FFFFFFFC)
  10423.      transbuff%=!transanchor%
  10424. *    $transbuff%=F$(F%):transbuff%?L%=0
  10425.  36,39:
  10426. &    R%=
  10427. rec_no(k$,key%,ClientPtr%)
  10428. /    L%=
  10429. blob_path(
  10430. ,$database%,R%,F%,V%,b$)
  10431.  L%>0 
  10432. F      
  10433. extend_named_sliding_block(transanchor%,(L%+4) 
  10434.  &FFFFFFFC)
  10435. "      transbuff%=!transanchor%
  10436. (      
  10437.  "OS_File",255,b$,transbuff%
  10438.       
  10439.  L%=1
  10440. 7      
  10441. extend_named_sliding_block(transanchor%,256)
  10442. "      transbuff%=!transanchor%
  10443.       ?transbuff%=0
  10444.         
  10445.     transbuff%?L%=0
  10446. +  P%=
  10447. S$," "):T$=
  10448. S$,P%+1):S$=
  10449. S$,P%-1)
  10450. 2  F%=
  10451. field(S$,
  10452. ):F$=
  10453. expand(F$(F%),T$,L%,SF$)
  10454. extend_named_sliding_block(transanchor%,L%+1)
  10455.   transbuff%=!transanchor%
  10456. 6  $transbuff%=F$:L%=
  10457. ($transbuff%):transbuff%?L%=0
  10458. len%=(L%+4) 
  10459.  &FFFFFFFC
  10460.     =len%
  10461. start_merge
  10462. Imp_wait%=
  10463. :merging%=
  10464. text(mergeW%,1)=document$
  10465.  common% 
  10466. text(mergeW%,3)=""
  10467. open_window(mergeW%)
  10468. set_caret(mergeW%,3)
  10469. merge_next(P%,D%)
  10470. D%=(D%+1) 
  10471. next_match(P%,D%,ClientSearch$)
  10472.  P%<>top 
  10473. ,  S$=F$(KF%(key%,0))+" "+F$(KF%(key%,1))
  10474. text(mergeW%,13)=
  10475. S$,80)
  10476. redraw_icon(mergeW%,13)
  10477.  "Impulse_SendMessage",&201,":"+mergewith$+"."+document$+" Merge",,,,mergetag%,mytask%
  10478.  End of "Impulse" handling -------------------------------------------
  10479.  Import/Export CSV files ---------------------------------------------
  10480. start_import(type$,wi%)
  10481.  present% 
  10482.  fields%=0 
  10483.  OK%=
  10484. softerror("",69)
  10485.  Modify% 
  10486.  OK%=
  10487. softerror("",14)
  10488. softerror("",69)
  10489.  OK% 
  10490. text(csvW%,13)=filename$
  10491. icon_bit(22,csvW%,0,
  10492. 4  !block%=csvW%:
  10493.  "Wimp_GetWindowState",,block%
  10494. )  block%!4=800:block%!12=block%!4+390
  10495. )  block%!8=150:block%!16=block%!8+716
  10496. (  $CSVTitle%="Import "+type$+" file"
  10497.  "Wimp_OpenWindow",,block%
  10498. set_caret(csvW%,13)
  10499. write_csv(Filename$,formula$,case%)
  10500.  writingcsv% 
  10501.  printorder$<>"" 
  10502.  Form$=printorder$ 
  10503. softerror("",34):
  10504.  P%,rec%,examined%,subtotal%
  10505. end_csv:
  10506. csvhandle%=
  10507. (Filename$)
  10508. selected(csvW%,1) 
  10509. csv_head
  10510. *dbasehandle%=
  10511. ($database%+".Database")
  10512. "Search$=
  10513. parse(formula$,case%)
  10514.  "Hourglass_On"
  10515.  usekey%=-1 
  10516. selected(savesubW%,6)=
  10517.   P%=
  10518. neighbour(key%,top,1)
  10519. scan_file("P%<>top",key%,3)
  10520. #  P%=
  10521. search(useval$,usekey%,1)
  10522.  P%>=0 
  10523.  k$=useval$:
  10524. scan_file("P%<>top AND k$=useval$",usekey%,3)
  10525.  "Hourglass_Off"
  10526. close_file(csvhandle%)
  10527. close_file(dbasehandle%)
  10528.  sep$="," 
  10529.  type%=&dfe 
  10530.  type%=&fff
  10531.  "OS_File",18,Filename$,type%
  10532. writingcsv%=
  10533. end_csv
  10534.  "Hourglass_Smash"
  10535. close_file(csvhandle%)
  10536. close_file(dbasehandle%)
  10537. close_file(F)
  10538.  "OS_File",18,Filename$,&dfe
  10539. writingcsv%=
  10540. softerror("",41)
  10541. wimp_error(
  10542. csv_head
  10543.  I%,F%,f$,H$,Head$,N%
  10544.     I%=-1
  10545. (Form$)-1
  10546. (  I%+=2:F%=
  10547. fnum(
  10548. Form$,I%,2)):N%+=1
  10549. selected(printW%,2) 
  10550.  Head$=$
  10551. text(mainW%,(desc%(F%))) 
  10552.  Head$=Tag$(F%)
  10553. selected(csvW%,4) 
  10554.  Head$=
  10555. (len%(F%))+"
  10556. "+Head$+"
  10557. (chartype%(F%))
  10558.  chartype%(F%)<>3 
  10559.  chartype%(F%)<>6 
  10560. selected(csvW%,0) 
  10561.  Head$=""""+Head$+""""
  10562.  N%>1 
  10563.  Head$=sep$+Head$
  10564. #csvhandle%,Head$;
  10565. #csvhandle%,term$;
  10566. write_csv_rec(R%)
  10567.  I%,F%,f$,F$,L%,N%,filename$,len%,base%,SF$
  10568. selected(csvW%,3) 
  10569.   F$=
  10570. key2(0,1)
  10571.  ),  
  10572. selected(csvW%,0) 
  10573.  F$=""""+F$+""""
  10574. #csvhandle%,F$+sep$;
  10575. I%=-1:L%=
  10576. (Form$)-1
  10577.  I%<L%
  10578.  ."  I%+=2:F%=
  10579. fnum(
  10580. Form$,I%,2))
  10581.  chartype%(F%) 
  10582.  36,39:
  10583.  1,    len%=
  10584. load_blob($database%,R%,F%,36)
  10585.  2'    
  10586.  len%>0 
  10587. selected(csvW%,2) 
  10588.  3+      N%+=1:
  10589.  N%>1 
  10590. #csvhandle%,sep$;
  10591.  43      
  10592. selected(csvW%,0) 
  10593. #csvhandle%,"""";
  10594.  5(      
  10595. blob_to_file(csvhandle%,len%)
  10596.  63      
  10597. selected(csvW%,0) 
  10598. #csvhandle%,"""";
  10599.  7        
  10600.  3,6,46,47,54,56,57:
  10601.     F$=F$(F%):N%+=1
  10602.  :'    
  10603.  F$<>"" 
  10604. selected(csvW%,2) 
  10605.       
  10606.  N%>1 
  10607.  F$=sep$+F$
  10608.       
  10609. #csvhandle%,F$;
  10610.  =        
  10611.  41,42,43,44,45:
  10612.       F$=F$(F%):N%+=1
  10613.       Z%=
  10614. no_yes(F%,n$,y$)
  10615.  A"      
  10616.  F$=" " 
  10617.  F$=y$ 
  10618.  F$=n$
  10619.  B0      
  10620. selected(csvW%,0) 
  10621.  F$=""""+F$+""""
  10622.       
  10623.  N%>1 
  10624.  F$=sep$+F$
  10625.       
  10626. #csvhandle%,F$;
  10627.  F!    
  10628. selected(printW%,11) 
  10629.  G/      F$=
  10630. expand(F$(F%),link$(F%),Len%,SF$)
  10631.       
  10632.  F$=F$(F%)
  10633.  I        
  10634.     N%+=1
  10635.  K'    
  10636.  F$<>"" 
  10637. selected(csvW%,2) 
  10638.  L0      
  10639. selected(csvW%,0) 
  10640.  F$=""""+F$+""""
  10641.       
  10642.  N%>1 
  10643.  F$=sep$+F$
  10644.       
  10645. #csvhandle%,F$;
  10646.  O        
  10647. #csvhandle%,term$;
  10648. convert_csv(f$)
  10649.  k$,B%,J%,fld%,csvhandle%,toobighandle%,S$,sep%,sep2%,term%,term2%,F$,avail%,nextfree%,keybase%,base%,base2%,show%,done%
  10650. stop_reading:
  10651. size%=&100:inc%=size%
  10652. extend_named_sliding_block(tempanchor%,size%)
  10653.  [:sep%=
  10654. (sep$):
  10655. (sep$)=2 
  10656.  sep2%=
  10657. sep$)) 
  10658.  sep2%=255
  10659.  \@term%=
  10660. (term$):
  10661. (term$)=2 
  10662.  term2%=
  10663. term$)) 
  10664.  term2%=255
  10665. csvhandle%=
  10666.  present%=0 
  10667. csv_to_dbase(f$)
  10668. Form$=
  10669. csv_importform
  10670.  `3toobighandle%=
  10671. ($database%+".PrintJobs.TooBig")
  10672.  "Hourglass_On"
  10673. selected(csvW%,3):
  10674. read_bytes
  10675.  f,    addr=
  10676. find(
  10677. $base%,KL%(key%)),0,1,
  10678.  g"    REC%=
  10679. rec_no(k$,key%,addr)
  10680.  h(    
  10681. read(fields%,
  10682. ,REC%,$database%)
  10683.  j3    keybase%=!keyanchor%(0):nextfree%=!keybase%
  10684.  k$    
  10685.  !(keybase%+nextfree%)<=0 
  10686.       incr%=
  10687. ($Increment%)
  10688.       
  10689.  incr%>0 
  10690.  n'        
  10691. change_length(RA%+incr%,
  10692.  o"        
  10693.  moan_err%,
  10694. msg(66)
  10695.       
  10696.  q        
  10697.  r-    REC%=!(keybase%+nextfree%+8+KL%(0)+1)
  10698.  s'    
  10699. read(fields%,
  10700. ,RA%,$database%)
  10701.   endline%=
  10702. :J%=-1
  10703.  v#  
  10704. (Form$)-2 
  10705.  endline%=
  10706.  w&    J%+=2:fld%=
  10707. fnum(
  10708. Form$,J%,2))
  10709.  x!    
  10710. transfer_csv_field(fld%)
  10711.  z2  
  10712.  fld%<=fields% 
  10713.  endline% 
  10714. next_csv_rec
  10715. write(fields%,key%)
  10716.  }-  
  10717. selected(csvW%,11) 
  10718. redraw(mainW%)
  10719.  ~?  
  10720.  "Hourglass_Percentage",
  10721. #csvhandle%*100 
  10722. #csvhandle%
  10723.  "OS_Byte",229,0
  10724. #csvhandle%
  10725.  "Hourglass_Off"
  10726. close_file(csvhandle%)
  10727. close_file(toobighandle%)
  10728. scrap_sliding_block(tempanchor%)
  10729.  "OS_File",18,$database%+".PrintJobs.TooBig",&fff
  10730. addr=
  10731. moveto(key%,top,1)
  10732. clear_selection
  10733. close_window(csvW%)
  10734. write_log(-1,"CSV data imported from "+f$)
  10735. transfer_csv_field(
  10736.  fld%)
  10737.  chartype%(fld%) 
  10738.  36,39:
  10739. read_bytes
  10740.  ptr%>0 
  10741. 3    Z%=
  10742. blob_path(
  10743. ,$database%,REC%,fld%,36,F$)
  10744. $    Start%=base%:End%=base%+ptr%
  10745. "    
  10746. save(F$,&fff,Start%,End%)
  10747. selected(csvW%,11) 
  10748.       
  10749.  chartype%(fld%) 
  10750. <        
  10751. set_blob_sprite(REC%,fld%,chartype%(fld%))
  10752. '        
  10753. show_text_block(fld%)
  10754.       
  10755.         
  10756.  41,42,43,44,45:
  10757. read_bytes:c$=$base%
  10758. W    
  10759. *YESyesYes",c$)>0 
  10760.  c$<>""):$Rf%(fld%)=" ":
  10761. select(mainW%,field%(fld%))
  10762. M    
  10763. "NnXxNOnoNo-",c$)>0):$Rf%(fld%)="":
  10764. deselect(mainW%,field%(fld%))
  10765. #toobighandle%,"Rec."+
  10766. (REC%)+",Fld."+
  10767. (fld%)+","+$base%+" unsuitable data for check-box":$Rf%(fld%)="":
  10768. deselect(mainW%,field%(fld%))
  10769.  0,1,2,3,4,5,6,7,8,46,47,48,49,50,51,52,53,54,55,56,57:
  10770.  len%(fld%)>0 
  10771. read_bytes
  10772. ;    
  10773. selected(csvW%,16) 
  10774.  $base%=
  10775. stripspaces($base%)
  10776. .      
  10777.  ptr%<=len%(fld%):$Rf%(fld%)=$base%
  10778.       
  10779.  ptr%<247:
  10780. C      
  10781. #toobighandle%,"Rec."+
  10782. (REC%)+",Fld."+
  10783. (fld%)+","+$base%
  10784.       $Rf%(fld%)="@"
  10785.       
  10786.       
  10787. #toobighandle%,"Rec."+
  10788. (REC%+1)+",Fld."+
  10789. (fld%)+" is more than 246 characters long. Data not saved. External field suggested."
  10790.       $Rf%(fld%)="@"
  10791.         
  10792.  fld%+=1
  10793. 8    
  10794.  ### Zero-length field is probably just a label
  10795. :fld%+=1
  10796.  ### Can't put CSV data into Button, Sprite or Draw fields! ###
  10797. read_bytes
  10798.  end$,flag%,B%,nq%
  10799. base%=!tempanchor%:ptr%=-1
  10800. #csvhandle%
  10801.  B%=34 
  10802.   flag%=
  10803. :nq%=1
  10804. c  end$="(base%?(ptr%-1)=34 AND (nq% MOD 2)=0) AND (B%=sep% OR B%=term% OR EOF#csvhandle%=TRUE)"
  10805. #csvhandle%=
  10806. #csvhandle%-1
  10807. 7  end$="B%=sep% OR B%=term% OR EOF#csvhandle%=TRUE"
  10808. +  B%=
  10809. #csvhandle%:ptr%+=1:base%?ptr%=B%
  10810.  B%=34 
  10811.  nq%+=1
  10812.  ptr%=size% 
  10813.  size%+=inc%:
  10814. extend_named_sliding_block(tempanchor%,size%)
  10815. (end$)
  10816.  flag% 
  10817.  ptr%-=1
  10818. base%?ptr%=13
  10819.  sep%:
  10820. skip_sep
  10821.  term%:
  10822. skip_term
  10823. next_csv_rec
  10824.   B%=
  10825. #csvhandle%
  10826.  B%=term%
  10827. skip_term
  10828. skip_sep
  10829.  sep2%<>255 
  10830.   B%=
  10831. #csvhandle%
  10832.  B%<>sep2% 
  10833. #csvhandle%=
  10834. #csvhandle%-1
  10835. skip_term
  10836.  term2%<>255 
  10837.   B%=
  10838. #csvhandle%
  10839.  B%<>term2% 
  10840. #csvhandle%=
  10841. #csvhandle%-1 
  10842.  endline%=
  10843.  endline%=
  10844. stop_reading
  10845.  "Hourglass_Off"
  10846. close_file(csvhandle%):
  10847. close_file(toobighandle%)
  10848.  "OS_File",18,$database%+".PrintJobs.TooBig",&fff
  10849. scrap_sliding_block(tempanchor%)
  10850. *block%!8=0:block%!12=csvW%:block%!16=9
  10851.  "Interface_SlabButton",,block%
  10852.  =17 
  10853. softerror("",74)
  10854. wimp_error(
  10855.  present%=7 
  10856.   addr=
  10857. moveto(key%,top,1)
  10858. clear_selection
  10859. csv_importform
  10860.  F%,f$,F$
  10861. endline%=
  10862. selected(csvW%,1):
  10863.  ### Use header record to build form ###
  10864. read_bytes
  10865.     F%=
  10866. field($base%,
  10867. %    
  10868.  F%=0 
  10869.  moan_err%,
  10870. msg(87)
  10871.     f$=
  10872. ~(F%)
  10873. (f$)=1 
  10874.  f$="0"+f$
  10875.     F$+=f$
  10876. "    
  10877. invert(mainW%,field%(F%))
  10878.  endline%
  10879.  printorder$<>"":
  10880.  ### Build form from highlighted fields, as in printing ###
  10881.   F$=printorder$
  10882. !    B  
  10883.  ### Assume entry into all fields, beginning with first ###
  10884.  F%=1 
  10885.  fields%
  10886.     f$=
  10887. ~(F%)
  10888. (f$)=1 
  10889.  f$="0"+f$
  10890.     F$+=f$
  10891. csv_to_dbase(f$)
  10892.  F%,P%,Q%,FH%,S$,readpos%
  10893. selected(csvW%,4) 
  10894. selected(csvW%,1)) 
  10895.  moan_err%,
  10896. msg(88)
  10897. read_bytes:S$=$base%:
  10898. #csvhandle%=0
  10899. ")=0 
  10900.  moan_err%,
  10901. msg(89)
  10902. leaf$=
  10903. leaf(f$):csvconv%=
  10904.  $database%="No data" 
  10905.  $database%=dbasepath$+".!"+leaf$
  10906. save($database%,0,0,0)
  10907. fields%=0:endline%=
  10908.   fields%+=1
  10909. read_bytes:S$=$base%
  10910. "  P%=
  10911. "):Q%=
  10912. ",P%+1)
  10913. %  Tag$(fields%)=
  10914. S$,P%+1,Q%-P%-1)
  10915. !    len%(fields%)=
  10916. S$,P%-1))
  10917. !!%  chartype%(fields%)=
  10918. S$,Q%+1))
  10919.  endline%
  10920. scrap_sliding_block(tempanchor%)
  10921. ($database%+".Form")
  10922. #FH%,fields%
  10923.  F%=1 
  10924.  fields%
  10925.   xd%=16:xf%=96
  10926.   yd%=-(F%*52):yf%=yd%
  10927. !)H  
  10928. #FH%,Tag$(F%),Tag$(F%),xd%,yd%,xf%,yf%,len%(F%),chartype%(F%),0,0
  10929. close_file(FH%)
  10930.  "OS_File",18,$database%+".Form",&7f2
  10931. fields%=0:Fieldnumber%=0
  10932. fields%=
  10933. get_form(Fptr%)
  10934. default_key
  10935. readpos%=
  10936. #csvhandle%
  10937. no_of_recs
  10938. defaults($database%,RA%,0)
  10939. save_keys
  10940. deselect(csvW%,1)
  10941. create_named_sliding_block(tempanchor%,size%)
  10942. csvhandle%=
  10943. #csvhandle%=readpos%
  10944. no_of_recs
  10945.  N%,B%
  10946. #csvhandle%
  10947.  B%=term% 
  10948. #csvhandle%
  10949.   N%+=1
  10950. !@?  
  10951.  "Hourglass_Percentage",
  10952. #csvhandle%*100 
  10953. #csvhandle%
  10954. #csvhandle%
  10955.  --- SLIDING HEAP 2.00 PROCEDURES
  10956.  requires SlidingHeap 2.00
  10957.  module and PROCs
  10958.  Steven Haslam 1992
  10959. _heap_slotsize
  10960.  "Wimp_SlotSize",-1,-1 
  10961. _heap_numtostr(d%,n%)=
  10962. d%,"0")+
  10963. ~n%,d%)
  10964. _heap_snumtostr(d%,n%)=
  10965. d%," ")+
  10966. n%,d%)
  10967. heapsinfo
  10968.  "OS_Heap",1,fixedheapbase% 
  10969.  ,,bigbloc%,totfree%
  10970.  "Fixed heap"
  10971.  "----- ----"
  10972.  "Heap base    : &";
  10973. _heap_numtostr(8,fixedheapbase%)
  10974.  "Heap size    : ";
  10975. _heap_bytes2(fixedheapsize%)
  10976.  "Largest free : ";
  10977. _heap_bytes2(bigbloc%)
  10978.  "Total free   : ";
  10979. _heap_bytes2(totfree%)
  10980.  "Sliding heap"
  10981.  "------- ----"
  10982.  "SlidingHeap_HeapInfo",slidingheapbase%
  10983. _heap_pageup(n%)
  10984.  "OS_ReadMemMapInfo" 
  10985. =(n%+R0%-1) 
  10986.  (R0%-1)
  10987. initheaps(heapsize%,slidingblocks%)
  10988. fixedheapsize%=heapsize%
  10989. !hLheap_trigger%=
  10990. _heap_pageup(
  10991. +fixedheapsize%+20+20*slidingblocks%-&8000)
  10992. setslotsize(heap_trigger%)
  10993. _heap_slotsize<heap_trigger% 
  10994.  130,"Unable to initialise heap"
  10995. fixedheapbase%=
  10996. !l%slidingheapbase%=
  10997. +fixedheapsize%
  10998.  "OS_Heap",0,fixedheapbase%,,fixedheapsize%
  10999.  "SlidingHeap_Create",slidingheapbase%,2,slidingblocks%
  11000.  "SlidingHeap_VerifyHeap",slidingheapbase%
  11001. _heap_nextfree
  11002.  nextfree%
  11003.  "SlidingHeap_NextFree",slidingheapbase% 
  11004.  nextfree%
  11005. =nextfree%
  11006. destroyheaps
  11007. setslotsize(
  11008. -&8000)
  11009. _heap_wordup(x%)=(x%+3) 
  11010. create_anchor(name$)
  11011.  space%
  11012.  space% 4+
  11013. name$+1
  11014. !space%=0
  11015. $(space%+4)=name$
  11016. =space%
  11017. create_named_sliding_block(anchor%,size%)
  11018.  trysize%
  11019. size%=
  11020. _heap_wordup(size%)
  11021. 7trysize%=
  11022. _heap_pageup(
  11023. _heap_nextfree+size%-&7FF4)
  11024.  trysize%>heap_trigger% 
  11025. setslotsize(trysize%)
  11026. _heap_slotsize<trysize% 
  11027. %      
  11028. setslotsize(heap_trigger%)
  11029. F      
  11030.  131,"Not enough room to create block """+$(anchor%+4)+""""
  11031.        heap_trigger%=trysize%
  11032.  "SlidingHeap_NewBlock",slidingheapbase%,anchor%,size%,anchor%+4
  11033.  "SlidingHeap_VerifyHeap",slidingheapbase%
  11034. scrap_sliding_block(anchor%)
  11035.  !anchor%=0 
  11036.  "SlidingHeap_ScrapBlock",slidingheapbase%,anchor%
  11037. 1trysize%=
  11038. _heap_pageup(
  11039. _heap_nextfree-&7FFC)
  11040.  trysize%<>heap_trigger% 
  11041. setslotsize(trysize%)
  11042.    heap_trigger%=trysize%
  11043. !anchor%=0
  11044.  "SlidingHeap_VerifyHeap",slidingheapbase%
  11045. setslotsize(newsize%)
  11046.  "Wimp_SlotSize",newsize%,-1
  11047. extend_named_sliding_block(anchor%,newsize%)
  11048.  !anchor%=0 
  11049. create_named_sliding_block(anchor%,newsize%):
  11050.  !anchor%>
  11051. _heap_nextfree 
  11052.  129,"Block beyond heap limits"
  11053. $newsize%=
  11054. _heap_wordup(newsize%)
  11055.  "SlidingHeap_DescribeBlock",slidingheapbase%,anchor% 
  11056.  ,,oldsize%
  11057. larger%=newsize%>oldsize%
  11058.  larger% 
  11059. H   trysize%=
  11060. _heap_pageup(
  11061. _heap_nextfree+(newsize%-oldsize%)-&7FFC)
  11062.  trysize%>heap_trigger% 
  11063.        
  11064. setslotsize(trysize%)
  11065. &      
  11066. _heap_slotsize<trysize% 
  11067. (         
  11068. setslotsize(heap_trigger%)
  11069. @         
  11070.  132,"Not enough room to extend block #"+
  11071. ~anchor%
  11072.       
  11073. #         heap_trigger%=trysize%
  11074.       
  11075.  "SlidingHeap_ExtendBlock",slidingheapbase%,anchor%,newsize%
  11076. 1trysize%=
  11077. _heap_pageup(
  11078. _heap_nextfree-&7FFC)
  11079.  trysize%<>heap_trigger% 
  11080. setslotsize(trysize%)
  11081.    heap_trigger%=trysize%
  11082.  "SlidingHeap_VerifyHeap",slidingheapbase%
  11083. _heap_bytes(b%)
  11084.  end%
  11085.  "OS_ConvertFixedFileSize",b%,block%,block%+&100 
  11086.  ,end%
  11087. ?end%=13
  11088. =$block%
  11089. _heap_bytes2(b%)
  11090.  end%
  11091.  "OS_ConvertFileSize",b%,block%,block%+&100 
  11092.  ,end%
  11093. ?end%=13
  11094. =$block%
  11095. create_fixed_block(size%)
  11096.  pointer%,flag%
  11097.  "XOS_Heap",2,fixedheapbase%,,size% 
  11098.  ,,pointer%;flag%
  11099.  flag% 
  11100. extendfixedheap
  11101.  "XOS_Heap",2,fixedheapbase%,,size% 
  11102.  ,,pointer%;flag%
  11103. =pointer%
  11104. extendfixedheap
  11105.  nshb%,extend%,trysize%
  11106.  "OS_ReadMemMapInfo" 
  11107.  extend%
  11108. $trysize%=
  11109. _heap_slotsize+extend%
  11110. setslotsize(trysize%)
  11111. _heap_slotsize<trysize% 
  11112.  255,"No room to extend fixed heap"
  11113. "nshb%=slidingheapbase%+extend%
  11114.  "SlidingHeap_ShiftHeap",slidingheapbase%,nshb%
  11115.  "OS_Heap",5,fixedheapbase%,,extend%
  11116. fixedheapsize%+=extend%
  11117. slidingheapbase%=nshb%
  11118.  "SlidingHeap_VerifyHeap",slidingheapbase%
  11119.