home *** CD-ROM | disk | FTP | other *** search
/ The Datafile PD-CD 5 / DATAFILE_PDCD5.iso / utilities / p / powerbase / !Powerbase / !RunImage (.txt) < prev    next >
Encoding:
RISC OS BBC BASIC V Source  |  1997-06-17  |  316.5 KB  |  14,668 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.98d (17-06-97)"
  7.  "OS_Byte",228,1
  8.  "OS_Byte",202,0,255 
  9.  ,kbdstatus%
  10.  fatal_err%=255:moan_err%=254
  11. present%=
  12. :library$=""
  13. ,"L0 error: "+
  14. $+" during initialisation at line "+
  15. setup
  16.  buff%>endbuff% 
  17.  0,"No room for defs."
  18.  menu_ptr%>men_end% 
  19.  0,"No room for menus"
  20. wimp_error(
  21.  "OS_GetEnv" 
  22.  ComString$
  23. ComString$,"-database") 
  24. 4  File$=
  25. ComString$,
  26. ComString$,"-database")+10)
  27.  "OS_GSTrans",File$,
  28. 13),255 
  29.  ,File$,L%
  30.   File$=
  31. File$,L%)
  32. get_it_in(File$)
  33. shade(passW%,17,
  34. wimp_error(
  35.  quit%
  36. close_down
  37.  "OS_Byte",229,1:
  38.  "OS_Byte",124
  39.  "Wimp_Poll",mask%,block% 
  40.  reason%
  41.  reason% 
  42.  autosave%>0 
  43.  Access%=
  44. check_save(
  45. ($Interval%)*6000)
  46.  Imp_wait% 
  47.  merging% 
  48. start_merge
  49.  flash%>0 
  50. flash(mainW%,field%(flash%))
  51. redraw(!block%)
  52. open_it(!block%)
  53. close_it(!block%)
  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. 6V      
  65.  &200,&201:
  66.  token%<>-1 
  67. Impulse_command_received(token%,params%,object%)
  68. 7/      
  69.  &202:
  70. Impulse_reply(token%,params%)
  71. 8.      
  72.  &203:
  73. Impulse_send(token%,object%)
  74. 99      
  75.  &204:
  76. Impulse_receive(token%,params%,object%)
  77. :        
  78. message
  79. not_acknowledged
  80. flash(wi%,ic%)
  81.  time%
  82.  "OS_ReadMonotonicTime" 
  83.  time%
  84.  (time% 
  85.  50)=0 
  86. invert(wi%,ic%)
  87.  Shutdown routines ---------------------------------------------------
  88. close_down
  89. #0:$block%="TASK":
  90.  "Wimp_CloseDown",mytask%,!block%:
  91. ,"L0 error: "+
  92. $+" during closedown at line "+
  93.  "Hourglass_Smash"
  94.  "Impulse_CloseDown",mytask%
  95. $block%="TASK"
  96.  "Wimp_CloseDown",mytask%,!block%
  97.  "OS_Byte",202,kbdstatus%
  98.  "Hourglass_Smash"
  99.  present%=7 
  100. check_change:
  101. save_winpos
  102.  ramwarn% 
  103.  ram% 
  104. softerror("",63)
  105.  design% 
  106.  protect% 
  107. save_form($database%+".Form")
  108.  altered% 
  109. save_everything:
  110. memory_usage
  111. auto_csv(
  112. close_files
  113. close_log("<Log$Dir>.Log")
  114. hide_windows
  115. delete_icons(mainW%,0)
  116. delete_icons(pselectW%,8)
  117.  ic%=24 
  118. text(keypadW%,ic%)=""
  119. recover_memory
  120. init_vars
  121. get_defaults
  122. select(prefsW%,36):
  123. deselect(prefsW%,35):
  124. shade(prefsW%,35,
  125.  I%=0 
  126.  LastTable%
  127.   printrel$(I%)=""
  128.  tableW%(I%)>0 
  129.  !block%=tableW%(I%):
  130.  "Wimp_DeleteWindow",,block%
  131.   tableW%()=0:TabTitle%()=0
  132. tableW%()=0:TabTitle%()=0
  133. field$()=""
  134. $Password%=""
  135. present%=
  136. exit%=
  137. lit(iconbarM%,1,
  138. lit(iconbarM%,2,
  139. lit(iconbarM%,3,
  140. lit(validateM%,1,
  141. ):ptr%=validateM%+52:ptr%!4=-1
  142. lit(printM%,5,
  143. lit(printM%,6,
  144. lit(printM%,7,
  145. lit(mainM%,7,
  146.  "OS_CLI","Unset Acl$Dir"
  147.  "OS_CLI","Unset Log$Dir"
  148. $dbase%="No data"
  149. $database%="No data"
  150. redraw_icon(-2,pbaseicon%)
  151. save_everything
  152.  Access% 
  153. save_links
  154. save_calcs
  155. save_subfilenames
  156. save_keys
  157. save_all_tables
  158.   changed%=
  159. update_calcs(0)
  160. asterisk(
  161. delete_icons(wi%,ic%)
  162. !block%=wi%:block%!4=ic%
  163.  "Wimp_DeleteIcon",,block%
  164.   ic%+=1:block%!4=ic%
  165.  "Wimp_GetIconState",,block%
  166.  ((block%!24) 
  167.  (1<<23))>0
  168. close_files
  169. close_file(lk):link$()=""
  170. close_file(cl):calc$()=""
  171. close_file(dbasehandle%)
  172. close_file(csvhandle%)
  173. close_file(autocsvhandle%)
  174. close_file(texthandle%)
  175. close_file(text%)
  176. close_file(toobighandle%)
  177. close_file(F)
  178. close_file(FH%)
  179. close_file(V)
  180. close_file(
  181.  filehandle%)
  182.  filehandle%>0 
  183. #filehandle%
  184.   filehandle%=0
  185. recover_memory
  186. scrap_sliding_block(headanchor%)
  187. scrap_sliding_block(lineanchor%)
  188. scrap_sliding_block(textanchor%)
  189. scrap_sliding_block(formanchor%)
  190. scrap_sliding_block(selanchor%)
  191. scrap_sliding_block(tempanchor%)
  192. scrap_sliding_block(balanchor%)
  193. scrap_sliding_block(flaganchor%)
  194. scrap_sliding_block(transanchor%)
  195. scrap_sliding_block(sprsanchor%)
  196. scrap_sliding_block(recanchor%)
  197. scrap_sliding_block(saveanchor%)
  198. scrap_sliding_block(logoanchor%)
  199. scrap_sliding_block(fieldmenuanchor%)
  200. scrap_sliding_block(usermenuanchor%)
  201. scrap_sliding_block(tablemenuanchor%)
  202.  I%=0 
  203.  MaxTabs%
  204. scrap_sliding_block(tabanchor%(I%))
  205. scrap_sliding_block(undoanchor%(I%))
  206.  I%=0 
  207.  MaxKeys%+1
  208. scrap_sliding_block(keyanchor%(I%))
  209.  I%=1 
  210.  fields%
  211.  chartype%(I%)=40 
  212. scrap_sliding_block(Rf%(I%))
  213.  Error handling ------------------------------------------------------
  214. wimp_error(return%,err%,erl%,err$)
  215.  type%,result%
  216. close_down:
  217. ,"L0 error: "+
  218. $+" during error handler at line "+
  219.  "Wimp_CommandWindow",-1
  220. block%!0=err%
  221.  return% 
  222.  err%<>fatal_err% 
  223.  err%=moan_err% 
  224. ;      type%=17:
  225.  OK button and no "Error from" in title
  226. )      type%=3:
  227.  OK and Cancel buttons
  228. A      err$+=" @ "+
  229. (erl%)+" (OK to continue, Cancel to quit)"
  230.    type%=2:
  231.  Cancel buttom
  232. ;   err$+=" @ "+
  233. (erl%)+" (Powerbase must quit at once)"
  234. $(block%+4)=err$+
  235.  "Wimp_ReportError",block%,type%,"Powerbase"+
  236.  ,result%
  237.  result=1 means OK selected, 2 means Cancel selected
  238.  result%=2 
  239. close_down
  240. softerror(E$,E%)
  241. M$="Err"+
  242.  E$<>"" 
  243.  M$+=","+E$
  244. $(block%+4)=
  245. msg(M$)
  246. !block%=255
  247.  "Wimp_ReportError",block%,17,"Powerbase"+
  248.  ### Use MessageTrans to display a message from the Messages file ###
  249. msg(token$)
  250.  result$,msgparams$,P%,Q%,p%
  251. param$()="":
  252. token$,",")
  253.  P%>0 
  254. "  msgparams$=
  255. token$,P%+1)+","
  256.   token$=
  257. token$,P%-1)
  258.   P%=0
  259.     Q%=P%+1
  260.     P%=
  261. msgparams$,",",Q%)
  262.  P%>0 
  263. *      param$(p%)=
  264. msgparams$,Q%,P%-Q%)
  265.       p%+=1
  266.         
  267.  P%=0
  268.  "MessageTrans_Lookup",filedesc%,token$,msgbuff%,&100,param$(0),param$(1),param$(2),param$(3) 
  269.  ,,result$
  270. =result$
  271. asterisk(on%)
  272.  on% 
  273. $RecInfo%)<>"*" 
  274.  $RecInfo%+=" *":ramwarn%=
  275. $RecInfo%)="*" 
  276.  $RecInfo%=
  277. $RecInfo%))
  278. altered%=on%
  279. E!block%=mainW%:
  280.  "Wimp_GetWindowOutline",,block%:ymax%=block%!16
  281.  "Wimp_GetWindowState",,block%
  282.  "Wimp_ForceRedraw",-1,block%!4,block%!16,block%!12,ymax%
  283.  Program initialisation ----------------------------------------------
  284. setup
  285.  F,A%,I%,J%,V%,valid$
  286. ("<Pbase$Dir>.Resources.Config")
  287. MaxFields%=
  288.  MaxFields%>127 
  289.  fatal_err%,
  290. msg("Err61")
  291. MaxKeys%=
  292. MaxTabs%=
  293. #F)-1
  294. MaxMenus%=
  295. #F)-1
  296. MaxCols%=
  297. #F)-1
  298. #F:P%=
  299. S$," "):leftmenu%=(
  300. S$,P%-1)="YES")
  301. winback%=
  302. uc%=(
  303. #F,3)="YES")
  304.  )S$=
  305. #F:P%=
  306. S$," "):dirdisp$=
  307. S$,P%-1)
  308. !)S$=
  309. #F:P%=
  310. S$," "):objname$=
  311. S$,P%-1)
  312. bannertime%=
  313. #F)*100
  314. close_file(F)
  315. dim_arrays(MaxFields%+1,MaxKeys%,MaxTabs%,MaxMenus%,MaxCols%)
  316. load_fkeys("Fkeys")
  317. init_vars
  318.  ------------------ Initialise Wimp ----------------------------
  319. $block%="TASK"
  320. mask%=(1<<4)+(1<<5)+(1<<11)
  321.  "Wimp_Initialise",200,!block%,"Powerbase" 
  322.  version%,mytask%
  323.  version%<316 
  324.  0,"This version of Powerbase is only suitable for RISC OS 3. Contact Powerbase Support for a RISC OS 2-compatible version."
  325.  "Impulse_Initialise",003,mytask%,"Powerbase",-1
  326. -Mpbaseicon%=
  327. create_icon(-1,0,-16,144,110,&1700312B,"",dbase%,psprite%,10)
  328.  --------- Set up Heap Manager. Load error messages -----------
  329. initheaps(128,128)
  330. 0'f$="<PBase$Dir>.Resources.Messages"
  331.  "MessageTrans_FileInfo",,f$ 
  332.  flags%,,len%
  333. 2'errormsg%=
  334. create_fixed_block(len%)
  335.  "OS_Module",6,,,17+
  336. (f$) 
  337.  ,,filedesc%
  338. $(filedesc%+16)=f$
  339.  "MessageTrans_OpenFile",filedesc%,filedesc%+16,errormsg%
  340. getscreensize(ScreenWidth%,ScreenHeight%,Vpix%)
  341.  Vpix%>=480 
  342.  f$="Sprites22" 
  343.  f$="Sprites"
  344.  "OS_File",5,"<PBase$Dir>.Resources."+f$ 
  345.  ,,,,len%
  346. 9(sprites%=
  347. create_fixed_block(len%+4)
  348. !sprites%=len%+4
  349.  "OS_File",255,"<PBase$Dir>.Resources."+f$,sprites%+4
  350. <)headanchor%=
  351. create_anchor("Heading")
  352. =*lineanchor%=
  353. create_anchor("TextLine")
  354. >&textanchor%=
  355. create_anchor("Text")
  356. ?&formanchor%=
  357. create_anchor("Form")
  358. @.sprsanchor%=
  359. create_anchor("DbaseSprites")
  360. A&tempanchor%=
  361. create_anchor("Temp")
  362. B(balanchor%=
  363. create_anchor("Balance")
  364. C'flaganchor%=
  365. create_anchor("Flags")
  366. D/transanchor%=
  367. create_anchor("DataTransfer")
  368. E)selanchor%=
  369. create_anchor("PrintSel")
  370. F*recanchor%=
  371. create_anchor("RecordNum")
  372. G,saveanchor%=
  373. create_anchor("SaveBuffer")
  374. H&logoanchor%=
  375. create_anchor("Logo")
  376. I0fieldmenuanchor%=
  377. create_anchor("FieldMenu")
  378. J.usermenuanchor%=
  379. create_anchor("UserMenu")
  380. K0tablemenuanchor%=
  381. create_anchor("TableMenu")
  382.  I%=0 
  383.  MaxKeys%+1
  384. M3   keyanchor%(I%)=
  385. create_anchor("Key #"+
  386. (I%))
  387.  I%=0 
  388.  MaxTabs%
  389. P6   tabanchor%(I%)=
  390. create_anchor("VTable #"+
  391. (I%))
  392. Q;   undoanchor%(I%)=
  393. create_anchor("UndoVTable #"+
  394. (I%))
  395.  ---------------------------------------------------------------
  396.  Method structure
  397.  PASS=0 
  398. P%=methodtable%
  399.   [OPT PASS
  400.         equd    0
  401. Y)        
  402. method(0,1,"GetPathname","")
  403. Z'        
  404. method(0,2,"Selection","")
  405. [(        
  406. method(0,3,"ParseQuery","")
  407. \'        
  408. method(0,4,"GetRecord","")
  409. ]'        
  410. method(0,5,"PutRecord","")
  411. ^(        
  412. method(0,6,"ExpandCode","")
  413. _&        
  414. method(0,7,"GetField","")
  415. `)        
  416. method(0,8,"GetExpanded","")
  417. a'        
  418. method(0,9,"NextMatch","")
  419. b         
  420. method(-1,-1,"","")
  421.  PASS
  422. create_windows
  423. make_menus
  424. get_defaults
  425. select(prefsW%,36):
  426. deselect(prefsW%,35):
  427. shade(prefsW%,35,
  428. select(csvW%,19):
  429. deselect(csvW%,18)
  430. scroll_icons(MaxCols%)
  431. userM%()=0
  432. banner
  433. banner
  434.  "OS_File",5,"<Pbase$Dir>.reg" 
  435.  d%=1 
  436. ("<Pbase$Dir>.reg")
  437. #F,S$:S$=
  438. encrypt(S$,
  439. u/  $
  440. text(infoW%,9)=S$:$
  441. text(bannerW%,5)=S$
  442. v1  $
  443. text(bannerW%,2)="":$
  444. text(bannerW%,3)=""
  445. w+  $
  446. text(bannerW%,4)="Registered user:"
  447. set_icon_cols(infoW%,9,23)
  448.  d%=0 
  449.  bannertime%>0 
  450. position_window(bannerW%,0,0,0,0,0,0)
  451. poll:
  452. >500 
  453.  (d%=1 
  454. >bannertime%)
  455. close_window(bannerW%)
  456. method(Flags,Token,Method$,Syntax$)
  457. [OPT PASS
  458.         equd    Flags
  459.         equd    Token
  460.          equs    Method$+
  461.          equs    Syntax$+
  462.         align
  463.     =PASS
  464. get_defaults
  465.  path$
  466. "path$="<Pbase$Dir>.Resources."
  467. get_preferences(prefsW%,path$+"Preference")
  468. get_csv_options(path$+"CSVoptions")
  469. get_options(printW%,path$+"PrtOptions")
  470. dim_arrays(F%,K%,T%,M%,C%)
  471.  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%)
  472.  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)
  473.  userM%(M%,1)
  474.  Label$(10,3)
  475.  DIM Sum(30,5)
  476.  key 256,date% 6,calcrow% F%,hide% 128
  477.  ftypeM%(6),fmenu$(6),flist%(6),choice$(4)
  478.  table$(T%+1),tableW%(T%),TabTitle%(T%)
  479.  tabfieldlen%(C%),rel%(C%),tabhead$(C%,1)
  480.  fcol%(8),ncol%(8)
  481.  Subfile%(5),filemem%(5)
  482.  buttonfield%(1,24),actionbutt%(5,1),winbuff%(4,1)
  483. MC%=30:
  484.  L%(MC%)
  485.  -------------------- Allocate buffers ------------------------------
  486. (indirectionmem%=&5000:menumem%=&1200
  487.  Mi% 20,Mo% 20
  488.  block% &1C00,iconblock% &100,paneblock% &600,savebuff% &200,choices% &100,remember% &B00
  489.  buffbase% indirectionmem%:endbuff%=buffbase%+indirectionmem%:buff%=buffbase%
  490.  menblk% menumem%:men_end%=menblk%+menumem%:menu_ptr%=menblk%
  491.  fontbuff% &100
  492.  msgbuff% &100,param$(3),att$(3)
  493.  hand% 16:$hand%="Pptr_hand,12,8"
  494.  paint% 8:$paint%="file_ff9"
  495.  writep% 16:$writep%="Pptr_write,4,4"
  496.  writenum% 20:$writenum%="Pptr_write,4,4;A0-9"
  497.  tick% 12:$tick%="Snull,yes"
  498.  dbase% 10:$dbase%="No data"
  499.  psprite% 15:$psprite%="S!Powerbase"
  500.  menspr% 20,mentxt% 1:$menspr%="Sgright,pgright;R5":$mentxt%=""
  501.  winspr% 20,wintxt% 1:$winspr%="R5;Swindow":$wintxt%=""
  502.  methodtable% 256
  503.  utctime% 5,datebuffer% 16,dateformat% 16,ordinals% 36
  504.  ------------- Indirection addresses for Heap Manager ---------------
  505.  keyanchor%(K%+1)
  506.  tabanchor%(T%),undoanchor%(T%)
  507.  printrel$(T%)
  508.  box% 16,box2% 16,matrix% 16,origin% 8
  509. init_vars
  510. /caps%=16:filemem%()=-1:dragbutt%=0:direc%=1
  511. 6firstsearch%=
  512. :firstfilter%=
  513. :sorted%=
  514. :protect%=
  515. 1getrec%=213:ClientSearch$="TRUE":ClientPtr%=0
  516. NImp_wait%=
  517. :Impref%=-1:merging%=
  518. :mergenum%=0:document$="":importingcsv%=
  519. -mergetag%=214:transtag%=215:printtag%=216
  520. 8flash%=
  521. :logosloaded%=
  522. :logging%=
  523. :acl%=
  524. :up_pend%=
  525. Gaccessbutton%=0:stop%=
  526. :customise%=
  527. :tablemenu%=0:undo%=
  528. :filter%=
  529. &displayed%=-1:scratchpad$="":k$=""
  530. ZSearch$="TRUE":Filter$="TRUE":query$="ALL":SearchKey$="":REC%=-1:usekey%=-1:useval$=""
  531. areal$="":visible$="":reform$="":val$="":calcfield%=0:savefunc$="":savetofile%=
  532. :writetable%=
  533. ?password$="":pw%=0:myref%=-1:Type%=0:fieldtype%=1:Length%=0
  534. 3printing%=
  535. :indexing%=
  536. :not%=
  537. :dontincrement%=
  538. $export%=
  539. :csvconv%=
  540. :OLE_edit%=0
  541. 'autosave%=0:autobalance%=
  542. :added%=0
  543. .present%=0:fields%=0:template%=0:adjust%=
  544. 7Listed%=
  545. :writingcsv%=
  546. :writingtext%=
  547. :calcerror%=
  548. 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
  549. $date%=
  550. "movetype%=8:movetype$="Move 
  551. vquit%=
  552. :exit%=
  553. :matching%=
  554. :newrec%=
  555. :val%=
  556. :ram%=
  557. :Access%=
  558. :Modify%=
  559. :ramwarn%=
  560. :altered%=
  561. :design%=
  562. :newtree%=
  563. /LenLine%=0:Count%=0:Start%=0:End%=0:Fptr%=0
  564. <Fieldnumber%=0:Lastwritable%=0:starthere%=-1:calclink%=0
  565. ALastTable%=-1:Tablenumber%=0:TabsLoaded$="Tables":table$()=""
  566. 5Rows%=0:TabFields%=0:Rec%=0:Match_tag%=1:fast%=10
  567. WKeys%=0:keylimit%=1:keylen%=1:LH%=90:addr=-1:file%=0:key%=0:top=8*file%+LH%:RA%=100
  568. +keyfunc$="":fieldfunc$="":Keys%=0:RU%=0
  569. Uprintorder$="":Form$="":ImpCom$="":margin$="":pitch$=
  570. (31)+"9001":format$="horiz"
  571. uon$=
  572. (27)+
  573. (%10001000)
  574. 9Filename$="":TextName$="":extrakeys$="":extratabs$=""
  575. 2months$="JanFebMarAprMayJunJulAugSepOctNovDec"
  576. 'nonleap$="312831303130313130313031"
  577. $leap$="312931303130313130313031"
  578. /gridcol%=15:showgrid%=
  579. :snapgrid%=
  580. :plot%=5
  581.  Window handling -----------------------------------------------------
  582. create_windows
  583.  "Wimp_OpenTemplate",,"<Pbase$Dir>.Resources.Templates"
  584. 'infoW%=
  585. new_window("info",sprites%)
  586. text(infoW%,7)=version$
  587. <keypadW%=
  588. new_window("keypad",sprites%):Title%=block%!72
  589. zsavesubW%=
  590. new_window("savesub",sprites%):SubName%=
  591. text(savesubW%,2):SubSprite%=
  592. val(savesubW%,0):SubTitle%=block%!72
  593. UsaveW%=
  594. new_window("save",1):SaveName%=
  595. text(saveW%,2):SaveSprite%=
  596. val(saveW%,0)
  597. xaccessW%=
  598. new_window("access",sprites%):UserID%=
  599. text(accessW%,0):Password%=
  600. text(accessW%,1):AccessTitle%=block%!72
  601. qpassW%=
  602. new_window("password",sprites%):Read%=
  603. text(passW%,2):Write%=
  604. text(passW%,3):Manager%=
  605. text(passW%,5)
  606. (aclW%=
  607. new_window("aclist",sprites%)
  608. :mainW%=
  609. new_window("main",sprites%):RecInfo%=block%!72
  610. >keyW%=
  611. new_window("keystruc",sprites%):KeyTitle%=block%!72
  612. BchangeW%=
  613. new_window("change",sprites%):ChangeTitle%=block%!72
  614. 'moveW%=
  615. new_window("move",sprites%)
  616. NtabcreateW%=
  617. new_window("tabcreate",sprites%):tabcol%=
  618. text(tabcreateW%,8)
  619. $scrollW%=
  620. new_window("scroll",0)
  621. linkW%=
  622. new_window("link",sprites%):LinkTitle%=block%!72:Tablename%=
  623. text(linkW%,0):fieldnum%=
  624. text(linkW%,2):substitute%=
  625. text(linkW%,10)
  626. VmiscW%=
  627. new_window("misc",sprites%):database%=
  628. text(miscW%,1):$database%="No data"
  629.  ic%=2 
  630. $  Date%(ic%-2)=
  631. text(miscW%,ic%)
  632.  ic%=28 
  633. (  Subfile%(ic%-28)=
  634. text(miscW%,ic%)
  635. Oused%=
  636. text(miscW%,17):filesize%=
  637. text(miscW%,18):percent%=
  638. text(miscW%,14)
  639. )printW%=
  640. new_window("print",sprites%)
  641. ;matchW%=
  642. new_window("match",sprites%):oldquery%=matchW%
  643. 'listW%=
  644. new_window("list",sprites%)
  645. XcreateW%=
  646. new_window("create",sprites%):FtitleText%=block%!72:$FtitleText%="Field 0"
  647. DescText%=
  648. text(createW%,4):TagText%=
  649. text(createW%,5):LenText%=
  650. text(createW%,6):ValText%=
  651. text(createW%,28):InsText%=
  652. text(createW%,26):Fixpt%=
  653. text(createW%,13):$Fixpt%="2"
  654. ;mintext%=
  655. text(createW%,15):maxtext%=
  656. text(createW%,25)
  657. dboxX%=
  658. text(createW%,7):boxY%=
  659. text(createW%,8):boxW%=
  660. text(createW%,9):boxH%=
  661. text(createW%,10)
  662. ArelateW%=
  663. new_window("relation",sprites%):RelTitle%=block%!72
  664. @reformW%=
  665. new_window("reform",sprites%):RefmTitle%=block%!72
  666. &colW%=
  667. new_window("cols",sprites%)
  668. VcalcW%=
  669. new_window("calc",sprites%):CalcForm%=
  670. text(calcW%,0):CalcTitle%=block%!72
  671. )labelW%=
  672. new_window("label",sprites%)
  673. -pselectW%=
  674. new_window("pselect",sprites%)
  675. FmergeW%=
  676. new_window("merge",sprites%):ImpulseApp%=
  677. text(mergeW%,9)
  678. PsizeW%=
  679. new_window("size",sprites%):Records%=
  680. text(sizeW%,1):$Records%="100"
  681.     /Increment%=
  682. text(sizeW%,3):$Increment%="25"
  683. =csvW%=
  684. new_window("csvfile",sprites%):CSVTitle%=block%!72
  685. <fkeyW%=
  686. new_window("fkey",sprites%):FkeyTitle%=block%!72
  687. 7Kpadicon%=
  688. val(fkeyW%,0):Fkeyequiv%=
  689. text(fkeyW%,3)
  690. )prefsW%=
  691. new_window("prefs",sprites%)
  692. 7datesep%=
  693. text(prefsW%,1):timesep%=
  694. text(prefsW%,4)
  695. .wc%=
  696. text(prefsW%,7):ws%=
  697. text(prefsW%,10)
  698.  mergewith%=
  699. text(prefsW%,17)
  700. 8Interval%=
  701. text(prefsW%,25):Every%=
  702. text(prefsW%,32)
  703.  StartHere%=
  704. text(prefsW%,45)
  705. )queryW%=
  706. new_window("query",sprites%)
  707. Query%=
  708. text(queryW%,0)
  709. 'helpW%=
  710. new_window("help",sprites%)
  711. +filterW%=
  712. new_window("filter",sprites%)
  713. +searchW%=
  714. new_window("search",sprites%)
  715. 'gridW%=
  716. new_window("grid",sprites%)
  717. 5gridint%=
  718. text(gridW%,8):snapint%=
  719. text(gridW%,9)
  720. +bannerW%=
  721. new_window("banner",sprites%)
  722.  "Wimp_CloseTemplate"
  723. Pactionbutt%()=matchW%,0,mergeW%,6,moveW%,7,changeW%,3,filterW%,0,savesubW%,1
  724. Gwinbuff%()=csvW%,0,passW%,500,labelW%,900,printW%,1150,prefsW%,1900
  725. scroll_icons(rows%)
  726.  I%=0 
  727.  rows%
  728.   iflags%=&0700E735
  729. #W  R%=
  730. create_icon(scrollW%,4,-I%*44-52,64,48,iflags%,"",buff%,writenum%,4):buff%+=4
  731.   iflags%=&0700E535
  732. %Y  R%=
  733. create_icon(scrollW%,66,-I%*44-52,212,48,iflags%,"",buff%,writep%,13):buff%+=13
  734. '#!block%=0:block%!4=-rows%*44-56
  735. block%!8=284:block%!12=0
  736.  "Wimp_SetExtent",scrollW%,block%
  737. new_window(name$,sp%)
  738.  handle%
  739.  "Wimp_LoadTemplate",,block%,buff%,endbuff%,fontbuff%,name$,0 
  740.  ,,buff%
  741.  name$="main" 
  742.  block%?35=winback%
  743. block%!64=sp%
  744.  "Wimp_CreateWindow",,block% 
  745.  handle%
  746. =handle%
  747. show_windows
  748. open_window(mainW%)
  749.  (present% 
  750.  7)=7 
  751. selected(passW%,9) 
  752. open_window(keypadW%)
  753.  filemem%(file%)>=0 
  754. selected (prefsW%,43) 
  755. 90    addr=filemem%(file%):
  756. display(key%,addr)
  757. :"    
  758.  addr=
  759. moveto(key%,top,1)
  760.  Listed% 
  761. open_window(listW%)
  762. store_window(wi%,buff%)
  763.  ic%,ptr%
  764. B'!block%=wi%:block%!4=ic%:ptr%=buff%
  765.  "Wimp_GetIconState",,block%
  766.  ((block%!24) 
  767.  (1<<23))=0
  768.   !ptr%=block%!24:ptr%+=4
  769.  ((block%?25) 
  770.  1)>0 
  771.  $ptr%=$
  772. text(wi%,ic%):ptr%+=
  773. ($ptr%)+1
  774. G%  !block%=wi%:ic%+=1:block%!4=ic%
  775.  "Wimp_GetIconState",,block%
  776. restore_window(wi%,buff%)
  777.  ic%,ptr%
  778. N'!block%=wi%:block%!4=ic%:ptr%=buff%
  779.  "Wimp_GetIconState",,block%
  780.  ((block%!24) 
  781.  (1<<23))=0
  782. QI  !block%=wi%:block%!4=ic%:block%!8=!ptr%:block%!12=&ffffffff:ptr%+=4
  783.  "Wimp_SetIconState",,block%
  784.  ((block%?25) 
  785.  1)>0 
  786. text(wi%,ic%)=$ptr%:ptr%+=
  787. ($ptr%)+1
  788. T%  !block%=wi%:ic%+=1:block%!4=ic%
  789.  "Wimp_GetIconState",,block%
  790. open_window(wi%)
  791. block%!0=wi%
  792.  "Wimp_GetWindowState",,block%
  793. block%!28=-1
  794. open_it(wi%)
  795. open_it(wi%)
  796.  win%
  797.  wi% 
  798.  tabcreateW%:
  799. update_pane(scrollW%,16,160,284,232,0,0)
  800.  matchW%:
  801. update_pane(queryW%,8,8,466,140,0,0):
  802. shade(queryW%,4,
  803.  changeW%:
  804. update_pane(queryW%,18,202,466,140,0,0):
  805. shade(queryW%,4,
  806.  moveW%:
  807. update_pane(queryW%,18,240,466,140,0,0):
  808. shade(queryW%,4,
  809.  savesubW%:
  810. update_pane(queryW%,10,40,466,140,0,0):
  811. redraw_icon(wi%,0):
  812. shade(queryW%,4,
  813.  filterW%:
  814. update_pane(queryW%,8,52,466,140,0,0):
  815. shade(queryW%,4,
  816.  "Wimp_OpenWindow",,block%
  817.  win%=0 
  818.  winbuff%(win%,0)=wi% 
  819. store_window(wi%,remember%+winbuff%(win%,1))
  820.  win%
  821. close_it(wi%)
  822.  wi% 
  823.  mainW%:
  824.  altered% 
  825. save_everything
  826. hide_windows:stop%=
  827.  matchW%:matching%=
  828. close_window(queryW%)
  829.  calcW%:calclink%=0
  830.  keyW%:design%=
  831. :newtree%=
  832.  mergeW%:
  833.  "Impulse_SendMessage",&200,":"+$mergewith%+"."+document$+" Edit On",,,,-1,mytask%
  834.   merging%=
  835.  tabcreateW%:
  836. close_window(scrollW%)
  837.  changeW%,moveW%,savesubW%,filterW%:
  838. close_window(queryW%)
  839. close_window(wi%)
  840.  T%=0 
  841.  LastTable%
  842.  wi%=tableW%(T%) 
  843. set_caret(mainW%,starthere%)
  844. hide_windows
  845. close_window(queryW%)
  846. close_window(keypadW%)
  847.  I%=0 
  848.  LastTable%
  849.  tableW%(I%)>0 
  850. close_window(tableW%(I%))
  851. close_window(listW%)
  852. close_window(matchW%)
  853. close_window(relateW%)
  854. close_window(keyW%)
  855. close_window(reformW%)
  856. close_window(calcW%)
  857. close_window(mergeW%)
  858. close_window(csvW%)
  859. close_window(passW%)
  860. close_window(aclW%)
  861. close_window(tabcreateW%)
  862. close_window(prefsW%)
  863. close_window(printW%)
  864. close_window(linkW%)
  865. close_window(changeW%)
  866. close_window(savesubW%)
  867. close_window(moveW%)
  868. close_window(searchW%)
  869. close_window(filterW%)
  870. close_window(helpW%)
  871. close_window(createW%)
  872. close_window(mainW%)
  873. filemem%(file%)=addr
  874. close_window(wi%)
  875. !block%=wi%
  876.  "Wimp_CloseWindow",,block%
  877. shut_window(wi%)
  878.  "Wimp_TransferBlock",mytask%,block%,mytask%,paneblock%,88
  879.  wi%=filterW% 
  880. filter_click(filterW%,1,4) 
  881. close_it(wi%)
  882.  "Wimp_TransferBlock",mytask%,paneblock%,mytask%,block%,88
  883. redraw(handle%)
  884. (margin$)
  885. !block%=handle%
  886.  "Wimp_RedrawWindow",,block% 
  887.  more%
  888. get_origin(block%,x0%,y0%)
  889.  more%
  890. draw(x0%,y0%)
  891.  "Wimp_GetRectangle",,block% 
  892.  more%
  893. get_origin(block%,
  894.  x0%,
  895.  y0%)
  896. x0%=block%!4-block%!20
  897. y0%=block%!16-block%!24
  898. draw(x0%,y0%)
  899.  TextPtr%,y1%,y2%,I%,chars%
  900.  handle% 
  901.  mainW%:
  902.  design% 
  903.  showgrid% 
  904.     int%=
  905. ($gridint%)
  906.  0,gridcol%
  907. 2    
  908.  X%=block%!4-block%!20 
  909.  block%!36 
  910.  int%
  911.       
  912.  X%,block%!8
  913.       
  914.  plot%,X%,block%!40
  915. 4    
  916.  Y%=block%!16-block%!24 
  917.  block%!32 
  918.  -int%
  919.       
  920.  block%!4,Y%
  921.       
  922.  plot%,block%!36,Y%
  923.  listW%:
  924.   y1%=-(block%!40-y0%)
  925.   y2%=-(block%!32-y0%)
  926.   y1%=y1% 
  927.  36+1
  928.   y2%=y2% 
  929.  36+1
  930. .  TextPtr%=(!textanchor%)+(y1%-1)*LenLine%
  931.  y2%>Count% 
  932.  y2%=Count%
  933.  I%=y1% 
  934. draw_line(I%)
  935.     TextPtr%+=LenLine%
  936. draw_line(Line%)
  937.  x0%,y0%-(Line%-1)*36-4
  938.  TextPtr%?L%=12 
  939.  "OS_WriteN",TextPtr%,LenLine%
  940. update_pane(wi%,x%,y%,w%,h%,xs%,ys%)
  941. newquery%=!block%
  942.  newquery%<>oldquery% 
  943. shut_window(oldquery%):oldquery%=newquery%
  944. 8!paneblock%=wi%:
  945.  "Wimp_GetWindowState",,paneblock%
  946. paneblock%!4=block%!4+x%
  947. !paneblock%!12=paneblock%!4+w%
  948. paneblock%!16=block%!16-y%
  949. !paneblock%!8=paneblock%!16-h%
  950. 'paneblock%!20=xs%:paneblock%!24=ys%
  951. "paneblock%!28=-1:block%!28=wi%
  952.  "Wimp_OpenWindow",,paneblock%
  953.  "Wimp_OpenWindow",,block%
  954.  up_pend% 
  955.  up_pend%=
  956.  "Wimp_GetWindowState",,block%
  957.  (block%!32 
  958.  (1<<18)) 
  959.  up_pend%=
  960. update_pane(wi%,x%,y%,w%,h%,xs%,ys%)
  961.  Menu handling -------------------------------------------------------
  962. make_menus
  963. fieldM%=
  964. create_menu(menu_ptr%,"Field,Index field...,#14,Global changes...,Link to table...,Combine fields...,Start editing,Remove object   ,Save contents>saveW%,Undo changes,Compact sequence")
  965. fAnalyseFunc%=
  966. menu_text(fieldM%,1):CalcFunc%=
  967. menu_text(fieldM%,4):RemoveOb%=
  968. menu_text(fieldM%,6)
  969. cvalidateM%=
  970. create_menu(menu_ptr%,"Validation,Create table...,~Display table,Show table files")
  971. esubfilenameM%=
  972. create_menu(menu_ptr%,"Subfile name,^20"):Subfilename%=
  973. menu_text(subfilenameM%,0)
  974. irenameM%=
  975. create_menu(menu_ptr%,"New name:,^10"):NewName%=
  976. menu_text(renameM%,0):$NewName%="!NewName"
  977. miscM%=
  978. create_menu(menu_ptr%,"Misc.,Move/delete...,Set passwords...,Colours!colW%,Edit template,Name subfile>subfilenameM%,Rename database>renameM%")
  979. hdelimiterM%=
  980. create_menu(menu_ptr%,"Separator,Comma,TAB,CR,_LF,^2"):Delim%=
  981. menu_text(delimiterM%,4)
  982. zterminatorM%=
  983. create_menu(menu_ptr%,"Terminator,CR,LF,LF CR,CR LF,CR CR,_LF LF,^2"):Termin%=
  984. menu_text(terminatorM%,6)
  985. printM%=
  986. create_menu(menu_ptr%,"Print,Match...,Show resources,Show jobs done,Options...,Save query!saveW%,~Numeric fields>pselectW%,~Save selection!saveW%,~Clear selection,Select all")
  987. string$="Powerbase,_Information!miscW%,Field: ''>fieldM%,Print>printM%,Validation>validateM%,Current key...,Miscellaneous>miscM%,Show keypad,~Export selected!saveW%,Export subset...,Export CSV...,CSV options...,_Undo changes,Help"
  988. ImainM%=
  989. create_menu(menu_ptr%,string$):Fieldpos%=
  990. menu_text(mainM%,1)
  991. JindextreeM%=
  992. create_menu(menu_ptr%,"Print index,Totals only,Complete")
  993. utilityM%=
  994. create_menu(menu_ptr%,"Utilities,New primary key...,Adjust format,New record format,Merge database,~Change length>sizeW%,Balance index,Print index>indextreeM%,Find duplicates")
  995. iconbarM%=
  996. create_menu(menu_ptr%,"\Powerbase,_Information>infoW%,New database!saveW%,~Utilities>utilityM%,~Close database,Preferences...,_Help,Quit")
  997. designM%=
  998. create_menu(menu_ptr%,"New database,Design field...,_Default database,Save form file!saveW%,Database size>sizeW%,_Primary key...,Grid>gridW%,Quit design")
  999. tableM%=
  1000. create_menu(menu_ptr%,"Table,Clear,Modify,Print,#15,Undo change,_Undo all,Save!saveW%,Save as CSV!saveW%"):SortTabCol%=
  1001. menu_text(tableM%,3):$SortTabCol%="Sort"
  1002. olistM%=
  1003. create_menu(menu_ptr%,"List,Save as text!saveW%,Sort   '',Scrap"):SortTextCol%=
  1004. menu_text(listM%,1)
  1005.     akeystrokeM%=
  1006. create_menu(menu_ptr%,"Keystroke,Assign>fkeyW%,Defaults,Save choices,List keys")
  1007.  --------------- Read validation strings etc -----------------------
  1008. [fmenu$()="Editable","Computed","Check-box","External","Button (1)","Button (2)","Stamp"
  1009.  I%=0 
  1010.  L% 30:flist%(I%)=L%:?L%=0
  1011. ("<Pbase$Dir>.Resources.ValStrings")
  1012. vstrings%=
  1013.  vname$(vstrings%),vtype$(vstrings%),valid%(vstrings%),rvalid%(vstrings%),hvalid%(vstrings%)
  1014.  I%=0 
  1015.  vstrings%
  1016.   valid$=
  1017. E  P%=
  1018. valid$,":"):vname$(I%)=
  1019. valid$,4,P%-4):valid$=
  1020. valid$,P%+1)
  1021. -  vtype$(I%)=
  1022. valid$,1):valid$=
  1023. valid$,3)
  1024. (valid$)+1:$V%=valid$:valid%(I%)=V%
  1025. (valid$)+1:$V%=valid$:rvalid%(I%)=V%
  1026. (valid$)+16:$V%=valid$+";Pptr_hand,12,8":hvalid%(I%)=V%
  1027.  vtype$(I%) 
  1028. Q    
  1029.  "E":fmenu$(0)+=","+vname$(I%):L%=flist%(0):N%=?L%:N%+=1:?L%=N%:L%?N%=I%
  1030. Q    
  1031.  "C":fmenu$(1)+=","+vname$(I%):L%=flist%(1):N%=?L%:N%+=1:?L%=N%:L%?N%=I%
  1032. Q    
  1033.  "T":fmenu$(2)+=","+vname$(I%):L%=flist%(2):N%=?L%:N%+=1:?L%=N%:L%?N%=I%
  1034. Q    
  1035.  "X":fmenu$(3)+=","+vname$(I%):L%=flist%(3):N%=?L%:N%+=1:?L%=N%:L%?N%=I%
  1036. Q    
  1037.  "K":fmenu$(4)+=","+vname$(I%):L%=flist%(4):N%=?L%:N%+=1:?L%=N%:L%?N%=I%
  1038. Q    
  1039.  "O":fmenu$(5)+=","+vname$(I%):L%=flist%(5):N%=?L%:N%+=1:?L%=N%:L%?N%=I%
  1040.  Q    
  1041.  "S":fmenu$(6)+=","+vname$(I%):L%=flist%(6):N%=?L%:N%+=1:?L%=N%:L%?N%=I%
  1042. close_file(V)
  1043.  I%=0 
  1044. %IftypeM%(I%)=
  1045. create_menu(menu_ptr%,fmenu$(I%)):
  1046. tick(ftypeM%(I%),0,
  1047. ybar%=144+7*44
  1048. make_user_menus
  1049.  f$,F,items%,item$,menu$,field%,N%,I%,n$,user_ptr%,blocksize%,forbidden$
  1050. wimp_error(
  1051. forbidden$=" $&%@\^:.#*|"
  1052. extend_named_sliding_block(usermenuanchor%,4)
  1053. 0+user_ptr%=!usermenuanchor%:blocksize%=4
  1054.  field%=1 
  1055.  fields%
  1056.  chartype%(field%)=33 
  1057. 3C    
  1058.  N%>MaxMenus% 
  1059.  moan_err%,
  1060. msg("Err117,"+
  1061. (MaxMenus%+1))
  1062.     n$=Tag$(field%-1)
  1063.  I%=1 
  1064. 6#      P%=
  1065. forbidden$,
  1066. n$,I%,1))
  1067. 7!      
  1068.  P%>0 
  1069. n$,I%,1)="-" 
  1070. 9#    f$=$database%+"."+n$+"menu"
  1071.     F=
  1072.     menu$="":items%=0
  1073.  F>0 
  1074.       
  1075.         item$=
  1076.         menu$+=item$+","
  1077.         items%+=1
  1078.       
  1079.       
  1080. close_file(F)
  1081.       menu$=
  1082. menu$)
  1083.       
  1084. E}      menu$=Tag$(field%-1)+" menu,Place your,menu choices,in the file,"""+n$+"menu"",which is in,the database,directory,"
  1085. F*      items%=7:P%=1:Q%=1:menu$=
  1086. menu$)
  1087.       F=
  1088.       
  1089.  Q%>0
  1090.         Q%=
  1091. menu$,",",P%)
  1092. J         
  1093. menu$,P%,Q%-P%)
  1094.         P%=Q%+1
  1095.       
  1096.       
  1097. close_file(F)
  1098. N!      
  1099.  "OS_File",18,f$,&fff
  1100. O        
  1101.     userM%(N%,0)=field%-1
  1102. Q     blocksize%+=items%*41+30
  1103. R?    
  1104. extend_named_sliding_block(usermenuanchor%,blocksize%)
  1105. S2    userM%(N%,1)=
  1106. create_menu(user_ptr%,menu$)
  1107.     N%+=1
  1108.  field%
  1109. field_menu(N%,pr%)
  1110.  F%,P%,L%,D$,F$,icptr%,textptr%,FF%
  1111. extend_named_sliding_block(fieldmenuanchor%,N%*41+30)
  1112. ]5icptr%=!fieldmenuanchor%:textptr%=icptr%+N%*24+28
  1113.  pr% 
  1114.  $icptr%="Print order" 
  1115.  $icptr%="Field list"
  1116. _Zicptr%?12=7:icptr%?13=2:icptr%?14=7:icptr%?15=0:icptr%!16=270:icptr%!20=44:icptr%!24=0
  1117. icptr%+=28
  1118.  pr% 
  1119.  I%=1 
  1120. (printorder$)-1 
  1121. d$    F%=
  1122. fnum(
  1123. printorder$,I%,2))
  1124. fieldmenu_item(F%)
  1125.  I%  
  1126.  F%=1 
  1127. fieldmenu_item(F%)
  1128. icptr%!-24=icptr%!-24 
  1129. =!fieldmenuanchor%
  1130. fieldmenu_item(F%)
  1131. get_icon_cols(mainW%,field%(F%))<>winback%*17 
  1132.   FF%+=1
  1133. r#  F$=
  1134. (FF%):F$=
  1135. (F$)," ")+F$
  1136. s7  D$=
  1137. text(mainW%,desc%(F%)),7):D$+=
  1138. (D$)," ")
  1139. t&  F$+=" "+D$+" "+Tag$(F%):L%=
  1140. u\  !icptr%=0:icptr%!4=-1:icptr%!8=&7000121:icptr%!12=textptr%:icptr%!16=-1:icptr%!20=L%+1
  1141. v!  $textptr%=F$:textptr%+=L%+1
  1142.   icptr%+=24
  1143. menu_text(menu%,item%)
  1144. ic%=menu%+28+item%*24
  1145.  ((ic%!8) 
  1146.  &100)=0 
  1147. =ic%+12 
  1148. =ic%!12
  1149. create_menu(
  1150.  menu%,list$)
  1151.  start%,choice$,entries%,item%,P%,Q%,S%,shaded%,width%,L%,LL%
  1152. start%=menu%
  1153. list$,1)="\" 
  1154.  leftmenu%=
  1155.  list$=
  1156. list$,2)
  1157. list$,",")
  1158. ($menu%=
  1159. list$,P%-1):width%=
  1160. ($menu%)
  1161. menu%?12=7:menu%?13=2
  1162. menu%?14=7:menu%?15=0
  1163. *menu%!16=width%:menu%!20=44:menu%!24=0
  1164. item%=menu%+28
  1165. list$+=","
  1166. entries%=0
  1167.   LL%=0
  1168.   Q%=P%+1
  1169.   P%=
  1170. list$,",",Q%)
  1171.  P%>0 
  1172.     !item%=0:shaded%=0
  1173.      choice$=
  1174. list$,Q%,P%-Q%)
  1175. choice$,1) 
  1176. 3      
  1177.  "~":choice$=
  1178. choice$,2):shaded%=(1<<22)
  1179. 5      
  1180.  "_":choice$=
  1181. choice$,2):?item%=?item% 
  1182. -      
  1183.  "#":LL%=
  1184. choice$,2)):choice$=""
  1185. D      
  1186.  "^":LL%=
  1187. choice$,2)):choice$="":?item%=?item% 
  1188.  (1<<2)
  1189.         
  1190.     S%=
  1191. choice$,"!")
  1192. 5    
  1193.  S%>0 
  1194.  ?item%=?item% 
  1195. choice$,S%,1)=">"
  1196.     S%=
  1197. choice$,">")
  1198.  S%=0 
  1199.       item%!4=-1
  1200.       
  1201. #      item%!4=
  1202. choice$,S%+1))
  1203.        choice$=
  1204. choice$,S%-1)
  1205.         
  1206. ,    
  1207.  LL%=0 
  1208. (choice$)+1 
  1209.  L%=LL%+1
  1210.  L%>width% 
  1211.  width%=L%
  1212.  L%>13 
  1213.  LL%>0 
  1214. I      item%!12=buff%:$buff%=choice$:buff%+=L%:item%!16=-1:item%!20=L%
  1215.       item%!8=&7000121
  1216.       
  1217.       $(item%+12)=choice$
  1218.       item%!8=&7000021
  1219.         
  1220. !    item%!8=item%!8 
  1221.  shaded%
  1222.     item%+=24
  1223.     entries%+=1
  1224.  P%=0
  1225. item%!-24=item%!-24 
  1226. menu%=item%
  1227. start%!16=width%*16+16
  1228. =start%
  1229. tick(menu%,item%,on%)
  1230. item%=menu%+28+item%*24
  1231.  on% 
  1232. :?item%=?item% 
  1233. :?item%=?item% 
  1234. tick_one(menu%,first%,last%,item%)
  1235.  I%=first% 
  1236.  last%
  1237. tick(menu%,I%,(I%=item%))
  1238. ticked(menu%,item%)
  1239. item%=menu%+28+item%*24
  1240.  (?item% 
  1241. lit(menu%,item%,on%)
  1242. item%=menu%+28+item%*24
  1243.  on% 
  1244. : item%!8=item%!8 
  1245.  (1<<22)
  1246. : item%!8=item%!8 
  1247.  (1<<22)
  1248. show_menu(menu%,x%,y%)
  1249. )menuhandle%=menu%:menux%=x%:menuy%=y%
  1250.  "Wimp_CreateMenu",,menu%,x%,y%
  1251. show_user_menu(datafield%,x%,y%)
  1252.     N%=-1
  1253.   N%+=1
  1254.  userM%(N%,0)=datafield% 
  1255.  N%=MaxMenus%
  1256.  userM%(N%,0)=datafield% 
  1257. show_menu(userM%(N%,1),x%,y%)
  1258. softerror(
  1259. (MaxMenus%+1),117)
  1260.  Icon handling -------------------------------------------------------
  1261. create_icon(whandle%,xmin%,ymin%,width%,height%,iconflags%,text$,d1%,d2%,d3%)
  1262.  handle%
  1263. block%!0=whandle%
  1264. !block%!4=xmin%:block%!8=ymin%
  1265. 2block%!12=xmin%+width%:block%!16=ymin%+height%
  1266. block%!20=iconflags%
  1267.  d1%=0 
  1268.   $(block%+24)=text$
  1269.   block%!24=d1%
  1270.   block%!28=d2%
  1271.   block%!32=d3%
  1272.  "Wimp_CreateIcon",,block% 
  1273.  handle%
  1274. =handle%
  1275. redraw_icon(wi%,ic%)
  1276. !block%=wi%:block%!4=ic%
  1277. block%!8=0:block%!12=0
  1278.  "Wimp_SetIconState",,block%
  1279. *block%!8=0:block%!12=wi%:block%!16=ic%
  1280. shade(wi%,ic%,on%)
  1281. icon_bit(22,wi%,ic%,on%)
  1282. icon_bit(bit%,wi%,ic%,on%)
  1283. !block%=wi%
  1284. block%!4=ic%
  1285.  on% 
  1286. :block%!8=0:block%!12=1<<bit%
  1287. :block%!8=1<<bit%:block%!12=1<<bit%
  1288.  "Wimp_SetIconState",,block%
  1289. select(wi%,ic%)
  1290. !block%=wi%:block%!4=ic%
  1291. "block%!8=1<<21:block%!12=1<<21
  1292.  "Wimp_SetIconState",,block%
  1293. deselect(wi%,ic%)
  1294. !block%=wi%:block%!4=ic%
  1295.  block%!8=0:block%!12=(1<<21)
  1296.  "Wimp_SetIconState",,block%
  1297. invert(wi%,ic%)
  1298. !block%=wi%:block%!4=ic%
  1299.  block%!8=(1<<21):block%!12=0
  1300.  "Wimp_SetIconState",,block%
  1301. set_icon(wi%,ic%,on%)
  1302.  on% 
  1303. select(wi%,ic%) 
  1304. deselect(wi%,ic%)
  1305. selected(wi%,ic%)
  1306. !block%=wi%:block%!4=ic%
  1307.  "Wimp_GetIconState",,block%
  1308. =((block%!24) 
  1309.  (1<<21))>0
  1310. shaded(wi%,ic%)
  1311. !block%=wi%:block%!4=ic%
  1312.  "Wimp_GetIconState",,block%
  1313. =((block%!24) 
  1314.  (1<<22))>0
  1315. selected_esg(wi%,esg%)
  1316.  "Wimp_WhichIcon",wi%,block%,&003F0000,&00200000+(esg%<<16)
  1317. =!block%
  1318. next_writable(wi%,ic%,d%,r%,wi2%,ic2%)
  1319.  P%,E%,next%
  1320.  "Wimp_WhichIcon",wi%,block%,&00C0E000,(14<<12)
  1321.   E%+=4
  1322.  block%!E%=-1
  1323.  block%!P%<>ic% 
  1324.  P%<E%
  1325.   P%+=4
  1326.  P%=E% 
  1327.  P%-=4
  1328.  r%=1 
  1329.  P%+4=E% 
  1330.  wi2%=0 
  1331.  r%=1 
  1332.  P%+4=E% 
  1333.  wi%=wi2%:next%=ic2%
  1334.  0:P%=E%
  1335.  2:P%=-4
  1336. :P%+=4*d%
  1337.  wi2%>0 
  1338.  wi%=wi2%:next%=ic2% 
  1339.  next%=!block%
  1340.  wi2%>0 
  1341.  wi%=wi2%:next%=ic2% 
  1342.  next%=block%!(E%-4)
  1343. :next%=block%!P%
  1344. set_caret(wi%,next%)
  1345. text(wi%,ic%)
  1346. !block%=wi%:block%!4=ic%
  1347.  "Wimp_GetIconState",,block%
  1348. =block%!28
  1349. val(wi%,ic%)
  1350. !block%=wi%:block%!4=ic%
  1351.  "Wimp_GetIconState",,block%
  1352. =block%!32
  1353. text_length(wi%,ic%)
  1354. !block%=wi%:block%!4=ic%
  1355.  "Wimp_GetIconState",,block%
  1356. ($(block%!28))
  1357. buffer_length(wi%,ic%)
  1358. !block%=wi%:block%!4=ic%
  1359.  "Wimp_GetIconState",,block%
  1360. =block%!36-1
  1361. set_caret(wi%,ic%)
  1362. Y0!block%=wi%:
  1363.  "Wimp_GetWindowState",,block%
  1364.  ((block%?34) 
  1365.  1)=1 
  1366.  ic%=-1 
  1367. \*    
  1368.  "Wimp_SetCaretPosition",wi%,ic%
  1369. ]        
  1370. ^G    
  1371.  "Wimp_SetCaretPosition",wi%,ic%,0,0,-1,
  1372. text_length(wi%,ic%)
  1373. alter_flags(dfg%,ffg%,bfg%)
  1374.  ic%,F%
  1375. !block%=mainW%
  1376.  ic%=0 
  1377.  fields%*2-1
  1378.   F%=(ic%+1) 
  1379. h1  block%!4=ic%:
  1380.  "Wimp_GetIconState",,block%
  1381.  (ic% 
  1382.  2)=1 
  1383.  chartype%(F%) 
  1384. kU      
  1385.  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%
  1386. l'      
  1387.  39:block%!8=ffg%:len%(F%)=0
  1388. mB      
  1389.  logosloaded% 
  1390.  block%!8=&0000611E 
  1391.  block%!8=ffg%
  1392.       
  1393. :block%!8=bfg%
  1394. o        
  1395.  block%!8=dfg%
  1396.   block%!12=&FFFFFFFF
  1397.  "Wimp_SetIconState",,block%
  1398. limit_actions(off%)
  1399. shade(keypadW%,ic%,off%)
  1400.  buttonfield%(0,ic%)>0 
  1401. shade(mainW%,field%(buttonfield%(0,ic%)),off%)
  1402.  ic%=-1
  1403. lit(fieldM%,0,off%)
  1404. lit(fieldM%,1,off%)
  1405. lit(fieldM%,2,off%)
  1406.  12,14,15,16,17,18,20,21,22,-1
  1407. identify_field(ic%)
  1408. .Fieldnumber%=0:Fieldname$="":TextLength%=0
  1409.  (ic% 
  1410.  2)=1 
  1411. !  !block%=mainW%:block%!4=ic%
  1412.  "Wimp_GetIconState",,block%
  1413.   TextLength%=block%!36-1
  1414.   Fieldnumber%=(ic%+1) 
  1415. 3  Fieldname$=$
  1416. text(mainW%,desc%(Fieldnumber%))
  1417.  Fieldname$="" 
  1418.  Fieldname$=Tag$(Fieldnumber%)
  1419. selected(prefsW%,21) 
  1420. $    
  1421.  chartype%(Fieldnumber%) 
  1422. /      
  1423.  Leave keyboard status unchanged
  1424. &      
  1425.  2,4:
  1426.  "OS_Byte",202,0,239
  1427. #      
  1428.  "OS_Byte",202,16,111
  1429.         
  1430.  "OS_Byte",118
  1431. first_writable
  1432.  I%+=1
  1433.  (vtype$(chartype%(I%))="E" 
  1434.  len%(I%)>0) 
  1435.  I%>fields%
  1436.  I%>fields% 
  1437. last_writable
  1438. I%=fields%+1
  1439.  I%-=1
  1440.  (vtype$(chartype%(I%))="E" 
  1441.  len%(I%)>0) 
  1442.  I%=0
  1443.  Mouse_click processing ----------------------------------------------
  1444. mouse(x%,y%,b%,wi%,ic%)
  1445. oldx%=x%:oldy%=y%
  1446. Cblock%!0=x%:block%!4=y%:block%!8=b%:block%!12=wi%:block%!16=ic%
  1447.  T%=0 
  1448.  LastTable%
  1449.  wi%=tableW%(T%) 
  1450.  Tablenumber%=T%
  1451.  wi% 
  1452. iconbar_click
  1453.  accessW%:accessbutton%=ic%
  1454.  aclW%:
  1455.  mainW%:
  1456. main_click(wi%,ic%,b%)
  1457.  keypadW%:
  1458. keypad_click(wi%,ic%,b%)
  1459.  saveW%,savesubW%:
  1460. save_click(wi%,ic%,b%)
  1461.  keyW%:
  1462. key_click(wi%,ic%,b%)
  1463.  tabcreateW%:
  1464. tabcreate_click(wi%,ic%,b%)
  1465.  scrollW%:
  1466. scroll_click
  1467.  linkW%:
  1468. link_to_table
  1469.  passW%:
  1470. passwords(x%,wi%,ic%,b%)
  1471.  printW%:
  1472. print_click(wi%,ic%,b%)
  1473.  matchW%:
  1474. match_click(wi%,ic%,b%)
  1475.  createW%:
  1476. create_click
  1477.  tableW%(Tablenumber%):
  1478. table_click(Tablenumber%)
  1479.  changeW%:
  1480. change_click(wi%,ic%,b%)
  1481.  moveW%:
  1482. move_click(wi%,ic%,b%)
  1483.  listW%:
  1484. list_click(x%,y%,b%,wi%)
  1485.  colW%:
  1486. set_colours(wi%,ic%,b%)
  1487.  calcW%:
  1488. calc_formula($CalcForm%)
  1489.  labelW%:
  1490. label_click(wi%,ic%,b%)
  1491.  mergeW%:
  1492. merge_click
  1493.  sizeW%:
  1494. size_click(wi%,ic%,b%)
  1495.  csvW%:
  1496. csv_click(wi%,ic%,b%)
  1497.  fkeyW%:
  1498. fkey_click(wi%,ic%,b%)
  1499.  prefsW%:
  1500. prefs_click(wi%,ic%,b%)
  1501.  queryW%:
  1502. query_click(wi%,ic%,b%)
  1503.  helpW%:
  1504. help_click(wi%,ic%,b%)
  1505.  reformW%:
  1506. reform_click(wi%,ic%,b%)
  1507.  filterW%:
  1508. filter_click(wi%,ic%,b%)
  1509.  searchW%:
  1510. search_click(wi%,ic%,b%)
  1511.  gridW%:
  1512. grid_click(wi%,ic%,b%)
  1513.  relateW%:
  1514. val_help
  1515.  pselectW%,infoW%,miscW%,bannerW%:
  1516.  ### No action on these ###
  1517. special_click
  1518. grid_click(wi%,ic%,b%)
  1519.  z%,space%,snap%
  1520. b%=(b% 
  1521.  %111)
  1522.  1,4:
  1523.  b%=4 
  1524.  z%=1 
  1525.  z%=-1
  1526.  ic% 
  1527. &    
  1528.  0:showgrid%=
  1529. selected(wi%,0)
  1530. (      
  1531.  4:gridcol%=(gridcol%+1) 
  1532. 4      
  1533.  1:gridcol%-=1:
  1534.  gridcol%<0 
  1535.  gridcol%=15
  1536.         
  1537. -    
  1538. set_icon_cols(wi%,ic%,7+gridcol%*16)
  1539.  3,4:
  1540. !    
  1541. selected_esg(wi%,1) 
  1542.       
  1543.  3:plot%=5
  1544.       
  1545.  4:plot%=21
  1546.         
  1547. D    
  1548.  5:snapgrid%=
  1549. selected(wi%,5):
  1550. shade(createW%,49,snapgrid%)
  1551. %    
  1552.  "Wimp_CreateMenu",,-1
  1553.  11,12:
  1554. >    space%=
  1555. ($gridint%):space%+=(2*z%)*((ic%=11)-(ic%=12))
  1556. <    
  1557.  space%>0 
  1558.  $gridint%=
  1559. (space%):
  1560. redraw_icon(wi%,8)
  1561.  13,14:
  1562. <    snap%=
  1563. ($snapint%):snap%+=(2*z%)*((ic%=13)-(ic%=14))
  1564. :    
  1565.  snap%>0 
  1566.  $snapint%=
  1567. (snap%):
  1568. redraw_icon(wi%,9)
  1569.  ic%>=0 
  1570. redraw(mainW%)
  1571. filter_click(wi%,ic%,b%)
  1572. b%=(b% 
  1573.  %111)
  1574.  ic% 
  1575. C    
  1576.  $Query%<>"" 
  1577.  Filter$=
  1578. parse:addr=
  1579. moveto(key%,top,1)
  1580. deselect(keypadW%,22)
  1581. F    ic%=field%(buttonfield%(0,22)):
  1582.  ic%>0 
  1583. deselect(mainW%,ic%)
  1584. *    
  1585. filter(keypadW%,
  1586. ):Filter$="TRUE"
  1587. 8    
  1588. close_it(wi%):
  1589. set_caret(mainW%,starthere%)
  1590. search_click(wi%,ic%,b%)
  1591.  searchkey%,index$,z%,addr2,oldaddr
  1592. oldaddr=addr
  1593. index$=$
  1594. text(wi%,3)
  1595.  index$<>Index$(searchkey%)
  1596.   searchkey%+=1
  1597. b%=(b% 
  1598.  %111)
  1599.  1,4:
  1600.  b%=4 
  1601.  z%=1 
  1602.  z%=-1
  1603.  ic% 
  1604.  z%=-1 
  1605. check_change
  1606. .    SearchKey$=
  1607. stripspaces($
  1608. text(wi%,1))
  1609. )    
  1610.  chartype%(KF%(searchkey%,0)) 
  1611.       
  1612.  5,50,51:
  1613. Z      
  1614. check_date(searchkey%,SearchKey$,1,date$)=
  1615.  SearchKey$=
  1616. reverse_date(date$)
  1617.         
  1618. >    
  1619.  SearchKey$<>"" 
  1620.  addr=
  1621. find(SearchKey$,searchkey%,
  1622.  searchkey%<>key% 
  1623. ,      val$=
  1624. type(key%):kl%=
  1625. (key$(key%))
  1626. *      addr2=
  1627. search(key$(key%),key%,2)
  1628.       
  1629.  addr2<0 
  1630.  /        
  1631.  7:flash%=KF%(key%,0):addr=oldaddr
  1632.         
  1633.  addr=addr2
  1634.       
  1635. #        
  1636.  b%=4 
  1637. %6      
  1638. close_it(wi%):
  1639. set_caret(mainW%,starthere%)
  1640.       
  1641. set_caret(wi%,1)
  1642. '        
  1643. ))    
  1644.  chartype%(KF%(searchkey%,0)) 
  1645. *8      
  1646.  5,50,51:SearchKey$=
  1647. reverse_date(SearchKey$)
  1648. +        
  1649. ,F    $
  1650. text(wi%,1)=SearchKey$:
  1651. redraw_icon(wi%,1):
  1652. set_caret(wi%,1)
  1653. -9    
  1654. close_it(wi%):
  1655. set_caret(mainW%,starthere%)
  1656.  11:searchkey%+=z%
  1657.  12:searchkey%-=z%
  1658.  searchkey%>Keys% 
  1659.  searchkey%=0
  1660.  searchkey%<0 
  1661.  searchkey%=Keys%
  1662. 3:  $
  1663. text(wi%,3)=Index$(searchkey%):
  1664. redraw_icon(wi%,3)
  1665. reform_click(wi%,ic%,b%)
  1666. text(wi%,7)
  1667. b%=(b% 
  1668.  %111)
  1669.  ic% 
  1670. close_window(wi%)
  1671.  reform$ 
  1672. ?(    
  1673.  "Merge":
  1674. merge_files(f$,file%)
  1675. @"    
  1676.  "Reformat":
  1677. reformat(f$)
  1678.  b%=4 
  1679. close_window(wi%)
  1680. query_click(wi%,ic%,b%)
  1681.  (b% 
  1682.  %111) 
  1683.  1,4:
  1684.  ic% 
  1685. JD    
  1686.  2:$Query%=query$:
  1687. redraw_icon(wi%,0):
  1688. set_caret(queryW%,0)
  1689.     Match_tag%=Fieldnumber%
  1690. M)    $
  1691. text(helpW%,0)=Tag$(Match_tag%)
  1692. N5    
  1693. position_window(helpW%,x%+64,y%-300,0,0,0,0)
  1694. O.    
  1695. set_caret(helpW%,6):fieldfunc$="help"
  1696. prefs_click(wi%,ic%,b%)
  1697. b%=(b% 
  1698.  %111)
  1699.  1,4:
  1700.  ic% 
  1701.  27,28,29:
  1702. [*    
  1703. shade(wi%,25,
  1704. selected(wi%,29))
  1705. \-    
  1706. shade(wi%,32,
  1707. selected(wi%,31))
  1708. ^Q    
  1709. get_preferences(prefsW%,"<Pbase$Dir>.Resources.Preference"):
  1710. redraw(wi%)
  1711. selected(wi%,35) 
  1712. a=      
  1713. save_preferences(prefsW%,$database%+".Preference")
  1714. bI      
  1715. save_preferences(prefsW%,"<Pbase$Dir>.Resources.Preference")
  1716. c        
  1717.  b%=4 
  1718.       
  1719. close_window(wi%)
  1720.       starthere%=
  1721. start_at
  1722. h'      
  1723. set_caret(mainW%,starthere%)
  1724. i        
  1725. k4    
  1726. restore_window(wi%,remember%+winbuff%(4,1))
  1727. lP    
  1728.  b%=4 
  1729. close_window(wi%):
  1730. set_caret(mainW%,starthere%) 
  1731. redraw(wi%)
  1732. m)    
  1733. auto_csv(
  1734. selected(wi%,44))
  1735. kill%=
  1736. selected(wi%,12)
  1737. q%autosave%=29-
  1738. selected_esg(wi%,2)
  1739. r"autobalance%=
  1740. selected(wi%,31)
  1741. shade(wi%,32,
  1742. selected(wi%,31))
  1743. set_icon(queryW%,1,
  1744. selected(wi%,30))
  1745. start_at
  1746.  ic%,F%,I%
  1747.  $StartHere%="":F%=
  1748. first_writable:ic%=field%(F%)
  1749. ($StartHere%)>0:F%=
  1750. ($StartHere%):ic%=F%*2-1
  1751.  I%<fields% 
  1752.  $StartHere%<>Tag$(I%)
  1753.     I%+=1
  1754.  $StartHere%=Tag$(I%) 
  1755.  vtype$(chartype%(I%))="E" 
  1756.     F%=I%:ic%=F%*2-1
  1757. ,    
  1758. first_writable:ic%=field%(F%) 
  1759. $StartHere%=Tag$(F%)
  1760. fkey_click(wi%,ic%,b%)
  1761.  z%,K$,K%,Z%
  1762. b%=(b% 
  1763.  %111)
  1764.  1,4:
  1765.  (b% 
  1766.  %111)=4 
  1767.  z%=1 
  1768.  z%=-1
  1769.  ic% 
  1770.  4,5:
  1771. #    K$=$Fkeyequiv%:K%=
  1772. K$,2))
  1773.  ic% 
  1774.       
  1775.  4:K%+=z%
  1776.       
  1777.  5:K%-=z%
  1778.         
  1779.  K%=12 
  1780.  K%=0
  1781.  K%<0 
  1782.  K%=11
  1783. )    
  1784.  K%=0 
  1785.  K$="None" 
  1786.  K$="F"+
  1787. *    $Fkeyequiv%=K$:
  1788. redraw_icon(wi%,3)
  1789. #    K$=$Fkeyequiv%:K%=
  1790. K$,2))
  1791.  K%>0 
  1792.       
  1793.  K%>9 
  1794.  K%+=64
  1795. %      
  1796. selected(wi%,1) 
  1797.  K%+=16
  1798. %      
  1799. selected(wi%,2) 
  1800.  K%+=32
  1801.       K%+=384
  1802. >      Z%=
  1803. key_assigned(K%):
  1804.  Z%<>-1 
  1805.  buttonfield%(1,Z%)=0
  1806.         
  1807.      buttonfield%(1,kpad%)=K%
  1808. -    
  1809.  kpad%=13 
  1810.  buttonfield%(1,23)=K%+16
  1811. -    
  1812.  kpad%=14 
  1813.  buttonfield%(1,24)=K%+16
  1814. )    
  1815.  b%=4 
  1816.  "Wimp_CreateMenu",,-1
  1817. $    
  1818.  "Wimp_CreateMenu",,-1
  1819. change_click(wi%,ic%,b%)
  1820. b%=(b% 
  1821.  %111)
  1822.  ic% 
  1823. I    
  1824. changes(key%,Menufield%,$
  1825. text(changeW%,0),$
  1826. text(changeW%,1),
  1827.  b%=4 
  1828. close_it(wi%)
  1829. %    
  1830. set_caret(mainW%,starthere%)
  1831. 8    
  1832. close_it(wi%):
  1833. set_caret(mainW%,starthere%)
  1834. move_click(wi%,ic%,b%)
  1835. b%=(b% 
  1836.  %111)
  1837.  ic% 
  1838. 8    
  1839.  0,1,2:
  1840. shade(moveW%,6,
  1841. set_caret(queryW%,0)
  1842. 3    
  1843. shade(moveW%,6,
  1844. set_caret(moveW%,6)
  1845. &    
  1846.  undo% 
  1847. save_keys:undo%=
  1848. %    
  1849. move_records(key%,file%,top)
  1850. (    
  1851. read(fields%,
  1852. ,REC%,$database%)
  1853.      addr=
  1854. moveto(key%,top,1)
  1855. @    
  1856.  b%=4 
  1857. close_it(moveW%):
  1858. set_caret(mainW%,starthere%)
  1859.  undo% 
  1860. 3      
  1861. open_index($database%+".PrimaryKey",0,
  1862. #      f$=$database%+".Indices."
  1863.       
  1864.  Keys%>0 
  1865.         
  1866.  K%=1 
  1867.  Keys%
  1868. -          
  1869. open_index(f$+Index$(K%),K%,
  1870.         
  1871.       
  1872.       undo%=
  1873.         
  1874. @    
  1875.  b%=4 
  1876. close_it(moveW%):
  1877. set_caret(mainW%,starthere%)
  1878. <    
  1879. close_it(moveW%):
  1880. set_caret(mainW%,starthere%)
  1881. csv_click(wi%,ic%,b%)
  1882. b%=(b% 
  1883.  %111)
  1884.  2,4:
  1885.  ic% 
  1886. 5    
  1887. show_menu(delimiterM%,oldx%+32,oldy%+16)
  1888. 6    
  1889. show_menu(terminatorM%,oldx%+32,oldy%+16)
  1890.  1,4:
  1891.  ic% 
  1892. ,    
  1893. shade(wi%,4,(
  1894. selected(wi%,1)))
  1895. "    
  1896. text(wi%,9)="Import" 
  1897.       
  1898.  csvfunc$ 
  1899. 7        
  1900.  "ImportMain":
  1901. convert_csv($
  1902. text(wi%,13))
  1903. F        
  1904.  "ImportTable":
  1905. csv_to_table(Tablenumber%,$
  1906. text(wi%,13))
  1907.       
  1908.         
  1909. %    
  1910.  b%=4 
  1911. close_window(csvW%)
  1912. d    
  1913. restore_window(wi%,remember%+winbuff%(0,1)):
  1914.  b%=4 
  1915. close_window(wi%) 
  1916. redraw(wi%)
  1917. selected(wi%,18) 
  1918. ?      
  1919. save_csv_options("<Pbase$Dir>.Resources.CSVoptions")
  1920. 7      
  1921. save_csv_options($database%+".CSVoptions")
  1922.         
  1923. A    
  1924. get_csv_options("<Pbase$Dir>.Resources.CSVoptions")
  1925. 7    
  1926. selected(csvW%,24) 
  1927. softerror("",132)
  1928. merge_click
  1929.  merging% 
  1930.  ic%<>4 
  1931.  ic%<>5 
  1932. finished%=
  1933.  (b% 
  1934.  %111)=4 
  1935.  z%=1 
  1936.  z%=-1
  1937.  ic% 
  1938.  "Impulse_SendMessage",&201,":"+$mergewith%+"."+document$+" Print",,,,printtag%,mytask%
  1939.   merging%=
  1940.   $mergewith%=$ImpulseApp%
  1941.  "Impulse_SendMessage",&200,":"+$mergewith%+"."+document$+" Edit Off",,,,-1,mytask%
  1942. H  mergenum%=0:$
  1943. text(mergeW%,7)=
  1944. (mergenum%):
  1945. redraw_icon(mergeW%,7)
  1946. selected(queryW%,4) 
  1947.  direction%=-1 
  1948.  direction%=1
  1949. 4  addr=
  1950. neighbour(key%,addr,(-direction%+1) 
  1951. (  addr=
  1952. moveto(key%,addr,direction%)
  1953. close_file(dbasehandle%):addr=ClientPtr%:
  1954. close_it(mergeW%)
  1955.  "Impulse_SendMessage",&200,":"+$mergewith%+"."+document$+" ClearMerge",,,,-1,mytask%
  1956.  "Impulse_SendMessage",&200,":"+$mergewith%+"."+document$+" Edit On",,,,-1,mytask%
  1957.  12:merging%=
  1958. deselect(mergeW%,3)
  1959. size_click(wi%,ic%,b%)
  1960.  recs$,int$
  1961. recs$=
  1962. (RA%)
  1963. keybase%=!keyanchor%(0)
  1964.  keybase%!4>0 
  1965.  inc$=
  1966. (keybase%!4) 
  1967.  inc$="0"
  1968. b%=(b% 
  1969.  %111)
  1970.  1,4:
  1971.  ic% 
  1972.       
  1973. ($Records%)<=0:
  1974.       
  1975. softerror("",71)
  1976. 0      $Records%=recs$:
  1977. redraw_icon(sizeW%,1)
  1978.       
  1979. ($Increment%)<0
  1980.       
  1981. softerror("",72)
  1982. 1      $Increment%=inc$:
  1983. redraw_icon(sizeW%,3)
  1984.       
  1985. !#      keybase%!4=
  1986. ($Increment%)
  1987. "7      
  1988.  present%=7 
  1989. change_length(
  1990. ($Records%),
  1991. #+      
  1992.  b%=4 
  1993.  "Wimp_CreateMenu",,-1
  1994. $        
  1995. &(    $Records%=recs$:$Increment%=inc$
  1996. '     
  1997.  "Wimp_CreateMenu",,-1
  1998. table_click(T%)
  1999.  S$,tablefield%
  2000. .`NewTab%=(
  2001. table_info(T%,Rows%,TabFields%,Rec%,tabfieldlen%(),offset%,heading%,colours$)="
  2002. /*extra%=-NewTab%*(Rows%*(TabFields%+1))
  2003. lit(tableM%,1,NewTab% 
  2004.  Modify%)
  2005. $tableM%=table$(T%)
  2006.  ic%>=0 
  2007. 3(  tablefield%=(ic% 
  2008.  (TabFields%+1))
  2009.  tablefield%=0
  2010.  2047 
  2011.  ic%<Rows%*(TabFields%+1) 
  2012. 9%    
  2013.  chartype%(Fieldnumber%)<4 
  2014. :(      scratchpad$=$Rf%(Fieldnumber%)
  2015. ;$      S$=$
  2016. text(tableW%(T%),ic%)
  2017. <'      
  2018. (S$)<=len%(Fieldnumber%) 
  2019. =!        $Rf%(Fieldnumber%)=S$
  2020. >5        
  2021. redraw_icon(mainW%,field%(Fieldnumber%))
  2022.       
  2023. @        
  2024.  1024:
  2025.  ic%<Rows%*(TabFields%+1) 
  2026.  Access%=
  2027. D<    !block%=tableW%(T%):
  2028.  "Wimp_GetWindowState",,block%
  2029. EQ    
  2030.  "Wimp_SetCaretPosition",tableW%(T%),ic%,x%-block%!4+block%!20,y%,-1,-1
  2031. asterisk(
  2032. I'  sort_tabcol%=ic% 
  2033.  (TabFields%+1)
  2034.  sort_tabcol%>=0 
  2035. lit(tableM%,3,Access%)
  2036.  NewTab% 
  2037. MB      h$=$
  2038. text(tableW%(T%),Rows%*(TabFields%+1)+sort_tabcol%)
  2039. N%      $SortTabCol%="Sort "+
  2040. h$,9)
  2041. O7      
  2042.  $SortTabCol%="Sort column "+
  2043. (sort_tabcol%)
  2044. P        
  2045. lit(tableM%,3,
  2046. lit(tableM%,7,
  2047. selected(passW%,13))
  2048. lit(tableM%,6,
  2049. selected(passW%,13))
  2050. show_menu(tableM%,x%-64,y%-20)
  2051.  256:
  2052. invert(wi%,tablefield%+extra%)
  2053. X@  field$=
  2054. (tablefield%):
  2055.  tablefield%<10 
  2056.  field$="0"+field$
  2057.   field$+=":"
  2058. selected(wi%,tablefield%+extra%) 
  2059.     printrel$(T%)+=field$
  2060. \        
  2061. ]!    P%=
  2062. printrel$(T%),field$)
  2063. ^?    printrel$(T%)=
  2064. printrel$(T%),P%-1)+
  2065. printrel$(T%),P%+3)
  2066. scroll_click
  2067.  (b% 
  2068.  %111)=2 
  2069. row%=(ic% 
  2070. f0$tabcol%=
  2071. (row%):
  2072. redraw_icon(tabcreateW%,8)
  2073. list_click(x%,y%,b%,wi%)
  2074.  N%,last%
  2075.  (b% 
  2076.  %111) 
  2077.   !block%=wi%
  2078.  "Wimp_GetWindowState",,block%
  2079. o*  column%=(x%-block%!4+block%!20) 
  2080. p(  last%=
  2081. (Form$) 
  2082.  2:sort_textcol%=0
  2083.  last%>0 
  2084. r        
  2085.       sort_textcol%+=1
  2086. t=    
  2087.  Tab%(sort_textcol%)>column%+1 
  2088.  sort_textcol%=last%
  2089. uW    sort_textcol%-=1:$SortTextCol%="Sort "+Tag$(
  2090. ("&"+
  2091. Form$,sort_textcol%*2+1,2)))
  2092. lit(listM%,0,
  2093. selected(passW%,13))
  2094. show_menu(listM%,x%-64,y%-20)
  2095.  1,4:
  2096.  sorted% 
  2097.     !block%=wi%
  2098. |(    
  2099.  "Wimp_GetWindowState",,block%
  2100. }.    line%=(block%!16-block%!24-y%+36) 
  2101. ~,    column%=(x%-block%!4+block%!20) 
  2102.     RecPtr%=!recanchor%
  2103.     R%=RecPtr%!(line%*4)
  2104.     last%=
  2105. (Form$) 
  2106.  R%>=0 
  2107. &      addr=
  2108. find("#"+
  2109. (R%),key%,
  2110.       
  2111.  format$ 
  2112.         
  2113.  "horiz","table"
  2114.         
  2115.           N%+=1
  2116. +        
  2117.  Tab%(N%)>column%+1 
  2118.  N%=last%
  2119. &        F%=
  2120. fnum(
  2121. Form$,N%*2-1,2))
  2122.         
  2123.  "vert":
  2124.         
  2125.           N%+=1:line%-=1
  2126. .        
  2127.  RecPtr%!(line%*4)<>R% 
  2128.  N%=last%
  2129. &        F%=
  2130. fnum(
  2131. Form$,N%*2-1,2))
  2132. $        
  2133.  "tree":F%=KF%(tkey%,0)
  2134.         
  2135.  "dup":F%=KF%(0,0)
  2136.       
  2137.        
  2138.  F%>0 
  2139.  F%<=fields% 
  2140. )        
  2141.  vtype$(chartype%(F%))="E" 
  2142. ;          
  2143. set_caret(mainW%,field%(F%)):Fieldnumber%=F%
  2144. E          
  2145. set_caret(mainW%,starthere%):Fieldnumber%=starthere%
  2146.         
  2147.         
  2148.  (b% 
  2149.  %111)=4 
  2150. "          
  2151. open_window(mainW%)
  2152.           
  2153. N          !block%=mainW%:block%!4=desc%(F%):
  2154.  "Wimp_GetIconState",,block%
  2155. L          xmin%=block%!8:ymin%=block%!12:xmax%=block%!16:ymax%=block%!20
  2156. @          block%!4=field%(F%):
  2157.  "Wimp_GetIconState",,block%
  2158. @          w%=block%!16-block%!8+16:h%=block%!20-block%!12+16
  2159. 6          scrollx%=block%!8-8:scrolly%=block%!20+8
  2160.           
  2161. G            
  2162.  xmax%<block%!8:w%=block%!16-xmin%+16:scrollx%=xmin%-8
  2163. 6            
  2164.  xmin%>block%!16:w%=xmax%-block%!8+16
  2165. 7            
  2166.  ymax%<block%!12:h%=block%!20-ymin%+16
  2167. H            
  2168.  ymin%>block%!20:h%=ymax%-block%!12+16:scrolly%=ymax%+8
  2169.           
  2170. V          
  2171. position_window(mainW%,x%-(w% 
  2172.  2),y%-(h% 
  2173.  2),w%,h%,scrollx%,scrolly%)
  2174.         
  2175.       
  2176.         
  2177. softerror("",61)
  2178. match_click(wi%,ic%,b%)
  2179.  not%,and%,or%
  2180. b%=(b% 
  2181.  %111)
  2182. selected_esg(printW%,4) 
  2183.  38:reportdest$="Window"
  2184.  39:reportdest$="File"
  2185.  41:reportdest$="Printer"
  2186.  ic% 
  2187. [    
  2188.  2:TextName$=$database%+".PrintJobs."+key$(0):
  2189. do_it("",REC%):$SaveName%=TextName$
  2190. Q    
  2191. shade(wi%,4,
  2192. selected(wi%,ic%)):
  2193. shade(wi%,6,
  2194. selected(wi%,ic%))
  2195. 8    
  2196. close_it(wi%):
  2197. set_caret(mainW%,starthere%)
  2198. $    Search$=
  2199. parse:displayed%=-1
  2200.  Search$<>"FALSE" 
  2201. B      $Query%="":
  2202. redraw_icon(queryW%,0):
  2203. set_caret(queryW%,0)
  2204. M      TextName$=$database%+".PrintJobs."+
  2205. query$,10):$SaveName%=TextName$
  2206.       
  2207.  reportdest$ 
  2208. !        
  2209.  "Window","Printer":
  2210. &        
  2211. do_it(Search$,displayed%)
  2212.         
  2213.  "File":
  2214. !        savefunc$="Save list"
  2215. 6        $SaveSprite%="sfile_fff;Pptr_hand,12,8;R2"
  2216. :        
  2217. position_window(saveW%,x%-138,y%-130,0,0,0,0)
  2218.          
  2219. set_caret(saveW%,2)
  2220.       
  2221.         
  2222. R    
  2223.  b%=4 
  2224. selected(wi%,3) 
  2225. close_it(wi%):
  2226. set_caret(mainW%,starthere%)
  2227. P    
  2228. show_menu(
  2229. field_menu(fields%,(printorder$<>"")),oldx%+32,oldy%+16)
  2230. help_click(wi%,ic%,b%)
  2231. butt%=(b% 
  2232.  %111)
  2233.  butt% 
  2234.  2,4:
  2235. '  fieldmenu%=
  2236. field_menu(fields%,
  2237. tick_one(fieldmenu%,0,fields%-1,Match_tag%-1)
  2238.  ic%=19 
  2239. show_menu(fieldmenu%,oldx%+32,oldy%+16)
  2240.  butt% 
  2241.  1,4:
  2242.  ic% 
  2243. W    
  2244.  1:new$="NOT (":$Query%+=new$:
  2245. redraw_icon(queryW%,0):
  2246. set_caret(wi%,6):not%=
  2247. P    
  2248.  9:new$=" AND ":$Query%+=new$:
  2249. redraw_icon(queryW%,0):
  2250. set_caret(wi%,6)
  2251. P    
  2252.  10:new$=" OR ":$Query%+=new$:
  2253. redraw_icon(queryW%,0):
  2254. set_caret(wi%,6)
  2255.  16,17:
  2256. 8    
  2257.  (b% 
  2258.  %111)=4 
  2259.  z%=1 
  2260.  (b% 
  2261.  %111)=1 
  2262.  z%=-1
  2263. 2    
  2264.  ic%=16 
  2265.  Match_tag%+=z% 
  2266.  Match_tag%-=z%
  2267. +    
  2268.  Match_tag%>fields% 
  2269.  Match_tag%=1
  2270. +    
  2271.  Match_tag%<1 
  2272.  Match_tag%=fields%
  2273. :    $
  2274. text(wi%,0)=Tag$(Match_tag%):
  2275. redraw_icon(wi%,0)
  2276. A    
  2277.  21:$Query%="":
  2278. redraw_icon(queryW%,0):
  2279. set_caret(wi%,6)
  2280.      op%=
  2281. selected_esg(wi%,1)
  2282.  op% 
  2283.       
  2284.  2:op$="="
  2285.       
  2286.  3:op$="{"
  2287.       
  2288.  4:op$="<"
  2289.       
  2290.  5:op$=">"
  2291.       
  2292.  11:op$="<>"
  2293.       
  2294.  13:op$=">="
  2295.       
  2296.  14:op$="<="
  2297.       
  2298.  15:op$="}{"
  2299.         
  2300.     tag$=$
  2301. text(wi%,0)
  2302.     contents$=$
  2303. text(wi%,6)
  2304.     new$=tag$+op$+contents$
  2305. E    $Query%+=new$:
  2306.  not%=
  2307. $Query%)<>")" 
  2308.  $Query%+=")":not%=
  2309. redraw_icon(queryW%,0)
  2310. >    $
  2311. text(wi%,6)="":
  2312. redraw_icon(wi%,6):
  2313. set_caret(wi%,6)
  2314. 4    
  2315. close_it(helpW%):
  2316. set_caret(queryW%,0)
  2317. iconbar_click
  2318.  %111 
  2319. selected(passW%,12) 
  2320. close_window(saveW%)
  2321. )    
  2322. show_menu(iconbarM%,x%-64,ybar%)
  2323.  $dbase%="No data" 
  2324.     $SaveName%="!DataBase"
  2325. 2    $SaveSprite%="snew_appl;Pptr_hand,12,8;R2"
  2326.     savefunc$=choice$(1)
  2327.     1    
  2328.  "Wimp_CreateMenu",,saveW%,x%-50,y%+300
  2329. show_windows
  2330. main_click(wi%,ic%,b%)
  2331.  P%,F%,H$,L%,T%,N$,field$
  2332.  present%=7 
  2333.  adjust%=
  2334. validate(Fieldnumber%,T%,N$)=
  2335.  changed%=
  2336. update_calcs(Fieldnumber%)
  2337.  flash% 
  2338. deselect(wi%,field%(flash%)):flash%=
  2339.  OLE_edit%>0:
  2340. show_text_block(OLE_edit%)
  2341.  OLE_edit%<0:
  2342. show_picture(-OLE_edit%)
  2343.  OLE_edit%<>0 
  2344. redraw_icon(wi%,field%(
  2345. (OLE_edit%))):OLE_edit%=0
  2346.  present% 
  2347.  0,3:
  2348. design_field(b%,ic%,
  2349. first_writable>0 
  2350. default_key
  2351. design_field(b%,ic%,
  2352.  5,7:
  2353.  adjust% 
  2354. design_field(b%,ic%,
  2355.          
  2356. identify_field(ic%)
  2357. ",    
  2358. selected(prefsW%,19) 
  2359. relations
  2360.  2047 
  2361.       
  2362. %&      
  2363.  chartype%(Fieldnumber%) 
  2364. &B        
  2365. show_user_menu(Fieldnumber%-1,oldx%+32,oldy%+16)
  2366. 'y        
  2367.  9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31:
  2368. fkey_status(chartype%(Fieldnumber%)-9)
  2369.         
  2370. )!        
  2371. close_window(saveW%)
  2372. *.        
  2373. selected(passW%,11) 
  2374.  Modify% 
  2375. +           
  2376. set_up_field_menu
  2377. ,,          
  2378. show_menu(mainM%,x%-64,y%-20)
  2379.         
  2380.       
  2381.       
  2382. 0&      
  2383.  chartype%(Fieldnumber%) 
  2384. 1J        
  2385.  0,1,2,3,4,5,6,7,8,39,46,47,48,49,50,51,52,53,54,55,56,57,58:
  2386. 2H        
  2387.  "Wimp_GetCaretPosition",,block%:first%=((block%!4)+2) 
  2388. 30        
  2389. select_range(first%,Fieldnumber%,
  2390. 4}        
  2391.  9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30:
  2392. keypad_click(wi%,chartype%(Fieldnumber%)-9,1)
  2393. 5G        
  2394. filter(wi%,
  2395. selected(wi%,field%(buttonfield%(0,22))))
  2396.         
  2397.  36,41,42,43:
  2398.         
  2399. invert(wi%,ic%)
  2400. 8(        col%=
  2401. get_icon_cols(wi%,ic%)
  2402. 94        col%=((col%>>4) 
  2403.  (col%<<4)) 
  2404.  %11111111
  2405. :(        
  2406. set_icon_cols(wi%,ic%,col%)
  2407. ;%        boxon%=((col% 
  2408.  %1111)<2)
  2409. <%        
  2410. update_selection(boxon%)
  2411.       
  2412.       
  2413.       
  2414. (-1) 
  2415. @(        
  2416.  chartype%(Fieldnumber%) 
  2417.           
  2418.  9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30:
  2419. keypad_click(wi%,chartype%(Fieldnumber%)-9,4)
  2420. BI          
  2421. filter(wi%,
  2422. selected(wi%,field%(buttonfield%(0,22))))
  2423. CA          
  2424. selected(passW%,14) 
  2425. match(x%-396,y%-131)
  2426. DD          
  2427. show_user_menu(Fieldnumber%-1,oldx%+32,oldy%+16)
  2428.           
  2429.           
  2430.  45:quit%=
  2431. G.          
  2432. execute_file(Fieldnumber%)
  2433.           
  2434. link$(Fieldnumber%),1)="@" 
  2435.  "OS_CLI","Filer_OpenDir "+
  2436. link$(Fieldnumber%),2)+" "+
  2437. (oldx%)+" "+
  2438. (oldy%)+" "+dirdisp$ 
  2439. softerror("",91)
  2440. It          
  2441.  36,39:
  2442. (-2) 
  2443. enter_tag 
  2444. edit_blob(Fieldnumber%,chartype%(Fieldnumber%)):OLE_edit%=Fieldnumber%
  2445. JF          
  2446.  37,38:
  2447. edit_blob(Fieldnumber%,chartype%(Fieldnumber%))
  2448. K[          
  2449. edit_blob(Fieldnumber%,chartype%(Fieldnumber%)):OLE_edit%=-Fieldnumber%
  2450.           
  2451.  41,42,43:
  2452. M,          
  2453.  Access% 
  2454. invert(wi%,ic%)
  2455.           
  2456. (-2) 
  2457. O,            
  2458.  Access% 
  2459. invert(wi%,ic%)
  2460.             
  2461. enter_tag
  2462.             
  2463. RU            
  2464. selected(wi%,ic%) 
  2465.  $Rf%(Fieldnumber%)=" " 
  2466.  $Rf%(Fieldnumber%)=""
  2467.           
  2468.           
  2469. relations
  2470.         
  2471. V#        
  2472. lookup(Fieldnumber%)
  2473.       
  2474.       
  2475.  256:
  2476. Y&      
  2477.  chartype%(Fieldnumber%) 
  2478. ZJ        
  2479.  0,1,2,3,4,5,6,7,8,39,46,47,48,49,50,51,52,53,54,55,56,57,58:
  2480. [k        
  2481. get_icon_cols(wi%,ic%)<>winback%*17 
  2482. invert(wi%,ic%):
  2483. update_selection(
  2484. selected(wi%,ic%))
  2485.       
  2486.       
  2487.  1024:
  2488.       
  2489. (-2) 
  2490.         
  2491. enter_tag
  2492.         
  2493. a(        
  2494.  chartype%(Fieldnumber%) 
  2495.           
  2496.  0,1,2,3,4,5,8:
  2497. cG          
  2498.  Fieldnumber%>0 
  2499. get_icon_cols(wi%,ic%)<>winback%*17 
  2500. d<            !block%=wi%:
  2501.  "Wimp_GetWindowState",,block%
  2502. e]            
  2503.  Access% 
  2504.  "Wimp_SetCaretPosition",wi%,ic%,x%-block%!4+block%!20,y%,-1,-1
  2505.           
  2506.         
  2507.       
  2508. i        
  2509. enter_tag
  2510.  wi%,S$
  2511.  "Wimp_GetCaretPosition",,block%
  2512. q+wi%=!block%:ic%=block%!4:pos%=block%!20
  2513. text(wi%,ic%)
  2514. s/S$=
  2515. S$,pos%)+Tag$(Fieldnumber%)+
  2516. S$,pos%+1)
  2517. text(wi%,ic%)=S$
  2518. redraw_icon(wi%,ic%)
  2519. set_caret(wi%,ic%)
  2520. set_up_field_menu
  2521.  I%,tabmen%,V%
  2522. tabmen%=(LastTable%<>-1)
  2523.  tabmen% 
  2524. tick_one(tablemenu%,0,LastTable%,LastTable%+1)
  2525. V%=chartype%(Fieldnumber%)
  2526.  Fieldnumber%>0 
  2527. get_icon_cols(wi%,ic%)<>winback%*17 
  2528.   Menufield%=Fieldnumber%
  2529. lit(mainM%,1,
  2530.   $AnalyseFunc%="Analyse"
  2531. E  $Fieldpos%="Field: "+Tag$(Fieldnumber%):Menufield%=Fieldnumber%
  2532. &  $LinkTitle%="Field: "+Fieldname$
  2533. '  $CalcForm%=Tag$(Fieldnumber%)+"="
  2534.  I%=0 
  2535. lit(fieldM%,I%,
  2536.  5,50,51:
  2537. $    isadate%=
  2538. lit(fieldM%,1,
  2539. &    $AnalyseFunc%="Analyse months"
  2540. :isadate%=
  2541. is_a_key(Fieldnumber%)>=0 
  2542. lit(fieldM%,1,
  2543. _    
  2544.  isadate%=
  2545. selected(mainW%,field%(Fieldnumber%)) 
  2546.  $AnalyseFunc%="Analyse index"
  2547.  0,1,2,3,4,5,8:
  2548. lit(fieldM%,0,Access%)
  2549. lit(fieldM%,2,Access%)
  2550. )    
  2551. lit(fieldM%,3,Access% 
  2552.  tabmen%)
  2553. lit(fieldM%,5,Access%)
  2554. lit(fieldM%,8,
  2555.  I%=0 
  2556.       keyfield%(I%)=0
  2557.       
  2558.  J%=12 
  2559. $        $
  2560. text(keyW%,4*I%+J%)=""
  2561.       
  2562. !    keyfield%(0)=Fieldnumber%
  2563. +    $
  2564. text(keyW%,12)=Tag$(Fieldnumber%)
  2565.     $
  2566. text(keyW%,14)="L"
  2567. .    $
  2568. text(keyW%,15)=
  2569. (len%(Fieldnumber%))
  2570. 1    keylimit%=TextLength%:$
  2571. text(keyW%,29)=""
  2572.     keylen%=keylimit%
  2573. *    $ChangeTitle%="Field: "+Fieldname$
  2574. 3    $
  2575. text(changeW%,0)="":$
  2576. text(changeW%,1)=""
  2577. link_status
  2578. lit(fieldM%,4,Modify%)
  2579. )    
  2580. lit(fieldM%,3,Access% 
  2581.  tabmen%)
  2582. lit(fieldM%,2,Access%)
  2583. '    
  2584. calc_link("Calculations...",6)
  2585. link_status
  2586. lit(fieldM%,4,Modify%)
  2587. )    
  2588. lit(fieldM%,3,Access% 
  2589.  tabmen%)
  2590. lit(fieldM%,2,Access%)
  2591. )    
  2592. calc_link("Combine fields...",7)
  2593. link_status
  2594. 1    
  2595.  46,47,48,49,50,51,52,53,54,55,56,57,58:
  2596.  V%=47 
  2597. !      
  2598. lit(fieldM%,4,Modify%)
  2599. !      
  2600. lit(fieldM%,9,Modify%)
  2601. )      
  2602. calc_link("Set base value",47)
  2603.         
  2604. lit(fieldM%,0,Access%)
  2605.  I%=0 
  2606.       keyfield%(I%)=0
  2607.       
  2608.  J%=12 
  2609. $        $
  2610. text(keyW%,4*I%+J%)=""
  2611.       
  2612. !    keyfield%(0)=Fieldnumber%
  2613. +    $
  2614. text(keyW%,12)=Tag$(Fieldnumber%)
  2615.     $
  2616. text(keyW%,14)="L"
  2617. .    $
  2618. text(keyW%,15)=
  2619. (len%(Fieldnumber%))
  2620. 1    keylimit%=TextLength%:$
  2621. text(keyW%,29)=""
  2622.     keylen%=keylimit%
  2623.  36,39:
  2624. D    
  2625. blob_path(
  2626. ,$database%,REC%,Fieldnumber%,V%,object$)>=0 
  2627. &      $RemoveOb%="Remove external"
  2628. !      
  2629. lit(fieldM%,6,Access%)
  2630. .      
  2631. lit(fieldM%,7,
  2632. selected(passW%,13))
  2633.       $SaveName%="TextFile"
  2634. 4      $SaveSprite%="sfile_fff;Pptr_hand,12,8;R2"
  2635.       savefunc$="Save text"
  2636.         
  2637.  37,40:
  2638. D    
  2639. blob_path(
  2640. ,$database%,REC%,Fieldnumber%,V%,object$)>=0 
  2641. &      $RemoveOb%="Remove external"
  2642. !      
  2643. lit(fieldM%,6,Access%)
  2644.       
  2645. lit(fieldM%,7,
  2646.       $SaveName%="Sprite"
  2647. 4      $SaveSprite%="sfile_ff9;Pptr_hand,12,8;R2"
  2648. !      savefunc$="Save sprite"
  2649.         
  2650. D    
  2651. blob_path(
  2652. ,$database%,REC%,Fieldnumber%,V%,object$)>=0 
  2653. &      $RemoveOb%="Remove external"
  2654. !      
  2655. lit(fieldM%,6,Access%)
  2656.       
  2657. lit(fieldM%,7,
  2658.       $SaveName%="DrawFile"
  2659. 4      $SaveSprite%="sfile_aff;Pptr_hand,12,8;R2"
  2660.       savefunc$="Save draw"
  2661.         
  2662. %    $RemoveOb%="Unlink directory"
  2663. ;    
  2664.  link$(Fieldnumber%)<>"" 
  2665. lit(fieldM%,6,Access%)
  2666.      $RemoveOb%="Unlink file"
  2667. ;    
  2668.  link$(Fieldnumber%)<>"" 
  2669. lit(fieldM%,6,Access%)
  2670. lit(mainM%,1,
  2671. ):$Fieldpos%="Field: ''"
  2672. update_selection(add%)
  2673.  P%,SP%,F%,SF%
  2674. >F%=Fieldnumber%:SF%=(F% 
  2675.  128):
  2676. (printorder$)=0 
  2677.  SF%=F%
  2678. -field$=
  2679. ~(F%):
  2680.  F%<16 
  2681.  field$="0"+field$
  2682. 2sfield$=
  2683. ~(SF%):
  2684.  SF%<16 
  2685.  sfield$="0"+sfield$
  2686.  add% 
  2687. (-1) 
  2688.  printorder$+=sfield$ 
  2689.  printorder$+=field$
  2690. enable_row(calcrow%?Fieldnumber%,
  2691. lit(printM%,6,
  2692. lit(printM%,7,
  2693. lit(mainM%,7,
  2694. selected(passW%,13))
  2695. $    P%=
  2696. printorder$,field$,P%+1)
  2697.  ((P%-1) 
  2698.  2)=0 
  2699.  P%=0
  2700.  P%>0 
  2701. 9    printorder$=
  2702. printorder$,P%-1)+
  2703. printorder$,P%+2)
  2704. ,    
  2705. enable_row(calcrow%?Fieldnumber%,
  2706.         
  2707.         
  2708. )      SP%=
  2709. printorder$,sfield$,SP%+1)
  2710. !    
  2711.  ((SP%-1) 
  2712.  2)=0 
  2713.  SP%=0
  2714.  SP%>0 
  2715. =      printorder$=
  2716. printorder$,SP%-1)+
  2717. printorder$,SP%+2)
  2718. .      
  2719. enable_row(calcrow%?Fieldnumber%,
  2720.         
  2721.  printorder$="" 
  2722. lit(printM%,6,
  2723. lit(printM%,7,
  2724. lit(mainM%,7,
  2725. shade(matchW%,7,printorder$<>"")
  2726. print_click(wi%,ic%,b%)
  2727. b%=(b% 
  2728.  %111)
  2729. selected(wi%,26) 
  2730. show_menu(labelW%,x%-500,y%+200)
  2731.  1,4:
  2732.  ic% 
  2733.  23,24,25:
  2734. (    
  2735. shade(wi%,15,
  2736. selected(wi%,25))
  2737. <    
  2738. shade(wi%,43,
  2739. selected(wi%,25) 
  2740. selected(wi%,23))
  2741. (    
  2742. shade(wi%,45,
  2743. selected(wi%,25))
  2744. (    
  2745. shade(wi%,15,
  2746. selected(wi%,25))
  2747. <    
  2748. shade(wi%,43,
  2749. selected(wi%,25) 
  2750. selected(wi%,23))
  2751. (    
  2752. shade(wi%,45,
  2753. selected(wi%,25))
  2754. 5    $
  2755. text(labelW%,20)=
  2756. text(labelW%,10))+1)
  2757.  0    
  2758. shade(labelW%,20,
  2759. selected(labelW%,11))
  2760. !0    
  2761. shade(labelW%,12,
  2762. selected(labelW%,11))
  2763. "N    
  2764. position_window(labelW%,x%-303,y%-360,0,0,0,0):
  2765. set_caret(labelW%,10)
  2766. #R    
  2767. get_options(printW%,"<Pbase$Dir>.Resources.PrtOptions"):
  2768. redraw(wi%)
  2769. $T    
  2770.  b%=4 
  2771. close_window(wi%):
  2772. set_caret(mainW%,starthere%) 
  2773. match(0,0)
  2774. restore_window(wi%,remember%+winbuff%(3,1)):
  2775.  b%=4 
  2776. close_window(wi%):
  2777. set_caret(mainW%,starthere%) 
  2778. redraw(wi%)
  2779. '(    
  2780. shade(wi%,10,
  2781. selected(wi%,47))
  2782. ((    
  2783. shade(wi%,19,
  2784. selected(wi%,47))
  2785. selected(wi%,50) 
  2786. +C      
  2787. save_options(printW%,"<Pbase$Dir>.Resources.PrtOptions")
  2788.       
  2789. -6      $SaveName%=$database%+".PrintRes.PrtOptions"
  2790. .4      $SaveSprite%="sfile_7f5;Pptr_hand,12,8;R2"
  2791. /"      savefunc$="Save options"
  2792. 0(      
  2793. show_menu(saveW%,x%-64,y%-20)
  2794. 1        
  2795. label_click(wi%,ic%,b%)
  2796. b%=(b% 
  2797.  %111)
  2798.  1,4:
  2799.  ic% 
  2800. <5    $
  2801. text(labelW%,20)=
  2802. text(labelW%,10))+1)
  2803. =0    
  2804. shade(labelW%,20,
  2805. selected(labelW%,11))
  2806. >0    
  2807. shade(labelW%,12,
  2808. selected(labelW%,11))
  2809. @5    $
  2810. text(labelW%,20)=
  2811. text(labelW%,10))+1)
  2812. A0    
  2813. shade(labelW%,20,
  2814. selected(labelW%,11))
  2815. B0    
  2816. shade(labelW%,12,
  2817. selected(labelW%,11))
  2818. C'    
  2819.  b%=4 
  2820. close_window(labelW%)
  2821. Dd    
  2822. restore_window(wi%,remember%+winbuff%(2,1)):
  2823.  b%=4 
  2824. close_window(wi%) 
  2825. redraw(wi%)
  2826. keypad_click(wi%,ic%,b%)
  2827.  handle%,icon%,T%,N$,date$
  2828. close_window(relateW%)
  2829.  flash% 
  2830. deselect(mainW%,field%(flash%)):flash%=
  2831.  ic%<>12 
  2832. validate(Fieldnumber%,T%,N$)=
  2833.  changed%=
  2834. update_calcs(Fieldnumber%)
  2835. check_change
  2836. b%=(b% 
  2837.  %111)
  2838. fkey_status(ic%)
  2839.  1,4:
  2840.  b%=4 
  2841.  z%=1 
  2842.  z%=-1
  2843.  ic% 
  2844. U'    
  2845. scan(z%,
  2846. text(wi%,23)))
  2847.  1:stop%=
  2848. W%    
  2849.  2:addr=
  2850. moveto(key%,top,z%)
  2851. X&    
  2852.  3:addr=
  2853. moveto(key%,top,-z%)
  2854. Y&    
  2855.  4:addr=
  2856. moveto(key%,addr,z%)
  2857. Z'    
  2858.  5:addr=
  2859. moveto(key%,addr,-z%)
  2860. [(    
  2861.  6:addr=
  2862. fast_wind(top,addr,z%)
  2863. \)    
  2864.  7:addr=
  2865. fast_wind(top,addr,-z%)
  2866. key_select(z%)
  2867. key_select(-z%)
  2868. subfile(z%)
  2869. subfile(-z%)
  2870. a-    
  2871. rotate:addr=
  2872. moveto(key%,top,1)
  2873. b"    
  2874. allow_search(wi%,z%)
  2875. c<    
  2876.  b%=4 
  2877. display(key%,-1) 
  2878. display(key%,-2) 
  2879. d#    
  2880.  15:addr=
  2881. shift(z%,key%,0)
  2882. (-1) 
  2883. f(      addr=
  2884. find("#"+
  2885. (REC%),key%,
  2886.       
  2887. display(key%,addr)
  2888. h        
  2889. i$    
  2890.  16:addr=
  2891. shift(-z%,key%,0)
  2892. (-1) 
  2893. k(      addr=
  2894. find("#"+
  2895. (REC%),key%,
  2896.       
  2897. display(key%,addr)
  2898. m        
  2899. n6    
  2900.  17:addr=
  2901. shift(0,key%,1):
  2902. display(key%,addr)
  2903. val_help
  2904. p+    
  2905. check_change:
  2906. save_everything
  2907. store
  2908. r#    
  2909. retrieve(scratchpad$)
  2910. s,    
  2911. filter(wi%,
  2912. selected(wi%,ic%))
  2913.  24,25,26,27:
  2914. v       
  2915. text(wi%,ic%)=""
  2916.       
  2917.       R$=$
  2918. text(wi%,ic%)
  2919. yG      
  2920.  R$="" 
  2921. text(wi%,ic%)=
  2922. (REC%) 
  2923.  addr=
  2924. find("#"+R$,key%,
  2925. z        
  2926. redraw_icon(wi%,ic%)
  2927. |K    
  2928.  "OS_Byte",202,0,239:
  2929. show_menu(specialM%,oldx%+32,oldy%+16)
  2930. }$    
  2931. open_window(specialW%)
  2932. fkey_status(ic%)
  2933.  Modify% 
  2934.  keynumber%
  2935.  ic%>=0 
  2936.  ic%<23 
  2937.   kpad%=ic%
  2938.  ic%=22 
  2939.  $Kpadicon%="Soptoff;r5,14" 
  2940.  $Kpadicon%=$
  2941. val(keypadW%,ic%)
  2942.   $FkeyTitle%=vname$(ic%+9)
  2943. $  keynumber%=buttonfield%(1,ic%)
  2944.  keynumber%>0 
  2945. -    $Fkeyequiv%="F"+
  2946. (keynumber% 
  2947.  %1111)
  2948. /    
  2949. set_icon(fkeyW%,1,(keynumber% 
  2950.  1<<4))
  2951. /    
  2952. set_icon(fkeyW%,2,(keynumber% 
  2953.  1<<5))
  2954.         
  2955.     $
  2956. text(fkeyW%,3)="None"
  2957. deselect(fkeyW%,1)
  2958. deselect(fkeyW%,2)
  2959. lit(keystrokeM%,0,
  2960. lit(keystrokeM%,0,
  2961. show_menu(keystrokeM%,x%-64,y%-20)
  2962. load_fkeys(f$)
  2963.  F,I%
  2964. buttonfield%()=0
  2965. ("<Pbase$Dir>.Resources."+f$)
  2966.  I%=0 
  2967.   buttonfield%(1,I%)=
  2968. close_file(F)
  2969. save_fkeys
  2970.  F,I%
  2971. ("<Pbase$Dir>.Resources.Fkeys")
  2972.  I%=0 
  2973. (buttonfield%(1,I%))
  2974. close_file(F)
  2975. list_fkeys
  2976.  I%,line$,Heading$,F
  2977. @TextName$=$database%+".PrintJobs.Fkeys":$SaveName%=TextName$
  2978. read_print_options
  2979. (format$="horiz":reportdest$="Window"
  2980. 5Heading$=margin$+
  2981. pad("Keystroke equivalents",30)
  2982. LenLine%=
  2983. (Heading$)+2
  2984. extend_named_sliding_block(lineanchor%,LenLine%+4)
  2985. extend_named_sliding_block(headanchor%,LenLine%+4):pos%=!headanchor%
  2986. heap_store(headanchor%,LenLine%,0,pos%,0,Heading$)
  2987. ,Count%=0:Title$="":Title1$="":Title2$=""
  2988. list_head(0)
  2989.  "Hourglass_On"
  2990.  I%=0 
  2991.   K%=buttonfield%(1,I%)
  2992.  K%=0 
  2993.     K$="None"
  2994.         
  2995.     K$="F"+
  2996.  %1111)
  2997. &    
  2998.  (K% 
  2999.  (1<<4)) 
  3000. (139)+K$
  3001. #    
  3002.  (K% 
  3003.  (1<<5)) 
  3004.  K$="^"+K$
  3005. ,  line$=margin$+
  3006. pad(vname$(I%+9),24)+K$
  3007. B  $(!lineanchor%)=line$:
  3008. list_line(-1,lineanchor%,
  3009. (line$),32)
  3010.  I%=13 
  3011. E    line$=margin$+
  3012. pad(vname$(I%+9)+" all subfiles",24)+
  3013. (139)+K$
  3014. D    $(!lineanchor%)=line$:
  3015. list_line(-1,lineanchor%,
  3016. (line$),32)
  3017.  I%=14 
  3018. @    line$=margin$+
  3019. pad("Copy displayed record",24)+
  3020. (139)+K$
  3021. D    $(!lineanchor%)=line$:
  3022. list_line(-1,lineanchor%,
  3023. (line$),32)
  3024. ("<Pbase$Dir>.Resources.KeyList")
  3025.     line$=margin$+
  3026. D    $(!lineanchor%)=line$:
  3027. list_line(-1,lineanchor%,
  3028. (line$),32)
  3029. close_file(F)
  3030.  "Hourglass_Off"
  3031. lit(listM%,1,
  3032. screen_list
  3033. pitch$=
  3034. pitch("2")
  3035. write_log(-1,"Keystroke equivalents printed")
  3036. scan(z%,s%)
  3037. stop%=
  3038.    addr=
  3039. moveto(key%,addr,z%)
  3040.   K%=
  3041.  stop%
  3042. store
  3043.  wi%,ic%
  3044.  "Wimp_GetCaretPosition",,block%
  3045. wi%=!block%:ic%=block%!4
  3046. scratchpad$=$
  3047. text(wi%,ic%)
  3048. retrieve(S$)
  3049.  wi%,ic%,L%
  3050.  "Wimp_GetCaretPosition",,block%
  3051. wi%=!block%:ic%=block%!4
  3052.  scratchpad$<>"" 
  3053.    L%=
  3054. buffer_length(wi%,ic%)
  3055. text(wi%,ic%)=
  3056. S$,L%)
  3057. redraw_icon(wi%,ic%)
  3058. set_caret(wi%,ic%)
  3059.  ### Binary Large Objects (B.L.O.B.s) ###
  3060. blob_path(create%,f$,R%,F%,V%,
  3061.  O$,main$,level1$,level2$,d%,dn%,do%,L%,bn$,bo$
  3062.  36,39:O$=".Memo"
  3063.  37,40:O$=".Sprite"
  3064.  38:O$=".Draw"
  3065. main$=f$+O$+
  3066. "level1$=main$+"."+
  3067.  4900)
  3068. "level2$=level1$+"."+
  3069. Tbn$=level2$+".Rec"+
  3070. (R%):
  3071.  "OS_File",5,bn$ 
  3072.  dn%,,,,Ln%:
  3073.  dn%=1 
  3074.  d%=dn%:L%=Ln%
  3075. Vbo$=level2$+"."+
  3076.  70):
  3077.  "OS_File",5,bo$ 
  3078.  do%,,,,Lo%:
  3079.  do%=1 
  3080.  d%=do%:L%=Lo%
  3081.  objname$ 
  3082.  "NEW":b$=bn$:
  3083.  do%=1 
  3084.  "OS_CLI","Rename "+bo$+" "+bn$
  3085.  "OLD":b$=bo$:
  3086.  dn%=1 
  3087.  "OS_CLI","Rename "+bn$+" "+bo$
  3088.  d%=0 
  3089.  create%=
  3090.  "OS_File",8,main$
  3091.  "OS_File",8,level1$
  3092.  "OS_File",8,level2$
  3093.  d%=1 
  3094. load_blob(f$,R%,F%,V%)
  3095.  L%,b$
  3096. blob_path(
  3097. ,f$,R%,F%,V%,b$)
  3098.  L%>=0 
  3099. extend_named_sliding_block(tempanchor%,L%+1)
  3100.  "OS_File",255,b$,!tempanchor%
  3101. blob_to_file(F,L%)
  3102.  Used only to transfer CSV fields to external files
  3103.  L%>0 
  3104.  "OS_GBPB",2,F,!tempanchor%,L%
  3105. copy_blob(source$,dest$,RS%,RD%,FS%,FD%,V%)
  3106.  L%,Z%,bs$,bd$
  3107. blob_path(
  3108. ,source$,RS%,FS%,V%,bs$)
  3109.  L%>0 
  3110.     !+  Z%=
  3111. blob_path(
  3112. ,dest$,RD%,FD%,V%,bd$)
  3113.     "/  
  3114.  "OS_CLI","Copy "+bs$+" "+bd$+" ~C~V~Q"
  3115. delete_blob(F%,F$,wi%,ic%)
  3116.  flag%,f$
  3117. selected(prefsW%,20) 
  3118.     )&  
  3119.  "OS_CLI","Delete "+F$:flag%=
  3120.     *$  
  3121. confirm(
  3122. msg("Err115")) 
  3123.     +(    
  3124.  "OS_CLI","Delete "+F$:flag%=
  3125.  flag% 
  3126.  chartype%(F%) 
  3127.     06    
  3128.  36:$
  3129. val(wi%,ic%)="R5;Pptr_ext,8,4;Ssm!edit"
  3130.     17    
  3131.  37:$
  3132. val(wi%,ic%)="R5;Pptr_ext,8,4;Ssm!paint"
  3133.     26    
  3134.  38:$
  3135. val(wi%,ic%)="R5;Pptr_ext,8,4;Ssm!draw"
  3136.  39:$
  3137. text(wi%,ic%)=""
  3138. redraw_icon(wi%,ic%)
  3139. asterisk(
  3140. set_blob_sprite(R%,F%,V%)
  3141.  L%,b$,sprite$
  3142.  R%=RA% 
  3143.  L%=-1 
  3144. blob_path(
  3145. ,$database%,R%,F%,V%,b$)
  3146.     ><  
  3147.  L%>=0 
  3148.  sprite$="small_fff" 
  3149.  sprite$="sm!edit"
  3150.     ?=  
  3151.  L%>=0 
  3152.  sprite$="small_ff9" 
  3153.  sprite$="sm!paint"
  3154.     @<  
  3155.  L%>=0 
  3156.  sprite$="small_aff" 
  3157.  sprite$="sm!draw"
  3158. val(mainW%,field%(F%))="R5;Pptr_ext,8,4;S"+sprite$
  3159. redraw_icon(mainW%,field%(F%))
  3160. edit_blob(F%,V%)
  3161.  wi%,ic%,b$,O$,val$,F
  3162. check_change
  3163. wi%=mainW%:ic%=field%(F%)
  3164.     KB  
  3165.  36:O$="Memo":val$="R5;Pptr_ext,8,4;Ssmall_fff":ftype%=&fff
  3166.     LD  
  3167.  37:O$="Sprite":val$="R5;Pptr_ext,8,4;Ssmall_ff9":ftype%=&ff9
  3168.     MB  
  3169.  38:O$="Draw":val$="R5;Pptr_ext,8,4;Ssmall_aff":ftype%=&aff
  3170.     N6  
  3171.  39:O$="Memo":val$="L;Pptr_ext,8,4":ftype%=&fff
  3172.     O7  
  3173.  40:O$="Sprite":val$="Z0;Ssmall_ff9":ftype%=&ff9
  3174. blob_path(
  3175. ,$database%,REC%,F%,V%,b$)<0 
  3176.     R$  
  3177.  V%<>40 
  3178. val(wi%,ic%)=val$
  3179.     SI  
  3180.  "OS_CLI","Copy <PBase$Dir>.Resources.Objects."+O$+" "+b$+" ~C~V"
  3181.     TP  
  3182.  V%=36 
  3183. (b$):
  3184. #F,"Record "+
  3185. (REC%)+": "+$Rf%(KF%(0,0)):
  3186. close_file(F)
  3187. redraw_icon(wi%,ic%)
  3188.     W4block%!0=256:block%!12=0:block%!16=5:block%!20=0
  3189.     X3block%!24=0:block%!28=0:block%!32=0:block%!36=0
  3190.     Y)block%!40=ftype%:$(block%+44)=b$+
  3191.  "Wimp_SendMessage",18,block%,0
  3192. link_file(wi%,ic%,F%,file$,ft%)
  3193. leaf$=
  3194. leaf(file$)
  3195.  dbasepath$=$database% 
  3196.  file$="<Dbase$Dir>."+leaf$
  3197.     `)link$(F%)="@"+file$:link$(0)="LOADED"
  3198. val(wi%,ic%)="R5;Sfile_"+
  3199. ~(ft%)
  3200. redraw_icon(wi%,ic%)
  3201. asterisk(
  3202. transfer_blob(wi%,ic%,file$,ft%)
  3203.  F%,V%,L%,W%,b$,ok%
  3204.  wi%<>mainW% 
  3205. check_change
  3206.     j#F%=(ic%+1) 
  3207.  2:V%=chartype%(F%)
  3208.  ft%=-1 
  3209.     leaf$=
  3210. leaf(file$)
  3211.     o<    
  3212.  dbasepath$=$database% 
  3213.  file$="<Dbase$Dir>."+leaf$
  3214.     p-    link$(F%)="@"+file$:link$(0)="LOADED"
  3215.     ok%=
  3216.     tR  
  3217.  ft%=&fff 
  3218. install_blob:$
  3219. val(wi%,ic%)="R5;Pptr_ext,8,4;Ssmall_fff":ok%=
  3220.     vR  
  3221.  ft%=&ff9 
  3222. install_blob:$
  3223. val(wi%,ic%)="R5;Pptr_ext,8,4;Ssmall_ff9":ok%=
  3224.     xR  
  3225.  ft%=&aff 
  3226. install_blob:$
  3227. val(wi%,ic%)="R5;Pptr_ext,8,4;Ssmall_aff":ok%=
  3228.     z;  
  3229.  ft%=&fff 
  3230. install_blob:
  3231. show_text_block(F%):ok%=
  3232.     |8  
  3233.  ft%=&ff9 
  3234. install_blob:
  3235. show_picture(F%):ok%=
  3236.  ok% 
  3237. redraw_icon(wi%,ic%):
  3238. asterisk(
  3239. install_blob
  3240. blob_path(
  3241. ,$database%,REC%,F%,V%,b$)
  3242.  "OS_CLI","Remove "+b$
  3243.  "OS_CLI","Copy "+file$+" "+b$+" ~C~V"
  3244. show_text_block(F%)
  3245.  F,b$,I%,L%,base%
  3246.  F%=0 
  3247. base%=Rf%(F%)
  3248. blob_path(
  3249. ,$database%,REC%,F%,39,b$)
  3250.  L%>0 
  3251.  L%>len%(F%) 
  3252.  L%=len%(F%)
  3253.  ### Load only as much of file as we can display ###
  3254. >  F=
  3255. (b$):
  3256.  F>0 
  3257.  "OS_GBPB",4,F,base%,L%:
  3258. close_file(F)
  3259.  ### Replace any characters<32 by spaces - but ONLY for display ###
  3260.  I%=0 
  3261.  L%-1
  3262. #    
  3263.  base%?I%<32 
  3264.  base%?I%=32
  3265.   base%?L%=10
  3266.  $base%=""
  3267. show_picture(F%)
  3268.  F,f$,I%,max%,len%,x%,y%,w%,h%
  3269.  F%=0 
  3270. /len%=
  3271. blob_path(
  3272. ,$database%,REC%,F%,40,f$)
  3273. E!block%=mainW%:block%!4=field%(F%):
  3274.  "Wimp_GetIconState",,block%
  3275. <x%=block%!8:y%=block%!12:w%=block%!16-x%:h%=block%!20-y%
  3276.  "Wimp_DeleteIcon",,block%
  3277.  len%>=0 
  3278. extend_named_sliding_block(Rf%(F%),len%+4):base%=!Rf%(F%)
  3279. /  !base%=len%+4:
  3280.  "OS_File",255,f$,base%+4
  3281. O  field%(F%)=
  3282. create_icon(mainW%,x%,y%,w%,h%,&0700A53E,"",base%+16,base%,0)
  3283. K  field%(F%)=
  3284. create_icon(mainW%,x%,y%,w%,h%,&0700A53E,"",paint%,1,384)
  3285. filter(wi%,on%)
  3286.  x%,y%,vxmin%,vymax%,scrollx%,scrolly%
  3287. filter%=on%:$Query%=""
  3288.  on% 
  3289.  wi% 
  3290.  keypadW%:
  3291. 4    !block%=wi%:
  3292.  "Wimp_GetWindowState",,block%
  3293. =    
  3294. position_window(filterW%,block%!12,block%!8,0,0,0,0)
  3295. A    
  3296.  mainW%:
  3297. open_at(firstfilter%,filterW%,22,482,314,44,44)
  3298. set_caret(queryW%,0)
  3299. :Filter$="TRUE":
  3300. close_it(filterW%):
  3301. set_caret(mainW%,starthere%)
  3302. fast_wind(T%,P%,D%)
  3303.  fast%=
  3304. text(keypadW%,23))
  3305. D%=(D%+1) 
  3306.  P%<>T% 
  3307.  I%<fast%
  3308.  filter% 
  3309. next_match(P%,D%,Filter$,Z%) 
  3310. neighbour(key%,P%,D%)
  3311.   I%+=1
  3312.  P%=T% 
  3313.  filter% 
  3314.  7:P%=
  3315. neighbour(key%,P%,1-D%)
  3316.  merging% 
  3317. merge_next(filter%,key%,P%) 
  3318. display(key%,P%)
  3319. subfile(direction%)
  3320. filemem%(file%)=addr
  3321. file%+=direction%
  3322.  file%=6 
  3323.  file%=0
  3324.  file%=-1 
  3325.  file%=5
  3326. "$Subfilename%=$Subfile%(file%)
  3327. top=8*file%+LH%
  3328.  filemem%(file%)>=0 
  3329. selected (prefsW%,43) 
  3330. .  addr=filemem%(file%):
  3331. display(key%,addr)
  3332.  addr=
  3333. moveto(key%,top,1)
  3334. save_subfilenames
  3335.  present%=7 
  3336. !  F=
  3337. ($database%+".Subfiles")
  3338.  I%=0 
  3339. #F,$Subfile%(I%)
  3340. close_file(F)
  3341. allow_search(wi%,e%)
  3342. select(searchW%,5):
  3343. deselect(searchW%,6)
  3344. select(searchW%,6):
  3345. deselect(searchW%,5)
  3346. text(searchW%,1)="":
  3347. redraw_icon(searchW%,1)
  3348. text(searchW%,7)="":
  3349. redraw_icon(searchW%,7)
  3350. text(searchW%,3)=Index$(key%)
  3351.  wi% 
  3352.  keypadW%:
  3353. 7  !block%=keypadW%:
  3354.  "Wimp_GetWindowState",,block%
  3355. position_window(searchW%,block%!12,block%!8,0,0,0,0)
  3356.  mainW%:
  3357. open_at(firstsearch%,searchW%,13,456,314,114,52)
  3358. set_caret(searchW%,1)
  3359. val_help
  3360.  name$,subst%,field%,extra%,fld%
  3361.  "Wimp_GetCaretPosition",,block%
  3362. wi%=block%!0:ic%=block%!4
  3363. fld%=(ic%+1) 
  3364.  wi%=mainW% 
  3365.  fld%>0 
  3366.   name$=link$(fld%)
  3367. +  field%=
  3368. trailing_number(name$,exact%)
  3369. #  subst%=
  3370. leading_number(name$)
  3371. '  Tablenumber%=
  3372. table_number(name$)
  3373.  Tablenumber%<>-1 
  3374. show_table(Tablenumber%) 
  3375.  Tablenumber%=0
  3376. val_on_off
  3377.  I%=1 
  3378. selected(prefsW%,21) 
  3379. $    
  3380. :$valid%(I%)=$rvalid%(I%)
  3381. (    
  3382. :$valid%(I%)="Pptr_write,4,4"
  3383. save_click(wi%,ic%,b%)
  3384.  p$,H$
  3385. butt%=(b% 
  3386.  %111)
  3387.  wi% 
  3388.  saveW%:
  3389.   Filename$=$SaveName%
  3390.  savefunc$ 
  3391.  "New database":
  3392.     Type%=0
  3393. 6    
  3394. Filename$,1)<>"!" 
  3395.  Filename$="!"+Filename$
  3396. 5    Filename$=
  3397. Filename$,10):$SaveName%=Filename$
  3398.  "Save as text":
  3399.     Type%=&fff
  3400. 7    Start%=!textanchor%:End%=Start%+Count%*LenLine%
  3401.     $Start%=pitch$
  3402.  "Save list":
  3403.      Type%=&fff:savetofile%=
  3404.  "Save text":
  3405.     Type%=&fff:
  3406. =    len%=
  3407. blob_path(
  3408. ,$database%,REC%,Fieldnumber%,36,f$)
  3409. 7    
  3410. extend_named_sliding_block(saveanchor%,len%+1)
  3411. (    
  3412.  "OS_File",255,f$,!saveanchor%
  3413. ,    Start%=!saveanchor%:End%=Start%+len%
  3414.  "Save sprite":
  3415.     Type%=&ff9
  3416. =    len%=
  3417. blob_path(
  3418. ,$database%,REC%,Fieldnumber%,37,f$)
  3419.  7    
  3420. extend_named_sliding_block(saveanchor%,len%+1)
  3421. !(    
  3422.  "OS_File",255,f$,!saveanchor%
  3423. ",    Start%=!saveanchor%:End%=Start%+len%
  3424.  "Save draw":
  3425.     Type%=&aff
  3426. %=    len%=
  3427. blob_path(
  3428. ,$database%,REC%,Fieldnumber%,38,f$)
  3429. &7    
  3430. extend_named_sliding_block(saveanchor%,len%+1)
  3431. '(    
  3432.  "OS_File",255,f$,!saveanchor%
  3433. (,    Start%=!saveanchor%:End%=Start%+len%
  3434.  "Save options":
  3435.     Type%=&7f5
  3436.  "Save query":
  3437.     $savebuff%=query$
  3438. -;    Start%=savebuff%:End%=Start%+
  3439. (query$)+1:Type%=&7f4
  3440. .*    
  3441.  "Save selection":
  3442. save_selection
  3443.  "Save table":
  3444. 0c    z$=
  3445. table_info(Tablenumber%,Rows%,TabFields%,Rec%,tabfieldlen%(),offset%,heading%,colours$)
  3446. 1R    Start%=!tabanchor%(Tablenumber%):End%=Start%+offset%+Rows%*Rec%:Type%=&7f1
  3447. 2=    
  3448.  "Save table as CSV":Filename$=$SaveName%:Type%=&dfe
  3449.  "Save form file":
  3450.     Type%=&7f2
  3451. lit(designM%,3,
  3452. lit(designM%,4,
  3453. lit(designM%,6,
  3454. 86    
  3455.  adjust%=
  3456. first_writable>0 
  3457. default_key
  3458. 99    
  3459.  "Export selected":
  3460. export_selected(printorder$)
  3461.  savesubW%:
  3462.  savefunc$ 
  3463.  "Export subset":
  3464. >#    Filename$=$SubName%:Type%=0
  3465.  "Export CSV":
  3466. @&    Filename$=$SubName%:Type%=&dfe
  3467.  ic% 
  3468.  (b% 
  3469.  %11110000)>0 
  3470. init_drag(wi%,ic%,5)
  3471. Filename$,".")>0 
  3472. H7    
  3473.  butt%<>2 
  3474. save(Filename$,Type%,Start%,End%)
  3475. I)    
  3476. write_log(-1,Filename$+" saved")
  3477.  butt%=4 
  3478.       
  3479.  wi%=saveW% 
  3480. L$        
  3481.  "Wimp_CreateMenu",,-1
  3482. M:        
  3483. close_it(wi%):
  3484. set_caret(mainW%,starthere%)
  3485.       
  3486. O        
  3487. softerror("",33)
  3488.  wi%=saveW% 
  3489. T     
  3490.  "Wimp_CreateMenu",,-1
  3491. U6    
  3492. close_it(wi%):
  3493. set_caret(mainW%,starthere%)
  3494. key_click(wi%,ic%,b%)
  3495. butt%=(b% 
  3496.  %111)
  3497. z%=(butt%=1)-(butt%=4)
  3498.  butt% 
  3499.  2,4:
  3500.  ic% 
  3501.  8,9,10,11:
  3502. b)    fieldmenu%=
  3503. field_menu(fields%,
  3504. c<    
  3505. tick_one(fieldmenu%,0,fields%-1,keyfield%(ic%-8)-1)
  3506. dD    
  3507. show_menu(fieldmenu%,oldx%+32,oldy%+16):fieldfunc$=
  3508. (ic%-8)
  3509.  ic% 
  3510.  0,1,2,3:
  3511. kcycle(keyfield%(ic%),4*ic%+12,z%)
  3512.  4,5,6,7:
  3513. kcycle(keyfield%(ic%-4),4*ic%-4,-z%)
  3514.  keyfunc$<>"Current key" 
  3515.     keylimit%=0:keylen%=0
  3516.  J%=0 
  3517. n(      keylimit%+=len%(keyfield%(J%))
  3518. o+      keylen%+=
  3519. text(keyW%,4*J%+15))
  3520. r/      
  3521.  keylen%>keylimit%:
  3522. softerror("",26)
  3523. s(      
  3524.  keylen%=0:
  3525. softerror("",105)
  3526.       
  3527.       
  3528.  keyfunc$ 
  3529.         
  3530.  "Primary key":
  3531. w*        
  3532. save_form($database%+".Form")
  3533.         key%=0
  3534.         
  3535. copy_keydata(key%)
  3536. z*        RA%=
  3537. ($Records%):f$=$database%
  3538. {&        
  3539. make_empty_index(RA%,0,
  3540. |*        
  3541. save_recs(f$+".Database",RA%)
  3542. }-        present%=7:
  3543. save_keys:
  3544. save_calcs
  3545. ~/        design%=
  3546. :present%=1:
  3547. get_it_in(f$)
  3548. 0        
  3549.  "New primary key":
  3550. new_tree(file%)
  3551. /        
  3552.  "Index field":
  3553. create_index(key%)
  3554.       
  3555.         
  3556.   keyfunc$=""
  3557.  b%=4 
  3558. close_window(keyW%):
  3559. set_caret(mainW%,starthere%)
  3560. close_window(keyW%):
  3561. set_caret(mainW%,starthere%)
  3562. shade_key_icons(con%)
  3563. shade(keyW%,30,con%)
  3564.  I%=0 
  3565. shade(keyW%,I%,con%)
  3566. shade(keyW%,31,con%)
  3567. shade(keyW%,12,
  3568. shade(keyW%,16,
  3569. shade(keyW%,20,
  3570. shade(keyW%,24,
  3571. shade(keyW%,30,con%)
  3572. shade(keyW%,35,con%)
  3573. shade(keyW%,37,con%)
  3574. kcycle(
  3575.  F%,show%,z%)
  3576.  J%=0 
  3577. text(keyW%,show%+J%)=""
  3578. F%+=z%
  3579.  F%>fields% 
  3580.  F%=0
  3581.  F%<0 
  3582.  F%=fields%
  3583.  F%>0 
  3584. text(keyW%,show%)=Tag$(F%)
  3585. text(keyW%,show%+1)="1":
  3586. set_caret(keyW%,show%+1)
  3587. text(keyW%,show%+2)="L"
  3588. text(keyW%,show%+3)=
  3589. (len%(F%))
  3590.  J%=0 
  3591. redraw_icon(keyW%,show%+J%)
  3592. tick_one(fieldmenu%,0,fields%-1,F%-1)
  3593. copy_keydata(key%)
  3594.  J%,chars%,pos%,word%,field%
  3595. KL%(key%)=0
  3596.  J%=0 
  3597. 7  chars%=
  3598. text(keyW%,4*J%+15)):KL%(key%)+=chars%
  3599. text(keyW%,4*J%+14) 
  3600.  "L":pos%=0
  3601.  "R":pos%=255
  3602. '    
  3603. :pos%=
  3604. text(keyW%,4*J%+14))
  3605. $  word%=
  3606. text(keyW%,4*J%+13))
  3607.   field%=keyfield%(J%)
  3608. <  KW%(key%,J%)=chars%+(pos%<<8)+(word%<<16)+(field%<<24)
  3609.   KF%(key%,J%)=field%
  3610. #case%(key%)=
  3611. selected(keyW%,30)
  3612. set_keydata(key%)
  3613.  J%,chars%,pos%,word%,field%,W%
  3614.  J%=12 
  3615. text(keyW%,J%)=""
  3616.  J%=0 
  3617.   W%=KW%(key%,J%)
  3618.  W%>0 
  3619. 7    chars%=W% 
  3620.  255:$
  3621. text(keyW%,4*J%+15)=
  3622. (chars%)
  3623.     pos%=(W%>>8) 
  3624.  pos% 
  3625. '      
  3626. text(keyW%,4*J%+14)="L"
  3627. )      
  3628.  255:$
  3629. text(keyW%,4*J%+14)="R"
  3630. )      
  3631. text(keyW%,4*J%+14)=
  3632. (pos%)
  3633.         
  3634. ;    word%=(W%>>16) 
  3635.  255:$
  3636. text(keyW%,4*J%+13)=
  3637. (word%)
  3638. >    field%=KF%(key%,J%):$
  3639. text(keyW%,4*J%+12)=Tag$(field%)
  3640.     keyfield%(J%)=field%
  3641. text(keyW%,29)=
  3642. (key%)
  3643. set_icon(keyW%,30,case%(key%))
  3644. set_icon(keyW%,35,incspace%(key%))
  3645. set_icon(keyW%,37,null%(key%))
  3646. key_select(D%)
  3647.  "Wimp_GetCaretPosition",,block%
  3648. wi%=block%!0:ic%=block%!4
  3649. colour(key%,2)
  3650.  +1:key%=(key%+1) 
  3651.  (Keys%+1)
  3652.  -1:key%-=1:
  3653.  key%<0 
  3654.  key%=Keys%
  3655. colour(key%,1)
  3656. set_keydata(key%)
  3657. text(searchW%,3)=Index$(key%):
  3658. redraw_icon(searchW%,3)
  3659. top=8*file%+LH%
  3660. addr=
  3661. moveto(key%,top,1)
  3662. set_caret(wi%,ic%)
  3663. set_colours(wi%,ic%,b%)
  3664.  (b% 
  3665.  %111)=4 
  3666.  z%=1 
  3667.  z%=-1
  3668.  (b% 
  3669.  %111) 
  3670.  1,4:
  3671.  ic% 
  3672.  0,1,2,3,4,5,6,7,8:
  3673. @    col%=
  3674. get_icon_cols(wi%,ic%):fg%=col% 
  3675.  16:bg%=col% 
  3676. S    
  3677. selected(wi%,11) 
  3678.  fg%=(fg%+z%+16) 
  3679.  ic%<8 
  3680.  bg%=(bg%+z%+16) 
  3681. '    col%=fg%+bg%*16:ncol%(ic%)=col%
  3682. $    
  3683. set_icon_cols(wi%,ic%,col%)
  3684.  9,10:
  3685.     fcol%()=ncol%()
  3686.  I%=0 
  3687.  Keys%
  3688.       
  3689. colour(I%,2)
  3690. colour(key%,1)
  3691.  I%=1 
  3692.  fields%
  3693. F      
  3694.  link$(I%)<>"" 
  3695. set_icon_cols(mainW%,field%(I%),ncol%(8))
  3696. !    
  3697.  ic%=10 
  3698. write_colours
  3699.      
  3700.  "Wimp_CreateMenu",,-1
  3701. 3    
  3702. read_colours("<Pbase$Dir>.Resources.Cols")
  3703.  I%=0 
  3704. *      
  3705. set_icon_cols(wi%,I%,ncol%(I%))
  3706. create_click
  3707.  Calc$,error%
  3708. butt%=(b% 
  3709.  %111)
  3710.  butt% 
  3711.  2,4:
  3712.  ic%=36 
  3713. show_menu(ftypeM%(menunumber%),oldx%+32,oldy%+16)
  3714.  ic%=44 
  3715.  fieldmenu%=
  3716. field_menu(fields%,
  3717. tick_one(fieldmenu%,0,fields%-1,Fieldnumber%-1):
  3718. show_menu(fieldmenu%,oldx%+32,oldy%+16)
  3719.  butt%=4 
  3720.  z%=1 
  3721.  butt%=1 
  3722.  z%=-1 
  3723.  ic% 
  3724. set_limits(0)
  3725. set_limits(1)
  3726. set_limits(2)
  3727. set_limits(3)
  3728. set_limits(4)
  3729. set_limits(5)
  3730. set_limits(6)
  3731. change_type(z%,menunumber%)
  3732. change_type(-z%,menunumber%)
  3733.  18:error%=
  3734. create_field(
  3735. ($InsText%),posx%,posy%,Calc$)
  3736. remove_field(Fieldnumber%,
  3737. ,Calc$)
  3738. :  error%=
  3739. create_field(Fieldnumber%,posx%,posy%,Calc$)
  3740. remove_field(Fieldnumber%,
  3741. ,Calc$)
  3742.  14,45,46:
  3743. shade(createW%,13,(
  3744. selected(createW%,14)))
  3745.   F%=
  3746. ($InsText%)
  3747.  F%>0 
  3748.  F%<=fields% 
  3749. #(    
  3750.  F%<Fieldnumber% 
  3751.  Z%=-1 
  3752.  Z%=1
  3753. $(    
  3754. re_sequence(Fieldnumber%,F%,Z%)
  3755. close_window(createW%)
  3756. 'C  x%=
  3757. ($boxX%):y%=
  3758. ($boxY%):int%=
  3759. ($snapint%):
  3760. snap(x%,y%,int%)
  3761. swap_fields(Fieldnumber%,
  3762. ($InsText%))
  3763. close_it(createW%)
  3764.  42:$boxW%=
  3765. ($LenText%)*16+16):
  3766. redraw_icon(createW%,9)
  3767. snap_all
  3768.  50,51,52,53:
  3769. nudge(butt%,ic%)
  3770. update_box
  3771.  (present% 
  3772.  4)=0 
  3773. lit(designM%,1,(fields%>0))
  3774.  ic% 
  3775.  18,29,30:
  3776.  butt%=4 
  3777. 3,    
  3778.  error% 
  3779. close_window(createW%)
  3780. 4        
  3781. shade(createW%,18,
  3782. 6%    
  3783. shade(createW%,30,
  3784.  adjust%)
  3785. shade(createW%,29,
  3786. update_box
  3787.  fieldtype% 
  3788.  0,1,2,3,4,5,6,7,46,47:
  3789.  adjust% 
  3790. shade(createW%,6,
  3791. shade(createW%,6,
  3792. A&num%=(fieldtype%=3 
  3793.  fieldtype%=6)
  3794. shade(createW%,14,num%)
  3795. shade(createW%,45,num%)
  3796. shade(createW%,46,num%)
  3797. shade(createW%,13,num% 
  3798. selected(createW%,14))
  3799. shade(createW%,15,(fieldtype%=3 
  3800.  fieldtype%=47))
  3801. shade(createW%,25,(fieldtype%=3))
  3802. shade(createW%,26,
  3803.  adjust%)
  3804.  adjust% 
  3805. lit(designM%,2,(fields%>0))
  3806. J $ValText%=vname$(fieldtype%)
  3807. redraw_icon(createW%,28)
  3808. set_limits(m%)
  3809. fieldtype%=?(flist%(m%)+1)
  3810. currenttype%=0
  3811. lasttype%=?flist%(m%)
  3812. menunumber%=m%
  3813. tick_one(ftypeM%(m%),0,lasttype%-1,0)
  3814. update_box
  3815. change_type(d%,m%)
  3816.  1:currenttype%+=1
  3817.  currenttype%=lasttype% 
  3818.  currenttype%=0
  3819.  -1:currenttype%-=1
  3820.  currenttype%<0 
  3821.  currenttype%=lasttype%-1
  3822. tick_one(ftypeM%(m%),0,lasttype%-1,currenttype%)
  3823. _+fieldtype%=?(flist%(m%)+currenttype%+1)
  3824. update_box
  3825. passwords(x%,wi%,ic%,b%)
  3826. b%=(b% 
  3827.  %111)
  3828.  1,4:
  3829.  ic% 
  3830. j%    
  3831.  $Write%="" 
  3832.  $Write%=$Read%
  3833. k*    
  3834.  $Manager%="" 
  3835.  $Manager%=$Write%
  3836.     F=
  3837. ($database%+".Cols")
  3838. #F=45
  3839. n$    S$=
  3840. encrypt($Read%,
  3841. #F,S$
  3842. o%    S$=
  3843. encrypt($Write%,
  3844. #F,S$
  3845. p'    S$=
  3846. encrypt($Manager%,
  3847. #F,S$
  3848.  I%=9 
  3849. r"      
  3850. selected(passW%,I%)
  3851. close_file(F)
  3852. v*    
  3853. lit(mainM%,6,
  3854. selected(passW%,9))
  3855. w?    
  3856.  printorder$<>"" 
  3857. lit(mainM%,7,
  3858. selected(passW%,13))
  3859. x+    
  3860. lit(mainM%,8,
  3861. selected(passW%,13))
  3862. y+    
  3863. lit(mainM%,9,
  3864. selected(passW%,13))
  3865. z+    
  3866. lit(mainM%,2,
  3867. selected(passW%,14))
  3868. close_window(aclW%)
  3869. |M    
  3870.  b%=4 
  3871. close_window(passW%):
  3872.  x%>=0 
  3873. set_caret(oldwin%,oldicon%)
  3874. }!    
  3875. selected(passW%,9) 
  3876. ~!      
  3877. close_window(keypadW%)
  3878. ?      
  3879.  x%>=0 
  3880. position_window(keypadW%,100,50,0,0,0,0)
  3881.         
  3882. asterisk(
  3883.      
  3884. selected(passW%,16) 
  3885. &      
  3886. open_log("<Log$Dir>.Log",
  3887. '      
  3888. close_log("<Log$Dir>.Log")
  3889.         
  3890. 4    
  3891. shade(prefsW%,34,
  3892. selected(passW%,15))
  3893. M    
  3894. selected(passW%,16) 
  3895. write_log(-1,"Logging discontinued")
  3896. A    $
  3897. text(aclW%,0)="":$
  3898. text(aclW%,1)="":$
  3899. text(aclW%,12)=""
  3900. @    
  3901. deselect(aclW%,
  3902. selected_esg(aclW%,1)):
  3903. select(aclW%,4)
  3904. /    
  3905. open_window(aclW%):
  3906. set_caret(aclW%,0)
  3907. 4    
  3908. restore_window(wi%,remember%+winbuff%(1,1))
  3909. close_window(aclW%)
  3910. O    
  3911.  b%=4 
  3912. close_window(wi%):
  3913. set_caret(oldwin%,oldicon%) 
  3914. redraw(wi%)
  3915.  F,user$,passwd$,ok%
  3916.  (b% 
  3917.  %111) 
  3918.  ic% 
  3919. !    
  3920. close_window(aclW%)
  3921. #    
  3922. selected_esg(aclW%,1) 
  3923.       
  3924.       user$=$
  3925. text(aclW%,0)
  3926. I      
  3927. confirm(
  3928. msg("Err123,"+user$)) 
  3929. remove_user(user$,
  3930. ):ok%=
  3931.       
  3932. )      
  3933. remove_user($
  3934. text(aclW%,0),
  3935.       
  3936. 3        
  3937. text(aclW%,0)="":
  3938. softerror("",126)
  3939. B        
  3940. text(aclW%,1)<>$
  3941. text(aclW%,12):
  3942. softerror("",108)
  3943. 3        
  3944. text(aclW%,1)="":
  3945. softerror("",125)
  3946.         
  3947. -        user$=
  3948. encrypt($
  3949. text(aclW%,0),
  3950. /        passwd$=
  3951. encrypt($
  3952. text(aclW%,1),
  3953.         
  3954.  acl% 
  3955. "          F=
  3956. ("<Acl$Dir>.acl")
  3957.           
  3958. $          
  3959. ("<Acl$Dir>.acl")
  3960.           acl%=
  3961.         
  3962. 6        
  3963. #F,user$,passwd$,
  3964. selected_esg(aclW%,1)-3
  3965.         
  3966. close_file(F)
  3967.         ok%=
  3968.       
  3969.         
  3970. A    $
  3971. text(aclW%,0)="":$
  3972. text(aclW%,1)="":$
  3973. text(aclW%,12)=""
  3974. K    
  3975. redraw_icon(aclW%,0):
  3976. redraw_icon(aclW%,1)::
  3977. redraw_icon(aclW%,12)
  3978. set_caret(aclW%,0)
  3979. 6    
  3980.  (b% 
  3981.  %111)=4 
  3982.  ok%=
  3983. close_window(aclW%)
  3984. remove_user(u$,remove%)
  3985.  user$,id$,p%,p%,ptr%,F,found%
  3986.  u$<>"" 
  3987.   user$=
  3988. encrypt(u$,
  3989.  acl% 
  3990.     F=
  3991. ("<Acl$Dir>.acl")
  3992.         
  3993.       ptr%=
  3994.       
  3995. #F,id$,p$,p%
  3996.       found%=(id$=user$)
  3997.  found% 
  3998.  found% 
  3999. 1      
  4000. #F=ptr%:
  4001. (id$),"Z"),
  4002. (p$),"Z"),0
  4003. *      
  4004.  remove% 
  4005. softerror(u$,124)
  4006.         
  4007. close_file(F)
  4008. open_log(f$,resume%)
  4009.  "OS_File",5,f$ 
  4010.  d%=1 
  4011.   loghandle%=
  4012. #loghandle%=
  4013. #loghandle%
  4014.  resume% 
  4015. #loghandle%,"Logging resumed "+
  4016. #loghandle%,"Log opened "+
  4017. #loghandle%,"Database: "+$database%
  4018.   loghandle%=
  4019. #loghandle%,"Log started "+
  4020. #loghandle%,"Database: "+$database%
  4021.  acl% 
  4022. #loghandle%,"User: "+user$
  4023. #loghandle%,"Password level used: "+
  4024. (pw%)
  4025. #loghandle%,
  4026. 35,"-")
  4027. close_file(loghandle%)
  4028. logging%=
  4029. close_log(f$)
  4030.  logging% 
  4031.   loghandle%=
  4032. #loghandle%=
  4033. #loghandle%
  4034. #loghandle%,
  4035. 35,"-")
  4036. #loghandle%,"Log closed "+
  4037. #loghandle%,
  4038. 35,"=")
  4039. close_file(loghandle%)
  4040.  "OS_File",18,f$,&fff
  4041.   logging%=
  4042. write_log(record%,S$)
  4043.  loghandle%
  4044.  logging% 
  4045. #  loghandle%=
  4046. ("<Log$Dir>.Log")
  4047. #loghandle%=
  4048. #loghandle%
  4049.  record%>=0 
  4050. #loghandle%,"    [Record number: "+
  4051. (record%)+"]"
  4052. #loghandle%,"    "+S$
  4053. close_file(loghandle%)
  4054. count(key%,
  4055.  RU%)
  4056.  zero%,file%,top,sum%
  4057.     RU%=0
  4058.  file%=0 
  4059.   top=8*file%+LH%
  4060. "  sum%=
  4061. count_recs(key%,zero%)
  4062.   RU%+=sum%
  4063. text(miscW%,file%+22)=
  4064. (sum%)
  4065.  file%
  4066. count_recs(key%,
  4067.  ptr%)
  4068.  P%,count%,S%,R%,S$,k$
  4069.  "Hourglass_On"
  4070. neighbour(key%,top,1)
  4071.  P%<>top
  4072.   count%+=1
  4073.  ptr%>0 
  4074.     R%=
  4075. rec_no(k$,key%,P%)
  4076. #    
  4077.  R%>highest% 
  4078.  highest%=R%
  4079. 1    !ptr%=R%:$(ptr%+4)=k$:ptr%+=4+KL%(key%)+1
  4080.     flagptr%?R%=0
  4081.   P%=
  4082. neighbour(key%,P%,1)
  4083.  "Hourglass_Off"
  4084. =count%
  4085. analyse(func%)
  4086.  L%,P%,S%,S$,K$,k$,ptr%,pos%,N%,values%,key%
  4087.  S$(),N%()
  4088. read_print_options
  4089.  func%<0 
  4090.  L%=6 
  4091.  key%=func%:L%=KL%(key%)
  4092.  L%>8 
  4093.  Tab%(0)=Lmargin%+L%+6 
  4094.  Tab%(0)=Lmargin%+14
  4095. Tab%(1)=Tab%(0)+6
  4096.  func%<0 
  4097. :  Title$="Analysis of date field: "+Tag$(Fieldnumber%)
  4098. 5  Heading$=
  4099. pad(margin$+"Month",Tab%(0))+"Number"
  4100.  V  TextName$=$database%+".PrintJobs.DateAn"+Tag$(Fieldnumber%):$SaveName%=TextName$
  4101. "/  Title$="Analysis of index: "+Index$(key%)
  4102. #8  Heading$=
  4103. pad(margin$+"Contents",Tab%(0))+"Number"
  4104. $U  TextName$=$database%+".PrintJobs.IndAn"+Tag$(Fieldnumber%):$SaveName%=TextName$
  4105. Title1$=
  4106. LenLine%=
  4107. (Heading$)+2
  4108. extend_named_sliding_block(lineanchor%,LenLine%+4)
  4109. extend_named_sliding_block(headanchor%,LenLine%+4):pos%=!headanchor%
  4110. heap_store(headanchor%,LenLine%,0,pos%,0,Heading$)
  4111. reportdest$="Window"
  4112. Count%=0
  4113. list_head(0)
  4114.  "Hourglass_On"
  4115.  func%<0 
  4116. analyse_date 
  4117. analyse_index
  4118.  "Hourglass_Off"
  4119. rule_off(45)
  4120. 2;Line$=
  4121. pad(margin$+"Total",Tab%(0))+
  4122. justify(
  4123. (N%),1,0)
  4124. 3@$(!lineanchor%)=Line$:
  4125. list_line(-1,lineanchor%,
  4126. (Line$),32)
  4127. rule_off(45)
  4128. screen_list
  4129. analyse_index
  4130. K$="***"
  4131. neighbour(key%,top,1)
  4132.  P%<>top
  4133.     R%=
  4134. rec_no(k$,key%,P%)
  4135. =#    
  4136.  k$<>K$ 
  4137.  values%+=1:K$=k$
  4138. >     P%=
  4139. neighbour(key%,P%,1)
  4140.  S$(values%),N%(values%)
  4141. K$="***"
  4142. neighbour(key%,top,1)
  4143.  P%<>top
  4144.     R%=
  4145. rec_no(k$,key%,P%)
  4146. EE    
  4147.  k$<>K$ 
  4148.  ptr%+=1:K$=k$:S$(ptr%)=K$:N%(ptr%)=1 
  4149.  N%(ptr%)+=1
  4150. F     P%=
  4151. neighbour(key%,P%,1)
  4152.  I%=1 
  4153.  ptr%
  4154. II  S$=S$(I%):
  4155.  S$="" 
  4156.  S$="<null>" 
  4157.  isadate% 
  4158. reverse_date(S$)
  4159. JH  Line$=margin$+S$:Line$=
  4160. pad(Line$,Tab%(0))+
  4161. justify(
  4162. (N%(I%)),1,0)
  4163. KB  $(!lineanchor%)=Line$:
  4164. list_line(-1,lineanchor%,
  4165. (Line$),32)
  4166.   N%+=N%(I%)
  4167. analyse_date
  4168.  S$(12),N%(12)
  4169. RYS$()="<null>","Jan","Feb","Mar","Apr","May","Jun","Jul","Aug","Sep","Oct","Nov","Dec"
  4170. S*dbasehandle%=
  4171. ($database%+".Database")
  4172. neighbour(key%,top,1)
  4173.  P%<>top
  4174.   R%=
  4175. rec_no(k$,key%,P%)
  4176. readsmarray(dbasehandle%,R%)
  4177.   S$=F$(Fieldnumber%)
  4178.  S$<>"" 
  4179.     M%=
  4180. S$,4,2))
  4181.     N%(M%)+=1
  4182.  N%(0)+=1
  4183.   P%=
  4184. neighbour(key%,P%,1)
  4185. close_file(dbasehandle%)
  4186.  I%=0 
  4187. bL  Line$=margin$+S$(I%):Line$=
  4188. pad(Line$,Tab%(0))+
  4189. justify(
  4190. (N%(I%)),1,0)
  4191. cB  $(!lineanchor%)=Line$:
  4192. list_line(-1,lineanchor%,
  4193. (Line$),32)
  4194.   N%+=N%(I%)
  4195. update_stats
  4196. $filesize%=
  4197. (RA%)
  4198. $Records%=
  4199. (RA%)
  4200. $used%=
  4201. (RU%)
  4202. l#$percent%=
  4203. (RU%*100/RA%))+"%"
  4204.  Keypress processing --------------------------------------------------
  4205. set_keyboard(wi%,ic%)
  4206. selected(prefsW%,21) 
  4207.  wi% 
  4208.  mainW%:
  4209.  chartype%((ic%+1) 
  4210. v-    
  4211.  Leave keyboard status unchanged
  4212. w$    
  4213.  2,4:
  4214.  "OS_Byte",202,0,239
  4215. x!    
  4216.  "OS_Byte",202,16,111
  4217.  accessW%:
  4218.  uc% 
  4219.  "OS_Byte",202,0,239 
  4220.  "OS_Byte",202,caps%,111
  4221.  "OS_Byte",202,caps%,111
  4222.  "OS_Byte",118
  4223. process_key
  4224.  printing% 
  4225.  indexing% 
  4226.  N$,T%
  4227.  "Wimp_GetCaretPosition",,block%
  4228. 4wi%=block%!0:ic%=block%!4:key_pressed%=block%!24
  4229.  T%=0 
  4230.  LastTable%
  4231.  wi%=tableW%(T%) 
  4232.  Tablenumber%=T%
  4233.  key_pressed% 
  4234. store
  4235. retrieve(scratchpad$)
  4236.  wi% 
  4237.  mainW%:
  4238. main_press(wi%,ic%)
  4239.  passW%:
  4240. dbox_press(4,18,0,0,0)
  4241.  aclW%:
  4242. dbox_press(9,11,0,0,0)
  4243.  changeW%:
  4244. dbox_press(3,6,queryW%,0,0)
  4245.  tabcreateW%:
  4246. dbox_press(2,3,scrollW%,0,MaxCols%*2+1)
  4247.  scrollW%:
  4248. scroll_press
  4249.  saveW%,savesubW%:
  4250. dbox_press(1,3,0,0,0)
  4251.  tableW%(Tablenumber%):
  4252. table_press(Tablenumber%)
  4253.  printW%:
  4254. dbox_press(20,52,0,0,0)
  4255.  labelW%:
  4256. dbox_press(15,19,0,0,0)
  4257.  createW%:
  4258. create_press
  4259.  accessW%:
  4260. dbox_press(3,2,0,0,0)
  4261.  keyW%:
  4262. dbox_press(31,36,0,0,0)
  4263.  matchW%:
  4264. dbox_press(0,6,0,0,0)
  4265.  moveW%:
  4266. dbox_press(7,11,0,0,0)
  4267.  calcW%:
  4268. dbox_press(1,-1,0,0,0)
  4269.  mergeW%:
  4270. dbox_press(6,7,queryW%,0,0)
  4271.  sizeW%:
  4272. dbox_press(4,5,0,0,0)
  4273.  csvW%:
  4274. dbox_press(9,10,0,0,0)
  4275.  prefsW%:
  4276. dbox_press(39,40,0,0,0)
  4277.  searchW%:
  4278.  key_pressed%=15 
  4279. #    
  4280. search_click(searchW%,9,4)
  4281. !    
  4282. dbox_press(8,10,0,0,0)
  4283.  helpW%:
  4284. dbox_press(7,20,0,0,0)
  4285.  queryW%:
  4286. query_press
  4287.  keypadW%:
  4288. special_press
  4289. query_press
  4290.  window%
  4291. window%=-1
  4292.   window%+=1
  4293.    wi%=actionbutt%(window%,0)
  4294.  wi%=oldquery%
  4295.  key_pressed% 
  4296. mouse(0,0,4,wi%,actionbutt%(window%,1))
  4297. query_click(queryW%,2,4)
  4298. shut_window(wi%):
  4299. set_caret(mainW%,starthere%)
  4300.  398:
  4301.  wi% 
  4302. $    
  4303.  changeW%:
  4304. set_caret(wi%,0)
  4305. $    
  4306.  mergeW%:
  4307. set_caret(wi%,14)
  4308.  399:
  4309.  wi% 
  4310. $    
  4311.  changeW%:
  4312. set_caret(wi%,1)
  4313. $    
  4314.  mergeW%:
  4315. set_caret(wi%,14)
  4316.  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,458,474,490,506,459,475,491,507:
  4317. button_action(key_pressed%)
  4318.  "OS_Byte",228,1:
  4319.  "Wimp_ProcessKey",key_pressed%
  4320. main_press(wi%,ic%)
  4321. selected(passW%,10) 
  4322.  "Wimp_ProcessKey",key_pressed%:
  4323.  icon%
  4324.  flash% 
  4325. deselect(wi%,field%(flash%)):flash%=
  4326. trim(wi%,ic%)
  4327.  key_pressed%<>392 
  4328. validate(Fieldnumber%,T%,N$)=
  4329.  changed%=
  4330. update_calcs(Fieldnumber%)
  4331.  key_pressed% 
  4332. select_range(1,fields%,
  4333.  len%(Fieldnumber%)>=10 
  4334. +    $Rf%(Fieldnumber%)=
  4335. convert_date(4)
  4336. G    
  4337.  len%(Fieldnumber%)>=8 
  4338.  $Rf%(Fieldnumber%)=
  4339. convert_date(2)
  4340. redraw_icon(wi%,field%(Fieldnumber%))
  4341.  5:template%=1:
  4342. display(key%,-1)
  4343. tick_one(fieldmenu%,0,fields%-1,Fieldnumber%-1)
  4344. 7  fieldmenu%=
  4345. field_menu(fields%,(printorder$<>""))
  4346.  "Wimp_GetPointerInfo",,block%
  4347. show_menu(fieldmenu%,!block%-150,block%!4+16)
  4348.   fieldfunc$="CtrlF"
  4349. 3  $Query%="":$ChangeTitle%="Field: "+Fieldname$
  4350. position_window(changeW%,0,0,0,0,0,0):
  4351. set_caret(changeW%,0)
  4352.  9:*Indices
  4353. set_up_field_menu
  4354. @  keyfunc$="Index field":$KeyTitle%=keyfunc$+": "+Fieldname$
  4355. shade_key_icons(
  4356. deselect(keyW%,30):
  4357. deselect(keyW%,35):
  4358. deselect(keyW%,37)
  4359. position_window(keyW%,0,0,0,504,0,0):
  4360. set_caret(keyW%,13)
  4361. 0  keyfunc$="Current key":$KeyTitle%=keyfunc$
  4362. set_keydata(key%):
  4363. shade_key_icons(
  4364. position_window(keyW%,0,0,0,504,0,0)
  4365. set_up_field_menu:
  4366.  LastTable%<>-1 
  4367. position_window(linkW%,0,0,0,0,0,0)
  4368.  Fieldnumber%=Lastwritable% 
  4369. close_window(relateW%)
  4370. display(key%,-1)
  4371.         
  4372.         
  4373. A      Fieldnumber%+=1:
  4374.  Fieldnumber%>fields% 
  4375.  Fieldnumber%=1
  4376. ?      c%=chartype%(Fieldnumber%):icon%=field%(Fieldnumber%)
  4377. X    
  4378.  vtype$(c%)="E" 
  4379.  len%(Fieldnumber%)>0 
  4380. get_icon_cols(wi%,icon%)<>winback%*17
  4381. set_caret(wi%,icon%)
  4382. ,    
  4383. selected(prefsW%,19) 
  4384. relations
  4385.  filter% 
  4386. P    
  4387.  field%(buttonfield%(0,22))>0 
  4388. filter(mainW%,
  4389. filter(keypadW%,
  4390. .    
  4391. selected(passW%,14) 
  4392. match(0,0)
  4393. query_click(queryW%,2,4)
  4394.  16:*JobsDone
  4395.  17:*Tables
  4396.  18:*Resources
  4397.  19:starthere%=field%(Fieldnumber%):$StartHere%=Tag$(Fieldnumber%):
  4398. redraw_icon(prefsW%,45):
  4399.  Access% 
  4400. set_caret(mainW%,starthere%)
  4401.  len%(Fieldnumber%)>=8 
  4402.     T$=
  4403. -    
  4404. T$,3,1)=$timesep%:
  4405. T$,6,1)=$timesep%
  4406.     $Rf%(Fieldnumber%)=T$
  4407. .    
  4408. redraw_icon(wi%,field%(Fieldnumber%))
  4409. selected(passW%,13) 
  4410. 8    
  4411. getscreensize(ScreenWidth%,ScreenHeight%,Vpix%)
  4412. :    x%=(ScreenWidth%-w%) 
  4413.  2:y%=(ScreenHeight%-h%) 
  4414. 1    choice$(1)="Export CSV":
  4415. act_on_main_menu
  4416. clear_selection
  4417. keypad_click(keypadW%,1,4)
  4418. close_it(linkW%):
  4419. close_it(keyW%):
  4420. close_it(csvW%)
  4421.  30:Fieldnumber%=
  4422. first_writable:
  4423. set_caret(wi%,field%(Fieldnumber%))
  4424.  384:
  4425. selected(passW%,14) 
  4426. match(0,0)
  4427.  394:
  4428. selected(passW%,9) 
  4429. position_window(keypadW%,250,100,0,0,0,0)
  4430.  398:
  4431. ?    Fieldnumber%+=1:
  4432.  Fieldnumber%>fields% 
  4433.  Fieldnumber%=1
  4434. =    c%=chartype%(Fieldnumber%):icon%=field%(Fieldnumber%)
  4435.  vtype$(c%)="E" 
  4436.  len%(Fieldnumber%)>0 
  4437. get_icon_cols(wi%,icon%)<>winback%*17 
  4438. set_caret(wi%,icon%)
  4439. selected(prefsW%,19) 
  4440. relations
  4441.  399:
  4442. ?    Fieldnumber%-=1:
  4443.  Fieldnumber%<1 
  4444.  Fieldnumber%=fields%
  4445. =    c%=chartype%(Fieldnumber%):icon%=field%(Fieldnumber%)
  4446.  vtype$(c%)="E" 
  4447.  len%(Fieldnumber%)>0 
  4448. get_icon_cols(wi%,icon%)<>winback%*17
  4449. set_caret(wi%,icon%)
  4450. selected(prefsW%,19) 
  4451. relations
  4452.  400:
  4453. select(printW%,51):
  4454. deselect(printW%,50)
  4455. position_window(printW%,0,0,0,0,0,0):
  4456. set_caret(printW%,16)
  4457.  416:
  4458. print_this
  4459.  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,458,474,490,506,459,475,491,507:
  4460. button_action(key_pressed%)
  4461.  433:
  4462. reveal(
  4463.  434:
  4464. reveal(
  4465.  441:
  4466. protect(wi%,ic%,Fieldnumber%)
  4467.  "OS_Byte",228,1:
  4468.  "Wimp_ProcessKey",key_pressed%
  4469. selected(prefsW%,21) 
  4470.  chartype%(Fieldnumber%) 
  4471. 0-    
  4472.  Leave keyboard status unchanged
  4473. 1$    
  4474.  2,4:
  4475.  "OS_Byte",202,0,239
  4476. 2!    
  4477.  "OS_Byte",202,16,111
  4478.  "OS_Byte",118
  4479.  "OS_Byte",15,0
  4480. button_action(K%)
  4481. check_change
  4482. button%=
  4483. key_assigned(K%)
  4484.  button% 
  4485.  "Wimp_ProcessKey",K%:
  4486.  ### No keypad action ###
  4487. selected(passW%,9) 
  4488. @O    
  4489. invert(keypadW%,button%):
  4490. filter(keypadW%,
  4491. selected(keypadW%,button%))
  4492. A        
  4493. B+    ic%=field%(buttonfield%(0,button%))
  4494. CB    
  4495.  ic%>0 
  4496. invert(wi%,ic%):
  4497. filter(wi%,
  4498. selected(wi%,ic%))
  4499.  13,23:
  4500.  button%=23 
  4501.  e%=-1:button%=13 
  4502.  e%=1
  4503. invert(keypadW%,button%)
  4504. selected(passW%,9) 
  4505. I"    
  4506. allow_search(keypadW%,e%)
  4507. JE    
  4508.  field%(buttonfield%(0,button%))>0 
  4509. allow_search(wi%,e%)
  4510. invert(keypadW%,button%)
  4511. invert(keypadW%,14):
  4512. display(key%,-2):
  4513. invert(keypadW%,14)
  4514. shaded(keypadW%,button%) 
  4515. P!    
  4516. invert(keypadW%,button%)
  4517. Q&    
  4518. mouse(0,0,4,keypadW%,button%)
  4519. R!    
  4520. invert(keypadW%,button%)
  4521. key_assigned(pressed%)
  4522. Y    I%=-1
  4523.   I%+=1
  4524.  I%=24 
  4525.  buttonfield%(1,I%)=pressed%
  4526.  buttonfield%(1,I%)=pressed% 
  4527. dbox_press(ok%,esc%,wi2%,down%,up%)
  4528. trim(wi%,ic%)
  4529.  wi% 
  4530.  accessW%:
  4531.  key_pressed% 
  4532. dM    
  4533. next_writable(wi%,ic%,1,1,wi2%,down%) 
  4534. mouse(0,0,4,wi%,ok%)
  4535. e#    
  4536. mouse(0,0,4,wi%,esc%)
  4537. f7    
  4538.  398:f%=
  4539. next_writable(wi%,ic%,1,0,wi2%,down%)
  4540. g6    
  4541.  399:f%=
  4542. next_writable(wi%,ic%,-1,0,wi2%,up%)
  4543. h+    
  4544.  "Wimp_ProcessKey",key_pressed%
  4545.  key_pressed% 
  4546. selected(prefsW%,41) 
  4547. next_writable(wi%,ic%,1,1,wi2%,down%) 
  4548. mouse(0,0,4,wi%,ok%):
  4549. set_caret(mainW%,starthere%)
  4550. mA    
  4551. mouse(0,0,4,wi%,esc%):
  4552. set_caret(mainW%,starthere%)
  4553. n7    
  4554.  398:f%=
  4555. next_writable(wi%,ic%,1,0,wi2%,down%)
  4556. o6    
  4557.  399:f%=
  4558. next_writable(wi%,ic%,-1,0,wi2%,up%)
  4559. p#    
  4560.  wi%=tabcreateW% 
  4561.  ic%=0 
  4562. q:      $tabcol%=
  4563. (MaxCols%):
  4564. redraw_icon(tabcreateW%,8)
  4565. r;      !block%=scrollW%:
  4566.  "Wimp_GetWindowState",,block%
  4567. s=      block%!24=-MaxCols%*44:
  4568.  "Wimp_OpenWindow",,block%
  4569. t        
  4570.  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,458,474,490,506,459,475,491,507:
  4571. v$    
  4572. button_action(key_pressed%)
  4573. w>    
  4574.  "OS_Byte",228,1:
  4575.  "Wimp_ProcessKey",key_pressed%
  4576. scroll_press
  4577.  row%
  4578. trim(wi%,ic%)
  4579.  key_pressed% 
  4580.  13,398:f%=
  4581. next_writable(wi%,ic%,1,0,tabcreateW%,0)
  4582.  399:f%=
  4583. next_writable(wi%,ic%,-1,0,tabcreateW%,8)
  4584.  "Wimp_ProcessKey",key_pressed%
  4585.  "Wimp_GetCaretPosition",,block%
  4586.  !block%=scrollW% 
  4587.  ic%=block%!4 
  4588.  ic%=0
  4589. row%=ic% 
  4590. 0$tabcol%=
  4591. (row%):
  4592. redraw_icon(tabcreateW%,8)
  4593. 5!block%=scrollW%:
  4594.  "Wimp_GetWindowState",,block%
  4595.  scrollrow%=-(block%!24 
  4596.  row%-scrollrow%>4 
  4597.  block%!24=(4-row%)*44:
  4598.  "Wimp_OpenWindow",,block%
  4599.  row%<scrollrow% 
  4600.  block%!24=-row%*44:
  4601.  "Wimp_OpenWindow",,block%
  4602. table_press(T%)
  4603.  icons%,row%,scrollrow%,visible_rows%
  4604. trim(wi%,ic%)
  4605. icons%=Rows%*(TabFields%+1)
  4606.  key_pressed% 
  4607.  ic%<icons%-1 
  4608.  ic%+=1 
  4609.  ic%=0
  4610.  398:
  4611.  ic%<icons%-TabFields%-1 
  4612.  ic%+=(TabFields%+1) 
  4613.  ic%=ic% 
  4614.  (TabFields%+1)
  4615.  399:
  4616.  ic%>=TabFields%+1 
  4617.  ic%-=(TabFields%+1) 
  4618.  ic%=icons%-TabFields%-1+ic% 
  4619.  (TabFields%+1)
  4620.  "Wimp_ProcessKey",key_pressed%
  4621. set_caret(tableW%(T%),ic%)
  4622. 'row%=(ic% 
  4623.  (TabFields%+1))-NewTab%
  4624. 8!block%=tableW%(T%):
  4625.  "Wimp_GetWindowState",,block%
  4626. -visible_rows%=(block%!16-block%!8) 
  4627.  44-1
  4628.  scrollrow%=-(block%!24 
  4629.  row%-scrollrow%>visible_rows% 
  4630.  block%!24=(visible_rows%-row%)*44:
  4631.  "Wimp_OpenWindow",,block%
  4632.  row%<scrollrow% 
  4633.  block%!24=-row%*44:
  4634.  "Wimp_OpenWindow",,block%
  4635. create_press
  4636. shaded(wi%,29):
  4637. shaded(wi%,18) 
  4638. dbox_press(18,41,0,0,0)
  4639. shaded(wi%,29) 
  4640. dbox_press(29,41,0,0,0)
  4641. menu_select
  4642.  handle%,P%,Q%,I%,M%,field%,umenu%
  4643. &choice1%=!block%:choice2%=block%!4
  4644. (choice3%=block%!8:choice4%=block%!12
  4645.  M%=0 
  4646.  MaxMenus%
  4647.  menuhandle%=userM%(M%,1) 
  4648.  umenu%=menuhandle%:field%=userM%(M%,0)
  4649.  "Wimp_DecodeMenu",,menuhandle%,block%,choices%
  4650.  I%=1 
  4651.   Q%=
  4652. $choices%,".",P%+1)
  4653. &  choice$(I%)=
  4654. $choices%,P%,Q%-P%)
  4655.   P%=Q%+1
  4656.  "Wimp_GetPointerInfo",,block%
  4657. x%=!block%:y%=block%!4
  4658. redo%=block%!8=1
  4659.  menuhandle% 
  4660.  iconbarM%:
  4661. act_on_icon_bar_menu
  4662.  mainM%:
  4663. act_on_main_menu
  4664.  designM%:
  4665. act_on_create_menu
  4666.  tableM%:
  4667. act_on_table_menu(choice$(1))
  4668.  listM%:
  4669. act_on_text_menu
  4670.  delimiterM%:
  4671. act_on_csv_sep
  4672.  terminatorM%:
  4673. act_on_csv_term
  4674.  ftypeM%(0):
  4675. act_on_fieldtype_menus(0)
  4676.  ftypeM%(1):
  4677. act_on_fieldtype_menus(1)
  4678.  ftypeM%(2):
  4679. act_on_fieldtype_menus(2)
  4680.  ftypeM%(3):
  4681. act_on_fieldtype_menus(3)
  4682.  ftypeM%(4):
  4683. act_on_fieldtype_menus(4)
  4684.  ftypeM%(5):
  4685. act_on_fieldtype_menus(5)
  4686.  ftypeM%(6):
  4687. act_on_fieldtype_menus(6)
  4688.  keystrokeM%:
  4689. act_on_keypad_menu
  4690.  tablemenu%::
  4691. act_on_menu_of_tables
  4692.  fieldmenu%:
  4693. act_on_menu_of_fields
  4694.  umenu%:
  4695. 2  menic%=umenu%+28+choice1%*24:flags%=menic%!8
  4696.  (flags% 
  4697.  (1<<8))=0 
  4698. !    choice$=
  4699. $(menic%+12),12)
  4700.  choice$=$(menic%!12)
  4701.  fix%(field%)<>0 
  4702.  choice$=
  4703. fix_point(choice$,field%)
  4704. (choice$)<=len%(field%) 
  4705.     $Rf%(field%)=choice$
  4706. +    
  4707. redraw_icon(mainW%,field%(field%))
  4708. )    
  4709. set_caret(mainW%,field%(field%))
  4710. )    
  4711. softerror(""""+choice$+"""",7)
  4712. special_select
  4713.  quit% 
  4714.  redo% 
  4715. show_menu(menuhandle%,menux%,menuy%)
  4716. act_on_main_menu
  4717.  choice$(1) 
  4718.  "CSV options"
  4719.   $CSVTitle%=choice$(1)
  4720. shade(csvW%,0,
  4721. text(csvW%,9)="Accept"
  4722. position_window(csvW%,x%-350,y%-180,700,440,0,0)
  4723.  "Miscellaneous":
  4724. act_on_misc_menu
  4725.  "Print":
  4726. act_on_print_menu
  4727.  "Validation":
  4728. act_on_validation_menu
  4729.  "Current key":
  4730. /  $KeyTitle%=choice$(1):keyfunc$=choice$(1)
  4731. set_keydata(key%):
  4732. shade_key_icons(
  4733. position_window(keyW%,x%-284,y%-252,0,504,0,0)
  4734.  "Show keypad":
  4735. selected(passW%,9) 
  4736. position_window(keypadW%,-1,-1,0,0,0,0)
  4737.  "Export subset":
  4738. ?  export%=
  4739. :$SubTitle%="Export subset":savefunc$=choice$(1)
  4740. /  $SubName%=$database%+".PrintJobs.!Subset"
  4741. /  $SubSprite%="snew_appl;Pptr_hand,12,8;R2"
  4742.   $Query%=""
  4743. position_window(savesubW%,x%-244,y%-161,0,0,0,0):
  4744. set_caret(queryW%,0)
  4745.  "Export CSV":
  4746. 7  $SubTitle%="Export CSV file":savefunc$=choice$(1)
  4747.  sep$="," 
  4748.  t$="dfe":f$="CSV" 
  4749.  t$="fff":f$="Sep"
  4750. 2  $SubName%=$database%+".PrintJobs."+f$+"file"
  4751. 2  $SubSprite%="sfile_"+t$+";Pptr_hand,12,8;R2"
  4752.   $Query%=""
  4753. position_window(savesubW%,x%-244,y%-161,0,0,0,0):
  4754. set_caret(queryW%,0)
  4755.  "Undo changes":
  4756. restore_rec
  4757.  "Help":
  4758.  "Wimp_StartTask","<Pbase$Dir>.!Help"
  4759. act_on_field_menu
  4760. act_on_misc_menu
  4761.  choice$(2) 
  4762.  "Move/delete":
  4763. shade(moveW%,6,
  4764. deselect(moveW%,
  4765. selected_esg(moveW%,1)):
  4766. select(moveW%,2)
  4767.   $Query%=""
  4768. position_window(moveW%,x%-253,y%-232,0,0,0,0):
  4769. set_caret(queryW%,0)
  4770.  "Set passwords":
  4771. position_window(passW%,x%-213,y%-388,0,0,0,0):
  4772. set_caret(passW%,2)
  4773.  "Edit template":template%=1:
  4774. display(key%,-1)
  4775.  "Name subfile":
  4776.  choice3% 
  4777. H    P%=
  4778. $RecInfo%,"Record")-1:$RecInfo%=$Subfilename%+
  4779. $RecInfo%,P%)
  4780. &    $Subfile%(file%)=$Subfilename%
  4781. asterisk(
  4782.  "Rename database":
  4783. rename_database($NewName%)
  4784. act_on_print_menu
  4785.  choice$(2) 
  4786.  "Match":
  4787. match(x%-396,y%-131)
  4788.  "Show resources":*Resources
  4789.  "Options":
  4790. select(printW%,51):
  4791. deselect(printW%,50)
  4792. position_window(printW%,x%-458,y%-401,0,0,0,0):
  4793. set_caret(printW%,16)
  4794.  "Save query":
  4795.  -  $SaveName%=$database%+".PrintRes.Query"
  4796. !2  savefunc$=choice$(2):
  4797. save_click(saveW%,1,4)
  4798.  "Save selection":
  4799. #1  $SaveName%=$database%+".PrintRes.Selection"
  4800. $2  savefunc$=choice$(2):
  4801. save_click(saveW%,1,4)
  4802.  "Show jobs done":*JobsDone
  4803.  "Clear selection":
  4804. clear_selection
  4805.  "Select all":
  4806. select_range(1,fields%,
  4807.  "Numeric fields":
  4808. match(x%-396,y%-131)
  4809. act_on_validation_menu
  4810.  choice$(2) 
  4811.  "Create table":
  4812. 0D  $
  4813. text(tabcreateW%,0)="":$
  4814. text(tabcreateW%,1)="":$tabcol%="0"
  4815.  I%=0 
  4816.  MaxCols%*2+1
  4817.     $
  4818. text(scrollW%,I%)=""
  4819. set_icon_cols(tabcreateW%,13,&28)
  4820. set_icon_cols(tabcreateW%,14,&07)
  4821. position_window(tabcreateW%,x%-241,y%-301,0,0,0,0):
  4822. set_caret(tabcreateW%,0)
  4823.  "Display table":
  4824.  choice3%>=0 
  4825.     Tablenumber%=choice3%
  4826. :!    
  4827. show_table(Tablenumber%)
  4828.  "Show table files":*Tables
  4829. act_on_field_menu
  4830.  choice$(2) 
  4831.  "Index field":
  4832. C=  keyfunc$=choice$(2):$KeyTitle%=keyfunc$+": "+Fieldname$
  4833. shade_key_icons(
  4834. deselect(keyW%,30):
  4835. deselect(keyW%,35):
  4836. deselect(keyW%,37)
  4837. position_window(keyW%,x%-284,y%-252,0,504,0,0):
  4838. set_caret(keyW%,13)
  4839.  "Analyse index":
  4840. analyse(
  4841. is_a_key(Fieldnumber%))
  4842.  "Analyse months":
  4843. analyse(-1)
  4844.  "Link to table":
  4845. position_window(linkW%,x%-350,y%-129,0,0,0,0)
  4846.  "Calculations","Combine fields":
  4847. position_window(calcW%,0,0,0,0,0,0):
  4848. set_caret(calcW%,0)
  4849.  "Global changes":$Query%="":
  4850. position_window(changeW%,x%-252,y%-214,0,0,0,0):
  4851. set_caret(changeW%,0)
  4852.  "Start editing":
  4853. M]  starthere%=field%(Fieldnumber%):$StartHere%=Tag$(Fieldnumber%):
  4854. redraw_icon(prefsW%,45)
  4855.  Access% 
  4856. set_caret(mainW%,starthere%)
  4857.  "Remove external","Unlink directory","Unlink file":
  4858.  chartype%(Fieldnumber%) 
  4859. Q0    
  4860.  35:link$(Fieldnumber%)="":
  4861. asterisk(
  4862.     link$(Fieldnumber%)=""
  4863. T7    $
  4864. val(mainW%,field%(Fieldnumber%))="R5;Saction"
  4865. U1    
  4866. redraw_icon(mainW%,field%(Fieldnumber%))
  4867. asterisk(
  4868. WR    
  4869. show_picture(Fieldnumber%):
  4870. redraw_icon(mainW%,field%(Fieldnumber%))
  4871. XI    
  4872. delete_blob(Fieldnumber%,object$,mainW%,field%(Fieldnumber%))
  4873.  "Undo changes":
  4874. restore(Fieldnumber%,"",-1)
  4875.  "Compact sequence":
  4876. compact(Fieldnumber%)
  4877. compact(F%)
  4878.  sequenceval$,V$
  4879. is_a_key(F%) 
  4880.  key%:
  4881. confirm(
  4882. msg("Err128")) 
  4883. d'    
  4884. split_link(F%,V$,sequenceval$)
  4885.     V$=sequenceval$
  4886.  "Hourglass_On"
  4887. g.    dbasehandle%=
  4888. ($database%+".Database")
  4889. h!    P%=
  4890. neighbour(key%,top,1)
  4891. i,    
  4892. scan_file("P%<>top",key%,file%,7,1)
  4893.  "Hourglass_Off"
  4894. k!    
  4895. close_file(dbasehandle%)
  4896. l%    calc$(F%)=V$+"|"+sequenceval$
  4897. save_calcs:
  4898. save_keys
  4899. softerror(Tag$(F%),116)
  4900. softerror(Tag$(F%),127)
  4901. act_on_keypad_menu
  4902.  choice$(1) 
  4903.  "Defaults":
  4904. load_fkeys("DFkeys")
  4905.  "Save choices":
  4906. save_fkeys
  4907.  "List keys":
  4908. list_fkeys
  4909. act_on_csv_sep
  4910.  choice$(1) 
  4911.  "Comma":sep$=","
  4912.  "TAB":sep$=
  4913.  "CR":sep$=
  4914.  "LF":sep$=
  4915.  sep$=$Delim%
  4916. tick_one(menuhandle%,0,3,choice1%)
  4917. text(csvW%,14)=choice$(1)
  4918. redraw_icon(csvW%,14)
  4919. act_on_csv_term
  4920.  choice$(1) 
  4921.  "CR":term$=
  4922.  "LF":term$=
  4923.  "CR LF":term$=
  4924. (13)+
  4925.  "LF CR":term$=
  4926. (10)+
  4927.  "CR CR":term$=
  4928. (13)+
  4929.  "LF LF":term$=
  4930. (10)+
  4931. :term$=$Termin%
  4932. tick_one(menuhandle%,0,5,choice1%)
  4933. text(csvW%,15)=choice$(1)
  4934. redraw_icon(csvW%,15)
  4935. act_on_text_menu
  4936. choice$(1),4) 
  4937.  "Save":
  4938.   $SaveName%=TextName$
  4939. 0  $SaveSprite%="sfile_fff;Pptr_hand,12,8;R2"
  4940. 2  savefunc$=choice$(1):
  4941. save_click(saveW%,1,4)
  4942.  "Sort":
  4943. sort_list(sort_textcol%)
  4944.  "Scra":
  4945. lose_list
  4946. act_on_create_menu
  4947.  choice$(1) 
  4948.  "Design field":
  4949. position_window(createW%,x%-425,y%-320,0,0,0,0):
  4950. set_caret(createW%,4)
  4951.  "Save form file":
  4952. #  $SaveName%=$database%+".Form"
  4953. 2  savefunc$=choice$(1):
  4954. save_click(saveW%,1,4)
  4955.  "Default database":
  4956. save_form($database%+".Form")
  4957. first_writable>0 
  4958. default_key
  4959. #    
  4960. defaults($database%,100,0)
  4961. softerror("",35)
  4962.  "Primary key":
  4963. '  fieldmenu%=
  4964. field_menu(fields%,
  4965.   F%=
  4966. first_writable
  4967. 0  starthere%=field%(F%):$StartHere%=Tag$(F%)
  4968.   $KeyTitle%=choice$(1)
  4969.   keyfunc$=choice$(1)
  4970.    case%(0)=
  4971. set_keydata(0)
  4972. shade_key_icons(
  4973. shade(keyW%,37,
  4974. position_window(keyW%,x%-284,y%-252,0,504,0,0):
  4975. set_caret(keyW%,13)
  4976.  "Quit design":
  4977. adjust_on(
  4978. save_form($database%+".Form")
  4979. save_calcs
  4980. get_it_in($database%)
  4981. act_on_fieldtype_menus(m%)
  4982. currenttype%=choice1%
  4983. +fieldtype%=?(flist%(m%)+currenttype%+1)
  4984. tick_one(menuhandle%,0,lasttype%,choice1%)
  4985. update_box
  4986. act_on_menu_of_tables
  4987. Tablenumber%=choice1%
  4988. $$Tablename%=table$(Tablenumber%)
  4989. tick_one(menuhandle%,0,LastTable%,choice1%)
  4990. redraw_icon(linkW%,0)
  4991. act_on_menu_of_fields
  4992.  fieldfunc$ 
  4993.  "create":
  4994. design_field(2,choice1%*2+1,
  4995.  "help":
  4996.   Match_tag%=choice1%+1
  4997. text(helpW%,0)=Tag$(Match_tag%):
  4998. redraw_icon(helpW%,0)
  4999. tick_one(fieldmenu%,0,fields%-1,choice1%)
  5000.  "CtrlF":
  5001.  printorder$="" 
  5002.   Fieldnumber%=(choice1%+1)
  5003. A    
  5004.  chartype%(Fieldnumber%)<6 
  5005.  chartype%(Fieldnumber%)=8 
  5006. 1      
  5007. set_caret(mainW%,field%(Fieldnumber%))
  5008. .      
  5009. selected(prefsW%,19) 
  5010. relations
  5011.         
  5012.  "0","1","2","3":
  5013.   keyfield%=
  5014. (fieldfunc$)
  5015.  keyfunc$<>"Current key" 
  5016. (    
  5017. ticked(fieldmenu%,choice1%) 
  5018. O      keyfield%(keyfield%)=0:
  5019. kcycle(keyfield%(keyfield%),4*keyfield%+12,0)
  5020.       
  5021. X      keyfield%(keyfield%)=choice1%+1:
  5022. kcycle(keyfield%(keyfield%),4*keyfield%+12,0)
  5023.         
  5024. act_on_table_menu(ch$)
  5025. (Tablenumber%=
  5026. table_number($tableM%)
  5027.  ch$="Save":
  5028. 2  $SaveName%=$database%+".ValTables."+$tableM%
  5029. 4  savefunc$="Save table":
  5030. save_click(saveW%,1,4)
  5031.  ch$="Clear":
  5032. clear_table(Tablenumber%)
  5033.  ch$="Print":
  5034. print_table(Tablenumber%)
  5035. ch$,4)="Sort":
  5036. sort_table(Tablenumber%,sort_tabcol%)
  5037.  ch$="Undo all":
  5038. restore_table(Tablenumber%)
  5039.  ch$="Undo change":
  5040. restore_tabfield
  5041.  ch$="Save as CSV":
  5042. 2  $SaveName%=$database%+".PrintJobs."+$tableM%
  5043. 1  savefunc$="Save table as CSV":writetable%=
  5044. save_click(saveW%,1,4)
  5045.  ch$="Modify":
  5046. modify_table(Tablenumber%,tabcreateW%)
  5047. act_on_icon_bar_menu
  5048.  choice$(1) 
  5049.  "Help":
  5050.  "Wimp_StartTask","<Pbase$Dir>.!Help"
  5051.  "Utilities":
  5052.  choice$(2) 
  5053.  "New primary key":
  5054.     $KeyTitle%=choice$(2)
  5055. +    keyfunc$=choice$(2):
  5056. set_keydata(0)
  5057.  (present% 
  5058.  2)=2 
  5059. /      
  5060. select(keyW%,32):
  5061. deselect(keyW%,33)
  5062. /      
  5063. shade(keyW%,32,
  5064. shade(keyW%,33,
  5065.       
  5066.     /      
  5067. select(keyW%,33):
  5068. deselect(keyW%,32)
  5069. /      
  5070. shade(keyW%,32,
  5071. shade(keyW%,33,
  5072.         
  5073. .    
  5074. shade_key_icons(
  5075. shade(keyW%,37,
  5076. L    
  5077. position_window(keyW%,x%-284,y%-303,0,606,0,0):
  5078. set_caret(keyW%,13)
  5079.  "New record format":
  5080. close_window(reformW%)
  5081. 5    reform$="Reformat":$
  5082. text(reformW%,6)=reform$
  5083. *    $RefmTitle%="Change record format"
  5084. shade(reformW%,6,
  5085. 7    
  5086. position_window(reformW%,x%-237,100,0,236,0,0)
  5087.         
  5088.  "Adjust format":
  5089. adjust_on(
  5090. open_window(mainW%)
  5091. display(key%,-1)
  5092. 3    
  5093. alter_flags(&07016711,&07006535,&1700653F)
  5094.  "Merge database":
  5095. close_window(reformW%)
  5096. 2    reform$="Merge":$
  5097. text(reformW%,6)=reform$
  5098. $    $RefmTitle%="Merge database"
  5099. shade(reformW%,6,
  5100. 7    
  5101. position_window(reformW%,x%-237,100,0,400,0,0)
  5102.  (    
  5103.  "Balance index":
  5104. balance(key%)
  5105.  "Print index":
  5106.  choice$(3) 
  5107.       
  5108.  "Complete":
  5109. $'      
  5110. print_tree(key%,file%,"ALL")
  5111.       
  5112.  "Totals only":
  5113. &*      
  5114. print_tree(key%,file%,"TOTALS")
  5115. '        
  5116. (-    
  5117.  "Find duplicates":
  5118. duplicates(key%)
  5119.  "Close database":
  5120.  "Preferences":
  5121. position_window(prefsW%,x%-371,150,0,0,0,0):
  5122. set_caret(prefsW%,1)
  5123.  "Quit":quit%=
  5124. reveal(vis%)
  5125.  F%,dic%,fic%
  5126.  Modify% 
  5127.  F%=1 
  5128.  fields%
  5129. 4&    dic%=desc%(F%):fic%=field%(F%)
  5130.  hide%?F%=1 
  5131.       
  5132.  vis% 
  5133. 7G        
  5134. set_icon_cols(wi%,dic%,23):
  5135. set_icon_cols(wi%,fic%,04)
  5136. 8Y        
  5137. set_icon_cols(wi%,dic%,winback%*17):
  5138. set_icon_cols(wi%,fic%,winback%*17)
  5139.       
  5140. :        
  5141. protect(wi%,ic%,F%)
  5142.  Modify% 
  5143. get_icon_cols(wi%,ic%) 
  5144. B2    
  5145. set_icon_cols(wi%,ic%,04):hide%?F%=1
  5146. C2    
  5147. set_icon_cols(wi%,ic%,07):hide%?F%=0
  5148.   protect%=
  5149. init_drag(wi%,ic%,dragtype%)
  5150. getscreensize(W%,H%,V%)
  5151. !block%=wi%
  5152.  "Wimp_GetWindowState",,block%
  5153. ysize%=block%!16-block%!8
  5154. x%=block%!4-block%!20
  5155. y%=block%!16-block%!24
  5156. block%!4=ic%
  5157.  "Wimp_GetIconState",,block%
  5158. block%!8+=x%:minx%=block%!8
  5159. S!block%!12+=y%:miny%=block%!12
  5160. T!block%!16+=x%:maxx%=block%!16
  5161. U!block%!20+=y%:maxy%=block%!20
  5162.  dragtype%=6 
  5163. W5  block%!24=2*minx%-maxx%:block%!36=2*maxy%-miny%
  5164.  block%!24=0:block%!36=H%
  5165. block%!28=0
  5166. block%!32=W%
  5167. !block%=0
  5168. block%!4=dragtype%
  5169.  wi% 
  5170.  saveW%,savesubW%:
  5171.  wi%=saveW% 
  5172.  sprite$=
  5173. $SaveSprite%,2,8) 
  5174.  sprite$=
  5175. $SubSprite%,2,8)
  5176.  "DragASprite_Start",&C5,1,sprite$,block%+8
  5177.  "Wimp_DragBox",,block%
  5178.  wi%=mainW% 
  5179.  ficon%=ic%
  5180. end_drag(start%,end%)
  5181.  wi%,ic%
  5182. datasize%=end%-start%
  5183.  "Wimp_GetPointerInfo",,block%
  5184. wi%=block%!12:ic%=block%!16
  5185. m7block%!32=block%!4:block%!28=block%!0:block%!24=ic%
  5186. n+block%!20=wi%:block%!24=ic%:block%!16=1
  5187. o3block%!12=0:block%!36=datasize%:block%!40=Type%
  5188.  design% 
  5189.  dragbutt%>0 
  5190. adjust_field(dragbutt%)
  5191.  Filename$<>"" 
  5192.  wi%<>mainW% 
  5193. t%    $(block%+44)=
  5194. leaf(Filename$)
  5195.     !block%=60
  5196. v/    
  5197.  "Wimp_SendMessage",17,block%,wi%,ic%
  5198.     ramptr%=start%
  5199. x     
  5200.  "Wimp_CreateMenu",,-1
  5201. encrypt(S$,Z%)
  5202.  I%,R%
  5203. (-12817)
  5204.  I%=1 
  5205. S$,I%,1)>"@" 
  5206.     R%=
  5207. (58)-1
  5208.  R%=58-R%
  5209. 1    
  5210. S$,I%,1)=
  5211. S$,I%,1))-65+R%) 
  5212.  58+65)
  5213. leaf(s$)
  5214. s2$=""
  5215. s$)<>"." 
  5216.  s$<>""
  5217.   s2$=
  5218. s$)+s2$
  5219.   s$=
  5220. dbasepath$=
  5221.  Message handling ----------------------------------------------------
  5222. not_acknowledged
  5223.  block%!16 
  5224.  DataOpen failed, so run file
  5225.  block%!8=Impref% 
  5226.  Imp_wait%=
  5227.  "Wimp_StartTask",$(block%+44)
  5228.  RAMTransmit failed
  5229.  merging% 
  5230.  moan_err%,
  5231. msg("Err39")
  5232.  At this point, the message ought to have been sent by us, so check it
  5233.  Very bizarre situation if you get this error (!!)
  5234.  block%!8<>myref% 
  5235.  moan_err%,"Reference fields mismatch (msglost/DataLoad)"
  5236.  If transfer marked as temporary, delete scrap file
  5237.  block%!36=-1 
  5238.  "OS_File",6,block%+44
  5239.  moan_err%,
  5240. msg("Err39")
  5241.  &80142:
  5242.  moan_err%,
  5243. msg("Err90")
  5244.  ### Attempt to print directly when no driver installed ###
  5245. message
  5246.  task%,ref%,ftype%,filename$,w%,i%,x%,y%
  5247.  task%=block%!4:ref%=block%!8
  5248.  block%!16 
  5249.  0:quit%=
  5250.  ### DataSave ###
  5251.  task%<>mytask% 
  5252.  present%=7 
  5253.     datasize%=block%!36
  5254.  block%!40 
  5255.        
  5256.  &fff,&ff9,&aff,&dfe:
  5257.       myref%=ref%
  5258. >      block%!0=256:block%!12=ref%:block%!16=2:block%!36=-1
  5259. *      $(block%+44)="<Wimp$Scrap>"+
  5260. /      
  5261.  "Wimp_SendMessage",17,block%,task%
  5262.         
  5263.  ### DataSaveAck ###
  5264.   block%!12=ref%
  5265.  "Wimp_SendMessage",19,block%,task%
  5266. 3  ftype%=block%!40:filename$=
  5267. getstr(block%+44)
  5268.  filename$<>"" 
  5269. ;    w%=block%!20:i%=block%!24:x%=block%!28:y%=block%!32
  5270. L    
  5271. save(filename$,Type%,Start%,End%):
  5272. write_log(-1,filename$+" saved")
  5273. +    block%!0=(44+
  5274.  filename$+1+3) 
  5275. V    block%!12=ref%:block%!16=3:block%!20=w%:block%!24=i%:block%!28=x%:block%!32=y%
  5276. 0    
  5277.  "OS_File",5,filename$ 
  5278.  ,,,,block%!36
  5279. 4    block%!40=ftype%:$(block%+44)=filename$+
  5280. -    
  5281.  "Wimp_SendMessage",18,block%,task%
  5282.     myref%=block%!8
  5283.  "Wimp_CreateMenu",,-1
  5284.  ### DataLoad ###
  5285. ,  myref%=block%!12:f$=
  5286. getstr(block%+44)
  5287. get_it_in(f$)
  5288.  myref%<>0 
  5289.  "OS_CLI","Remove <Wimp$Scrap>"
  5290.  ### DataLoadAck ###
  5291.  block%!12=Impref% 
  5292.  merging% 
  5293. start_merge
  5294.  ### DataOpen - response to file double click ###
  5295.  block%!40 
  5296.  &7f1,&7f3,&7f4,&7f5:
  5297.  present%=7 
  5298. N      block%!0=20:block%!12=ref%:block%!16=4:block%!20=mainW%:block%!24=-1
  5299. )      
  5300.  "Wimp_SendMessage",17,block%
  5301. (      
  5302. get_it_in(
  5303. getstr(block%+44))
  5304.         
  5305.  &2000:
  5306.  kill% 
  5307.  present%=0 
  5308. 2      
  5309.  ### Is it a Powerbase application? ###
  5310. *      f$=
  5311. getstr(block%+44)+".Indices"
  5312. '      
  5313.  "OS_File",5,f$ 
  5314.  d%,,type%
  5315. !      type%=(type%>>8) 
  5316.  &fff
  5317.       
  5318.  d%=2 
  5319. 2        block%!0=20:block%!12=ref%:block%!16=4
  5320. 4        
  5321.  "Wimp_SendMessage",17,block%,block%!4
  5322. *        
  5323. get_it_in(
  5324. getstr(block%+44))
  5325.       
  5326.         
  5327.  savefunc$ 
  5328.  "Save as text","Save text","Save sprite","Save draw","Save query","Save selection","Save table","Export selected":
  5329. ram_transmit
  5330.  10: 
  5331.  ### Desktop boot file
  5332. F    
  5333.  "OS_GSTrans","Run <PBase$Dir>",block%+&100,&f00 
  5334.  ,bootcmd$
  5335. #block%!20,bootcmd$
  5336.  &502:PR OChelp_message(block%!32,block%!36)
  5337.  &400C2:
  5338. getscreensize(ScreenWidth%,ScreenHeight%,Vpix%)
  5339.  &400C0:
  5340. message_menu_select
  5341.  &80140:
  5342.  ### PrintFile - ignore ###
  5343. ram_transmit
  5344.  datasize%>block%!24 
  5345.  tosend%=block%!24 
  5346.  tosend%=datasize%
  5347.  "Wimp_TransferBlock",mytask%,ramptr%,block%!4,block%!20,tosend%
  5348. block%!24=tosend%
  5349. datasize%-=tosend%
  5350. ramptr%+=tosend%
  5351. block%!12=block%!8
  5352. block%!16=7
  5353.  "Wimp_SendMessage",18+(datasize%=0),block%,block%!4
  5354. message_menu_select
  5355.  P%,Q%,I%
  5356. keyfunc$="":savefunc$=""
  5357. 5handle%=block%!20:xmin%=block%!24:ymax%=block%!28
  5358.  "Wimp_DecodeMenu",,menuhandle%,block%+32,choices%
  5359.  I%=1 
  5360.   Q%=
  5361. $choices%,".",P%+1)
  5362. &  choice$(I%)=
  5363. $choices%,P%,Q%-P%)
  5364.   P%=Q%+1
  5365.  menuhandle% 
  5366.  iconbarM%:
  5367.  choice$(1) 
  5368.  "New database":
  5369.     $SaveName%="!DataBase"
  5370. 2    $SaveSprite%="snew_appl;Pptr_hand,12,8;R2"
  5371.     savefunc$=choice$(1)
  5372.  mainM%:
  5373.  choice$(1) 
  5374. 6    
  5375.  "Information":
  5376. count(key%,RU%):
  5377. update_stats
  5378.  "Print":
  5379.  choice$(2) 
  5380.       
  5381.  "Save query":
  5382. 1      $SaveName%=$database%+".PrintRes.Query"
  5383. 4      $SaveSprite%="sfile_7f4;Pptr_hand,12,8;R2"
  5384.       
  5385.  "Save selection":
  5386. 5      $SaveName%=$database%+".PrintRes.Selection"
  5387. 4      $SaveSprite%="sfile_7f3;Pptr_hand,12,8;R2"
  5388.         
  5389.     savefunc$=choice$(2)
  5390.  "Miscellaneous":
  5391.  choice$(2) 
  5392.       
  5393.  "Colours":
  5394.       ncol%()=fcol%()
  5395.       
  5396.  I%=0 
  5397. !.        
  5398. set_icon_cols(colW%,I%,ncol%(I%))
  5399.       
  5400. #        
  5401.  "Export selected":
  5402. %3    $SaveName%=$database%+".PrintJobs.Selected"
  5403. &2    $SaveSprite%="sfile_fff;Pptr_hand,12,8;R2"
  5404.     savefunc$=choice$(1)
  5405.  designM%:
  5406.  choice$(1) 
  5407.  "Save form file":
  5408. ,%    $SaveName%=$database%+".Form"
  5409. -2    $SaveSprite%="sfile_7f2;Pptr_hand,12,8;R2"
  5410.     savefunc$=choice$(1)
  5411.  tableM%:
  5412.  choice$(1) 
  5413.  "Save":
  5414. 34    $SaveName%=$database%+".ValTables."+$tableM%
  5415. 42    $SaveSprite%="sfile_7f1;Pptr_hand,12,8;R2"
  5416.     savefunc$="Save table"
  5417.  "Save as CSV":
  5418. 74    $SaveName%=$database%+".PrintJobs."+$tableM%
  5419. 82    $SaveSprite%="sfile_dfe;Pptr_hand,12,8;R2"
  5420. 93    savefunc$="Save table as CSV":writetable%=
  5421.  listM%:
  5422.  choice$(1) 
  5423.  "Save as text":
  5424.     $SaveName%=TextName$
  5425. ?2    $SaveSprite%="sfile_fff;Pptr_hand,12,8;R2"
  5426.     savefunc$=choice$(1)
  5427.  "Wimp_CreateSubMenu",,handle%,xmin%,ymax%
  5428. help_message(wi%,ic%)
  5429.  T%=0 
  5430.  LastTable%
  5431.  wi%=tableW%(T%) 
  5432.  Tablenumber%=T%
  5433.  wi% 
  5434. help("HelpPbase")
  5435.  listW%:
  5436. help("HelpList")
  5437.  tableW%(Tablenumber%):
  5438. help("HelpTable")
  5439.  mainW%:
  5440. Q-    
  5441.  ic%<0:
  5442.  present%=7 
  5443. help("main?")
  5444.  (ic% 
  5445.  2)=1:
  5446.     field%=(ic%+1) 
  5447. TM    
  5448.  present%=7 
  5449. help("main"+
  5450. (chartype%(field%))) 
  5451. help("maindrag")
  5452.  pselectW%:
  5453. help("Pselect")
  5454.  infoW%:
  5455. help("info"+
  5456. (ic%))
  5457.  miscW%:
  5458. help("misc"+
  5459. (ic%))
  5460.  relateW%:
  5461. help("relate"+
  5462. (ic%))
  5463.  accessW%:
  5464. help("access"+
  5465. (ic%))
  5466.  keypadW%:
  5467. help("keypad"+
  5468. (ic%))
  5469.  searchW%:
  5470. help("search"+
  5471. (ic%))
  5472.  filterW%:
  5473. help("filter"+
  5474. (ic%))
  5475.  queryW%:
  5476. help("query"+
  5477. (ic%))
  5478.  moveW%:
  5479. help("move"+
  5480. (ic%))
  5481.  calcW%:
  5482. help("calc"+
  5483. (ic%))
  5484.  sizeW%:
  5485. help("size"+
  5486. (ic%))
  5487.  matchW%:
  5488. help("match"+
  5489. (ic%))
  5490.  tabcreateW%:
  5491. help("tabcreate"+
  5492. (ic%))
  5493.  changeW%:
  5494. help("change"+
  5495. (ic%))
  5496.  passW%:
  5497. help("passwd"+
  5498. (ic%))
  5499.  aclW%:
  5500. help("acl"+
  5501. (ic%))
  5502.  saveW%:
  5503. help("save"+
  5504. (ic%))
  5505.  savesubW%:
  5506. help("savesub"+
  5507. (ic%))
  5508.  printW%:
  5509. help("print"+
  5510. (ic%))
  5511.  labelW%:
  5512. help("label"+
  5513. (ic%))
  5514.  createW%:
  5515. help("create"+
  5516. (ic%))
  5517.  scrollW%:
  5518. help("scroll")
  5519.  prefsW%:
  5520. help("prefs"+
  5521. (ic%))
  5522.  csvW%:
  5523. help("csv"+
  5524. (ic%))
  5525.  fkeyW%:
  5526. help("fkey"+
  5527. (ic%))
  5528.  helpW%:
  5529. help("help"+
  5530. (ic%))
  5531.  keyW%:
  5532. help("key"+
  5533. (ic%))
  5534.  colW%:
  5535. help("col"+
  5536. (ic%))
  5537.  linkW%:
  5538. help("link"+
  5539. (ic%))
  5540.  reformW%:
  5541. help("reform"+
  5542. (ic%))
  5543.  mergeW%:
  5544. help("merge"+
  5545. (ic%))
  5546.  gridW%:
  5547. help("grid"+
  5548. (ic%))
  5549. help(token$)
  5550. !block%=256
  5551. block%!12=ref%
  5552. block%!16=&503
  5553. $(block%+20)=
  5554. msg(token$)
  5555.  "Wimp_SendMessage",17,block%,block%!4
  5556.  File saving --------------------------------------------------------
  5557. export_selected(Form$)
  5558.  I%,F%,P%,F$
  5559. extend_named_sliding_block(textanchor%,Length%+fields%+3)
  5560. P%=!textanchor%
  5561.  I%=1 
  5562. (Form$)-1 
  5563.   F%=
  5564. fnum(
  5565. Form$,I%,2))
  5566.   F$=$Rf%(F%)+
  5567.   $P%=F$:P%+=
  5568. *Start%=!textanchor%:End%=P%:Type%=&fff
  5569. save_all_tables
  5570.  "Hourglass_On"
  5571. Tablenumber%=0
  5572.  Tablenumber%<=LastTable%
  5573. 6  f$=$database%+".ValTables."+table$(Tablenumber%)
  5574. a  t$=
  5575. table_info(Tablenumber%,Rows%,TabFields%,Rec%,tabfieldlen%(),offset%,heading%,colours$)
  5576. E  Start%=!tabanchor%(Tablenumber%):End%=Start%+offset%+Rows%*Rec%
  5577. save(f$,&7f1,Start%,End%)
  5578.   Tablenumber%+=1
  5579.  "Hourglass_Percentage",Tablenumber%*100 
  5580.  (LastTable%+1)
  5581.  "Hourglass_Off"
  5582. save(f$,ft%,start%,end%)
  5583. f$,9)="Powerbase" 
  5584. softerror("",129):
  5585.  writingtext% 
  5586.  ft% 
  5587.   leaf$=
  5588. leaf(f$)
  5589. leaf$,1)<>"!" 
  5590.  leaf$="!"+leaf$
  5591. "  f$=dbasepath$+"."+
  5592. leaf$,10)
  5593.  "OS_File",8,f$
  5594.  "OS_File",8,f$+".Indices"
  5595.  "OS_File",8,f$+".ValTables"
  5596.  "OS_File",8,f$+".PrintRes"
  5597.  "OS_File",8,f$+".PrintJobs"
  5598.  "OS_CLI","Copy <PBase$Dir>.Resources.Temp.!Run "+f$+".!Run ~C~V"
  5599.  "OS_CLI","Copy <PBase$Dir>.Resources.Cols "+f$+".Cols ~C~V"
  5600. copy_database_spritefile(f$,
  5601. leaf(f$))
  5602. $    
  5603.  export%:
  5604. export_subset(f$)
  5605.  csvconv%:
  5606.  !formanchor%=0 
  5607. 4      
  5608. extend_named_sliding_block(formanchor%,0)
  5609.       Fptr%=!formanchor%
  5610. "      fields%=0:Fieldnumber%=0
  5611. "      fields%=
  5612. get_form(Fptr%)
  5613.         
  5614. lit(iconbarM%,1,
  5615. get_it_in(f$)
  5616. open_window(mainW%)
  5617.  !formanchor%=0 
  5618. 4      
  5619. extend_named_sliding_block(formanchor%,0)
  5620.       Fptr%=!formanchor%
  5621. "      fields%=0:Fieldnumber%=0
  5622.         
  5623. close_window(saveW%)
  5624.  &7f2:
  5625. save_form(f$)
  5626.  &7f5:
  5627. save_options(printW%,f$)
  5628.  &dfe:
  5629.  writetable% 
  5630. ,    
  5631. write_table_as_csv(Tablenumber%,f$)
  5632. write_csv(f$)
  5633.  savetofile%:
  5634. (    texthandle%=
  5635. (f$):writingtext%=
  5636. "    
  5637. do_it(Search$,displayed%)
  5638.     writingtext%=
  5639. +    
  5640.  "OS_File",10,f$,ft%,,start%,end%
  5641. )    
  5642. scrap_sliding_block(saveanchor%)
  5643. ramwarn%=
  5644. getstr(p%)
  5645.  ?p%>31
  5646.   p$+=
  5647. (?p%)
  5648.   p%+=1
  5649.  Validation tables ----------------------------------------------------
  5650. tabcreate_click(wi%,ic%,b%)
  5651.  I%,Rows%,Rec%,L%,TabFields%,head$,tablen%,width$,max%,row%,y%,headlen%,col%,z%,lim%
  5652.  "Hourglass_Smash":
  5653. wimp_error(
  5654.  (b% 
  5655.  %111)=4 
  5656.  z%=1 
  5657.  z%=-1
  5658.  %111 
  5659.  1,4:
  5660.  ic% 
  5661.     row%=
  5662. ($tabcol%)
  5663.  row%>MaxCols% 
  5664. &      
  5665. softerror(
  5666. (MaxCols%+1),42)
  5667.       row%=MaxCols%
  5668.       $tabcol%=
  5669. (row%)
  5670.       
  5671. redraw_icon(wi%,8)
  5672.         
  5673. #    
  5674. set_caret(scrollW%,row%*2)
  5675. )    
  5676.  row%<3 
  5677.  y%=0 
  5678.  y%=-(row%-2)*44
  5679. 9    !block%=scrollW%:
  5680.  "Wimp_GetWindowState",,block%
  5681. 1    block%!24=y%:
  5682.  "Wimp_OpenWindow",,block%
  5683.  13,14:
  5684. @    col%=
  5685. get_icon_cols(wi%,ic%):fg%=col% 
  5686.  16:bg%=col% 
  5687. I    
  5688. selected(wi%,11) 
  5689.  fg%=(fg%+z%+16) 
  5690.  bg%=(bg%+z%+16) 
  5691. *    
  5692. set_icon_cols(wi%,ic%,fg%+bg%*16)
  5693.  LastTable%=MaxTabs% 
  5694. &      
  5695. softerror(
  5696. (MaxTabs%+1),32)
  5697.       
  5698. L      start$="new"+
  5699. get_icon_cols(wi%,13)*256+
  5700. get_icon_cols(wi%,14))
  5701. E      name$=$
  5702. text(wi%,0):
  5703.  name$="" 
  5704.  moan_err%,
  5705. msg("Err103")
  5706. G      Rows%=
  5707. text(wi%,1)):
  5708.  Rows%=0 
  5709.  moan_err%,
  5710. msg("Err104")
  5711.       LastTable%+=1
  5712. !      Tablenumber%=LastTable%
  5713. $      table$(Tablenumber%)=name$
  5714.       tablen%=
  5715. (start$)+1
  5716.        tablen%+=
  5717. (Rows%))+1
  5718.       
  5719.  "Hourglass_On"
  5720. .      
  5721. text(scrollW%,TabFields%*2)<>""
  5722. 0        width$=$
  5723. text(scrollW%,TabFields%*2)
  5724.          tablen%+=
  5725. (width$)+1
  5726.     .        tabfieldlen%(TabFields%)=
  5727. (width$)
  5728. ,        Rec%+=tabfieldlen%(TabFields%)+1
  5729. 1        head$=$
  5730. text(scrollW%,TabFields%*2+1)
  5731. Y        
  5732. (head$)>tabfieldlen%(TabFields%) 
  5733.  LastTable%-=1:
  5734.  moan_err%,
  5735. msg("Err38")
  5736.          headlen%+=
  5737. (head$)+1
  5738.         TabFields%+=1
  5739.       
  5740.       TabFields%-=1
  5741. 5      
  5742.  TabFields%<0 
  5743.  moan_err%,
  5744. msg("Err112")
  5745. ;      tablen%+=(
  5746. (TabFields%))+1+headlen%+Rows%*Rec%)
  5747. Q      
  5748. extend_named_sliding_block(tabanchor%(Tablenumber%),(tablen%+3) 
  5749. +      tabptr%=!tabanchor%(Tablenumber%)
  5750. 0      $tabptr%=start$:tabptr%+=
  5751. ($tabptr%)+1
  5752. 2      $tabptr%=
  5753. (Rows%):tabptr%+=
  5754. ($tabptr%)+1
  5755. 7      $tabptr%=
  5756. (TabFields%):tabptr%+=
  5757. ($tabptr%)+1
  5758.       
  5759.  I%=0 
  5760.  TabFields%
  5761. ?        $tabptr%=
  5762. (tabfieldlen%(I%)):tabptr%+=
  5763. ($tabptr%)+1
  5764.       
  5765.       
  5766.  I%=0 
  5767.  TabFields%
  5768. C        $tabptr%=$
  5769. text(scrollW%,I%*2+1):tabptr%+=
  5770. ($tabptr%)+1
  5771.       
  5772.       
  5773.  row%=1 
  5774.  Rows%
  5775.         
  5776.  I%=0 
  5777.  TabFields%
  5778.  5          $tabptr%="":tabptr%+=tabfieldlen%(I%)+1
  5779.         
  5780.       
  5781.  row%
  5782.       
  5783.  "Hourglass_Off"
  5784. $#      
  5785. show_table(Tablenumber%)
  5786. %       TabsLoaded$+=","+name$
  5787. &!      
  5788.  !tablemenuanchor%=0 
  5789. 'H        
  5790. extend_named_sliding_block(tablemenuanchor%,MaxTabs%*35+65)
  5791. (i        tablemenu%=!tablemenuanchor%:tableiconptr%=tablemenu%:tabletextptr%=tablemenu%+MaxTabs%*24+52
  5792. )#        $tableiconptr%="Tables"
  5793.         tableiconptr%?12=7:tableiconptr%?13=2:tableiconptr%?14=7:tableiconptr%?15=0:tableiconptr%!16=168:tableiconptr%!20=44:tableiconptr%!24=0
  5794.         tableiconptr%+=28
  5795. ,E        ptr%=validateM%+52:ptr%!4=tablemenu%:
  5796. lit(validateM%,1,
  5797.         !tableiconptr%=128
  5798. .C        
  5799.  !tableiconptr%=0:tableiconptr%+=24:!tableiconptr%=128
  5800.       
  5801. 0~      tableiconptr%!4=-1:tableiconptr%!8=&7000121:tableiconptr%!12=tabletextptr%:tableiconptr%!16=-1:tableiconptr%!20=L%+1
  5802. 12      $tabletextptr%=name$:tabletextptr%+=L%+1
  5803. 2U      
  5804. text(wi%,2)="Modify" 
  5805. write_back_to_table(OldTable%,Tablenumber%,wi%)
  5806. 3        
  5807. 44    
  5808. close_it(wi%):
  5809. set_caret(mainW%,starthere%)
  5810. asterisk(
  5811. 6O    
  5812. close_it(wi%):
  5813. set_caret(mainW%,starthere%):$
  5814. text(wi%,2)="Create"
  5815. modify_table(T%,wi%)
  5816.  I%,Rows%,Rec%,L%,TabFields%,head$,cols%
  5817. =Ut$=
  5818. table_info(T%,Rows%,TabFields%,Rec%,tabfieldlen%(),offset%,heading%,colours$)
  5819. text(wi%,2)="Modify"
  5820. text(wi%,0)=table$(T%)
  5821. text(wi%,1)=
  5822. (Rows%)
  5823. $tabcol%="0"
  5824.  I%=0 
  5825.  MaxCols%*2+1
  5826. text(scrollW%,I%)=""
  5827.  I%=0 
  5828.  TabFields%
  5829. F/  $
  5830. text(scrollW%,I%*2)=
  5831. (tabfieldlen%(I%))
  5832. GI  $
  5833. text(scrollW%,I%*2+1)=$
  5834. text(tableW%(T%),Rows%*(TabFields%+1)+I%)
  5835.  colours$="" 
  5836.  colours$="2807"
  5837. cols%=
  5838. ("&"+colours$)
  5839. set_icon_cols(wi%,13,cols% 
  5840.  256)
  5841. set_icon_cols(wi%,14,cols% 
  5842.  256)
  5843. OldTable%=T%
  5844. open_window(wi%):
  5845. set_caret(wi%,0)
  5846. redraw(tabcreateW%):
  5847. redraw(scrollW%)
  5848. write_back_to_table(old%,new%,wi%)
  5849.  row%,column%,P%,N%,I%,ic%
  5850. Tct$=
  5851. table_info(old%,oldRows%,oldTabFields%,Rec%,tabfieldlen%(),oldoffset%,oldheading%,colours$)
  5852. P%=oldheading%
  5853. tabhead$()=""
  5854.  I%=0 
  5855.  oldTabFields%
  5856. X%  tabhead$(I%,0)=$P%:P%+=
  5857. ($P%)+1
  5858.  I%=0 
  5859.  TabFields%
  5860. [,  tabhead$(I%,1)=$
  5861. text(scrollW%,2*I%+1)
  5862.  oldRows%<=Rows% 
  5863.  N%=oldRows%-1 
  5864.  N%=Rows%-1
  5865.  "Hourglass_On"
  5866.  row%=0 
  5867. `/  P%=!tabanchor%(old%)+oldoffset%+row%*Rec%
  5868.  column%=0 
  5869.  oldTabFields%
  5870.     I%=-1
  5871. c        
  5872.       I%+=1
  5873. e<    
  5874.  tabhead$(I%,1)=tabhead$(column%,0) 
  5875.  I%>TabFields%
  5876.  I%<=TabFields% 
  5877. g$      ic%=row%*(TabFields%+1)+I%
  5878. hK      $
  5879. text(tableW%(new%),ic%)=
  5880. buffer_length(tableW%(new%),ic%))
  5881. i%      P%+=tabfieldlen%(column%)+1
  5882. j        
  5883.  column%
  5884.  row%
  5885.  "Hourglass_Off"
  5886. text(wi%,2)="Create"
  5887. redraw(tableW%(new%))
  5888. clear_table(T%)
  5889. confirm(
  5890. msg("Err47"))=
  5891.  R%,F%,ind%,Rows%,TabFields%,start%,Rec%
  5892. uUT$=
  5893. table_info(T%,Rows%,TabFields%,Rec%,tabfieldlen%(),offset%,heading%,colours$)
  5894. v'start%=!tabanchor%(T%)+offset%-Rec%
  5895.  R%=1 
  5896.  Rows%
  5897.   ind%=start%+R%*Rec%
  5898.  F%=0 
  5899.  TabFields%
  5900. z)    $ind%="":ind%+=tabfieldlen%(F%)+1
  5901. redraw(tableW%(T%))
  5902. asterisk(
  5903. show_table(T%)
  5904.  ind%,start%,dflags%,hflags%,c%,I%,pos%,p$,t$,B%,tablefield%,offset%,heading%,colours$
  5905. table_info(T%,Rows%,TabFields%,Rec%,tabfieldlen%(),offset%,heading%,colours$)
  5906. ;NewTab%=(t$="
  5907. "):extra%=-NewTab%*(Rows%*(TabFields%+1))
  5908.  T%<0 
  5909.  "SlidingHeap_DescribeBlock",slidingheapbase%,tabanchor%(T%) 
  5910.  ,,tablen%
  5911. extend_named_sliding_block(undoanchor%(T%),tablen%+1)
  5912.  "Wimp_TransferBlock",mytask%,!tabanchor%(T%),mytask%,!undoanchor%(T%),tablen%+1
  5913.  tableW%(T%)>0 
  5914. open_window(tableW%(T%)):
  5915. name$=table$(T%)
  5916. $Tablename%=name$
  5917. $tableM%=name$
  5918.  ind%=!tabanchor%(T%)+offset%
  5919.  "Wimp_OpenTemplate",,"<Pbase$Dir>.Resources.Templates"
  5920. B%=buff%
  5921.  "Wimp_LoadTemplate",,block%,buff%,endbuff%,-1,"table",0 
  5922.  ,,buff%
  5923.  NewTab% 
  5924. (name$)+1 
  5925. (t$)+1
  5926. buff%+=L%:block%!80=L%
  5927.  "Wimp_CloseTemplate"
  5928. #block%!28=block%!28 
  5929.  &AFFFFFFF
  5930.  (Rec%+TabFields%+9)*16<1136 
  5931.  Rows%<16:
  5932.  (Rec%+TabFields%+9)*16<1136:block%!28=block%!28 
  5933.  (1<<28)
  5934.  Rows%<16:block%!28=block%!28 
  5935.  (1<<30)
  5936. :block%!28=block%!28 
  5937.  ((1<<28)+(1<<30))
  5938.  "Wimp_CreateWindow",,block% 
  5939.  tableW%(T%)
  5940. PTabTitle%(T%)=block%!72:
  5941.  NewTab% 
  5942.  $TabTitle%(T%)=name$ 
  5943.  $TabTitle%(T%)=t$
  5944.  "Hourglass_On"
  5945.  colours$="" 
  5946.  colours$="2807"
  5947. cols%=
  5948. ("&"+colours$)
  5949. )hflags%=&0000A535+((cols% 
  5950.  256)<<24)
  5951. )dflags%=&0000A535+((cols% 
  5952.  256)<<24)
  5953.  row%=1 
  5954.  Rows%
  5955.   pos%=72
  5956.  I%=0 
  5957.  TabFields%
  5958.     R%=
  5959. create_icon(tableW%(T%),pos%,-row%*44-4+44*NewTab%,(tabfieldlen%(I%)+1)*16+2,48,dflags%,"",ind%,writep%,tabfieldlen%(I%)+1)
  5960. %    pos%+=(tabfieldlen%(I%)+1)*16
  5961.      ind%+=tabfieldlen%(I%)+1
  5962.  "Hourglass_Percentage",row%*100 
  5963.  Rows%
  5964.  row%
  5965.  NewTab% 
  5966.   pos%=72
  5967.  I%=0 
  5968.  TabFields%
  5969. t    R%=
  5970. create_icon(tableW%(T%),pos%,-48,(tabfieldlen%(I%)+1)*16+2,48,hflags%,"",heading%,-1,tabfieldlen%(I%)+1)
  5971. %    pos%+=(tabfieldlen%(I%)+1)*16
  5972.      heading%+=
  5973. ($heading%)+1
  5974.  "Hourglass_Off"
  5975. p$=printrel$(T%)
  5976.  p$<>"" 
  5977.  I%=1 
  5978. (p$) 
  5979.      tablefield%=
  5980. p$,I%,3))
  5981. /    
  5982. select(tableW%(T%),tablefield%+extra%)
  5983. width%=(Rec%*16)+112
  5984. -!block%=0:block%!4=-Rows%*44-4+44*NewTab%
  5985. block%!8=width%:block%!12=0
  5986.  "Wimp_SetExtent",tableW%(T%),block%
  5987. getscreensize(ScreenWidth%,ScreenHeight%,Vpix%)
  5988. !block%=tableW%(T%)
  5989.  "Wimp_GetWindowState",,block%
  5990. &block%!4=(ScreenWidth%-width%) 
  5991. block%!12=block%!4+width%
  5992.  Rows%<20 
  5993. -  block%!8=ScreenHeight% 
  5994.  2-(Rows%*18+2)
  5995. .  block%!16=block%!8+Rows%*44+4-44*NewTab%
  5996. $  block%!8=ScreenHeight% 
  5997.  2-362
  5998. +  block%!16=block%!8+44*20+4-44*NewTab%
  5999.  "Wimp_OpenWindow",,block%
  6000. redraw(tableW%(T%))
  6001.  Access% 
  6002. set_caret(tableW%(T%),0)
  6003. restore_table(T%)
  6004.  "SlidingHeap_DescribeBlock",slidingheapbase%,tabanchor%(T%) 
  6005.  ,,tablen%
  6006.  "Wimp_TransferBlock",mytask%,!undoanchor%(T%),mytask%,!tabanchor%(T%),tablen%+1
  6007. redraw(tableW%(T%))
  6008. restore_tabfield
  6009.  source%,dest%
  6010.  "Wimp_GetCaretPosition",,block%:wi%=!block%:ic%=block%!4
  6011.  wi%=tableW%(Tablenumber%) 
  6012. ,  dest%=
  6013. text(tableW%(Tablenumber%),ic%)
  6014. H  source%=!undoanchor%(Tablenumber%)+dest%-!tabanchor%(Tablenumber%)
  6015.   $dest%=$source%
  6016. redraw_icon(tableW%(Tablenumber%),ic%)
  6017. sort_table(T%,field%)
  6018.  tablen%,ind%,Rec%,Rows%,row%,TabFields%,pos%,dest%
  6019. Ytitle$=
  6020. table_info(T%,Rows%,TabFields%,Rec%,tabfieldlen%(),offset%,heading%,colours$)
  6021. ,pos%=
  6022. table_field(field%,tabfieldlen%())
  6023. *ind%=!tabanchor%(T%)+offset%-Rec%+pos%
  6024.  row%=0 
  6025.  Rows%-1
  6026.   ind%+=Rec%
  6027.   block%!(row%*4)=ind%
  6028.  $ind%="" 
  6029.  $ind%="~"
  6030.  row%
  6031.  "OS_HeapSort",Rows%,block%,4
  6032. extend_named_sliding_block(tempanchor%,Rows%*Rec%)
  6033. dest%=!tempanchor%-Rec%
  6034.  row%=0 
  6035.  Rows%-1
  6036. &  ind%=block%!(row%*4):dest%+=Rec%
  6037.  $ind%="~" 
  6038.  $ind%=""
  6039.  "Wimp_TransferBlock",mytask%,ind%-pos%,mytask%,dest%,Rec%
  6040.  row%
  6041.  "Wimp_TransferBlock",mytask%,!tempanchor%,mytask%,!tabanchor%(T%)+offset%,Rows%*Rec%
  6042. scrap_sliding_block(tempanchor%)
  6043. redraw(tableW%(T%))
  6044. print_table(T%)
  6045.  printing% 
  6046.  indexing% 
  6047.  start%,ptr%,Line$,title$,rowsused%,Heading$,h$,column%
  6048. QTextName$=$database%+".PrintJobs."+
  6049. "Tab"+table$(T%),10):$SaveName%=TextName$
  6050. read_print_options
  6051. format$="horiz"
  6052. Ytitle$=
  6053. table_info(T%,Rows%,TabFields%,Rec%,tabfieldlen%(),offset%,heading%,colours$)
  6054. Heading$=margin$
  6055.  NewTab% 
  6056.  column%=0 
  6057.  TabFields%
  6058. ;    h$=$
  6059. text(tableW%(T%),Rows%*(TabFields%+1)+column%)
  6060. ;    Heading$+=h$+
  6061. tabfieldlen%(column%)-
  6062. (h$)," ")+"  "
  6063.  column%
  6064.  Heading$+=title$+
  6065. Rec%-
  6066. (title$)," ")
  6067. 'LenLine%=Lmargin%+Rec%+TabFields%+2
  6068. extend_named_sliding_block(lineanchor%,LenLine%+4)
  6069. extend_named_sliding_block(headanchor%,LenLine%+4):pos%=!headanchor%
  6070. heap_store(headanchor%,LenLine%,0,pos%,0,Heading$)
  6071. Title$="Validation table"
  6072. Title1$=table$(T%)
  6073. Title2$=""
  6074. reportdest$="Window"
  6075. Count%=0
  6076. list_head(0)
  6077.  "Hourglass_On"
  6078.  I%=1 
  6079.  Rows%
  6080. )  start%=!tabanchor%(T%)+offset%-Rec%
  6081.   Line$=margin$
  6082.   ptr%=start%+I%*Rec%
  6083.  J%=0 
  6084.  TabFields%
  6085. D    
  6086.  $ptr%<>"" 
  6087.  Line$+=$ptr%+
  6088. tabfieldlen%(J%)-
  6089. ($ptr%)+2," ")
  6090.      ptr%+=tabfieldlen%(J%)+1
  6091.  Line$<>margin$ 
  6092.     rowsused%+=1
  6093. D    $(!lineanchor%)=Line$:
  6094. list_line(-1,lineanchor%,
  6095. (Line$),32)
  6096.  "Hourglass_Percentage",I%*100 
  6097.  Rows%
  6098.  "Hourglass_Off"
  6099. rule_off(45)
  6100. S$=margin$+
  6101. (Rows%)+" rows"
  6102. #:$(!lineanchor%)=S$:
  6103. list_line(-1,lineanchor%,
  6104. (S$),32)
  6105. $#S$=margin$+
  6106. (rowsused%)+" used"
  6107. %:$(!lineanchor%)=S$:
  6108. list_line(-1,lineanchor%,
  6109. (S$),32)
  6110. rule_off(45)
  6111. screen_list
  6112. pitch$=
  6113. pitch("0")
  6114. lit(listM%,1,
  6115. write_log(-1,"Table printed: "+table$(T%))
  6116. write_table_as_csv(T%,Filename$)
  6117.  ic%,row%,column%,Rows%,TabFields%,Rec%,offset%,heading%,csvhandle%,F$
  6118. /Ut$=
  6119. table_info(T%,Rows%,TabFields%,Rec%,tabfieldlen%(),offset%,heading%,colours$)
  6120. csvhandle%=
  6121. (Filename$)
  6122. ic%=-1
  6123.  "Hourglass_On"
  6124.  row%=0 
  6125.  Rows%-1
  6126.  column%=0 
  6127.  TabFields%
  6128. 5)    ic%+=1:F$=$
  6129. text(tableW%(T%),ic%)
  6130. 6.    
  6131. selected(csvW%,0) 
  6132.  F$=""""+F$+""""
  6133. 73    
  6134.  column%<TabFields% 
  6135.  F$+=sep$ 
  6136.  F$+=term$
  6137. #csvhandle%,F$;
  6138.  column%
  6139.  row%
  6140.  "Hourglass_Off"
  6141. close_file(csvhandle%)
  6142.  sep$="," 
  6143.  type%=&dfe 
  6144.  type%=&fff
  6145.  "OS_File",18,Filename$,type%
  6146. writetable%=
  6147. csv_to_table(T%,filename$)
  6148.  ic%,row%,column%,Rows%,TabFields%,Rec%,offset%,heading%,csvhandle%,base%,F$,sep%,sep2%,term%,term2%
  6149. DUt$=
  6150. table_info(T%,Rows%,TabFields%,Rec%,tabfieldlen%(),offset%,heading%,colours$)
  6151. E:sep%=
  6152. (sep$):
  6153. (sep$)=2 
  6154.  sep2%=
  6155. sep$)) 
  6156.  sep2%=255
  6157. F@term%=
  6158. (term$):
  6159. (term$)=2 
  6160.  term2%=
  6161. term$)) 
  6162.  term2%=255
  6163. size%=&100:inc%=size%
  6164. extend_named_sliding_block(tempanchor%,size%)
  6165. base%=!tempanchor%
  6166. csvhandle%=
  6167. (filename$)
  6168. ic%=-1
  6169.  "Hourglass_On"
  6170.  row%=0 
  6171.  Rows%-1
  6172.  column%=0 
  6173.  TabFields%
  6174.     ic%+=1
  6175. #csvhandle% 
  6176.        
  6177. read_bytes
  6178. RK       $
  6179. text(tableW%(T%),ic%)=
  6180. $base%,
  6181. buffer_length(tableW%(T%),ic%))
  6182. S        
  6183.  column%
  6184.  row%
  6185.  "Hourglass_Off"
  6186. close_file(csvhandle%)
  6187. redraw(tableW%(T%))
  6188. table_number(N$)
  6189.  T%,P%
  6190.  N$="" 
  6191. ^    T%=-1
  6192.   T%+=1
  6193.  table$(T%)=N$ 
  6194.  T%>LastTable%
  6195.  T%>LastTable% 
  6196. table_info(table%,
  6197.  rows%,
  6198.  columns%,
  6199.  recordlength%,colwidth%(),
  6200.  offset%,
  6201.  heading%,
  6202.  colours$)
  6203.  P%,Q%,I%,new%,S$
  6204. f P%=!tabanchor%(table%):Q%=P%
  6205. S$=$P%
  6206. S$,3)="new" 
  6207.  new%=
  6208. :colours$=
  6209. S$,4):P%+=
  6210. ($P%)+1
  6211. rows%=
  6212. ($P%):P%+=
  6213. ($P%)+1
  6214. j columns%=
  6215. ($P%):P%+=
  6216. ($P%)+1
  6217. recordlength%=0
  6218.  I%=0 
  6219.  columns%
  6220. m'  colwidth%(I%)=
  6221. ($P%):P%+=
  6222. ($P%)+1
  6223. n$  recordlength%+=colwidth%(I%)+1
  6224. heading%=P%
  6225.  new% 
  6226.  I%=0 
  6227.  columns%
  6228.     P%+=
  6229. ($P%)+1
  6230.   offset%=P%-Q%
  6231.  P%+=
  6232. ($P%)+1:offset%=160
  6233.  new% 
  6234. =$heading%
  6235. table_field(F%,L%())
  6236.  I%,P%
  6237.  I%<F%
  6238.   P%+=L%(I%)+1
  6239.   I%+=1
  6240. trailing_number(
  6241.  exact%)
  6242. S$)="~" 
  6243.  exact%=
  6244.  exact%=
  6245.  S$<>"" 
  6246. S$))<58
  6247.     N$=
  6248. S$)+N$
  6249.     S$=
  6250.  N$="" 
  6251. leading_number(
  6252.  S$<>"" 
  6253. (S$)<58
  6254.     N$=N$+
  6255. S$,1)
  6256.     S$=
  6257. S$,2)
  6258.  N$="" 
  6259. load_table(f$,show%)
  6260.  pos%,name$,d%,L%
  6261. name$=
  6262. leaf(f$):L%=
  6263. (name$)
  6264. TabsLoaded$,name$)=0 
  6265.  "OS_File",5,f$ 
  6266.  d%,,,,tablen%
  6267.  LastTable%=MaxTabs% 
  6268.  show% 
  6269. .      
  6270. softerror(
  6271. (MaxTabs%+1),32):show%=
  6272. :      
  6273. extratabs$,name$)=0 
  6274.  extratabs$+=name$+" "
  6275.         
  6276.         
  6277.     LastTable%+=1
  6278. M    
  6279. create_named_sliding_block(tabanchor%(LastTable%),(tablen%+3) 
  6280. 3    
  6281.  "OS_File",255,f$,!tabanchor%(LastTable%)
  6282.      table$(LastTable%)=name$
  6283.     Tablenumber%=LastTable%
  6284.     TabsLoaded$+=","+name$
  6285.  !tablemenuanchor%=0 
  6286. F      
  6287. extend_named_sliding_block(tablemenuanchor%,MaxTabs%*35+65)
  6288. g      tablemenu%=!tablemenuanchor%:tableiconptr%=tablemenu%:tabletextptr%=tablemenu%+MaxTabs%*24+52
  6289. !      $tableiconptr%="Tables"
  6290.       tableiconptr%?12=7:tableiconptr%?13=2:tableiconptr%?14=7:tableiconptr%?15=0:tableiconptr%!16=168:tableiconptr%!20=44:tableiconptr%!24=0
  6291.       tableiconptr%+=28
  6292. C      ptr%=validateM%+52:ptr%!4=tablemenu%:
  6293. lit(validateM%,1,
  6294.       !tableiconptr%=128
  6295. A      
  6296.  !tableiconptr%=0:tableiconptr%+=24:!tableiconptr%=128
  6297.         
  6298. |    tableiconptr%!4=-1:tableiconptr%!8=&7000121:tableiconptr%!12=tabletextptr%:tableiconptr%!16=-1:tableiconptr%!20=L%+1
  6299. 0    $tabletextptr%=name$:tabletextptr%+=L%+1
  6300.  Tablenumber%=
  6301. table_number(name$)
  6302.  show% 
  6303. show_table(Tablenumber%)
  6304. link_to_table
  6305.  icon%
  6306. b%=(b% 
  6307.  %111)
  6308.  2,4:
  6309.  ic%=13 
  6310. 7    
  6311. tick_one(tablemenu%,0,LastTable%,Tablenumber%)
  6312. -    
  6313. show_menu(tablemenu%,oldx%+32,oldy%)
  6314.  %111 
  6315.  1,4:
  6316.  b%=4 
  6317.  z%=1 
  6318.  z%=-1
  6319.  ic% 
  6320. tcycle(z%)
  6321. tcycle(-z%)
  6322. !    
  6323. fcycle(z%,fieldnum%)
  6324. "    
  6325. fcycle(-z%,fieldnum%)
  6326. $    
  6327. fcycle(z%,substitute%)
  6328. %    
  6329. fcycle(-z%,substitute%)
  6330.  icon%=10 
  6331. 2      
  6332. shade(linkW%,icon%,
  6333. selected(linkW%,9))
  6334.  icon%
  6335. $    
  6336.  ### Default action ###
  6337. "    icon%=field%(Fieldnumber%)
  6338. 1    
  6339. selected(linkW%,4) 
  6340.  $Tablename%<>"" 
  6341. 4      link$(Fieldnumber%)=$Tablename%+$fieldnum%
  6342. =      
  6343. selected(linkW%,15) 
  6344.  link$(Fieldnumber%)+="~"
  6345. 0      
  6346. set_icon_cols(mainW%,icon%,-fcol%(8))
  6347. V      
  6348. selected(linkW%,9) 
  6349.  link$(Fieldnumber%)=$substitute%+link$(Fieldnumber%)
  6350.       
  6351. ?      link$(Fieldnumber%)="":
  6352. set_icon_cols(mainW%,icon%,7)
  6353. $      K%=
  6354. is_a_key(Fieldnumber%)
  6355.       
  6356.         
  6357.          
  6358.  key%:
  6359. colour(K%,1)
  6360.         
  6361. colour(K%,2)
  6362.       
  6363.         
  6364.     link$(0)="LOADED"
  6365. asterisk(
  6366. &    
  6367.  b%=4 
  6368. close_window(linkW%)
  6369. "    
  6370. close_window(linkW%)
  6371. tcycle(z%)
  6372.  LastTable%=-1 
  6373. Tablenumber%+=z%
  6374.  Tablenumber%>LastTable% 
  6375.  Tablenumber%=0
  6376.  Tablenumber%<0 
  6377.  Tablenumber%=LastTable%
  6378. $$Tablename%=table$(Tablenumber%)
  6379. redraw_icon(linkW%,0)
  6380. fcycle(z%,column%)
  6381. table_info(Tablenumber%,Rows%,TabFields%,Rec%,tabfieldlen%(),offset%,heading%,colours$)
  6382. field%=
  6383. ($column%)
  6384. field%+=z%
  6385.  field%>TabFields% 
  6386.  field%=0
  6387.  field%<0 
  6388.  field%=TabFields%
  6389. $column%=
  6390. (field%)
  6391. redraw_icon(linkW%,2)
  6392. redraw_icon(linkW%,10)
  6393. link_status
  6394.  name$,field$,ic%,subst$,exact%
  6395. name$=link$(Fieldnumber%)
  6396. ,field$=
  6397. trailing_number(name$,exact%))
  6398. set_icon(linkW%,15,exact%)
  6399. ?subst$=
  6400. leading_number(name$)):
  6401.  subst$="-1" 
  6402.  subst$="0"
  6403.  (name$<>"" 
  6404. TabsLoaded$,name$)>0) 
  6405. =  $Tablename%=name$:$fieldnum%=field$:$substitute%=subst$
  6406. '  Tablenumber%=
  6407. table_number(name$)
  6408. select(linkW%,4)
  6409.   Tablenumber%=0
  6410. &  $Tablename%=table$(Tablenumber%)
  6411. deselect(linkW%,4):$fieldnum%="0"
  6412. set_icon(linkW%,9,subst$<>"0")
  6413.  ic%=10 
  6414. shade(linkW%,ic%,
  6415. selected(linkW%,9))
  6416. redraw_icon(linkW%,0):
  6417. redraw_icon(linkW%,2)
  6418. save_links
  6419.  link$(0)="LOADED" 
  6420.   lk=
  6421. ($database%+".Link")
  6422.  F%=1 
  6423.  fields%
  6424. #lk,link$(F%)
  6425. close_file(lk)
  6426.  End of Validation table routines ------------------------------------
  6427. changes(key%,field%,Old$,New$,confirm%)
  6428.  M$,K%,index%,target$,log$
  6429. ""target$=$Query%:Search$=
  6430. parse
  6431.  New$="" 
  6432.  n$="<null>" 
  6433.  n$=New$
  6434.  New$<>"" 
  6435. "+-*/",
  6436. New$,1))>0 
  6437.   numeric%=
  6438.  numeric%=
  6439. is_a_key(field%)
  6440.  K%=key% 
  6441. softerror("",12):
  6442.  "Wimp_CreateMenu",,-1:
  6443.  K%>=0 
  6444.  M$=" NOTE! Index on this field will NO LONGER BE VALID and should be deleted." 
  6445.  M$=""
  6446.  Old$<>"" 
  6447.  o$=" when existing value is "+Old$ 
  6448.  o$=""
  6449.  target$="" 
  6450.  target$=" for all subfile "+
  6451. (file%) 
  6452.  target$=" for "+target$+" in subfile "+
  6453. (file%)
  6454. -Klog$="Change contents of field "+Tag$(field%)+" to "+n$+o$+target$+". "
  6455. target$=log$+M$
  6456.  confirm%=
  6457. confirm(target$)=
  6458. 0'  subtotal%=
  6459. count_recs(key%,zero%)
  6460.  "Hourglass_On"
  6461. 2,  dbasehandle%=
  6462. ($database%+".Database")
  6463.   P%=
  6464. neighbour(key%,top,1)
  6465. scan_file("P%<>top",key%,file%,5,1)
  6466. close_file(dbasehandle%)
  6467.   $Date%(file%)=
  6468. today
  6469.   date%?file%=1
  6470. display(key%,addr)
  6471.  "Hourglass_Off"
  6472.  K%>=0 
  6473.  index%=K% 
  6474.  Keys%-1
  6475. <!      Index$(K%)=Index$(K%+1)
  6476.  index%
  6477. >/    
  6478. scrap_sliding_block(keyanchor%(Keys%))
  6479.     Index$(Keys%)=""
  6480.     Keys%-=1
  6481. write_log(-1,log$)
  6482. asterisk(
  6483. is_a_key(F%)
  6484.  key%,flag%,J%
  6485. flag%=-1
  6486.  J%=0 
  6487. L&    
  6488.  KF%(key%,J%)=F% 
  6489.  flag%=key%
  6490.   key%+=1
  6491.  flag%>=0 
  6492.  key%>Keys% 
  6493. =flag%
  6494. read(N%,K%,R%,f$)
  6495.  I%,key%,dbasehandle%
  6496. T"dbasehandle%=
  6497. (f$+".Database")
  6498. U%$Rf%(0)="":field$(0)="":key$()=""
  6499. #dbasehandle%=
  6500. (R%)*Length%
  6501.  I%=1 
  6502.   field$(I%)=
  6503. #dbasehandle%
  6504.  chartype%(I%)<>40 
  6505.  chartype%(I%)<>59 
  6506.  $Rf%(I%)=field$(I%)
  6507.  chartype%(I%) 
  6508. [8    
  6509.  36,37,38:
  6510. set_blob_sprite(R%,I%,chartype%(I%))
  6511. \!    
  6512. show_text_block(I%)
  6513. show_picture(I%)
  6514.  41,42,43,44,45:
  6515. _T    
  6516.  field$(I%)=" " 
  6517. select(mainW%,field%(I%)) 
  6518. deselect(mainW%,field%(I%))
  6519. `(    
  6520.  R%=RA% 
  6521.  $Rf%(I%)=
  6522. (REC%)
  6523. a9    
  6524.  R%=RA% 
  6525. split_link(I%,R$,V$):$Rf%(I%)=R$
  6526. b'    
  6527.  R%=RA% 
  6528.  $Rf%(I%)=
  6529. c(    
  6530.  R%=RA% 
  6531.  $Rf%(I%)=
  6532. $,15)
  6533. d1    
  6534.  R%=RA% 
  6535.  $Rf%(I%)=
  6536. convert_date(2)
  6537. e1    
  6538.  R%=RA% 
  6539.  $Rf%(I%)=
  6540. convert_date(4)
  6541. f#    
  6542.  R%=RA% 
  6543.  $Rf%(I%)=
  6544. g'    
  6545.  R%=RA% 
  6546.  $Rf%(I%)=
  6547. h)    
  6548.  R%=RA% 
  6549.  $Rf%(I%)=
  6550. $,5,2)
  6551. i)    
  6552.  R%=RA% 
  6553.  $Rf%(I%)=
  6554. $,8,3)
  6555. jJ    
  6556.  R%=RA% 
  6557. $,8,3):P%=
  6558. months$,M$):$Rf%(I%)=
  6559. ((P%+2) 
  6560. k*    
  6561.  R%=RA% 
  6562.  $Rf%(I%)=
  6563. $,12,4)
  6564.  key%=0 
  6565.  Keys%
  6566.     key$(key%)=
  6567. key(key%)
  6568.  key%
  6569. close_file(dbasehandle%)
  6570. cfield$()=field$()
  6571. update_calcs(N%)
  6572.  design% 
  6573.  N%>0 
  6574.  $Rf%(N%)=cfield$(N%) 
  6575.  I%,C%,L%,F,F$,Form$,S$,SF$,changed%
  6576. {GForm$=update$(N%):
  6577.  List of fields affected by a change in field N%
  6578.  Form$=0 
  6579. calc_error:=
  6580.  I%=1 
  6581. (Form$)-1 
  6582.   F%=
  6583. fnum(
  6584. Form$,I%,2))
  6585.  F%<>N% 
  6586. &    
  6587. split_link(F%,real$,visible$)
  6588.  chartype%(F%) 
  6589. E      
  6590.  6:F=
  6591. (real$):F$=
  6592.  fix%(F%)<>0 
  6593. fix_point(F$,F%)
  6594. I      
  6595.  7:F$=
  6596. (real$):
  6597.  N%=0 
  6598. expand(F$,link$(F%),L%,SF$):F$=SF$
  6599.         
  6600. (F$)<=len%(F%) 
  6601. *      $Rf%(F%)=F$:cfield$(N%)=$Rf%(N%)
  6602. 4      
  6603. redraw_icon(mainW%,field%(F%))           
  6604. .      
  6605.  F$(F%)<>F$ 
  6606.  F$(F%)=F$:changed%=
  6607.       
  6608.  moan_err%,""
  6609.         
  6610. "    changed%=
  6611. update_calcs(F%)
  6612. =changed%
  6613. calc_error
  6614.  ### Division by zero. Ignore ###
  6615.  moan_err%:
  6616. softerror(calc$(F%),10)
  6617. softerror(calc$(F%),73)
  6618. check_change
  6619.  F%,flag%
  6620.  F%<fields%
  6621.   F%+=1
  6622. selected(prefsW%,47) 
  6623.  chartype%(F%) 
  6624.       
  6625.  0,1,2,3,4,5,6,7,8:
  6626.       
  6627.  ?Rf%(F%)=32
  6628. !        $Rf%(F%)=$(Rf%(F%)+1)
  6629.       
  6630.         
  6631.  chartype%(F%) 
  6632. +    
  6633.  0,1,2,3,4,5,6,7,8,41,42,43,44,45:
  6634.      
  6635.  $Rf%(F%)<>field$(F%) 
  6636.       flag%=
  6637. D      
  6638.  customise% 
  6639. record_change(REC%,F%,field$(F%),$Rf%(F%))
  6640.         
  6641.  flag% 
  6642. write(fields%,key%):
  6643. asterisk(
  6644. write(N%,k%)
  6645.  key%,newrec%,dontalter%
  6646.  Access% 
  6647. softerror("",14):
  6648. close_file(dbasehandle%)
  6649.  template%=2 
  6650. write_dbase(RA%,N%,
  6651. ):template%=0:
  6652. PRI$=
  6653. key(0)
  6654.  PRI$="" 
  6655.  key$(0) 
  6656.  key%=0 
  6657.  Keys%
  6658.     KEY$=
  6659. key(key%)
  6660.     kl%=
  6661. (KEY$)
  6662. insert(KEY$,key%)
  6663.  KEY$<>"*Failed*" 
  6664. #      key$(key%)=KEY$:newrec%=
  6665. $      
  6666.  k%=key% 
  6667.  addr=nextfree%
  6668.       
  6669.  dontalter%=
  6670.         
  6671.  key%
  6672.  key%=0 
  6673.  Keys%
  6674.     KEY$=
  6675. key(key%)
  6676.  KEY$<>key$(key%) 
  6677. L      
  6678.  key%=0 
  6679. confirm(
  6680. msg("Err48")) 
  6681.  dontalter%=
  6682. restore_rec
  6683.       
  6684.  dontalter%=
  6685. $        
  6686. delete(key$(key%),key%)
  6687.         
  6688. insert(KEY$,key%)
  6689.         
  6690.  KEY$="*Failed*" 
  6691.           KEY$=key$(key%)
  6692.           
  6693. restore_rec
  6694.            
  6695. insert(KEY$,key%)
  6696.         
  6697.         key$(key%)=KEY$
  6698.       
  6699.         
  6700.  key%
  6701.  dontalter% 
  6702. $Date%(file%)=
  6703. today
  6704. date%?file%=1
  6705.  newtree% 
  6706. write_dbase(REC%,N%,
  6707.  newrec% 
  6708.  autobalance% 
  6709.   added%+=1
  6710.  added%=
  6711. ($Every%) 
  6712.  key%=0 
  6713.  Keys%
  6714.       
  6715. balance(key%)
  6716.  key%
  6717.     added%=0
  6718. write_dbase(R%,N%,logchanges%)
  6719.  I%,F$,S$,dbasehandle%,flag%
  6720. *dbasehandle%=
  6721. ($database%+".Database")
  6722. #dbasehandle%=R%*Length%
  6723.  logchanges% 
  6724.  newrec% 
  6725. C    
  6726. write_log(R%,"New record: Subfile "+
  6727. (file%)+"  "+
  6728. key(0))
  6729. *    
  6730. write_log(R%,logentry$):flag%=
  6731.  I%=1 
  6732.  chartype%(I%) 
  6733.  39,40:F$=""
  6734.  newrec% 
  6735.       F$=$Rf%(I%)
  6736.       
  6737. split_link(I%,R$,V$)
  6738.       S%=
  6739. /      
  6740.  dontincrement%=
  6741.  S%+=1:F$=
  6742. (S%-1)
  6743.        calc$(I%)=V$+"|"+
  6744.       
  6745.  F$=$Rf%(I%)
  6746.         
  6747.     dontincrement%=
  6748.  58:F$=
  6749. :F$=$Rf%(I%)
  6750. #dbasehandle%,F$
  6751.  flag%=
  6752.  F$<>field$(I%) 
  6753.  chartype%(I%)<>59 
  6754. %    
  6755.  F$="" 
  6756.  D$="<null>" 
  6757.  D$=F$
  6758. 5    
  6759.  field$(I%)="" 
  6760.  S$="<null>" 
  6761.  S$=field$(I%)
  6762. 3    
  6763. write_log(-1,Tag$(I%)+": "+S$+" ---> "+D$)
  6764.   field$(I%)=F$
  6765. selected(prefsW%,44) 
  6766. readsmarray(dbasehandle%,R%)
  6767. write_csv_rec(R%,csvform$,autocsvhandle%)
  6768. close_file(dbasehandle%)
  6769. split_link(F%,
  6770.  L$,P%,F
  6771. L$=calc$(F%)
  6772. L$,1)="#":
  6773. /  P%=
  6774. L$,"#",2):V$=
  6775. L$,P%+1):R$=
  6776. L$,2,P%-2)
  6777. L$,"|")>0:
  6778. +  P%=
  6779. L$,"|"):V$=
  6780. L$,P%-1):R$=
  6781. L$,P%+1)
  6782. :R$="":V$=""
  6783. key(key%)
  6784. key2(key%,0)
  6785. key2(key%,loc%)
  6786.  I%,W%,P%,S$,W$,T$,pad$,chars%,pos%,word%,wd%,field%,numeric%
  6787.  I%=0 
  6788.   W%=KW%(key%,I%):W$=""
  6789.  W%>0 
  6790.     chars%=W% 
  6791.     pos%=(W%>>8) 
  6792.     word%=(W%>>16) 
  6793.     field%=KF%(key%,I%)
  6794.  chartype%(field%) 
  6795. ()      
  6796.  3,6,46,47,54,56,57:numeric%=
  6797.       
  6798. :numeric%=
  6799. *        
  6800. +:    
  6801.  loc%=0 
  6802.  S$=$Rf%(field%)+" " 
  6803.  S$=F$(field%)+" "
  6804.  numeric% 
  6805.       
  6806.  word% 
  6807.         
  6808.         
  6809. 0!          C$=
  6810. S$,1):S$=
  6811. S$,2)
  6812. 1           
  6813.  C$<>" " 
  6814.  W$+=C$
  6815.         
  6816.  S$=""
  6817.         
  6818.         wd%=0
  6819.         
  6820. 6:          P%=
  6821. S$," "):w$=
  6822. S$,P%-1):S$=
  6823. S$,P%+1):wd%+=1
  6824.         
  6825.  wd%=word% 
  6826.  S$=""
  6827.         
  6828.  wd%=word% 
  6829.  W$=w$
  6830.       
  6831.       
  6832.  pos% 
  6833.         
  6834.  0:W$=
  6835. W$,chars%)
  6836. <         
  6837.  255:W$=
  6838. W$,chars%)
  6839. =!        
  6840. W$,pos%,chars%)
  6841.       
  6842. ?@      
  6843.  incspace%(key%)=
  6844.  word%>0 
  6845.  W$+=
  6846. chars%-
  6847. (W$)," ")
  6848. @       
  6849.  chartype%(field%) 
  6850. A*        
  6851.  5,51,52:W$=
  6852. reverse_date(W$)
  6853.       
  6854.       
  6855. D        
  6856.     T$+=W$
  6857.  T$<>"" 
  6858.  incspace%(key%)=
  6859.  pad$=" " 
  6860.  pad$="#"
  6861. J   T$+=
  6862. KL%(key%)-
  6863. (T$),pad$)
  6864.  case%(key%) 
  6865. u(T$)
  6866. u(N$)
  6867.  I%,B%
  6868. $key=N$
  6869.  I%=0 
  6870. (N$)-1
  6871.   B%=key?I%
  6872.  B%>96 
  6873.  B%<123 
  6874.  key?I%=B% 
  6875. U    =$key
  6876. today
  6877.  Y$,M$,D$,M%,date$
  6878. $,14,2)
  6879. $,5,2)
  6880. $,8,3)
  6881. \:M%=(
  6882. "JanFebMarAprMayJunJulAugSepOctNovDec",M$)+2) 
  6883.  M%<10 
  6884.  M$="0"+
  6885. (M%) 
  6886. date$=D$+"-"+M$+"-"+Y$
  6887. =date$
  6888. date(key%)
  6889.  !keyanchor%(key%)=0 
  6890.  I%=0 
  6891.  date%?I%=1 
  6892. f*    $(!keyanchor%(key%)+8+9*I%)=
  6893. today
  6894.     $Date%(I%)=
  6895. today
  6896. check_date(key%,D$,place%,
  6897.  date$)
  6898.  F%,I%,D%,M%,Y%,L%,P%,Q%,U$,d$,m$,y$
  6899.  place%=0 
  6900.  F%=Fieldnumber% 
  6901.  F%=KF%(key%,0)
  6902.  L%=0 
  6903.  I%=1 
  6904.   C$=
  6905. D$,I%,1)
  6906.  C$<"0" 
  6907.  C$>"9" 
  6908.  P%=0 
  6909.  P%=I% 
  6910.  Q%=I%
  6911.  P%=0 
  6912.  Q%=0 
  6913. restore(F%,
  6914. msg("Err102"),4):=
  6915. D$,P%-1))
  6916. D$,P%+1,Q%-P%-1))
  6917. D$,Q%+1))
  6918.  Y%<0 
  6919.  D%<1 
  6920. restore(F%,"",4):=
  6921.  M%<1 
  6922.  M%>12 
  6923. restore(F%,
  6924. msg("Err118"),4):=
  6925.  (Y% 
  6926.  400)=0:U$=leap$:
  6927.  Century year is leap year if divisible by 400
  6928.  (Y% 
  6929.  100)<>0 
  6930.  (Y% 
  6931.  4)=0:U$=leap$:
  6932.  otherwise not
  6933. :U$=nonleap$
  6934. U$,2*M%-1,2)
  6935. (DM$) 
  6936. restore(F%,
  6937. msg("Err119,"+DM$),4):=
  6938. (D%):
  6939. (d$)=1 
  6940.  d$="0"+d$
  6941. (M%):
  6942. (m$)=1 
  6943.  m$="0"+m$
  6944. (Y%):
  6945. (y$)=1 
  6946.  y$="0"+y$
  6947. (y$)<>2 
  6948. (y$)<>4 
  6949. restore(F%,
  6950. msg("Err120"),4):=
  6951. (y$)=4 
  6952.  len%(F%)<10 
  6953. y$,2)
  6954. (y$)=2 
  6955.  len%(F%)>=10 
  6956. $,12,2)+y$
  6957. &date$=d$+$datesep%+m$+$datesep%+y$
  6958.  place%=0 
  6959. (date$)>len%(F%) 
  6960. restore(F%,
  6961. msg("Err121"),4):=
  6962.  place% 
  6963.  0:$Rf%(F%)=date$:
  6964. redraw_icon(mainW%,field%(F%))
  6965. text(searchW%,1)=date$:
  6966. redraw_icon(searchW%,1)
  6967. convert_date(L%)
  6968.  d$,m$,y$,M$,M%
  6969. $,5,2)
  6970. $,8,3)
  6971. months$,M$)
  6972. M%=(P%+2) 
  6973. (M%):
  6974.  M%<10 
  6975.  m$="0"+m$
  6976. $,16-L%,L%)
  6977. !=d$+$datesep%+m$+$datesep%+y$
  6978. reverse_date(K$)
  6979. (K$) 
  6980.  8:K$=
  6981. K$,2)+
  6982. K$,3,4)+
  6983. K$,2)
  6984. (K$)<100 
  6985. !    K$=
  6986. K$,4)+
  6987. K$,3,4)+
  6988. K$,2)
  6989. #    
  6990. K$,2)+
  6991. K$,5,4)+
  6992. K$,4)
  6993. refresh_dates
  6994.  key%
  6995.  key%=0 
  6996.  Keys%
  6997. date(key%)
  6998.  key%
  6999. days(date$)
  7000.  M%,d$,y$
  7001. date$,2)
  7002. date$,4,2))
  7003. date$,7)
  7004. *date$=d$+" "+
  7005. months$,M%*3-2,3)+" "+y$
  7006.  "Territory_ConvertTimeStringToOrdinals",-1,2,date$,ordinals%
  7007. ;!ordinals%=0:ordinals%!4=0:ordinals%!8=0:ordinals%!12=0
  7008.  "Territory_ConvertOrdinalsToTime",-1,utctime%,ordinals%
  7009. =(utctime%!1) 
  7010.  33750
  7011. date(days%,L%)
  7012. 0$dateformat%="%DY"+$datesep%+"%MN"+$datesep%
  7013.  L%=8 
  7014.  $dateformat%+="%YR"+
  7015.  $dateformat%+="%CE%YR"+
  7016. utctime%!1=days%*33750
  7017.  "Territory_ConvertDateAndTime",-1,utctime%,datebuffer%,16,dateformat%
  7018. datebuffer%?L%=13
  7019. =$datebuffer%
  7020. check_time(
  7021.  time$)
  7022.  I%,P%,Q%,H%,M%,S%,C$
  7023.  I%=1 
  7024. (time$)
  7025.   C$=
  7026. time$,I%,1)
  7027.  C$<"0" 
  7028.  C$>"9" 
  7029.  P%=0 
  7030.  P%=I% 
  7031.  Q%=I%
  7032.  P%=0 
  7033.  Q%=0 
  7034. restore(Fieldnumber%,"",101):=
  7035. time$,P%-1)):
  7036.  H%<0 
  7037.  H%>23 
  7038. restore(Fieldnumber%,"hours",94):=
  7039. time$,P%+1,Q%-P%-1)):
  7040.  M%<0 
  7041.  M%>59 
  7042. restore(Fieldnumber%,"minutes",94):=
  7043. time$,Q%+1)):
  7044.  S%<0 
  7045.  S%>59 
  7046. restore(Fieldnumber%,"seconds",94):=
  7047. !time$=
  7048. time(H%*3600+M%*60+S%)
  7049. F$Rf%(Fieldnumber%)=time$:
  7050. redraw_icon(mainW%,field%(Fieldnumber%))
  7051. seconds(time$)
  7052.  H%,M%,S%,secs%
  7053. time$,2))
  7054. time$,4,2))
  7055. time$,2))
  7056. secs%=H%*3600+M%*60+S%
  7057. =secs%
  7058. time(secs%)
  7059. ;$dateformat%="%24"+$timesep%+"%MI"+$timesep%+"%SE"+
  7060. $!utctime%=secs%*100:utctime%?4=0
  7061.  "Territory_ConvertDateAndTime",-1,utctime%,datebuffer%,16,dateformat%
  7062. datebuffer%?8=13
  7063. =$datebuffer%
  7064. validate(F%,
  7065.  TabFields%,
  7066.  name$)
  7067. selected(prefsW%,21) 
  7068.  row%,field%,Rows%,Rec%,ind%,sind%,pos%,start%,subst%,spos%,date$,subst$,L1%,L2%,L%,S$,exact%,extra$
  7069. S$=$Rf%(F%):L%=
  7070.  S$="" 
  7071.  fix%(F%)<>0 
  7072.  $Rf%(F%)=
  7073. fix_point(S$,F%):
  7074. redraw_icon(mainW%,field%(F%))
  7075.  chartype%(F%)=3 
  7076. check_val(calc$(F%),S$)=
  7077.  chartype%(F%)=5 
  7078. check_date(key%,S$,0,date$)
  7079.  chartype%(F%)=8 
  7080. check_time(S$)
  7081. Bname$=link$(F%):
  7082.  name$="" 
  7083. name$,1)="#" 
  7084. name$,1)="@" 
  7085. )field%=
  7086. trailing_number(name$,exact%)
  7087. !subst%=
  7088. leading_number(name$)
  7089. table_number(name$):
  7090.  T%<0 
  7091. table_info(T%,Rows%,TabFields%,Rec%,tabfieldlen%(),offset%,heading%,colours$)
  7092.  S$=field$(F%) 
  7093.  TabFields%=0 
  7094. ,pos%=
  7095. table_field(field%,tabfieldlen%())
  7096.  subst%<0 
  7097.  spos%=pos% 
  7098.  spos%=
  7099. table_field(subst%,tabfieldlen%())
  7100. 'start%=!tabanchor%(T%)+offset%-Rec%
  7101. 'ind%=start%+pos%:sind%=start%+spos%
  7102.  exact% 
  7103. 1  cond$="row%>Rows% OR $ind%=S$ OR $sind%=S$"
  7104.  cond$="row%>Rows% OR ($ind%=LEFT$(S$,L1%) AND L1%>0) OR ($sind%=LEFT$(S$,L2%) AND L2%>0)"
  7105.  row%+=1
  7106.   ind%+=Rec%:sind%+=Rec%
  7107.    L1%=
  7108. ($ind%):L2%=
  7109. ($sind%)
  7110. (cond$)=
  7111.  row%>Rows% 
  7112. restore(F%," ("+name$+")",5):=
  7113.  exact% 
  7114. ,    
  7115.  $sind%=
  7116. S$,L2%):extra$=
  7117. S$,L%-L2%)
  7118. +    
  7119.  $ind%=
  7120. S$,L1%):extra$=
  7121. S$,L%-L1%)
  7122. ind%=start%+row%*Rec%
  7123.  I%=0 
  7124.  TabFields%
  7125. ,  rel%(I%)=ind%:ind%+=tabfieldlen%(I%)+1
  7126.  subst%>=0 
  7127.   subst$=$sind%
  7128.   S$=subst$+extra$
  7129. (S$)<=len%(F%) 
  7130.  $Rf%(F%)=S$
  7131. redraw_icon(mainW%,field%(F%))
  7132.     =row%
  7133. check_val(C$,N$)
  7134.  min$,max$,P%,V,ok%
  7135.     ok%=
  7136.  N$="" 
  7137.  C$<>"" 
  7138.   P%=
  7139. C$,"|")
  7140.  P%>0 
  7141.     min$=
  7142. C$,P%-1)
  7143.     max$=
  7144. C$,P%+1)
  7145. H    
  7146.  min$<>"" 
  7147. (min$) 
  7148.  ok%=
  7149. restore(F%," (min="+min$+")",58)
  7150. H    
  7151.  max$<>"" 
  7152. (max$) 
  7153.  ok%=
  7154. restore(F%," (max="+max$+")",59)
  7155. restore_rec
  7156.  F%=1 
  7157.  fields%
  7158.  field$(F%)<>$Rf%(F%) 
  7159.     $Rf%(F%)=field$(F%)
  7160. #'    
  7161. redraw_icon(mainW%,field%(F%))
  7162. restore(F%,E$,E%)
  7163.  E%>=0 
  7164. softerror(E$,E%)
  7165. $Rf%(F%)=field$(F%)
  7166. redraw_icon(mainW%,field%(F%))
  7167. set_caret(mainW%,field%(F%))
  7168. relations
  7169.  F%,I%,W%,L%,N$,row%,col%,subst%,flags%,name$,x%,y%,vxmin%,vymax%,scrollx%,scrolly%,exact%
  7170.  "Wimp_CreateMenu",,-1
  7171. getscreensize(ScreenWidth%,ScreenHeight%,Vpix%)
  7172. name$=link$(Fieldnumber%)
  7173.  name$="" 
  7174.  $Rf%(Fieldnumber%)="" 
  7175. 5    F%=-1
  7176. 6&row%=
  7177. validate(Fieldnumber%,F%,N$)
  7178. 7'col%=
  7179. trailing_number(name$,exact%)
  7180. 8!subst%=
  7181. leading_number(name$)
  7182.  row%>0 
  7183. delete_icons(relateW%,0)
  7184.  I%=0 
  7185. =0      
  7186.  col%:flags%=&00000531+(fcol%(8)<<24)
  7187. >#      
  7188.  subst%:flags%=&0B000531
  7189.       
  7190. :flags%=&07000531
  7191. @        
  7192.     L%=
  7193. ($rel%(I%))
  7194. BT    R%=
  7195. create_icon(relateW%,0,-I%*36-36,L%*16+16,32,flags%,"",rel%(I%),-1,L%+1)
  7196.  L%>W% 
  7197.  W%=L%
  7198.  W%<3 
  7199.  W%=3
  7200.   $RelTitle%=N$
  7201. G&  width%=W%*16+16:height%=F%*36+36
  7202. Ha  !block%=0:block%!4=-height%:block%!8=width%:block%!12=0:
  7203.  "Wimp_SetExtent",relateW%,block%
  7204. I5  !block%=mainW%:
  7205.  "Wimp_GetWindowState",,block%
  7206. JL  vxmin%=block%!4:vymax%=block%!16:scrollx%=block%!20:scrolly%=block%!24
  7207. KQ  !block%=mainW%:block%!4=field%(Fieldnumber%):
  7208.  "Wimp_GetIconState",,block%
  7209. L?  x%=block%!16-scrollx%+vxmin%:y%=block%!20-scrolly%+vymax%
  7210. M7  !block%=relateW%:
  7211.  "Wimp_GetWindowState",,block%
  7212.  ScreenWidth%-x%<width% 
  7213.  width%=ScreenWidth%-x%
  7214. O)  block%!4=x%+4:block%!12=x%+width%-4
  7215. P*  block%!8=y%-height%-4:block%!16=y%-4
  7216. Q/  block%!28=-1:
  7217.  "Wimp_OpenWindow",,block%
  7218.  "Wimp_CreateMenu",,relateW%,x%+4,y%-4
  7219. fix_point(F$,F%)
  7220.  F$="" 
  7221.  fix%(F%) 
  7222.  -1:F$=
  7223. (V+0.5))
  7224.  Floating point. Do nothing
  7225. :@%=&01020009+fix%(F%)*256:F$=
  7226. (V),len%(F%)):@%=&90A
  7227. moveto(key%,P%,D%)
  7228. D%=(D%+1) 
  7229.  filter% 
  7230. d-  P%=
  7231. next_match(P%,D%,Filter$,finished%)
  7232.   P%=
  7233. neighbour(key%,P%,D%)
  7234.  P%=top 
  7235.  7:finished%=
  7236. neighbour(key%,P%,D%)
  7237.  merging% 
  7238. merge_next(filter%,key%,P%) 
  7239. display(key%,P%)
  7240. next_match(P%,D%,S$,
  7241.  nomore%)
  7242.  record%,abort%,passgo%,matched%
  7243. n*dbasehandle%=
  7244. ($database%+".Database")
  7245.   P%=
  7246. neighbour(key%,P%,D%)
  7247.  P%=top 
  7248.     nomore%=
  7249. s!    P%=
  7250. neighbour(key%,P%,D%)
  7251.     passgo%+=1
  7252. u+    
  7253.  passgo%>1 
  7254.  matched% 
  7255.  abort%=
  7256.  P%=top 
  7257.     matched%=
  7258. y        
  7259. z#    record%=
  7260. rec_no(k$,key%,P%)
  7261. {*    
  7262. readsmarray(dbasehandle%,record%)
  7263. |(    
  7264. (S$)=
  7265.  matched%=
  7266. :passgo%=0
  7267.  matched% 
  7268.  abort%
  7269. close_file(dbasehandle%)
  7270.  abort% 
  7271. softerror($Query%,113)
  7272. display(key%,P%)
  7273. 3!block%=mainW%:
  7274.  "Wimp_GetWindowState",,block%
  7275.  P%=-1 
  7276. check_change
  7277.  template%=1 
  7278.  template%=2 
  7279.  template%=0
  7280.  I%,L%,S%,S$,k$,ok%
  7281.  -1,-2:
  7282. .  keybase%=!keyanchor%(0):avail%=!keybase%
  7283. :    
  7284.  !(keybase%+avail%)>0,template%=2,design%=
  7285. :ok%=
  7286.     incr%=
  7287. ($Increment%)
  7288.  incr%>0 
  7289. +      
  7290. change_length(RA%+incr%,
  7291. ):ok%=
  7292.       
  7293. softerror("",2)
  7294.         
  7295.  ok% 
  7296.       
  7297.  design%:
  7298. 0      $RecInfo%="Make adjustments to fields"
  7299. )      
  7300. read(fields%,
  7301. ,RA%,$database%)
  7302.       
  7303.  template%=2:
  7304. S      $RecInfo%="Enter data which you want to appear by default on new records"
  7305. )      
  7306. read(fields%,
  7307. ,RA%,$database%)
  7308.       
  7309.  P%=-2:
  7310. o      REC%=!(keybase%+avail%+8+KL%(0)+1):$RecInfo%=$Subfile%(file%)+" Record="+
  7311. (REC%)+". (Copy)":key$()=""
  7312.       
  7313.  P%=-1:
  7314. d      REC%=!(keybase%+avail%+8+KL%(0)+1):$RecInfo%=$Subfile%(file%)+" Record="+
  7315. (REC%)+". (New)"
  7316. )      
  7317. read(fields%,
  7318. ,RA%,$database%)
  7319.         
  7320.  top:
  7321.  ### Empty subfile accessed ###
  7322. .  keybase%=!keyanchor%(0):avail%=!keybase%
  7323. (  REC%=!(keybase%+avail%+8+KL%(0)+1)
  7324. read(fields%,
  7325. ,RA%,$database%)
  7326.  7:$RecInfo%=$Subfile%(file%)+" Record="+
  7327. (REC%)+". (New)"
  7328.   REC%=
  7329. rec_no(k$,key%,P%)
  7330. read(fields%,
  7331. ,REC%,$database%)
  7332.   key$(key%)=k$
  7333. k$)="#"
  7334.     k$=
  7335. >  $RecInfo%=$Subfile%(file%)+" Record="+
  7336. (REC%)+" Key="+k$
  7337. text_length(mainW%,starthere%)
  7338.  Access% 
  7339. set_caret(mainW%,starthere%)
  7340. identify_field(starthere%)
  7341. changed%=
  7342. update_calcs(0)
  7343. *logentry$=$Subfile%(file%)+" "+
  7344. key(0)
  7345.  altered% 
  7346. $RecInfo%)<>"*" 
  7347.  $RecInfo%+=" *"
  7348. redraw(mainW%)
  7349.  P%=-2 
  7350. softerror("",130)
  7351.  -------------------- Icon colours -------------------------------
  7352. colour(key%,type%)
  7353.  type%=1 - Selected key,2 - Non-selected key
  7354.  J%=0 
  7355.  KF%(key%,J%)>0 
  7356. change_field_cols(key%,type%,J%)
  7357. change_field_cols(key%,type%,fld%)
  7358.  key% 
  7359.  type% 
  7360. )    
  7361.  1:dcol%=fcol%(0):fcol%=fcol%(1)
  7362. )    
  7363.  2:dcol%=fcol%(2):fcol%=fcol%(3)
  7364.  type% 
  7365. )    
  7366.  1:dcol%=fcol%(4):fcol%=fcol%(5)
  7367. )    
  7368.  2:dcol%=fcol%(6):fcol%=fcol%(7)
  7369. set_icon_cols(mainW%,desc%(KF%(key%,fld%)),dcol%)
  7370. 6col%=
  7371. get_icon_cols(mainW%,field%(KF%(key%,fld%)))
  7372.  (col% 
  7373.  16)=fcol%(8) 
  7374.  fcol%=(fcol% 
  7375.  &F0) 
  7376.  (col% 
  7377. set_icon_cols(mainW%,field%(KF%(key%,fld%)),fcol%)
  7378. get_icon_cols(wi%,ic%)
  7379. ;!block%=wi%:block%!4=ic%:
  7380.  "Wimp_GetIconState",,block%
  7381. =block%?27
  7382. set_icon_cols(wi%,ic%,col%)
  7383.  col%<0 
  7384.  col%=
  7385. (col%):block%!12=&0F000000 
  7386.  block%!12=&FF000000
  7387. F!block%=wi%:block%!4=ic%:block%!8=(col%<<24):
  7388.  block%!12=&FF000000
  7389.  "Wimp_SetIconState",,block%
  7390. read_colours(f$)
  7391.  ic%=0 
  7392. #F,fcol%(ic%)
  7393. ncol%()=fcol%()
  7394. close_file(F)
  7395. write_colours
  7396. ($database%+".Cols")
  7397.  ic%=0 
  7398. #F,fcol%(ic%)
  7399. close_file(F)
  7400. find(S$,key%,disp%)
  7401.  P%,F%,H%,recnum%,abort%,cond$
  7402.  case%(key%) 
  7403. u(S$)
  7404. S$,1)="#" 
  7405. check_change
  7406.   REC%=
  7407. S$,2))
  7408.  REC%>=0 
  7409.  REC%<RA% 
  7410. (    
  7411. read(fields%,
  7412. ,REC%,$database%)
  7413. $    S$=key$(key%):H%=1:recnum%=
  7414. 1    
  7415. select(searchW%,6):
  7416. deselect(searchW%,5)
  7417. $    
  7418. softerror(S$,56):abort%=
  7419. S$,KL%(key%))
  7420.  abort% 
  7421. =addr
  7422. val$=
  7423. type(key%)
  7424.  val$="VAL" 
  7425.   kl%=KL%(key%)
  7426.   S$=
  7427. stripspaces(S$)
  7428.   kl%=
  7429. search(S$,key%,1+H%)
  7430.  P%<0 
  7431. selected(searchW%,6) 
  7432.   F%=file%
  7433.     file%=(file%+1) 
  7434.     top=8*file%+LH%
  7435.      P%=
  7436. search(S$,key%,1+H%)
  7437.  P%>0 
  7438.  file%=F%
  7439.  val$="VAL" 
  7440.  cond$="VAL($(!keyanchor%(key%)+P%+8))=VAL(S$)" 
  7441.  cond$="LEFT$($(!keyanchor%(key%)+P%+8),kl%)=S$"
  7442. matches%=0
  7443.  P%>=0 
  7444.  recnum%:RecF%=
  7445. :addr=P%:matches%=1
  7446.  P%>=0:RecF%=
  7447.  ### RecF% is used only by !DELETE in script language ###
  7448. count_matches(addr)
  7449. selected(searchW%,6) 
  7450. $    F%=file%:file%=(file%+1) 
  7451.         
  7452.       top=8*file%+LH%
  7453.       P%=
  7454. search(S$,key%,1)
  7455.  %      
  7456.  P%>0 
  7457. count_matches(Q%)
  7458.       file%=(file%+1) 
  7459.  file%=F%
  7460.     top=8*file%+LH%
  7461.  recnum%:
  7462. softerror("#"+
  7463. (REC%),55)
  7464.  disp% 
  7465.  addr=
  7466. (P%):flash%=KF%(key%,0) 
  7467.  addr=P%
  7468. text(searchW%,7)=
  7469. (matches%)+" found":
  7470. redraw_icon(searchW%,7)
  7471.  disp% 
  7472. display(key%,addr)
  7473. *    =addr
  7474. count_matches(
  7475. (cond$)
  7476.   P%=
  7477. neighbour(key%,P%,0)
  7478. 0XP%=
  7479. neighbour(key%,P%,1):Q%=P%:
  7480.  ### Scan back to FIRST match & point addr at it ###
  7481. (cond$)
  7482.   matches%+=1
  7483.   P%=
  7484. neighbour(key%,P%,1)
  7485. lookup(F%)
  7486.  K%,S$,K$
  7487.  chartype%(F%)>8 
  7488. is_a_key(F%)
  7489.  K%>=0 
  7490.   K$=
  7491. key(K%)
  7492.   addr=
  7493. find(K$,key%,
  7494.  addr=
  7495. find($Rf%(F%),key%,
  7496. get_it_in(filename$)
  7497.  "OS_File",5,filename$ 
  7498.  d%,,ftype%
  7499. D9ftype%=(ftype%>>8) 
  7500.  &fff:wi%=block%!20:ic%=block%!24
  7501. field%=(ic%+1) 
  7502.  wi%=mainW% 
  7503.  chartype%(field%)=44 
  7504. link_file(wi%,ic%,field%,filename$,ftype%)
  7505.  d%=2 
  7506.  wi%=reformW% 
  7507. I-    
  7508.  "OS_File",5,filename$+".Form" 
  7509.  d%=1 
  7510. KJ      $
  7511. text(wi%,7)=filename$:
  7512. redraw_icon(wi%,7):
  7513. shade(reformW%,6,
  7514.       
  7515. softerror("",28)
  7516. M        
  7517. N        
  7518. O!    
  7519. leaf(filename$),1) 
  7520.       
  7521.  "!":
  7522. Q1      
  7523.  ### Is it an Impression document? ###
  7524. R3      
  7525.  "OS_File",5,filename$+".!DocData" 
  7526.       
  7527.  d%=1 
  7528. T"        
  7529. ready_to_merge(&2000)
  7530.         
  7531. V4        
  7532.  ### Is it a Powerbase application? ###
  7533. W;        
  7534.  "OS_File",5,filename$+".Indices" 
  7535.  d%,,type%
  7536. X#        type%=(type%>>8) 
  7537.  &fff
  7538.         
  7539.  d%=2 
  7540. Z"          
  7541.  present%>0 
  7542. [&          $Title%=
  7543. leaf(filename$)
  7544. \$          
  7545. open_files(filename$)
  7546.         
  7547.       
  7548.       
  7549. `5      
  7550.  ### It's an ordinary directory folder ###
  7551. a:      
  7552. transfer_blob(block%!20,block%!24,filename$,-1)
  7553. b        
  7554.  ftype% 
  7555. f'    
  7556.  &7f1:
  7557. load_table(filename$,
  7558. g)    
  7559.  &7f3:
  7560. load_selection(filename$)
  7561. h-    
  7562.  &7f4:
  7563. load_query(filename$,wi%,ic%)
  7564. i.    
  7565.  &7f5:
  7566. get_options(printW%,filename$)
  7567. jB    
  7568.  &dfe:$
  7569. text(csvW%,13)=filename$:
  7570. start_import("CSV",wi%)
  7571. kH    
  7572.  &ff9,&aff:
  7573. transfer_blob(block%!20,block%!24,filename$,ftype%)
  7574. l>    
  7575.  &bc5:
  7576.  chartype%(field%)<>44 
  7577. ready_to_merge(&bc5)
  7578.  &fff:
  7579. n1    F=
  7580. (filename$):header$=
  7581. close_file(F)
  7582.  wi% 
  7583. p,      
  7584.  mainW%,tableW%(Tablenumber%),-1:
  7585.       
  7586. rQ        
  7587.  header$="!SCRIPT POWERBASE":
  7588.  present%=7:
  7589. execute_script(filename$)
  7590. sI        
  7591.  wi%=mainW% 
  7592.  ic%>0:
  7593. transfer_blob(wi%,ic%,filename$,ftype%)
  7594. tB        
  7595. text(csvW%,13)=filename$:
  7596. start_import("text",wi%)
  7597.       
  7598. v(      
  7599.  customise% 
  7600. special_drop
  7601. w        
  7602. ready_to_merge(doctype%)
  7603. selected(passW%,13) 
  7604.  present%=7 
  7605.    document$=
  7606. leaf(filename$)
  7607. document$,1)="!" 
  7608.  document$=
  7609. document$,2)
  7610. 6  block%!0=256:block%!12=0:block%!16=5:block%!20=0
  7611. 5  block%!24=0:block%!28=0:block%!32=0:block%!36=0
  7612. /  block%!40=doctype%:$(block%+44)=filename$
  7613.  "Wimp_SendMessage",18,block%,0
  7614.   Impref%=block%!8
  7615. softerror("",107)
  7616. open_files(f$)
  7617.  I%,J%,F%,A$
  7618.  ### Delete redundant files if present ###
  7619.  "OS_CLI","Remove "+f$+".Winsize"
  7620.  "OS_CLI","Remove "+f$+".Choices"
  7621. read_sys_vars(f$)
  7622.  "OS_File",5,f$+".Database" 
  7623.  d%=1 
  7624.  present%=present% 
  7625.  "OS_File",5,f$+".PrimaryKey" 
  7626.  d%=1 
  7627.  present%=present% 
  7628.  "OS_File",5,f$+".Form" 
  7629.  d%=1 
  7630.  present%=present% 
  7631.  "OS_File",5,f$+".UsrSprites" 
  7632.  d%,,,,len%
  7633.  d%=1 
  7634. create_named_sliding_block(logoanchor%,len%+8)
  7635. &  base%=!logoanchor%:!base%=len%+4
  7636.  "OS_File",255,f$+".UsrSprites",base%+4
  7637.   logosloaded%=
  7638. $database%=f$
  7639.  "OS_CLI","Set Dbase$Dir "+f$
  7640.  present% 
  7641.  0,1,5:Access%=
  7642. :Modify%=
  7643. resume_opening
  7644. access(f$,accessW%) 
  7645. resume_opening
  7646. wimp_error(
  7647. ,254,0,
  7648. msg("Err24"))
  7649. read_sys_vars(f$)
  7650.  E%,F,A$,L$,S$
  7651. (f$+".!Run")
  7652.   S$=
  7653. S$,"Acl$Dir")>0 
  7654.  A$=S$
  7655. S$,"Log$Dir")>0 
  7656.  L$=S$
  7657. close_file(F)
  7658.  A$="" 
  7659.  A$="Set Acl$Dir "+f$
  7660.  L$="" 
  7661.  L$="Set Log$Dir "+f$
  7662.  "XOS_ReadVarVal","Acl$Dir",,-1 
  7663.  ,,E%:
  7664.  E%=0 
  7665.  "OS_CLI",A$
  7666.  "XOS_ReadVarVal","Log$Dir",,-1 
  7667.  ,,E%:
  7668.  E%=0 
  7669.  "OS_CLI",L$
  7670. access(f$,wi%)
  7671.  L%,P%,keybase%,login%,attempts%,old%
  7672. (f$+".Colours")
  7673.  F>0 
  7674. #F=35:old%=
  7675. (f$+".Cols")
  7676.  F>0 
  7677. #F=45:old%=
  7678.  fatal_err%,f$+"."+
  7679. msg("Err18")
  7680. #F,S$:$Read%=
  7681. encrypt(S$,
  7682. #F,S$:$Write%=
  7683. encrypt(S$,
  7684. #F,S$:$Manager%=
  7685. encrypt(S$,
  7686.  I%=9 
  7687. select(passW%,I%)
  7688. deselect(passW%,16)
  7689.  I%<17 
  7690. #F,Z%:
  7691. set_icon(passW%,I%,Z%)
  7692.   I%+=1
  7693. close_file(F)
  7694.  old% 
  7695.  "OS_CLI","Copy <PBase$Dir>.Resources.Cols "+f$+".Cols ~C~V"
  7696. mouse(-1,0,4,passW%,4)
  7697.  "OS_CLI","Remove "+f$+".Colours"
  7698.  "OS_File",5,"<Acl$Dir>.acl" 
  7699.  d%:acl%=(d%=1)
  7700.  $Manager%="" 
  7701.  acl%=
  7702.  Access%=
  7703. :Modify%=
  7704. 9$AccessTitle%="!Powerbase opening "+
  7705. leaf($database%)
  7706.  acl% 
  7707. position_window(wi%,0,0,0,310,0,110):refuse$="Access denied"
  7708. position_window(wi%,0,0,0,200,0,0):refuse$="Password not known"
  7709. 0!block%=wi%:
  7710.  "Wimp_GetWindowState",,block%
  7711.  block%!4,block%!8,block%!12-block%!4,block%!16-block%!8
  7712. (  cancel%=
  7713. :login%=
  7714. :accessbutton%=0
  7715.   $Password%="":$UserID%=""
  7716. redraw_icon(wi%,1):
  7717. redraw_icon(wi%,0)
  7718. text(wi%,5)="Type in your password"
  7719.  acl% 
  7720. set_caret(wi%,0) 
  7721. set_caret(wi%,1)
  7722.  accessbutton%>0
  7723.  accessbutton% 
  7724.  2:cancel%=
  7725. +    password$=$Password%:user$=$UserID%
  7726.  acl% 
  7727.       F=
  7728. ("<Acl$Dir>.acl")
  7729.       
  7730. !        
  7731. #F,id$,personal$,pw%
  7732. X        
  7733.  id$=
  7734. encrypt(user$,
  7735.  personal$=
  7736. encrypt(password$,
  7737.  pw%>0 
  7738.  login%=
  7739.       
  7740.  login% 
  7741.       
  7742. close_file(F)
  7743.       
  7744.       user$="<none>"
  7745.       
  7746.  password$ 
  7747. &        
  7748.  $Manager%:pw%=3:login%=
  7749. $        
  7750.  $Write%:pw%=2:login%=
  7751. #        
  7752.  $Read%:pw%=1:login%=
  7753.       
  7754.         
  7755.  (login% 
  7756.  cancel%) 
  7757.     $
  7758. text(wi%,5)=refuse$
  7759. !    
  7760. set_icon_cols(wi%,5,&1B)
  7761.     delay%=
  7762.         
  7763.       
  7764. >delay%
  7765. !    
  7766. set_icon_cols(wi%,5,&17)
  7767.     attempts%+=1
  7768. R    att$(attempts%)=
  7769. (attempts%)+","+
  7770. leaf($database%)+","+user$+","+password$
  7771.  login% 
  7772.  cancel% 
  7773.  attempts%=3
  7774. getscreensize(W%,H%,V%)
  7775. #Access%=(pw%>1):Modify%=(pw%>2)
  7776. close_window(wi%)
  7777.  0,0,W%,H%
  7778.  attempts%=3 
  7779. "  user$="<unrecognised>":pw%=0
  7780. open_log("<Log$Dir>.Log",
  7781.  I%=1 
  7782. /    
  7783. write_log(-1,
  7784. msg("Err122,"+att$(I%)))
  7785. close_log("<Log$Dir>.Log")
  7786. close_down
  7787. =login%
  7788. resume_opening
  7789.  "OS_Byte",202,kbdstatus%
  7790.  "Hourglass_On"
  7791. selected(passW%,16) 
  7792. open_log("<Log$Dir>.Log",
  7793. ($database%+".Subfiles")
  7794.  I%=0 
  7795. *    
  7796.  0:$Subfile%(I%)="Subfile "+
  7797.     S$=
  7798. %    
  7799.  S$="" 
  7800.  S$="Subfile "+
  7801.     $Subfile%(I%)=S$
  7802. close_file(F)
  7803.  "OS_File",5,f$+".UserFuncs" 
  7804.  d%=1 
  7805.  f$+".UserFuncs"
  7806.  "OS_File",5,f$+".Cols" 
  7807.  d%=0 
  7808.  "OS_CLI","Copy <PBase$Dir>.Resources.Cols "+f$+".Cols ~C~V"
  7809.  "OS_CLI","Remove "+f$+".Colours"
  7810. read_colours($database%+".Cols")
  7811.  "OS_File",5,f$+".PrintRes.PrtOptions" 
  7812.  d%=1 
  7813. get_options(printW%,f$+".PrintRes.PrtOptions")
  7814.  "OS_File",5,f$+".Preference" 
  7815.  d%=1 
  7816. get_preferences(prefsW%,f$+".Preference")
  7817.  "OS_File",5,f$+".CSVoptions" 
  7818.  d%=1 
  7819. get_csv_options(f$+".CSVoptions")
  7820. deselect(prefsW%,36):
  7821. select(prefsW%,35):
  7822. shade(prefsW%,35,
  7823. f$,3)="RAM" 
  7824.  ram%=
  7825.  "OS_CLI","Set Alias$Indices Filer_OpenDir "+$database%+".Indices"
  7826.  "OS_CLI","Set Alias$Tables Filer_OpenDir "+$database%+".ValTables"
  7827.  "OS_CLI","Set Alias$Resources Filer_OpenDir "+$database%+".PrintRes"
  7828.  "OS_CLI","Set Alias$JobsDone Filer_OpenDir "+$database%+".PrintJobs"
  7829. shade(csvW%,18,Modify%)
  7830. shade(csvW%,21,Access%)
  7831. shade(printW%,50,Modify%)
  7832. shade(printW%,53,Access%)
  7833. shade(prefsW%,36,Modify%)
  7834. shade(prefsW%,38,Access%)
  7835. lit(iconbarM%,1,
  7836. lit(iconbarM%,2,Modify%)
  7837. lit(iconbarM%,3,
  7838. lit(iconbarM%,5,Modify%)
  7839. lit(mainM%,6,
  7840. selected(passW%,9))
  7841. lit(miscM%,0,Access%)
  7842. lit(miscM%,1,Modify%)
  7843. lit(miscM%,2,Access%)
  7844. lit(miscM%,3,Access%)
  7845. lit(miscM%,4,Access%)
  7846. lit(miscM%,5,Access%)
  7847. lit(validateM%,0,Access%)
  7848. lit(fieldM%,0,Access%)
  7849. lit(fieldM%,2,Access%)
  7850. lit(fieldM%,3,Access%)
  7851. lit(tableM%,0,Access%)
  7852. lit(tableM%,3,Access%)
  7853. lit(utilityM%,0,((present% 
  7854.  4)>0))
  7855. lit(designM%,1,((present% 
  7856.  4)=0))
  7857.  I%=1 
  7858. lit(utilityM%,I%,(present%=7))
  7859. limit_actions(Access%)
  7860.  present%<4 
  7861.  design%=
  7862.  present%=5 
  7863. adjust_on(
  7864. lit(designM%,6,
  7865. fields%=
  7866. get_form(Fptr%)
  7867. V0chartype%(0)=100:chartype%(MaxFields%+1)=100
  7868.  fields%>0 
  7869.   starthere%=
  7870. start_at
  7871. Y"  Lastwritable%=
  7872. last_writable
  7873. Z'  fieldmenu%=
  7874. field_menu(fields%,
  7875. create_named_sliding_block(transanchor%,Length%+1)
  7876.  adjust% 
  7877. lit(designM%,2,(fields%>0))
  7878.  present% 
  7879. `-  $RecInfo%="No record design exists yet"
  7880.  I%=1 
  7881. lit(designM%,I%,
  7882. lit(designM%,5,
  7883. get_winpos
  7884.  !formanchor%=0 
  7885. g2    
  7886. extend_named_sliding_block(formanchor%,0)
  7887.     Fptr%=!formanchor%
  7888. i     fields%=0:Fieldnumber%=0
  7889. l8  $RecInfo%="Record design exists, but no datafiles"
  7890. first_writable>0 
  7891. lit(designM%,3,
  7892. lit(designM%,4,
  7893. get_winpos
  7894. s6  $RecInfo%="No primary key index file exists yet"
  7895.  "OS_File",5,$database%+".Database" 
  7896.  ,,,,len%
  7897. u-  RA%=(len% 
  7898.  Length%)-1:$Records%=
  7899. (RA%)
  7900. first_writable>0 
  7901. get_winpos
  7902. lit(mainM%,8,
  7903. selected(passW%,13))
  7904. lit(mainM%,9,
  7905. selected(passW%,13))
  7906. lit(mainM%,2,
  7907. selected(passW%,14))
  7908.  "OS_File",5,$database%+".Database" 
  7909.  ,,,,len%
  7910. |-  RA%=(len% 
  7911.  Length%)-1:$Records%=
  7912. (RA%)
  7913.  (len% 
  7914.  Length%)<>0 
  7915. rectify
  7916. open_index($database%+".PrimaryKey",0,
  7917. $  key%=0:file%=0:top=8*file%+LH%
  7918. #  $Subfilename%=$Subfile%(key%)
  7919. set_keydata(key%)
  7920. Z  keybase%=!keyanchor%(0):
  7921.  keybase%!4>0 
  7922.  $Increment%=
  7923. (keybase%!4) 
  7924.  $Increment%="0"
  7925. ,  f$=$database%+".Indices":R4%=0:Keys%=0
  7926.  R4%<>-1
  7927.     Keys%+=1
  7928. 5    
  7929.  "OS_GBPB",9,f$,block%,1,R4%,11 
  7930.  ,,K$,,R4%
  7931. C    
  7932.  R4%<>-1 
  7933. open_index(f$+"."+K$,Keys%,
  7934. colour(Keys%,2)
  7935.   Keys%-=1
  7936.  extrakeys$<>"" 
  7937. softerror(
  7938. extrakeys$),96)
  7939. colour(0,1)
  7940. get_tables
  7941.   key%=0
  7942. count(key%,RU%):
  7943. update_stats
  7944. get_winpos
  7945. load_calcs
  7946. auto_csv(
  7947. selected(prefsW%,44))
  7948. limit_actions(Access%)
  7949.   addr=
  7950. moveto(key%,top,1)
  7951.  "Hourglass_Off"
  7952. $dbase%=
  7953. $Title%,2)
  7954. redraw_icon(-2,pbaseicon%)
  7955. make_user_menus
  7956. lib$=$database%+".Special"
  7957.  "OS_File",5,lib$ 
  7958.  d%=1 
  7959.  library$ 
  7960. -    
  7961.  "":library$=lib$:
  7962.  lib$:
  7963. customise
  7964. C    
  7965.  lib$:
  7966.  Do nothing - required library is already installed
  7967. 3    P%=
  7968. library$,".Special"):P$=
  7969. library$,P%-1)
  7970. 7    
  7971. softerror(
  7972. leaf(P$)+","+
  7973. leaf($database%),134)
  7974. "    
  7975. delete_icons(keypadW%,29)
  7976. delete_icons(keypadW%,29)
  7977. rectify
  7978.  REC%,I%,J%,F$
  7979. REC%=-1
  7980. *dbasehandle%=
  7981. ($database%+".Database")
  7982.  REC%<RA% 
  7983. (F$)<>0
  7984.   REC%+=1
  7985. #dbasehandle%=Length%*REC%
  7986.   F$=
  7987. #dbasehandle%
  7988. (F$)=0 
  7989. softerror("",109)
  7990. #dbasehandle%=REC%*Length%
  7991.  "Hourglass_On"
  7992.  I%=REC% 
  7993. !    
  7994. #dbasehandle%=I%*Length%
  7995.  J%=1 
  7996.  fields%
  7997.       
  7998. #dbasehandle%,""
  7999. >    
  8000.  "Hourglass_Percentage",((I%-REC%)*100) 
  8001.  (RA%-REC%)
  8002.  "Hourglass_Off"
  8003.  RA%+=1
  8004. #dbasehandle%=(RA%+1)*Length%
  8005. close_file(dbasehandle%)
  8006. val(keypadW%,17)
  8007. $,5,6)="01 Apr" 
  8008. $,17,2)<"12" 
  8009. !  S$="Stoilet"+
  8010. $block%!32,8)
  8011.  S$="Sdelete"+
  8012. $block%!32,8)
  8013. val(keypadW%,17)=S$
  8014. get_options(wi%,f$)
  8015.  F,S$,C$,P%
  8016. 2  S$=
  8017. #F:P%=
  8018. S$," "):C$=
  8019. S$,P%+1):S$=
  8020. S$,P%-1)
  8021.  "Destination":
  8022. +    
  8023. deselect(wi%,
  8024. selected_esg(wi%,4))
  8025. $      
  8026.  "window":
  8027. select(wi%,38)
  8028. "      
  8029.  "file":
  8030. select(wi%,39)
  8031. %      
  8032.  "printer":
  8033. select(wi%,41)
  8034.         
  8035.  "Headings":
  8036. +    
  8037. deselect(wi%,
  8038. selected_esg(wi%,1))
  8039. ;    
  8040.  C$="descriptor" 
  8041. select(wi%,2) 
  8042. select(wi%,1)
  8043.  "Pitch":
  8044. +    
  8045. deselect(wi%,
  8046. selected_esg(wi%,2))
  8047.       
  8048.  "5":
  8049. select(wi%,4)
  8050.       
  8051.  "10":
  8052. select(wi%,7)
  8053.       
  8054.  "12":
  8055. select(wi%,8)
  8056.       
  8057.  "17":
  8058. select(wi%,6)
  8059.         
  8060.  "Format":
  8061. +    
  8062. deselect(wi%,
  8063. selected_esg(wi%,3))
  8064. C$,6) 
  8065. #      
  8066.  "horiz":
  8067. select(wi%,23)
  8068. "      
  8069.  "vert":
  8070. select(wi%,24)
  8071.       
  8072.  "column":
  8073. /      
  8074. select(wi%,25):$
  8075. text(wi%,15)=
  8076. C$,7)
  8077. #      
  8078.  "label":
  8079. select(wi%,26)
  8080.         
  8081. (    
  8082. shade(wi%,15,
  8083. selected(wi%,25))
  8084. <    
  8085. shade(wi%,43,
  8086. selected(wi%,25) 
  8087. selected(wi%,23))
  8088. (    
  8089. shade(wi%,45,
  8090. selected(wi%,25))
  8091. .    
  8092.  "Expand":
  8093. set_icon(wi%,11,(C$="ON"))
  8094. 1    
  8095.  "Underline":
  8096. set_icon(wi%,29,(C$="ON"))
  8097. 1    
  8098.  "Uppercase":
  8099. set_icon(wi%,12,(C$="ON"))
  8100. .    
  8101.  "Header":
  8102. set_icon(wi%,47,(C$="ON"))
  8103. -    
  8104.  "Page1":
  8105. set_icon(wi%,10,(C$="ON"))
  8106. .    
  8107.  "Footer":
  8108. set_icon(wi%,48,(C$="ON"))
  8109. ,    
  8110.  "Date":
  8111. set_icon(wi%,19,(C$="ON"))
  8112. .    
  8113.  "Shrink":
  8114. set_icon(wi%,40,(C$="ON"))
  8115. /    
  8116.  "Control":
  8117. set_icon(wi%,42,(C$="ON"))
  8118. 2    
  8119.  "PageNumber":
  8120. set_icon(wi%,54,(C$="ON"))
  8121. (    
  8122.  "PageLength":$
  8123. text(wi%,16)=C$
  8124. '    
  8125.  "LineSpace":$
  8126. text(wi%,17)=C$
  8127. %    
  8128.  "Lmargin":$
  8129. text(wi%,30)=C$
  8130. %    
  8131.  "Tmargin":$
  8132. text(wi%,32)=C$
  8133. #    
  8134.  "Title":$
  8135. text(wi%,18)=C$
  8136. '    
  8137.  "TextWidth":$
  8138. text(wi%,34)=C$
  8139. *    
  8140.  "ColumnSpacer":$
  8141. text(wi%,43)=C$
  8142. )    
  8143.  "ColumnWidth":$
  8144. text(wi%,45)=C$
  8145.  "LabelRowOf":
  8146. 3    
  8147. deselect(labelW%,
  8148. selected_esg(labelW%,1))
  8149.      
  8150. select(labelW%,
  8151. (C$)-1)
  8152. +    
  8153.  "LabelWidth":$
  8154. text(labelW%,4)=C$
  8155. ,    
  8156.  "LabelHeight":$
  8157. text(labelW%,6)=C$
  8158. ,    
  8159.  "LabelLines":$
  8160. text(labelW%,10)=C$
  8161.     -    
  8162.  "LabelCopies":$
  8163. text(labelW%,17)=C$
  8164. n    
  8165.  "Substitute":
  8166. C$,4)="SUBS" 
  8167. select(labelW%,11):$
  8168. text(labelW%,12)=
  8169. C$,5) 
  8170. deselect(labelW%,11)
  8171. 4    
  8172.  "PrintKey":
  8173. set_icon(labelW%,13,(C$="ON"))
  8174. 5    
  8175.  "SkipBlank":
  8176. set_icon(labelW%,16,(C$="ON"))
  8177. close_file(F)
  8178. save_options(wi%,f$)
  8179. selected_esg(wi%,4) 
  8180.  38:C$="window"
  8181.  39:C$="file"
  8182.  41:C$="printer"
  8183. #F,"Destination "+C$
  8184. selected_esg(wi%,1) 
  8185.  1:C$="tag"
  8186.  2:C$="descriptor"
  8187. #F,"Headings "+C$
  8188. selected_esg(wi%,2) 
  8189.  4:C$="5"
  8190.  7:C$="10"
  8191.  8:C$="12"
  8192.  6:C$="17"
  8193. #F,"Pitch "+C$
  8194. selected_esg(wi%,3) 
  8195.  23:C$="horiz"
  8196.  24:C$="vert"
  8197.  25:C$="column"+$
  8198. text(wi%,15)
  8199.  26:C$="label"
  8200. #F,"Format "+C$
  8201. selected(wi%,11) 
  8202.  C$="ON" 
  8203.  C$="OFF"
  8204. #F,"Expand "+C$
  8205. selected(wi%,29) 
  8206.  C$="ON" 
  8207.  C$="OFF"
  8208. #F,"Underline "+C$
  8209. selected(wi%,12) 
  8210.  C$="ON" 
  8211.  C$="OFF"
  8212. #F,"Uppercase "+C$
  8213. selected(wi%,47) 
  8214.  C$="ON" 
  8215.  C$="OFF"
  8216. #F,"Header "+C$
  8217. selected(wi%,10) 
  8218.  C$="ON" 
  8219.  C$="OFF"
  8220. #F,"Page1 "+C$
  8221. selected(wi%,48) 
  8222.  C$="ON" 
  8223.  C$="OFF"
  8224. #F,"Footer "+C$
  8225. selected(wi%,19) 
  8226.  C$="ON" 
  8227.  C$="OFF"
  8228. #F,"Date "+C$
  8229. selected(wi%,40) 
  8230.  C$="ON" 
  8231.  C$="OFF"
  8232. #F,"Shrink "+C$
  8233. selected(wi%,42) 
  8234.  C$="ON" 
  8235.  C$="OFF"
  8236. #F,"Control "+C$
  8237. selected(wi%,54) 
  8238.  C$="ON" 
  8239.  C$="OFF"
  8240. #F,"PageNumber "+C$
  8241. #F,"PageLength "+$
  8242. text(wi%,16)
  8243. #F,"LineSpace "+$
  8244. text(wi%,17)
  8245. #F,"Lmargin "+$
  8246. text(wi%,30)
  8247. #F,"Tmargin "+$
  8248. text(wi%,32)
  8249. #F,"Title "+$
  8250. text(wi%,18)
  8251. #F,"TextWidth "+$
  8252. text(wi%,34)
  8253. #F,"ColumnSpacer "+$
  8254. text(wi%,43)
  8255. #F,"ColumnWidth "+$
  8256. text(wi%,45)
  8257. J$C$=
  8258. selected_esg(labelW%,1)+1)
  8259. #F,"LabelRowOf "+C$
  8260. #F,"LabelWidth "+$
  8261. text(labelW%,4)
  8262. #F,"LabelHeight "+$
  8263. text(labelW%,6)
  8264. #F,"LabelLines "+$
  8265. text(labelW%,10)
  8266. #F,"LabelCopies "+$
  8267. text(labelW%,17)
  8268. selected(labelW%,11) 
  8269.  C$="SUBS"+$
  8270. text(labelW%,12) 
  8271.  C$="OFF"
  8272. #F,"Substitute "+C$
  8273. selected(labelW%,13) 
  8274.  C$="ON" 
  8275.  C$="OFF"
  8276. #F,"PrintKey "+C$
  8277. selected(labelW%,16) 
  8278.  C$="ON" 
  8279.  C$="OFF"
  8280. #F,"SkipBlank "+C$
  8281. close_file(F)
  8282.  "OS_File",18,f$,&7f5
  8283. get_preferences(wi%,f$)
  8284.  F,S$,C$,P%
  8285. ^2  S$=
  8286. #F:P%=
  8287. S$," "):C$=
  8288. S$,P%+1):S$=
  8289. S$,P%-1)
  8290. `&    
  8291.  "DateSeparator":$datesep%=C$
  8292. a&    
  8293.  "TimeSeparator":$timesep%=C$
  8294.  "WildcardS":$wc%=C$
  8295.  "WildcardM":$ws%=C$
  8296. d3    
  8297.  "Recalculate":
  8298. set_icon(wi%,14,(C$="ON"))
  8299. e>    
  8300.  "NewCopy":kill%=(C$<>"ON"):
  8301. set_icon(wi%,12,
  8302.  kill%)
  8303. fS    
  8304.  "CaseSpecific":
  8305. set_icon(wi%,30,(C$="ON")):
  8306. set_icon(queryW%,1,(C$="ON"))
  8307. g3    
  8308.  "BlankRecord":
  8309. set_icon(wi%,15,(C$="ON"))
  8310. h6    
  8311.  "MoveDescriptor":
  8312. set_icon(wi%,16,(C$="ON"))
  8313. iA    
  8314.  "ImpulseClient":$mergewith%=C$:$ImpulseApp%=$mergewith%
  8315. j0    
  8316.  "Validate":
  8317. set_icon(wi%,21,(C$="ON"))
  8318. k2    
  8319.  "ShowLinked":
  8320. set_icon(wi%,19,(C$="ON"))
  8321. l/    
  8322.  "Warning":
  8323. set_icon(wi%,20,(C$="ON"))
  8324.  "Autosave":
  8325. n+    
  8326. deselect(wi%,
  8327. selected_esg(wi%,2))
  8328. C$,4) 
  8329. p-      
  8330.  "OFF":autosave%=0:$Interval%="10"
  8331. q0      
  8332.  "WARN":autosave%=1:$Interval%=
  8333. C$,5)
  8334. r0      
  8335.  "AUTO":autosave%=2:$Interval%=
  8336. C$,5)
  8337. s        
  8338. t!    
  8339. select(wi%,29-autosave%)
  8340. u%    
  8341. shade(wi%,25,(autosave%<>0))
  8342.  "Autobalance":
  8343. C$,4) 
  8344. x-      
  8345.  "OFF":autobalance%=
  8346. :$Every%="25"
  8347. y0      
  8348.  "AUTO":$Every%=
  8349. C$,5):autobalance%=
  8350. z        
  8351. {G    
  8352. set_icon(wi%,31,autobalance%):
  8353. shade(wi%,32,
  8354. selected(wi%,31))
  8355. |Y    
  8356.  "Duplication":
  8357. set_icon(wi%,34,C$="ON"):
  8358. shade(prefsW%,34,
  8359. selected(passW%,15))
  8360. }3    
  8361.  "DefaultAction":
  8362. set_icon(wi%,41,C$="ON")
  8363. ~2    
  8364.  "StripLeading":
  8365. set_icon(wi%,47,C$="ON")
  8366. 3    
  8367.  "StripTrailing":
  8368. set_icon(wi%,42,C$="ON")
  8369. 3    
  8370.  "RememberPlace":
  8371. set_icon(wi%,43,C$="ON")
  8372. -    
  8373.  "AutoCSV":
  8374. set_icon(wi%,44,C$="ON")
  8375. $    
  8376.  "SaveStart":$StartHere%=C$
  8377. close_file(F)
  8378. save_preferences(wi%,f$)
  8379.  F,C$
  8380. #F,"DateSeparator "+$datesep%
  8381. #F,"TimeSeparator "+$timesep%
  8382. #F,"WildcardS "+$wc%
  8383. #F,"WildcardM "+$ws%
  8384. #F,"ImpulseClient "+$mergewith%
  8385. selected(wi%,12) 
  8386.  C$="ON" 
  8387.  C$="OFF"
  8388. #F,"NewCopy "+C$
  8389. selected(wi%,30) 
  8390.  C$="ON" 
  8391.  C$="OFF"
  8392. #F,"CaseSpecific "+C$
  8393. selected(wi%,14) 
  8394.  C$="ON" 
  8395.  C$="OFF"
  8396. #F,"Recalculate "+C$
  8397. selected(wi%,15) 
  8398.  C$="ON" 
  8399.  C$="OFF"
  8400. #F,"BlankRecord "+C$
  8401. selected(wi%,16) 
  8402.  C$="ON" 
  8403.  C$="OFF"
  8404. #F,"MoveDescriptor "+C$
  8405. selected(wi%,21) 
  8406.  C$="ON" 
  8407.  C$="OFF"
  8408. #F,"Validate "+C$
  8409. selected(wi%,19) 
  8410.  C$="ON" 
  8411.  C$="OFF"
  8412. #F,"ShowLinked "+C$
  8413. selected(wi%,20) 
  8414.  C$="ON" 
  8415.  C$="OFF"
  8416. #F,"Warning "+C$
  8417.  autosave% 
  8418.  0:C$="OFF"
  8419.  1:C$="WARN"+$Interval%
  8420.  2:C$="AUTO"+$Interval%
  8421. #F,"Autosave "+C$
  8422.  autobalance% 
  8423. :C$="OFF"
  8424. :C$="AUTO"+$Every%
  8425. #F,"Autobalance "+C$
  8426. selected(prefsW%,34) 
  8427.  C$="ON" 
  8428.  C$="OFF"
  8429. #F,"Duplication "+C$
  8430. selected(prefsW%,41) 
  8431.  C$="ON" 
  8432.  C$="OFF"
  8433. #F,"DefaultAction "+C$
  8434. selected(prefsW%,47) 
  8435.  C$="ON" 
  8436.  C$="OFF"
  8437. #F,"StripLeading "+C$
  8438. selected(prefsW%,42) 
  8439.  C$="ON" 
  8440.  C$="OFF"
  8441. #F,"StripTrailing "+C$
  8442. selected(prefsW%,43) 
  8443.  C$="ON" 
  8444.  C$="OFF"
  8445. #F,"RememberPlace "+C$
  8446. selected(prefsW%,44) 
  8447.  C$="ON" 
  8448.  C$="OFF"
  8449. #F,"AutoCSV "+C$
  8450. C$=$StartHere%
  8451.  C$<>"" 
  8452. #F,"SaveStart "+C$
  8453. close_file(F)
  8454.  "OS_File",18,f$,&fff
  8455. get_csv_options(f$)
  8456.  F,S$,C$,P%
  8457. 2  S$=
  8458. #F:P%=
  8459. S$," "):C$=
  8460. S$,P%+1):S$=
  8461. S$,P%-1)
  8462.  "Separator":
  8463.     $Delim%=""
  8464. !      
  8465.  "Comma":sep$=",":P%=0
  8466.        
  8467.  "TAB":sep$=
  8468. (9):P%=1
  8469.        
  8470.  "CR":sep$=
  8471. (13):P%=2
  8472.        
  8473.  "LF":sep$=
  8474. (10):P%=3
  8475. #      
  8476.  $Delim%=C$:sep$=C$:P%=4
  8477.         
  8478. %    
  8479. tick_one(delimiterM%,0,3,P%)
  8480. 2    $
  8481. text(csvW%,14)=C$:
  8482. redraw_icon(csvW%,14)
  8483.  "Terminator":
  8484.     $Termin%=""
  8485. !      
  8486.  "CR":term$=
  8487. (13):P%=0
  8488. !      
  8489.  "LF":term$=
  8490. (10):P%=1
  8491. *      
  8492.  "CR LF":term$=
  8493. (13)+
  8494. (10):P%=2
  8495. *      
  8496.  "LF CR":term$=
  8497. (10)+
  8498. (13):P%=3
  8499. *      
  8500.  "CR CR":term$=
  8501. (13)+
  8502. (13):P%=4
  8503. *      
  8504.  "LF LF":term$=
  8505. (10)+
  8506. (10):P%=5
  8507. &      
  8508. : $Termin%=C$:term$=C$:P%=6
  8509.         
  8510. &    
  8511. tick_one(terminatorM%,0,5,P%)
  8512. 2    $
  8513. text(csvW%,15)=C$:
  8514. redraw_icon(csvW%,15)
  8515. -    
  8516.  "Quotes":
  8517. set_icon(csvW%,0,C$="ON")
  8518. -    
  8519.  "Header":
  8520. set_icon(csvW%,1,C$="ON")
  8521. -    
  8522.  "Blanks":
  8523. set_icon(csvW%,2,C$="ON")
  8524. *    
  8525.  "Key":
  8526. set_icon(csvW%,3,C$="ON")
  8527. -    
  8528.  "RecNo":
  8529. set_icon(csvW%,22,C$="ON")
  8530. B    
  8531.  "Data":
  8532. set_icon(csvW%,4,(C$="ON" 
  8533. selected(csvW%,1)))
  8534. /    
  8535.  "Display":
  8536. set_icon(csvW%,11,C$="ON")
  8537. -    
  8538.  "Strip":
  8539. set_icon(csvW%,16,C$="ON")
  8540. .    
  8541.  "NewSeq":
  8542. set_icon(csvW%,23,C$="ON")
  8543. shade(csvW%,4,(
  8544. selected(csvW%,1)))
  8545. close_file(F)
  8546. save_csv_options(f$)
  8547.  F,C$
  8548. selected(csvW%,0) 
  8549.  C$="ON" 
  8550.  C$="OFF"
  8551. #F,"Quotes "+C$
  8552. selected(csvW%,1) 
  8553.  C$="ON" 
  8554.  C$="OFF"
  8555. #F,"Header "+C$
  8556. selected(csvW%,2) 
  8557.  C$="ON" 
  8558.  C$="OFF"
  8559. #F,"Blanks "+C$
  8560. selected(csvW%,3) 
  8561.  C$="ON" 
  8562.  C$="OFF"
  8563. #F,"Key "+C$
  8564. selected(csvW%,22) 
  8565.  C$="ON" 
  8566.  C$="OFF"
  8567. #F,"RecNo "+C$
  8568. selected(csvW%,4) 
  8569.  C$="ON" 
  8570.  C$="OFF"
  8571. #F,"Data "+C$
  8572.  sep$ 
  8573.  ",":C$="Comma"
  8574. (9):C$="TAB"
  8575. (10):C$="LF"
  8576. (13):C$="CR"
  8577. :C$=sep$
  8578. #F,"Separator "+C$
  8579.  term$ 
  8580. (13):C$="CR"
  8581. (10):C$="LF"
  8582. (13)+
  8583. (10):C$="CR LF"
  8584. (10)+
  8585. (13):C$="LF CR"
  8586. (13)+
  8587. (13):C$="CR CR"
  8588. (10)+
  8589. (10):C$="LF LF"
  8590. :C$=term$
  8591. #F,"Terminator "+C$
  8592. selected(csvW%,11) 
  8593.  C$="ON" 
  8594.  C$="OFF"
  8595. #F,"Display "+C$
  8596. selected(csvW%,16) 
  8597.  C$="ON" 
  8598.  C$="OFF"
  8599. #F,"Strip "+C$
  8600. selected(csvW%,23) 
  8601.  C$="ON" 
  8602.  C$="OFF"
  8603. #F,"NewSeq "+C$
  8604. close_file(F)
  8605.  "OS_File",18,f$,&fff
  8606. open_index(f$,key%,merge%)
  8607.  keybase%,I%
  8608.  key%>MaxKeys% 
  8609.  merge% 
  8610.  extrakeys$+=
  8611. leaf(f$)+",":Keys%-=1:
  8612.  keyanchor%(key%) 
  8613. scrap_sliding_block(keyanchor%(key%))
  8614.  "OS_File",5,f$ 
  8615.  ,,,,len%
  8616. create_named_sliding_block(keyanchor%(key%),len%)
  8617.  "OS_File",255,f$,!keyanchor%(key%)
  8618. Index$(key%)=
  8619. leaf(f$)
  8620. keybase%=!keyanchor%(key%)
  8621.  key%=0 
  8622.  I%=0 
  8623.  %    $Date%(I%)=$(keybase%+8+9*I%)
  8624. KL%(key%)=keybase%?70
  8625.  I%=0 
  8626. %&  KW%(key%,I%)=!(keybase%+74+I%*4)
  8627. &+  KF%(key%,I%)=(KW%(key%,I%)>>24) 
  8628. (!case%(key%)=(keybase%?71=255)
  8629. )%incspace%(key%)=(keybase%?72=255)
  8630. *!null%(key%)=(keybase%?73=255)
  8631.  keybase%!62>0 
  8632.  ### Old key structure applies ###
  8633.   words%=
  8634.  I%=0 
  8635.  KW%(key%,I%)>0 
  8636. 0"      KF%(key%,I%)=keybase%!62
  8637. 1K      KW%(key%,I%)=!(keybase%+74+I%*4)+((I%+1)<<16)+((keybase%!62)<<24)
  8638.       words%=
  8639. 3        
  8640.  words% 
  8641.  KF%(key%,0)=keybase%!62:KW%(key%,0)=KL%(key%)+((keybase%!62)<<24)
  8642.  keybase%!66>0 
  8643.  I%=1 
  8644.       
  8645.  KW%(key%,I%)>0 
  8646. 9$        KF%(key%,I%)=keybase%!66
  8647. :I        KW%(key%,I%)=!(keybase%+74+I%*4)+(I%<<16)+((keybase%!66)<<24)
  8648.       
  8649. get_tables
  8650.  lk,F%,d%,R4%,f$,name$,subst%,field%,exact%
  8651. C$f$=$database%+".ValTables":R4%=0
  8652. close_file(lk):
  8653. wimp_error(
  8654. ($database%+".Link")
  8655.  lk>0 
  8656.   !block%=mainW%
  8657.     F%+=1
  8658. #lk,link$(F%)
  8659.     name$=link$(F%)
  8660. M-    field%=
  8661. trailing_number(name$,exact%)
  8662. name$,1)="@" 
  8663.       
  8664.  chartype%(F%)=44 
  8665.         file$=
  8666. name$,2)
  8667. Q,        
  8668.  "OS_File",5,file$ 
  8669.  d%,,type%
  8670. R#        type%=(type%>>8) 
  8671.  &fff
  8672. S:        $
  8673. val(mainW%,field%(F%))="R5;Sfile_"+
  8674. ~(type%)
  8675.       
  8676.       
  8677.       
  8678.  name$<>"" 
  8679. W)        subst%=
  8680. leading_number(name$)
  8681. X,        
  8682.  "OS_File",5,f$+"."+name$ 
  8683.         
  8684.  d%=1 
  8685. Z)          
  8686. load_table(f$+"."+name$,
  8687. [8          
  8688. set_icon_cols(mainW%,field%(F%),fcol%(8))
  8689. \$          
  8690. softerror(name$,31)
  8691.         
  8692.       
  8693. _        
  8694.   link$(0)="LOADED"
  8695. close_file(lk)
  8696.  ### Force loading of unlinked but flagged tables ###
  8697.  R4%<>-1
  8698.  "OS_GBPB",9,f$,block%,1,R4%,11 
  8699.  ,,name$,,R4%
  8700.  R4%<>-1 
  8701. name$)="!" 
  8702. load_table(f$+"."+name$,
  8703.  extratabs$<>"" 
  8704. softerror(
  8705. extratabs$),97)
  8706. load_calcs
  8707.  I%,F%,F1%,P%,calc$,file%,top
  8708. update$()=""
  8709. ($database%+".Calc")
  8710.  cl>0 
  8711. s+    F%+=1:F$=
  8712. ~(F%):
  8713.  F%<16 
  8714.  F$="0"+F$
  8715. t"    
  8716. #cl,calc$:calc$(F%)=calc$
  8717.  chartype%(F%) 
  8718.       
  8719.  6,7:
  8720.       
  8721. x!        P%=
  8722. calc$,"$Rf%(",P%)
  8723. y?        
  8724.  P%>0 
  8725.  F1%=
  8726. calc$,P%+5)):update$(F1%)+=F$:P%+=5
  8727.       
  8728.  P%=0
  8729.       
  8730. |         P%=
  8731. calc$,"FNn(",P%)
  8732. }?        
  8733.  P%>0 
  8734.  F1%=
  8735. calc$,P%+4)):update$(F1%)+=F$:P%+=4
  8736.       
  8737.  P%=0
  8738. .      
  8739. calc$,"TIME$")>0 
  8740.  update$(0)+=F$
  8741.         
  8742.   calc$(0)="LOADED"
  8743. close_file(cl)
  8744. selected(prefsW%,14) 
  8745.  update$(0)<>"" 
  8746. ,  dbasehandle%=
  8747. ($database%+".Database")
  8748.  "Hourglass_On"
  8749.  file%=0 
  8750.     top=8*file%+LH%
  8751. !    P%=
  8752. neighbour(key%,top,1)
  8753. ,    
  8754. scan_file("P%<>top",key%,file%,6,1)
  8755.  file%
  8756.  "Hourglass_Off"
  8757. close_file(dbasehandle%)
  8758.  I%=1 
  8759.  fields%
  8760.     $Rf%(I%)=field$(I%)
  8761. redraw(mainW%)
  8762. get_form(
  8763.  Fptr%)
  8764.  F,L%,N%,I%,V%,x%,y%,xlim%,ylim%,text%
  8765.  design% 
  8766.  dval%=hand%:func%=1 
  8767.  dval%=-1:func%=0
  8768. ($database%+".Form")
  8769.  F>0 
  8770. #F,N%
  8771.  N%>127 
  8772.  fatal_err%,
  8773. msg("Err98")
  8774. 2  formlen%=&100:forminc%=formlen%:form_incs%=0
  8775. extend_named_sliding_block(formanchor%,formlen%)
  8776. 9  Fptr%=!formanchor%:Rf%(0)=Fptr%:$Rf%(0)="":Fptr%+=1
  8777.   Length%=0
  8778.  I%=1 
  8779. @    
  8780. #F,Desc$,Tag$(I%),xd%,yd%,xf%,yf%,len%,char%,fix%,bbox%
  8781. .    
  8782.  char%>=128 
  8783.  hide%?I%=1 
  8784.  hide%?I%=0
  8785.     char%=char% 
  8786. B      
  8787.  hide%?I%=1:dflg%=(winback%<<28)+(winback%<<24)+&016711
  8788. 2      
  8789.  Desc$="":dflg%=(winback%<<28)+&7016711
  8790. )      
  8791. :dflg%=(winback%<<28)+&7016731
  8792.         
  8793. /      
  8794.  bbox%=0 
  8795.  len%=0:width%=0:height%=0
  8796. 0      
  8797.  bbox%=0:width%=len%*16+16:height%=48
  8798. @      
  8799.  bbox%<&10000 
  8800.  bbox%>0:width%=bbox%*16+16:height%=48
  8801. 2      
  8802. :width%=bbox% 
  8803.  &FFFF:height%=bbox%>>16
  8804.         
  8805.  design% 
  8806.       
  8807.  char% 
  8808. 1        
  8809.  0,1,2,3,4,5,6,7,8,39,40:fval%=hand%
  8810. "        
  8811. :fval%=hvalid%(char%)
  8812.       
  8813.       
  8814.       
  8815.  vtype$(char%) 
  8816. .        
  8817.  "K":fval%=
  8818. val(keypadW%,char%-9)
  8819.         
  8820.  "O":
  8821.         
  8822.  char%=44 
  8823. #          fval%=Fptr%:Fptr%+=16
  8824. !          $fval%="R5;Saction"
  8825. #          
  8826.  fval%=valid%(char%)
  8827.         
  8828. !        
  8829. :fval%=valid%(char%)
  8830.       
  8831.         
  8832. "    x%=xf%+width%+32:y%=yf%-16
  8833.  x%>xlim% 
  8834.  xlim%=x%
  8835.  y%<ylim% 
  8836.  ylim%=y%
  8837. '    y%=yd%-16:
  8838.  y%<ylim% 
  8839.  ylim%=y%
  8840.     Length%+=len%+1
  8841. F    
  8842.  design%=
  8843.  char%=39 
  8844.  len%=(height% 
  8845.  40)*((width% 
  8846.  16)-4)
  8847. 7    len%(I%)=len%:chartype%(I%)=char%:fix%(I%)=fix%
  8848.     L%=
  8849. (Desc$)
  8850. 1    
  8851.  Fptr%-!formanchor%+L%+len%+2>formlen% 
  8852. *      form_incs%+=1:formlen%+=forminc%
  8853. ;      
  8854. extend_named_sliding_block(formanchor%,formlen%)
  8855.         
  8856.     $Fptr%=Desc$
  8857. S    desc%(I%)=
  8858. create_icon(mainW%,xd%,yd%,L%*16+8,44,dflg%,"",Fptr%,dval%,L%+1)
  8859. -    Fptr%+=L%+1:Rf%(I%)=Fptr%:$Rf%(I%)=""
  8860. 0    
  8861. icon_design(char%,func%,width%,height%)
  8862. H    
  8863.  char%=59 
  8864.  fval%=!logoanchor%:$Fptr%=Tag$(I%):len%=
  8865. (Tag$(I%))
  8866. \    field%(I%)=
  8867. create_icon(mainW%,xf%,yf%,width%,height%,iflags%,"",Fptr%,fval%,len%+1)
  8868.  char% 
  8869. j      
  8870.  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%
  8871. 6      
  8872.  40:Rf%(I%)=
  8873. create_anchor("Picture"+
  8874. (I%))
  8875. ?      
  8876.  3,6,46,47,54,56,57:
  8877. icon_bit(9,mainW%,field%(I%),
  8878.         
  8879.     Fptr%+=len%+1
  8880. close_file(F)
  8881. extend_named_sliding_block(formanchor%,Fptr%-!formanchor%):form_incs%+=1
  8882.   numericfields%=0
  8883. setup_select(N%,numericfields%)
  8884.  N%=0
  8885. 7!block%=0:block%!4=ylim%:block%!8=xlim%:block%!12=0
  8886.  "Wimp_SetExtent",mainW%,block%
  8887. Tag$(0)="REC"
  8888. get_winpos
  8889.  F,x%,y%,w%,h%,xs%,ys%
  8890. getscreensize(ScreenWidth%,ScreenHeight%,Vpix%)
  8891. ($database%+".Winpos")
  8892.  present%<7 
  8893. *  w%=ScreenWidth%*2:h%=ScreenHeight%*2
  8894.   x%=0:y%=0:xs%=0:ys%=0
  8895. 4  !block%=0:block%!4=-h%:block%!8=w%:block%!12=0
  8896.  "Wimp_SetExtent",mainW%,block%
  8897. position_window(mainW%,x%,y%,w%,h%,xs%,ys%)
  8898.  F>0 
  8899. #F,x%,y%,w%,h%,xs%,ys%
  8900. 4    
  8901. position_window(mainW%,x%,y%,w%,h%,xs%,ys%)
  8902. open_window(mainW%)
  8903. selected(passW%,9) 
  8904.  F>0 
  8905. !      
  8906. #F,x%,y%,w%,h%,xs%,ys%
  8907. 8      
  8908. position_window(keypadW%,x%,y%,w%,h%,xs%,ys%)
  8909. 5      
  8910. position_window(keypadW%,100,50,0,0,0,0)
  8911.         
  8912. close_file(F)
  8913. save_winpos
  8914.  F,x%,y%,w%,h%,xs%,ys%
  8915. ($database%+".Winpos")
  8916. 3!block%=mainW%:
  8917.  "Wimp_GetWindowState",,block%
  8918. Wx%=block%!4:y%=block%!8:w%=block%!12-x%:h%=block%!16-y%:xs%=block%!20:ys%=block%!24
  8919. #F,x%,y%,w%,h%,xs%,ys%
  8920. 5!block%=keypadW%:
  8921.  "Wimp_GetWindowState",,block%
  8922. Wx%=block%!4:y%=block%!8:w%=block%!12-x%:h%=block%!16-y%:xs%=block%!20:ys%=block%!24
  8923. #F,x%,y%,w%,h%,xs%,ys%
  8924. close_file(F)
  8925. position_window(wi%,x%,y%,w%,h%,xs%,ys%)
  8926.  "Wimp_GetCaretPosition",,block%:oldwin%=!block%:oldicon%=block%!4
  8927. getscreensize(ScreenWidth%,ScreenHeight%,Vpix%)
  8928. 0!block%=wi%:
  8929.  "Wimp_GetWindowState",,block%
  8930.  w%=0 
  8931.  w%=block%!12-block%!4
  8932.  h%=0 
  8933.  h%=block%!16-block%!8
  8934.  0:x%=(ScreenWidth%-w%) 
  8935.  -1:x%=block%!4
  8936.  0: y%=(ScreenHeight%-h%) 
  8937.  -1:y%=block%!8
  8938. block%!4=x%:block%!12=x%+w%
  8939. block%!8=y%:block%!16=y%+h%
  8940. block%!20=xs%:block%!24=ys%
  8941. block%!28=-1
  8942. open_it(wi%)
  8943. open_at(
  8944.  flag%,wi%,butt%,ww%,wh%,iw%,ih%)
  8945.  x%,y%,vxmin%,vymax%,scrollx%,scrolly%
  8946.  flag% 
  8947. $5  !block%=mainW%:
  8948.  "Wimp_GetWindowState",,block%
  8949. %L  vxmin%=block%!4:vymax%=block%!16:scrollx%=block%!20:scrolly%=block%!24
  8950. &Z  !block%=mainW%:block%!4=field%(buttonfield%(0,butt%)):
  8951.  "Wimp_GetIconState",,block%
  8952. '?  x%=block%!16-scrollx%+vxmin%:y%=block%!20-scrolly%+vymax%
  8953. (2  !block%=wi%:
  8954.  "Wimp_GetWindowState",,block%
  8955. )6  block%!4=x%-(ww%+iw%) 
  8956.  2:block%!12=block%!4+ww%
  8957. *6  block%!8=y%-(wh%+ih%) 
  8958.  2:block%!16=block%!8+wh%
  8959. +   block%!28=-1:
  8960. open_it(wi%)
  8961.   flag%=
  8962. open_window(wi%)
  8963. setup_select(fields%,
  8964.  rows%)
  8965.  S$,I%,J%,Fptr%
  8966. 3&selectlen%=&200:selinc%=selectlen%
  8967. create_named_sliding_block(selanchor%,selectlen%)
  8968. Fptr%=!selanchor%
  8969.  I%=1 
  8970.  fields%
  8971.  Fptr%-!selanchor%+144>selectlen% 
  8972.     selectlen%+=selinc%
  8973. 9:    
  8974. extend_named_sliding_block(selanchor%,selectlen%)
  8975.  chartype%(I%) 
  8976.  3,6,8,46,47,54,56,57:
  8977. ="    rows%+=1:
  8978. lit(printM%,5,
  8979. >V    handle%=
  8980. create_icon(pselectW%,8,-rows%*48-56,144,48,&17000531,"",Fptr%,-1,15)
  8981. ?9    S$=$
  8982. text(mainW%,desc%(I%)):
  8983. (S$)>8 
  8984. S$,8)
  8985. @$    $Fptr%=S$:Fptr%+=
  8986. ($Fptr%)+1
  8987. AW    handle%=
  8988. create_icon(pselectW%,160,-rows%*48-56,80,48,&17000531,"",Fptr%,-1,15)
  8989. B*    $Fptr%=Tag$(I%):Fptr%+=
  8990. ($Fptr%)+1
  8991.  J%=0 
  8992. Da      handle%=
  8993. create_icon(pselectW%,240+J%*88,-rows%*48-52,44,44,&0740B13B,"",Fptr%,tick%,1)
  8994.       $Fptr%="":Fptr%+=1
  8995.     calcrow%?I%=rows%
  8996. :calcrow%?I%=0
  8997. K#!block%=0:block%!4=-rows%*48-56
  8998. block%!8=740:block%!12=0
  8999.  "Wimp_SetExtent",pselectW%,block%
  9000. enable_row(R%,on%)
  9001.  R%>0 
  9002.  I%=R%*8+2 
  9003.  R%*8+7
  9004. T     
  9005. shade(pselectW%,I%,on%)
  9006. U)    
  9007.  on% 
  9008. deselect(pselectW%,I%)
  9009. save_form(f$)
  9010.  F,I%,xd%,yd%,xf%,yf%,w%,h%,bbox%,type%
  9011.  fields%=0 
  9012. Length%=0
  9013. !block%=mainW%
  9014. #F,fields%
  9015.  I%=1 
  9016.  fields%
  9017.  chartype%(I%)=39 
  9018.  len%(I%)=0
  9019. c(  dicon%=desc%(I%):ficon%=field%(I%)
  9020. d4  block%!4=dicon%:
  9021.  "Wimp_GetIconState",,block%
  9022. e   xd%=block%!8:yd%=block%!12
  9023.   Desc$=$(block%!28)
  9024. g4  block%!4=ficon%:
  9025.  "Wimp_GetIconState",,block%
  9026. h   xf%=block%!8:yf%=block%!12
  9027. i2  w%=block%!16-block%!8:h%=block%!20-block%!12
  9028.   bbox%=(h%<<16)+w%
  9029.   char%=chartype%(I%)
  9030.  hide%?I%=1 
  9031.  char%=char% 
  9032. #F,Desc$,Tag$(I%),xd%,yd%,xf%,yf%,len%(I%),char%,fix%(I%),bbox%
  9033.   Length%+=len%(I%)+1
  9034. oA  field$(I%)="":
  9035.  Rf%(I%)>0 
  9036.  chartype%(I%)<>40 
  9037.  $Rf%(I%)=""
  9038. close_file(F)
  9039.  "OS_File",18,f$,&7f2
  9040. lit(iconbarM%,3,
  9041. make_empty_index(RA%,key%,Z%)
  9042.  I%,K%,P%,KLM%,S$
  9043.  "Hourglass_On"
  9044. KL%(key%),".")
  9045. KLM%=KL%(key%)+13
  9046. P%=LH%+48+(RA%+1)*KLM%
  9047. create_named_sliding_block(keyanchor%(key%),P%)
  9048. keybase%=!keyanchor%(key%)
  9049. keybase%!0=138
  9050. keybase%!4=
  9051. ($Increment%)
  9052. $date%=
  9053. (1)):
  9054. date(key%)
  9055. keybase%!62=0:keybase%!66=0
  9056. keybase%?70=KL%(key%)
  9057. Ckeybase%?71=
  9058. selected(keyW%,30):case%(key%)=
  9059. selected(keyW%,30)
  9060. Gkeybase%?72=
  9061. selected(keyW%,35):incspace%(key%)=
  9062. selected(keyW%,35)
  9063. Ckeybase%?73=
  9064. selected(keyW%,37):null%(key%)=
  9065. selected(keyW%,37)
  9066.  I%=0 
  9067. (  !(keybase%+74+(I%*4))=KW%(key%,I%)
  9068.  I%=0 
  9069.   P%=I%*8+LH%
  9070.   !(keybase%+P%)=-P%
  9071.   !(keybase%+P%+4)=P%
  9072. P%=!keybase%
  9073.  I%=0 
  9074.  RA%-1
  9075.  "Hourglass_Percentage",(I%*100) 
  9076.   !(keybase%+P%)=P%+KLM%
  9077.   !(keybase%+P%+4)=0
  9078.   $(keybase%+P%+8)=S$
  9079. #  !(keybase%+P%+KL%(key%)+9)=I%
  9080.   P%+=KLM%
  9081. !(keybase%+P%)=0
  9082. !(keybase%+P%+4)=0
  9083. $(keybase%+P%+8)=S$
  9084.  !(keybase%+P%+KL%(key%)+9)=0
  9085.  "Hourglass_Off"
  9086. save_recs(f$,RA%)
  9087.  dbasehandle%,I%,J%,rec$
  9088. rec$=
  9089. fields%-1,
  9090. (10))
  9091.  "Hourglass_On"
  9092. dbasehandle%=
  9093.  I%=0 
  9094. #dbasehandle%=I%*Length%
  9095. #dbasehandle%,rec$
  9096.  "Hourglass_Percentage",(I%*100) 
  9097. #dbasehandle%=(RA%+1)*Length%
  9098. close_file(dbasehandle%)
  9099.  "OS_File",18,f$,&7f2
  9100.  "Hourglass_Off"
  9101. move_records(key%,file%,top)
  9102.  REC%,target$,action$,dest%,ex%,ptr%
  9103. target$=$Query%
  9104. Search$=
  9105. parse
  9106.  "Wimp_WhichIcon",moveW%,block%,&003F0000,&00210000
  9107. movetype%=!block%-1
  9108.  movetype%<>2 
  9109.  target$="" 
  9110.  target$=" all records from subfile "+
  9111. (file%) 
  9112.  target$=" from subfile "+
  9113. (file%)+" when "+target$
  9114.  movetype% 
  9115.  -1:action$="Move 
  9116. "+target$
  9117.  0:action$="Delete"+target$
  9118.  1:action$="Move 
  9119. "+target$
  9120.  2:dest%=
  9121. text(moveW%,6))
  9122.  target$="" 
  9123.  action$="Accumulate all records in subfile "+
  9124. (dest%) 
  9125.  action$="Accumulate records in subfile "+
  9126. (dest%)+" when "+target$
  9127. confirm(action$) 
  9128.  "Hourglass_On"
  9129. *dbasehandle%=
  9130. ($database%+".Database")
  9131. earmark(movetype%=2,file%,top)
  9132. close_file(dbasehandle%)
  9133. ptr%=!tempanchor%
  9134.  REC%=0 
  9135.  RA%-1
  9136. 6  ex%+=1:
  9137.  "Hourglass_Percentage",(ex%*100) 
  9138.  movetype% 
  9139.     file%=ptr%?REC%
  9140. %    
  9141.  dest%<>file% 
  9142.  file%<>255 
  9143. *      
  9144. read(fields%,
  9145. ,REC%,$database%)
  9146.       
  9147.  key%=0 
  9148.  Keys%
  9149.         top=8*file%+LH%
  9150.         N$=key$(key%)
  9151. ?        
  9152. delete(N$,key%):date%?file%=1:$Date%(file%)=
  9153. today
  9154.         top=8*dest%+LH%
  9155. ?        
  9156. insert(N$,key%):date%?dest%=1:$Date%(dest%)=
  9157. today
  9158.       
  9159.  key%
  9160.         
  9161.  ptr%?REC%<>255 
  9162. *      
  9163. read(fields%,
  9164. ,REC%,$database%)
  9165. '      addr=
  9166. shift(movetype%,key%,0)
  9167.         
  9168.  REC%
  9169. scrap_sliding_block(tempanchor%)
  9170.  "Hourglass_Off"
  9171. export_subset(f$)
  9172.  I%,F,R%,recs%,ptr%,count%,subtotal%,blobs%,ex%,Z%,len%,source$,dest$,O$,REC%
  9173.  "OS_CLI","Copy "+$database%+".Form "+f$+".Form ~C~V"
  9174.  link$(0)="LOADED" 
  9175.  "OS_CLI","Copy "+$database%+".Link "+f$+".Link ~C~V"
  9176.  calc$(0)="LOADED" 
  9177.  "OS_CLI","Copy "+$database%+".Calc "+f$+".Calc ~C~V"
  9178.  "OS_CLI","Copy "+$database%+".ValTables "+f$+".Valtables ~C~VR"
  9179.  "OS_CLI","Copy "+$database%+".Cols "+f$+".Cols ~CF~V"
  9180.  "OS_File",5,$database%+".UserFuncs" 
  9181.  d%=1 
  9182.  "OS_CLI","Copy "+$database%+".UserFuncs "+f$+".UserFuncs ~CF~V"
  9183.  "OS_File",5,$database%+".UsrSprites" 
  9184.  d%=1 
  9185.  "OS_CLI","Copy "+$database%+".UsrSprites "+f$+".UsrSprites ~CF~V"
  9186.  "OS_CLI","Copy "+$database%+".!Run "+f$+".!Run ~CF~V"
  9187.  "Hourglass_On"
  9188. "blobs%=
  9189. find_blobs($database%)
  9190. Search$=
  9191. parse
  9192. *dbasehandle%=
  9193. ($database%+".Database")
  9194. earmark(
  9195. ,file%,top)
  9196. (f$+".Database")
  9197. ptr%=!tempanchor%
  9198. %subtotal%=
  9199. count_recs(key%,zero%)
  9200.  I%=0 
  9201.  RA%-1
  9202.  ptr%?I%<>255 
  9203.     ex%=-1
  9204.  ex%<blobs%
  9205.       ex%+=1:F%=Ext%(ex%)
  9206. @      
  9207. copy_blob($database%,f$,I%,recs%,F%,F%,chartype%(F%))
  9208.         
  9209. <    
  9210. readsmarray(dbasehandle%,I%):
  9211. writesmarray(F,recs%)
  9212.     count%+=1
  9213. :    
  9214.  "Hourglass_Percentage",(count%*100) 
  9215.  subtotal%
  9216. scrap_sliding_block(tempanchor%)
  9217. =F$()="":
  9218. writesmarray(F,recs%):
  9219. #F=Length%*recs%:recs%-=1
  9220.  K%=0 
  9221.  Keys%
  9222.   KL%(MaxKeys%+1)=KL%(K%)
  9223.  I%=0 
  9224. %    KF%(MaxKeys%+1,I%)=KF%(K%,I%)
  9225. %    KW%(MaxKeys%+1,I%)=KW%(K%,I%)
  9226. make_empty_index(recs%,MaxKeys%+1,
  9227.  REC%=0 
  9228.  recs%-1
  9229. readsmarray(F,REC%)
  9230.     KEY$=
  9231. key2(K%,1)
  9232.      
  9233. insert(KEY$,MaxKeys%+1)
  9234. 4    
  9235.  "Hourglass_Percentage",(REC%*100) 
  9236.  recs%
  9237.  REC%
  9238. &  keybase%=!keyanchor%(MaxKeys%+1)
  9239.  "SlidingHeap_DescribeBlock",slidingheapbase%,keyanchor%(MaxKeys%+1) 
  9240.  ,,filelength%
  9241.  K%>0 
  9242.  index$="Indices." 
  9243.  index$=""
  9244.  "OS_File",10,f$+"."+index$+Index$(K%),&7f0,,keybase%,keybase%+filelength%
  9245. scrap_sliding_block(keyanchor%(MaxKeys%+1))
  9246. close_file(F)
  9247. close_file(dbasehandle%)
  9248.  "OS_File",18,f$+".Database",&7f2
  9249. export%=
  9250.  "Hourglass_Off"
  9251. close_it(savesubW%)
  9252. find_blobs(f$)
  9253.  N%,R4%,S$
  9254.     N%=-1
  9255.  R4%<>-1
  9256.  "OS_GBPB",9,f$,block%,1,R4%,11 
  9257.  ,,S$,,R4%
  9258. S$,4) 
  9259. !)    
  9260.  "Memo":N%+=1:Ext%(N%)=
  9261. S$,5))
  9262. ")    
  9263.  "Draw":N%+=1:Ext%(N%)=
  9264. S$,5))
  9265. #)    
  9266.  "Spri":N%+=1:Ext%(N%)=
  9267. S$,7))
  9268. earmark(all%,file%,top)
  9269.  I%,P%
  9270.  tempanchor% 
  9271. scrap_sliding_block(tempanchor%)
  9272. create_named_sliding_block(tempanchor%,RA%)
  9273. ptr%=!tempanchor%
  9274.  I%=0 
  9275.  RA%-1
  9276.   ptr%?I%=255
  9277.  "Hourglass_On"
  9278.  all% 
  9279.  file%=0 
  9280.     top=8*file%+LH%
  9281. 4!    P%=
  9282. neighbour(key%,top,1)
  9283. 5,    
  9284. scan_file("P%<>top",key%,file%,2,1)
  9285.  file%
  9286.   P%=
  9287. neighbour(key%,top,1)
  9288. scan_file("P%<>top",key%,file%,2,1)
  9289.  "Hourglass_Off"
  9290. rotate
  9291.  Access% 
  9292. confirm(
  9293. msg("Err49"))=
  9294.  keybase%
  9295.  I%,L%,Z%,Q%,R%,S%,key%
  9296.  key%=0 
  9297.  Keys%
  9298. D   keybase%=!keyanchor%(key%)
  9299.   S%=LH%+40
  9300.   Z%=keybase%!S%
  9301.  I%=S%-8 
  9302.  S%-40 
  9303. H)    L%=keybase%!I%:R%=keybase%!(I%+4)
  9304. I=    
  9305.  L%>0 
  9306.  keybase%!(I%+8)=L% 
  9307.  keybase%!(I%+8)=-(I%+8)
  9308.  Z%>0 
  9309.  keybase%!(S%-40)=Z% 
  9310.  keybase%!(S%-40)=-(S%-40)
  9311.  I%=S%-40 
  9312.     Q%=I%-8
  9313.  Q%=S%-48 
  9314.  Q%=S%
  9315. O!    PR%=
  9316. neighbour(key%,I%,0)
  9317. P!    SU%=
  9318. neighbour(key%,I%,1)
  9319. Q'    
  9320.  PR%>S% 
  9321.  keybase%!(PR%+4)=-I%
  9322. R#    
  9323.  SU%>S% 
  9324.  keybase%!SU%=-I%
  9325.  key%
  9326. $date%=
  9327. asterisk(
  9328. write_log(-1,"Subfiles rotated")
  9329. create_index(key%)
  9330.  indexing% 
  9331.  printing% 
  9332.  Keys%=MaxKeys% 
  9333. softerror(
  9334. (Keys%),95):
  9335.  file%,top,P%,KEY$,REC%,val$,zero%,abort%,replace%,J%,I%
  9336. newkey%=0:f$=""
  9337.  J%=0 
  9338.  keyfield%(J%)>0 
  9339.  f$+=Tag$(keyfield%(J%))+"+"
  9340.  I%=0 
  9341. bC    
  9342.  keyfield%(J%)=KF%(0,I%) 
  9343.  keyfield%(J%)>0 
  9344.  KF%(0,I%)>0 
  9345. cF      
  9346. confirm(
  9347. msg("Err100,"+Tag$(keyfield%(J%))))=
  9348.  abort%=
  9349. d        
  9350.  abort% 
  9351. f$)="+" 
  9352. (f$)>10
  9353.   newkey%+=1
  9354.  Index$(newkey%)=f$ 
  9355.  newkey%>Keys%
  9356.  newkey%=key%:
  9357. softerror(f$,106):abort%=
  9358.  newkey%<=Keys%:
  9359. q)    
  9360. confirm(
  9361. msg("Err50,"+f$))=
  9362. r3      
  9363. scrap_sliding_block(keyanchor%(newkey%))
  9364.       replace%=
  9365.       
  9366.  abort%=
  9367. u        
  9368.  Keys%>MaxKeys%:Keys%-=1:
  9369. softerror(
  9370. (Keys%),95):abort%=
  9371. :Keys%=newkey%
  9372.  abort% 
  9373. copy_keydata(newkey%)
  9374. Index$(newkey%)=f$
  9375. |-f$=$database%+".Indices."+Index$(newkey%)
  9376. make_empty_index(RA%,newkey%,
  9377. lit(iconbarM%,2,
  9378. limit_actions(
  9379. abort_index(f$):
  9380. *dbasehandle%=
  9381. ($database%+".Database")
  9382. indexing%=
  9383. :Search$="TRUE"
  9384. update_stats
  9385.  "Hourglass_On"
  9386.  file%=0 
  9387.   top=file%*8+LH%
  9388.   P%=
  9389. neighbour(key%,top,1)
  9390.   val$=
  9391. type(newkey%)
  9392.  "Hourglass_On"
  9393. scan_file("P%<>top",key%,file%,4,1)
  9394.  file%
  9395.  "Hourglass_Off"
  9396. end_index
  9397. colour(newkey%,2)
  9398. asterisk(
  9399. write_log(-1,"Index "+Index$(newkey%)+" created")
  9400. abort_index(f$)
  9401. end_index
  9402.  replace% 
  9403. open_index(f$,newkey%,
  9404.  index%=newkey% 
  9405.  Keys%
  9406. )    Index$(newkey%)=Index$(newkey%+1)
  9407.  index%
  9408. scrap_sliding_block(keyanchor%(newkey%))
  9409.   Keys%-=1
  9410.   newkey%=0
  9411. softerror("",43)
  9412. wimp_error(
  9413. end_index
  9414.  "Hourglass_Smash"
  9415. indexing%=
  9416. limit_actions(Access%)
  9417.  "Wimp_CreateMenu",,-1
  9418. lit(iconbarM%,2,Modify%)
  9419. close_file(dbasehandle%)
  9420. shift(t%,k%,m%)
  9421.  a%,key%,fi%,I%,F$,action$,finished%
  9422.  Access% 
  9423. =addr
  9424.  REC%=RA% 
  9425. =addr
  9426.  t%=0 
  9427.  m%=1 
  9428. confirm(
  9429. msg("Err51"))=
  9430. =addr
  9431.  key%=0 
  9432.  Keys%
  9433.   N$=key$(key%)
  9434. delete(N$,key%)
  9435.  N$="*Failed*" 
  9436. =addr
  9437.  key%=k% 
  9438. next_match(addr,1,Filter$,finished%)
  9439.  t%=1 
  9440.  fi%=(file%+1) 
  9441.  t%=-1 
  9442.  fi%=(file%-1-6*(file%=0))
  9443.   top=8*fi%+LH%
  9444.  I%=1 
  9445.  fields%
  9446.       V%=chartype%(I%)
  9447.       
  9448.         
  9449.  36,39:
  9450. R        
  9451. blob_path(
  9452. ,$database%,REC%,I%,V%,F$)>=0 
  9453.  "OS_CLI","Delete "+F$
  9454.         
  9455.  9,37:
  9456. R        
  9457. blob_path(
  9458. ,$database%,REC%,I%,V%,F$)>=0 
  9459.  "OS_CLI","Delete "+F$
  9460.         
  9461. R        
  9462. blob_path(
  9463. ,$database%,REC%,I%,V%,F$)>=0 
  9464.  "OS_CLI","Delete "+F$
  9465.       
  9466. 7    
  9467. insert(N$,key%):date%?fi%=1:$Date%(fi%)=
  9468. today
  9469.   top=8*file%+LH%
  9470.   date%?file%=1
  9471.   $Date%(file%)=
  9472. today
  9473.  key%
  9474. selected(prefsW%,15) 
  9475. '    
  9476. read(fields%,
  9477. ,RA%,$database%)
  9478. $    
  9479. write_dbase(REC%,fields%,
  9480. &    action$=" Deleted and blanked"
  9481.  action$=" Deleted"
  9482. :action$=" ===> subfile "+
  9483. (fi%)
  9484. asterisk(
  9485. write_log(REC%,logentry$+action$)
  9486. type(key%)
  9487.  F%,V$
  9488.  key%>=0 
  9489.  F%=KF%(key%,0) 
  9490.  F%=-key%
  9491.  chartype%(F%) 
  9492.  3,6,46,47,54,56,57:V$="VAL"
  9493. confirm(string$)
  9494. !block%=255
  9495. $(block%+4)=string$+
  9496.  "Wimp_ReportError",block%,19,"Powerbase"+
  9497.  ,result%
  9498. =result%=1
  9499. getscreensize(
  9500.  S_Width%,
  9501.  S_Height%,
  9502.  Vpix%)
  9503.  H1%,V1%,H2%,V2%,End%
  9504. $H1%=0:V1%=4:H2%=8:V2%=12:End%=16
  9505. 9Mi%!H1%=4:Mi%!V1%=5:Mi%!H2%=11:Mi%!V2%=12:Mi%!End%=-1
  9506.  "OS_ReadVduVariables",Mi%,Mo%
  9507. )S_Width%=(1<<(Mo%!H1%))*((Mo%!H2%)+1)
  9508. *S_Height%=(1<<(Mo%!V1%))*((Mo%!V2%)+1)
  9509. Vpix%=Mo%!V2%+1
  9510. match(X%,Y%)
  9511. check_change
  9512. $Query%=""
  9513. redraw_icon(queryW%,0)
  9514. shade(matchW%,7,printorder$<>"")
  9515. position_window(matchW%,X%,Y%,0,0,0,0)
  9516. set_caret(queryW%,0)
  9517. text(helpW%,0)=Tag$(Match_tag%)
  9518. tick_one(fieldmenu%,0,fields%-1,Match_tag%-1)
  9519. redraw_icon(helpW%,0)
  9520. text(matchW%,1)="":
  9521. redraw_icon(matchW%,1)
  9522. matching%=
  9523.  List printing -----------------------------------------------------
  9524. print_this
  9525. %f$=$database%+".PrintRes.Default"
  9526.  "OS_File",5,f$ 
  9527.  d%,,type%
  9528.  d%=1 
  9529.  type%=&7f3 
  9530. load_selection(f$)
  9531. !old%=
  9532. selected_esg(printW%,3)
  9533. deselect(printW%,old%)
  9534. select(printW%,24)
  9535. mouse(0,0,4,matchW%,2)
  9536. clear_selection
  9537. deselect(printW%,24)
  9538. select(printW%,old%)
  9539. do_it(Search$,displayed%)
  9540.  printing% 
  9541.  zero%,P%,rec%,REC%,copy%
  9542.  Sum()
  9543.  Sum(numericfields%,5)
  9544. sorted%=
  9545. lit(listM%,1,
  9546. Form$=printorder$
  9547.  Form$="" 
  9548.  W%=0 
  9549.     F%=KF%(0,W%)
  9550.  F%>0 
  9551. !D      F$=
  9552. ~(F%):
  9553. (F$)=1 
  9554.  F$="0"+F$:
  9555. Form$,F$)=0 
  9556.  Form$+=F$
  9557.       
  9558. selected(matchW%,3) 
  9559. select(mainW%,field%(F%)):printorder$=Form$:
  9560. lit(printM%,6,
  9561. lit(printM%,7,
  9562. lit(mainM%,7,
  9563. selected(passW%,13))
  9564. #        
  9565. &#Heading$="":Hlongest%=0:Sum()=0
  9566.  numericfields%>0 
  9567.  I%=1 
  9568.  numericfields%
  9569.     Sum(I%,5)=10^30
  9570. ,+Count%=0:examined%=0:printed%=0:sums%=0
  9571. read_print_options
  9572. selected(printW%,40) 
  9573. find_max_lengths(displayed%) 
  9574.  maxlen%()=len%()
  9575. LenLine%=
  9576. include_fields
  9577. 0,numfirst%=
  9578. margin_warn:
  9579.  numfirst%<0 
  9580. list_head(0)
  9581.  "Wimp_GetPointerInfo",,block%
  9582. limit_actions(
  9583. lit(iconbarM%,2,0)
  9584. printing%=
  9585.  "OS_ReadMonotonicTime" 
  9586.  stime%
  9587. abort_printing:
  9588. 8*dbasehandle%=
  9589. ($database%+".Database")
  9590.  "Hourglass_On"
  9591.  displayed%>=0:
  9592. readsmarray(dbasehandle%,displayed%)
  9593.  format$="label" 
  9594.  copy%=1 
  9595.  labcopies%
  9596. ?(      
  9597. print_record(displayed%,addr)
  9598.  copy%
  9599. A(    
  9600. print_record(displayed%,addr)
  9601.  usekey%=-1:
  9602. D#  direc%=
  9603. selected(queryW%,4)+1
  9604. EN  P%=
  9605. neighbour(key%,top,direc%):
  9606. scan_file("P%<>top",key%,file%,1,direc%)
  9607.   kl%=
  9608. (useval$)
  9609. H#  P%=
  9610. search(useval$,usekey%,1)
  9611.  P%>=0 
  9612.  k$=useval$:
  9613. scan_file("P%<>top AND LEFT$(k$,kl%)=useval$",usekey%,file%,1,1)
  9614. end_printing
  9615. abort_printing
  9616. end_printing
  9617. softerror("",29)
  9618. wimp_error(
  9619. end_printing
  9620.  time%
  9621.  format$="label" 
  9622.  thislab%>0 
  9623. print_labels
  9624.  "OS_ReadMonotonicTime" 
  9625.  etime%
  9626. time%=etime%-stime%
  9627. selected(matchW%,3) 
  9628. text(matchW%,1)=
  9629. (printed%)+" found" 
  9630. text(matchW%,1)=
  9631. (time% 
  9632.  100)+"."+
  9633. (time% 
  9634.  100)+" sec"
  9635. redraw_icon(matchW%,1)
  9636.  "Hourglass_Smash"
  9637.  format$<>"label" 
  9638.  displayed%=-1 
  9639. total_list:
  9640. page_number
  9641.  reportdest$ 
  9642.  "Window":
  9643. selected(matchW%,3) 
  9644. screen_list
  9645. extend_named_sliding_block(textanchor%,Count%*LenLine%)
  9646.  "File":
  9647. close_file(texthandle%):
  9648.  "OS_File",18,f$,&fff
  9649. close_window(saveW%)
  9650.  "Printer":
  9651. hB  Start%=!textanchor%:End%=Start%+Count%*LenLine%+1:Type%=&fff
  9652. i)  $Start%=pitch$:?(End%-1)=0:?End%=12
  9653. j;  block%!0=256:block%!12=0:block%!16=&80142:block%!20=0
  9654. kD  block%!24=0:block%!28=0:block%!32=0:block%!36=0:block%!40=&fff
  9655.   $(block%+44)="List"
  9656.  "Wimp_SendMessage",18,block%,0
  9657. printing%=
  9658. :savetofile%=
  9659. lit(iconbarM%,2,Modify%)
  9660. limit_actions(Access%)
  9661. close_file(dbasehandle%)
  9662. write_log(-1,"List printed: "+query$)
  9663. find_max_lengths(displayed%)
  9664.  P%,k$
  9665. end_find_max:
  9666. maxlen%()=0
  9667. {*dbasehandle%=
  9668. ($database%+".Database")
  9669.  "Hourglass_On"
  9670.  "Hourglass_LEDs",%11
  9671.  displayed%>=0:
  9672. readsmarray(dbasehandle%,displayed%)
  9673. get_lengths
  9674.   usekey%=-1:
  9675. D  P%=
  9676. neighbour(key%,top,1):
  9677. scan_file("P%<>top",key%,file%,0,1)
  9678.   kl%=
  9679. (useval$)
  9680. #  P%=
  9681. search(useval$,usekey%,1)
  9682.  P%>=0 
  9683.  k$=useval$:
  9684. scan_file("P%<>top AND LEFT$(k$,kl%)=useval$",usekey%,file%,0,1)
  9685.  "Hourglass_LEDs",%00
  9686.  "Hourglass_Off"
  9687. close_file(dbasehandle%)
  9688. get_lengths
  9689.  I%,L%,F%,l%,Len%,F$,SF$
  9690. I%=-1:L%=
  9691. (Form$)-1
  9692.  I%<L%
  9693. "  I%+=2:F%=
  9694. fnum(
  9695. Form$,I%,2))
  9696. selected(printW%,11) 
  9697. /      F$=
  9698. expand(F$(F%),link$(F%),Len%,SF$)
  9699.       
  9700.  F$=F$(F%)
  9701.   l%=
  9702.  l%>maxlen%(F%) 
  9703.  maxlen%(F%)=l%
  9704. end_find_max
  9705.  "Hourglass_Smash"
  9706. close_file(dbasehandle%)
  9707. maxlen%()=len%()
  9708. softerror("",70)
  9709. wimp_error(
  9710. print_record(REC%,address%)
  9711.  I%,F%,N%,Z%,F$,SF$,Tab%,n$,y$,base%,pos%
  9712.  format$<>"label" 
  9713.  printed%+=1
  9714. selected(matchW%,3) 
  9715. -thisrow%=-1:base%=!lineanchor%:pos%=base%
  9716. heap_store(lineanchor%,LenLine%,0,pos%,0,margin$)
  9717.  I%=1 
  9718. (Form$)-1 
  9719.   F%=
  9720. fnum(
  9721. Form$,I%,2))
  9722.  format$="label" 
  9723.  newline%=
  9724.  newline%
  9725.   N%+=1
  9726. *    
  9727.  0:F$=
  9728. (REC%):F$=
  9729. (F$)," ")+F$
  9730. 3    
  9731.  MaxFields%+1:Z%=
  9732. rec_no(F$,key%,address%)
  9733. !    
  9734. selected(printW%,11) 
  9735. /      F$=
  9736. expand(F$(F%),link$(F%),Len%,SF$)
  9737.       
  9738. #      F$=F$(F%):Len%=len%(F%)+2
  9739.         
  9740.  chartype%(F%) 
  9741.       
  9742.  41,42,43,44,45:
  9743.       Z%=
  9744. no_yes(F%,n$,y$)
  9745. "      
  9746.  F$=" " 
  9747.  F$=y$ 
  9748.  F$=n$
  9749. !      
  9750.  3,6,8,46,47,54,56,57:
  9751. -      
  9752. sums(F$,calcrow%?F%,chartype%(F%))
  9753.       
  9754.  format$="vert" 
  9755. &        F$=
  9756. len%(F%)-
  9757. (F$)," ")+F$
  9758. %        
  9759. justify(F$,N%,N%-1)
  9760.       
  9761.         
  9762. selected(printW%,12) 
  9763. u(F$)
  9764.  chartype%(F%) 
  9765.  37:F$="<Sprite>"
  9766.  38:F$="<Drawfile>"
  9767.  format$ 
  9768.  "horiz","table":
  9769. >    
  9770. heap_store(lineanchor%,LenLine%,0,pos%,0,
  9771. tab(F$,N%))
  9772.  "vert":
  9773. R    
  9774. selected(printW%,2) 
  9775.  Head$=$
  9776. text(mainW%,(desc%(F%))) 
  9777.  Head$=Tag$(F%)
  9778. 8    Head$=margin$+
  9779. Tab%(1)-
  9780. (Head$)," ")+Head$+" : "
  9781. @    hdlen%=
  9782. (Head$):H$=
  9783. hdlen%," "):datlen%=
  9784. (F$):pos%=base%
  9785.  chartype%(F%) 
  9786. /      
  9787.  36,39:
  9788. print_memo(REC%,F%,Head$,F$)
  9789.       
  9790. :      
  9791. heap_store(lineanchor%,LenLine%,0,pos%,0,Head$)
  9792. %      
  9793.  hdlen%+datlen%<LenLine% 
  9794. 9        
  9795. heap_store(lineanchor%,LenLine%,0,pos%,0,F$)
  9796. :        
  9797. list_line(REC%,lineanchor%,hdlen%+datlen%,32)
  9798.         
  9799. A        L%=LenLine%-hdlen%-1:F$+=" ":H$=
  9800. hdlen%," "):first%=
  9801.         
  9802. (F$)>L%
  9803.           p%=1:q%=1
  9804.           
  9805.             p%=
  9806. F$," ",q%)
  9807. "            
  9808.  p%<=L% 
  9809.  q%=p%+1
  9810.           
  9811.  p%>L%
  9812. %          s$=
  9813. F$,q%-2):F$=
  9814. F$,q%)
  9815. #          
  9816.  first% 
  9817.  s$=H$+s$
  9818. ;          
  9819. heap_store(lineanchor%,LenLine%,0,pos%,0,s$)
  9820. :          
  9821. list_line(REC%,lineanchor%,hdlen%+
  9822. (s$),32)
  9823. !          pos%=base%:first%=
  9824.         
  9825.         pos%=base%:
  9826. <        
  9827. heap_store(lineanchor%,LenLine%,0,pos%,0,H$+F$)
  9828. 8        
  9829. list_line(REC%,lineanchor%,hdlen%+
  9830. (F$),32)
  9831.       
  9832.         
  9833. #    
  9834. extra_lines(linefeed%-1,0)
  9835.  "label":
  9836.  newline% 
  9837. n      
  9838.  (F$<>"" 
  9839. selected(labelW%,16)=
  9840.  thisrow%<=labrepl% 
  9841.  thisrow%+=1:Label$(thisrow%,thislab%)=F$
  9842.       
  9843. /      Label$(thisrow%,thislab%)+=spacer$+F$
  9844.         
  9845.  format$ 
  9846.  "horiz":
  9847. list_line(REC%,lineanchor%,pos%-base%,32)
  9848. extra_lines(linefeed%-1,0)
  9849.  "vert":
  9850. rule_off(45)
  9851.  "table":
  9852.   colpos%=pos%-base%
  9853. heap_store(lineanchor%,LenLine%,0,pos%,0,column$)
  9854. list_line(REC%,lineanchor%,pos%-base%,32)
  9855. extra_lines(linefeed%-1,colpos%)
  9856.  "label":
  9857. ,  Label$(labrepl%+1,thislab%)=
  9858. key2(0,1)
  9859. 3  thislab%+=1:
  9860.  thislab%>labup% 
  9861. print_labels
  9862.  format$<>"label" 
  9863.  (printed% 
  9864.  LinesPerPage%)=0 
  9865. selected(printW%,10)=
  9866.  displayed%=-1 
  9867. page_number
  9868. N    $(!lineanchor%)=margin$+
  9869. (12):
  9870. list_line(-1,lineanchor%,Lmargin%+1,32)
  9871. T    
  9872. list_head(1):
  9873. lit(listM%,1,
  9874. selected(printW%,10) 
  9875. selected(printW%,47))
  9876. page_number
  9877.  page%>0 
  9878. rule_off(32)
  9879. $  line$=margin$+"Page "+
  9880. (page%)
  9881. B  $(!lineanchor%)=line$:
  9882. list_line(-1,lineanchor%,
  9883. (line$),32)
  9884.   page%+=1
  9885. extra_lines(ex%,tab%)
  9886.  base%,pos%
  9887.  ex%>0
  9888.  tab% 
  9889. rule_off(32)
  9890. %    base%=!lineanchor%:pos%=base%
  9891.  I%=0 
  9892.  tab%-1
  9893.       pos%?I%=32
  9894.     pos%+=tab%
  9895.  :    
  9896. heap_store(lineanchor%,LenLine%,0,pos%,0,column$)
  9897. !2    
  9898. list_line(REC%,lineanchor%,pos%-base%,32)
  9899.   ex%-=1
  9900. print_memo(R%,F%,margin$,F$)
  9901.  text%,B%,F$,sp%,L%,rem$,base%,pos%,Line$,first%
  9902. blob_path(
  9903. ,$database%,R%,F%,36,F$)>=0 
  9904. *!  base%=!lineanchor%:first%=
  9905.   text%=
  9906. #text%
  9907. -&    Line$=margin$+rem$:L%=
  9908. (Line$)
  9909. .        
  9910.       B%=
  9911. #text%
  9912.       Line$+=
  9913. (B%):L%+=1
  9914.       
  9915.  B%=32 
  9916.  sp%=L%
  9917. 2)    
  9918.  B%=10 
  9919.  L%=LenLine%-3 
  9920. #text%
  9921. 4'      
  9922.  B%=10:rem$="":Line$=
  9923. Line$)
  9924.       
  9925. #text%:rem$=""
  9926. 62      
  9927. :rem$=
  9928. Line$,sp%+1):Line$=
  9929. Line$,sp%-1)
  9930. 7        
  9931.     pos%=base%
  9932. 98    
  9933. heap_store(lineanchor%,LenLine%,0,pos%,0,Line$)
  9934. :0    
  9935. list_line(REC%,lineanchor%,
  9936. (Line$),32)
  9937. ;4    
  9938.  first% 
  9939.  margin$=
  9940. (margin$)," "):first%=
  9941. close_file(text%)
  9942. inmemo(F%,s$)
  9943.  len%,found%,line$,base%,ptr%,case%
  9944. C*len%=
  9945. load_blob($database%,REC%,F%,36)
  9946.  len%>0 
  9947. E   case%=
  9948. selected(queryW%,1)
  9949. F   base%=!tempanchor%:ptr%=-1
  9950.     line$=""
  9951. I        
  9952. J&      ptr%+=1:line$+=
  9953. (base%?ptr%)
  9954. K"    
  9955. (line$)>250 
  9956.  ptr%=len%
  9957. L#    
  9958.  case% 
  9959.  line$=
  9960. u(line$)
  9961. M!    
  9962. line$,s$)>0 
  9963.  found%=
  9964.  ptr%=len%
  9965. =found%
  9966. wc(f$,t$)
  9967.  failed%,P%,Q%,F%,end%,c$,x$
  9968.  P%+=1
  9969.   c$=
  9970. t$,P%,1)
  9971. X(    
  9972.  "":end%=(Q%=F%):failed%=
  9973.  end%
  9974.  $wc%:
  9975.  P%+=1:Q%+=1
  9976.       c$=
  9977. t$,P%,1)
  9978.  c$<>$wc%
  9979.     P%-=1
  9980.  $ws%:
  9981.     R%=P%+1
  9982.  P%+=1
  9983.       c$=
  9984. t$,P%,1)
  9985. b#    
  9986.  c$=$ws% 
  9987.  c$=$wc% 
  9988.  c$=""
  9989.       
  9990.  "":end%=
  9991. e-      s$=
  9992. t$,R%):failed%=(
  9993. (s$))<>s$)
  9994.       
  9995.  $wc%,$ws%:
  9996. g7      s$=
  9997. t$,R%,P%-R%):Q%=
  9998. f$,s$,Q%):failed%=(Q%=0)
  9999. h9      Q%+=
  10000. (s$)-1:P%-=1:
  10001.  failed% 
  10002.  failed%=(Q%=F%)
  10003. i        
  10004.     Q%+=1:x$=
  10005. f$,Q%,1)
  10006.     failed%=(c$<>x$)
  10007.  end% 
  10008.  failed%
  10009.  failed%
  10010. print_labels
  10011.  I%,Line$,S$,linesprinted%,pos%
  10012. fixed_line($
  10013. text(labelW%,24))
  10014.  I%=0 
  10015.  labrepl%-1
  10016.   Line$=margin$
  10017.  K%=0 
  10018.  thislab%-1
  10019.     S$=Label$(I%,K%)
  10020. x!    
  10021. selected(labelW%,11) 
  10022. y9      
  10023.  I%=labsubst% 
  10024.  S$="" 
  10025.  S$=Label$(labrepl%,K%)
  10026. z        
  10027. {9    
  10028.  K%=thislab%-1 
  10029.  W%=longestfield% 
  10030.  W%=labwidth%
  10031. (S$)>W% 
  10032. S$,W%)
  10033. }     Line$+=S$+
  10034. (S$)," ")
  10035.   pos%=!lineanchor%
  10036. heap_store(lineanchor%,LenLine%,0,pos%,0,Line$)
  10037. list_line(REC%,lineanchor%,
  10038. (Line$),32)
  10039.   linesprinted%+=1
  10040. fixed_line($
  10041. text(labelW%,25))
  10042. selected(labelW%,13) 
  10043. rule_off(32)
  10044.   Line$=margin$
  10045.  K%=0 
  10046.  thislab%-1
  10047. (    S$="("+Label$(labrepl%+1,K%)+")"
  10048. 1    
  10049.  K%=thislab%-1 
  10050. (S$) 
  10051.  W%=labwidth%
  10052.      Line$+=S$+
  10053. (S$)," ")
  10054.   pos%=!lineanchor%
  10055. heap_store(lineanchor%,LenLine%,0,pos%,0,Line$)
  10056. list_line(REC%,lineanchor%,
  10057. (Line$),32)
  10058.   linesprinted%+=1
  10059. rows_printed%+=1
  10060.  rows_printed%=labrows% 
  10061. L  $(!lineanchor%)=margin$+
  10062. (12):
  10063. list_line(-1,lineanchor%,Lmargin%+1,32)
  10064. list_head(1)
  10065.   rows_printed%=0
  10066.  linesprinted%<labdepth%
  10067. rule_off(32)
  10068.     linesprinted%+=1
  10069. &thislab%=0:thisrow%=-1:Label$()=""
  10070. fixed_line(S$)
  10071.  K%,W%
  10072.  S$<>"" 
  10073.   Line$=margin$
  10074.  K%=0 
  10075.  thislab%-1
  10076. 9    
  10077.  K%=thislab%-1 
  10078.  W%=longestfield% 
  10079.  W%=labwidth%
  10080. (S$)>W% 
  10081. S$,W%)
  10082.      Line$+=S$+
  10083. (S$)," ")
  10084.   pos%=!lineanchor%
  10085. heap_store(lineanchor%,LenLine%,0,pos%,0,Line$)
  10086. list_line(REC%,lineanchor%,
  10087. (Line$),32)
  10088.   linesprinted%+=1
  10089. read_print_options
  10090. thislab%=0:LinesPerPage%=0
  10091.  usekey%=-1 
  10092.  S$=Index$(key%) 
  10093.  S$=Index$(usekey%)+" index"
  10094. Title1$="Ordered by "+S$
  10095. selected(printW%,19) 
  10096.  Title1$+=" ("+
  10097. $+")"
  10098. Title2$=$
  10099. text(printW%,18)
  10100. selected_esg(printW%,2) 
  10101.  4:cpi%=5:p$="3"
  10102.  7:cpi%=10:p$="0"
  10103.  8:cpi%=12:p$="1"
  10104.  6:cpi%=17:p$="2"
  10105. pitch$=
  10106. pitch(p$)
  10107. 3Lmargin%=
  10108. text(printW%,30)):Tab%(0)=Lmargin%
  10109. margin$=
  10110. Lmargin%," ")
  10111. "Tmargin%=
  10112. text(printW%,32))
  10113. #TextLine%=
  10114. text(printW%,34))
  10115. #linefeed%=
  10116. text(printW%,17))
  10117. #colwidth%=
  10118. text(printW%,45))
  10119. *s$=$
  10120. text(printW%,43):s%=
  10121. (s$):c$=
  10122.  s%=0:spacer$=s$
  10123.  c$<"0" 
  10124.  c$>"9":spacer$=
  10125. s%,c$)
  10126. :spacer$=
  10127. s%," ")
  10128.  linefeed%=0 
  10129.  linefeed%=1:$
  10130. text(printW%,17)=
  10131. (linefeed%)
  10132. %pagelength%=
  10133. text(printW%,16))
  10134.  pagelength%=0 
  10135.  pagelength%=70:$
  10136. text(printW%,16)=
  10137. (pagelength%)
  10138. selected_esg(printW%,3) 
  10139.   format$="horiz"
  10140. 9  LinesPerPage%=(pagelength%-Tmargin%-15) 
  10141.  linefeed%
  10142.  24:format$="vert"
  10143.  Form$<>"" 
  10144.  LinesPerPage%=(pagelength%-Tmargin%-15) 
  10145.  (linefeed%*(
  10146. (Form$) 
  10147.   format$="table"
  10148. $  columns%=
  10149. text(printW%,15))
  10150. 0  column$=
  10151. columns%,"|"+
  10152. colwidth%," "))+"|"
  10153. 9  LinesPerPage%=(pagelength%-Tmargin%-15) 
  10154.  linefeed%
  10155.   format$="label"
  10156. )  labwidth%=
  10157. text(labelW%,4))*cpi%
  10158. &  labdepth%=
  10159. text(labelW%,6))*6
  10160. 1  labrows%=(pagelength%-Tmargin%) 
  10161.  labdepth%
  10162.   rows_printed%=0
  10163. D  labup%=
  10164. selected_esg(labelW%,1):
  10165.  ### Value is 0,1,2 or 26 ###
  10166.  labup%=26 
  10167.  labup%=3
  10168. $  labrepl%=
  10169. text(labelW%,10))
  10170. '  labsubst%=
  10171. text(labelW%,12))-1
  10172. &  labcopies%=
  10173. text(labelW%,17))
  10174. %  Title$="":Title1$="":Title2$=""
  10175. selected_esg(printW%,4) 
  10176.  38:reportdest$="Window"
  10177.  39:reportdest$="File"
  10178.  41:reportdest$="Printer"
  10179. selected(printW%,54) 
  10180.  page%=1:LinesPerPage%-=2 
  10181.  page%=0
  10182.  LinesPerPage%<=0 
  10183.  LinesPerPage%=1
  10184. pitch(p$)
  10185. selected(printW%,42) 
  10186. (31)+"9"+p$+"01" 
  10187. list_head(place%)
  10188.  place%=0 
  10189.  reportdest$ 
  10190.  "Window","Printer":
  10191.     RU%=
  10192. ($used%)
  10193. O    
  10194.  RU%<5 
  10195.  textblocksize%=5*LenLine% 
  10196.  textblocksize%=(RU% 
  10197.  5)*LenLine%
  10198. $    textblockinc%=textblocksize%
  10199. ?    
  10200. extend_named_sliding_block(textanchor%,textblocksize%)
  10201.     TextPtr%=!textanchor%
  10202.     recblocksize%=400
  10203. =    
  10204. extend_named_sliding_block(recanchor%,recblocksize%)
  10205. %    
  10206.  "File":
  10207. #texthandle%,pitch$
  10208. extra_lines(Tmargin%,0)
  10209. selected(printW%,47) 
  10210.  header_lines%=Count%:
  10211.  displayed%=-1 
  10212. send_title(Title$)
  10213. send_title(Title1$)
  10214. send_title(Title2$)
  10215.  format$ 
  10216.  "horiz":
  10217. selected(printW%,29) 
  10218. V    
  10219. selected(printW%,42) 
  10220.  $(!lineanchor%)=uon$:
  10221. list_line(-1,lineanchor%,2,32)
  10222. .    
  10223. list_line(-1,headanchor%,LenLine%,32)
  10224. rule_off(45)
  10225. .    
  10226. list_line(-1,headanchor%,LenLine%,32)
  10227. rule_off(45)
  10228.  "table":
  10229. rule_off(32):$(TextPtr%-3)=uon$
  10230. rule_off(32)
  10231. list_line(-1,headanchor%,LenLine%,32)
  10232. rule_off(32)
  10233.  "vert":
  10234. rule_off(45)
  10235. header_lines%=Count%
  10236. list_line(REC%,anchor%,length%,char%)
  10237. Count%+=1
  10238.  reportdest$ 
  10239.  "Window","Printer":
  10240. pad_line(LenLine%-length%-1,char%)
  10241. heap_store(textanchor%,textblocksize%,textblockinc%,TextPtr%,LenLine%,"")
  10242.  "Wimp_TransferBlock",mytask%,!anchor%,mytask%,TextPtr%,LenLine%
  10243.  Count%*4>=recblocksize% 
  10244.     recblocksize%+=400
  10245. $=    
  10246. extend_named_sliding_block(recanchor%,recblocksize%)
  10247. &"  !(!recanchor%+Count%*4)=REC%
  10248.   TextPtr%+=LenLine%
  10249.  "File":
  10250. pad_line(LenLine%-length%-1,char%)
  10251.  "OS_GBPB",2,texthandle%,!anchor%,LenLine%
  10252. pad_line(bytes%,char%)
  10253.  base%,ptr%,I%
  10254. 1/base%=!anchor%:ptr%=base%+LenLine%-bytes%-1
  10255.  bytes%>0 
  10256.  I%=0 
  10257.  bytes%-2
  10258.     ptr%?I%=char%
  10259. ptr%?(bytes%-1)=32
  10260. ptr%?bytes%=10
  10261. rule_off(char%)
  10262.  base%
  10263. base%=!lineanchor%
  10264. $base%=margin$
  10265. list_line(-1,lineanchor%,Lmargin%,char%)
  10266. total_list
  10267. selected(printW%,48) 
  10268.  C%,L%,base%,pos%,L$
  10269. E#L$=margin$+"Total "+
  10270. (printed%)
  10271. F!base%=!lineanchor%:pos%=base%
  10272.  format$ 
  10273.  "horiz":
  10274. selected(printW%,29) 
  10275. rule_off(45)
  10276. ctotals(numfirst%)
  10277. (L$)>LenLine%-2 
  10278.  L$=margin$+
  10279. (printed%)
  10280. heap_store(lineanchor%,LenLine%,0,pos%,0,L$)
  10281. list_line(REC%,lineanchor%,pos%-base%,32)
  10282. selected(printW%,29) 
  10283. rule_off(45)
  10284.  "table":
  10285. rule_off(32)
  10286. extra_lines(linefeed%,colpos%)
  10287. ctotals(numfirst%)
  10288. (L$)>LenLine%-2 
  10289.  L$=margin$+
  10290. (printed%)
  10291. heap_store(lineanchor%,LenLine%,0,pos%,0,L$)
  10292. list_line(REC%,lineanchor%,pos%-base%,32)
  10293. selected(printW%,29) 
  10294. rule_off(45)
  10295.  "vert":
  10296. (L$)>LenLine%-2 
  10297.  L$=margin$+
  10298. (printed%)
  10299. heap_store(lineanchor%,LenLine%,0,pos%,0,L$)
  10300. list_line(REC%,lineanchor%,pos%-base%,32)
  10301. selected(printW%,29) 
  10302. rule_off(45)
  10303. lit(printM%,6,
  10304. send_title(T$)
  10305.  C$,L$,P%,L%
  10306.  T$="" 
  10307. L%=LenLine%-Lmargin%-1
  10308. (T$)>=L%
  10309.   P%=
  10310.     P%-=1:C$=
  10311. T$,P%,1)
  10312. "= ,.;:",C$)>0 
  10313.  P%<L%) 
  10314.  P%=0
  10315.  P%=0 
  10316. j'    L$=margin$+
  10317. T$,L%-1):T$=
  10318. T$,L%)
  10319. k)    
  10320.  L$=margin$+
  10321. T$,P%):T$=
  10322. T$,P%+1)
  10323.   $(!lineanchor%)=L$
  10324. list_line(-1,lineanchor%,
  10325. (L$),32)
  10326. $(!lineanchor%)=margin$+T$
  10327. list_line(-1,lineanchor%,Lmargin%+
  10328. (T$),32)
  10329. screen_list
  10330. u!!block%=0:block%!4=-Count%*36
  10331. v(block%!8=(LenLine%-1)*16:block%!12=0
  10332.  "Wimp_SetExtent",listW%,block%
  10333. !block%=listW%
  10334.  "Wimp_GetWindowState",,block%
  10335. z;x%=(block%!12+block%!4) 
  10336.  2:y%=(block%!16+block%!8) 
  10337. {"block%!12=block%!4+LenLine%*16
  10338.  Count%<28 
  10339. }"  block%!16=block%!8+Count%*36
  10340.   block%!16=block%!8+36*28
  10341.  "Wimp_CloseWindow",,block%
  10342. open_window(listW%)
  10343. Listed%=
  10344. lit(listM%,0,
  10345. selected(passW%,13))
  10346. show_menu(listM%,x%,y%)
  10347.  x%+256,y%-20
  10348. sort_list(N%)
  10349. >ind%=!textanchor%+LenLine%*header_lines%+Tab%(N%)-LenLine%
  10350.  I%=0 
  10351.  printed%-1
  10352.   ind%+=LenLine%
  10353.   block%!(I%*4)=ind%
  10354.  "OS_HeapSort",printed%,block%,4
  10355. extend_named_sliding_block(tempanchor%,printed%*LenLine%)
  10356. 3dest%=!tempanchor%-LenLine%:recptr%=!recanchor%
  10357.  I%=0 
  10358.  printed%-1
  10359.   recptr%!(I%*4)=-1
  10360. (  ind%=block%!(I%*4):dest%+=LenLine%
  10361.  "Wimp_TransferBlock",mytask%,ind%-Tab%(N%),mytask%,dest%,LenLine%
  10362.  "Wimp_TransferBlock",mytask%,!tempanchor%,mytask%,!textanchor%+LenLine%*header_lines%,printed%*LenLine%
  10363. scrap_sliding_block(tempanchor%)
  10364. redraw(listW%)
  10365. sorted%=
  10366. lose_list
  10367. close_window(listW%)
  10368. scrap_sliding_block(textanchor%)
  10369. scrap_sliding_block(recanchor%)
  10370. Listed%=
  10371. parse
  10372.  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%
  10373. !S$=$Query%:
  10374.  S$="" 
  10375.  S$="ALL"
  10376. (query$=S$:case%=
  10377. selected(queryW%,1)
  10378. usekey%=-1:useval$=""
  10379. stripspaces(S$)
  10380.  S$="" 
  10381. u(S$)="ALL" 
  10382.  Title$=
  10383. leaf($database%),2)+". All records":="TRUE"
  10384. simple%=
  10385. simple(S$)
  10386. S$+=" ":Title$=""
  10387. (S$)>0
  10388.   W$=
  10389. word(S$," ")
  10390.  W$="NOT" 
  10391. S$,1)<>"(" 
  10392.  moan_err%,
  10393. msg("Err60")
  10394. strip_brackets
  10395. (W$)>0 
  10396. *    flag%=
  10397. :TitFd$="":TitTg$="":op$=""
  10398. 5      
  10399.  "AND","OR","NOT":E$=W$:Title$+=" "+E$+" "
  10400. +      
  10401.  "&":E$="AND":Title$+=" "+E$+" "
  10402.       
  10403.       E$=""
  10404.       
  10405. split
  10406.       
  10407. (field$)>0
  10408. 0        f$=
  10409. word(field$,",")):f1%=0:f2%=0
  10410.         
  10411. <          
  10412.  f$="@":f1%=1:f2%=fields%:TitFd$="Any field "
  10413.           
  10414. f$,"-")>0:
  10415.           P%=
  10416. f$,"-")
  10417. %          f1%=
  10418. field(
  10419. f$,P%-1),
  10420. !          TitFd$=
  10421. TitFd$)+"-"
  10422. %          f2%=
  10423. field(
  10424. f$,P%+1),
  10425. $          
  10426.  f1%>f2% 
  10427.  f1%,f2%
  10428.           
  10429.           f1%=
  10430. field(f$,
  10431. !          f$="F$("+
  10432. (f1%)+")"
  10433. *          
  10434.  case% 
  10435.  f$="FNu("+f$+")"
  10436. 5          
  10437.  val% 
  10438.  instring% 
  10439.  f$="VAL("+f$+")"
  10440. !          
  10441.  chartype%(f1%) 
  10442. 5            
  10443.  5,51,52:f$="FNreverse_date("+f$+")"
  10444.           
  10445.         
  10446.         targ$=target$
  10447.         
  10448. (targ$)>0
  10449. '          t$=
  10450. word(targ$,","):u$=t$
  10451. C          
  10452.  flag% 
  10453.  TitTg$+=
  10454. expand(t$,link$(f1%),L%,SF$)+","
  10455. !          
  10456.  chartype%(f1%) 
  10457. 0            
  10458.  41,42,43,44,45:t$=
  10459. pos_neg(t$)
  10460. Z            
  10461.  5,51,52:
  10462. check_date(key%,t$,2,date$)=
  10463. reverse_date(date$):u$=t$
  10464.           
  10465. E          t$=""""+t$+"""":
  10466.  val% 
  10467.  instring% 
  10468.  t$="VAL("+t$+")"
  10469.           
  10470.  f2%>0 
  10471.             
  10472.  val% 
  10473. T              E1$="FNvany("+
  10474. (f1%)+","+
  10475. (f2%)+","+t$+","""+op$+""","""+bo$+""")"
  10476. U              
  10477.  E1$="FNany("+
  10478. (f1%)+","+
  10479. (f2%)+","+t$+","""+op$+""","""+bo$+""")"
  10480.             
  10481. 6            
  10482.  E1$=
  10483. element(op$,f1%,chartype%(f1%))
  10484.           
  10485. E          
  10486. (E$)+
  10487. (E1$)>255 
  10488.  moan_err%,
  10489. msg("Err6") 
  10490.  E$+=E1$
  10491. E          
  10492. (E$)+
  10493. (bo$)>255 
  10494.  moan_err%,
  10495. msg("Err6") 
  10496.  E$+=bo$
  10497.         
  10498.         flag%=
  10499.       
  10500.       E$=
  10501. (E$)-
  10502. (bo$))
  10503.       
  10504. E$,bo$)>0 
  10505. B        
  10506. (E$)>253 
  10507.  moan_err%,
  10508. msg("Err6") 
  10509.  E$="("+E$+")"
  10510.       
  10511.         
  10512. add_brackets
  10513.   E$+=" "
  10514. (search$)+
  10515. (E$)>255 
  10516.      
  10517.  moan_err%,
  10518. msg("Err6")
  10519.  search$+=E$
  10520. build_title
  10521. ,Title$=
  10522. leaf($database%),2)+". "+Title$
  10523.  usekey%>=0 
  10524.  kl%=KL%(usekey%):val$=
  10525. type(usekey%)
  10526. =search$
  10527. pos_neg(s$)
  10528.  "+","y","Y","*","
  10529. ","T","t","YES","Yes","yes","TRUE","True":s$=" "
  10530.  "-","n","N","x","X","F","f","NO","No","no","FALSE","False":s$=""
  10531. :s$="@"
  10532. simple(S$)
  10533. S$,"=")>0 
  10534. S$,",")=0 
  10535. S$,"-")=0 
  10536. S$,"OR")=0 
  10537. S$,"NOT")=0) 
  10538. word(
  10539.  S$,sep$)
  10540.  P%,W$,Q1%,Q2%
  10541. '  Q1%=
  10542. S$,""""):Q2%=
  10543. S$,"""",Q1%+1)
  10544.   P%=
  10545. S$,sep$,P%)
  10546. -    
  10547.  (P%>Q1% 
  10548.  P%<Q2%),(P%>Q2% 
  10549.  Q2%>0):
  10550. 5    S$=
  10551. S$,Q1%-1)+
  10552. S$,Q1%+1,Q2%-Q1%-1)+
  10553. S$,Q2%+1)
  10554. 9    P%=Q2%-1:
  10555.  ### S$ is now 2 characters shorter ###
  10556. )    
  10557.  Q1%>0 
  10558.  Q2%=0:
  10559. softerror("",93)
  10560.          S$=
  10561. S$,Q1%-1)+
  10562. S$,Q1%+1)
  10563.  Q1%+Q2%=0 
  10564.  P%<Q1%
  10565. S$,P%-1)
  10566. S$,P%+1)
  10567. S$,1)=sep$
  10568.   S$=
  10569. S$,2)
  10570. element(op$,f%,char%)
  10571.  op$ 
  10572.  "{":
  10573.  char% 
  10574. 5    
  10575.  36,39:E$="FNinmemo("+
  10576. (f%)+","+t$+")=TRUE "
  10577. %    
  10578. :E$="INSTR("+f$+","+t$+")>0"
  10579.  "}{":
  10580.  char% 
  10581. 6    
  10582.  36,39:E$="FNinmemo("+
  10583. (f%)+","+t$+")=FALSE "
  10584. %    
  10585. :E$="INSTR("+f$+","+t$+")=0"
  10586.  "=":
  10587.   E$=f$+op$+t$
  10588.  simple%=
  10589.  usekey%=-1 
  10590.     foundkey%=
  10591. is_a_key(f%)
  10592. $4    
  10593.  foundkey%>=0 
  10594.  KL%(foundkey%)=len%(f%) 
  10595. %&      usekey%=foundkey%:useval$=u$
  10596. &        
  10597.  "$":E$="FNwc("+f$+","+t$+")=TRUE "
  10598. ":E$="FNwc("+f$+","+t$+")=FALSE "
  10599. :E$=f$+op$+t$
  10600. vany(from%,to%,t%,op$,bo$)
  10601.  F%,found%,v%,bo%
  10602. bo%=(bo$="OR")
  10603. F%=from%-1
  10604.   F%+=1:v%=
  10605. (F$(F%))
  10606.  op$ 
  10607.  "=":found%=(v%=t%)
  10608.  "<>":found%=(v%<>t%)
  10609.  "<":found%=(v%<t%)
  10610.  ">":found%=(v%>t%)
  10611.  "<=":found%=(v%<=t%)
  10612.  ">=":found%=(v%>=t%)
  10613.  (bo%=found%) 
  10614.  F%=to%
  10615. =found%
  10616. any(from%,to%,t$,op$,bo$)
  10617.  F%,found%,f$,bo%,case%
  10618. case%=
  10619. selected(queryW%,1)
  10620. bo%=(bo$="OR")
  10621. F%=from%-1
  10622.   F%+=1:f$=F$(F%)
  10623.  case% 
  10624. u(f$)
  10625.  op$ 
  10626.  "{":
  10627.  chartype%(F%) 
  10628.       
  10629.  36,39:
  10630.       found%=
  10631. inmemo(F%,t$)
  10632.       
  10633. :found%=(
  10634. f$,t$)>0) 
  10635. M        
  10636.  "}{":
  10637.  chartype%(F%) 
  10638.       
  10639.  36,39:
  10640. Q#      found%=(
  10641. inmemo(F%,t$))
  10642.       
  10643. :found%=(
  10644. f$,t$)=0)
  10645. S        
  10646.  "=":found%=(f$=t$)
  10647.  "<>":found%=(f$<>t$)
  10648.  "<":found%=(f$<t$)
  10649.  ">":found%=(f$>t$)
  10650.  "<=":found%=(f$<=t$)
  10651.  ">=":found%=(f$>=t$)
  10652.  (bo%=found%) 
  10653.  F%=to%
  10654. =found%
  10655. split
  10656.  X$,Q%,I%,t$
  10657. `8X$=">=>=,<=<=,<>,}{,>=,<=,==,>>,<<,{{,=,<,>,{,":P%=0
  10658. (X$)>0 
  10659.  P%=0
  10660. b8  Q%=
  10661. X$,","):op$=
  10662. X$,Q%-1):X$=
  10663. X$,Q%+1):P%=
  10664. W$,op$)
  10665.  P%>0 
  10666.   field$=
  10667. W$,P%-1)
  10668. f   target$=
  10669. W$,P%+
  10670. (op$))+","
  10671.  case% 
  10672.  target$=
  10673. u(target$)
  10674.   field$+=","
  10675.  op$ 
  10676.  "<>","}{":bo$="AND"
  10677. kD    
  10678.  op$="<>" 
  10679. target$,$wc%)>0 
  10680. target$,$ws%)>0) 
  10681.  op$="
  10682.  "<=",">=":bo$="OR"
  10683.  "<=<=",">=>=":
  10684.     op$=
  10685. op$,2):bo$="AND"
  10686.  "==","<<",">>","{{":
  10687.     op$=
  10688. op$,1):bo$="AND"
  10689. :bo$="OR"
  10690. rC    
  10691.  op$="=" 
  10692. target$,$wc%)>0 
  10693. target$,$ws%)>0) 
  10694.  op$="$"
  10695.  moan_err%,
  10696. msg("Err40")
  10697. instring%=
  10698. "}{,{{,{",op$)>0
  10699. fnum(S$)
  10700.  S$="KK" 
  10701. =MaxFields%+1
  10702. ("&"+S$)
  10703. newline%=((N% 
  10704.  128)>0)
  10705. =(N% 
  10706.  127)
  10707. field(f$,Z%)
  10708.  I%,F%,desc$
  10709. val%=
  10710. f$,1)="[" 
  10711. f$)="]" 
  10712. f$),2):val%=
  10713.  I%<fields%
  10714.   I%+=1
  10715. u(Tag$(I%))=
  10716. u(f$) 
  10717.  F%=I%
  10718.  F%>0 
  10719. $  desc$=$
  10720. text(mainW%,desc%(F%))
  10721.  desc$<>"" 
  10722.  TitFd$+=desc$+"," 
  10723.  TitFd$+=f$+","
  10724.  moan_err%,
  10725. msg("Err8,"+f$)
  10726.  chartype%(F%) 
  10727.  3,6,46,47,54,56,57:val%=
  10728. find_fields(S$,sep$,
  10729.  length%)
  10730.  f$,F$,C$,P%,Q%,F%
  10731. Q%=1:length%=0
  10732.   P%=
  10733. S$,sep$,Q%)
  10734.  P%>0 
  10735. S$,Q%,P%-Q%)
  10736.   F%=
  10737. field(f$,
  10738.   length%+=len%(F%)+1
  10739.   F$=
  10740. ~(F%)
  10741. (F$)=1 
  10742.  F$="0"+F$
  10743.   C$+=F$
  10744.   Q%=P%+1
  10745. length%+=
  10746. (RA%))+1
  10747. strip_brackets
  10748. W$,1)="("
  10749.   left%+=1:W$=
  10750. W$,2)
  10751. W$)=")"
  10752.   right%+=1:W$=
  10753. add_brackets
  10754.  left%>0
  10755.   E$="("+E$:left%-=1
  10756.  right%>0
  10757.   E$+=")":right%-=1
  10758. build_title
  10759.  change%
  10760. #TitFd$=
  10761. TitFd$):TitTg$=
  10762. TitTg$)
  10763. TitFd$,",")>0 
  10764. TitFd$,"-")>0 
  10765.  bo$ 
  10766. &    
  10767.  "OR":TitFd$="One of:"+TitFd$
  10768.  "AND":
  10769.  op$ 
  10770. ;      
  10771.  "<>":TitFd$="None of:"+TitFd$:op$="=":change%=
  10772. ;      
  10773.  "}{":TitFd$="None of:"+TitFd$:op$="{":change%=
  10774. #      
  10775. :TitFd$="All of:"+TitFd$
  10776.         
  10777. TitTg$,",")>0 
  10778.  bo$ 
  10779. &    
  10780.  "OR":TitTg$="one of:"+TitTg$
  10781.  "AND":
  10782.  op$ 
  10783. 1      
  10784.  "<>":TitTg$="none of:"+TitTg$:op$="="
  10785. 1      
  10786.  "}{":TitTg$="none of:"+TitTg$:op$="{"
  10787. '      
  10788. ":TitTg$="any of:"+TitTg$
  10789. I      
  10790.  change% 
  10791.  TitTg$="any of:"+TitTg$ 
  10792.  TitTg$="all of:"+TitTg$
  10793.         
  10794.  op$ 
  10795.  "{":op$=" contains "
  10796.  "}{":op$=" does not contain "
  10797.  "$":op$=" has wild-card match with "
  10798. ":op$=" does not have wild-card match with ":
  10799. Title$+=TitFd$+op$+TitTg$
  10800. expand(string$,table$,
  10801.  ExpLen%,
  10802.  subst$)
  10803.  p$,s$,start%,F%,I%,T%,ind%,row%,Rec%,Rows%,TabFields%,field%,subst%,exact%,pos%
  10804. subst$=string$
  10805.  table$="" 
  10806.  ExpLen%=0:=string$:
  10807.  ### Not linked ###
  10808. *field%=
  10809. trailing_number(table$,exact%)
  10810. "subst%=
  10811. leading_number(table$)
  10812.  ### field% is the linked field, subst% (if >=0) is the one to substitute on entry ###
  10813. table_number(table$)
  10814.  T%<0 
  10815.  ExpLen%=0:=string$:
  10816.  ### Table not found ###
  10817. p$=printrel$(T%)
  10818. `NewTab%=(
  10819. table_info(T%,Rows%,TabFields%,Rec%,tabfieldlen%(),offset%,heading%,colours$)="
  10820. *extra%=-NewTab%*(Rows%*(TabFields%+1))
  10821.  subst%>=0 
  10822.  pos%=
  10823. table_field(subst%,tabfieldlen%()) 
  10824.  pos%=
  10825. table_field(field%,tabfieldlen%())
  10826.  p$<>"" 
  10827.   ExpLen%=0
  10828.  I%=1 
  10829. (p$) 
  10830.     F%=
  10831. p$,I%,3))
  10832. #    ExpLen%+=tabfieldlen%(F%)+2
  10833.   ExpLen%-=2
  10834.  ExpLen%=tabfieldlen%(1)
  10835. 8start%=!tabanchor%(T%)+offset%-Rec%:ind%=start%+pos%
  10836.   row%+=1:ind%+=Rec%
  10837.  row%>Rows% 
  10838.  $ind%=subst$
  10839.  row%>Rows% 
  10840.  subst$="":=string$:
  10841.  ## String not in table ###
  10842. ;ind%=start%+row%*Rec%:
  10843.  subst%>=0 
  10844.  subst$=$(ind%+pos%)
  10845.  p$<>"" 
  10846.  I%=1 
  10847. (p$) 
  10848.     F%=
  10849. p$,I%,3))
  10850. ,    pos%=
  10851. table_field(F%,tabfieldlen%())
  10852. 4    s$+=
  10853. pad($(ind%+pos%),tabfieldlen%(F%))+"  "
  10854.   s$=
  10855.  ind%+=tabfieldlen%(0)+1:s$=$ind%:
  10856.  ### Return 2nd field ###
  10857. n(F%)
  10858.  T%,row%,ind%,start%,Rows%,Rec%,TabFields%,pos%,valpos%,N%,field%,subst%,table$,S$,exact%
  10859.  link$(F%)="" 
  10860. S$=$Rf%(F%)
  10861. table$=link$(F%)
  10862. *field%=
  10863. trailing_number(table$,exact%)
  10864. "subst%=
  10865. leading_number(table$)
  10866. /table%=
  10867. table_number(table$):
  10868.  table%<0 
  10869. table_info(table%,Rows%,TabFields%,Rec%,tabfieldlen%(),offset%,heading%,colours$)
  10870.  TabFields%=field% 
  10871. softerror("",54):=0
  10872.  subst%>0 
  10873.      .  pos%=
  10874. table_field(subst%,tabfieldlen%())
  10875.  pos%=
  10876. table_field(field%,tabfieldlen%())
  10877. 1valpos%=
  10878. table_field(field%+1,tabfieldlen%())
  10879. +start%=!tabanchor%(table%)+offset%-Rec%
  10880.  row%+=1
  10881.    ind%=start%+row%*Rec%+pos%
  10882.  row%>Rows% 
  10883.  S$=$ind%
  10884.  row%<=Rows% 
  10885. #  ind%=start%+row%*Rec%+valpos%
  10886.   N%=
  10887. ($ind%)
  10888.  N%=0
  10889. pad(s$,L%)
  10890. (s$)<L%
  10891.   s$+=" "
  10892. stripspaces(s$)
  10893. s$)=" "
  10894.   s$=
  10895. trim(wi%,ic%)
  10896. selected(prefsW%,42) 
  10897.  &2 $
  10898. text(wi%,ic%)=
  10899. stripspaces($
  10900. text(wi%,ic%))
  10901. redraw_icon(wi%,ic%)
  10902. include_fields
  10903.  Hdlen%,Datlen%,hlm%,dlm%,I%,F%,f$,Head$,limit%,pad%,col%,fail%,n$,y$,SF$,memo%,base%,pos%,blocksize%,blockinc%
  10904.  -'blocksize%=256:blockinc%=blocksize%
  10905. extend_named_sliding_block(headanchor%,blocksize%)
  10906.  /!base%=!headanchor%:pos%=base%
  10907. heap_store(headanchor%,blocksize%,blockinc%,pos%,0,margin$)
  10908. selected(matchW%,6) 
  10909.  Form$="KK"+Form$
  10910. selected(matchW%,4) 
  10911.  Form$="00"+Form$
  10912.  I%=1 
  10913. (Form$)-1 
  10914.   F%=
  10915. fnum(
  10916. Form$,I%,2))
  10917.  chartype%(F%) 
  10918.  60    
  10919.  36,39:dlm%=TextLine%:memo%=
  10920. set_vert
  10921.  41,42,43,44,45:
  10922.  8!    Datlen%=
  10923. no_yes(F%,n$,y$)
  10924.  9E    
  10925.  ### Get data length for strings printed for check boxes ###
  10926.  ;:  
  10927. selected(printW%,11) 
  10928. selected (printW%,40) 
  10929.  </    f$=
  10930. expand("@#*",link$(F%),Datlen%,SF$)
  10931.  =)    
  10932.  Datlen%=0 
  10933.  Datlen%=maxlen%(F%)
  10934.  >        
  10935.     Datlen%=maxlen%(F%)
  10936.  AP  
  10937. selected(printW%,2) 
  10938.  Head$=$
  10939. text(mainW%,(desc%(F%))) 
  10940.  Head$=Tag$(F%)
  10941.  B'  
  10942.  F%=0 
  10943.  Head$="RECORD":Datlen%=6
  10944.  C7  
  10945.  F%=MaxFields%+1 
  10946.  Datlen%=KL%(key%):Head$="KEY"
  10947.  D#  
  10948.  Datlen%>dlm% 
  10949.  dlm%=Datlen%
  10950.   Hdlen%=
  10951. (Head$)
  10952.  F!  
  10953.  Hdlen%>hlm% 
  10954.  hlm%=Hdlen%
  10955.  format$ 
  10956.  "horiz","table":
  10957.  I-    pad%=Datlen%-Hdlen%:
  10958.  pad%<0 
  10959.  pad%=0
  10960.  chartype%(F%) 
  10961.  Kc      
  10962.  3,6,46,47,54,56,57:
  10963. selected(printW%,11) 
  10964.  Head$+=
  10965. pad%," ") 
  10966.  Head$=
  10967. pad%," ")+Head$
  10968.  LA      
  10969.  ### Right justify numbers unless Expand option on ###
  10970.       
  10971. :Head$+=
  10972. pad%," ")
  10973.  N        
  10974.  OJ    
  10975. heap_store(headanchor%,blocksize%,blockinc%,pos%,0,Head$+spacer$)
  10976.  P#    Tab%((I%+1) 
  10977.  2)=pos%-base%
  10978.  format$ 
  10979.  "horiz":L%=pos%-base%+2
  10980.  U*  
  10981.  "vert":L%=TextLine%+5:Tab%(1)=hlm%
  10982.  "table":
  10983.   col%=
  10984. (column$)
  10985.  XF  
  10986. heap_store(headanchor%,blocksize%,blockinc%,pos%,0,column$+" ")
  10987.   ?pos%=10:L%=pos%-base%+1
  10988.  "label":
  10989.   longestfield%=dlm%
  10990.  \)  L%=labup%*labwidth%+dlm%+Lmargin%+1
  10991. extend_named_sliding_block(lineanchor%,L%+8)
  10992. no_yes(F%,
  10993.  no$,
  10994.  yes$)
  10995.  P%,V$,L%
  10996. val(mainW%,field%(F%))
  10997. V$,"Q")
  10998.  P%>0 
  10999.   V$=
  11000. V$,P%+1)
  11001.   P%=
  11002. V$,",")
  11003.   no$=
  11004. V$,P%-1)
  11005.   yes$=
  11006. V$,P%+1)
  11007.  no$="N":yes$="Y"
  11008. (no$)
  11009. (yes$)>L% 
  11010. (yes$)
  11011. heap_store(anchor%,
  11012.  size%,inc%,
  11013.  ptr%,L%,string$)
  11014.  string$<>"" 
  11015. (string$)
  11016.  ptr%-!anchor%+L%+1>size% 
  11017.   size%+=inc%
  11018.  t0  
  11019. extend_named_sliding_block(anchor%,size%)
  11020.  string$<>"" 
  11021.  $ptr%=string$:ptr%+=L%:?ptr%=10
  11022. set_vert
  11023. deselect(printW%,23)
  11024. deselect(printW%,25)
  11025. deselect(printW%,26)
  11026. select(printW%,24)
  11027. format$="vert"
  11028. ?LinesPerPage%=(pagelength%-10) 
  11029.  (linefeed%*(
  11030. (Form$) 
  11031.  LinesPerPage%=0 
  11032.  LinesPerPage%=1
  11033. save_selection
  11034.  P%,T%,I%,F%,J%
  11035. -P%=savebuff%:$P%=printorder$:P%+=
  11036. ($P%)+1
  11037.  T%=0 
  11038.  LastTable%
  11039. # $P%=printrel$(T%):P%+=
  11040. ($P%)+1
  11041. $P%="***":P%+=
  11042. ($P%)+1
  11043.  I%=1 
  11044. (printorder$)-1 
  11045. "  F%=
  11046. fnum(
  11047. printorder$,I%,2))
  11048.  chartype%(F%) 
  11049.  3,6,8,46,47,54,56,57:
  11050.  J%=0 
  11051. L      
  11052. selected(pselectW%,(calcrow%?F%)*8+2+J%) 
  11053.  $P%="ON" 
  11054.  $P%="OFF"
  11055.       P%+=
  11056. ($P%)+1
  11057. 8Start%=savebuff%:End%=Start%+P%-savebuff%:Type%=&7F3
  11058. load_selection(f$)
  11059.  F%,I%,T%,F,new%
  11060. clear_selection
  11061. printorder$=
  11062. T%=-1:printrel$()=""
  11063.  p$<>"***"
  11064.   T%+=1
  11065.   p$=
  11066.  p$<>"" 
  11067.  p$<>"***" 
  11068. select(printW%,11)
  11069.     printrel$(T%)=p$
  11070.  tableW%(T%)>0 
  11071. f      NewTab%=(
  11072. table_info(T%,Rows%,TabFields%,Rec%,tabfieldlen%(),offset%,heading%,colours$)="
  11073. 0      extra%=-NewTab%*(Rows%*(TabFields%+1))
  11074.       
  11075.  I%=1 
  11076. (p$) 
  11077. $        tablefield%=
  11078. p$,I%,3))
  11079. 3        
  11080. select(tableW%(T%),tablefield%+extra%)
  11081.       
  11082.         
  11083.  I%=1 
  11084. (printorder$)-1 
  11085. "  F%=
  11086. fnum(
  11087. printorder$,I%,2))
  11088.  chartype%(F%) 
  11089.  41,42,43,44,45:
  11090. .    col%=
  11091. get_icon_cols(mainW%,field%(F%))
  11092. 0    col%=((col%>>4) 
  11093.  (col%<<4)) 
  11094.  %11111111
  11095. .    
  11096. set_icon_cols(mainW%,field%(F%),col%)
  11097.  3,6,8,46,47,54,56,57:
  11098. "    
  11099. select(mainW%,field%(F%))
  11100. "    
  11101. enable_row(calcrow%?F%,
  11102.  J%=0 
  11103. H      
  11104. set_icon(pselectW%,(calcrow%?F%)*8+2+J%,(
  11105. #F="ON"))
  11106. $    
  11107. select(mainW%,field%(F%))
  11108. close_file(F)
  11109. lit(printM%,6,
  11110. lit(printM%,7,
  11111. lit(mainM%,7,
  11112. selected(passW%,13))
  11113. select_range(first%,last%,show%)
  11114.  F%,T%,F$,wi%,ic%
  11115.  first%>last% 
  11116.  first%,last%
  11117.  first%=1 
  11118.  last%=fields% 
  11119.  printorder$="" 
  11120.  printorder$=
  11121. printorder$))
  11122. wi%=mainW%
  11123.  F%=first% 
  11124.  last%
  11125.   ic%=field%(F%)
  11126.  chartype%(F%) 
  11127.  41,42,43:
  11128. $    col%=
  11129. get_icon_cols(wi%,ic%)
  11130. F    
  11131.  (col% 
  11132.  %1111)>=2 
  11133.  col%=((col%>>4) 
  11134.  (col%<<4)) 
  11135.  %11111111
  11136. .    
  11137.  show% 
  11138. set_icon_cols(wi%,ic%,col%)
  11139. '    F$=
  11140. ~(F%):
  11141. (F$)=1 
  11142.  F$="0"+F$
  11143.     printorder$+=F$
  11144.  0,1,2,4,5,7,8:
  11145. =    
  11146.  len%(F%)>0 
  11147. get_icon_cols(wi%,ic%)<>winback%*17 
  11148. )      F$=
  11149. ~(F%):
  11150. (F$)=1 
  11151.  F$="0"+F$
  11152.       printorder$+=F$
  11153. $      
  11154.  show% 
  11155. select(wi%,ic%)
  11156.         
  11157.  3,6,46,47,54,56,57:
  11158. =    
  11159.  len%(F%)>0 
  11160. get_icon_cols(wi%,ic%)<>winback%*17 
  11161. )      F$=
  11162. ~(F%):
  11163. (F$)=1 
  11164.  F$="0"+F$
  11165.       printorder$+=F$
  11166. $      
  11167.  show% 
  11168. select(wi%,ic%)
  11169. $      
  11170. enable_row(calcrow%?F%,
  11171.         
  11172. '    F$=
  11173. ~(F%):
  11174. (F$)=1 
  11175.  F$="0"+F$
  11176.     printorder$+=F$
  11177. $    col%=
  11178. get_icon_cols(wi%,ic%)
  11179. 0    col%=((col%>>4) 
  11180.  (col%<<4)) 
  11181.  %11111111
  11182. .    
  11183.  show% 
  11184. set_icon_cols(wi%,ic%,col%)
  11185. %    
  11186.  39,48,49,50,51,52,53,55,58:
  11187. '    F$=
  11188. ~(F%):
  11189. (F$)=1 
  11190.  F$="0"+F$
  11191.     printorder$+=F$
  11192. "    
  11193.  show% 
  11194. select(wi%,ic%)
  11195. lit(printM%,6,
  11196. lit(printM%,7,
  11197. lit(mainM%,7,
  11198. selected(passW%,13))
  11199. shade(matchW%,7,printorder$<>"")
  11200. clear_selection
  11201.  F%,T%,new%
  11202.  F%=1 
  11203.  fields%
  11204.  chartype%(F%) 
  11205.  36,41,42,43,44,45:
  11206. .    col%=
  11207. get_icon_cols(mainW%,field%(F%))
  11208. E    
  11209.  (col% 
  11210.  %1111)<2 
  11211.  col%=((col%>>4) 
  11212.  (col%<<4)) 
  11213.  %11111111
  11214. .    
  11215. set_icon_cols(mainW%,field%(F%),col%)
  11216. V    
  11217.  3,6,8,46,47,54,56,57:
  11218. enable_row(calcrow%?F%,
  11219. deselect(mainW%,field%(F%))
  11220. &    
  11221. deselect(mainW%,field%(F%))
  11222. printorder$=""
  11223.  T%=0 
  11224.  LastTable%
  11225. b  NewTab%=(
  11226. table_info(T%,Rows%,TabFields%,Rec%,tabfieldlen%(),offset%,heading%,colours$)="
  11227. ,  extra%=-NewTab%*(Rows%*(TabFields%+1))
  11228.   p$=printrel$(T%)
  11229.  p$<>"" 
  11230.  tableW%(T%)>0 
  11231.       
  11232.  I%=1 
  11233. (p$) 
  11234. $        tablefield%=
  11235. p$,I%,3))
  11236. 5        
  11237. deselect(tableW%(T%),tablefield%+extra%)
  11238.       
  11239.         
  11240. printrel$()=""
  11241. lit(printM%,6,
  11242. lit(printM%,7,
  11243. lit(mainM%,7,
  11244. shade(matchW%,7,
  11245. load_query(f$,wi%,ic%)
  11246.  wi% 
  11247.  mainW%:
  11248.  ic% 
  11249. D    
  11250.  field%(buttonfield%(0,22)):
  11251. select(wi%,ic%):
  11252. filter(wi%,
  11253. .    
  11254. selected(passW%,14) 
  11255. match(0,0)
  11256.  keypadW%:
  11257. select(wi%,22):
  11258. filter(wi%,
  11259.  "OS_File",255,f$,Query%
  11260. query$=$Query%
  11261. set_caret(queryW%,0)
  11262. redraw_icon(queryW%,0)
  11263. design_field(b%,ic%,menu%)
  11264.  w%,h%
  11265. clickicon%=ic%
  11266. !#!posx%=x%:posy%=y%:dragbutt%=0
  11267. !$3!block%=mainW%:
  11268.  "Wimp_GetWindowState",,block%
  11269. x%+=block%!20-block%!4
  11270. y%+=block%!24-block%!16
  11271. !'5!block%=createW%:
  11272.  "Wimp_GetWindowState",,block%
  11273. !(%closed%=((block%!32 
  11274.  (1<<16))=0)
  11275.  %1111111 
  11276. !*+  
  11277.  1,4:
  11278.  fields%=0 
  11279. softerror("",62)
  11280.  closed% 
  11281. !-C    
  11282.  (ic% 
  11283.  2)=1 
  11284.  drag%=6:dragbutt%=16 
  11285.  drag%=5:dragbutt%=64
  11286. !.$    
  11287. init_drag(mainW%,ic%,drag%)
  11288. !1%  
  11289. shade(createW%,44,(fields%>0))
  11290.   fieldfunc$="create"
  11291.   $InsText%=""
  11292. !43  
  11293. deselect(createW%,
  11294. selected_esg(createW%,1))
  11295. !5#  
  11296. shade(createW%,49,snapgrid%)
  11297.  ic%>=0 
  11298. lit(designM%,0,
  11299. !8B    !block%=mainW%:block%!4=ic%:
  11300.  "Wimp_GetIconState",,block%
  11301. !9M    x%=block%!8:y%=block%!12:w%=block%!16-block%!8:h%=block%!20-block%!12
  11302. !:$    Fieldnumber%=
  11303. get_field(ic%)
  11304. !;%    type%=chartype%(Fieldnumber%)
  11305.  vtype$(type%) 
  11306. !=3      
  11307.  "E":
  11308. select(createW%,21):
  11309. set_limits(0)
  11310. !>3      
  11311.  "C":
  11312. select(createW%,47):
  11313. set_limits(1)
  11314. !?3      
  11315.  "T":
  11316. select(createW%,24):
  11317. set_limits(2)
  11318. !@3      
  11319.  "X":
  11320. select(createW%,22):
  11321. set_limits(3)
  11322. !A3      
  11323.  "K":
  11324. select(createW%,23):
  11325. set_limits(4)
  11326. !B3      
  11327.  "O":
  11328. select(createW%,48):
  11329. set_limits(5)
  11330. !C3      
  11331.  "S":
  11332. select(createW%,35):
  11333. set_limits(6)
  11334. !D        
  11335. !E'    fieldtype%=type%:currenttype%=0
  11336. !F        
  11337.       currenttype%+=1
  11338. !H:    
  11339.  ?(flist%(menunumber%)+currenttype%+1)=fieldtype%
  11340. !IB    
  11341. tick_one(ftypeM%(menunumber%),0,lasttype%-1,currenttype%)
  11342. !J4    $FtitleText%="Modify field "+
  11343. (Fieldnumber%)
  11344. !K5    $DescText%=$
  11345. text(mainW%,desc%(Fieldnumber%))
  11346. !L$    $TagText%=Tag$(Fieldnumber%)
  11347. !M'    $LenText%=
  11348. (len%(Fieldnumber%))
  11349. !N$    $ValText%=vname$(fieldtype%)
  11350. !O5    
  11351. deselect(createW%,
  11352. selected_esg(createW%,2))
  11353.  fix%(Fieldnumber%) 
  11354. !Q/      
  11355. select(createW%,45):$Fixpt%="0"
  11356. !R.      
  11357. select(createW%,46):$Fixpt%="0"
  11358. !S>      
  11359. select(createW%,14):$Fixpt%=
  11360. (fix%(Fieldnumber%))
  11361. !T        
  11362. !U*    num%=(fieldtype%=3 
  11363.  fieldtype%=6)
  11364. !V4    
  11365. shade(createW%,13,(
  11366. selected(createW%,14)))
  11367. !W     
  11368. shade(createW%,14,num%)
  11369. !X     
  11370. shade(createW%,45,num%)
  11371. !Y     
  11372. shade(createW%,46,num%)
  11373. shade(createW%,18,
  11374. ![U    
  11375. shade(createW%,6,(fieldtype%<9 
  11376.  fieldtype%=46 
  11377.  fieldtype%=47) 
  11378.  adjust%)
  11379. !\%    
  11380. shade(createW%,30,
  11381.  adjust%)
  11382. shade(createW%,29,
  11383. !^:    
  11384. shade(createW%,15,(fieldtype%=3 
  11385.  fieldtype%=47))
  11386. !_*    
  11387. shade(createW%,25,(fieldtype%=3))
  11388. !`*    C$=calc$(Fieldnumber%):P%=
  11389. C$,"|")
  11390. !a8    
  11391.  P%>0 
  11392.  $mintext%=
  11393. C$,P%-1):$maxtext%=
  11394. C$,P%+1)
  11395.  I%=21 
  11396. !c'      
  11397. shade(createW%,I%,
  11398.  adjust%)
  11399. !e%    
  11400. shade(createW%,35,
  11401.  adjust%)
  11402. !f%    
  11403. shade(createW%,39,
  11404.  adjust%)
  11405. !g%    
  11406. shade(createW%,40,
  11407.  adjust%)
  11408. !h%    
  11409. shade(createW%,47,
  11410.  adjust%)
  11411. !i%    
  11412. shade(createW%,48,
  11413.  adjust%)
  11414. !j        
  11415. !k"    
  11416. lit(designM%,0,
  11417.  adjust%)
  11418. select(createW%,21)
  11419. set_limits(0)
  11420. !n.    $FtitleText%="New field "+
  11421. (fields%+1)
  11422. !o/    $DescText%="":$TagText%="":$LenText%=""
  11423. !p-    $Fixpt%="2":$mintext%="":$maxtext%=""
  11424. !q5    
  11425. deselect(createW%,
  11426. selected_esg(createW%,2))
  11427. select(createW%,46)
  11428. shade(createW%,13,
  11429. shade(createW%,14,
  11430. shade(createW%,45,
  11431. shade(createW%,46,
  11432. shade(createW%,15,
  11433. shade(createW%,25,
  11434. shade(createW%,29,
  11435. shade(createW%,30,
  11436. shade(createW%,39,
  11437. shade(createW%,40,
  11438. !}%    
  11439. shade(createW%,18,
  11440.  adjust%)
  11441.  (ic% 
  11442.  2)=1 
  11443. ;    $boxX%=
  11444. (x%):$boxY%=
  11445. (y%):$boxW%=
  11446. (w%):$boxH%=
  11447. B    
  11448.  x%+=w%+8:$boxX%=
  11449. (x%):$boxY%=
  11450. (y%):$boxW%="0":$boxH%="0"
  11451. close_window(createW%)
  11452.  menu% 
  11453. .    
  11454. show_menu(designM%,posx%-64,posy%-20)
  11455. G    
  11456. position_window(createW%,0,0,0,0,0,0):
  11457. set_caret(createW%,4)
  11458.  closed% 
  11459. init_drag(mainW%,ic%,5):dragbutt%=64
  11460. remove_field(Field%,con%,
  11461.  Calc$)
  11462.  con% 
  11463. confirm(
  11464. msg("Err53"))=
  11465. )!block%=mainW%:block%!4=desc%(Field%)
  11466.  "Wimp_GetIconState",,block%
  11467. "posx%=block%!8:posy%=block%!12
  11468.  "Wimp_DeleteIcon",,block%
  11469. 8block%!4=field%(Field%):
  11470.  "Wimp_DeleteIcon",,block%
  11471. fields%-=1
  11472. Calc$=calc$(Field%)
  11473.  F%=Field% 
  11474.  fields%
  11475.   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)
  11476. !block%=mainW%
  11477.  "Wimp_GetWindowState",,block%
  11478. ;posx%-=block%!20-block%!4:posy%-=block%!24-block%!16-48
  11479.  "Wimp_ForceRedraw",-1,block%!4,block%!8,block%!12,block%!16
  11480. create_field(Before%,x%,y%,Calc$)
  11481.  Desc%,Field%,F%,tag$,Len%,Char%,F%,L%,LF%,x%,y%,width%,height%,dflg%
  11482.  fields%=MaxFields% 
  11483. softerror(
  11484. (MaxFields%),23):=
  11485.  $DescText%="" 
  11486.  $TagText%="" 
  11487.  fieldtype%<=8 
  11488. ($DescText%):LF%=
  11489. ($LenText%)
  11490.  L%=0 
  11491.  dflg%=(winback%<<28)+&7016711 
  11492.  dflg%=(winback%<<28)+&7016731
  11493.  LF%>246 
  11494. softerror("",64):=
  11495. ($boxX%):y%=
  11496. ($boxY%):int%=
  11497. ($snapint%):
  11498. snap(x%,y%,int%)
  11499. &width%=
  11500. ($boxW%):height%=
  11501. ($boxH%)
  11502.  fieldtype% 
  11503.  39,40,59:
  11504.   LF%=0
  11505.  width%=0 
  11506.  width%=48
  11507.  height%=0 
  11508.  height%=48
  11509.  41,42,43:LF%=1
  11510.  8,48,50:LF%=8
  11511.  49:LF%=15
  11512.  51:LF%=10
  11513.  52,58:LF%=24
  11514.  53,55:LF%=3
  11515.  54,56:LF%=2
  11516.  57:LF%=4
  11517.  LF%>0 
  11518.  $TagText%="" 
  11519. softerror("",16):=
  11520.  F%+=1
  11521.  $TagText%=Tag$(F%) 
  11522.  F%>fields%
  11523.  F%<=fields% 
  11524.  $TagText%<>"" 
  11525. softerror("",20):=
  11526. 8fields%+=1:Tag$(fields%)=$TagText%:len%(fields%)=LF%
  11527.  width%=0 
  11528.  $TagText%<>"" 
  11529.  len%(fields%)<70 
  11530.  width%=len%(fields%)*16+16 
  11531.  width%=70*16+16
  11532.  height%=0 
  11533.  width%>0 
  11534.  height%=48
  11535. !chartype%(fields%)=fieldtype%
  11536. selected(createW%,45):fix%(fields%)=-1
  11537. selected(createW%,14):fix%(fields%)=
  11538. ($Fixpt%)
  11539. :fix%(fields%)=0
  11540. extend_named_sliding_block(formanchor%,Fptr%-!formanchor%+L%+6)
  11541. [desc%(fields%)=
  11542. create_icon(mainW%,x%-L%*16-16,y%+2,L%*16+8,44,dflg%,"",Fptr%,hand%,L%)
  11543. !$Fptr%=$DescText%:Fptr%+=L%+1
  11544. $Fptr%=""
  11545.  fieldtype% 
  11546.   min$=$
  11547. text(createW%,15)
  11548.   max$=$
  11549. text(createW%,25)
  11550.  min$<>"" 
  11551.  max$<>"" 
  11552.  calc$(fields%)=min$+"|"+max$:calc$(0)="LOADED"
  11553. 3  min$=$
  11554. text(createW%,15):
  11555.  min$="" 
  11556.  min$="0"
  11557. 4  calc$(fields%)=min$+"|"+min$:calc$(0)="LOADED"
  11558.  fieldtype% 
  11559.  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%
  11560.  59:valptr%=!logoanchor%:$Fptr%=Tag$(fields%)
  11561. :valptr%=hvalid%(fieldtype%)
  11562. icon_design(fieldtype%,1,width%,height%)
  11563. Xfield%(fields%)=
  11564. create_icon(mainW%,x%,y%,width%,height%,iflags%,"",Fptr%,valptr%,4)
  11565.  fieldtype%=40 
  11566.  Rf%(fields%)=
  11567. create_anchor("Picture"+
  11568. (fields%))
  11569. Fptr%+=5
  11570. redraw_icon(mainW%,desc%(fields%)):
  11571. redraw_icon(mainW%,field%(fields%))
  11572.  Before%<fields% 
  11573.  Before%>0 
  11574. re_sequence(fields%,Before%,-1)
  11575. snap(
  11576.  y%,int%)
  11577.  X%,Y%
  11578.  snapgrid%=
  11579.  int%>0 
  11580. 5  X%=(x% 
  11581.  int%)*int%:
  11582.  x%-X%>int% 
  11583.  X%+=int%
  11584. 5  Y%=(y% 
  11585.  int%)*int%:
  11586.  Y%-y%>int% 
  11587.  Y%-=int%
  11588.   $boxX%=
  11589. (X%):$boxY%=
  11590.   x%=X%:y%=Y%
  11591. snap_all
  11592.  ic%,x%,y%,w%,h%
  11593.  ic%=0 
  11594.  2*fields%-1
  11595. )  !iconblock%=mainW%:iconblock%!4=ic%
  11596.  "Wimp_GetIconState",,iconblock%
  11597. &  x%=iconblock%!8:y%=iconblock%!12
  11598. -  w%=iconblock%!16-x%:h%=iconblock%!20-y%
  11599. snap(x%,y%,
  11600. ($snapint%))
  11601. )  iconblock%!8=x%:iconblock%!16=x%+w%
  11602. *  iconblock%!12=y%:iconblock%!20=y%+h%
  11603.   iconblock%!4=mainW%
  11604. >  !block%=mainW%:block%!4=ic%:
  11605.  "Wimp_DeleteIcon",,block%
  11606.  "Wimp_CreateIcon",,iconblock%+4
  11607. redraw(mainW%)
  11608. nudge(b%,ic%)
  11609.  int%,z%
  11610.  b%=4 
  11611.  z%=1 
  11612.  z%=-1
  11613.  snapgrid% 
  11614.  int%=
  11615. ($snapint%) 
  11616.  int%=2
  11617. ficon%=clickicon%
  11618. *!iconblock%=mainW%:iconblock%!4=ficon%
  11619.  "Wimp_GetIconState",,iconblock%
  11620. $x%=iconblock%!8:y%=iconblock%!12
  11621. +w%=iconblock%!16-x%:h%=iconblock%!20-y%
  11622.  ic% 
  11623.  50:y%+=int%*z%
  11624.  51:y%-=int%*z%
  11625.  52:x%+=int%*z%
  11626.  53:x%-=int%*z%
  11627. "    'iconblock%!8=x%:iconblock%!16=x%+w%
  11628. (iconblock%!12=y%:iconblock%!20=y%+h%
  11629. iconblock%!4=mainW%
  11630. ?!block%=mainW%:block%!4=ficon%:
  11631.  "Wimp_DeleteIcon",,block%
  11632.  "Wimp_CreateIcon",,iconblock%+4
  11633. redraw(mainW%)
  11634. adjust_field(b%)
  11635.  Dptr%,Fptr%,dflg%
  11636.  "Wimp_GetPointerInfo",,block%
  11637.  newx%=!block%:newy%=block%!4
  11638. #Fieldnumber%=
  11639. get_field(ficon%)
  11640.  (ficon% 
  11641.  2)=0 
  11642. C  !block%=mainW%:block%!4=ficon%:
  11643.  "Wimp_GetIconState",,block%
  11644. .  Dptr%=block%!28:Desc$=$Dptr%:L%=
  11645. (Desc$)
  11646.  L%=0 
  11647.  dflg%=(winback%<<28)+&7016711 
  11648.  dflg%=(winback%<<28)+&7016731
  11649.  "Wimp_DeleteIcon",,block%
  11650.  "Wimp_GetWindowState",,block%
  11651. -  x%=block%!20-block%!4+newx%-oldx%+minx%
  11652. .  y%=block%!24-block%!16+miny%+newy%-oldy%
  11653. snap(x%,y%,
  11654. ($snapint%))
  11655. W  desc%(Fieldnumber%)=
  11656. create_icon(mainW%,x%,y%,L%*16+8,44,dflg%,"",Dptr%,hand%,L%)
  11657. "!C  !block%=mainW%:block%!4=ficon%:
  11658.  "Wimp_GetIconState",,block%
  11659.   Fptr%=block%!28
  11660. "%$    
  11661.  "Wimp_DeleteIcon",,block%
  11662. "&(    
  11663.  "Wimp_GetWindowState",,block%
  11664. "'#    x%=block%!20-block%!4+minx%
  11665. "(0    y%=block%!24-block%!16+miny%+newy%-oldy%
  11666. ")!    
  11667. snap(x%,y%,
  11668. ($snapint%))
  11669. "*F    width%=maxx%-minx%+newx%-oldx%:height%=maxy%-miny%+oldy%-newy%
  11670. ",'    keepwith%=
  11671. selected(prefsW%,16)
  11672.  keepwith% 
  11673. ".I      !block%=mainW%:block%!4=ficon%-1:
  11674.  "Wimp_GetIconState",,block%
  11675. "/2      Dptr%=block%!28:Desc$=$Dptr%:L%=
  11676. (Desc$)
  11677. "0P      
  11678.  L%=0 
  11679.  dflg%=(winback%<<28)+&7016711 
  11680.  dflg%=(winback%<<28)+&7016731
  11681. "1&      
  11682.  "Wimp_DeleteIcon",,block%
  11683. "2        
  11684. "3C    !block%=mainW%:block%!4=ficon%:
  11685.  "Wimp_DeleteIcon",,block%
  11686.  keepwith% 
  11687. "5*      
  11688.  "Wimp_GetWindowState",,block%
  11689. "6:      x%=block%!20-block%!4+newx%-oldx%+minx%-L%*16-16
  11690. "72      y%=block%!24-block%!16+miny%+newy%-oldy%
  11691. "8#      
  11692. snap(x%,y%,
  11693. ($snapint%))
  11694. "9]      desc%(Fieldnumber%)=
  11695. create_icon(mainW%,x%,y%+2,L%*16+8,44,dflg%,"",Dptr%,hand%,L%)
  11696. ":        
  11697. ";(    
  11698.  "Wimp_GetWindowState",,block%
  11699. "</    x%=block%!20-block%!4+newx%-oldx%+minx%
  11700. "=0    y%=block%!24-block%!16+miny%+newy%-oldy%
  11701. ">!    
  11702. snap(x%,y%,
  11703. ($snapint%))
  11704. "?.    width%=maxx%-minx%:height%=maxy%-miny%
  11705. "A(  fieldtype%=chartype%(Fieldnumber%)
  11706.  fieldtype% 
  11707. "CV    
  11708.  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%
  11709. "D<    
  11710.  59:valptr%=!logoanchor%::$Fptr%=Tag$(Fieldnumber%)
  11711. "E%    
  11712. :valptr%=hvalid%(fieldtype%)
  11713. "G/  
  11714. icon_design(fieldtype%,1,width%,height%)
  11715. "H_  field%(Fieldnumber%)=
  11716. create_icon(mainW%,x%,y%,width%,height%,iflags%,"",Fptr%,valptr%,4)
  11717. "IS  
  11718.  fieldtype%=40 
  11719.  Rf%(Fieldnumber%)=
  11720. create_anchor("Picture"+
  11721. (Fieldnumber%))
  11722. "K@$boxX%=
  11723. (x%):$boxY%=
  11724. (y%):$boxW%=
  11725. (width%):$boxH%=
  11726. (height%)
  11727. !block%=mainW%
  11728.  "Wimp_GetWindowState",,block%
  11729.  "Wimp_ForceRedraw",-1,block%!4,block%!8,block%!12,block%!16
  11730. swap_fields(F1%,F2%)
  11731.  F2%>0 
  11732.  F2%<=fields% 
  11733.  desc%(F1%),desc%(F2%)
  11734.  Tag$(F1%),Tag$(F2%)
  11735. "U   
  11736.  field%(F1%),field%(F2%)
  11737.  len%(F1%),len%(F2%)
  11738. "W&  
  11739.  chartype%(F1%),chartype%(F2%)
  11740.  fix%(F1%),fix%(F2%)
  11741.  calc$(F1%),calc$(F2%)
  11742. close_window(createW%)
  11743. re_sequence(F1%,F2%,Z%)
  11744. "_jD%=desc%(F1%):T$=Tag$(F1%):F%=field%(F1%):L%=len%(F1%):C%=chartype%(F1%):f%=fix%(F1%):Calc$=calc$(F1%)
  11745.  I%=F1%+Z% 
  11746.  F2% 
  11747.   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%)
  11748. "cjdesc%(F2%)=D%:Tag$(F2%)=T$:field%(F2%)=F%:len%(F2%)=L%:chartype%(F2%)=C%:fix%(F2%)=f%:calc$(F2%)=Calc$
  11749. icon_design(char%,func%,
  11750.  func% 
  11751. "hc  
  11752.  0:bfg%=&1700353F:rbfg%=&1700253F:ffg%=&0700A535:
  11753.  logosloaded% 
  11754.  lfg%=&0000611A 
  11755.  lfg%=ffg%
  11756. "i^  
  11757.  1:bfg%=&1700653F:rbfg%=bfg%:ffg%=&07006535:
  11758.  logosloaded% 
  11759.  lfg%=&0000611E 
  11760.  lfg%=ffg%
  11761.  char% 
  11762. "lC  
  11763.  9,10,11,12,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30:
  11764. "mF  !block%=keypadW%:block%!4=char%-9:
  11765.  "Wimp_GetIconState",,block%
  11766. "n?  w%=block%!16-block%!8:h%=block%!20-block%!12:iflags%=bfg%
  11767.  13,14:
  11768. "pF  !block%=keypadW%:block%!4=char%-9:
  11769.  "Wimp_GetIconState",,block%
  11770. "q@  w%=block%!16-block%!8:h%=block%!20-block%!12:iflags%=rbfg%
  11771. "r(  
  11772.  31:w%=48:h%=48:iflags%=&1700B53B
  11773. "s*  
  11774.  32,34,45:w%=112:h%=52:iflags%=bfg%
  11775. "tH  
  11776.  33:w%=44:h%=44:
  11777.  func%=0 
  11778.  iflags%=&1700353B 
  11779.  iflags%=&1700653B
  11780. "u&  
  11781.  35,44:w%=80:h%=80:iflags%=bfg%
  11782. "v)  
  11783.  36,37,38:w%=48:h%=48:iflags%=bfg%
  11784.  39:iflags%=ffg%
  11785. "x7  
  11786.  func%=0 
  11787.  iflags%=&0700A53E 
  11788.  iflags%=ffg%
  11789. "y.  
  11790.  41,42,43:w%=52:h%=52:iflags%=&1700B53B
  11791.  59:iflags%=lfg%
  11792. "{]  
  11793.  func%=0 
  11794.  hide%?I%=1 
  11795.  iflags%=&00A535+(winback%<<24)+(winback%<<28) 
  11796.  iflags%=ffg%
  11797.  w%=0 
  11798.  h%=0 
  11799.  iflags%=&00000000
  11800. get_field(ic%)
  11801.  F%+=1
  11802.  field%(F%)=ic% 
  11803.  desc%(F%)=ic%
  11804. adjust_on(on%)
  11805. design%=on%:adjust%=on%
  11806. lit(designM%,6,on%)
  11807. lit(designM%,1,
  11808.  on%)
  11809. lit(designM%,2,
  11810.  on%)
  11811. lit(designM%,3,
  11812.  on%)
  11813. lit(designM%,4,
  11814.  on%)
  11815. shade(createW%,6,
  11816.  on%)
  11817.  on% 
  11818. *  w%=ScreenWidth%*2:h%=ScreenHeight%*2
  11819. 4  !block%=0:block%!4=-h%:block%!8=w%:block%!12=0
  11820.  "Wimp_SetExtent",mainW%,block%
  11821. change_length(NL%,msg%)
  11822.  EX%,klm%,S$,N%
  11823. EX%=NL%-RA%
  11824.  EX%=0 
  11825. *dbasehandle%=
  11826. ($database%+".Database")
  11827. readsmarray(dbasehandle%,RA%)
  11828.  msg%:
  11829. extend_dbase
  11830.  (EX%>0):
  11831. confirm("Extend file from "+
  11832. (RA%)+" to "+
  11833. (NL%)+" records")=
  11834. extend_dbase
  11835.  (EX%<0):
  11836. confirm("Shorten file from "+
  11837. (RA%)+" to "+
  11838. (NL%)+" records")=
  11839. shorten_dbase
  11840. $Records%=
  11841. (RA%):N%=RA%
  11842. writesmarray(dbasehandle%,N%)
  11843. close_file(dbasehandle%)
  11844.  msg% 
  11845.  addr=
  11846. moveto(key%,top,1)
  11847. extend_dbase
  11848.  end%,P%,I%,key%,keybase%,KLM%,S$
  11849.  key%=0 
  11850.  Keys%
  11851.   S$=
  11852. KL%(key%),".")
  11853.   KLM%=KL%(key%)+13
  11854.   P%=LH%+48+(NL%+1)*KLM%
  11855. extend_named_sliding_block(keyanchor%(key%),P%)
  11856.    keybase%=!keyanchor%(key%)
  11857.   P%=LH%+48+RA%*KLM%
  11858.  I%=RA% 
  11859.  EX%+RA%-1
  11860.     !(keybase%+P%)=P%+KLM%
  11861.     !(keybase%+P%+4)=0
  11862.     $(keybase%+P%+8)=S$
  11863. %    !(keybase%+P%+KL%(key%)+9)=I%
  11864.     P%+=KLM%
  11865.   !(keybase%+P%)=0
  11866.   !(keybase%+P%+4)=0
  11867.   $(keybase%+P%+8)=S$
  11868. "  !(keybase%+P%+KL%(key%)+9)=0
  11869.  key%
  11870. end%=(RA%+1)*Length%
  11871.  I%=0 
  11872.  EX%-1
  11873. #dbasehandle%=end%+I%*Length%
  11874.  J%=1 
  11875.  fields%
  11876. #dbasehandle%,""
  11877. RA%=NL%
  11878. #dbasehandle%=(RA%+1)*Length%
  11879. shorten_dbase
  11880.  P%,L%,R%,s$,key%,keybase%,S$
  11881.  key%=0 
  11882.  Keys%
  11883.   S$=
  11884. KL%(key%),".")
  11885.   KLM%=KL%(key%)+13
  11886.    keybase%=!keyanchor%(key%)
  11887. $  s$=$(keybase%+LH%+56+NL%*KLM%)
  11888.  s$<>S$ 
  11889. confirm(
  11890. msg("Err52"))=
  11891.   P%=LH%+48+NL%*KLM%
  11892.   !(keybase%+P%)=0
  11893.   !(keybase%+P%+4)=0
  11894.   $(keybase%+P%+8)=S$
  11895. "  !(keybase%+P%+KL%(key%)+9)=0
  11896.  key%
  11897. RA%=NL%
  11898. #dbasehandle%=(RA%+1)*Length%
  11899. copy_database_spritefile(path$,leaf$)
  11900.  sprites%
  11901. create_named_sliding_block(sprsanchor%,1024)
  11902.  ### This is a temporary sprite area used simply to hold ###
  11903.  ### the sprite 'new_appl' whilst it is renamed and saved ###
  11904. sprites%=!sprsanchor%
  11905. !sprites%=1024
  11906. sprites%!8=16
  11907.  ### Initialise sprite area ###
  11908.  "OS_SpriteOp",&109,sprites%
  11909.  ### Load !Sprites file from Resources ###
  11910.  "OS_SpriteOp",&10A,sprites%,"<PBase$Dir>.Resources.Temp.!Sprites"
  11911.  ### Rename sprite 'new_appl' to new database name ###
  11912.  "OS_SpriteOp",&11A,sprites%,"new_appl",leaf$
  11913.  ### Save spritefile (with renamed new_appl) as !Sprites ###
  11914.  "OS_SpriteOp",&10C,sprites%,path$+".!Sprites"
  11915.  ### Do same for hi-res sprite ###
  11916.  "OS_SpriteOp",&109,sprites%
  11917.  "OS_SpriteOp",&10A,sprites%,"<PBase$Dir>.Resources.Temp.!Sprites22"
  11918.  "OS_SpriteOp",&11A,sprites%,"new_appl",leaf$
  11919.  "OS_SpriteOp",&10C,sprites%,path$+".!Sprites22"
  11920. scrap_sliding_block(sprsanchor%)
  11921. rename_database(name$)
  11922.  sprites%
  11923. name$,1)<>"!" 
  11924.  name$="!"+name$
  11925. name$=
  11926. name$,10)
  11927. create_named_sliding_block(sprsanchor%,1024)
  11928. sprites%=!sprsanchor%
  11929. !sprites%=1024
  11930. sprites%!8=16
  11931.  "OS_SpriteOp",&109,sprites%
  11932.  "OS_SpriteOp",&10A,sprites%,$database%+".!Sprites"
  11933.  "OS_SpriteOp",&11A,sprites%,"!"+$dbase%,name$
  11934.  "OS_SpriteOp",&10C,sprites%,$database%+".!Sprites"
  11935.  "OS_SpriteOp",&109,sprites%
  11936.  "OS_SpriteOp",&10A,sprites%,$database%+".!Sprites22"
  11937.  "OS_SpriteOp",&11A,sprites%,"!"+$dbase%,name$
  11938.  "OS_SpriteOp",&10C,sprites%,$database%+".!Sprites22"
  11939. $dbase%=
  11940. name$,2)
  11941. redraw_icon(-2,pbaseicon%)
  11942. scrap_sliding_block(sprsanchor%)
  11943. old$=
  11944. leaf($database%)
  11945. name$=dbasepath$+"."+name$
  11946.  "OS_CLI","Rename "+$database%+" "+name$
  11947. $database%=name$
  11948. defaults(f$,N%,key%)
  11949. confirm(
  11950. msg("Err133,"+Tag$(KF%(0,0)))) 
  11951. $Records%=
  11952. make_empty_index(N%,key%,
  11953. save_recs(f$+".Database",N%)
  11954. %present%=7:
  11955. save_keys:
  11956. save_calcs
  11957. 'design%=
  11958. :present%=1:
  11959. get_it_in(f$)
  11960. lit(iconbarM%,2,
  11961. default_key
  11962. first_writable
  11963.  chartype%(F%) 
  11964.  3,6,46,47,54,56,57:KL%(0)=len%(F%)
  11965.  len%(F%)>3 
  11966.  KL%(0)=4 
  11967.  KL%(0)=len%(F%)
  11968. Index$(0)="PrimaryKey"
  11969. key%=0
  11970. KW%()=0:KF%()=0
  11971. # 0KW%(0,0)=KL%(0)+(1<<16)+(F%<<24):KF%(0,0)=F%
  11972. set_keydata(key%)
  11973. new_tree(f%)
  11974.  REC%,I%,ptr%,file%,old$,chars%,pos%,word%,c$,p$,w$
  11975.  I%=0 
  11976.   W%=KW%(0,I%)
  11977.  W%>0 
  11978. #)$    chars%=W% 
  11979.  255:c$=
  11980. (chars%)
  11981. #*L    pos%=(W%>>8) 
  11982.  255:p$=
  11983. (pos%):
  11984.  pos%=0 
  11985.  p$="L" 
  11986.  pos%=25 
  11987.  p$="R"
  11988. #+(    word%=(W%>>16) 
  11989.  255:w$=
  11990. (word%)
  11991. #,8    old$+=Tag$(KF%(0,I%))+" ("+w$+","+p$+","+c$+"),"
  11992. old$=
  11993. old$)
  11994. #01d%=
  11995. selected(keyW%,33):s%=
  11996. selected(keyW%,32)
  11997.  f%=0
  11998. M$="Build index with "
  11999.  M$+="records in same subfiles" 
  12000.  M$+="all records in subfile "+
  12001. M$+=" of current database"
  12002.  M$+=", also restoring 'deleted' records."
  12003.  M$+=" WARNING! Other indices will need rebuilding!"
  12004. confirm(M$)=
  12005. mark_files(0,RA%,
  12006.  d%,s%,f%)
  12007. copy_keydata(0)
  12008.  "OS_File",5,$database%+".Database" 
  12009.  ,,,,len%
  12010. RA%=(len% 
  12011.  Length%)-1
  12012. scrap_sliding_block(keyanchor%(0))
  12013. make_empty_index(RA%,0,
  12014. close_window(keyW%)
  12015. redraw(keypadW%)
  12016. ptr%=!tempanchor%
  12017. poll:
  12018.  "Hourglass_On"
  12019. #C*dbasehandle%=
  12020. ($database%+".Database")
  12021.  REC%=0 
  12022.  RA%-1
  12023.   file%=ptr%?REC%
  12024.  file%<>255 
  12025.     top=8*file%+LH%
  12026. #H'    
  12027. readsmarray(dbasehandle%,REC%)
  12028.     KEY$=
  12029. key2(0,1)
  12030.     K$=
  12031. stripspaces(KEY$)
  12032.  K$<>"" 
  12033.       
  12034. insert(KEY$,0)
  12035.       
  12036.       
  12037. #O-        
  12038. scrap_sliding_block(tempanchor%)
  12039. #P%        
  12040. close_file(dbasehandle%)
  12041. #Q5        
  12042. open_index($database%+".PrimaryKey",0,
  12043. #R&        
  12044.  moan_err%,
  12045. msg("Err111")
  12046.         
  12047.  ptr%?REC%=255
  12048.       
  12049. #U        
  12050. #W0  
  12051.  "Hourglass_Percentage",(REC%*100) 
  12052.  REC%
  12053. close_file(dbasehandle%)
  12054. #ZXkeybase%=!keyanchor%(0):nextfree%=!keybase%:nodesize%=12+KL%(0)+1:offset%=8+KL%(0)+1
  12055.  REC%=0 
  12056.  RA%-1
  12057.  ptr%?REC%=255 
  12058. #]*    !(keybase%+nextfree%+offset%)=REC%
  12059.     nextfree%+=nodesize% 
  12060.  REC%
  12061. #a"newtree%=
  12062. :design%=
  12063. :adjust%=
  12064. scrap_sliding_block(tempanchor%)
  12065. Index$(0)="PrimaryKey"
  12066.  "Hourglass_Off"
  12067. present%=7
  12068. write_log(-1,"Primary key structure altered. Was "+old$)
  12069.  "Wimp_CreateMenu",,-1
  12070. file%=0:
  12071. asterisk(
  12072. get_it_in($database%)
  12073. reformat(f$)
  12074.  I%,F,REC%,dfields%,DLength%,chdd,z%,blobs%,ex%
  12075.  DTag$(),F%(),F1%(),L%(),l$(),c$()
  12076. F$(0)=""
  12077.  "OS_File",5,f$+".Form" 
  12078.  z%<>1:
  12079. softerror("",19)
  12080. #s'  
  12081.  f$=$database%:
  12082. softerror("",36)
  12083. #u$  blobs%=
  12084. find_blobs($database%)
  12085. (f$+".Form")
  12086. #F,dfields%
  12087. #xX  
  12088.  DTag$(dfields%),F%(dfields%),F1%(fields%),L%(dfields%),l$(dfields%),c$(dfields%)
  12089.  I%=1 
  12090.  dfields%
  12091. #zF    
  12092. #F,Desc$,DTag$(I%),xd%,yd%,xf%,yf%,L%(I%),char%,extra%,extra%
  12093.     DLength%+=L%(I%)+1
  12094. #}      
  12095.   chdd=
  12096. (f$+".Database")
  12097. ,  dbasehandle%=
  12098. ($database%+".Database")
  12099. compare
  12100.  "Hourglass_On"
  12101.  REC%=0 
  12102. #chdd=REC%*DLength%
  12103. '    
  12104. readsmarray(dbasehandle%,REC%)
  12105.  I%=1 
  12106.  dfields%
  12107.       S$=F$(F%(I%))
  12108. )      
  12109. (S$)>L%(I%) 
  12110. S$,L%(I%))
  12111.       
  12112. #chdd,S$
  12113.     ex%=-1
  12114.  ex%<blobs%
  12115.       ex%+=1:F%=Ext%(ex%)
  12116. F      
  12117. copy_blob($database%,f$,REC%,REC%,F%,F1%(F%),chartype%(F%))
  12118.         
  12119. 2    
  12120.  "Hourglass_Percentage",(REC%*100) 
  12121.  REC%
  12122.  "Hourglass_Off"
  12123. close_file(chdd)
  12124. close_file(dbasehandle%)
  12125.  "OS_File",18,f$+".Database",&7f2
  12126.  object$
  12127. O    
  12128.  "XOS_CLI","Copy "+$database%+"."+object$+" "+f$+"."+object$+" ~CF~V"
  12129.  object$="***"
  12130.  !Run,Cols,Indices,Log,PrimaryKey,PrintJobs
  12131.  PrintRes,Special,STemplate,Subfiles,UserFuncs,UsrSprites,ValTables,Winpos,***
  12132.  link$(0)="LOADED" 
  12133.     lk=
  12134. (f$+".Link")
  12135.  F%=1 
  12136.  dfields%
  12137.       
  12138. #lk,l$(F%)
  12139. close_file(lk)
  12140.  calc$(0)="LOADED" 
  12141.     cl=
  12142. (f$+".Calc")
  12143.  F%=1 
  12144.  dfields%
  12145.       
  12146. #cl,c$(F%)
  12147. close_file(cl)
  12148. close_window(reformW%)
  12149. reform$="":
  12150. asterisk(
  12151. write_log(-1,"Record structure changed")
  12152. compare
  12153.  source%,dest%
  12154.  dest%=1 
  12155.  dfields%
  12156.   source%=fields%+1
  12157.     source%-=1
  12158.  source%=0 
  12159.  Tag$(source%)=DTag$(dest%)
  12160. *  F%(dest%)=source%:F1%(source%)=dest%
  12161.  source%>0 
  12162.      l$(dest%)=link$(source%)
  12163.      c$(dest%)=calc$(source%)
  12164.  dest%
  12165. merge_files(f$,fi%)
  12166.  R%,REC%,ptr%,file%,d%,s%,z%,RUM%,RAM%,NL%,ex%,blobs%
  12167.  "OS_File",5,f$+".Database" 
  12168.  z%<>1:
  12169. softerror("",29)
  12170.  f$=$database%:
  12171. softerror("",15)
  12172. identical:
  12173. softerror("",21)
  12174. 7  s%=
  12175. selected(reformW%,2):d%=
  12176. selected(reformW%,3)
  12177.  fi%=0
  12178.   M$="Merge "+f$+" with "
  12179.  M$+="corresponding subfiles" 
  12180.  M$+="subfile "+
  12181. (fi%)
  12182.    M$+=" of current database"
  12183.  M$+=", also restoring deleted records"
  12184.  M$+=". WARNING! Indices will need rebuilding!"
  12185. confirm(M$)=
  12186. 0    
  12187.  "OS_File",5,f$+".Database" 
  12188.  ,,,,len%
  12189.     RAM%=(len% 
  12190.  Length%)-1
  12191. I    
  12192.  ### Load primary key of file to be merged into a spare slot ###
  12193. 2    
  12194. open_index(f$+".PrimaryKey",MaxKeys%+1,
  12195. @    
  12196.  ### Mark which subfile each new record is to go in ###
  12197. 0    
  12198. mark_files(MaxKeys%+1,RAM%,
  12199.  d%,s%,fi%)
  12200. (    keybase%=!keyanchor%(MaxKeys%+1)
  12201. F    
  12202.  ### Count how many record actually used in file to merge ###
  12203. -    
  12204. count(MaxKeys%+1,RUM%):
  12205. count(0,RU%)
  12206.     NL%=RU%+RUM%
  12207.  "Hourglass_On"
  12208. O    
  12209.  ### Expand existing file if new length (NL%) exceeds availability ###
  12210. )    
  12211.  NL%>RA% 
  12212. change_length(NL%,
  12213. &    blobs%=
  12214. find_blobs($database%)
  12215.     ptr%=!tempanchor%
  12216.  R%=0 
  12217.  RAM%-1
  12218.       file%=ptr%?R%
  12219.       
  12220.  file%<>255 
  12221.         
  12222. make_new_rec
  12223.         top=8*file%+LH%
  12224. "        
  12225. read(fields%,
  12226. ,R%,f$)
  12227. 8        
  12228. selected(reformW%,8) 
  12229.  dontincrement%=
  12230.          
  12231. write(fields%,key%)
  12232.         ex%=-1
  12233.         
  12234.  ex%<blobs%
  12235. !          ex%+=1:F%=Ext%(ex%)
  12236. C          
  12237. copy_blob(f$,$database%,R%,REC%,F%,F%,chartype%(F%))
  12238.         
  12239. 5        
  12240.  "Hourglass_Percentage",(R%*100) 
  12241.  RUM%
  12242.       
  12243.  "Hourglass_Off"
  12244. close_window(reformW%)
  12245. )    
  12246. scrap_sliding_block(tempanchor%)
  12247. 4    
  12248. scrap_sliding_block(keyanchor%(MaxKeys%+1))
  12249. !    file%=fi%:top=8*file%+LH%
  12250.      addr=
  12251. moveto(key%,top,1)
  12252. reform$="":
  12253. asterisk(
  12254. write_log(-1,"Records merged from "+f$)
  12255. identical
  12256.  I%,F,dfields%,different%
  12257. (f$+".Form")
  12258. #F,dfields%
  12259.  dfields%<>fields% 
  12260.  different%=
  12261.  I%<fields% 
  12262.  different%
  12263.   I%+=1
  12264. #F,Desc$,Tag$,xd%,yd%,xf%,yf%,len%,char%,extra%,extra%
  12265.  len%<>len%(I%) 
  12266.  different%=
  12267.  char%<>chartype%(I%) 
  12268.  (char%>8 
  12269.  chartype%(I%)>8) 
  12270.  different%=
  12271.  different%
  12272. mark_files(key%,RA%,d%,s%,f%)
  12273.  P%,I%,M,file%,top,ptr%
  12274. create_named_sliding_block(tempanchor%,RA%+1)
  12275.  "Hourglass_On"
  12276. ptr%=!tempanchor%
  12277.  I%=0 
  12278.  RA%-1
  12279.   ptr%?I%=d%
  12280.  file%=0 
  12281.     top=8*file%+LH%
  12282. !    P%=
  12283. neighbour(key%,top,1)
  12284.  P%<>top
  12285.        S%=
  12286. rec_no(k$,key%,P%)
  12287. +      
  12288.  ptr%?S%=file% 
  12289.  ptr%?S%=f%
  12290. "      P%=
  12291. neighbour(key%,P%,1)
  12292.         
  12293.  file%
  12294.  "Hourglass_Off"
  12295. print_tree(key%,file%,PR$)
  12296.  L%(),COL%,levels%,depth%
  12297. $ YTextName$=$database%+".PrintJobs.Tree"+
  12298. Index$(key%),5)+
  12299. (file%):$SaveName%=TextName$
  12300. read_print_options
  12301. reportdest$="Window"
  12302. keybase%=!keyanchor%(key%)
  12303. P%=!(keybase%+top)
  12304.  "Hourglass_On"
  12305. traverse(P%,
  12306. levels%=depth%-2:COL%=0
  12307.  L%(levels%)
  12308. tree_heading
  12309. P%=!(keybase%+top)
  12310. traverse(P%,
  12311. H$=" No. nodes     1"
  12312. H1$=" Max nodes     1"
  12313.  L%=1 
  12314.  levels%
  12315.  L%<40 
  12316.     L$=
  12317. (L%(L%))
  12318.     L$=
  12319. (L$)," ")+L$
  12320.     M$=
  12321. (2^L%)
  12322. $30    
  12323. (M$)>5 
  12324.  M$=BL$ 
  12325. (M$)," ")+M$
  12326.     H$+=L$:H1$+=M$
  12327. rule_off(45)
  12328. $8:$(!lineanchor%)=H$:
  12329. list_line(-1,lineanchor%,
  12330. (H$),32)
  12331. $9<$(!lineanchor%)=H1$:
  12332. list_line(-1,lineanchor%,
  12333. (H1$),32)
  12334. $:<$(!lineanchor%)=LH$:
  12335. list_line(-1,lineanchor%,
  12336. (LH$),32)
  12337. rule_off(45)
  12338.  "Hourglass_Off"
  12339. format$="tree":tkey%=key%
  12340. screen_list
  12341. pitch$=
  12342. pitch("2")
  12343. lit(listM%,1,
  12344. write_log(-1,"Tree printed: subfile:"+
  12345. (file%)+", key:"+
  12346. (key%)+", "+Index$(key%))
  12347. tree_heading
  12348.  zero%,len%
  12349. 6," ")
  12350. LH$=" Level No.  Root"
  12351.  L%=1 
  12352.  levels%
  12353.   L$=
  12354.  L%<10 
  12355.  L$="0"+L$
  12356.  L%<40 
  12357.     LH$+="    "+L$
  12358.     len%=
  12359. (LH$)
  12360. U$=" "+
  12361. len%-1,"-")
  12362. LenLine%=len%+4
  12363. Count%=0
  12364. $S"count%=
  12365. count_recs(key%,zero%)
  12366. $TDtextblocksize%=(count%+11)*LenLine%:textblockinc%=textblocksize%
  12367. extend_named_sliding_block(textanchor%,textblocksize%)
  12368. extend_named_sliding_block(lineanchor%,LenLine%+4)
  12369. TextPtr%=!textanchor%
  12370. recblocksize%=400
  12371. extend_named_sliding_block(recanchor%,recblocksize%)
  12372. rule_off(32)
  12373. rule_off(45)
  12374. send_title("Tree Analysis (subfile:"+
  12375. (file%)+", key:"+
  12376. (key%)+", "+Index$(key%)+")")
  12377. rule_off(32)
  12378. $^<$(!lineanchor%)=LH$:
  12379. list_line(-1,lineanchor%,
  12380. (LH$),32)
  12381. rule_off(45)
  12382. traverse(P%,Z%)
  12383.  string$
  12384. COL%=COL%+1
  12385.  COL%>depth% 
  12386.  depth%=COL%
  12387.  P%<0 
  12388. L%=!(keybase%+P%)
  12389. R%=!(keybase%+P%+4)
  12390. S$=$(keybase%+P%+8)
  12391.  S$="" 
  12392.  S$="<null>"
  12393. S$)="#"
  12394.   S$=
  12395. $n%rec%=!(keybase%+P%+8+KL%(key%)+1)
  12396.   L%(COL%-1)=L%(COL%-1)+1
  12397.  PR$="ALL" 
  12398.  COL%<=40 
  12399. $s*      string$=
  12400. COL%*6+10-
  12401. (S$)," ")+S$
  12402. $tL      $(!lineanchor%)=string$:
  12403. list_line(rec%,lineanchor%,
  12404. (string$),32)
  12405.       
  12406. $v1      string$=" "+S$+" (level "+
  12407. (COL%-1)+")"
  12408. $wL      $(!lineanchor%)=string$:
  12409. list_line(rec%,lineanchor%,
  12410. (string$),32)
  12411. $x        
  12412. traverse(L%,Z%)
  12413. COL%=COL%-1
  12414. L%=!(keybase%+P%)
  12415. R%=!(keybase%+P%+4)
  12416. S$=$(keybase%+P%+8)
  12417. %rec%=!(keybase%+P%+8+KL%(key%)+1)
  12418. traverse(R%,Z%)
  12419. COL%=COL%-1
  12420. balance(key%)
  12421.  recptr%,top,file%,flagptr%,balptr%,I%,N%,A%,max%,done%,highest%,avail%,seglen%
  12422.  recs%(),ptr%()
  12423.  recs%(5),ptr%(5)
  12424. newtree%=
  12425. seglen%=KL%(key%)+5
  12426. extend_named_sliding_block(recanchor%,seglen%*RA%)
  12427. create_named_sliding_block(balanchor%,seglen%*RA%)
  12428. create_named_sliding_block(flaganchor%,RA%)
  12429. Arecptr%=!recanchor%:flagptr%=!flaganchor%:balptr%=!balanchor%
  12430.  I%=0 
  12431.  RA%-1
  12432.   flagptr%?I%=255
  12433.  Bytes are changed from 255 to 0 where records are in use
  12434.  "Hourglass_On"
  12435.  file%=0 
  12436.   ptr%(file%)=recptr%
  12437.   top=8*file%+LH%
  12438. .  recs%(file%)=
  12439. count_recs(key%,recptr%)-1
  12440.   max%+=recs%(file%)+1
  12441.  file%
  12442. make_empty_index(RA%,key%,
  12443.  "Hourglass_LEDs",%11
  12444.  file%=0 
  12445.   top=8*file%+LH%
  12446.  recs%(file%)>=0 
  12447.     recptr%=ptr%(file%)
  12448.     N%=1
  12449.         
  12450.       N%=N%+N%
  12451.  N%>recs%(file%)+2
  12452.     step%=N%
  12453.     N%=(N% 
  12454.  2)-1
  12455.     start%=N%
  12456.     C%=0
  12457.         
  12458.       start%=start% 
  12459.       end%=N%-start%-1
  12460.       step%=step% 
  12461. $      
  12462.  I%=start% 
  12463.  end% 
  12464.  step%
  12465. 9        A%=recptr%+seglen%*(I%*(recs%(file%)+1) 
  12466. =        balptr%!C%=!A%:$(balptr%+C%+4)=$(A%+4):!A%=-!A%-1
  12467.         C%+=seglen%
  12468.       
  12469.  step%=2
  12470. %    
  12471.  I%=0 
  12472.  C%-seglen% 
  12473.  seglen%
  12474. .      REC%=balptr%!I%:KEY$=$(balptr%+I%+4)
  12475.       
  12476. insert(KEY$,key%)
  12477.       done%+=1
  12478. 6      
  12479.  "Hourglass_Percentage",(done%*100) 
  12480.  max%
  12481.  I%=0 
  12482.  recs%(file%)
  12483. #      REC%=recptr%!(seglen%*I%)
  12484.       
  12485.  REC%>=0 
  12486. (        KEY$=$(recptr%+seglen%*I%+4)
  12487.         
  12488. insert(KEY$,key%)
  12489.         done%+=1
  12490. 8        
  12491.  "Hourglass_Percentage",(done%*100) 
  12492.  max%
  12493.       
  12494.  file%
  12495.  "Hourglass_LEDs",%00
  12496. keybase%=!keyanchor%(key%)
  12497. nodesize%=8+KL%(key%)+1+4
  12498. avail%=!keybase%
  12499.  I%=0 
  12500.  highest%
  12501.  flagptr%?I%=255 
  12502. +    !(keybase%+avail%+8+KL%(key%)+1)=I%
  12503.     avail%+=nodesize%
  12504.  "Hourglass_Off"
  12505. scrap_sliding_block(balanchor%)
  12506. scrap_sliding_block(recanchor%)
  12507. scrap_sliding_block(flaganchor%)
  12508. save_keys
  12509. newtree%=
  12510. asterisk(
  12511. write_log(-1,"Index "+Index$(key%)+" balanced")
  12512. duplicates(key%)
  12513.  P$,S$,RP$,RS$,addr,top,RP%,RS%,count%,examined%,file%,flag%
  12514. abort_dup:
  12515. YTextName$=$database%+".PrintJobs.Dupl"+
  12516. Index$(key%),5)+
  12517. (file%):$SaveName%=TextName$
  12518. read_print_options
  12519. Breportdest$="Window":format$="dup":Count%=0:LenLine%=KL%(0)+23
  12520. <textblocksize%=100*LenLine%:textblockinc%=textblocksize%
  12521. extend_named_sliding_block(textanchor%,textblocksize%)
  12522. extend_named_sliding_block(lineanchor%,LenLine%+4)
  12523. TextPtr%=!textanchor%
  12524. recblocksize%=400
  12525. extend_named_sliding_block(recanchor%,recblocksize%)
  12526. rule_off(32)
  12527. Yline$=" Duplicated keys":$(!lineanchor%)=line$:
  12528. list_line(-1,lineanchor%,
  12529. (line$),32)
  12530.  "Hourglass_On"
  12531.  file%=0 
  12532. rule_off(45)
  12533. ]  line$=" "+$Subfile%(file%):$(!lineanchor%)=line$:
  12534. list_line(-1,lineanchor%,
  12535. (line$),32)
  12536. rule_off(32)
  12537.   top=8*file%+LH%
  12538. !  addr=
  12539. neighbour(key%,top,1)
  12540. 0  count%=
  12541. count_recs(key%,zero%):examined%=0
  12542.  addr<>top
  12543.  "OS_Byte",229,0
  12544. P    S$=$(!keyanchor%(key%)+addr+8):RS%=!(!keyanchor%(key%)+addr+9+KL%(key%))
  12545. =    RS$=
  12546. (RS%):RS$=" Record No."+
  12547. (RS$)," ")+RS$+"   "
  12548.  S$<>P$ 
  12549. '      P$=S$:RP%=RS%:RP$=RS$:flag%=
  12550.       
  12551.       
  12552.  flag% 
  12553.         line$=RP$+P$
  12554. I        $(!lineanchor%)=line$:
  12555. list_line(RP%,lineanchor%,
  12556. (line$),32)
  12557.         flag%=
  12558.       
  12559.       line$=RS$+S$
  12560. G      $(!lineanchor%)=line$:
  12561. list_line(RS%,lineanchor%,
  12562. (line$),32)
  12563.         
  12564.     examined%+=1
  12565. 8    
  12566.  "Hourglass_Percentage",examined%*100 
  12567.  count%
  12568. $    addr=
  12569. neighbour(key%,addr,1)
  12570.  file%
  12571. rule_off(32)
  12572.  "Hourglass_Off"
  12573. screen_list
  12574. abort_dup
  12575.  "Hourglass_Off"
  12576. screen_list
  12577. softerror("",67)
  12578. wimp_error(
  12579.  >RAMtree
  12580.  Index handling ------------------------------------------------------
  12581. neighbour(key%,addr%,d%)
  12582.  R%,S%,p%,keybase%
  12583. keybase%=!keyanchor%(key%)
  12584. p%=d%*4
  12585. R%=!(keybase%+addr%+p%)
  12586.  R%<0 
  12587.  =-R%
  12588. p%=4-p%
  12589.   addr%=R%
  12590.   S%=!(keybase%+addr%+p%)
  12591.  S%>0 
  12592.  R%=S%
  12593.  S%<=0
  12594. rec_no(
  12595.  k$,key%,addr%)
  12596. %$#k$=$(!keyanchor%(key%)+addr%+8)
  12597. %%-=!(!keyanchor%(key%)+addr%+8+KL%(key%)+1)
  12598. scan_file(c$,key%,file%,action%,direc%)
  12599.  REC%,examined%,subtotal%,X%,Y%,n$,copy%,I%
  12600. n$="0123456789."
  12601. %*%subtotal%=
  12602. count_recs(key%,zero%)
  12603. (c$)=
  12604.  "OS_Byte",229,0
  12605.   REC%=
  12606. rec_no(k$,key%,P%)
  12607. %.%  
  12608. readsmarray(dbasehandle%,REC%)
  12609.   examined%+=1
  12610. (Search$)=
  12611.  action% 
  12612.       
  12613. get_lengths
  12614.       
  12615.       
  12616.  format$="label" 
  12617. %5"        
  12618.  copy%=1 
  12619.  labcopies%
  12620. %6$          
  12621. print_record(REC%,P%)
  12622.         
  12623.  copy%
  12624. %8$        
  12625. print_record(REC%,P%)
  12626.       
  12627. %:/      
  12628.  2:ptr%?REC%=file%:
  12629.  ### earmark ###
  12630. %;?      
  12631. write_csv_rec(REC%,Form$,csvhandle%):
  12632. poll:
  12633. %<9      
  12634.  4:KEY$=
  12635. key2(newkey%,1):
  12636. insert(KEY$,newkey%)
  12637. %=       
  12638.  ### create index ###
  12639.       
  12640.       S$=F$(Menufield%)
  12641.       
  12642. %AC        
  12643. New$,$ws%)>0:S$=
  12644. wildcard_replace(S$,Old$,New$,$ws%)
  12645. %BC        
  12646. New$,$wc%)>0:S$=
  12647. wildcard_replace(S$,Old$,New$,$wc%)
  12648.         
  12649.  numeric%:
  12650.         X%=0:Y%=0
  12651.         
  12652.  X%+=1
  12653. %F)        
  12654. (S$) 
  12655. S$,X%,1))>0
  12656.         
  12657.  X%<=
  12658. (S$) 
  12659.           Y%=X%
  12660.           
  12661.  Y%+=1
  12662. %J+          
  12663. (S$) 
  12664. S$,Y%,1))=0
  12665.         
  12666. %L9        S$=
  12667. S$,X%-1)+
  12668. S$,X%,Y%-X%)+New$))+
  12669. S$,Y%)
  12670. %M*        
  12671.  Old$<>"":
  12672.  S$=Old$ 
  12673.  S$=New$
  12674.         
  12675. :S$=New$
  12676.       
  12677.       
  12678. (S$)>TextLength% 
  12679.         
  12680. softerror("",10)
  12681.         
  12682.         F$(Menufield%)=S$
  12683. %T,        
  12684. writesmarray(dbasehandle%,REC%)
  12685.       
  12686. %V!      
  12687.  ### global change ###
  12688.       
  12689.       
  12690.  I%=1 
  12691.  fields%
  12692.         $Rf%(I%)=F$(I%)
  12693.       
  12694. %[?      
  12695. update_calcs(0) 
  12696. writesmarray(dbasehandle%,REC%)
  12697. %\:      
  12698.  ### update time-dependent calcs on opening ###
  12699.       
  12700.       F$(F%)=sequenceval$
  12701. %_+      sequenceval$=
  12702. (sequenceval$)+1)
  12703. %`*      
  12704. writesmarray(dbasehandle%,REC%)
  12705. %a1      $(!keyanchor%(key%)+P%+8)=
  12706. key2(key%,1)
  12707. %b        
  12708. %d#  P%=
  12709. neighbour(key%,P%,direc%)
  12710. %e;  
  12711.  "Hourglass_Percentage",(examined%*100) 
  12712.  subtotal%
  12713. wildcard_replace(S$,Old$,New$,type$)
  12714.  old$,new$,old2$,new2$,c$,L%,P%,R%
  12715.  type$ 
  12716.  $ws%:
  12717. %oD    
  12718. Old$,1)=$ws% 
  12719. New$,1)=$ws% 
  12720. Old$)=$ws% 
  12721. New$)=$ws%:
  12722. %p'    old$=
  12723. Old$,2)):new$=
  12724. New$,2))
  12725.     P%=
  12726. S$,old$)
  12727. %r2    
  12728.  P%>0 
  12729. S$,P%-1)+new$+
  12730. S$,P%+
  12731. (old$))
  12732. %s(    
  12733. Old$,1)=$ws% 
  12734. New$,1)=$ws%:
  12735. %t/    old$=
  12736. Old$,2):new$=
  12737. New$,2)::R%=
  12738. (old$)
  12739. %u.    
  12740. S$,R%)=old$ 
  12741. (S$)-R%)+new$
  12742. %v$    
  12743. Old$)=$ws% 
  12744. New$)=$ws%:
  12745. %w*    old$=
  12746. Old$):new$=
  12747. New$):L%=
  12748. (old$)
  12749. %x*    
  12750. S$,L%)=old$ 
  12751.  S$=new$+
  12752. S$,L%+1)
  12753. %y(    
  12754. Old$,$ws%)>0 
  12755. New$,$ws%)>0:
  12756. %zP    P%=
  12757. Old$,$ws%):old$=
  12758. Old$,P%-1):L%=
  12759. (old$):old2$=
  12760. Old$,P%+1):R%=
  12761. (old2$)
  12762. %{9    P%=
  12763. New$,$ws%):new$=
  12764. New$,P%-1):new2$=
  12765. New$,P%+1)
  12766. %|*    
  12767. S$,L%)=old$ 
  12768.  S$=new$+
  12769. S$,L%+1)
  12770. %}0    
  12771. S$,R%)=old2$ 
  12772. (S$)-R%)+new2$
  12773.  $wc%:
  12774. (Old$)=
  12775. (New$) 
  12776.  P%=1 
  12777. (Old$)
  12778.       c$=
  12779. Old$,P%,1)
  12780. ;      
  12781.  c$<>$wc% 
  12782. S$,P%,1) 
  12783. S$,P%,1)=
  12784. New$,P%,1)
  12785. search(S$,key%,M%)
  12786.  P%,found%,info$,keybase%,rec%,cond$
  12787. keybase%=!keyanchor%(key%)
  12788. Z%=0:P%=top:ident%=
  12789.   L%=P%
  12790.   P%=!(keybase%+L%+Z%)
  12791.  P%<=0 
  12792.  P%=-L%:found%=
  12793.   info$=$(keybase%+P%+8)
  12794.   rec%=
  12795. rec_no(k$,key%,P%)
  12796. (val$+"(S$)="+val$+"LEFT$(info$,kl%)") 
  12797.       
  12798.  0:ident%=(key%=0)
  12799.       
  12800.  1,3:found%=
  12801. $      
  12802.  rec%=REC% 
  12803.  found%=
  12804.         
  12805.  found% 
  12806.  Z%=-
  12807. (val$+"(S$)>="+val$+"(info$)")*4
  12808.  found%
  12809.  ### M%=0 - Find leaf position at which to insert ###
  12810.  ### M%=1 - Find first match in tree (if there is one) ###
  12811.  ### M%=2 - Find exact matching record, checking for record no. ###
  12812. insert(
  12813.  S$,key%)
  12814.  P%,avail%,kl%,keybase%,abort%
  12815.  S$="" 
  12816.  null%(key%)=
  12817. keybase%=!keyanchor%(key%)
  12818. "kl%=KL%(key%):val$=
  12819. type(key%)
  12820. search(S$,key%,0)
  12821.  ident% 
  12822. !    
  12823. selected(passW%,15):
  12824. "    
  12825. softerror(S$,37):abort%=
  12826. L    
  12827. selected(prefsW%,34) 
  12828. confirm(
  12829. msg("Err45,"+S$)) 
  12830.  abort%=
  12831.  abort% 
  12832.  S$="*Failed*":
  12833. nextfree%=!keybase%
  12834.  !(keybase%+nextfree%)<=0 
  12835.   incr%=
  12836. ($Increment%)
  12837.  incr%>0 
  12838. #    
  12839. change_length(RA%+incr%,
  12840.  S$="*Failed*"
  12841.  S$="*Failed*" 
  12842. softerror("",2):
  12843.  avail%=!(keybase%+nextfree%)
  12844. .!(keybase%+nextfree%+Z%)=!(keybase%+P%+Z%)
  12845. $!(keybase%+nextfree%+(4-Z%))=-P%
  12846. $(keybase%+nextfree%+8)=S$
  12847. ,!(keybase%+nextfree%+8+KL%(key%)+1)=REC%
  12848. !(keybase%+P%+Z%)=nextfree%
  12849. !keybase%=avail%
  12850.  key%=0 
  12851.  RU%+=1
  12852. delete(
  12853.  S$,key%)
  12854.  P%,A%,kl%,keybase%
  12855.  S$="" 
  12856.  null%(key%)=
  12857. keybase%=!keyanchor%(key%)
  12858. A%=!keybase%
  12859. "kl%=KL%(key%):val$=
  12860. type(key%)
  12861. search(S$,key%,2)
  12862.  P%<0 
  12863. softerror(S$+","+Index$(key%),1):S$="*Failed*":
  12864. neighbour(key%,P%,0)
  12865. neighbour(key%,P%,1)
  12866. '!(keybase%+L%+Z%)=!(keybase%+P%+Z%)
  12867.     Q%=P%
  12868. ZL%=4-Z%
  12869. P1%=!(keybase%+P%+ZL%)
  12870.  P1%>0 
  12871.   info$=$(keybase%+P1%+8)
  12872.   P%=-
  12873. search(info$,key%,0)
  12874.   !(keybase%+P%+Z%)=P1%
  12875.  !(keybase%+PR%+4)<=0 
  12876.  !(keybase%+PR%+4)=-SU%
  12877.  !(keybase%+SU%+0)<=0 
  12878.  !(keybase%+SU%+0)=-PR%
  12879. !(keybase%+Q%)=A%
  12880. !keybase%=Q%
  12881.  key%=0 
  12882.  RU%-=1
  12883. save_keys
  12884.  keyN%
  12885.  present%<>7 
  12886.  "Hourglass_On"
  12887. refresh_dates
  12888. 5keybase%=!keyanchor%(0):keybase%!4=
  12889. ($Increment%)
  12890.  !keyanchor%(keyN%)>0
  12891. !  keybase%=!keyanchor%(keyN%)
  12892.  "SlidingHeap_DescribeBlock",slidingheapbase%,keyanchor%(keyN%) 
  12893.  ,,filelength%
  12894.  keyN%=0 
  12895.     index$=""
  12896.  index$="Indices."
  12897.  "OS_File",10,$database%+"."+index$+Index$(keyN%),&7F0,,keybase%,keybase%+filelength%
  12898.   keyN%+=1
  12899.  "Hourglass_Percentage",keyN%*100 
  12900.  (Keys%+1)
  12901.  "Hourglass_Off"
  12902. readsmarray(filehandle%,REC%)
  12903.  loop%
  12904. #filehandle%=REC%*Length%
  12905.  loop%=1 
  12906.  fields%
  12907.   F$(loop%)=
  12908. #filehandle%
  12909.  loop%
  12910. writesmarray(F,
  12911.  loop%,F$,L%
  12912. #F=R%*Length%
  12913.  loop%=1 
  12914.  fields%
  12915. !  F$=F$(loop%):L%=len%(loop%)
  12916. (F$)<=L% 
  12917. #F,F$ 
  12918. L%,"!")
  12919.  loop%
  12920.     R%+=1
  12921. check_save(T%)
  12922.  time%
  12923.  T%=0 
  12924.  "OS_ReadMonotonicTime" 
  12925.  time%
  12926.  (time% 
  12927.  T%)<10 
  12928.  buttonfield%(0,19)>0 
  12929.  wi%=mainW%:ic%=field%(buttonfield%(0,19)) 
  12930.  wi%=keypadW%:ic%=19
  12931.  autosave% 
  12932.     delay%=
  12933.  loop%=0 
  12934.       
  12935. invert(wi%,ic%)
  12936.       delay%+=50
  12937.       
  12938. >delay%
  12939.       
  12940.  1,-15,180,5
  12941.       
  12942. invert(wi%,ic%)
  12943.       delay%+=50
  12944.       
  12945. >delay%
  12946.  loop%
  12947. invert(wi%,ic%)
  12948. mouse(0,0,4,wi%,ic%)
  12949. invert(wi%,ic%)
  12950.  Calculations ---------------------------------------------------------
  12951. calc_link(T$,type%)
  12952.  ### Sets up calculation formula window & menu entry ###
  12953. $CalcFunc%=T$
  12954.  I%=1 
  12955.   T$=
  12956. &&)$CalcTitle%=T$:calclink%=Fieldnumber%
  12957. split_link(calclink%,real$,visible$)
  12958.  type% 
  12959. &)3  
  12960.  6,7:$CalcForm%=Tag$(calclink%)+"="+visible$
  12961.   $CalcForm%=visible$
  12962. shade(calcW%,2,off%)
  12963. deselect(calcW%,2)
  12964. calc_formula(S$)
  12965.  ### Parses calculation formula (S$) & builds calc$(I%) ###
  12966.  I%,P%,t$,s$,C$,time%,date%,user%
  12967.  ic% 
  12968. close_window(wi%)
  12969. &71  C$=
  12970. ~(calclink%):
  12971.  calclink%<16 
  12972.  C$="0"+C$
  12973. &8%  
  12974.  $CalcFunc%="Set base value" 
  12975.  S$="" 
  12976.  S$="0"
  12977. &:"    calc$(calclink%)=S$+"|"+S$
  12978.     calc$(0)="LOADED"
  12979. &<        
  12980. &=,    P%=
  12981. S$,"="):S$=
  12982. S$,P%+1):visible$=S$
  12983.  I%=fields% 
  12984.       t$=Tag$(I%)
  12985.       
  12986.  t$<>"" 
  12987.         P%=0
  12988.         
  12989. &C'          user%=(
  12990. S$,"FNU",P%+1)>0)
  12991.           P%=
  12992. S$,t$,P%+1)
  12993.           
  12994.  P%>0 
  12995. &F"            
  12996.  chartype%(I%) 
  12997. &Ga              
  12998.  3,6,46,47,54,56,57:
  12999.  user% 
  13000.  s$="$Rf%("+
  13001. (I%)+")" 
  13002.  s$="VAL($Rf%("+
  13003. (I%)+"))"
  13004. &H:              
  13005.  5:s$="FNdays($Rf%("+
  13006. (I%)+"))":date%=
  13007. &I=              
  13008.  8:s$="FNseconds($Rf%("+
  13009. (I%)+"))":time%=
  13010.               
  13011. &K+              
  13012.  chartype%(calclink%) 
  13013. &LL                
  13014.  user% 
  13015.  s$="$Rf%("+
  13016. (I%)+")" 
  13017.  s$="FNn("+
  13018. (I%)+")"
  13019. &M,                
  13020.  7:s$="$Rf%("+
  13021. (I%)+")"
  13022.               
  13023.             
  13024. &P-            S$=
  13025. S$,P%-1)+s$+
  13026. S$,P%+
  13027. (t$))
  13028.             update$(I%)+=C$
  13029.           
  13030.         
  13031.  P%=0
  13032.       
  13033. &V/    
  13034. visible$,"TIME$")>0 
  13035.  update$(0)+=C$
  13036. &W@    
  13037.  time%=
  13038.  chartype%(calclink%)=7 
  13039.  S$="FNtime("+S$+")"
  13040. &XW    
  13041.  date%=
  13042.  chartype%(calclink%)=7 
  13043.  S$="FNdate("+S$+","+
  13044. (len%(calclink%))+")"
  13045. &Y#    
  13046. (S$)+
  13047. (visible$)+2<256 
  13048. &Z.      calc$(calclink%)="#"+S$+"#"+visible$
  13049.       calc$(0)="LOADED"
  13050. &\9      
  13051. selected(calcW%,2) 
  13052. recalculate(calclink%)
  13053.       
  13054. softerror("",44)
  13055. &^        
  13056.   calclink%=0
  13057. asterisk(
  13058. &b*  
  13059.  (b% 
  13060.  %111)=4 
  13061. close_window(wi%)
  13062. recalculate(F%)
  13063.  F,I%,R%,k$,P%,real$,visible$,subtotal%,zero%,examined%
  13064. softerror(real$,73):
  13065. split_link(F%,real$,visible$)
  13066. confirm("Recalculate "+Tag$(F%)+"="+visible$+" for existing records?")=
  13067. &l%subtotal%=
  13068. count_recs(key%,zero%)
  13069.  "Hourglass_On"
  13070. &n*dbasehandle%=
  13071. ($database%+".Database")
  13072. neighbour(key%,top,1)
  13073.  P%<>top
  13074.   R%=
  13075. rec_no(k$,key%,P%)
  13076. &r#  
  13077. readsmarray(dbasehandle%,R%)
  13078.  I%=1 
  13079.  fields%
  13080. &t-    
  13081.  chartype%(I%)<>40 
  13082.  $Rf%(I%)=F$(I%)
  13083.  chartype%(F%) 
  13084.     F=
  13085. (real$):F$=
  13086. &y+    
  13087.  fix%(F%)>0 
  13088. fix_point(F$,F%)
  13089.  7:F$=
  13090. (real$)
  13091. &|#  
  13092. (F$)<=len%(F%) 
  13093.  F$(F%)=F$
  13094. &}$  
  13095. writesmarray(dbasehandle%,R%)
  13096.   P%=
  13097. neighbour(key%,P%,1)
  13098.   examined%+=1
  13099.  "Hourglass_Percentage",examined%*100 
  13100.  subtotal%
  13101.  "Hourglass_Off"
  13102. close_file(dbasehandle%)
  13103.  I%=1 
  13104.  fields%
  13105.  chartype%(I%)<>40 
  13106.  $Rf%(I%)=field$(I%)
  13107. display(key%,addr)
  13108. asterisk(
  13109. save_calcs
  13110.  calc$(0)="LOADED" 
  13111.   cl=
  13112. ($database%+".Calc")
  13113.  F%=1 
  13114.  fields%
  13115. #cl,calc$(F%)
  13116. close_file(cl)
  13117. sums(
  13118.  F$,F%,type%)
  13119.  F$<>"" 
  13120.  type% 
  13121.  8:V=
  13122. seconds(F$)
  13123.   Sum(F%,0)+=1
  13124.   Sum(F%,1)+=V
  13125.   Sum(F%,3)+=V*V
  13126.  V>Sum(F%,4) 
  13127.  Sum(F%,4)=V
  13128.  V<Sum(F%,5) 
  13129.  Sum(F%,5)=V
  13130. ctotals(flag%)
  13131.  F%,I%,J%,N%,R%,S%,base%,pos%,F$
  13132.  S$(),f%()
  13133.  S$(5),f%(5)
  13134. base%=!lineanchor%
  13135. 3S$()="Items","Sum","Mean","St.Dev.","Max","Min"
  13136.  I%=1 
  13137. (Form$)-1 
  13138.   F%=
  13139. fnum(
  13140. Form$,I%,2))
  13141.   R%=calcrow%?F%
  13142.  chartype%(F%) 
  13143.  3,6,8,46,47,54,56,57:
  13144.  Sum(R%,0)>0 
  13145. '      Sum(R%,2)=Sum(R%,1)/Sum(R%,0)
  13146. 6      Sum(R%,3)=
  13147. (Sum(R%,3)/Sum(R%,0)-Sum(R%,2)^2)
  13148.         
  13149. '    
  13150.  Sum(R%,5)=10^30 
  13151.  Sum(R%,5)=0
  13152.  J%=0 
  13153.   pos%=base%
  13154.  flag%>0 
  13155. >    N%=0:start%=1:F$=
  13156. Lmargin%-
  13157. (S$(J%))-1," ")+S$(J%)+" "
  13158.  N%=1:start%=3
  13159. &    L%=Tab%(1)-Lmargin%-
  13160. (spacer$)
  13161. N    
  13162.  L%>=7 
  13163.  F$=margin$+
  13164. tab(S$(J%),N%) 
  13165.  F$=margin$+
  13166. S$(J%),L%),N%)
  13167. heap_store(lineanchor%,LenLine%,0,pos%,0,F$)
  13168. (Form$)>2 
  13169.  start%=1 
  13170. $    
  13171.  I%=start% 
  13172. (Form$)-1 
  13173. &      F%=
  13174. fnum(
  13175. Form$,I%,2)):F$=""
  13176.       N%+=1
  13177.       
  13178.  chartype%(F%) 
  13179. #        
  13180.  3,6,8,46,47,54,56,57:
  13181.         R%=calcrow%?F%
  13182. Q        
  13183.  chartype%(F%)=8 
  13184.  result$=
  13185. time(Sum(R%,J%)) 
  13186.  result$=
  13187. (Sum(R%,J%))
  13188. T        
  13189. selected(pselectW%,R%*8+2+J%) 
  13190. justify(result$,N%,N%-1):f%(J%)=1
  13191.       
  13192. @      
  13193. heap_store(lineanchor%,LenLine%,0,pos%,0,
  13194. tab(F$,N%))
  13195. =    
  13196.  f%(J%)=1 
  13197. list_line(-1,lineanchor%,pos%-base%,32)
  13198. (f%())>0 
  13199. rule_off(45)
  13200. margin_warn
  13201.  f%,F%,R%,J%
  13202. fnum(
  13203. Form$,2))
  13204.  chartype%(F%) 
  13205.  3,6,8,46,47,54,56,57:
  13206.   R%=calcrow%?F%
  13207.  J%=0 
  13208. 0    
  13209. selected(pselectW%,R%*8+2+J%) 
  13210.  f%=F%
  13211.  f%>0 
  13212.  Lmargin%<9 
  13213. softerror(Tag$(f%),92):=-1
  13214. tab(F$,N%)
  13215. (F$)+
  13216. (spacer$)
  13217.  Tab%(N%)-Tab%(N%-1)-L%<=0 
  13218. =F$+spacer$
  13219. ,=F$+
  13220. Tab%(N%)-Tab%(N%-1)-L%," ")+spacer$
  13221. justify(f$,x%,x1%)
  13222. $L%=Tab%(x%)-Tab%(x1%)-
  13223. (spacer$)
  13224. (f$)>L% 
  13225.   f$=
  13226. f$,L%)
  13227. (f$)," ")+f$
  13228. f$)="." 
  13229.  f$=" "+
  13230. execute_file(F%)
  13231.  file$,d%
  13232. link$(F%),1)="@" 
  13233.   file$=
  13234. link$(F%),2)
  13235.  "OS_File",5,file$ 
  13236.  d%,,type%
  13237.   type%=(type%>>8) 
  13238.  &fff
  13239.  type% 
  13240. %    
  13241.  &fff:
  13242. execute_script(file$)
  13243. 8    block%!0=256:block%!12=0:block%!16=5:block%!20=0
  13244. 7    block%!24=0:block%!28=0:block%!32=0:block%!36=0
  13245. /    block%!40=type%:$(block%+44)=file$+
  13246. )    
  13247.  "Wimp_SendMessage",18,block%,0
  13248. execute_script(f$)
  13249.  F,P%,name$,command$,finished%,firstquery%,state%
  13250. confirm(
  13251. msg("Err68,"+
  13252. leaf(f$))) 
  13253. selected(printW%,39) 
  13254.  reportdest$="File" 
  13255.  reportdest$="Window"
  13256.  Script file signature
  13257. junk$=
  13258. abort_script:
  13259.  finished%)
  13260.  "OS_Byte",229,0
  13261.   line$=
  13262.   space%=
  13263. line$," ")
  13264.  space%=0 
  13265.  command$=line$:params$="" 
  13266.  command$=
  13267. line$,space%-1):params$=
  13268. line$,space%+1):state%=(params$="ON")
  13269.  command$ 
  13270.  "!COMMENT":
  13271.  "!SCRIPT":
  13272.     ImpCom$=""
  13273.  params$="END" 
  13274.       finished%=
  13275. <      
  13276. execute_script($database%+".PrintRes."+params$)
  13277.         
  13278.  "!DELETE":
  13279.  present%=7 
  13280.       RecF%=
  13281. 0      
  13282.  params$="" 
  13283.  key$=
  13284.  key$=params$
  13285. 3      
  13286. select(searchW%,6):
  13287. deselect(searchW%,5)
  13288.       addr=
  13289. find(key$,0,
  13290.       
  13291.  RecF%=
  13292.         addr=
  13293. shift(0,0,0)
  13294. $        addr=
  13295. moveto(key%,top,1)
  13296.       
  13297. '         
  13298.  "!INSERT":
  13299.  present%=7 
  13300. '#0      subfile%=
  13301. (params$):top=8*subfile%+LH%
  13302.       
  13303. make_new_rec
  13304.       
  13305.  loop%=1 
  13306.  fields%
  13307. '&)        $Rf%(loop%)=
  13308. #F,len%(loop%))
  13309.       
  13310.       
  13311. write(fields%,key%)
  13312.       top=8*file%+LH%
  13313.       
  13314. asterisk(
  13315. '+        
  13316.  "!CHANGE":
  13317.  params$<>"" 
  13318.       P%=
  13319. params$,",")
  13320. '/2      f$=
  13321. params$,P%-1):params$=
  13322. params$,P%+1)
  13323.       F%=
  13324. field(f$,
  13325.       P%=
  13326. params$,",")
  13327. '25      from$=
  13328. params$,P%-1):params$=
  13329. params$,P%+1)
  13330. '33      to$=
  13331. params$,P%-1):$Query%=
  13332. params$,P%+1)
  13333. '4'      
  13334. changes(key%,F%,from$,to$,
  13335. '5        
  13336.  "!QUERY":
  13337.  params$<>"" 
  13338.       P%=
  13339. params$,",")
  13340. '95      $Query%=
  13341. params$,P%+1):name$=
  13342. params$,P%-1)
  13343. ':H      
  13344. name$,"$")=0 
  13345.  f$=$database%+".PrintJobs."+name$ 
  13346.  f$=name$
  13347.       Search$=
  13348. parse
  13349.       
  13350.  "Hourglass_On"
  13351.       
  13352.  reportdest$ 
  13353. '>#        
  13354.  "Window":TextName$=f$
  13355. '?&        
  13356.  "File":texthandle%=
  13357.         
  13358.  ImpCom$<>"" 
  13359.           
  13360. 'B-            
  13361.  firstquery%=
  13362. :firstquery%=
  13363. 'C'            
  13364. #texthandle%,ImpCom$
  13365.           
  13366.         
  13367.       
  13368.       
  13369. do_it(Search$,-1)
  13370. 'H        
  13371.  "!CSV":
  13372.     P%=
  13373. params$,",")
  13374. 'K3    $Query%=
  13375. params$,P%+1):name$=
  13376. params$,P%-1)
  13377. 'LF    
  13378. name$,"$")=0 
  13379.  f$=$database%+".PrintJobs."+name$ 
  13380.  f$=name$
  13381. write_csv(f$)
  13382.  "!SELECTION":
  13383.  params$<>"" 
  13384. 'P3      filename$=$database%+".PrintRes."+params$
  13385. 'Q-      
  13386.  "OS_File",5,filename$ 
  13387.  ,,ftype%
  13388. 'R#      ftype%=(ftype%>>8) 
  13389.  &FFF
  13390. 'S4      
  13391.  ftype%=&7F3 
  13392. load_selection(filename$)
  13393.       
  13394. clear_selection
  13395. 'U        
  13396.  "!PRINTOPTS":
  13397.  params$<>"" 
  13398. 'X3      filename$=$database%+".PrintRes."+params$
  13399. 'Y-      
  13400.  "OS_File",5,filename$ 
  13401.  ,,ftype%
  13402. 'Z#      ftype%=(ftype%>>8) 
  13403.  &FFF
  13404. '[9      
  13405.  ftype%=&7F5 
  13406. get_options(printW%,filename$)
  13407.       
  13408. ']?      
  13409.  "OS_File",5,$database%+".PrintRes.PrtOptions" 
  13410.       
  13411.  d%=1 
  13412. '_C        
  13413. get_options(printW%,$database%+".PrintRes.PrtOptions")
  13414. '`F        
  13415. get_options(printW%,"<Pbase$Dir>.Resources.PrtOptions")
  13416.       
  13417. 'b        
  13418. 'c-    
  13419.  "!CASE":
  13420. set_icon(queryW%,1,state%)
  13421. 'd0    
  13422.  "!EXPAND":
  13423. set_icon(printW%,11,state%)
  13424. 'e.    
  13425.  "!DATE":
  13426. set_icon(printW%,19,state%)
  13427. 'f/    
  13428.  "!UPPER":
  13429. set_icon(printW%,12,state%)
  13430. 'g0    
  13431.  "!HEADER":
  13432. set_icon(printW%,47,state%)
  13433. 'h0    
  13434.  "!FOOTER":
  13435. set_icon(printW%,48,state%)
  13436. 'i/    
  13437.  "!FIRST":
  13438. set_icon(printW%,10,state%)
  13439. 'j3    
  13440.  "!UNDERLINE":
  13441. set_icon(printW%,29,state%)
  13442. 'k0    
  13443.  "!SHRINK":
  13444. set_icon(printW%,40,state%)
  13445. 'l1    
  13446.  "!CONTROL":
  13447. set_icon(printW%,42,state%)
  13448. 'm-    
  13449.  "!TITLE":$
  13450. text(printW%,18)=params$
  13451. 'n,    
  13452.  "!PAGE":$
  13453. text(printW%,16)=params$
  13454. 'o1    
  13455.  "!LINESPACE":$
  13456. text(printW%,17)=params$
  13457. 'p/    
  13458.  "!LMARGIN":$
  13459. text(printW%,30)=params$
  13460. 'q/    
  13461.  "!TMARGIN":$
  13462. text(printW%,32)=params$
  13463. 'r.    
  13464.  "!SPACER":$
  13465. text(printW%,43)=params$
  13466. 's0    
  13467.  "!COLWIDTH":$
  13468. text(printW%,45)=params$
  13469. 't1    
  13470.  "!TEXTWIDTH":$
  13471. text(printW%,34)=params$
  13472.  "!HEADINGS":
  13473. u(params$) 
  13474. 'w7      
  13475.  "D":
  13476. select(printW%,2):
  13477. deselect(printW%,1)
  13478. 'x3      
  13479. select(printW%,1):
  13480. deselect(printW%,2)
  13481. 'y        
  13482.  "!PITCH":
  13483. '{3    
  13484. deselect(printW%,
  13485. selected_esg(printW%,2))
  13486. (params$) 
  13487. '}       
  13488. select(printW%,4)
  13489. '~!      
  13490. select(printW%,7)
  13491. !      
  13492. select(printW%,8)
  13493.       
  13494. select(printW%,6)
  13495.         
  13496.  "!FORMAT":
  13497. 3    
  13498. deselect(printW%,
  13499. selected_esg(printW%,3))
  13500. shade(printW%,15,
  13501. Q    P%=
  13502. params$," "):
  13503.  P%>0 
  13504.  cols$=
  13505. params$,P%+1):params$=
  13506. params$,P%-1))
  13507.  params$ 
  13508. *      
  13509.  "VERTICAL":
  13510. select(printW%,24)
  13511. '      
  13512.  "TABLE":
  13513. select(printW%,25)
  13514. "      $
  13515. text(printW%,15)=cols$
  13516.       
  13517. shade(printW%,15,
  13518. '      
  13519.  "LABEL":
  13520. select(printW%,26)
  13521.       
  13522. select(printW%,23)
  13523.         
  13524.  "!DESTINATION":
  13525. 3    
  13526. deselect(printW%,
  13527. selected_esg(printW%,4))
  13528.     params$=
  13529. u(params$)
  13530.  params$ 
  13531. 9      
  13532.  "FILE":
  13533. select(printW%,39):reportdest$="File"
  13534. ?      
  13535.  "PRINTER":
  13536. select(printW%,41):reportdest$="Printer"
  13537.       
  13538. 2      
  13539. select(printW%,38):reportdest$="Window"
  13540. 8      TextName$=$database%+".PrintJobs."+
  13541. query$,10)
  13542.         
  13543.  "!LABEL":
  13544.     params$+=","
  13545.  I%=1 
  13546.       P%=
  13547. params$,",")
  13548. 4      par$=
  13549. params$,P%-1):params$=
  13550. params$,P%+1)
  13551.       
  13552.         
  13553. 7        
  13554. deselect(labelW%,
  13555. selected_esg(labelW%,1))
  13556.         
  13557.  par$ 
  13558. &          
  13559.  "1":
  13560. select(labelW%,0)
  13561. &          
  13562.  "2":
  13563. select(labelW%,1)
  13564. "          
  13565. select(labelW%,2)
  13566.         
  13567. &        
  13568. text(labelW%,4)=par$
  13569. &        
  13570. text(labelW%,6)=par$
  13571. '        
  13572. text(labelW%,10)=par$
  13573. '        
  13574. text(labelW%,12)=par$
  13575. '        
  13576. text(labelW%,17)=par$
  13577. ,        
  13578. set_icon(labelW%,11,(par$<>""))
  13579. 4        
  13580. shade(labelW%,12,
  13581. selected(labelW%,11))
  13582. 5        
  13583. set_icon(labelW%,13,(
  13584. u(par$)="ON"))
  13585. 5        
  13586. set_icon(labelW%,16,(
  13587. u(par$)="ON"))
  13588.       
  13589.  "!IMPRESSION":
  13590.     P%=
  13591. params$," ")
  13592.  P%>0 
  13593. =      ImpCom$=
  13594. params$,P%-1):modifier$=
  13595. params$,P%+1))
  13596.       
  13597.  modifier$ 
  13598. '        
  13599.  "NOT FIRST":firstquery%=
  13600.       
  13601.       
  13602.  ImpCom$=params$
  13603.         
  13604.         
  13605. softerror(command$,46)
  13606.     finished%=
  13607.  "Hourglass_Smash"
  13608. close_file(F)
  13609. abort_script
  13610. close_file(F)
  13611. softerror("",57)
  13612. wimp_error(
  13613.  "Impulse" handling -----------------------------------------------
  13614. Impulse_command_received(token%,params%,object%)
  13615. 4param$=
  13616. getstr(params%):object$=
  13617. getstr(object%)
  13618.  object$="" 
  13619.  object$=
  13620. leaf($database%)
  13621.  token% 
  13622.  ### GetPathname. Returns full pathname of object ###
  13623. leaf($database%) 
  13624.  object$:
  13625. <    
  13626.  "Impulse_SendMessage",&202,$database%,,,,,mytask%
  13627.  "No data":
  13628. D    
  13629.  "Impulse_SendMessage",&202,"No database open",,,,,mytask%
  13630. T    
  13631.  "Impulse_SendMessage",&202,"Current database is not "+object$,,,,,mytask%
  13632.  ### Selection. Returns maximum data length ###
  13633.   ClientSep$=
  13634. param$,1)
  13635. ?  ClientForm$=
  13636. find_fields(param$,ClientSep$,ClientLength%)
  13637. extend_named_sliding_block(transanchor%,ClientLength%+1)
  13638.  "Impulse_SendMessage",&202,
  13639. (ClientLength%),,,,,mytask%
  13640.  ### ParseQuery. Returns title generated by FNparse ###
  13641. )  $Query%=param$:ClientSearch$=
  13642. parse
  13643.  "Impulse_SendMessage",&202,Title$,,,,,mytask%
  13644.  ### GetRecord. Returns data specified in Selection according to criteria specified in ParseQuery ###
  13645. <  datalength%=
  13646. prepare_next_record(param$,!transanchor%)
  13647.  "Impulse_SendMessage",&202,"Ready to receive?",-1,,,transtag%,mytask%,Length%
  13648.  ### PutRecord ###
  13649.  "Impulse_SendMessage",&201,"GetRecord",,,,getrec%,mytask%
  13650.  ### ExpandCode ###
  13651.   P%=
  13652. param$," ")
  13653. .  code$=
  13654. param$,P%-1):table$=
  13655. param$,P%+1)
  13656.  "Impulse_SendMessage",&202,
  13657. expand(code$,table$,L%,SF$),,,,,mytask%
  13658.  7,8:
  13659.  ### GetField, GetExpanded ###
  13660.  params%<>-1 
  13661. D    datalength%=
  13662. prepare_next_field(token%,param$,!transanchor%)
  13663. \    
  13664.  "Impulse_SendMessage",&202,"Ready to receive?",-1,,,transtag%,mytask%,datalength%
  13665. :    
  13666.  ### Max. length for a Powerbase field is 246 ###
  13667.  ### NextMatch ###
  13668. move_on_and_continue(key%)
  13669. move_on_and_continue(key%)
  13670.  S$,J%
  13671. 7addr=
  13672. next_match(addr,direction%,Filter$,finished%)
  13673.  finished% 
  13674.  F$()="":
  13675.  J%=0 
  13676.   S$+=F$(KF%(key%,J%))+" "
  13677. text(mergeW%,6)=
  13678. S$,80):
  13679. redraw_icon(mergeW%,6)
  13680. Impulse_reply(replytag%,reply%)
  13681. abort_merge:
  13682. reply$=
  13683. getstr(reply%)
  13684.  replytag% 
  13685.  getrec%:
  13686.  ### Reply to GetRecord command. ###
  13687.  "Impulse_FetchData",!transanchor%,Length%,,,,,mytask%
  13688.  mergetag%:
  13689.  ### Merging application replies when all data in document merged ###
  13690. selected(mergeW%,3) 
  13691.  "Impulse_SendMessage",&201,":"+$mergewith%+"."+document$+" Print",,,,printtag%,mytask%
  13692.  printtag%:
  13693.  ### Merging application has printed the current document ###
  13694.  "OS_Byte",229,0
  13695. 1  mergenum%+=1:$
  13696. text(mergeW%,7)=
  13697. (mergenum%)
  13698. redraw_icon(mergeW%,7)
  13699. selected(mergeW%,3) 
  13700.  finished% 
  13701. *    addr=
  13702. moveto(key%,addr,direction%)
  13703. deselect(mergeW%,3)
  13704. abort_merge
  13705. close_file(dbasehandle%)
  13706. addr=ClientPtr%
  13707. deselect(mergeW%,3)
  13708. close_it(mergeW%)
  13709. softerror("",27)
  13710. wimp_error(
  13711. Impulse_send(tag%,maxsize%)
  13712.  "Impulse_TransmitData",!transanchor%,datalength%,,,,,mytask%
  13713. datalength%=0
  13714. Impulse_receive(replytag%,expected%,received%)
  13715.  I%,F%,P%
  13716. transbuff%=!transanchor%
  13717. transbuff%?received%=13
  13718. data$=$transbuff%
  13719.  ### Acknowledge data received (get reason code 19 otherwise!) ###
  13720.  "Impulse_SendMessage",&202,,,,,replytag%,mytask%
  13721.  data$<>"" 
  13722.   P%=
  13723. data$,"#")
  13724.   REC%=
  13725. data$,P%-1))
  13726.   data$=
  13727. data$,P%+1)
  13728.  REC%=-1 
  13729.  REC%=RA%
  13730. (5.  
  13731. read(fields%,REC%<>RA%,REC%,$database%)
  13732. (6!  
  13733.  I%=1 
  13734. (ClientForm$) 
  13735. (7$    F%=
  13736. fnum(
  13737. ClientForm$,I%,2))
  13738. (8<    
  13739.  data$<>"" 
  13740.  $Rf%(F%)=
  13741. get_string(data$,ClientSep$)
  13742. write(fields%,key%)
  13743. (;R  
  13744.  received%=0 
  13745.  "Impulse_SendMessage",&201,"GetRecord",,,,getrec%,mytask%
  13746. get_string(
  13747.  S$,sep$)
  13748.  P%,F$
  13749. S$,sep$)
  13750.  P%>0 
  13751.   F$=
  13752. S$,P%-1)
  13753.   S$=
  13754. S$,P%+1)
  13755. stripspaces(F$)
  13756. prepare_next_record(key$,transbuff%)
  13757.  ok%,I%,F%,P%
  13758.  dbasehandle%=0 
  13759. (K,  dbasehandle%=
  13760. ($database%+".Database")
  13761. (L'  ClientPtr%=
  13762. neighbour(key%,top,1)
  13763. P%=transbuff%
  13764.  key$ 
  13765.  "***":
  13766. close_file(dbasehandle%)
  13767.   $P%=key$:P%+=
  13768. ($P%)+1
  13769. (T   
  13770.  ok%=
  13771.  ClientPtr%<>top
  13772. (U(    REC%=
  13773. rec_no(k$,key%,ClientPtr%)
  13774. (V'    
  13775. readsmarray(dbasehandle%,REC%)
  13776. (ClientSearch$)=
  13777. (X$      $P%=
  13778. (REC%)+"#":P%+=
  13779. ($P%)
  13780. (Y%      
  13781.  I%=1 
  13782. (ClientForm$) 
  13783. (Z(        F%=
  13784. fnum(
  13785. ClientForm$,I%,2))
  13786. ([,        $P%=F$(F%)+ClientSep$:P%+=
  13787. ($P%)
  13788.       
  13789.       $P%+=ClientSep$:P%+=1
  13790.       ok%=
  13791. (_        
  13792. (`0    ClientPtr%=
  13793. neighbour(key%,ClientPtr%,1)
  13794. (b1  
  13795.  P%=transbuff% 
  13796. close_file(dbasehandle%)
  13797. (d"  val$=
  13798. type(key%):kl%=
  13799. (key$)
  13800. (e%  ClientPtr%=
  13801. search(key$,key%,1)
  13802.  ClientPtr%>=0 
  13803. (g(    REC%=
  13804. rec_no(k$,key%,ClientPtr%)
  13805. (h'    
  13806. readsmarray(dbasehandle%,REC%)
  13807. (i"    $P%=
  13808. (REC%)+"#":P%+=
  13809. ($P%)
  13810. (j#    
  13811.  I%=1 
  13812. (ClientForm$) 
  13813. (k&      F%=
  13814. fnum(
  13815. ClientForm$,I%,2))
  13816. (l*      $P%=F$(F%)+ClientSep$:P%+=
  13817. ($P%)
  13818.     $P%+=ClientSep$:P%+=1
  13819. =P%-transbuff%
  13820. prepare_next_field(method%,S$,transbuff%)
  13821.  L%,F%,P%,len%,T$,F$,V%,R%,b$,k$,SF$
  13822.  token% 
  13823.  ### GetField ###
  13824. (w&  F%=
  13825. field(S$,
  13826. ):V%=chartype%(F%)
  13827. (yC    
  13828.  0,1,2,3,4,5,6,7,8,46,47,48,49,50,51,52,53,54,55,56,57,58:
  13829.     L%=
  13830. (F$(F%))
  13831. ({D    
  13832. extend_named_sliding_block(transanchor%,(L%+4) 
  13833.  &FFFFFFFC)
  13834. (|     transbuff%=!transanchor%
  13835. (}*    $transbuff%=F$(F%):transbuff%?L%=0
  13836.  36,39:
  13837.      R%=
  13838. rec_no(k$,key%,addr)
  13839. /    L%=
  13840. blob_path(
  13841. ,$database%,R%,F%,V%,b$)
  13842.  L%>0 
  13843. F      
  13844. extend_named_sliding_block(transanchor%,(L%+4) 
  13845.  &FFFFFFFC)
  13846. "      transbuff%=!transanchor%
  13847. (      
  13848.  "OS_File",255,b$,transbuff%
  13849.       
  13850.  L%=1
  13851. 7      
  13852. extend_named_sliding_block(transanchor%,256)
  13853. "      transbuff%=!transanchor%
  13854.       ?transbuff%=0
  13855.         
  13856.     transbuff%?L%=0
  13857.  ### GetExpanded ###
  13858. +  P%=
  13859. S$," "):T$=
  13860. S$,P%+1):S$=
  13861. S$,P%-1)
  13862. 2  F%=
  13863. field(S$,
  13864. ):F$=
  13865. expand(F$(F%),T$,L%,SF$)
  13866. extend_named_sliding_block(transanchor%,L%+1)
  13867.   transbuff%=!transanchor%
  13868. 6  $transbuff%=F$:L%=
  13869. ($transbuff%):transbuff%?L%=0
  13870. len%=(L%+4) 
  13871.  &FFFFFFFC
  13872.     =len%
  13873. start_merge
  13874. ClientPtr%=addr
  13875. Imp_wait%=
  13876. text(mergeW%,1)=document$
  13877. $Query%=""
  13878. text(mergeW%,6)="":$
  13879. text(mergeW%,7)=""
  13880. position_window(mergeW%,0,0,0,0,0,0)
  13881. set_caret(queryW%,0)
  13882. merge_next(filter%,key%,P%)
  13883.  J%,S$
  13884.  P%=top 
  13885.  finished% 
  13886. selected(mergeW%,3) 
  13887.  filter% 
  13888. .    dbasehandle%=
  13889. ($database%+".Database")
  13890. #    record%=
  13891. rec_no(k$,key%,P%)
  13892. *    
  13893. readsmarray(dbasehandle%,record%)
  13894. !    
  13895. close_file(dbasehandle%)
  13896.  J%=0 
  13897.      S$+=F$(KF%(key%,J%))+" "
  13898. text(mergeW%,6)=
  13899. S$,80)
  13900. redraw_icon(mergeW%,6)
  13901.  "Impulse_SendMessage",&201,":"+$mergewith%+"."+document$+" Merge",,,,mergetag%,mytask%
  13902.  End of "Impulse" handling -------------------------------------------
  13903.  Import/Export CSV files ---------------------------------------------
  13904. start_import(type$,wi%)
  13905.  OK%,T%,filename$
  13906.  "Wimp_GetPointerInfo",,block%:x%=!block%:y%=block%!4
  13907.  present% 
  13908.  fields%=0 
  13909.  OK%=
  13910. softerror("",69)
  13911.  Modify% 
  13912.  OK%=
  13913. softerror("",14)
  13914. softerror("",69)
  13915.  T%=0 
  13916.  LastTable%
  13917.  wi%=tableW%(T%) 
  13918.  Tablenumber%=T%
  13919.  OK% 
  13920.  wi% 
  13921. V    
  13922. select(csvW%,1):
  13923. select(csvW%,4):
  13924. shade(csvW%,4,
  13925. ):csvfunc$="ImportMain"
  13926. &    
  13927.  mainW%:csvfunc$="ImportMain"
  13928. 6    
  13929.  tableW%(Tablenumber%):csvfunc$="ImportTable"
  13930.    filename$=$
  13931. text(csvW%,13)
  13932. shade(csvW%,0,
  13933. (  $CSVTitle%="Import "+type$+" file"
  13934. text(csvW%,9)="Import"
  13935.  wi%=mainW% 
  13936. 7    
  13937. position_window(csvW%,x%-350,y%-260,0,570,0,0)
  13938. -    
  13939. position_window(csvW%,0,0,0,0,0,0)
  13940. auto_csv(on%)
  13941.  on% 
  13942.  present%=7 
  13943. 9    autocsvhandle%=
  13944. ($database%+".PrintJobs.NewData")
  13945. "    
  13946. select_range(1,fields%,
  13947.     csvform$=printorder$
  13948. clear_selection
  13949.  autocsvhandle%>0 
  13950. #    
  13951. close_file(autocsvhandle%)
  13952. <    
  13953.  "OS_File",18,$database%+".PrintJobs.NewData",&dfe
  13954. write_csv(Filename$)
  13955.  writingcsv% 
  13956.  printorder$<>"" 
  13957.  Form$=printorder$ 
  13958. softerror("",34):
  13959.  P%,rec%,examined%,subtotal%
  13960. end_csv:
  13961. )csvhandle%=
  13962. (Filename$):writingcsv%=
  13963. selected(csvW%,1) 
  13964. csv_head
  13965. *dbasehandle%=
  13966. ($database%+".Database")
  13967. Search$=
  13968. parse
  13969.  "Hourglass_On"
  13970.  usekey%=-1 
  13971. selected(savesubW%,6)=
  13972. #  direc%=
  13973. selected(queryW%,4)+1
  13974. $  P%=
  13975. neighbour(key%,top,direc%)
  13976. scan_file("P%<>top",key%,file%,3,direc%)
  13977. #  P%=
  13978. search(useval$,usekey%,1)
  13979.  P%>=0 
  13980.  k$=useval$:
  13981. scan_file("P%<>top AND k$=useval$",usekey%,file%,3,1)
  13982.  "Hourglass_Off"
  13983. close_file(csvhandle%)
  13984. close_file(dbasehandle%)
  13985.  sep$="," 
  13986.  type%=&dfe 
  13987.  type%=&fff
  13988.  "OS_File",18,Filename$,type%
  13989. writingcsv%=
  13990. close_it(savesubW%)
  13991. end_csv
  13992.  "Hourglass_Smash"
  13993. close_file(csvhandle%)
  13994. close_file(dbasehandle%)
  13995. close_file(F)
  13996.  "OS_File",18,Filename$,&dfe
  13997. writingcsv%=
  13998. softerror("",41)
  13999. wimp_error(
  14000. csv_head
  14001.  I%,F%,f$,H$,Head$,N%
  14002.     I%=-1
  14003. (Form$)-1
  14004. (  I%+=2:F%=
  14005. fnum(
  14006. Form$,I%,2)):N%+=1
  14007. selected(printW%,2) 
  14008.  Head$=$
  14009. text(mainW%,(desc%(F%))) 
  14010.  Head$=Tag$(F%)
  14011. selected(csvW%,4) 
  14012.  Head$=
  14013. (len%(F%))+"
  14014. "+Head$+"
  14015. (chartype%(F%))
  14016.  chartype%(F%)<>3 
  14017.  chartype%(F%)<>6 
  14018. selected(csvW%,0) 
  14019.  Head$=""""+Head$+""""
  14020.  N%>1 
  14021.  Head$=sep$+Head$
  14022. #csvhandle%,Head$;
  14023. #csvhandle%,term$;
  14024. write_csv_rec(R%,Form$,handle%)
  14025.  I%,F%,f$,F$,L%,N%,filename$,len%,base%,SF$
  14026. selected(csvW%,3) 
  14027.   F$=
  14028. key2(0,1)
  14029. ) ,  
  14030. selected(csvW%,0) 
  14031.  F$=""""+F$+""""
  14032. #handle%,F$+sep$;
  14033. selected(csvW%,22) 
  14034. #handle%,
  14035. (REC%)+sep$;
  14036. I%=-1:L%=
  14037. (Form$)-1
  14038.  I%<L%
  14039. )&"  I%+=2:F%=
  14040. fnum(
  14041. Form$,I%,2))
  14042.  chartype%(F%) 
  14043.  36,39:
  14044. )),    len%=
  14045. load_blob($database%,R%,F%,36)
  14046. )*'    
  14047.  len%>0 
  14048. selected(csvW%,2) 
  14049. )+(      N%+=1:
  14050.  N%>1 
  14051. #handle%,sep$;
  14052. ),0      
  14053. selected(csvW%,0) 
  14054. #handle%,"""";
  14055. )-%      
  14056. blob_to_file(handle%,len%)
  14057. ).0      
  14058. selected(csvW%,0) 
  14059. #handle%,"""";
  14060. )/        
  14061.  3,6,46,47,54,56,57:
  14062.     F$=F$(F%):N%+=1
  14063. )2'    
  14064.  F$<>"" 
  14065. selected(csvW%,2) 
  14066.       
  14067.  N%>1 
  14068.  F$=sep$+F$
  14069.       
  14070. #handle%,F$;
  14071. )5        
  14072.  41,42,43,44,45:
  14073.       F$=F$(F%):N%+=1
  14074.       Z%=
  14075. no_yes(F%,n$,y$)
  14076. )9"      
  14077.  F$=" " 
  14078.  F$=y$ 
  14079.  F$=n$
  14080. ):0      
  14081. selected(csvW%,0) 
  14082.  F$=""""+F$+""""
  14083.       
  14084.  N%>1 
  14085.  F$=sep$+F$
  14086.       
  14087. #handle%,F$;
  14088. )>!    
  14089. selected(printW%,11) 
  14090. )?/      F$=
  14091. expand(F$(F%),link$(F%),Len%,SF$)
  14092.       
  14093.  F$=F$(F%)
  14094. )A        
  14095.     N%+=1
  14096. )C'    
  14097.  F$<>"" 
  14098. selected(csvW%,2) 
  14099. )D0      
  14100. selected(csvW%,0) 
  14101.  F$=""""+F$+""""
  14102.       
  14103.  N%>1 
  14104.  F$=sep$+F$
  14105.       
  14106. #handle%,F$;
  14107. )G        
  14108. #handle%,term$;
  14109. convert_csv(f$)
  14110.  k$,B%,J%,fld%,csvhandle%,toobighandle%,S$,sep%,sep2%,term%,term2%,F$,avail%,nextfree%,keybase%,base%,base2%,show%,done%
  14111.  importingcsv% 
  14112. importingcsv%=
  14113. )Q3toobighandle%=
  14114. ($database%+".PrintJobs.TooBig")
  14115. stop_reading:
  14116. size%=&100:inc%=size%
  14117. extend_named_sliding_block(tempanchor%,size%)
  14118. )V:sep%=
  14119. (sep$):
  14120. (sep$)=2 
  14121.  sep2%=
  14122. sep$)) 
  14123.  sep2%=255
  14124. )W@term%=
  14125. (term$):
  14126. (term$)=2 
  14127.  term2%=
  14128. term$)) 
  14129.  term2%=255
  14130. csvhandle%=
  14131.  present%=0 
  14132. csv_to_dbase(f$)
  14133. Form$=
  14134. csv_importform
  14135.  "Hourglass_On"
  14136. limit_actions(
  14137. selected(csvW%,24) 
  14138.  addr=top
  14139. )`7    
  14140. selected(csvW%,24):
  14141.  Modify exisitng records
  14142. )a$    addr=
  14143. neighbour(key%,addr,1)
  14144. )b/    
  14145.  addr=top 
  14146.  moan_err%,
  14147. msg("Err131")
  14148. )c"    REC%=
  14149. rec_no(k$,key%,addr)
  14150. )d(    
  14151. read(fields%,
  14152. ,REC%,$database%)
  14153. )e2    
  14154. selected(csvW%,22):
  14155.  With record number
  14156. read_bytes
  14157.     REC%=
  14158. ($base%)
  14159. )h(    
  14160. read(fields%,
  14161. ,REC%,$database%)
  14162. )i/    
  14163. selected(csvW%,3):
  14164.  With primary key
  14165. read_bytes
  14166. )k*    addr=
  14167. find(
  14168. $base%,KL%(key%)),0,
  14169.  addr>0 
  14170. )m$      REC%=
  14171. rec_no(k$,key%,addr)
  14172. )n*      
  14173. read(fields%,
  14174. ,REC%,$database%)
  14175.       
  14176. make_new_rec
  14177. )p        
  14178. make_new_rec
  14179.   endline%=
  14180. :J%=-1
  14181. )t#  
  14182. (Form$)-2 
  14183.  endline%=
  14184. )u&    J%+=2:fld%=
  14185. fnum(
  14186. Form$,J%,2))
  14187. )v!    
  14188. transfer_csv_field(fld%)
  14189. )x2  
  14190.  fld%<=fields% 
  14191.  endline% 
  14192. next_csv_rec
  14193. write(fields%,key%)
  14194. ){-  
  14195. selected(csvW%,11) 
  14196. redraw(mainW%)
  14197. )|?  
  14198.  "Hourglass_Percentage",
  14199. #csvhandle%*100 
  14200. #csvhandle%
  14201.  "OS_Byte",229,0
  14202. #csvhandle%
  14203.  "Hourglass_Off"
  14204. close_file(csvhandle%)
  14205. close_file(toobighandle%)
  14206. scrap_sliding_block(tempanchor%)
  14207.  "OS_File",18,$database%+".PrintJobs.TooBig",&fff
  14208. addr=
  14209. moveto(key%,top,1)
  14210. clear_selection
  14211. asterisk(
  14212. write_log(-1,"CSV data imported from "+f$)
  14213. importingcsv%=
  14214. limit_actions(Access%)
  14215. make_new_rec
  14216. /keybase%=!keyanchor%(0):nextfree%=!keybase%
  14217.  !(keybase%+nextfree%)<=0 
  14218.   incr%=
  14219. ($Increment%)
  14220.  incr%>0 
  14221. #    
  14222. change_length(RA%+incr%,
  14223. #    
  14224.  moan_err%,
  14225. msg("Err66")
  14226. )REC%=!(keybase%+nextfree%+8+KL%(0)+1)
  14227. read(fields%,
  14228. ,RA%,$database%)
  14229. transfer_csv_field(
  14230.  fld%)
  14231.  chartype%(fld%) 
  14232.  36,39:
  14233. read_bytes
  14234.  ptr%>0 
  14235. 3    Z%=
  14236. blob_path(
  14237. ,$database%,REC%,fld%,36,F$)
  14238. $    Start%=base%:End%=base%+ptr%
  14239. "    
  14240. save(F$,&fff,Start%,End%)
  14241. selected(csvW%,11) 
  14242.       
  14243.  chartype%(fld%) 
  14244. <        
  14245. set_blob_sprite(REC%,fld%,chartype%(fld%))
  14246. '        
  14247. show_text_block(fld%)
  14248.       
  14249.         
  14250.  41,42,43,44,45:
  14251. read_bytes:c$=
  14252. pos_neg($base%)
  14253. 9    
  14254.  " ":$Rf%(fld%)=" ":
  14255. select(mainW%,field%(fld%))
  14256. 9    
  14257.  "":$Rf%(fld%)="":
  14258. deselect(mainW%,field%(fld%))
  14259.  "@":
  14260. #toobighandle%,"Rec."+
  14261. (REC%)+",Fld."+
  14262. (fld%)+","+$base%+" unsuitable data for check-box":$Rf%(fld%)="":
  14263. deselect(mainW%,field%(fld%))
  14264.  0,1,2,3,4,5,6,7,8,46,47,48,49,50,51,52,53,54,55,56,57,58:
  14265.  len%(fld%)>0 
  14266. read_bytes
  14267. ;    
  14268. selected(csvW%,16) 
  14269.  $base%=
  14270. stripspaces($base%)
  14271.       
  14272.  ptr%<=len%(fld%):
  14273.        
  14274.  chartype%(fld%)=47 
  14275. H        
  14276. selected(csvW%,23) 
  14277.  $Rf%(fld%)=$base%:dontincrement%=
  14278.         
  14279.  $Rf%(fld%)=$base%
  14280.       
  14281.       
  14282.  ptr%<247:
  14283. C      
  14284. #toobighandle%,"Rec."+
  14285. (REC%)+",Fld."+
  14286. (fld%)+","+$base%
  14287.       $Rf%(fld%)="@"
  14288.       
  14289.       
  14290. #toobighandle%,"Rec."+
  14291. (REC%+1)+",Fld."+
  14292. (fld%)+" is more than 246 characters long. Data not saved. External field suggested."
  14293.       $Rf%(fld%)="@"
  14294.         
  14295.  fld%+=1
  14296. 8    
  14297.  ### Zero-length field is probably just a label
  14298. :fld%+=1
  14299.  ### Can't put CSV data into Button, Sprite or Draw fields! ###
  14300. read_bytes
  14301.  end$,B%
  14302. base%=!tempanchor%:ptr%=-1
  14303. #csvhandle%
  14304.  B%=34 
  14305. O  end$="(B%=sep% OR B%=term% OR EOF#csvhandle%=TRUE) AND base%?(ptr%-1)=34"
  14306. 7  end$="B%=sep% OR B%=term% OR EOF#csvhandle%=TRUE"
  14307. #csvhandle%=
  14308. #csvhandle%-1
  14309.   B%=
  14310. #csvhandle%
  14311.   ptr%+=1:base%?ptr%=B%
  14312.  ptr%=size% 
  14313.  size%+=inc%:
  14314. extend_named_sliding_block(tempanchor%,size%)
  14315. (end$)
  14316.  base%?(ptr%-1)=34 
  14317.  ptr%-=1
  14318. base%?ptr%=13
  14319.  sep%:
  14320. skip_sep
  14321.  term%:
  14322. skip_term
  14323. next_csv_rec
  14324.   B%=
  14325. #csvhandle%
  14326.  B%=term%
  14327. skip_term
  14328. skip_sep
  14329.  sep2%<>255 
  14330.   B%=
  14331. #csvhandle%
  14332.  B%<>sep2% 
  14333. #csvhandle%=
  14334. #csvhandle%-1
  14335. skip_term
  14336.  term2%<>255 
  14337.   B%=
  14338. #csvhandle%
  14339.  B%<>term2% 
  14340. #csvhandle%=
  14341. #csvhandle%-1 
  14342.  endline%=
  14343.  endline%=
  14344. stop_reading
  14345.  "Hourglass_Off"
  14346. close_file(csvhandle%)
  14347. close_file(toobighandle%)
  14348. close_file(dbasehandle%)
  14349.  "OS_File",18,$database%+".PrintJobs.TooBig",&fff
  14350. scrap_sliding_block(tempanchor%)
  14351.  =17 
  14352. softerror("",74)
  14353. wimp_error(
  14354.  present%=7 
  14355.   addr=
  14356. moveto(key%,top,1)
  14357. clear_selection
  14358. importingcsv%=
  14359. limit_actions(Access%)
  14360. csv_importform
  14361.  F%,f$,F$
  14362. endline%=
  14363. selected(csvW%,1):
  14364.  ### Use header record to build form ###
  14365. read_bytes
  14366.     F%=
  14367. field($base%,
  14368. 2    
  14369.  F%=0 
  14370.  moan_err%,
  14371. msg("Err87,"+$base%)
  14372.     f$=
  14373. ~(F%)
  14374. (f$)=1 
  14375.  f$="0"+f$
  14376.     F$+=f$
  14377. "    
  14378. invert(mainW%,field%(F%))
  14379.  endline%
  14380.  printorder$<>"":
  14381.  ### Build form from highlighted fields, as in printing ###
  14382.   F$=printorder$
  14383.  ### Assume entry into all fields, beginning with first ###
  14384.  F%=1 
  14385.  fields%
  14386.     f$=
  14387. ~(F%)
  14388. (f$)=1 
  14389.  f$="0"+f$
  14390.     F$+=f$
  14391. csv_to_dbase(f$)
  14392.  F%,P%,Q%,FH%,S$,readpos%
  14393. read_bytes:S$=$base%:
  14394. #csvhandle%=0
  14395. ")=0 
  14396.  moan_err%,
  14397. msg("Err89")
  14398. leaf$=
  14399. leaf(f$):csvconv%=
  14400.  $database%="No data" 
  14401.  $database%=dbasepath$+".!"+leaf$
  14402. save($database%,0,0,0)
  14403. fields%=0:endline%=
  14404.   fields%+=1
  14405. read_bytes:S$=$base%
  14406. */"  P%=
  14407. "):Q%=
  14408. ",P%+1)
  14409. *0%  Tag$(fields%)=
  14410. S$,P%+1,Q%-P%-1)
  14411. *1   len%(fields%)=
  14412. S$,P%-1))
  14413. *2%  chartype%(fields%)=
  14414. S$,Q%+1))
  14415.  endline%
  14416. scrap_sliding_block(tempanchor%)
  14417. ($database%+".Form")
  14418. #FH%,fields%
  14419.  F%=1 
  14420.  fields%
  14421.   xd%=16:xf%=96
  14422.   yd%=-(F%*52):yf%=yd%
  14423. *:H  
  14424. #FH%,Tag$(F%),Tag$(F%),xd%,yd%,xf%,yf%,len%(F%),chartype%(F%),0,0
  14425. close_file(FH%)
  14426.  "OS_File",18,$database%+".Form",&7f2
  14427. fields%=0:Fieldnumber%=0
  14428. fields%=
  14429. get_form(Fptr%)
  14430. default_key
  14431. readpos%=
  14432. #csvhandle%
  14433. no_of_recs
  14434. defaults($database%,RA%,0)
  14435. save_keys
  14436. deselect(csvW%,1)
  14437. create_named_sliding_block(tempanchor%,size%)
  14438. csvhandle%=
  14439. #csvhandle%=readpos%
  14440. no_of_recs
  14441.  N%,B%
  14442. #csvhandle%
  14443.  B%=term% 
  14444. #csvhandle%
  14445.   N%+=1
  14446. *Q?  
  14447.  "Hourglass_Percentage",
  14448. #csvhandle%*100 
  14449. #csvhandle%
  14450. #csvhandle%
  14451.  --- SLIDING HEAP 2.00 PROCEDURES
  14452.  requires SlidingHeap 2.00
  14453.  module and PROCs
  14454.  Steven Haslam 1992
  14455. _heap_slotsize
  14456.  "Wimp_SlotSize",-1,-1 
  14457. _heap_numtostr(d%,n%)=
  14458. d%,"0")+
  14459. ~n%,d%)
  14460. _heap_snumtostr(d%,n%)=
  14461. d%," ")+
  14462.  n%,d%)
  14463. heapsinfo
  14464.  "OS_Heap",1,fixedheapbase% 
  14465.  ,,bigbloc%,totfree%
  14466.  "Fixed heap"
  14467.  "----- ----"
  14468.  "Heap base    : &";
  14469. _heap_numtostr(8,fixedheapbase%)
  14470.  "Heap size    : ";
  14471. _heap_bytes2(fixedheapsize%)
  14472.  "Largest free : ";
  14473. _heap_bytes2(bigbloc%)
  14474.  "Total free   : ";
  14475. _heap_bytes2(totfree%)
  14476.  "Sliding heap"
  14477.  "------- ----"
  14478.  "SlidingHeap_HeapInfo",slidingheapbase%
  14479. _heap_pageup(n%)
  14480.  "OS_ReadMemMapInfo" 
  14481. =(n%+R0%-1) 
  14482.  (R0%-1)
  14483. initheaps(heapsize%,slidingblocks%)
  14484. fixedheapsize%=heapsize%
  14485. *yLheap_trigger%=
  14486. _heap_pageup(
  14487. +fixedheapsize%+20+20*slidingblocks%-&8000)
  14488. setslotsize(heap_trigger%)
  14489. _heap_slotsize<heap_trigger% 
  14490.  130,"Unable to initialise heap"
  14491. fixedheapbase%=
  14492. *}%slidingheapbase%=
  14493. +fixedheapsize%
  14494.  "OS_Heap",0,fixedheapbase%,,fixedheapsize%
  14495.  "SlidingHeap_Create",slidingheapbase%,2,slidingblocks%
  14496.  "SlidingHeap_VerifyHeap",slidingheapbase%
  14497. _heap_nextfree
  14498.  nextfree%
  14499.  "SlidingHeap_NextFree",slidingheapbase% 
  14500.  nextfree%
  14501. =nextfree%
  14502. destroyheaps
  14503. setslotsize(
  14504. -&8000)
  14505. _heap_wordup(x%)=(x%+3) 
  14506. create_anchor(name$)
  14507.  space%
  14508.  space% 4+
  14509.  name$+1
  14510. !space%=0
  14511. $(space%+4)=name$
  14512. =space%
  14513. create_named_sliding_block(anchor%,size%)
  14514.  trysize%
  14515. size%=
  14516. _heap_wordup(size%)
  14517. 7trysize%=
  14518. _heap_pageup(
  14519. _heap_nextfree+size%-&7FF4)
  14520.  trysize%>heap_trigger% 
  14521. setslotsize(trysize%)
  14522. _heap_slotsize<trysize% 
  14523. #    
  14524. setslotsize(heap_trigger%)
  14525. D    
  14526.  131,"Not enough room to create block """+$(anchor%+4)+""""
  14527.         
  14528.     heap_trigger%=trysize%
  14529.  "SlidingHeap_NewBlock",slidingheapbase%,anchor%,size%,anchor%+4
  14530.  "SlidingHeap_VerifyHeap",slidingheapbase%
  14531. scrap_sliding_block(anchor%)
  14532.  !anchor%=0 
  14533.  "SlidingHeap_ScrapBlock",slidingheapbase%,anchor%
  14534. 1trysize%=
  14535. _heap_pageup(
  14536. _heap_nextfree-&7FFC)
  14537.  trysize%<>heap_trigger% 
  14538. setslotsize(trysize%)
  14539.   heap_trigger%=trysize%
  14540. !anchor%=0
  14541.  "SlidingHeap_VerifyHeap",slidingheapbase%
  14542. setslotsize(newsize%)
  14543.  "Wimp_SlotSize",newsize%,-1
  14544. extend_named_sliding_block(anchor%,newsize%)
  14545.  !anchor%=0 
  14546. create_named_sliding_block(anchor%,newsize%):
  14547.  !anchor%>
  14548. _heap_nextfree 
  14549.  129,"Block beyond heap limits"
  14550. $newsize%=
  14551. _heap_wordup(newsize%)
  14552.  "SlidingHeap_DescribeBlock",slidingheapbase%,anchor% 
  14553.  ,,oldsize%
  14554. larger%=newsize%>oldsize%
  14555.  larger% 
  14556. G  trysize%=
  14557. _heap_pageup(
  14558. _heap_nextfree+(newsize%-oldsize%)-&7FFC)
  14559.  trysize%>heap_trigger% 
  14560. setslotsize(trysize%)
  14561. $    
  14562. _heap_slotsize<trysize% 
  14563. %      
  14564. setslotsize(heap_trigger%)
  14565. =      
  14566.  132,"Not enough room to extend block #"+
  14567. ~anchor%
  14568.       
  14569.        heap_trigger%=trysize%
  14570.         
  14571.  "SlidingHeap_ExtendBlock",slidingheapbase%,anchor%,newsize%
  14572. 1trysize%=
  14573. _heap_pageup(
  14574. _heap_nextfree-&7FFC)
  14575.  trysize%<>heap_trigger% 
  14576. setslotsize(trysize%)
  14577.    heap_trigger%=trysize%
  14578.  "SlidingHeap_VerifyHeap",slidingheapbase%
  14579. _heap_bytes(b%)
  14580.  end%
  14581.  "OS_ConvertFixedFileSize",b%,block%,block%+&100 
  14582.  ,end%
  14583. ?end%=13
  14584. =$block%
  14585. _heap_bytes2(b%)
  14586.  end%
  14587.  "OS_ConvertFileSize",b%,block%,block%+&100 
  14588.  ,end%
  14589. ?end%=13
  14590. =$block%
  14591. create_fixed_block(size%)
  14592.  pointer%,flag%
  14593.  "XOS_Heap",2,fixedheapbase%,,size% 
  14594.  ,,pointer%;flag%
  14595.  flag% 
  14596. extendfixedheap
  14597.  "XOS_Heap",2,fixedheapbase%,,size% 
  14598.  ,,pointer%;flag%
  14599. =pointer%
  14600. extendfixedheap
  14601.  nshb%,extend%,trysize%
  14602.  "OS_ReadMemMapInfo" 
  14603.  extend%
  14604. $trysize%=
  14605. _heap_slotsize+extend%
  14606. setslotsize(trysize%)
  14607. _heap_slotsize<trysize% 
  14608.  255,"No room to extend fixed heap"
  14609. "nshb%=slidingheapbase%+extend%
  14610.  "SlidingHeap_ShiftHeap",slidingheapbase%,nshb%
  14611.  "OS_Heap",5,fixedheapbase%,,extend%
  14612. fixedheapsize%+=extend%
  14613. slidingheapbase%=nshb%
  14614.  "SlidingHeap_VerifyHeap",slidingheapbase%
  14615. memory_usage
  14616.  F,R,f$,S$,P%
  14617. f$=$database%+".MemoryUsed"
  14618. #F,"Database: "+
  14619. leaf($database%)+" ("+
  14620. $+")"
  14621. #F,"(Record has "+
  14622. (fields%)+" fields and is "+
  14623. (Length%)+" bytes long)"
  14624. N%=((
  14625. )+1024) 
  14626.  1024
  14627. #F,"Program size: "+
  14628. (N%)+"K"
  14629. N%=((
  14630. P)+1024) 
  14631.  1024
  14632. #F,"Basic variables: "+
  14633. (N%)+"K"
  14634. N%=((
  14635. )+1024) 
  14636.  1024
  14637. ("<Pbase$Dir>.!Run")
  14638.   S$=
  14639. S$,8)="WimpSlot"
  14640. close_file(R)
  14641. S$,"K")-3
  14642. #F,"Program + variables: "+
  14643. (N%)+"K (Wimpslot = "+
  14644. S$,P%,4)+")"
  14645. @A%=indirectionmem% 
  14646.  1024:N%=((buff%-buffbase%)+1024) 
  14647.  1024
  14648. IM%=endbuff%-buff%:
  14649.  M%<1024 
  14650. (M%)+" bytes" 
  14651.  1024)+"K"
  14652. #F,"Icon indirection: "+
  14653. (A%)+"K allocated, "+M$+" left"
  14654. +    ;A%=menumem% 
  14655.  1024:N%=((menu_ptr%-menblk%)+1024) 
  14656.  1024
  14657. MM%=men_end%-menu_ptr%:
  14658.  M%<1024 
  14659. (M%)+" bytes" 
  14660.  1024)+"K"
  14661. #F,"Menus: "+
  14662. (A%)+"K allocated, "+M$+" left"
  14663. close_file(F)
  14664.  "OS_File",18,f$,&fff
  14665. debug(S$)
  14666. wimp_error(
  14667. ,254,0,S$)
  14668.