home *** CD-ROM | disk | FTP | other *** search
/ The Datafile PD-CD 4 / DATAFILE_PDCD4.iso / utilities / utilsp / powerbase / !Powerbase / !RunImage (.txt) < prev    next >
Encoding:
RISC OS BBC BASIC V Source  |  1996-01-30  |  300.3 KB  |  13,841 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.     "version$="6.91a (30-Jan-1995)"
  7.  "OS_Byte",202,0,255 
  8.  ,kbdstatus%
  9.  fatal_err%=255:moan_err%=254
  10. present%=
  11. ,"L0 error: "+
  12. $+" during initialisation at line "+
  13. setup
  14.  buff%>endbuff% 
  15.  0,"No room for defs."
  16.  menu_ptr%>men_end% 
  17.  0,"No room for menus"
  18. wimp_error(
  19.  "OS_GetEnv" 
  20.  ComString$
  21. ComString$,"-database") 
  22. 4  File$=
  23. ComString$,
  24. ComString$,"-database")+10)
  25.  "OS_GSTrans",File$,
  26. 13),255 
  27.  ,File$,L%
  28.   File$=
  29. File$,L%)
  30. get_it_in(File$)
  31. icon_bit(22,passW%,17,
  32. wimp_error(
  33.  quit%
  34. close_down
  35.  "OS_Byte",229,1:
  36.  "OS_Byte",124
  37.  "Wimp_Poll",mask%,block% 
  38.  reason%
  39.  reason% 
  40.  autosave%>0 
  41.  Access%=
  42. check_save(
  43. ($Interval%)*6000)
  44.  Imp_wait% 
  45.  merging% 
  46. start_merge
  47.  flash%>0 
  48. flash(mainW%,field%(flash%))
  49. redraw(!block%)
  50. open_it(!block%)
  51. close_it(!block%)
  52. hourglass(
  53. hourglass(
  54. mouse(block%!0,block%!4,block%!8,block%!12,block%!16)
  55. end_drag(Start%,End%)
  56. process_key
  57. menu_select
  58. set_keyboard(!block%,block%!4)
  59.  17,18:
  60.  "Impulse_Decode",reason%,block%,,,,methodtable%,mytask% 
  61.  reason%,,,,,token%,params%,object%
  62.  reason%>=&200 
  63.  reason% 
  64. 7V      
  65.  &200,&201:
  66.  token%<>-1 
  67. Impulse_command_received(token%,params%,object%)
  68. 8/      
  69.  &202:
  70. Impulse_reply(token%,params%)
  71. 9.      
  72.  &203:
  73. Impulse_send(token%,object%)
  74. :9      
  75.  &204:
  76. Impulse_receive(token%,params%,object%)
  77. ;        
  78. message
  79. not_acknowledged
  80. hourglass(on%)
  81.  (indexing% 
  82.  printing%) 
  83.  !block%=keypadW% 
  84.  on% 
  85.  "Hourglass_On" 
  86.  "Hourglass_Off"
  87. flash(wi%,ic%)
  88.  time%
  89.  "OS_ReadMonotonicTime" 
  90.  time%
  91.  (time% 
  92.  50)=0 
  93. invert(wi%,ic%)
  94.  Shutdown routines ---------------------------------------------------
  95. close_down
  96. #0:$block%="TASK":
  97.  "Wimp_CloseDown",mytask%,!block%:
  98. ,"L0 error: "+
  99. $+" during closedown at line "+
  100.  "Hourglass_Smash"
  101.  "Impulse_CloseDown",mytask%
  102. $block%="TASK"
  103.  "Wimp_CloseDown",mytask%,!block%
  104.  "OS_Byte",202,kbdstatus%
  105.  "Hourglass_Smash"
  106.  present%=7 
  107. check_change
  108.  ramwarn% 
  109.  ram% 
  110. softerror("",63)
  111.  design% 
  112. save_form($database%+".Form")
  113.  altered% 
  114. save_everything:
  115. memory_usage
  116. auto_csv(
  117. close_files
  118. close_log("<Log$Dir>.Log")
  119. hide_windows
  120. delete_icons(mainW%,0)
  121. delete_icons(pselectW%,8)
  122. delete_icons(keypadW%,24)
  123. recover_memory
  124. init_vars
  125. get_preferences(prefsW%,"<Pbase$Dir>.Resources.Preference")
  126. select(prefsW%,36):
  127. deselect(prefsW%,35):
  128. icon_bit(22,prefsW%,35,
  129.  I%=0 
  130.  LastTable%
  131.   printrel$(I%)=""
  132.  tableW%(I%)>0 
  133.  !block%=tableW%(I%):
  134.  "Wimp_DeleteWindow",,block%
  135.   tableW%()=0:TabTitle%()=0
  136. tableW%()=0:TabTitle%()=0
  137. field$()=""
  138. $Password%=""
  139. present%=
  140. exit%=
  141. lit(menu%(0),1,
  142. lit(menu%(0),2,
  143. lit(menu%(0),3,
  144. lit(menu%(2),1,
  145. ):ptr%=menu%(2)+52:ptr%!4=-1
  146. lit(menu%(6),5,
  147. lit(menu%(6),6,
  148. lit(menu%(6),7,
  149. lit(menu%(1),7,
  150.  "OS_CLI","Unset Acl$Dir"
  151.  "OS_CLI","Unset Log$Dir"
  152. $dbase%="No data"
  153. $database%="No data"
  154. redraw_icon(-2,pbaseicon%)
  155. save_everything
  156.  Access% 
  157. save_links
  158. save_calcs
  159. save_subfilenames
  160. save_keys
  161. save_all_tables
  162. save_winpos
  163. refresh_dates
  164.   changed%=
  165. update_calcs(0)
  166. asterisk(
  167. delete_icons(wi%,ic%)
  168. !block%=wi%:block%!4=ic%
  169.  "Wimp_DeleteIcon",,block%
  170.   ic%+=1:block%!4=ic%
  171.  "Wimp_GetIconState",,block%
  172.  ((block%!24) 
  173.  (1<<23))>0
  174. close_files
  175. close_file(lk):link$()=""
  176. close_file(cl):calc$()=""
  177. close_file(dbasehandle%)
  178. close_file(csvhandle%)
  179. close_file(autocsvhandle%)
  180. close_file(texthandle%)
  181. close_file(text%)
  182. close_file(toobighandle%)
  183. close_file(F)
  184. close_file(FH%)
  185. close_file(V)
  186. close_file(
  187.  filehandle%)
  188.  filehandle%>0 
  189. #filehandle%
  190.   filehandle%=0
  191. recover_memory
  192. scrap_sliding_block(headanchor%)
  193. scrap_sliding_block(lineanchor%)
  194. scrap_sliding_block(textanchor%)
  195. scrap_sliding_block(formanchor%)
  196. scrap_sliding_block(selanchor%)
  197. scrap_sliding_block(tempanchor%)
  198. scrap_sliding_block(balanchor%)
  199. scrap_sliding_block(flaganchor%)
  200. scrap_sliding_block(transanchor%)
  201. scrap_sliding_block(sprsanchor%)
  202. scrap_sliding_block(recanchor%)
  203. scrap_sliding_block(saveanchor%)
  204. scrap_sliding_block(logoanchor%)
  205. scrap_sliding_block(fieldmenuanchor%)
  206. scrap_sliding_block(usermenuanchor%)
  207. scrap_sliding_block(tablemenuanchor%)
  208.  I%=0 
  209.  MaxTabs%
  210. scrap_sliding_block(tabanchor%(I%))
  211. scrap_sliding_block(undoanchor%(I%))
  212.  I%=0 
  213.  MaxKeys%+1
  214. scrap_sliding_block(keyanchor%(I%))
  215.  I%=1 
  216.  fields%
  217.  chartype%(I%)=40 
  218. scrap_sliding_block(Rf%(I%))
  219.  Error handling ------------------------------------------------------
  220. wimp_error(return%,err%,erl%,err$)
  221.  type%,result%
  222. close_down:
  223. ,"L0 error: "+
  224. $+" during error handler at line "+
  225.  "Wimp_CommandWindow",-1
  226. block%!0=err%
  227.  return% 
  228.  err%<>fatal_err% 
  229.  err%=moan_err% 
  230. ;      type%=17:
  231.  OK button and no "Error from" in title
  232. )      type%=3:
  233.  OK and Cancel buttons
  234. A      err$+=" @ "+
  235. (erl%)+" (OK to continue, Cancel to quit)"
  236.    type%=2:
  237.  Cancel buttom
  238. ;   err$+=" @ "+
  239. (erl%)+" (Powerbase must quit at once)"
  240. $(block%+4)=err$+
  241.  "Wimp_ReportError",block%,type%,"Powerbase" 
  242.  ,result%
  243.  result=1 means OK selected, 2 means Cancel selected
  244.  result%=2 
  245. close_down
  246. softerror(E$,E%)
  247. M$="Err"+
  248.  E$<>"" 
  249.  M$+=","+E$
  250. $(block%+4)=
  251. msg(M$)
  252. !block%=255
  253.  "Wimp_ReportError",block%,17,"Message from Powerbase"
  254.  ### Use MessageTrans to display a message from the Messages file ###
  255. msg(token$)
  256.  result$,msgparams$,P%,Q%,p%
  257. param$()="":
  258. token$,",")
  259.  P%>0 
  260. "  msgparams$=
  261. token$,P%+1)+","
  262.   token$=
  263. token$,P%-1)
  264.   P%=0
  265.     Q%=P%+1
  266.     P%=
  267. msgparams$,",",Q%)
  268.  P%>0 
  269. *      param$(p%)=
  270. msgparams$,Q%,P%-Q%)
  271.       p%+=1
  272.         
  273.  P%=0
  274.  "MessageTrans_Lookup",filedesc%,token$,msgbuff%,&100,param$(0),param$(1),param$(2),param$(3) 
  275.  ,,result$
  276. =result$
  277. asterisk(on%)
  278.  on% 
  279. :$RecInfo%+=" *":ramwarn%=
  280. $RecInfo%)="*" 
  281.  $RecInfo%=
  282. $RecInfo%))
  283. altered%=on%
  284. E!block%=mainW%:
  285.  "Wimp_GetWindowOutline",,block%:ymax%=block%!16
  286.  "Wimp_GetWindowState",,block%
  287.  "Wimp_ForceRedraw",-1,block%!4,block%!16,block%!12,ymax%
  288.  Program initialisation ----------------------------------------------
  289. setup
  290.  F,A%,I%,J%,V%,valid$
  291. ("<Pbase$Dir>.Resources.Config")
  292. MaxFields%=
  293.  MaxFields%>127 
  294.  fatal_err%,
  295. msg("Err61")
  296. MaxKeys%=
  297. MaxTabs%=
  298. #F)-1
  299. MaxMenus%=
  300. #F)-1
  301. MaxCols%=
  302. #F)-1
  303. $2S$=
  304. #F:P%=
  305. S$," "):leftmenu%=(
  306. S$,P%-1)="YES")
  307. winback%=
  308. uc%=(
  309. #F,3)="YES")
  310. close_file(F)
  311. dim_arrays(MaxFields%+1,MaxKeys%,MaxTabs%,MaxMenus%,MaxCols%)
  312. load_fkeys("Fkeys")
  313. init_vars
  314.  ------------------ Initialise Wimp ----------------------------
  315. $block%="TASK"
  316. mask%=(1<<11)
  317.  "Wimp_Initialise",200,!block%,"Powerbase" 
  318.  version%,mytask%
  319.  version%<316 
  320.  0,"This version of Powerbase is only suitable for RISC OS 3. Contact Powerbase Support for a RISC OS 2-compatible version."
  321.  "Impulse_Initialise",003,mytask%,"Powerbase",-1
  322. 1Mpbaseicon%=
  323. create_icon(-1,0,-16,144,110,&1700312B,"",dbase%,psprite%,10)
  324.  --------- Set up Heap Manager. Load error messages -----------
  325. initheaps(128,128)
  326. 4'f$="<PBase$Dir>.Resources.Messages"
  327.  "MessageTrans_FileInfo",,f$ 
  328.  flags%,,len%
  329. 6'errormsg%=
  330. create_fixed_block(len%)
  331.  "OS_Module",6,,,17+
  332. (f$) 
  333.  ,,filedesc%
  334. $(filedesc%+16)=f$
  335.  "MessageTrans_OpenFile",filedesc%,filedesc%+16,errormsg%
  336. getscreensize(ScreenWidth%,ScreenHeight%,Vpix%)
  337.  Vpix%>=480 
  338.  f$="Sprites22" 
  339.  f$="Sprites"
  340.  "OS_File",5,"<PBase$Dir>.Resources."+f$ 
  341.  ,,,,len%
  342. =(sprites%=
  343. create_fixed_block(len%+4)
  344. !sprites%=len%+4
  345.  "OS_File",255,"<PBase$Dir>.Resources."+f$,sprites%+4
  346. @)headanchor%=
  347. create_anchor("Heading")
  348. A*lineanchor%=
  349. create_anchor("TextLine")
  350. B&textanchor%=
  351. create_anchor("Text")
  352. C&formanchor%=
  353. create_anchor("Form")
  354. D.sprsanchor%=
  355. create_anchor("DbaseSprites")
  356. E&tempanchor%=
  357. create_anchor("Temp")
  358. F(balanchor%=
  359. create_anchor("Balance")
  360. G'flaganchor%=
  361. create_anchor("Flags")
  362. H/transanchor%=
  363. create_anchor("DataTransfer")
  364. I)selanchor%=
  365. create_anchor("PrintSel")
  366. J*recanchor%=
  367. create_anchor("RecordNum")
  368. K,saveanchor%=
  369. create_anchor("SaveBuffer")
  370. L&logoanchor%=
  371. create_anchor("Logo")
  372. M0fieldmenuanchor%=
  373. create_anchor("FieldMenu")
  374. N/usermenuanchor%=
  375. create_anchor("FieldMenu")
  376. O0tablemenuanchor%=
  377. create_anchor("TableMenu")
  378.  I%=0 
  379.  MaxKeys%+1
  380. Q3   keyanchor%(I%)=
  381. create_anchor("Key #"+
  382. (I%))
  383.  I%=0 
  384.  MaxTabs%
  385. T6   tabanchor%(I%)=
  386. create_anchor("VTable #"+
  387. (I%))
  388. U;   undoanchor%(I%)=
  389. create_anchor("UndoVTable #"+
  390. (I%))
  391.  --------------- Read validation strings etc -----------------------
  392. ("<Pbase$Dir>.Resources.ValStrings")
  393. vstrings%=
  394.  vname$(vstrings%),valid%(vstrings%),rvalid%(vstrings%),hvalid%(vstrings%)
  395.  I%=0 
  396.  vstrings%
  397.   vname$(I%)=
  398. #V,4)
  399.   valid$=
  400. (valid$)+1:$V%=valid$:valid%(I%)=V%
  401. (valid$)+1:$V%=valid$:rvalid%(I%)=V%
  402. (valid$)+16:$V%=valid$+";Pptr_hand,12,8":hvalid%(I%)=V%
  403. close_file(V)
  404.  ---------------------------------------------------------------
  405.  Method structure
  406.  PASS=0 
  407. P%=methodtable%
  408.   [OPT PASS
  409.         equd    0
  410. i)        
  411. method(0,1,"GetPathname","")
  412. j'        
  413. method(0,2,"Selection","")
  414. k(        
  415. method(0,3,"ParseQuery","")
  416. l'        
  417. method(0,4,"GetRecord","")
  418. m'        
  419. method(0,5,"PutRecord","")
  420. n(        
  421. method(0,6,"ExpandCode","")
  422. o&        
  423. method(0,7,"GetField","")
  424. p)        
  425. method(0,8,"GetExpanded","")
  426. q'        
  427. method(0,9,"NextMatch","")
  428. r         
  429. method(-1,-1,"","")
  430.  PASS
  431. create_windows
  432. make_menus
  433. get_preferences(prefsW%,"<Pbase$Dir>.Resources.Preference")
  434. select(prefsW%,36):
  435. deselect(prefsW%,35):
  436. icon_bit(22,prefsW%,35,
  437. get_csv_options("<Pbase$Dir>.Resources.CSVoptions")
  438. select(csvW%,19):
  439. deselect(csvW%,18)
  440. scroll_icons(MaxCols%)
  441. usermenu%()=0
  442. method(Flags,Token,Method$,Syntax$)
  443. [OPT PASS
  444.         equd    Flags
  445.         equd    Token
  446.          equs    Method$+
  447.          equs    Syntax$+
  448.         align
  449.     =PASS
  450. dim_arrays(F%,K%,T%,M%,C%)
  451.  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%)
  452.  Date%(5),Index$(K%+1),KL%(K%+1),KW%(K%+1,3),KF%(K%+1,3),keyfield%(3),key$(K%+1),case%(K%+1),incspace%(K%+1),null%(K%+1),WD%(3),Ext%(10)
  453.  usermenu%(M%,1)
  454.  Label$(10,3)
  455.  Sum(30,5)
  456.  key 256,date% 6,calcrow% F%
  457.  menu%(23),choice$(4)
  458.  table$(T%+1),tableW%(T%),TabTitle%(T%)
  459.  tabfieldlen%(C%),rel%(C%),tabhead$(C%,1)
  460.  fcol%(8),ncol%(8)
  461.  Subfile%(5),filemem%(5)
  462.  buttonfield%(1,23),actionbutt%(5,1),winbuff%(4,1)
  463. MC%=30:
  464.  L%(MC%)
  465.  -------------------- Allocate buffers ------------------------------
  466. (indirectionmem%=&5000:menumem%=&1400
  467.  Mi% 20,Mo% 20
  468.  block% &1C00,paneblock% &600,savebuff% &200,choices% &100,remember% &B00
  469.  buffbase% indirectionmem%:endbuff%=buffbase%+indirectionmem%:buff%=buffbase%
  470.  menblk% menumem%:men_end%=menblk%+menumem%:menu_ptr%=menblk%
  471.  msgbuff% &100,param$(3),att$(3)
  472.  hand% 16:$hand%="Pptr_hand,12,8"
  473.  paint% 8:$paint%="file_ff9"
  474.  writep% 16:$writep%="Pptr_write,4,4"
  475.  writenum% 20:$writenum%="Pptr_write,4,4;A0-9"
  476.  tick% 12:$tick%="Snull,yes"
  477.  dbase% 10:$dbase%="No data"
  478.  psprite% 15:$psprite%="S!Powerbase"
  479.  menspr% 20,mentxt% 1:$menspr%="Sgright,pgright;R5":$mentxt%=""
  480.  winspr% 20,wintxt% 1:$winspr%="R5;Swindow":$wintxt%=""
  481.  methodtable% 256
  482.  ------------- Indirection addresses for Heap Manager ---------------
  483.  keyanchor%(K%+1)
  484.  tabanchor%(T%),undoanchor%(T%)
  485.  printrel$(T%)
  486.  box% 16,box2% 16,matrix% 16,origin% 8
  487. init_vars
  488. /caps%=16:filemem%()=-1:dragbutt%=0:direc%=1
  489. +firstsearch%=
  490. :firstfilter%=
  491. :sorted%=
  492. 1getrec%=213:ClientSearch$="TRUE":ClientPtr%=0
  493. NImp_wait%=
  494. :Impref%=-1:merging%=
  495. :mergenum%=0:document$="":importingcsv%=
  496. -mergetag%=214:transtag%=215:printtag%=216
  497. 8flash%=
  498. :logosloaded%=
  499. :logging%=
  500. :acl%=
  501. :up_pend%=
  502. Gaccessbutton%=0:stop%=
  503. :customise%=
  504. :tablemenu%=0:undo%=
  505. :filter%=
  506. &displayed%=-1:scratchpad$="":k$=""
  507. ZSearch$="TRUE":Filter$="TRUE":query$="ALL":SearchKey$="":REC%=-1:usekey%=-1:useval$=""
  508. areal$="":visible$="":reform$="":val$="":calcfield%=0:savefunc$="":savetofile%=
  509. :writetable%=
  510. ?password$="":pw%=0:myref%=-1:Type%=0:fieldtype%=1:Length%=0
  511. 3printing%=
  512. :indexing%=
  513. :not%=
  514. :dontincrement%=
  515. $export%=
  516. :csvconv%=
  517. :OLE_edit%=0
  518. 'autosave%=0:autobalance%=
  519. :added%=0
  520. .present%=0:fields%=0:template%=0:adjust%=
  521. 7Listed%=
  522. :writingcsv%=
  523. :writingtext%=
  524. :calcerror%=
  525. lk=0:cl=0:V=0:F=0:FH%=0:dbasehandle%=0:csvhandle%=0:autocsvhandle%=0:texthandle%=0:text%=0:toobighandle%=0:loghandle%=0:handle%=0
  526. $date%=
  527. "movetype%=8:movetype$="Move 
  528. vquit%=
  529. :exit%=
  530. :matching%=
  531. :newrec%=
  532. :val%=
  533. :ram%=
  534. :Access%=
  535. :Modify%=
  536. :ramwarn%=
  537. :altered%=
  538. :design%=
  539. :newtree%=
  540. /LenLine%=0:Count%=0:Start%=0:End%=0:Fptr%=0
  541. <Fieldnumber%=0:Lastwritable%=0:starthere%=-1:calclink%=0
  542. ALastTable%=-1:Tablenumber%=0:TabsLoaded$="Tables":table$()=""
  543. 5Rows%=0:TabFields%=0:Rec%=0:Match_tag%=1:fast%=10
  544. WKeys%=0:keylimit%=1:keylen%=1:LH%=90:addr=-1:file%=0:key%=0:top=8*file%+LH%:RA%=100
  545. +keyfunc$="":fieldfunc$="":Keys%=0:RU%=0
  546. Eprintorder$="":Form$="":ImpCom$="":margin$="":pitch$=
  547. (31)+"9001"
  548. uon$=
  549. (27)+
  550. (%10001000)
  551. 9Filename$="":TextName$="":extrakeys$="":extratabs$=""
  552. 2months$="JanFebMarAprMayJunJulAugSepOctNovDec"
  553.  Window handling -----------------------------------------------------
  554. create_windows
  555.  "Wimp_OpenTemplate",,"<Pbase$Dir>.Resources.Templates"
  556. 'infoW%=
  557. new_window("info",sprites%)
  558. text(infoW%,7)=version$
  559. <keypadW%=
  560. new_window("keypad",sprites%):Title%=block%!72
  561. zsavesubW%=
  562. new_window("savesub",sprites%):SubName%=
  563. text(savesubW%,2):SubSprite%=
  564. val(savesubW%,0):SubTitle%=block%!72
  565. UsaveW%=
  566. new_window("save",1):SaveName%=
  567. text(saveW%,2):SaveSprite%=
  568. val(saveW%,0)
  569. xaccessW%=
  570. new_window("access",sprites%):UserID%=
  571. text(accessW%,0):Password%=
  572. text(accessW%,1):AccessTitle%=block%!72
  573. qpassW%=
  574. new_window("password",sprites%):Read%=
  575. text(passW%,2):Write%=
  576. text(passW%,3):Manager%=
  577. text(passW%,5)
  578. (aclW%=
  579. new_window("aclist",sprites%)
  580. :mainW%=
  581. new_window("main",sprites%):RecInfo%=block%!72
  582. >keyW%=
  583. new_window("keystruc",sprites%):KeyTitle%=block%!72
  584. BchangeW%=
  585. new_window("change",sprites%):ChangeTitle%=block%!72
  586. 'moveW%=
  587. new_window("move",sprites%)
  588. NtabcreateW%=
  589. new_window("tabcreate",sprites%):tabcol%=
  590. text(tabcreateW%,8)
  591. $scrollW%=
  592. new_window("scroll",0)
  593. linkW%=
  594. new_window("link",sprites%):LinkTitle%=block%!72:Tablename%=
  595. text(linkW%,0):fieldnum%=
  596. text(linkW%,2):substitute%=
  597. text(linkW%,10)
  598. VmiscW%=
  599. new_window("misc",sprites%):database%=
  600. text(miscW%,1):$database%="No data"
  601.  ic%=2 
  602. $  Date%(ic%-2)=
  603. text(miscW%,ic%)
  604.  ic%=28 
  605. (  Subfile%(ic%-28)=
  606. text(miscW%,ic%)
  607. Oused%=
  608. text(miscW%,17):filesize%=
  609. text(miscW%,18):percent%=
  610. text(miscW%,14)
  611. )printW%=
  612. new_window("print",sprites%)
  613. ;matchW%=
  614. new_window("match",sprites%):oldquery%=matchW%
  615. 'listW%=
  616. new_window("list",sprites%)
  617. XcreateW%=
  618. new_window("create",sprites%):FtitleText%=block%!72:$FtitleText%="Field 0"
  619. DescText%=
  620. text(createW%,4):TagText%=
  621. text(createW%,5):LenText%=
  622. text(createW%,6):ValText%=
  623. text(createW%,28):InsText%=
  624. text(createW%,26):Fixpt%=
  625. text(createW%,13):$Fixpt%="2"
  626. ;mintext%=
  627. text(createW%,15):maxtext%=
  628. text(createW%,25)
  629. dboxX%=
  630. text(createW%,7):boxY%=
  631. text(createW%,8):boxW%=
  632. text(createW%,9):boxH%=
  633. text(createW%,10)
  634. grid%=
  635. text(createW%,48)
  636. ArelateW%=
  637. new_window("relation",sprites%):RelTitle%=block%!72
  638. @reformW%=
  639. new_window("reform",sprites%):RefmTitle%=block%!72
  640. &colW%=
  641. new_window("cols",sprites%)
  642. VcalcW%=
  643. new_window("calc",sprites%):CalcForm%=
  644. text(calcW%,0):CalcTitle%=block%!72
  645. )labelW%=
  646. new_window("label",sprites%)
  647. -pselectW%=
  648. new_window("pselect",sprites%)
  649. GmergeW%=
  650. new_window("merge",sprites%):ImpulseApp%=
  651. text(mergeW%,14)
  652. PsizeW%=
  653. new_window("size",sprites%):Records%=
  654. text(sizeW%,1):$Records%="100"
  655. /Increment%=
  656. text(sizeW%,3):$Increment%="25"
  657. =csvW%=
  658. new_window("csvfile",sprites%):CSVTitle%=block%!72
  659. <fkeyW%=
  660. new_window("fkey",sprites%):FkeyTitle%=block%!72
  661. 7Kpadicon%=
  662. val(fkeyW%,0):Fkeyequiv%=
  663. text(fkeyW%,3)
  664. )prefsW%=
  665. new_window("prefs",sprites%)
  666. 7datesep%=
  667. text(prefsW%,1):timesep%=
  668. text(prefsW%,4)
  669. .wc%=
  670. text(prefsW%,7):ws%=
  671. text(prefsW%,10)
  672.  mergewith%=
  673. text(prefsW%,17)
  674. 8Interval%=
  675. text(prefsW%,25):Every%=
  676. text(prefsW%,32)
  677. )queryW%=
  678. new_window("query",sprites%)
  679. Query%=
  680. text(queryW%,0)
  681. 'helpW%=
  682. new_window("help",sprites%)
  683. +filterW%=
  684. new_window("filter",sprites%)
  685. +searchW%=
  686. new_window("search",sprites%)
  687.  "Wimp_CloseTemplate"
  688. Pactionbutt%()=matchW%,0,mergeW%,6,moveW%,7,changeW%,3,filterW%,0,savesubW%,1
  689. Gwinbuff%()=csvW%,0,passW%,500,labelW%,900,printW%,1150,prefsW%,1900
  690. scroll_icons(rows%)
  691.  I%=0 
  692.  rows%
  693.   iflags%=&0700E735
  694. W  R%=
  695. create_icon(scrollW%,4,-I%*44-52,64,48,iflags%,"",buff%,writenum%,4):buff%+=4
  696.   iflags%=&0700E535
  697. Y  R%=
  698. create_icon(scrollW%,66,-I%*44-52,212,48,iflags%,"",buff%,writep%,13):buff%+=13
  699. #!block%=0:block%!4=-rows%*44-56
  700. block%!8=284:block%!12=0
  701.  "Wimp_SetExtent",scrollW%,block%
  702. new_window(name$,sp%)
  703.  handle%
  704.  "Wimp_LoadTemplate",,block%,buff%,endbuff%,-1,name$,0 
  705.  ,,buff%
  706.  name$="main" 
  707.  block%?35=winback%
  708. block%!64=sp%
  709.  "Wimp_CreateWindow",,block% 
  710.  handle%
  711. =handle%
  712. show_windows
  713. open_window(mainW%)
  714.  (present% 
  715.  7)=7 
  716. selected(passW%,9) 
  717. open_window(keypadW%)
  718.  filemem%(file%)>=0 
  719. selected (prefsW%,43) 
  720. '0    addr=filemem%(file%):
  721. display(key%,addr)
  722. ("    
  723.  addr=
  724. moveto(key%,top,1)
  725.  Listed% 
  726. open_window(listW%)
  727. store_window(wi%,buff%)
  728.  ic%,ptr%
  729. 0'!block%=wi%:block%!4=ic%:ptr%=buff%
  730.  "Wimp_GetIconState",,block%
  731.  ((block%!24) 
  732.  (1<<23))=0
  733.   !ptr%=block%!24:ptr%+=4
  734.  ((block%?25) 
  735.  1)>0 
  736.  $ptr%=$
  737. text(wi%,ic%):ptr%+=
  738. ($ptr%)+1
  739. 5%  !block%=wi%:ic%+=1:block%!4=ic%
  740.  "Wimp_GetIconState",,block%
  741. restore_window(wi%,buff%)
  742.  ic%,ptr%
  743. <'!block%=wi%:block%!4=ic%:ptr%=buff%
  744.  "Wimp_GetIconState",,block%
  745.  ((block%!24) 
  746.  (1<<23))=0
  747. ?I  !block%=wi%:block%!4=ic%:block%!8=!ptr%:block%!12=&ffffffff:ptr%+=4
  748.  "Wimp_SetIconState",,block%
  749.  ((block%?25) 
  750.  1)>0 
  751. text(wi%,ic%)=$ptr%:ptr%+=
  752. ($ptr%)+1
  753. B%  !block%=wi%:ic%+=1:block%!4=ic%
  754.  "Wimp_GetIconState",,block%
  755. open_window(wi%)
  756. block%!0=wi%
  757.  "Wimp_GetWindowState",,block%
  758. block%!28=-1
  759. open_it(wi%)
  760. open_it(wi%)
  761.  win%
  762.  wi% 
  763.  tabcreateW%:
  764. update_pane(scrollW%,16,160,284,232,0,0)
  765.  matchW%:
  766. update_pane(queryW%,8,8,466,140,0,0):
  767.  changeW%:
  768. update_pane(queryW%,18,202,466,140,0,0)
  769.  moveW%:
  770. update_pane(queryW%,18,240,466,140,0,0)
  771.  savesubW%:
  772. update_pane(queryW%,10,40,466,140,0,0):
  773. redraw_icon(wi%,0)
  774.  mergeW%:
  775. update_pane(queryW%,24,184,466,140,0,0)
  776.  filterW%:
  777. update_pane(queryW%,8,52,466,140,0,0)
  778.  "Wimp_OpenWindow",,block%
  779.  win%=0 
  780.  winbuff%(win%,0)=wi% 
  781. store_window(wi%,remember%+winbuff%(win%,1))
  782.  win%
  783. close_it(wi%)
  784.  wi% 
  785.  mainW%:
  786. hide_windows:stop%=
  787.  matchW%:matching%=
  788. close_window(queryW%)
  789.  calcW%:calclink%=0
  790.  keyW%:design%=
  791. :newtree%=
  792.  mergeW%:
  793.  "Impulse_SendMessage",&200,":"+$mergewith%+"."+document$+" Edit On",,,,-1,mytask%
  794. g'  merging%=
  795. close_window(queryW%)
  796.  tabcreateW%:
  797. close_window(scrollW%)
  798.  changeW%,moveW%,savesubW%,filterW%:
  799. close_window(queryW%)
  800. close_window(wi%)
  801.  T%=0 
  802.  LastTable%
  803.  wi%=tableW%(T%) 
  804. set_caret(mainW%,starthere%)
  805. hide_windows
  806. close_window(queryW%)
  807. close_window(keypadW%)
  808.  I%=0 
  809.  LastTable%
  810.  tableW%(I%)>0 
  811. close_window(tableW%(I%))
  812. close_window(listW%)
  813. close_window(matchW%)
  814. close_window(relateW%)
  815. close_window(keyW%)
  816. close_window(reformW%)
  817. close_window(calcW%)
  818. close_window(mergeW%)
  819. close_window(csvW%)
  820. close_window(passW%)
  821. close_window(aclW%)
  822. close_window(tabcreateW%)
  823. close_window(prefsW%)
  824. close_window(printW%)
  825. close_window(linkW%)
  826. close_window(changeW%)
  827. close_window(savesubW%)
  828. close_window(moveW%)
  829. close_window(searchW%)
  830. close_window(filterW%)
  831. close_window(helpW%)
  832. close_window(mainW%)
  833. filemem%(file%)=addr
  834. close_window(wi%)
  835. !block%=wi%
  836.  "Wimp_CloseWindow",,block%
  837. shut_window(wi%)
  838.  "Wimp_TransferBlock",mytask%,block%,mytask%,paneblock%,88
  839.  wi%=filterW% 
  840. filter_click(filterW%,1,4) 
  841. close_it(wi%)
  842.  "Wimp_TransferBlock",mytask%,paneblock%,mytask%,block%,88
  843. redraw(handle%)
  844. (margin$)
  845. !block%=handle%
  846.  "Wimp_RedrawWindow",,block% 
  847.  more%
  848. get_origin(block%,x0%,y0%)
  849.  more%
  850. draw(x0%,y0%)
  851.  "Wimp_GetRectangle",,block% 
  852.  more%
  853. get_origin(block%,
  854.  x0%,
  855.  y0%)
  856. x0%=block%!4-block%!20
  857. y0%=block%!16-block%!24
  858. draw(x0%,y0%)
  859.  TextPtr%,y1%,y2%,I%,chars%
  860.  handle% 
  861.  listW%
  862.   y1%=-(block%!40-y0%)
  863.   y2%=-(block%!32-y0%)
  864.   y1%=y1% 
  865.  36+1
  866.   y2%=y2% 
  867.  36+1
  868. .  TextPtr%=(!textanchor%)+(y1%-1)*LenLine%
  869.  y2%>Count% 
  870.  y2%=Count%
  871.  I%=y1% 
  872. draw_line(I%)
  873.     TextPtr%+=LenLine%
  874. draw_line(Line%)
  875.  x0%,y0%-(Line%-1)*36-4
  876.  TextPtr%?L%=12 
  877.  "OS_WriteN",TextPtr%,LenLine%
  878. update_pane(wi%,x%,y%,w%,h%,xs%,ys%)
  879. newquery%=!block%
  880.  newquery%<>oldquery% 
  881. shut_window(oldquery%):oldquery%=newquery%
  882. 8!paneblock%=wi%:
  883.  "Wimp_GetWindowState",,paneblock%
  884. paneblock%!4=block%!4+x%
  885. !paneblock%!12=paneblock%!4+w%
  886. paneblock%!16=block%!16-y%
  887. !paneblock%!8=paneblock%!16-h%
  888. 'paneblock%!20=xs%:paneblock%!24=ys%
  889. "paneblock%!28=-1:block%!28=wi%
  890.  "Wimp_OpenWindow",,paneblock%
  891.  "Wimp_OpenWindow",,block%
  892.  up_pend% 
  893.  up_pend%=
  894.  "Wimp_GetWindowState",,block%
  895.  (block%!32 
  896.  (1<<18)) 
  897.  up_pend%=
  898. update_pane(wi%,x%,y%,w%,h%,xs%,ys%)
  899.  Menu handling -------------------------------------------------------
  900. make_menus
  901. menu%(10)=
  902. create_menu(menu_ptr%,280,"Field,Index field...,Analyse months,Global changes...,Link to table...,Combine fields...,Start editing,Remove external,Save contents>"+
  903. (saveW%)+",Undo changes")
  904. Omenic%=menu%(10)+28+(1*24):AnalyseFunc%=menic%!12:menic%!16=-1:menic%!20=14
  905. Lmenic%=menu%(10)+28+(4*24):CalcFunc%=menic%!12:menic%!16=-1:menic%!20=14
  906. emenu%(2)=
  907. create_menu(menu_ptr%,265,"Validation,Create table...,~Display table,Show table files")
  908. Amenu%(5)=
  909. create_menu(menu_ptr%,180,"Name subfile,"+
  910. 20,"0"))
  911. qmenic%=menu%(5)+28:Subfilename%=menic%!12:menic%!16=-1:menic%!20=21:?menic%=?menic% 
  912.  (1<<2):$Subfilename%=""
  913. menu%(7)=
  914. create_menu(menu_ptr%,280,"Misc.,Move/delete...,Set passwords...,Colours!"+
  915. (colW%)+",Edit template,Name subfile>"+
  916. (menu%(5)))
  917. Nmenu%(15)=
  918. create_menu(menu_ptr%,90,"Separator,Comma,TAB,CR,LF,"+
  919. 13,"0"))
  920. lmenic%=menu%(15)+28+(4*24):Delim%=menic%!12:menic%!16=-1:menic%!20=3:?menic%=?menic% 
  921.  (1<<2):$Delim%=""
  922. ]menu%(20)=
  923. create_menu(menu_ptr%,90,"Terminator,CR,LF,LF CR,CR LF,CR CR,LF LF,"+
  924. 13,"0"))
  925. nmenic%=menu%(20)+28+(6*24):Termin%=menic%!12:menic%!16=-1:menic%!20=3:?menic%=?menic% 
  926.  (1<<2):$Termin%=""
  927. string$="Print,Match...,Show resources,Show jobs done,Options...,Save query!"+
  928. (saveW%)+",~Numeric fields>"+
  929. (pselectW%)+",~Save selection!"+
  930. (saveW%)+",~Clear selection"
  931. >menu%(6)=
  932. create_menu(menu_ptr%,260,string$+",Select all")
  933. zstring$="Powerbase,Information!"+
  934. (miscW%)+",Field: ''>"+
  935. (menu%(10))+",Print>"+
  936. (menu%(6))+",Validation>"+
  937. (menu%(2))
  938. string2$=",Current key...,Miscellaneous>"+
  939. (menu%(7))+",Show keypad,~Export selected!"+
  940. (saveW%)+",Export subset...,Export CSV...,CSV options...,Undo changes,Help"
  941. 9menu%(1)=
  942. create_menu(menu_ptr%,248,string$+string2$)
  943. #Fieldpos%=menu%(1)+28+(1*24)+12
  944. Kmenu%(4)=
  945. create_menu(menu_ptr%,200,"Print index,Totals only,Complete")
  946. menu%(3)=
  947. create_menu(menu_ptr%,300,"Utilities,New primary key...,Adjust format,New record format,Merge database,~Change length>"+
  948. (sizeW%)+",Balance index,Print index>"+
  949. (menu%(4))+",Find duplicates")
  950. menu%(0)=
  951. create_menu(menu_ptr%,266,"\Powerbase,_Information>"+
  952. (infoW%)+",New database!"+
  953. (saveW%)+",~Utilities>"+
  954. (menu%(3))+",~Close database,Preferences...,_Help,Quit")
  955. menu%(9)=
  956. create_menu(menu_ptr%,270,"New database,Design field...,~_Default database,~Save form file!"+
  957. (saveW%)+",~Database size>"+
  958. (sizeW%)+",~Primary key...,~Quit design")
  959. menu%(17)=
  960. create_menu(menu_ptr%,240,"Table,Clear,Save!"+
  961. (saveW%)+",Print,"+
  962. 15,"0")+",Undo change,Undo all,Save as CSV!"+
  963. (saveW%)+",Modify")
  964. bmenic%=menu%(17)+28+(3*24):SortTabCol%=menic%!12:menic%!16=-1:menic%!20=14:$SortTabCol%="Sort"
  965. [menu%(18)=
  966. create_menu(menu_ptr%,250,"List,Save as text!"+
  967. (saveW%)+",Sort   '',Scrap")
  968. 'SortTextCol%=menu%(18)+28+(1*24)+12
  969. jmenu%(23)=
  970. create_menu(menu_ptr%,200,"Keystroke,Assign>"+
  971. (fkeyW%)+",Defaults,Save choices,List keys")
  972. menu$="Data"
  973.  I%=0 
  974.   menu$+=","+vname$(I%)
  975. Bmenu%(8)=
  976. create_menu(menu_ptr%,200,menu$):
  977. tick(menu%(8),1,
  978. menu$="External"
  979.  I%=36 
  980.   menu$+=","+vname$(I%)
  981. Dmenu%(11)=
  982. create_menu(menu_ptr%,180,menu$):
  983. tick(menu%(11),0,
  984. menu$="Check box"
  985.  I%=41 
  986.   menu$+=","+vname$(I%)
  987. Dmenu%(14)=
  988. create_menu(menu_ptr%,180,menu$):
  989. tick(menu%(14),0,
  990. menu$="Stamp"
  991.  I%=46 
  992.   menu$+=","+vname$(I%)
  993. Dmenu%(16)=
  994. create_menu(menu_ptr%,250,menu$):
  995. tick(menu%(16),0,
  996. menu$="Button"
  997.  I%=9 
  998.   menu$+=","+vname$(I%)
  999.     Dmenu%(19)=
  1000. create_menu(menu_ptr%,270,menu$):
  1001. tick(menu%(19),0,
  1002. ybar%=144+7*44
  1003. make_user_menus
  1004.  f$,F,items%,longest%,item$,menu$,field%,N%,I%,n$,user_ptr%,blocksize%,forbidden$
  1005. wimp_error(
  1006. forbidden$=" $&%@\^:.#*|"
  1007. extend_named_sliding_block(usermenuanchor%,4)
  1008. +user_ptr%=!usermenuanchor%:blocksize%=4
  1009.  field%=1 
  1010.  fields%
  1011.  chartype%(field%)=33 
  1012. C    
  1013.  N%>MaxMenus% 
  1014.  moan_err%,
  1015. msg("Err117,"+
  1016. (MaxMenus%+1))
  1017.     n$=Tag$(field%-1)
  1018.  I%=1 
  1019. #      P%=
  1020. forbidden$,
  1021. n$,I%,1))
  1022. !      
  1023.  P%>0 
  1024. n$,I%,1)="-" 
  1025. #    f$=$database%+"."+n$+"menu"
  1026.     F=
  1027. $    menu$="":longest%=0:items%=0
  1028.  F>0 
  1029.       
  1030.         item$=
  1031. "3        
  1032. (item$)>longest% 
  1033.  longest%=
  1034. (item$)
  1035.         menu$+=item$+","
  1036.         items%+=1
  1037.       
  1038.       
  1039. close_file(F)
  1040.       menu$=
  1041. menu$)
  1042.       
  1043. )}      menu$=Tag$(field%-1)+" menu,Place your,menu choices,in the file,"""+n$+"menu"",which is in,the database,directory,"
  1044. *6      items%=7:longest%=12:P%=1:Q%=1:menu$=
  1045. menu$)
  1046.       F=
  1047.       
  1048.  Q%>0
  1049.         Q%=
  1050. menu$,",",P%)
  1051. .         
  1052. menu$,P%,Q%-P%)
  1053.         P%=Q%+1
  1054.       
  1055.       
  1056. close_file(F)
  1057. 2!      
  1058.  "OS_File",18,f$,&fff
  1059. 3        
  1060. 4     usermenu%(N%,0)=field%-1
  1061. 5     blocksize%+=items%*41+30
  1062. 6?    
  1063. extend_named_sliding_block(usermenuanchor%,blocksize%)
  1064. 7E    usermenu%(N%,1)=
  1065. create_menu(user_ptr%,(longest%+1)*16,menu$)
  1066.     N%+=1
  1067.  field%
  1068. field_menu(N%)
  1069.  F%,P%,L%,D$,F$,icptr%,textptr%
  1070. extend_named_sliding_block(fieldmenuanchor%,N%*41+30)
  1071. A5icptr%=!fieldmenuanchor%:textptr%=icptr%+N%*24+28
  1072. $icptr%="Field list"
  1073. CZicptr%?12=7:icptr%?13=2:icptr%?14=7:icptr%?15=0:icptr%!16=270:icptr%!20=44:icptr%!24=0
  1074. icptr%+=28
  1075.  F%=1 
  1076. F"  F$=
  1077. (F%):F$=
  1078. (F$)," ")+F$
  1079. G7  D$=
  1080. text(mainW%,desc%(F%)),7):D$+=
  1081. (D$)," ")
  1082. H&  F$+=" "+D$+" "+Tag$(F%):L%=
  1083. I\  !icptr%=0:icptr%!4=-1:icptr%!8=&7000121:icptr%!12=textptr%:icptr%!16=-1:icptr%!20=L%+1
  1084. J!  $textptr%=F$:textptr%+=L%+1
  1085.   icptr%+=24
  1086. icptr%!-24=icptr%!-24 
  1087. =!fieldmenuanchor%
  1088. create_menu(
  1089.  menu%,width%,list$)
  1090.  start%,choice$,entries%,item%,P%,Q%,S%,shaded%
  1091. start%=menu%
  1092. list$,1)="\" 
  1093.  leftmenu%=
  1094.  list$=
  1095. list$,2)
  1096. list$,",")
  1097. $menu%=
  1098. list$,P%-1)
  1099. menu%?12=7:menu%?13=2
  1100. menu%?14=7:menu%?15=0
  1101. X*menu%!16=width%:menu%!20=44:menu%!24=0
  1102. item%=menu%+28
  1103. list$+=","
  1104. entries%=0
  1105.   Q%=P%+1
  1106.   P%=
  1107. list$,",",Q%)
  1108.  P%>0 
  1109.     !item%=0:shaded%=0
  1110. a     choice$=
  1111. list$,Q%,P%-Q%)
  1112. b?    
  1113. choice$,1)="~" 
  1114.  choice$=
  1115. choice$,2):shaded%=(1<<22)
  1116. cA    
  1117. choice$,1)="_" 
  1118.  choice$=
  1119. choice$,2):?item%=?item% 
  1120.     S%=
  1121. choice$,"!")
  1122. e5    
  1123.  S%>0 
  1124.  ?item%=?item% 
  1125. choice$,S%,1)=">"
  1126.     S%=
  1127. choice$,">")
  1128.  S%=0 
  1129.       item%!4=-1
  1130.       
  1131. j#      item%!4=
  1132. choice$,S%+1))
  1133. k       choice$=
  1134. choice$,S%-1)
  1135. l        
  1136. (choice$)<=12 
  1137.       $(item%+12)=choice$
  1138.       item%!8=&7000021
  1139.       
  1140.       L%=
  1141. (choice$)+1
  1142. rI      item%!12=buff%:$buff%=choice$:buff%+=L%:item%!16=-1:item%!20=L%
  1143.       item%!8=&7000121
  1144. t        
  1145. u!    item%!8=item%!8 
  1146.  shaded%
  1147.     item%+=24
  1148.     entries%+=1
  1149.  P%=0
  1150. item%!-24=item%!-24 
  1151. menu%=item%
  1152. =start%
  1153. tick(menu%,item%,on%)
  1154. item%=menu%+28+item%*24
  1155.  on% 
  1156. :?item%=?item% 
  1157. :?item%=?item% 
  1158. tick_one(menu%,first%,last%,item%)
  1159.  I%=first% 
  1160.  last%
  1161. tick(menu%,I%,(I%=item%))
  1162. ticked(menu%,item%)
  1163. item%=menu%+28+item%*24
  1164.  (?item% 
  1165. lit(menu%,item%,on%)
  1166. item%=menu%+28+item%*24
  1167.  on% 
  1168. : item%!8=item%!8 
  1169.  (1<<22)
  1170. : item%!8=item%!8 
  1171.  (1<<22)
  1172. lit(menu%,item%)
  1173. item%=menu%+28+item%*24
  1174. =((item%!8 
  1175.  (1<<22))=0)
  1176. show_menu(menu%,x%,y%)
  1177. )menuhandle%=menu%:menux%=x%:menuy%=y%
  1178.  "Wimp_CreateMenu",,menu%,x%,y%
  1179. show_user_menu(datafield%,x%,y%)
  1180.     N%=-1
  1181.   N%+=1
  1182.  usermenu%(N%,0)=datafield% 
  1183.  N%=MaxMenus%
  1184.  usermenu%(N%,0)=datafield% 
  1185. show_menu(usermenu%(N%,1),x%,y%)
  1186. softerror(
  1187. (MaxMenus%+1),117)
  1188.  Icon handling -------------------------------------------------------
  1189. create_icon(whandle%,xmin%,ymin%,width%,height%,iconflags%,text$,d1%,d2%,d3%)
  1190.  handle%
  1191. block%!0=whandle%
  1192. !block%!4=xmin%:block%!8=ymin%
  1193. 2block%!12=xmin%+width%:block%!16=ymin%+height%
  1194. block%!20=iconflags%
  1195.  d1%=0 
  1196.   $(block%+24)=text$
  1197.   block%!24=d1%
  1198.   block%!28=d2%
  1199.   block%!32=d3%
  1200.  "Wimp_CreateIcon",,block% 
  1201.  handle%
  1202. =handle%
  1203. redraw_icon(wi%,ic%)
  1204. !block%=wi%:block%!4=ic%
  1205. block%!8=0:block%!12=0
  1206.  "Wimp_SetIconState",,block%
  1207. *block%!8=0:block%!12=wi%:block%!16=ic%
  1208. icon_bit(bit%,wi%,ic%,on%)
  1209. !block%=wi%
  1210. block%!4=ic%
  1211.  on% 
  1212. :block%!8=0:block%!12=1<<bit%
  1213. :block%!8=1<<bit%:block%!12=1<<bit%
  1214.  "Wimp_SetIconState",,block%
  1215. select(wi%,ic%)
  1216. !block%=wi%:block%!4=ic%
  1217. "block%!8=1<<21:block%!12=1<<21
  1218.  "Wimp_SetIconState",,block%
  1219. deselect(wi%,ic%)
  1220. !block%=wi%:block%!4=ic%
  1221.  block%!8=0:block%!12=(1<<21)
  1222.  "Wimp_SetIconState",,block%
  1223. invert(wi%,ic%)
  1224. !block%=wi%:block%!4=ic%
  1225.  block%!8=(1<<21):block%!12=0
  1226.  "Wimp_SetIconState",,block%
  1227. set_icon(wi%,ic%,on%)
  1228.  on% 
  1229. select(wi%,ic%) 
  1230. deselect(wi%,ic%)
  1231. selected(wi%,ic%)
  1232. !block%=wi%:block%!4=ic%
  1233.  "Wimp_GetIconState",,block%
  1234. =((block%!24) 
  1235.  (1<<21))>0
  1236. shaded(wi%,ic%)
  1237. !block%=wi%:block%!4=ic%
  1238.  "Wimp_GetIconState",,block%
  1239. =((block%!24) 
  1240.  (1<<22))>0
  1241. selected_esg(wi%,esg%)
  1242.  "Wimp_WhichIcon",wi%,block%,&003F0000,&00200000+(esg%<<16)
  1243. =!block%
  1244. next_writable(wi%,ic%,d%,r%,wi2%,ic2%)
  1245.  P%,E%,next%
  1246.  "Wimp_WhichIcon",wi%,block%,&00C0E000,(14<<12)
  1247.   E%+=4
  1248.  block%!E%=-1
  1249.  block%!P%<>ic% 
  1250.  P%<E%
  1251.   P%+=4
  1252.  P%=E% 
  1253.  P%-=4
  1254.  r%=1 
  1255.  P%+4=E% 
  1256.  wi2%=0 
  1257.  r%=1 
  1258.  P%+4=E% 
  1259.  wi%=wi2%:next%=ic2%
  1260.  0:P%=E%
  1261.  2:P%=-4
  1262. :P%+=4*d%
  1263.  wi2%>0 
  1264.  wi%=wi2%:next%=ic2% 
  1265.  next%=!block%
  1266.  wi2%>0 
  1267.  wi%=wi2%:next%=ic2% 
  1268.  next%=block%!(E%-4)
  1269. :next%=block%!P%
  1270. set_caret(wi%,next%)
  1271. text(wi%,ic%)
  1272. !block%=wi%:block%!4=ic%
  1273.  "Wimp_GetIconState",,block%
  1274. =block%!28
  1275. val(wi%,ic%)
  1276. !block%=wi%:block%!4=ic%
  1277.  "Wimp_GetIconState",,block%
  1278. =block%!32
  1279. text_length(wi%,ic%)
  1280. !block%=wi%:block%!4=ic%
  1281.  "Wimp_GetIconState",,block%
  1282. ($(block%!28))
  1283. buffer_length(wi%,ic%)
  1284. !block%=wi%:block%!4=ic%
  1285.  "Wimp_GetIconState",,block%
  1286. =block%!36-1
  1287. set_caret(wi%,ic%)
  1288. "0!block%=wi%:
  1289.  "Wimp_GetWindowState",,block%
  1290.  ((block%?34) 
  1291.  1)=1 
  1292.  ic%=-1 
  1293. %*    
  1294.  "Wimp_SetCaretPosition",wi%,ic%
  1295. &        
  1296. 'G    
  1297.  "Wimp_SetCaretPosition",wi%,ic%,0,0,-1,
  1298. text_length(wi%,ic%)
  1299. alter_flags(dfg%,ffg%,bfg%)
  1300.  ic%,F%
  1301. !block%=mainW%
  1302.  ic%=0 
  1303.  fields%*2-1
  1304.   F%=(ic%+1) 
  1305. 11  block%!4=ic%:
  1306.  "Wimp_GetIconState",,block%
  1307.  (ic% 
  1308.  2)=1 
  1309.  chartype%(F%) 
  1310. 4U      
  1311.  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%
  1312. 5'      
  1313.  39:block%!8=ffg%:len%(F%)=0
  1314. 6B      
  1315.  logosloaded% 
  1316.  block%!8=&0000611E 
  1317.  block%!8=ffg%
  1318.       
  1319. :block%!8=bfg%
  1320. 8        
  1321.  block%!8=dfg%
  1322.   block%!12=&FFFFFFFF
  1323.  "Wimp_SetIconState",,block%
  1324. limit_actions(off%)
  1325. icon_bit(22,keypadW%,ic%,off%)
  1326.  buttonfield%(0,ic%)>0 
  1327. icon_bit(22,mainW%,field%(buttonfield%(0,ic%)),off%)
  1328.  ic%=-1
  1329. lit(menu%(10),0,off%)
  1330. lit(menu%(10),1,off%)
  1331. lit(menu%(10),2,off%)
  1332.  12,14,15,16,17,18,20,21,22,-1
  1333. identify_field(ic%)
  1334. R.Fieldnumber%=0:Fieldname$="":TextLength%=0
  1335.  (ic% 
  1336.  2)=1 
  1337. T!  !block%=mainW%:block%!4=ic%
  1338.  "Wimp_GetIconState",,block%
  1339.   TextLength%=block%!36-1
  1340.   Fieldnumber%=(ic%+1) 
  1341.  chartype%(Fieldnumber%)<=10 
  1342.  Lastwritable%=Fieldnumber%
  1343. Y3  Fieldname$=$
  1344. text(mainW%,desc%(Fieldnumber%))
  1345.  Fieldname$="" 
  1346.  Fieldname$=Tag$(Fieldnumber%)
  1347. selected(prefsW%,21) 
  1348. \$    
  1349.  chartype%(Fieldnumber%) 
  1350. ]/      
  1351.  Leave keyboard status unchanged
  1352. ^&      
  1353.  2,4:
  1354.  "OS_Byte",202,0,239
  1355. _#      
  1356.  "OS_Byte",202,16,111
  1357. `        
  1358.  "OS_Byte",118
  1359. first_field
  1360.  I%+=1
  1361.  (len%(I%)>0 
  1362.  chartype%(I%)<9) 
  1363.  I%>fields%
  1364.  I%>fields% 
  1365.  Mouse_click processing ----------------------------------------------
  1366. mouse(x%,y%,b%,wi%,ic%)
  1367. oldx%=x%:oldy%=y%
  1368. qCblock%!0=x%:block%!4=y%:block%!8=b%:block%!12=wi%:block%!16=ic%
  1369.  T%=0 
  1370.  LastTable%
  1371.  wi%=tableW%(T%) 
  1372.  Tablenumber%=T%
  1373.  wi% 
  1374. iconbar_click
  1375.  accessW%:accessbutton%=ic%
  1376.  aclW%:
  1377.  mainW%:
  1378. main_click(wi%,ic%,b%)
  1379.  keypadW%:
  1380. keypad_click(wi%,ic%,b%)
  1381.  saveW%,savesubW%:
  1382. save_click(wi%,ic%,b%)
  1383.  keyW%:
  1384. key_click(wi%,ic%,b%)
  1385.  tabcreateW%:
  1386. tabcreate_click(wi%,ic%,b%)
  1387.  scrollW%:
  1388. scroll_click
  1389.  linkW%:
  1390. link_to_table
  1391.  passW%:
  1392. passwords(x%,wi%,ic%,b%)
  1393.  printW%:
  1394. print_click(wi%,ic%,b%)
  1395.  matchW%:
  1396. match_click(wi%,ic%,b%)
  1397.  createW%:
  1398. create_click
  1399.  tableW%(Tablenumber%):
  1400. table_click(Tablenumber%)
  1401.  changeW%:
  1402. change_click(wi%,ic%,b%)
  1403.  moveW%:
  1404. move_click(wi%,ic%,b%)
  1405.  listW%:
  1406. list_click(x%,y%,b%,wi%)
  1407.  colW%:
  1408. set_colours(wi%,ic%,b%)
  1409.  calcW%:
  1410. calc_formula($CalcForm%)
  1411.  labelW%:
  1412. label_click(wi%,ic%,b%)
  1413.  mergeW%:
  1414. merge_click
  1415.  sizeW%:
  1416. size_click(wi%,ic%,b%)
  1417.  csvW%:
  1418. csv_click(wi%,ic%,b%)
  1419.  fkeyW%:
  1420. fkey_click(wi%,ic%,b%)
  1421.  prefsW%:
  1422. prefs_click(wi%,ic%,b%)
  1423.  queryW%:
  1424. query_click(wi%,ic%,b%)
  1425.  helpW%:
  1426. help_click(wi%,ic%,b%)
  1427.  reformW%:
  1428. reform_click(wi%,ic%,b%)
  1429.  filterW%:
  1430. filter_click(wi%,ic%,b%)
  1431.  searchW%:
  1432. search_click(wi%,ic%,b%)
  1433.  pselectW%,relateW%,infoW%,miscW%:
  1434.  ### No action on these ###
  1435. special_click
  1436. filter_click(wi%,ic%,b%)
  1437. b%=(b% 
  1438.  %111)
  1439.  ic% 
  1440. C    
  1441.  $Query%<>"" 
  1442.  Filter$=
  1443. parse:addr=
  1444. moveto(key%,top,1)
  1445. deselect(keypadW%,22)
  1446. F    ic%=field%(buttonfield%(0,22)):
  1447.  ic%>0 
  1448. deselect(mainW%,ic%)
  1449. *    
  1450. filter(keypadW%,
  1451. ):Filter$="TRUE"
  1452. 8    
  1453. close_it(wi%):
  1454. set_caret(mainW%,starthere%)
  1455. search_click(wi%,ic%,b%)
  1456.  searchkey%,index$,z%,addr2,oldaddr
  1457. oldaddr=addr
  1458. index$=$
  1459. text(wi%,3)
  1460.  index$<>Index$(searchkey%)
  1461.   searchkey%+=1
  1462. b%=(b% 
  1463.  %111)
  1464.  1,4:
  1465.  b%=4 
  1466.  z%=1 
  1467.  z%=-1
  1468.  ic% 
  1469. .    SearchKey$=
  1470. stripspaces($
  1471. text(wi%,1))
  1472. #    
  1473.  chartype%(KF%(key%,0)) 
  1474.       
  1475.  5,50,51:
  1476. G      
  1477. check_date(SearchKey$,1,date$)=
  1478. reverse_date(date$)
  1479.         
  1480. @    
  1481.  SearchKey$<>"" 
  1482.  addr=
  1483. find(SearchKey$,searchkey%,1,
  1484.  searchkey%<>key% 
  1485. ,      val$=
  1486. type(key%):kl%=
  1487. (key$(key%))
  1488. *      addr2=
  1489. search(key$(key%),key%,2)
  1490.       
  1491.  addr2<0 
  1492. /        
  1493.  7:flash%=KF%(key%,0):addr=oldaddr
  1494.         
  1495.  addr=addr2
  1496.       
  1497.         
  1498.  b%=4 
  1499. 6      
  1500. close_it(wi%):
  1501. set_caret(mainW%,starthere%)
  1502.       
  1503. set_caret(wi%,1)
  1504.         
  1505. J    
  1506. text(wi%,1)=SearchKey$:
  1507. redraw_icon(wi%,1):
  1508. set_caret(wi%,1)
  1509. 9    
  1510. close_it(wi%):
  1511. set_caret(mainW%,starthere%)
  1512.  11:searchkey%+=z%
  1513.  12:searchkey%-=z%
  1514.  searchkey%>Keys% 
  1515.  searchkey%=0
  1516.  searchkey%<0 
  1517.  searchkey%=Keys%
  1518. text(wi%,3)=Index$(searchkey%):
  1519. redraw_icon(wi%,3)
  1520. reform_click(wi%,ic%,b%)
  1521. text(wi%,7)
  1522. b%=(b% 
  1523.  %111)
  1524.  ic% 
  1525. close_window(wi%)
  1526.  reform$ 
  1527. (    
  1528.  "Merge":
  1529. merge_files(f$,file%)
  1530. "    
  1531.  "Reformat":
  1532. reformat(f$)
  1533.  b%=4 
  1534. close_window(wi%)
  1535. query_click(wi%,ic%,b%)
  1536.  (b% 
  1537.  %111) 
  1538.  1,4:
  1539.  ic% 
  1540. D    
  1541.  2:$Query%=query$:
  1542. redraw_icon(wi%,0):
  1543. set_caret(queryW%,0)
  1544.     Match_tag%=Fieldnumber%
  1545. )    $
  1546. text(helpW%,0)=Tag$(Match_tag%)
  1547. 5    
  1548. position_window(helpW%,x%+64,y%-300,0,0,0,0)
  1549. .    
  1550. set_caret(helpW%,6):fieldfunc$="help"
  1551. prefs_click(wi%,ic%,b%)
  1552. b%=(b% 
  1553.  %111)
  1554.  1,4:
  1555.  ic% 
  1556.  27,28,29:
  1557. 0    
  1558. icon_bit(22,wi%,25,
  1559. selected(wi%,29))
  1560. 3    
  1561. icon_bit(22,wi%,32,
  1562. selected(wi%,31))
  1563. Q    
  1564. get_preferences(prefsW%,"<Pbase$Dir>.Resources.Preference"):
  1565. redraw(wi%)
  1566. selected(wi%,35) 
  1567. =      
  1568. save_preferences(prefsW%,$database%+".Preference")
  1569. I      
  1570. save_preferences(prefsW%,"<Pbase$Dir>.Resources.Preference")
  1571.         
  1572. F    
  1573.  b%=4 
  1574. close_window(wi%):
  1575. set_caret(mainW%,starthere%)
  1576. 4    
  1577. restore_window(wi%,remember%+winbuff%(4,1))
  1578. P    
  1579.  b%=4 
  1580. close_window(wi%):
  1581. set_caret(mainW%,starthere%) 
  1582. redraw(wi%)
  1583. )    
  1584. auto_csv(
  1585. selected(wi%,44))
  1586. kill%=
  1587. selected(wi%,12)
  1588. %autosave%=29-
  1589. selected_esg(wi%,2)
  1590.     "autobalance%=
  1591. selected(wi%,31)
  1592. icon_bit(22,wi%,32,
  1593. selected(wi%,31))
  1594. set_icon(queryW%,1,
  1595. selected(wi%,30))
  1596. fkey_click(wi%,ic%,b%)
  1597.  z%,K$,K%,Z%
  1598. b%=(b% 
  1599.  %111)
  1600.  1,4:
  1601.  (b% 
  1602.  %111)=4 
  1603.  z%=1 
  1604.  z%=-1
  1605.  ic% 
  1606.  4,5:
  1607. #    K$=$Fkeyequiv%:K%=
  1608. K$,2))
  1609.  ic% 
  1610.       
  1611.  4:K%+=z%
  1612.       
  1613.  5:K%-=z%
  1614.         
  1615.  K%=12 
  1616.  K%=0
  1617.  K%<0 
  1618.  K%=11
  1619. )    
  1620.  K%=0 
  1621.  K$="None" 
  1622.  K$="F"+
  1623. *    $Fkeyequiv%=K$:
  1624. redraw_icon(wi%,3)
  1625.  #    K$=$Fkeyequiv%:K%=
  1626. K$,2))
  1627.  K%>0 
  1628.       
  1629.  K%>9 
  1630.  K%+=64
  1631. #%      
  1632. selected(wi%,1) 
  1633.  K%+=16
  1634. $%      
  1635. selected(wi%,2) 
  1636.  K%+=32
  1637.       K%+=384
  1638. &>      Z%=
  1639. key_assigned(K%):
  1640.  Z%<>-1 
  1641.  buttonfield%(1,Z%)=0
  1642. '        
  1643. (F    buttonfield%(1,kpad%)=K%:
  1644.  kpad%=13 
  1645.  buttonfield%(1,23)=K%+16
  1646. ))    
  1647.  b%=4 
  1648.  "Wimp_CreateMenu",,-1
  1649. *$    
  1650.  "Wimp_CreateMenu",,-1
  1651. change_click(wi%,ic%,b%)
  1652. b%=(b% 
  1653.  %111)
  1654.  ic% 
  1655. 4P    
  1656. changes(key%):
  1657.  b%=4 
  1658. close_it(wi%):
  1659. set_caret(mainW%,starthere%)
  1660. 58    
  1661. close_it(wi%):
  1662. set_caret(mainW%,starthere%)
  1663. move_click(wi%,ic%,b%)
  1664. b%=(b% 
  1665.  %111)
  1666.  ic% 
  1667. ?>    
  1668.  0,1,2:
  1669. icon_bit(22,moveW%,6,
  1670. set_caret(queryW%,0)
  1671. @9    
  1672. icon_bit(22,moveW%,6,
  1673. set_caret(moveW%,6)
  1674. B&    
  1675.  undo% 
  1676. save_keys:undo%=
  1677. C%    
  1678. move_records(key%,file%,top)
  1679. D(    
  1680. read(fields%,
  1681. ,REC%,$database%)
  1682. E     addr=
  1683. moveto(key%,top,1)
  1684. F@    
  1685.  b%=4 
  1686. close_it(moveW%):
  1687. set_caret(mainW%,starthere%)
  1688.  undo% 
  1689. I3      
  1690. open_index($database%+".PrimaryKey",0,
  1691. J#      f$=$database%+".Indices."
  1692.       
  1693.  Keys%>0 
  1694.         
  1695.  K%=1 
  1696.  Keys%
  1697. M-          
  1698. open_index(f$+Index$(K%),K%,
  1699.         
  1700.       
  1701.       undo%=
  1702. Q        
  1703. R@    
  1704.  b%=4 
  1705. close_it(moveW%):
  1706. set_caret(mainW%,starthere%)
  1707. S<    
  1708. close_it(moveW%):
  1709. set_caret(mainW%,starthere%)
  1710. csv_click(wi%,ic%,b%)
  1711. b%=(b% 
  1712.  %111)
  1713.  2,4:
  1714.  ic% 
  1715. ]3    
  1716. show_menu(menu%(15),oldx%+32,oldy%+16)
  1717. ^3    
  1718. show_menu(menu%(20),oldx%+32,oldy%+16)
  1719.  1,4:
  1720.  ic% 
  1721. d2    
  1722. icon_bit(22,wi%,4,(
  1723. selected(wi%,1)))
  1724. f"    
  1725. text(wi%,9)="Import" 
  1726.       
  1727.  csvfunc$ 
  1728. h7        
  1729.  "ImportMain":
  1730. convert_csv($
  1731. text(wi%,13))
  1732. iF        
  1733.  "ImportTable":
  1734. csv_to_table(Tablenumber%,$
  1735. text(wi%,13))
  1736.       
  1737. k        
  1738. l%    
  1739.  b%=4 
  1740. close_window(csvW%)
  1741. md    
  1742. restore_window(wi%,remember%+winbuff%(0,1)):
  1743.  b%=4 
  1744. close_window(wi%) 
  1745. redraw(wi%)
  1746. selected(wi%,18) 
  1747. p?      
  1748. save_csv_options("<Pbase$Dir>.Resources.CSVoptions")
  1749. q7      
  1750. save_csv_options($database%+".CSVoptions")
  1751. r        
  1752. sA    
  1753. get_csv_options("<Pbase$Dir>.Resources.CSVoptions")
  1754. merge_click
  1755.  merging% 
  1756.  ic%<>6 
  1757.  ic%<>7 
  1758. finished%=
  1759.  (b% 
  1760.  %111)=4 
  1761.  z%=1 
  1762.  z%=-1
  1763.  ic% 
  1764.  3:ClientPtr%=
  1765. merge_next(ClientPtr%,z%)
  1766.  8:ClientPtr%=
  1767. merge_next(ClientPtr%,-z%)
  1768.  10:ClientPtr%=
  1769. merge_next(top,z%)
  1770.  9:ClientPtr%=
  1771. merge_next(top,-z%)
  1772.  "Impulse_SendMessage",&201,":"+$mergewith%+"."+document$+" Print",,,,printtag%,mytask%
  1773.   merging%=
  1774.   $mergewith%=$ImpulseApp%
  1775.  "Impulse_SendMessage",&200,":"+$mergewith%+"."+document$+" Edit Off",,,,-1,mytask%
  1776. J  mergenum%=0:$
  1777. text(mergeW%,12)=
  1778. (mergenum%):
  1779. redraw_icon(mergeW%,12)
  1780.   ClientSearch$=
  1781. parse
  1782. #  ClientPtr%=
  1783. merge_next(top,1)
  1784. close_file(dbasehandle%):ClientPtr%=top:
  1785. close_it(mergeW%)
  1786.  "Impulse_SendMessage",&200,":"+$mergewith%+"."+document$+" ClearMerge",,,,-1,mytask%
  1787.  "Impulse_SendMessage",&200,":"+$mergewith%+"."+document$+" Edit On",,,,-1,mytask%
  1788. size_click(wi%,ic%,b%)
  1789.  recs$,int$
  1790. recs$=
  1791. (RA%)
  1792. keybase%=!keyanchor%(0)
  1793.  keybase%!4>0 
  1794.  inc$=
  1795. (keybase%!4) 
  1796.  inc$="0"
  1797. b%=(b% 
  1798.  %111)
  1799.  1,4:
  1800.  ic% 
  1801.       
  1802. ($Records%)<=0:
  1803.       
  1804. softerror("",71)
  1805. 0      $Records%=recs$:
  1806. redraw_icon(sizeW%,1)
  1807.       
  1808. ($Increment%)<0
  1809.       
  1810. softerror("",72)
  1811. 1      $Increment%=inc$:
  1812. redraw_icon(sizeW%,3)
  1813.       
  1814. #      keybase%!4=
  1815. ($Increment%)
  1816. 7      
  1817.  present%=7 
  1818. change_length(
  1819. ($Records%),
  1820. +      
  1821.  b%=4 
  1822.  "Wimp_CreateMenu",,-1
  1823.         
  1824. (    $Records%=recs$:$Increment%=inc$
  1825.      
  1826.  "Wimp_CreateMenu",,-1
  1827. table_click(T%)
  1828.  S$,tablefield%
  1829. `NewTab%=(
  1830. table_info(T%,Rows%,TabFields%,Rec%,tabfieldlen%(),offset%,heading%,colours$)="
  1831. *extra%=-NewTab%*(Rows%*(TabFields%+1))
  1832. lit(menu%(17),7,NewTab% 
  1833.  Modify%)
  1834. $menu%(17)=table$(T%)
  1835.  ic%>=0 
  1836. (  tablefield%=(ic% 
  1837.  (TabFields%+1))
  1838.  tablefield%=0
  1839.  2047 
  1840.  ic%<Rows%*(TabFields%+1) 
  1841. %    
  1842.  chartype%(Fieldnumber%)<4 
  1843. (      scratchpad$=$Rf%(Fieldnumber%)
  1844. $      S$=$
  1845. text(tableW%(T%),ic%)
  1846. '      
  1847. (S$)<=len%(Fieldnumber%) 
  1848. !        $Rf%(Fieldnumber%)=S$
  1849. 5        
  1850. redraw_icon(mainW%,field%(Fieldnumber%))
  1851.       
  1852.         
  1853.  1024:
  1854.  ic%<Rows%*(TabFields%+1) 
  1855.  Access%=
  1856. <    !block%=tableW%(T%):
  1857.  "Wimp_GetWindowState",,block%
  1858. Q    
  1859.  "Wimp_SetCaretPosition",tableW%(T%),ic%,x%-block%!4+block%!20,y%,-1,-1
  1860. asterisk(
  1861. '  sort_tabcol%=ic% 
  1862.  (TabFields%+1)
  1863.  sort_tabcol%>=0 
  1864. !    
  1865. lit(menu%(17),3,Access%)
  1866.  NewTab% 
  1867. B      h$=$
  1868. text(tableW%(T%),Rows%*(TabFields%+1)+sort_tabcol%)
  1869. %      $SortTabCol%="Sort "+
  1870. h$,9)
  1871. 7      
  1872.  $SortTabCol%="Sort column "+
  1873. (sort_tabcol%)
  1874.         
  1875. lit(menu%(17),3,
  1876. show_menu(menu%(17),x%-64,y%-20)
  1877.  256:
  1878. invert(wi%,tablefield%+extra%)
  1879. @  field$=
  1880. (tablefield%):
  1881.  tablefield%<10 
  1882.  field$="0"+field$
  1883.   field$+=":"
  1884. selected(wi%,tablefield%+extra%) 
  1885.     printrel$(T%)+=field$
  1886.         
  1887. !    P%=
  1888. printrel$(T%),field$)
  1889. ?    printrel$(T%)=
  1890. printrel$(T%),P%-1)+
  1891. printrel$(T%),P%+3)
  1892. scroll_click
  1893.  (b% 
  1894.  %111)=2 
  1895. row%=(ic% 
  1896. 0$tabcol%=
  1897. (row%):
  1898. redraw_icon(tabcreateW%,8)
  1899. list_click(x%,y%,b%,wi%)
  1900.  N%,last%
  1901.  (b% 
  1902.  %111) 
  1903.   !block%=wi%
  1904.  "Wimp_GetWindowState",,block%
  1905. *  column%=(x%-block%!4+block%!20) 
  1906. (  last%=
  1907. (Form$) 
  1908.  2:sort_textcol%=0
  1909.  last%>0 
  1910.         
  1911.       sort_textcol%+=1
  1912. =    
  1913.  Tab%(sort_textcol%)>column%+1 
  1914.  sort_textcol%=last%
  1915. W    sort_textcol%-=1:$SortTextCol%="Sort "+Tag$(
  1916. ("&"+
  1917. Form$,sort_textcol%*2+1,2)))
  1918. show_menu(menu%(18),x%-64,y%-20)
  1919.  sorted% 
  1920.     !block%=wi%
  1921. (    
  1922.  "Wimp_GetWindowState",,block%
  1923. .    line%=(block%!16-block%!24-y%+36) 
  1924. ,    column%=(x%-block%!4+block%!20) 
  1925.     RecPtr%=!recanchor%
  1926.     R%=RecPtr%!(line%*4)
  1927.     last%=
  1928. (Form$) 
  1929.  R%>=0 
  1930. (      addr=
  1931. find("#"+
  1932. (R%),key%,1,
  1933.       
  1934.  format$ 
  1935.         
  1936.  "horiz","table"
  1937.         
  1938.           N%+=1
  1939. +        
  1940.  Tab%(N%)>column%+1 
  1941.  N%=last%
  1942. &        F%=
  1943. fnum(
  1944. Form$,N%*2-1,2))
  1945.         
  1946.  "vert":
  1947.         
  1948.           N%+=1:line%-=1
  1949. .        
  1950.  RecPtr%!(line%*4)<>R% 
  1951.  N%=last%
  1952. &        F%=
  1953. fnum(
  1954. Form$,N%*2-1,2))
  1955. $        
  1956.  "tree":F%=KF%(tkey%,0)
  1957.         
  1958.  "dup":F%=KF%(0,0)
  1959.       
  1960.       
  1961.  chartype%(F%)<=10 
  1962. 9        
  1963. set_caret(mainW%,field%(F%)):Fieldnumber%=F%
  1964. C        
  1965. set_caret(mainW%,starthere%):Fieldnumber%=starthere%
  1966.       
  1967.         
  1968. softerror("",61)
  1969. match_click(wi%,ic%,b%)
  1970.  not%,and%,or%
  1971. b%=(b% 
  1972.  %111)
  1973. selected_esg(printW%,4) 
  1974.  38:reportdest$="Window"
  1975.  39:reportdest$="File"
  1976.  41:reportdest$="Printer"
  1977.  ic% 
  1978. &[    
  1979.  2:TextName$=$database%+".PrintJobs."+key$(0):
  1980. do_it("",REC%):$SaveName%=TextName$
  1981. (K    
  1982. selected(wi%,4) 
  1983. text(wi%,3)="Found:" 
  1984. text(wi%,3)="Time:"
  1985. redraw_icon(wi%,3)
  1986. +4    
  1987. close_it(wi%):
  1988. set_caret(mainW%,starthere%)
  1989. -$    Search$=
  1990. parse:displayed%=-1
  1991.  Search$<>"FALSE" 
  1992. /B      $Query%="":
  1993. redraw_icon(queryW%,0):
  1994. set_caret(queryW%,0)
  1995. 0M      TextName$=$database%+".PrintJobs."+
  1996. query$,10):$SaveName%=TextName$
  1997.       
  1998.  reportdest$ 
  1999. 2!        
  2000.  "Window","Printer":
  2001. 3&        
  2002. do_it(Search$,displayed%)
  2003.         
  2004.  "File":
  2005. 5!        savefunc$="Save list"
  2006. 66        $SaveSprite%="sfile_fff;Pptr_hand,12,8;R2"
  2007. 7:        
  2008. position_window(saveW%,x%-138,y%-130,0,0,0,0)
  2009. 8         
  2010. set_caret(saveW%,2)
  2011.       
  2012. :        
  2013. ;R    
  2014.  b%=4 
  2015. selected(wi%,4) 
  2016. close_it(wi%):
  2017. set_caret(mainW%,starthere%)
  2018. help_click(wi%,ic%,b%)
  2019. butt%=(b% 
  2020.  %111)
  2021.  butt% 
  2022.  2,4:
  2023. tick_one(fieldmenu%,0,fields%-1,Match_tag%-1)
  2024.  ic%=19 
  2025. show_menu(fieldmenu%,oldx%+32,oldy%+16)
  2026.  butt% 
  2027.  1,4:
  2028.  ic% 
  2029. JW    
  2030.  1:new$="NOT (":$Query%+=new$:
  2031. redraw_icon(queryW%,0):
  2032. set_caret(wi%,6):not%=
  2033. KP    
  2034.  9:new$=" AND ":$Query%+=new$:
  2035. redraw_icon(queryW%,0):
  2036. set_caret(wi%,6)
  2037. LP    
  2038.  10:new$=" OR ":$Query%+=new$:
  2039. redraw_icon(queryW%,0):
  2040. set_caret(wi%,6)
  2041.  16,17:
  2042. N8    
  2043.  (b% 
  2044.  %111)=4 
  2045.  z%=1 
  2046.  (b% 
  2047.  %111)=1 
  2048.  z%=-1
  2049. O2    
  2050.  ic%=16 
  2051.  Match_tag%+=z% 
  2052.  Match_tag%-=z%
  2053. P+    
  2054.  Match_tag%>fields% 
  2055.  Match_tag%=1
  2056. Q+    
  2057.  Match_tag%<1 
  2058.  Match_tag%=fields%
  2059. R:    $
  2060. text(wi%,0)=Tag$(Match_tag%):
  2061. redraw_icon(wi%,0)
  2062. SA    
  2063.  21:$Query%="":
  2064. redraw_icon(queryW%,0):
  2065. set_caret(wi%,6)
  2066. U     op%=
  2067. selected_esg(wi%,1)
  2068.  op% 
  2069.       
  2070.  2:op$="="
  2071.       
  2072.  3:op$="{"
  2073.       
  2074.  4:op$="<"
  2075.       
  2076.  5:op$=">"
  2077.       
  2078.  11:op$="<>"
  2079.       
  2080.  13:op$=">="
  2081.       
  2082.  14:op$="<="
  2083.       
  2084.  15:op$="}{"
  2085. _        
  2086.     tag$=$
  2087. text(wi%,0)
  2088.     contents$=$
  2089. text(wi%,6)
  2090.     new$=tag$+op$+contents$
  2091. cE    $Query%+=new$:
  2092.  not%=
  2093. $Query%)<>")" 
  2094.  $Query%+=")":not%=
  2095. redraw_icon(queryW%,0)
  2096. e>    $
  2097. text(wi%,6)="":
  2098. redraw_icon(wi%,6):
  2099. set_caret(wi%,6)
  2100. f4    
  2101. close_it(helpW%):
  2102. set_caret(queryW%,0)
  2103. iconbar_click
  2104.  %111 
  2105. selected(passW%,12) 
  2106. close_window(saveW%)
  2107. p(    
  2108. show_menu(menu%(0),x%-64,ybar%)
  2109.  $dbase%="No data" 
  2110.     $SaveName%="!DataBase"
  2111. u2    $SaveSprite%="snew_appl;Pptr_hand,12,8;R2"
  2112.     savefunc$=choice$(1)
  2113. w1    
  2114.  "Wimp_CreateMenu",,saveW%,x%-50,y%+300
  2115. show_windows
  2116. main_click(wi%,ic%,b%)
  2117.  P%,F%,H$,L%,T%,N$,field$
  2118.  present%=7 
  2119.  adjust%=
  2120. validate(Fieldnumber%,T%,N$)=
  2121.  changed%=
  2122. update_calcs(Fieldnumber%)
  2123.  flash% 
  2124. deselect(wi%,field%(flash%)):flash%=
  2125.  OLE_edit%>0:
  2126. show_text_block(OLE_edit%)
  2127.  OLE_edit%<0:
  2128. show_picture(-OLE_edit%)
  2129.  OLE_edit%<>0 
  2130. redraw_icon(wi%,field%(
  2131. (OLE_edit%))):OLE_edit%=0
  2132.  present% 
  2133.  0,3:
  2134. design_field(b%,ic%,
  2135. first_field>0 
  2136. default_key
  2137. design_field(b%,ic%,
  2138.  5,7:
  2139.  adjust% 
  2140. design_field(b%,ic%,
  2141.         
  2142. identify_field(ic%)
  2143. ,    
  2144. selected(prefsW%,19) 
  2145. relations
  2146.  2047 
  2147.       
  2148. &      
  2149.  chartype%(Fieldnumber%) 
  2150. B        
  2151. show_user_menu(Fieldnumber%-1,oldx%+32,oldy%+16)
  2152. y        
  2153.  9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31:
  2154. fkey_status(chartype%(Fieldnumber%)-9)
  2155.         
  2156. !        
  2157. close_window(saveW%)
  2158. .        
  2159. selected(passW%,11) 
  2160.  Modify% 
  2161.            
  2162. set_up_field_menu
  2163. .          
  2164. show_menu(menu%(1),x%-64,y%-20)
  2165.         
  2166.       
  2167.       
  2168. &      
  2169.  chartype%(Fieldnumber%) 
  2170. J        
  2171.  0,1,2,3,4,5,6,7,8,39,46,47,48,49,50,51,52,53,54,55,56,57,58:
  2172. H        
  2173.  "Wimp_GetCaretPosition",,block%:first%=((block%!4)+2) 
  2174. 0        
  2175. select_range(first%,Fieldnumber%,
  2176. }        
  2177.  9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30:
  2178. keypad_click(wi%,chartype%(Fieldnumber%)-9,1)
  2179. G        
  2180. filter(wi%,
  2181. selected(wi%,field%(buttonfield%(0,22))))
  2182.          
  2183.  36,41,42,43,44,45:
  2184.         
  2185. invert(wi%,ic%)
  2186. (        col%=
  2187. get_icon_cols(wi%,ic%)
  2188. 4        col%=((col%>>4) 
  2189.  (col%<<4)) 
  2190.  %11111111
  2191. (        
  2192. set_icon_cols(wi%,ic%,col%)
  2193. %        boxon%=((col% 
  2194.  %1111)<2)
  2195. %        
  2196. update_selection(boxon%)
  2197.       
  2198.       
  2199.       
  2200. (-1) 
  2201. (        
  2202.  chartype%(Fieldnumber%) 
  2203.           
  2204.  9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30:
  2205. keypad_click(wi%,chartype%(Fieldnumber%)-9,4)
  2206. I          
  2207. filter(wi%,
  2208. selected(wi%,field%(buttonfield%(0,22))))
  2209. (          
  2210. match(x%-396,y%-131)
  2211. D          
  2212. show_user_menu(Fieldnumber%-1,oldx%+32,oldy%+16)
  2213.           
  2214. {          
  2215. link$(Fieldnumber%),1)="@" 
  2216.  "OS_CLI","Filer_OpenDir "+
  2217. link$(Fieldnumber%),2) 
  2218. softerror("",91)
  2219. t          
  2220.  36,39:
  2221. (-2) 
  2222. enter_tag 
  2223. edit_blob(Fieldnumber%,chartype%(Fieldnumber%)):OLE_edit%=Fieldnumber%
  2224. F          
  2225.  37,38:
  2226. edit_blob(Fieldnumber%,chartype%(Fieldnumber%))
  2227. [          
  2228. edit_blob(Fieldnumber%,chartype%(Fieldnumber%)):OLE_edit%=-Fieldnumber%
  2229.           
  2230.  41,42,43,44,45:
  2231. ,          
  2232.  Access% 
  2233. invert(wi%,ic%)
  2234.           
  2235. (-2) 
  2236. ,            
  2237.  Access% 
  2238. invert(wi%,ic%)
  2239.             
  2240. enter_tag
  2241.             
  2242. U            
  2243. selected(wi%,ic%) 
  2244.  $Rf%(Fieldnumber%)=" " 
  2245.  $Rf%(Fieldnumber%)=""
  2246.           
  2247.           
  2248. relations
  2249.         
  2250. #        
  2251. lookup(Fieldnumber%)
  2252.       
  2253.       
  2254.  256:
  2255. &      
  2256.  chartype%(Fieldnumber%) 
  2257. J        
  2258.  0,1,2,3,4,5,6,7,8,39,46,47,48,49,50,51,52,53,54,55,56,57,58:
  2259.         
  2260. invert(wi%,ic%)
  2261. 1        
  2262. update_selection(
  2263. selected(wi%,ic%))
  2264.       
  2265.       
  2266.  1024:
  2267.       
  2268. (-2) 
  2269.         
  2270. enter_tag
  2271.         
  2272. (        
  2273.  chartype%(Fieldnumber%) 
  2274.           
  2275.  0,1,2,3,4,5,8:
  2276.            
  2277.  Fieldnumber%>0 
  2278. <            !block%=wi%:
  2279.  "Wimp_GetWindowState",,block%
  2280. ]            
  2281.  Access% 
  2282.  "Wimp_SetCaretPosition",wi%,ic%,x%-block%!4+block%!20,y%,-1,-1
  2283.           
  2284.         
  2285.       
  2286.         
  2287. enter_tag
  2288.  wi%,S$
  2289.  "Wimp_GetCaretPosition",,block%
  2290. +wi%=!block%:ic%=block%!4:pos%=block%!20
  2291. text(wi%,ic%)
  2292. S$,pos%)+Tag$(Fieldnumber%)+
  2293. S$,pos%+1)
  2294. text(wi%,ic%)=S$
  2295. redraw_icon(wi%,ic%)
  2296. set_caret(wi%,ic%)
  2297. set_up_field_menu
  2298.  I%,tabmen%
  2299. tabmen%=(LastTable%<>-1)
  2300.  tabmen% 
  2301. tick_one(tablemenu%,0,LastTable%,LastTable%+1)
  2302.  Fieldnumber%>0 
  2303. lit(menu%(1),1,
  2304.   $AnalyseFunc%="Analyse"
  2305. -  $Fieldpos%="Field: "+Tag$(Fieldnumber%)
  2306. &  $LinkTitle%="Field: "+Fieldname$
  2307. '  $CalcForm%=Tag$(Fieldnumber%)+"="
  2308.  I%=0 
  2309. lit(menu%(10),I%,
  2310.    V%=chartype%(Fieldnumber%)
  2311.  5,50,51:
  2312. &    isadate%=
  2313. lit(menu%(10),1,
  2314. &    $AnalyseFunc%="Analyse months"
  2315. :isadate%=
  2316. is_a_key(Fieldnumber%)>=0 
  2317. lit(menu%(10),1,
  2318. _    
  2319.  isadate%=
  2320. selected(mainW%,field%(Fieldnumber%)) 
  2321.  $AnalyseFunc%="Analyse index"
  2322.  0,1,2,3,4,5,8:
  2323. !    
  2324. lit(menu%(10),0,Access%)
  2325. !    
  2326. lit(menu%(10),2,Access%)
  2327. +    
  2328. lit(menu%(10),3,Access% 
  2329.  tabmen%)
  2330. !    
  2331. lit(menu%(10),5,Access%)
  2332. lit(menu%(10),8,
  2333.  I%=0 
  2334.       keyfield%(I%)=0
  2335.       
  2336.  J%=12 
  2337. $        $
  2338. text(keyW%,4*I%+J%)=""
  2339.       
  2340. !    keyfield%(0)=Fieldnumber%
  2341. +    $
  2342. text(keyW%,12)=Tag$(Fieldnumber%)
  2343.     $
  2344. text(keyW%,14)="L"
  2345. .    $
  2346. text(keyW%,15)=
  2347. (len%(Fieldnumber%))
  2348. 1    keylimit%=TextLength%:$
  2349. text(keyW%,29)=""
  2350.     keylen%=keylimit%
  2351. *    $ChangeTitle%="Field: "+Fieldname$
  2352. 3    $
  2353. text(changeW%,0)="":$
  2354. text(changeW%,1)=""
  2355. link_status
  2356. !    
  2357. lit(menu%(10),4,Modify%)
  2358. +    
  2359. lit(menu%(10),3,Access% 
  2360.  tabmen%)
  2361. !    
  2362. lit(menu%(10),2,Access%)
  2363. '    
  2364. calc_link("Calculations...",6)
  2365. link_status
  2366. !    
  2367. lit(menu%(10),4,Modify%)
  2368. +    
  2369. lit(menu%(10),3,Access% 
  2370.  tabmen%)
  2371. !    
  2372. lit(menu%(10),2,Access%)
  2373. )    
  2374. calc_link("Combine fields...",7)
  2375. link_status
  2376.  1    
  2377.  46,47,48,49,50,51,52,53,54,55,56,57,58:
  2378.  V%=47 
  2379. "#      
  2380. lit(menu%(10),4,Modify%)
  2381. #)      
  2382. calc_link("Set base value",47)
  2383. $        
  2384. %!    
  2385. lit(menu%(10),0,Access%)
  2386.  I%=0 
  2387.       keyfield%(I%)=0
  2388.       
  2389.  J%=12 
  2390. )$        $
  2391. text(keyW%,4*I%+J%)=""
  2392.       
  2393. ,!    keyfield%(0)=Fieldnumber%
  2394. -+    $
  2395. text(keyW%,12)=Tag$(Fieldnumber%)
  2396.     $
  2397. text(keyW%,14)="L"
  2398. /.    $
  2399. text(keyW%,15)=
  2400. (len%(Fieldnumber%))
  2401. 01    keylimit%=TextLength%:$
  2402. text(keyW%,29)=""
  2403.     keylen%=keylimit%
  2404.  36,39:
  2405. 3D    
  2406. blob_path(
  2407. ,$database%,REC%,Fieldnumber%,V%,object$)>=0 
  2408. 4#      
  2409. lit(menu%(10),6,Access%)
  2410.       
  2411. lit(menu%(10),7,
  2412.       $SaveName%="TextFile"
  2413. 74      $SaveSprite%="sfile_fff;Pptr_hand,12,8;R2"
  2414.       savefunc$="Save text"
  2415. 9        
  2416.  37,40:
  2417. ;D    
  2418. blob_path(
  2419. ,$database%,REC%,Fieldnumber%,V%,object$)>=0 
  2420. <#      
  2421. lit(menu%(10),6,Access%)
  2422.       
  2423. lit(menu%(10),7,
  2424.       $SaveName%="Sprite"
  2425. ?4      $SaveSprite%="sfile_ff9;Pptr_hand,12,8;R2"
  2426. @!      savefunc$="Save sprite"
  2427. A        
  2428. CD    
  2429. blob_path(
  2430. ,$database%,REC%,Fieldnumber%,V%,object$)>=0 
  2431. D#      
  2432. lit(menu%(10),6,Access%)
  2433.       
  2434. lit(menu%(10),7,
  2435.       $SaveName%="DrawFile"
  2436. G4      $SaveSprite%="sfile_aff;Pptr_hand,12,8;R2"
  2437.       savefunc$="Save draw"
  2438. I        
  2439. JB    
  2440.  link$(Fieldnumber%)<>"" 
  2441. lit(menu%(10),6,Access%)
  2442. lit(menu%(1),1,
  2443. ):$Fieldpos%="Field: ''"
  2444. update_selection(add%)
  2445.  P%,SP%,F%,SF%
  2446. R>F%=Fieldnumber%:SF%=(F% 
  2447.  128):
  2448. (printorder$)=0 
  2449.  SF%=F%
  2450. S-field$=
  2451. ~(F%):
  2452.  F%<16 
  2453.  field$="0"+field$
  2454. T2sfield$=
  2455. ~(SF%):
  2456.  SF%<16 
  2457.  sfield$="0"+sfield$
  2458.  add% 
  2459. (-1) 
  2460.  printorder$+=sfield$ 
  2461.  printorder$+=field$
  2462. enable_row(calcrow%?Fieldnumber%,
  2463. lit(menu%(6),6,
  2464. lit(menu%(6),7,
  2465. lit(menu%(1),7,
  2466. ]$    P%=
  2467. printorder$,field$,P%+1)
  2468.  ((P%-1) 
  2469.  2)=0 
  2470.  P%=0
  2471.  P%>0 
  2472. `9    printorder$=
  2473. printorder$,P%-1)+
  2474. printorder$,P%+2)
  2475. a,    
  2476. enable_row(calcrow%?Fieldnumber%,
  2477. b        
  2478. c        
  2479. d)      SP%=
  2480. printorder$,sfield$,SP%+1)
  2481. e!    
  2482.  ((SP%-1) 
  2483.  2)=0 
  2484.  SP%=0
  2485.  SP%>0 
  2486. g=      printorder$=
  2487. printorder$,SP%-1)+
  2488. printorder$,SP%+2)
  2489. h.      
  2490. enable_row(calcrow%?Fieldnumber%,
  2491. i        
  2492.  printorder$="" 
  2493. lit(menu%(6),6,
  2494. lit(menu%(6),7,
  2495. lit(menu%(1),7,
  2496. print_click(wi%,ic%,b%)
  2497. b%=(b% 
  2498.  %111)
  2499. selected(wi%,26) 
  2500. show_menu(labelW%,x%-500,y%+200)
  2501.  1,4:
  2502.  ic% 
  2503.  23,24,25:
  2504. z.    
  2505. icon_bit(22,wi%,15,
  2506. selected(wi%,25))
  2507. {B    
  2508. icon_bit(22,wi%,43,
  2509. selected(wi%,25) 
  2510. selected(wi%,23))
  2511. |.    
  2512. icon_bit(22,wi%,45,
  2513. selected(wi%,25))
  2514. ~.    
  2515. icon_bit(22,wi%,15,
  2516. selected(wi%,25))
  2517. B    
  2518. icon_bit(22,wi%,43,
  2519. selected(wi%,25) 
  2520. selected(wi%,23))
  2521. .    
  2522. icon_bit(22,wi%,45,
  2523. selected(wi%,25))
  2524. 5    $
  2525. text(labelW%,20)=
  2526. text(labelW%,10))+1)
  2527. 6    
  2528. icon_bit(22,labelW%,20,
  2529. selected(labelW%,11))
  2530. 6    
  2531. icon_bit(22,labelW%,12,
  2532. selected(labelW%,11))
  2533. N    
  2534. position_window(labelW%,x%-303,y%-360,0,0,0,0):
  2535. set_caret(labelW%,10)
  2536. R    
  2537. get_options(printW%,"<Pbase$Dir>.Resources.PrtOptions"):
  2538. redraw(wi%)
  2539. T    
  2540.  b%=4 
  2541. close_window(wi%):
  2542. set_caret(mainW%,starthere%) 
  2543. match(0,0)
  2544. restore_window(wi%,remember%+winbuff%(3,1)):
  2545.  b%=4 
  2546. close_window(wi%):
  2547. set_caret(mainW%,starthere%) 
  2548. redraw(wi%)
  2549. .    
  2550. icon_bit(22,wi%,10,
  2551. selected(wi%,47))
  2552. .    
  2553. icon_bit(22,wi%,19,
  2554. selected(wi%,47))
  2555. selected(wi%,50) 
  2556. C      
  2557. save_options(printW%,"<Pbase$Dir>.Resources.PrtOptions")
  2558.       
  2559. 6      $SaveName%=$database%+".PrintRes.PrtOptions"
  2560. 4      $SaveSprite%="sfile_7f5;Pptr_hand,12,8;R2"
  2561. "      savefunc$="Save options"
  2562. (      
  2563. show_menu(saveW%,x%-64,y%-20)
  2564.         
  2565. label_click(wi%,ic%,b%)
  2566. b%=(b% 
  2567.  %111)
  2568.  1,4:
  2569.  ic% 
  2570. 5    $
  2571. text(labelW%,20)=
  2572. text(labelW%,10))+1)
  2573. 6    
  2574. icon_bit(22,labelW%,20,
  2575. selected(labelW%,11))
  2576. 6    
  2577. icon_bit(22,labelW%,12,
  2578. selected(labelW%,11))
  2579. 5    $
  2580. text(labelW%,20)=
  2581. text(labelW%,10))+1)
  2582. 6    
  2583. icon_bit(22,labelW%,20,
  2584. selected(labelW%,11))
  2585. 6    
  2586. icon_bit(22,labelW%,12,
  2587. selected(labelW%,11))
  2588. '    
  2589.  b%=4 
  2590. close_window(labelW%)
  2591. d    
  2592. restore_window(wi%,remember%+winbuff%(2,1)):
  2593.  b%=4 
  2594. close_window(wi%) 
  2595. redraw(wi%)
  2596. keypad_click(wi%,ic%,b%)
  2597.  handle%,icon%,T%,N$,date$
  2598. close_window(relateW%)
  2599.  flash% 
  2600. deselect(mainW%,field%(flash%)):flash%=
  2601.  ic%<>12 
  2602. validate(Fieldnumber%,T%,N$)=
  2603.  changed%=
  2604. update_calcs(Fieldnumber%)
  2605. check_change
  2606. b%=(b% 
  2607.  %111)
  2608. fkey_status(ic%)
  2609.  1,4:
  2610.  b%=4 
  2611.  z%=1 
  2612.  z%=-1
  2613.  ic% 
  2614. '    
  2615. scan(z%,
  2616. text(wi%,23)))
  2617.  1:stop%=
  2618. %    
  2619.  2:addr=
  2620. moveto(key%,top,z%)
  2621. &    
  2622.  3:addr=
  2623. moveto(key%,top,-z%)
  2624. &    
  2625.  4:addr=
  2626. moveto(key%,addr,z%)
  2627. '    
  2628.  5:addr=
  2629. moveto(key%,addr,-z%)
  2630. (    
  2631.  6:addr=
  2632. fast_wind(top,addr,z%)
  2633. )    
  2634.  7:addr=
  2635. fast_wind(top,addr,-z%)
  2636. key_select(z%)
  2637. key_select(-z%)
  2638. subfile(z%)
  2639. subfile(-z%)
  2640. -    
  2641. rotate:addr=
  2642. moveto(key%,top,1)
  2643. "    
  2644. allow_search(wi%,z%)
  2645. display(key%,-1)
  2646. #    
  2647.  15:addr=
  2648. shift(z%,key%,0)
  2649. (-1) 
  2650. *      addr=
  2651. find("#"+
  2652. (REC%),key%,0,
  2653.       
  2654. display(key%,addr)
  2655.         
  2656. $    
  2657.  16:addr=
  2658. shift(-z%,key%,0)
  2659. (-1) 
  2660. *      addr=
  2661. find("#"+
  2662. (REC%),key%,0,
  2663.       
  2664. display(key%,addr)
  2665.         
  2666. 6    
  2667.  17:addr=
  2668. shift(0,key%,1):
  2669. display(key%,addr)
  2670. val_help
  2671. +    
  2672. check_change:
  2673. save_everything
  2674. store
  2675. retrieve
  2676. ,    
  2677. filter(wi%,
  2678. selected(wi%,ic%))
  2679. K    
  2680.  "OS_Byte",202,0,239:
  2681. show_menu(specmenu%,oldx%+32,oldy%+16)
  2682. $    
  2683. open_window(specialW%)
  2684. fkey_status(ic%)
  2685.  Modify% 
  2686.  keynumber%
  2687.  ic%>=0 
  2688.  ic%<23 
  2689.   kpad%=ic%
  2690.  ic%=22 
  2691.  $Kpadicon%="Soptoff;r5,14" 
  2692.  $Kpadicon%=$
  2693. val(keypadW%,ic%)
  2694.   $FkeyTitle%=vname$(ic%+9)
  2695. $  keynumber%=buttonfield%(1,ic%)
  2696.  keynumber%>0 
  2697. -    $Fkeyequiv%="F"+
  2698. (keynumber% 
  2699.  %1111)
  2700. /    
  2701. set_icon(fkeyW%,1,(keynumber% 
  2702.  1<<4))
  2703. /    
  2704. set_icon(fkeyW%,2,(keynumber% 
  2705.  1<<5))
  2706.         
  2707.     $
  2708. text(fkeyW%,3)="None"
  2709. deselect(fkeyW%,1)
  2710. deselect(fkeyW%,2)
  2711. lit(menu%(23),0,
  2712. lit(menu%(23),0,
  2713. show_menu(menu%(23),x%-64,y%-20)
  2714. load_fkeys(f$)
  2715.  F,I%
  2716. buttonfield%()=0
  2717. ("<Pbase$Dir>.Resources."+f$)
  2718.  I%=0 
  2719.   buttonfield%(1,I%)=
  2720. close_file(F)
  2721. save_fkeys
  2722.  F,I%
  2723. ("<Pbase$Dir>.Resources.Fkeys")
  2724.  I%=0 
  2725. (buttonfield%(1,I%))
  2726. close_file(F)
  2727. list_fkeys
  2728.  I%,line$,Heading$,F
  2729. @TextName$=$database%+".PrintJobs.Fkeys":$SaveName%=TextName$
  2730. read_print_options
  2731. (format$="horiz":reportdest$="Window"
  2732. 5Heading$=margin$+
  2733. pad("Keystroke equivalents",30)
  2734. LenLine%=
  2735. (Heading$)+2
  2736. extend_named_sliding_block(lineanchor%,LenLine%+4)
  2737. extend_named_sliding_block(headanchor%,LenLine%+4):pos%=!headanchor%
  2738. heap_store(headanchor%,LenLine%,0,pos%,0,Heading$)
  2739. ,Count%=0:Title$="":Title1$="":Title2$=""
  2740. list_head(0)
  2741.  "Hourglass_On"
  2742.  I%=0 
  2743.   K%=buttonfield%(1,I%)
  2744.  K%=0 
  2745.     K$="None"
  2746.         
  2747.     K$="F"+
  2748.  %1111)
  2749. &    
  2750.  (K% 
  2751.  (1<<4)) 
  2752. (139)+K$
  2753. #    
  2754.  (K% 
  2755.  (1<<5)) 
  2756.  K$="^"+K$
  2757. ,  line$=margin$+
  2758. pad(vname$(I%+9),24)+K$
  2759. B  $(!lineanchor%)=line$:
  2760. list_line(-1,lineanchor%,
  2761. (line$),32)
  2762.  I%=13 
  2763. E    line$=margin$+
  2764. pad(vname$(I%+9)+" all subfiles",24)+
  2765. (139)+K$
  2766.  D    $(!lineanchor%)=line$:
  2767. list_line(-1,lineanchor%,
  2768. (line$),32)
  2769. ("<Pbase$Dir>.Resources.KeyList")
  2770.     line$=margin$+
  2771. &D    $(!lineanchor%)=line$:
  2772. list_line(-1,lineanchor%,
  2773. (line$),32)
  2774. close_file(F)
  2775.  "Hourglass_Off"
  2776. lit(menu%(18),1,
  2777. screen_list
  2778. pitch$=
  2779. pitch("2")
  2780. write_log(-1,"Keystroke equivalents printed")
  2781. scan(z%,s%)
  2782. stop%=
  2783. 3   addr=
  2784. moveto(key%,addr,z%)
  2785.   K%=
  2786.  stop%
  2787. store
  2788.  wi%,ic%
  2789.  "Wimp_GetCaretPosition",,block%
  2790. wi%=!block%:ic%=block%!4
  2791. scratchpad$=$
  2792. text(wi%,ic%)
  2793. retrieve
  2794.  wi%,ic%,L%
  2795.  "Wimp_GetCaretPosition",,block%
  2796. wi%=!block%:ic%=block%!4
  2797.  scratchpad$<>"" 
  2798. E   L%=
  2799. buffer_length(wi%,ic%)
  2800. F&  $
  2801. text(wi%,ic%)=
  2802. scratchpad$,L%)
  2803. redraw_icon(wi%,ic%)
  2804. set_caret(wi%,ic%)
  2805.  ### Binary Large Objects (B.L.O.B.s) ###
  2806. blob_path(create%,f$,R%,F%,V%,
  2807.  O$,main$,level1$,level2$,d%,L%
  2808.  36,39:O$=".Memo"
  2809.  37,40:O$=".Sprite"
  2810.  38:O$=".Draw"
  2811. main$=f$+O$+
  2812. V"level1$=main$+"."+
  2813.  4900)
  2814. W"level2$=level1$+"."+
  2815. b$=level2$+"."+
  2816.  "OS_File",5,b$ 
  2817.  d%,,,,L%
  2818.  d%=0 
  2819.  create%=
  2820.  "OS_File",8,main$
  2821.  "OS_File",8,level1$
  2822.  "OS_File",8,level2$
  2823.  d%=1 
  2824. load_blob(f$,R%,F%,V%)
  2825.  L%,b$
  2826. c#L%=
  2827. blob_path(
  2828. ,f$,R%,F%,V%,b$)
  2829.  L%>=0 
  2830. extend_named_sliding_block(tempanchor%,L%+1)
  2831.  "OS_File",255,b$,!tempanchor%
  2832. blob_to_file(F,L%)
  2833.  L%>0 
  2834.  "OS_GBPB",2,F,!tempanchor%,L%
  2835. copy_blob(source$,dest$,RS%,RD%,FS%,FD%,V%)
  2836.  L%,Z%,bs$,bd$
  2837. p+L%=
  2838. blob_path(
  2839. ,source$,RS%,FS%,V%,bs$)
  2840.  L%>0 
  2841. r+  Z%=
  2842. blob_path(
  2843. ,dest$,RD%,FD%,V%,bd$)
  2844.  "OS_CLI","Copy "+bs$+" "+bd$+" ~C~V~Q"
  2845. delete_blob(F%,F$,wi%,ic%)
  2846.  flag%,f$
  2847. selected(prefsW%,20) 
  2848.  "OS_CLI","Delete "+F$:flag%=
  2849. confirm(
  2850. msg("Err115")) 
  2851. |(    
  2852.  "OS_CLI","Delete "+F$:flag%=
  2853.  flag% 
  2854.  chartype%(F%) 
  2855. 6    
  2856.  36:$
  2857. val(wi%,ic%)="R5;Pptr_ext,8,4;Ssm!edit"
  2858. 7    
  2859.  37:$
  2860. val(wi%,ic%)="R5;Pptr_ext,8,4;Ssm!paint"
  2861. 6    
  2862.  38:$
  2863. val(wi%,ic%)="R5;Pptr_ext,8,4;Ssm!draw"
  2864.  39:$
  2865. text(wi%,ic%)=""
  2866. redraw_icon(wi%,ic%)
  2867. set_blob_sprite(R%,F%,V%)
  2868.  L%,b$,sprite$
  2869.  R%=RA% 
  2870.  L%=-1 
  2871. blob_path(
  2872. ,$database%,R%,F%,V%,b$)
  2873.  L%>=0 
  2874.  sprite$="small_fff" 
  2875.  sprite$="sm!edit"
  2876.  L%>=0 
  2877.  sprite$="small_ff9" 
  2878.  sprite$="sm!paint"
  2879.  L%>=0 
  2880.  sprite$="small_aff" 
  2881.  sprite$="sm!draw"
  2882. val(mainW%,field%(F%))="R5;Pptr_ext,8,4;S"+sprite$
  2883. redraw_icon(mainW%,field%(F%))
  2884. edit_blob(F%,V%)
  2885.  wi%,ic%,b$,O$,val$
  2886. check_change
  2887. wi%=mainW%:ic%=field%(F%)
  2888.  36:O$="Memo":val$="R5;Pptr_ext,8,4;Ssmall_fff":ftype%=&fff
  2889.  37:O$="Sprite":val$="R5;Pptr_ext,8,4;Ssmall_ff9":ftype%=&ff9
  2890.  38:O$="Draw":val$="R5;Pptr_ext,8,4;Ssmall_aff":ftype%=&aff
  2891.  39:O$="Memo":val$="L;Pptr_ext,8,4":ftype%=&fff
  2892.  40:O$="Sprite":val$="Z0;Ssmall_ff9":ftype%=&ff9
  2893. blob_path(
  2894. ,$database%,REC%,F%,V%,b$)<0 
  2895.  V%<>40 
  2896. val(wi%,ic%)=val$
  2897.  "OS_CLI","Copy <PBase$Dir>.Resources.Objects."+O$+" "+b$+" ~C~V"
  2898. redraw_icon(wi%,ic%)
  2899. 4block%!0=256:block%!12=0:block%!16=5:block%!20=0
  2900. 3block%!24=0:block%!28=0:block%!32=0:block%!36=0
  2901. )block%!40=ftype%:$(block%+44)=b$+
  2902.  "Wimp_SendMessage",18,block%,0
  2903. transfer_blob(wi%,ic%,file$,ft%)
  2904.  F%,V%,L%,W%,b$
  2905.  wi%<>mainW% 
  2906. check_change
  2907. #F%=(ic%+1) 
  2908.  2:V%=chartype%(F%)
  2909.  ft%=-1 
  2910.  link$(F%)="@"+file$:link$(0)="LOADED"
  2911.  ft%=&fff 
  2912. install_blob:$
  2913. val(wi%,ic%)="R5;Pptr_ext,8,4;Ssmall_fff"
  2914.  ft%=&ff9 
  2915. install_blob:$
  2916. val(wi%,ic%)="R5;Pptr_ext,8,4;Ssmall_ff9"
  2917.  ft%=&aff 
  2918. install_blob:$
  2919. val(wi%,ic%)="R5;Pptr_ext,8,4;Ssmall_aff"
  2920.  ft%=&fff 
  2921. install_blob:
  2922. show_text_block(F%)
  2923.  ft%=&ff9 
  2924. install_blob:
  2925. show_picture(F%)
  2926. redraw_icon(wi%,ic%)
  2927. install_blob
  2928. blob_path(
  2929. ,$database%,REC%,F%,V%,b$)
  2930.  "OS_CLI","Remove "+b$
  2931.  "OS_CLI","Copy "+file$+" "+b$+" ~C~V"
  2932. show_text_block(F%)
  2933.  F,b$,I%,L%,base%
  2934.  F%=0 
  2935. base%=Rf%(F%)
  2936. blob_path(
  2937. ,$database%,REC%,F%,39,b$)
  2938.  L%>0 
  2939.  L%>len%(F%) 
  2940.  L%=len%(F%)
  2941.  ### Load only as much of file as we can display ###
  2942. >  F=
  2943. (b$):
  2944.  F>0 
  2945.  "OS_GBPB",4,F,base%,L%:
  2946. close_file(F)
  2947.  ### Replace any characters<32 by spaces - but ONLY for display ###
  2948.  I%=0 
  2949.  L%-1
  2950. #    
  2951.  base%?I%<32 
  2952.  base%?I%=32
  2953.   base%?L%=10
  2954.  $base%=""
  2955. show_picture(F%)
  2956.  F,f$,I%,max%,len%,x%,y%,w%,h%
  2957.  F%=0 
  2958. /len%=
  2959. blob_path(
  2960. ,$database%,REC%,F%,40,f$)
  2961. E!block%=mainW%:block%!4=field%(F%):
  2962.  "Wimp_GetIconState",,block%
  2963. <x%=block%!8:y%=block%!12:w%=block%!16-x%:h%=block%!20-y%
  2964.  "Wimp_DeleteIcon",,block%
  2965.  len%>=0 
  2966. extend_named_sliding_block(Rf%(F%),len%+4):base%=!Rf%(F%)
  2967. /  !base%=len%+4:
  2968.  "OS_File",255,f$,base%+4
  2969. O  field%(F%)=
  2970. create_icon(mainW%,x%,y%,w%,h%,&0700A53E,"",base%+16,base%,0)
  2971. K  field%(F%)=
  2972. create_icon(mainW%,x%,y%,w%,h%,&0700A53E,"",paint%,1,384)
  2973. filter(wi%,on%)
  2974.  x%,y%,vxmin%,vymax%,scrollx%,scrolly%
  2975. filter%=on%:$Query%=""
  2976.  on% 
  2977.  wi% 
  2978.  keypadW%:
  2979. 4    !block%=wi%:
  2980.  "Wimp_GetWindowState",,block%
  2981. =    
  2982. position_window(filterW%,block%!12,block%!8,0,0,0,0)
  2983. A    
  2984.  mainW%:
  2985. open_at(firstfilter%,filterW%,22,482,314,44,44)
  2986. set_caret(queryW%,0)
  2987. close_it(filterW%):
  2988. set_caret(mainW%,starthere%)
  2989. fast_wind(T%,P%,D%)
  2990.  fast%=
  2991. text(keypadW%,23))
  2992. D%=(D%+1) 
  2993.  P%<>T% 
  2994.  I%<fast%
  2995.  filter% 
  2996. next_match(P%,D%,Filter$,Z%) 
  2997. neighbour(key%,P%,D%)
  2998.   I%+=1
  2999.  P%=T% 
  3000.  filter% 
  3001.  7:P%=
  3002. neighbour(key%,P%,1-D%)
  3003. display(key%,P%)
  3004. subfile(direction%)
  3005. filemem%(file%)=addr
  3006. file%+=direction%
  3007.  file%=6 
  3008.  file%=0
  3009.  file%=-1 
  3010.  file%=5
  3011. "$Subfilename%=$Subfile%(file%)
  3012. top=8*file%+LH%
  3013.  filemem%(file%)>=0 
  3014. selected (prefsW%,43) 
  3015. .  addr=filemem%(file%):
  3016. display(key%,addr)
  3017.  addr=
  3018. moveto(key%,top,1)
  3019. save_subfilenames
  3020.  present%=7 
  3021. !  F=
  3022. ($database%+".Subfiles")
  3023.  I%=0 
  3024. #F,$Subfile%(I%)
  3025. close_file(F)
  3026. allow_search(wi%,e%)
  3027. select(searchW%,5):
  3028. deselect(searchW%,6)
  3029.      4  
  3030. select(searchW%,6):
  3031. deselect(searchW%,5)
  3032. text(searchW%,1)="":
  3033. redraw_icon(searchW%,1)
  3034. text(searchW%,7)="":
  3035. redraw_icon(searchW%,7)
  3036. text(searchW%,3)=Index$(key%)
  3037.  wi% 
  3038.  keypadW%:
  3039.     '7  !block%=keypadW%:
  3040.  "Wimp_GetWindowState",,block%
  3041.     (;  
  3042. position_window(searchW%,block%!12,block%!8,0,0,0,0)
  3043.     )@  
  3044.  mainW%:
  3045. open_at(firstsearch%,searchW%,13,456,314,114,52)
  3046. set_caret(searchW%,1)
  3047. val_help
  3048.  name$,subst%,field%,extra%,fld%
  3049.  "Wimp_GetCaretPosition",,block%
  3050. wi%=block%!0:ic%=block%!4
  3051. fld%=(ic%+1) 
  3052.  wi%=mainW% 
  3053.  fld%>0 
  3054.   name$=link$(fld%)
  3055.     5+  field%=
  3056. trailing_number(name$,exact%)
  3057.     6#  subst%=
  3058. leading_number(name$)
  3059.     7'  Tablenumber%=
  3060. table_number(name$)
  3061.     84  
  3062.  Tablenumber%<>-1 
  3063. show_table(Tablenumber%)
  3064. val_on_off
  3065.  I%=1 
  3066.     ?   
  3067. selected(prefsW%,21) 
  3068.     @$    
  3069. :$valid%(I%)=$rvalid%(I%)
  3070.     A(    
  3071. :$valid%(I%)="Pptr_write,4,4"
  3072. save_click(wi%,ic%,b%)
  3073.  p$,H$
  3074. butt%=(b% 
  3075.  %111)
  3076.  wi% 
  3077.  saveW%:
  3078.   Filename$=$SaveName%
  3079.  savefunc$ 
  3080.  "New database":
  3081.     Type%=0
  3082.     O6    
  3083. Filename$,1)<>"!" 
  3084.  Filename$="!"+Filename$
  3085.     P5    Filename$=
  3086. Filename$,10):$SaveName%=Filename$
  3087.  "Save as text":
  3088.     Type%=&fff
  3089.     S7    Start%=!textanchor%:End%=Start%+Count%*LenLine%
  3090.     $Start%=pitch$
  3091.  "Save list":
  3092.     V     Type%=&fff:savetofile%=
  3093.  "Save text":
  3094.     Type%=&fff:
  3095.     Y=    len%=
  3096. blob_path(
  3097. ,$database%,REC%,Fieldnumber%,36,f$)
  3098.     Z7    
  3099. extend_named_sliding_block(saveanchor%,len%+1)
  3100.     [(    
  3101.  "OS_File",255,f$,!saveanchor%
  3102.     \,    Start%=!saveanchor%:End%=Start%+len%
  3103.  "Save sprite":
  3104.     Type%=&ff9
  3105.     _=    len%=
  3106. blob_path(
  3107. ,$database%,REC%,Fieldnumber%,37,f$)
  3108.     `7    
  3109. extend_named_sliding_block(saveanchor%,len%+1)
  3110.     a(    
  3111.  "OS_File",255,f$,!saveanchor%
  3112.     b,    Start%=!saveanchor%:End%=Start%+len%
  3113.  "Save draw":
  3114.     Type%=&aff
  3115.     e=    len%=
  3116. blob_path(
  3117. ,$database%,REC%,Fieldnumber%,38,f$)
  3118.     f7    
  3119. extend_named_sliding_block(saveanchor%,len%+1)
  3120.     g(    
  3121.  "OS_File",255,f$,!saveanchor%
  3122.     h,    Start%=!saveanchor%:End%=Start%+len%
  3123.  "Save options":
  3124.     Type%=&7f5
  3125.  "Save query":
  3126.     $savebuff%=query$
  3127.     m;    Start%=savebuff%:End%=Start%+
  3128. (query$)+1:Type%=&7f4
  3129.     n*    
  3130.  "Save selection":
  3131. save_selection
  3132.  "Save table":
  3133.     pc    z$=
  3134. table_info(Tablenumber%,Rows%,TabFields%,Rec%,tabfieldlen%(),offset%,heading%,colours$)
  3135.     qR    Start%=!tabanchor%(Tablenumber%):End%=Start%+offset%+Rows%*Rec%:Type%=&7f1
  3136.     r=    
  3137.  "Save table as CSV":Filename$=$SaveName%:Type%=&dfe
  3138.  "Save form file":
  3139.     Type%=&7f2
  3140. lit(menu%(9),3,
  3141. lit(menu%(9),4,
  3142. lit(menu%(9),5,
  3143.     x3    
  3144.  adjust%=
  3145. first_field>0 
  3146. default_key
  3147.     y9    
  3148.  "Export selected":
  3149. export_selected(printorder$)
  3150.  savesubW%:
  3151.  savefunc$ 
  3152.  "Export subset":
  3153.     ~#    Filename$=$SubName%:Type%=0
  3154.  "Export CSV":
  3155. &    Filename$=$SubName%:Type%=&dfe
  3156.  ic% 
  3157.  (b% 
  3158.  %11110000)>0 
  3159. init_drag(wi%,ic%,5)
  3160. Filename$,".")>0 
  3161. 7    
  3162.  butt%<>2 
  3163. save(Filename$,Type%,Start%,End%)
  3164. )    
  3165. write_log(-1,Filename$+" saved")
  3166.  butt%=4 
  3167.       
  3168.  wi%=saveW% 
  3169. $        
  3170.  "Wimp_CreateMenu",,-1
  3171. :        
  3172. close_it(wi%):
  3173. set_caret(mainW%,starthere%)
  3174.       
  3175.         
  3176. softerror("",33)
  3177.  wi%=saveW% 
  3178.      
  3179.  "Wimp_CreateMenu",,-1
  3180. 6    
  3181. close_it(wi%):
  3182. set_caret(mainW%,starthere%)
  3183. key_click(wi%,ic%,b%)
  3184. butt%=(b% 
  3185.  %111)
  3186. z%=(butt%=1)-(butt%=4)
  3187.  butt% 
  3188.  2,4:
  3189.  ic% 
  3190.  8,9,10,11:
  3191. <    
  3192. tick_one(fieldmenu%,0,fields%-1,keyfield%(ic%-8)-1)
  3193. D    
  3194. show_menu(fieldmenu%,oldx%+32,oldy%+16):fieldfunc$=
  3195. (ic%-8)
  3196.  ic% 
  3197.  0,1,2,3:
  3198. kcycle(keyfield%(ic%),4*ic%+12,z%)
  3199.  4,5,6,7:
  3200. kcycle(keyfield%(ic%-4),4*ic%-4,-z%)
  3201.  keyfunc$<>"Current key" 
  3202.     keylimit%=0:keylen%=0
  3203.  J%=0 
  3204. (      keylimit%+=len%(keyfield%(J%))
  3205. +      keylen%+=
  3206. text(keyW%,4*J%+15))
  3207. /      
  3208.  keylen%>keylimit%:
  3209. softerror("",26)
  3210. (      
  3211.  keylen%=0:
  3212. softerror("",105)
  3213.       
  3214.       
  3215.  keyfunc$ 
  3216.         
  3217.  "Primary key":
  3218. *        
  3219. save_form($database%+".Form")
  3220.         key%=0
  3221.         
  3222. copy_keydata(key%)
  3223. *        RA%=
  3224. ($Records%):f$=$database%
  3225. &        
  3226. make_empty_index(RA%,0,
  3227. *        
  3228. save_recs(f$+".Database",RA%)
  3229. -        present%=7:
  3230. save_keys:
  3231. save_calcs
  3232. /        design%=
  3233. :present%=1:
  3234. get_it_in(f$)
  3235. 0        
  3236.  "New primary key":
  3237. new_tree(file%)
  3238. /        
  3239.  "Index field":
  3240. create_index(key%)
  3241.       
  3242.         
  3243.   keyfunc$=""
  3244.  b%=4 
  3245. close_window(keyW%):
  3246. set_caret(mainW%,starthere%)
  3247. close_window(keyW%):
  3248. set_caret(mainW%,starthere%)
  3249. shade_key_icons(con%)
  3250. icon_bit(22,keyW%,30,con%)
  3251.  I%=0 
  3252. icon_bit(22,keyW%,I%,con%)
  3253. icon_bit(22,keyW%,31,con%)
  3254. icon_bit(22,keyW%,12,
  3255. icon_bit(22,keyW%,16,
  3256. icon_bit(22,keyW%,20,
  3257. icon_bit(22,keyW%,24,
  3258. icon_bit(22,keyW%,30,con%)
  3259. icon_bit(22,keyW%,35,con%)
  3260. icon_bit(22,keyW%,37,con%)
  3261. kcycle(
  3262.  F%,show%,z%)
  3263.  J%=0 
  3264. text(keyW%,show%+J%)=""
  3265. F%+=z%
  3266.  F%>fields% 
  3267.  F%=0
  3268.  F%<0 
  3269.  F%=fields%
  3270.  F%>0 
  3271. text(keyW%,show%)=Tag$(F%)
  3272. text(keyW%,show%+1)="1":
  3273. set_caret(keyW%,show%+1)
  3274. text(keyW%,show%+2)="L"
  3275. text(keyW%,show%+3)=
  3276. (len%(F%))
  3277.  J%=0 
  3278. redraw_icon(keyW%,show%+J%)
  3279. tick_one(fieldmenu%,0,fields%-1,F%-1)
  3280. copy_keydata(key%)
  3281.  J%,chars%,pos%,word%,field%
  3282. KL%(key%)=0
  3283.  J%=0 
  3284. 7  chars%=
  3285. text(keyW%,4*J%+15)):KL%(key%)+=chars%
  3286. text(keyW%,4*J%+14) 
  3287.  "L":pos%=0
  3288.  "R":pos%=255
  3289. '    
  3290. :pos%=
  3291. text(keyW%,4*J%+14))
  3292. $  word%=
  3293. text(keyW%,4*J%+13))
  3294.   field%=keyfield%(J%)
  3295. <  KW%(key%,J%)=chars%+(pos%<<8)+(word%<<16)+(field%<<24)
  3296.   KF%(key%,J%)=field%
  3297. #case%(key%)=
  3298. selected(keyW%,30)
  3299. set_keydata(key%)
  3300.  J%,chars%,pos%,word%,field%,W%
  3301.  J%=12 
  3302. text(keyW%,J%)=""
  3303.  J%=0 
  3304.   W%=KW%(key%,J%)
  3305.  W%>0 
  3306. 7    chars%=W% 
  3307.  255:$
  3308. text(keyW%,4*J%+15)=
  3309. (chars%)
  3310.     pos%=(W%>>8) 
  3311.  pos% 
  3312.     '      
  3313. text(keyW%,4*J%+14)="L"
  3314. )      
  3315.  255:$
  3316. text(keyW%,4*J%+14)="R"
  3317. )      
  3318. text(keyW%,4*J%+14)=
  3319. (pos%)
  3320.         
  3321. ;    word%=(W%>>16) 
  3322.  255:$
  3323. text(keyW%,4*J%+13)=
  3324. (word%)
  3325. >    field%=KF%(key%,J%):$
  3326. text(keyW%,4*J%+12)=Tag$(field%)
  3327.     keyfield%(J%)=field%
  3328. text(keyW%,29)=
  3329. (key%)
  3330. set_icon(keyW%,30,case%(key%))
  3331. set_icon(keyW%,35,incspace%(key%))
  3332. set_icon(keyW%,37,null%(key%))
  3333. key_select(D%)
  3334.  "Wimp_GetCaretPosition",,block%
  3335. wi%=block%!0:ic%=block%!4
  3336. colour(key%,2)
  3337.  +1:key%=(key%+1) 
  3338.  (Keys%+1)
  3339.  -1:key%-=1:
  3340.  key%<0 
  3341.  key%=Keys%
  3342. colour(key%,1)
  3343. set_keydata(key%)
  3344. text(searchW%,3)=Index$(key%):
  3345. redraw_icon(searchW%,3)
  3346. top=8*file%+LH%
  3347. addr=
  3348. moveto(key%,top,1)
  3349. set_caret(wi%,ic%)
  3350. set_colours(wi%,ic%,b%)
  3351.  (b% 
  3352.  %111)=4 
  3353.  z%=1 
  3354.  z%=-1
  3355.  (b% 
  3356.  %111) 
  3357.  1,4:
  3358.  ic% 
  3359.  0,1,2,3,4,5,6,7,8:
  3360. /@    col%=
  3361. get_icon_cols(wi%,ic%):fg%=col% 
  3362.  16:bg%=col% 
  3363. 0S    
  3364. selected(wi%,11) 
  3365.  fg%=(fg%+z%+16) 
  3366.  ic%<8 
  3367.  bg%=(bg%+z%+16) 
  3368. 1'    col%=fg%+bg%*16:ncol%(ic%)=col%
  3369. 2$    
  3370. set_icon_cols(wi%,ic%,col%)
  3371.  9,10:
  3372.     fcol%()=ncol%()
  3373.  I%=0 
  3374.  Keys%
  3375.       
  3376. colour(I%,2)
  3377. colour(key%,1)
  3378.  I%=1 
  3379.  fields%
  3380. :F      
  3381.  link$(I%)<>"" 
  3382. set_icon_cols(mainW%,field%(I%),ncol%(8))
  3383. <!    
  3384.  ic%=10 
  3385. write_colours
  3386. =     
  3387.  "Wimp_CreateMenu",,-1
  3388. ?3    
  3389. read_colours("<Pbase$Dir>.Resources.Cols")
  3390.  I%=0 
  3391. A*      
  3392. set_icon_cols(wi%,I%,ncol%(I%))
  3393. create_click
  3394.  Calc$
  3395. butt%=(b% 
  3396.  %111)
  3397.  butt% 
  3398.  2,4:
  3399.  ic%=36 
  3400. show_menu(menu%(menunumber%),oldx%+32,oldy%+16)
  3401.  ic%=44 
  3402.  fieldmenu%=
  3403. field_menu(fields%):
  3404. tick_one(fieldmenu%,0,fields%-1,Fieldnumber%-1):
  3405. show_menu(fieldmenu%,oldx%+32,oldy%+16)
  3406.  butt%=4 
  3407.  z%=1 
  3408.  butt%=1 
  3409.  z%=-1 
  3410.  ic% 
  3411. set_limits(0,0,8,8)
  3412. set_limits(36,36,40,11)
  3413. set_limits(9,9,35,19)
  3414. set_limits(41,41,45,14)
  3415. set_limits(46,46,59,16)
  3416. change_type(z%,menunumber%)
  3417. change_type(-z%,menunumber%)
  3418. create_field(
  3419. ($InsText%),posx%,posy%,Calc$)
  3420. remove_field(Fieldnumber%,
  3421. ,Calc$)
  3422. create_field(Fieldnumber%,posx%,posy%,Calc$)
  3423. remove_field(Fieldnumber%,
  3424. ,Calc$)
  3425.  14,45,46:
  3426. icon_bit(22,createW%,13,(
  3427. selected(createW%,14)))
  3428.   F%=
  3429. ($InsText%)
  3430.  F%>0 
  3431.  F%<=fields% 
  3432. `(    
  3433.  F%<Fieldnumber% 
  3434.  Z%=-1 
  3435.  Z%=1
  3436. a(    
  3437. re_sequence(Fieldnumber%,F%,Z%)
  3438. close_window(createW%)
  3439. snap(
  3440. ($boxX%),
  3441. ($boxY%),
  3442. ($grid%))
  3443. swap_fields(Fieldnumber%,
  3444. ($InsText%))
  3445. close_it(createW%)
  3446.  42:$boxW%=
  3447. ($LenText%)*16+16):
  3448. redraw_icon(createW%,9)
  3449. update_box
  3450.  (present% 
  3451.  4)=0 
  3452. lit(menu%(9),1,(fields%>0))
  3453.  ic% 
  3454.  18,29,30:
  3455.  butt%=4 
  3456. close_window(createW%)
  3457. o        
  3458. p#    
  3459. icon_bit(22,createW%,18,
  3460. q+    
  3461. icon_bit(22,createW%,30,
  3462.  adjust%)
  3463. r#    
  3464. icon_bit(22,createW%,29,
  3465. update_box
  3466.  fieldtype% 
  3467.  0,1,2,3,4,5,6,7,46,47:
  3468.  adjust% 
  3469. icon_bit(22,createW%,6,
  3470. icon_bit(22,createW%,6,
  3471. }&num%=(fieldtype%=3 
  3472.  fieldtype%=6)
  3473. icon_bit(22,createW%,14,num%)
  3474. icon_bit(22,createW%,45,num%)
  3475. icon_bit(22,createW%,46,num%)
  3476. icon_bit(22,createW%,13,num% 
  3477. selected(createW%,14))
  3478. icon_bit(22,createW%,15,(fieldtype%=3 
  3479.  fieldtype%=47))
  3480. icon_bit(22,createW%,25,(fieldtype%=3))
  3481. icon_bit(22,createW%,26,
  3482.  adjust%)
  3483.  adjust% 
  3484. lit(menu%(9),2,(fields%>0))
  3485.  $ValText%=vname$(fieldtype%)
  3486. redraw_icon(createW%,28)
  3487. set_limits(t%,f%,l%,m%)
  3488. fieldtype%=t%
  3489. firsttype%=f%
  3490. lasttype%=l%
  3491. menunumber%=m%
  3492. tick_one(menu%(m%),0,l%-f%,t%-f%)
  3493. update_box
  3494. change_type(d%,m%)
  3495.  1:fieldtype%+=1
  3496.  fieldtype%>lasttype% 
  3497.  fieldtype%=firsttype%
  3498.  -1:fieldtype%-=1
  3499.  fieldtype%<firsttype% 
  3500.  fieldtype%=lasttype%
  3501. tick_one(menu%(m%),0,lasttype%-firsttype%,fieldtype%-firsttype%)
  3502. update_box
  3503. passwords(x%,wi%,ic%,b%)
  3504. b%=(b% 
  3505.  %111)
  3506.  1,4:
  3507.  ic% 
  3508. %    
  3509.  $Write%="" 
  3510.  $Write%=$Read%
  3511. *    
  3512.  $Manager%="" 
  3513.  $Manager%=$Write%
  3514.     F=
  3515. ($database%+".Cols")
  3516. #F=45
  3517. $    S$=
  3518. encrypt($Read%,
  3519. #F,S$
  3520. %    S$=
  3521. encrypt($Write%,
  3522. #F,S$
  3523. '    S$=
  3524. encrypt($Manager%,
  3525. #F,S$
  3526.  I%=9 
  3527. "      
  3528. selected(passW%,I%)
  3529. close_file(F)
  3530. ,    
  3531. lit(menu%(1),6,
  3532. selected(passW%,9))
  3533. -    
  3534. lit(menu%(1),8,
  3535. selected(passW%,13))
  3536. -    
  3537. lit(menu%(1),9,
  3538. selected(passW%,13))
  3539. -    
  3540. lit(menu%(1),2,
  3541. selected(passW%,14))
  3542. close_window(aclW%)
  3543. M    
  3544.  b%=4 
  3545. close_window(passW%):
  3546.  x%>=0 
  3547. set_caret(oldwin%,oldicon%)
  3548. !    
  3549. selected(passW%,9) 
  3550. !      
  3551. close_window(keypadW%)
  3552. ?      
  3553.  x%>=0 
  3554. position_window(keypadW%,100,50,0,0,0,0)
  3555.         
  3556. asterisk(
  3557.      
  3558. selected(passW%,16) 
  3559. &      
  3560. open_log("<Log$Dir>.Log",
  3561. '      
  3562. close_log("<Log$Dir>.Log")
  3563.         
  3564. :    
  3565. icon_bit(22,prefsW%,34,
  3566. selected(passW%,15))
  3567. M    
  3568. selected(passW%,16) 
  3569. write_log(-1,"Logging discontinued")
  3570. A    $
  3571. text(aclW%,0)="":$
  3572. text(aclW%,1)="":$
  3573. text(aclW%,12)=""
  3574. @    
  3575. deselect(aclW%,
  3576. selected_esg(aclW%,1)):
  3577. select(aclW%,4)
  3578. /    
  3579. open_window(aclW%):
  3580. set_caret(aclW%,0)
  3581. 4    
  3582. restore_window(wi%,remember%+winbuff%(1,1))
  3583. close_window(aclW%)
  3584. O    
  3585.  b%=4 
  3586. close_window(wi%):
  3587. set_caret(oldwin%,oldicon%) 
  3588. redraw(wi%)
  3589.  F,user$,passwd$,ok%
  3590.  (b% 
  3591.  %111) 
  3592.  ic% 
  3593. !    
  3594. close_window(aclW%)
  3595. #    
  3596. selected_esg(aclW%,1) 
  3597.       
  3598.       user$=$
  3599. text(aclW%,0)
  3600. I      
  3601. confirm(
  3602. msg("Err123,"+user$)) 
  3603. remove_user(user$,
  3604. ):ok%=
  3605.       
  3606. )      
  3607. remove_user($
  3608. text(aclW%,0),
  3609.       
  3610. 3        
  3611. text(aclW%,0)="":
  3612. softerror("",126)
  3613. B        
  3614. text(aclW%,1)<>$
  3615. text(aclW%,12):
  3616. softerror("",108)
  3617. 3        
  3618. text(aclW%,1)="":
  3619. softerror("",125)
  3620.         
  3621. -        user$=
  3622. encrypt($
  3623. text(aclW%,0),
  3624. /        passwd$=
  3625. encrypt($
  3626. text(aclW%,1),
  3627.         
  3628.  acl% 
  3629. "          F=
  3630. ("<Acl$Dir>.acl")
  3631.           
  3632. $          
  3633. ("<Acl$Dir>.acl")
  3634.           acl%=
  3635.         
  3636. 6        
  3637. #F,user$,passwd$,
  3638. selected_esg(aclW%,1)-3
  3639.         
  3640. close_file(F)
  3641.         ok%=
  3642.       
  3643.         
  3644. A    $
  3645. text(aclW%,0)="":$
  3646. text(aclW%,1)="":$
  3647. text(aclW%,12)=""
  3648. K    
  3649. redraw_icon(aclW%,0):
  3650. redraw_icon(aclW%,1)::
  3651. redraw_icon(aclW%,12)
  3652. set_caret(aclW%,0)
  3653. 6    
  3654.  (b% 
  3655.  %111)=4 
  3656.  ok%=
  3657. close_window(aclW%)
  3658. remove_user(u$,remove%)
  3659.  user$,id$,p%,p%,ptr%,F,found%
  3660.  u$<>"" 
  3661.   user$=
  3662. encrypt(u$,
  3663.  acl% 
  3664.     F=
  3665. ("<Acl$Dir>.acl")
  3666.         
  3667.       ptr%=
  3668.       
  3669. #F,id$,p$,p%
  3670.       found%=(id$=user$)
  3671.  found% 
  3672.  found% 
  3673. 1      
  3674. #F=ptr%:
  3675. (id$),"Z"),
  3676. (p$),"Z"),0
  3677. *      
  3678.  remove% 
  3679. softerror(u$,124)
  3680.         
  3681. close_file(F)
  3682. open_log(f$,resume%)
  3683.  "OS_File",5,f$ 
  3684.  d%=1 
  3685.   loghandle%=
  3686. #loghandle%=
  3687. #loghandle%
  3688.  resume% 
  3689. #loghandle%,"Logging resumed "+
  3690. #loghandle%,"Log opened "+
  3691. #loghandle%,"Database: "+$database%
  3692.   loghandle%=
  3693. #loghandle%,"Log started "+
  3694. #loghandle%,"Database: "+$database%
  3695.  acl% 
  3696. #loghandle%,"User: "+user$
  3697. #loghandle%,"Password level used: "+
  3698. (pw%)
  3699. #loghandle%,
  3700. 35,"-")
  3701. close_file(loghandle%)
  3702. logging%=
  3703. close_log(f$)
  3704.  logging% 
  3705.   loghandle%=
  3706. #loghandle%=
  3707. #loghandle%
  3708. #loghandle%,
  3709. 35,"-")
  3710. #loghandle%,"Log closed "+
  3711. #loghandle%,
  3712. 35,"=")
  3713. close_file(loghandle%)
  3714.  "OS_File",18,f$,&fff
  3715.   logging%=
  3716. write_log(record%,S$)
  3717.  loghandle%
  3718.  logging% 
  3719. ,#  loghandle%=
  3720. ("<Log$Dir>.Log")
  3721. #loghandle%=
  3722. #loghandle%
  3723.  record%>=0 
  3724. #loghandle%,"    [Record number: "+
  3725. (record%)+"]"
  3726. #loghandle%,"    "+S$
  3727. close_file(loghandle%)
  3728. count(key%,
  3729.  RU%)
  3730.  zero%,file%,top,sum%
  3731. 6    RU%=0
  3732.  file%=0 
  3733.   top=8*file%+LH%
  3734. 9"  sum%=
  3735. count_recs(key%,zero%)
  3736.   RU%+=sum%
  3737. ;%  $
  3738. text(miscW%,file%+22)=
  3739. (sum%)
  3740.  file%
  3741. count_recs(key%,
  3742.  ptr%)
  3743.  P%,count%,S%,R%,S$,k$
  3744.  "Hourglass_On"
  3745. neighbour(key%,top,1)
  3746.  P%<>top
  3747.   count%+=1
  3748.  ptr%>0 
  3749.     R%=
  3750. rec_no(k$,key%,P%)
  3751. G#    
  3752.  R%>highest% 
  3753.  highest%=R%
  3754. H1    !ptr%=R%:$(ptr%+4)=k$:ptr%+=4+KL%(key%)+1
  3755.     flagptr%?R%=0
  3756.   P%=
  3757. neighbour(key%,P%,1)
  3758.  "Hourglass_Off"
  3759. =count%
  3760. analyse(func%)
  3761.  L%,P%,S%,S$,K$,k$,ptr%,pos%,N%,values%,key%
  3762.  S$(),N%()
  3763. read_print_options
  3764.  func%<0 
  3765.  L%=6 
  3766.  key%=func%:L%=KL%(key%)
  3767.  L%>8 
  3768.  Tab%(0)=Lmargin%+L%+6 
  3769.  Tab%(0)=Lmargin%+14
  3770. Tab%(1)=Tab%(0)+6
  3771.  func%<0 
  3772. X:  Title$="Analysis of date field: "+Tag$(Fieldnumber%)
  3773. Y5  Heading$=
  3774. pad(margin$+"Month",Tab%(0))+"Number"
  3775. ZV  TextName$=$database%+".PrintJobs.DateAn"+Tag$(Fieldnumber%):$SaveName%=TextName$
  3776. \/  Title$="Analysis of index: "+Index$(key%)
  3777. ]8  Heading$=
  3778. pad(margin$+"Contents",Tab%(0))+"Number"
  3779. ^U  TextName$=$database%+".PrintJobs.IndAn"+Tag$(Fieldnumber%):$SaveName%=TextName$
  3780. Title1$=
  3781. LenLine%=
  3782. (Heading$)+2
  3783. extend_named_sliding_block(lineanchor%,LenLine%+4)
  3784. extend_named_sliding_block(headanchor%,LenLine%+4):pos%=!headanchor%
  3785. heap_store(headanchor%,LenLine%,0,pos%,0,Heading$)
  3786. reportdest$="Window"
  3787. Count%=0
  3788. list_head(0)
  3789.  "Hourglass_On"
  3790.  func%<0 
  3791. analyse_date 
  3792. analyse_index
  3793.  "Hourglass_Off"
  3794. rule_off(45)
  3795. l;Line$=
  3796. pad(margin$+"Total",Tab%(0))+
  3797. justify(
  3798. (N%),1,0)
  3799. m@$(!lineanchor%)=Line$:
  3800. list_line(-1,lineanchor%,
  3801. (Line$),32)
  3802. rule_off(45)
  3803. screen_list
  3804. analyse_index
  3805. K$="***"
  3806. neighbour(key%,top,1)
  3807.  P%<>top
  3808.     R%=
  3809. rec_no(k$,key%,P%)
  3810. w#    
  3811.  k$<>K$ 
  3812.  values%+=1:K$=k$
  3813. x     P%=
  3814. neighbour(key%,P%,1)
  3815.  S$(values%),N%(values%)
  3816. K$="***"
  3817. neighbour(key%,top,1)
  3818.  P%<>top
  3819.     R%=
  3820. rec_no(k$,key%,P%)
  3821. E    
  3822.  k$<>K$ 
  3823.  ptr%+=1:K$=k$:S$(ptr%)=K$:N%(ptr%)=1 
  3824.  N%(ptr%)+=1
  3825.      P%=
  3826. neighbour(key%,P%,1)
  3827.  I%=1 
  3828.  ptr%
  3829. I  S$=S$(I%):
  3830.  S$="" 
  3831.  S$="<null>" 
  3832.  isadate% 
  3833. reverse_date(S$)
  3834. H  Line$=margin$+S$:Line$=
  3835. pad(Line$,Tab%(0))+
  3836. justify(
  3837. (N%(I%)),1,0)
  3838. B  $(!lineanchor%)=Line$:
  3839. list_line(-1,lineanchor%,
  3840. (Line$),32)
  3841.   N%+=N%(I%)
  3842. analyse_date
  3843.  S$(12),N%(12)
  3844. YS$()="<null>","Jan","Feb","Mar","Apr","May","Jun","Jul","Aug","Sep","Oct","Nov","Dec"
  3845. *dbasehandle%=
  3846. ($database%+".Database")
  3847. neighbour(key%,top,1)
  3848.  P%<>top
  3849.   R%=
  3850. rec_no(k$,key%,P%)
  3851. readsmarray(dbasehandle%,R%)
  3852.   S$=F$(Fieldnumber%)
  3853.  S$<>"" 
  3854.     M%=
  3855. S$,4,2))
  3856.     N%(M%)+=1
  3857.  N%(0)+=1
  3858.   P%=
  3859. neighbour(key%,P%,1)
  3860. close_file(dbasehandle%)
  3861.  I%=0 
  3862. L  Line$=margin$+S$(I%):Line$=
  3863. pad(Line$,Tab%(0))+
  3864. justify(
  3865. (N%(I%)),1,0)
  3866. B  $(!lineanchor%)=Line$:
  3867. list_line(-1,lineanchor%,
  3868. (Line$),32)
  3869.   N%+=N%(I%)
  3870. update_stats
  3871. $filesize%=
  3872. (RA%)
  3873. $Records%=
  3874. (RA%)
  3875. $used%=
  3876. (RU%)
  3877. #$percent%=
  3878. (RU%*100/RA%))+"%"
  3879.  Keypress processing --------------------------------------------------
  3880. set_keyboard(wi%,ic%)
  3881. selected(prefsW%,21) 
  3882.  wi% 
  3883.  mainW%:
  3884.  chartype%((ic%+1) 
  3885. -    
  3886.  Leave keyboard status unchanged
  3887. $    
  3888.  2,4:
  3889.  "OS_Byte",202,0,239
  3890. !    
  3891.  "OS_Byte",202,16,111
  3892.  accessW%:
  3893.  uc% 
  3894.  "OS_Byte",202,0,239 
  3895.  "OS_Byte",202,caps%,111
  3896.  "OS_Byte",202,caps%,111
  3897.  "OS_Byte",118
  3898. process_key
  3899.  printing% 
  3900.  indexing% 
  3901.  N$,T%
  3902.  "Wimp_GetCaretPosition",,block%
  3903. 4wi%=block%!0:ic%=block%!4:key_pressed%=block%!24
  3904.  T%=0 
  3905.  LastTable%
  3906.  wi%=tableW%(T%) 
  3907.  Tablenumber%=T%
  3908.  key_pressed% 
  3909. store
  3910. retrieve
  3911.  wi% 
  3912.  mainW%:
  3913. main_press(wi%,ic%)
  3914.  passW%:
  3915. dbox_press(4,18,0,0,0)
  3916.  aclW%:
  3917. dbox_press(9,11,0,0,0)
  3918.  changeW%:
  3919. dbox_press(3,6,queryW%,0,0)
  3920.  tabcreateW%:
  3921. dbox_press(2,3,scrollW%,0,MaxCols%*2+1)
  3922.  scrollW%:
  3923. scroll_press
  3924.  saveW%,savesubW%:
  3925. dbox_press(1,3,0,0,0)
  3926.  tableW%(Tablenumber%):
  3927. table_press(Tablenumber%)
  3928.  printW%:
  3929. dbox_press(20,52,0,0,0)
  3930.  labelW%:
  3931. dbox_press(15,19,0,0,0)
  3932.  createW%:
  3933. create_press
  3934.  accessW%:
  3935. dbox_press(3,2,0,0,0)
  3936.  keyW%:
  3937. dbox_press(31,36,0,0,0)
  3938.  matchW%:
  3939. dbox_press(0,6,0,0,0)
  3940.  moveW%:
  3941. dbox_press(7,11,0,0,0)
  3942.  calcW%:
  3943. dbox_press(1,-1,0,0,0)
  3944.  mergeW%:
  3945. dbox_press(6,7,queryW%,0,0)
  3946.  sizeW%:
  3947. dbox_press(4,5,0,0,0)
  3948.  csvW%:
  3949. dbox_press(9,10,0,0,0)
  3950.  prefsW%:
  3951. dbox_press(39,40,0,0,0)
  3952.  searchW%:
  3953.  key_pressed%=15 
  3954. #    
  3955. search_click(searchW%,9,4)
  3956. !    
  3957. dbox_press(8,10,0,0,0)
  3958.  helpW%:
  3959. dbox_press(7,20,0,0,0)
  3960.  queryW%:
  3961. query_press
  3962.  keypadW%:
  3963. special_press
  3964. query_press
  3965.  window%
  3966. window%=-1
  3967.   window%+=1
  3968.    wi%=actionbutt%(window%,0)
  3969.  wi%=oldquery%
  3970.  key_pressed% 
  3971. mouse(0,0,4,wi%,actionbutt%(window%,1))
  3972. query_click(queryW%,2,4)
  3973. shut_window(wi%):
  3974. set_caret(mainW%,starthere%)
  3975.  398:
  3976.  wi% 
  3977. $    
  3978.  changeW%:
  3979. set_caret(wi%,0)
  3980. $    
  3981.  mergeW%:
  3982. set_caret(wi%,14)
  3983.  399:
  3984.  wi% 
  3985. $    
  3986.  changeW%:
  3987. set_caret(wi%,1)
  3988. $    
  3989.  mergeW%:
  3990. set_caret(wi%,14)
  3991.  385,386,387,388,389,390,391,392,393,401,402,403,404,405,406,407,408,409,417,418,419,420,421,422,423,424,425,433,434.435,436,437,438,439,440,441,458,474,490,506,459,475,491,507:
  3992. button_action(key_pressed%)
  3993.  "Wimp_ProcessKey",key_pressed%
  3994. main_press(wi%,ic%)
  3995. selected(passW%,10) 
  3996.  "Wimp_ProcessKey",key_pressed%:
  3997.  icon%
  3998.  flash% 
  3999. deselect(wi%,field%(flash%)):flash%=
  4000. trim(wi%,ic%)
  4001.  key_pressed%<>392 
  4002. validate(Fieldnumber%,T%,N$)=
  4003.  changed%=
  4004. update_calcs(Fieldnumber%)
  4005.  key_pressed% 
  4006. select_range(1,fields%,
  4007.  len%(Fieldnumber%)>=10 
  4008. +    $Rf%(Fieldnumber%)=
  4009. convert_date(4)
  4010. G    
  4011.  len%(Fieldnumber%)>=8 
  4012.  $Rf%(Fieldnumber%)=
  4013. convert_date(2)
  4014. redraw_icon(wi%,field%(Fieldnumber%))
  4015.  5:template%=1:
  4016. display(key%,-1)
  4017.  "Wimp_GetPointerInfo",,block%:
  4018. show_menu(fieldmenu%,!block%-150,block%!4+16)
  4019. 3  $Query%="":$ChangeTitle%="Field: "+Fieldname$
  4020. position_window(changeW%,0,0,0,0,0,0):
  4021. set_caret(changeW%,0)
  4022. set_up_field_menu
  4023. @  keyfunc$="Index field":$KeyTitle%=keyfunc$+": "+Fieldname$
  4024. shade_key_icons(
  4025. deselect(keyW%,30):
  4026. deselect(keyW%,35):
  4027. deselect(keyW%,37)
  4028. position_window(keyW%,0,0,0,504,0,0):
  4029. set_caret(keyW%,13)
  4030. 0  keyfunc$="Current key":$KeyTitle%=keyfunc$
  4031. set_keydata(key%):
  4032. shade_key_icons(
  4033. position_window(keyW%,0,0,0,504,0,0)
  4034. set_up_field_menu:
  4035. position_window(linkW%,0,0,0,0,0,0)
  4036.  Fieldnumber%=fields% 
  4037. close_window(relateW%)
  4038. display(key%,-1)
  4039. #        
  4040. $        
  4041. %A      Fieldnumber%+=1:
  4042.  Fieldnumber%>fields% 
  4043.  Fieldnumber%=1
  4044. &$      c%=chartype%(Fieldnumber%)
  4045. '.    
  4046.  len%(Fieldnumber%)>0 
  4047.  (c%<6 
  4048.  c%=8)
  4049. ("    icon%=field%(Fieldnumber%)
  4050. set_caret(wi%,icon%)
  4051. *,    
  4052. selected(prefsW%,19) 
  4053. relations
  4054.  filter% 
  4055. .P    
  4056.  field%(buttonfield%(0,22))>0 
  4057. filter(mainW%,
  4058. filter(keypadW%,
  4059. match(0,0)
  4060. query_click(queryW%,2,4)
  4061.  9:*Indices
  4062.  16:*JobsDone
  4063.  17:*Tables
  4064.  18:*Resources
  4065.  19:starthere%=field%(Fieldnumber%):
  4066.  Access% 
  4067. set_caret(mainW%,starthere%)
  4068.  len%(Fieldnumber%)>=8 
  4069.     T$=
  4070. :-    
  4071. T$,3,1)=$timesep%:
  4072. T$,6,1)=$timesep%
  4073.     $Rf%(Fieldnumber%)=T$
  4074. <.    
  4075. redraw_icon(wi%,field%(Fieldnumber%))
  4076. clear_selection
  4077. keypad_click(keypadW%,1,4)
  4078. close_it(linkW%):
  4079. close_it(keyW%):
  4080. close_it(csvW%)
  4081.  384:
  4082. match(0,0)
  4083.  394:
  4084. selected(passW%,9) 
  4085. position_window(keypadW%,250,100,0,0,0,0)
  4086.  398:
  4087. G?    Fieldnumber%+=1:
  4088.  Fieldnumber%>fields% 
  4089.  Fieldnumber%=1
  4090. H"    c%=chartype%(Fieldnumber%)
  4091.  len%(Fieldnumber%)>0 
  4092.  (c%<6 
  4093.  c%=8)
  4094. J   icon%=field%(Fieldnumber%)
  4095. set_caret(wi%,icon%)
  4096. selected(prefsW%,19) 
  4097. relations
  4098.  399:
  4099. O?    Fieldnumber%-=1:
  4100.  Fieldnumber%<1 
  4101.  Fieldnumber%=fields%
  4102. P"    c%=chartype%(Fieldnumber%)
  4103.  len%(Fieldnumber%)>0 
  4104.  (c%<6 
  4105.  c%=8)
  4106. R   icon%=field%(Fieldnumber%)
  4107. set_caret(wi%,icon%)
  4108. selected(prefsW%,19) 
  4109. relations
  4110.  400:
  4111. select(printW%,51):
  4112. deselect(printW%,50)
  4113. position_window(printW%,0,0,0,0,0,0):
  4114. set_caret(printW%,16)
  4115.  416:
  4116. print_this
  4117.  385,386,387,388,389,390,391,392,393,401,402,403,404,405,406,407,408,409,417,418,419,420,421,422,423,424,425,433,434.435,436,437,438,439,440,441,458,474,490,506,459,475,491,507:
  4118. button_action(key_pressed%)
  4119.  "Wimp_ProcessKey",key_pressed%
  4120. selected(prefsW%,21) 
  4121.  chartype%(Fieldnumber%) 
  4122. ^-    
  4123.  Leave keyboard status unchanged
  4124. _$    
  4125.  2,4:
  4126.  "OS_Byte",202,0,239
  4127. `!    
  4128.  "OS_Byte",202,16,111
  4129.  "OS_Byte",118
  4130.  "OS_Byte",15,0
  4131. button_action(K%)
  4132. check_change
  4133. button%=
  4134. key_assigned(K%)
  4135.  button% 
  4136.  ### No action ###
  4137. selected(passW%,9) 
  4138. nO    
  4139. invert(keypadW%,button%):
  4140. filter(keypadW%,
  4141. selected(keypadW%,button%))
  4142. o        
  4143. p+    ic%=field%(buttonfield%(0,button%))
  4144. qB    
  4145.  ic%>0 
  4146. invert(wi%,ic%):
  4147. filter(wi%,
  4148. selected(wi%,ic%))
  4149.  13,23:
  4150.  button%=23 
  4151.  e%=-1:button%=13 
  4152.  e%=1
  4153. invert(keypadW%,button%)
  4154. selected(passW%,9) 
  4155. w"    
  4156. allow_search(keypadW%,e%)
  4157. xE    
  4158.  field%(buttonfield%(0,button%))>0 
  4159. allow_search(wi%,e%)
  4160. invert(keypadW%,button%)
  4161. shaded(keypadW%,button%) 
  4162. }!    
  4163. invert(keypadW%,button%)
  4164. ~&    
  4165. mouse(0,0,4,keypadW%,button%)
  4166. !    
  4167. invert(keypadW%,button%)
  4168. key_assigned(pressed%)
  4169.     I%=-1
  4170.   I%+=1
  4171.  I%=23 
  4172.  buttonfield%(1,I%)=pressed%
  4173.  buttonfield%(1,I%)=pressed% 
  4174. dbox_press(ok%,esc%,wi2%,down%,up%)
  4175. trim(wi%,ic%)
  4176.  wi% 
  4177.  accessW%:
  4178.  key_pressed% 
  4179. M    
  4180. next_writable(wi%,ic%,1,1,wi2%,down%) 
  4181. mouse(0,0,4,wi%,ok%)
  4182. #    
  4183. mouse(0,0,4,wi%,esc%)
  4184. 7    
  4185.  398:f%=
  4186. next_writable(wi%,ic%,1,0,wi2%,down%)
  4187. 6    
  4188.  399:f%=
  4189. next_writable(wi%,ic%,-1,0,wi2%,up%)
  4190. +    
  4191.  "Wimp_ProcessKey",key_pressed%
  4192.  key_pressed% 
  4193. selected(prefsW%,41) 
  4194. next_writable(wi%,ic%,1,1,wi2%,down%) 
  4195. mouse(0,0,4,wi%,ok%):
  4196. set_caret(mainW%,starthere%)
  4197. A    
  4198. mouse(0,0,4,wi%,esc%):
  4199. set_caret(mainW%,starthere%)
  4200. 7    
  4201.  398:f%=
  4202. next_writable(wi%,ic%,1,0,wi2%,down%)
  4203. 6    
  4204.  399:f%=
  4205. next_writable(wi%,ic%,-1,0,wi2%,up%)
  4206. #    
  4207.  wi%=tabcreateW% 
  4208.  ic%=0 
  4209. :      $tabcol%=
  4210. (MaxCols%):
  4211. redraw_icon(tabcreateW%,8)
  4212. ;      !block%=scrollW%:
  4213.  "Wimp_GetWindowState",,block%
  4214. =      block%!24=-MaxCols%*44:
  4215.  "Wimp_OpenWindow",,block%
  4216.         
  4217.  385,386,387,388,389,390,391,392,393,401,402,403,404,405,406,407,408,409,417,418,419,420,421,422,423,424,425,433,434.435,436,437,438,439,440,441,458,474,490,506,459,475,491,507:
  4218. $    
  4219. button_action(key_pressed%)
  4220. +    
  4221.  "Wimp_ProcessKey",key_pressed%
  4222. scroll_press
  4223.  row%
  4224. trim(wi%,ic%)
  4225.  key_pressed% 
  4226.  13,398:f%=
  4227. next_writable(wi%,ic%,1,0,tabcreateW%,0)
  4228.  399:f%=
  4229. next_writable(wi%,ic%,-1,0,tabcreateW%,8)
  4230.  "Wimp_ProcessKey",key_pressed%
  4231.  "Wimp_GetCaretPosition",,block%
  4232.  !block%=scrollW% 
  4233.  ic%=block%!4 
  4234.  ic%=0
  4235. row%=ic% 
  4236. 0$tabcol%=
  4237. (row%):
  4238. redraw_icon(tabcreateW%,8)
  4239. 5!block%=scrollW%:
  4240.  "Wimp_GetWindowState",,block%
  4241.  scrollrow%=-(block%!24 
  4242.  row%-scrollrow%>4 
  4243.  block%!24=(4-row%)*44:
  4244.  "Wimp_OpenWindow",,block%
  4245.  row%<scrollrow% 
  4246.  block%!24=-row%*44:
  4247.  "Wimp_OpenWindow",,block%
  4248. table_press(T%)
  4249.  icons%,row%,scrollrow%,visible_rows%
  4250. trim(wi%,ic%)
  4251. icons%=Rows%*(TabFields%+1)
  4252.  key_pressed% 
  4253.  ic%<icons%-1 
  4254.  ic%+=1 
  4255.  ic%=0
  4256.  398:
  4257.  ic%<icons%-TabFields%-1 
  4258.  ic%+=(TabFields%+1) 
  4259.  ic%=ic% 
  4260.  (TabFields%+1)
  4261.  399:
  4262.  ic%>=TabFields%+1 
  4263.  ic%-=(TabFields%+1) 
  4264.  ic%=icons%-TabFields%-1+ic% 
  4265.  (TabFields%+1)
  4266.  "Wimp_ProcessKey",key_pressed%
  4267. set_caret(tableW%(T%),ic%)
  4268. 'row%=(ic% 
  4269.  (TabFields%+1))-NewTab%
  4270. 8!block%=tableW%(T%):
  4271.  "Wimp_GetWindowState",,block%
  4272. -visible_rows%=(block%!16-block%!8) 
  4273.  44-1
  4274.  scrollrow%=-(block%!24 
  4275.  row%-scrollrow%>visible_rows% 
  4276.  block%!24=(visible_rows%-row%)*44:
  4277.  "Wimp_OpenWindow",,block%
  4278.  row%<scrollrow% 
  4279.  block%!24=-row%*44:
  4280.  "Wimp_OpenWindow",,block%
  4281. create_press
  4282. shaded(wi%,29):
  4283. shaded(wi%,18) 
  4284. dbox_press(18,41,0,0,0)
  4285. shaded(wi%,29) 
  4286. dbox_press(29,41,0,0,0)
  4287. menu_select
  4288.  handle%,P%,Q%,I%,M%,field%,umenu%
  4289. &choice1%=!block%:choice2%=block%!4
  4290. (choice3%=block%!8:choice4%=block%!12
  4291.  M%=0 
  4292.  MaxMenus%
  4293.  menuhandle%=usermenu%(M%,1) 
  4294.  umenu%=menuhandle%:field%=usermenu%(M%,0)
  4295.  "Wimp_DecodeMenu",,menuhandle%,block%,choices%
  4296.  I%=1 
  4297.   Q%=
  4298. $choices%,".",P%+1)
  4299. &  choice$(I%)=
  4300. $choices%,P%,Q%-P%)
  4301.   P%=Q%+1
  4302.  "Wimp_GetPointerInfo",,block%
  4303. x%=!block%:y%=block%!4
  4304. redo%=block%!8=1
  4305.  menuhandle% 
  4306.  menu%(0):
  4307. act_on_icon_bar_menu
  4308.  menu%(1):
  4309. act_on_main_menu
  4310.  menu%(9):
  4311. act_on_create_menu
  4312.  menu%(17):
  4313. act_on_table_menu(choice$(1))
  4314.  menu%(18):
  4315. act_on_text_menu
  4316.  menu%(15):
  4317. act_on_csv_sep
  4318.  menu%(20):
  4319. act_on_csv_term
  4320.  menu%(8),menu%(11),menu%(14),menu%(16),menu%(19):
  4321. act_on_fieldtype_menus
  4322.  menu%(23):
  4323. act_on_keypad_menu
  4324.  tablemenu%::
  4325. act_on_menu_of_tables
  4326.  fieldmenu%:
  4327. act_on_menu_of_fields
  4328.  umenu%:
  4329. 2  menic%=umenu%+28+choice1%*24:flags%=menic%!8
  4330.  (flags% 
  4331.  (1<<8))=0 
  4332. !    choice$=
  4333. $(menic%+12),12)
  4334.  choice$=$(menic%!12)
  4335.  fix%(field%)<>0 
  4336.  choice$=
  4337. fix_point(choice$,field%)
  4338. (choice$)<=len%(field%) 
  4339.     $Rf%(field%)=choice$
  4340. +    
  4341. redraw_icon(mainW%,field%(field%))
  4342. )    
  4343. set_caret(mainW%,field%(field%))
  4344. )    
  4345. softerror(""""+choice$+"""",7)
  4346. special_select
  4347.  quit% 
  4348.  redo% 
  4349. show_menu(menuhandle%,menux%,menuy%)
  4350. act_on_main_menu
  4351.  choice$(1) 
  4352.  "CSV options"
  4353.   $CSVTitle%=choice$(1)
  4354. icon_bit(22,csvW%,0,
  4355. text(csvW%,9)="Accept"
  4356. position_window(csvW%,x%-350,y%-180,700,390,0,0)
  4357.  "Miscellaneous":
  4358. act_on_misc_menu
  4359.  "Print":
  4360. act_on_print_menu
  4361.  "Validation":
  4362. act_on_validation_menu
  4363.  "Current key":
  4364. /  $KeyTitle%=choice$(1):keyfunc$=choice$(1)
  4365. set_keydata(key%):
  4366. shade_key_icons(
  4367. position_window(keyW%,x%-284,y%-252,0,504,0,0)
  4368.  "Show keypad":
  4369. selected(passW%,9) 
  4370. position_window(keypadW%,-1,-1,0,0,0,0)
  4371.  "Export subset":
  4372. ?  export%=
  4373. :$SubTitle%="Export subset":savefunc$=choice$(1)
  4374. /  $SubName%=$database%+".PrintJobs.!Subset"
  4375. /  $SubSprite%="snew_appl;Pptr_hand,12,8;R2"
  4376.   $Query%=""
  4377. position_window(savesubW%,x%-244,y%-161,0,0,0,0):
  4378. set_caret(savesubW%,2)
  4379.  "Export CSV":
  4380. 7  $SubTitle%="Export CSV file":savefunc$=choice$(1)
  4381.  sep$="," 
  4382.  t$="dfe":f$="CSV" 
  4383.  t$="fff":f$="Sep"
  4384. !2  $SubName%=$database%+".PrintJobs."+f$+"file"
  4385. "2  $SubSprite%="sfile_"+t$+";Pptr_hand,12,8;R2"
  4386.   $Query%=""
  4387. position_window(savesubW%,x%-244,y%-161,0,0,0,0):
  4388. set_caret(savesubW%,2)
  4389.  "Undo changes":
  4390. restore_rec
  4391.  "Help":
  4392.  "Wimp_StartTask","<Pbase$Dir>.!Help"
  4393. act_on_field_menu
  4394. act_on_misc_menu
  4395.  choice$(2) 
  4396.  "Move/delete":
  4397. icon_bit(22,moveW%,6,
  4398. deselect(moveW%,
  4399. selected_esg(moveW%,1)):
  4400. select(moveW%,2)
  4401.   $Query%=""
  4402. position_window(moveW%,x%-253,y%-232,0,0,0,0):
  4403. set_caret(queryW%,0)
  4404.  "Set passwords":
  4405. position_window(passW%,x%-213,y%-388,0,0,0,0):
  4406. set_caret(passW%,2)
  4407.  "Edit template":template%=1:
  4408. display(key%,-1)
  4409.  "Name subfile":
  4410.  choice3% 
  4411. 7H    P%=
  4412. $RecInfo%,"Record")-1:$RecInfo%=$Subfilename%+
  4413. $RecInfo%,P%)
  4414. 8&    $Subfile%(file%)=$Subfilename%
  4415. asterisk(
  4416. act_on_print_menu
  4417.  choice$(2) 
  4418.  "Match":
  4419. match(x%-396,y%-131)
  4420.  "Show resources":*Resources
  4421.  "Options":
  4422. select(printW%,51):
  4423. deselect(printW%,50)
  4424. position_window(printW%,x%-458,y%-401,0,0,0,0):
  4425. set_caret(printW%,16)
  4426.  "Save query":
  4427. F-  $SaveName%=$database%+".PrintRes.Query"
  4428. G2  savefunc$=choice$(2):
  4429. save_click(saveW%,1,4)
  4430.  "Save selection":
  4431. I1  $SaveName%=$database%+".PrintRes.Selection"
  4432. J2  savefunc$=choice$(2):
  4433. save_click(saveW%,1,4)
  4434.  "Show jobs done":*JobsDone
  4435.  "Clear selection":
  4436. clear_selection
  4437.  "Select all":
  4438. select_range(1,fields%,
  4439.  "Numeric fields":
  4440. match(x%-396,y%-131)
  4441. act_on_validation_menu
  4442.  choice$(2) 
  4443.  "Create table":
  4444. VD  $
  4445. text(tabcreateW%,0)="":$
  4446. text(tabcreateW%,1)="":$tabcol%="0"
  4447.  I%=0 
  4448.  MaxCols%*2+1
  4449.     $
  4450. text(scrollW%,I%)=""
  4451. set_icon_cols(tabcreateW%,13,&28)
  4452. set_icon_cols(tabcreateW%,14,&07)
  4453. position_window(tabcreateW%,x%-241,y%-301,0,0,0,0):
  4454. set_caret(tabcreateW%,0)
  4455.  "Display table":
  4456.  choice3%>=0 
  4457.     Tablenumber%=choice3%
  4458. `!    
  4459. show_table(Tablenumber%)
  4460.  "Show table files":*Tables
  4461. act_on_field_menu
  4462.  choice$(2) 
  4463.  "Index field":
  4464. i=  keyfunc$=choice$(2):$KeyTitle%=keyfunc$+": "+Fieldname$
  4465. shade_key_icons(
  4466. deselect(keyW%,30):
  4467. deselect(keyW%,35):
  4468. deselect(keyW%,37)
  4469. position_window(keyW%,x%-284,y%-252,0,504,0,0):
  4470. set_caret(keyW%,13)
  4471.  "Analyse index":
  4472. analyse(
  4473. is_a_key(Fieldnumber%))
  4474.  "Analyse months":
  4475. analyse(-1)
  4476.  "Link to table":
  4477. position_window(linkW%,x%-350,y%-129,0,0,0,0)
  4478.  "Calculations","Combine fields":
  4479. position_window(calcW%,0,0,0,0,0,0):
  4480. set_caret(calcW%,0)
  4481.  "Global changes":$Query%="":
  4482. position_window(changeW%,x%-252,y%-214,0,0,0,0):
  4483. set_caret(changeW%,0)
  4484.  "Start editing":
  4485. s%  starthere%=field%(Fieldnumber%)
  4486.  Access% 
  4487. set_caret(mainW%,starthere%)
  4488.  "Remove external":
  4489.  chartype%(Fieldnumber%)=35 
  4490.  link$(Fieldnumber%)="" 
  4491. delete_blob(Fieldnumber%,object$,mainW%,field%(Fieldnumber%))
  4492.  chartype%(Fieldnumber%)=40 
  4493. xM    
  4494. show_picture(Fieldnumber%):
  4495. redraw_icon(mainW%,field%(Fieldnumber%))
  4496.  "Undo changes":
  4497. restore(Fieldnumber%,"",-1)
  4498. act_on_keypad_menu
  4499.  choice$(1) 
  4500.  "Defaults":
  4501. load_fkeys("DFkeys")
  4502.  "Save choices":
  4503. save_fkeys
  4504.  "List keys":
  4505. list_fkeys
  4506. act_on_csv_sep
  4507.  choice$(1) 
  4508.  "Comma":sep$=","
  4509.  "TAB":sep$=
  4510.  "CR":sep$=
  4511.  "LF":sep$=
  4512.  sep$=$Delim%
  4513. tick_one(menuhandle%,0,3,choice1%)
  4514. text(csvW%,14)=choice$(1)
  4515. redraw_icon(csvW%,14)
  4516. act_on_csv_term
  4517.  choice$(1) 
  4518.  "CR":term$=
  4519.  "LF":term$=
  4520.  "CR LF":term$=
  4521. (13)+
  4522.  "LF CR":term$=
  4523. (10)+
  4524.  "CR CR":term$=
  4525. (13)+
  4526.  "LF LF":term$=
  4527. (10)+
  4528. :term$=$Termin%
  4529. tick_one(menuhandle%,0,5,choice1%)
  4530. text(csvW%,15)=choice$(1)
  4531. redraw_icon(csvW%,15)
  4532. act_on_text_menu
  4533. choice$(1),4) 
  4534.  "Save":
  4535.   $SaveName%=TextName$
  4536. 0  $SaveSprite%="sfile_fff;Pptr_hand,12,8;R2"
  4537. 2  savefunc$=choice$(1):
  4538. save_click(saveW%,1,4)
  4539.  "Sort":
  4540. sort_list(sort_textcol%)
  4541.  "Scra":
  4542. lose_list
  4543. act_on_create_menu
  4544.  choice$(1) 
  4545.  "Design field":
  4546. position_window(createW%,x%-425,y%-320,0,0,0,0):
  4547. set_caret(createW%,4)
  4548.  "Save form file":
  4549. #  $SaveName%=$database%+".Form"
  4550. 2  savefunc$=choice$(1):
  4551. save_click(saveW%,1,4)
  4552.  "Default database":
  4553. save_form($database%+".Form")
  4554. first_field>0 
  4555. default_key
  4556. #    
  4557. defaults($database%,100,0)
  4558. softerror("",35)
  4559.  "Primary key":
  4560. %  fieldmenu%=
  4561. field_menu(fields%)
  4562. >  starthere%=field%(
  4563. first_field):Lastwritable%=starthere%
  4564.   $KeyTitle%=choice$(1)
  4565.   keyfunc$=choice$(1)
  4566.    case%(0)=
  4567. set_keydata(0)
  4568. shade_key_icons(
  4569. icon_bit(22,keyW%,37,
  4570. position_window(keyW%,x%-284,y%-252,0,504,0,0):
  4571. set_caret(keyW%,13)
  4572.  "Quit design":
  4573. adjust_on(
  4574. save_form($database%+".Form")
  4575. save_calcs
  4576. get_it_in($database%)
  4577. act_on_fieldtype_menus
  4578. "fieldtype%=firsttype%+choice1%
  4579. tick_one(menuhandle%,0,lasttype%-firsttype%,choice1%)
  4580. update_box
  4581. act_on_menu_of_tables
  4582. Tablenumber%=choice1%
  4583. $$Tablename%=table$(Tablenumber%)
  4584. tick_one(menuhandle%,0,LastTable%,choice1%)
  4585. redraw_icon(linkW%,0)
  4586. act_on_menu_of_fields
  4587.  fieldfunc$ 
  4588.  "create":
  4589. design_field(2,choice1%*2+1,
  4590.  "help":
  4591.   Match_tag%=choice1%+1
  4592. text(helpW%,0)=Tag$(Match_tag%):
  4593. redraw_icon(helpW%,0)
  4594. tick_one(fieldmenu%,0,fields%-1,choice1%)
  4595.  "0","1","2","3":
  4596.   keyfield%=
  4597. (fieldfunc$)
  4598.  keyfunc$<>"Current key" 
  4599. (    
  4600. ticked(fieldmenu%,choice1%) 
  4601. O      keyfield%(keyfield%)=0:
  4602. kcycle(keyfield%(keyfield%),4*keyfield%+12,0)
  4603.       
  4604. X      keyfield%(keyfield%)=choice1%+1:
  4605. kcycle(keyfield%(keyfield%),4*keyfield%+12,0)
  4606.         
  4607. act_on_table_menu(ch$)
  4608. *Tablenumber%=
  4609. table_number($menu%(17))
  4610.  ch$="Save":
  4611. 4  $SaveName%=$database%+".ValTables."+$menu%(17)
  4612. 4  savefunc$="Save table":
  4613. save_click(saveW%,1,4)
  4614.  ch$="Clear":
  4615. clear_table(Tablenumber%)
  4616.  ch$="Print":
  4617. print_table(Tablenumber%)
  4618. ch$,4)="Sort":
  4619. sort_table(Tablenumber%,sort_tabcol%)
  4620.  ch$="Undo all":
  4621. restore_table(Tablenumber%)
  4622.  ch$="Undo change":
  4623. restore_tabfield
  4624.  ch$="Save as CSV":
  4625. 4  $SaveName%=$database%+".PrintJobs."+$menu%(17)
  4626. 1  savefunc$="Save table as CSV":writetable%=
  4627. save_click(saveW%,1,4)
  4628.  ch$="Modify":
  4629. modify_table(Tablenumber%,tabcreateW%)
  4630. act_on_icon_bar_menu
  4631.  choice$(1) 
  4632.  "Help":
  4633.  "Wimp_StartTask","<Pbase$Dir>.!Help"
  4634.  "Utilities":
  4635.  choice$(2) 
  4636.  "New primary key":
  4637.     $KeyTitle%=choice$(2)
  4638. +    keyfunc$=choice$(2):
  4639. set_keydata(0)
  4640.  (present% 
  4641.  2)=2 
  4642. /      
  4643. select(keyW%,32):
  4644. deselect(keyW%,33)
  4645. ;      
  4646. icon_bit(22,keyW%,32,
  4647. icon_bit(22,keyW%,33,
  4648.       
  4649.     /      
  4650. select(keyW%,33):
  4651. deselect(keyW%,32)
  4652. ;      
  4653. icon_bit(22,keyW%,32,
  4654. icon_bit(22,keyW%,33,
  4655.         
  4656. 4    
  4657. shade_key_icons(
  4658. icon_bit(22,keyW%,37,
  4659. L    
  4660. position_window(keyW%,x%-284,y%-303,0,606,0,0):
  4661. set_caret(keyW%,13)
  4662.  "New record format":
  4663. close_window(reformW%)
  4664. 5    reform$="Reformat":$
  4665. text(reformW%,6)=reform$
  4666. *    $RefmTitle%="Change record format"
  4667. "    
  4668. icon_bit(22,reformW%,6,
  4669. 7    
  4670. position_window(reformW%,x%-237,100,0,236,0,0)
  4671.         
  4672.  "Adjust format":
  4673. adjust_on(
  4674. open_window(mainW%)
  4675. display(key%,-1)
  4676. 3    
  4677. alter_flags(&07016711,&07006535,&1700653F)
  4678.  "Merge database":
  4679. close_window(reformW%)
  4680. 2    reform$="Merge":$
  4681. text(reformW%,6)=reform$
  4682. $    $RefmTitle%="Merge database"
  4683. "    
  4684. icon_bit(22,reformW%,6,
  4685. 7    
  4686. position_window(reformW%,x%-237,100,0,400,0,0)
  4687.  (    
  4688.  "Balance index":
  4689. balance(key%)
  4690.  "Print index":
  4691.  choice$(3) 
  4692.       
  4693.  "Complete":
  4694. $'      
  4695. print_tree(key%,file%,"ALL")
  4696.       
  4697.  "Totals only":
  4698. &*      
  4699. print_tree(key%,file%,"TOTALS")
  4700. '        
  4701. (-    
  4702.  "Find duplicates":
  4703. duplicates(key%)
  4704.  "Close database":
  4705.  "Preferences":
  4706. position_window(prefsW%,x%-371,150,0,0,0,0):
  4707. set_caret(prefsW%,1)
  4708.  "Quit":quit%=
  4709. init_drag(wi%,ic%,dragtype%)
  4710. getscreensize(W%,H%,V%)
  4711. !block%=wi%
  4712.  "Wimp_GetWindowState",,block%
  4713. ysize%=block%!16-block%!8
  4714. x%=block%!4-block%!20
  4715. y%=block%!16-block%!24
  4716. block%!4=ic%
  4717.  "Wimp_GetIconState",,block%
  4718. block%!8+=x%:minx%=block%!8
  4719. :!block%!12+=y%:miny%=block%!12
  4720. ;!block%!16+=x%:maxx%=block%!16
  4721. <!block%!20+=y%:maxy%=block%!20
  4722.  dragtype%=6 
  4723. >5  block%!24=2*minx%-maxx%:block%!36=2*maxy%-miny%
  4724.  block%!24=0:block%!36=H%
  4725. block%!28=0
  4726. block%!32=W%
  4727. !block%=0
  4728. block%!4=dragtype%
  4729. dragging%=
  4730.  wi% 
  4731.  saveW%,savesubW%:
  4732.  wi%=saveW% 
  4733.  sprite$=
  4734. $SaveSprite%,2,8) 
  4735.  sprite$=
  4736. $SubSprite%,2,8)
  4737.  "DragASprite_Start",&C5,1,sprite$,block%+8
  4738.  "Wimp_DragBox",,block%
  4739.  wi%=mainW% 
  4740.  ficon%=ic%
  4741. end_drag(start%,end%)
  4742.  wi%,ic%
  4743. dragging%=
  4744. datasize%=end%-start%
  4745.  "Wimp_GetPointerInfo",,block%
  4746. wi%=block%!12:ic%=block%!16
  4747. V7block%!32=block%!4:block%!28=block%!0:block%!24=ic%
  4748. W+block%!20=wi%:block%!24=ic%:block%!16=1
  4749. X3block%!12=0:block%!36=datasize%:block%!40=Type%
  4750.  design% 
  4751.  dragbutt%>0 
  4752. adjust_field(dragbutt%)
  4753.  Filename$<>"" 
  4754.  wi%<>mainW% 
  4755. ]%    $(block%+44)=
  4756. leaf(Filename$)
  4757.     !block%=60
  4758. _/    
  4759.  "Wimp_SendMessage",17,block%,wi%,ic%
  4760.     ramptr%=start%
  4761. a     
  4762.  "Wimp_CreateMenu",,-1
  4763. encrypt(S$,Z%)
  4764.  I%,R%
  4765. (-12817)
  4766.  I%=1 
  4767. S$,I%,1)>"@" 
  4768.     R%=
  4769. (58)-1
  4770.  R%=58-R%
  4771. m1    
  4772. S$,I%,1)=
  4773. S$,I%,1))-65+R%) 
  4774.  58+65)
  4775. leaf(s$)
  4776. s2$=""
  4777. s$)<>"." 
  4778.  s$<>""
  4779.   s2$=
  4780. s$)+s2$
  4781.   s$=
  4782. dbasepath$=
  4783.  Message handling ----------------------------------------------------
  4784. not_acknowledged
  4785.  block%!16 
  4786.  DataOpen failed, so run file
  4787.  block%!8=Impref% 
  4788.  Imp_wait%=
  4789.  "Wimp_StartTask",$(block%+44)
  4790.  RAMTransmit failed
  4791.  merging% 
  4792.  moan_err%,
  4793. msg("Err39")
  4794.  At this point, the message ought to have been sent by us, so check it
  4795.  Very bizarre situation if you get this error (!!)
  4796.  block%!8<>myref% 
  4797.  moan_err%,"Reference fields mismatch (msglost/DataLoad)"
  4798.  If transfer marked as temporary, delete scrap file
  4799.  block%!36=-1 
  4800.  "OS_File",6,block%+44
  4801.  moan_err%,
  4802. msg("Err39")
  4803.  &80142:
  4804.  moan_err%,
  4805. msg("Err90")
  4806.  ### Attempt to print directly when no driver installed ###
  4807. message
  4808.  task%,ref%,ftype%,filename$,w%,i%,x%,y%
  4809.  task%=block%!4:ref%=block%!8
  4810.  block%!16 
  4811.  0:quit%=
  4812.  ### DataSave ###
  4813.  task%<>mytask% 
  4814.  present%=7 
  4815.     datasize%=block%!36
  4816.  block%!40 
  4817.        
  4818.  &fff,&ff9,&aff,&dfe:
  4819.       myref%=ref%
  4820. >      block%!0=256:block%!12=ref%:block%!16=2:block%!36=-1
  4821. *      $(block%+44)="<Wimp$Scrap>"+
  4822. /      
  4823.  "Wimp_SendMessage",17,block%,task%
  4824.         
  4825.  ### DataSaveAck ###
  4826.   block%!12=ref%
  4827.  "Wimp_SendMessage",19,block%,task%
  4828. 3  ftype%=block%!40:filename$=
  4829. getstr(block%+44)
  4830.  filename$<>"" 
  4831. ;    w%=block%!20:i%=block%!24:x%=block%!28:y%=block%!32
  4832. L    
  4833. save(filename$,Type%,Start%,End%):
  4834. write_log(-1,filename$+" saved")
  4835. *    block%!0=(44+
  4836. filename$+1+3) 
  4837. V    block%!12=ref%:block%!16=3:block%!20=w%:block%!24=i%:block%!28=x%:block%!32=y%
  4838. 0    
  4839.  "OS_File",5,filename$ 
  4840.  ,,,,block%!36
  4841. 4    block%!40=ftype%:$(block%+44)=filename$+
  4842. -    
  4843.  "Wimp_SendMessage",18,block%,task%
  4844.     myref%=block%!8
  4845.  "Wimp_CreateMenu",,-1
  4846.  ### DataLoad ###
  4847. ,  myref%=block%!12:f$=
  4848. getstr(block%+44)
  4849. get_it_in(f$)
  4850.  myref%<>0 
  4851.  "OS_CLI","Remove <Wimp$Scrap>"
  4852.  ### DataLoadAck ###
  4853.  block%!12=Impref% 
  4854.  merging% 
  4855. start_merge
  4856.  ### DataOpen - response to file double click ###
  4857.  block%!40 
  4858.  &7f1,&7f3,&7f4,&7f5:
  4859.  present%=7 
  4860. N      block%!0=20:block%!12=ref%:block%!16=4:block%!20=mainW%:block%!24=-1
  4861. )      
  4862.  "Wimp_SendMessage",17,block%
  4863. (      
  4864. get_it_in(
  4865. getstr(block%+44))
  4866.         
  4867.  &2000:
  4868.  kill% 
  4869.  present%=0 
  4870. 2      
  4871.  ### Is it a Powerbase application? ###
  4872. *      f$=
  4873. getstr(block%+44)+".Indices"
  4874. '      
  4875.  "OS_File",5,f$ 
  4876.  d%,,type%
  4877. !      type%=(type%>>8) 
  4878.  &fff
  4879.       
  4880.  d%=2 
  4881. 2        block%!0=20:block%!12=ref%:block%!16=4
  4882. 4        
  4883.  "Wimp_SendMessage",17,block%,block%!4
  4884. *        
  4885. get_it_in(
  4886. getstr(block%+44))
  4887.       
  4888.         
  4889.  savefunc$ 
  4890.  "Save as text","Save text","Save sprite","Save draw","Save query","Save selection","Save table","Export selected":
  4891. ram_transmit
  4892.  10: 
  4893.  ### Desktop boot file
  4894. F    
  4895.  "OS_GSTrans","Run <PBase$Dir>",block%+&100,&f00 
  4896.  ,bootcmd$
  4897. #block%!20,bootcmd$
  4898.  &502:
  4899. help_message(block%!32,block%!36)
  4900.  &400C2:
  4901. getscreensize(ScreenWidth%,ScreenHeight%,Vpix%)
  4902.  &400C0:
  4903. message_menu_select
  4904.  &80140:
  4905.  ### PrintFile - ignore ###
  4906. ram_transmit
  4907.  datasize%>block%!24 
  4908.  tosend%=block%!24 
  4909.  tosend%=datasize%
  4910.  "Wimp_TransferBlock",mytask%,ramptr%,block%!4,block%!20,tosend%
  4911. block%!24=tosend%
  4912. datasize%-=tosend%
  4913. ramptr%+=tosend%
  4914. block%!12=block%!8
  4915. block%!16=7
  4916.  "Wimp_SendMessage",18+(datasize%=0),block%,block%!4
  4917. message_menu_select
  4918.  P%,Q%,I%
  4919. keyfunc$="":savefunc$=""
  4920. 5handle%=block%!20:xmin%=block%!24:ymax%=block%!28
  4921.  "Wimp_DecodeMenu",,menuhandle%,block%+32,choices%
  4922.  I%=1 
  4923.   Q%=
  4924. $choices%,".",P%+1)
  4925. &  choice$(I%)=
  4926. $choices%,P%,Q%-P%)
  4927.   P%=Q%+1
  4928.  menuhandle% 
  4929.  menu%(0):
  4930.  choice$(1) 
  4931.  "New database":
  4932.     $SaveName%="!DataBase"
  4933. 2    $SaveSprite%="snew_appl;Pptr_hand,12,8;R2"
  4934.     savefunc$=choice$(1)
  4935.  menu%(1):
  4936.  choice$(1) 
  4937. 6    
  4938.  "Information":
  4939. count(key%,RU%):
  4940. update_stats
  4941.  "Print":
  4942.  choice$(2) 
  4943.       
  4944.  "Save query":
  4945. 1      $SaveName%=$database%+".PrintRes.Query"
  4946. 4      $SaveSprite%="sfile_7f4;Pptr_hand,12,8;R2"
  4947.       
  4948.  "Save selection":
  4949. 5      $SaveName%=$database%+".PrintRes.Selection"
  4950. 4      $SaveSprite%="sfile_7f3;Pptr_hand,12,8;R2"
  4951.         
  4952.     savefunc$=choice$(2)
  4953.  "Miscellaneous":
  4954.  choice$(2) 
  4955.       
  4956.  "Colours":
  4957.       ncol%()=fcol%()
  4958.       
  4959.  I%=0 
  4960. .        
  4961. set_icon_cols(colW%,I%,ncol%(I%))
  4962.       
  4963.         
  4964.  "Export selected":
  4965. 3    $SaveName%=$database%+".PrintJobs.Selected"
  4966. 2    $SaveSprite%="sfile_fff;Pptr_hand,12,8;R2"
  4967.     savefunc$=choice$(1)
  4968.  menu%(9):
  4969.  choice$(1) 
  4970.  "Save form file":
  4971. %    $SaveName%=$database%+".Form"
  4972. 2    $SaveSprite%="sfile_7f2;Pptr_hand,12,8;R2"
  4973.     savefunc$=choice$(1)
  4974.  menu%(17):
  4975.  choice$(1) 
  4976.  "Save":
  4977. 6    $SaveName%=$database%+".ValTables."+$menu%(17)
  4978. 2    $SaveSprite%="sfile_7f1;Pptr_hand,12,8;R2"
  4979.     savefunc$="Save table"
  4980.  "Save as CSV":
  4981.  6    $SaveName%=$database%+".PrintJobs."+$menu%(17)
  4982. !2    $SaveSprite%="sfile_dfe;Pptr_hand,12,8;R2"
  4983. "3    savefunc$="Save table as CSV":writetable%=
  4984.  menu%(18):
  4985.  choice$(1) 
  4986.  "Save as text":
  4987.     $SaveName%=TextName$
  4988. (2    $SaveSprite%="sfile_fff;Pptr_hand,12,8;R2"
  4989.     savefunc$=choice$(1)
  4990.  "Wimp_CreateSubMenu",,handle%,xmin%,ymax%
  4991. help_message(wi%,ic%)
  4992.  T%=0 
  4993.  LastTable%
  4994.  wi%=tableW%(T%) 
  4995.  Tablenumber%=T%
  4996.  wi% 
  4997. help("HelpPbase")
  4998.  listW%:
  4999. help("HelpList")
  5000.  tableW%(Tablenumber%):
  5001. help("HelpTable")
  5002.  mainW%:
  5003.  ic%<0:
  5004. help("main?")
  5005.  (ic% 
  5006.  2)=1:
  5007. <=    field%=(ic%+1) 
  5008. help("main"+
  5009. (chartype%(field%)))
  5010.  pselectW%:
  5011. help("Pselect")
  5012.  infoW%:
  5013. help("info"+
  5014. (ic%))
  5015.  miscW%:
  5016. help("misc"+
  5017. (ic%))
  5018.  relateW%:
  5019. help("relate"+
  5020. (ic%))
  5021.  accessW%:
  5022. help("access"+
  5023. (ic%))
  5024.  keypadW%:
  5025. help("keypad"+
  5026. (ic%))
  5027.  searchW%:
  5028. help("search"+
  5029. (ic%))
  5030.  filterW%:
  5031. help("filter"+
  5032. (ic%))
  5033.  queryW%:
  5034. help("query"+
  5035. (ic%))
  5036.  moveW%:
  5037. help("move"+
  5038. (ic%))
  5039.  calcW%:
  5040. help("calc"+
  5041. (ic%))
  5042.  sizeW%:
  5043. help("size"+
  5044. (ic%))
  5045.  matchW%:
  5046. help("match"+
  5047. (ic%))
  5048.  tabcreateW%:
  5049. help("tabcreate"+
  5050. (ic%))
  5051.  changeW%:
  5052. help("change"+
  5053. (ic%))
  5054.  passW%:
  5055. help("passwd"+
  5056. (ic%))
  5057.  aclW%:
  5058. help("acl"+
  5059. (ic%))
  5060.  saveW%:
  5061. help("save"+
  5062. (ic%))
  5063.  savesubW%:
  5064. help("savesub"+
  5065. (ic%))
  5066.  printW%:
  5067. help("print"+
  5068. (ic%))
  5069.  labelW%:
  5070. help("label"+
  5071. (ic%))
  5072.  createW%:
  5073. help("create"+
  5074. (ic%))
  5075.  scrollW%:
  5076. help("scroll")
  5077.  prefsW%:
  5078. help("prefs"+
  5079. (ic%))
  5080.  csvW%:
  5081. help("csv"+
  5082. (ic%))
  5083.  fkeyW%:
  5084. help("fkey"+
  5085. (ic%))
  5086.  helpW%:
  5087. help("help"+
  5088. (ic%))
  5089.  keyW%:
  5090. help("key"+
  5091. (ic%))
  5092.  colW%:
  5093. help("col"+
  5094. (ic%))
  5095.  linkW%:
  5096. help("link"+
  5097. (ic%))
  5098.  reformW%:
  5099. help("reform"+
  5100. (ic%))
  5101.  mergeW%:
  5102. help("merge"+
  5103. (ic%))
  5104. help(token$)
  5105. !block%=256
  5106. block%!12=ref%
  5107. block%!16=&503
  5108. $(block%+20)=
  5109. msg(token$)
  5110.  "Wimp_SendMessage",17,block%,block%!4
  5111.  File saving --------------------------------------------------------
  5112. export_selected(Form$)
  5113.  I%,F%,P%,F$
  5114. extend_named_sliding_block(textanchor%,Length%+fields%+3)
  5115. P%=!textanchor%
  5116.  I%=1 
  5117. (Form$)-1 
  5118.   F%=
  5119. fnum(
  5120. Form$,I%,2))
  5121.   F$=$Rf%(F%)+
  5122.   $P%=F$:P%+=
  5123. t*Start%=!textanchor%:End%=P%:Type%=&fff
  5124. save_all_tables
  5125.  "Hourglass_On"
  5126. Tablenumber%=0
  5127.  Tablenumber%<=LastTable%
  5128. {6  f$=$database%+".ValTables."+table$(Tablenumber%)
  5129. |a  t$=
  5130. table_info(Tablenumber%,Rows%,TabFields%,Rec%,tabfieldlen%(),offset%,heading%,colours$)
  5131. }E  Start%=!tabanchor%(Tablenumber%):End%=Start%+offset%+Rows%*Rec%
  5132. save(f$,&7f1,Start%,End%)
  5133.   Tablenumber%+=1
  5134.  "Hourglass_Percentage",Tablenumber%*100 
  5135.  (LastTable%+1)
  5136.  "Hourglass_Off"
  5137. save(f$,ft%,start%,end%)
  5138.  writingtext% 
  5139.  ft% 
  5140.   leaf$=
  5141. leaf(f$)
  5142. leaf$,1)<>"!" 
  5143.  leaf$="!"+leaf$
  5144. "  f$=dbasepath$+"."+
  5145. leaf$,10)
  5146.  "OS_File",8,f$
  5147.  "OS_File",8,f$+".Indices"
  5148.  "OS_File",8,f$+".ValTables"
  5149.  "OS_File",8,f$+".PrintRes"
  5150.  "OS_File",8,f$+".PrintJobs"
  5151.  "OS_CLI","Copy <PBase$Dir>.Resources.Temp.!Run "+f$+".!Run ~C~V"
  5152.  "OS_CLI","Copy <PBase$Dir>.Resources.Cols "+f$+".Cols ~C~V"
  5153. copy_database_spritefile(f$,
  5154. leaf(f$))
  5155. $    
  5156.  export%:
  5157. export_subset(f$)
  5158.  csvconv%:
  5159.  !formanchor%=0 
  5160. 4      
  5161. extend_named_sliding_block(formanchor%,0)
  5162.       Fptr%=!formanchor%
  5163. "      fields%=0:Fieldnumber%=0
  5164. "      fields%=
  5165. get_form(Fptr%)
  5166.         
  5167. lit(menu%(0),1,
  5168. get_it_in(f$)
  5169. open_window(mainW%)
  5170.  !formanchor%=0 
  5171. 4      
  5172. extend_named_sliding_block(formanchor%,0)
  5173.       Fptr%=!formanchor%
  5174. "      fields%=0:Fieldnumber%=0
  5175.         
  5176. close_window(saveW%)
  5177.  &7f2:
  5178. save_form(f$)
  5179.  &7f5:
  5180. save_options(printW%,f$)
  5181.  &dfe:
  5182.  writetable% 
  5183. ,    
  5184. write_table_as_csv(Tablenumber%,f$)
  5185. write_csv(f$)
  5186.  savetofile%:
  5187. (    texthandle%=
  5188. (f$):writingtext%=
  5189. "    
  5190. do_it(Search$,displayed%)
  5191.     writingtext%=
  5192. +    
  5193.  "OS_File",10,f$,ft%,,start%,end%
  5194. )    
  5195. scrap_sliding_block(saveanchor%)
  5196. ramwarn%=
  5197. getstr(p%)
  5198.  ?p%>31
  5199.   p$+=
  5200. (?p%)
  5201.   p%+=1
  5202.  Validation tables ----------------------------------------------------
  5203. tabcreate_click(wi%,ic%,b%)
  5204.  I%,Rows%,Rec%,L%,TabFields%,head$,tablen%,width$,max%,row%,y%,headlen%,col%,z%,lim%
  5205.  ic%=3 
  5206. text(wi%,2)="Create":
  5207. close_it(wi%):
  5208. set_caret(mainW%,starthere%):
  5209.  "Hourglass_Smash":
  5210. wimp_error(
  5211.  (b% 
  5212.  %111)=4 
  5213.  z%=1 
  5214.  z%=-1
  5215.  %111 
  5216.  1,4:
  5217.  ic% 
  5218.     row%=
  5219. ($tabcol%)
  5220.  row%>MaxCols% 
  5221. &      
  5222. softerror(
  5223. (MaxCols%+1),42)
  5224.       row%=MaxCols%
  5225.       $tabcol%=
  5226. (row%)
  5227.       
  5228. redraw_icon(wi%,8)
  5229.         
  5230. #    
  5231. set_caret(scrollW%,row%*2)
  5232. )    
  5233.  row%<3 
  5234.  y%=0 
  5235.  y%=-(row%-2)*44
  5236. 9    !block%=scrollW%:
  5237.  "Wimp_GetWindowState",,block%
  5238. 1    block%!24=y%:
  5239.  "Wimp_OpenWindow",,block%
  5240.  13,14:
  5241. @    col%=
  5242. get_icon_cols(wi%,ic%):fg%=col% 
  5243.  16:bg%=col% 
  5244. I    
  5245. selected(wi%,11) 
  5246.  fg%=(fg%+z%+16) 
  5247.  bg%=(bg%+z%+16) 
  5248. *    
  5249. set_icon_cols(wi%,ic%,fg%+bg%*16)
  5250.  LastTable%=MaxTabs% 
  5251. &      
  5252. softerror(
  5253. (MaxTabs%+1),32)
  5254.       
  5255. L      start$="new"+
  5256. get_icon_cols(wi%,13)*256+
  5257. get_icon_cols(wi%,14))
  5258. E      name$=$
  5259. text(wi%,0):
  5260.  name$="" 
  5261.  moan_err%,
  5262. msg("Err103")
  5263. G      Rows%=
  5264. text(wi%,1)):
  5265.  Rows%=0 
  5266.  moan_err%,
  5267. msg("Err104")
  5268.       LastTable%+=1
  5269. !      Tablenumber%=LastTable%
  5270. $      table$(Tablenumber%)=name$
  5271.       tablen%=
  5272. (start$)+1
  5273.        tablen%+=
  5274. (Rows%))+1
  5275.       
  5276.  "Hourglass_On"
  5277. .      
  5278. text(scrollW%,TabFields%*2)<>""
  5279. 0        width$=$
  5280. text(scrollW%,TabFields%*2)
  5281.          tablen%+=
  5282. (width$)+1
  5283. .        tabfieldlen%(TabFields%)=
  5284. (width$)
  5285. ,        Rec%+=tabfieldlen%(TabFields%)+1
  5286. 1        head$=$
  5287. text(scrollW%,TabFields%*2+1)
  5288. Y        
  5289. (head$)>tabfieldlen%(TabFields%) 
  5290.  LastTable%-=1:
  5291.  moan_err%,
  5292. msg("Err38")
  5293.          headlen%+=
  5294. (head$)+1
  5295.         TabFields%+=1
  5296.       
  5297.       TabFields%-=1
  5298. 5      
  5299.  TabFields%<0 
  5300.  moan_err%,
  5301. msg("Err112")
  5302. ;      tablen%+=(
  5303. (TabFields%))+1+headlen%+Rows%*Rec%)
  5304. Q      
  5305. extend_named_sliding_block(tabanchor%(Tablenumber%),(tablen%+3) 
  5306. +      tabptr%=!tabanchor%(Tablenumber%)
  5307. 0      $tabptr%=start$:tabptr%+=
  5308. ($tabptr%)+1
  5309. 2      $tabptr%=
  5310. (Rows%):tabptr%+=
  5311. ($tabptr%)+1
  5312. 7      $tabptr%=
  5313. (TabFields%):tabptr%+=
  5314. ($tabptr%)+1
  5315.       
  5316.  I%=0 
  5317.  TabFields%
  5318. ?        $tabptr%=
  5319. (tabfieldlen%(I%)):tabptr%+=
  5320. ($tabptr%)+1
  5321.       
  5322.       
  5323.  I%=0 
  5324.  TabFields%
  5325. C        $tabptr%=$
  5326. text(scrollW%,I%*2+1):tabptr%+=
  5327. ($tabptr%)+1
  5328.       
  5329.       
  5330.  row%=1 
  5331.  Rows%
  5332.         
  5333.  I%=0 
  5334.  TabFields%
  5335. 5          $tabptr%="":tabptr%+=tabfieldlen%(I%)+1
  5336.         
  5337.       
  5338.  row%
  5339.       
  5340.  "Hourglass_Off"
  5341. #      
  5342. show_table(Tablenumber%)
  5343.        TabsLoaded$+=","+name$
  5344. !      
  5345.  !tablemenuanchor%=0 
  5346. H        
  5347. extend_named_sliding_block(tablemenuanchor%,MaxTabs%*35+65)
  5348. i        tablemenu%=!tablemenuanchor%:tableiconptr%=tablemenu%:tabletextptr%=tablemenu%+MaxTabs%*24+52
  5349. #        $tableiconptr%="Tables"
  5350.         tableiconptr%?12=7:tableiconptr%?13=2:tableiconptr%?14=7:tableiconptr%?15=0:tableiconptr%!16=168:tableiconptr%!20=44:tableiconptr%!24=0
  5351.         tableiconptr%+=28
  5352. A        ptr%=menu%(2)+52:ptr%!4=tablemenu%:
  5353. lit(menu%(2),1,
  5354.         !tableiconptr%=128
  5355. C        
  5356.  !tableiconptr%=0:tableiconptr%+=24:!tableiconptr%=128
  5357.       
  5358. ~      tableiconptr%!4=-1:tableiconptr%!8=&7000121:tableiconptr%!12=tabletextptr%:tableiconptr%!16=-1:tableiconptr%!20=L%+1
  5359. 2      $tabletextptr%=name$:tabletextptr%+=L%+1
  5360. U      
  5361. text(wi%,2)="Modify" 
  5362. write_back_to_table(OldTable%,Tablenumber%,wi%)
  5363.         
  5364. 4    
  5365. close_it(wi%):
  5366. set_caret(mainW%,starthere%)
  5367. asterisk(
  5368. modify_table(T%,wi%)
  5369.  I%,Rows%,Rec%,L%,TabFields%,head$,cols%
  5370. #Ut$=
  5371. table_info(T%,Rows%,TabFields%,Rec%,tabfieldlen%(),offset%,heading%,colours$)
  5372. text(wi%,2)="Modify"
  5373. text(wi%,0)=table$(T%)
  5374. text(wi%,1)=
  5375. (Rows%)
  5376. $tabcol%="0"
  5377.  I%=0 
  5378.  MaxCols%*2+1
  5379. text(scrollW%,I%)=""
  5380.  I%=0 
  5381.  TabFields%
  5382. ,/  $
  5383. text(scrollW%,I%*2)=
  5384. (tabfieldlen%(I%))
  5385. -I  $
  5386. text(scrollW%,I%*2+1)=$
  5387. text(tableW%(T%),Rows%*(TabFields%+1)+I%)
  5388.  colours$="" 
  5389.  colours$="2807"
  5390. cols%=
  5391. ("&"+colours$)
  5392. set_icon_cols(wi%,13,cols% 
  5393.  256)
  5394. set_icon_cols(wi%,14,cols% 
  5395.  256)
  5396. OldTable%=T%
  5397. open_window(wi%):
  5398. set_caret(wi%,0)
  5399. redraw(tabcreateW%):
  5400. redraw(scrollW%)
  5401. write_back_to_table(old%,new%,wi%)
  5402.  row%,column%,P%,N%,I%,ic%
  5403. :ct$=
  5404. table_info(old%,oldRows%,oldTabFields%,Rec%,tabfieldlen%(),oldoffset%,oldheading%,colours$)
  5405. P%=oldheading%
  5406. tabhead$()=""
  5407.  I%=0 
  5408.  oldTabFields%
  5409. >%  tabhead$(I%,0)=$P%:P%+=
  5410. ($P%)+1
  5411.  I%=0 
  5412.  TabFields%
  5413. A,  tabhead$(I%,1)=$
  5414. text(scrollW%,2*I%+1)
  5415.  oldRows%<=Rows% 
  5416.  N%=oldRows%-1 
  5417.  N%=Rows%-1
  5418.  "Hourglass_On"
  5419.  row%=0 
  5420. F/  P%=!tabanchor%(old%)+oldoffset%+row%*Rec%
  5421.  column%=0 
  5422.  oldTabFields%
  5423.     I%=-1
  5424. I        
  5425.       I%+=1
  5426. K<    
  5427.  tabhead$(I%,1)=tabhead$(column%,0) 
  5428.  I%>TabFields%
  5429.  I%<=TabFields% 
  5430. M$      ic%=row%*(TabFields%+1)+I%
  5431. NK      $
  5432. text(tableW%(new%),ic%)=
  5433. buffer_length(tableW%(new%),ic%))
  5434. O%      P%+=tabfieldlen%(column%)+1
  5435. P        
  5436.  column%
  5437.  row%
  5438.  "Hourglass_Off"
  5439. text(wi%,2)="Create"
  5440. redraw(tableW%(new%))
  5441. clear_table(T%)
  5442. confirm(
  5443. msg("Err47"))=
  5444.  R%,F%,ind%,Rows%,TabFields%,start%,Rec%
  5445. [UT$=
  5446. table_info(T%,Rows%,TabFields%,Rec%,tabfieldlen%(),offset%,heading%,colours$)
  5447. \'start%=!tabanchor%(T%)+offset%-Rec%
  5448.  R%=1 
  5449.  Rows%
  5450.   ind%=start%+R%*Rec%
  5451.  F%=0 
  5452.  TabFields%
  5453. `)    $ind%="":ind%+=tabfieldlen%(F%)+1
  5454. redraw(tableW%(T%))
  5455. asterisk(
  5456. show_table(T%)
  5457.  ind%,start%,dflags%,hflags%,c%,I%,pos%,p$,t$,B%,tablefield%,offset%,heading%,colours$
  5458. iUt$=
  5459. table_info(T%,Rows%,TabFields%,Rec%,tabfieldlen%(),offset%,heading%,colours$)
  5460. j;NewTab%=(t$="
  5461. "):extra%=-NewTab%*(Rows%*(TabFields%+1))
  5462.  T%<0 
  5463.  "SlidingHeap_DescribeBlock",slidingheapbase%,tabanchor%(T%) 
  5464.  ,,tablen%
  5465. extend_named_sliding_block(undoanchor%(T%),tablen%+1)
  5466.  "Wimp_TransferBlock",mytask%,!tabanchor%(T%),mytask%,!undoanchor%(T%),tablen%+1
  5467.  tableW%(T%)>0 
  5468. open_window(tableW%(T%)):
  5469. name$=table$(T%)
  5470. $Tablename%=name$
  5471. $menu%(17)=name$
  5472. s ind%=!tabanchor%(T%)+offset%
  5473.  "Wimp_OpenTemplate",,"<Pbase$Dir>.Resources.Templates"
  5474. B%=buff%
  5475.  "Wimp_LoadTemplate",,block%,buff%,endbuff%,-1,"table",0 
  5476.  ,,buff%
  5477.  NewTab% 
  5478. (name$)+1 
  5479. (t$)+1
  5480. buff%+=L%:block%!80=L%
  5481.  "Wimp_CloseTemplate"
  5482. z#block%!28=block%!28 
  5483.  &AFFFFFFF
  5484.  (Rec%+TabFields%+9)*16<1136 
  5485.  Rows%<16:
  5486.  (Rec%+TabFields%+9)*16<1136:block%!28=block%!28 
  5487.  (1<<28)
  5488.  Rows%<16:block%!28=block%!28 
  5489.  (1<<30)
  5490. :block%!28=block%!28 
  5491.  ((1<<28)+(1<<30))
  5492.  "Wimp_CreateWindow",,block% 
  5493.  tableW%(T%)
  5494. PTabTitle%(T%)=block%!72:
  5495.  NewTab% 
  5496.  $TabTitle%(T%)=name$ 
  5497.  $TabTitle%(T%)=t$
  5498.  "Hourglass_On"
  5499.  colours$="" 
  5500.  colours$="2807"
  5501. cols%=
  5502. ("&"+colours$)
  5503. )hflags%=&0000A535+((cols% 
  5504.  256)<<24)
  5505. )dflags%=&0000A535+((cols% 
  5506.  256)<<24)
  5507.  row%=1 
  5508.  Rows%
  5509.   pos%=72
  5510.  I%=0 
  5511.  TabFields%
  5512.     R%=
  5513. create_icon(tableW%(T%),pos%,-row%*44-4+44*NewTab%,(tabfieldlen%(I%)+1)*16+2,48,dflags%,"",ind%,writep%,tabfieldlen%(I%)+1)
  5514. %    pos%+=(tabfieldlen%(I%)+1)*16
  5515.      ind%+=tabfieldlen%(I%)+1
  5516.  "Hourglass_Percentage",row%*100 
  5517.  Rows%
  5518.  row%
  5519.  NewTab% 
  5520.   pos%=72
  5521.  I%=0 
  5522.  TabFields%
  5523. t    R%=
  5524. create_icon(tableW%(T%),pos%,-48,(tabfieldlen%(I%)+1)*16+2,48,hflags%,"",heading%,-1,tabfieldlen%(I%)+1)
  5525. %    pos%+=(tabfieldlen%(I%)+1)*16
  5526.      heading%+=
  5527. ($heading%)+1
  5528.  "Hourglass_Off"
  5529. p$=printrel$(T%)
  5530.  p$<>"" 
  5531.  I%=1 
  5532. (p$) 
  5533.      tablefield%=
  5534. p$,I%,3))
  5535. /    
  5536. select(tableW%(T%),tablefield%+extra%)
  5537. width%=(Rec%*16)+112
  5538. -!block%=0:block%!4=-Rows%*44-4+44*NewTab%
  5539. block%!8=width%:block%!12=0
  5540.  "Wimp_SetExtent",tableW%(T%),block%
  5541. getscreensize(ScreenWidth%,ScreenHeight%,Vpix%)
  5542. !block%=tableW%(T%)
  5543.  "Wimp_GetWindowState",,block%
  5544. &block%!4=(ScreenWidth%-width%) 
  5545. block%!12=block%!4+width%
  5546.  Rows%<20 
  5547. -  block%!8=ScreenHeight% 
  5548.  2-(Rows%*18+2)
  5549. .  block%!16=block%!8+Rows%*44+4-44*NewTab%
  5550. $  block%!8=ScreenHeight% 
  5551.  2-362
  5552. +  block%!16=block%!8+44*20+4-44*NewTab%
  5553.  "Wimp_OpenWindow",,block%
  5554. redraw(tableW%(T%))
  5555.  Access% 
  5556. set_caret(tableW%(T%),0)
  5557. restore_table(T%)
  5558.  "SlidingHeap_DescribeBlock",slidingheapbase%,tabanchor%(T%) 
  5559.  ,,tablen%
  5560.  "Wimp_TransferBlock",mytask%,!undoanchor%(T%),mytask%,!tabanchor%(T%),tablen%+1
  5561. redraw(tableW%(T%))
  5562. restore_tabfield
  5563.  source%,dest%
  5564.  "Wimp_GetCaretPosition",,block%:wi%=!block%:ic%=block%!4
  5565.  wi%=tableW%(Tablenumber%) 
  5566. ,  dest%=
  5567. text(tableW%(Tablenumber%),ic%)
  5568. H  source%=!undoanchor%(Tablenumber%)+dest%-!tabanchor%(Tablenumber%)
  5569.   $dest%=$source%
  5570. redraw_icon(tableW%(Tablenumber%),ic%)
  5571. sort_table(T%,field%)
  5572.  tablen%,ind%,Rec%,Rows%,row%,TabFields%,pos%,dest%
  5573. Ytitle$=
  5574. table_info(T%,Rows%,TabFields%,Rec%,tabfieldlen%(),offset%,heading%,colours$)
  5575. ,pos%=
  5576. table_field(field%,tabfieldlen%())
  5577. *ind%=!tabanchor%(T%)+offset%-Rec%+pos%
  5578.  row%=0 
  5579.  Rows%-1
  5580.   ind%+=Rec%
  5581.   block%!(row%*4)=ind%
  5582.  $ind%="" 
  5583.  $ind%="~"
  5584.  row%
  5585.  "OS_HeapSort",Rows%,block%,4
  5586. extend_named_sliding_block(tempanchor%,Rows%*Rec%)
  5587. dest%=!tempanchor%-Rec%
  5588.  row%=0 
  5589.  Rows%-1
  5590. &  ind%=block%!(row%*4):dest%+=Rec%
  5591.  $ind%="~" 
  5592.  $ind%=""
  5593.  "Wimp_TransferBlock",mytask%,ind%-pos%,mytask%,dest%,Rec%
  5594.  row%
  5595.  "Wimp_TransferBlock",mytask%,!tempanchor%,mytask%,!tabanchor%(T%)+offset%,Rows%*Rec%
  5596. scrap_sliding_block(tempanchor%)
  5597. redraw(tableW%(T%))
  5598. print_table(T%)
  5599.  printing% 
  5600.  indexing% 
  5601.  start%,ptr%,Line$,title$,rowsused%,Heading$,h$,column%
  5602. QTextName$=$database%+".PrintJobs."+
  5603. "Tab"+table$(T%),10):$SaveName%=TextName$
  5604. read_print_options
  5605. format$="horiz"
  5606. Ytitle$=
  5607. table_info(T%,Rows%,TabFields%,Rec%,tabfieldlen%(),offset%,heading%,colours$)
  5608. Heading$=margin$
  5609.  NewTab% 
  5610.  column%=0 
  5611.  TabFields%
  5612. ;    h$=$
  5613. text(tableW%(T%),Rows%*(TabFields%+1)+column%)
  5614. ;    Heading$+=h$+
  5615. tabfieldlen%(column%)-
  5616. (h$)," ")+"  "
  5617.  column%
  5618.  Heading$+=title$+
  5619. Rec%-
  5620. (title$)," ")
  5621. 'LenLine%=Lmargin%+Rec%+TabFields%+2
  5622. extend_named_sliding_block(lineanchor%,LenLine%+4)
  5623. extend_named_sliding_block(headanchor%,LenLine%+4):pos%=!headanchor%
  5624. heap_store(headanchor%,LenLine%,0,pos%,0,Heading$)
  5625. Title$="Validation table"
  5626. Title1$=table$(T%)
  5627. Title2$=""
  5628. reportdest$="Window"
  5629. Count%=0
  5630. list_head(0)
  5631.  "Hourglass_On"
  5632.  I%=1 
  5633.  Rows%
  5634. )  start%=!tabanchor%(T%)+offset%-Rec%
  5635.   Line$=margin$
  5636.   ptr%=start%+I%*Rec%
  5637.  J%=0 
  5638.  TabFields%
  5639. D    
  5640.  $ptr%<>"" 
  5641.  Line$+=$ptr%+
  5642. tabfieldlen%(J%)-
  5643. ($ptr%)+2," ")
  5644.      ptr%+=tabfieldlen%(J%)+1
  5645.  Line$<>margin$ 
  5646.     rowsused%+=1
  5647. D    $(!lineanchor%)=Line$:
  5648. list_line(-1,lineanchor%,
  5649. (Line$),32)
  5650.  "Hourglass_Percentage",I%*100 
  5651.  Rows%
  5652.  "Hourglass_Off"
  5653. rule_off(45)
  5654. S$=margin$+
  5655. (Rows%)+" rows"
  5656.     :$(!lineanchor%)=S$:
  5657. list_line(-1,lineanchor%,
  5658. (S$),32)
  5659. #S$=margin$+
  5660. (rowsused%)+" used"
  5661. :$(!lineanchor%)=S$:
  5662. list_line(-1,lineanchor%,
  5663. (S$),32)
  5664. rule_off(45)
  5665. screen_list
  5666. pitch$=
  5667. pitch("0")
  5668. lit(menu%(18),1,
  5669. write_log(-1,"Table printed: "+table$(T%))
  5670. write_table_as_csv(T%,Filename$)
  5671.  ic%,row%,column%,Rows%,TabFields%,Rec%,offset%,heading%,csvhandle%,F$
  5672. table_info(T%,Rows%,TabFields%,Rec%,tabfieldlen%(),offset%,heading%,colours$)
  5673. csvhandle%=
  5674. (Filename$)
  5675. ic%=-1
  5676.  "Hourglass_On"
  5677.  row%=0 
  5678.  Rows%-1
  5679.  column%=0 
  5680.  TabFields%
  5681. )    ic%+=1:F$=$
  5682. text(tableW%(T%),ic%)
  5683. .    
  5684. selected(csvW%,0) 
  5685.  F$=""""+F$+""""
  5686. 3    
  5687.  column%<TabFields% 
  5688.  F$+=sep$ 
  5689.  F$+=term$
  5690. #csvhandle%,F$;
  5691.  column%
  5692.  row%
  5693.  "Hourglass_Off"
  5694. close_file(csvhandle%)
  5695.  sep$="," 
  5696.  type%=&dfe 
  5697.  type%=&fff
  5698.  "OS_File",18,Filename$,type%
  5699. writetable%=
  5700. csv_to_table(T%,filename$)
  5701.  ic%,row%,column%,Rows%,TabFields%,Rec%,offset%,heading%,csvhandle%,base%,F$,sep%,sep2%,term%,term2%
  5702. *Ut$=
  5703. table_info(T%,Rows%,TabFields%,Rec%,tabfieldlen%(),offset%,heading%,colours$)
  5704. +:sep%=
  5705. (sep$):
  5706. (sep$)=2 
  5707.  sep2%=
  5708. sep$)) 
  5709.  sep2%=255
  5710. ,@term%=
  5711. (term$):
  5712. (term$)=2 
  5713.  term2%=
  5714. term$)) 
  5715.  term2%=255
  5716. size%=&100:inc%=size%
  5717. extend_named_sliding_block(tempanchor%,size%)
  5718. base%=!tempanchor%
  5719. csvhandle%=
  5720. (filename$)
  5721. ic%=-1
  5722.  "Hourglass_On"
  5723.  row%=0 
  5724.  Rows%-1
  5725.  column%=0 
  5726.  TabFields%
  5727.     ic%+=1
  5728. #csvhandle% 
  5729.        
  5730. read_bytes
  5731. 8K       $
  5732. text(tableW%(T%),ic%)=
  5733. $base%,
  5734. buffer_length(tableW%(T%),ic%))
  5735. 9        
  5736.  column%
  5737.  row%
  5738.  "Hourglass_Off"
  5739. close_file(csvhandle%)
  5740. redraw(tableW%(T%))
  5741. table_number(N$)
  5742.  T%,P%
  5743.  N$="" 
  5744. D    T%=-1
  5745.   T%+=1
  5746.  table$(T%)=N$ 
  5747.  T%>LastTable%
  5748.  T%>LastTable% 
  5749. table_info(table%,
  5750.  rows%,
  5751.  columns%,
  5752.  recordlength%,colwidth%(),
  5753.  offset%,
  5754.  heading%,
  5755.  colours$)
  5756.  P%,Q%,I%,new%,S$
  5757. L P%=!tabanchor%(table%):Q%=P%
  5758. S$=$P%
  5759. S$,3)="new" 
  5760.  new%=
  5761. :colours$=
  5762. S$,4):P%+=
  5763. ($P%)+1
  5764. rows%=
  5765. ($P%):P%+=
  5766. ($P%)+1
  5767. P columns%=
  5768. ($P%):P%+=
  5769. ($P%)+1
  5770. recordlength%=0
  5771.  I%=0 
  5772.  columns%
  5773. S'  colwidth%(I%)=
  5774. ($P%):P%+=
  5775. ($P%)+1
  5776. T$  recordlength%+=colwidth%(I%)+1
  5777. heading%=P%
  5778.  new% 
  5779.  I%=0 
  5780.  columns%
  5781.     P%+=
  5782. ($P%)+1
  5783.   offset%=P%-Q%
  5784.  P%+=
  5785. ($P%)+1:offset%=160
  5786.  new% 
  5787. =$heading%
  5788. table_field(F%,L%())
  5789.  I%,P%
  5790.  I%<F%
  5791.   P%+=L%(I%)+1
  5792.   I%+=1
  5793. trailing_number(
  5794.  exact%)
  5795. S$)="~" 
  5796.  exact%=
  5797.  exact%=
  5798.  S$<>"" 
  5799. S$))<58
  5800.     N$=
  5801. S$)+N$
  5802.     S$=
  5803.  N$="" 
  5804. leading_number(
  5805.  S$<>"" 
  5806. (S$)<58
  5807.     N$=N$+
  5808. S$,1)
  5809.     S$=
  5810. S$,2)
  5811.  N$="" 
  5812. load_table(f$,show%)
  5813.  pos%,name$,d%,L%
  5814. name$=
  5815. leaf(f$):L%=
  5816. (name$)
  5817. TabsLoaded$,name$)=0 
  5818.  "OS_File",5,f$ 
  5819.  d%,,,,tablen%
  5820.  LastTable%=MaxTabs% 
  5821.  show% 
  5822. .      
  5823. softerror(
  5824. (MaxTabs%+1),32):show%=
  5825. :      
  5826. extratabs$,name$)=0 
  5827.  extratabs$+=name$+" "
  5828.         
  5829.         
  5830.     LastTable%+=1
  5831. M    
  5832. create_named_sliding_block(tabanchor%(LastTable%),(tablen%+3) 
  5833. 3    
  5834.  "OS_File",255,f$,!tabanchor%(LastTable%)
  5835.      table$(LastTable%)=name$
  5836.     Tablenumber%=LastTable%
  5837.     TabsLoaded$+=","+name$
  5838.  !tablemenuanchor%=0 
  5839. F      
  5840. extend_named_sliding_block(tablemenuanchor%,MaxTabs%*35+65)
  5841. g      tablemenu%=!tablemenuanchor%:tableiconptr%=tablemenu%:tabletextptr%=tablemenu%+MaxTabs%*24+52
  5842. !      $tableiconptr%="Tables"
  5843.       tableiconptr%?12=7:tableiconptr%?13=2:tableiconptr%?14=7:tableiconptr%?15=0:tableiconptr%!16=168:tableiconptr%!20=44:tableiconptr%!24=0
  5844.       tableiconptr%+=28
  5845. ?      ptr%=menu%(2)+52:ptr%!4=tablemenu%:
  5846. lit(menu%(2),1,
  5847.       !tableiconptr%=128
  5848. A      
  5849.  !tableiconptr%=0:tableiconptr%+=24:!tableiconptr%=128
  5850.         
  5851. |    tableiconptr%!4=-1:tableiconptr%!8=&7000121:tableiconptr%!12=tabletextptr%:tableiconptr%!16=-1:tableiconptr%!20=L%+1
  5852. 0    $tabletextptr%=name$:tabletextptr%+=L%+1
  5853.  Tablenumber%=
  5854. table_number(name$)
  5855.  show% 
  5856. show_table(Tablenumber%)
  5857. link_to_table
  5858.  icon%
  5859. b%=(b% 
  5860.  %111)
  5861.  2,4:
  5862.  ic%=13 
  5863. 7    
  5864. tick_one(tablemenu%,0,LastTable%,Tablenumber%)
  5865. -    
  5866. show_menu(tablemenu%,oldx%+32,oldy%)
  5867.  %111 
  5868.  1,4:
  5869.  b%=4 
  5870.  z%=1 
  5871.  z%=-1
  5872.  ic% 
  5873. tcycle(z%)
  5874. tcycle(-z%)
  5875. !    
  5876. fcycle(z%,fieldnum%)
  5877. "    
  5878. fcycle(-z%,fieldnum%)
  5879. $    
  5880. fcycle(z%,substitute%)
  5881. %    
  5882. fcycle(-z%,substitute%)
  5883.  icon%=10 
  5884. 8      
  5885. icon_bit(22,linkW%,icon%,
  5886. selected(linkW%,9))
  5887.  icon%
  5888. $    
  5889.  ### Default action ###
  5890. "    icon%=field%(Fieldnumber%)
  5891. 1    
  5892. selected(linkW%,4) 
  5893.  $Tablename%<>"" 
  5894. 4      link$(Fieldnumber%)=$Tablename%+$fieldnum%
  5895. =      
  5896. selected(linkW%,15) 
  5897.  link$(Fieldnumber%)+="~"
  5898. 0      
  5899. set_icon_cols(mainW%,icon%,-fcol%(8))
  5900. V      
  5901. selected(linkW%,9) 
  5902.  link$(Fieldnumber%)=$substitute%+link$(Fieldnumber%)
  5903.       
  5904. ?      link$(Fieldnumber%)="":
  5905. set_icon_cols(mainW%,icon%,7)
  5906. $      K%=
  5907. is_a_key(Fieldnumber%)
  5908.       
  5909.         
  5910.          
  5911.  key%:
  5912. colour(K%,1)
  5913.         
  5914. colour(K%,2)
  5915.       
  5916.         
  5917.     link$(0)="LOADED"
  5918. asterisk(
  5919. &    
  5920.  b%=4 
  5921. close_window(linkW%)
  5922. "    
  5923. close_window(linkW%)
  5924. tcycle(z%)
  5925.  LastTable%=-1 
  5926. Tablenumber%+=z%
  5927.  Tablenumber%>LastTable% 
  5928.  Tablenumber%=0
  5929.  Tablenumber%<0 
  5930.  Tablenumber%=LastTable%
  5931. $$Tablename%=table$(Tablenumber%)
  5932. redraw_icon(linkW%,0)
  5933. fcycle(z%,column%)
  5934. table_info(Tablenumber%,Rows%,TabFields%,Rec%,tabfieldlen%(),offset%,heading%,colours$)
  5935. field%=
  5936. ($column%)
  5937. field%+=z%
  5938.  field%>TabFields% 
  5939.  field%=0
  5940.  field%<0 
  5941.  field%=TabFields%
  5942. $column%=
  5943. (field%)
  5944. redraw_icon(linkW%,2)
  5945. redraw_icon(linkW%,10)
  5946. link_status
  5947.  name$,field$,ic%,subst$,exact%
  5948. name$=link$(Fieldnumber%)
  5949. ,field$=
  5950. trailing_number(name$,exact%))
  5951. set_icon(linkW%,15,exact%)
  5952. ?subst$=
  5953. leading_number(name$)):
  5954.  subst$="-1" 
  5955.  subst$="0"
  5956.  (name$<>"" 
  5957. TabsLoaded$,name$)>0) 
  5958. =  $Tablename%=name$:$fieldnum%=field$:$substitute%=subst$
  5959. '  Tablenumber%=
  5960. table_number(name$)
  5961. select(linkW%,4)
  5962.   Tablenumber%=0
  5963. &  $Tablename%=table$(Tablenumber%)
  5964. deselect(linkW%,4):$fieldnum%="0"
  5965. set_icon(linkW%,9,subst$<>"0")
  5966.  ic%=10 
  5967. icon_bit(22,linkW%,ic%,
  5968. selected(linkW%,9))
  5969. redraw_icon(linkW%,0):
  5970. redraw_icon(linkW%,2)
  5971. save_links
  5972.  link$(0)="LOADED" 
  5973.   lk=
  5974. ($database%+".Link")
  5975.  F%=1 
  5976.  fields%
  5977. #lk,link$(F%)
  5978. close_file(lk)
  5979.  End of Validation table routines ------------------------------------
  5980. changes(key%)
  5981.  M$,K%,index%,target$,log$
  5982. "target$=$Query%:Search$=
  5983. parse
  5984. Old$=$
  5985. text(changeW%,0)
  5986. New$=$
  5987. text(changeW%,1)
  5988.  New$="" 
  5989.  n$="<null>" 
  5990.  n$=New$
  5991.  New$<>"" 
  5992. "+-*/",
  5993. New$,1))>0 
  5994.   numeric%=
  5995.  numeric%=
  5996. is_a_key(Fieldnumber%)
  5997.  K%=key% 
  5998. softerror("",12):
  5999.  "Wimp_CreateMenu",,-1:
  6000.  K%>=0 
  6001.  M$=" NOTE! Index on this field will NO LONGER BE VALID and should be deleted." 
  6002.  M$=""
  6003.  Old$<>"" 
  6004.  o$=" when existing value is "+Old$ 
  6005.  o$=""
  6006.  target$="" 
  6007.  target$=" for all subfile "+
  6008. (file%) 
  6009.  target$=" for "+target$+" in subfile "+
  6010. (file%)
  6011. Qlog$="Change contents of field "+Tag$(Fieldnumber%)+" to "+n$+o$+target$+". "
  6012. target$=log$+M$
  6013. confirm(target$)=
  6014. '  subtotal%=
  6015. count_recs(key%,zero%)
  6016.  "Hourglass_On"
  6017. ,  dbasehandle%=
  6018. ($database%+".Database")
  6019.   P%=
  6020. neighbour(key%,top,1)
  6021. scan_file("P%<>top",key%,file%,5,1)
  6022. close_file(dbasehandle%)
  6023.   $Date%(file%)=
  6024.   date%?file%=1
  6025. display(key%,addr)
  6026.  "Hourglass_Off"
  6027.  K%>=0 
  6028.  index%=K% 
  6029.  Keys%-1
  6030. $!      Index$(K%)=Index$(K%+1)
  6031.  index%
  6032. &/    
  6033. scrap_sliding_block(keyanchor%(Keys%))
  6034.     Index$(Keys%)=""
  6035.     Keys%-=1
  6036. write_log(-1,log$)
  6037. asterisk(
  6038. is_a_key(F%)
  6039.  key%,flag%,J%
  6040. flag%=-1
  6041.  J%=0 
  6042. 4&    
  6043.  KF%(key%,J%)=F% 
  6044.  flag%=key%
  6045.   key%+=1
  6046.  flag%>=0 
  6047.  key%>Keys% 
  6048. =flag%
  6049. read(N%,K%,R%,f$)
  6050.  I%,key%,dbasehandle%
  6051. <"dbasehandle%=
  6052. (f$+".Database")
  6053. =%$Rf%(0)="":field$(0)="":key$()=""
  6054. #dbasehandle%=
  6055. (R%)*Length%
  6056.  I%=1 
  6057.   field$(I%)=
  6058. #dbasehandle%
  6059.  chartype%(I%)<>40 
  6060.  chartype%(I%)<>59 
  6061.  $Rf%(I%)=field$(I%)
  6062.  chartype%(I%) 
  6063. C8    
  6064.  36,37,38:
  6065. set_blob_sprite(R%,I%,chartype%(I%))
  6066. D!    
  6067. show_text_block(I%)
  6068. show_picture(I%)
  6069.  41,42,43,44,45:
  6070. GT    
  6071.  field$(I%)=" " 
  6072. select(mainW%,field%(I%)) 
  6073. deselect(mainW%,field%(I%))
  6074. H(    
  6075.  R%=RA% 
  6076.  $Rf%(I%)=
  6077. (REC%)
  6078. I9    
  6079.  R%=RA% 
  6080. split_link(I%,R$,V$):$Rf%(I%)=R$
  6081. J'    
  6082.  R%=RA% 
  6083.  $Rf%(I%)=
  6084. K(    
  6085.  R%=RA% 
  6086.  $Rf%(I%)=
  6087. $,15)
  6088. L1    
  6089.  R%=RA% 
  6090.  $Rf%(I%)=
  6091. convert_date(2)
  6092. M1    
  6093.  R%=RA% 
  6094.  $Rf%(I%)=
  6095. convert_date(4)
  6096. N#    
  6097.  R%=RA% 
  6098.  $Rf%(I%)=
  6099. O'    
  6100.  R%=RA% 
  6101.  $Rf%(I%)=
  6102. P)    
  6103.  R%=RA% 
  6104.  $Rf%(I%)=
  6105. $,5,2)
  6106. Q)    
  6107.  R%=RA% 
  6108.  $Rf%(I%)=
  6109. $,8,3)
  6110. RJ    
  6111.  R%=RA% 
  6112. $,8,3):P%=
  6113. months$,M$):$Rf%(I%)=
  6114. ((P%+2) 
  6115. S*    
  6116.  R%=RA% 
  6117.  $Rf%(I%)=
  6118. $,12,4)
  6119.  key%=0 
  6120.  Keys%
  6121.     key$(key%)=
  6122. key(key%)
  6123.  key%
  6124. close_file(dbasehandle%)
  6125. cfield$()=field$()
  6126. update_calcs(N%)
  6127.  design% 
  6128.  N%>0 
  6129.  $Rf%(N%)=cfield$(N%) 
  6130.  I%,C%,L%,F,F$,Form$,S$,SF$,changed%
  6131. Form$=update$(N%)
  6132.  Form$=0 
  6133. calc_error:=
  6134.  I%=1 
  6135. (Form$)-1 
  6136.   F%=
  6137. fnum(
  6138. Form$,I%,2))
  6139.  F%<>N% 
  6140. j&    
  6141. split_link(F%,real$,visible$)
  6142.  chartype%(F%) 
  6143.       
  6144. mA      F=
  6145. (real$):F$=
  6146.  fix%(F%)<>0 
  6147. fix_point(F$,F%)
  6148.       
  6149.       F$=
  6150. (real$)
  6151. p9      
  6152.  N%=0 
  6153. expand(F$,link$(F%),L%,SF$):F$=SF$
  6154. q        
  6155. (F$)<=len%(F%) 
  6156. s*      $Rf%(F%)=F$:cfield$(N%)=$Rf%(N%)
  6157. t)      
  6158. redraw_icon(mainW%,field%(F%))
  6159. u.      
  6160.  F$(F%)<>F$ 
  6161.  F$(F%)=F$:changed%=
  6162.       
  6163.  moan_err%,""
  6164. w        
  6165. x"    changed%=
  6166. update_calcs(F%)
  6167. =changed%
  6168. calc_error
  6169.  ### Division by zero. Ignore ###
  6170.  moan_err%:
  6171. softerror(calc$(F%),10)
  6172. softerror(calc$(F%),73)
  6173. check_change
  6174.  F%,flag%
  6175.  F%<fields%
  6176.   F%+=1
  6177.  chartype%(F%) 
  6178.  0,1,2,3,4,5,6,7,8:
  6179.  ?Rf%(F%)=32
  6180.       $Rf%(F%)=$(Rf%(F%)+1)
  6181.         
  6182.  chartype%(F%) 
  6183. +    
  6184.  0,1,2,3,4,5,6,7,8,41,42,43,44,45:
  6185.      
  6186.  $Rf%(F%)<>field$(F%) 
  6187.       flag%=
  6188. D      
  6189.  customise% 
  6190. record_change(REC%,F%,field$(F%),$Rf%(F%))
  6191.         
  6192.  flag% 
  6193. write(fields%,key%):
  6194. asterisk(
  6195. write(N%,k%)
  6196.  key%,newrec%,dontalter%
  6197.  Access% 
  6198. softerror("",14):
  6199. close_file(dbasehandle%)
  6200.  template%=2 
  6201. write_dbase(RA%,N%,
  6202. ):template%=0:
  6203. PRI$=
  6204. key(0)
  6205.  PRI$="" 
  6206.  key$(0) 
  6207.  key%=0 
  6208.  Keys%
  6209.     KEY$=
  6210. key(key%)
  6211.     kl%=
  6212. (KEY$)
  6213. insert(KEY$,key%)
  6214.  KEY$<>"*Failed*" 
  6215. #      key$(key%)=KEY$:newrec%=
  6216. $      
  6217.  k%=key% 
  6218.  addr=nextfree%
  6219.       
  6220.  dontalter%=
  6221.         
  6222.  key%
  6223.  key%=0 
  6224.  Keys%
  6225.     KEY$=
  6226. key(key%)
  6227.  KEY$<>key$(key%) 
  6228. L      
  6229.  key%=0 
  6230. confirm(
  6231. msg("Err48")) 
  6232.  dontalter%=
  6233. restore_rec
  6234.       
  6235.  dontalter%=
  6236. $        
  6237. delete(key$(key%),key%)
  6238.         
  6239. insert(KEY$,key%)
  6240.         key$(key%)=KEY$
  6241.       
  6242.         
  6243.  key%
  6244.  dontalter% 
  6245. $Date%(file%)=
  6246. date%?file%=1
  6247.  newtree% 
  6248. write_dbase(REC%,N%,
  6249.  newrec% 
  6250.  autobalance% 
  6251.   added%+=1
  6252.  added%=
  6253. ($Every%) 
  6254.  key%=0 
  6255.  Keys%
  6256.       
  6257. balance(key%)
  6258.  key%
  6259.     added%=0
  6260. write_dbase(R%,N%,logchanges%)
  6261.  I%,F$,S$,dbasehandle%,flag%
  6262. *dbasehandle%=
  6263. ($database%+".Database")
  6264. #dbasehandle%=R%*Length%
  6265.  logchanges% 
  6266.  newrec% 
  6267. C    
  6268. write_log(R%,"New record: Subfile "+
  6269. (file%)+"  "+
  6270. key(0))
  6271. *    
  6272. write_log(R%,logentry$):flag%=
  6273.  I%=1 
  6274.  chartype%(I%) 
  6275.  39,40:F$=""
  6276.  newrec% 
  6277.       F$=$Rf%(I%)
  6278.       
  6279. split_link(I%,R$,V$)
  6280.       S%=
  6281. /      
  6282.  dontincrement%=
  6283.  S%+=1:F$=
  6284. (S%-1)
  6285.        calc$(I%)=V$+"|"+
  6286.       
  6287.  F$=$Rf%(I%)
  6288.         
  6289.     dontincrement%=
  6290.  58:F$=
  6291. :F$=$Rf%(I%)
  6292. #dbasehandle%,F$
  6293.  flag%=
  6294.  F$<>field$(I%) 
  6295.  chartype%(I%)<>59 
  6296. %    
  6297.  F$="" 
  6298.  D$="<null>" 
  6299.  D$=F$
  6300. 5    
  6301.  field$(I%)="" 
  6302.  S$="<null>" 
  6303.  S$=field$(I%)
  6304. 3    
  6305. write_log(-1,Tag$(I%)+": "+S$+" ---> "+D$)
  6306.   field$(I%)=F$
  6307. selected(prefsW%,44) 
  6308. readsmarray(dbasehandle%,R%)
  6309. write_csv_rec(R%,csvform$,autocsvhandle%)
  6310. close_file(dbasehandle%)
  6311. split_link(F%,
  6312.  L$,P%,F
  6313. L$=calc$(F%)
  6314. L$,1)="#":
  6315. /  P%=
  6316. L$,"#",2):V$=
  6317. L$,P%+1):R$=
  6318. L$,2,P%-2)
  6319. L$,"|")>0:
  6320. +  P%=
  6321. L$,"|"):V$=
  6322. L$,P%-1):R$=
  6323. L$,P%+1)
  6324. :R$="":V$=""
  6325. key(key%)
  6326. key2(key%,0)
  6327. key2(key%,loc%)
  6328.  I%,W%,P%,S$,W$,T$,pad$,chars%,pos%,word%,wd%,field%,numeric%
  6329.  I%=0 
  6330.   W%=KW%(key%,I%):W$=""
  6331.  W%>0 
  6332.     chars%=W% 
  6333.     pos%=(W%>>8) 
  6334.     word%=(W%>>16) 
  6335.     field%=KF%(key%,I%)
  6336.  chartype%(field%) 
  6337. )      
  6338.  3,6,46,47,54,56,57:numeric%=
  6339.       
  6340. :numeric%=
  6341.         
  6342. :    
  6343.  loc%=0 
  6344.  S$=$Rf%(field%)+" " 
  6345.  S$=F$(field%)+" "
  6346.  numeric% 
  6347.       
  6348.  word% 
  6349.         
  6350.         
  6351. !          C$=
  6352. S$,1):S$=
  6353. S$,2)
  6354.            
  6355.  C$<>" " 
  6356.  W$+=C$
  6357.         
  6358.  S$=""
  6359.         
  6360.         wd%=0
  6361.         
  6362. :          P%=
  6363. S$," "):w$=
  6364. S$,P%-1):S$=
  6365. S$,P%+1):wd%+=1
  6366.         
  6367.  wd%=word% 
  6368.  S$=""
  6369.         
  6370.  wd%=word% 
  6371.  W$=w$
  6372.       
  6373.       
  6374.  pos% 
  6375.         
  6376.  0:W$=
  6377. W$,chars%)
  6378.           
  6379.  255:W$=
  6380. W$,chars%)
  6381. !!        
  6382. W$,pos%,chars%)
  6383.       
  6384. #@      
  6385.  incspace%(key%)=
  6386.  word%>0 
  6387.  W$+=
  6388. chars%-
  6389. (W$)," ")
  6390. $       
  6391.  chartype%(field%) 
  6392. %*        
  6393.  5,51,52:W$=
  6394. reverse_date(W$)
  6395.       
  6396.       
  6397. (        
  6398.     T$+=W$
  6399.  T$<>"" 
  6400.  incspace%(key%)=
  6401.  pad$=" " 
  6402.  pad$="#"
  6403. .   T$+=
  6404. KL%(key%)-
  6405. (T$),pad$)
  6406.  case%(key%) 
  6407. u(T$)
  6408. u(N$)
  6409.  I%,B%
  6410. $key=N$
  6411.  I%=0 
  6412. (N$)-1
  6413.   B%=key?I%
  6414.  B%>96 
  6415.  B%<123 
  6416.  key?I%=B% 
  6417. 9    =$key
  6418.  Y$,M$,D$,M%,date$
  6419. $,14,2)
  6420. $,5,2)
  6421. $,8,3)
  6422. @:M%=(
  6423. "JanFebMarAprMayJunJulAugSepOctNovDec",M$)+2) 
  6424.  M%<10 
  6425.  M$="0"+
  6426. (M%) 
  6427. date$=D$+"-"+M$+"-"+Y$
  6428. =date$
  6429. date(key%)
  6430.  !keyanchor%(key%)=0 
  6431.  I%=0 
  6432.  date%?I%=1 
  6433. J)    $(!keyanchor%(key%)+8+9*I%)=
  6434.     $Date%(I%)=
  6435. check_date(D$,place%,
  6436.  date$)
  6437.  I%,D%,M%,Y%,L%,P%,Q%,U$,d$,m$,y$
  6438.  L%=0 
  6439.  I%=1 
  6440.   C$=
  6441. D$,I%,1)
  6442.  C$<"0" 
  6443.  C$>"9" 
  6444.  P%=0 
  6445.  P%=I% 
  6446.  Q%=I%
  6447.  P%=0 
  6448.  Q%=0 
  6449. restore(Fieldnumber%,"",102):=
  6450. D$,P%-1))
  6451. D$,P%+1,Q%-P%-1))
  6452. D$,Q%+1))
  6453.  Y%<0 
  6454.  D%<1 
  6455. restore(Fieldnumber%,"",4):=
  6456.  M%<1 
  6457.  M%>12 
  6458. restore(Fieldnumber%,
  6459. msg("Err118"),4):=
  6460.  400=0:U$="312931303130313130313031"
  6461.  100<>0 
  6462.  4=0:U$="312931303130313130313031"
  6463. :U$="312831303130313130313031"
  6464. U$,2*M%-1,2)
  6465. (DM$) 
  6466. restore(Fieldnumber%,
  6467. msg("Err119,"+DM$),4):=
  6468. g"d$=
  6469. (D%):
  6470. (d$)=1 
  6471.  d$="0"+d$
  6472. h"m$=
  6473. (M%):
  6474. (m$)=1 
  6475.  m$="0"+m$
  6476. i"y$=
  6477. (Y%):
  6478. (y$)=1 
  6479.  y$="0"+y$
  6480. (y$)<>2 
  6481. (y$)<>4 
  6482. restore(Fieldnumber%,
  6483. msg("Err120"),4):=
  6484. (y$)=4 
  6485.  len%(Fieldnumber%)<10 
  6486. y$,2)
  6487. (y$)=2 
  6488.  len%(Fieldnumber%)>=10 
  6489. $,12,2)+y$
  6490. m&date$=d$+$datesep%+m$+$datesep%+y$
  6491.  place%=0 
  6492. (date$)>len%(Fieldnumber%) 
  6493. restore(Fieldnumber%,
  6494. msg("Err121"),4):=
  6495.  place% 
  6496. qH  $Rf%(Fieldnumber%)=date$:
  6497. redraw_icon(mainW%,field%(Fieldnumber%))
  6498. s7  $
  6499. text(searchW%,1)=date$:
  6500. redraw_icon(searchW%,1)
  6501. convert_date(L%)
  6502.  d$,m$,y$,M$,M%
  6503. $,5,2)
  6504. $,8,3)
  6505. months$,M$)
  6506. M%=(P%+2) 
  6507. } m$=
  6508. (M%):
  6509.  M%<10 
  6510.  m$="0"+m$
  6511. $,16-L%,L%)
  6512. !=d$+$datesep%+m$+$datesep%+y$
  6513. reverse_date(K$)
  6514.  sep$
  6515. (K$) 
  6516.   sep$=
  6517. K$,3,1)
  6518. .  K$=
  6519. K$,2)+sep$+
  6520. K$,4,2)+sep$+
  6521. K$,2) 
  6522. (K$)<100 
  6523.     sep$=
  6524. K$,3,1)
  6525. +    K$=
  6526. K$,4)+sep$+
  6527. K$,4,2)+sep$+
  6528. K$,2)
  6529.         
  6530.     sep$=
  6531. K$,5,1)
  6532. +    K$=
  6533. K$,2)+sep$+
  6534. K$,6,2)+sep$+
  6535. K$,4)
  6536. refresh_dates
  6537.  key%
  6538.  key%=0 
  6539.  Keys%
  6540. date(key%)
  6541.  key%
  6542. seconds(time$,place%)
  6543.  I%,L%,P%,Q%,H%,M%,S%,secs%,h$,m$,s$,C$
  6544. (time$)
  6545.  L%=0 
  6546.  I%=1 
  6547.   C$=
  6548. time$,I%,1)
  6549.  C$<"0" 
  6550.  C$>"9" 
  6551.  P%=0 
  6552.  P%=I% 
  6553.  Q%=I%
  6554.  P%=0 
  6555.  Q%=0 
  6556. restore(Fieldnumber%,"",101):=-1
  6557. time$,P%-1)):
  6558.  H%<0 
  6559.  H%>23 
  6560. restore(Fieldnumber%,"hours",94):=-1
  6561. time$,P%+1,Q%-P%-1)):
  6562.  M%<0 
  6563.  M%>59 
  6564. restore(Fieldnumber%,"minutes",94):=-1
  6565. time$,Q%+1)):
  6566.  S%<0 
  6567.  S%>59 
  6568. restore(Fieldnumber%,"seconds",94):=-1
  6569. (H%):
  6570. (h$)=1 
  6571.  h$="0"+h$
  6572. (M%):
  6573. (m$)=1 
  6574.  m$="0"+m$
  6575. (S%):
  6576. (s$)=1 
  6577.  s$="0"+s$
  6578. &time$=h$+$timesep%+m$+$timesep%+s$
  6579. secs%=H%*3600+M%*60+S%
  6580.  place%=0 
  6581.  $Rf%(Fieldnumber%)=time$:
  6582. redraw_icon(mainW%,field%(Fieldnumber%))
  6583. =secs%
  6584. time(secs%)
  6585.  H%,M%,S%,h$,m$,s$
  6586. &H%=secs% 
  6587.  3600:secs%=secs% 
  6588.  3600
  6589. M%=secs% 
  6590. S%=secs% 
  6591. (H%):
  6592. (h$)=1 
  6593.  h$="0"+h$
  6594. (M%):
  6595. (m$)=1 
  6596.  m$="0"+m$
  6597. (S%):
  6598. (s$)=1 
  6599.  s$="0"+s$
  6600. !=h$+$timesep%+m$+$timesep%+s$
  6601. validate(F%,
  6602.  TabFields%,
  6603.  name$)
  6604. selected(prefsW%,21) 
  6605.  row%,field%,Rows%,Rec%,ind%,sind%,pos%,start%,subst%,spos%,date$,subst$,L1%,L2%,L%,S$,exact%,extra$
  6606. S$=$Rf%(F%):L%=
  6607.  S$="" 
  6608.  fix%(F%)<>0 
  6609.  $Rf%(F%)=
  6610. fix_point(S$,F%):
  6611. redraw_icon(mainW%,field%(F%))
  6612.  chartype%(F%)=3 
  6613. check_val(calc$(F%),S$)=
  6614.  chartype%(F%)=5 
  6615. check_date(S$,0,date$)
  6616.  chartype%(F%)=8 
  6617. seconds(S$,0)>=0)
  6618. Bname$=link$(F%):
  6619.  name$="" 
  6620. name$,1)="#" 
  6621. name$,1)="@" 
  6622. )field%=
  6623. trailing_number(name$,exact%)
  6624. !subst%=
  6625. leading_number(name$)
  6626. table_number(name$):
  6627.  T%<0 
  6628. table_info(T%,Rows%,TabFields%,Rec%,tabfieldlen%(),offset%,heading%,colours$)
  6629.  S$=field$(F%) 
  6630.  TabFields%=0 
  6631. ,pos%=
  6632. table_field(field%,tabfieldlen%())
  6633.  subst%<0 
  6634.  spos%=pos% 
  6635.  spos%=
  6636. table_field(subst%,tabfieldlen%())
  6637. 'start%=!tabanchor%(T%)+offset%-Rec%
  6638. 'ind%=start%+pos%:sind%=start%+spos%
  6639.  exact% 
  6640. 1  cond$="row%>Rows% OR $ind%=S$ OR $sind%=S$"
  6641.  cond$="row%>Rows% OR ($ind%=LEFT$(S$,L1%) AND L1%>0) OR ($sind%=LEFT$(S$,L2%) AND L2%>0)"
  6642.  row%+=1
  6643.   ind%+=Rec%:sind%+=Rec%
  6644.    L1%=
  6645. ($ind%):L2%=
  6646. ($sind%)
  6647. (cond$)=
  6648.  row%>Rows% 
  6649. restore(F%," ("+name$+")",5):=
  6650.  exact% 
  6651. ,    
  6652.  $sind%=
  6653. S$,L2%):extra$=
  6654. S$,L%-L2%)
  6655. +    
  6656.  $ind%=
  6657. S$,L1%):extra$=
  6658. S$,L%-L1%)
  6659. ind%=start%+row%*Rec%
  6660.  I%=0 
  6661.  TabFields%
  6662. ,  rel%(I%)=ind%:ind%+=tabfieldlen%(I%)+1
  6663.  subst%>=0 
  6664.   subst$=$sind%
  6665.   S$=subst$+extra$
  6666. (S$)<=len%(F%) 
  6667.  $Rf%(F%)=S$
  6668. redraw_icon(mainW%,field%(F%))
  6669.     =row%
  6670. check_val(C$,N$)
  6671.  min$,max$,P%,V,ok%
  6672.     ok%=
  6673.  N$="" 
  6674.  C$<>"" 
  6675.   P%=
  6676. C$,"|")
  6677.  P%>0 
  6678.     min$=
  6679. C$,P%-1)
  6680.     max$=
  6681. C$,P%+1)
  6682. H    
  6683.  min$<>"" 
  6684. (min$) 
  6685.  ok%=
  6686. restore(F%," (min="+min$+")",58)
  6687. H    
  6688.  max$<>"" 
  6689. (max$) 
  6690.  ok%=
  6691. restore(F%," (max="+max$+")",59)
  6692. restore_rec
  6693.  F%=1 
  6694.  fields%
  6695.  field$(F%)<>$Rf%(F%) 
  6696.     $Rf%(F%)=field$(F%)
  6697. '    
  6698. redraw_icon(mainW%,field%(F%))
  6699. restore(F%,E$,E%)
  6700.  E%>=0 
  6701. softerror(E$,E%)
  6702. $Rf%(F%)=field$(F%)
  6703. redraw_icon(mainW%,field%(F%))
  6704. set_caret(mainW%,field%(F%))
  6705. relations
  6706.  F%,I%,W%,L%,N$,row%,col%,subst%,flags%,name$,x%,y%,vxmin%,vymax%,scrollx%,scrolly%,exact%
  6707.  "Wimp_CreateMenu",,-1
  6708. getscreensize(ScreenWidth%,ScreenHeight%,Vpix%)
  6709. name$=link$(Fieldnumber%)
  6710.  name$="" 
  6711.  $Rf%(Fieldnumber%)="" 
  6712.     F%=-1
  6713. &row%=
  6714. validate(Fieldnumber%,F%,N$)
  6715. 'col%=
  6716. trailing_number(name$,exact%)
  6717. !subst%=
  6718. leading_number(name$)
  6719.  row%>0 
  6720. delete_icons(relateW%,0)
  6721.  I%=0 
  6722. 0      
  6723.  col%:flags%=&00000531+(fcol%(8)<<24)
  6724. #      
  6725.  subst%:flags%=&0B000531
  6726.       
  6727. :flags%=&07000531
  6728.         
  6729.     L%=
  6730. ($rel%(I%))
  6731. T    R%=
  6732. create_icon(relateW%,0,-I%*36-36,L%*16+16,32,flags%,"",rel%(I%),-1,L%+1)
  6733.  L%>W% 
  6734.  W%=L%
  6735.  W%<3 
  6736.  W%=3
  6737.   $RelTitle%=N$
  6738.  &  width%=W%*16+16:height%=F%*36+36
  6739. !a  !block%=0:block%!4=-height%:block%!8=width%:block%!12=0:
  6740.  "Wimp_SetExtent",relateW%,block%
  6741. "5  !block%=mainW%:
  6742.  "Wimp_GetWindowState",,block%
  6743. #L  vxmin%=block%!4:vymax%=block%!16:scrollx%=block%!20:scrolly%=block%!24
  6744. $Q  !block%=mainW%:block%!4=field%(Fieldnumber%):
  6745.  "Wimp_GetIconState",,block%
  6746. %?  x%=block%!16-scrollx%+vxmin%:y%=block%!20-scrolly%+vymax%
  6747. &7  !block%=relateW%:
  6748.  "Wimp_GetWindowState",,block%
  6749.  ScreenWidth%-x%<width% 
  6750.  width%=ScreenWidth%-x%
  6751. ()  block%!4=x%+4:block%!12=x%+width%-4
  6752. )*  block%!8=y%-height%-4:block%!16=y%-4
  6753. */  block%!28=-1:
  6754.  "Wimp_OpenWindow",,block%
  6755.  "Wimp_CreateMenu",,relateW%,x%+4,y%-4
  6756. fix_point(F$,F%)
  6757.  F$="" 
  6758.  fix%(F%) 
  6759.  -1:F$=
  6760. (V+0.5))
  6761.  Floating point. Do nothing
  6762. :@%=&01020009+fix%(F%)*256:F$=
  6763. (V),len%(F%)):@%=&90A
  6764. moveto(key%,P%,D%)
  6765. D%=(D%+1) 
  6766.  filter% 
  6767. =&  P%=
  6768. next_match(P%,D%,Filter$,Z%)
  6769.   P%=
  6770. neighbour(key%,P%,D%)
  6771.  P%=top 
  6772.  7:P%=
  6773. neighbour(key%,P%,D%)
  6774. display(key%,P%)
  6775. next_match(P%,D%,S$,
  6776.  nomore%)
  6777.  record%,abort%,passgo%,matched%
  6778. G*dbasehandle%=
  6779. ($database%+".Database")
  6780.   P%=
  6781. neighbour(key%,P%,D%)
  6782.  P%=top 
  6783.     nomore%=
  6784. L!    P%=
  6785. neighbour(key%,P%,D%)
  6786.     passgo%+=1
  6787. N+    
  6788.  passgo%>1 
  6789.  matched% 
  6790.  abort%=
  6791.  P%=top 
  6792.     matched%=
  6793. R        
  6794. S#    record%=
  6795. rec_no(k$,key%,P%)
  6796. T*    
  6797. readsmarray(dbasehandle%,record%)
  6798. U(    
  6799. (S$)=
  6800.  matched%=
  6801. :passgo%=0
  6802.  matched% 
  6803.  abort%
  6804. close_file(dbasehandle%)
  6805.  abort% 
  6806. softerror($Query%,113)
  6807. display(key%,P%)
  6808. ]3!block%=mainW%:
  6809.  "Wimp_GetWindowState",,block%
  6810.  P%=-1 
  6811. check_change
  6812.  template%=1 
  6813.  template%=2 
  6814.  template%=0
  6815.  I%,L%,S%,S$,k$,ok%
  6816. c.  keybase%=!keyanchor%(0):avail%=!keybase%
  6817. e:    
  6818.  !(keybase%+avail%)>0,template%=2,design%=
  6819. :ok%=
  6820.     incr%=
  6821. ($Increment%)
  6822.  incr%>0 
  6823. i+      
  6824. change_length(RA%+incr%,
  6825. ):ok%=
  6826.       
  6827. softerror("",2)
  6828. k        
  6829.  ok% 
  6830. o:      
  6831.  design%:$RecInfo%="Make adjustments to fields"
  6832. pa      
  6833.  template%=2:$RecInfo%="Enter data which you want to appear by default on new records"
  6834. qf      
  6835. :REC%=!(keybase%+avail%+8+KL%(0)+1):$RecInfo%=$Subfile%(file%)+" Record="+
  6836. (REC%)+". (New)"
  6837. r        
  6838. s'    
  6839. read(fields%,
  6840. ,RA%,$database%)
  6841.  top:
  6842.  ### Empty subfile accessed ###
  6843. w.  keybase%=!keyanchor%(0):avail%=!keybase%
  6844. x(  REC%=!(keybase%+avail%+8+KL%(0)+1)
  6845. read(fields%,
  6846. ,RA%,$database%)
  6847.  7:$RecInfo%=$Subfile%(file%)+" Record="+
  6848. (REC%)+". (New)"
  6849.   REC%=
  6850. rec_no(k$,key%,P%)
  6851. read(fields%,
  6852. ,REC%,$database%)
  6853.   key$(key%)=k$
  6854. k$)="#"
  6855.     k$=
  6856. >  $RecInfo%=$Subfile%(file%)+" Record="+
  6857. (REC%)+" Key="+k$
  6858. Lastwritable%=starthere%
  6859. text_length(mainW%,starthere%)
  6860.  Access% 
  6861. set_caret(mainW%,starthere%)
  6862. identify_field(starthere%)
  6863. changed%=
  6864. update_calcs(0)
  6865. *logentry$=$Subfile%(file%)+" "+
  6866. key(0)
  6867.  altered% 
  6868. $RecInfo%)<>"*" 
  6869.  $RecInfo%+=" *"
  6870. redraw(mainW%)
  6871.  -------------------- Icon colours -------------------------------
  6872. colour(key%,type%)
  6873.  type%=1 - Selected key,2 - Non-selected key
  6874.  J%=0 
  6875.  KF%(key%,J%)>0 
  6876. change_field_cols(key%,type%,J%)
  6877. change_field_cols(key%,type%,fld%)
  6878.  key% 
  6879.  type% 
  6880. )    
  6881.  1:dcol%=fcol%(0):fcol%=fcol%(1)
  6882. )    
  6883.  2:dcol%=fcol%(2):fcol%=fcol%(3)
  6884.  type% 
  6885. )    
  6886.  1:dcol%=fcol%(4):fcol%=fcol%(5)
  6887. )    
  6888.  2:dcol%=fcol%(6):fcol%=fcol%(7)
  6889. set_icon_cols(mainW%,desc%(KF%(key%,fld%)),dcol%)
  6890. 6col%=
  6891. get_icon_cols(mainW%,field%(KF%(key%,fld%)))
  6892.  (col% 
  6893.  16)=fcol%(8) 
  6894.  fcol%=(fcol% 
  6895.  &F0) 
  6896.  (col% 
  6897. set_icon_cols(mainW%,field%(KF%(key%,fld%)),fcol%)
  6898. get_icon_cols(wi%,ic%)
  6899. ;!block%=wi%:block%!4=ic%:
  6900.  "Wimp_GetIconState",,block%
  6901. =block%?27
  6902. set_icon_cols(wi%,ic%,col%)
  6903.  col%<0 
  6904.  col%=
  6905. (col%):block%!12=&0F000000 
  6906.  block%!12=&FF000000
  6907. F!block%=wi%:block%!4=ic%:block%!8=(col%<<24):
  6908.  block%!12=&FF000000
  6909.  "Wimp_SetIconState",,block%
  6910. read_colours(f$)
  6911.  ic%=0 
  6912. #F,fcol%(ic%)
  6913. ncol%()=fcol%()
  6914. close_file(F)
  6915. write_colours
  6916. ($database%+".Cols")
  6917.  ic%=0 
  6918. #F,fcol%(ic%)
  6919. close_file(F)
  6920. find(S$,key%,m%,disp%)
  6921.  P%,F%,H%,num%,abort%,cond$
  6922.  case%(key%) 
  6923. u(S$)
  6924. S$,1)="#" 
  6925. check_change
  6926.   REC%=
  6927. S$,2))
  6928.  REC%>=0 
  6929.  REC%<RA% 
  6930. (    
  6931. read(fields%,
  6932. ,REC%,$database%)
  6933. !    S$=key$(key%):H%=1:num%=
  6934. 1    
  6935. select(searchW%,6):
  6936. deselect(searchW%,5)
  6937. $    
  6938. softerror(S$,56):abort%=
  6939. S$,KL%(key%))
  6940.  abort% 
  6941. =addr
  6942. val$=
  6943. type(key%)
  6944.  val$="VAL" 
  6945.   kl%=KL%(key%)
  6946.   S$=
  6947. stripspaces(S$)
  6948.   kl%=
  6949. search(S$,key%,1+H%)
  6950.  P%<0 
  6951. selected(searchW%,6) 
  6952.   F%=file%
  6953.     file%=(file%+1) 
  6954.     top=8*file%+LH%
  6955.      P%=
  6956. search(S$,key%,1+H%)
  6957.  P%>0 
  6958.  file%=F%
  6959.  val$="VAL" 
  6960.  cond$="VAL($(!keyanchor%(key%)+P%+8))=VAL(S$)" 
  6961.  cond$="LEFT$($(!keyanchor%(key%)+P%+8),kl%)=S$"
  6962. matches%=0
  6963.  P%>=0 
  6964.  num%:RecF%=
  6965. :addr=P%
  6966.  P%>=0:RecF%=
  6967. (cond$)
  6968.      P%=
  6969. neighbour(key%,P%,0)
  6970. \  P%=
  6971. neighbour(key%,P%,1):addr=P%:
  6972.  ### Scan back to FIRST match & point addr at it ###
  6973. (cond$)
  6974.     matches%+=1
  6975.      P%=
  6976. neighbour(key%,P%,1)
  6977.  num%:
  6978. softerror("#"+
  6979. (REC%),55)
  6980.  disp% 
  6981.  addr=
  6982. (P%):flash%=KF%(key%,0) 
  6983.  addr=P%
  6984. text(searchW%,7)=
  6985. (matches%)+" found":
  6986. redraw_icon(searchW%,7)
  6987.  disp% 
  6988. display(key%,addr)
  6989.     =addr
  6990. lookup(F%)
  6991.  K%,S$,K$
  6992.  chartype%(F%)>8 
  6993. is_a_key(F%)
  6994.  K%>=0 
  6995.   K$=
  6996. key(K%)
  6997.   addr=
  6998. find(K$,key%,1,
  6999.  addr=
  7000. find($Rf%(F%),key%,1,
  7001. get_it_in(filename$)
  7002.  "OS_File",5,filename$ 
  7003.  d%,,ftype%
  7004. 9ftype%=(ftype%>>8) 
  7005.  &fff:wi%=block%!20:ic%=block%!24
  7006.  ftype% 
  7007.  &7f1:
  7008. load_table(filename$,
  7009.  &7f3:
  7010. load_selection(filename$)
  7011.  &7f4:
  7012. load_query(filename$,wi%,ic%)
  7013.  &7f5:
  7014. get_options(printW%,filename$)
  7015.  &dfe:$
  7016. text(csvW%,13)=filename$:
  7017. start_import("CSV",wi%)
  7018.  &ff9,&aff:
  7019. transfer_blob(block%!20,block%!24,filename$,ftype%)
  7020.  &bc5:
  7021. ready_to_merge(&bc5)
  7022.  &fff:
  7023. /  F=
  7024. (filename$):header$=
  7025. close_file(F)
  7026.  wi% 
  7027. *    
  7028.  mainW%,tableW%(Tablenumber%),-1:
  7029. O      
  7030.  header$="!SCRIPT POWERBASE":
  7031.  present%=7:
  7032. execute_script(filename$)
  7033. S      
  7034.  wi%=mainW% 
  7035.  ic%>0:
  7036. transfer_blob(block%!20,block%!24,filename$,ftype%)
  7037. @      
  7038. text(csvW%,13)=filename$:
  7039. start_import("text",wi%)
  7040.         
  7041. &    
  7042.  customise% 
  7043. special_drop
  7044.  d%=2 
  7045.  wi%=reformW% 
  7046. /      
  7047.  "OS_File",5,filename$+".Form" 
  7048.       
  7049.  d%=1 
  7050. !R        $
  7051. text(wi%,7)=filename$:
  7052. redraw_icon(wi%,7):
  7053. icon_bit(22,reformW%,6,
  7054.         
  7055. softerror("",28)
  7056.       
  7057.       
  7058. %#      
  7059. leaf(filename$),1) 
  7060.         
  7061.  "!":
  7062. '3        
  7063.  ### Is it an Impression document? ###
  7064. (5        
  7065.  "OS_File",5,filename$+".!DocData" 
  7066.         
  7067.  d%=1 
  7068. *$          
  7069. ready_to_merge(&2000)
  7070.           
  7071. ,6          
  7072.  ### Is it a Powerbase application? ###
  7073. -=          
  7074.  "OS_File",5,filename$+".Indices" 
  7075.  d%,,type%
  7076. .%          type%=(type%>>8) 
  7077.  &fff
  7078.           
  7079.  d%=2 
  7080. 0$            
  7081.  present%>0 
  7082. 1(            $Title%=
  7083. leaf(filename$)
  7084. 2&            
  7085. open_files(filename$)
  7086.           
  7087.         
  7088.         
  7089. 67        
  7090.  ### It's an ordinary directory folder ###
  7091. 7<        
  7092. transfer_blob(block%!20,block%!24,filename$,-1)
  7093.       
  7094. 9        
  7095. ready_to_merge(doctype%)
  7096.  present%=7 
  7097. @   document$=
  7098. leaf(filename$)
  7099. document$,1)="!" 
  7100.  document$=
  7101. document$,2)
  7102. B6  block%!0=256:block%!12=0:block%!16=5:block%!20=0
  7103. C5  block%!24=0:block%!28=0:block%!32=0:block%!36=0
  7104. D/  block%!40=doctype%:$(block%+44)=filename$
  7105.  "Wimp_SendMessage",18,block%,0
  7106.   Impref%=block%!8
  7107. softerror("",107)
  7108. open_files(f$)
  7109.  I%,J%,F%,A$
  7110.  ### Delete redundant files if present ###
  7111.  "OS_CLI","Remove "+f$+".Winsize"
  7112.  "OS_CLI","Remove "+f$+".Choices"
  7113. read_sys_vars(f$)
  7114.  "OS_File",5,f$+".Database" 
  7115.  d%=1 
  7116.  present%=present% 
  7117.  "OS_File",5,f$+".PrimaryKey" 
  7118.  d%=1 
  7119.  present%=present% 
  7120.  "OS_File",5,f$+".Form" 
  7121.  d%=1 
  7122.  present%=present% 
  7123.  "OS_File",5,f$+".UsrSprites" 
  7124.  d%,,,,len%
  7125.  d%=1 
  7126. create_named_sliding_block(logoanchor%,len%+8)
  7127. Z&  base%=!logoanchor%:!base%=len%+4
  7128.  "OS_File",255,f$+".UsrSprites",base%+4
  7129.   logosloaded%=
  7130. $database%=f$
  7131.  present% 
  7132.  0,1,5:Access%=
  7133. :Modify%=
  7134. resume_opening
  7135. access(f$,accessW%) 
  7136. resume_opening
  7137. wimp_error(
  7138. ,254,0,
  7139. msg("Err24"))
  7140. read_sys_vars(f$)
  7141.  E%,F,A$,L$,S$
  7142. (f$+".!Run")
  7143.   S$=
  7144. S$,"Acl$Dir")>0 
  7145.  A$=S$
  7146. S$,"Log$Dir")>0 
  7147.  L$=S$
  7148. close_file(F)
  7149.  A$="" 
  7150.  A$="Set Acl$Dir "+f$
  7151.  L$="" 
  7152.  L$="Set Log$Dir "+f$
  7153.  "XOS_ReadVarVal","Acl$Dir",,-1 
  7154.  ,,E%:
  7155.  E%=0 
  7156.  "OS_CLI",A$
  7157.  "XOS_ReadVarVal","Log$Dir",,-1 
  7158.  ,,E%:
  7159.  E%=0 
  7160.  "OS_CLI",L$
  7161. access(f$,wi%)
  7162.  L%,P%,keybase%,login%,attempts%,old%
  7163. (f$+".Colours")
  7164.  F>0 
  7165. #F=35:old%=
  7166. (f$+".Cols")
  7167.  F>0 
  7168. #F=45:old%=
  7169.  fatal_err%,f$+"."+
  7170. msg("Err18")
  7171. #F,S$:$Read%=
  7172. encrypt(S$,
  7173. #F,S$:$Write%=
  7174. encrypt(S$,
  7175. #F,S$:$Manager%=
  7176. encrypt(S$,
  7177.  I%=9 
  7178. select(passW%,I%)
  7179. deselect(passW%,16)
  7180.  I%<17 
  7181. #F,Z%:
  7182. set_icon(passW%,I%,Z%)
  7183.   I%+=1
  7184. close_file(F)
  7185.  old% 
  7186.  "OS_CLI","Copy <PBase$Dir>.Resources.Cols "+f$+".Cols ~C~V"
  7187. mouse(-1,0,4,passW%,4)
  7188.  "OS_CLI","Remove "+f$+".Colours"
  7189.  "OS_File",5,"<Acl$Dir>.acl" 
  7190.  d%:acl%=(d%=1)
  7191.  $Manager%="" 
  7192.  acl%=
  7193.  Access%=
  7194. :Modify%=
  7195. 9$AccessTitle%="!Powerbase opening "+
  7196. leaf($database%)
  7197.  acl% 
  7198. position_window(wi%,0,0,0,310,0,110):refuse$="Access denied"
  7199. position_window(wi%,0,0,0,200,0,0):refuse$="Password not known"
  7200. 0!block%=wi%:
  7201.  "Wimp_GetWindowState",,block%
  7202.  block%!4,block%!8,block%!12-block%!4,block%!16-block%!8
  7203. (  cancel%=
  7204. :login%=
  7205. :accessbutton%=0
  7206.   $Password%="":$UserID%=""
  7207. redraw_icon(wi%,1):
  7208. redraw_icon(wi%,0)
  7209. text(wi%,5)="Type in your password"
  7210.  acl% 
  7211. set_caret(wi%,0) 
  7212. set_caret(wi%,1)
  7213.  accessbutton%>0
  7214.  accessbutton% 
  7215.  2:cancel%=
  7216. +    password$=$Password%:user$=$UserID%
  7217.  acl% 
  7218.       F=
  7219. ("<Acl$Dir>.acl")
  7220.       
  7221. !        
  7222. #F,id$,personal$,pw%
  7223. X        
  7224.  id$=
  7225. encrypt(user$,
  7226.  personal$=
  7227. encrypt(password$,
  7228.  pw%>0 
  7229.  login%=
  7230.       
  7231.  login% 
  7232.       
  7233. close_file(F)
  7234.       
  7235.       user$="<none>"
  7236.       
  7237.  password$ 
  7238. &        
  7239.  $Manager%:pw%=3:login%=
  7240. $        
  7241.  $Write%:pw%=2:login%=
  7242. #        
  7243.  $Read%:pw%=1:login%=
  7244.       
  7245.         
  7246.  (login% 
  7247.  cancel%) 
  7248.     $
  7249. text(wi%,5)=refuse$
  7250. !    
  7251. set_icon_cols(wi%,5,&1B)
  7252.     delay%=
  7253.         
  7254.       
  7255. >delay%
  7256. !    
  7257. set_icon_cols(wi%,5,&17)
  7258.     attempts%+=1
  7259. R    att$(attempts%)=
  7260. (attempts%)+","+
  7261. leaf($database%)+","+user$+","+password$
  7262.  login% 
  7263.  cancel% 
  7264.  attempts%=3
  7265. getscreensize(W%,H%,V%)
  7266. #Access%=(pw%>1):Modify%=(pw%>2)
  7267. close_window(wi%)
  7268.  0,0,W%,H%
  7269.  attempts%=3 
  7270. "  user$="<unrecognised>":pw%=0
  7271. open_log("<Log$Dir>.Log",
  7272.  I%=1 
  7273. /    
  7274. write_log(-1,
  7275. msg("Err122,"+att$(I%)))
  7276. close_log("<Log$Dir>.Log")
  7277. close_down
  7278. =login%
  7279. resume_opening
  7280.  "OS_Byte",202,kbdstatus%
  7281.  "Hourglass_On"
  7282. selected(passW%,16) 
  7283. open_log("<Log$Dir>.Log",
  7284. ($database%+".Subfiles")
  7285.  I%=0 
  7286. *    
  7287.  0:$Subfile%(I%)="Subfile "+
  7288.     S$=
  7289. %    
  7290.  S$="" 
  7291.  S$="Subfile "+
  7292.     $Subfile%(I%)=S$
  7293. close_file(F)
  7294.  "OS_File",5,f$+".UserFuncs" 
  7295.  d%=1 
  7296.  f$+".UserFuncs"
  7297.  "OS_File",5,f$+".Cols" 
  7298.  d%=0 
  7299.  "OS_CLI","Copy <PBase$Dir>.Resources.Cols "+f$+".Cols ~C~V"
  7300.  "OS_CLI","Remove "+f$+".Colours"
  7301. read_colours($database%+".Cols")
  7302.  "OS_File",5,f$+".PrintRes.PrtOptions" 
  7303.  d%=1 
  7304. get_options(printW%,f$+".PrintRes.PrtOptions")
  7305. get_options(printW%,"<Pbase$Dir>.Resources.PrtOptions")
  7306.  "OS_File",5,f$+".Preference" 
  7307.  d%=1 
  7308. get_preferences(prefsW%,f$+".Preference")
  7309. deselect(prefsW%,36):
  7310. select(prefsW%,35):
  7311. icon_bit(22,prefsW%,35,
  7312. f$,3)="RAM" 
  7313.  ram%=
  7314.  "OS_CLI","Set Alias$Indices Filer_OpenDir "+$database%+".Indices"
  7315.  "OS_CLI","Set Alias$Tables Filer_OpenDir "+$database%+".ValTables"
  7316.  "OS_CLI","Set Alias$Resources Filer_OpenDir "+$database%+".PrintRes"
  7317.  "OS_CLI","Set Alias$JobsDone Filer_OpenDir "+$database%+".PrintJobs"
  7318. icon_bit(22,csvW%,18,Modify%)
  7319. icon_bit(22,csvW%,17,Access%)
  7320. icon_bit(22,printW%,50,Modify%)
  7321. icon_bit(22,printW%,49,Access%)
  7322. icon_bit(22,prefsW%,38,Modify%)
  7323. lit(menu%(0),1,
  7324. lit(menu%(0),2,Modify%)
  7325. lit(menu%(0),3,
  7326. lit(menu%(0),5,Modify%)
  7327. lit(menu%(1),6,
  7328. selected(passW%,9))
  7329. lit(menu%(7),0,Access%)
  7330. lit(menu%(7),1,Modify%)
  7331. lit(menu%(7),2,Access%)
  7332. lit(menu%(7),3,Access%)
  7333. lit(menu%(7),4,Access%)
  7334. lit(menu%(2),0,Access%)
  7335. lit(menu%(10),0,Access%)
  7336. lit(menu%(10),2,Access%)
  7337. lit(menu%(10),3,Access%)
  7338. lit(menu%(17),0,Access%)
  7339. lit(menu%(17),3,Access%)
  7340. lit(menu%(3),0,((present% 
  7341.  4)>0))
  7342. lit(menu%(9),1,((present% 
  7343.  4)=0))
  7344.  I%=1 
  7345. lit(menu%(3),I%,(present%=7))
  7346. limit_actions(Access%)
  7347.  present%<4 
  7348.  design%=
  7349.  present%=5 
  7350. adjust_on(
  7351. lit(menu%(9),5,
  7352. fields%=
  7353. get_form(Fptr%)
  7354. 0chartype%(0)=100:chartype%(MaxFields%+1)=100
  7355.  fields%>0 
  7356. >  starthere%=field%(
  7357. first_field):Lastwritable%=starthere%
  7358. %  fieldmenu%=
  7359. field_menu(fields%)
  7360. create_named_sliding_block(transanchor%,Length%+1)
  7361.  adjust% 
  7362. lit(menu%(9),2,(fields%>0))
  7363.  present% 
  7364. -  $RecInfo%="No record design exists yet"
  7365.  I%=1 
  7366. lit(menu%(9),I%,
  7367. get_winpos
  7368.  !formanchor%=0 
  7369. $2    
  7370. extend_named_sliding_block(formanchor%,0)
  7371.     Fptr%=!formanchor%
  7372. &     fields%=0:Fieldnumber%=0
  7373. )8  $RecInfo%="Record design exists, but no datafiles"
  7374. first_field>0 
  7375. lit(menu%(9),3,
  7376. lit(menu%(9),4,
  7377. get_winpos
  7378. 06  $RecInfo%="No primary key index file exists yet"
  7379.  "OS_File",5,$database%+".Database" 
  7380.  ,,,,len%
  7381. 2-  RA%=(len% 
  7382.  Length%)-1:$Records%=
  7383. (RA%)
  7384. first_field>0 
  7385. get_winpos
  7386. lit(menu%(1),8,
  7387. selected(passW%,13))
  7388. lit(menu%(1),9,
  7389. selected(passW%,13))
  7390. lit(menu%(1),2,
  7391. selected(passW%,14))
  7392.  "OS_File",5,$database%+".Database" 
  7393.  ,,,,len%
  7394. 9-  RA%=(len% 
  7395.  Length%)-1:$Records%=
  7396. (RA%)
  7397.  (len% 
  7398.  Length%)<>0 
  7399. rectify
  7400. open_index($database%+".PrimaryKey",0,
  7401. <$  key%=0:file%=0:top=8*file%+LH%
  7402. =#  $Subfilename%=$Subfile%(key%)
  7403. set_keydata(key%)
  7404. ?Z  keybase%=!keyanchor%(0):
  7405.  keybase%!4>0 
  7406.  $Increment%=
  7407. (keybase%!4) 
  7408.  $Increment%="0"
  7409. @,  f$=$database%+".Indices":R4%=0:Keys%=0
  7410.  R4%<>-1
  7411.     Keys%+=1
  7412. C5    
  7413.  "OS_GBPB",9,f$,block%,1,R4%,11 
  7414.  ,,K$,,R4%
  7415. DC    
  7416.  R4%<>-1 
  7417. open_index(f$+"."+K$,Keys%,
  7418. colour(Keys%,2)
  7419.   Keys%-=1
  7420.  extrakeys$<>"" 
  7421. softerror(
  7422. extrakeys$),96)
  7423. colour(0,1)
  7424. get_tables
  7425.   key%=0
  7426. count(key%,RU%):
  7427. update_stats
  7428. get_winpos
  7429. load_calcs
  7430. auto_csv(
  7431. selected(prefsW%,44))
  7432.   addr=
  7433. moveto(key%,top,1)
  7434.  "Hourglass_Off"
  7435. $dbase%=
  7436. $Title%,2)
  7437. redraw_icon(-2,pbaseicon%)
  7438. f$=$database%+".CSVoptions"
  7439.  "OS_File",5,f$ 
  7440.  d%=1 
  7441. get_csv_options(f$)
  7442. make_user_menus
  7443.  "OS_File",5,$database%+".Special" 
  7444.  d%=1 
  7445.  $database%+".Special":
  7446. customise
  7447. rectify
  7448.  REC%,I%,J%,F$
  7449. REC%=-1
  7450. `*dbasehandle%=
  7451. ($database%+".Database")
  7452.  REC%<RA% 
  7453. (F$)<>0
  7454.   REC%+=1
  7455. #dbasehandle%=Length%*REC%
  7456.   F$=
  7457. #dbasehandle%
  7458. (F$)=0 
  7459. softerror("",109)
  7460. #dbasehandle%=REC%*Length%
  7461.  "Hourglass_On"
  7462.  I%=REC% 
  7463. k!    
  7464. #dbasehandle%=I%*Length%
  7465.  J%=1 
  7466.  fields%
  7467.       
  7468. #dbasehandle%,""
  7469. o>    
  7470.  "Hourglass_Percentage",((I%-REC%)*100) 
  7471.  (RA%-REC%)
  7472.  "Hourglass_Off"
  7473.  RA%+=1
  7474. #dbasehandle%=(RA%+1)*Length%
  7475. close_file(dbasehandle%)
  7476. val(keypadW%,17)
  7477. $,5,6)="01 Apr" 
  7478. $,17,2)<"12" 
  7479. {!  S$="Stoilet"+
  7480. $block%!32,8)
  7481.  S$="Sdelete"+
  7482. $block%!32,8)
  7483. val(keypadW%,17)=S$
  7484. get_options(wi%,f$)
  7485.  F,S$,C$,P%
  7486. 2  S$=
  7487. #F:P%=
  7488. S$," "):C$=
  7489. S$,P%+1):S$=
  7490. S$,P%-1)
  7491.  "Destination":
  7492. +    
  7493. deselect(wi%,
  7494. selected_esg(wi%,4))
  7495. $      
  7496.  "window":
  7497. select(wi%,38)
  7498. "      
  7499.  "file":
  7500. select(wi%,39)
  7501. %      
  7502.  "printer":
  7503. select(wi%,41)
  7504.         
  7505.  "Headings":
  7506. +    
  7507. deselect(wi%,
  7508. selected_esg(wi%,1))
  7509. ;    
  7510.  C$="descriptor" 
  7511. select(wi%,2) 
  7512. select(wi%,1)
  7513.  "Pitch":
  7514. +    
  7515. deselect(wi%,
  7516. selected_esg(wi%,2))
  7517.       
  7518.  "5":
  7519. select(wi%,4)
  7520.       
  7521.  "10":
  7522. select(wi%,7)
  7523.       
  7524.  "12":
  7525. select(wi%,8)
  7526.       
  7527.  "17":
  7528. select(wi%,6)
  7529.         
  7530.  "Format":
  7531. +    
  7532. deselect(wi%,
  7533. selected_esg(wi%,3))
  7534. C$,6) 
  7535. #      
  7536.  "horiz":
  7537. select(wi%,23)
  7538. "      
  7539.  "vert":
  7540. select(wi%,24)
  7541.       
  7542.  "column":
  7543. /      
  7544. select(wi%,25):$
  7545. text(wi%,15)=
  7546. C$,7)
  7547. #      
  7548.  "label":
  7549. select(wi%,26)
  7550.         
  7551. .    
  7552. icon_bit(22,wi%,15,
  7553. selected(wi%,25))
  7554. B    
  7555. icon_bit(22,wi%,43,
  7556. selected(wi%,25) 
  7557. selected(wi%,23))
  7558. .    
  7559. icon_bit(22,wi%,45,
  7560. selected(wi%,25))
  7561. .    
  7562.  "Expand":
  7563. set_icon(wi%,11,(C$="ON"))
  7564. 1    
  7565.  "Underline":
  7566. set_icon(wi%,29,(C$="ON"))
  7567. 1    
  7568.  "Uppercase":
  7569. set_icon(wi%,12,(C$="ON"))
  7570. .    
  7571.  "Header":
  7572. set_icon(wi%,47,(C$="ON"))
  7573. -    
  7574.  "Page1":
  7575. set_icon(wi%,10,(C$="ON"))
  7576. .    
  7577.  "Footer":
  7578. set_icon(wi%,48,(C$="ON"))
  7579. ,    
  7580.  "Date":
  7581. set_icon(wi%,19,(C$="ON"))
  7582. .    
  7583.  "Shrink":
  7584. set_icon(wi%,40,(C$="ON"))
  7585. /    
  7586.  "Control":
  7587. set_icon(wi%,42,(C$="ON"))
  7588. 2    
  7589.  "PageNumber":
  7590. set_icon(wi%,54,(C$="ON"))
  7591. (    
  7592.  "PageLength":$
  7593. text(wi%,16)=C$
  7594. '    
  7595.  "LineSpace":$
  7596. text(wi%,17)=C$
  7597. %    
  7598.  "Lmargin":$
  7599. text(wi%,30)=C$
  7600. %    
  7601.  "Tmargin":$
  7602. text(wi%,32)=C$
  7603. #    
  7604.  "Title":$
  7605. text(wi%,18)=C$
  7606. '    
  7607.  "TextWidth":$
  7608. text(wi%,34)=C$
  7609. *    
  7610.  "ColumnSpacer":$
  7611. text(wi%,43)=C$
  7612. )    
  7613.  "ColumnWidth":$
  7614. text(wi%,45)=C$
  7615.  "LabelRowOf":
  7616. 3    
  7617. deselect(labelW%,
  7618. selected_esg(labelW%,1))
  7619.      
  7620. select(labelW%,
  7621. (C$)-1)
  7622. +    
  7623.  "LabelWidth":$
  7624. text(labelW%,4)=C$
  7625. ,    
  7626.  "LabelHeight":$
  7627. text(labelW%,6)=C$
  7628. ,    
  7629.  "LabelLines":$
  7630. text(labelW%,10)=C$
  7631. -    
  7632.  "LabelCopies":$
  7633. text(labelW%,17)=C$
  7634. n    
  7635.  "Substitute":
  7636. C$,4)="SUBS" 
  7637. select(labelW%,11):$
  7638. text(labelW%,12)=
  7639. C$,5) 
  7640. deselect(labelW%,11)
  7641. 4    
  7642.  "PrintKey":
  7643. set_icon(labelW%,13,(C$="ON"))
  7644. 5    
  7645.  "SkipBlank":
  7646. set_icon(labelW%,16,(C$="ON"))
  7647. close_file(F)
  7648. save_options(wi%,f$)
  7649. selected_esg(wi%,4) 
  7650.  38:C$="window"
  7651.  39:C$="file"
  7652.  41:C$="printer"
  7653. #F,"Destination "+C$
  7654. selected_esg(wi%,1) 
  7655.  1:C$="tag"
  7656.  2:C$="descriptor"
  7657. #F,"Headings "+C$
  7658. selected_esg(wi%,2) 
  7659.  4:C$="5"
  7660.  7:C$="10"
  7661.  8:C$="12"
  7662.  6:C$="17"
  7663. #F,"Pitch "+C$
  7664. selected_esg(wi%,3) 
  7665.  23:C$="horiz"
  7666.  24:C$="vert"
  7667.  25:C$="column"+$
  7668. text(wi%,15)
  7669.  26:C$="label"
  7670. #F,"Format "+C$
  7671. selected(wi%,11) 
  7672.  C$="ON" 
  7673.  C$="OFF"
  7674. #F,"Expand "+C$
  7675. selected(wi%,29) 
  7676.  C$="ON" 
  7677.  C$="OFF"
  7678. #F,"Underline "+C$
  7679. selected(wi%,12) 
  7680.  C$="ON" 
  7681.  C$="OFF"
  7682. #F,"Uppercase "+C$
  7683. selected(wi%,47) 
  7684.  C$="ON" 
  7685.  C$="OFF"
  7686. #F,"Header "+C$
  7687. selected(wi%,10) 
  7688.  C$="ON" 
  7689.  C$="OFF"
  7690. #F,"Page1 "+C$
  7691. selected(wi%,48) 
  7692.  C$="ON" 
  7693.  C$="OFF"
  7694. #F,"Footer "+C$
  7695. selected(wi%,19) 
  7696.  C$="ON" 
  7697.  C$="OFF"
  7698. #F,"Date "+C$
  7699. selected(wi%,40) 
  7700.  C$="ON" 
  7701.  C$="OFF"
  7702. #F,"Shrink "+C$
  7703. selected(wi%,42) 
  7704.  C$="ON" 
  7705.  C$="OFF"
  7706. #F,"Control "+C$
  7707. selected(wi%,54) 
  7708.  C$="ON" 
  7709.  C$="OFF"
  7710. #F,"PageNumber "+C$
  7711. #F,"PageLength "+$
  7712. text(wi%,16)
  7713. #F,"LineSpace "+$
  7714. text(wi%,17)
  7715. #F,"Lmargin "+$
  7716. text(wi%,30)
  7717. #F,"Tmargin "+$
  7718. text(wi%,32)
  7719. #F,"Title "+$
  7720. text(wi%,18)
  7721. #F,"TextWidth "+$
  7722. text(wi%,34)
  7723. #F,"ColumnSpacer "+$
  7724. text(wi%,43)
  7725. #F,"ColumnWidth "+$
  7726. text(wi%,45)
  7727. selected_esg(labelW%,1)+1)
  7728. #F,"LabelRowOf "+C$
  7729. #F,"LabelWidth "+$
  7730. text(labelW%,4)
  7731. #F,"LabelHeight "+$
  7732. text(labelW%,6)
  7733. #F,"LabelLines "+$
  7734. text(labelW%,10)
  7735. #F,"LabelCopies "+$
  7736. text(labelW%,17)
  7737. selected(labelW%,11) 
  7738.  C$="SUBS"+$
  7739. text(labelW%,12) 
  7740.  C$="OFF"
  7741. #F,"Substitute "+C$
  7742. selected(labelW%,13) 
  7743.  C$="ON" 
  7744.  C$="OFF"
  7745. #F,"PrintKey "+C$
  7746. selected(labelW%,16) 
  7747.  C$="ON" 
  7748.  C$="OFF"
  7749. #F,"SkipBlank "+C$
  7750. close_file(F)
  7751.  "OS_File",18,f$,&7f5
  7752. get_preferences(wi%,f$)
  7753.  F,S$,C$,P%
  7754. 2  S$=
  7755. #F:P%=
  7756. S$," "):C$=
  7757. S$,P%+1):S$=
  7758. S$,P%-1)
  7759. &    
  7760.  "DateSeparator":$datesep%=C$
  7761. &    
  7762.  "TimeSeparator":$timesep%=C$
  7763.  "WildcardS":$wc%=C$
  7764.  "WildcardM":$ws%=C$
  7765. 3    
  7766.  "Recalculate":
  7767. set_icon(wi%,14,(C$="ON"))
  7768. >    
  7769.  "NewCopy":kill%=(C$<>"ON"):
  7770. set_icon(wi%,12,
  7771.  kill%)
  7772. S    
  7773.  "CaseSpecific":
  7774. set_icon(wi%,30,(C$="ON")):
  7775. set_icon(queryW%,1,(C$="ON"))
  7776. 3    
  7777.  "BlankRecord":
  7778. set_icon(wi%,15,(C$="ON"))
  7779. 6    
  7780.  "MoveDescriptor":
  7781. set_icon(wi%,16,(C$="ON"))
  7782. A    
  7783.  "ImpulseClient":$mergewith%=C$:$ImpulseApp%=$mergewith%
  7784. 0    
  7785.  "Validate":
  7786. set_icon(wi%,21,(C$="ON"))
  7787. 2    
  7788.  "ShowLinked":
  7789. set_icon(wi%,19,(C$="ON"))
  7790.  /    
  7791.  "Warning":
  7792. set_icon(wi%,20,(C$="ON"))
  7793.  "Autosave":
  7794. "+    
  7795. deselect(wi%,
  7796. selected_esg(wi%,2))
  7797. C$,4) 
  7798. $-      
  7799.  "OFF":autosave%=0:$Interval%="10"
  7800. %0      
  7801.  "WARN":autosave%=1:$Interval%=
  7802. C$,5)
  7803. &0      
  7804.  "AUTO":autosave%=2:$Interval%=
  7805. C$,5)
  7806. '        
  7807. (!    
  7808. select(wi%,29-autosave%)
  7809. )+    
  7810. icon_bit(22,wi%,25,(autosave%<>0))
  7811.  "Autobalance":
  7812. C$,4) 
  7813. ,-      
  7814.  "OFF":autobalance%=
  7815. :$Every%="25"
  7816. -0      
  7817.  "AUTO":$Every%=
  7818. C$,5):autobalance%=
  7819. .        
  7820. /M    
  7821. set_icon(wi%,31,autobalance%):
  7822. icon_bit(22,wi%,32,
  7823. selected(wi%,31))
  7824. 0_    
  7825.  "Duplication":
  7826. set_icon(wi%,34,C$="ON"):
  7827. icon_bit(22,prefsW%,34,
  7828. selected(passW%,15))
  7829. 13    
  7830.  "DefaultAction":
  7831. set_icon(wi%,41,C$="ON")
  7832. 21    
  7833.  "StripSpaces":
  7834. set_icon(wi%,42,C$="ON")
  7835. 33    
  7836.  "RememberPlace":
  7837. set_icon(wi%,43,C$="ON")
  7838. 4-    
  7839.  "AutoCSV":
  7840. set_icon(wi%,44,C$="ON")
  7841. close_file(F)
  7842. save_preferences(wi%,f$)
  7843.  F,C$
  7844. #F,"DateSeparator "+$datesep%
  7845. #F,"TimeSeparator "+$timesep%
  7846. #F,"WildcardS "+$wc%
  7847. #F,"WildcardM "+$ws%
  7848. #F,"ImpulseClient "+$mergewith%
  7849. selected(wi%,12) 
  7850.  C$="ON" 
  7851.  C$="OFF"
  7852. #F,"NewCopy "+C$
  7853. selected(wi%,30) 
  7854.  C$="ON" 
  7855.  C$="OFF"
  7856. #F,"CaseSpecific "+C$
  7857. selected(wi%,14) 
  7858.  C$="ON" 
  7859.  C$="OFF"
  7860. #F,"Recalculate "+C$
  7861. selected(wi%,15) 
  7862.  C$="ON" 
  7863.  C$="OFF"
  7864. #F,"BlankRecord "+C$
  7865. selected(wi%,16) 
  7866.  C$="ON" 
  7867.  C$="OFF"
  7868. #F,"MoveDescriptor "+C$
  7869. selected(wi%,21) 
  7870.  C$="ON" 
  7871.  C$="OFF"
  7872. #F,"Validate "+C$
  7873. selected(wi%,19) 
  7874.  C$="ON" 
  7875.  C$="OFF"
  7876. #F,"ShowLinked "+C$
  7877. selected(wi%,20) 
  7878.  C$="ON" 
  7879.  C$="OFF"
  7880. #F,"Warning "+C$
  7881.  autosave% 
  7882.  0:C$="OFF"
  7883.  1:C$="WARN"+$Interval%
  7884.  2:C$="AUTO"+$Interval%
  7885. #F,"Autosave "+C$
  7886.  autobalance% 
  7887. :C$="OFF"
  7888. :C$="AUTO"+$Every%
  7889. #F,"Autobalance "+C$
  7890. selected(prefsW%,34) 
  7891.  C$="ON" 
  7892.  C$="OFF"
  7893. #F,"Duplication "+C$
  7894. selected(prefsW%,41) 
  7895.  C$="ON" 
  7896.  C$="OFF"
  7897. #F,"DefaultAction "+C$
  7898. selected(prefsW%,42) 
  7899.  C$="ON" 
  7900.  C$="OFF"
  7901. #F,"StripSpaces "+C$
  7902. selected(prefsW%,43) 
  7903.  C$="ON" 
  7904.  C$="OFF"
  7905. #F,"RememberPlace "+C$
  7906. selected(prefsW%,44) 
  7907.  C$="ON" 
  7908.  C$="OFF"
  7909. #F,"AutoCSV "+C$
  7910. close_file(F)
  7911.  "OS_File",18,f$,&fff
  7912. get_csv_options(f$)
  7913.  F,S$,C$,P%
  7914. o2  S$=
  7915. #F:P%=
  7916. S$," "):C$=
  7917. S$,P%+1):S$=
  7918. S$,P%-1)
  7919.  "Separator":
  7920.     $Delim%=""
  7921. t!      
  7922.  "Comma":sep$=",":P%=0
  7923. u       
  7924.  "TAB":sep$=
  7925. (9):P%=1
  7926. v       
  7927.  "CR":sep$=
  7928. (13):P%=2
  7929. w       
  7930.  "LF":sep$=
  7931. (10):P%=3
  7932. x#      
  7933.  $Delim%=C$:sep$=C$:P%=4
  7934. y        
  7935. z#    
  7936. tick_one(menu%(15),0,3,P%)
  7937. {2    $
  7938. text(csvW%,14)=C$:
  7939. redraw_icon(csvW%,14)
  7940.  "Terminator":
  7941.     $Termin%=""
  7942. !      
  7943.  "CR":term$=
  7944. (13):P%=0
  7945. !      
  7946.  "LF":term$=
  7947. (10):P%=1
  7948. *      
  7949.  "CR LF":term$=
  7950. (13)+
  7951. (10):P%=2
  7952. *      
  7953.  "LF CR":term$=
  7954. (10)+
  7955. (13):P%=3
  7956. *      
  7957.  "CR CR":term$=
  7958. (13)+
  7959. (13):P%=4
  7960. *      
  7961.  "LF LF":term$=
  7962. (10)+
  7963. (10):P%=5
  7964. &      
  7965. : $Termin%=C$:term$=C$:P%=6
  7966.         
  7967. #    
  7968. tick_one(menu%(20),0,5,P%)
  7969. 2    $
  7970. text(csvW%,15)=C$:
  7971. redraw_icon(csvW%,15)
  7972. -    
  7973.  "Quotes":
  7974. set_icon(csvW%,0,C$="ON")
  7975. -    
  7976.  "Header":
  7977. set_icon(csvW%,1,C$="ON")
  7978. -    
  7979.  "Blanks":
  7980. set_icon(csvW%,2,C$="ON")
  7981. *    
  7982.  "Key":
  7983. set_icon(csvW%,3,C$="ON")
  7984. -    
  7985.  "RecNo":
  7986. set_icon(csvW%,22,C$="ON")
  7987. B    
  7988.  "Data":
  7989. set_icon(csvW%,4,(C$="ON" 
  7990. selected(csvW%,1)))
  7991. /    
  7992.  "Display":
  7993. set_icon(csvW%,11,C$="ON")
  7994. -    
  7995.  "Strip":
  7996. set_icon(csvW%,16,C$="ON")
  7997. .    
  7998.  "NewSeq":
  7999. set_icon(csvW%,23,C$="ON")
  8000. icon_bit(22,csvW%,4,(
  8001. selected(csvW%,1)))
  8002. close_file(F)
  8003. save_csv_options(f$)
  8004.  F,C$
  8005. selected(csvW%,0) 
  8006.  C$="ON" 
  8007.  C$="OFF"
  8008. #F,"Quotes "+C$
  8009. selected(csvW%,1) 
  8010.  C$="ON" 
  8011.  C$="OFF"
  8012. #F,"Header "+C$
  8013. selected(csvW%,2) 
  8014.  C$="ON" 
  8015.  C$="OFF"
  8016. #F,"Blanks "+C$
  8017. selected(csvW%,3) 
  8018.  C$="ON" 
  8019.  C$="OFF"
  8020. #F,"Key "+C$
  8021. selected(csvW%,22) 
  8022.  C$="ON" 
  8023.  C$="OFF"
  8024. #F,"RecNo "+C$
  8025. selected(csvW%,4) 
  8026.  C$="ON" 
  8027.  C$="OFF"
  8028. #F,"Data "+C$
  8029.  sep$ 
  8030.  ",":C$="Comma"
  8031. (9):C$="TAB"
  8032. (10):C$="LF"
  8033. (13):C$="CR"
  8034. :C$=sep$
  8035. #F,"Separator "+C$
  8036.  term$ 
  8037. (13):C$="CR"
  8038. (10):C$="LF"
  8039. (13)+
  8040. (10):C$="CR LF"
  8041. (10)+
  8042. (13):C$="LF CR"
  8043. (13)+
  8044. (13):C$="CR CR"
  8045. (10)+
  8046. (10):C$="LF LF"
  8047. :C$=term$
  8048. #F,"Terminator "+C$
  8049. selected(csvW%,11) 
  8050.  C$="ON" 
  8051.  C$="OFF"
  8052. #F,"Display "+C$
  8053. selected(csvW%,16) 
  8054.  C$="ON" 
  8055.  C$="OFF"
  8056. #F,"Strip "+C$
  8057. selected(csvW%,23) 
  8058.  C$="ON" 
  8059.  C$="OFF"
  8060. #F,"NewSeq "+C$
  8061. close_file(F)
  8062.  "OS_File",18,f$,&fff
  8063. open_index(f$,key%,merge%)
  8064.  keybase%,I%
  8065.  key%>MaxKeys% 
  8066.  merge% 
  8067.  extrakeys$+=
  8068. leaf(f$)+",":Keys%-=1:
  8069.  keyanchor%(key%) 
  8070. scrap_sliding_block(keyanchor%(key%))
  8071.  "OS_File",5,f$ 
  8072.  ,,,,len%
  8073. create_named_sliding_block(keyanchor%(key%),len%)
  8074.  "OS_File",255,f$,!keyanchor%(key%)
  8075. Index$(key%)=
  8076. leaf(f$)
  8077. keybase%=!keyanchor%(key%)
  8078.  key%=0 
  8079.  I%=0 
  8080. %    $Date%(I%)=$(keybase%+8+9*I%)
  8081. KL%(key%)=keybase%?70
  8082.  I%=0 
  8083. &  KW%(key%,I%)=!(keybase%+74+I%*4)
  8084. +  KF%(key%,I%)=(KW%(key%,I%)>>24) 
  8085. !case%(key%)=(keybase%?71=255)
  8086. %incspace%(key%)=(keybase%?72=255)
  8087. !null%(key%)=(keybase%?73=255)
  8088.  keybase%!62>0 
  8089.  ### Old key structure applies ###
  8090.   words%=
  8091.  I%=0 
  8092.  KW%(key%,I%)>0 
  8093. "      KF%(key%,I%)=keybase%!62
  8094. K      KW%(key%,I%)=!(keybase%+74+I%*4)+((I%+1)<<16)+((keybase%!62)<<24)
  8095.       words%=
  8096.         
  8097.  words% 
  8098.  KF%(key%,0)=keybase%!62:KW%(key%,0)=KL%(key%)+((keybase%!62)<<24)
  8099.  keybase%!66>0 
  8100.  I%=1 
  8101.       
  8102.  KW%(key%,I%)>0 
  8103. $        KF%(key%,I%)=keybase%!66
  8104. I        KW%(key%,I%)=!(keybase%+74+I%*4)+(I%<<16)+((keybase%!66)<<24)
  8105.       
  8106. get_tables
  8107.  lk,F%,d%,R4%,f$,name$,subst%,field%,exact%
  8108. $f$=$database%+".ValTables":R4%=0
  8109. close_file(lk):
  8110. wimp_error(
  8111. ($database%+".Link")
  8112.  lk>0 
  8113.   !block%=mainW%
  8114.     F%+=1
  8115. #lk,link$(F%)
  8116.     name$=link$(F%)
  8117. -    field%=
  8118. trailing_number(name$,exact%)
  8119. name$,1)<>"@" 
  8120.       
  8121.  name$<>"" 
  8122. )        subst%=
  8123. leading_number(name$)
  8124. ,        
  8125.  "OS_File",5,f$+"."+name$ 
  8126.         
  8127.  d%=1 
  8128. )          
  8129. load_table(f$+"."+name$,
  8130. 8          
  8131. set_icon_cols(mainW%,field%(F%),fcol%(8))
  8132. $          
  8133. softerror(name$,31)
  8134.         
  8135.       
  8136.         
  8137.   link$(0)="LOADED"
  8138. close_file(lk)
  8139.  ### Force loading of unlinked but flagged tables ###
  8140.  R4%<>-1
  8141.  "OS_GBPB",9,f$,block%,1,R4%,11 
  8142.  ,,name$,,R4%
  8143.  R4%<>-1 
  8144. name$)="!" 
  8145. load_table(f$+"."+name$,
  8146.  extratabs$<>"" 
  8147. softerror(
  8148. extratabs$),97)
  8149. load_calcs
  8150.  I%,F%,F1%,P%,calc$,file%,top
  8151. update$()=""
  8152. ($database%+".Calc")
  8153.  cl>0 
  8154. +    F%+=1:F$=
  8155. ~(F%):
  8156.  F%<16 
  8157.  F$="0"+F$
  8158. "    
  8159. #cl,calc$:calc$(F%)=calc$
  8160.  chartype%(F%) 
  8161.       
  8162.  6,7:
  8163.       
  8164. !        P%=
  8165. calc$,"$Rf%(",P%)
  8166.  ?        
  8167.  P%>0 
  8168.  F1%=
  8169. calc$,P%+5)):update$(F1%)+=F$:P%+=5
  8170.       
  8171.  P%=0
  8172.       
  8173. #         P%=
  8174. calc$,"FNn(",P%)
  8175. $?        
  8176.  P%>0 
  8177.  F1%=
  8178. calc$,P%+4)):update$(F1%)+=F$:P%+=4
  8179.       
  8180.  P%=0
  8181. &.      
  8182. calc$,"TIME$")>0 
  8183.  update$(0)+=F$
  8184. '        
  8185.   calc$(0)="LOADED"
  8186. close_file(cl)
  8187. selected(prefsW%,14) 
  8188.  update$(0)<>"" 
  8189. -,  dbasehandle%=
  8190. ($database%+".Database")
  8191.  file%=0 
  8192.     top=8*file%+LH%
  8193. 0!    P%=
  8194. neighbour(key%,top,1)
  8195. 1,    
  8196. scan_file("P%<>top",key%,file%,6,1)
  8197.  file%
  8198. close_file(dbasehandle%)
  8199.  I%=1 
  8200.  fields%
  8201.     $Rf%(I%)=field$(I%)
  8202. redraw(mainW%)
  8203. get_form(
  8204.  Fptr%)
  8205.  F,L%,N%,I%,V%,x%,y%,xlim%,ylim%,text%
  8206.  design% 
  8207.  dval%=hand%:func%=1 
  8208.  dval%=-1:func%=0
  8209. ($database%+".Form")
  8210.  F>0 
  8211. #F,N%
  8212.  N%>127 
  8213.  fatal_err%,
  8214. msg("Err98")
  8215. B2  formlen%=&100:forminc%=formlen%:form_incs%=0
  8216. extend_named_sliding_block(formanchor%,formlen%)
  8217. D9  Fptr%=!formanchor%:Rf%(0)=Fptr%:$Rf%(0)="":Fptr%+=1
  8218.   Length%=0
  8219.  I%=1 
  8220. G@    
  8221. #F,Desc$,Tag$(I%),xd%,yd%,xf%,yf%,len%,char%,fix%,bbox%
  8222. HR    
  8223.  Desc$="" 
  8224.  dflg%=(winback%<<28)+&7016711 
  8225.  dflg%=(winback%<<28)+&7016731
  8226. J/      
  8227.  bbox%=0 
  8228.  len%=0:width%=0:height%=0
  8229. K0      
  8230.  bbox%=0:width%=len%*16+16:height%=48
  8231. L@      
  8232.  bbox%<&10000 
  8233.  bbox%>0:width%=bbox%*16+16:height%=48
  8234. M2      
  8235. :width%=bbox% 
  8236.  &FFFF:height%=bbox%>>16
  8237. N        
  8238.  design% 
  8239.       
  8240.  char% 
  8241. Q1        
  8242.  0,1,2,3,4,5,6,7,8,39,40:fval%=hand%
  8243. R"        
  8244. :fval%=hvalid%(char%)
  8245.       
  8246.       
  8247.       
  8248. V=        
  8249.  char%>8 
  8250.  char%<32:fval%=
  8251. val(keypadW%,char%-9)
  8252. W!        
  8253. :fval%=valid%(char%)
  8254.       
  8255. Y        
  8256. Z"    x%=xf%+width%+32:y%=yf%-16
  8257.  x%>xlim% 
  8258.  xlim%=x%
  8259.  y%<ylim% 
  8260.  ylim%=y%
  8261. ]'    y%=yd%-16:
  8262.  y%<ylim% 
  8263.  ylim%=y%
  8264.     Length%+=len%+1
  8265. _F    
  8266.  design%=
  8267.  char%=39 
  8268.  len%=(height% 
  8269.  40)*((width% 
  8270.  16)-4)
  8271. `7    len%(I%)=len%:chartype%(I%)=char%:fix%(I%)=fix%
  8272.     L%=
  8273. (Desc$)
  8274. b1    
  8275.  Fptr%-!formanchor%+L%+len%+2>formlen% 
  8276. c*      form_incs%+=1:formlen%+=forminc%
  8277. d;      
  8278. extend_named_sliding_block(formanchor%,formlen%)
  8279. e        
  8280.     $Fptr%=Desc$
  8281. gS    desc%(I%)=
  8282. create_icon(mainW%,xd%,yd%,L%*16+8,44,dflg%,"",Fptr%,dval%,L%+1)
  8283. h-    Fptr%+=L%+1:Rf%(I%)=Fptr%:$Rf%(I%)=""
  8284. i0    
  8285. icon_design(char%,func%,width%,height%)
  8286. jH    
  8287.  char%=59 
  8288.  fval%=!logoanchor%:$Fptr%=Tag$(I%):len%=
  8289. (Tag$(I%))
  8290. k\    field%(I%)=
  8291. create_icon(mainW%,xf%,yf%,width%,height%,iflags%,"",Fptr%,fval%,len%+1)
  8292.  char% 
  8293. mj      
  8294.  9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31:buttonfield%(0,char%-9)=I%
  8295. n6      
  8296.  40:Rf%(I%)=
  8297. create_anchor("Picture"+
  8298. (I%))
  8299. o?      
  8300.  3,6,46,47,54,56,57:
  8301. icon_bit(9,mainW%,field%(I%),
  8302. p        
  8303.     Fptr%+=len%+1
  8304. close_file(F)
  8305. extend_named_sliding_block(formanchor%,Fptr%-!formanchor%):form_incs%+=1
  8306. setup_select(N%)
  8307.  N%=0
  8308. x7!block%=0:block%!4=ylim%:block%!8=xlim%:block%!12=0
  8309.  "Wimp_SetExtent",mainW%,block%
  8310. Tag$(0)="REC"
  8311. get_winpos
  8312.  F,x%,y%,w%,h%,xs%,ys%
  8313. getscreensize(ScreenWidth%,ScreenHeight%,Vpix%)
  8314. ($database%+".Winpos")
  8315.  present%<7 
  8316. *  w%=ScreenWidth%*2:h%=ScreenHeight%*2
  8317.   x%=0:y%=0:xs%=0:ys%=0
  8318. 4  !block%=0:block%!4=-h%:block%!8=w%:block%!12=0
  8319.  "Wimp_SetExtent",mainW%,block%
  8320. position_window(mainW%,x%,y%,w%,h%,xs%,ys%)
  8321.  F>0 
  8322. #F,x%,y%,w%,h%,xs%,ys%
  8323. 4    
  8324. position_window(mainW%,x%,y%,w%,h%,xs%,ys%)
  8325. open_window(mainW%)
  8326. selected(passW%,9) 
  8327.  F>0 
  8328. !      
  8329. #F,x%,y%,w%,h%,xs%,ys%
  8330. 8      
  8331. position_window(keypadW%,x%,y%,w%,h%,xs%,ys%)
  8332. 5      
  8333. position_window(keypadW%,100,50,0,0,0,0)
  8334.         
  8335. close_file(F)
  8336. save_winpos
  8337.  F,x%,y%,w%,h%,xs%,ys%
  8338. ($database%+".Winpos")
  8339. 3!block%=mainW%:
  8340.  "Wimp_GetWindowState",,block%
  8341. Wx%=block%!4:y%=block%!8:w%=block%!12-x%:h%=block%!16-y%:xs%=block%!20:ys%=block%!24
  8342. #F,x%,y%,w%,h%,xs%,ys%
  8343. 5!block%=keypadW%:
  8344.  "Wimp_GetWindowState",,block%
  8345. Wx%=block%!4:y%=block%!8:w%=block%!12-x%:h%=block%!16-y%:xs%=block%!20:ys%=block%!24
  8346. #F,x%,y%,w%,h%,xs%,ys%
  8347. close_file(F)
  8348. position_window(wi%,x%,y%,w%,h%,xs%,ys%)
  8349.  "Wimp_GetCaretPosition",,block%:oldwin%=!block%:oldicon%=block%!4
  8350. getscreensize(ScreenWidth%,ScreenHeight%,Vpix%)
  8351. 0!block%=wi%:
  8352.  "Wimp_GetWindowState",,block%
  8353.  w%=0 
  8354.  w%=block%!12-block%!4
  8355.  h%=0 
  8356.  h%=block%!16-block%!8
  8357.  0:x%=(ScreenWidth%-w%) 
  8358.  -1:x%=block%!4
  8359.  0: y%=(ScreenHeight%-h%) 
  8360.  -1:y%=block%!8
  8361. block%!4=x%:block%!12=x%+w%
  8362. block%!8=y%:block%!16=y%+h%
  8363. block%!20=xs%:block%!24=ys%
  8364. block%!28=-1
  8365. open_it(wi%)
  8366. open_at(
  8367.  flag%,wi%,butt%,ww%,wh%,iw%,ih%)
  8368.  x%,y%,vxmin%,vymax%,scrollx%,scrolly%
  8369.  flag% 
  8370. 5  !block%=mainW%:
  8371.  "Wimp_GetWindowState",,block%
  8372. L  vxmin%=block%!4:vymax%=block%!16:scrollx%=block%!20:scrolly%=block%!24
  8373. Z  !block%=mainW%:block%!4=field%(buttonfield%(0,butt%)):
  8374.  "Wimp_GetIconState",,block%
  8375. ?  x%=block%!16-scrollx%+vxmin%:y%=block%!20-scrolly%+vymax%
  8376. 2  !block%=wi%:
  8377.  "Wimp_GetWindowState",,block%
  8378. 6  block%!4=x%-(ww%+iw%) 
  8379.  2:block%!12=block%!4+ww%
  8380. 6  block%!8=y%-(wh%+ih%) 
  8381.  2:block%!16=block%!8+wh%
  8382.    block%!28=-1:
  8383. open_it(wi%)
  8384.   flag%=
  8385. open_window(wi%)
  8386. setup_select(fields%)
  8387.  S$,I%,J%,Fptr%,rows%
  8388. &selectlen%=&200:selinc%=selectlen%
  8389. create_named_sliding_block(selanchor%,selectlen%)
  8390. Fptr%=!selanchor%
  8391.  I%=1 
  8392.  fields%
  8393.  Fptr%-!selanchor%+144>selectlen% 
  8394.     selectlen%+=selinc%
  8395. :    
  8396. extend_named_sliding_block(selanchor%,selectlen%)
  8397.  chartype%(I%) 
  8398.  3,6,8,46,47,54,56,57:
  8399. #    rows%+=1:
  8400. lit(menu%(6),5,
  8401. V    handle%=
  8402. create_icon(pselectW%,8,-rows%*48-56,144,48,&17000531,"",Fptr%,-1,15)
  8403. 9    S$=$
  8404. text(mainW%,desc%(I%)):
  8405. (S$)>8 
  8406. S$,8)
  8407. $    $Fptr%=S$:Fptr%+=
  8408. ($Fptr%)+1
  8409. W    handle%=
  8410. create_icon(pselectW%,160,-rows%*48-56,80,48,&17000531,"",Fptr%,-1,15)
  8411. *    $Fptr%=Tag$(I%):Fptr%+=
  8412. ($Fptr%)+1
  8413.  J%=0 
  8414. a      handle%=
  8415. create_icon(pselectW%,240+J%*88,-rows%*48-52,44,44,&0740B13B,"",Fptr%,tick%,1)
  8416.       $Fptr%="":Fptr%+=1
  8417.     calcrow%?I%=rows%
  8418. :calcrow%?I%=0
  8419. #!block%=0:block%!4=-rows%*48-56
  8420. block%!8=740:block%!12=0
  8421.  "Wimp_SetExtent",pselectW%,block%
  8422. enable_row(R%,on%)
  8423.  R%>0 
  8424.  I%=R%*8+2 
  8425.  R%*8+7
  8426. &    
  8427. icon_bit(22,pselectW%,I%,on%)
  8428. )    
  8429.  on% 
  8430. deselect(pselectW%,I%)
  8431. save_form(f$)
  8432.  F,I%,xd%,yd%,xf%,yf%,w%,h%,bbox%,type%
  8433.  fields%=0 
  8434. Length%=0
  8435. !block%=mainW%
  8436. #F,fields%
  8437.  I%=1 
  8438.  fields%
  8439. (  dicon%=desc%(I%):ficon%=field%(I%)
  8440. 4  block%!4=dicon%:
  8441.  "Wimp_GetIconState",,block%
  8442.    xd%=block%!8:yd%=block%!12
  8443.   Desc$=$(block%!28)
  8444. 4  block%!4=ficon%:
  8445.  "Wimp_GetIconState",,block%
  8446.    xf%=block%!8:yf%=block%!12
  8447. 2  w%=block%!16-block%!8:h%=block%!20-block%!12
  8448.   bbox%=(h%<<16)+w%
  8449. #F,Desc$,Tag$(I%),xd%,yd%,xf%,yf%,len%(I%),chartype%(I%),fix%(I%),bbox%
  8450.   Length%+=len%(I%)+1
  8451. A  field$(I%)="":
  8452.  Rf%(I%)>0 
  8453.  chartype%(I%)<>40 
  8454.  $Rf%(I%)=""
  8455. close_file(F)
  8456.  "OS_File",18,f$,&7f2
  8457. lit(menu%(0),3,
  8458. make_empty_index(RA%,key%,Z%)
  8459.  I%,K%,P%,KLM%,S$
  8460.  "Hourglass_On"
  8461. KL%(key%),".")
  8462. KLM%=KL%(key%)+13
  8463. P%=LH%+48+(RA%+1)*KLM%
  8464. create_named_sliding_block(keyanchor%(key%),P%)
  8465. keybase%=!keyanchor%(key%)
  8466. keybase%!0=138
  8467. keybase%!4=
  8468. ($Increment%)
  8469. $date%=
  8470. (1)):
  8471. date(key%)
  8472. keybase%!62=0:keybase%!66=0
  8473. keybase%?70=KL%(key%)
  8474. Ckeybase%?71=
  8475. selected(keyW%,30):case%(key%)=
  8476. selected(keyW%,30)
  8477. Gkeybase%?72=
  8478. selected(keyW%,35):incspace%(key%)=
  8479. selected(keyW%,35)
  8480. Ckeybase%?73=
  8481. selected(keyW%,37):null%(key%)=
  8482. selected(keyW%,37)
  8483.  I%=0 
  8484. (  !(keybase%+74+(I%*4))=KW%(key%,I%)
  8485.  I%=0 
  8486.   P%=I%*8+LH%
  8487.   !(keybase%+P%)=-P%
  8488.   !(keybase%+P%+4)=P%
  8489. P%=!keybase%
  8490.  I%=0 
  8491.  RA%-1
  8492.  "Hourglass_Percentage",(I%*100) 
  8493.   !(keybase%+P%)=P%+KLM%
  8494.   !(keybase%+P%+4)=0
  8495.   $(keybase%+P%+8)=S$
  8496. )#  !(keybase%+P%+KL%(key%)+9)=I%
  8497.   P%+=KLM%
  8498. !(keybase%+P%)=0
  8499. !(keybase%+P%+4)=0
  8500. $(keybase%+P%+8)=S$
  8501. / !(keybase%+P%+KL%(key%)+9)=0
  8502.  "Hourglass_Off"
  8503. save_recs(f$,RA%)
  8504.  dbasehandle%,I%,J%,rec$
  8505. rec$=
  8506. fields%-1,
  8507. (10))
  8508.  "Hourglass_On"
  8509. dbasehandle%=
  8510.  I%=0 
  8511. #dbasehandle%=I%*Length%
  8512. #dbasehandle%,rec$
  8513.  "Hourglass_Percentage",(I%*100) 
  8514. #dbasehandle%=(RA%+1)*Length%
  8515. close_file(dbasehandle%)
  8516.  "OS_File",18,f$,&7f2
  8517.  "Hourglass_Off"
  8518. move_records(key%,file%,top)
  8519.  REC%,target$,action$,dest%,ex%,ptr%
  8520. target$=$Query%
  8521. Search$=
  8522. parse
  8523.  "Wimp_WhichIcon",moveW%,block%,&003F0000,&00210000
  8524. movetype%=!block%-1
  8525.  movetype%<>2 
  8526.  target$="" 
  8527.  target$=" all records from subfile "+
  8528. (file%) 
  8529.  target$=" from subfile "+
  8530. (file%)+" when "+target$
  8531.  movetype% 
  8532.  -1:action$="Move 
  8533. "+target$
  8534.  0:action$="Delete"+target$
  8535.  1:action$="Move 
  8536. "+target$
  8537.  2:dest%=
  8538. text(moveW%,6))
  8539.  target$="" 
  8540.  action$="Accumulate all records in subfile "+
  8541. (dest%) 
  8542.  action$="Accumulate records in subfile "+
  8543. (dest%)+" when "+target$
  8544. confirm(action$) 
  8545.  "Hourglass_On"
  8546. U*dbasehandle%=
  8547. ($database%+".Database")
  8548. earmark(movetype%=2,file%,top)
  8549. close_file(dbasehandle%)
  8550. ptr%=!tempanchor%
  8551.  REC%=0 
  8552.  RA%-1
  8553. Z6  ex%+=1:
  8554.  "Hourglass_Percentage",(ex%*100) 
  8555.  movetype% 
  8556.     file%=ptr%?REC%
  8557. ^%    
  8558.  dest%<>file% 
  8559.  file%<>255 
  8560. _*      
  8561. read(fields%,
  8562. ,REC%,$database%)
  8563.       
  8564.  key%=0 
  8565.  Keys%
  8566.         top=8*file%+LH%
  8567.         N$=key$(key%)
  8568. c>        
  8569. delete(N$,key%):date%?file%=1:$Date%(file%)=
  8570.         top=8*dest%+LH%
  8571. e>        
  8572. insert(N$,key%):date%?dest%=1:$Date%(dest%)=
  8573.       
  8574.  key%
  8575. g        
  8576.  ptr%?REC%<>255 
  8577. j*      
  8578. read(fields%,
  8579. ,REC%,$database%)
  8580. k'      addr=
  8581. shift(movetype%,key%,0)
  8582. l        
  8583.  REC%
  8584. scrap_sliding_block(tempanchor%)
  8585.  "Hourglass_Off"
  8586. export_subset(f$)
  8587.  I%,F,R%,recs%,ptr%,count%,subtotal%,blobs%,ex%,Z%,len%,source$,dest$,O$,REC%
  8588.  "OS_CLI","Copy "+$database%+".Form "+f$+".Form ~C~V"
  8589.  link$(0)="LOADED" 
  8590.  "OS_CLI","Copy "+$database%+".Link "+f$+".Link ~C~V"
  8591.  calc$(0)="LOADED" 
  8592.  "OS_CLI","Copy "+$database%+".Calc "+f$+".Calc ~C~V"
  8593.  "OS_CLI","Copy "+$database%+".ValTables "+f$+".Valtables ~C~VR"
  8594.  "OS_CLI","Copy "+$database%+".Cols "+f$+".Cols ~CF~V"
  8595.  "OS_File",5,$database%+".UserFuncs" 
  8596.  d%=1 
  8597.  "OS_CLI","Copy "+$database%+".UserFuncs "+f$+".UserFuncs ~CF~V"
  8598.  "OS_File",5,$database%+".UsrSprites" 
  8599.  d%=1 
  8600.  "OS_CLI","Copy "+$database%+".UsrSprites "+f$+".UsrSprites ~CF~V"
  8601.  "OS_CLI","Copy "+$database%+".!Run "+f$+".!Run ~CF~V"
  8602.  "Hourglass_On"
  8603. "blobs%=
  8604. find_blobs($database%)
  8605. Search$=
  8606. parse
  8607. *dbasehandle%=
  8608. ($database%+".Database")
  8609. earmark(
  8610. ,file%,top)
  8611. (f$+".Database")
  8612. ptr%=!tempanchor%
  8613. %subtotal%=
  8614. count_recs(key%,zero%)
  8615.  I%=0 
  8616.  RA%-1
  8617.  ptr%?I%<>255 
  8618.     ex%=-1
  8619.  ex%<blobs%
  8620.       ex%+=1:F%=Ext%(ex%)
  8621. @      
  8622. copy_blob($database%,f$,I%,recs%,F%,F%,chartype%(F%))
  8623.         
  8624. <    
  8625. readsmarray(dbasehandle%,I%):
  8626. writesmarray(F,recs%)
  8627.     count%+=1
  8628. :    
  8629.  "Hourglass_Percentage",(count%*100) 
  8630.  subtotal%
  8631. scrap_sliding_block(tempanchor%)
  8632. =F$()="":
  8633. writesmarray(F,recs%):
  8634. #F=Length%*recs%:recs%-=1
  8635.  K%=0 
  8636.  Keys%
  8637.   KL%(MaxKeys%+1)=KL%(K%)
  8638.  I%=0 
  8639. %    KF%(MaxKeys%+1,I%)=KF%(K%,I%)
  8640. %    KW%(MaxKeys%+1,I%)=KW%(K%,I%)
  8641. make_empty_index(recs%,MaxKeys%+1,
  8642.  REC%=0 
  8643.  recs%-1
  8644. readsmarray(F,REC%)
  8645.     KEY$=
  8646. key2(K%,1)
  8647.      
  8648. insert(KEY$,MaxKeys%+1)
  8649. 4    
  8650.  "Hourglass_Percentage",(REC%*100) 
  8651.  recs%
  8652.  REC%
  8653. &  keybase%=!keyanchor%(MaxKeys%+1)
  8654.  "SlidingHeap_DescribeBlock",slidingheapbase%,keyanchor%(MaxKeys%+1) 
  8655.  ,,filelength%
  8656.  K%>0 
  8657.  index$="Indices." 
  8658.  index$=""
  8659.  "OS_File",10,f$+"."+index$+Index$(K%),&7f0,,keybase%,keybase%+filelength%
  8660. scrap_sliding_block(keyanchor%(MaxKeys%+1))
  8661. close_file(F)
  8662. close_file(dbasehandle%)
  8663.  "OS_File",18,f$+".Database",&7f2
  8664. export%=
  8665.  "Hourglass_Off"
  8666. close_it(savesubW%)
  8667. find_blobs(f$)
  8668.  N%,R4%,S$
  8669.     N%=-1
  8670.  R4%<>-1
  8671.  "OS_GBPB",9,f$,block%,1,R4%,11 
  8672.  ,,S$,,R4%
  8673. S$,4) 
  8674. )    
  8675.  "Memo":N%+=1:Ext%(N%)=
  8676. S$,5))
  8677. )    
  8678.  "Draw":N%+=1:Ext%(N%)=
  8679. S$,5))
  8680. )    
  8681.  "Spri":N%+=1:Ext%(N%)=
  8682. S$,7))
  8683. earmark(all%,file%,top)
  8684.  I%,P%
  8685.  tempanchor% 
  8686. scrap_sliding_block(tempanchor%)
  8687. create_named_sliding_block(tempanchor%,RA%)
  8688. ptr%=!tempanchor%
  8689.  I%=0 
  8690.  RA%-1
  8691.   ptr%?I%=255
  8692.  all% 
  8693.  file%=0 
  8694.     top=8*file%+LH%
  8695. !    P%=
  8696. neighbour(key%,top,1)
  8697. ,    
  8698. scan_file("P%<>top",key%,file%,2,1)
  8699.  file%
  8700.   P%=
  8701. neighbour(key%,top,1)
  8702. scan_file("P%<>top",key%,file%,2,1)
  8703. rotate
  8704.  Access% 
  8705. confirm(
  8706. msg("Err49"))=
  8707.  keybase%
  8708.  I%,L%,Z%,Q%,R%,S%,key%
  8709.  key%=0 
  8710.  Keys%
  8711.    keybase%=!keyanchor%(key%)
  8712.   S%=LH%+40
  8713.   Z%=keybase%!S%
  8714.  I%=S%-8 
  8715.  S%-40 
  8716. )    L%=keybase%!I%:R%=keybase%!(I%+4)
  8717. =    
  8718.  L%>0 
  8719.  keybase%!(I%+8)=L% 
  8720.  keybase%!(I%+8)=-(I%+8)
  8721.  Z%>0 
  8722.  keybase%!(S%-40)=Z% 
  8723.  keybase%!(S%-40)=-(S%-40)
  8724.  I%=S%-40 
  8725.     Q%=I%-8
  8726.  Q%=S%-48 
  8727.  Q%=S%
  8728. !    PR%=
  8729. neighbour(key%,I%,0)
  8730. !    SU%=
  8731. neighbour(key%,I%,1)
  8732. '    
  8733.  PR%>S% 
  8734.  keybase%!(PR%+4)=-I%
  8735. #    
  8736.  SU%>S% 
  8737.  keybase%!SU%=-I%
  8738.  key%
  8739. $date%=
  8740. asterisk(
  8741. write_log(-1,"Subfiles rotated")
  8742. create_index(key%)
  8743.  indexing% 
  8744.  printing% 
  8745.  Keys%=MaxKeys% 
  8746. softerror(
  8747. (Keys%),95):
  8748.  file%,top,P%,KEY$,REC%,val$,zero%,abort%,replace%,J%,I%
  8749. newkey%=0:f$=""
  8750.  J%=0 
  8751.  keyfield%(J%)>0 
  8752.  f$+=Tag$(keyfield%(J%))+"+"
  8753.  I%=0 
  8754. C    
  8755.  keyfield%(J%)=KF%(0,I%) 
  8756.  keyfield%(J%)>0 
  8757.  KF%(0,I%)>0 
  8758. F      
  8759. confirm(
  8760. msg("Err100,"+Tag$(keyfield%(J%))))=
  8761.  abort%=
  8762.         
  8763.  abort% 
  8764. f$)="+" 
  8765. (f$)>10
  8766.   newkey%+=1
  8767.  Index$(newkey%)=f$ 
  8768.  newkey%>Keys%
  8769.  newkey%=key%:
  8770. softerror(f$,106):abort%=
  8771.  newkey%<=Keys%:
  8772. )    
  8773. confirm(
  8774. msg("Err50,"+f$))=
  8775. 3      
  8776. scrap_sliding_block(keyanchor%(newkey%))
  8777.       replace%=
  8778.       
  8779.  abort%=
  8780.         
  8781.  Keys%>MaxKeys%:Keys%-=1:
  8782. softerror(
  8783. (Keys%),95):abort%=
  8784. :Keys%=newkey%
  8785.  abort% 
  8786. copy_keydata(newkey%)
  8787. Index$(newkey%)=f$
  8788. -f$=$database%+".Indices."+Index$(newkey%)
  8789. make_empty_index(RA%,newkey%,
  8790. lit(menu%(0),2,
  8791. limit_actions(
  8792. abort_index(f$):
  8793. *dbasehandle%=
  8794. ($database%+".Database")
  8795. indexing%=
  8796. :Search$="TRUE"
  8797. update_stats
  8798.  file%=0 
  8799.   top=file%*8+LH%
  8800.   P%=
  8801. neighbour(key%,top,1)
  8802.   val$=
  8803. type(newkey%)
  8804.  "Hourglass_On"
  8805. scan_file("P%<>top",key%,file%,4,1)
  8806.  file%
  8807. end_index
  8808. colour(newkey%,2)
  8809. asterisk(
  8810. write_log(-1,"Index "+Index$(newkey%)+" created")
  8811. abort_index(f$)
  8812. end_index
  8813.  replace% 
  8814. open_index(f$,newkey%,
  8815.  index%=newkey% 
  8816.  Keys%
  8817. ,)    Index$(newkey%)=Index$(newkey%+1)
  8818.  index%
  8819. scrap_sliding_block(keyanchor%(newkey%))
  8820.   Keys%-=1
  8821.   newkey%=0
  8822. softerror("",43)
  8823. wimp_error(
  8824. end_index
  8825.  "Hourglass_Smash"
  8826. indexing%=
  8827. limit_actions(Access%)
  8828.  "Wimp_CreateMenu",,-1
  8829. lit(menu%(0),2,Modify%)
  8830. close_file(dbasehandle%)
  8831. shift(t%,k%,m%)
  8832.  a%,key%,fi%,I%,F$,action$,finished%
  8833.  Access% 
  8834. =addr
  8835.  REC%=RA% 
  8836. =addr
  8837.  t%=0 
  8838.  m%=1 
  8839. confirm(
  8840. msg("Err51"))=
  8841. =addr
  8842.  key%=0 
  8843.  Keys%
  8844.   N$=key$(key%)
  8845. delete(N$,key%)
  8846.  N$="*Failed*" 
  8847. =addr
  8848.  key%=k% 
  8849. next_match(addr,1,Filter$,finished%)
  8850.  t%=1 
  8851.  fi%=(file%+1) 
  8852.  t%=-1 
  8853.  fi%=(file%-1-6*(file%=0))
  8854.   top=8*fi%+LH%
  8855.  I%=1 
  8856.  fields%
  8857.       V%=chartype%(I%)
  8858.       
  8859.         
  8860.  36,39:
  8861. TR        
  8862. blob_path(
  8863. ,$database%,REC%,I%,V%,F$)>=0 
  8864.  "OS_CLI","Delete "+F$
  8865.         
  8866.  9,37:
  8867. VR        
  8868. blob_path(
  8869. ,$database%,REC%,I%,V%,F$)>=0 
  8870.  "OS_CLI","Delete "+F$
  8871.         
  8872. XR        
  8873. blob_path(
  8874. ,$database%,REC%,I%,V%,F$)>=0 
  8875.  "OS_CLI","Delete "+F$
  8876.       
  8877. \6    
  8878. insert(N$,key%):date%?fi%=1:$Date%(fi%)=
  8879.   top=8*file%+LH%
  8880.   date%?file%=1
  8881.   $Date%(file%)=
  8882.  key%
  8883. selected(prefsW%,15) 
  8884. e'    
  8885. read(fields%,
  8886. ,RA%,$database%)
  8887. f$    
  8888. write_dbase(REC%,fields%,
  8889. g&    action$=" Deleted and blanked"
  8890.  action$=" Deleted"
  8891. :action$=" ===> subfile "+
  8892. (fi%)
  8893. asterisk(
  8894. write_log(REC%,logentry$+action$)
  8895. type(key%)
  8896.  F%,V$
  8897.  key%>=0 
  8898.  F%=KF%(key%,0) 
  8899.  F%=-key%
  8900.  chartype%(F%) 
  8901.  3,6,46,47,54,56,57:V$="VAL"
  8902. confirm(string$)
  8903. !block%=255
  8904. $(block%+4)=string$
  8905.  "Wimp_ReportError",block%,19,"Powerbase - please confirm:" 
  8906.  ,result%
  8907. =result%=1
  8908. getscreensize(
  8909.  S_Width%,
  8910.  S_Height%,
  8911.  Vpix%)
  8912.  H1%,V1%,H2%,V2%,End%
  8913. $H1%=0:V1%=4:H2%=8:V2%=12:End%=16
  8914. 9Mi%!H1%=4:Mi%!V1%=5:Mi%!H2%=11:Mi%!V2%=12:Mi%!End%=-1
  8915.  "OS_ReadVduVariables",Mi%,Mo%
  8916. )S_Width%=(1<<(Mo%!H1%))*((Mo%!H2%)+1)
  8917. *S_Height%=(1<<(Mo%!V1%))*((Mo%!V2%)+1)
  8918. Vpix%=Mo%!V2%+1
  8919. match(X%,Y%)
  8920. check_change
  8921. $Query%=""
  8922. redraw_icon(queryW%,0)
  8923. position_window(matchW%,X%,Y%,0,0,0,0)
  8924. set_caret(queryW%,0)
  8925. text(helpW%,0)=Tag$(Match_tag%)
  8926. tick_one(fieldmenu%,0,fields%-1,Match_tag%-1)
  8927. redraw_icon(helpW%,0)
  8928. text(matchW%,1)="":
  8929. redraw_icon(matchW%,1)
  8930. selected(matchW%,4) 
  8931. text(matchW%,3)="Found:" 
  8932. text(matchW%,3)="Time:"
  8933. redraw_icon(matchW%,3)
  8934. matching%=
  8935.  List printing -----------------------------------------------------
  8936. print_this
  8937. %f$=$database%+".PrintRes.Default"
  8938.  "OS_File",5,f$ 
  8939.  d%,,type%
  8940.  d%=1 
  8941.  type%=&7f3 
  8942. load_selection(f$)
  8943. !old%=
  8944. selected_esg(printW%,3)
  8945. deselect(printW%,old%)
  8946. select(printW%,24)
  8947. mouse(0,0,4,matchW%,2)
  8948. clear_selection
  8949. deselect(printW%,24)
  8950. select(printW%,old%)
  8951. do_it(Search$,displayed%)
  8952.  printing% 
  8953.  zero%,P%,rec%,REC%,copy%
  8954. sorted%=
  8955. lit(menu%(18),1,
  8956. Form$=printorder$
  8957.  Form$="" 
  8958.  W%=0 
  8959.     F%=KF%(0,W%)
  8960.  F%>0 
  8961. D      F$=
  8962. ~(F%):
  8963. (F$)=1 
  8964.  F$="0"+F$:
  8965. Form$,F$)=0 
  8966.  Form$+=F$
  8967.       
  8968. selected(matchW%,4) 
  8969. select(mainW%,field%(F%)):printorder$=Form$:
  8970. lit(menu%(6),6,
  8971. lit(menu%(6),7,
  8972. lit(menu%(1),7,
  8973.         
  8974. #Heading$="":Hlongest%=0:Sum()=0
  8975.  I%=1 
  8976.   Sum(I%,5)=10^30
  8977. +Count%=0:examined%=0:printed%=0:sums%=0
  8978. read_print_options
  8979. selected(printW%,40) 
  8980. find_max_lengths(displayed%) 
  8981.  maxlen%()=len%()
  8982. LenLine%=
  8983. include_fields
  8984. ,numfirst%=
  8985. margin_warn:
  8986.  numfirst%<0 
  8987. list_head(0)
  8988.  "Wimp_GetPointerInfo",,block%
  8989. limit_actions(
  8990. lit(menu%(0),2,0)
  8991. printing%=
  8992.  "OS_ReadMonotonicTime" 
  8993.  stime%
  8994. abort_printing:
  8995. *dbasehandle%=
  8996. ($database%+".Database")
  8997.  "Hourglass_On"
  8998.  displayed%>=0:
  8999. readsmarray(dbasehandle%,displayed%)
  9000.  format$="label" 
  9001.  copy%=1 
  9002.  labcopies%
  9003. (      
  9004. print_record(displayed%,addr)
  9005.  copy%
  9006. (    
  9007. print_record(displayed%,addr)
  9008.  usekey%=-1:
  9009. #  direc%=
  9010. selected(queryW%,4)+1
  9011. N  P%=
  9012. neighbour(key%,top,direc%):
  9013. scan_file("P%<>top",key%,file%,1,direc%)
  9014.   kl%=
  9015. (useval$)
  9016. #  P%=
  9017. search(useval$,usekey%,1)
  9018.  P%>=0 
  9019.  k$=useval$:
  9020. scan_file("P%<>top AND LEFT$(k$,kl%)=useval$",usekey%,file%,1,1)
  9021. end_printing
  9022. abort_printing
  9023. end_printing
  9024. softerror("",29)
  9025. wimp_error(
  9026. end_printing
  9027.  time%
  9028.  format$="label" 
  9029.  thislab%>0 
  9030. print_labels
  9031.  "OS_ReadMonotonicTime" 
  9032.  etime%
  9033. time%=etime%-stime%
  9034. selected(matchW%,4) 
  9035. text(matchW%,1)=
  9036. (printed%) 
  9037. text(matchW%,1)=
  9038. (time% 
  9039.  100)+"."+
  9040. (time% 
  9041.  100)+" sec"
  9042. redraw_icon(matchW%,1)
  9043.  "Hourglass_Smash"
  9044.  format$<>"label" 
  9045.  displayed%=-1 
  9046. total_list:
  9047. page_number
  9048.  reportdest$ 
  9049.  "Window":
  9050. selected(matchW%,4) 
  9051. screen_list
  9052. extend_named_sliding_block(textanchor%,Count%*LenLine%)
  9053.  "File":
  9054. close_file(texthandle%):
  9055.  "OS_File",18,f$,&fff
  9056. close_window(saveW%)
  9057.  "Printer":
  9058. B  Start%=!textanchor%:End%=Start%+Count%*LenLine%+1:Type%=&fff
  9059. )  $Start%=pitch$:?(End%-1)=0:?End%=12
  9060. ;  block%!0=256:block%!12=0:block%!16=&80142:block%!20=0
  9061. D  block%!24=0:block%!28=0:block%!32=0:block%!36=0:block%!40=&fff
  9062.   $(block%+44)="List"
  9063.  "Wimp_SendMessage",18,block%,0
  9064. printing%=
  9065. :savetofile%=
  9066. lit(menu%(0),2,Modify%)
  9067. limit_actions(Access%)
  9068. close_file(dbasehandle%)
  9069. write_log(-1,"List printed: "+query$)
  9070. find_max_lengths(displayed%)
  9071.  P%,k$
  9072. end_find_max:
  9073. maxlen%()=0
  9074.     *dbasehandle%=
  9075. ($database%+".Database")
  9076.  "Hourglass_On"
  9077.  "Hourglass_LEDs",%11
  9078.  displayed%>=0:
  9079. readsmarray(dbasehandle%,displayed%)
  9080. get_lengths
  9081.   usekey%=-1:
  9082. D  P%=
  9083. neighbour(key%,top,1):
  9084. scan_file("P%<>top",key%,file%,0,1)
  9085.   kl%=
  9086. (useval$)
  9087. #  P%=
  9088. search(useval$,usekey%,1)
  9089.  P%>=0 
  9090.  k$=useval$:
  9091. scan_file("P%<>top AND LEFT$(k$,kl%)=useval$",usekey%,file%,0,1)
  9092.  "Hourglass_LEDs",%00
  9093.  "Hourglass_Off"
  9094. close_file(dbasehandle%)
  9095. get_lengths
  9096.  I%,L%,F%,l%,Len%,F$,SF$
  9097. I%=-1:L%=
  9098. (Form$)-1
  9099.  I%<L%
  9100.  "  I%+=2:F%=
  9101. fnum(
  9102. Form$,I%,2))
  9103. selected(printW%,11) 
  9104. "/      F$=
  9105. expand(F$(F%),link$(F%),Len%,SF$)
  9106.       
  9107.  F$=F$(F%)
  9108.   l%=
  9109.  l%>maxlen%(F%) 
  9110.  maxlen%(F%)=l%
  9111. end_find_max
  9112.  "Hourglass_Smash"
  9113. close_file(dbasehandle%)
  9114. maxlen%()=len%()
  9115. softerror("",70)
  9116. wimp_error(
  9117. print_record(REC%,address%)
  9118.  I%,F%,N%,Z%,F$,SF$,Tab%,n$,y$,base%,pos%
  9119.  format$<>"label" 
  9120.  printed%+=1
  9121. selected(matchW%,4) 
  9122. 8-thisrow%=-1:base%=!lineanchor%:pos%=base%
  9123. heap_store(lineanchor%,LenLine%,0,pos%,0,margin$)
  9124.  I%=1 
  9125. (Form$)-1 
  9126.   F%=
  9127. fnum(
  9128. Form$,I%,2))
  9129.  format$="label" 
  9130.  newline%=
  9131.  newline%
  9132.   N%+=1
  9133. ?*    
  9134.  0:F$=
  9135. (REC%):F$=
  9136. (F$)," ")+F$
  9137. @3    
  9138.  MaxFields%+1:Z%=
  9139. rec_no(F$,key%,address%)
  9140. B!    
  9141. selected(printW%,11) 
  9142. C/      F$=
  9143. expand(F$(F%),link$(F%),Len%,SF$)
  9144.       
  9145. E#      F$=F$(F%):Len%=len%(F%)+2
  9146. F        
  9147.  chartype%(F%) 
  9148.       
  9149.  41,42,43,44,45:
  9150.       Z%=
  9151. no_yes(F%,n$,y$)
  9152. J"      
  9153.  F$=" " 
  9154.  F$=y$ 
  9155.  F$=n$
  9156. K!      
  9157.  3,6,8,46,47,54,56,57:
  9158. L-      
  9159. sums(F$,calcrow%?F%,chartype%(F%))
  9160.       
  9161.  format$="vert" 
  9162. N&        F$=
  9163. len%(F%)-
  9164. (F$)," ")+F$
  9165. O%        
  9166. justify(F$,N%,N%-1)
  9167.       
  9168. Q        
  9169. selected(printW%,12) 
  9170. u(F$)
  9171.  chartype%(F%) 
  9172.  37:F$="<Sprite>"
  9173.  38:F$="<Drawfile>"
  9174.  format$ 
  9175.  "horiz","table":
  9176. Z>    
  9177. heap_store(lineanchor%,LenLine%,0,pos%,0,
  9178. tab(F$,N%))
  9179.  "vert":
  9180. \R    
  9181. selected(printW%,2) 
  9182.  Head$=$
  9183. text(mainW%,(desc%(F%))) 
  9184.  Head$=Tag$(F%)
  9185. ]8    Head$=margin$+
  9186. Tab%(1)-
  9187. (Head$)," ")+Head$+" : "
  9188. ^@    hdlen%=
  9189. (Head$):H$=
  9190. hdlen%," "):datlen%=
  9191. (F$):pos%=base%
  9192.  chartype%(F%) 
  9193. `/      
  9194.  36,39:
  9195. print_memo(REC%,F%,Head$,F$)
  9196.       
  9197. b:      
  9198. heap_store(lineanchor%,LenLine%,0,pos%,0,Head$)
  9199. c%      
  9200.  hdlen%+datlen%<LenLine% 
  9201. d9        
  9202. heap_store(lineanchor%,LenLine%,0,pos%,0,F$)
  9203. e:        
  9204. list_line(REC%,lineanchor%,hdlen%+datlen%,32)
  9205.         
  9206. gA        L%=LenLine%-hdlen%-1:F$+=" ":H$=
  9207. hdlen%," "):first%=
  9208.         
  9209. (F$)>L%
  9210.           p%=1:q%=1
  9211.           
  9212.             p%=
  9213. F$," ",q%)
  9214. l"            
  9215.  p%<=L% 
  9216.  q%=p%+1
  9217.           
  9218.  p%>L%
  9219. n%          s$=
  9220. F$,q%-2):F$=
  9221. F$,q%)
  9222. o#          
  9223.  first% 
  9224.  s$=H$+s$
  9225. p;          
  9226. heap_store(lineanchor%,LenLine%,0,pos%,0,s$)
  9227. q:          
  9228. list_line(REC%,lineanchor%,hdlen%+
  9229. (s$),32)
  9230. r!          pos%=base%:first%=
  9231.         
  9232.         pos%=base%:
  9233. u<        
  9234. heap_store(lineanchor%,LenLine%,0,pos%,0,H$+F$)
  9235. v8        
  9236. list_line(REC%,lineanchor%,hdlen%+
  9237. (F$),32)
  9238.       
  9239. x        
  9240. y#    
  9241. extra_lines(linefeed%-1,0)
  9242.  "label":
  9243.  newline% 
  9244. |n      
  9245.  (F$<>"" 
  9246. selected(labelW%,16)=
  9247.  thisrow%<=labrepl% 
  9248.  thisrow%+=1:Label$(thisrow%,thislab%)=F$
  9249.       
  9250. ~/      Label$(thisrow%,thislab%)+=spacer$+F$
  9251.         
  9252.  format$ 
  9253.  "horiz":
  9254. list_line(REC%,lineanchor%,pos%-base%,32)
  9255. extra_lines(linefeed%-1,0)
  9256.  "vert":
  9257. rule_off(45)
  9258.  "table":
  9259.   colpos%=pos%-base%
  9260. heap_store(lineanchor%,LenLine%,0,pos%,0,column$)
  9261. list_line(REC%,lineanchor%,pos%-base%,32)
  9262. extra_lines(linefeed%-1,colpos%)
  9263.  "label":
  9264. ,  Label$(labrepl%+1,thislab%)=
  9265. key2(0,1)
  9266. 3  thislab%+=1:
  9267.  thislab%>labup% 
  9268. print_labels
  9269.  format$<>"label" 
  9270.  (printed% 
  9271.  LinesPerPage%)=0 
  9272. selected(printW%,10)=
  9273.  displayed%=-1 
  9274. page_number
  9275. N    $(!lineanchor%)=margin$+
  9276. (12):
  9277. list_line(-1,lineanchor%,Lmargin%+1,32)
  9278. W    
  9279. list_head(1):
  9280. lit(menu%(18),1,
  9281. selected(printW%,10) 
  9282. selected(printW%,47))
  9283. page_number
  9284.  page%>0 
  9285. rule_off(32)
  9286. $  line$=margin$+"Page "+
  9287. (page%)
  9288. B  $(!lineanchor%)=line$:
  9289. list_line(-1,lineanchor%,
  9290. (line$),32)
  9291.   page%+=1
  9292. extra_lines(ex%,tab%)
  9293.  base%,pos%
  9294.  ex%>0
  9295.  tab% 
  9296. rule_off(32)
  9297. %    base%=!lineanchor%:pos%=base%
  9298.  I%=0 
  9299.  tab%-1
  9300.       pos%?I%=32
  9301.     pos%+=tab%
  9302. :    
  9303. heap_store(lineanchor%,LenLine%,0,pos%,0,column$)
  9304. 2    
  9305. list_line(REC%,lineanchor%,pos%-base%,32)
  9306.   ex%-=1
  9307. print_memo(R%,F%,margin$,F$)
  9308.  text%,B%,F$,sp%,L%,rem$,base%,pos%,Line$,first%
  9309. blob_path(
  9310. ,$database%,R%,F%,36,F$)>=0 
  9311. !  base%=!lineanchor%:first%=
  9312.   text%=
  9313. #text%
  9314. &    Line$=margin$+rem$:L%=
  9315. (Line$)
  9316.         
  9317.       B%=
  9318. #text%
  9319.       Line$+=
  9320. (B%):L%+=1
  9321.       
  9322.  B%=32 
  9323.  sp%=L%
  9324. )    
  9325.  B%=10 
  9326.  L%=LenLine%-3 
  9327. #text%
  9328. '      
  9329.  B%=10:rem$="":Line$=
  9330. Line$)
  9331.       
  9332. #text%:rem$=""
  9333. 2      
  9334. :rem$=
  9335. Line$,sp%+1):Line$=
  9336. Line$,sp%-1)
  9337.         
  9338.     pos%=base%
  9339. 8    
  9340. heap_store(lineanchor%,LenLine%,0,pos%,0,Line$)
  9341. 0    
  9342. list_line(REC%,lineanchor%,
  9343. (Line$),32)
  9344. 4    
  9345.  first% 
  9346.  margin$=
  9347. (margin$)," "):first%=
  9348. close_file(text%)
  9349. inmemo(F%,s$)
  9350.  len%,found%,line$,base%,ptr%,case%
  9351. *len%=
  9352. load_blob($database%,REC%,F%,36)
  9353.  len%>0 
  9354.    case%=
  9355. selected(queryW%,1)
  9356.    base%=!tempanchor%:ptr%=-1
  9357.     line$=""
  9358.         
  9359. &      ptr%+=1:line$+=
  9360. (base%?ptr%)
  9361. "    
  9362. (line$)>250 
  9363.  ptr%=len%
  9364. #    
  9365.  case% 
  9366.  line$=
  9367. u(line$)
  9368. !    
  9369. line$,s$)>0 
  9370.  found%=
  9371.  ptr%=len%
  9372. =found%
  9373. wc(f$,t$)
  9374.  failed%,P%,Q%,F%,end%,c$,x$
  9375.  P%+=1
  9376.   c$=
  9377. t$,P%,1)
  9378. (    
  9379.  "":end%=(Q%=F%):failed%=
  9380.  end%
  9381.  $wc%:
  9382.  P%+=1:Q%+=1
  9383.       c$=
  9384. t$,P%,1)
  9385.  c$<>$wc%
  9386.     P%-=1
  9387.  $ws%:
  9388.     R%=P%+1
  9389.  P%+=1
  9390.       c$=
  9391. t$,P%,1)
  9392. #    
  9393.  c$=$ws% 
  9394.  c$=$wc% 
  9395.  c$=""
  9396.       
  9397.  "":end%=
  9398. -      s$=
  9399. t$,R%):failed%=(
  9400. (s$))<>s$)
  9401.       
  9402.  $wc%,$ws%:
  9403. 7      s$=
  9404. t$,R%,P%-R%):Q%=
  9405. f$,s$,Q%):failed%=(Q%=0)
  9406. 9      Q%+=
  9407. (s$)-1:P%-=1:
  9408.  failed% 
  9409.  failed%=(Q%=F%)
  9410.         
  9411.     Q%+=1:x$=
  9412. f$,Q%,1)
  9413.     failed%=(c$<>x$)
  9414.  end% 
  9415.  failed%
  9416.  failed%
  9417. print_labels
  9418.  I%,Line$,S$,linesprinted%,pos%
  9419. fixed_line($
  9420. text(labelW%,24))
  9421.  I%=0 
  9422.  labrepl%-1
  9423.   Line$=margin$
  9424.  K%=0 
  9425.  thislab%-1
  9426.     S$=Label$(I%,K%)
  9427. !    
  9428. selected(labelW%,11) 
  9429. 9      
  9430.  I%=labsubst% 
  9431.  S$="" 
  9432.  S$=Label$(labrepl%,K%)
  9433.         
  9434.     9    
  9435.  K%=thislab%-1 
  9436.  W%=longestfield% 
  9437.  W%=labwidth%
  9438. (S$)>W% 
  9439. S$,W%)
  9440.      Line$+=S$+
  9441. (S$)," ")
  9442.   pos%=!lineanchor%
  9443. heap_store(lineanchor%,LenLine%,0,pos%,0,Line$)
  9444. list_line(REC%,lineanchor%,
  9445. (Line$),32)
  9446.   linesprinted%+=1
  9447. fixed_line($
  9448. text(labelW%,25))
  9449. selected(labelW%,13) 
  9450. rule_off(32)
  9451.   Line$=margin$
  9452.  K%=0 
  9453.  thislab%-1
  9454. (    S$="("+Label$(labrepl%+1,K%)+")"
  9455. 1    
  9456.  K%=thislab%-1 
  9457. (S$) 
  9458.  W%=labwidth%
  9459.      Line$+=S$+
  9460. (S$)," ")
  9461.   pos%=!lineanchor%
  9462. heap_store(lineanchor%,LenLine%,0,pos%,0,Line$)
  9463. list_line(REC%,lineanchor%,
  9464. (Line$),32)
  9465.   linesprinted%+=1
  9466. rows_printed%+=1
  9467.  rows_printed%=labrows% 
  9468. "L  $(!lineanchor%)=margin$+
  9469. (12):
  9470. list_line(-1,lineanchor%,Lmargin%+1,32)
  9471. list_head(1)
  9472.   rows_printed%=0
  9473.  linesprinted%<labdepth%
  9474. rule_off(32)
  9475.     linesprinted%+=1
  9476. +&thislab%=0:thisrow%=-1:Label$()=""
  9477. fixed_line(S$)
  9478.  K%,W%
  9479.  S$<>"" 
  9480.   Line$=margin$
  9481.  K%=0 
  9482.  thislab%-1
  9483. 39    
  9484.  K%=thislab%-1 
  9485.  W%=longestfield% 
  9486.  W%=labwidth%
  9487. (S$)>W% 
  9488. S$,W%)
  9489. 5     Line$+=S$+
  9490. (S$)," ")
  9491.   pos%=!lineanchor%
  9492. heap_store(lineanchor%,LenLine%,0,pos%,0,Line$)
  9493. list_line(REC%,lineanchor%,
  9494. (Line$),32)
  9495.   linesprinted%+=1
  9496. read_print_options
  9497. thislab%=0:LinesPerPage%=0
  9498.  usekey%=-1 
  9499.  S$=Index$(key%) 
  9500.  S$=Index$(usekey%)+" index"
  9501. Title1$="Ordered by "+S$
  9502. selected(printW%,19) 
  9503.  Title1$+=" ("+
  9504. $+")"
  9505. Title2$=$
  9506. text(printW%,18)
  9507. selected_esg(printW%,2) 
  9508.  4:cpi%=5:p$="3"
  9509.  7:cpi%=10:p$="0"
  9510.  8:cpi%=12:p$="1"
  9511.  6:cpi%=17:p$="2"
  9512. pitch$=
  9513. pitch(p$)
  9514. L3Lmargin%=
  9515. text(printW%,30)):Tab%(0)=Lmargin%
  9516. margin$=
  9517. Lmargin%," ")
  9518. N"Tmargin%=
  9519. text(printW%,32))
  9520. O#TextLine%=
  9521. text(printW%,34))
  9522. P#linefeed%=
  9523. text(printW%,17))
  9524. Q#colwidth%=
  9525. text(printW%,45))
  9526. R*s$=$
  9527. text(printW%,43):s%=
  9528. (s$):c$=
  9529.  s%=0:spacer$=s$
  9530.  c$<"0" 
  9531.  c$>"9":spacer$=
  9532. s%,c$)
  9533. :spacer$=
  9534. s%," ")
  9535.  linefeed%=0 
  9536.  linefeed%=1:$
  9537. text(printW%,17)=
  9538. (linefeed%)
  9539. Y%pagelength%=
  9540. text(printW%,16))
  9541.  pagelength%=0 
  9542.  pagelength%=70:$
  9543. text(printW%,16)=
  9544. (pagelength%)
  9545. selected_esg(printW%,3) 
  9546.   format$="horiz"
  9547. ^9  LinesPerPage%=(pagelength%-Tmargin%-15) 
  9548.  linefeed%
  9549.  24:format$="vert"
  9550.  Form$<>"" 
  9551.  LinesPerPage%=(pagelength%-Tmargin%-15) 
  9552.  (linefeed%*(
  9553. (Form$) 
  9554.   format$="table"
  9555. c$  columns%=
  9556. text(printW%,15))
  9557. d0  column$=
  9558. columns%,"|"+
  9559. colwidth%," "))+"|"
  9560. e9  LinesPerPage%=(pagelength%-Tmargin%-15) 
  9561.  linefeed%
  9562.   format$="label"
  9563. h)  labwidth%=
  9564. text(labelW%,4))*cpi%
  9565. i&  labdepth%=
  9566. text(labelW%,6))*6
  9567. j1  labrows%=(pagelength%-Tmargin%) 
  9568.  labdepth%
  9569.   rows_printed%=0
  9570. lD  labup%=
  9571. selected_esg(labelW%,1):
  9572.  ### Value is 0,1,2 or 26 ###
  9573.  labup%=26 
  9574.  labup%=3
  9575. n$  labrepl%=
  9576. text(labelW%,10))
  9577. o'  labsubst%=
  9578. text(labelW%,12))-1
  9579. p&  labcopies%=
  9580. text(labelW%,17))
  9581. q%  Title$="":Title1$="":Title2$=""
  9582. selected_esg(printW%,4) 
  9583.  38:reportdest$="Window"
  9584.  39:reportdest$="File"
  9585.  41:reportdest$="Printer"
  9586. selected(printW%,54) 
  9587.  page%=1:LinesPerPage%-=2 
  9588.  page%=0
  9589.  LinesPerPage%<=0 
  9590.  LinesPerPage%=1
  9591. pitch(p$)
  9592. selected(printW%,42) 
  9593. (31)+"9"+p$+"01" 
  9594. list_head(place%)
  9595.  place%=0 
  9596.  reportdest$ 
  9597.  "Window","Printer":
  9598.     RU%=
  9599. ($used%)
  9600. O    
  9601.  RU%<5 
  9602.  textblocksize%=5*LenLine% 
  9603.  textblocksize%=(RU% 
  9604.  5)*LenLine%
  9605. $    textblockinc%=textblocksize%
  9606. ?    
  9607. extend_named_sliding_block(textanchor%,textblocksize%)
  9608.     TextPtr%=!textanchor%
  9609.     recblocksize%=400
  9610. =    
  9611. extend_named_sliding_block(recanchor%,recblocksize%)
  9612. %    
  9613.  "File":
  9614. #texthandle%,pitch$
  9615. extra_lines(Tmargin%,0)
  9616. selected(printW%,47) 
  9617.  header_lines%=Count%:
  9618.  displayed%=-1 
  9619. send_title(Title$)
  9620. send_title(Title1$)
  9621. send_title(Title2$)
  9622.  format$ 
  9623.  "horiz":
  9624. selected(printW%,29) 
  9625. V    
  9626. selected(printW%,42) 
  9627.  $(!lineanchor%)=uon$:
  9628. list_line(-1,lineanchor%,2,32)
  9629. .    
  9630. list_line(-1,headanchor%,LenLine%,32)
  9631. rule_off(45)
  9632. .    
  9633. list_line(-1,headanchor%,LenLine%,32)
  9634. rule_off(45)
  9635.  "table":
  9636. rule_off(32):$(TextPtr%-3)=uon$
  9637. rule_off(32)
  9638. list_line(-1,headanchor%,LenLine%,32)
  9639. rule_off(32)
  9640.  "vert":
  9641. rule_off(45)
  9642. header_lines%=Count%
  9643. list_line(REC%,anchor%,length%,char%)
  9644. Count%+=1
  9645.  reportdest$ 
  9646.  "Window","Printer":
  9647. pad_line(LenLine%-length%-1,char%)
  9648. heap_store(textanchor%,textblocksize%,textblockinc%,TextPtr%,LenLine%,"")
  9649.  "Wimp_TransferBlock",mytask%,!anchor%,mytask%,TextPtr%,LenLine%
  9650.  Count%*4>=recblocksize% 
  9651.     recblocksize%+=400
  9652. =    
  9653. extend_named_sliding_block(recanchor%,recblocksize%)
  9654. "  !(!recanchor%+Count%*4)=REC%
  9655.   TextPtr%+=LenLine%
  9656.  "File":
  9657. pad_line(LenLine%-length%-1,char%)
  9658.  "OS_GBPB",2,texthandle%,!anchor%,LenLine%
  9659. pad_line(bytes%,char%)
  9660.  base%,ptr%,I%
  9661. /base%=!anchor%:ptr%=base%+LenLine%-bytes%-1
  9662.  bytes%>0 
  9663.  I%=0 
  9664.  bytes%-2
  9665.     ptr%?I%=char%
  9666. ptr%?(bytes%-1)=32
  9667. ptr%?bytes%=10
  9668. rule_off(char%)
  9669.  base%
  9670. base%=!lineanchor%
  9671. $base%=margin$
  9672. list_line(-1,lineanchor%,Lmargin%,char%)
  9673. total_list
  9674. selected(printW%,48) 
  9675.  C%,L%,base%,pos%,L$
  9676. #L$=margin$+"Total "+
  9677. (printed%)
  9678. !base%=!lineanchor%:pos%=base%
  9679.  format$ 
  9680.  "horiz":
  9681. selected(printW%,29) 
  9682. rule_off(45)
  9683. ctotals(numfirst%)
  9684. (L$)>LenLine%-2 
  9685.  L$=margin$+
  9686. (printed%)
  9687. heap_store(lineanchor%,LenLine%,0,pos%,0,L$)
  9688. list_line(REC%,lineanchor%,pos%-base%,32)
  9689. selected(printW%,29) 
  9690. rule_off(45)
  9691.  "table":
  9692. rule_off(32)
  9693. extra_lines(linefeed%,colpos%)
  9694. ctotals(numfirst%)
  9695. (L$)>LenLine%-2 
  9696.  L$=margin$+
  9697. (printed%)
  9698. heap_store(lineanchor%,LenLine%,0,pos%,0,L$)
  9699. list_line(REC%,lineanchor%,pos%-base%,32)
  9700. selected(printW%,29) 
  9701. rule_off(45)
  9702.  "vert":
  9703. (L$)>LenLine%-2 
  9704.  L$=margin$+
  9705. (printed%)
  9706. heap_store(lineanchor%,LenLine%,0,pos%,0,L$)
  9707. list_line(REC%,lineanchor%,pos%-base%,32)
  9708. selected(printW%,29) 
  9709. rule_off(45)
  9710. lit(menu%(6),6,
  9711. send_title(T$)
  9712.  C$,L$,P%,L%
  9713.  T$="" 
  9714. L%=LenLine%-Lmargin%-1
  9715. (T$)>=L%
  9716.   P%=
  9717.     P%-=1:C$=
  9718. T$,P%,1)
  9719. "= ,.;:",C$)>0 
  9720.  P%<L%) 
  9721.  P%=0
  9722.  P%=0 
  9723. '    L$=margin$+
  9724. T$,L%-1):T$=
  9725. T$,L%)
  9726. )    
  9727.  L$=margin$+
  9728. T$,P%):T$=
  9729. T$,P%+1)
  9730.   $(!lineanchor%)=L$
  9731. list_line(-1,lineanchor%,
  9732. (L$),32)
  9733. $(!lineanchor%)=margin$+T$
  9734. list_line(-1,lineanchor%,Lmargin%+
  9735. (T$),32)
  9736. screen_list
  9737. !!block%=0:block%!4=-Count%*36
  9738. (block%!8=(LenLine%-1)*16:block%!12=0
  9739.  "Wimp_SetExtent",listW%,block%
  9740. !block%=listW%
  9741.  "Wimp_GetWindowState",,block%
  9742. ;x%=(block%!12+block%!4) 
  9743.  2:y%=(block%!16+block%!8) 
  9744.     "block%!12=block%!4+LenLine%*16
  9745.  Count%<28 
  9746. "  block%!16=block%!8+Count%*36
  9747.   block%!16=block%!8+36*28
  9748.  "Wimp_CloseWindow",,block%
  9749. open_window(listW%)
  9750. Listed%=
  9751. show_menu(menu%(18),x%,y%)
  9752. sort_list(N%)
  9753. >ind%=!textanchor%+LenLine%*header_lines%+Tab%(N%)-LenLine%
  9754.  I%=0 
  9755.  printed%-1
  9756.   ind%+=LenLine%
  9757.   block%!(I%*4)=ind%
  9758.  "OS_HeapSort",printed%,block%,4
  9759. extend_named_sliding_block(tempanchor%,printed%*LenLine%)
  9760. 3dest%=!tempanchor%-LenLine%:recptr%=!recanchor%
  9761.  I%=0 
  9762.  printed%-1
  9763.   recptr%!(I%*4)=-1
  9764. !(  ind%=block%!(I%*4):dest%+=LenLine%
  9765.  "Wimp_TransferBlock",mytask%,ind%-Tab%(N%),mytask%,dest%,LenLine%
  9766.  "Wimp_TransferBlock",mytask%,!tempanchor%,mytask%,!textanchor%+LenLine%*header_lines%,printed%*LenLine%
  9767. scrap_sliding_block(tempanchor%)
  9768. redraw(listW%)
  9769. sorted%=
  9770. lose_list
  9771. close_window(listW%)
  9772. scrap_sliding_block(textanchor%)
  9773. scrap_sliding_block(recanchor%)
  9774. Listed%=
  9775. parse
  9776.  val%,I%,P%,F%,f1%,f2%,t%,flag%,left%,right%,search$,field$,op$,bo$,target$,targ$,f$,t$,E$,E1$,TitFd$,TitTg$,simple%,date$,SF$,S$,case%
  9777. 3!S$=$Query%:
  9778.  S$="" 
  9779.  S$="ALL"
  9780. 4(query$=S$:case%=
  9781. selected(queryW%,1)
  9782. usekey%=-1:useval$=""
  9783. stripspaces(S$)
  9784.  S$="" 
  9785. u(S$)="ALL" 
  9786.  Title$=
  9787. leaf($database%),2)+". All records":="TRUE"
  9788. simple%=
  9789. simple(S$)
  9790. S$+=" ":Title$=""
  9791. (S$)>0
  9792.   W$=
  9793. word(S$," ")
  9794.  W$="NOT" 
  9795. S$,1)<>"(" 
  9796.  moan_err%,
  9797. msg("Err60")
  9798. strip_brackets
  9799. (W$)>0 
  9800. ?*    flag%=
  9801. :TitFd$="":TitTg$="":op$=""
  9802. A5      
  9803.  "AND","OR","NOT":E$=W$:Title$+=" "+E$+" "
  9804. B+      
  9805.  "&":E$="AND":Title$+=" "+E$+" "
  9806.       
  9807.       E$=""
  9808.       
  9809. split
  9810.       
  9811. (field$)>0
  9812. G0        f$=
  9813. word(field$,",")):f1%=0:f2%=0
  9814.         
  9815. I<          
  9816.  f$="@":f1%=1:f2%=fields%:TitFd$="Any field "
  9817.           
  9818. f$,"-")>0:
  9819.           P%=
  9820. f$,"-")
  9821. L%          f1%=
  9822. field(
  9823. f$,P%-1),
  9824. M!          TitFd$=
  9825. TitFd$)+"-"
  9826. N%          f2%=
  9827. field(
  9828. f$,P%+1),
  9829. O$          
  9830.  f1%>f2% 
  9831.  f1%,f2%
  9832.           
  9833.           f1%=
  9834. field(f$,
  9835. R!          f$="F$("+
  9836. (f1%)+")"
  9837. S*          
  9838.  case% 
  9839.  f$="FNu("+f$+")"
  9840. T5          
  9841.  val% 
  9842.  instring% 
  9843.  f$="VAL("+f$+")"
  9844. U!          
  9845.  chartype%(f1%) 
  9846. V5            
  9847.  5,51,52:f$="FNreverse_date("+f$+")"
  9848.           
  9849.         
  9850.         targ$=target$
  9851.         
  9852. (targ$)>0
  9853. ['          t$=
  9854. word(targ$,","):u$=t$
  9855. \C          
  9856.  flag% 
  9857.  TitTg$+=
  9858. expand(t$,link$(f1%),L%,SF$)+","
  9859. ]!          
  9860.  chartype%(f1%) 
  9861. ^0            
  9862.  41,42,43,44,45:t$=
  9863. pos_neg(t$)
  9864. _U            
  9865.  5,51,52:
  9866. check_date(t$,2,date$)=
  9867. reverse_date(date$):u$=t$
  9868.           
  9869. aE          t$=""""+t$+"""":
  9870.  val% 
  9871.  instring% 
  9872.  t$="VAL("+t$+")"
  9873.           
  9874.  f2%>0 
  9875.             
  9876.  val% 
  9877. dT              E1$="FNvany("+
  9878. (f1%)+","+
  9879. (f2%)+","+t$+","""+op$+""","""+bo$+""")"
  9880. eU              
  9881.  E1$="FNany("+
  9882. (f1%)+","+
  9883. (f2%)+","+t$+","""+op$+""","""+bo$+""")"
  9884.             
  9885. g6            
  9886.  E1$=
  9887. element(op$,f1%,chartype%(f1%))
  9888.           
  9889. iE          
  9890. (E$)+
  9891. (E1$)>255 
  9892.  moan_err%,
  9893. msg("Err6") 
  9894.  E$+=E1$
  9895. jE          
  9896. (E$)+
  9897. (bo$)>255 
  9898.  moan_err%,
  9899. msg("Err6") 
  9900.  E$+=bo$
  9901.         
  9902.         flag%=
  9903.       
  9904.       E$=
  9905. (E$)-
  9906. (bo$))
  9907.       
  9908. E$,bo$)>0 
  9909. pB        
  9910. (E$)>253 
  9911.  moan_err%,
  9912. msg("Err6") 
  9913.  E$="("+E$+")"
  9914.       
  9915. r        
  9916. add_brackets
  9917.   E$+=" "
  9918. (search$)+
  9919. (E$)>255 
  9920. w     
  9921.  moan_err%,
  9922. msg("Err6")
  9923.  search$+=E$
  9924. build_title
  9925. |,Title$=
  9926. leaf($database%),2)+". "+Title$
  9927.  usekey%>=0 
  9928.  kl%=KL%(usekey%):val$=
  9929. type(usekey%)
  9930. =search$
  9931. pos_neg(s$)
  9932.  "+","y","Y","*","
  9933. ","T","t","YES","Yes","yes","TRUE","True":s$=" "
  9934.  "-","n","N","x","X","F","f","NO","No","no","FALSE","False":s$=""
  9935. :s$="@"
  9936. simple(S$)
  9937. S$,"=")>0 
  9938. S$,",")=0 
  9939. S$,"-")=0 
  9940. S$,"OR")=0 
  9941. S$,"NOT")=0) 
  9942. word(
  9943.  S$,sep$)
  9944.  P%,W$,Q1%,Q2%
  9945. '  Q1%=
  9946. S$,""""):Q2%=
  9947. S$,"""",Q1%+1)
  9948.   P%=
  9949. S$,sep$,P%)
  9950. -    
  9951.  (P%>Q1% 
  9952.  P%<Q2%),(P%>Q2% 
  9953.  Q2%>0):
  9954. 5    S$=
  9955. S$,Q1%-1)+
  9956. S$,Q1%+1,Q2%-Q1%-1)+
  9957. S$,Q2%+1)
  9958. 9    P%=Q2%-1:
  9959.  ### S$ is now 2 characters shorter ###
  9960. )    
  9961.  Q1%>0 
  9962.  Q2%=0:
  9963. softerror("",93)
  9964.      S$=
  9965. S$,Q1%-1)+
  9966. S$,Q1%+1)
  9967.  Q1%+Q2%=0 
  9968.  P%<Q1%
  9969. S$,P%-1)
  9970. S$,P%+1)
  9971. S$,1)=sep$
  9972.   S$=
  9973. S$,2)
  9974. element(op$,f%,char%)
  9975.  op$ 
  9976.  "{":
  9977.  char% 
  9978. 5    
  9979.  36,39:E$="FNinmemo("+
  9980. (f%)+","+t$+")=TRUE "
  9981. %    
  9982. :E$="INSTR("+f$+","+t$+")>0"
  9983.  "}{":
  9984.  char% 
  9985. 6    
  9986.  36,39:E$="FNinmemo("+
  9987. (f%)+","+t$+")=FALSE "
  9988. %    
  9989. :E$="INSTR("+f$+","+t$+")=0"
  9990.  "=":
  9991.   E$=f$+op$+t$
  9992.  simple%=
  9993.  usekey%=-1 
  9994.     foundkey%=
  9995. is_a_key(f%)
  9996. 4    
  9997.  foundkey%>=0 
  9998.  KL%(foundkey%)=len%(f%) 
  9999. &      usekey%=foundkey%:useval$=u$
  10000.         
  10001.  "$":E$="FNwc("+f$+","+t$+")=TRUE "
  10002. ":E$="FNwc("+f$+","+t$+")=FALSE "
  10003. :E$=f$+op$+t$
  10004. vany(from%,to%,t%,op$,bo$)
  10005.  F%,found%,v%,bo%
  10006. bo%=(bo$="OR")
  10007. F%=from%-1
  10008.   F%+=1:v%=
  10009. (F$(F%))
  10010.  op$ 
  10011.  "=":found%=(v%=t%)
  10012.  "<>":found%=(v%<>t%)
  10013.  "<":found%=(v%<t%)
  10014.  ">":found%=(v%>t%)
  10015.  "<=":found%=(v%<=t%)
  10016.  ">=":found%=(v%>=t%)
  10017.  (bo%=found%) 
  10018.  F%=to%
  10019. =found%
  10020. any(from%,to%,t$,op$,bo$)
  10021.  F%,found%,f$,bo%,case%
  10022. case%=
  10023. selected(queryW%,1)
  10024. bo%=(bo$="OR")
  10025. F%=from%-1
  10026.   F%+=1:f$=F$(F%)
  10027.  case% 
  10028. u(f$)
  10029.  op$ 
  10030.  "{":
  10031.  chartype%(F%) 
  10032.       
  10033.  36,39:
  10034.       found%=
  10035. inmemo(F%,t$)
  10036.       
  10037. :found%=(
  10038. f$,t$)>0) 
  10039.         
  10040.  "}{":
  10041.  chartype%(F%) 
  10042.       
  10043.  36,39:
  10044. #      found%=(
  10045. inmemo(F%,t$))
  10046.       
  10047. :found%=(
  10048. f$,t$)=0)
  10049.         
  10050.  "=":found%=(f$=t$)
  10051.  "<>":found%=(f$<>t$)
  10052.  "<":found%=(f$<t$)
  10053.  ">":found%=(f$>t$)
  10054.  "<=":found%=(f$<=t$)
  10055.  ">=":found%=(f$>=t$)
  10056.  (bo%=found%) 
  10057.  F%=to%
  10058. =found%
  10059. split
  10060.  X$,Q%,I%,t$
  10061. 8X$=">=>=,<=<=,<>,}{,>=,<=,==,>>,<<,{{,=,<,>,{,":P%=0
  10062. (X$)>0 
  10063.  P%=0
  10064. 8  Q%=
  10065. X$,","):op$=
  10066. X$,Q%-1):X$=
  10067. X$,Q%+1):P%=
  10068. W$,op$)
  10069.  P%>0 
  10070.   field$=
  10071. W$,P%-1)
  10072.    target$=
  10073. W$,P%+
  10074. (op$))+","
  10075.  case% 
  10076.  target$=
  10077. u(target$)
  10078.   field$+=","
  10079.  op$ 
  10080.  "<>","}{":bo$="AND"
  10081. D    
  10082.  op$="<>" 
  10083. target$,$wc%)>0 
  10084. target$,$ws%)>0) 
  10085.  op$="
  10086.  "<=",">=":bo$="OR"
  10087.  "<=<=",">=>=":
  10088.     op$=
  10089. op$,2):bo$="AND"
  10090.  "==","<<",">>","{{":
  10091.     op$=
  10092. op$,1):bo$="AND"
  10093. :bo$="OR"
  10094. C    
  10095.  op$="=" 
  10096. target$,$wc%)>0 
  10097. target$,$ws%)>0) 
  10098.  op$="$"
  10099.  moan_err%,
  10100. msg("Err40")
  10101. instring%=
  10102. "}{,{{,{",op$)>0
  10103. fnum(S$)
  10104.  S$="KK" 
  10105. =MaxFields%+1
  10106. ("&"+S$)
  10107. newline%=((N% 
  10108.  128)>0)
  10109. =(N% 
  10110.  127)
  10111. field(f$,Z%)
  10112.  I%,F%,desc$
  10113. val%=
  10114. f$,1)="[" 
  10115. f$)="]" 
  10116. f$),2):val%=
  10117.  I%<fields%
  10118.   I%+=1
  10119. u(Tag$(I%))=
  10120. u(f$) 
  10121.  F%=I%
  10122.  F%>0 
  10123. $  desc$=$
  10124. text(mainW%,desc%(F%))
  10125.  desc$<>"" 
  10126.  TitFd$+=desc$+"," 
  10127.  TitFd$+=f$+","
  10128.  moan_err%,
  10129. msg("Err8,"+f$)
  10130.  chartype%(F%) 
  10131.  3,6,46,47,54,56,57:val%=
  10132. find_fields(S$,sep$,
  10133.  length%)
  10134.  f$,F$,C$,P%,Q%,F%
  10135. Q%=1:length%=0
  10136.   P%=
  10137. S$,sep$,Q%)
  10138.  P%>0 
  10139. S$,Q%,P%-Q%)
  10140.   F%=
  10141. field(f$,
  10142.   length%+=len%(F%)+1
  10143.   F$=
  10144. ~(F%)
  10145. (F$)=1 
  10146.  F$="0"+F$
  10147.   C$+=F$
  10148.   Q%=P%+1
  10149. length%+=
  10150. (RA%))+1
  10151. strip_brackets
  10152. W$,1)="("
  10153.   left%+=1:W$=
  10154. W$,2)
  10155. W$)=")"
  10156.   right%+=1:W$=
  10157. add_brackets
  10158.  left%>0
  10159.   E$="("+E$:left%-=1
  10160.  right%>0
  10161.   E$+=")":right%-=1
  10162. build_title
  10163.  change%
  10164. B#TitFd$=
  10165. TitFd$):TitTg$=
  10166. TitTg$)
  10167. TitFd$,",")>0 
  10168. TitFd$,"-")>0 
  10169.  bo$ 
  10170. E&    
  10171.  "OR":TitFd$="One of:"+TitFd$
  10172.  "AND":
  10173.  op$ 
  10174. H;      
  10175.  "<>":TitFd$="None of:"+TitFd$:op$="=":change%=
  10176. I;      
  10177.  "}{":TitFd$="None of:"+TitFd$:op$="{":change%=
  10178. J#      
  10179. :TitFd$="All of:"+TitFd$
  10180. K        
  10181. TitTg$,",")>0 
  10182.  bo$ 
  10183. P&    
  10184.  "OR":TitTg$="one of:"+TitTg$
  10185.  "AND":
  10186.  op$ 
  10187. S1      
  10188.  "<>":TitTg$="none of:"+TitTg$:op$="="
  10189. T1      
  10190.  "}{":TitTg$="none of:"+TitTg$:op$="{"
  10191. U'      
  10192. ":TitTg$="any of:"+TitTg$
  10193. VI      
  10194.  change% 
  10195.  TitTg$="any of:"+TitTg$ 
  10196.  TitTg$="all of:"+TitTg$
  10197. W        
  10198.  op$ 
  10199.  "{":op$=" contains "
  10200.  "}{":op$=" does not contain "
  10201.  "$":op$=" has wild-card match with "
  10202. ":op$=" does not have wild-card match with ":
  10203. Title$+=TitFd$+op$+TitTg$
  10204. expand(string$,table$,
  10205.  ExpLen%,
  10206.  subst$)
  10207.  p$,s$,start%,F%,I%,T%,ind%,row%,Rec%,Rows%,TabFields%,field%,subst%,exact%,pos%
  10208. subst$=string$
  10209.  table$="" 
  10210.  ExpLen%=0:=string$:
  10211.  ### Not linked ###
  10212. g*field%=
  10213. trailing_number(table$,exact%)
  10214. h"subst%=
  10215. leading_number(table$)
  10216.  ### field% is the linked field, subst% (if >=0) is the one to substitute on entry ###
  10217. table_number(table$)
  10218.  T%<0 
  10219.  ExpLen%=0:=string$:
  10220.  ### Table not found ###
  10221. p$=printrel$(T%)
  10222. m`NewTab%=(
  10223. table_info(T%,Rows%,TabFields%,Rec%,tabfieldlen%(),offset%,heading%,colours$)="
  10224. n*extra%=-NewTab%*(Rows%*(TabFields%+1))
  10225.  subst%>=0 
  10226.  pos%=
  10227. table_field(subst%,tabfieldlen%()) 
  10228.  pos%=
  10229. table_field(field%,tabfieldlen%())
  10230.  p$<>"" 
  10231.   ExpLen%=0
  10232.  I%=1 
  10233. (p$) 
  10234.     F%=
  10235. p$,I%,3))
  10236. t#    ExpLen%+=tabfieldlen%(F%)+2
  10237.   ExpLen%-=2
  10238.  ExpLen%=tabfieldlen%(1)
  10239. y8start%=!tabanchor%(T%)+offset%-Rec%:ind%=start%+pos%
  10240.   row%+=1:ind%+=Rec%
  10241.  row%>Rows% 
  10242.  $ind%=subst$
  10243.  row%>Rows% 
  10244.  subst$="":=string$:
  10245.  ## String not in table ###
  10246. ~;ind%=start%+row%*Rec%:
  10247.  subst%>=0 
  10248.  subst$=$(ind%+pos%)
  10249.  p$<>"" 
  10250.  I%=1 
  10251. (p$) 
  10252.     F%=
  10253. p$,I%,3))
  10254. ,    pos%=
  10255. table_field(F%,tabfieldlen%())
  10256. 4    s$+=
  10257. pad($(ind%+pos%),tabfieldlen%(F%))+"  "
  10258.   s$=
  10259.  ind%+=tabfieldlen%(0)+1:s$=$ind%:
  10260.  ### Return 2nd field ###
  10261. n(F%)
  10262.  T%,row%,ind%,start%,Rows%,Rec%,TabFields%,pos%,valpos%,N%,field%,subst%,table$,S$,exact%
  10263.  link$(F%)="" 
  10264. S$=$Rf%(F%)
  10265. table$=link$(F%)
  10266. *field%=
  10267. trailing_number(table$,exact%)
  10268. "subst%=
  10269. leading_number(table$)
  10270. /table%=
  10271. table_number(table$):
  10272.  table%<0 
  10273. table_info(table%,Rows%,TabFields%,Rec%,tabfieldlen%(),offset%,heading%,colours$)
  10274.  TabFields%=field% 
  10275. softerror("",54):=0
  10276.  subst%>0 
  10277. .  pos%=
  10278. table_field(subst%,tabfieldlen%())
  10279.  pos%=
  10280. table_field(field%,tabfieldlen%())
  10281. 1valpos%=
  10282. table_field(field%+1,tabfieldlen%())
  10283. +start%=!tabanchor%(table%)+offset%-Rec%
  10284.  row%+=1
  10285.    ind%=start%+row%*Rec%+pos%
  10286.  row%>Rows% 
  10287.  S$=$ind%
  10288.  row%<=Rows% 
  10289. #  ind%=start%+row%*Rec%+valpos%
  10290.   N%=
  10291. ($ind%)
  10292.  N%=0
  10293. pad(s$,L%)
  10294. (s$)<L%
  10295.   s$+=" "
  10296. stripspaces(s$)
  10297. s$)=" "
  10298.   s$=
  10299. trim(wi%,ic%)
  10300. selected(prefsW%,42) 
  10301. text(wi%,ic%)=
  10302. stripspaces($
  10303. text(wi%,ic%))
  10304. redraw_icon(wi%,ic%)
  10305. include_fields
  10306.  Hdlen%,Datlen%,hlm%,dlm%,I%,F%,f$,Head$,limit%,pad%,col%,fail%,n$,y$,SF$,memo%,base%,pos%,blocksize%,blockinc%
  10307. 'blocksize%=256:blockinc%=blocksize%
  10308. extend_named_sliding_block(headanchor%,blocksize%)
  10309. !base%=!headanchor%:pos%=base%
  10310. heap_store(headanchor%,blocksize%,blockinc%,pos%,0,margin$)
  10311. selected(matchW%,7) 
  10312.  Form$="KK"+Form$
  10313. selected(matchW%,5) 
  10314.  Form$="00"+Form$
  10315.  I%=1 
  10316. (Form$)-1 
  10317.   F%=
  10318. fnum(
  10319. Form$,I%,2))
  10320.  chartype%(F%) 
  10321. 0    
  10322.  36,39:dlm%=TextLine%:memo%=
  10323. set_vert
  10324.  41,42,43,44,45:
  10325. !    Datlen%=
  10326. no_yes(F%,n$,y$)
  10327. E    
  10328.  ### Get data length for strings printed for check boxes ###
  10329. selected(printW%,11) 
  10330. selected (printW%,40) 
  10331. /    f$=
  10332. expand("@#*",link$(F%),Datlen%,SF$)
  10333. )    
  10334.  Datlen%=0 
  10335.  Datlen%=maxlen%(F%)
  10336.         
  10337.     Datlen%=maxlen%(F%)
  10338. selected(printW%,2) 
  10339.  Head$=$
  10340. text(mainW%,(desc%(F%))) 
  10341.  Head$=Tag$(F%)
  10342.  F%=0 
  10343.  Head$="RECORD":Datlen%=6
  10344.  F%=MaxFields%+1 
  10345.  Datlen%=KL%(key%):Head$="KEY"
  10346.  Datlen%>dlm% 
  10347.  dlm%=Datlen%
  10348.   Hdlen%=
  10349. (Head$)
  10350.  Hdlen%>hlm% 
  10351.  hlm%=Hdlen%
  10352.  format$ 
  10353.  "horiz","table":
  10354. -    pad%=Datlen%-Hdlen%:
  10355.  pad%<0 
  10356.  pad%=0
  10357.  chartype%(F%) 
  10358. c      
  10359.  3,6,46,47,54,56,57:
  10360. selected(printW%,11) 
  10361.  Head$+=
  10362. pad%," ") 
  10363.  Head$=
  10364. pad%," ")+Head$
  10365. A      
  10366.  ### Right justify numbers unless Expand option on ###
  10367.       
  10368. :Head$+=
  10369. pad%," ")
  10370.         
  10371. J    
  10372. heap_store(headanchor%,blocksize%,blockinc%,pos%,0,Head$+spacer$)
  10373. #    Tab%((I%+1) 
  10374.  2)=pos%-base%
  10375.  format$ 
  10376.  "horiz":L%=pos%-base%+2
  10377.  "vert":L%=TextLine%+5:Tab%(1)=hlm%
  10378.  "table":
  10379.   col%=
  10380. (column$)
  10381. heap_store(headanchor%,blocksize%,blockinc%,pos%,0,column$+" ")
  10382.   ?pos%=10:L%=pos%-base%+1
  10383.  "label":
  10384.   longestfield%=dlm%
  10385. )  L%=labup%*labwidth%+dlm%+Lmargin%+1
  10386. extend_named_sliding_block(lineanchor%,L%+8)
  10387. no_yes(F%,
  10388.  no$,
  10389.  yes$)
  10390.  P%,V$,L%
  10391. val(mainW%,field%(F%))
  10392. V$,"Q")
  10393.  P%>0 
  10394.   V$=
  10395. V$,P%+1)
  10396.   P%=
  10397. V$,",")
  10398.   no$=
  10399. V$,P%-1)
  10400.   yes$=
  10401. V$,P%+1)
  10402.  no$="N":yes$="Y"
  10403. (no$)
  10404. (yes$)>L% 
  10405. (yes$)
  10406. heap_store(anchor%,
  10407.  size%,inc%,
  10408.  ptr%,L%,string$)
  10409.  string$<>"" 
  10410. (string$)
  10411.  ptr%-!anchor%+L%+1>size% 
  10412.   size%+=inc%
  10413. extend_named_sliding_block(anchor%,size%)
  10414.  string$<>"" 
  10415.  $ptr%=string$:ptr%+=L%:?ptr%=10
  10416. set_vert
  10417. deselect(printW%,23)
  10418. deselect(printW%,25)
  10419. deselect(printW%,26)
  10420. select(printW%,24)
  10421. format$="vert"
  10422. ?LinesPerPage%=(pagelength%-10) 
  10423.  (linefeed%*(
  10424. (Form$) 
  10425.  LinesPerPage%=0 
  10426.  LinesPerPage%=1
  10427. save_selection
  10428.  P%,T%,I%,F%,J%
  10429. -P%=savebuff%:$P%=printorder$:P%+=
  10430. ($P%)+1
  10431.  T%=0 
  10432.  LastTable%
  10433. # $P%=printrel$(T%):P%+=
  10434. ($P%)+1
  10435. $P%="***":P%+=
  10436. ($P%)+1
  10437.  I%=1 
  10438. (printorder$)-1 
  10439. "  F%=
  10440. fnum(
  10441. printorder$,I%,2))
  10442.  chartype%(F%) 
  10443.  3,6,8,46,47,54,56,57:
  10444.  J%=0 
  10445. L      
  10446. selected(pselectW%,(calcrow%?F%)*8+2+J%) 
  10447.  $P%="ON" 
  10448.  $P%="OFF"
  10449.       P%+=
  10450. ($P%)+1
  10451.  8Start%=savebuff%:End%=Start%+P%-savebuff%:Type%=&7F3
  10452. load_selection(f$)
  10453.  F%,I%,T%,F,new%
  10454. clear_selection
  10455. printorder$=
  10456. T%=-1:printrel$()=""
  10457.  p$<>"***"
  10458.   T%+=1
  10459.   p$=
  10460.  p$<>"" 
  10461.  p$<>"***" 
  10462. select(printW%,11)
  10463.     printrel$(T%)=p$
  10464.  tableW%(T%)>0 
  10465. 0f      NewTab%=(
  10466. table_info(T%,Rows%,TabFields%,Rec%,tabfieldlen%(),offset%,heading%,colours$)="
  10467. 10      extra%=-NewTab%*(Rows%*(TabFields%+1))
  10468.       
  10469.  I%=1 
  10470. (p$) 
  10471. 3$        tablefield%=
  10472. p$,I%,3))
  10473. 43        
  10474. select(tableW%(T%),tablefield%+extra%)
  10475.       
  10476. 6        
  10477.  I%=1 
  10478. (printorder$)-1 
  10479. :"  F%=
  10480. fnum(
  10481. printorder$,I%,2))
  10482.  chartype%(F%) 
  10483.  41,42,43,44,45:
  10484. =.    col%=
  10485. get_icon_cols(mainW%,field%(F%))
  10486. >0    col%=((col%>>4) 
  10487.  (col%<<4)) 
  10488.  %11111111
  10489. ?.    
  10490. set_icon_cols(mainW%,field%(F%),col%)
  10491.  3,6,8,46,47,54,56,57:
  10492. A"    
  10493. select(mainW%,field%(F%))
  10494. B"    
  10495. enable_row(calcrow%?F%,
  10496.  J%=0 
  10497. DH      
  10498. set_icon(pselectW%,(calcrow%?F%)*8+2+J%,(
  10499. #F="ON"))
  10500. F$    
  10501. select(mainW%,field%(F%))
  10502. close_file(F)
  10503. lit(menu%(6),6,
  10504. lit(menu%(6),7,
  10505. lit(menu%(1),7,
  10506. select_range(first%,last%,show%)
  10507.  F%,T%,F$,wi%,ic%
  10508.  first%>last% 
  10509.  first%,last%
  10510.  first%=1 
  10511.  last%=fields% 
  10512.  printorder$="" 
  10513.  printorder$=
  10514. printorder$))
  10515. wi%=mainW%
  10516.  F%=first% 
  10517.  last%
  10518.   ic%=field%(F%)
  10519.  chartype%(F%) 
  10520.  41,42,43,44,45:
  10521. X$    col%=
  10522. get_icon_cols(wi%,ic%)
  10523. YF    
  10524.  (col% 
  10525.  %1111)>=2 
  10526.  col%=((col%>>4) 
  10527.  (col%<<4)) 
  10528.  %11111111
  10529. Z.    
  10530.  show% 
  10531. set_icon_cols(wi%,ic%,col%)
  10532. ['    F$=
  10533. ~(F%):
  10534. (F$)=1 
  10535.  F$="0"+F$
  10536.     printorder$+=F$
  10537.  0,1,2,4,5,7,8:
  10538.  len%(F%)>0 
  10539. _)      F$=
  10540. ~(F%):
  10541. (F$)=1 
  10542.  F$="0"+F$
  10543.       printorder$+=F$
  10544. a$      
  10545.  show% 
  10546. select(wi%,ic%)
  10547. b        
  10548. d'    F$=
  10549. ~(F%):
  10550. (F$)=1 
  10551.  F$="0"+F$
  10552.     printorder$+=F$
  10553. f$    col%=
  10554. get_icon_cols(wi%,ic%)
  10555. g0    col%=((col%>>4) 
  10556.  (col%<<4)) 
  10557.  %11111111
  10558. h.    
  10559.  show% 
  10560. set_icon_cols(wi%,ic%,col%)
  10561. i%    
  10562.  39,48,49,50,51,52,53,55,58:
  10563. j'    F$=
  10564. ~(F%):
  10565. (F$)=1 
  10566.  F$="0"+F$
  10567.     printorder$+=F$
  10568. l"    
  10569.  show% 
  10570. select(wi%,ic%)
  10571.  3,6,46,47,54,56,57:
  10572. n'    F$=
  10573. ~(F%):
  10574. (F$)=1 
  10575.  F$="0"+F$
  10576.     printorder$+=F$
  10577. p=    
  10578.  show% 
  10579. select(wi%,ic%):
  10580. enable_row(calcrow%?F%,
  10581. lit(menu%(6),6,
  10582. lit(menu%(6),7,
  10583. lit(menu%(1),7,
  10584. clear_selection
  10585.  F%,T%,new%
  10586.  F%=1 
  10587.  fields%
  10588.  chartype%(F%) 
  10589.  36,41,42,43,44,45:
  10590. }.    col%=
  10591. get_icon_cols(mainW%,field%(F%))
  10592. ~E    
  10593.  (col% 
  10594.  %1111)<2 
  10595.  col%=((col%>>4) 
  10596.  (col%<<4)) 
  10597.  %11111111
  10598. .    
  10599. set_icon_cols(mainW%,field%(F%),col%)
  10600. V    
  10601.  3,6,8,46,47,54,56,57:
  10602. enable_row(calcrow%?F%,
  10603. deselect(mainW%,field%(F%))
  10604. &    
  10605. deselect(mainW%,field%(F%))
  10606. printorder$=""
  10607.  T%=0 
  10608.  LastTable%
  10609. b  NewTab%=(
  10610. table_info(T%,Rows%,TabFields%,Rec%,tabfieldlen%(),offset%,heading%,colours$)="
  10611. ,  extra%=-NewTab%*(Rows%*(TabFields%+1))
  10612.   p$=printrel$(T%)
  10613.  p$<>"" 
  10614.  tableW%(T%)>0 
  10615.       
  10616.  I%=1 
  10617. (p$) 
  10618. $        tablefield%=
  10619. p$,I%,3))
  10620. 5        
  10621. deselect(tableW%(T%),tablefield%+extra%)
  10622.       
  10623.         
  10624. printrel$()=""
  10625. lit(menu%(6),6,
  10626. lit(menu%(6),7,
  10627. lit(menu%(1),7,
  10628. load_query(f$,wi%,ic%)
  10629.  wi% 
  10630.  mainW%:
  10631.  ic% 
  10632. D    
  10633.  field%(buttonfield%(0,22)):
  10634. select(wi%,ic%):
  10635. filter(wi%,
  10636. .    
  10637. selected(passW%,14) 
  10638. match(0,0)
  10639.  keypadW%:
  10640. select(wi%,22):
  10641. filter(wi%,
  10642.  "OS_File",255,f$,Query%
  10643. query$=$Query%
  10644. set_caret(queryW%,0)
  10645. redraw_icon(queryW%,0)
  10646. design_field(b%,ic%,menu%)
  10647.  w%,h%
  10648. !posx%=x%:posy%=y%:dragbutt%=0
  10649. 3!block%=mainW%:
  10650.  "Wimp_GetWindowState",,block%
  10651. x%+=block%!20-block%!4
  10652. y%+=block%!24-block%!16
  10653.  %1111111 
  10654.  (ic% 
  10655.  2)=1 
  10656.  drag%=6:dragbutt%=16 
  10657.  drag%=5:dragbutt%=64
  10658. init_drag(mainW%,ic%,drag%)
  10659. icon_bit(22,createW%,44,(fields%>0))
  10660.   fieldfunc$="create"
  10661.   $InsText%=""
  10662. deselect(createW%,
  10663. selected_esg(createW%,1))
  10664.  ic%>=0 
  10665. lit(menu%(9),0,
  10666. B    !block%=mainW%:block%!4=ic%:
  10667.  "Wimp_GetIconState",,block%
  10668. M    x%=block%!8:y%=block%!12:w%=block%!16-block%!8:h%=block%!20-block%!12
  10669. $    Fieldnumber%=
  10670. get_field(ic%)
  10671. %    type%=chartype%(Fieldnumber%)
  10672.  type% 
  10673.       
  10674.  0,1,2,3,4,5,6,7,8:
  10675.       
  10676. select(createW%,21)
  10677.       
  10678. set_limits(0,0,8,8)
  10679.       
  10680.  36,37,38,39,40:
  10681.       
  10682. select(createW%,22)
  10683. "      
  10684. set_limits(36,36,40,11)
  10685.       
  10686.  41,42,43,44,45:
  10687.       
  10688. select(createW%,24)
  10689. "      
  10690. set_limits(41,41,45,14)
  10691. 6      
  10692.  46,47,48,49,50,51,52,53,54,55,56,57,58,59:
  10693.       
  10694. select(createW%,35)
  10695. "      
  10696. set_limits(46,46,59,16)
  10697.       
  10698.       
  10699. select(createW%,23)
  10700.        
  10701. set_limits(9,9,35,19)
  10702.         
  10703.     fieldtype%=type%
  10704. R    
  10705. tick_one(menu%(menunumber%),0,lasttype%-firsttype%,fieldtype%-firsttype%)
  10706. 4    $FtitleText%="Modify field "+
  10707. (Fieldnumber%)
  10708. 5    $DescText%=$
  10709. text(mainW%,desc%(Fieldnumber%))
  10710. $    $TagText%=Tag$(Fieldnumber%)
  10711. '    $LenText%=
  10712. (len%(Fieldnumber%))
  10713. $    $ValText%=vname$(fieldtype%)
  10714. 5    
  10715. deselect(createW%,
  10716. selected_esg(createW%,2))
  10717.  fix%(Fieldnumber%) 
  10718. /      
  10719. select(createW%,45):$Fixpt%="0"
  10720. .      
  10721. select(createW%,46):$Fixpt%="0"
  10722. >      
  10723. select(createW%,14):$Fixpt%=
  10724. (fix%(Fieldnumber%))
  10725.         
  10726. *    num%=(fieldtype%=3 
  10727.  fieldtype%=6)
  10728. :    
  10729. icon_bit(22,createW%,13,(
  10730. selected(createW%,14)))
  10731. &    
  10732. icon_bit(22,createW%,14,num%)
  10733. &    
  10734. icon_bit(22,createW%,45,num%)
  10735. &    
  10736. icon_bit(22,createW%,46,num%)
  10737. #    
  10738. icon_bit(22,createW%,18,
  10739. [    
  10740. icon_bit(22,createW%,6,(fieldtype%<9 
  10741.  fieldtype%=46 
  10742.  fieldtype%=47) 
  10743.  adjust%)
  10744. +    
  10745. icon_bit(22,createW%,30,
  10746.  adjust%)
  10747. #    
  10748. icon_bit(22,createW%,29,
  10749. @    
  10750. icon_bit(22,createW%,15,(fieldtype%=3 
  10751.  fieldtype%=47))
  10752. 0    
  10753. icon_bit(22,createW%,25,(fieldtype%=3))
  10754. *    C$=calc$(Fieldnumber%):P%=
  10755. C$,"|")
  10756. 8    
  10757.  P%>0 
  10758.  $mintext%=
  10759. C$,P%-1):$maxtext%=
  10760. C$,P%+1)
  10761.  I%=21 
  10762. -      
  10763. icon_bit(22,createW%,I%,
  10764.  adjust%)
  10765. +    
  10766. icon_bit(22,createW%,35,
  10767.  adjust%)
  10768. +    
  10769. icon_bit(22,createW%,39,
  10770.  adjust%)
  10771. +    
  10772. icon_bit(22,createW%,40,
  10773.  adjust%)
  10774.         
  10775. "    
  10776. lit(menu%(9),0,
  10777.  adjust%)
  10778. select(createW%,21)
  10779. set_limits(0,0,8,8)
  10780. .    $FtitleText%="New field "+
  10781. (fields%+1)
  10782. /    $DescText%="":$TagText%="":$LenText%=""
  10783. -    $Fixpt%="2":$mintext%="":$maxtext%=""
  10784. 5    
  10785. deselect(createW%,
  10786. selected_esg(createW%,2))
  10787. select(createW%,46)
  10788. #    
  10789. icon_bit(22,createW%,13,
  10790. #    
  10791. icon_bit(22,createW%,14,
  10792. #    
  10793. icon_bit(22,createW%,45,
  10794. #    
  10795. icon_bit(22,createW%,46,
  10796. #    
  10797. icon_bit(22,createW%,15,
  10798. #    
  10799. icon_bit(22,createW%,25,
  10800. #    
  10801. icon_bit(22,createW%,29,
  10802. #    
  10803. icon_bit(22,createW%,30,
  10804. #    
  10805. icon_bit(22,createW%,39,
  10806. #    
  10807. icon_bit(22,createW%,40,
  10808. +    
  10809. icon_bit(22,createW%,18,
  10810.  adjust%)
  10811.  (ic% 
  10812.  2)=1 
  10813. ;    $boxX%=
  10814. (x%):$boxY%=
  10815. (y%):$boxW%=
  10816. (w%):$boxH%=
  10817. B    
  10818.  x%+=w%+8:$boxX%=
  10819. (x%):$boxY%=
  10820. (y%):$boxW%="0":$boxH%="0"
  10821. close_window(createW%)
  10822.  menu% 
  10823. .    
  10824. show_menu(menu%(9),posx%-64,posy%-20)
  10825.      G    
  10826. position_window(createW%,0,0,0,0,0,0):
  10827. set_caret(createW%,4)
  10828. init_drag(mainW%,ic%,5):dragbutt%=64
  10829. remove_field(Field%,con%,
  10830.  Calc$)
  10831.  con% 
  10832. confirm(
  10833. msg("Err53"))=
  10834. )!block%=mainW%:block%!4=desc%(Field%)
  10835.  "Wimp_GetIconState",,block%
  10836. "posx%=block%!8:posy%=block%!12
  10837.  "Wimp_DeleteIcon",,block%
  10838. 8block%!4=field%(Field%):
  10839.  "Wimp_DeleteIcon",,block%
  10840. fields%-=1
  10841. Calc$=calc$(Field%)
  10842.  F%=Field% 
  10843.  fields%
  10844.   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)
  10845. !block%=mainW%
  10846.  "Wimp_GetWindowState",,block%
  10847. ;posx%-=block%!20-block%!4:posy%-=block%!24-block%!16-48
  10848.  "Wimp_ForceRedraw",-1,block%!4,block%!8,block%!12,block%!16
  10849. create_field(Before%,x%,y%,Calc$)
  10850.  Desc%,Field%,F%,tag$,Len%,Char%,F%,L%,LF%,x%,y%,width%,height%,dflg%
  10851.  fields%=MaxFields% 
  10852. softerror(
  10853. (MaxFields%),23):
  10854.  $DescText%="" 
  10855.  $TagText%="" 
  10856.  fieldtype%<=8 
  10857.  &%L%=
  10858. ($DescText%):LF%=
  10859. ($LenText%)
  10860.  L%=0 
  10861.  dflg%=(winback%<<28)+&7016711 
  10862.  dflg%=(winback%<<28)+&7016731
  10863.  LF%>246 
  10864. softerror("",64):
  10865.  ),x%=
  10866. ($boxX%):y%=
  10867. ($boxY%):int%=
  10868. ($grid%)
  10869. snap(x%,y%,int%)
  10870.  +&width%=
  10871. ($boxW%):height%=
  10872. ($boxH%)
  10873.  fieldtype% 
  10874.  39,40,59:
  10875.   LF%=0
  10876.  width%=0 
  10877.  width%=48
  10878.  height%=0 
  10879.  height%=48
  10880.  41,42,43,44,45:LF%=1
  10881.  8,48,50:LF%=8
  10882.  49:LF%=15
  10883.  51:LF%=10
  10884.  52,58:LF%=24
  10885.  53,55:LF%=3
  10886.  54,56:LF%=2
  10887.  57:LF%=4
  10888.  LF%>0 
  10889.  $TagText%="" 
  10890. softerror("",16):
  10891.  F%+=1
  10892.  $TagText%=Tag$(F%) 
  10893.  F%>fields%
  10894.  F%<=fields% 
  10895.  $TagText%<>"" 
  10896. softerror("",20):
  10897.  >8fields%+=1:Tag$(fields%)=$TagText%:len%(fields%)=LF%
  10898.  width%=0 
  10899.  $TagText%<>"" 
  10900.  @G  
  10901.  len%(fields%)<70 
  10902.  width%=len%(fields%)*16+16 
  10903.  width%=70*16+16
  10904.  height%=0 
  10905.  width%>0 
  10906.  height%=48
  10907.  C!chartype%(fields%)=fieldtype%
  10908.  E/  
  10909. selected(createW%,45):fix%(fields%)=-1
  10910.  F7  
  10911. selected(createW%,14):fix%(fields%)=
  10912. ($Fixpt%)
  10913. :fix%(fields%)=0
  10914. extend_named_sliding_block(formanchor%,Fptr%-!formanchor%+L%+6)
  10915.  J[desc%(fields%)=
  10916. create_icon(mainW%,x%-L%*16-16,y%+2,L%*16+8,44,dflg%,"",Fptr%,hand%,L%)
  10917.  K!$Fptr%=$DescText%:Fptr%+=L%+1
  10918. $Fptr%=""
  10919.  fieldtype% 
  10920.   min$=$
  10921. text(createW%,15)
  10922.   max$=$
  10923. text(createW%,25)
  10924.  QL  
  10925.  min$<>"" 
  10926.  max$<>"" 
  10927.  calc$(fields%)=min$+"|"+max$:calc$(0)="LOADED"
  10928.  S3  min$=$
  10929. text(createW%,15):
  10930.  min$="" 
  10931.  min$="0"
  10932.  T4  calc$(fields%)=min$+"|"+min$:calc$(0)="LOADED"
  10933.  fieldtype% 
  10934.  WT  
  10935.  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%
  10936.  X4  
  10937.  59:valptr%=!logoanchor%:$Fptr%=Tag$(fields%)
  10938.  Y#  
  10939. :valptr%=hvalid%(fieldtype%)
  10940. icon_design(fieldtype%,1,width%,height%)
  10941.  \Xfield%(fields%)=
  10942. create_icon(mainW%,x%,y%,width%,height%,iflags%,"",Fptr%,valptr%,4)
  10943.  fieldtype%=40 
  10944.  Rf%(fields%)=
  10945. create_anchor("Picture"+
  10946. (fields%))
  10947. Fptr%+=5
  10948. redraw_icon(mainW%,desc%(fields%)):
  10949. redraw_icon(mainW%,field%(fields%))
  10950.  Before%<fields% 
  10951.  Before%>0 
  10952. re_sequence(fields%,Before%,-1)
  10953. snap(
  10954.  y%,int%)
  10955.  X%,Y%
  10956.  int%>0 
  10957.  f5  X%=(x% 
  10958.  int%)*int%:
  10959.  x%-X%>int% 
  10960.  X%+=int%
  10961.  g5  Y%=(y% 
  10962.  int%)*int%:
  10963.  Y%-y%>int% 
  10964.  Y%-=int%
  10965.   $boxX%=
  10966. (X%):$boxY%=
  10967.   x%=X%:y%=Y%
  10968. adjust_field(b%)
  10969.  Dptr%,Fptr%,dflg%
  10970.  "Wimp_GetPointerInfo",,block%
  10971.  p newx%=!block%:newy%=block%!4
  10972.  q#Fieldnumber%=
  10973. get_field(ficon%)
  10974.  (ficon% 
  10975.  2)=0 
  10976.  sC  !block%=mainW%:block%!4=ficon%:
  10977.  "Wimp_GetIconState",,block%
  10978.  t.  Dptr%=block%!28:Desc$=$Dptr%:L%=
  10979. (Desc$)
  10980.  uL  
  10981.  L%=0 
  10982.  dflg%=(winback%<<28)+&7016711 
  10983.  dflg%=(winback%<<28)+&7016731
  10984.  v"  
  10985.  "Wimp_DeleteIcon",,block%
  10986.  w&  
  10987.  "Wimp_GetWindowState",,block%
  10988.  x-  x%=block%!20-block%!4+newx%-oldx%+minx%
  10989.  y.  y%=block%!24-block%!16+miny%+newy%-oldy%
  10990.  zW  desc%(Fieldnumber%)=
  10991. create_icon(mainW%,x%,y%,L%*16+8,44,dflg%,"",Dptr%,hand%,L%)
  10992.  |C  !block%=mainW%:block%!4=ficon%:
  10993.  "Wimp_GetIconState",,block%
  10994.   Fptr%=block%!28
  10995. $    
  10996.  "Wimp_DeleteIcon",,block%
  10997. (    
  10998.  "Wimp_GetWindowState",,block%
  10999. #    x%=block%!20-block%!4+minx%
  11000. 0    y%=block%!24-block%!16+miny%+newy%-oldy%
  11001. F    width%=maxx%-minx%+newx%-oldx%:height%=maxy%-miny%+oldy%-newy%
  11002. '    keepwith%=
  11003. selected(prefsW%,16)
  11004.  keepwith% 
  11005. I      !block%=mainW%:block%!4=ficon%-1:
  11006.  "Wimp_GetIconState",,block%
  11007. 2      Dptr%=block%!28:Desc$=$Dptr%:L%=
  11008. (Desc$)
  11009. P      
  11010.  L%=0 
  11011.  dflg%=(winback%<<28)+&7016711 
  11012.  dflg%=(winback%<<28)+&7016731
  11013. &      
  11014.  "Wimp_DeleteIcon",,block%
  11015.         
  11016. C    !block%=mainW%:block%!4=ficon%:
  11017.  "Wimp_DeleteIcon",,block%
  11018.  keepwith% 
  11019. *      
  11020.  "Wimp_GetWindowState",,block%
  11021. :      x%=block%!20-block%!4+newx%-oldx%+minx%-L%*16-16
  11022. 2      y%=block%!24-block%!16+miny%+newy%-oldy%
  11023. ]      desc%(Fieldnumber%)=
  11024. create_icon(mainW%,x%,y%+2,L%*16+8,44,dflg%,"",Dptr%,hand%,L%)
  11025.         
  11026. (    
  11027.  "Wimp_GetWindowState",,block%
  11028. /    x%=block%!20-block%!4+newx%-oldx%+minx%
  11029. 0    y%=block%!24-block%!16+miny%+newy%-oldy%
  11030. .    width%=maxx%-minx%:height%=maxy%-miny%
  11031. (  fieldtype%=chartype%(Fieldnumber%)
  11032.  fieldtype% 
  11033. V    
  11034.  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%
  11035. <    
  11036.  59:valptr%=!logoanchor%::$Fptr%=Tag$(Fieldnumber%)
  11037. %    
  11038. :valptr%=hvalid%(fieldtype%)
  11039. icon_design(fieldtype%,1,width%,height%)
  11040. _  field%(Fieldnumber%)=
  11041. create_icon(mainW%,x%,y%,width%,height%,iflags%,"",Fptr%,valptr%,4)
  11042.  fieldtype%=40 
  11043.  Rf%(Fieldnumber%)=
  11044. create_anchor("Picture"+
  11045. (Fieldnumber%))
  11046. @$boxX%=
  11047. (x%):$boxY%=
  11048. (y%):$boxW%=
  11049. (width%):$boxH%=
  11050. (height%)
  11051. !block%=mainW%
  11052.  "Wimp_GetWindowState",,block%
  11053.  "Wimp_ForceRedraw",-1,block%!4,block%!8,block%!12,block%!16
  11054. swap_fields(F1%,F2%)
  11055.  F2%>0 
  11056.  F2%<=fields% 
  11057.  desc%(F1%),desc%(F2%)
  11058.  Tag$(F1%),Tag$(F2%)
  11059.  field%(F1%),field%(F2%)
  11060.  len%(F1%),len%(F2%)
  11061.  chartype%(F1%),chartype%(F2%)
  11062.  fix%(F1%),fix%(F2%)
  11063.  calc$(F1%),calc$(F2%)
  11064. close_window(createW%)
  11065. re_sequence(F1%,F2%,Z%)
  11066. jD%=desc%(F1%):T$=Tag$(F1%):F%=field%(F1%):L%=len%(F1%):C%=chartype%(F1%):f%=fix%(F1%):Calc$=calc$(F1%)
  11067.  I%=F1%+Z% 
  11068.  F2% 
  11069.   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%)
  11070. jdesc%(F2%)=D%:Tag$(F2%)=T$:field%(F2%)=F%:len%(F2%)=L%:chartype%(F2%)=C%:fix%(F2%)=f%:calc$(F2%)=Calc$
  11071. icon_design(char%,func%,
  11072.  func% 
  11073.  0:bfg%=&1700353F:rbfg%=&1700253F:ffg%=&0700A535:
  11074.  logosloaded% 
  11075.  lfg%=&0000611A 
  11076.  lfg%=ffg%
  11077.  1:bfg%=&1700653F:rbfg%=bfg%:ffg%=&07006535:
  11078.  logosloaded% 
  11079.  lfg%=&0000611E 
  11080.  lfg%=ffg%
  11081.  char% 
  11082.  9,10,11,12,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30:
  11083. F  !block%=keypadW%:block%!4=char%-9:
  11084.  "Wimp_GetIconState",,block%
  11085. ?  w%=block%!16-block%!8:h%=block%!20-block%!12:iflags%=bfg%
  11086.  13,14:
  11087. F  !block%=keypadW%:block%!4=char%-9:
  11088.  "Wimp_GetIconState",,block%
  11089. @  w%=block%!16-block%!8:h%=block%!20-block%!12:iflags%=rbfg%
  11090.  31:w%=48:h%=48:iflags%=&1700B53B
  11091.  32,34:w%=112:h%=52:iflags%=bfg%
  11092.  33:w%=44:h%=44:
  11093.  func%=0 
  11094.  iflags%=&1700353B 
  11095.  iflags%=&1700653B
  11096.  35:w%=80:h%=80:iflags%=bfg%
  11097.  36,37,38:w%=48:h%=48:iflags%=bfg%
  11098.  39:iflags%=ffg%
  11099.  func%=0 
  11100.  iflags%=&0700A53E 
  11101.  iflags%=ffg%
  11102.  41,42,43,44,45:w%=52:h%=52:iflags%=&1700B53B
  11103.  59:iflags%=lfg%
  11104. :iflags%=ffg%
  11105.  w%=0 
  11106.  h%=0 
  11107.  iflags%=&00000000
  11108. get_field(ic%)
  11109.  F%+=1
  11110.  field%(F%)=ic% 
  11111.  desc%(F%)=ic%
  11112. adjust_on(on%)
  11113. design%=on%:adjust%=on%
  11114. lit(menu%(9),5,on%)
  11115. lit(menu%(9),1,
  11116.  on%)
  11117. lit(menu%(9),2,
  11118.  on%)
  11119. lit(menu%(9),3,
  11120.  on%)
  11121. lit(menu%(9),4,
  11122.  on%)
  11123. icon_bit(22,createW%,6,
  11124.  on%)
  11125.  on% 
  11126. *  w%=ScreenWidth%*2:h%=ScreenHeight%*2
  11127. 4  !block%=0:block%!4=-h%:block%!8=w%:block%!12=0
  11128.  "Wimp_SetExtent",mainW%,block%
  11129. change_length(NL%,msg%)
  11130.  EX%,klm%,S$,N%
  11131. EX%=NL%-RA%
  11132.  EX%=0 
  11133. *dbasehandle%=
  11134. ($database%+".Database")
  11135. readsmarray(dbasehandle%,RA%)
  11136.  msg%:
  11137. extend_dbase
  11138.  (EX%>0):
  11139. confirm("Extend file from "+
  11140. (RA%)+" to "+
  11141. (NL%)+" records")=
  11142. extend_dbase
  11143.  (EX%<0):
  11144. confirm("Shorten file from "+
  11145. (RA%)+" to "+
  11146. (NL%)+" records")=
  11147. shorten_dbase
  11148. $Records%=
  11149. (RA%):N%=RA%
  11150. writesmarray(dbasehandle%,N%)
  11151. close_file(dbasehandle%)
  11152.  msg% 
  11153.  addr=
  11154. moveto(key%,top,1)
  11155. extend_dbase
  11156.  end%,P%,I%,key%,keybase%,KLM%,S$
  11157.  key%=0 
  11158.  Keys%
  11159.   S$=
  11160. KL%(key%),".")
  11161.   KLM%=KL%(key%)+13
  11162.   P%=LH%+48+(NL%+1)*KLM%
  11163. extend_named_sliding_block(keyanchor%(key%),P%)
  11164.    keybase%=!keyanchor%(key%)
  11165.   P%=LH%+48+RA%*KLM%
  11166.  I%=RA% 
  11167.  EX%+RA%-1
  11168.     !(keybase%+P%)=P%+KLM%
  11169.     !(keybase%+P%+4)=0
  11170.     $(keybase%+P%+8)=S$
  11171. %    !(keybase%+P%+KL%(key%)+9)=I%
  11172.     P%+=KLM%
  11173.   !(keybase%+P%)=0
  11174.   !(keybase%+P%+4)=0
  11175.   $(keybase%+P%+8)=S$
  11176. "  !(keybase%+P%+KL%(key%)+9)=0
  11177.  key%
  11178. end%=(RA%+1)*Length%
  11179.  I%=0 
  11180.  EX%-1
  11181. #dbasehandle%=end%+I%*Length%
  11182.  J%=1 
  11183.  fields%
  11184. #dbasehandle%,""
  11185. RA%=NL%
  11186. #dbasehandle%=(RA%+1)*Length%
  11187. shorten_dbase
  11188.  P%,L%,R%,s$,key%,keybase%,S$
  11189.  key%=0 
  11190.  Keys%
  11191.   S$=
  11192. KL%(key%),".")
  11193.   KLM%=KL%(key%)+13
  11194. !%   keybase%=!keyanchor%(key%)
  11195. !&$  s$=$(keybase%+LH%+56+NL%*KLM%)
  11196. !'0  
  11197.  s$<>S$ 
  11198. confirm(
  11199. msg("Err52"))=
  11200.   P%=LH%+48+NL%*KLM%
  11201.   !(keybase%+P%)=0
  11202.   !(keybase%+P%+4)=0
  11203.   $(keybase%+P%+8)=S$
  11204. !,"  !(keybase%+P%+KL%(key%)+9)=0
  11205.  key%
  11206. RA%=NL%
  11207. #dbasehandle%=(RA%+1)*Length%
  11208. copy_database_spritefile(path$,leaf$)
  11209.  sprites%
  11210. create_named_sliding_block(sprsanchor%,1024)
  11211.  ### This is a temporary sprite area used simply to hold ###
  11212.  ### the sprite 'new_appl' whilst it is renamed and saved ###
  11213. sprites%=!sprsanchor%
  11214. !sprites%=1024
  11215. sprites%!8=16
  11216.  ### Initialise sprite area ###
  11217.  "OS_SpriteOp",&109,sprites%
  11218.  ### Load !Sprites file from Resources ###
  11219.  "OS_SpriteOp",&10A,sprites%,"<PBase$Dir>.Resources.Temp.!Sprites"
  11220.  ### Rename sprite 'new_appl' to new database name ###
  11221.  "OS_SpriteOp",&11A,sprites%,"new_appl",leaf$
  11222.  ### Save spritefile (with renamed new_appl) as !Sprites ###
  11223.  "OS_SpriteOp",&10C,sprites%,path$+".!Sprites"
  11224.  ### Do same for hi-res sprite ###
  11225.  "OS_SpriteOp",&109,sprites%
  11226.  "OS_SpriteOp",&10A,sprites%,"<PBase$Dir>.Resources.Temp.!Sprites22"
  11227.  "OS_SpriteOp",&11A,sprites%,"new_appl",leaf$
  11228.  "OS_SpriteOp",&10C,sprites%,path$+".!Sprites22"
  11229. scrap_sliding_block(sprsanchor%)
  11230. defaults(f$,N%,key%)
  11231. $Records%=
  11232. make_empty_index(N%,key%,
  11233. save_recs(f$+".Database",N%)
  11234. !N%present%=7:
  11235. save_keys:
  11236. save_calcs
  11237. !O'design%=
  11238. :present%=1:
  11239. get_it_in(f$)
  11240. lit(menu%(0),2,
  11241. default_key
  11242. first_field
  11243.  chartype%(F%) 
  11244. !W*  
  11245.  3,6,46,47,54,56,57:KL%(0)=len%(F%)
  11246. !X1  
  11247.  len%(F%)>3 
  11248.  KL%(0)=4 
  11249.  KL%(0)=len%(F%)
  11250. Index$(0)="PrimaryKey"
  11251. key%=0
  11252. KW%()=0:KF%()=0
  11253. !]0KW%(0,0)=KL%(0)+(1<<16)+(F%<<24):KF%(0,0)=F%
  11254. set_keydata(key%)
  11255. new_tree(f%)
  11256.  REC%,I%,ptr%,file%,old$,chars%,pos%,word%,c$,p$,w$
  11257.  I%=0 
  11258.   W%=KW%(0,I%)
  11259.  W%>0 
  11260. !f$    chars%=W% 
  11261.  255:c$=
  11262. (chars%)
  11263. !gL    pos%=(W%>>8) 
  11264.  255:p$=
  11265. (pos%):
  11266.  pos%=0 
  11267.  p$="L" 
  11268.  pos%=25 
  11269.  p$="R"
  11270. !h(    word%=(W%>>16) 
  11271.  255:w$=
  11272. (word%)
  11273. !i8    old$+=Tag$(KF%(0,I%))+" ("+w$+","+p$+","+c$+"),"
  11274. old$=
  11275. old$)
  11276. !m1d%=
  11277. selected(keyW%,33):s%=
  11278. selected(keyW%,32)
  11279.  f%=0
  11280. M$="Build index with "
  11281.  M$+="records in same subfiles" 
  11282.  M$+="all records in subfile "+
  11283. M$+=" of current database"
  11284.  M$+=", also restoring 'deleted' records."
  11285.  M$+=" WARNING! Other indices will need rebuilding!"
  11286. confirm(M$)=
  11287. mark_files(0,RA%,
  11288.  d%,s%,f%)
  11289. copy_keydata(0)
  11290.  "OS_File",5,$database%+".Database" 
  11291.  ,,,,len%
  11292. RA%=(len% 
  11293.  Length%)-1
  11294. scrap_sliding_block(keyanchor%(0))
  11295. make_empty_index(RA%,0,
  11296. close_window(keyW%)
  11297. redraw(keypadW%)
  11298. ptr%=!tempanchor%
  11299. poll:
  11300.  "Hourglass_On"
  11301. *dbasehandle%=
  11302. ($database%+".Database")
  11303.  REC%=0 
  11304.  RA%-1
  11305.   file%=ptr%?REC%
  11306.  file%<>255 
  11307.     top=8*file%+LH%
  11308. '    
  11309. readsmarray(dbasehandle%,REC%)
  11310.     KEY$=
  11311. key2(0,1)
  11312.     K$=
  11313. stripspaces(KEY$)
  11314.  K$<>"" 
  11315.       
  11316. insert(KEY$,0)
  11317.       
  11318.       
  11319. -        
  11320. scrap_sliding_block(tempanchor%)
  11321. 5        
  11322. open_index($database%+".PrimaryKey",0,
  11323. &        
  11324.  moan_err%,
  11325. msg("Err111")
  11326.         
  11327.  ptr%?REC%=255
  11328.       
  11329.         
  11330.  "Hourglass_Percentage",(REC%*100) 
  11331.  REC%
  11332. close_file(dbasehandle%)
  11333. Xkeybase%=!keyanchor%(0):nextfree%=!keybase%:nodesize%=12+KL%(0)+1:offset%=8+KL%(0)+1
  11334.  REC%=0 
  11335.  RA%-1
  11336.  ptr%?REC%=255 
  11337. *    !(keybase%+nextfree%+offset%)=REC%
  11338.     nextfree%+=nodesize% 
  11339.  REC%
  11340. "newtree%=
  11341. :design%=
  11342. :adjust%=
  11343. scrap_sliding_block(tempanchor%)
  11344. Index$(0)="PrimaryKey"
  11345.  "Hourglass_Off"
  11346. present%=7
  11347. write_log(-1,"Primary key structure altered. Was "+old$)
  11348.  "Wimp_CreateMenu",,-1
  11349. file%=0:
  11350. asterisk(
  11351. get_it_in($database%)
  11352. reformat(f$)
  11353.  I%,F,REC%,dfields%,DLength%,chdd,z%,blobs%,ex%
  11354.  DTag$(),F%(),F1%(),L%(),l$(),c$()
  11355. F$(0)=""
  11356.  "OS_File",5,f$+".Form" 
  11357.  z%<>1:
  11358. softerror("",19)
  11359.  f$=$database%:
  11360. softerror("",36)
  11361. $  blobs%=
  11362. find_blobs($database%)
  11363. (f$+".Form")
  11364. #F,dfields%
  11365.  DTag$(dfields%),F%(dfields%),F1%(fields%),L%(dfields%),l$(dfields%),c$(dfields%)
  11366.  I%=1 
  11367.  dfields%
  11368. F    
  11369. #F,Desc$,DTag$(I%),xd%,yd%,xf%,yf%,L%(I%),char%,extra%,extra%
  11370.     DLength%+=L%(I%)+1
  11371.   chdd=
  11372. (f$+".Database")
  11373. ,  dbasehandle%=
  11374. ($database%+".Database")
  11375. compare
  11376.  "Hourglass_On"
  11377.  REC%=0 
  11378. #chdd=REC%*DLength%
  11379. '    
  11380. readsmarray(dbasehandle%,REC%)
  11381.  I%=1 
  11382.  dfields%
  11383.       S$=F$(F%(I%))
  11384. )      
  11385. (S$)>L%(I%) 
  11386. S$,L%(I%))
  11387.       
  11388. #chdd,S$
  11389.     ex%=-1
  11390.  ex%<blobs%
  11391.       ex%+=1:F%=Ext%(ex%)
  11392. F      
  11393. copy_blob($database%,f$,REC%,REC%,F%,F1%(F%),chartype%(F%))
  11394.         
  11395. 2    
  11396.  "Hourglass_Percentage",(REC%*100) 
  11397.  REC%
  11398.  "Hourglass_Off"
  11399. close_file(chdd)
  11400. close_file(dbasehandle%)
  11401.  "OS_File",18,f$+".Database",&7f2
  11402.  object$
  11403. O    
  11404.  "XOS_CLI","Copy "+$database%+"."+object$+" "+f$+"."+object$+" ~CF~V"
  11405.  object$="***"
  11406.  !Run,Cols,Indices,Log,PrimaryKey,PrintJobs
  11407.  PrintRes,Special,STemplate,Subfiles,UserFuncs,UsrSprites,ValTables,Winpos,***
  11408.  link$(0)="LOADED" 
  11409.     lk=
  11410. (f$+".Link")
  11411.  F%=1 
  11412.  dfields%
  11413.       
  11414. #lk,l$(F%)
  11415. close_file(lk)
  11416.  calc$(0)="LOADED" 
  11417.     cl=
  11418. (f$+".Calc")
  11419.  F%=1 
  11420.  dfields%
  11421.       
  11422. #cl,c$(F%)
  11423. close_file(cl)
  11424. close_window(reformW%)
  11425. reform$="":
  11426. asterisk(
  11427. write_log(-1,"Record structure changed")
  11428. compare
  11429.  source%,dest%
  11430.  dest%=1 
  11431.  dfields%
  11432.   source%=fields%+1
  11433.     source%-=1
  11434.  source%=0 
  11435.  Tag$(source%)=DTag$(dest%)
  11436. *  F%(dest%)=source%:F1%(source%)=dest%
  11437.  source%>0 
  11438.      l$(dest%)=link$(source%)
  11439.      c$(dest%)=calc$(source%)
  11440.  dest%
  11441. merge_files(f$,fi%)
  11442.  R%,REC%,ptr%,file%,d%,s%,z%,RUM%,RAM%,NL%,ex%,blobs%
  11443.  "OS_File",5,f$+".Database" 
  11444.  z%<>1:
  11445. softerror("",29)
  11446.  f$=$database%:
  11447. softerror("",15)
  11448. identical:
  11449. softerror("",21)
  11450. 7  s%=
  11451. selected(reformW%,2):d%=
  11452. selected(reformW%,3)
  11453.  fi%=0
  11454.   M$="Merge "+f$+" with "
  11455.  M$+="corresponding subfiles" 
  11456.  M$+="subfile "+
  11457. (fi%)
  11458.    M$+=" of current database"
  11459.  M$+=", also restoring deleted records"
  11460. "    B  
  11461.  M$+=". WARNING! Indices will need rebuilding!"
  11462. confirm(M$)=
  11463. 0    
  11464.  "OS_File",5,f$+".Database" 
  11465.  ,,,,len%
  11466.     RAM%=(len% 
  11467.  Length%)-1
  11468. I    
  11469.  ### Load primary key of file to be merged into a spare slot ###
  11470. 2    
  11471. open_index(f$+".PrimaryKey",MaxKeys%+1,
  11472. @    
  11473.  ### Mark which subfile each new record is to go in ###
  11474. 0    
  11475. mark_files(MaxKeys%+1,RAM%,
  11476.  d%,s%,fi%)
  11477. (    keybase%=!keyanchor%(MaxKeys%+1)
  11478. F    
  11479.  ### Count how many record actually used in file to merge ###
  11480. -    
  11481. count(MaxKeys%+1,RUM%):
  11482. count(0,RU%)
  11483.     NL%=RU%+RUM%
  11484.  "Hourglass_On"
  11485. O    
  11486.  ### Expand existing file if new length (NL%) exceeds availability ###
  11487. )    
  11488.  NL%>RA% 
  11489. change_length(NL%,
  11490. &    blobs%=
  11491. find_blobs($database%)
  11492.     ptr%=!tempanchor%
  11493.  R%=0 
  11494.  RAM%-1
  11495.       file%=ptr%?R%
  11496.       
  11497.  file%<>255 
  11498.         
  11499. make_new_rec
  11500.         top=8*file%+LH%
  11501. "        
  11502. read(fields%,
  11503. ,R%,f$)
  11504. " 8        
  11505. selected(reformW%,8) 
  11506.  dontincrement%=
  11507. "!         
  11508. write(fields%,key%)
  11509.         ex%=-1
  11510.         
  11511.  ex%<blobs%
  11512. "$!          ex%+=1:F%=Ext%(ex%)
  11513. "%C          
  11514. copy_blob(f$,$database%,R%,REC%,F%,F%,chartype%(F%))
  11515.         
  11516. "'5        
  11517.  "Hourglass_Percentage",(R%*100) 
  11518.  RUM%
  11519.       
  11520.  "Hourglass_Off"
  11521. close_window(reformW%)
  11522. ",)    
  11523. scrap_sliding_block(tempanchor%)
  11524. "-4    
  11525. scrap_sliding_block(keyanchor%(MaxKeys%+1))
  11526. ".!    file%=fi%:top=8*file%+LH%
  11527. "/     addr=
  11528. moveto(key%,top,1)
  11529. reform$="":
  11530. asterisk(
  11531. write_log(-1,"Records merged from "+f$)
  11532. identical
  11533.  I%,F,dfields%,different%
  11534. (f$+".Form")
  11535. #F,dfields%
  11536.  dfields%<>fields% 
  11537.  different%=
  11538.  I%<fields% 
  11539.  different%
  11540.   I%+=1
  11541. "==  
  11542. #F,Desc$,Tag$,xd%,yd%,xf%,yf%,len%,char%,extra%,extra%
  11543. ">%  
  11544.  len%<>len%(I%) 
  11545.  different%=
  11546. "?J  
  11547.  char%<>chartype%(I%) 
  11548.  (char%>8 
  11549.  chartype%(I%)>8) 
  11550.  different%=
  11551.  different%
  11552. mark_files(key%,RA%,d%,s%,f%)
  11553.  P%,I%,M,file%,top,ptr%
  11554. create_named_sliding_block(tempanchor%,RA%+1)
  11555.  "Hourglass_On"
  11556. ptr%=!tempanchor%
  11557.  I%=0 
  11558.  RA%-1
  11559.   ptr%?I%=d%
  11560.  file%=0 
  11561.     top=8*file%+LH%
  11562. "O!    P%=
  11563. neighbour(key%,top,1)
  11564.  P%<>top
  11565. "Q       S%=
  11566. rec_no(k$,key%,P%)
  11567. "R+      
  11568.  ptr%?S%=file% 
  11569.  ptr%?S%=f%
  11570. "S"      P%=
  11571. neighbour(key%,P%,1)
  11572. "T        
  11573.  file%
  11574.  "Hourglass_Off"
  11575. print_tree(key%,file%,PR$)
  11576.  L%(),COL%,levels%,depth%
  11577. "\YTextName$=$database%+".PrintJobs.Tree"+
  11578. Index$(key%),5)+
  11579. (file%):$SaveName%=TextName$
  11580. read_print_options
  11581. reportdest$="Window"
  11582. keybase%=!keyanchor%(key%)
  11583. P%=!(keybase%+top)
  11584.  "Hourglass_On"
  11585. traverse(P%,
  11586. levels%=depth%-2:COL%=0
  11587.  L%(levels%)
  11588. tree_heading
  11589. P%=!(keybase%+top)
  11590. traverse(P%,
  11591. H$=" No. nodes     1"
  11592. H1$=" Max nodes     1"
  11593.  L%=1 
  11594.  levels%
  11595.  L%<40 
  11596.     L$=
  11597. (L%(L%))
  11598.     L$=
  11599. (L$)," ")+L$
  11600.     M$=
  11601. (2^L%)
  11602. "o0    
  11603. (M$)>5 
  11604.  M$=BL$ 
  11605. (M$)," ")+M$
  11606.     H$+=L$:H1$+=M$
  11607. rule_off(45)
  11608. "t:$(!lineanchor%)=H$:
  11609. list_line(-1,lineanchor%,
  11610. (H$),32)
  11611. "u<$(!lineanchor%)=H1$:
  11612. list_line(-1,lineanchor%,
  11613. (H1$),32)
  11614. "v<$(!lineanchor%)=LH$:
  11615. list_line(-1,lineanchor%,
  11616. (LH$),32)
  11617. rule_off(45)
  11618.  "Hourglass_Off"
  11619. format$="tree":tkey%=key%
  11620. screen_list
  11621. pitch$=
  11622. pitch("2")
  11623. lit(menu%(18),1,
  11624. write_log(-1,"Tree printed: subfile:"+
  11625. (file%)+", key:"+
  11626. (key%)+", "+Index$(key%))
  11627. tree_heading
  11628.  zero%,len%
  11629. 6," ")
  11630. LH$=" Level No.  Root"
  11631.  L%=1 
  11632.  levels%
  11633.   L$=
  11634.  L%<10 
  11635.  L$="0"+L$
  11636.  L%<40 
  11637.     LH$+="    "+L$
  11638.     len%=
  11639. (LH$)
  11640. U$=" "+
  11641. len%-1,"-")
  11642. LenLine%=len%+4
  11643. Count%=0
  11644. "count%=
  11645. count_recs(key%,zero%)
  11646. Dtextblocksize%=(count%+11)*LenLine%:textblockinc%=textblocksize%
  11647. extend_named_sliding_block(textanchor%,textblocksize%)
  11648. extend_named_sliding_block(lineanchor%,LenLine%+4)
  11649. TextPtr%=!textanchor%
  11650. recblocksize%=400
  11651. extend_named_sliding_block(recanchor%,recblocksize%)
  11652. rule_off(32)
  11653. rule_off(45)
  11654. send_title("Tree Analysis (subfile:"+
  11655. (file%)+", key:"+
  11656. (key%)+", "+Index$(key%)+")")
  11657. rule_off(32)
  11658. <$(!lineanchor%)=LH$:
  11659. list_line(-1,lineanchor%,
  11660. (LH$),32)
  11661. rule_off(45)
  11662. traverse(P%,Z%)
  11663.  string$
  11664. COL%=COL%+1
  11665.  COL%>depth% 
  11666.  depth%=COL%
  11667.  P%<0 
  11668. L%=!(keybase%+P%)
  11669. R%=!(keybase%+P%+4)
  11670. S$=$(keybase%+P%+8)
  11671.  S$="" 
  11672.  S$="<null>"
  11673. S$)="#"
  11674.   S$=
  11675. %rec%=!(keybase%+P%+8+KL%(key%)+1)
  11676.   L%(COL%-1)=L%(COL%-1)+1
  11677.  PR$="ALL" 
  11678.  COL%<=40 
  11679. *      string$=
  11680. COL%*6+10-
  11681. (S$)," ")+S$
  11682. L      $(!lineanchor%)=string$:
  11683. list_line(rec%,lineanchor%,
  11684. (string$),32)
  11685.       
  11686. 1      string$=" "+S$+" (level "+
  11687. (COL%-1)+")"
  11688. L      $(!lineanchor%)=string$:
  11689. list_line(rec%,lineanchor%,
  11690. (string$),32)
  11691.         
  11692. traverse(L%,Z%)
  11693. COL%=COL%-1
  11694. L%=!(keybase%+P%)
  11695. R%=!(keybase%+P%+4)
  11696. S$=$(keybase%+P%+8)
  11697. %rec%=!(keybase%+P%+8+KL%(key%)+1)
  11698. traverse(R%,Z%)
  11699. COL%=COL%-1
  11700. balance(key%)
  11701.  recptr%,top,file%,flagptr%,balptr%,I%,N%,A%,max%,done%,highest%,avail%,seglen%
  11702.  recs%(),ptr%()
  11703.  recs%(5),ptr%(5)
  11704. newtree%=
  11705. seglen%=KL%(key%)+5
  11706. extend_named_sliding_block(recanchor%,seglen%*RA%)
  11707. create_named_sliding_block(balanchor%,seglen%*RA%)
  11708. create_named_sliding_block(flaganchor%,RA%)
  11709. Arecptr%=!recanchor%:flagptr%=!flaganchor%:balptr%=!balanchor%
  11710.  I%=0 
  11711.  RA%-1
  11712.   flagptr%?I%=255
  11713.  Bytes are changed from 255 to 0 where records are in use
  11714.  "Hourglass_On"
  11715.  file%=0 
  11716.   ptr%(file%)=recptr%
  11717.   top=8*file%+LH%
  11718. .  recs%(file%)=
  11719. count_recs(key%,recptr%)-1
  11720.   max%+=recs%(file%)+1
  11721.  file%
  11722. make_empty_index(RA%,key%,
  11723.  "Hourglass_LEDs",%11
  11724.  file%=0 
  11725.   top=8*file%+LH%
  11726.  recs%(file%)>=0 
  11727.     recptr%=ptr%(file%)
  11728.     N%=1
  11729.         
  11730.       N%=N%+N%
  11731.  N%>recs%(file%)+2
  11732.     step%=N%
  11733.     N%=(N% 
  11734.  2)-1
  11735.     start%=N%
  11736.     C%=0
  11737.         
  11738.       start%=start% 
  11739.       end%=N%-start%-1
  11740.       step%=step% 
  11741. $      
  11742.  I%=start% 
  11743.  end% 
  11744.  step%
  11745. 9        A%=recptr%+seglen%*(I%*(recs%(file%)+1) 
  11746. =        balptr%!C%=!A%:$(balptr%+C%+4)=$(A%+4):!A%=-!A%-1
  11747.         C%+=seglen%
  11748.       
  11749.  step%=2
  11750. %    
  11751.  I%=0 
  11752.  C%-seglen% 
  11753.  seglen%
  11754. .      REC%=balptr%!I%:KEY$=$(balptr%+I%+4)
  11755.       
  11756. insert(KEY$,key%)
  11757.       done%+=1
  11758. 6      
  11759.  "Hourglass_Percentage",(done%*100) 
  11760.  max%
  11761.  I%=0 
  11762.  recs%(file%)
  11763. #      REC%=recptr%!(seglen%*I%)
  11764.       
  11765.  REC%>=0 
  11766. (        KEY$=$(recptr%+seglen%*I%+4)
  11767.         
  11768. insert(KEY$,key%)
  11769.         done%+=1
  11770. 8        
  11771.  "Hourglass_Percentage",(done%*100) 
  11772.  max%
  11773.       
  11774.  file%
  11775.  "Hourglass_LEDs",%00
  11776. keybase%=!keyanchor%(key%)
  11777. nodesize%=8+KL%(key%)+1+4
  11778. avail%=!keybase%
  11779.  I%=0 
  11780.  highest%
  11781.  flagptr%?I%=255 
  11782. +    !(keybase%+avail%+8+KL%(key%)+1)=I%
  11783.     avail%+=nodesize%
  11784.  "Hourglass_Off"
  11785. scrap_sliding_block(balanchor%)
  11786. scrap_sliding_block(recanchor%)
  11787. scrap_sliding_block(flaganchor%)
  11788. save_keys
  11789. newtree%=
  11790. asterisk(
  11791. write_log(-1,"Index "+Index$(key%)+" balanced")
  11792. duplicates(key%)
  11793.  P$,S$,RP$,RS$,addr,top,RP%,RS%,count%,examined%,file%
  11794. abort_dup:
  11795. YTextName$=$database%+".PrintJobs.Dupl"+
  11796. Index$(key%),5)+
  11797. (file%):$SaveName%=TextName$
  11798. read_print_options
  11799. Breportdest$="Window":format$="dup":Count%=0:LenLine%=KL%(0)+23
  11800. <textblocksize%=100*LenLine%:textblockinc%=textblocksize%
  11801. extend_named_sliding_block(textanchor%,textblocksize%)
  11802. extend_named_sliding_block(lineanchor%,LenLine%+4)
  11803. TextPtr%=!textanchor%
  11804. recblocksize%=400
  11805. extend_named_sliding_block(recanchor%,recblocksize%)
  11806. rule_off(32)
  11807. #!Yline$=" Duplicated keys":$(!lineanchor%)=line$:
  11808. list_line(-1,lineanchor%,
  11809. (line$),32)
  11810.  "Hourglass_On"
  11811.  file%=0 
  11812. rule_off(45)
  11813. #%]  line$=" "+$Subfile%(file%):$(!lineanchor%)=line$:
  11814. list_line(-1,lineanchor%,
  11815. (line$),32)
  11816. rule_off(32)
  11817.   top=8*file%+LH%
  11818. #(!  addr=
  11819. neighbour(key%,top,1)
  11820. #)0  count%=
  11821. count_recs(key%,zero%):examined%=0
  11822.  addr<>top
  11823.  "OS_Byte",229,0
  11824. #,P    S$=$(!keyanchor%(key%)+addr+8):RS%=!(!keyanchor%(key%)+addr+9+KL%(key%))
  11825. #-=    RS$=
  11826. (RS%):RS$=" Record No."+
  11827. (RS$)," ")+RS$+"   "
  11828.  S$=P$ 
  11829.       line$=RP$+P$
  11830. #0G      $(!lineanchor%)=line$:
  11831. list_line(RP%,lineanchor%,
  11832. (line$),32)
  11833.       line$=RS$+S$
  11834. #2G      $(!lineanchor%)=line$:
  11835. list_line(RS%,lineanchor%,
  11836. (line$),32)
  11837. #3        
  11838.     P$=S$:RP%=RS%:RP$=RS$
  11839.     examined%+=1
  11840. #68    
  11841.  "Hourglass_Percentage",examined%*100 
  11842.  count%
  11843. #7$    addr=
  11844. neighbour(key%,addr,1)
  11845.  file%
  11846. rule_off(32)
  11847.  "Hourglass_Off"
  11848. screen_list
  11849. abort_dup
  11850.  "Hourglass_Off"
  11851. screen_list
  11852. softerror("",67)
  11853. wimp_error(
  11854.  >RAMtree
  11855.  Index handling ------------------------------------------------------
  11856. neighbour(key%,addr%,d%)
  11857.  R%,S%,p%,keybase%
  11858. keybase%=!keyanchor%(key%)
  11859. p%=d%*4
  11860. R%=!(keybase%+addr%+p%)
  11861.  R%<0 
  11862.  =-R%
  11863. p%=4-p%
  11864.   addr%=R%
  11865.   S%=!(keybase%+addr%+p%)
  11866.  S%>0 
  11867.  R%=S%
  11868.  S%<=0
  11869. rec_no(
  11870.  k$,key%,addr%)
  11871. #\#k$=$(!keyanchor%(key%)+addr%+8)
  11872. #]-=!(!keyanchor%(key%)+addr%+8+KL%(key%)+1)
  11873. scan_file(c$,key%,file%,action%,direc%)
  11874.  REC%,examined%,subtotal%,X%,Y%,n$,copy%,I%
  11875. n$="0123456789."
  11876. #b%subtotal%=
  11877. count_recs(key%,zero%)
  11878. (c$)=
  11879.  "OS_Byte",229,0
  11880.   REC%=
  11881. rec_no(k$,key%,P%)
  11882. #f%  
  11883. readsmarray(dbasehandle%,REC%)
  11884.   examined%+=1
  11885. (Search$)=
  11886.  action% 
  11887.       
  11888. get_lengths
  11889.       
  11890.       
  11891.  format$="label" 
  11892. #m"        
  11893.  copy%=1 
  11894.  labcopies%
  11895. #n$          
  11896. print_record(REC%,P%)
  11897.         
  11898.  copy%
  11899. #p$        
  11900. print_record(REC%,P%)
  11901.       
  11902. #r/      
  11903.  2:ptr%?REC%=file%:
  11904.  ### earmark ###
  11905. #s?      
  11906. write_csv_rec(REC%,Form$,csvhandle%):
  11907. poll:
  11908. #t9      
  11909.  4:KEY$=
  11910. key2(newkey%,1):
  11911. insert(KEY$,newkey%)
  11912. #u       
  11913.  ### create index ###
  11914.       
  11915.       S$=F$(Fieldnumber%)
  11916.       
  11917. #yC        
  11918. New$,$ws%)>0:S$=
  11919. wildcard_replace(S$,Old$,New$,$ws%)
  11920. #zC        
  11921. New$,$wc%)>0:S$=
  11922. wildcard_replace(S$,Old$,New$,$wc%)
  11923.         
  11924.  numeric%:
  11925.         X%=0:Y%=0
  11926.         
  11927.  X%+=1
  11928. #~)        
  11929. (S$) 
  11930. S$,X%,1))>0
  11931.         
  11932.  X%<=
  11933. (S$) 
  11934.           Y%=X%
  11935.           
  11936.  Y%+=1
  11937. +          
  11938. (S$) 
  11939. S$,Y%,1))=0
  11940.         
  11941. 9        S$=
  11942. S$,X%-1)+
  11943. S$,X%,Y%-X%)+New$))+
  11944. S$,Y%)
  11945. *        
  11946.  Old$<>"":
  11947.  S$=Old$ 
  11948.  S$=New$
  11949.         
  11950. :S$=New$
  11951.       
  11952.       
  11953. (S$)>TextLength% 
  11954.         
  11955. softerror("",10)
  11956.         
  11957.         F$(Fieldnumber%)=S$
  11958. ,        
  11959. writesmarray(dbasehandle%,REC%)
  11960.       
  11961. !      
  11962.  ### global change ###
  11963.       
  11964.       
  11965.  I%=1 
  11966.  fields%
  11967.         $Rf%(I%)=F$(I%)
  11968.       
  11969. ?      
  11970. update_calcs(0) 
  11971. writesmarray(dbasehandle%,REC%)
  11972. :      
  11973.  ### update time-dependent calcs on opening ###
  11974.         
  11975. #  P%=
  11976. neighbour(key%,P%,direc%)
  11977.  "Hourglass_Percentage",(examined%*100) 
  11978.  subtotal%
  11979. wildcard_replace(S$,Old$,New$,type$)
  11980.  old$,new$,old2$,new2$,c$,L%,P%,R%
  11981.  type$ 
  11982.  $ws%:
  11983. D    
  11984. Old$,1)=$ws% 
  11985. New$,1)=$ws% 
  11986. Old$)=$ws% 
  11987. New$)=$ws%:
  11988. '    old$=
  11989. Old$,2)):new$=
  11990. New$,2))
  11991.     P%=
  11992. S$,old$)
  11993. 2    
  11994.  P%>0 
  11995. S$,P%-1)+new$+
  11996. S$,P%+
  11997. (old$))
  11998. (    
  11999. Old$,1)=$ws% 
  12000. New$,1)=$ws%:
  12001. /    old$=
  12002. Old$,2):new$=
  12003. New$,2)::R%=
  12004. (old$)
  12005. .    
  12006. S$,R%)=old$ 
  12007. (S$)-R%)+new$
  12008. $    
  12009. Old$)=$ws% 
  12010. New$)=$ws%:
  12011. *    old$=
  12012. Old$):new$=
  12013. New$):L%=
  12014. (old$)
  12015. *    
  12016. S$,L%)=old$ 
  12017.  S$=new$+
  12018. S$,L%+1)
  12019. (    
  12020. Old$,$ws%)>0 
  12021. New$,$ws%)>0:
  12022. P    P%=
  12023. Old$,$ws%):old$=
  12024. Old$,P%-1):L%=
  12025. (old$):old2$=
  12026. Old$,P%+1):R%=
  12027. (old2$)
  12028. 9    P%=
  12029. New$,$ws%):new$=
  12030. New$,P%-1):new2$=
  12031. New$,P%+1)
  12032. *    
  12033. S$,L%)=old$ 
  12034.  S$=new$+
  12035. S$,L%+1)
  12036. 0    
  12037. S$,R%)=old2$ 
  12038. (S$)-R%)+new2$
  12039.  $wc%:
  12040. (Old$)=
  12041. (New$) 
  12042.  P%=1 
  12043. (Old$)
  12044.       c$=
  12045. Old$,P%,1)
  12046. ;      
  12047.  c$<>$wc% 
  12048. S$,P%,1) 
  12049. S$,P%,1)=
  12050. New$,P%,1)
  12051. search(S$,key%,M%)
  12052.  P%,found%,info$,keybase%,rec%,cond$
  12053. keybase%=!keyanchor%(key%)
  12054. Z%=0:P%=top:ident%=
  12055.   L%=P%
  12056.   P%=!(keybase%+L%+Z%)
  12057.  P%<=0 
  12058.  P%=-L%:found%=
  12059.   info$=$(keybase%+P%+8)
  12060.   rec%=
  12061. rec_no(k$,key%,P%)
  12062. (val$+"(S$)="+val$+"LEFT$(info$,kl%)") 
  12063.       
  12064.  0:ident%=(key%=0)
  12065.       
  12066.  1,3:found%=
  12067. $      
  12068.  rec%=REC% 
  12069.  found%=
  12070.         
  12071.  found% 
  12072.  Z%=-
  12073. (val$+"(S$)>="+val$+"(info$)")*4
  12074.  found%
  12075.  ### M%=0 - Find leaf position at which to insert ###
  12076.  ### M%=1 - Find first match in tree (if there is one) ###
  12077.  ### M%=2 - Find exact matching record, checking for record no. ###
  12078. insert(
  12079.  S$,key%)
  12080.  P%,avail%,kl%,keybase%,abort%
  12081.  S$="" 
  12082.  null%(key%)=
  12083. keybase%=!keyanchor%(key%)
  12084. "kl%=KL%(key%):val$=
  12085. type(key%)
  12086. search(S$,key%,0)
  12087.  ident% 
  12088. !    
  12089. selected(passW%,15):
  12090. "    
  12091. softerror(S$,37):abort%=
  12092. T    
  12093. selected(prefsW%,34) 
  12094. confirm(
  12095. msg("Err45")+" ("+S$+")") 
  12096.  abort%=
  12097.  abort% 
  12098.  S$="*Failed*":
  12099. nextfree%=!keybase%
  12100.  !(keybase%+nextfree%)<=0 
  12101.   incr%=
  12102. ($Increment%)
  12103.  incr%>0 
  12104. #    
  12105. change_length(RA%+incr%,
  12106.  S$="*Failed*"
  12107.  S$="*Failed*" 
  12108. softerror("",2):
  12109.  avail%=!(keybase%+nextfree%)
  12110. .!(keybase%+nextfree%+Z%)=!(keybase%+P%+Z%)
  12111. $!(keybase%+nextfree%+(4-Z%))=-P%
  12112. $(keybase%+nextfree%+8)=S$
  12113. ,!(keybase%+nextfree%+8+KL%(key%)+1)=REC%
  12114. !(keybase%+P%+Z%)=nextfree%
  12115. !keybase%=avail%
  12116.  key%=0 
  12117.  RU%+=1
  12118. delete(
  12119.  S$,key%)
  12120.  P%,A%,kl%,keybase%
  12121.  S$="" 
  12122.  null%(key%)=
  12123. keybase%=!keyanchor%(key%)
  12124. A%=!keybase%
  12125. "kl%=KL%(key%):val$=
  12126. type(key%)
  12127. search(S$,key%,2)
  12128.  P%<0 
  12129. softerror(S$+","+Index$(key%),1):S$="*Failed*":
  12130. neighbour(key%,P%,0)
  12131. neighbour(key%,P%,1)
  12132. '!(keybase%+L%+Z%)=!(keybase%+P%+Z%)
  12133.     Q%=P%
  12134. ZL%=4-Z%
  12135. P1%=!(keybase%+P%+ZL%)
  12136.  P1%>0 
  12137.   info$=$(keybase%+P1%+8)
  12138.   P%=-
  12139. search(info$,key%,0)
  12140.   !(keybase%+P%+Z%)=P1%
  12141.  !(keybase%+PR%+4)<=0 
  12142.  !(keybase%+PR%+4)=-SU%
  12143.  !(keybase%+SU%+0)<=0 
  12144.  !(keybase%+SU%+0)=-PR%
  12145. !(keybase%+Q%)=A%
  12146. !keybase%=Q%
  12147.  key%=0 
  12148.  RU%-=1
  12149. save_keys
  12150.  keyN%
  12151.  present%<>7 
  12152.  "Hourglass_On"
  12153. 5keybase%=!keyanchor%(0):keybase%!4=
  12154. ($Increment%)
  12155.  !keyanchor%(keyN%)>0
  12156. !  keybase%=!keyanchor%(keyN%)
  12157.  "SlidingHeap_DescribeBlock",slidingheapbase%,keyanchor%(keyN%) 
  12158.  ,,filelength%
  12159.  keyN%=0 
  12160.     index$=""
  12161.  index$="Indices."
  12162.  "OS_File",10,$database%+"."+index$+Index$(keyN%),&7F0,,keybase%,keybase%+filelength%
  12163.   keyN%+=1
  12164.  "Hourglass_Percentage",keyN%*100 
  12165.  (Keys%+1)
  12166.  "Hourglass_Off"
  12167. readsmarray(filehandle%,REC%)
  12168.  loop%
  12169. #filehandle%=REC%*Length%
  12170.  loop%=1 
  12171.  fields%
  12172.   F$(loop%)=
  12173. #filehandle%
  12174.  loop%
  12175. writesmarray(F,
  12176.  loop%,F$,L%
  12177. #F=R%*Length%
  12178.  loop%=1 
  12179.  fields%
  12180. $0!  F$=F$(loop%):L%=len%(loop%)
  12181. $1)  
  12182. (F$)<=L% 
  12183. #F,F$ 
  12184. L%,"!")
  12185.  loop%
  12186. $3    R%+=1
  12187. check_save(T%)
  12188.  time%
  12189.  T%=0 
  12190.  "OS_ReadMonotonicTime" 
  12191.  time%
  12192.  (time% 
  12193.  T%)<10 
  12194.  buttonfield%(0,19)>0 
  12195.  wi%=mainW%:ic%=field%(buttonfield%(0,19)) 
  12196.  wi%=keypadW%:ic%=19
  12197.  autosave% 
  12198.     delay%=
  12199.  loop%=0 
  12200.       
  12201. invert(wi%,ic%)
  12202.       delay%+=50
  12203.       
  12204. >delay%
  12205.       
  12206.  1,-15,180,5
  12207.       
  12208. invert(wi%,ic%)
  12209.       delay%+=50
  12210.       
  12211. >delay%
  12212.  loop%
  12213. invert(wi%,ic%)
  12214. mouse(0,0,4,wi%,ic%)
  12215. invert(wi%,ic%)
  12216.  Calculations ---------------------------------------------------------
  12217. calc_link(T$,type%)
  12218.  ### Sets up calculation formula window & menu entry ###
  12219. $CalcFunc%=T$
  12220.  I%=1 
  12221.   T$=
  12222. $X)$CalcTitle%=T$:calclink%=Fieldnumber%
  12223. split_link(calclink%,real$,visible$)
  12224.  type% 
  12225. $[3  
  12226.  6,7:$CalcForm%=Tag$(calclink%)+"="+visible$
  12227.   $CalcForm%=visible$
  12228. $^!  
  12229. icon_bit(22,calcW%,2,off%)
  12230. deselect(calcW%,2)
  12231. calc_formula(S$)
  12232.  ### Parses calculation formula (S$) & builds calc$(I%) ###
  12233.  I%,P%,t$,s$,C$,time%,user%
  12234.  ic% 
  12235. close_window(wi%)
  12236. $i1  C$=
  12237. ~(calclink%):
  12238.  calclink%<16 
  12239.  C$="0"+C$
  12240. $j%  
  12241.  $CalcFunc%="Set base value" 
  12242.  S$="" 
  12243.  S$="0"
  12244. $l"    calc$(calclink%)=S$+"|"+S$
  12245.     calc$(0)="LOADED"
  12246. $n        
  12247. $o,    P%=
  12248. S$,"="):S$=
  12249. S$,P%+1):visible$=S$
  12250.  I%=fields% 
  12251.       t$=Tag$(I%)
  12252.       
  12253.  t$<>"" 
  12254.         P%=0
  12255.         
  12256. $u'          user%=(
  12257. S$,"FNU",P%+1)>0)
  12258.           P%=
  12259. S$,t$,P%+1)
  12260.           
  12261.  P%>0 
  12262. $x"            
  12263.  chartype%(I%) 
  12264. $ya              
  12265.  3,6,46,47,54,56,57:
  12266.  user% 
  12267.  s$="$Rf%("+
  12268. (I%)+")" 
  12269.  s$="VAL($Rf%("+
  12270. (I%)+"))"
  12271. $z?              
  12272.  8:s$="FNseconds($Rf%("+
  12273. (I%)+"),1)":time%=
  12274.               
  12275. $|+              
  12276.  chartype%(calclink%) 
  12277. $}L                
  12278.  user% 
  12279.  s$="$Rf%("+
  12280. (I%)+")" 
  12281.  s$="FNn("+
  12282. (I%)+")"
  12283. $~,                
  12284.  7:s$="$Rf%("+
  12285. (I%)+")"
  12286.               
  12287.             
  12288. -            S$=
  12289. S$,P%-1)+s$+
  12290. S$,P%+
  12291. (t$))
  12292.             update$(I%)+=C$
  12293.           
  12294.         
  12295.  P%=0
  12296.       
  12297. /    
  12298. visible$,"TIME$")>0 
  12299.  update$(0)+=C$
  12300. @    
  12301.  time%=
  12302.  chartype%(calclink%)=7 
  12303.  S$="FNtime("+S$+")"
  12304. #    
  12305. (S$)+
  12306. (visible$)+2<256 
  12307. .      calc$(calclink%)="#"+S$+"#"+visible$
  12308.       calc$(0)="LOADED"
  12309. 9      
  12310. selected(calcW%,2) 
  12311. recalculate(calclink%)
  12312.       
  12313. softerror("",44)
  12314.         
  12315.   calclink%=0
  12316. asterisk(
  12317.  (b% 
  12318.  %111)=4 
  12319. close_window(wi%)
  12320. recalculate(F%)
  12321.  F,I%,R%,k$,P%,real$,visible$,subtotal%,zero%,examined%
  12322. softerror(real$,73):
  12323. split_link(F%,real$,visible$)
  12324. confirm("Recalculate "+Tag$(F%)+"="+visible$+" for existing records?")=
  12325. %subtotal%=
  12326. count_recs(key%,zero%)
  12327.  "Hourglass_On"
  12328. *dbasehandle%=
  12329. ($database%+".Database")
  12330. neighbour(key%,top,1)
  12331.  P%<>top
  12332.   R%=
  12333. rec_no(k$,key%,P%)
  12334. readsmarray(dbasehandle%,R%)
  12335.  I%=1 
  12336.  fields%
  12337. -    
  12338.  chartype%(I%)<>40 
  12339.  $Rf%(I%)=F$(I%)
  12340.  chartype%(F%) 
  12341.     F=
  12342. (real$):F$=
  12343. +    
  12344.  fix%(F%)>0 
  12345. fix_point(F$,F%)
  12346.  7:F$=
  12347. (real$)
  12348. (F$)<=len%(F%) 
  12349.  F$(F%)=F$
  12350. writesmarray(dbasehandle%,R%)
  12351.   P%=
  12352. neighbour(key%,P%,1)
  12353.   examined%+=1
  12354.  "Hourglass_Percentage",examined%*100 
  12355.  subtotal%
  12356.  "Hourglass_Off"
  12357. close_file(dbasehandle%)
  12358.  I%=1 
  12359.  fields%
  12360.  chartype%(I%)<>40 
  12361.  $Rf%(I%)=field$(I%)
  12362. display(key%,addr)
  12363. asterisk(
  12364. save_calcs
  12365.  calc$(0)="LOADED" 
  12366.   cl=
  12367. ($database%+".Calc")
  12368.  F%=1 
  12369.  fields%
  12370. #cl,calc$(F%)
  12371. close_file(cl)
  12372. sums(
  12373.  F$,F%,type%)
  12374.  F$<>"" 
  12375.  type% 
  12376.  8:V=
  12377. seconds(F$,1)
  12378.   Sum(F%,0)+=1
  12379.   Sum(F%,1)+=V
  12380.   Sum(F%,3)+=V*V
  12381.  V>Sum(F%,4) 
  12382.  Sum(F%,4)=V
  12383.  V<Sum(F%,5) 
  12384.  Sum(F%,5)=V
  12385. ctotals(flag%)
  12386.  F%,I%,J%,N%,R%,S%,base%,pos%,F$
  12387.  S$(),f%()
  12388.  S$(5),f%(5)
  12389. base%=!lineanchor%
  12390. 3S$()="Items","Sum","Mean","St.Dev.","Max","Min"
  12391.  I%=1 
  12392. (Form$)-1 
  12393.   F%=
  12394. fnum(
  12395. Form$,I%,2))
  12396.   R%=calcrow%?F%
  12397.  chartype%(F%) 
  12398.  3,6,8,46,47,54,56,57:
  12399.  Sum(R%,0)>0 
  12400. '      Sum(R%,2)=Sum(R%,1)/Sum(R%,0)
  12401. 6      Sum(R%,3)=
  12402. (Sum(R%,3)/Sum(R%,0)-Sum(R%,2)^2)
  12403.         
  12404. '    
  12405.  Sum(R%,5)=10^30 
  12406.  Sum(R%,5)=0
  12407.  J%=0 
  12408.   pos%=base%
  12409.  flag%>0 
  12410. >    N%=0:start%=1:F$=
  12411. Lmargin%-
  12412. (S$(J%))-1," ")+S$(J%)+" "
  12413.  N%=1:start%=3
  12414. &    L%=Tab%(1)-Lmargin%-
  12415. (spacer$)
  12416. N    
  12417.  L%>=7 
  12418.  F$=margin$+
  12419. tab(S$(J%),N%) 
  12420.  F$=margin$+
  12421. S$(J%),L%),N%)
  12422. heap_store(lineanchor%,LenLine%,0,pos%,0,F$)
  12423. (Form$)>2 
  12424.  start%=1 
  12425. $    
  12426.  I%=start% 
  12427. (Form$)-1 
  12428. &      F%=
  12429. fnum(
  12430. Form$,I%,2)):F$=""
  12431.       N%+=1
  12432.       
  12433.  chartype%(F%) 
  12434. #        
  12435.  3,6,8,46,47,54,56,57:
  12436.         R%=calcrow%?F%
  12437. Q        
  12438.  chartype%(F%)=8 
  12439.  result$=
  12440. time(Sum(R%,J%)) 
  12441.  result$=
  12442. (Sum(R%,J%))
  12443. T        
  12444. selected(pselectW%,R%*8+2+J%) 
  12445. justify(result$,N%,N%-1):f%(J%)=1
  12446.       
  12447. @      
  12448. heap_store(lineanchor%,LenLine%,0,pos%,0,
  12449. tab(F$,N%))
  12450. =    
  12451.  f%(J%)=1 
  12452. list_line(-1,lineanchor%,pos%-base%,32)
  12453. (f%())>0 
  12454. rule_off(45)
  12455. margin_warn
  12456.  f%,F%,R%,J%
  12457. fnum(
  12458. Form$,2))
  12459.  chartype%(F%) 
  12460.  3,6,8,46,47,54,56,57:
  12461.   R%=calcrow%?F%
  12462.  J%=0 
  12463. %    0    
  12464. selected(pselectW%,R%*8+2+J%) 
  12465.  f%=F%
  12466.  f%>0 
  12467.  Lmargin%<9 
  12468. softerror(Tag$(f%),92):=-1
  12469. tab(F$,N%)
  12470. (F$)+
  12471. (spacer$)
  12472.  Tab%(N%)-Tab%(N%-1)-L%<=0 
  12473. =F$+spacer$
  12474. ,=F$+
  12475. Tab%(N%)-Tab%(N%-1)-L%," ")+spacer$
  12476. justify(f$,x%,x1%)
  12477. $L%=Tab%(x%)-Tab%(x1%)-
  12478. (spacer$)
  12479. (f$)>L% 
  12480.   f$=
  12481. f$,L%)
  12482. (f$)," ")+f$
  12483. f$)="." 
  12484.  f$=" "+
  12485. execute_script(f$)
  12486.  F,P%,name$,command$,finished%,firstquery%,state%
  12487. confirm(
  12488. msg("Err68,"+
  12489. leaf(f$))) 
  12490. selected(printW%,39) 
  12491.  reportdest$="File" 
  12492.  reportdest$="Window"
  12493.  Script file signature
  12494. junk$=
  12495. abort_script:
  12496.  finished%)
  12497.  "OS_Byte",229,0
  12498.   line$=
  12499.   space%=
  12500. line$," ")
  12501. %,w  
  12502.  space%=0 
  12503.  command$=line$:params$="" 
  12504.  command$=
  12505. line$,space%-1):params$=
  12506. line$,space%+1):state%=(params$="ON")
  12507.  command$ 
  12508.  "!COMMENT":
  12509.  "!SCRIPT":
  12510.     ImpCom$=""
  12511.  params$="END" 
  12512.       finished%=
  12513. %3<      
  12514. execute_script($database%+".PrintRes."+params$)
  12515. %4        
  12516.  "!DELETE":
  12517.  present%=7 
  12518.       RecF%=
  12519. %80      
  12520.  params$="" 
  12521.  key$=
  12522.  key$=params$
  12523. %93      
  12524. select(searchW%,6):
  12525. deselect(searchW%,5)
  12526. %:       addr=
  12527. find(key$,0,0,
  12528.       
  12529.  RecF%=
  12530.         addr=
  12531. shift(0,0,0)
  12532. %=$        addr=
  12533. moveto(key%,top,1)
  12534.       
  12535. %?        
  12536.  "!INSERT":
  12537.  present%=7 
  12538. %B0      subfile%=
  12539. (params$):top=8*subfile%+LH%
  12540.       
  12541. make_new_rec
  12542.       
  12543.  loop%=1 
  12544.  fields%
  12545. %E)        $Rf%(loop%)=
  12546. #F,len%(loop%))
  12547.       
  12548.       
  12549. write(fields%,key%)
  12550.       top=8*file%+LH%
  12551.       
  12552. asterisk(
  12553. %J        
  12554.  "!QUERY":
  12555.  params$<>"" 
  12556.       P%=
  12557. params$,",")
  12558. %N5      $Query%=
  12559. params$,P%+1):name$=
  12560. params$,P%-1)
  12561. %O0      f$=$database%+".PrintJobs."+
  12562. name$,10)
  12563.       Search$=
  12564. parse
  12565.       
  12566.  "Hourglass_On"
  12567.       
  12568.  reportdest$ 
  12569. %S#        
  12570.  "Window":TextName$=f$
  12571. %T&        
  12572.  "File":texthandle%=
  12573.         
  12574.  ImpCom$<>"" 
  12575.           
  12576. %W-            
  12577.  firstquery%=
  12578. :firstquery%=
  12579. %X'            
  12580. #texthandle%,ImpCom$
  12581.           
  12582.         
  12583.       
  12584.       
  12585. do_it(Search$,-1)
  12586. %]        
  12587.  "!CSV":
  12588.     P%=
  12589. params$,",")
  12590. %`3    $Query%=
  12591. params$,P%+1):name$=
  12592. params$,P%-1)
  12593. %a.    f$=$database%+".PrintJobs."+
  12594. name$,10)
  12595. write_csv(f$)
  12596.  "!SELECTION":
  12597.  params$<>"" 
  12598. %e3      filename$=$database%+".PrintRes."+params$
  12599. %f-      
  12600.  "OS_File",5,filename$ 
  12601.  ,,ftype%
  12602. %g#      ftype%=(ftype%>>8) 
  12603.  &FFF
  12604. %h4      
  12605.  ftype%=&7F3 
  12606. load_selection(filename$)
  12607.       
  12608. clear_selection
  12609. %j        
  12610.  "!PRINTOPTS":
  12611.  params$<>"" 
  12612. %m3      filename$=$database%+".PrintRes."+params$
  12613. %n-      
  12614.  "OS_File",5,filename$ 
  12615.  ,,ftype%
  12616. %o#      ftype%=(ftype%>>8) 
  12617.  &FFF
  12618. %p9      
  12619.  ftype%=&7F5 
  12620. get_options(printW%,filename$)
  12621. %qD      
  12622. get_options(printW%,"<Pbase$Dir>.Resources.PrtOptions")
  12623. %r        
  12624. %s-    
  12625.  "!CASE":
  12626. set_icon(queryW%,1,state%)
  12627. %t0    
  12628.  "!EXPAND":
  12629. set_icon(printW%,11,state%)
  12630. %u.    
  12631.  "!DATE":
  12632. set_icon(printW%,19,state%)
  12633. %v/    
  12634.  "!UPPER":
  12635. set_icon(printW%,12,state%)
  12636. %w0    
  12637.  "!HEADER":
  12638. set_icon(printW%,47,state%)
  12639. %x0    
  12640.  "!FOOTER":
  12641. set_icon(printW%,48,state%)
  12642. %y/    
  12643.  "!FIRST":
  12644. set_icon(printW%,10,state%)
  12645. %z3    
  12646.  "!UNDERLINE":
  12647. set_icon(printW%,29,state%)
  12648. %{0    
  12649.  "!SHRINK":
  12650. set_icon(printW%,40,state%)
  12651. %|1    
  12652.  "!CONTROL":
  12653. set_icon(printW%,42,state%)
  12654. %}-    
  12655.  "!TITLE":$
  12656. text(printW%,18)=params$
  12657. %~,    
  12658.  "!PAGE":$
  12659. text(printW%,16)=params$
  12660. 1    
  12661.  "!LINESPACE":$
  12662. text(printW%,17)=params$
  12663. /    
  12664.  "!LMARGIN":$
  12665. text(printW%,30)=params$
  12666. /    
  12667.  "!TMARGIN":$
  12668. text(printW%,32)=params$
  12669. .    
  12670.  "!SPACER":$
  12671. text(printW%,43)=params$
  12672. 0    
  12673.  "!COLWIDTH":$
  12674. text(printW%,45)=params$
  12675. 1    
  12676.  "!TEXTWIDTH":$
  12677. text(printW%,34)=params$
  12678.  "!HEADINGS":
  12679. u(params$) 
  12680. 7      
  12681.  "D":
  12682. select(printW%,2):
  12683. deselect(printW%,1)
  12684. 3      
  12685. select(printW%,1):
  12686. deselect(printW%,2)
  12687.         
  12688.  "!PITCH":
  12689. 3    
  12690. deselect(printW%,
  12691. selected_esg(printW%,2))
  12692. (params$) 
  12693.        
  12694. select(printW%,4)
  12695. !      
  12696. select(printW%,7)
  12697. !      
  12698. select(printW%,8)
  12699.       
  12700. select(printW%,6)
  12701.         
  12702.  "!FORMAT":
  12703. 3    
  12704. deselect(printW%,
  12705. selected_esg(printW%,3))
  12706. "    
  12707. icon_bit(22,printW%,15,
  12708. Q    P%=
  12709. params$," "):
  12710.  P%>0 
  12711.  cols$=
  12712. params$,P%+1):params$=
  12713. params$,P%-1))
  12714.  params$ 
  12715. *      
  12716.  "VERTICAL":
  12717. select(printW%,24)
  12718. '      
  12719.  "TABLE":
  12720. select(printW%,25)
  12721. "      $
  12722. text(printW%,15)=cols$
  12723. $      
  12724. icon_bit(22,printW%,15,
  12725. '      
  12726.  "LABEL":
  12727. select(printW%,26)
  12728.       
  12729. select(printW%,23)
  12730.         
  12731.  "!DESTINATION":
  12732. 3    
  12733. deselect(printW%,
  12734. selected_esg(printW%,4))
  12735.     params$=
  12736. u(params$)
  12737.  params$ 
  12738. 9      
  12739.  "FILE":
  12740. select(printW%,39):reportdest$="File"
  12741. ?      
  12742.  "PRINTER":
  12743. select(printW%,41):reportdest$="Printer"
  12744.       
  12745. 2      
  12746. select(printW%,38):reportdest$="Window"
  12747. 8      TextName$=$database%+".PrintJobs."+
  12748. query$,10)
  12749.         
  12750.  "!LABEL":
  12751.     params$+=","
  12752.  I%=1 
  12753.       P%=
  12754. params$,",")
  12755. 4      par$=
  12756. params$,P%-1):params$=
  12757. params$,P%+1)
  12758.       
  12759.         
  12760. 7        
  12761. deselect(labelW%,
  12762. selected_esg(labelW%,1))
  12763.         
  12764.  par$ 
  12765. &          
  12766.  "1":
  12767. select(labelW%,0)
  12768. &          
  12769.  "2":
  12770. select(labelW%,1)
  12771. "          
  12772. select(labelW%,2)
  12773.         
  12774. &        
  12775. text(labelW%,4)=par$
  12776. &        
  12777. text(labelW%,6)=par$
  12778. '        
  12779. text(labelW%,10)=par$
  12780. '        
  12781. text(labelW%,12)=par$
  12782. '        
  12783. text(labelW%,17)=par$
  12784. ,        
  12785. set_icon(labelW%,11,(par$<>""))
  12786. :        
  12787. icon_bit(22,labelW%,12,
  12788. selected(labelW%,11))
  12789. 5        
  12790. set_icon(labelW%,13,(
  12791. u(par$)="ON"))
  12792. 5        
  12793. set_icon(labelW%,16,(
  12794. u(par$)="ON"))
  12795.       
  12796.  "!IMPRESSION":
  12797.     P%=
  12798. params$," ")
  12799.  P%>0 
  12800. =      ImpCom$=
  12801. params$,P%-1):modifier$=
  12802. params$,P%+1))
  12803.       
  12804.  modifier$ 
  12805. '        
  12806.  "NOT FIRST":firstquery%=
  12807.       
  12808.       
  12809.  ImpCom$=params$
  12810.         
  12811.         
  12812. softerror(command$,46)
  12813.     finished%=
  12814.  "Hourglass_Smash"
  12815. close_file(F)
  12816. abort_script
  12817. close_file(F)
  12818. softerror("",57)
  12819. wimp_error(
  12820.  "Impulse" handling -----------------------------------------------
  12821. Impulse_command_received(token%,params%,object%)
  12822. 4param$=
  12823. getstr(params%):object$=
  12824. getstr(object%)
  12825.  object$="" 
  12826.  object$=
  12827. leaf($database%)
  12828.  token% 
  12829.  ### GetPathname. Returns full pathname of object ###
  12830. leaf($database%) 
  12831.  object$:
  12832. <    
  12833.  "Impulse_SendMessage",&202,$database%,,,,,mytask%
  12834.  "No data":
  12835. D    
  12836.  "Impulse_SendMessage",&202,"No database open",,,,,mytask%
  12837. T    
  12838.  "Impulse_SendMessage",&202,"Current database is not "+object$,,,,,mytask%
  12839.  ### Selection. Returns maximum data length ###
  12840.   ClientSep$=
  12841. param$,1)
  12842. ?  ClientForm$=
  12843. find_fields(param$,ClientSep$,ClientLength%)
  12844. extend_named_sliding_block(transanchor%,ClientLength%+1)
  12845.  "Impulse_SendMessage",&202,
  12846. (ClientLength%),,,,,mytask%
  12847.  ### ParseQuery. Returns title generated by FNparse ###
  12848. )  $Query%=param$:ClientSearch$=
  12849. parse
  12850.  "Impulse_SendMessage",&202,Title$,,,,,mytask%
  12851.  ### GetRecord. Returns data specified in Selection according to criteria specified in ParseQuery ###
  12852. <  datalength%=
  12853. prepare_next_record(param$,!transanchor%)
  12854.  "Impulse_SendMessage",&202,"Ready to receive?",-1,,,transtag%,mytask%,Length%
  12855.  ### PutRecord ###
  12856.  "Impulse_SendMessage",&201,"GetRecord",,,,getrec%,mytask%
  12857.  ### ExpandCode ###
  12858.   P%=
  12859. param$," ")
  12860. .  code$=
  12861. param$,P%-1):table$=
  12862. param$,P%+1)
  12863.  "Impulse_SendMessage",&202,
  12864. expand(code$,table$,L%,SF$),,,,,mytask%
  12865.  7,8:
  12866.  ### GetField, GetExpanded ###
  12867.  params%<>-1 
  12868. D    datalength%=
  12869. prepare_next_field(token%,param$,!transanchor%)
  12870. \    
  12871.  "Impulse_SendMessage",&202,"Ready to receive?",-1,,,transtag%,mytask%,datalength%
  12872. :    
  12873.  ### Max. length for a Powerbase field is 246 ###
  12874.  ### NextMatch ###
  12875. move_on_and_continue(key%)
  12876. move_on_and_continue(key%)
  12877.  S$,J%
  12878. &    @ClientPtr%=
  12879. next_match(ClientPtr%,1,ClientSearch$,finished%)
  12880.  finished% 
  12881.  F$()="":
  12882.  J%=0 
  12883.   S$+=F$(KF%(key%,J%))+" "
  12884. text(mergeW%,11)=
  12885. S$,80):
  12886. redraw_icon(mergeW%,11)
  12887. Impulse_reply(replytag%,reply%)
  12888. abort_merge:
  12889. reply$=
  12890. getstr(reply%)
  12891.  replytag% 
  12892.  getrec%:
  12893.  ### Reply to GetRecord command. ###
  12894.  "Impulse_FetchData",!transanchor%,Length%,,,,,mytask%
  12895.  mergetag%:
  12896.  ### Merging application replies when all data in document merged ###
  12897. selected(mergeW%,5) 
  12898.  "Impulse_SendMessage",&201,":"+$mergewith%+"."+document$+" Print",,,,printtag%,mytask%
  12899.  printtag%:
  12900.  ### Merging application has printed the current document ###
  12901.  "OS_Byte",229,0
  12902. 2  mergenum%+=1:$
  12903. text(mergeW%,12)=
  12904. (mergenum%)
  12905. redraw_icon(mergeW%,12)
  12906. &!0  
  12907. selected(mergeW%,5) 
  12908.  ClientPtr%<>top 
  12909. &",    ClientPtr%=
  12910. merge_next(ClientPtr%,1)
  12911. deselect(mergeW%,5)
  12912. abort_merge
  12913. close_file(dbasehandle%)
  12914. ClientPtr%=top
  12915. deselect(mergeW%,5)
  12916. close_it(mergeW%)
  12917. softerror("",27)
  12918. wimp_error(
  12919. Impulse_send(tag%,maxsize%)
  12920.  "Impulse_TransmitData",!transanchor%,datalength%,,,,,mytask%
  12921. datalength%=0
  12922. Impulse_receive(replytag%,expected%,received%)
  12923.  I%,F%,P%
  12924. transbuff%=!transanchor%
  12925. transbuff%?received%=13
  12926. data$=$transbuff%
  12927.  ### Acknowledge data received (get reason code 19 otherwise!) ###
  12928.  "Impulse_SendMessage",&202,,,,,replytag%,mytask%
  12929.  data$<>"" 
  12930.   P%=
  12931. data$,"#")
  12932.   REC%=
  12933. data$,P%-1))
  12934.   data$=
  12935. data$,P%+1)
  12936.  REC%=-1 
  12937.  REC%=RA%
  12938. &E.  
  12939. read(fields%,REC%<>RA%,REC%,$database%)
  12940. &F!  
  12941.  I%=1 
  12942. (ClientForm$) 
  12943. &G$    F%=
  12944. fnum(
  12945. ClientForm$,I%,2))
  12946. &H<    
  12947.  data$<>"" 
  12948.  $Rf%(F%)=
  12949. get_string(data$,ClientSep$)
  12950. write(fields%,key%)
  12951. &KR  
  12952.  received%=0 
  12953.  "Impulse_SendMessage",&201,"GetRecord",,,,getrec%,mytask%
  12954. get_string(
  12955.  S$,sep$)
  12956.  P%,F$
  12957. S$,sep$)
  12958.  P%>0 
  12959.   F$=
  12960. S$,P%-1)
  12961.   S$=
  12962. S$,P%+1)
  12963. stripspaces(F$)
  12964. prepare_next_record(key$,transbuff%)
  12965.  ok%,I%,F%,P%
  12966.  dbasehandle%=0 
  12967. &[,  dbasehandle%=
  12968. ($database%+".Database")
  12969. &\'  ClientPtr%=
  12970. neighbour(key%,top,1)
  12971. P%=transbuff%
  12972.  key$ 
  12973.  "***":
  12974. close_file(dbasehandle%)
  12975.   $P%=key$:P%+=
  12976. ($P%)+1
  12977. &d   
  12978.  ok%=
  12979.  ClientPtr%<>top
  12980. &e(    REC%=
  12981. rec_no(k$,key%,ClientPtr%)
  12982. &f'    
  12983. readsmarray(dbasehandle%,REC%)
  12984. (ClientSearch$)=
  12985. &h$      $P%=
  12986. (REC%)+"#":P%+=
  12987. ($P%)
  12988. &i%      
  12989.  I%=1 
  12990. (ClientForm$) 
  12991. &j(        F%=
  12992. fnum(
  12993. ClientForm$,I%,2))
  12994. &k,        $P%=F$(F%)+ClientSep$:P%+=
  12995. ($P%)
  12996.       
  12997.       $P%+=ClientSep$:P%+=1
  12998.       ok%=
  12999. &o        
  13000. &p0    ClientPtr%=
  13001. neighbour(key%,ClientPtr%,1)
  13002. &r1  
  13003.  P%=transbuff% 
  13004. close_file(dbasehandle%)
  13005. &t"  val$=
  13006. type(key%):kl%=
  13007. (key$)
  13008. &u%  ClientPtr%=
  13009. search(key$,key%,1)
  13010.  ClientPtr%>=0 
  13011. &w(    REC%=
  13012. rec_no(k$,key%,ClientPtr%)
  13013. &x'    
  13014. readsmarray(dbasehandle%,REC%)
  13015. &y"    $P%=
  13016. (REC%)+"#":P%+=
  13017. ($P%)
  13018. &z#    
  13019.  I%=1 
  13020. (ClientForm$) 
  13021. &{&      F%=
  13022. fnum(
  13023. ClientForm$,I%,2))
  13024. &|*      $P%=F$(F%)+ClientSep$:P%+=
  13025. ($P%)
  13026.     $P%+=ClientSep$:P%+=1
  13027. =P%-transbuff%
  13028. prepare_next_field(method%,S$,transbuff%)
  13029.  L%,F%,P%,len%,T$,F$,V%,R%,b$,k$,SF$
  13030.  token% 
  13031.  ### GetField ###
  13032. &  F%=
  13033. field(S$,
  13034. ):V%=chartype%(F%)
  13035. C    
  13036.  0,1,2,3,4,5,6,7,8,46,47,48,49,50,51,52,53,54,55,56,57,58:
  13037.     L%=
  13038. (F$(F%))
  13039. D    
  13040. extend_named_sliding_block(transanchor%,(L%+4) 
  13041.  &FFFFFFFC)
  13042.      transbuff%=!transanchor%
  13043. *    $transbuff%=F$(F%):transbuff%?L%=0
  13044.  36,39:
  13045. &    R%=
  13046. rec_no(k$,key%,ClientPtr%)
  13047. /    L%=
  13048. blob_path(
  13049. ,$database%,R%,F%,V%,b$)
  13050.  L%>0 
  13051. F      
  13052. extend_named_sliding_block(transanchor%,(L%+4) 
  13053.  &FFFFFFFC)
  13054. "      transbuff%=!transanchor%
  13055. (      
  13056.  "OS_File",255,b$,transbuff%
  13057.       
  13058.  L%=1
  13059. 7      
  13060. extend_named_sliding_block(transanchor%,256)
  13061. "      transbuff%=!transanchor%
  13062.       ?transbuff%=0
  13063.         
  13064.     transbuff%?L%=0
  13065.  ### GetExpanded ###
  13066. +  P%=
  13067. S$," "):T$=
  13068. S$,P%+1):S$=
  13069. S$,P%-1)
  13070. 2  F%=
  13071. field(S$,
  13072. ):F$=
  13073. expand(F$(F%),T$,L%,SF$)
  13074. extend_named_sliding_block(transanchor%,L%+1)
  13075.   transbuff%=!transanchor%
  13076. 6  $transbuff%=F$:L%=
  13077. ($transbuff%):transbuff%?L%=0
  13078. len%=(L%+4) 
  13079.  &FFFFFFFC
  13080.     =len%
  13081. start_merge
  13082. Imp_wait%=
  13083. text(mergeW%,1)=document$
  13084. ClientPtr%=top
  13085. $Query%=""
  13086. position_window(mergeW%,0,0,0,0,0,0)
  13087. set_caret(queryW%,0)
  13088. merge_next(P%,D%)
  13089.  S$,J%
  13090. D%=(D%+1) 
  13091. next_match(P%,D%,ClientSearch$,finished%)
  13092.  finished% 
  13093. selected(mergeW%,5) 
  13094.  J%=0 
  13095.      S$+=F$(KF%(key%,J%))+" "
  13096. text(mergeW%,11)=
  13097. S$,80)
  13098. redraw_icon(mergeW%,11)
  13099.  "Impulse_SendMessage",&201,":"+$mergewith%+"."+document$+" Merge",,,,mergetag%,mytask%
  13100.  End of "Impulse" handling -------------------------------------------
  13101.  Import/Export CSV files ---------------------------------------------
  13102. start_import(type$,wi%)
  13103.  OK%,T%,filename$
  13104.  "Wimp_GetPointerInfo",,block%:x%=!block%:y%=block%!4
  13105.  present% 
  13106.  fields%=0 
  13107.  OK%=
  13108. softerror("",69)
  13109.  Modify% 
  13110.  OK%=
  13111. softerror("",14)
  13112. softerror("",69)
  13113.  T%=0 
  13114.  LastTable%
  13115.  wi%=tableW%(T%) 
  13116.  Tablenumber%=T%
  13117.  OK% 
  13118.  wi% 
  13119. \    
  13120. select(csvW%,1):
  13121. select(csvW%,4):
  13122. icon_bit(22,csvW%,4,
  13123. ):csvfunc$="ImportMain"
  13124. &    
  13125.  mainW%:csvfunc$="ImportMain"
  13126. 6    
  13127.  tableW%(Tablenumber%):csvfunc$="ImportTable"
  13128.    filename$=$
  13129. text(csvW%,13)
  13130. icon_bit(22,csvW%,0,
  13131. (  $CSVTitle%="Import "+type$+" file"
  13132. text(csvW%,9)="Import"
  13133.  wi%=mainW% 
  13134. 7    
  13135. position_window(csvW%,x%-350,y%-260,0,520,0,0)
  13136. -    
  13137. position_window(csvW%,0,0,0,0,0,0)
  13138. auto_csv(on%)
  13139.  on% 
  13140.  present%=7 
  13141. 9    autocsvhandle%=
  13142. ($database%+".PrintJobs.NewData")
  13143. "    
  13144. select_range(1,fields%,
  13145.     csvform$=printorder$
  13146. clear_selection
  13147.  autocsvhandle%>0 
  13148. #    
  13149. close_file(autocsvhandle%)
  13150. <    
  13151.  "OS_File",18,$database%+".PrintJobs.NewData",&dfe
  13152. write_csv(Filename$)
  13153.  writingcsv% 
  13154.  printorder$<>"" 
  13155.  Form$=printorder$ 
  13156. softerror("",34):
  13157.  P%,rec%,examined%,subtotal%
  13158. end_csv:
  13159. )csvhandle%=
  13160. (Filename$):writingcsv%=
  13161. selected(csvW%,1) 
  13162. csv_head
  13163. *dbasehandle%=
  13164. ($database%+".Database")
  13165. Search$=
  13166. parse
  13167.  "Hourglass_On"
  13168.  usekey%=-1 
  13169. selected(savesubW%,6)=
  13170. #  direc%=
  13171. selected(queryW%,4)+1
  13172. $  P%=
  13173. neighbour(key%,top,direc%)
  13174. scan_file("P%<>top",key%,file%,3,direc%)
  13175. #  P%=
  13176. search(useval$,usekey%,1)
  13177.  P%>=0 
  13178.  k$=useval$:
  13179. scan_file("P%<>top AND k$=useval$",usekey%,file%,3,1)
  13180.  "Hourglass_Off"
  13181. close_file(csvhandle%)
  13182. close_file(dbasehandle%)
  13183.  sep$="," 
  13184.  type%=&dfe 
  13185.  type%=&fff
  13186.  "OS_File",18,Filename$,type%
  13187. writingcsv%=
  13188. close_it(savesubW%)
  13189. end_csv
  13190.  "Hourglass_Smash"
  13191. close_file(csvhandle%)
  13192. close_file(dbasehandle%)
  13193. close_file(F)
  13194.  "OS_File",18,Filename$,&dfe
  13195. writingcsv%=
  13196. softerror("",41)
  13197. wimp_error(
  13198. csv_head
  13199.  I%,F%,f$,H$,Head$,N%
  13200.     I%=-1
  13201. (Form$)-1
  13202. (  I%+=2:F%=
  13203. fnum(
  13204. Form$,I%,2)):N%+=1
  13205. selected(printW%,2) 
  13206.  Head$=$
  13207. text(mainW%,(desc%(F%))) 
  13208.  Head$=Tag$(F%)
  13209. selected(csvW%,4) 
  13210.  Head$=
  13211. (len%(F%))+"
  13212. "+Head$+"
  13213. (chartype%(F%))
  13214.  chartype%(F%)<>3 
  13215.  chartype%(F%)<>6 
  13216. selected(csvW%,0) 
  13217.  Head$=""""+Head$+""""
  13218.  N%>1 
  13219.  Head$=sep$+Head$
  13220. #csvhandle%,Head$;
  13221. #csvhandle%,term$;
  13222. write_csv_rec(R%,Form$,handle%)
  13223.  I%,F%,f$,F$,L%,N%,filename$,len%,base%,SF$
  13224. selected(csvW%,3) 
  13225.   F$=
  13226. key2(0,1)
  13227. '*,  
  13228. selected(csvW%,0) 
  13229.  F$=""""+F$+""""
  13230. #handle%,F$+sep$;
  13231. selected(csvW%,22) 
  13232. #handle%,
  13233. (REC%)+sep$;
  13234. I%=-1:L%=
  13235. (Form$)-1
  13236.  I%<L%
  13237. '0"  I%+=2:F%=
  13238. fnum(
  13239. Form$,I%,2))
  13240.  chartype%(F%) 
  13241.  36,39:
  13242. '3,    len%=
  13243. load_blob($database%,R%,F%,36)
  13244. '4'    
  13245.  len%>0 
  13246. selected(csvW%,2) 
  13247. '5(      N%+=1:
  13248.  N%>1 
  13249. #handle%,sep$;
  13250. '60      
  13251. selected(csvW%,0) 
  13252. #handle%,"""";
  13253. '7%      
  13254. blob_to_file(handle%,len%)
  13255. '80      
  13256. selected(csvW%,0) 
  13257. #handle%,"""";
  13258. '9        
  13259.  3,6,46,47,54,56,57:
  13260.     F$=F$(F%):N%+=1
  13261. '<'    
  13262.  F$<>"" 
  13263. selected(csvW%,2) 
  13264.       
  13265.  N%>1 
  13266.  F$=sep$+F$
  13267.       
  13268. #handle%,F$;
  13269. '?        
  13270.  41,42,43,44,45:
  13271.       F$=F$(F%):N%+=1
  13272.       Z%=
  13273. no_yes(F%,n$,y$)
  13274. 'C"      
  13275.  F$=" " 
  13276.  F$=y$ 
  13277.  F$=n$
  13278. 'D0      
  13279. selected(csvW%,0) 
  13280.  F$=""""+F$+""""
  13281.       
  13282.  N%>1 
  13283.  F$=sep$+F$
  13284.       
  13285. #handle%,F$;
  13286. 'H!    
  13287. selected(printW%,11) 
  13288. 'I/      F$=
  13289. expand(F$(F%),link$(F%),Len%,SF$)
  13290.       
  13291.  F$=F$(F%)
  13292. 'K        
  13293.     N%+=1
  13294. 'M'    
  13295.  F$<>"" 
  13296. selected(csvW%,2) 
  13297. 'N0      
  13298. selected(csvW%,0) 
  13299.  F$=""""+F$+""""
  13300.       
  13301.  N%>1 
  13302.  F$=sep$+F$
  13303.       
  13304. #handle%,F$;
  13305. 'Q        
  13306. #handle%,term$;
  13307. convert_csv(f$)
  13308.  k$,B%,J%,fld%,csvhandle%,toobighandle%,S$,sep%,sep2%,term%,term2%,F$,avail%,nextfree%,keybase%,base%,base2%,show%,done%
  13309.  importingcsv% 
  13310. importingcsv%=
  13311. '[3toobighandle%=
  13312. ($database%+".PrintJobs.TooBig")
  13313. stop_reading:
  13314. size%=&100:inc%=size%
  13315. extend_named_sliding_block(tempanchor%,size%)
  13316. '`:sep%=
  13317. (sep$):
  13318. (sep$)=2 
  13319.  sep2%=
  13320. sep$)) 
  13321.  sep2%=255
  13322. 'a@term%=
  13323. (term$):
  13324. (term$)=2 
  13325.  term2%=
  13326. term$)) 
  13327.  term2%=255
  13328. csvhandle%=
  13329.  present%=0 
  13330. csv_to_dbase(f$)
  13331. Form$=
  13332. csv_importform
  13333.  "Hourglass_On"
  13334. selected(csvW%,22):
  13335. read_bytes
  13336.     REC%=
  13337. ($base%)
  13338. 'k(    
  13339. read(fields%,
  13340. ,REC%,$database%)
  13341. selected(csvW%,3):
  13342. read_bytes
  13343. 'n,    addr=
  13344. find(
  13345. $base%,KL%(key%)),0,1,
  13346.  addr>0 
  13347. 'p$      REC%=
  13348. rec_no(k$,key%,addr)
  13349. 'q*      
  13350. read(fields%,
  13351. ,REC%,$database%)
  13352.       
  13353. make_new_rec
  13354. 's        
  13355. make_new_rec
  13356.   endline%=
  13357. :J%=-1
  13358. 'w#  
  13359. (Form$)-2 
  13360.  endline%=
  13361. 'x&    J%+=2:fld%=
  13362. fnum(
  13363. Form$,J%,2))
  13364. 'y!    
  13365. transfer_csv_field(fld%)
  13366. '{2  
  13367.  fld%<=fields% 
  13368.  endline% 
  13369. next_csv_rec
  13370. write(fields%,key%)
  13371. '~-  
  13372. selected(csvW%,11) 
  13373. redraw(mainW%)
  13374.  "Hourglass_Percentage",
  13375. #csvhandle%*100 
  13376. #csvhandle%
  13377.  "OS_Byte",229,0
  13378. #csvhandle%
  13379.  "Hourglass_Off"
  13380. close_file(csvhandle%)
  13381. close_file(toobighandle%)
  13382. scrap_sliding_block(tempanchor%)
  13383.  "OS_File",18,$database%+".PrintJobs.TooBig",&fff
  13384. addr=
  13385. moveto(key%,top,1)
  13386. clear_selection
  13387. asterisk(
  13388. write_log(-1,"CSV data imported from "+f$)
  13389. importingcsv%=
  13390. make_new_rec
  13391. /keybase%=!keyanchor%(0):nextfree%=!keybase%
  13392.  !(keybase%+nextfree%)<=0 
  13393.   incr%=
  13394. ($Increment%)
  13395.  incr%>0 
  13396. #    
  13397. change_length(RA%+incr%,
  13398. #    
  13399.  moan_err%,
  13400. msg("Err66")
  13401. )REC%=!(keybase%+nextfree%+8+KL%(0)+1)
  13402. read(fields%,
  13403. ,RA%,$database%)
  13404. transfer_csv_field(
  13405.  fld%)
  13406.  chartype%(fld%) 
  13407.  36,39:
  13408. read_bytes
  13409.  ptr%>0 
  13410. 3    Z%=
  13411. blob_path(
  13412. ,$database%,REC%,fld%,36,F$)
  13413. $    Start%=base%:End%=base%+ptr%
  13414. "    
  13415. save(F$,&fff,Start%,End%)
  13416. selected(csvW%,11) 
  13417.       
  13418.  chartype%(fld%) 
  13419. <        
  13420. set_blob_sprite(REC%,fld%,chartype%(fld%))
  13421. '        
  13422. show_text_block(fld%)
  13423.       
  13424.         
  13425.  41,42,43,44,45:
  13426. read_bytes:c$=
  13427. pos_neg($base%)
  13428. 9    
  13429.  " ":$Rf%(fld%)=" ":
  13430. select(mainW%,field%(fld%))
  13431. 9    
  13432.  "":$Rf%(fld%)="":
  13433. deselect(mainW%,field%(fld%))
  13434.  "@":
  13435. #toobighandle%,"Rec."+
  13436. (REC%)+",Fld."+
  13437. (fld%)+","+$base%+" unsuitable data for check-box":$Rf%(fld%)="":
  13438. deselect(mainW%,field%(fld%))
  13439.  0,1,2,3,4,5,6,7,8,46,47,48,49,50,51,52,53,54,55,56,57,58:
  13440.  len%(fld%)>0 
  13441. read_bytes
  13442. ;    
  13443. selected(csvW%,16) 
  13444.  $base%=
  13445. stripspaces($base%)
  13446.       
  13447.  ptr%<=len%(fld%):
  13448.        
  13449.  chartype%(fld%)=47 
  13450. H        
  13451. selected(csvW%,23) 
  13452.  $Rf%(fld%)=$base%:dontincrement%=
  13453.         
  13454.  $Rf%(fld%)=$base%
  13455.       
  13456.       
  13457.  ptr%<247:
  13458. C      
  13459. #toobighandle%,"Rec."+
  13460. (REC%)+",Fld."+
  13461. (fld%)+","+$base%
  13462.       $Rf%(fld%)="@"
  13463.       
  13464.       
  13465. #toobighandle%,"Rec."+
  13466. (REC%+1)+",Fld."+
  13467. (fld%)+" is more than 246 characters long. Data not saved. External field suggested."
  13468.       $Rf%(fld%)="@"
  13469.         
  13470.  fld%+=1
  13471. 8    
  13472.  ### Zero-length field is probably just a label
  13473. :fld%+=1
  13474.  ### Can't put CSV data into Button, Sprite or Draw fields! ###
  13475. read_bytes
  13476.  end$,B%
  13477. base%=!tempanchor%:ptr%=-1
  13478. #csvhandle%
  13479.  B%=34 
  13480. O  end$="(B%=sep% OR B%=term% OR EOF#csvhandle%=TRUE) AND base%?(ptr%-1)=34"
  13481. 7  end$="B%=sep% OR B%=term% OR EOF#csvhandle%=TRUE"
  13482. #csvhandle%=
  13483. #csvhandle%-1
  13484.   B%=
  13485. #csvhandle%
  13486.   ptr%+=1:base%?ptr%=B%
  13487.  ptr%=size% 
  13488.  size%+=inc%:
  13489. extend_named_sliding_block(tempanchor%,size%)
  13490. (end$)
  13491.  base%?(ptr%-1)=34 
  13492.  ptr%-=1
  13493. base%?ptr%=13
  13494.  sep%:
  13495. skip_sep
  13496.  term%:
  13497. skip_term
  13498. next_csv_rec
  13499.   B%=
  13500. #csvhandle%
  13501.  B%=term%
  13502. skip_term
  13503. skip_sep
  13504.  sep2%<>255 
  13505.   B%=
  13506. #csvhandle%
  13507.  B%<>sep2% 
  13508. #csvhandle%=
  13509. #csvhandle%-1
  13510. skip_term
  13511.  term2%<>255 
  13512.   B%=
  13513. #csvhandle%
  13514.  B%<>term2% 
  13515. #csvhandle%=
  13516. #csvhandle%-1 
  13517.  endline%=
  13518.  endline%=
  13519. stop_reading
  13520.  "Hourglass_Off"
  13521. close_file(csvhandle%):
  13522. close_file(toobighandle%)
  13523.  "OS_File",18,$database%+".PrintJobs.TooBig",&fff
  13524. scrap_sliding_block(tempanchor%)
  13525.  =17 
  13526. softerror("",74)
  13527. wimp_error(
  13528.  present%=7 
  13529.   addr=
  13530. moveto(key%,top,1)
  13531. clear_selection
  13532. importingcsv%=
  13533. csv_importform
  13534.  F%,f$,F$
  13535. endline%=
  13536. selected(csvW%,1):
  13537.  ### Use header record to build form ###
  13538. read_bytes
  13539.     F%=
  13540. field($base%,
  13541. 2    
  13542.  F%=0 
  13543.  moan_err%,
  13544. msg("Err87,"+$base%)
  13545.     f$=
  13546. ~(F%)
  13547. (f$)=1 
  13548.  f$="0"+f$
  13549.     F$+=f$
  13550. "    
  13551. invert(mainW%,field%(F%))
  13552.  endline%
  13553.  printorder$<>"":
  13554.  ### Build form from highlighted fields, as in printing ###
  13555.   F$=printorder$
  13556.  ### Assume entry into all fields, beginning with first ###
  13557.  F%=1 
  13558.  fields%
  13559.     f$=
  13560. ~(F%)
  13561. (f$)=1 
  13562.  f$="0"+f$
  13563.     F$+=f$
  13564. csv_to_dbase(f$)
  13565.  F%,P%,Q%,FH%,S$,readpos%
  13566. read_bytes:S$=$base%:
  13567. #csvhandle%=0
  13568. ")=0 
  13569.  moan_err%,
  13570. msg("Err89")
  13571. leaf$=
  13572. leaf(f$):csvconv%=
  13573.  $database%="No data" 
  13574.  $database%=dbasepath$+".!"+leaf$
  13575. save($database%,0,0,0)
  13576. fields%=0:endline%=
  13577.   fields%+=1
  13578. read_bytes:S$=$base%
  13579. (."  P%=
  13580. "):Q%=
  13581. ",P%+1)
  13582. (/%  Tag$(fields%)=
  13583. S$,P%+1,Q%-P%-1)
  13584. (0   len%(fields%)=
  13585. S$,P%-1))
  13586. (1%  chartype%(fields%)=
  13587. S$,Q%+1))
  13588.  endline%
  13589. scrap_sliding_block(tempanchor%)
  13590. ($database%+".Form")
  13591. #FH%,fields%
  13592.  F%=1 
  13593.  fields%
  13594.   xd%=16:xf%=96
  13595.   yd%=-(F%*52):yf%=yd%
  13596. (9H  
  13597. #FH%,Tag$(F%),Tag$(F%),xd%,yd%,xf%,yf%,len%(F%),chartype%(F%),0,0
  13598. close_file(FH%)
  13599.  "OS_File",18,$database%+".Form",&7f2
  13600. fields%=0:Fieldnumber%=0
  13601. fields%=
  13602. get_form(Fptr%)
  13603. default_key
  13604. readpos%=
  13605. #csvhandle%
  13606. no_of_recs
  13607. defaults($database%,RA%,0)
  13608. save_keys
  13609. deselect(csvW%,1)
  13610. create_named_sliding_block(tempanchor%,size%)
  13611. csvhandle%=
  13612. #csvhandle%=readpos%
  13613. no_of_recs
  13614.  N%,B%
  13615. #csvhandle%
  13616.  B%=term% 
  13617. #csvhandle%
  13618.   N%+=1
  13619. (P?  
  13620.  "Hourglass_Percentage",
  13621. #csvhandle%*100 
  13622. #csvhandle%
  13623. #csvhandle%
  13624.  --- SLIDING HEAP 2.00 PROCEDURES
  13625.  requires SlidingHeap 2.00
  13626.  module and PROCs
  13627.  Steven Haslam 1992
  13628. _heap_slotsize
  13629.  "Wimp_SlotSize",-1,-1 
  13630. _heap_numtostr(d%,n%)=
  13631. d%,"0")+
  13632. ~n%,d%)
  13633. _heap_snumtostr(d%,n%)=
  13634. d%," ")+
  13635. n%,d%)
  13636. heapsinfo
  13637.  "OS_Heap",1,fixedheapbase% 
  13638.  ,,bigbloc%,totfree%
  13639.  "Fixed heap"
  13640.  "----- ----"
  13641.  "Heap base    : &";
  13642. _heap_numtostr(8,fixedheapbase%)
  13643.  "Heap size    : ";
  13644. _heap_bytes2(fixedheapsize%)
  13645.  "Largest free : ";
  13646. _heap_bytes2(bigbloc%)
  13647.  "Total free   : ";
  13648. _heap_bytes2(totfree%)
  13649.  "Sliding heap"
  13650.  "------- ----"
  13651.  "SlidingHeap_HeapInfo",slidingheapbase%
  13652. _heap_pageup(n%)
  13653.  "OS_ReadMemMapInfo" 
  13654. =(n%+R0%-1) 
  13655.  (R0%-1)
  13656. initheaps(heapsize%,slidingblocks%)
  13657. fixedheapsize%=heapsize%
  13658. (xLheap_trigger%=
  13659. _heap_pageup(
  13660. +fixedheapsize%+20+20*slidingblocks%-&8000)
  13661. setslotsize(heap_trigger%)
  13662. _heap_slotsize<heap_trigger% 
  13663.  130,"Unable to initialise heap"
  13664. fixedheapbase%=
  13665. (|%slidingheapbase%=
  13666. +fixedheapsize%
  13667.  "OS_Heap",0,fixedheapbase%,,fixedheapsize%
  13668.  "SlidingHeap_Create",slidingheapbase%,2,slidingblocks%
  13669.  "SlidingHeap_VerifyHeap",slidingheapbase%
  13670. _heap_nextfree
  13671.  nextfree%
  13672.  "SlidingHeap_NextFree",slidingheapbase% 
  13673.  nextfree%
  13674. =nextfree%
  13675. destroyheaps
  13676. setslotsize(
  13677. -&8000)
  13678. _heap_wordup(x%)=(x%+3) 
  13679. create_anchor(name$)
  13680.  space%
  13681.  space% 4+
  13682. name$+1
  13683. !space%=0
  13684. $(space%+4)=name$
  13685. =space%
  13686. create_named_sliding_block(anchor%,size%)
  13687.  trysize%
  13688. size%=
  13689. _heap_wordup(size%)
  13690. 7trysize%=
  13691. _heap_pageup(
  13692. _heap_nextfree+size%-&7FF4)
  13693.  trysize%>heap_trigger% 
  13694. setslotsize(trysize%)
  13695. _heap_slotsize<trysize% 
  13696. #    
  13697. setslotsize(heap_trigger%)
  13698. D    
  13699.  131,"Not enough room to create block """+$(anchor%+4)+""""
  13700.         
  13701.     heap_trigger%=trysize%
  13702.  "SlidingHeap_NewBlock",slidingheapbase%,anchor%,size%,anchor%+4
  13703.  "SlidingHeap_VerifyHeap",slidingheapbase%
  13704. scrap_sliding_block(anchor%)
  13705.  !anchor%=0 
  13706.  "SlidingHeap_ScrapBlock",slidingheapbase%,anchor%
  13707. 1trysize%=
  13708. _heap_pageup(
  13709. _heap_nextfree-&7FFC)
  13710.  trysize%<>heap_trigger% 
  13711. setslotsize(trysize%)
  13712.   heap_trigger%=trysize%
  13713. !anchor%=0
  13714.  "SlidingHeap_VerifyHeap",slidingheapbase%
  13715. setslotsize(newsize%)
  13716.  "Wimp_SlotSize",newsize%,-1
  13717. extend_named_sliding_block(anchor%,newsize%)
  13718.  !anchor%=0 
  13719. create_named_sliding_block(anchor%,newsize%):
  13720.  !anchor%>
  13721. _heap_nextfree 
  13722.  129,"Block beyond heap limits"
  13723. $newsize%=
  13724. _heap_wordup(newsize%)
  13725.  "SlidingHeap_DescribeBlock",slidingheapbase%,anchor% 
  13726.  ,,oldsize%
  13727. larger%=newsize%>oldsize%
  13728.  larger% 
  13729. G  trysize%=
  13730. _heap_pageup(
  13731. _heap_nextfree+(newsize%-oldsize%)-&7FFC)
  13732.  trysize%>heap_trigger% 
  13733. setslotsize(trysize%)
  13734. $    
  13735. _heap_slotsize<trysize% 
  13736. %      
  13737. setslotsize(heap_trigger%)
  13738. =      
  13739.  132,"Not enough room to extend block #"+
  13740. ~anchor%
  13741.       
  13742.        heap_trigger%=trysize%
  13743.         
  13744.  "SlidingHeap_ExtendBlock",slidingheapbase%,anchor%,newsize%
  13745. 1trysize%=
  13746. _heap_pageup(
  13747. _heap_nextfree-&7FFC)
  13748.  trysize%<>heap_trigger% 
  13749. setslotsize(trysize%)
  13750.    heap_trigger%=trysize%
  13751.  "SlidingHeap_VerifyHeap",slidingheapbase%
  13752. _heap_bytes(b%)
  13753.  end%
  13754.  "OS_ConvertFixedFileSize",b%,block%,block%+&100 
  13755.  ,end%
  13756. ?end%=13
  13757. =$block%
  13758. _heap_bytes2(b%)
  13759.  end%
  13760.  "OS_ConvertFileSize",b%,block%,block%+&100 
  13761.  ,end%
  13762. ?end%=13
  13763. =$block%
  13764. create_fixed_block(size%)
  13765.  pointer%,flag%
  13766.  "XOS_Heap",2,fixedheapbase%,,size% 
  13767.  ,,pointer%;flag%
  13768.  flag% 
  13769. extendfixedheap
  13770.  "XOS_Heap",2,fixedheapbase%,,size% 
  13771.  ,,pointer%;flag%
  13772. =pointer%
  13773. extendfixedheap
  13774.  nshb%,extend%,trysize%
  13775.  "OS_ReadMemMapInfo" 
  13776.  extend%
  13777. $trysize%=
  13778. _heap_slotsize+extend%
  13779. setslotsize(trysize%)
  13780. _heap_slotsize<trysize% 
  13781.  255,"No room to extend fixed heap"
  13782. "nshb%=slidingheapbase%+extend%
  13783.  "SlidingHeap_ShiftHeap",slidingheapbase%,nshb%
  13784.  "OS_Heap",5,fixedheapbase%,,extend%
  13785. fixedheapsize%+=extend%
  13786. slidingheapbase%=nshb%
  13787.  "SlidingHeap_VerifyHeap",slidingheapbase%
  13788. memory_usage
  13789.  F,R,f$,S$,P%
  13790. f$=$database%+".MemoryUsed"
  13791. #F,"Database: "+
  13792. leaf($database%)+" ("+
  13793. $+")"
  13794. #F,"(Record has "+
  13795. (fields%)+" fields and is "+
  13796. (Length%)+" bytes long)"
  13797. N%=((
  13798. )+1024) 
  13799.  1024
  13800. #F,"Program size: "+
  13801. (N%)+"K"
  13802. N%=((
  13803. P)+1024) 
  13804.  1024
  13805. #F,"Basic variables: "+
  13806. (N%)+"K"
  13807. N%=((
  13808. )+1024) 
  13809.  1024
  13810. ("<Pbase$Dir>.!Run")
  13811.   S$=
  13812. S$,8)="WimpSlot"
  13813. close_file(R)
  13814. S$,"K")-3
  13815. #F,"Program + variables: "+
  13816. (N%)+"K (Wimpslot = "+
  13817. S$,P%,4)+")"
  13818. @A%=indirectionmem% 
  13819.  1024:N%=((buff%-buffbase%)+1024) 
  13820.  1024
  13821. IM%=endbuff%-buff%:
  13822.  M%<1024 
  13823. (M%)+" bytes" 
  13824.  1024)+"K"
  13825. #F,"Icon indirection: "+
  13826. (A%)+"K allocated, "+M$+" left"
  13827. ;A%=menumem% 
  13828.  1024:N%=((menu_ptr%-menblk%)+1024) 
  13829.  1024
  13830. )    MM%=men_end%-menu_ptr%:
  13831.  M%<1024 
  13832. (M%)+" bytes" 
  13833.  1024)+"K"
  13834. #F,"Menus: "+
  13835. (A%)+"K allocated, "+M$+" left"
  13836. close_file(F)
  13837.  "OS_File",18,f$,&fff
  13838. debug(S$)
  13839. wimp_error(
  13840. ,254,0,S$)
  13841.