>.!RunImage !RunImage for !Powerbase database D.L. & S.R. Haslam Heap Manager (module + BASIC) S.R. Haslam version$="6.98d (17-06-97)" "OS_Byte",228,1 "OS_Byte",202,0,255 ,kbdstatus% fatal_err%=255:moan_err%=254 present%= :library$="" ,"L0 error: "+ $+" during initialisation at line "+ setup buff%>endbuff% 0,"No room for defs." menu_ptr%>men_end% 0,"No room for menus" wimp_error( "OS_GetEnv" ComString$ ComString$,"-database") 4 File$= ComString$, ComString$,"-database")+10) "OS_GSTrans",File$, 13),255 ,File$,L% File$= File$,L%) get_it_in(File$) shade(passW%,17, wimp_error( quit% close_down "OS_Byte",229,1: "OS_Byte",124 "Wimp_Poll",mask%,block% reason% reason% autosave%>0 Access%= check_save( ($Interval%)*6000) Imp_wait% merging% start_merge flash%>0 flash(mainW%,field%(flash%)) redraw(!block%) open_it(!block%) close_it(!block%) mouse(block%!0,block%!4,block%!8,block%!12,block%!16) end_drag(Start%,End%) process_key menu_select set_keyboard(!block%,block%!4) 17,18: "Impulse_Decode",reason%,block%,,,,methodtable%,mytask% reason%,,,,,token%,params%,object% reason%>=&200 reason% 6V &200,&201: token%<>-1 Impulse_command_received(token%,params%,object%) 7/ &202: Impulse_reply(token%,params%) 8. &203: Impulse_send(token%,object%) 99 &204: Impulse_receive(token%,params%,object%) : message not_acknowledged flash(wi%,ic%) time% "OS_ReadMonotonicTime" time% (time% 50)=0 invert(wi%,ic%) Shutdown routines --------------------------------------------------- close_down #0:$block%="TASK": "Wimp_CloseDown",mytask%,!block%: ,"L0 error: "+ $+" during closedown at line "+ "Hourglass_Smash" "Impulse_CloseDown",mytask% $block%="TASK" "Wimp_CloseDown",mytask%,!block% "OS_Byte",202,kbdstatus% "Hourglass_Smash" present%=7 check_change: save_winpos ramwarn% ram% softerror("",63) design% protect% save_form($database%+".Form") altered% save_everything: memory_usage auto_csv( close_files close_log(".Log") hide_windows delete_icons(mainW%,0) delete_icons(pselectW%,8) ic%=24 text(keypadW%,ic%)="" recover_memory init_vars get_defaults select(prefsW%,36): deselect(prefsW%,35): shade(prefsW%,35, I%=0 LastTable% printrel$(I%)="" tableW%(I%)>0 !block%=tableW%(I%): "Wimp_DeleteWindow",,block% tableW%()=0:TabTitle%()=0 tableW%()=0:TabTitle%()=0 field$()="" $Password%="" present%= exit%= lit(iconbarM%,1, lit(iconbarM%,2, lit(iconbarM%,3, lit(validateM%,1, ):ptr%=validateM%+52:ptr%!4=-1 lit(printM%,5, lit(printM%,6, lit(printM%,7, lit(mainM%,7, "OS_CLI","Unset Acl$Dir" "OS_CLI","Unset Log$Dir" $dbase%="No data" $database%="No data" redraw_icon(-2,pbaseicon%) save_everything Access% save_links save_calcs save_subfilenames save_keys save_all_tables changed%= update_calcs(0) asterisk( delete_icons(wi%,ic%) !block%=wi%:block%!4=ic% "Wimp_DeleteIcon",,block% ic%+=1:block%!4=ic% "Wimp_GetIconState",,block% ((block%!24) (1<<23))>0 close_files close_file(lk):link$()="" close_file(cl):calc$()="" close_file(dbasehandle%) close_file(csvhandle%) close_file(autocsvhandle%) close_file(texthandle%) close_file(text%) close_file(toobighandle%) close_file(F) close_file(FH%) close_file(V) close_file( filehandle%) filehandle%>0 #filehandle% filehandle%=0 recover_memory scrap_sliding_block(headanchor%) scrap_sliding_block(lineanchor%) scrap_sliding_block(textanchor%) scrap_sliding_block(formanchor%) scrap_sliding_block(selanchor%) scrap_sliding_block(tempanchor%) scrap_sliding_block(balanchor%) scrap_sliding_block(flaganchor%) scrap_sliding_block(transanchor%) scrap_sliding_block(sprsanchor%) scrap_sliding_block(recanchor%) scrap_sliding_block(saveanchor%) scrap_sliding_block(logoanchor%) scrap_sliding_block(fieldmenuanchor%) scrap_sliding_block(usermenuanchor%) scrap_sliding_block(tablemenuanchor%) I%=0 MaxTabs% scrap_sliding_block(tabanchor%(I%)) scrap_sliding_block(undoanchor%(I%)) I%=0 MaxKeys%+1 scrap_sliding_block(keyanchor%(I%)) I%=1 fields% chartype%(I%)=40 scrap_sliding_block(Rf%(I%)) Error handling ------------------------------------------------------ wimp_error(return%,err%,erl%,err$) type%,result% close_down: ,"L0 error: "+ $+" during error handler at line "+ "Wimp_CommandWindow",-1 block%!0=err% return% err%<>fatal_err% err%=moan_err% ; type%=17: OK button and no "Error from" in title ) type%=3: OK and Cancel buttons A err$+=" @ "+ (erl%)+" (OK to continue, Cancel to quit)" type%=2: Cancel buttom ; err$+=" @ "+ (erl%)+" (Powerbase must quit at once)" $(block%+4)=err$+ "Wimp_ReportError",block%,type%,"Powerbase"+ ,result% result=1 means OK selected, 2 means Cancel selected result%=2 close_down softerror(E$,E%) M$="Err"+ E$<>"" M$+=","+E$ $(block%+4)= msg(M$) !block%=255 "Wimp_ReportError",block%,17,"Powerbase"+ ### Use MessageTrans to display a message from the Messages file ### msg(token$) result$,msgparams$,P%,Q%,p% param$()="": token$,",") P%>0 " msgparams$= token$,P%+1)+"," token$= token$,P%-1) P%=0 Q%=P%+1 P%= msgparams$,",",Q%) P%>0 * param$(p%)= msgparams$,Q%,P%-Q%) p%+=1 P%=0 "MessageTrans_Lookup",filedesc%,token$,msgbuff%,&100,param$(0),param$(1),param$(2),param$(3) ,,result$ =result$ asterisk(on%) on% $RecInfo%)<>"*" $RecInfo%+=" *":ramwarn%= $RecInfo%)="*" $RecInfo%= $RecInfo%)) altered%=on% E!block%=mainW%: "Wimp_GetWindowOutline",,block%:ymax%=block%!16 "Wimp_GetWindowState",,block% "Wimp_ForceRedraw",-1,block%!4,block%!16,block%!12,ymax% Program initialisation ---------------------------------------------- setup F,A%,I%,J%,V%,valid$ (".Resources.Config") MaxFields%= MaxFields%>127 fatal_err%, msg("Err61") MaxKeys%= MaxTabs%= #F)-1 MaxMenus%= #F)-1 MaxCols%= #F)-1 #F:P%= S$," "):leftmenu%=( S$,P%-1)="YES") winback%= uc%=( #F,3)="YES") )S$= #F:P%= S$," "):dirdisp$= S$,P%-1) !)S$= #F:P%= S$," "):objname$= S$,P%-1) bannertime%= #F)*100 close_file(F) dim_arrays(MaxFields%+1,MaxKeys%,MaxTabs%,MaxMenus%,MaxCols%) load_fkeys("Fkeys") init_vars ------------------ Initialise Wimp ---------------------------- $block%="TASK" mask%=(1<<4)+(1<<5)+(1<<11) "Wimp_Initialise",200,!block%,"Powerbase" version%,mytask% version%<316 0,"This version of Powerbase is only suitable for RISC OS 3. Contact Powerbase Support for a RISC OS 2-compatible version." "Impulse_Initialise",003,mytask%,"Powerbase",-1 -Mpbaseicon%= create_icon(-1,0,-16,144,110,&1700312B,"",dbase%,psprite%,10) --------- Set up Heap Manager. Load error messages ----------- initheaps(128,128) 0'f$=".Resources.Messages" "MessageTrans_FileInfo",,f$ flags%,,len% 2'errormsg%= create_fixed_block(len%) "OS_Module",6,,,17+ (f$) ,,filedesc% $(filedesc%+16)=f$ "MessageTrans_OpenFile",filedesc%,filedesc%+16,errormsg% getscreensize(ScreenWidth%,ScreenHeight%,Vpix%) Vpix%>=480 f$="Sprites22" f$="Sprites" "OS_File",5,".Resources."+f$ ,,,,len% 9(sprites%= create_fixed_block(len%+4) !sprites%=len%+4 "OS_File",255,".Resources."+f$,sprites%+4 <)headanchor%= create_anchor("Heading") =*lineanchor%= create_anchor("TextLine") >&textanchor%= create_anchor("Text") ?&formanchor%= create_anchor("Form") @.sprsanchor%= create_anchor("DbaseSprites") A&tempanchor%= create_anchor("Temp") B(balanchor%= create_anchor("Balance") C'flaganchor%= create_anchor("Flags") D/transanchor%= create_anchor("DataTransfer") E)selanchor%= create_anchor("PrintSel") F*recanchor%= create_anchor("RecordNum") G,saveanchor%= create_anchor("SaveBuffer") H&logoanchor%= create_anchor("Logo") I0fieldmenuanchor%= create_anchor("FieldMenu") J.usermenuanchor%= create_anchor("UserMenu") K0tablemenuanchor%= create_anchor("TableMenu") I%=0 MaxKeys%+1 M3 keyanchor%(I%)= create_anchor("Key #"+ (I%)) I%=0 MaxTabs% P6 tabanchor%(I%)= create_anchor("VTable #"+ (I%)) Q; undoanchor%(I%)= create_anchor("UndoVTable #"+ (I%)) --------------------------------------------------------------- Method structure PASS=0 P%=methodtable% [OPT PASS equd 0 Y) method(0,1,"GetPathname","") Z' method(0,2,"Selection","") [( method(0,3,"ParseQuery","") \' method(0,4,"GetRecord","") ]' method(0,5,"PutRecord","") ^( method(0,6,"ExpandCode","") _& method(0,7,"GetField","") `) method(0,8,"GetExpanded","") a' method(0,9,"NextMatch","") b method(-1,-1,"","") PASS create_windows make_menus get_defaults select(prefsW%,36): deselect(prefsW%,35): shade(prefsW%,35, select(csvW%,19): deselect(csvW%,18) scroll_icons(MaxCols%) userM%()=0 banner banner "OS_File",5,".reg" d%=1 (".reg") #F,S$:S$= encrypt(S$, u/ $ text(infoW%,9)=S$:$ text(bannerW%,5)=S$ v1 $ text(bannerW%,2)="":$ text(bannerW%,3)="" w+ $ text(bannerW%,4)="Registered user:" set_icon_cols(infoW%,9,23) d%=0 bannertime%>0 position_window(bannerW%,0,0,0,0,0,0) poll: >500 (d%=1 >bannertime%) close_window(bannerW%) method(Flags,Token,Method$,Syntax$) [OPT PASS equd Flags equd Token equs Method$+ equs Syntax$+ align =PASS get_defaults path$ "path$=".Resources." get_preferences(prefsW%,path$+"Preference") get_csv_options(path$+"CSVoptions") get_options(printW%,path$+"PrtOptions") dim_arrays(F%,K%,T%,M%,C%) 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%) 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) userM%(M%,1) Label$(10,3) DIM Sum(30,5) key 256,date% 6,calcrow% F%,hide% 128 ftypeM%(6),fmenu$(6),flist%(6),choice$(4) table$(T%+1),tableW%(T%),TabTitle%(T%) tabfieldlen%(C%),rel%(C%),tabhead$(C%,1) fcol%(8),ncol%(8) Subfile%(5),filemem%(5) buttonfield%(1,24),actionbutt%(5,1),winbuff%(4,1) MC%=30: L%(MC%) -------------------- Allocate buffers ------------------------------ (indirectionmem%=&5000:menumem%=&1200 Mi% 20,Mo% 20 block% &1C00,iconblock% &100,paneblock% &600,savebuff% &200,choices% &100,remember% &B00 buffbase% indirectionmem%:endbuff%=buffbase%+indirectionmem%:buff%=buffbase% menblk% menumem%:men_end%=menblk%+menumem%:menu_ptr%=menblk% fontbuff% &100 msgbuff% &100,param$(3),att$(3) hand% 16:$hand%="Pptr_hand,12,8" paint% 8:$paint%="file_ff9" writep% 16:$writep%="Pptr_write,4,4" writenum% 20:$writenum%="Pptr_write,4,4;A0-9" tick% 12:$tick%="Snull,yes" dbase% 10:$dbase%="No data" psprite% 15:$psprite%="S!Powerbase" menspr% 20,mentxt% 1:$menspr%="Sgright,pgright;R5":$mentxt%="" winspr% 20,wintxt% 1:$winspr%="R5;Swindow":$wintxt%="" methodtable% 256 utctime% 5,datebuffer% 16,dateformat% 16,ordinals% 36 ------------- Indirection addresses for Heap Manager --------------- keyanchor%(K%+1) tabanchor%(T%),undoanchor%(T%) printrel$(T%) box% 16,box2% 16,matrix% 16,origin% 8 init_vars /caps%=16:filemem%()=-1:dragbutt%=0:direc%=1 6firstsearch%= :firstfilter%= :sorted%= :protect%= 1getrec%=213:ClientSearch$="TRUE":ClientPtr%=0 NImp_wait%= :Impref%=-1:merging%= :mergenum%=0:document$="":importingcsv%= -mergetag%=214:transtag%=215:printtag%=216 8flash%= :logosloaded%= :logging%= :acl%= :up_pend%= Gaccessbutton%=0:stop%= :customise%= :tablemenu%=0:undo%= :filter%= &displayed%=-1:scratchpad$="":k$="" ZSearch$="TRUE":Filter$="TRUE":query$="ALL":SearchKey$="":REC%=-1:usekey%=-1:useval$="" areal$="":visible$="":reform$="":val$="":calcfield%=0:savefunc$="":savetofile%= :writetable%= ?password$="":pw%=0:myref%=-1:Type%=0:fieldtype%=1:Length%=0 3printing%= :indexing%= :not%= :dontincrement%= $export%= :csvconv%= :OLE_edit%=0 'autosave%=0:autobalance%= :added%=0 .present%=0:fields%=0:template%=0:adjust%= 7Listed%= :writingcsv%= :writingtext%= :calcerror%= 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 $date%= "movetype%=8:movetype$="Move vquit%= :exit%= :matching%= :newrec%= :val%= :ram%= :Access%= :Modify%= :ramwarn%= :altered%= :design%= :newtree%= /LenLine%=0:Count%=0:Start%=0:End%=0:Fptr%=0 .Resources.Templates" 'infoW%= new_window("info",sprites%) text(infoW%,7)=version$ keyW%= new_window("keystruc",sprites%):KeyTitle%=block%!72 BchangeW%= new_window("change",sprites%):ChangeTitle%=block%!72 'moveW%= new_window("move",sprites%) NtabcreateW%= new_window("tabcreate",sprites%):tabcol%= text(tabcreateW%,8) $scrollW%= new_window("scroll",0) linkW%= new_window("link",sprites%):LinkTitle%=block%!72:Tablename%= text(linkW%,0):fieldnum%= text(linkW%,2):substitute%= text(linkW%,10) VmiscW%= new_window("misc",sprites%):database%= text(miscW%,1):$database%="No data" ic%=2 $ Date%(ic%-2)= text(miscW%,ic%) ic%=28 ( Subfile%(ic%-28)= text(miscW%,ic%) Oused%= text(miscW%,17):filesize%= text(miscW%,18):percent%= text(miscW%,14) )printW%= new_window("print",sprites%) ;matchW%= new_window("match",sprites%):oldquery%=matchW% 'listW%= new_window("list",sprites%) XcreateW%= new_window("create",sprites%):FtitleText%=block%!72:$FtitleText%="Field 0" DescText%= text(createW%,4):TagText%= text(createW%,5):LenText%= text(createW%,6):ValText%= text(createW%,28):InsText%= text(createW%,26):Fixpt%= text(createW%,13):$Fixpt%="2" ;mintext%= text(createW%,15):maxtext%= text(createW%,25) dboxX%= text(createW%,7):boxY%= text(createW%,8):boxW%= text(createW%,9):boxH%= text(createW%,10) ArelateW%= new_window("relation",sprites%):RelTitle%=block%!72 @reformW%= new_window("reform",sprites%):RefmTitle%=block%!72 &colW%= new_window("cols",sprites%) VcalcW%= new_window("calc",sprites%):CalcForm%= text(calcW%,0):CalcTitle%=block%!72 )labelW%= new_window("label",sprites%) -pselectW%= new_window("pselect",sprites%) FmergeW%= new_window("merge",sprites%):ImpulseApp%= text(mergeW%,9) PsizeW%= new_window("size",sprites%):Records%= text(sizeW%,1):$Records%="100" /Increment%= text(sizeW%,3):$Increment%="25" =csvW%= new_window("csvfile",sprites%):CSVTitle%=block%!72 =0 selected (prefsW%,43) 90 addr=filemem%(file%): display(key%,addr) :" addr= moveto(key%,top,1) Listed% open_window(listW%) store_window(wi%,buff%) ic%,ptr% B'!block%=wi%:block%!4=ic%:ptr%=buff% "Wimp_GetIconState",,block% ((block%!24) (1<<23))=0 !ptr%=block%!24:ptr%+=4 ((block%?25) 1)>0 $ptr%=$ text(wi%,ic%):ptr%+= ($ptr%)+1 G% !block%=wi%:ic%+=1:block%!4=ic% "Wimp_GetIconState",,block% restore_window(wi%,buff%) ic%,ptr% N'!block%=wi%:block%!4=ic%:ptr%=buff% "Wimp_GetIconState",,block% ((block%!24) (1<<23))=0 QI !block%=wi%:block%!4=ic%:block%!8=!ptr%:block%!12=&ffffffff:ptr%+=4 "Wimp_SetIconState",,block% ((block%?25) 1)>0 text(wi%,ic%)=$ptr%:ptr%+= ($ptr%)+1 T% !block%=wi%:ic%+=1:block%!4=ic% "Wimp_GetIconState",,block% open_window(wi%) block%!0=wi% "Wimp_GetWindowState",,block% block%!28=-1 open_it(wi%) open_it(wi%) win% wi% tabcreateW%: update_pane(scrollW%,16,160,284,232,0,0) matchW%: update_pane(queryW%,8,8,466,140,0,0): shade(queryW%,4, changeW%: update_pane(queryW%,18,202,466,140,0,0): shade(queryW%,4, moveW%: update_pane(queryW%,18,240,466,140,0,0): shade(queryW%,4, savesubW%: update_pane(queryW%,10,40,466,140,0,0): redraw_icon(wi%,0): shade(queryW%,4, filterW%: update_pane(queryW%,8,52,466,140,0,0): shade(queryW%,4, "Wimp_OpenWindow",,block% win%=0 winbuff%(win%,0)=wi% store_window(wi%,remember%+winbuff%(win%,1)) win% close_it(wi%) wi% mainW%: altered% save_everything hide_windows:stop%= matchW%:matching%= close_window(queryW%) calcW%:calclink%=0 keyW%:design%= :newtree%= mergeW%: "Impulse_SendMessage",&200,":"+$mergewith%+"."+document$+" Edit On",,,,-1,mytask% merging%= tabcreateW%: close_window(scrollW%) changeW%,moveW%,savesubW%,filterW%: close_window(queryW%) close_window(wi%) T%=0 LastTable% wi%=tableW%(T%) set_caret(mainW%,starthere%) hide_windows close_window(queryW%) close_window(keypadW%) I%=0 LastTable% tableW%(I%)>0 close_window(tableW%(I%)) close_window(listW%) close_window(matchW%) close_window(relateW%) close_window(keyW%) close_window(reformW%) close_window(calcW%) close_window(mergeW%) close_window(csvW%) close_window(passW%) close_window(aclW%) close_window(tabcreateW%) close_window(prefsW%) close_window(printW%) close_window(linkW%) close_window(changeW%) close_window(savesubW%) close_window(moveW%) close_window(searchW%) close_window(filterW%) close_window(helpW%) close_window(createW%) close_window(mainW%) filemem%(file%)=addr close_window(wi%) !block%=wi% "Wimp_CloseWindow",,block% shut_window(wi%) "Wimp_TransferBlock",mytask%,block%,mytask%,paneblock%,88 wi%=filterW% filter_click(filterW%,1,4) close_it(wi%) "Wimp_TransferBlock",mytask%,paneblock%,mytask%,block%,88 redraw(handle%) (margin$) !block%=handle% "Wimp_RedrawWindow",,block% more% get_origin(block%,x0%,y0%) more% draw(x0%,y0%) "Wimp_GetRectangle",,block% more% get_origin(block%, x0%, y0%) x0%=block%!4-block%!20 y0%=block%!16-block%!24 draw(x0%,y0%) TextPtr%,y1%,y2%,I%,chars% handle% mainW%: design% showgrid% int%= ($gridint%) 0,gridcol% 2 X%=block%!4-block%!20 block%!36 int% X%,block%!8 plot%,X%,block%!40 4 Y%=block%!16-block%!24 block%!32 -int% block%!4,Y% plot%,block%!36,Y% listW%: y1%=-(block%!40-y0%) y2%=-(block%!32-y0%) y1%=y1% 36+1 y2%=y2% 36+1 . TextPtr%=(!textanchor%)+(y1%-1)*LenLine% y2%>Count% y2%=Count% I%=y1% draw_line(I%) TextPtr%+=LenLine% draw_line(Line%) x0%,y0%-(Line%-1)*36-4 TextPtr%?L%=12 "OS_WriteN",TextPtr%,LenLine% update_pane(wi%,x%,y%,w%,h%,xs%,ys%) newquery%=!block% newquery%<>oldquery% shut_window(oldquery%):oldquery%=newquery% 8!paneblock%=wi%: "Wimp_GetWindowState",,paneblock% paneblock%!4=block%!4+x% !paneblock%!12=paneblock%!4+w% paneblock%!16=block%!16-y% !paneblock%!8=paneblock%!16-h% 'paneblock%!20=xs%:paneblock%!24=ys% "paneblock%!28=-1:block%!28=wi% "Wimp_OpenWindow",,paneblock% "Wimp_OpenWindow",,block% up_pend% up_pend%= "Wimp_GetWindowState",,block% (block%!32 (1<<18)) up_pend%= update_pane(wi%,x%,y%,w%,h%,xs%,ys%) Menu handling ------------------------------------------------------- make_menus fieldM%= 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") fAnalyseFunc%= menu_text(fieldM%,1):CalcFunc%= menu_text(fieldM%,4):RemoveOb%= menu_text(fieldM%,6) cvalidateM%= create_menu(menu_ptr%,"Validation,Create table...,~Display table,Show table files") esubfilenameM%= create_menu(menu_ptr%,"Subfile name,^20"):Subfilename%= menu_text(subfilenameM%,0) irenameM%= create_menu(menu_ptr%,"New name:,^10"):NewName%= menu_text(renameM%,0):$NewName%="!NewName" miscM%= create_menu(menu_ptr%,"Misc.,Move/delete...,Set passwords...,Colours!colW%,Edit template,Name subfile>subfilenameM%,Rename database>renameM%") hdelimiterM%= create_menu(menu_ptr%,"Separator,Comma,TAB,CR,_LF,^2"):Delim%= menu_text(delimiterM%,4) zterminatorM%= create_menu(menu_ptr%,"Terminator,CR,LF,LF CR,CR LF,CR CR,_LF LF,^2"):Termin%= menu_text(terminatorM%,6) printM%= 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") 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" ImainM%= create_menu(menu_ptr%,string$):Fieldpos%= menu_text(mainM%,1) JindextreeM%= create_menu(menu_ptr%,"Print index,Totals only,Complete") utilityM%= 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") iconbarM%= create_menu(menu_ptr%,"\Powerbase,_Information>infoW%,New database!saveW%,~Utilities>utilityM%,~Close database,Preferences...,_Help,Quit") designM%= create_menu(menu_ptr%,"New database,Design field...,_Default database,Save form file!saveW%,Database size>sizeW%,_Primary key...,Grid>gridW%,Quit design") tableM%= create_menu(menu_ptr%,"Table,Clear,Modify,Print,#15,Undo change,_Undo all,Save!saveW%,Save as CSV!saveW%"):SortTabCol%= menu_text(tableM%,3):$SortTabCol%="Sort" olistM%= create_menu(menu_ptr%,"List,Save as text!saveW%,Sort '',Scrap"):SortTextCol%= menu_text(listM%,1) akeystrokeM%= create_menu(menu_ptr%,"Keystroke,Assign>fkeyW%,Defaults,Save choices,List keys") --------------- Read validation strings etc ----------------------- [fmenu$()="Editable","Computed","Check-box","External","Button (1)","Button (2)","Stamp" I%=0 L% 30:flist%(I%)=L%:?L%=0 (".Resources.ValStrings") vstrings%= vname$(vstrings%),vtype$(vstrings%),valid%(vstrings%),rvalid%(vstrings%),hvalid%(vstrings%) I%=0 vstrings% valid$= E P%= valid$,":"):vname$(I%)= valid$,4,P%-4):valid$= valid$,P%+1) - vtype$(I%)= valid$,1):valid$= valid$,3) (valid$)+1:$V%=valid$:valid%(I%)=V% (valid$)+1:$V%=valid$:rvalid%(I%)=V% (valid$)+16:$V%=valid$+";Pptr_hand,12,8":hvalid%(I%)=V% vtype$(I%) Q "E":fmenu$(0)+=","+vname$(I%):L%=flist%(0):N%=?L%:N%+=1:?L%=N%:L%?N%=I% Q "C":fmenu$(1)+=","+vname$(I%):L%=flist%(1):N%=?L%:N%+=1:?L%=N%:L%?N%=I% Q "T":fmenu$(2)+=","+vname$(I%):L%=flist%(2):N%=?L%:N%+=1:?L%=N%:L%?N%=I% Q "X":fmenu$(3)+=","+vname$(I%):L%=flist%(3):N%=?L%:N%+=1:?L%=N%:L%?N%=I% Q "K":fmenu$(4)+=","+vname$(I%):L%=flist%(4):N%=?L%:N%+=1:?L%=N%:L%?N%=I% Q "O":fmenu$(5)+=","+vname$(I%):L%=flist%(5):N%=?L%:N%+=1:?L%=N%:L%?N%=I% Q "S":fmenu$(6)+=","+vname$(I%):L%=flist%(6):N%=?L%:N%+=1:?L%=N%:L%?N%=I% close_file(V) I%=0 %IftypeM%(I%)= create_menu(menu_ptr%,fmenu$(I%)): tick(ftypeM%(I%),0, ybar%=144+7*44 make_user_menus f$,F,items%,item$,menu$,field%,N%,I%,n$,user_ptr%,blocksize%,forbidden$ wimp_error( forbidden$=" $&%@\^:.#*|" extend_named_sliding_block(usermenuanchor%,4) 0+user_ptr%=!usermenuanchor%:blocksize%=4 field%=1 fields% chartype%(field%)=33 3C N%>MaxMenus% moan_err%, msg("Err117,"+ (MaxMenus%+1)) n$=Tag$(field%-1) I%=1 6# P%= forbidden$, n$,I%,1)) 7! P%>0 n$,I%,1)="-" 9# f$=$database%+"."+n$+"menu" F= menu$="":items%=0 F>0 item$= menu$+=item$+"," items%+=1 close_file(F) menu$= menu$) E} menu$=Tag$(field%-1)+" menu,Place your,menu choices,in the file,"""+n$+"menu"",which is in,the database,directory," F* items%=7:P%=1:Q%=1:menu$= menu$) F= Q%>0 Q%= menu$,",",P%) J menu$,P%,Q%-P%) P%=Q%+1 close_file(F) N! "OS_File",18,f$,&fff O userM%(N%,0)=field%-1 Q blocksize%+=items%*41+30 R? extend_named_sliding_block(usermenuanchor%,blocksize%) S2 userM%(N%,1)= create_menu(user_ptr%,menu$) N%+=1 field% field_menu(N%,pr%) F%,P%,L%,D$,F$,icptr%,textptr%,FF% extend_named_sliding_block(fieldmenuanchor%,N%*41+30) ]5icptr%=!fieldmenuanchor%:textptr%=icptr%+N%*24+28 pr% $icptr%="Print order" $icptr%="Field list" _Zicptr%?12=7:icptr%?13=2:icptr%?14=7:icptr%?15=0:icptr%!16=270:icptr%!20=44:icptr%!24=0 icptr%+=28 pr% I%=1 (printorder$)-1 d$ F%= fnum( printorder$,I%,2)) fieldmenu_item(F%) I% F%=1 fieldmenu_item(F%) icptr%!-24=icptr%!-24 =!fieldmenuanchor% fieldmenu_item(F%) get_icon_cols(mainW%,field%(F%))<>winback%*17 FF%+=1 r# F$= (FF%):F$= (F$)," ")+F$ s7 D$= text(mainW%,desc%(F%)),7):D$+= (D$)," ") t& F$+=" "+D$+" "+Tag$(F%):L%= u\ !icptr%=0:icptr%!4=-1:icptr%!8=&7000121:icptr%!12=textptr%:icptr%!16=-1:icptr%!20=L%+1 v! $textptr%=F$:textptr%+=L%+1 icptr%+=24 menu_text(menu%,item%) ic%=menu%+28+item%*24 ((ic%!8) &100)=0 =ic%+12 =ic%!12 create_menu( menu%,list$) start%,choice$,entries%,item%,P%,Q%,S%,shaded%,width%,L%,LL% start%=menu% list$,1)="\" leftmenu%= list$= list$,2) list$,",") ($menu%= list$,P%-1):width%= ($menu%) menu%?12=7:menu%?13=2 menu%?14=7:menu%?15=0 *menu%!16=width%:menu%!20=44:menu%!24=0 item%=menu%+28 list$+="," entries%=0 LL%=0 Q%=P%+1 P%= list$,",",Q%) P%>0 !item%=0:shaded%=0 choice$= list$,Q%,P%-Q%) choice$,1) 3 "~":choice$= choice$,2):shaded%=(1<<22) 5 "_":choice$= choice$,2):?item%=?item% - "#":LL%= choice$,2)):choice$="" D "^":LL%= choice$,2)):choice$="":?item%=?item% (1<<2) S%= choice$,"!") 5 S%>0 ?item%=?item% choice$,S%,1)=">" S%= choice$,">") S%=0 item%!4=-1 # item%!4= choice$,S%+1)) choice$= choice$,S%-1) , LL%=0 (choice$)+1 L%=LL%+1 L%>width% width%=L% L%>13 LL%>0 I item%!12=buff%:$buff%=choice$:buff%+=L%:item%!16=-1:item%!20=L% item%!8=&7000121 $(item%+12)=choice$ item%!8=&7000021 ! item%!8=item%!8 shaded% item%+=24 entries%+=1 P%=0 item%!-24=item%!-24 menu%=item% start%!16=width%*16+16 =start% tick(menu%,item%,on%) item%=menu%+28+item%*24 on% :?item%=?item% :?item%=?item% tick_one(menu%,first%,last%,item%) I%=first% last% tick(menu%,I%,(I%=item%)) ticked(menu%,item%) item%=menu%+28+item%*24 (?item% lit(menu%,item%,on%) item%=menu%+28+item%*24 on% : item%!8=item%!8 (1<<22) : item%!8=item%!8 (1<<22) show_menu(menu%,x%,y%) )menuhandle%=menu%:menux%=x%:menuy%=y% "Wimp_CreateMenu",,menu%,x%,y% show_user_menu(datafield%,x%,y%) N%=-1 N%+=1 userM%(N%,0)=datafield% N%=MaxMenus% userM%(N%,0)=datafield% show_menu(userM%(N%,1),x%,y%) softerror( (MaxMenus%+1),117) Icon handling ------------------------------------------------------- create_icon(whandle%,xmin%,ymin%,width%,height%,iconflags%,text$,d1%,d2%,d3%) handle% block%!0=whandle% !block%!4=xmin%:block%!8=ymin% 2block%!12=xmin%+width%:block%!16=ymin%+height% block%!20=iconflags% d1%=0 $(block%+24)=text$ block%!24=d1% block%!28=d2% block%!32=d3% "Wimp_CreateIcon",,block% handle% =handle% redraw_icon(wi%,ic%) !block%=wi%:block%!4=ic% block%!8=0:block%!12=0 "Wimp_SetIconState",,block% *block%!8=0:block%!12=wi%:block%!16=ic% shade(wi%,ic%,on%) icon_bit(22,wi%,ic%,on%) icon_bit(bit%,wi%,ic%,on%) !block%=wi% block%!4=ic% on% :block%!8=0:block%!12=1<0 shaded(wi%,ic%) !block%=wi%:block%!4=ic% "Wimp_GetIconState",,block% =((block%!24) (1<<22))>0 selected_esg(wi%,esg%) "Wimp_WhichIcon",wi%,block%,&003F0000,&00200000+(esg%<<16) =!block% next_writable(wi%,ic%,d%,r%,wi2%,ic2%) P%,E%,next% "Wimp_WhichIcon",wi%,block%,&00C0E000,(14<<12) E%+=4 block%!E%=-1 block%!P%<>ic% P%0 wi%=wi2%:next%=ic2% next%=!block% wi2%>0 wi%=wi2%:next%=ic2% next%=block%!(E%-4) :next%=block%!P% set_caret(wi%,next%) text(wi%,ic%) !block%=wi%:block%!4=ic% "Wimp_GetIconState",,block% =block%!28 val(wi%,ic%) !block%=wi%:block%!4=ic% "Wimp_GetIconState",,block% =block%!32 text_length(wi%,ic%) !block%=wi%:block%!4=ic% "Wimp_GetIconState",,block% ($(block%!28)) buffer_length(wi%,ic%) !block%=wi%:block%!4=ic% "Wimp_GetIconState",,block% =block%!36-1 set_caret(wi%,ic%) Y0!block%=wi%: "Wimp_GetWindowState",,block% ((block%?34) 1)=1 ic%=-1 \* "Wimp_SetCaretPosition",wi%,ic% ] ^G "Wimp_SetCaretPosition",wi%,ic%,0,0,-1, text_length(wi%,ic%) alter_flags(dfg%,ffg%,bfg%) ic%,F% !block%=mainW% ic%=0 fields%*2-1 F%=(ic%+1) h1 block%!4=ic%: "Wimp_GetIconState",,block% (ic% 2)=1 chartype%(F%) kU 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% l' 39:block%!8=ffg%:len%(F%)=0 mB logosloaded% block%!8=&0000611E block%!8=ffg% :block%!8=bfg% o block%!8=dfg% block%!12=&FFFFFFFF "Wimp_SetIconState",,block% limit_actions(off%) shade(keypadW%,ic%,off%) buttonfield%(0,ic%)>0 shade(mainW%,field%(buttonfield%(0,ic%)),off%) ic%=-1 lit(fieldM%,0,off%) lit(fieldM%,1,off%) lit(fieldM%,2,off%) 12,14,15,16,17,18,20,21,22,-1 identify_field(ic%) .Fieldnumber%=0:Fieldname$="":TextLength%=0 (ic% 2)=1 ! !block%=mainW%:block%!4=ic% "Wimp_GetIconState",,block% TextLength%=block%!36-1 Fieldnumber%=(ic%+1) 3 Fieldname$=$ text(mainW%,desc%(Fieldnumber%)) Fieldname$="" Fieldname$=Tag$(Fieldnumber%) selected(prefsW%,21) $ chartype%(Fieldnumber%) / Leave keyboard status unchanged & 2,4: "OS_Byte",202,0,239 # "OS_Byte",202,16,111 "OS_Byte",118 first_writable I%+=1 (vtype$(chartype%(I%))="E" len%(I%)>0) I%>fields% I%>fields% last_writable I%=fields%+1 I%-=1 (vtype$(chartype%(I%))="E" len%(I%)>0) I%=0 Mouse_click processing ---------------------------------------------- mouse(x%,y%,b%,wi%,ic%) oldx%=x%:oldy%=y% Cblock%!0=x%:block%!4=y%:block%!8=b%:block%!12=wi%:block%!16=ic% T%=0 LastTable% wi%=tableW%(T%) Tablenumber%=T% wi% iconbar_click accessW%:accessbutton%=ic% aclW%: mainW%: main_click(wi%,ic%,b%) keypadW%: keypad_click(wi%,ic%,b%) saveW%,savesubW%: save_click(wi%,ic%,b%) keyW%: key_click(wi%,ic%,b%) tabcreateW%: tabcreate_click(wi%,ic%,b%) scrollW%: scroll_click linkW%: link_to_table passW%: passwords(x%,wi%,ic%,b%) printW%: print_click(wi%,ic%,b%) matchW%: match_click(wi%,ic%,b%) createW%: create_click tableW%(Tablenumber%): table_click(Tablenumber%) changeW%: change_click(wi%,ic%,b%) moveW%: move_click(wi%,ic%,b%) listW%: list_click(x%,y%,b%,wi%) colW%: set_colours(wi%,ic%,b%) calcW%: calc_formula($CalcForm%) labelW%: label_click(wi%,ic%,b%) mergeW%: merge_click sizeW%: size_click(wi%,ic%,b%) csvW%: csv_click(wi%,ic%,b%) fkeyW%: fkey_click(wi%,ic%,b%) prefsW%: prefs_click(wi%,ic%,b%) queryW%: query_click(wi%,ic%,b%) helpW%: help_click(wi%,ic%,b%) reformW%: reform_click(wi%,ic%,b%) filterW%: filter_click(wi%,ic%,b%) searchW%: search_click(wi%,ic%,b%) gridW%: grid_click(wi%,ic%,b%) relateW%: val_help pselectW%,infoW%,miscW%,bannerW%: ### No action on these ### special_click grid_click(wi%,ic%,b%) z%,space%,snap% b%=(b% %111) 1,4: b%=4 z%=1 z%=-1 ic% & 0:showgrid%= selected(wi%,0) ( 4:gridcol%=(gridcol%+1) 4 1:gridcol%-=1: gridcol%<0 gridcol%=15 - set_icon_cols(wi%,ic%,7+gridcol%*16) 3,4: ! selected_esg(wi%,1) 3:plot%=5 4:plot%=21 D 5:snapgrid%= selected(wi%,5): shade(createW%,49,snapgrid%) % "Wimp_CreateMenu",,-1 11,12: > space%= ($gridint%):space%+=(2*z%)*((ic%=11)-(ic%=12)) < space%>0 $gridint%= (space%): redraw_icon(wi%,8) 13,14: < snap%= ($snapint%):snap%+=(2*z%)*((ic%=13)-(ic%=14)) : snap%>0 $snapint%= (snap%): redraw_icon(wi%,9) ic%>=0 redraw(mainW%) filter_click(wi%,ic%,b%) b%=(b% %111) ic% C $Query%<>"" Filter$= parse:addr= moveto(key%,top,1) deselect(keypadW%,22) F ic%=field%(buttonfield%(0,22)): ic%>0 deselect(mainW%,ic%) * filter(keypadW%, ):Filter$="TRUE" 8 close_it(wi%): set_caret(mainW%,starthere%) search_click(wi%,ic%,b%) searchkey%,index$,z%,addr2,oldaddr oldaddr=addr index$=$ text(wi%,3) index$<>Index$(searchkey%) searchkey%+=1 b%=(b% %111) 1,4: b%=4 z%=1 z%=-1 ic% z%=-1 check_change . SearchKey$= stripspaces($ text(wi%,1)) ) chartype%(KF%(searchkey%,0)) 5,50,51: Z check_date(searchkey%,SearchKey$,1,date$)= SearchKey$= reverse_date(date$) > SearchKey$<>"" addr= find(SearchKey$,searchkey%, searchkey%<>key% , val$= type(key%):kl%= (key$(key%)) * addr2= search(key$(key%),key%,2) addr2<0 / 7:flash%=KF%(key%,0):addr=oldaddr addr=addr2 # b%=4 %6 close_it(wi%): set_caret(mainW%,starthere%) set_caret(wi%,1) ' )) chartype%(KF%(searchkey%,0)) *8 5,50,51:SearchKey$= reverse_date(SearchKey$) + ,F $ text(wi%,1)=SearchKey$: redraw_icon(wi%,1): set_caret(wi%,1) -9 close_it(wi%): set_caret(mainW%,starthere%) 11:searchkey%+=z% 12:searchkey%-=z% searchkey%>Keys% searchkey%=0 searchkey%<0 searchkey%=Keys% 3: $ text(wi%,3)=Index$(searchkey%): redraw_icon(wi%,3) reform_click(wi%,ic%,b%) text(wi%,7) b%=(b% %111) ic% close_window(wi%) reform$ ?( "Merge": merge_files(f$,file%) @" "Reformat": reformat(f$) b%=4 close_window(wi%) query_click(wi%,ic%,b%) (b% %111) 1,4: ic% JD 2:$Query%=query$: redraw_icon(wi%,0): set_caret(queryW%,0) Match_tag%=Fieldnumber% M) $ text(helpW%,0)=Tag$(Match_tag%) N5 position_window(helpW%,x%+64,y%-300,0,0,0,0) O. set_caret(helpW%,6):fieldfunc$="help" prefs_click(wi%,ic%,b%) b%=(b% %111) 1,4: ic% 27,28,29: [* shade(wi%,25, selected(wi%,29)) \- shade(wi%,32, selected(wi%,31)) ^Q get_preferences(prefsW%,".Resources.Preference"): redraw(wi%) selected(wi%,35) a= save_preferences(prefsW%,$database%+".Preference") bI save_preferences(prefsW%,".Resources.Preference") c b%=4 close_window(wi%) starthere%= start_at h' set_caret(mainW%,starthere%) i k4 restore_window(wi%,remember%+winbuff%(4,1)) lP b%=4 close_window(wi%): set_caret(mainW%,starthere%) redraw(wi%) m) auto_csv( selected(wi%,44)) kill%= selected(wi%,12) q%autosave%=29- selected_esg(wi%,2) r"autobalance%= selected(wi%,31) shade(wi%,32, selected(wi%,31)) set_icon(queryW%,1, selected(wi%,30)) start_at ic%,F%,I% $StartHere%="":F%= first_writable:ic%=field%(F%) ($StartHere%)>0:F%= ($StartHere%):ic%=F%*2-1 I%Tag$(I%) I%+=1 $StartHere%=Tag$(I%) vtype$(chartype%(I%))="E" F%=I%:ic%=F%*2-1 , first_writable:ic%=field%(F%) $StartHere%=Tag$(F%) fkey_click(wi%,ic%,b%) z%,K$,K%,Z% b%=(b% %111) 1,4: (b% %111)=4 z%=1 z%=-1 ic% 4,5: # K$=$Fkeyequiv%:K%= K$,2)) ic% 4:K%+=z% 5:K%-=z% K%=12 K%=0 K%<0 K%=11 ) K%=0 K$="None" K$="F"+ * $Fkeyequiv%=K$: redraw_icon(wi%,3) # K$=$Fkeyequiv%:K%= K$,2)) K%>0 K%>9 K%+=64 % selected(wi%,1) K%+=16 % selected(wi%,2) K%+=32 K%+=384 > Z%= key_assigned(K%): Z%<>-1 buttonfield%(1,Z%)=0 buttonfield%(1,kpad%)=K% - kpad%=13 buttonfield%(1,23)=K%+16 - kpad%=14 buttonfield%(1,24)=K%+16 ) b%=4 "Wimp_CreateMenu",,-1 $ "Wimp_CreateMenu",,-1 change_click(wi%,ic%,b%) b%=(b% %111) ic% I changes(key%,Menufield%,$ text(changeW%,0),$ text(changeW%,1), b%=4 close_it(wi%) % set_caret(mainW%,starthere%) 8 close_it(wi%): set_caret(mainW%,starthere%) move_click(wi%,ic%,b%) b%=(b% %111) ic% 8 0,1,2: shade(moveW%,6, set_caret(queryW%,0) 3 shade(moveW%,6, set_caret(moveW%,6) & undo% save_keys:undo%= % move_records(key%,file%,top) ( read(fields%, ,REC%,$database%) addr= moveto(key%,top,1) @ b%=4 close_it(moveW%): set_caret(mainW%,starthere%) undo% 3 open_index($database%+".PrimaryKey",0, # f$=$database%+".Indices." Keys%>0 K%=1 Keys% - open_index(f$+Index$(K%),K%, undo%= @ b%=4 close_it(moveW%): set_caret(mainW%,starthere%) < close_it(moveW%): set_caret(mainW%,starthere%) csv_click(wi%,ic%,b%) b%=(b% %111) 2,4: ic% 5 show_menu(delimiterM%,oldx%+32,oldy%+16) 6 show_menu(terminatorM%,oldx%+32,oldy%+16) 1,4: ic% , shade(wi%,4,( selected(wi%,1))) " text(wi%,9)="Import" csvfunc$ 7 "ImportMain": convert_csv($ text(wi%,13)) F "ImportTable": csv_to_table(Tablenumber%,$ text(wi%,13)) % b%=4 close_window(csvW%) d restore_window(wi%,remember%+winbuff%(0,1)): b%=4 close_window(wi%) redraw(wi%) selected(wi%,18) ? save_csv_options(".Resources.CSVoptions") 7 save_csv_options($database%+".CSVoptions") A get_csv_options(".Resources.CSVoptions") 7 selected(csvW%,24) softerror("",132) merge_click merging% ic%<>4 ic%<>5 finished%= (b% %111)=4 z%=1 z%=-1 ic% "Impulse_SendMessage",&201,":"+$mergewith%+"."+document$+" Print",,,,printtag%,mytask% merging%= $mergewith%=$ImpulseApp% "Impulse_SendMessage",&200,":"+$mergewith%+"."+document$+" Edit Off",,,,-1,mytask% H mergenum%=0:$ text(mergeW%,7)= (mergenum%): redraw_icon(mergeW%,7) selected(queryW%,4) direction%=-1 direction%=1 4 addr= neighbour(key%,addr,(-direction%+1) ( addr= moveto(key%,addr,direction%) close_file(dbasehandle%):addr=ClientPtr%: close_it(mergeW%) "Impulse_SendMessage",&200,":"+$mergewith%+"."+document$+" ClearMerge",,,,-1,mytask% "Impulse_SendMessage",&200,":"+$mergewith%+"."+document$+" Edit On",,,,-1,mytask% 12:merging%= deselect(mergeW%,3) size_click(wi%,ic%,b%) recs$,int$ recs$= (RA%) keybase%=!keyanchor%(0) keybase%!4>0 inc$= (keybase%!4) inc$="0" b%=(b% %111) 1,4: ic% ($Records%)<=0: softerror("",71) 0 $Records%=recs$: redraw_icon(sizeW%,1) ($Increment%)<0 softerror("",72) 1 $Increment%=inc$: redraw_icon(sizeW%,3) !# keybase%!4= ($Increment%) "7 present%=7 change_length( ($Records%), #+ b%=4 "Wimp_CreateMenu",,-1 $ &( $Records%=recs$:$Increment%=inc$ ' "Wimp_CreateMenu",,-1 table_click(T%) S$,tablefield% .`NewTab%=( table_info(T%,Rows%,TabFields%,Rec%,tabfieldlen%(),offset%,heading%,colours$)=" /*extra%=-NewTab%*(Rows%*(TabFields%+1)) lit(tableM%,1,NewTab% Modify%) $tableM%=table$(T%) ic%>=0 3( tablefield%=(ic% (TabFields%+1)) tablefield%=0 2047 ic%5 redraw_icon(mainW%,field%(Fieldnumber%)) @ 1024: ic%=0 lit(tableM%,3,Access%) NewTab% MB h$=$ text(tableW%(T%),Rows%*(TabFields%+1)+sort_tabcol%) N% $SortTabCol%="Sort "+ h$,9) O7 $SortTabCol%="Sort column "+ (sort_tabcol%) P lit(tableM%,3, lit(tableM%,7, selected(passW%,13)) lit(tableM%,6, selected(passW%,13)) show_menu(tableM%,x%-64,y%-20) 256: invert(wi%,tablefield%+extra%) X@ field$= (tablefield%): tablefield%<10 field$="0"+field$ field$+=":" selected(wi%,tablefield%+extra%) printrel$(T%)+=field$ \ ]! P%= printrel$(T%),field$) ^? printrel$(T%)= printrel$(T%),P%-1)+ printrel$(T%),P%+3) scroll_click (b% %111)=2 row%=(ic% f0$tabcol%= (row%): redraw_icon(tabcreateW%,8) list_click(x%,y%,b%,wi%) N%,last% (b% %111) !block%=wi% "Wimp_GetWindowState",,block% o* column%=(x%-block%!4+block%!20) p( last%= (Form$) 2:sort_textcol%=0 last%>0 r sort_textcol%+=1 t= Tab%(sort_textcol%)>column%+1 sort_textcol%=last% uW sort_textcol%-=1:$SortTextCol%="Sort "+Tag$( ("&"+ Form$,sort_textcol%*2+1,2))) lit(listM%,0, selected(passW%,13)) show_menu(listM%,x%-64,y%-20) 1,4: sorted% !block%=wi% |( "Wimp_GetWindowState",,block% }. line%=(block%!16-block%!24-y%+36) ~, column%=(x%-block%!4+block%!20) RecPtr%=!recanchor% R%=RecPtr%!(line%*4) last%= (Form$) R%>=0 & addr= find("#"+ (R%),key%, format$ "horiz","table" N%+=1 + Tab%(N%)>column%+1 N%=last% & F%= fnum( Form$,N%*2-1,2)) "vert": N%+=1:line%-=1 . RecPtr%!(line%*4)<>R% N%=last% & F%= fnum( Form$,N%*2-1,2)) $ "tree":F%=KF%(tkey%,0) "dup":F%=KF%(0,0) F%>0 F%<=fields% ) vtype$(chartype%(F%))="E" ; set_caret(mainW%,field%(F%)):Fieldnumber%=F% E set_caret(mainW%,starthere%):Fieldnumber%=starthere% (b% %111)=4 " open_window(mainW%) N !block%=mainW%:block%!4=desc%(F%): "Wimp_GetIconState",,block% L xmin%=block%!8:ymin%=block%!12:xmax%=block%!16:ymax%=block%!20 @ block%!4=field%(F%): "Wimp_GetIconState",,block% @ w%=block%!16-block%!8+16:h%=block%!20-block%!12+16 6 scrollx%=block%!8-8:scrolly%=block%!20+8 G xmax%block%!16:w%=xmax%-block%!8+16 7 ymax%block%!20:h%=ymax%-block%!12+16:scrolly%=ymax%+8 V position_window(mainW%,x%-(w% 2),y%-(h% 2),w%,h%,scrollx%,scrolly%) softerror("",61) match_click(wi%,ic%,b%) not%,and%,or% b%=(b% %111) selected_esg(printW%,4) 38:reportdest$="Window" 39:reportdest$="File" 41:reportdest$="Printer" ic% [ 2:TextName$=$database%+".PrintJobs."+key$(0): do_it("",REC%):$SaveName%=TextName$ Q shade(wi%,4, selected(wi%,ic%)): shade(wi%,6, selected(wi%,ic%)) 8 close_it(wi%): set_caret(mainW%,starthere%) $ Search$= parse:displayed%=-1 Search$<>"FALSE" B $Query%="": redraw_icon(queryW%,0): set_caret(queryW%,0) M TextName$=$database%+".PrintJobs."+ query$,10):$SaveName%=TextName$ reportdest$ ! "Window","Printer": & do_it(Search$,displayed%) "File": ! savefunc$="Save list" 6 $SaveSprite%="sfile_fff;Pptr_hand,12,8;R2" : position_window(saveW%,x%-138,y%-130,0,0,0,0) set_caret(saveW%,2) R b%=4 selected(wi%,3) close_it(wi%): set_caret(mainW%,starthere%) P show_menu( field_menu(fields%,(printorder$<>"")),oldx%+32,oldy%+16) help_click(wi%,ic%,b%) butt%=(b% %111) butt% 2,4: ' fieldmenu%= field_menu(fields%, tick_one(fieldmenu%,0,fields%-1,Match_tag%-1) ic%=19 show_menu(fieldmenu%,oldx%+32,oldy%+16) butt% 1,4: ic% W 1:new$="NOT (":$Query%+=new$: redraw_icon(queryW%,0): set_caret(wi%,6):not%= P 9:new$=" AND ":$Query%+=new$: redraw_icon(queryW%,0): set_caret(wi%,6) P 10:new$=" OR ":$Query%+=new$: redraw_icon(queryW%,0): set_caret(wi%,6) 16,17: 8 (b% %111)=4 z%=1 (b% %111)=1 z%=-1 2 ic%=16 Match_tag%+=z% Match_tag%-=z% + Match_tag%>fields% Match_tag%=1 + Match_tag%<1 Match_tag%=fields% : $ text(wi%,0)=Tag$(Match_tag%): redraw_icon(wi%,0) A 21:$Query%="": redraw_icon(queryW%,0): set_caret(wi%,6) op%= selected_esg(wi%,1) op% 2:op$="=" 3:op$="{" 4:op$="<" 5:op$=">" 11:op$="<>" 13:op$=">=" 14:op$="<=" 15:op$="}{" tag$=$ text(wi%,0) contents$=$ text(wi%,6) new$=tag$+op$+contents$ E $Query%+=new$: not%= $Query%)<>")" $Query%+=")":not%= redraw_icon(queryW%,0) > $ text(wi%,6)="": redraw_icon(wi%,6): set_caret(wi%,6) 4 close_it(helpW%): set_caret(queryW%,0) iconbar_click %111 selected(passW%,12) close_window(saveW%) ) show_menu(iconbarM%,x%-64,ybar%) $dbase%="No data" $SaveName%="!DataBase" 2 $SaveSprite%="snew_appl;Pptr_hand,12,8;R2" savefunc$=choice$(1) 1 "Wimp_CreateMenu",,saveW%,x%-50,y%+300 show_windows main_click(wi%,ic%,b%) P%,F%,H$,L%,T%,N$,field$ present%=7 adjust%= validate(Fieldnumber%,T%,N$)= changed%= update_calcs(Fieldnumber%) flash% deselect(wi%,field%(flash%)):flash%= OLE_edit%>0: show_text_block(OLE_edit%) OLE_edit%<0: show_picture(-OLE_edit%) OLE_edit%<>0 redraw_icon(wi%,field%( (OLE_edit%))):OLE_edit%=0 present% 0,3: design_field(b%,ic%, first_writable>0 default_key design_field(b%,ic%, 5,7: adjust% design_field(b%,ic%, identify_field(ic%) ", selected(prefsW%,19) relations 2047 %& chartype%(Fieldnumber%) &B show_user_menu(Fieldnumber%-1,oldx%+32,oldy%+16) 'y 9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31: fkey_status(chartype%(Fieldnumber%)-9) )! close_window(saveW%) *. selected(passW%,11) Modify% + set_up_field_menu ,, show_menu(mainM%,x%-64,y%-20) 0& chartype%(Fieldnumber%) 1J 0,1,2,3,4,5,6,7,8,39,46,47,48,49,50,51,52,53,54,55,56,57,58: 2H "Wimp_GetCaretPosition",,block%:first%=((block%!4)+2) 30 select_range(first%,Fieldnumber%, 4} 9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30: keypad_click(wi%,chartype%(Fieldnumber%)-9,1) 5G filter(wi%, selected(wi%,field%(buttonfield%(0,22)))) 36,41,42,43: invert(wi%,ic%) 8( col%= get_icon_cols(wi%,ic%) 94 col%=((col%>>4) (col%<<4)) %11111111 :( set_icon_cols(wi%,ic%,col%) ;% boxon%=((col% %1111)<2) <% update_selection(boxon%) (-1) @( chartype%(Fieldnumber%) 9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30: keypad_click(wi%,chartype%(Fieldnumber%)-9,4) BI filter(wi%, selected(wi%,field%(buttonfield%(0,22)))) CA selected(passW%,14) match(x%-396,y%-131) DD show_user_menu(Fieldnumber%-1,oldx%+32,oldy%+16) 45:quit%= G. execute_file(Fieldnumber%) link$(Fieldnumber%),1)="@" "OS_CLI","Filer_OpenDir "+ link$(Fieldnumber%),2)+" "+ (oldx%)+" "+ (oldy%)+" "+dirdisp$ softerror("",91) It 36,39: (-2) enter_tag edit_blob(Fieldnumber%,chartype%(Fieldnumber%)):OLE_edit%=Fieldnumber% JF 37,38: edit_blob(Fieldnumber%,chartype%(Fieldnumber%)) K[ edit_blob(Fieldnumber%,chartype%(Fieldnumber%)):OLE_edit%=-Fieldnumber% 41,42,43: M, Access% invert(wi%,ic%) (-2) O, Access% invert(wi%,ic%) enter_tag RU selected(wi%,ic%) $Rf%(Fieldnumber%)=" " $Rf%(Fieldnumber%)="" relations V# lookup(Fieldnumber%) 256: Y& chartype%(Fieldnumber%) ZJ 0,1,2,3,4,5,6,7,8,39,46,47,48,49,50,51,52,53,54,55,56,57,58: [k get_icon_cols(wi%,ic%)<>winback%*17 invert(wi%,ic%): update_selection( selected(wi%,ic%)) 1024: (-2) enter_tag a( chartype%(Fieldnumber%) 0,1,2,3,4,5,8: cG Fieldnumber%>0 get_icon_cols(wi%,ic%)<>winback%*17 d< !block%=wi%: "Wimp_GetWindowState",,block% e] Access% "Wimp_SetCaretPosition",wi%,ic%,x%-block%!4+block%!20,y%,-1,-1 i enter_tag wi%,S$ "Wimp_GetCaretPosition",,block% q+wi%=!block%:ic%=block%!4:pos%=block%!20 text(wi%,ic%) s/S$= S$,pos%)+Tag$(Fieldnumber%)+ S$,pos%+1) text(wi%,ic%)=S$ redraw_icon(wi%,ic%) set_caret(wi%,ic%) set_up_field_menu I%,tabmen%,V% tabmen%=(LastTable%<>-1) tabmen% tick_one(tablemenu%,0,LastTable%,LastTable%+1) V%=chartype%(Fieldnumber%) Fieldnumber%>0 get_icon_cols(wi%,ic%)<>winback%*17 Menufield%=Fieldnumber% lit(mainM%,1, $AnalyseFunc%="Analyse" E $Fieldpos%="Field: "+Tag$(Fieldnumber%):Menufield%=Fieldnumber% & $LinkTitle%="Field: "+Fieldname$ ' $CalcForm%=Tag$(Fieldnumber%)+"=" I%=0 lit(fieldM%,I%, 5,50,51: $ isadate%= lit(fieldM%,1, & $AnalyseFunc%="Analyse months" :isadate%= is_a_key(Fieldnumber%)>=0 lit(fieldM%,1, _ isadate%= selected(mainW%,field%(Fieldnumber%)) $AnalyseFunc%="Analyse index" 0,1,2,3,4,5,8: lit(fieldM%,0,Access%) lit(fieldM%,2,Access%) ) lit(fieldM%,3,Access% tabmen%) lit(fieldM%,5,Access%) lit(fieldM%,8, I%=0 keyfield%(I%)=0 J%=12 $ $ text(keyW%,4*I%+J%)="" ! keyfield%(0)=Fieldnumber% + $ text(keyW%,12)=Tag$(Fieldnumber%) $ text(keyW%,14)="L" . $ text(keyW%,15)= (len%(Fieldnumber%)) 1 keylimit%=TextLength%:$ text(keyW%,29)="" keylen%=keylimit% * $ChangeTitle%="Field: "+Fieldname$ 3 $ text(changeW%,0)="":$ text(changeW%,1)="" link_status lit(fieldM%,4,Modify%) ) lit(fieldM%,3,Access% tabmen%) lit(fieldM%,2,Access%) ' calc_link("Calculations...",6) link_status lit(fieldM%,4,Modify%) ) lit(fieldM%,3,Access% tabmen%) lit(fieldM%,2,Access%) ) calc_link("Combine fields...",7) link_status 1 46,47,48,49,50,51,52,53,54,55,56,57,58: V%=47 ! lit(fieldM%,4,Modify%) ! lit(fieldM%,9,Modify%) ) calc_link("Set base value",47) lit(fieldM%,0,Access%) I%=0 keyfield%(I%)=0 J%=12 $ $ text(keyW%,4*I%+J%)="" ! keyfield%(0)=Fieldnumber% + $ text(keyW%,12)=Tag$(Fieldnumber%) $ text(keyW%,14)="L" . $ text(keyW%,15)= (len%(Fieldnumber%)) 1 keylimit%=TextLength%:$ text(keyW%,29)="" keylen%=keylimit% 36,39: D blob_path( ,$database%,REC%,Fieldnumber%,V%,object$)>=0 & $RemoveOb%="Remove external" ! lit(fieldM%,6,Access%) . lit(fieldM%,7, selected(passW%,13)) $SaveName%="TextFile" 4 $SaveSprite%="sfile_fff;Pptr_hand,12,8;R2" savefunc$="Save text" 37,40: D blob_path( ,$database%,REC%,Fieldnumber%,V%,object$)>=0 & $RemoveOb%="Remove external" ! lit(fieldM%,6,Access%) lit(fieldM%,7, $SaveName%="Sprite" 4 $SaveSprite%="sfile_ff9;Pptr_hand,12,8;R2" ! savefunc$="Save sprite" D blob_path( ,$database%,REC%,Fieldnumber%,V%,object$)>=0 & $RemoveOb%="Remove external" ! lit(fieldM%,6,Access%) lit(fieldM%,7, $SaveName%="DrawFile" 4 $SaveSprite%="sfile_aff;Pptr_hand,12,8;R2" savefunc$="Save draw" % $RemoveOb%="Unlink directory" ; link$(Fieldnumber%)<>"" lit(fieldM%,6,Access%) $RemoveOb%="Unlink file" ; link$(Fieldnumber%)<>"" lit(fieldM%,6,Access%) lit(mainM%,1, ):$Fieldpos%="Field: ''" update_selection(add%) P%,SP%,F%,SF% >F%=Fieldnumber%:SF%=(F% 128): (printorder$)=0 SF%=F% -field$= ~(F%): F%<16 field$="0"+field$ 2sfield$= ~(SF%): SF%<16 sfield$="0"+sfield$ add% (-1) printorder$+=sfield$ printorder$+=field$ enable_row(calcrow%?Fieldnumber%, lit(printM%,6, lit(printM%,7, lit(mainM%,7, selected(passW%,13)) $ P%= printorder$,field$,P%+1) ((P%-1) 2)=0 P%=0 P%>0 9 printorder$= printorder$,P%-1)+ printorder$,P%+2) , enable_row(calcrow%?Fieldnumber%, ) SP%= printorder$,sfield$,SP%+1) ! ((SP%-1) 2)=0 SP%=0 SP%>0 = printorder$= printorder$,SP%-1)+ printorder$,SP%+2) . enable_row(calcrow%?Fieldnumber%, printorder$="" lit(printM%,6, lit(printM%,7, lit(mainM%,7, shade(matchW%,7,printorder$<>"") print_click(wi%,ic%,b%) b%=(b% %111) selected(wi%,26) show_menu(labelW%,x%-500,y%+200) 1,4: ic% 23,24,25: ( shade(wi%,15, selected(wi%,25)) < shade(wi%,43, selected(wi%,25) selected(wi%,23)) ( shade(wi%,45, selected(wi%,25)) ( shade(wi%,15, selected(wi%,25)) < shade(wi%,43, selected(wi%,25) selected(wi%,23)) ( shade(wi%,45, selected(wi%,25)) 5 $ text(labelW%,20)= text(labelW%,10))+1) 0 shade(labelW%,20, selected(labelW%,11)) !0 shade(labelW%,12, selected(labelW%,11)) "N position_window(labelW%,x%-303,y%-360,0,0,0,0): set_caret(labelW%,10) #R get_options(printW%,".Resources.PrtOptions"): redraw(wi%) $T b%=4 close_window(wi%): set_caret(mainW%,starthere%) match(0,0) restore_window(wi%,remember%+winbuff%(3,1)): b%=4 close_window(wi%): set_caret(mainW%,starthere%) redraw(wi%) '( shade(wi%,10, selected(wi%,47)) (( shade(wi%,19, selected(wi%,47)) selected(wi%,50) +C save_options(printW%,".Resources.PrtOptions") -6 $SaveName%=$database%+".PrintRes.PrtOptions" .4 $SaveSprite%="sfile_7f5;Pptr_hand,12,8;R2" /" savefunc$="Save options" 0( show_menu(saveW%,x%-64,y%-20) 1 label_click(wi%,ic%,b%) b%=(b% %111) 1,4: ic% <5 $ text(labelW%,20)= text(labelW%,10))+1) =0 shade(labelW%,20, selected(labelW%,11)) >0 shade(labelW%,12, selected(labelW%,11)) @5 $ text(labelW%,20)= text(labelW%,10))+1) A0 shade(labelW%,20, selected(labelW%,11)) B0 shade(labelW%,12, selected(labelW%,11)) C' b%=4 close_window(labelW%) Dd restore_window(wi%,remember%+winbuff%(2,1)): b%=4 close_window(wi%) redraw(wi%) keypad_click(wi%,ic%,b%) handle%,icon%,T%,N$,date$ close_window(relateW%) flash% deselect(mainW%,field%(flash%)):flash%= ic%<>12 validate(Fieldnumber%,T%,N$)= changed%= update_calcs(Fieldnumber%) check_change b%=(b% %111) fkey_status(ic%) 1,4: b%=4 z%=1 z%=-1 ic% U' scan(z%, text(wi%,23))) 1:stop%= W% 2:addr= moveto(key%,top,z%) X& 3:addr= moveto(key%,top,-z%) Y& 4:addr= moveto(key%,addr,z%) Z' 5:addr= moveto(key%,addr,-z%) [( 6:addr= fast_wind(top,addr,z%) \) 7:addr= fast_wind(top,addr,-z%) key_select(z%) key_select(-z%) subfile(z%) subfile(-z%) a- rotate:addr= moveto(key%,top,1) b" allow_search(wi%,z%) c< b%=4 display(key%,-1) display(key%,-2) d# 15:addr= shift(z%,key%,0) (-1) f( addr= find("#"+ (REC%),key%, display(key%,addr) h i$ 16:addr= shift(-z%,key%,0) (-1) k( addr= find("#"+ (REC%),key%, display(key%,addr) m n6 17:addr= shift(0,key%,1): display(key%,addr) val_help p+ check_change: save_everything store r# retrieve(scratchpad$) s, filter(wi%, selected(wi%,ic%)) 24,25,26,27: v text(wi%,ic%)="" R$=$ text(wi%,ic%) yG R$="" text(wi%,ic%)= (REC%) addr= find("#"+R$,key%, z redraw_icon(wi%,ic%) |K "OS_Byte",202,0,239: show_menu(specialM%,oldx%+32,oldy%+16) }$ open_window(specialW%) fkey_status(ic%) Modify% keynumber% ic%>=0 ic%<23 kpad%=ic% ic%=22 $Kpadicon%="Soptoff;r5,14" $Kpadicon%=$ val(keypadW%,ic%) $FkeyTitle%=vname$(ic%+9) $ keynumber%=buttonfield%(1,ic%) keynumber%>0 - $Fkeyequiv%="F"+ (keynumber% %1111) / set_icon(fkeyW%,1,(keynumber% 1<<4)) / set_icon(fkeyW%,2,(keynumber% 1<<5)) $ text(fkeyW%,3)="None" deselect(fkeyW%,1) deselect(fkeyW%,2) lit(keystrokeM%,0, lit(keystrokeM%,0, show_menu(keystrokeM%,x%-64,y%-20) load_fkeys(f$) F,I% buttonfield%()=0 (".Resources."+f$) I%=0 buttonfield%(1,I%)= close_file(F) save_fkeys F,I% (".Resources.Fkeys") I%=0 (buttonfield%(1,I%)) close_file(F) list_fkeys I%,line$,Heading$,F @TextName$=$database%+".PrintJobs.Fkeys":$SaveName%=TextName$ read_print_options (format$="horiz":reportdest$="Window" 5Heading$=margin$+ pad("Keystroke equivalents",30) LenLine%= (Heading$)+2 extend_named_sliding_block(lineanchor%,LenLine%+4) extend_named_sliding_block(headanchor%,LenLine%+4):pos%=!headanchor% heap_store(headanchor%,LenLine%,0,pos%,0,Heading$) ,Count%=0:Title$="":Title1$="":Title2$="" list_head(0) "Hourglass_On" I%=0 K%=buttonfield%(1,I%) K%=0 K$="None" K$="F"+ %1111) & (K% (1<<4)) (139)+K$ # (K% (1<<5)) K$="^"+K$ , line$=margin$+ pad(vname$(I%+9),24)+K$ B $(!lineanchor%)=line$: list_line(-1,lineanchor%, (line$),32) I%=13 E line$=margin$+ pad(vname$(I%+9)+" all subfiles",24)+ (139)+K$ D $(!lineanchor%)=line$: list_line(-1,lineanchor%, (line$),32) I%=14 @ line$=margin$+ pad("Copy displayed record",24)+ (139)+K$ D $(!lineanchor%)=line$: list_line(-1,lineanchor%, (line$),32) (".Resources.KeyList") line$=margin$+ D $(!lineanchor%)=line$: list_line(-1,lineanchor%, (line$),32) close_file(F) "Hourglass_Off" lit(listM%,1, screen_list pitch$= pitch("2") write_log(-1,"Keystroke equivalents printed") scan(z%,s%) stop%= addr= moveto(key%,addr,z%) K%= stop% store wi%,ic% "Wimp_GetCaretPosition",,block% wi%=!block%:ic%=block%!4 scratchpad$=$ text(wi%,ic%) retrieve(S$) wi%,ic%,L% "Wimp_GetCaretPosition",,block% wi%=!block%:ic%=block%!4 scratchpad$<>"" L%= buffer_length(wi%,ic%) text(wi%,ic%)= S$,L%) redraw_icon(wi%,ic%) set_caret(wi%,ic%) ### Binary Large Objects (B.L.O.B.s) ### blob_path(create%,f$,R%,F%,V%, O$,main$,level1$,level2$,d%,dn%,do%,L%,bn$,bo$ 36,39:O$=".Memo" 37,40:O$=".Sprite" 38:O$=".Draw" main$=f$+O$+ "level1$=main$+"."+ 4900) "level2$=level1$+"."+ Tbn$=level2$+".Rec"+ (R%): "OS_File",5,bn$ dn%,,,,Ln%: dn%=1 d%=dn%:L%=Ln% Vbo$=level2$+"."+ 70): "OS_File",5,bo$ do%,,,,Lo%: do%=1 d%=do%:L%=Lo% objname$ "NEW":b$=bn$: do%=1 "OS_CLI","Rename "+bo$+" "+bn$ "OLD":b$=bo$: dn%=1 "OS_CLI","Rename "+bn$+" "+bo$ d%=0 create%= "OS_File",8,main$ "OS_File",8,level1$ "OS_File",8,level2$ d%=1 load_blob(f$,R%,F%,V%) L%,b$ blob_path( ,f$,R%,F%,V%,b$) L%>=0 extend_named_sliding_block(tempanchor%,L%+1) "OS_File",255,b$,!tempanchor% blob_to_file(F,L%) Used only to transfer CSV fields to external files L%>0 "OS_GBPB",2,F,!tempanchor%,L% copy_blob(source$,dest$,RS%,RD%,FS%,FD%,V%) L%,Z%,bs$,bd$ blob_path( ,source$,RS%,FS%,V%,bs$) L%>0 !+ Z%= blob_path( ,dest$,RD%,FD%,V%,bd$) "/ "OS_CLI","Copy "+bs$+" "+bd$+" ~C~V~Q" delete_blob(F%,F$,wi%,ic%) flag%,f$ selected(prefsW%,20) )& "OS_CLI","Delete "+F$:flag%= *$ confirm( msg("Err115")) +( "OS_CLI","Delete "+F$:flag%= flag% chartype%(F%) 06 36:$ val(wi%,ic%)="R5;Pptr_ext,8,4;Ssm!edit" 17 37:$ val(wi%,ic%)="R5;Pptr_ext,8,4;Ssm!paint" 26 38:$ val(wi%,ic%)="R5;Pptr_ext,8,4;Ssm!draw" 39:$ text(wi%,ic%)="" redraw_icon(wi%,ic%) asterisk( set_blob_sprite(R%,F%,V%) L%,b$,sprite$ R%=RA% L%=-1 blob_path( ,$database%,R%,F%,V%,b$) >< L%>=0 sprite$="small_fff" sprite$="sm!edit" ?= L%>=0 sprite$="small_ff9" sprite$="sm!paint" @< L%>=0 sprite$="small_aff" sprite$="sm!draw" val(mainW%,field%(F%))="R5;Pptr_ext,8,4;S"+sprite$ redraw_icon(mainW%,field%(F%)) edit_blob(F%,V%) wi%,ic%,b$,O$,val$,F check_change wi%=mainW%:ic%=field%(F%) KB 36:O$="Memo":val$="R5;Pptr_ext,8,4;Ssmall_fff":ftype%=&fff LD 37:O$="Sprite":val$="R5;Pptr_ext,8,4;Ssmall_ff9":ftype%=&ff9 MB 38:O$="Draw":val$="R5;Pptr_ext,8,4;Ssmall_aff":ftype%=&aff N6 39:O$="Memo":val$="L;Pptr_ext,8,4":ftype%=&fff O7 40:O$="Sprite":val$="Z0;Ssmall_ff9":ftype%=&ff9 blob_path( ,$database%,REC%,F%,V%,b$)<0 R$ V%<>40 val(wi%,ic%)=val$ SI "OS_CLI","Copy .Resources.Objects."+O$+" "+b$+" ~C~V" TP V%=36 (b$): #F,"Record "+ (REC%)+": "+$Rf%(KF%(0,0)): close_file(F) redraw_icon(wi%,ic%) W4block%!0=256:block%!12=0:block%!16=5:block%!20=0 X3block%!24=0:block%!28=0:block%!32=0:block%!36=0 Y)block%!40=ftype%:$(block%+44)=b$+ "Wimp_SendMessage",18,block%,0 link_file(wi%,ic%,F%,file$,ft%) leaf$= leaf(file$) dbasepath$=$database% file$="."+leaf$ `)link$(F%)="@"+file$:link$(0)="LOADED" val(wi%,ic%)="R5;Sfile_"+ ~(ft%) redraw_icon(wi%,ic%) asterisk( transfer_blob(wi%,ic%,file$,ft%) F%,V%,L%,W%,b$,ok% wi%<>mainW% check_change j#F%=(ic%+1) 2:V%=chartype%(F%) ft%=-1 leaf$= leaf(file$) o< dbasepath$=$database% file$="."+leaf$ p- link$(F%)="@"+file$:link$(0)="LOADED" ok%= tR ft%=&fff install_blob:$ val(wi%,ic%)="R5;Pptr_ext,8,4;Ssmall_fff":ok%= vR ft%=&ff9 install_blob:$ val(wi%,ic%)="R5;Pptr_ext,8,4;Ssmall_ff9":ok%= xR ft%=&aff install_blob:$ val(wi%,ic%)="R5;Pptr_ext,8,4;Ssmall_aff":ok%= z; ft%=&fff install_blob: show_text_block(F%):ok%= |8 ft%=&ff9 install_blob: show_picture(F%):ok%= ok% redraw_icon(wi%,ic%): asterisk( install_blob blob_path( ,$database%,REC%,F%,V%,b$) "OS_CLI","Remove "+b$ "OS_CLI","Copy "+file$+" "+b$+" ~C~V" show_text_block(F%) F,b$,I%,L%,base% F%=0 base%=Rf%(F%) blob_path( ,$database%,REC%,F%,39,b$) L%>0 L%>len%(F%) L%=len%(F%) ### Load only as much of file as we can display ### > F= (b$): F>0 "OS_GBPB",4,F,base%,L%: close_file(F) ### Replace any characters<32 by spaces - but ONLY for display ### I%=0 L%-1 # base%?I%<32 base%?I%=32 base%?L%=10 $base%="" show_picture(F%) F,f$,I%,max%,len%,x%,y%,w%,h% F%=0 /len%= blob_path( ,$database%,REC%,F%,40,f$) E!block%=mainW%:block%!4=field%(F%): "Wimp_GetIconState",,block% =0 extend_named_sliding_block(Rf%(F%),len%+4):base%=!Rf%(F%) / !base%=len%+4: "OS_File",255,f$,base%+4 O field%(F%)= create_icon(mainW%,x%,y%,w%,h%,&0700A53E,"",base%+16,base%,0) K field%(F%)= create_icon(mainW%,x%,y%,w%,h%,&0700A53E,"",paint%,1,384) filter(wi%,on%) x%,y%,vxmin%,vymax%,scrollx%,scrolly% filter%=on%:$Query%="" on% wi% keypadW%: 4 !block%=wi%: "Wimp_GetWindowState",,block% = position_window(filterW%,block%!12,block%!8,0,0,0,0) A mainW%: open_at(firstfilter%,filterW%,22,482,314,44,44) set_caret(queryW%,0) :Filter$="TRUE": close_it(filterW%): set_caret(mainW%,starthere%) fast_wind(T%,P%,D%) fast%= text(keypadW%,23)) D%=(D%+1) P%<>T% I%=0 selected (prefsW%,43) . addr=filemem%(file%): display(key%,addr) addr= moveto(key%,top,1) save_subfilenames present%=7 ! F= ($database%+".Subfiles") I%=0 #F,$Subfile%(I%) close_file(F) allow_search(wi%,e%) select(searchW%,5): deselect(searchW%,6) select(searchW%,6): deselect(searchW%,5) text(searchW%,1)="": redraw_icon(searchW%,1) text(searchW%,7)="": redraw_icon(searchW%,7) text(searchW%,3)=Index$(key%) wi% keypadW%: 7 !block%=keypadW%: "Wimp_GetWindowState",,block% position_window(searchW%,block%!12,block%!8,0,0,0,0) mainW%: open_at(firstsearch%,searchW%,13,456,314,114,52) set_caret(searchW%,1) val_help name$,subst%,field%,extra%,fld% "Wimp_GetCaretPosition",,block% wi%=block%!0:ic%=block%!4 fld%=(ic%+1) wi%=mainW% fld%>0 name$=link$(fld%) + field%= trailing_number(name$,exact%) # subst%= leading_number(name$) ' Tablenumber%= table_number(name$) Tablenumber%<>-1 show_table(Tablenumber%) Tablenumber%=0 val_on_off I%=1 selected(prefsW%,21) $ :$valid%(I%)=$rvalid%(I%) ( :$valid%(I%)="Pptr_write,4,4" save_click(wi%,ic%,b%) p$,H$ butt%=(b% %111) wi% saveW%: Filename$=$SaveName% savefunc$ "New database": Type%=0 6 Filename$,1)<>"!" Filename$="!"+Filename$ 5 Filename$= Filename$,10):$SaveName%=Filename$ "Save as text": Type%=&fff 7 Start%=!textanchor%:End%=Start%+Count%*LenLine% $Start%=pitch$ "Save list": Type%=&fff:savetofile%= "Save text": Type%=&fff: = len%= blob_path( ,$database%,REC%,Fieldnumber%,36,f$) 7 extend_named_sliding_block(saveanchor%,len%+1) ( "OS_File",255,f$,!saveanchor% , Start%=!saveanchor%:End%=Start%+len% "Save sprite": Type%=&ff9 = len%= blob_path( ,$database%,REC%,Fieldnumber%,37,f$) 7 extend_named_sliding_block(saveanchor%,len%+1) !( "OS_File",255,f$,!saveanchor% ", Start%=!saveanchor%:End%=Start%+len% "Save draw": Type%=&aff %= len%= blob_path( ,$database%,REC%,Fieldnumber%,38,f$) &7 extend_named_sliding_block(saveanchor%,len%+1) '( "OS_File",255,f$,!saveanchor% (, Start%=!saveanchor%:End%=Start%+len% "Save options": Type%=&7f5 "Save query": $savebuff%=query$ -; Start%=savebuff%:End%=Start%+ (query$)+1:Type%=&7f4 .* "Save selection": save_selection "Save table": 0c z$= table_info(Tablenumber%,Rows%,TabFields%,Rec%,tabfieldlen%(),offset%,heading%,colours$) 1R Start%=!tabanchor%(Tablenumber%):End%=Start%+offset%+Rows%*Rec%:Type%=&7f1 2= "Save table as CSV":Filename$=$SaveName%:Type%=&dfe "Save form file": Type%=&7f2 lit(designM%,3, lit(designM%,4, lit(designM%,6, 86 adjust%= first_writable>0 default_key 99 "Export selected": export_selected(printorder$) savesubW%: savefunc$ "Export subset": ># Filename$=$SubName%:Type%=0 "Export CSV": @& Filename$=$SubName%:Type%=&dfe ic% (b% %11110000)>0 init_drag(wi%,ic%,5) Filename$,".")>0 H7 butt%<>2 save(Filename$,Type%,Start%,End%) I) write_log(-1,Filename$+" saved") butt%=4 wi%=saveW% L$ "Wimp_CreateMenu",,-1 M: close_it(wi%): set_caret(mainW%,starthere%) O softerror("",33) wi%=saveW% T "Wimp_CreateMenu",,-1 U6 close_it(wi%): set_caret(mainW%,starthere%) key_click(wi%,ic%,b%) butt%=(b% %111) z%=(butt%=1)-(butt%=4) butt% 2,4: ic% 8,9,10,11: b) fieldmenu%= field_menu(fields%, c< tick_one(fieldmenu%,0,fields%-1,keyfield%(ic%-8)-1) dD show_menu(fieldmenu%,oldx%+32,oldy%+16):fieldfunc$= (ic%-8) ic% 0,1,2,3: kcycle(keyfield%(ic%),4*ic%+12,z%) 4,5,6,7: kcycle(keyfield%(ic%-4),4*ic%-4,-z%) keyfunc$<>"Current key" keylimit%=0:keylen%=0 J%=0 n( keylimit%+=len%(keyfield%(J%)) o+ keylen%+= text(keyW%,4*J%+15)) r/ keylen%>keylimit%: softerror("",26) s( keylen%=0: softerror("",105) keyfunc$ "Primary key": w* save_form($database%+".Form") key%=0 copy_keydata(key%) z* RA%= ($Records%):f$=$database% {& make_empty_index(RA%,0, |* save_recs(f$+".Database",RA%) }- present%=7: save_keys: save_calcs ~/ design%= :present%=1: get_it_in(f$) 0 "New primary key": new_tree(file%) / "Index field": create_index(key%) keyfunc$="" b%=4 close_window(keyW%): set_caret(mainW%,starthere%) close_window(keyW%): set_caret(mainW%,starthere%) shade_key_icons(con%) shade(keyW%,30,con%) I%=0 shade(keyW%,I%,con%) shade(keyW%,31,con%) shade(keyW%,12, shade(keyW%,16, shade(keyW%,20, shade(keyW%,24, shade(keyW%,30,con%) shade(keyW%,35,con%) shade(keyW%,37,con%) kcycle( F%,show%,z%) J%=0 text(keyW%,show%+J%)="" F%+=z% F%>fields% F%=0 F%<0 F%=fields% F%>0 text(keyW%,show%)=Tag$(F%) text(keyW%,show%+1)="1": set_caret(keyW%,show%+1) text(keyW%,show%+2)="L" text(keyW%,show%+3)= (len%(F%)) J%=0 redraw_icon(keyW%,show%+J%) tick_one(fieldmenu%,0,fields%-1,F%-1) copy_keydata(key%) J%,chars%,pos%,word%,field% KL%(key%)=0 J%=0 7 chars%= text(keyW%,4*J%+15)):KL%(key%)+=chars% text(keyW%,4*J%+14) "L":pos%=0 "R":pos%=255 ' :pos%= text(keyW%,4*J%+14)) $ word%= text(keyW%,4*J%+13)) field%=keyfield%(J%) < KW%(key%,J%)=chars%+(pos%<<8)+(word%<<16)+(field%<<24) KF%(key%,J%)=field% #case%(key%)= selected(keyW%,30) set_keydata(key%) J%,chars%,pos%,word%,field%,W% J%=12 text(keyW%,J%)="" J%=0 W%=KW%(key%,J%) W%>0 7 chars%=W% 255:$ text(keyW%,4*J%+15)= (chars%) pos%=(W%>>8) pos% ' text(keyW%,4*J%+14)="L" ) 255:$ text(keyW%,4*J%+14)="R" ) text(keyW%,4*J%+14)= (pos%) ; word%=(W%>>16) 255:$ text(keyW%,4*J%+13)= (word%) > field%=KF%(key%,J%):$ text(keyW%,4*J%+12)=Tag$(field%) keyfield%(J%)=field% text(keyW%,29)= (key%) set_icon(keyW%,30,case%(key%)) set_icon(keyW%,35,incspace%(key%)) set_icon(keyW%,37,null%(key%)) key_select(D%) "Wimp_GetCaretPosition",,block% wi%=block%!0:ic%=block%!4 colour(key%,2) +1:key%=(key%+1) (Keys%+1) -1:key%-=1: key%<0 key%=Keys% colour(key%,1) set_keydata(key%) text(searchW%,3)=Index$(key%): redraw_icon(searchW%,3) top=8*file%+LH% addr= moveto(key%,top,1) set_caret(wi%,ic%) set_colours(wi%,ic%,b%) (b% %111)=4 z%=1 z%=-1 (b% %111) 1,4: ic% 0,1,2,3,4,5,6,7,8: @ col%= get_icon_cols(wi%,ic%):fg%=col% 16:bg%=col% S selected(wi%,11) fg%=(fg%+z%+16) ic%<8 bg%=(bg%+z%+16) ' col%=fg%+bg%*16:ncol%(ic%)=col% $ set_icon_cols(wi%,ic%,col%) 9,10: fcol%()=ncol%() I%=0 Keys% colour(I%,2) colour(key%,1) I%=1 fields% F link$(I%)<>"" set_icon_cols(mainW%,field%(I%),ncol%(8)) ! ic%=10 write_colours "Wimp_CreateMenu",,-1 3 read_colours(".Resources.Cols") I%=0 * set_icon_cols(wi%,I%,ncol%(I%)) create_click Calc$,error% butt%=(b% %111) butt% 2,4: ic%=36 show_menu(ftypeM%(menunumber%),oldx%+32,oldy%+16) ic%=44 fieldmenu%= field_menu(fields%, tick_one(fieldmenu%,0,fields%-1,Fieldnumber%-1): show_menu(fieldmenu%,oldx%+32,oldy%+16) butt%=4 z%=1 butt%=1 z%=-1 ic% set_limits(0) set_limits(1) set_limits(2) set_limits(3) set_limits(4) set_limits(5) set_limits(6) change_type(z%,menunumber%) change_type(-z%,menunumber%) 18:error%= create_field( ($InsText%),posx%,posy%,Calc$) remove_field(Fieldnumber%, ,Calc$) : error%= create_field(Fieldnumber%,posx%,posy%,Calc$) remove_field(Fieldnumber%, ,Calc$) 14,45,46: shade(createW%,13,( selected(createW%,14))) F%= ($InsText%) F%>0 F%<=fields% #( F%0)) ic% 18,29,30: butt%=4 3, error% close_window(createW%) 4 shade(createW%,18, 6% shade(createW%,30, adjust%) shade(createW%,29, update_box fieldtype% 0,1,2,3,4,5,6,7,46,47: adjust% shade(createW%,6, shade(createW%,6, A&num%=(fieldtype%=3 fieldtype%=6) shade(createW%,14,num%) shade(createW%,45,num%) shade(createW%,46,num%) shade(createW%,13,num% selected(createW%,14)) shade(createW%,15,(fieldtype%=3 fieldtype%=47)) shade(createW%,25,(fieldtype%=3)) shade(createW%,26, adjust%) adjust% lit(designM%,2,(fields%>0)) J $ValText%=vname$(fieldtype%) redraw_icon(createW%,28) set_limits(m%) fieldtype%=?(flist%(m%)+1) currenttype%=0 lasttype%=?flist%(m%) menunumber%=m% tick_one(ftypeM%(m%),0,lasttype%-1,0) update_box change_type(d%,m%) 1:currenttype%+=1 currenttype%=lasttype% currenttype%=0 -1:currenttype%-=1 currenttype%<0 currenttype%=lasttype%-1 tick_one(ftypeM%(m%),0,lasttype%-1,currenttype%) _+fieldtype%=?(flist%(m%)+currenttype%+1) update_box passwords(x%,wi%,ic%,b%) b%=(b% %111) 1,4: ic% j% $Write%="" $Write%=$Read% k* $Manager%="" $Manager%=$Write% F= ($database%+".Cols") #F=45 n$ S$= encrypt($Read%, #F,S$ o% S$= encrypt($Write%, #F,S$ p' S$= encrypt($Manager%, #F,S$ I%=9 r" selected(passW%,I%) close_file(F) v* lit(mainM%,6, selected(passW%,9)) w? printorder$<>"" lit(mainM%,7, selected(passW%,13)) x+ lit(mainM%,8, selected(passW%,13)) y+ lit(mainM%,9, selected(passW%,13)) z+ lit(mainM%,2, selected(passW%,14)) close_window(aclW%) |M b%=4 close_window(passW%): x%>=0 set_caret(oldwin%,oldicon%) }! selected(passW%,9) ~! close_window(keypadW%) ? x%>=0 position_window(keypadW%,100,50,0,0,0,0) asterisk( selected(passW%,16) & open_log(".Log", ' close_log(".Log") 4 shade(prefsW%,34, selected(passW%,15)) M selected(passW%,16) write_log(-1,"Logging discontinued") A $ text(aclW%,0)="":$ text(aclW%,1)="":$ text(aclW%,12)="" @ deselect(aclW%, selected_esg(aclW%,1)): select(aclW%,4) / open_window(aclW%): set_caret(aclW%,0) 4 restore_window(wi%,remember%+winbuff%(1,1)) close_window(aclW%) O b%=4 close_window(wi%): set_caret(oldwin%,oldicon%) redraw(wi%) F,user$,passwd$,ok% (b% %111) ic% ! close_window(aclW%) # selected_esg(aclW%,1) user$=$ text(aclW%,0) I confirm( msg("Err123,"+user$)) remove_user(user$, ):ok%= ) remove_user($ text(aclW%,0), 3 text(aclW%,0)="": softerror("",126) B text(aclW%,1)<>$ text(aclW%,12): softerror("",108) 3 text(aclW%,1)="": softerror("",125) - user$= encrypt($ text(aclW%,0), / passwd$= encrypt($ text(aclW%,1), acl% " F= (".acl") $ (".acl") acl%= 6 #F,user$,passwd$, selected_esg(aclW%,1)-3 close_file(F) ok%= A $ text(aclW%,0)="":$ text(aclW%,1)="":$ text(aclW%,12)="" K redraw_icon(aclW%,0): redraw_icon(aclW%,1):: redraw_icon(aclW%,12) set_caret(aclW%,0) 6 (b% %111)=4 ok%= close_window(aclW%) remove_user(u$,remove%) user$,id$,p%,p%,ptr%,F,found% u$<>"" user$= encrypt(u$, acl% F= (".acl") ptr%= #F,id$,p$,p% found%=(id$=user$) found% found% 1 #F=ptr%: (id$),"Z"), (p$),"Z"),0 * remove% softerror(u$,124) close_file(F) open_log(f$,resume%) "OS_File",5,f$ d%=1 loghandle%= #loghandle%= #loghandle% resume% #loghandle%,"Logging resumed "+ #loghandle%,"Log opened "+ #loghandle%,"Database: "+$database% loghandle%= #loghandle%,"Log started "+ #loghandle%,"Database: "+$database% acl% #loghandle%,"User: "+user$ #loghandle%,"Password level used: "+ (pw%) #loghandle%, 35,"-") close_file(loghandle%) logging%= close_log(f$) logging% loghandle%= #loghandle%= #loghandle% #loghandle%, 35,"-") #loghandle%,"Log closed "+ #loghandle%, 35,"=") close_file(loghandle%) "OS_File",18,f$,&fff logging%= write_log(record%,S$) loghandle% logging% # loghandle%= (".Log") #loghandle%= #loghandle% record%>=0 #loghandle%," [Record number: "+ (record%)+"]" #loghandle%," "+S$ close_file(loghandle%) count(key%, RU%) zero%,file%,top,sum% RU%=0 file%=0 top=8*file%+LH% " sum%= count_recs(key%,zero%) RU%+=sum% text(miscW%,file%+22)= (sum%) file% count_recs(key%, ptr%) P%,count%,S%,R%,S$,k$ "Hourglass_On" neighbour(key%,top,1) P%<>top count%+=1 ptr%>0 R%= rec_no(k$,key%,P%) # R%>highest% highest%=R% 1 !ptr%=R%:$(ptr%+4)=k$:ptr%+=4+KL%(key%)+1 flagptr%?R%=0 P%= neighbour(key%,P%,1) "Hourglass_Off" =count% analyse(func%) L%,P%,S%,S$,K$,k$,ptr%,pos%,N%,values%,key% S$(),N%() read_print_options func%<0 L%=6 key%=func%:L%=KL%(key%) L%>8 Tab%(0)=Lmargin%+L%+6 Tab%(0)=Lmargin%+14 Tab%(1)=Tab%(0)+6 func%<0 : Title$="Analysis of date field: "+Tag$(Fieldnumber%) 5 Heading$= pad(margin$+"Month",Tab%(0))+"Number" V TextName$=$database%+".PrintJobs.DateAn"+Tag$(Fieldnumber%):$SaveName%=TextName$ "/ Title$="Analysis of index: "+Index$(key%) #8 Heading$= pad(margin$+"Contents",Tab%(0))+"Number" $U TextName$=$database%+".PrintJobs.IndAn"+Tag$(Fieldnumber%):$SaveName%=TextName$ Title1$= LenLine%= (Heading$)+2 extend_named_sliding_block(lineanchor%,LenLine%+4) extend_named_sliding_block(headanchor%,LenLine%+4):pos%=!headanchor% heap_store(headanchor%,LenLine%,0,pos%,0,Heading$) reportdest$="Window" Count%=0 list_head(0) "Hourglass_On" func%<0 analyse_date analyse_index "Hourglass_Off" rule_off(45) 2;Line$= pad(margin$+"Total",Tab%(0))+ justify( (N%),1,0) 3@$(!lineanchor%)=Line$: list_line(-1,lineanchor%, (Line$),32) rule_off(45) screen_list analyse_index K$="***" neighbour(key%,top,1) P%<>top R%= rec_no(k$,key%,P%) =# k$<>K$ values%+=1:K$=k$ > P%= neighbour(key%,P%,1) S$(values%),N%(values%) K$="***" neighbour(key%,top,1) P%<>top R%= rec_no(k$,key%,P%) EE k$<>K$ ptr%+=1:K$=k$:S$(ptr%)=K$:N%(ptr%)=1 N%(ptr%)+=1 F P%= neighbour(key%,P%,1) I%=1 ptr% II S$=S$(I%): S$="" S$="" isadate% reverse_date(S$) JH Line$=margin$+S$:Line$= pad(Line$,Tab%(0))+ justify( (N%(I%)),1,0) KB $(!lineanchor%)=Line$: list_line(-1,lineanchor%, (Line$),32) N%+=N%(I%) analyse_date S$(12),N%(12) RYS$()="","Jan","Feb","Mar","Apr","May","Jun","Jul","Aug","Sep","Oct","Nov","Dec" S*dbasehandle%= ($database%+".Database") neighbour(key%,top,1) P%<>top R%= rec_no(k$,key%,P%) readsmarray(dbasehandle%,R%) S$=F$(Fieldnumber%) S$<>"" M%= S$,4,2)) N%(M%)+=1 N%(0)+=1 P%= neighbour(key%,P%,1) close_file(dbasehandle%) I%=0 bL Line$=margin$+S$(I%):Line$= pad(Line$,Tab%(0))+ justify( (N%(I%)),1,0) cB $(!lineanchor%)=Line$: list_line(-1,lineanchor%, (Line$),32) N%+=N%(I%) update_stats $filesize%= (RA%) $Records%= (RA%) $used%= (RU%) l#$percent%= (RU%*100/RA%))+"%" Keypress processing -------------------------------------------------- set_keyboard(wi%,ic%) selected(prefsW%,21) wi% mainW%: chartype%((ic%+1) v- Leave keyboard status unchanged w$ 2,4: "OS_Byte",202,0,239 x! "OS_Byte",202,16,111 accessW%: uc% "OS_Byte",202,0,239 "OS_Byte",202,caps%,111 "OS_Byte",202,caps%,111 "OS_Byte",118 process_key printing% indexing% N$,T% "Wimp_GetCaretPosition",,block% 4wi%=block%!0:ic%=block%!4:key_pressed%=block%!24 T%=0 LastTable% wi%=tableW%(T%) Tablenumber%=T% key_pressed% store retrieve(scratchpad$) wi% mainW%: main_press(wi%,ic%) passW%: dbox_press(4,18,0,0,0) aclW%: dbox_press(9,11,0,0,0) changeW%: dbox_press(3,6,queryW%,0,0) tabcreateW%: dbox_press(2,3,scrollW%,0,MaxCols%*2+1) scrollW%: scroll_press saveW%,savesubW%: dbox_press(1,3,0,0,0) tableW%(Tablenumber%): table_press(Tablenumber%) printW%: dbox_press(20,52,0,0,0) labelW%: dbox_press(15,19,0,0,0) createW%: create_press accessW%: dbox_press(3,2,0,0,0) keyW%: dbox_press(31,36,0,0,0) matchW%: dbox_press(0,6,0,0,0) moveW%: dbox_press(7,11,0,0,0) calcW%: dbox_press(1,-1,0,0,0) mergeW%: dbox_press(6,7,queryW%,0,0) sizeW%: dbox_press(4,5,0,0,0) csvW%: dbox_press(9,10,0,0,0) prefsW%: dbox_press(39,40,0,0,0) searchW%: key_pressed%=15 # search_click(searchW%,9,4) ! dbox_press(8,10,0,0,0) helpW%: dbox_press(7,20,0,0,0) queryW%: query_press keypadW%: special_press query_press window% window%=-1 window%+=1 wi%=actionbutt%(window%,0) wi%=oldquery% key_pressed% mouse(0,0,4,wi%,actionbutt%(window%,1)) query_click(queryW%,2,4) shut_window(wi%): set_caret(mainW%,starthere%) 398: wi% $ changeW%: set_caret(wi%,0) $ mergeW%: set_caret(wi%,14) 399: wi% $ changeW%: set_caret(wi%,1) $ mergeW%: set_caret(wi%,14) 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: button_action(key_pressed%) "OS_Byte",228,1: "Wimp_ProcessKey",key_pressed% main_press(wi%,ic%) selected(passW%,10) "Wimp_ProcessKey",key_pressed%: icon% flash% deselect(wi%,field%(flash%)):flash%= trim(wi%,ic%) key_pressed%<>392 validate(Fieldnumber%,T%,N$)= changed%= update_calcs(Fieldnumber%) key_pressed% select_range(1,fields%, len%(Fieldnumber%)>=10 + $Rf%(Fieldnumber%)= convert_date(4) G len%(Fieldnumber%)>=8 $Rf%(Fieldnumber%)= convert_date(2) redraw_icon(wi%,field%(Fieldnumber%)) 5:template%=1: display(key%,-1) tick_one(fieldmenu%,0,fields%-1,Fieldnumber%-1) 7 fieldmenu%= field_menu(fields%,(printorder$<>"")) "Wimp_GetPointerInfo",,block% show_menu(fieldmenu%,!block%-150,block%!4+16) fieldfunc$="CtrlF" 3 $Query%="":$ChangeTitle%="Field: "+Fieldname$ position_window(changeW%,0,0,0,0,0,0): set_caret(changeW%,0) 9:*Indices set_up_field_menu @ keyfunc$="Index field":$KeyTitle%=keyfunc$+": "+Fieldname$ shade_key_icons( deselect(keyW%,30): deselect(keyW%,35): deselect(keyW%,37) position_window(keyW%,0,0,0,504,0,0): set_caret(keyW%,13) 0 keyfunc$="Current key":$KeyTitle%=keyfunc$ set_keydata(key%): shade_key_icons( position_window(keyW%,0,0,0,504,0,0) set_up_field_menu: LastTable%<>-1 position_window(linkW%,0,0,0,0,0,0) Fieldnumber%=Lastwritable% close_window(relateW%) display(key%,-1) A Fieldnumber%+=1: Fieldnumber%>fields% Fieldnumber%=1 ? c%=chartype%(Fieldnumber%):icon%=field%(Fieldnumber%) X vtype$(c%)="E" len%(Fieldnumber%)>0 get_icon_cols(wi%,icon%)<>winback%*17 set_caret(wi%,icon%) , selected(prefsW%,19) relations filter% P field%(buttonfield%(0,22))>0 filter(mainW%, filter(keypadW%, . selected(passW%,14) match(0,0) query_click(queryW%,2,4) 16:*JobsDone 17:*Tables 18:*Resources 19:starthere%=field%(Fieldnumber%):$StartHere%=Tag$(Fieldnumber%): redraw_icon(prefsW%,45): Access% set_caret(mainW%,starthere%) len%(Fieldnumber%)>=8 T$= - T$,3,1)=$timesep%: T$,6,1)=$timesep% $Rf%(Fieldnumber%)=T$ . redraw_icon(wi%,field%(Fieldnumber%)) selected(passW%,13) 8 getscreensize(ScreenWidth%,ScreenHeight%,Vpix%) : x%=(ScreenWidth%-w%) 2:y%=(ScreenHeight%-h%) 1 choice$(1)="Export CSV": act_on_main_menu clear_selection keypad_click(keypadW%,1,4) close_it(linkW%): close_it(keyW%): close_it(csvW%) 30:Fieldnumber%= first_writable: set_caret(wi%,field%(Fieldnumber%)) 384: selected(passW%,14) match(0,0) 394: selected(passW%,9) position_window(keypadW%,250,100,0,0,0,0) 398: ? Fieldnumber%+=1: Fieldnumber%>fields% Fieldnumber%=1 = c%=chartype%(Fieldnumber%):icon%=field%(Fieldnumber%) vtype$(c%)="E" len%(Fieldnumber%)>0 get_icon_cols(wi%,icon%)<>winback%*17 set_caret(wi%,icon%) selected(prefsW%,19) relations 399: ? Fieldnumber%-=1: Fieldnumber%<1 Fieldnumber%=fields% = c%=chartype%(Fieldnumber%):icon%=field%(Fieldnumber%) vtype$(c%)="E" len%(Fieldnumber%)>0 get_icon_cols(wi%,icon%)<>winback%*17 set_caret(wi%,icon%) selected(prefsW%,19) relations 400: select(printW%,51): deselect(printW%,50) position_window(printW%,0,0,0,0,0,0): set_caret(printW%,16) 416: print_this 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: button_action(key_pressed%) 433: reveal( 434: reveal( 441: protect(wi%,ic%,Fieldnumber%) "OS_Byte",228,1: "Wimp_ProcessKey",key_pressed% selected(prefsW%,21) chartype%(Fieldnumber%) 0- Leave keyboard status unchanged 1$ 2,4: "OS_Byte",202,0,239 2! "OS_Byte",202,16,111 "OS_Byte",118 "OS_Byte",15,0 button_action(K%) check_change button%= key_assigned(K%) button% "Wimp_ProcessKey",K%: ### No keypad action ### selected(passW%,9) @O invert(keypadW%,button%): filter(keypadW%, selected(keypadW%,button%)) A B+ ic%=field%(buttonfield%(0,button%)) CB ic%>0 invert(wi%,ic%): filter(wi%, selected(wi%,ic%)) 13,23: button%=23 e%=-1:button%=13 e%=1 invert(keypadW%,button%) selected(passW%,9) I" allow_search(keypadW%,e%) JE field%(buttonfield%(0,button%))>0 allow_search(wi%,e%) invert(keypadW%,button%) invert(keypadW%,14): display(key%,-2): invert(keypadW%,14) shaded(keypadW%,button%) P! invert(keypadW%,button%) Q& mouse(0,0,4,keypadW%,button%) R! invert(keypadW%,button%) key_assigned(pressed%) Y I%=-1 I%+=1 I%=24 buttonfield%(1,I%)=pressed% buttonfield%(1,I%)=pressed% dbox_press(ok%,esc%,wi2%,down%,up%) trim(wi%,ic%) wi% accessW%: key_pressed% dM next_writable(wi%,ic%,1,1,wi2%,down%) mouse(0,0,4,wi%,ok%) e# mouse(0,0,4,wi%,esc%) f7 398:f%= next_writable(wi%,ic%,1,0,wi2%,down%) g6 399:f%= next_writable(wi%,ic%,-1,0,wi2%,up%) h+ "Wimp_ProcessKey",key_pressed% key_pressed% selected(prefsW%,41) next_writable(wi%,ic%,1,1,wi2%,down%) mouse(0,0,4,wi%,ok%): set_caret(mainW%,starthere%) mA mouse(0,0,4,wi%,esc%): set_caret(mainW%,starthere%) n7 398:f%= next_writable(wi%,ic%,1,0,wi2%,down%) o6 399:f%= next_writable(wi%,ic%,-1,0,wi2%,up%) p# wi%=tabcreateW% ic%=0 q: $tabcol%= (MaxCols%): redraw_icon(tabcreateW%,8) r; !block%=scrollW%: "Wimp_GetWindowState",,block% s= block%!24=-MaxCols%*44: "Wimp_OpenWindow",,block% t 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: v$ button_action(key_pressed%) w> "OS_Byte",228,1: "Wimp_ProcessKey",key_pressed% scroll_press row% trim(wi%,ic%) key_pressed% 13,398:f%= next_writable(wi%,ic%,1,0,tabcreateW%,0) 399:f%= next_writable(wi%,ic%,-1,0,tabcreateW%,8) "Wimp_ProcessKey",key_pressed% "Wimp_GetCaretPosition",,block% !block%=scrollW% ic%=block%!4 ic%=0 row%=ic% 0$tabcol%= (row%): redraw_icon(tabcreateW%,8) 5!block%=scrollW%: "Wimp_GetWindowState",,block% scrollrow%=-(block%!24 row%-scrollrow%>4 block%!24=(4-row%)*44: "Wimp_OpenWindow",,block% row%=TabFields%+1 ic%-=(TabFields%+1) ic%=icons%-TabFields%-1+ic% (TabFields%+1) "Wimp_ProcessKey",key_pressed% set_caret(tableW%(T%),ic%) 'row%=(ic% (TabFields%+1))-NewTab% 8!block%=tableW%(T%): "Wimp_GetWindowState",,block% -visible_rows%=(block%!16-block%!8) 44-1 scrollrow%=-(block%!24 row%-scrollrow%>visible_rows% block%!24=(visible_rows%-row%)*44: "Wimp_OpenWindow",,block% row%0 choice$= fix_point(choice$,field%) (choice$)<=len%(field%) $Rf%(field%)=choice$ + redraw_icon(mainW%,field%(field%)) ) set_caret(mainW%,field%(field%)) ) softerror(""""+choice$+"""",7) special_select quit% redo% show_menu(menuhandle%,menux%,menuy%) act_on_main_menu choice$(1) "CSV options" $CSVTitle%=choice$(1) shade(csvW%,0, text(csvW%,9)="Accept" position_window(csvW%,x%-350,y%-180,700,440,0,0) "Miscellaneous": act_on_misc_menu "Print": act_on_print_menu "Validation": act_on_validation_menu "Current key": / $KeyTitle%=choice$(1):keyfunc$=choice$(1) set_keydata(key%): shade_key_icons( position_window(keyW%,x%-284,y%-252,0,504,0,0) "Show keypad": selected(passW%,9) position_window(keypadW%,-1,-1,0,0,0,0) "Export subset": ? export%= :$SubTitle%="Export subset":savefunc$=choice$(1) / $SubName%=$database%+".PrintJobs.!Subset" / $SubSprite%="snew_appl;Pptr_hand,12,8;R2" $Query%="" position_window(savesubW%,x%-244,y%-161,0,0,0,0): set_caret(queryW%,0) "Export CSV": 7 $SubTitle%="Export CSV file":savefunc$=choice$(1) sep$="," t$="dfe":f$="CSV" t$="fff":f$="Sep" 2 $SubName%=$database%+".PrintJobs."+f$+"file" 2 $SubSprite%="sfile_"+t$+";Pptr_hand,12,8;R2" $Query%="" position_window(savesubW%,x%-244,y%-161,0,0,0,0): set_caret(queryW%,0) "Undo changes": restore_rec "Help": "Wimp_StartTask",".!Help" act_on_field_menu act_on_misc_menu choice$(2) "Move/delete": shade(moveW%,6, deselect(moveW%, selected_esg(moveW%,1)): select(moveW%,2) $Query%="" position_window(moveW%,x%-253,y%-232,0,0,0,0): set_caret(queryW%,0) "Set passwords": position_window(passW%,x%-213,y%-388,0,0,0,0): set_caret(passW%,2) "Edit template":template%=1: display(key%,-1) "Name subfile": choice3% H P%= $RecInfo%,"Record")-1:$RecInfo%=$Subfilename%+ $RecInfo%,P%) & $Subfile%(file%)=$Subfilename% asterisk( "Rename database": rename_database($NewName%) act_on_print_menu choice$(2) "Match": match(x%-396,y%-131) "Show resources":*Resources "Options": select(printW%,51): deselect(printW%,50) position_window(printW%,x%-458,y%-401,0,0,0,0): set_caret(printW%,16) "Save query": - $SaveName%=$database%+".PrintRes.Query" !2 savefunc$=choice$(2): save_click(saveW%,1,4) "Save selection": #1 $SaveName%=$database%+".PrintRes.Selection" $2 savefunc$=choice$(2): save_click(saveW%,1,4) "Show jobs done":*JobsDone "Clear selection": clear_selection "Select all": select_range(1,fields%, "Numeric fields": match(x%-396,y%-131) act_on_validation_menu choice$(2) "Create table": 0D $ text(tabcreateW%,0)="":$ text(tabcreateW%,1)="":$tabcol%="0" I%=0 MaxCols%*2+1 $ text(scrollW%,I%)="" set_icon_cols(tabcreateW%,13,&28) set_icon_cols(tabcreateW%,14,&07) position_window(tabcreateW%,x%-241,y%-301,0,0,0,0): set_caret(tabcreateW%,0) "Display table": choice3%>=0 Tablenumber%=choice3% :! show_table(Tablenumber%) "Show table files":*Tables act_on_field_menu choice$(2) "Index field": C= keyfunc$=choice$(2):$KeyTitle%=keyfunc$+": "+Fieldname$ shade_key_icons( deselect(keyW%,30): deselect(keyW%,35): deselect(keyW%,37) position_window(keyW%,x%-284,y%-252,0,504,0,0): set_caret(keyW%,13) "Analyse index": analyse( is_a_key(Fieldnumber%)) "Analyse months": analyse(-1) "Link to table": position_window(linkW%,x%-350,y%-129,0,0,0,0) "Calculations","Combine fields": position_window(calcW%,0,0,0,0,0,0): set_caret(calcW%,0) "Global changes":$Query%="": position_window(changeW%,x%-252,y%-214,0,0,0,0): set_caret(changeW%,0) "Start editing": M] starthere%=field%(Fieldnumber%):$StartHere%=Tag$(Fieldnumber%): redraw_icon(prefsW%,45) Access% set_caret(mainW%,starthere%) "Remove external","Unlink directory","Unlink file": chartype%(Fieldnumber%) Q0 35:link$(Fieldnumber%)="": asterisk( link$(Fieldnumber%)="" T7 $ val(mainW%,field%(Fieldnumber%))="R5;Saction" U1 redraw_icon(mainW%,field%(Fieldnumber%)) asterisk( WR show_picture(Fieldnumber%): redraw_icon(mainW%,field%(Fieldnumber%)) XI delete_blob(Fieldnumber%,object$,mainW%,field%(Fieldnumber%)) "Undo changes": restore(Fieldnumber%,"",-1) "Compact sequence": compact(Fieldnumber%) compact(F%) sequenceval$,V$ is_a_key(F%) key%: confirm( msg("Err128")) d' split_link(F%,V$,sequenceval$) V$=sequenceval$ "Hourglass_On" g. dbasehandle%= ($database%+".Database") h! P%= neighbour(key%,top,1) i, scan_file("P%<>top",key%,file%,7,1) "Hourglass_Off" k! close_file(dbasehandle%) l% calc$(F%)=V$+"|"+sequenceval$ save_calcs: save_keys softerror(Tag$(F%),116) softerror(Tag$(F%),127) act_on_keypad_menu choice$(1) "Defaults": load_fkeys("DFkeys") "Save choices": save_fkeys "List keys": list_fkeys act_on_csv_sep choice$(1) "Comma":sep$="," "TAB":sep$= "CR":sep$= "LF":sep$= sep$=$Delim% tick_one(menuhandle%,0,3,choice1%) text(csvW%,14)=choice$(1) redraw_icon(csvW%,14) act_on_csv_term choice$(1) "CR":term$= "LF":term$= "CR LF":term$= (13)+ "LF CR":term$= (10)+ "CR CR":term$= (13)+ "LF LF":term$= (10)+ :term$=$Termin% tick_one(menuhandle%,0,5,choice1%) text(csvW%,15)=choice$(1) redraw_icon(csvW%,15) act_on_text_menu choice$(1),4) "Save": $SaveName%=TextName$ 0 $SaveSprite%="sfile_fff;Pptr_hand,12,8;R2" 2 savefunc$=choice$(1): save_click(saveW%,1,4) "Sort": sort_list(sort_textcol%) "Scra": lose_list act_on_create_menu choice$(1) "Design field": position_window(createW%,x%-425,y%-320,0,0,0,0): set_caret(createW%,4) "Save form file": # $SaveName%=$database%+".Form" 2 savefunc$=choice$(1): save_click(saveW%,1,4) "Default database": save_form($database%+".Form") first_writable>0 default_key # defaults($database%,100,0) softerror("",35) "Primary key": ' fieldmenu%= field_menu(fields%, F%= first_writable 0 starthere%=field%(F%):$StartHere%=Tag$(F%) $KeyTitle%=choice$(1) keyfunc$=choice$(1) case%(0)= set_keydata(0) shade_key_icons( shade(keyW%,37, position_window(keyW%,x%-284,y%-252,0,504,0,0): set_caret(keyW%,13) "Quit design": adjust_on( save_form($database%+".Form") save_calcs get_it_in($database%) act_on_fieldtype_menus(m%) currenttype%=choice1% +fieldtype%=?(flist%(m%)+currenttype%+1) tick_one(menuhandle%,0,lasttype%,choice1%) update_box act_on_menu_of_tables Tablenumber%=choice1% $$Tablename%=table$(Tablenumber%) tick_one(menuhandle%,0,LastTable%,choice1%) redraw_icon(linkW%,0) act_on_menu_of_fields fieldfunc$ "create": design_field(2,choice1%*2+1, "help": Match_tag%=choice1%+1 text(helpW%,0)=Tag$(Match_tag%): redraw_icon(helpW%,0) tick_one(fieldmenu%,0,fields%-1,choice1%) "CtrlF": printorder$="" Fieldnumber%=(choice1%+1) A chartype%(Fieldnumber%)<6 chartype%(Fieldnumber%)=8 1 set_caret(mainW%,field%(Fieldnumber%)) . selected(prefsW%,19) relations "0","1","2","3": keyfield%= (fieldfunc$) keyfunc$<>"Current key" ( ticked(fieldmenu%,choice1%) O keyfield%(keyfield%)=0: kcycle(keyfield%(keyfield%),4*keyfield%+12,0) X keyfield%(keyfield%)=choice1%+1: kcycle(keyfield%(keyfield%),4*keyfield%+12,0) act_on_table_menu(ch$) (Tablenumber%= table_number($tableM%) ch$="Save": 2 $SaveName%=$database%+".ValTables."+$tableM% 4 savefunc$="Save table": save_click(saveW%,1,4) ch$="Clear": clear_table(Tablenumber%) ch$="Print": print_table(Tablenumber%) ch$,4)="Sort": sort_table(Tablenumber%,sort_tabcol%) ch$="Undo all": restore_table(Tablenumber%) ch$="Undo change": restore_tabfield ch$="Save as CSV": 2 $SaveName%=$database%+".PrintJobs."+$tableM% 1 savefunc$="Save table as CSV":writetable%= save_click(saveW%,1,4) ch$="Modify": modify_table(Tablenumber%,tabcreateW%) act_on_icon_bar_menu choice$(1) "Help": "Wimp_StartTask",".!Help" "Utilities": choice$(2) "New primary key": $KeyTitle%=choice$(2) + keyfunc$=choice$(2): set_keydata(0) (present% 2)=2 / select(keyW%,32): deselect(keyW%,33) / shade(keyW%,32, shade(keyW%,33, / select(keyW%,33): deselect(keyW%,32) / shade(keyW%,32, shade(keyW%,33, . shade_key_icons( shade(keyW%,37, L position_window(keyW%,x%-284,y%-303,0,606,0,0): set_caret(keyW%,13) "New record format": close_window(reformW%) 5 reform$="Reformat":$ text(reformW%,6)=reform$ * $RefmTitle%="Change record format" shade(reformW%,6, 7 position_window(reformW%,x%-237,100,0,236,0,0) "Adjust format": adjust_on( open_window(mainW%) display(key%,-1) 3 alter_flags(&07016711,&07006535,&1700653F) "Merge database": close_window(reformW%) 2 reform$="Merge":$ text(reformW%,6)=reform$ $ $RefmTitle%="Merge database" shade(reformW%,6, 7 position_window(reformW%,x%-237,100,0,400,0,0) ( "Balance index": balance(key%) "Print index": choice$(3) "Complete": $' print_tree(key%,file%,"ALL") "Totals only": &* print_tree(key%,file%,"TOTALS") ' (- "Find duplicates": duplicates(key%) "Close database": "Preferences": position_window(prefsW%,x%-371,150,0,0,0,0): set_caret(prefsW%,1) "Quit":quit%= reveal(vis%) F%,dic%,fic% Modify% F%=1 fields% 4& dic%=desc%(F%):fic%=field%(F%) hide%?F%=1 vis% 7G set_icon_cols(wi%,dic%,23): set_icon_cols(wi%,fic%,04) 8Y set_icon_cols(wi%,dic%,winback%*17): set_icon_cols(wi%,fic%,winback%*17) : protect(wi%,ic%,F%) Modify% get_icon_cols(wi%,ic%) B2 set_icon_cols(wi%,ic%,04):hide%?F%=1 C2 set_icon_cols(wi%,ic%,07):hide%?F%=0 protect%= init_drag(wi%,ic%,dragtype%) getscreensize(W%,H%,V%) !block%=wi% "Wimp_GetWindowState",,block% ysize%=block%!16-block%!8 x%=block%!4-block%!20 y%=block%!16-block%!24 block%!4=ic% "Wimp_GetIconState",,block% block%!8+=x%:minx%=block%!8 S!block%!12+=y%:miny%=block%!12 T!block%!16+=x%:maxx%=block%!16 U!block%!20+=y%:maxy%=block%!20 dragtype%=6 W5 block%!24=2*minx%-maxx%:block%!36=2*maxy%-miny% block%!24=0:block%!36=H% block%!28=0 block%!32=W% !block%=0 block%!4=dragtype% wi% saveW%,savesubW%: wi%=saveW% sprite$= $SaveSprite%,2,8) sprite$= $SubSprite%,2,8) "DragASprite_Start",&C5,1,sprite$,block%+8 "Wimp_DragBox",,block% wi%=mainW% ficon%=ic% end_drag(start%,end%) wi%,ic% datasize%=end%-start% "Wimp_GetPointerInfo",,block% wi%=block%!12:ic%=block%!16 m7block%!32=block%!4:block%!28=block%!0:block%!24=ic% n+block%!20=wi%:block%!24=ic%:block%!16=1 o3block%!12=0:block%!36=datasize%:block%!40=Type% design% dragbutt%>0 adjust_field(dragbutt%) Filename$<>"" wi%<>mainW% t% $(block%+44)= leaf(Filename$) !block%=60 v/ "Wimp_SendMessage",17,block%,wi%,ic% ramptr%=start% x "Wimp_CreateMenu",,-1 encrypt(S$,Z%) I%,R% (-12817) I%=1 S$,I%,1)>"@" R%= (58)-1 R%=58-R% 1 S$,I%,1)= S$,I%,1))-65+R%) 58+65) leaf(s$) s2$="" s$)<>"." s$<>"" s2$= s$)+s2$ s$= dbasepath$= Message handling ---------------------------------------------------- not_acknowledged block%!16 DataOpen failed, so run file block%!8=Impref% Imp_wait%= "Wimp_StartTask",$(block%+44) RAMTransmit failed merging% moan_err%, msg("Err39") At this point, the message ought to have been sent by us, so check it Very bizarre situation if you get this error (!!) block%!8<>myref% moan_err%,"Reference fields mismatch (msglost/DataLoad)" If transfer marked as temporary, delete scrap file block%!36=-1 "OS_File",6,block%+44 moan_err%, msg("Err39") &80142: moan_err%, msg("Err90") ### Attempt to print directly when no driver installed ### message task%,ref%,ftype%,filename$,w%,i%,x%,y% task%=block%!4:ref%=block%!8 block%!16 0:quit%= ### DataSave ### task%<>mytask% present%=7 datasize%=block%!36 block%!40 &fff,&ff9,&aff,&dfe: myref%=ref% > block%!0=256:block%!12=ref%:block%!16=2:block%!36=-1 * $(block%+44)=""+ / "Wimp_SendMessage",17,block%,task% ### DataSaveAck ### block%!12=ref% "Wimp_SendMessage",19,block%,task% 3 ftype%=block%!40:filename$= getstr(block%+44) filename$<>"" ; w%=block%!20:i%=block%!24:x%=block%!28:y%=block%!32 L save(filename$,Type%,Start%,End%): write_log(-1,filename$+" saved") + block%!0=(44+ filename$+1+3) V block%!12=ref%:block%!16=3:block%!20=w%:block%!24=i%:block%!28=x%:block%!32=y% 0 "OS_File",5,filename$ ,,,,block%!36 4 block%!40=ftype%:$(block%+44)=filename$+ - "Wimp_SendMessage",18,block%,task% myref%=block%!8 "Wimp_CreateMenu",,-1 ### DataLoad ### , myref%=block%!12:f$= getstr(block%+44) get_it_in(f$) myref%<>0 "OS_CLI","Remove " ### DataLoadAck ### block%!12=Impref% merging% start_merge ### DataOpen - response to file double click ### block%!40 &7f1,&7f3,&7f4,&7f5: present%=7 N block%!0=20:block%!12=ref%:block%!16=4:block%!20=mainW%:block%!24=-1 ) "Wimp_SendMessage",17,block% ( get_it_in( getstr(block%+44)) &2000: kill% present%=0 2 ### Is it a Powerbase application? ### * f$= getstr(block%+44)+".Indices" ' "OS_File",5,f$ d%,,type% ! type%=(type%>>8) &fff d%=2 2 block%!0=20:block%!12=ref%:block%!16=4 4 "Wimp_SendMessage",17,block%,block%!4 * get_it_in( getstr(block%+44)) savefunc$ "Save as text","Save text","Save sprite","Save draw","Save query","Save selection","Save table","Export selected": ram_transmit 10: ### Desktop boot file F "OS_GSTrans","Run ",block%+&100,&f00 ,bootcmd$ #block%!20,bootcmd$ &502:PR OChelp_message(block%!32,block%!36) &400C2: getscreensize(ScreenWidth%,ScreenHeight%,Vpix%) &400C0: message_menu_select &80140: ### PrintFile - ignore ### ram_transmit datasize%>block%!24 tosend%=block%!24 tosend%=datasize% "Wimp_TransferBlock",mytask%,ramptr%,block%!4,block%!20,tosend% block%!24=tosend% datasize%-=tosend% ramptr%+=tosend% block%!12=block%!8 block%!16=7 "Wimp_SendMessage",18+(datasize%=0),block%,block%!4 message_menu_select P%,Q%,I% keyfunc$="":savefunc$="" 5handle%=block%!20:xmin%=block%!24:ymax%=block%!28 "Wimp_DecodeMenu",,menuhandle%,block%+32,choices% I%=1 Q%= $choices%,".",P%+1) & choice$(I%)= $choices%,P%,Q%-P%) P%=Q%+1 menuhandle% iconbarM%: choice$(1) "New database": $SaveName%="!DataBase" 2 $SaveSprite%="snew_appl;Pptr_hand,12,8;R2" savefunc$=choice$(1) mainM%: choice$(1) 6 "Information": count(key%,RU%): update_stats "Print": choice$(2) "Save query": 1 $SaveName%=$database%+".PrintRes.Query" 4 $SaveSprite%="sfile_7f4;Pptr_hand,12,8;R2" "Save selection": 5 $SaveName%=$database%+".PrintRes.Selection" 4 $SaveSprite%="sfile_7f3;Pptr_hand,12,8;R2" savefunc$=choice$(2) "Miscellaneous": choice$(2) "Colours": ncol%()=fcol%() I%=0 !. set_icon_cols(colW%,I%,ncol%(I%)) # "Export selected": %3 $SaveName%=$database%+".PrintJobs.Selected" &2 $SaveSprite%="sfile_fff;Pptr_hand,12,8;R2" savefunc$=choice$(1) designM%: choice$(1) "Save form file": ,% $SaveName%=$database%+".Form" -2 $SaveSprite%="sfile_7f2;Pptr_hand,12,8;R2" savefunc$=choice$(1) tableM%: choice$(1) "Save": 34 $SaveName%=$database%+".ValTables."+$tableM% 42 $SaveSprite%="sfile_7f1;Pptr_hand,12,8;R2" savefunc$="Save table" "Save as CSV": 74 $SaveName%=$database%+".PrintJobs."+$tableM% 82 $SaveSprite%="sfile_dfe;Pptr_hand,12,8;R2" 93 savefunc$="Save table as CSV":writetable%= listM%: choice$(1) "Save as text": $SaveName%=TextName$ ?2 $SaveSprite%="sfile_fff;Pptr_hand,12,8;R2" savefunc$=choice$(1) "Wimp_CreateSubMenu",,handle%,xmin%,ymax% help_message(wi%,ic%) T%=0 LastTable% wi%=tableW%(T%) Tablenumber%=T% wi% help("HelpPbase") listW%: help("HelpList") tableW%(Tablenumber%): help("HelpTable") mainW%: Q- ic%<0: present%=7 help("main?") (ic% 2)=1: field%=(ic%+1) TM present%=7 help("main"+ (chartype%(field%))) help("maindrag") pselectW%: help("Pselect") infoW%: help("info"+ (ic%)) miscW%: help("misc"+ (ic%)) relateW%: help("relate"+ (ic%)) accessW%: help("access"+ (ic%)) keypadW%: help("keypad"+ (ic%)) searchW%: help("search"+ (ic%)) filterW%: help("filter"+ (ic%)) queryW%: help("query"+ (ic%)) moveW%: help("move"+ (ic%)) calcW%: help("calc"+ (ic%)) sizeW%: help("size"+ (ic%)) matchW%: help("match"+ (ic%)) tabcreateW%: help("tabcreate"+ (ic%)) changeW%: help("change"+ (ic%)) passW%: help("passwd"+ (ic%)) aclW%: help("acl"+ (ic%)) saveW%: help("save"+ (ic%)) savesubW%: help("savesub"+ (ic%)) printW%: help("print"+ (ic%)) labelW%: help("label"+ (ic%)) createW%: help("create"+ (ic%)) scrollW%: help("scroll") prefsW%: help("prefs"+ (ic%)) csvW%: help("csv"+ (ic%)) fkeyW%: help("fkey"+ (ic%)) helpW%: help("help"+ (ic%)) keyW%: help("key"+ (ic%)) colW%: help("col"+ (ic%)) linkW%: help("link"+ (ic%)) reformW%: help("reform"+ (ic%)) mergeW%: help("merge"+ (ic%)) gridW%: help("grid"+ (ic%)) help(token$) !block%=256 block%!12=ref% block%!16=&503 $(block%+20)= msg(token$) "Wimp_SendMessage",17,block%,block%!4 File saving -------------------------------------------------------- export_selected(Form$) I%,F%,P%,F$ extend_named_sliding_block(textanchor%,Length%+fields%+3) P%=!textanchor% I%=1 (Form$)-1 F%= fnum( Form$,I%,2)) F$=$Rf%(F%)+ $P%=F$:P%+= *Start%=!textanchor%:End%=P%:Type%=&fff save_all_tables "Hourglass_On" Tablenumber%=0 Tablenumber%<=LastTable% 6 f$=$database%+".ValTables."+table$(Tablenumber%) a t$= table_info(Tablenumber%,Rows%,TabFields%,Rec%,tabfieldlen%(),offset%,heading%,colours$) E Start%=!tabanchor%(Tablenumber%):End%=Start%+offset%+Rows%*Rec% save(f$,&7f1,Start%,End%) Tablenumber%+=1 "Hourglass_Percentage",Tablenumber%*100 (LastTable%+1) "Hourglass_Off" save(f$,ft%,start%,end%) f$,9)="Powerbase" softerror("",129): writingtext% ft% leaf$= leaf(f$) leaf$,1)<>"!" leaf$="!"+leaf$ " f$=dbasepath$+"."+ leaf$,10) "OS_File",8,f$ "OS_File",8,f$+".Indices" "OS_File",8,f$+".ValTables" "OS_File",8,f$+".PrintRes" "OS_File",8,f$+".PrintJobs" "OS_CLI","Copy .Resources.Temp.!Run "+f$+".!Run ~C~V" "OS_CLI","Copy .Resources.Cols "+f$+".Cols ~C~V" copy_database_spritefile(f$, leaf(f$)) $ export%: export_subset(f$) csvconv%: !formanchor%=0 4 extend_named_sliding_block(formanchor%,0) Fptr%=!formanchor% " fields%=0:Fieldnumber%=0 " fields%= get_form(Fptr%) lit(iconbarM%,1, get_it_in(f$) open_window(mainW%) !formanchor%=0 4 extend_named_sliding_block(formanchor%,0) Fptr%=!formanchor% " fields%=0:Fieldnumber%=0 close_window(saveW%) &7f2: save_form(f$) &7f5: save_options(printW%,f$) &dfe: writetable% , write_table_as_csv(Tablenumber%,f$) write_csv(f$) savetofile%: ( texthandle%= (f$):writingtext%= " do_it(Search$,displayed%) writingtext%= + "OS_File",10,f$,ft%,,start%,end% ) scrap_sliding_block(saveanchor%) ramwarn%= getstr(p%) ?p%>31 p$+= (?p%) p%+=1 Validation tables ---------------------------------------------------- tabcreate_click(wi%,ic%,b%) I%,Rows%,Rec%,L%,TabFields%,head$,tablen%,width$,max%,row%,y%,headlen%,col%,z%,lim% "Hourglass_Smash": wimp_error( (b% %111)=4 z%=1 z%=-1 %111 1,4: ic% row%= ($tabcol%) row%>MaxCols% & softerror( (MaxCols%+1),42) row%=MaxCols% $tabcol%= (row%) redraw_icon(wi%,8) # set_caret(scrollW%,row%*2) ) row%<3 y%=0 y%=-(row%-2)*44 9 !block%=scrollW%: "Wimp_GetWindowState",,block% 1 block%!24=y%: "Wimp_OpenWindow",,block% 13,14: @ col%= get_icon_cols(wi%,ic%):fg%=col% 16:bg%=col% I selected(wi%,11) fg%=(fg%+z%+16) bg%=(bg%+z%+16) * set_icon_cols(wi%,ic%,fg%+bg%*16) LastTable%=MaxTabs% & softerror( (MaxTabs%+1),32) L start$="new"+ get_icon_cols(wi%,13)*256+ get_icon_cols(wi%,14)) E name$=$ text(wi%,0): name$="" moan_err%, msg("Err103") G Rows%= text(wi%,1)): Rows%=0 moan_err%, msg("Err104") LastTable%+=1 ! Tablenumber%=LastTable% $ table$(Tablenumber%)=name$ tablen%= (start$)+1 tablen%+= (Rows%))+1 "Hourglass_On" . text(scrollW%,TabFields%*2)<>"" 0 width$=$ text(scrollW%,TabFields%*2) tablen%+= (width$)+1 . tabfieldlen%(TabFields%)= (width$) , Rec%+=tabfieldlen%(TabFields%)+1 1 head$=$ text(scrollW%,TabFields%*2+1) Y (head$)>tabfieldlen%(TabFields%) LastTable%-=1: moan_err%, msg("Err38") headlen%+= (head$)+1 TabFields%+=1 TabFields%-=1 5 TabFields%<0 moan_err%, msg("Err112") ; tablen%+=( (TabFields%))+1+headlen%+Rows%*Rec%) Q extend_named_sliding_block(tabanchor%(Tablenumber%),(tablen%+3) + tabptr%=!tabanchor%(Tablenumber%) 0 $tabptr%=start$:tabptr%+= ($tabptr%)+1 2 $tabptr%= (Rows%):tabptr%+= ($tabptr%)+1 7 $tabptr%= (TabFields%):tabptr%+= ($tabptr%)+1 I%=0 TabFields% ? $tabptr%= (tabfieldlen%(I%)):tabptr%+= ($tabptr%)+1 I%=0 TabFields% C $tabptr%=$ text(scrollW%,I%*2+1):tabptr%+= ($tabptr%)+1 row%=1 Rows% I%=0 TabFields% 5 $tabptr%="":tabptr%+=tabfieldlen%(I%)+1 row% "Hourglass_Off" $# show_table(Tablenumber%) % TabsLoaded$+=","+name$ &! !tablemenuanchor%=0 'H extend_named_sliding_block(tablemenuanchor%,MaxTabs%*35+65) (i tablemenu%=!tablemenuanchor%:tableiconptr%=tablemenu%:tabletextptr%=tablemenu%+MaxTabs%*24+52 )# $tableiconptr%="Tables" tableiconptr%?12=7:tableiconptr%?13=2:tableiconptr%?14=7:tableiconptr%?15=0:tableiconptr%!16=168:tableiconptr%!20=44:tableiconptr%!24=0 tableiconptr%+=28 ,E ptr%=validateM%+52:ptr%!4=tablemenu%: lit(validateM%,1, !tableiconptr%=128 .C !tableiconptr%=0:tableiconptr%+=24:!tableiconptr%=128 0~ tableiconptr%!4=-1:tableiconptr%!8=&7000121:tableiconptr%!12=tabletextptr%:tableiconptr%!16=-1:tableiconptr%!20=L%+1 12 $tabletextptr%=name$:tabletextptr%+=L%+1 2U text(wi%,2)="Modify" write_back_to_table(OldTable%,Tablenumber%,wi%) 3 44 close_it(wi%): set_caret(mainW%,starthere%) asterisk( 6O close_it(wi%): set_caret(mainW%,starthere%):$ text(wi%,2)="Create" modify_table(T%,wi%) I%,Rows%,Rec%,L%,TabFields%,head$,cols% =Ut$= table_info(T%,Rows%,TabFields%,Rec%,tabfieldlen%(),offset%,heading%,colours$) text(wi%,2)="Modify" text(wi%,0)=table$(T%) text(wi%,1)= (Rows%) $tabcol%="0" I%=0 MaxCols%*2+1 text(scrollW%,I%)="" I%=0 TabFields% F/ $ text(scrollW%,I%*2)= (tabfieldlen%(I%)) GI $ text(scrollW%,I%*2+1)=$ text(tableW%(T%),Rows%*(TabFields%+1)+I%) colours$="" colours$="2807" cols%= ("&"+colours$) set_icon_cols(wi%,13,cols% 256) set_icon_cols(wi%,14,cols% 256) OldTable%=T% open_window(wi%): set_caret(wi%,0) redraw(tabcreateW%): redraw(scrollW%) write_back_to_table(old%,new%,wi%) row%,column%,P%,N%,I%,ic% Tct$= table_info(old%,oldRows%,oldTabFields%,Rec%,tabfieldlen%(),oldoffset%,oldheading%,colours$) P%=oldheading% tabhead$()="" I%=0 oldTabFields% X% tabhead$(I%,0)=$P%:P%+= ($P%)+1 I%=0 TabFields% [, tabhead$(I%,1)=$ text(scrollW%,2*I%+1) oldRows%<=Rows% N%=oldRows%-1 N%=Rows%-1 "Hourglass_On" row%=0 `/ P%=!tabanchor%(old%)+oldoffset%+row%*Rec% column%=0 oldTabFields% I%=-1 c I%+=1 e< tabhead$(I%,1)=tabhead$(column%,0) I%>TabFields% I%<=TabFields% g$ ic%=row%*(TabFields%+1)+I% hK $ text(tableW%(new%),ic%)= buffer_length(tableW%(new%),ic%)) i% P%+=tabfieldlen%(column%)+1 j column% row% "Hourglass_Off" text(wi%,2)="Create" redraw(tableW%(new%)) clear_table(T%) confirm( msg("Err47"))= R%,F%,ind%,Rows%,TabFields%,start%,Rec% uUT$= table_info(T%,Rows%,TabFields%,Rec%,tabfieldlen%(),offset%,heading%,colours$) v'start%=!tabanchor%(T%)+offset%-Rec% R%=1 Rows% ind%=start%+R%*Rec% F%=0 TabFields% z) $ind%="":ind%+=tabfieldlen%(F%)+1 redraw(tableW%(T%)) asterisk( show_table(T%) ind%,start%,dflags%,hflags%,c%,I%,pos%,p$,t$,B%,tablefield%,offset%,heading%,colours$ table_info(T%,Rows%,TabFields%,Rec%,tabfieldlen%(),offset%,heading%,colours$) ;NewTab%=(t$=" "):extra%=-NewTab%*(Rows%*(TabFields%+1)) T%<0 "SlidingHeap_DescribeBlock",slidingheapbase%,tabanchor%(T%) ,,tablen% extend_named_sliding_block(undoanchor%(T%),tablen%+1) "Wimp_TransferBlock",mytask%,!tabanchor%(T%),mytask%,!undoanchor%(T%),tablen%+1 tableW%(T%)>0 open_window(tableW%(T%)): name$=table$(T%) $Tablename%=name$ $tableM%=name$ ind%=!tabanchor%(T%)+offset% "Wimp_OpenTemplate",,".Resources.Templates" B%=buff% "Wimp_LoadTemplate",,block%,buff%,endbuff%,-1,"table",0 ,,buff% NewTab% (name$)+1 (t$)+1 buff%+=L%:block%!80=L% "Wimp_CloseTemplate" #block%!28=block%!28 &AFFFFFFF (Rec%+TabFields%+9)*16<1136 Rows%<16: (Rec%+TabFields%+9)*16<1136:block%!28=block%!28 (1<<28) Rows%<16:block%!28=block%!28 (1<<30) :block%!28=block%!28 ((1<<28)+(1<<30)) "Wimp_CreateWindow",,block% tableW%(T%) PTabTitle%(T%)=block%!72: NewTab% $TabTitle%(T%)=name$ $TabTitle%(T%)=t$ "Hourglass_On" colours$="" colours$="2807" cols%= ("&"+colours$) )hflags%=&0000A535+((cols% 256)<<24) )dflags%=&0000A535+((cols% 256)<<24) row%=1 Rows% pos%=72 I%=0 TabFields% R%= create_icon(tableW%(T%),pos%,-row%*44-4+44*NewTab%,(tabfieldlen%(I%)+1)*16+2,48,dflags%,"",ind%,writep%,tabfieldlen%(I%)+1) % pos%+=(tabfieldlen%(I%)+1)*16 ind%+=tabfieldlen%(I%)+1 "Hourglass_Percentage",row%*100 Rows% row% NewTab% pos%=72 I%=0 TabFields% t R%= create_icon(tableW%(T%),pos%,-48,(tabfieldlen%(I%)+1)*16+2,48,hflags%,"",heading%,-1,tabfieldlen%(I%)+1) % pos%+=(tabfieldlen%(I%)+1)*16 heading%+= ($heading%)+1 "Hourglass_Off" p$=printrel$(T%) p$<>"" I%=1 (p$) tablefield%= p$,I%,3)) / select(tableW%(T%),tablefield%+extra%) width%=(Rec%*16)+112 -!block%=0:block%!4=-Rows%*44-4+44*NewTab% block%!8=width%:block%!12=0 "Wimp_SetExtent",tableW%(T%),block% getscreensize(ScreenWidth%,ScreenHeight%,Vpix%) !block%=tableW%(T%) "Wimp_GetWindowState",,block% &block%!4=(ScreenWidth%-width%) block%!12=block%!4+width% Rows%<20 - block%!8=ScreenHeight% 2-(Rows%*18+2) . block%!16=block%!8+Rows%*44+4-44*NewTab% $ block%!8=ScreenHeight% 2-362 + block%!16=block%!8+44*20+4-44*NewTab% "Wimp_OpenWindow",,block% redraw(tableW%(T%)) Access% set_caret(tableW%(T%),0) restore_table(T%) "SlidingHeap_DescribeBlock",slidingheapbase%,tabanchor%(T%) ,,tablen% "Wimp_TransferBlock",mytask%,!undoanchor%(T%),mytask%,!tabanchor%(T%),tablen%+1 redraw(tableW%(T%)) restore_tabfield source%,dest% "Wimp_GetCaretPosition",,block%:wi%=!block%:ic%=block%!4 wi%=tableW%(Tablenumber%) , dest%= text(tableW%(Tablenumber%),ic%) H source%=!undoanchor%(Tablenumber%)+dest%-!tabanchor%(Tablenumber%) $dest%=$source% redraw_icon(tableW%(Tablenumber%),ic%) sort_table(T%,field%) tablen%,ind%,Rec%,Rows%,row%,TabFields%,pos%,dest% Ytitle$= table_info(T%,Rows%,TabFields%,Rec%,tabfieldlen%(),offset%,heading%,colours$) ,pos%= table_field(field%,tabfieldlen%()) *ind%=!tabanchor%(T%)+offset%-Rec%+pos% row%=0 Rows%-1 ind%+=Rec% block%!(row%*4)=ind% $ind%="" $ind%="~" row% "OS_HeapSort",Rows%,block%,4 extend_named_sliding_block(tempanchor%,Rows%*Rec%) dest%=!tempanchor%-Rec% row%=0 Rows%-1 & ind%=block%!(row%*4):dest%+=Rec% $ind%="~" $ind%="" "Wimp_TransferBlock",mytask%,ind%-pos%,mytask%,dest%,Rec% row% "Wimp_TransferBlock",mytask%,!tempanchor%,mytask%,!tabanchor%(T%)+offset%,Rows%*Rec% scrap_sliding_block(tempanchor%) redraw(tableW%(T%)) print_table(T%) printing% indexing% start%,ptr%,Line$,title$,rowsused%,Heading$,h$,column% QTextName$=$database%+".PrintJobs."+ "Tab"+table$(T%),10):$SaveName%=TextName$ read_print_options format$="horiz" Ytitle$= table_info(T%,Rows%,TabFields%,Rec%,tabfieldlen%(),offset%,heading%,colours$) Heading$=margin$ NewTab% column%=0 TabFields% ; h$=$ text(tableW%(T%),Rows%*(TabFields%+1)+column%) ; Heading$+=h$+ tabfieldlen%(column%)- (h$)," ")+" " column% Heading$+=title$+ Rec%- (title$)," ") 'LenLine%=Lmargin%+Rec%+TabFields%+2 extend_named_sliding_block(lineanchor%,LenLine%+4) extend_named_sliding_block(headanchor%,LenLine%+4):pos%=!headanchor% heap_store(headanchor%,LenLine%,0,pos%,0,Heading$) Title$="Validation table" Title1$=table$(T%) Title2$="" reportdest$="Window" Count%=0 list_head(0) "Hourglass_On" I%=1 Rows% ) start%=!tabanchor%(T%)+offset%-Rec% Line$=margin$ ptr%=start%+I%*Rec% J%=0 TabFields% D $ptr%<>"" Line$+=$ptr%+ tabfieldlen%(J%)- ($ptr%)+2," ") ptr%+=tabfieldlen%(J%)+1 Line$<>margin$ rowsused%+=1 D $(!lineanchor%)=Line$: list_line(-1,lineanchor%, (Line$),32) "Hourglass_Percentage",I%*100 Rows% "Hourglass_Off" rule_off(45) S$=margin$+ (Rows%)+" rows" #:$(!lineanchor%)=S$: list_line(-1,lineanchor%, (S$),32) $#S$=margin$+ (rowsused%)+" used" %:$(!lineanchor%)=S$: list_line(-1,lineanchor%, (S$),32) rule_off(45) screen_list pitch$= pitch("0") lit(listM%,1, write_log(-1,"Table printed: "+table$(T%)) write_table_as_csv(T%,Filename$) ic%,row%,column%,Rows%,TabFields%,Rec%,offset%,heading%,csvhandle%,F$ /Ut$= table_info(T%,Rows%,TabFields%,Rec%,tabfieldlen%(),offset%,heading%,colours$) csvhandle%= (Filename$) ic%=-1 "Hourglass_On" row%=0 Rows%-1 column%=0 TabFields% 5) ic%+=1:F$=$ text(tableW%(T%),ic%) 6. selected(csvW%,0) F$=""""+F$+"""" 73 column%LastTable% T%>LastTable% table_info(table%, rows%, columns%, recordlength%,colwidth%(), offset%, heading%, colours$) P%,Q%,I%,new%,S$ f P%=!tabanchor%(table%):Q%=P% S$=$P% S$,3)="new" new%= :colours$= S$,4):P%+= ($P%)+1 rows%= ($P%):P%+= ($P%)+1 j columns%= ($P%):P%+= ($P%)+1 recordlength%=0 I%=0 columns% m' colwidth%(I%)= ($P%):P%+= ($P%)+1 n$ recordlength%+=colwidth%(I%)+1 heading%=P% new% I%=0 columns% P%+= ($P%)+1 offset%=P%-Q% P%+= ($P%)+1:offset%=160 new% =$heading% table_field(F%,L%()) I%,P% I%"" S$))<58 N$= S$)+N$ S$= N$="" leading_number( S$<>"" (S$)<58 N$=N$+ S$,1) S$= S$,2) N$="" load_table(f$,show%) pos%,name$,d%,L% name$= leaf(f$):L%= (name$) TabsLoaded$,name$)=0 "OS_File",5,f$ d%,,,,tablen% LastTable%=MaxTabs% show% . softerror( (MaxTabs%+1),32):show%= : extratabs$,name$)=0 extratabs$+=name$+" " LastTable%+=1 M create_named_sliding_block(tabanchor%(LastTable%),(tablen%+3) 3 "OS_File",255,f$,!tabanchor%(LastTable%) table$(LastTable%)=name$ Tablenumber%=LastTable% TabsLoaded$+=","+name$ !tablemenuanchor%=0 F extend_named_sliding_block(tablemenuanchor%,MaxTabs%*35+65) g tablemenu%=!tablemenuanchor%:tableiconptr%=tablemenu%:tabletextptr%=tablemenu%+MaxTabs%*24+52 ! $tableiconptr%="Tables" tableiconptr%?12=7:tableiconptr%?13=2:tableiconptr%?14=7:tableiconptr%?15=0:tableiconptr%!16=168:tableiconptr%!20=44:tableiconptr%!24=0 tableiconptr%+=28 C ptr%=validateM%+52:ptr%!4=tablemenu%: lit(validateM%,1, !tableiconptr%=128 A !tableiconptr%=0:tableiconptr%+=24:!tableiconptr%=128 | tableiconptr%!4=-1:tableiconptr%!8=&7000121:tableiconptr%!12=tabletextptr%:tableiconptr%!16=-1:tableiconptr%!20=L%+1 0 $tabletextptr%=name$:tabletextptr%+=L%+1 Tablenumber%= table_number(name$) show% show_table(Tablenumber%) link_to_table icon% b%=(b% %111) 2,4: ic%=13 7 tick_one(tablemenu%,0,LastTable%,Tablenumber%) - show_menu(tablemenu%,oldx%+32,oldy%) %111 1,4: b%=4 z%=1 z%=-1 ic% tcycle(z%) tcycle(-z%) ! fcycle(z%,fieldnum%) " fcycle(-z%,fieldnum%) $ fcycle(z%,substitute%) % fcycle(-z%,substitute%) icon%=10 2 shade(linkW%,icon%, selected(linkW%,9)) icon% $ ### Default action ### " icon%=field%(Fieldnumber%) 1 selected(linkW%,4) $Tablename%<>"" 4 link$(Fieldnumber%)=$Tablename%+$fieldnum% = selected(linkW%,15) link$(Fieldnumber%)+="~" 0 set_icon_cols(mainW%,icon%,-fcol%(8)) V selected(linkW%,9) link$(Fieldnumber%)=$substitute%+link$(Fieldnumber%) ? link$(Fieldnumber%)="": set_icon_cols(mainW%,icon%,7) $ K%= is_a_key(Fieldnumber%) key%: colour(K%,1) colour(K%,2) link$(0)="LOADED" asterisk( & b%=4 close_window(linkW%) " close_window(linkW%) tcycle(z%) LastTable%=-1 Tablenumber%+=z% Tablenumber%>LastTable% Tablenumber%=0 Tablenumber%<0 Tablenumber%=LastTable% $$Tablename%=table$(Tablenumber%) redraw_icon(linkW%,0) fcycle(z%,column%) table_info(Tablenumber%,Rows%,TabFields%,Rec%,tabfieldlen%(),offset%,heading%,colours$) field%= ($column%) field%+=z% field%>TabFields% field%=0 field%<0 field%=TabFields% $column%= (field%) redraw_icon(linkW%,2) redraw_icon(linkW%,10) link_status name$,field$,ic%,subst$,exact% name$=link$(Fieldnumber%) ,field$= trailing_number(name$,exact%)) set_icon(linkW%,15,exact%) ?subst$= leading_number(name$)): subst$="-1" subst$="0" (name$<>"" TabsLoaded$,name$)>0) = $Tablename%=name$:$fieldnum%=field$:$substitute%=subst$ ' Tablenumber%= table_number(name$) select(linkW%,4) Tablenumber%=0 & $Tablename%=table$(Tablenumber%) deselect(linkW%,4):$fieldnum%="0" set_icon(linkW%,9,subst$<>"0") ic%=10 shade(linkW%,ic%, selected(linkW%,9)) redraw_icon(linkW%,0): redraw_icon(linkW%,2) save_links link$(0)="LOADED" lk= ($database%+".Link") F%=1 fields% #lk,link$(F%) close_file(lk) End of Validation table routines ------------------------------------ changes(key%,field%,Old$,New$,confirm%) M$,K%,index%,target$,log$ ""target$=$Query%:Search$= parse New$="" n$="" n$=New$ New$<>"" "+-*/", New$,1))>0 numeric%= numeric%= is_a_key(field%) K%=key% softerror("",12): "Wimp_CreateMenu",,-1: K%>=0 M$=" NOTE! Index on this field will NO LONGER BE VALID and should be deleted." M$="" Old$<>"" o$=" when existing value is "+Old$ o$="" target$="" target$=" for all subfile "+ (file%) target$=" for "+target$+" in subfile "+ (file%) -Klog$="Change contents of field "+Tag$(field%)+" to "+n$+o$+target$+". " target$=log$+M$ confirm%= confirm(target$)= 0' subtotal%= count_recs(key%,zero%) "Hourglass_On" 2, dbasehandle%= ($database%+".Database") P%= neighbour(key%,top,1) scan_file("P%<>top",key%,file%,5,1) close_file(dbasehandle%) $Date%(file%)= today date%?file%=1 display(key%,addr) "Hourglass_Off" K%>=0 index%=K% Keys%-1 / scrap_sliding_block(keyanchor%(Keys%)) Index$(Keys%)="" Keys%-=1 write_log(-1,log$) asterisk( is_a_key(F%) key%,flag%,J% flag%=-1 J%=0 L& KF%(key%,J%)=F% flag%=key% key%+=1 flag%>=0 key%>Keys% =flag% read(N%,K%,R%,f$) I%,key%,dbasehandle% T"dbasehandle%= (f$+".Database") U%$Rf%(0)="":field$(0)="":key$()="" #dbasehandle%= (R%)*Length% I%=1 field$(I%)= #dbasehandle% chartype%(I%)<>40 chartype%(I%)<>59 $Rf%(I%)=field$(I%) chartype%(I%) [8 36,37,38: set_blob_sprite(R%,I%,chartype%(I%)) \! show_text_block(I%) show_picture(I%) 41,42,43,44,45: _T field$(I%)=" " select(mainW%,field%(I%)) deselect(mainW%,field%(I%)) `( R%=RA% $Rf%(I%)= (REC%) a9 R%=RA% split_link(I%,R$,V$):$Rf%(I%)=R$ b' R%=RA% $Rf%(I%)= c( R%=RA% $Rf%(I%)= $,15) d1 R%=RA% $Rf%(I%)= convert_date(2) e1 R%=RA% $Rf%(I%)= convert_date(4) f# R%=RA% $Rf%(I%)= g' R%=RA% $Rf%(I%)= h) R%=RA% $Rf%(I%)= $,5,2) i) R%=RA% $Rf%(I%)= $,8,3) jJ R%=RA% $,8,3):P%= months$,M$):$Rf%(I%)= ((P%+2) k* R%=RA% $Rf%(I%)= $,12,4) key%=0 Keys% key$(key%)= key(key%) key% close_file(dbasehandle%) cfield$()=field$() update_calcs(N%) design% N%>0 $Rf%(N%)=cfield$(N%) I%,C%,L%,F,F$,Form$,S$,SF$,changed% {GForm$=update$(N%): List of fields affected by a change in field N% Form$=0 calc_error:= I%=1 (Form$)-1 F%= fnum( Form$,I%,2)) F%<>N% & split_link(F%,real$,visible$) chartype%(F%) E 6:F= (real$):F$= fix%(F%)<>0 fix_point(F$,F%) I 7:F$= (real$): N%=0 expand(F$,link$(F%),L%,SF$):F$=SF$ (F$)<=len%(F%) * $Rf%(F%)=F$:cfield$(N%)=$Rf%(N%) 4 redraw_icon(mainW%,field%(F%)) . F$(F%)<>F$ F$(F%)=F$:changed%= moan_err%,"" " changed%= update_calcs(F%) =changed% calc_error ### Division by zero. Ignore ### moan_err%: softerror(calc$(F%),10) softerror(calc$(F%),73) check_change F%,flag% F%field$(F%) flag%= D customise% record_change(REC%,F%,field$(F%),$Rf%(F%)) flag% write(fields%,key%): asterisk( write(N%,k%) key%,newrec%,dontalter% Access% softerror("",14): close_file(dbasehandle%) template%=2 write_dbase(RA%,N%, ):template%=0: PRI$= key(0) PRI$="" key$(0) key%=0 Keys% KEY$= key(key%) kl%= (KEY$) insert(KEY$,key%) KEY$<>"*Failed*" # key$(key%)=KEY$:newrec%= $ k%=key% addr=nextfree% dontalter%= key% key%=0 Keys% KEY$= key(key%) KEY$<>key$(key%) L key%=0 confirm( msg("Err48")) dontalter%= restore_rec dontalter%= $ delete(key$(key%),key%) insert(KEY$,key%) KEY$="*Failed*" KEY$=key$(key%) restore_rec insert(KEY$,key%) key$(key%)=KEY$ key% dontalter% $Date%(file%)= today date%?file%=1 newtree% write_dbase(REC%,N%, newrec% autobalance% added%+=1 added%= ($Every%) key%=0 Keys% balance(key%) key% added%=0 write_dbase(R%,N%,logchanges%) I%,F$,S$,dbasehandle%,flag% *dbasehandle%= ($database%+".Database") #dbasehandle%=R%*Length% logchanges% newrec% C write_log(R%,"New record: Subfile "+ (file%)+" "+ key(0)) * write_log(R%,logentry$):flag%= I%=1 chartype%(I%) 39,40:F$="" newrec% F$=$Rf%(I%) split_link(I%,R$,V$) S%= / dontincrement%= S%+=1:F$= (S%-1) calc$(I%)=V$+"|"+ F$=$Rf%(I%) dontincrement%= 58:F$= :F$=$Rf%(I%) #dbasehandle%,F$ flag%= F$<>field$(I%) chartype%(I%)<>59 % F$="" D$="" D$=F$ 5 field$(I%)="" S$="" S$=field$(I%) 3 write_log(-1,Tag$(I%)+": "+S$+" ---> "+D$) field$(I%)=F$ selected(prefsW%,44) readsmarray(dbasehandle%,R%) write_csv_rec(R%,csvform$,autocsvhandle%) close_file(dbasehandle%) split_link(F%, L$,P%,F L$=calc$(F%) L$,1)="#": / P%= L$,"#",2):V$= L$,P%+1):R$= L$,2,P%-2) L$,"|")>0: + P%= L$,"|"):V$= L$,P%-1):R$= L$,P%+1) :R$="":V$="" key(key%) key2(key%,0) key2(key%,loc%) I%,W%,P%,S$,W$,T$,pad$,chars%,pos%,word%,wd%,field%,numeric% I%=0 W%=KW%(key%,I%):W$="" W%>0 chars%=W% pos%=(W%>>8) word%=(W%>>16) field%=KF%(key%,I%) chartype%(field%) () 3,6,46,47,54,56,57:numeric%= :numeric%= * +: loc%=0 S$=$Rf%(field%)+" " S$=F$(field%)+" " numeric% word% 0! C$= S$,1):S$= S$,2) 1 C$<>" " W$+=C$ S$="" wd%=0 6: P%= S$," "):w$= S$,P%-1):S$= S$,P%+1):wd%+=1 wd%=word% S$="" wd%=word% W$=w$ pos% 0:W$= W$,chars%) < 255:W$= W$,chars%) =! W$,pos%,chars%) ?@ incspace%(key%)= word%>0 W$+= chars%- (W$)," ") @ chartype%(field%) A* 5,51,52:W$= reverse_date(W$) D T$+=W$ T$<>"" incspace%(key%)= pad$=" " pad$="#" J T$+= KL%(key%)- (T$),pad$) case%(key%) u(T$) u(N$) I%,B% $key=N$ I%=0 (N$)-1 B%=key?I% B%>96 B%<123 key?I%=B% U =$key today Y$,M$,D$,M%,date$ $,14,2) $,5,2) $,8,3) \:M%=( "JanFebMarAprMayJunJulAugSepOctNovDec",M$)+2) M%<10 M$="0"+ (M%) date$=D$+"-"+M$+"-"+Y$ =date$ date(key%) !keyanchor%(key%)=0 I%=0 date%?I%=1 f* $(!keyanchor%(key%)+8+9*I%)= today $Date%(I%)= today check_date(key%,D$,place%, date$) F%,I%,D%,M%,Y%,L%,P%,Q%,U$,d$,m$,y$ place%=0 F%=Fieldnumber% F%=KF%(key%,0) L%=0 I%=1 C$= D$,I%,1) C$<"0" C$>"9" P%=0 P%=I% Q%=I% P%=0 Q%=0 restore(F%, msg("Err102"),4):= D$,P%-1)) D$,P%+1,Q%-P%-1)) D$,Q%+1)) Y%<0 D%<1 restore(F%,"",4):= M%<1 M%>12 restore(F%, msg("Err118"),4):= (Y% 400)=0:U$=leap$: Century year is leap year if divisible by 400 (Y% 100)<>0 (Y% 4)=0:U$=leap$: otherwise not :U$=nonleap$ U$,2*M%-1,2) (DM$) restore(F%, msg("Err119,"+DM$),4):= (D%): (d$)=1 d$="0"+d$ (M%): (m$)=1 m$="0"+m$ (Y%): (y$)=1 y$="0"+y$ (y$)<>2 (y$)<>4 restore(F%, msg("Err120"),4):= (y$)=4 len%(F%)<10 y$,2) (y$)=2 len%(F%)>=10 $,12,2)+y$ &date$=d$+$datesep%+m$+$datesep%+y$ place%=0 (date$)>len%(F%) restore(F%, msg("Err121"),4):= place% 0:$Rf%(F%)=date$: redraw_icon(mainW%,field%(F%)) text(searchW%,1)=date$: redraw_icon(searchW%,1) convert_date(L%) d$,m$,y$,M$,M% $,5,2) $,8,3) months$,M$) M%=(P%+2) (M%): M%<10 m$="0"+m$ $,16-L%,L%) !=d$+$datesep%+m$+$datesep%+y$ reverse_date(K$) (K$) 8:K$= K$,2)+ K$,3,4)+ K$,2) (K$)<100 ! K$= K$,4)+ K$,3,4)+ K$,2) # K$,2)+ K$,5,4)+ K$,4) refresh_dates key% key%=0 Keys% date(key%) key% days(date$) M%,d$,y$ date$,2) date$,4,2)) date$,7) *date$=d$+" "+ months$,M%*3-2,3)+" "+y$ "Territory_ConvertTimeStringToOrdinals",-1,2,date$,ordinals% ;!ordinals%=0:ordinals%!4=0:ordinals%!8=0:ordinals%!12=0 "Territory_ConvertOrdinalsToTime",-1,utctime%,ordinals% =(utctime%!1) 33750 date(days%,L%) 0$dateformat%="%DY"+$datesep%+"%MN"+$datesep% L%=8 $dateformat%+="%YR"+ $dateformat%+="%CE%YR"+ utctime%!1=days%*33750 "Territory_ConvertDateAndTime",-1,utctime%,datebuffer%,16,dateformat% datebuffer%?L%=13 =$datebuffer% check_time( time$) I%,P%,Q%,H%,M%,S%,C$ I%=1 (time$) C$= time$,I%,1) C$<"0" C$>"9" P%=0 P%=I% Q%=I% P%=0 Q%=0 restore(Fieldnumber%,"",101):= time$,P%-1)): H%<0 H%>23 restore(Fieldnumber%,"hours",94):= time$,P%+1,Q%-P%-1)): M%<0 M%>59 restore(Fieldnumber%,"minutes",94):= time$,Q%+1)): S%<0 S%>59 restore(Fieldnumber%,"seconds",94):= !time$= time(H%*3600+M%*60+S%) F$Rf%(Fieldnumber%)=time$: redraw_icon(mainW%,field%(Fieldnumber%)) seconds(time$) H%,M%,S%,secs% time$,2)) time$,4,2)) time$,2)) secs%=H%*3600+M%*60+S% =secs% time(secs%) ;$dateformat%="%24"+$timesep%+"%MI"+$timesep%+"%SE"+ $!utctime%=secs%*100:utctime%?4=0 "Territory_ConvertDateAndTime",-1,utctime%,datebuffer%,16,dateformat% datebuffer%?8=13 =$datebuffer% validate(F%, TabFields%, name$) selected(prefsW%,21) row%,field%,Rows%,Rec%,ind%,sind%,pos%,start%,subst%,spos%,date$,subst$,L1%,L2%,L%,S$,exact%,extra$ S$=$Rf%(F%):L%= S$="" fix%(F%)<>0 $Rf%(F%)= fix_point(S$,F%): redraw_icon(mainW%,field%(F%)) chartype%(F%)=3 check_val(calc$(F%),S$)= chartype%(F%)=5 check_date(key%,S$,0,date$) chartype%(F%)=8 check_time(S$) Bname$=link$(F%): name$="" name$,1)="#" name$,1)="@" )field%= trailing_number(name$,exact%) !subst%= leading_number(name$) table_number(name$): T%<0 table_info(T%,Rows%,TabFields%,Rec%,tabfieldlen%(),offset%,heading%,colours$) S$=field$(F%) TabFields%=0 ,pos%= table_field(field%,tabfieldlen%()) subst%<0 spos%=pos% spos%= table_field(subst%,tabfieldlen%()) 'start%=!tabanchor%(T%)+offset%-Rec% 'ind%=start%+pos%:sind%=start%+spos% exact% 1 cond$="row%>Rows% OR $ind%=S$ OR $sind%=S$" cond$="row%>Rows% OR ($ind%=LEFT$(S$,L1%) AND L1%>0) OR ($sind%=LEFT$(S$,L2%) AND L2%>0)" row%+=1 ind%+=Rec%:sind%+=Rec% L1%= ($ind%):L2%= ($sind%) (cond$)= row%>Rows% restore(F%," ("+name$+")",5):= exact% , $sind%= S$,L2%):extra$= S$,L%-L2%) + $ind%= S$,L1%):extra$= S$,L%-L1%) ind%=start%+row%*Rec% I%=0 TabFields% , rel%(I%)=ind%:ind%+=tabfieldlen%(I%)+1 subst%>=0 subst$=$sind% S$=subst$+extra$ (S$)<=len%(F%) $Rf%(F%)=S$ redraw_icon(mainW%,field%(F%)) =row% check_val(C$,N$) min$,max$,P%,V,ok% ok%= N$="" C$<>"" P%= C$,"|") P%>0 min$= C$,P%-1) max$= C$,P%+1) H min$<>"" (min$) ok%= restore(F%," (min="+min$+")",58) H max$<>"" (max$) ok%= restore(F%," (max="+max$+")",59) restore_rec F%=1 fields% field$(F%)<>$Rf%(F%) $Rf%(F%)=field$(F%) #' redraw_icon(mainW%,field%(F%)) restore(F%,E$,E%) E%>=0 softerror(E$,E%) $Rf%(F%)=field$(F%) redraw_icon(mainW%,field%(F%)) set_caret(mainW%,field%(F%)) relations F%,I%,W%,L%,N$,row%,col%,subst%,flags%,name$,x%,y%,vxmin%,vymax%,scrollx%,scrolly%,exact% "Wimp_CreateMenu",,-1 getscreensize(ScreenWidth%,ScreenHeight%,Vpix%) name$=link$(Fieldnumber%) name$="" $Rf%(Fieldnumber%)="" 5 F%=-1 6&row%= validate(Fieldnumber%,F%,N$) 7'col%= trailing_number(name$,exact%) 8!subst%= leading_number(name$) row%>0 delete_icons(relateW%,0) I%=0 =0 col%:flags%=&00000531+(fcol%(8)<<24) ># subst%:flags%=&0B000531 :flags%=&07000531 @ L%= ($rel%(I%)) BT R%= create_icon(relateW%,0,-I%*36-36,L%*16+16,32,flags%,"",rel%(I%),-1,L%+1) L%>W% W%=L% W%<3 W%=3 $RelTitle%=N$ G& width%=W%*16+16:height%=F%*36+36 Ha !block%=0:block%!4=-height%:block%!8=width%:block%!12=0: "Wimp_SetExtent",relateW%,block% I5 !block%=mainW%: "Wimp_GetWindowState",,block% JL vxmin%=block%!4:vymax%=block%!16:scrollx%=block%!20:scrolly%=block%!24 KQ !block%=mainW%:block%!4=field%(Fieldnumber%): "Wimp_GetIconState",,block% L? x%=block%!16-scrollx%+vxmin%:y%=block%!20-scrolly%+vymax% M7 !block%=relateW%: "Wimp_GetWindowState",,block% ScreenWidth%-x%1 matched% abort%= P%=top matched%= y z# record%= rec_no(k$,key%,P%) {* readsmarray(dbasehandle%,record%) |( (S$)= matched%= :passgo%=0 matched% abort% close_file(dbasehandle%) abort% softerror($Query%,113) display(key%,P%) 3!block%=mainW%: "Wimp_GetWindowState",,block% P%=-1 check_change template%=1 template%=2 template%=0 I%,L%,S%,S$,k$,ok% -1,-2: . keybase%=!keyanchor%(0):avail%=!keybase% : !(keybase%+avail%)>0,template%=2,design%= :ok%= incr%= ($Increment%) incr%>0 + change_length(RA%+incr%, ):ok%= softerror("",2) ok% design%: 0 $RecInfo%="Make adjustments to fields" ) read(fields%, ,RA%,$database%) template%=2: S $RecInfo%="Enter data which you want to appear by default on new records" ) read(fields%, ,RA%,$database%) P%=-2: o REC%=!(keybase%+avail%+8+KL%(0)+1):$RecInfo%=$Subfile%(file%)+" Record="+ (REC%)+". (Copy)":key$()="" P%=-1: d REC%=!(keybase%+avail%+8+KL%(0)+1):$RecInfo%=$Subfile%(file%)+" Record="+ (REC%)+". (New)" ) read(fields%, ,RA%,$database%) top: ### Empty subfile accessed ### . keybase%=!keyanchor%(0):avail%=!keybase% ( REC%=!(keybase%+avail%+8+KL%(0)+1) read(fields%, ,RA%,$database%) 7:$RecInfo%=$Subfile%(file%)+" Record="+ (REC%)+". (New)" REC%= rec_no(k$,key%,P%) read(fields%, ,REC%,$database%) key$(key%)=k$ k$)="#" k$= > $RecInfo%=$Subfile%(file%)+" Record="+ (REC%)+" Key="+k$ text_length(mainW%,starthere%) Access% set_caret(mainW%,starthere%) identify_field(starthere%) changed%= update_calcs(0) *logentry$=$Subfile%(file%)+" "+ key(0) altered% $RecInfo%)<>"*" $RecInfo%+=" *" redraw(mainW%) P%=-2 softerror("",130) -------------------- Icon colours ------------------------------- colour(key%,type%) type%=1 - Selected key,2 - Non-selected key J%=0 KF%(key%,J%)>0 change_field_cols(key%,type%,J%) change_field_cols(key%,type%,fld%) key% type% ) 1:dcol%=fcol%(0):fcol%=fcol%(1) ) 2:dcol%=fcol%(2):fcol%=fcol%(3) type% ) 1:dcol%=fcol%(4):fcol%=fcol%(5) ) 2:dcol%=fcol%(6):fcol%=fcol%(7) set_icon_cols(mainW%,desc%(KF%(key%,fld%)),dcol%) 6col%= get_icon_cols(mainW%,field%(KF%(key%,fld%))) (col% 16)=fcol%(8) fcol%=(fcol% &F0) (col% set_icon_cols(mainW%,field%(KF%(key%,fld%)),fcol%) get_icon_cols(wi%,ic%) ;!block%=wi%:block%!4=ic%: "Wimp_GetIconState",,block% =block%?27 set_icon_cols(wi%,ic%,col%) col%<0 col%= (col%):block%!12=&0F000000 block%!12=&FF000000 F!block%=wi%:block%!4=ic%:block%!8=(col%<<24): block%!12=&FF000000 "Wimp_SetIconState",,block% read_colours(f$) ic%=0 #F,fcol%(ic%) ncol%()=fcol%() close_file(F) write_colours ($database%+".Cols") ic%=0 #F,fcol%(ic%) close_file(F) find(S$,key%,disp%) P%,F%,H%,recnum%,abort%,cond$ case%(key%) u(S$) S$,1)="#" check_change REC%= S$,2)) REC%>=0 REC%0 file%=F% val$="VAL" cond$="VAL($(!keyanchor%(key%)+P%+8))=VAL(S$)" cond$="LEFT$($(!keyanchor%(key%)+P%+8),kl%)=S$" matches%=0 P%>=0 recnum%:RecF%= :addr=P%:matches%=1 P%>=0:RecF%= ### RecF% is used only by !DELETE in script language ### count_matches(addr) selected(searchW%,6) $ F%=file%:file%=(file%+1) top=8*file%+LH% P%= search(S$,key%,1) % P%>0 count_matches(Q%) file%=(file%+1) file%=F% top=8*file%+LH% recnum%: softerror("#"+ (REC%),55) disp% addr= (P%):flash%=KF%(key%,0) addr=P% text(searchW%,7)= (matches%)+" found": redraw_icon(searchW%,7) disp% display(key%,addr) * =addr count_matches( (cond$) P%= neighbour(key%,P%,0) 0XP%= neighbour(key%,P%,1):Q%=P%: ### Scan back to FIRST match & point addr at it ### (cond$) matches%+=1 P%= neighbour(key%,P%,1) lookup(F%) K%,S$,K$ chartype%(F%)>8 is_a_key(F%) K%>=0 K$= key(K%) addr= find(K$,key%, addr= find($Rf%(F%),key%, get_it_in(filename$) "OS_File",5,filename$ d%,,ftype% D9ftype%=(ftype%>>8) &fff:wi%=block%!20:ic%=block%!24 field%=(ic%+1) wi%=mainW% chartype%(field%)=44 link_file(wi%,ic%,field%,filename$,ftype%) d%=2 wi%=reformW% I- "OS_File",5,filename$+".Form" d%=1 KJ $ text(wi%,7)=filename$: redraw_icon(wi%,7): shade(reformW%,6, softerror("",28) M N O! leaf(filename$),1) "!": Q1 ### Is it an Impression document? ### R3 "OS_File",5,filename$+".!DocData" d%=1 T" ready_to_merge(&2000) V4 ### Is it a Powerbase application? ### W; "OS_File",5,filename$+".Indices" d%,,type% X# type%=(type%>>8) &fff d%=2 Z" present%>0 [& $Title%= leaf(filename$) \$ open_files(filename$) `5 ### It's an ordinary directory folder ### a: transfer_blob(block%!20,block%!24,filename$,-1) b ftype% f' &7f1: load_table(filename$, g) &7f3: load_selection(filename$) h- &7f4: load_query(filename$,wi%,ic%) i. &7f5: get_options(printW%,filename$) jB &dfe:$ text(csvW%,13)=filename$: start_import("CSV",wi%) kH &ff9,&aff: transfer_blob(block%!20,block%!24,filename$,ftype%) l> &bc5: chartype%(field%)<>44 ready_to_merge(&bc5) &fff: n1 F= (filename$):header$= close_file(F) wi% p, mainW%,tableW%(Tablenumber%),-1: rQ header$="!SCRIPT POWERBASE": present%=7: execute_script(filename$) sI wi%=mainW% ic%>0: transfer_blob(wi%,ic%,filename$,ftype%) tB text(csvW%,13)=filename$: start_import("text",wi%) v( customise% special_drop w ready_to_merge(doctype%) selected(passW%,13) present%=7 document$= leaf(filename$) document$,1)="!" document$= document$,2) 6 block%!0=256:block%!12=0:block%!16=5:block%!20=0 5 block%!24=0:block%!28=0:block%!32=0:block%!36=0 / block%!40=doctype%:$(block%+44)=filename$ "Wimp_SendMessage",18,block%,0 Impref%=block%!8 softerror("",107) open_files(f$) I%,J%,F%,A$ ### Delete redundant files if present ### "OS_CLI","Remove "+f$+".Winsize" "OS_CLI","Remove "+f$+".Choices" read_sys_vars(f$) "OS_File",5,f$+".Database" d%=1 present%=present% "OS_File",5,f$+".PrimaryKey" d%=1 present%=present% "OS_File",5,f$+".Form" d%=1 present%=present% "OS_File",5,f$+".UsrSprites" d%,,,,len% d%=1 create_named_sliding_block(logoanchor%,len%+8) & base%=!logoanchor%:!base%=len%+4 "OS_File",255,f$+".UsrSprites",base%+4 logosloaded%= $database%=f$ "OS_CLI","Set Dbase$Dir "+f$ present% 0,1,5:Access%= :Modify%= resume_opening access(f$,accessW%) resume_opening wimp_error( ,254,0, msg("Err24")) read_sys_vars(f$) E%,F,A$,L$,S$ (f$+".!Run") S$= S$,"Acl$Dir")>0 A$=S$ S$,"Log$Dir")>0 L$=S$ close_file(F) A$="" A$="Set Acl$Dir "+f$ L$="" L$="Set Log$Dir "+f$ "XOS_ReadVarVal","Acl$Dir",,-1 ,,E%: E%=0 "OS_CLI",A$ "XOS_ReadVarVal","Log$Dir",,-1 ,,E%: E%=0 "OS_CLI",L$ access(f$,wi%) L%,P%,keybase%,login%,attempts%,old% (f$+".Colours") F>0 #F=35:old%= (f$+".Cols") F>0 #F=45:old%= fatal_err%,f$+"."+ msg("Err18") #F,S$:$Read%= encrypt(S$, #F,S$:$Write%= encrypt(S$, #F,S$:$Manager%= encrypt(S$, I%=9 select(passW%,I%) deselect(passW%,16) I%<17 #F,Z%: set_icon(passW%,I%,Z%) I%+=1 close_file(F) old% "OS_CLI","Copy .Resources.Cols "+f$+".Cols ~C~V" mouse(-1,0,4,passW%,4) "OS_CLI","Remove "+f$+".Colours" "OS_File",5,".acl" d%:acl%=(d%=1) $Manager%="" acl%= Access%= :Modify%= 9$AccessTitle%="!Powerbase opening "+ leaf($database%) acl% position_window(wi%,0,0,0,310,0,110):refuse$="Access denied" position_window(wi%,0,0,0,200,0,0):refuse$="Password not known" 0!block%=wi%: "Wimp_GetWindowState",,block% block%!4,block%!8,block%!12-block%!4,block%!16-block%!8 ( cancel%= :login%= :accessbutton%=0 $Password%="":$UserID%="" redraw_icon(wi%,1): redraw_icon(wi%,0) text(wi%,5)="Type in your password" acl% set_caret(wi%,0) set_caret(wi%,1) accessbutton%>0 accessbutton% 2:cancel%= + password$=$Password%:user$=$UserID% acl% F= (".acl") ! #F,id$,personal$,pw% X id$= encrypt(user$, personal$= encrypt(password$, pw%>0 login%= login% close_file(F) user$="" password$ & $Manager%:pw%=3:login%= $ $Write%:pw%=2:login%= # $Read%:pw%=1:login%= (login% cancel%) $ text(wi%,5)=refuse$ ! set_icon_cols(wi%,5,&1B) delay%= >delay% ! set_icon_cols(wi%,5,&17) attempts%+=1 R att$(attempts%)= (attempts%)+","+ leaf($database%)+","+user$+","+password$ login% cancel% attempts%=3 getscreensize(W%,H%,V%) #Access%=(pw%>1):Modify%=(pw%>2) close_window(wi%) 0,0,W%,H% attempts%=3 " user$="":pw%=0 open_log(".Log", I%=1 / write_log(-1, msg("Err122,"+att$(I%))) close_log(".Log") close_down =login% resume_opening "OS_Byte",202,kbdstatus% "Hourglass_On" selected(passW%,16) open_log(".Log", ($database%+".Subfiles") I%=0 * 0:$Subfile%(I%)="Subfile "+ S$= % S$="" S$="Subfile "+ $Subfile%(I%)=S$ close_file(F) "OS_File",5,f$+".UserFuncs" d%=1 f$+".UserFuncs" "OS_File",5,f$+".Cols" d%=0 "OS_CLI","Copy .Resources.Cols "+f$+".Cols ~C~V" "OS_CLI","Remove "+f$+".Colours" read_colours($database%+".Cols") "OS_File",5,f$+".PrintRes.PrtOptions" d%=1 get_options(printW%,f$+".PrintRes.PrtOptions") "OS_File",5,f$+".Preference" d%=1 get_preferences(prefsW%,f$+".Preference") "OS_File",5,f$+".CSVoptions" d%=1 get_csv_options(f$+".CSVoptions") deselect(prefsW%,36): select(prefsW%,35): shade(prefsW%,35, f$,3)="RAM" ram%= "OS_CLI","Set Alias$Indices Filer_OpenDir "+$database%+".Indices" "OS_CLI","Set Alias$Tables Filer_OpenDir "+$database%+".ValTables" "OS_CLI","Set Alias$Resources Filer_OpenDir "+$database%+".PrintRes" "OS_CLI","Set Alias$JobsDone Filer_OpenDir "+$database%+".PrintJobs" shade(csvW%,18,Modify%) shade(csvW%,21,Access%) shade(printW%,50,Modify%) shade(printW%,53,Access%) shade(prefsW%,36,Modify%) shade(prefsW%,38,Access%) lit(iconbarM%,1, lit(iconbarM%,2,Modify%) lit(iconbarM%,3, lit(iconbarM%,5,Modify%) lit(mainM%,6, selected(passW%,9)) lit(miscM%,0,Access%) lit(miscM%,1,Modify%) lit(miscM%,2,Access%) lit(miscM%,3,Access%) lit(miscM%,4,Access%) lit(miscM%,5,Access%) lit(validateM%,0,Access%) lit(fieldM%,0,Access%) lit(fieldM%,2,Access%) lit(fieldM%,3,Access%) lit(tableM%,0,Access%) lit(tableM%,3,Access%) lit(utilityM%,0,((present% 4)>0)) lit(designM%,1,((present% 4)=0)) I%=1 lit(utilityM%,I%,(present%=7)) limit_actions(Access%) present%<4 design%= present%=5 adjust_on( lit(designM%,6, fields%= get_form(Fptr%) V0chartype%(0)=100:chartype%(MaxFields%+1)=100 fields%>0 starthere%= start_at Y" Lastwritable%= last_writable Z' fieldmenu%= field_menu(fields%, create_named_sliding_block(transanchor%,Length%+1) adjust% lit(designM%,2,(fields%>0)) present% `- $RecInfo%="No record design exists yet" I%=1 lit(designM%,I%, lit(designM%,5, get_winpos !formanchor%=0 g2 extend_named_sliding_block(formanchor%,0) Fptr%=!formanchor% i fields%=0:Fieldnumber%=0 l8 $RecInfo%="Record design exists, but no datafiles" first_writable>0 lit(designM%,3, lit(designM%,4, get_winpos s6 $RecInfo%="No primary key index file exists yet" "OS_File",5,$database%+".Database" ,,,,len% u- RA%=(len% Length%)-1:$Records%= (RA%) first_writable>0 get_winpos lit(mainM%,8, selected(passW%,13)) lit(mainM%,9, selected(passW%,13)) lit(mainM%,2, selected(passW%,14)) "OS_File",5,$database%+".Database" ,,,,len% |- RA%=(len% Length%)-1:$Records%= (RA%) (len% Length%)<>0 rectify open_index($database%+".PrimaryKey",0, $ key%=0:file%=0:top=8*file%+LH% # $Subfilename%=$Subfile%(key%) set_keydata(key%) Z keybase%=!keyanchor%(0): keybase%!4>0 $Increment%= (keybase%!4) $Increment%="0" , f$=$database%+".Indices":R4%=0:Keys%=0 R4%<>-1 Keys%+=1 5 "OS_GBPB",9,f$,block%,1,R4%,11 ,,K$,,R4% C R4%<>-1 open_index(f$+"."+K$,Keys%, colour(Keys%,2) Keys%-=1 extrakeys$<>"" softerror( extrakeys$),96) colour(0,1) get_tables key%=0 count(key%,RU%): update_stats get_winpos load_calcs auto_csv( selected(prefsW%,44)) limit_actions(Access%) addr= moveto(key%,top,1) "Hourglass_Off" $dbase%= $Title%,2) redraw_icon(-2,pbaseicon%) make_user_menus lib$=$database%+".Special" "OS_File",5,lib$ d%=1 library$ - "":library$=lib$: lib$: customise C lib$: Do nothing - required library is already installed 3 P%= library$,".Special"):P$= library$,P%-1) 7 softerror( leaf(P$)+","+ leaf($database%),134) " delete_icons(keypadW%,29) delete_icons(keypadW%,29) rectify REC%,I%,J%,F$ REC%=-1 *dbasehandle%= ($database%+".Database") REC%0 REC%+=1 #dbasehandle%=Length%*REC% F$= #dbasehandle% (F$)=0 softerror("",109) #dbasehandle%=REC%*Length% "Hourglass_On" I%=REC% ! #dbasehandle%=I%*Length% J%=1 fields% #dbasehandle%,"" > "Hourglass_Percentage",((I%-REC%)*100) (RA%-REC%) "Hourglass_Off" RA%+=1 #dbasehandle%=(RA%+1)*Length% close_file(dbasehandle%) val(keypadW%,17) $,5,6)="01 Apr" $,17,2)<"12" ! S$="Stoilet"+ $block%!32,8) S$="Sdelete"+ $block%!32,8) val(keypadW%,17)=S$ get_options(wi%,f$) F,S$,C$,P% 2 S$= #F:P%= S$," "):C$= S$,P%+1):S$= S$,P%-1) "Destination": + deselect(wi%, selected_esg(wi%,4)) $ "window": select(wi%,38) " "file": select(wi%,39) % "printer": select(wi%,41) "Headings": + deselect(wi%, selected_esg(wi%,1)) ; C$="descriptor" select(wi%,2) select(wi%,1) "Pitch": + deselect(wi%, selected_esg(wi%,2)) "5": select(wi%,4) "10": select(wi%,7) "12": select(wi%,8) "17": select(wi%,6) "Format": + deselect(wi%, selected_esg(wi%,3)) C$,6) # "horiz": select(wi%,23) " "vert": select(wi%,24) "column": / select(wi%,25):$ text(wi%,15)= C$,7) # "label": select(wi%,26) ( shade(wi%,15, selected(wi%,25)) < shade(wi%,43, selected(wi%,25) selected(wi%,23)) ( shade(wi%,45, selected(wi%,25)) . "Expand": set_icon(wi%,11,(C$="ON")) 1 "Underline": set_icon(wi%,29,(C$="ON")) 1 "Uppercase": set_icon(wi%,12,(C$="ON")) . "Header": set_icon(wi%,47,(C$="ON")) - "Page1": set_icon(wi%,10,(C$="ON")) . "Footer": set_icon(wi%,48,(C$="ON")) , "Date": set_icon(wi%,19,(C$="ON")) . "Shrink": set_icon(wi%,40,(C$="ON")) / "Control": set_icon(wi%,42,(C$="ON")) 2 "PageNumber": set_icon(wi%,54,(C$="ON")) ( "PageLength":$ text(wi%,16)=C$ ' "LineSpace":$ text(wi%,17)=C$ % "Lmargin":$ text(wi%,30)=C$ % "Tmargin":$ text(wi%,32)=C$ # "Title":$ text(wi%,18)=C$ ' "TextWidth":$ text(wi%,34)=C$ * "ColumnSpacer":$ text(wi%,43)=C$ ) "ColumnWidth":$ text(wi%,45)=C$ "LabelRowOf": 3 deselect(labelW%, selected_esg(labelW%,1)) select(labelW%, (C$)-1) + "LabelWidth":$ text(labelW%,4)=C$ , "LabelHeight":$ text(labelW%,6)=C$ , "LabelLines":$ text(labelW%,10)=C$ - "LabelCopies":$ text(labelW%,17)=C$ n "Substitute": C$,4)="SUBS" select(labelW%,11):$ text(labelW%,12)= C$,5) deselect(labelW%,11) 4 "PrintKey": set_icon(labelW%,13,(C$="ON")) 5 "SkipBlank": set_icon(labelW%,16,(C$="ON")) close_file(F) save_options(wi%,f$) selected_esg(wi%,4) 38:C$="window" 39:C$="file" 41:C$="printer" #F,"Destination "+C$ selected_esg(wi%,1) 1:C$="tag" 2:C$="descriptor" #F,"Headings "+C$ selected_esg(wi%,2) 4:C$="5" 7:C$="10" 8:C$="12" 6:C$="17" #F,"Pitch "+C$ selected_esg(wi%,3) 23:C$="horiz" 24:C$="vert" 25:C$="column"+$ text(wi%,15) 26:C$="label" #F,"Format "+C$ selected(wi%,11) C$="ON" C$="OFF" #F,"Expand "+C$ selected(wi%,29) C$="ON" C$="OFF" #F,"Underline "+C$ selected(wi%,12) C$="ON" C$="OFF" #F,"Uppercase "+C$ selected(wi%,47) C$="ON" C$="OFF" #F,"Header "+C$ selected(wi%,10) C$="ON" C$="OFF" #F,"Page1 "+C$ selected(wi%,48) C$="ON" C$="OFF" #F,"Footer "+C$ selected(wi%,19) C$="ON" C$="OFF" #F,"Date "+C$ selected(wi%,40) C$="ON" C$="OFF" #F,"Shrink "+C$ selected(wi%,42) C$="ON" C$="OFF" #F,"Control "+C$ selected(wi%,54) C$="ON" C$="OFF" #F,"PageNumber "+C$ #F,"PageLength "+$ text(wi%,16) #F,"LineSpace "+$ text(wi%,17) #F,"Lmargin "+$ text(wi%,30) #F,"Tmargin "+$ text(wi%,32) #F,"Title "+$ text(wi%,18) #F,"TextWidth "+$ text(wi%,34) #F,"ColumnSpacer "+$ text(wi%,43) #F,"ColumnWidth "+$ text(wi%,45) J$C$= selected_esg(labelW%,1)+1) #F,"LabelRowOf "+C$ #F,"LabelWidth "+$ text(labelW%,4) #F,"LabelHeight "+$ text(labelW%,6) #F,"LabelLines "+$ text(labelW%,10) #F,"LabelCopies "+$ text(labelW%,17) selected(labelW%,11) C$="SUBS"+$ text(labelW%,12) C$="OFF" #F,"Substitute "+C$ selected(labelW%,13) C$="ON" C$="OFF" #F,"PrintKey "+C$ selected(labelW%,16) C$="ON" C$="OFF" #F,"SkipBlank "+C$ close_file(F) "OS_File",18,f$,&7f5 get_preferences(wi%,f$) F,S$,C$,P% ^2 S$= #F:P%= S$," "):C$= S$,P%+1):S$= S$,P%-1) `& "DateSeparator":$datesep%=C$ a& "TimeSeparator":$timesep%=C$ "WildcardS":$wc%=C$ "WildcardM":$ws%=C$ d3 "Recalculate": set_icon(wi%,14,(C$="ON")) e> "NewCopy":kill%=(C$<>"ON"): set_icon(wi%,12, kill%) fS "CaseSpecific": set_icon(wi%,30,(C$="ON")): set_icon(queryW%,1,(C$="ON")) g3 "BlankRecord": set_icon(wi%,15,(C$="ON")) h6 "MoveDescriptor": set_icon(wi%,16,(C$="ON")) iA "ImpulseClient":$mergewith%=C$:$ImpulseApp%=$mergewith% j0 "Validate": set_icon(wi%,21,(C$="ON")) k2 "ShowLinked": set_icon(wi%,19,(C$="ON")) l/ "Warning": set_icon(wi%,20,(C$="ON")) "Autosave": n+ deselect(wi%, selected_esg(wi%,2)) C$,4) p- "OFF":autosave%=0:$Interval%="10" q0 "WARN":autosave%=1:$Interval%= C$,5) r0 "AUTO":autosave%=2:$Interval%= C$,5) s t! select(wi%,29-autosave%) u% shade(wi%,25,(autosave%<>0)) "Autobalance": C$,4) x- "OFF":autobalance%= :$Every%="25" y0 "AUTO":$Every%= C$,5):autobalance%= z {G set_icon(wi%,31,autobalance%): shade(wi%,32, selected(wi%,31)) |Y "Duplication": set_icon(wi%,34,C$="ON"): shade(prefsW%,34, selected(passW%,15)) }3 "DefaultAction": set_icon(wi%,41,C$="ON") ~2 "StripLeading": set_icon(wi%,47,C$="ON") 3 "StripTrailing": set_icon(wi%,42,C$="ON") 3 "RememberPlace": set_icon(wi%,43,C$="ON") - "AutoCSV": set_icon(wi%,44,C$="ON") $ "SaveStart":$StartHere%=C$ close_file(F) save_preferences(wi%,f$) F,C$ #F,"DateSeparator "+$datesep% #F,"TimeSeparator "+$timesep% #F,"WildcardS "+$wc% #F,"WildcardM "+$ws% #F,"ImpulseClient "+$mergewith% selected(wi%,12) C$="ON" C$="OFF" #F,"NewCopy "+C$ selected(wi%,30) C$="ON" C$="OFF" #F,"CaseSpecific "+C$ selected(wi%,14) C$="ON" C$="OFF" #F,"Recalculate "+C$ selected(wi%,15) C$="ON" C$="OFF" #F,"BlankRecord "+C$ selected(wi%,16) C$="ON" C$="OFF" #F,"MoveDescriptor "+C$ selected(wi%,21) C$="ON" C$="OFF" #F,"Validate "+C$ selected(wi%,19) C$="ON" C$="OFF" #F,"ShowLinked "+C$ selected(wi%,20) C$="ON" C$="OFF" #F,"Warning "+C$ autosave% 0:C$="OFF" 1:C$="WARN"+$Interval% 2:C$="AUTO"+$Interval% #F,"Autosave "+C$ autobalance% :C$="OFF" :C$="AUTO"+$Every% #F,"Autobalance "+C$ selected(prefsW%,34) C$="ON" C$="OFF" #F,"Duplication "+C$ selected(prefsW%,41) C$="ON" C$="OFF" #F,"DefaultAction "+C$ selected(prefsW%,47) C$="ON" C$="OFF" #F,"StripLeading "+C$ selected(prefsW%,42) C$="ON" C$="OFF" #F,"StripTrailing "+C$ selected(prefsW%,43) C$="ON" C$="OFF" #F,"RememberPlace "+C$ selected(prefsW%,44) C$="ON" C$="OFF" #F,"AutoCSV "+C$ C$=$StartHere% C$<>"" #F,"SaveStart "+C$ close_file(F) "OS_File",18,f$,&fff get_csv_options(f$) F,S$,C$,P% 2 S$= #F:P%= S$," "):C$= S$,P%+1):S$= S$,P%-1) "Separator": $Delim%="" ! "Comma":sep$=",":P%=0 "TAB":sep$= (9):P%=1 "CR":sep$= (13):P%=2 "LF":sep$= (10):P%=3 # $Delim%=C$:sep$=C$:P%=4 % tick_one(delimiterM%,0,3,P%) 2 $ text(csvW%,14)=C$: redraw_icon(csvW%,14) "Terminator": $Termin%="" ! "CR":term$= (13):P%=0 ! "LF":term$= (10):P%=1 * "CR LF":term$= (13)+ (10):P%=2 * "LF CR":term$= (10)+ (13):P%=3 * "CR CR":term$= (13)+ (13):P%=4 * "LF LF":term$= (10)+ (10):P%=5 & : $Termin%=C$:term$=C$:P%=6 & tick_one(terminatorM%,0,5,P%) 2 $ text(csvW%,15)=C$: redraw_icon(csvW%,15) - "Quotes": set_icon(csvW%,0,C$="ON") - "Header": set_icon(csvW%,1,C$="ON") - "Blanks": set_icon(csvW%,2,C$="ON") * "Key": set_icon(csvW%,3,C$="ON") - "RecNo": set_icon(csvW%,22,C$="ON") B "Data": set_icon(csvW%,4,(C$="ON" selected(csvW%,1))) / "Display": set_icon(csvW%,11,C$="ON") - "Strip": set_icon(csvW%,16,C$="ON") . "NewSeq": set_icon(csvW%,23,C$="ON") shade(csvW%,4,( selected(csvW%,1))) close_file(F) save_csv_options(f$) F,C$ selected(csvW%,0) C$="ON" C$="OFF" #F,"Quotes "+C$ selected(csvW%,1) C$="ON" C$="OFF" #F,"Header "+C$ selected(csvW%,2) C$="ON" C$="OFF" #F,"Blanks "+C$ selected(csvW%,3) C$="ON" C$="OFF" #F,"Key "+C$ selected(csvW%,22) C$="ON" C$="OFF" #F,"RecNo "+C$ selected(csvW%,4) C$="ON" C$="OFF" #F,"Data "+C$ sep$ ",":C$="Comma" (9):C$="TAB" (10):C$="LF" (13):C$="CR" :C$=sep$ #F,"Separator "+C$ term$ (13):C$="CR" (10):C$="LF" (13)+ (10):C$="CR LF" (10)+ (13):C$="LF CR" (13)+ (13):C$="CR CR" (10)+ (10):C$="LF LF" :C$=term$ #F,"Terminator "+C$ selected(csvW%,11) C$="ON" C$="OFF" #F,"Display "+C$ selected(csvW%,16) C$="ON" C$="OFF" #F,"Strip "+C$ selected(csvW%,23) C$="ON" C$="OFF" #F,"NewSeq "+C$ close_file(F) "OS_File",18,f$,&fff open_index(f$,key%,merge%) keybase%,I% key%>MaxKeys% merge% extrakeys$+= leaf(f$)+",":Keys%-=1: keyanchor%(key%) scrap_sliding_block(keyanchor%(key%)) "OS_File",5,f$ ,,,,len% create_named_sliding_block(keyanchor%(key%),len%) "OS_File",255,f$,!keyanchor%(key%) Index$(key%)= leaf(f$) keybase%=!keyanchor%(key%) key%=0 I%=0 % $Date%(I%)=$(keybase%+8+9*I%) KL%(key%)=keybase%?70 I%=0 %& KW%(key%,I%)=!(keybase%+74+I%*4) &+ KF%(key%,I%)=(KW%(key%,I%)>>24) (!case%(key%)=(keybase%?71=255) )%incspace%(key%)=(keybase%?72=255) *!null%(key%)=(keybase%?73=255) keybase%!62>0 ### Old key structure applies ### words%= I%=0 KW%(key%,I%)>0 0" KF%(key%,I%)=keybase%!62 1K KW%(key%,I%)=!(keybase%+74+I%*4)+((I%+1)<<16)+((keybase%!62)<<24) words%= 3 words% KF%(key%,0)=keybase%!62:KW%(key%,0)=KL%(key%)+((keybase%!62)<<24) keybase%!66>0 I%=1 KW%(key%,I%)>0 9$ KF%(key%,I%)=keybase%!66 :I KW%(key%,I%)=!(keybase%+74+I%*4)+(I%<<16)+((keybase%!66)<<24) get_tables lk,F%,d%,R4%,f$,name$,subst%,field%,exact% C$f$=$database%+".ValTables":R4%=0 close_file(lk): wimp_error( ($database%+".Link") lk>0 !block%=mainW% F%+=1 #lk,link$(F%) name$=link$(F%) M- field%= trailing_number(name$,exact%) name$,1)="@" chartype%(F%)=44 file$= name$,2) Q, "OS_File",5,file$ d%,,type% R# type%=(type%>>8) &fff S: $ val(mainW%,field%(F%))="R5;Sfile_"+ ~(type%) name$<>"" W) subst%= leading_number(name$) X, "OS_File",5,f$+"."+name$ d%=1 Z) load_table(f$+"."+name$, [8 set_icon_cols(mainW%,field%(F%),fcol%(8)) \$ softerror(name$,31) _ link$(0)="LOADED" close_file(lk) ### Force loading of unlinked but flagged tables ### R4%<>-1 "OS_GBPB",9,f$,block%,1,R4%,11 ,,name$,,R4% R4%<>-1 name$)="!" load_table(f$+"."+name$, extratabs$<>"" softerror( extratabs$),97) load_calcs I%,F%,F1%,P%,calc$,file%,top update$()="" ($database%+".Calc") cl>0 s+ F%+=1:F$= ~(F%): F%<16 F$="0"+F$ t" #cl,calc$:calc$(F%)=calc$ chartype%(F%) 6,7: x! P%= calc$,"$Rf%(",P%) y? P%>0 F1%= calc$,P%+5)):update$(F1%)+=F$:P%+=5 P%=0 | P%= calc$,"FNn(",P%) }? P%>0 F1%= calc$,P%+4)):update$(F1%)+=F$:P%+=4 P%=0 . calc$,"TIME$")>0 update$(0)+=F$ calc$(0)="LOADED" close_file(cl) selected(prefsW%,14) update$(0)<>"" , dbasehandle%= ($database%+".Database") "Hourglass_On" file%=0 top=8*file%+LH% ! P%= neighbour(key%,top,1) , scan_file("P%<>top",key%,file%,6,1) file% "Hourglass_Off" close_file(dbasehandle%) I%=1 fields% $Rf%(I%)=field$(I%) redraw(mainW%) get_form( Fptr%) F,L%,N%,I%,V%,x%,y%,xlim%,ylim%,text% design% dval%=hand%:func%=1 dval%=-1:func%=0 ($database%+".Form") F>0 #F,N% N%>127 fatal_err%, msg("Err98") 2 formlen%=&100:forminc%=formlen%:form_incs%=0 extend_named_sliding_block(formanchor%,formlen%) 9 Fptr%=!formanchor%:Rf%(0)=Fptr%:$Rf%(0)="":Fptr%+=1 Length%=0 I%=1 @ #F,Desc$,Tag$(I%),xd%,yd%,xf%,yf%,len%,char%,fix%,bbox% . char%>=128 hide%?I%=1 hide%?I%=0 char%=char% B hide%?I%=1:dflg%=(winback%<<28)+(winback%<<24)+&016711 2 Desc$="":dflg%=(winback%<<28)+&7016711 ) :dflg%=(winback%<<28)+&7016731 / bbox%=0 len%=0:width%=0:height%=0 0 bbox%=0:width%=len%*16+16:height%=48 @ bbox%<&10000 bbox%>0:width%=bbox%*16+16:height%=48 2 :width%=bbox% &FFFF:height%=bbox%>>16 design% char% 1 0,1,2,3,4,5,6,7,8,39,40:fval%=hand% " :fval%=hvalid%(char%) vtype$(char%) . "K":fval%= val(keypadW%,char%-9) "O": char%=44 # fval%=Fptr%:Fptr%+=16 ! $fval%="R5;Saction" # fval%=valid%(char%) ! :fval%=valid%(char%) " x%=xf%+width%+32:y%=yf%-16 x%>xlim% xlim%=x% y%formlen% * form_incs%+=1:formlen%+=forminc% ; extend_named_sliding_block(formanchor%,formlen%) $Fptr%=Desc$ S desc%(I%)= create_icon(mainW%,xd%,yd%,L%*16+8,44,dflg%,"",Fptr%,dval%,L%+1) - Fptr%+=L%+1:Rf%(I%)=Fptr%:$Rf%(I%)="" 0 icon_design(char%,func%,width%,height%) H char%=59 fval%=!logoanchor%:$Fptr%=Tag$(I%):len%= (Tag$(I%)) \ field%(I%)= create_icon(mainW%,xf%,yf%,width%,height%,iflags%,"",Fptr%,fval%,len%+1) char% j 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% 6 40:Rf%(I%)= create_anchor("Picture"+ (I%)) ? 3,6,46,47,54,56,57: icon_bit(9,mainW%,field%(I%), Fptr%+=len%+1 close_file(F) extend_named_sliding_block(formanchor%,Fptr%-!formanchor%):form_incs%+=1 numericfields%=0 setup_select(N%,numericfields%) N%=0 7!block%=0:block%!4=ylim%:block%!8=xlim%:block%!12=0 "Wimp_SetExtent",mainW%,block% Tag$(0)="REC" get_winpos F,x%,y%,w%,h%,xs%,ys% getscreensize(ScreenWidth%,ScreenHeight%,Vpix%) ($database%+".Winpos") present%<7 * w%=ScreenWidth%*2:h%=ScreenHeight%*2 x%=0:y%=0:xs%=0:ys%=0 4 !block%=0:block%!4=-h%:block%!8=w%:block%!12=0 "Wimp_SetExtent",mainW%,block% position_window(mainW%,x%,y%,w%,h%,xs%,ys%) F>0 #F,x%,y%,w%,h%,xs%,ys% 4 position_window(mainW%,x%,y%,w%,h%,xs%,ys%) open_window(mainW%) selected(passW%,9) F>0 ! #F,x%,y%,w%,h%,xs%,ys% 8 position_window(keypadW%,x%,y%,w%,h%,xs%,ys%) 5 position_window(keypadW%,100,50,0,0,0,0) close_file(F) save_winpos F,x%,y%,w%,h%,xs%,ys% ($database%+".Winpos") 3!block%=mainW%: "Wimp_GetWindowState",,block% Wx%=block%!4:y%=block%!8:w%=block%!12-x%:h%=block%!16-y%:xs%=block%!20:ys%=block%!24 #F,x%,y%,w%,h%,xs%,ys% 5!block%=keypadW%: "Wimp_GetWindowState",,block% Wx%=block%!4:y%=block%!8:w%=block%!12-x%:h%=block%!16-y%:xs%=block%!20:ys%=block%!24 #F,x%,y%,w%,h%,xs%,ys% close_file(F) position_window(wi%,x%,y%,w%,h%,xs%,ys%) "Wimp_GetCaretPosition",,block%:oldwin%=!block%:oldicon%=block%!4 getscreensize(ScreenWidth%,ScreenHeight%,Vpix%) 0!block%=wi%: "Wimp_GetWindowState",,block% w%=0 w%=block%!12-block%!4 h%=0 h%=block%!16-block%!8 0:x%=(ScreenWidth%-w%) -1:x%=block%!4 0: y%=(ScreenHeight%-h%) -1:y%=block%!8 block%!4=x%:block%!12=x%+w% block%!8=y%:block%!16=y%+h% block%!20=xs%:block%!24=ys% block%!28=-1 open_it(wi%) open_at( flag%,wi%,butt%,ww%,wh%,iw%,ih%) x%,y%,vxmin%,vymax%,scrollx%,scrolly% flag% $5 !block%=mainW%: "Wimp_GetWindowState",,block% %L vxmin%=block%!4:vymax%=block%!16:scrollx%=block%!20:scrolly%=block%!24 &Z !block%=mainW%:block%!4=field%(buttonfield%(0,butt%)): "Wimp_GetIconState",,block% '? x%=block%!16-scrollx%+vxmin%:y%=block%!20-scrolly%+vymax% (2 !block%=wi%: "Wimp_GetWindowState",,block% )6 block%!4=x%-(ww%+iw%) 2:block%!12=block%!4+ww% *6 block%!8=y%-(wh%+ih%) 2:block%!16=block%!8+wh% + block%!28=-1: open_it(wi%) flag%= open_window(wi%) setup_select(fields%, rows%) S$,I%,J%,Fptr% 3&selectlen%=&200:selinc%=selectlen% create_named_sliding_block(selanchor%,selectlen%) Fptr%=!selanchor% I%=1 fields% Fptr%-!selanchor%+144>selectlen% selectlen%+=selinc% 9: extend_named_sliding_block(selanchor%,selectlen%) chartype%(I%) 3,6,8,46,47,54,56,57: =" rows%+=1: lit(printM%,5, >V handle%= create_icon(pselectW%,8,-rows%*48-56,144,48,&17000531,"",Fptr%,-1,15) ?9 S$=$ text(mainW%,desc%(I%)): (S$)>8 S$,8) @$ $Fptr%=S$:Fptr%+= ($Fptr%)+1 AW handle%= create_icon(pselectW%,160,-rows%*48-56,80,48,&17000531,"",Fptr%,-1,15) B* $Fptr%=Tag$(I%):Fptr%+= ($Fptr%)+1 J%=0 Da handle%= create_icon(pselectW%,240+J%*88,-rows%*48-52,44,44,&0740B13B,"",Fptr%,tick%,1) $Fptr%="":Fptr%+=1 calcrow%?I%=rows% :calcrow%?I%=0 K#!block%=0:block%!4=-rows%*48-56 block%!8=740:block%!12=0 "Wimp_SetExtent",pselectW%,block% enable_row(R%,on%) R%>0 I%=R%*8+2 R%*8+7 T shade(pselectW%,I%,on%) U) on% deselect(pselectW%,I%) save_form(f$) F,I%,xd%,yd%,xf%,yf%,w%,h%,bbox%,type% fields%=0 Length%=0 !block%=mainW% #F,fields% I%=1 fields% chartype%(I%)=39 len%(I%)=0 c( dicon%=desc%(I%):ficon%=field%(I%) d4 block%!4=dicon%: "Wimp_GetIconState",,block% e xd%=block%!8:yd%=block%!12 Desc$=$(block%!28) g4 block%!4=ficon%: "Wimp_GetIconState",,block% h xf%=block%!8:yf%=block%!12 i2 w%=block%!16-block%!8:h%=block%!20-block%!12 bbox%=(h%<<16)+w% char%=chartype%(I%) hide%?I%=1 char%=char% #F,Desc$,Tag$(I%),xd%,yd%,xf%,yf%,len%(I%),char%,fix%(I%),bbox% Length%+=len%(I%)+1 oA field$(I%)="": Rf%(I%)>0 chartype%(I%)<>40 $Rf%(I%)="" close_file(F) "OS_File",18,f$,&7f2 lit(iconbarM%,3, make_empty_index(RA%,key%,Z%) I%,K%,P%,KLM%,S$ "Hourglass_On" KL%(key%),".") KLM%=KL%(key%)+13 P%=LH%+48+(RA%+1)*KLM% create_named_sliding_block(keyanchor%(key%),P%) keybase%=!keyanchor%(key%) keybase%!0=138 keybase%!4= ($Increment%) $date%= (1)): date(key%) keybase%!62=0:keybase%!66=0 keybase%?70=KL%(key%) Ckeybase%?71= selected(keyW%,30):case%(key%)= selected(keyW%,30) Gkeybase%?72= selected(keyW%,35):incspace%(key%)= selected(keyW%,35) Ckeybase%?73= selected(keyW%,37):null%(key%)= selected(keyW%,37) I%=0 ( !(keybase%+74+(I%*4))=KW%(key%,I%) I%=0 P%=I%*8+LH% !(keybase%+P%)=-P% !(keybase%+P%+4)=P% P%=!keybase% I%=0 RA%-1 "Hourglass_Percentage",(I%*100) !(keybase%+P%)=P%+KLM% !(keybase%+P%+4)=0 $(keybase%+P%+8)=S$ # !(keybase%+P%+KL%(key%)+9)=I% P%+=KLM% !(keybase%+P%)=0 !(keybase%+P%+4)=0 $(keybase%+P%+8)=S$ !(keybase%+P%+KL%(key%)+9)=0 "Hourglass_Off" save_recs(f$,RA%) dbasehandle%,I%,J%,rec$ rec$= fields%-1, (10)) "Hourglass_On" dbasehandle%= I%=0 #dbasehandle%=I%*Length% #dbasehandle%,rec$ "Hourglass_Percentage",(I%*100) #dbasehandle%=(RA%+1)*Length% close_file(dbasehandle%) "OS_File",18,f$,&7f2 "Hourglass_Off" move_records(key%,file%,top) REC%,target$,action$,dest%,ex%,ptr% target$=$Query% Search$= parse "Wimp_WhichIcon",moveW%,block%,&003F0000,&00210000 movetype%=!block%-1 movetype%<>2 target$="" target$=" all records from subfile "+ (file%) target$=" from subfile "+ (file%)+" when "+target$ movetype% -1:action$="Move "+target$ 0:action$="Delete"+target$ 1:action$="Move "+target$ 2:dest%= text(moveW%,6)) target$="" action$="Accumulate all records in subfile "+ (dest%) action$="Accumulate records in subfile "+ (dest%)+" when "+target$ confirm(action$) "Hourglass_On" *dbasehandle%= ($database%+".Database") earmark(movetype%=2,file%,top) close_file(dbasehandle%) ptr%=!tempanchor% REC%=0 RA%-1 6 ex%+=1: "Hourglass_Percentage",(ex%*100) movetype% file%=ptr%?REC% % dest%<>file% file%<>255 * read(fields%, ,REC%,$database%) key%=0 Keys% top=8*file%+LH% N$=key$(key%) ? delete(N$,key%):date%?file%=1:$Date%(file%)= today top=8*dest%+LH% ? insert(N$,key%):date%?dest%=1:$Date%(dest%)= today key% ptr%?REC%<>255 * read(fields%, ,REC%,$database%) ' addr= shift(movetype%,key%,0) REC% scrap_sliding_block(tempanchor%) "Hourglass_Off" export_subset(f$) I%,F,R%,recs%,ptr%,count%,subtotal%,blobs%,ex%,Z%,len%,source$,dest$,O$,REC% "OS_CLI","Copy "+$database%+".Form "+f$+".Form ~C~V" link$(0)="LOADED" "OS_CLI","Copy "+$database%+".Link "+f$+".Link ~C~V" calc$(0)="LOADED" "OS_CLI","Copy "+$database%+".Calc "+f$+".Calc ~C~V" "OS_CLI","Copy "+$database%+".ValTables "+f$+".Valtables ~C~VR" "OS_CLI","Copy "+$database%+".Cols "+f$+".Cols ~CF~V" "OS_File",5,$database%+".UserFuncs" d%=1 "OS_CLI","Copy "+$database%+".UserFuncs "+f$+".UserFuncs ~CF~V" "OS_File",5,$database%+".UsrSprites" d%=1 "OS_CLI","Copy "+$database%+".UsrSprites "+f$+".UsrSprites ~CF~V" "OS_CLI","Copy "+$database%+".!Run "+f$+".!Run ~CF~V" "Hourglass_On" "blobs%= find_blobs($database%) Search$= parse *dbasehandle%= ($database%+".Database") earmark( ,file%,top) (f$+".Database") ptr%=!tempanchor% %subtotal%= count_recs(key%,zero%) I%=0 RA%-1 ptr%?I%<>255 ex%=-1 ex%0 index$="Indices." index$="" "OS_File",10,f$+"."+index$+Index$(K%),&7f0,,keybase%,keybase%+filelength% scrap_sliding_block(keyanchor%(MaxKeys%+1)) close_file(F) close_file(dbasehandle%) "OS_File",18,f$+".Database",&7f2 export%= "Hourglass_Off" close_it(savesubW%) find_blobs(f$) N%,R4%,S$ N%=-1 R4%<>-1 "OS_GBPB",9,f$,block%,1,R4%,11 ,,S$,,R4% S$,4) !) "Memo":N%+=1:Ext%(N%)= S$,5)) ") "Draw":N%+=1:Ext%(N%)= S$,5)) #) "Spri":N%+=1:Ext%(N%)= S$,7)) earmark(all%,file%,top) I%,P% tempanchor% scrap_sliding_block(tempanchor%) create_named_sliding_block(tempanchor%,RA%) ptr%=!tempanchor% I%=0 RA%-1 ptr%?I%=255 "Hourglass_On" all% file%=0 top=8*file%+LH% 4! P%= neighbour(key%,top,1) 5, scan_file("P%<>top",key%,file%,2,1) file% P%= neighbour(key%,top,1) scan_file("P%<>top",key%,file%,2,1) "Hourglass_Off" rotate Access% confirm( msg("Err49"))= keybase% I%,L%,Z%,Q%,R%,S%,key% key%=0 Keys% D keybase%=!keyanchor%(key%) S%=LH%+40 Z%=keybase%!S% I%=S%-8 S%-40 H) L%=keybase%!I%:R%=keybase%!(I%+4) I= L%>0 keybase%!(I%+8)=L% keybase%!(I%+8)=-(I%+8) Z%>0 keybase%!(S%-40)=Z% keybase%!(S%-40)=-(S%-40) I%=S%-40 Q%=I%-8 Q%=S%-48 Q%=S% O! PR%= neighbour(key%,I%,0) P! SU%= neighbour(key%,I%,1) Q' PR%>S% keybase%!(PR%+4)=-I% R# SU%>S% keybase%!SU%=-I% key% $date%= asterisk( write_log(-1,"Subfiles rotated") create_index(key%) indexing% printing% Keys%=MaxKeys% softerror( (Keys%),95): file%,top,P%,KEY$,REC%,val$,zero%,abort%,replace%,J%,I% newkey%=0:f$="" J%=0 keyfield%(J%)>0 f$+=Tag$(keyfield%(J%))+"+" I%=0 bC keyfield%(J%)=KF%(0,I%) keyfield%(J%)>0 KF%(0,I%)>0 cF confirm( msg("Err100,"+Tag$(keyfield%(J%))))= abort%= d abort% f$)="+" (f$)>10 newkey%+=1 Index$(newkey%)=f$ newkey%>Keys% newkey%=key%: softerror(f$,106):abort%= newkey%<=Keys%: q) confirm( msg("Err50,"+f$))= r3 scrap_sliding_block(keyanchor%(newkey%)) replace%= abort%= u Keys%>MaxKeys%:Keys%-=1: softerror( (Keys%),95):abort%= :Keys%=newkey% abort% copy_keydata(newkey%) Index$(newkey%)=f$ |-f$=$database%+".Indices."+Index$(newkey%) make_empty_index(RA%,newkey%, lit(iconbarM%,2, limit_actions( abort_index(f$): *dbasehandle%= ($database%+".Database") indexing%= :Search$="TRUE" update_stats "Hourglass_On" file%=0 top=file%*8+LH% P%= neighbour(key%,top,1) val$= type(newkey%) "Hourglass_On" scan_file("P%<>top",key%,file%,4,1) file% "Hourglass_Off" end_index colour(newkey%,2) asterisk( write_log(-1,"Index "+Index$(newkey%)+" created") abort_index(f$) end_index replace% open_index(f$,newkey%, index%=newkey% Keys% ) Index$(newkey%)=Index$(newkey%+1) index% scrap_sliding_block(keyanchor%(newkey%)) Keys%-=1 newkey%=0 softerror("",43) wimp_error( end_index "Hourglass_Smash" indexing%= limit_actions(Access%) "Wimp_CreateMenu",,-1 lit(iconbarM%,2,Modify%) close_file(dbasehandle%) shift(t%,k%,m%) a%,key%,fi%,I%,F$,action$,finished% Access% =addr REC%=RA% =addr t%=0 m%=1 confirm( msg("Err51"))= =addr key%=0 Keys% N$=key$(key%) delete(N$,key%) N$="*Failed*" =addr key%=k% next_match(addr,1,Filter$,finished%) t%=1 fi%=(file%+1) t%=-1 fi%=(file%-1-6*(file%=0)) top=8*fi%+LH% I%=1 fields% V%=chartype%(I%) 36,39: R blob_path( ,$database%,REC%,I%,V%,F$)>=0 "OS_CLI","Delete "+F$ 9,37: R blob_path( ,$database%,REC%,I%,V%,F$)>=0 "OS_CLI","Delete "+F$ R blob_path( ,$database%,REC%,I%,V%,F$)>=0 "OS_CLI","Delete "+F$ 7 insert(N$,key%):date%?fi%=1:$Date%(fi%)= today top=8*file%+LH% date%?file%=1 $Date%(file%)= today key% selected(prefsW%,15) ' read(fields%, ,RA%,$database%) $ write_dbase(REC%,fields%, & action$=" Deleted and blanked" action$=" Deleted" :action$=" ===> subfile "+ (fi%) asterisk( write_log(REC%,logentry$+action$) type(key%) F%,V$ key%>=0 F%=KF%(key%,0) F%=-key% chartype%(F%) 3,6,46,47,54,56,57:V$="VAL" confirm(string$) !block%=255 $(block%+4)=string$+ "Wimp_ReportError",block%,19,"Powerbase"+ ,result% =result%=1 getscreensize( S_Width%, S_Height%, Vpix%) H1%,V1%,H2%,V2%,End% $H1%=0:V1%=4:H2%=8:V2%=12:End%=16 9Mi%!H1%=4:Mi%!V1%=5:Mi%!H2%=11:Mi%!V2%=12:Mi%!End%=-1 "OS_ReadVduVariables",Mi%,Mo% )S_Width%=(1<<(Mo%!H1%))*((Mo%!H2%)+1) *S_Height%=(1<<(Mo%!V1%))*((Mo%!V2%)+1) Vpix%=Mo%!V2%+1 match(X%,Y%) check_change $Query%="" redraw_icon(queryW%,0) shade(matchW%,7,printorder$<>"") position_window(matchW%,X%,Y%,0,0,0,0) set_caret(queryW%,0) text(helpW%,0)=Tag$(Match_tag%) tick_one(fieldmenu%,0,fields%-1,Match_tag%-1) redraw_icon(helpW%,0) text(matchW%,1)="": redraw_icon(matchW%,1) matching%= List printing ----------------------------------------------------- print_this %f$=$database%+".PrintRes.Default" "OS_File",5,f$ d%,,type% d%=1 type%=&7f3 load_selection(f$) !old%= selected_esg(printW%,3) deselect(printW%,old%) select(printW%,24) mouse(0,0,4,matchW%,2) clear_selection deselect(printW%,24) select(printW%,old%) do_it(Search$,displayed%) printing% zero%,P%,rec%,REC%,copy% Sum() Sum(numericfields%,5) sorted%= lit(listM%,1, Form$=printorder$ Form$="" W%=0 F%=KF%(0,W%) F%>0 !D F$= ~(F%): (F$)=1 F$="0"+F$: Form$,F$)=0 Form$+=F$ selected(matchW%,3) select(mainW%,field%(F%)):printorder$=Form$: lit(printM%,6, lit(printM%,7, lit(mainM%,7, selected(passW%,13)) # &#Heading$="":Hlongest%=0:Sum()=0 numericfields%>0 I%=1 numericfields% Sum(I%,5)=10^30 ,+Count%=0:examined%=0:printed%=0:sums%=0 read_print_options selected(printW%,40) find_max_lengths(displayed%) maxlen%()=len%() LenLine%= include_fields 0,numfirst%= margin_warn: numfirst%<0 list_head(0) "Wimp_GetPointerInfo",,block% limit_actions( lit(iconbarM%,2,0) printing%= "OS_ReadMonotonicTime" stime% abort_printing: 8*dbasehandle%= ($database%+".Database") "Hourglass_On" displayed%>=0: readsmarray(dbasehandle%,displayed%) format$="label" copy%=1 labcopies% ?( print_record(displayed%,addr) copy% A( print_record(displayed%,addr) usekey%=-1: D# direc%= selected(queryW%,4)+1 EN P%= neighbour(key%,top,direc%): scan_file("P%<>top",key%,file%,1,direc%) kl%= (useval$) H# P%= search(useval$,usekey%,1) P%>=0 k$=useval$: scan_file("P%<>top AND LEFT$(k$,kl%)=useval$",usekey%,file%,1,1) end_printing abort_printing end_printing softerror("",29) wimp_error( end_printing time% format$="label" thislab%>0 print_labels "OS_ReadMonotonicTime" etime% time%=etime%-stime% selected(matchW%,3) text(matchW%,1)= (printed%)+" found" text(matchW%,1)= (time% 100)+"."+ (time% 100)+" sec" redraw_icon(matchW%,1) "Hourglass_Smash" format$<>"label" displayed%=-1 total_list: page_number reportdest$ "Window": selected(matchW%,3) screen_list extend_named_sliding_block(textanchor%,Count%*LenLine%) "File": close_file(texthandle%): "OS_File",18,f$,&fff close_window(saveW%) "Printer": hB Start%=!textanchor%:End%=Start%+Count%*LenLine%+1:Type%=&fff i) $Start%=pitch$:?(End%-1)=0:?End%=12 j; block%!0=256:block%!12=0:block%!16=&80142:block%!20=0 kD block%!24=0:block%!28=0:block%!32=0:block%!36=0:block%!40=&fff $(block%+44)="List" "Wimp_SendMessage",18,block%,0 printing%= :savetofile%= lit(iconbarM%,2,Modify%) limit_actions(Access%) close_file(dbasehandle%) write_log(-1,"List printed: "+query$) find_max_lengths(displayed%) P%,k$ end_find_max: maxlen%()=0 {*dbasehandle%= ($database%+".Database") "Hourglass_On" "Hourglass_LEDs",%11 displayed%>=0: readsmarray(dbasehandle%,displayed%) get_lengths usekey%=-1: D P%= neighbour(key%,top,1): scan_file("P%<>top",key%,file%,0,1) kl%= (useval$) # P%= search(useval$,usekey%,1) P%>=0 k$=useval$: scan_file("P%<>top AND LEFT$(k$,kl%)=useval$",usekey%,file%,0,1) "Hourglass_LEDs",%00 "Hourglass_Off" close_file(dbasehandle%) get_lengths I%,L%,F%,l%,Len%,F$,SF$ I%=-1:L%= (Form$)-1 I%maxlen%(F%) maxlen%(F%)=l% end_find_max "Hourglass_Smash" close_file(dbasehandle%) maxlen%()=len%() softerror("",70) wimp_error( print_record(REC%,address%) I%,F%,N%,Z%,F$,SF$,Tab%,n$,y$,base%,pos% format$<>"label" printed%+=1 selected(matchW%,3) -thisrow%=-1:base%=!lineanchor%:pos%=base% heap_store(lineanchor%,LenLine%,0,pos%,0,margin$) I%=1 (Form$)-1 F%= fnum( Form$,I%,2)) format$="label" newline%= newline% N%+=1 * 0:F$= (REC%):F$= (F$)," ")+F$ 3 MaxFields%+1:Z%= rec_no(F$,key%,address%) ! selected(printW%,11) / F$= expand(F$(F%),link$(F%),Len%,SF$) # F$=F$(F%):Len%=len%(F%)+2 chartype%(F%) 41,42,43,44,45: Z%= no_yes(F%,n$,y$) " F$=" " F$=y$ F$=n$ ! 3,6,8,46,47,54,56,57: - sums(F$,calcrow%?F%,chartype%(F%)) format$="vert" & F$= len%(F%)- (F$)," ")+F$ % justify(F$,N%,N%-1) selected(printW%,12) u(F$) chartype%(F%) 37:F$="" 38:F$="" format$ "horiz","table": > heap_store(lineanchor%,LenLine%,0,pos%,0, tab(F$,N%)) "vert": R selected(printW%,2) Head$=$ text(mainW%,(desc%(F%))) Head$=Tag$(F%) 8 Head$=margin$+ Tab%(1)- (Head$)," ")+Head$+" : " @ hdlen%= (Head$):H$= hdlen%," "):datlen%= (F$):pos%=base% chartype%(F%) / 36,39: print_memo(REC%,F%,Head$,F$) : heap_store(lineanchor%,LenLine%,0,pos%,0,Head$) % hdlen%+datlen%L% p%=1:q%=1 p%= F$," ",q%) " p%<=L% q%=p%+1 p%>L% % s$= F$,q%-2):F$= F$,q%) # first% s$=H$+s$ ; heap_store(lineanchor%,LenLine%,0,pos%,0,s$) : list_line(REC%,lineanchor%,hdlen%+ (s$),32) ! pos%=base%:first%= pos%=base%: < heap_store(lineanchor%,LenLine%,0,pos%,0,H$+F$) 8 list_line(REC%,lineanchor%,hdlen%+ (F$),32) # extra_lines(linefeed%-1,0) "label": newline% n (F$<>"" selected(labelW%,16)= thisrow%<=labrepl% thisrow%+=1:Label$(thisrow%,thislab%)=F$ / Label$(thisrow%,thislab%)+=spacer$+F$ format$ "horiz": list_line(REC%,lineanchor%,pos%-base%,32) extra_lines(linefeed%-1,0) "vert": rule_off(45) "table": colpos%=pos%-base% heap_store(lineanchor%,LenLine%,0,pos%,0,column$) list_line(REC%,lineanchor%,pos%-base%,32) extra_lines(linefeed%-1,colpos%) "label": , Label$(labrepl%+1,thislab%)= key2(0,1) 3 thislab%+=1: thislab%>labup% print_labels format$<>"label" (printed% LinesPerPage%)=0 selected(printW%,10)= displayed%=-1 page_number N $(!lineanchor%)=margin$+ (12): list_line(-1,lineanchor%,Lmargin%+1,32) T list_head(1): lit(listM%,1, selected(printW%,10) selected(printW%,47)) page_number page%>0 rule_off(32) $ line$=margin$+"Page "+ (page%) B $(!lineanchor%)=line$: list_line(-1,lineanchor%, (line$),32) page%+=1 extra_lines(ex%,tab%) base%,pos% ex%>0 tab% rule_off(32) % base%=!lineanchor%:pos%=base% I%=0 tab%-1 pos%?I%=32 pos%+=tab% : heap_store(lineanchor%,LenLine%,0,pos%,0,column$) !2 list_line(REC%,lineanchor%,pos%-base%,32) ex%-=1 print_memo(R%,F%,margin$,F$) text%,B%,F$,sp%,L%,rem$,base%,pos%,Line$,first% blob_path( ,$database%,R%,F%,36,F$)>=0 *! base%=!lineanchor%:first%= text%= #text% -& Line$=margin$+rem$:L%= (Line$) . B%= #text% Line$+= (B%):L%+=1 B%=32 sp%=L% 2) B%=10 L%=LenLine%-3 #text% 4' B%=10:rem$="":Line$= Line$) #text%:rem$="" 62 :rem$= Line$,sp%+1):Line$= Line$,sp%-1) 7 pos%=base% 98 heap_store(lineanchor%,LenLine%,0,pos%,0,Line$) :0 list_line(REC%,lineanchor%, (Line$),32) ;4 first% margin$= (margin$)," "):first%= close_file(text%) inmemo(F%,s$) len%,found%,line$,base%,ptr%,case% C*len%= load_blob($database%,REC%,F%,36) len%>0 E case%= selected(queryW%,1) F base%=!tempanchor%:ptr%=-1 line$="" I J& ptr%+=1:line$+= (base%?ptr%) K" (line$)>250 ptr%=len% L# case% line$= u(line$) M! line$,s$)>0 found%= ptr%=len% =found% wc(f$,t$) failed%,P%,Q%,F%,end%,c$,x$ P%+=1 c$= t$,P%,1) X( "":end%=(Q%=F%):failed%= end% $wc%: P%+=1:Q%+=1 c$= t$,P%,1) c$<>$wc% P%-=1 $ws%: R%=P%+1 P%+=1 c$= t$,P%,1) b# c$=$ws% c$=$wc% c$="" "":end%= e- s$= t$,R%):failed%=( (s$))<>s$) $wc%,$ws%: g7 s$= t$,R%,P%-R%):Q%= f$,s$,Q%):failed%=(Q%=0) h9 Q%+= (s$)-1:P%-=1: failed% failed%=(Q%=F%) i Q%+=1:x$= f$,Q%,1) failed%=(c$<>x$) end% failed% failed% print_labels I%,Line$,S$,linesprinted%,pos% fixed_line($ text(labelW%,24)) I%=0 labrepl%-1 Line$=margin$ K%=0 thislab%-1 S$=Label$(I%,K%) x! selected(labelW%,11) y9 I%=labsubst% S$="" S$=Label$(labrepl%,K%) z {9 K%=thislab%-1 W%=longestfield% W%=labwidth% (S$)>W% S$,W%) } Line$+=S$+ (S$)," ") pos%=!lineanchor% heap_store(lineanchor%,LenLine%,0,pos%,0,Line$) list_line(REC%,lineanchor%, (Line$),32) linesprinted%+=1 fixed_line($ text(labelW%,25)) selected(labelW%,13) rule_off(32) Line$=margin$ K%=0 thislab%-1 ( S$="("+Label$(labrepl%+1,K%)+")" 1 K%=thislab%-1 (S$) W%=labwidth% Line$+=S$+ (S$)," ") pos%=!lineanchor% heap_store(lineanchor%,LenLine%,0,pos%,0,Line$) list_line(REC%,lineanchor%, (Line$),32) linesprinted%+=1 rows_printed%+=1 rows_printed%=labrows% L $(!lineanchor%)=margin$+ (12): list_line(-1,lineanchor%,Lmargin%+1,32) list_head(1) rows_printed%=0 linesprinted%"" Line$=margin$ K%=0 thislab%-1 9 K%=thislab%-1 W%=longestfield% W%=labwidth% (S$)>W% S$,W%) Line$+=S$+ (S$)," ") pos%=!lineanchor% heap_store(lineanchor%,LenLine%,0,pos%,0,Line$) list_line(REC%,lineanchor%, (Line$),32) linesprinted%+=1 read_print_options thislab%=0:LinesPerPage%=0 usekey%=-1 S$=Index$(key%) S$=Index$(usekey%)+" index" Title1$="Ordered by "+S$ selected(printW%,19) Title1$+=" ("+ $+")" Title2$=$ text(printW%,18) selected_esg(printW%,2) 4:cpi%=5:p$="3" 7:cpi%=10:p$="0" 8:cpi%=12:p$="1" 6:cpi%=17:p$="2" pitch$= pitch(p$) 3Lmargin%= text(printW%,30)):Tab%(0)=Lmargin% margin$= Lmargin%," ") "Tmargin%= text(printW%,32)) #TextLine%= text(printW%,34)) #linefeed%= text(printW%,17)) #colwidth%= text(printW%,45)) *s$=$ text(printW%,43):s%= (s$):c$= s%=0:spacer$=s$ c$<"0" c$>"9":spacer$= s%,c$) :spacer$= s%," ") linefeed%=0 linefeed%=1:$ text(printW%,17)= (linefeed%) %pagelength%= text(printW%,16)) pagelength%=0 pagelength%=70:$ text(printW%,16)= (pagelength%) selected_esg(printW%,3) format$="horiz" 9 LinesPerPage%=(pagelength%-Tmargin%-15) linefeed% 24:format$="vert" Form$<>"" LinesPerPage%=(pagelength%-Tmargin%-15) (linefeed%*( (Form$) format$="table" $ columns%= text(printW%,15)) 0 column$= columns%,"|"+ colwidth%," "))+"|" 9 LinesPerPage%=(pagelength%-Tmargin%-15) linefeed% format$="label" ) labwidth%= text(labelW%,4))*cpi% & labdepth%= text(labelW%,6))*6 1 labrows%=(pagelength%-Tmargin%) labdepth% rows_printed%=0 D labup%= selected_esg(labelW%,1): ### Value is 0,1,2 or 26 ### labup%=26 labup%=3 $ labrepl%= text(labelW%,10)) ' labsubst%= text(labelW%,12))-1 & labcopies%= text(labelW%,17)) % Title$="":Title1$="":Title2$="" selected_esg(printW%,4) 38:reportdest$="Window" 39:reportdest$="File" 41:reportdest$="Printer" selected(printW%,54) page%=1:LinesPerPage%-=2 page%=0 LinesPerPage%<=0 LinesPerPage%=1 pitch(p$) selected(printW%,42) (31)+"9"+p$+"01" list_head(place%) place%=0 reportdest$ "Window","Printer": RU%= ($used%) O RU%<5 textblocksize%=5*LenLine% textblocksize%=(RU% 5)*LenLine% $ textblockinc%=textblocksize% ? extend_named_sliding_block(textanchor%,textblocksize%) TextPtr%=!textanchor% recblocksize%=400 = extend_named_sliding_block(recanchor%,recblocksize%) % "File": #texthandle%,pitch$ extra_lines(Tmargin%,0) selected(printW%,47) header_lines%=Count%: displayed%=-1 send_title(Title$) send_title(Title1$) send_title(Title2$) format$ "horiz": selected(printW%,29) V selected(printW%,42) $(!lineanchor%)=uon$: list_line(-1,lineanchor%,2,32) . list_line(-1,headanchor%,LenLine%,32) rule_off(45) . list_line(-1,headanchor%,LenLine%,32) rule_off(45) "table": rule_off(32):$(TextPtr%-3)=uon$ rule_off(32) list_line(-1,headanchor%,LenLine%,32) rule_off(32) "vert": rule_off(45) header_lines%=Count% list_line(REC%,anchor%,length%,char%) Count%+=1 reportdest$ "Window","Printer": pad_line(LenLine%-length%-1,char%) heap_store(textanchor%,textblocksize%,textblockinc%,TextPtr%,LenLine%,"") "Wimp_TransferBlock",mytask%,!anchor%,mytask%,TextPtr%,LenLine% Count%*4>=recblocksize% recblocksize%+=400 $= extend_named_sliding_block(recanchor%,recblocksize%) &" !(!recanchor%+Count%*4)=REC% TextPtr%+=LenLine% "File": pad_line(LenLine%-length%-1,char%) "OS_GBPB",2,texthandle%,!anchor%,LenLine% pad_line(bytes%,char%) base%,ptr%,I% 1/base%=!anchor%:ptr%=base%+LenLine%-bytes%-1 bytes%>0 I%=0 bytes%-2 ptr%?I%=char% ptr%?(bytes%-1)=32 ptr%?bytes%=10 rule_off(char%) base% base%=!lineanchor% $base%=margin$ list_line(-1,lineanchor%,Lmargin%,char%) total_list selected(printW%,48) C%,L%,base%,pos%,L$ E#L$=margin$+"Total "+ (printed%) F!base%=!lineanchor%:pos%=base% format$ "horiz": selected(printW%,29) rule_off(45) ctotals(numfirst%) (L$)>LenLine%-2 L$=margin$+ (printed%) heap_store(lineanchor%,LenLine%,0,pos%,0,L$) list_line(REC%,lineanchor%,pos%-base%,32) selected(printW%,29) rule_off(45) "table": rule_off(32) extra_lines(linefeed%,colpos%) ctotals(numfirst%) (L$)>LenLine%-2 L$=margin$+ (printed%) heap_store(lineanchor%,LenLine%,0,pos%,0,L$) list_line(REC%,lineanchor%,pos%-base%,32) selected(printW%,29) rule_off(45) "vert": (L$)>LenLine%-2 L$=margin$+ (printed%) heap_store(lineanchor%,LenLine%,0,pos%,0,L$) list_line(REC%,lineanchor%,pos%-base%,32) selected(printW%,29) rule_off(45) lit(printM%,6, send_title(T$) C$,L$,P%,L% T$="" L%=LenLine%-Lmargin%-1 (T$)>=L% P%= P%-=1:C$= T$,P%,1) "= ,.;:",C$)>0 P%ind%=!textanchor%+LenLine%*header_lines%+Tab%(N%)-LenLine% I%=0 printed%-1 ind%+=LenLine% block%!(I%*4)=ind% "OS_HeapSort",printed%,block%,4 extend_named_sliding_block(tempanchor%,printed%*LenLine%) 3dest%=!tempanchor%-LenLine%:recptr%=!recanchor% I%=0 printed%-1 recptr%!(I%*4)=-1 ( ind%=block%!(I%*4):dest%+=LenLine% "Wimp_TransferBlock",mytask%,ind%-Tab%(N%),mytask%,dest%,LenLine% "Wimp_TransferBlock",mytask%,!tempanchor%,mytask%,!textanchor%+LenLine%*header_lines%,printed%*LenLine% scrap_sliding_block(tempanchor%) redraw(listW%) sorted%= lose_list close_window(listW%) scrap_sliding_block(textanchor%) scrap_sliding_block(recanchor%) Listed%= parse 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% !S$=$Query%: S$="" S$="ALL" (query$=S$:case%= selected(queryW%,1) usekey%=-1:useval$="" stripspaces(S$) S$="" u(S$)="ALL" Title$= leaf($database%),2)+". All records":="TRUE" simple%= simple(S$) S$+=" ":Title$="" (S$)>0 W$= word(S$," ") W$="NOT" S$,1)<>"(" moan_err%, msg("Err60") strip_brackets (W$)>0 * flag%= :TitFd$="":TitTg$="":op$="" 5 "AND","OR","NOT":E$=W$:Title$+=" "+E$+" " + "&":E$="AND":Title$+=" "+E$+" " E$="" split (field$)>0 0 f$= word(field$,",")):f1%=0:f2%=0 < f$="@":f1%=1:f2%=fields%:TitFd$="Any field " f$,"-")>0: P%= f$,"-") % f1%= field( f$,P%-1), ! TitFd$= TitFd$)+"-" % f2%= field( f$,P%+1), $ f1%>f2% f1%,f2% f1%= field(f$, ! f$="F$("+ (f1%)+")" * case% f$="FNu("+f$+")" 5 val% instring% f$="VAL("+f$+")" ! chartype%(f1%) 5 5,51,52:f$="FNreverse_date("+f$+")" targ$=target$ (targ$)>0 ' t$= word(targ$,","):u$=t$ C flag% TitTg$+= expand(t$,link$(f1%),L%,SF$)+"," ! chartype%(f1%) 0 41,42,43,44,45:t$= pos_neg(t$) Z 5,51,52: check_date(key%,t$,2,date$)= reverse_date(date$):u$=t$ E t$=""""+t$+"""": val% instring% t$="VAL("+t$+")" f2%>0 val% T E1$="FNvany("+ (f1%)+","+ (f2%)+","+t$+","""+op$+""","""+bo$+""")" U E1$="FNany("+ (f1%)+","+ (f2%)+","+t$+","""+op$+""","""+bo$+""")" 6 E1$= element(op$,f1%,chartype%(f1%)) E (E$)+ (E1$)>255 moan_err%, msg("Err6") E$+=E1$ E (E$)+ (bo$)>255 moan_err%, msg("Err6") E$+=bo$ flag%= E$= (E$)- (bo$)) E$,bo$)>0 B (E$)>253 moan_err%, msg("Err6") E$="("+E$+")" add_brackets E$+=" " (search$)+ (E$)>255 moan_err%, msg("Err6") search$+=E$ build_title ,Title$= leaf($database%),2)+". "+Title$ usekey%>=0 kl%=KL%(usekey%):val$= type(usekey%) =search$ pos_neg(s$) "+","y","Y","*"," ","T","t","YES","Yes","yes","TRUE","True":s$=" " "-","n","N","x","X","F","f","NO","No","no","FALSE","False":s$="" :s$="@" simple(S$) S$,"=")>0 S$,",")=0 S$,"-")=0 S$,"OR")=0 S$,"NOT")=0) word( S$,sep$) P%,W$,Q1%,Q2% ' Q1%= S$,""""):Q2%= S$,"""",Q1%+1) P%= S$,sep$,P%) - (P%>Q1% P%Q2% Q2%>0): 5 S$= S$,Q1%-1)+ S$,Q1%+1,Q2%-Q1%-1)+ S$,Q2%+1) 9 P%=Q2%-1: ### S$ is now 2 characters shorter ### ) Q1%>0 Q2%=0: softerror("",93) S$= S$,Q1%-1)+ S$,Q1%+1) Q1%+Q2%=0 P%0" "}{": char% 6 36,39:E$="FNinmemo("+ (f%)+","+t$+")=FALSE " % :E$="INSTR("+f$+","+t$+")=0" "=": E$=f$+op$+t$ simple%= usekey%=-1 foundkey%= is_a_key(f%) $4 foundkey%>=0 KL%(foundkey%)=len%(f%) %& usekey%=foundkey%:useval$=u$ & "$":E$="FNwc("+f$+","+t$+")=TRUE " ":E$="FNwc("+f$+","+t$+")=FALSE " :E$=f$+op$+t$ vany(from%,to%,t%,op$,bo$) F%,found%,v%,bo% bo%=(bo$="OR") F%=from%-1 F%+=1:v%= (F$(F%)) op$ "=":found%=(v%=t%) "<>":found%=(v%<>t%) "<":found%=(v%":found%=(v%>t%) "<=":found%=(v%<=t%) ">=":found%=(v%>=t%) (bo%=found%) F%=to% =found% any(from%,to%,t$,op$,bo$) F%,found%,f$,bo%,case% case%= selected(queryW%,1) bo%=(bo$="OR") F%=from%-1 F%+=1:f$=F$(F%) case% u(f$) op$ "{": chartype%(F%) 36,39: found%= inmemo(F%,t$) :found%=( f$,t$)>0) M "}{": chartype%(F%) 36,39: Q# found%=( inmemo(F%,t$)) :found%=( f$,t$)=0) S "=":found%=(f$=t$) "<>":found%=(f$<>t$) "<":found%=(f$":found%=(f$>t$) "<=":found%=(f$<=t$) ">=":found%=(f$>=t$) (bo%=found%) F%=to% =found% split X$,Q%,I%,t$ `8X$=">=>=,<=<=,<>,}{,>=,<=,==,>>,<<,{{,=,<,>,{,":P%=0 (X$)>0 P%=0 b8 Q%= X$,","):op$= X$,Q%-1):X$= X$,Q%+1):P%= W$,op$) P%>0 field$= W$,P%-1) f target$= W$,P%+ (op$))+"," case% target$= u(target$) field$+="," op$ "<>","}{":bo$="AND" kD op$="<>" target$,$wc%)>0 target$,$ws%)>0) op$=" "<=",">=":bo$="OR" "<=<=",">=>=": op$= op$,2):bo$="AND" "==","<<",">>","{{": op$= op$,1):bo$="AND" :bo$="OR" rC op$="=" target$,$wc%)>0 target$,$ws%)>0) op$="$" moan_err%, msg("Err40") instring%= "}{,{{,{",op$)>0 fnum(S$) S$="KK" =MaxFields%+1 ("&"+S$) newline%=((N% 128)>0) =(N% 127) field(f$,Z%) I%,F%,desc$ val%= f$,1)="[" f$)="]" f$),2):val%= I%0 $ desc$=$ text(mainW%,desc%(F%)) desc$<>"" TitFd$+=desc$+"," TitFd$+=f$+"," moan_err%, msg("Err8,"+f$) chartype%(F%) 3,6,46,47,54,56,57:val%= find_fields(S$,sep$, length%) f$,F$,C$,P%,Q%,F% Q%=1:length%=0 P%= S$,sep$,Q%) P%>0 S$,Q%,P%-Q%) F%= field(f$, length%+=len%(F%)+1 F$= ~(F%) (F$)=1 F$="0"+F$ C$+=F$ Q%=P%+1 length%+= (RA%))+1 strip_brackets W$,1)="(" left%+=1:W$= W$,2) W$)=")" right%+=1:W$= add_brackets left%>0 E$="("+E$:left%-=1 right%>0 E$+=")":right%-=1 build_title change% #TitFd$= TitFd$):TitTg$= TitTg$) TitFd$,",")>0 TitFd$,"-")>0 bo$ & "OR":TitFd$="One of:"+TitFd$ "AND": op$ ; "<>":TitFd$="None of:"+TitFd$:op$="=":change%= ; "}{":TitFd$="None of:"+TitFd$:op$="{":change%= # :TitFd$="All of:"+TitFd$ TitTg$,",")>0 bo$ & "OR":TitTg$="one of:"+TitTg$ "AND": op$ 1 "<>":TitTg$="none of:"+TitTg$:op$="=" 1 "}{":TitTg$="none of:"+TitTg$:op$="{" ' ":TitTg$="any of:"+TitTg$ I change% TitTg$="any of:"+TitTg$ TitTg$="all of:"+TitTg$ op$ "{":op$=" contains " "}{":op$=" does not contain " "$":op$=" has wild-card match with " ":op$=" does not have wild-card match with ": Title$+=TitFd$+op$+TitTg$ expand(string$,table$, ExpLen%, subst$) p$,s$,start%,F%,I%,T%,ind%,row%,Rec%,Rows%,TabFields%,field%,subst%,exact%,pos% subst$=string$ table$="" ExpLen%=0:=string$: ### Not linked ### *field%= trailing_number(table$,exact%) "subst%= leading_number(table$) ### field% is the linked field, subst% (if >=0) is the one to substitute on entry ### table_number(table$) T%<0 ExpLen%=0:=string$: ### Table not found ### p$=printrel$(T%) `NewTab%=( table_info(T%,Rows%,TabFields%,Rec%,tabfieldlen%(),offset%,heading%,colours$)=" *extra%=-NewTab%*(Rows%*(TabFields%+1)) subst%>=0 pos%= table_field(subst%,tabfieldlen%()) pos%= table_field(field%,tabfieldlen%()) p$<>"" ExpLen%=0 I%=1 (p$) F%= p$,I%,3)) # ExpLen%+=tabfieldlen%(F%)+2 ExpLen%-=2 ExpLen%=tabfieldlen%(1) 8start%=!tabanchor%(T%)+offset%-Rec%:ind%=start%+pos% row%+=1:ind%+=Rec% row%>Rows% $ind%=subst$ row%>Rows% subst$="":=string$: ## String not in table ### ;ind%=start%+row%*Rec%: subst%>=0 subst$=$(ind%+pos%) p$<>"" I%=1 (p$) F%= p$,I%,3)) , pos%= table_field(F%,tabfieldlen%()) 4 s$+= pad($(ind%+pos%),tabfieldlen%(F%))+" " s$= ind%+=tabfieldlen%(0)+1:s$=$ind%: ### Return 2nd field ### n(F%) T%,row%,ind%,start%,Rows%,Rec%,TabFields%,pos%,valpos%,N%,field%,subst%,table$,S$,exact% link$(F%)="" S$=$Rf%(F%) table$=link$(F%) *field%= trailing_number(table$,exact%) "subst%= leading_number(table$) /table%= table_number(table$): table%<0 table_info(table%,Rows%,TabFields%,Rec%,tabfieldlen%(),offset%,heading%,colours$) TabFields%=field% softerror("",54):=0 subst%>0 . pos%= table_field(subst%,tabfieldlen%()) pos%= table_field(field%,tabfieldlen%()) 1valpos%= table_field(field%+1,tabfieldlen%()) +start%=!tabanchor%(table%)+offset%-Rec% row%+=1 ind%=start%+row%*Rec%+pos% row%>Rows% S$=$ind% row%<=Rows% # ind%=start%+row%*Rec%+valpos% N%= ($ind%) N%=0 pad(s$,L%) (s$) Datlen%=maxlen%(F%) AP selected(printW%,2) Head$=$ text(mainW%,(desc%(F%))) Head$=Tag$(F%) B' F%=0 Head$="RECORD":Datlen%=6 C7 F%=MaxFields%+1 Datlen%=KL%(key%):Head$="KEY" D# Datlen%>dlm% dlm%=Datlen% Hdlen%= (Head$) F! Hdlen%>hlm% hlm%=Hdlen% format$ "horiz","table": I- pad%=Datlen%-Hdlen%: pad%<0 pad%=0 chartype%(F%) Kc 3,6,46,47,54,56,57: selected(printW%,11) Head$+= pad%," ") Head$= pad%," ")+Head$ LA ### Right justify numbers unless Expand option on ### :Head$+= pad%," ") N OJ heap_store(headanchor%,blocksize%,blockinc%,pos%,0,Head$+spacer$) P# Tab%((I%+1) 2)=pos%-base% format$ "horiz":L%=pos%-base%+2 U* "vert":L%=TextLine%+5:Tab%(1)=hlm% "table": col%= (column$) XF heap_store(headanchor%,blocksize%,blockinc%,pos%,0,column$+" ") ?pos%=10:L%=pos%-base%+1 "label": longestfield%=dlm% \) L%=labup%*labwidth%+dlm%+Lmargin%+1 extend_named_sliding_block(lineanchor%,L%+8) no_yes(F%, no$, yes$) P%,V$,L% val(mainW%,field%(F%)) V$,"Q") P%>0 V$= V$,P%+1) P%= V$,",") no$= V$,P%-1) yes$= V$,P%+1) no$="N":yes$="Y" (no$) (yes$)>L% (yes$) heap_store(anchor%, size%,inc%, ptr%,L%,string$) string$<>"" (string$) ptr%-!anchor%+L%+1>size% size%+=inc% t0 extend_named_sliding_block(anchor%,size%) string$<>"" $ptr%=string$:ptr%+=L%:?ptr%=10 set_vert deselect(printW%,23) deselect(printW%,25) deselect(printW%,26) select(printW%,24) format$="vert" ?LinesPerPage%=(pagelength%-10) (linefeed%*( (Form$) LinesPerPage%=0 LinesPerPage%=1 save_selection P%,T%,I%,F%,J% -P%=savebuff%:$P%=printorder$:P%+= ($P%)+1 T%=0 LastTable% # $P%=printrel$(T%):P%+= ($P%)+1 $P%="***":P%+= ($P%)+1 I%=1 (printorder$)-1 " F%= fnum( printorder$,I%,2)) chartype%(F%) 3,6,8,46,47,54,56,57: J%=0 L selected(pselectW%,(calcrow%?F%)*8+2+J%) $P%="ON" $P%="OFF" P%+= ($P%)+1 8Start%=savebuff%:End%=Start%+P%-savebuff%:Type%=&7F3 load_selection(f$) F%,I%,T%,F,new% clear_selection printorder$= T%=-1:printrel$()="" p$<>"***" T%+=1 p$= p$<>"" p$<>"***" select(printW%,11) printrel$(T%)=p$ tableW%(T%)>0 f NewTab%=( table_info(T%,Rows%,TabFields%,Rec%,tabfieldlen%(),offset%,heading%,colours$)=" 0 extra%=-NewTab%*(Rows%*(TabFields%+1)) I%=1 (p$) $ tablefield%= p$,I%,3)) 3 select(tableW%(T%),tablefield%+extra%) I%=1 (printorder$)-1 " F%= fnum( printorder$,I%,2)) chartype%(F%) 41,42,43,44,45: . col%= get_icon_cols(mainW%,field%(F%)) 0 col%=((col%>>4) (col%<<4)) %11111111 . set_icon_cols(mainW%,field%(F%),col%) 3,6,8,46,47,54,56,57: " select(mainW%,field%(F%)) " enable_row(calcrow%?F%, J%=0 H set_icon(pselectW%,(calcrow%?F%)*8+2+J%,( #F="ON")) $ select(mainW%,field%(F%)) close_file(F) lit(printM%,6, lit(printM%,7, lit(mainM%,7, selected(passW%,13)) select_range(first%,last%,show%) F%,T%,F$,wi%,ic% first%>last% first%,last% first%=1 last%=fields% printorder$="" printorder$= printorder$)) wi%=mainW% F%=first% last% ic%=field%(F%) chartype%(F%) 41,42,43: $ col%= get_icon_cols(wi%,ic%) F (col% %1111)>=2 col%=((col%>>4) (col%<<4)) %11111111 . show% set_icon_cols(wi%,ic%,col%) ' F$= ~(F%): (F$)=1 F$="0"+F$ printorder$+=F$ 0,1,2,4,5,7,8: = len%(F%)>0 get_icon_cols(wi%,ic%)<>winback%*17 ) F$= ~(F%): (F$)=1 F$="0"+F$ printorder$+=F$ $ show% select(wi%,ic%) 3,6,46,47,54,56,57: = len%(F%)>0 get_icon_cols(wi%,ic%)<>winback%*17 ) F$= ~(F%): (F$)=1 F$="0"+F$ printorder$+=F$ $ show% select(wi%,ic%) $ enable_row(calcrow%?F%, ' F$= ~(F%): (F$)=1 F$="0"+F$ printorder$+=F$ $ col%= get_icon_cols(wi%,ic%) 0 col%=((col%>>4) (col%<<4)) %11111111 . show% set_icon_cols(wi%,ic%,col%) % 39,48,49,50,51,52,53,55,58: ' F$= ~(F%): (F$)=1 F$="0"+F$ printorder$+=F$ " show% select(wi%,ic%) lit(printM%,6, lit(printM%,7, lit(mainM%,7, selected(passW%,13)) shade(matchW%,7,printorder$<>"") clear_selection F%,T%,new% F%=1 fields% chartype%(F%) 36,41,42,43,44,45: . col%= get_icon_cols(mainW%,field%(F%)) E (col% %1111)<2 col%=((col%>>4) (col%<<4)) %11111111 . set_icon_cols(mainW%,field%(F%),col%) V 3,6,8,46,47,54,56,57: enable_row(calcrow%?F%, deselect(mainW%,field%(F%)) & deselect(mainW%,field%(F%)) printorder$="" T%=0 LastTable% b NewTab%=( table_info(T%,Rows%,TabFields%,Rec%,tabfieldlen%(),offset%,heading%,colours$)=" , extra%=-NewTab%*(Rows%*(TabFields%+1)) p$=printrel$(T%) p$<>"" tableW%(T%)>0 I%=1 (p$) $ tablefield%= p$,I%,3)) 5 deselect(tableW%(T%),tablefield%+extra%) printrel$()="" lit(printM%,6, lit(printM%,7, lit(mainM%,7, shade(matchW%,7, load_query(f$,wi%,ic%) wi% mainW%: ic% D field%(buttonfield%(0,22)): select(wi%,ic%): filter(wi%, . selected(passW%,14) match(0,0) keypadW%: select(wi%,22): filter(wi%, "OS_File",255,f$,Query% query$=$Query% set_caret(queryW%,0) redraw_icon(queryW%,0) design_field(b%,ic%,menu%) w%,h% clickicon%=ic% !#!posx%=x%:posy%=y%:dragbutt%=0 !$3!block%=mainW%: "Wimp_GetWindowState",,block% x%+=block%!20-block%!4 y%+=block%!24-block%!16 !'5!block%=createW%: "Wimp_GetWindowState",,block% !(%closed%=((block%!32 (1<<16))=0) %1111111 !*+ 1,4: fields%=0 softerror("",62) closed% !-C (ic% 2)=1 drag%=6:dragbutt%=16 drag%=5:dragbutt%=64 !.$ init_drag(mainW%,ic%,drag%) !1% shade(createW%,44,(fields%>0)) fieldfunc$="create" $InsText%="" !43 deselect(createW%, selected_esg(createW%,1)) !5# shade(createW%,49,snapgrid%) ic%>=0 lit(designM%,0, !8B !block%=mainW%:block%!4=ic%: "Wimp_GetIconState",,block% !9M x%=block%!8:y%=block%!12:w%=block%!16-block%!8:h%=block%!20-block%!12 !:$ Fieldnumber%= get_field(ic%) !;% type%=chartype%(Fieldnumber%) vtype$(type%) !=3 "E": select(createW%,21): set_limits(0) !>3 "C": select(createW%,47): set_limits(1) !?3 "T": select(createW%,24): set_limits(2) !@3 "X": select(createW%,22): set_limits(3) !A3 "K": select(createW%,23): set_limits(4) !B3 "O": select(createW%,48): set_limits(5) !C3 "S": select(createW%,35): set_limits(6) !D !E' fieldtype%=type%:currenttype%=0 !F currenttype%+=1 !H: ?(flist%(menunumber%)+currenttype%+1)=fieldtype% !IB tick_one(ftypeM%(menunumber%),0,lasttype%-1,currenttype%) !J4 $FtitleText%="Modify field "+ (Fieldnumber%) !K5 $DescText%=$ text(mainW%,desc%(Fieldnumber%)) !L$ $TagText%=Tag$(Fieldnumber%) !M' $LenText%= (len%(Fieldnumber%)) !N$ $ValText%=vname$(fieldtype%) !O5 deselect(createW%, selected_esg(createW%,2)) fix%(Fieldnumber%) !Q/ select(createW%,45):$Fixpt%="0" !R. select(createW%,46):$Fixpt%="0" !S> select(createW%,14):$Fixpt%= (fix%(Fieldnumber%)) !T !U* num%=(fieldtype%=3 fieldtype%=6) !V4 shade(createW%,13,( selected(createW%,14))) !W shade(createW%,14,num%) !X shade(createW%,45,num%) !Y shade(createW%,46,num%) shade(createW%,18, ![U shade(createW%,6,(fieldtype%<9 fieldtype%=46 fieldtype%=47) adjust%) !\% shade(createW%,30, adjust%) shade(createW%,29, !^: shade(createW%,15,(fieldtype%=3 fieldtype%=47)) !_* shade(createW%,25,(fieldtype%=3)) !`* C$=calc$(Fieldnumber%):P%= C$,"|") !a8 P%>0 $mintext%= C$,P%-1):$maxtext%= C$,P%+1) I%=21 !c' shade(createW%,I%, adjust%) !e% shade(createW%,35, adjust%) !f% shade(createW%,39, adjust%) !g% shade(createW%,40, adjust%) !h% shade(createW%,47, adjust%) !i% shade(createW%,48, adjust%) !j !k" lit(designM%,0, adjust%) select(createW%,21) set_limits(0) !n. $FtitleText%="New field "+ (fields%+1) !o/ $DescText%="":$TagText%="":$LenText%="" !p- $Fixpt%="2":$mintext%="":$maxtext%="" !q5 deselect(createW%, selected_esg(createW%,2)) select(createW%,46) shade(createW%,13, shade(createW%,14, shade(createW%,45, shade(createW%,46, shade(createW%,15, shade(createW%,25, shade(createW%,29, shade(createW%,30, shade(createW%,39, shade(createW%,40, !}% shade(createW%,18, adjust%) (ic% 2)=1 ; $boxX%= (x%):$boxY%= (y%):$boxW%= (w%):$boxH%= B x%+=w%+8:$boxX%= (x%):$boxY%= (y%):$boxW%="0":$boxH%="0" close_window(createW%) menu% . show_menu(designM%,posx%-64,posy%-20) G position_window(createW%,0,0,0,0,0,0): set_caret(createW%,4) closed% init_drag(mainW%,ic%,5):dragbutt%=64 remove_field(Field%,con%, Calc$) con% confirm( msg("Err53"))= )!block%=mainW%:block%!4=desc%(Field%) "Wimp_GetIconState",,block% "posx%=block%!8:posy%=block%!12 "Wimp_DeleteIcon",,block% 8block%!4=field%(Field%): "Wimp_DeleteIcon",,block% fields%-=1 Calc$=calc$(Field%) F%=Field% fields% 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) !block%=mainW% "Wimp_GetWindowState",,block% ;posx%-=block%!20-block%!4:posy%-=block%!24-block%!16-48 "Wimp_ForceRedraw",-1,block%!4,block%!8,block%!12,block%!16 create_field(Before%,x%,y%,Calc$) Desc%,Field%,F%,tag$,Len%,Char%,F%,L%,LF%,x%,y%,width%,height%,dflg% fields%=MaxFields% softerror( (MaxFields%),23):= $DescText%="" $TagText%="" fieldtype%<=8 ($DescText%):LF%= ($LenText%) L%=0 dflg%=(winback%<<28)+&7016711 dflg%=(winback%<<28)+&7016731 LF%>246 softerror("",64):= ($boxX%):y%= ($boxY%):int%= ($snapint%): snap(x%,y%,int%) &width%= ($boxW%):height%= ($boxH%) fieldtype% 39,40,59: LF%=0 width%=0 width%=48 height%=0 height%=48 41,42,43:LF%=1 8,48,50:LF%=8 49:LF%=15 51:LF%=10 52,58:LF%=24 53,55:LF%=3 54,56:LF%=2 57:LF%=4 LF%>0 $TagText%="" softerror("",16):= F%+=1 $TagText%=Tag$(F%) F%>fields% F%<=fields% $TagText%<>"" softerror("",20):= 8fields%+=1:Tag$(fields%)=$TagText%:len%(fields%)=LF% width%=0 $TagText%<>"" len%(fields%)<70 width%=len%(fields%)*16+16 width%=70*16+16 height%=0 width%>0 height%=48 !chartype%(fields%)=fieldtype% selected(createW%,45):fix%(fields%)=-1 selected(createW%,14):fix%(fields%)= ($Fixpt%) :fix%(fields%)=0 extend_named_sliding_block(formanchor%,Fptr%-!formanchor%+L%+6) [desc%(fields%)= create_icon(mainW%,x%-L%*16-16,y%+2,L%*16+8,44,dflg%,"",Fptr%,hand%,L%) !$Fptr%=$DescText%:Fptr%+=L%+1 $Fptr%="" fieldtype% min$=$ text(createW%,15) max$=$ text(createW%,25) min$<>"" max$<>"" calc$(fields%)=min$+"|"+max$:calc$(0)="LOADED" 3 min$=$ text(createW%,15): min$="" min$="0" 4 calc$(fields%)=min$+"|"+min$:calc$(0)="LOADED" fieldtype% 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% 59:valptr%=!logoanchor%:$Fptr%=Tag$(fields%) :valptr%=hvalid%(fieldtype%) icon_design(fieldtype%,1,width%,height%) Xfield%(fields%)= create_icon(mainW%,x%,y%,width%,height%,iflags%,"",Fptr%,valptr%,4) fieldtype%=40 Rf%(fields%)= create_anchor("Picture"+ (fields%)) Fptr%+=5 redraw_icon(mainW%,desc%(fields%)): redraw_icon(mainW%,field%(fields%)) Before%0 re_sequence(fields%,Before%,-1) snap( y%,int%) X%,Y% snapgrid%= int%>0 5 X%=(x% int%)*int%: x%-X%>int% X%+=int% 5 Y%=(y% int%)*int%: Y%-y%>int% Y%-=int% $boxX%= (X%):$boxY%= x%=X%:y%=Y% snap_all ic%,x%,y%,w%,h% ic%=0 2*fields%-1 ) !iconblock%=mainW%:iconblock%!4=ic% "Wimp_GetIconState",,iconblock% & x%=iconblock%!8:y%=iconblock%!12 - w%=iconblock%!16-x%:h%=iconblock%!20-y% snap(x%,y%, ($snapint%)) ) iconblock%!8=x%:iconblock%!16=x%+w% * iconblock%!12=y%:iconblock%!20=y%+h% iconblock%!4=mainW% > !block%=mainW%:block%!4=ic%: "Wimp_DeleteIcon",,block% "Wimp_CreateIcon",,iconblock%+4 redraw(mainW%) nudge(b%,ic%) int%,z% b%=4 z%=1 z%=-1 snapgrid% int%= ($snapint%) int%=2 ficon%=clickicon% *!iconblock%=mainW%:iconblock%!4=ficon% "Wimp_GetIconState",,iconblock% $x%=iconblock%!8:y%=iconblock%!12 +w%=iconblock%!16-x%:h%=iconblock%!20-y% ic% 50:y%+=int%*z% 51:y%-=int%*z% 52:x%+=int%*z% 53:x%-=int%*z% " 'iconblock%!8=x%:iconblock%!16=x%+w% (iconblock%!12=y%:iconblock%!20=y%+h% iconblock%!4=mainW% ?!block%=mainW%:block%!4=ficon%: "Wimp_DeleteIcon",,block% "Wimp_CreateIcon",,iconblock%+4 redraw(mainW%) adjust_field(b%) Dptr%,Fptr%,dflg% "Wimp_GetPointerInfo",,block% newx%=!block%:newy%=block%!4 #Fieldnumber%= get_field(ficon%) (ficon% 2)=0 C !block%=mainW%:block%!4=ficon%: "Wimp_GetIconState",,block% . Dptr%=block%!28:Desc$=$Dptr%:L%= (Desc$) L%=0 dflg%=(winback%<<28)+&7016711 dflg%=(winback%<<28)+&7016731 "Wimp_DeleteIcon",,block% "Wimp_GetWindowState",,block% - x%=block%!20-block%!4+newx%-oldx%+minx% . y%=block%!24-block%!16+miny%+newy%-oldy% snap(x%,y%, ($snapint%)) W desc%(Fieldnumber%)= create_icon(mainW%,x%,y%,L%*16+8,44,dflg%,"",Dptr%,hand%,L%) "!C !block%=mainW%:block%!4=ficon%: "Wimp_GetIconState",,block% Fptr%=block%!28 "%$ "Wimp_DeleteIcon",,block% "&( "Wimp_GetWindowState",,block% "'# x%=block%!20-block%!4+minx% "(0 y%=block%!24-block%!16+miny%+newy%-oldy% ")! snap(x%,y%, ($snapint%)) "*F width%=maxx%-minx%+newx%-oldx%:height%=maxy%-miny%+oldy%-newy% ",' keepwith%= selected(prefsW%,16) keepwith% ".I !block%=mainW%:block%!4=ficon%-1: "Wimp_GetIconState",,block% "/2 Dptr%=block%!28:Desc$=$Dptr%:L%= (Desc$) "0P L%=0 dflg%=(winback%<<28)+&7016711 dflg%=(winback%<<28)+&7016731 "1& "Wimp_DeleteIcon",,block% "2 "3C !block%=mainW%:block%!4=ficon%: "Wimp_DeleteIcon",,block% keepwith% "5* "Wimp_GetWindowState",,block% "6: x%=block%!20-block%!4+newx%-oldx%+minx%-L%*16-16 "72 y%=block%!24-block%!16+miny%+newy%-oldy% "8# snap(x%,y%, ($snapint%)) "9] desc%(Fieldnumber%)= create_icon(mainW%,x%,y%+2,L%*16+8,44,dflg%,"",Dptr%,hand%,L%) ": ";( "Wimp_GetWindowState",,block% "! snap(x%,y%, ($snapint%)) "?. width%=maxx%-minx%:height%=maxy%-miny% "A( fieldtype%=chartype%(Fieldnumber%) fieldtype% "CV 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% "D< 59:valptr%=!logoanchor%::$Fptr%=Tag$(Fieldnumber%) "E% :valptr%=hvalid%(fieldtype%) "G/ icon_design(fieldtype%,1,width%,height%) "H_ field%(Fieldnumber%)= create_icon(mainW%,x%,y%,width%,height%,iflags%,"",Fptr%,valptr%,4) "IS fieldtype%=40 Rf%(Fieldnumber%)= create_anchor("Picture"+ (Fieldnumber%)) "K@$boxX%= (x%):$boxY%= (y%):$boxW%= (width%):$boxH%= (height%) !block%=mainW% "Wimp_GetWindowState",,block% "Wimp_ForceRedraw",-1,block%!4,block%!8,block%!12,block%!16 swap_fields(F1%,F2%) F2%>0 F2%<=fields% desc%(F1%),desc%(F2%) Tag$(F1%),Tag$(F2%) "U field%(F1%),field%(F2%) len%(F1%),len%(F2%) "W& chartype%(F1%),chartype%(F2%) fix%(F1%),fix%(F2%) calc$(F1%),calc$(F2%) close_window(createW%) re_sequence(F1%,F2%,Z%) "_jD%=desc%(F1%):T$=Tag$(F1%):F%=field%(F1%):L%=len%(F1%):C%=chartype%(F1%):f%=fix%(F1%):Calc$=calc$(F1%) I%=F1%+Z% F2% 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%) "cjdesc%(F2%)=D%:Tag$(F2%)=T$:field%(F2%)=F%:len%(F2%)=L%:chartype%(F2%)=C%:fix%(F2%)=f%:calc$(F2%)=Calc$ icon_design(char%,func%, func% "hc 0:bfg%=&1700353F:rbfg%=&1700253F:ffg%=&0700A535: logosloaded% lfg%=&0000611A lfg%=ffg% "i^ 1:bfg%=&1700653F:rbfg%=bfg%:ffg%=&07006535: logosloaded% lfg%=&0000611E lfg%=ffg% char% "lC 9,10,11,12,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30: "mF !block%=keypadW%:block%!4=char%-9: "Wimp_GetIconState",,block% "n? w%=block%!16-block%!8:h%=block%!20-block%!12:iflags%=bfg% 13,14: "pF !block%=keypadW%:block%!4=char%-9: "Wimp_GetIconState",,block% "q@ w%=block%!16-block%!8:h%=block%!20-block%!12:iflags%=rbfg% "r( 31:w%=48:h%=48:iflags%=&1700B53B "s* 32,34,45:w%=112:h%=52:iflags%=bfg% "tH 33:w%=44:h%=44: func%=0 iflags%=&1700353B iflags%=&1700653B "u& 35,44:w%=80:h%=80:iflags%=bfg% "v) 36,37,38:w%=48:h%=48:iflags%=bfg% 39:iflags%=ffg% "x7 func%=0 iflags%=&0700A53E iflags%=ffg% "y. 41,42,43:w%=52:h%=52:iflags%=&1700B53B 59:iflags%=lfg% "{] func%=0 hide%?I%=1 iflags%=&00A535+(winback%<<24)+(winback%<<28) iflags%=ffg% w%=0 h%=0 iflags%=&00000000 get_field(ic%) F%+=1 field%(F%)=ic% desc%(F%)=ic% adjust_on(on%) design%=on%:adjust%=on% lit(designM%,6,on%) lit(designM%,1, on%) lit(designM%,2, on%) lit(designM%,3, on%) lit(designM%,4, on%) shade(createW%,6, on%) on% * w%=ScreenWidth%*2:h%=ScreenHeight%*2 4 !block%=0:block%!4=-h%:block%!8=w%:block%!12=0 "Wimp_SetExtent",mainW%,block% change_length(NL%,msg%) EX%,klm%,S$,N% EX%=NL%-RA% EX%=0 *dbasehandle%= ($database%+".Database") readsmarray(dbasehandle%,RA%) msg%: extend_dbase (EX%>0): confirm("Extend file from "+ (RA%)+" to "+ (NL%)+" records")= extend_dbase (EX%<0): confirm("Shorten file from "+ (RA%)+" to "+ (NL%)+" records")= shorten_dbase $Records%= (RA%):N%=RA% writesmarray(dbasehandle%,N%) close_file(dbasehandle%) msg% addr= moveto(key%,top,1) extend_dbase end%,P%,I%,key%,keybase%,KLM%,S$ key%=0 Keys% S$= KL%(key%),".") KLM%=KL%(key%)+13 P%=LH%+48+(NL%+1)*KLM% extend_named_sliding_block(keyanchor%(key%),P%) keybase%=!keyanchor%(key%) P%=LH%+48+RA%*KLM% I%=RA% EX%+RA%-1 !(keybase%+P%)=P%+KLM% !(keybase%+P%+4)=0 $(keybase%+P%+8)=S$ % !(keybase%+P%+KL%(key%)+9)=I% P%+=KLM% !(keybase%+P%)=0 !(keybase%+P%+4)=0 $(keybase%+P%+8)=S$ " !(keybase%+P%+KL%(key%)+9)=0 key% end%=(RA%+1)*Length% I%=0 EX%-1 #dbasehandle%=end%+I%*Length% J%=1 fields% #dbasehandle%,"" RA%=NL% #dbasehandle%=(RA%+1)*Length% shorten_dbase P%,L%,R%,s$,key%,keybase%,S$ key%=0 Keys% S$= KL%(key%),".") KLM%=KL%(key%)+13 keybase%=!keyanchor%(key%) $ s$=$(keybase%+LH%+56+NL%*KLM%) s$<>S$ confirm( msg("Err52"))= P%=LH%+48+NL%*KLM% !(keybase%+P%)=0 !(keybase%+P%+4)=0 $(keybase%+P%+8)=S$ " !(keybase%+P%+KL%(key%)+9)=0 key% RA%=NL% #dbasehandle%=(RA%+1)*Length% copy_database_spritefile(path$,leaf$) sprites% create_named_sliding_block(sprsanchor%,1024) ### This is a temporary sprite area used simply to hold ### ### the sprite 'new_appl' whilst it is renamed and saved ### sprites%=!sprsanchor% !sprites%=1024 sprites%!8=16 ### Initialise sprite area ### "OS_SpriteOp",&109,sprites% ### Load !Sprites file from Resources ### "OS_SpriteOp",&10A,sprites%,".Resources.Temp.!Sprites" ### Rename sprite 'new_appl' to new database name ### "OS_SpriteOp",&11A,sprites%,"new_appl",leaf$ ### Save spritefile (with renamed new_appl) as !Sprites ### "OS_SpriteOp",&10C,sprites%,path$+".!Sprites" ### Do same for hi-res sprite ### "OS_SpriteOp",&109,sprites% "OS_SpriteOp",&10A,sprites%,".Resources.Temp.!Sprites22" "OS_SpriteOp",&11A,sprites%,"new_appl",leaf$ "OS_SpriteOp",&10C,sprites%,path$+".!Sprites22" scrap_sliding_block(sprsanchor%) rename_database(name$) sprites% name$,1)<>"!" name$="!"+name$ name$= name$,10) create_named_sliding_block(sprsanchor%,1024) sprites%=!sprsanchor% !sprites%=1024 sprites%!8=16 "OS_SpriteOp",&109,sprites% "OS_SpriteOp",&10A,sprites%,$database%+".!Sprites" "OS_SpriteOp",&11A,sprites%,"!"+$dbase%,name$ "OS_SpriteOp",&10C,sprites%,$database%+".!Sprites" "OS_SpriteOp",&109,sprites% "OS_SpriteOp",&10A,sprites%,$database%+".!Sprites22" "OS_SpriteOp",&11A,sprites%,"!"+$dbase%,name$ "OS_SpriteOp",&10C,sprites%,$database%+".!Sprites22" $dbase%= name$,2) redraw_icon(-2,pbaseicon%) scrap_sliding_block(sprsanchor%) old$= leaf($database%) name$=dbasepath$+"."+name$ "OS_CLI","Rename "+$database%+" "+name$ $database%=name$ defaults(f$,N%,key%) confirm( msg("Err133,"+Tag$(KF%(0,0)))) $Records%= make_empty_index(N%,key%, save_recs(f$+".Database",N%) %present%=7: save_keys: save_calcs 'design%= :present%=1: get_it_in(f$) lit(iconbarM%,2, default_key first_writable chartype%(F%) 3,6,46,47,54,56,57:KL%(0)=len%(F%) len%(F%)>3 KL%(0)=4 KL%(0)=len%(F%) Index$(0)="PrimaryKey" key%=0 KW%()=0:KF%()=0 # 0KW%(0,0)=KL%(0)+(1<<16)+(F%<<24):KF%(0,0)=F% set_keydata(key%) new_tree(f%) REC%,I%,ptr%,file%,old$,chars%,pos%,word%,c$,p$,w$ I%=0 W%=KW%(0,I%) W%>0 #)$ chars%=W% 255:c$= (chars%) #*L pos%=(W%>>8) 255:p$= (pos%): pos%=0 p$="L" pos%=25 p$="R" #+( word%=(W%>>16) 255:w$= (word%) #,8 old$+=Tag$(KF%(0,I%))+" ("+w$+","+p$+","+c$+")," old$= old$) #01d%= selected(keyW%,33):s%= selected(keyW%,32) f%=0 M$="Build index with " M$+="records in same subfiles" M$+="all records in subfile "+ M$+=" of current database" M$+=", also restoring 'deleted' records." M$+=" WARNING! Other indices will need rebuilding!" confirm(M$)= mark_files(0,RA%, d%,s%,f%) copy_keydata(0) "OS_File",5,$database%+".Database" ,,,,len% RA%=(len% Length%)-1 scrap_sliding_block(keyanchor%(0)) make_empty_index(RA%,0, close_window(keyW%) redraw(keypadW%) ptr%=!tempanchor% poll: "Hourglass_On" #C*dbasehandle%= ($database%+".Database") REC%=0 RA%-1 file%=ptr%?REC% file%<>255 top=8*file%+LH% #H' readsmarray(dbasehandle%,REC%) KEY$= key2(0,1) K$= stripspaces(KEY$) K$<>"" insert(KEY$,0) #O- scrap_sliding_block(tempanchor%) #P% close_file(dbasehandle%) #Q5 open_index($database%+".PrimaryKey",0, #R& moan_err%, msg("Err111") ptr%?REC%=255 #U #W0 "Hourglass_Percentage",(REC%*100) REC% close_file(dbasehandle%) #ZXkeybase%=!keyanchor%(0):nextfree%=!keybase%:nodesize%=12+KL%(0)+1:offset%=8+KL%(0)+1 REC%=0 RA%-1 ptr%?REC%=255 #]* !(keybase%+nextfree%+offset%)=REC% nextfree%+=nodesize% REC% #a"newtree%= :design%= :adjust%= scrap_sliding_block(tempanchor%) Index$(0)="PrimaryKey" "Hourglass_Off" present%=7 write_log(-1,"Primary key structure altered. Was "+old$) "Wimp_CreateMenu",,-1 file%=0: asterisk( get_it_in($database%) reformat(f$) I%,F,REC%,dfields%,DLength%,chdd,z%,blobs%,ex% DTag$(),F%(),F1%(),L%(),l$(),c$() F$(0)="" "OS_File",5,f$+".Form" z%<>1: softerror("",19) #s' f$=$database%: softerror("",36) #u$ blobs%= find_blobs($database%) (f$+".Form") #F,dfields% #xX DTag$(dfields%),F%(dfields%),F1%(fields%),L%(dfields%),l$(dfields%),c$(dfields%) I%=1 dfields% #zF #F,Desc$,DTag$(I%),xd%,yd%,xf%,yf%,L%(I%),char%,extra%,extra% DLength%+=L%(I%)+1 #} chdd= (f$+".Database") , dbasehandle%= ($database%+".Database") compare "Hourglass_On" REC%=0 #chdd=REC%*DLength% ' readsmarray(dbasehandle%,REC%) I%=1 dfields% S$=F$(F%(I%)) ) (S$)>L%(I%) S$,L%(I%)) #chdd,S$ ex%=-1 ex%0 l$(dest%)=link$(source%) c$(dest%)=calc$(source%) dest% merge_files(f$,fi%) R%,REC%,ptr%,file%,d%,s%,z%,RUM%,RAM%,NL%,ex%,blobs% "OS_File",5,f$+".Database" z%<>1: softerror("",29) f$=$database%: softerror("",15) identical: softerror("",21) 7 s%= selected(reformW%,2):d%= selected(reformW%,3) fi%=0 M$="Merge "+f$+" with " M$+="corresponding subfiles" M$+="subfile "+ (fi%) M$+=" of current database" M$+=", also restoring deleted records" M$+=". WARNING! Indices will need rebuilding!" confirm(M$)= 0 "OS_File",5,f$+".Database" ,,,,len% RAM%=(len% Length%)-1 I ### Load primary key of file to be merged into a spare slot ### 2 open_index(f$+".PrimaryKey",MaxKeys%+1, @ ### Mark which subfile each new record is to go in ### 0 mark_files(MaxKeys%+1,RAM%, d%,s%,fi%) ( keybase%=!keyanchor%(MaxKeys%+1) F ### Count how many record actually used in file to merge ### - count(MaxKeys%+1,RUM%): count(0,RU%) NL%=RU%+RUM% "Hourglass_On" O ### Expand existing file if new length (NL%) exceeds availability ### ) NL%>RA% change_length(NL%, & blobs%= find_blobs($database%) ptr%=!tempanchor% R%=0 RAM%-1 file%=ptr%?R% file%<>255 make_new_rec top=8*file%+LH% " read(fields%, ,R%,f$) 8 selected(reformW%,8) dontincrement%= write(fields%,key%) ex%=-1 ex%fields% different%= I%len%(I%) different%= char%<>chartype%(I%) (char%>8 chartype%(I%)>8) different%= different% mark_files(key%,RA%,d%,s%,f%) P%,I%,M,file%,top,ptr% create_named_sliding_block(tempanchor%,RA%+1) "Hourglass_On" ptr%=!tempanchor% I%=0 RA%-1 ptr%?I%=d% file%=0 top=8*file%+LH% ! P%= neighbour(key%,top,1) P%<>top S%= rec_no(k$,key%,P%) + ptr%?S%=file% ptr%?S%=f% " P%= neighbour(key%,P%,1) file% "Hourglass_Off" print_tree(key%,file%,PR$) L%(),COL%,levels%,depth% $ YTextName$=$database%+".PrintJobs.Tree"+ Index$(key%),5)+ (file%):$SaveName%=TextName$ read_print_options reportdest$="Window" keybase%=!keyanchor%(key%) P%=!(keybase%+top) "Hourglass_On" traverse(P%, levels%=depth%-2:COL%=0 L%(levels%) tree_heading P%=!(keybase%+top) traverse(P%, H$=" No. nodes 1" H1$=" Max nodes 1" L%=1 levels% L%<40 L$= (L%(L%)) L$= (L$)," ")+L$ M$= (2^L%) $30 (M$)>5 M$=BL$ (M$)," ")+M$ H$+=L$:H1$+=M$ rule_off(45) $8:$(!lineanchor%)=H$: list_line(-1,lineanchor%, (H$),32) $9<$(!lineanchor%)=H1$: list_line(-1,lineanchor%, (H1$),32) $:<$(!lineanchor%)=LH$: list_line(-1,lineanchor%, (LH$),32) rule_off(45) "Hourglass_Off" format$="tree":tkey%=key% screen_list pitch$= pitch("2") lit(listM%,1, write_log(-1,"Tree printed: subfile:"+ (file%)+", key:"+ (key%)+", "+Index$(key%)) tree_heading zero%,len% 6," ") LH$=" Level No. Root" L%=1 levels% L$= L%<10 L$="0"+L$ L%<40 LH$+=" "+L$ len%= (LH$) U$=" "+ len%-1,"-") LenLine%=len%+4 Count%=0 $S"count%= count_recs(key%,zero%) $TDtextblocksize%=(count%+11)*LenLine%:textblockinc%=textblocksize% extend_named_sliding_block(textanchor%,textblocksize%) extend_named_sliding_block(lineanchor%,LenLine%+4) TextPtr%=!textanchor% recblocksize%=400 extend_named_sliding_block(recanchor%,recblocksize%) rule_off(32) rule_off(45) send_title("Tree Analysis (subfile:"+ (file%)+", key:"+ (key%)+", "+Index$(key%)+")") rule_off(32) $^<$(!lineanchor%)=LH$: list_line(-1,lineanchor%, (LH$),32) rule_off(45) traverse(P%,Z%) string$ COL%=COL%+1 COL%>depth% depth%=COL% P%<0 L%=!(keybase%+P%) R%=!(keybase%+P%+4) S$=$(keybase%+P%+8) S$="" S$="" S$)="#" S$= $n%rec%=!(keybase%+P%+8+KL%(key%)+1) L%(COL%-1)=L%(COL%-1)+1 PR$="ALL" COL%<=40 $s* string$= COL%*6+10- (S$)," ")+S$ $tL $(!lineanchor%)=string$: list_line(rec%,lineanchor%, (string$),32) $v1 string$=" "+S$+" (level "+ (COL%-1)+")" $wL $(!lineanchor%)=string$: list_line(rec%,lineanchor%, (string$),32) $x traverse(L%,Z%) COL%=COL%-1 L%=!(keybase%+P%) R%=!(keybase%+P%+4) S$=$(keybase%+P%+8) %rec%=!(keybase%+P%+8+KL%(key%)+1) traverse(R%,Z%) COL%=COL%-1 balance(key%) recptr%,top,file%,flagptr%,balptr%,I%,N%,A%,max%,done%,highest%,avail%,seglen% recs%(),ptr%() recs%(5),ptr%(5) newtree%= seglen%=KL%(key%)+5 extend_named_sliding_block(recanchor%,seglen%*RA%) create_named_sliding_block(balanchor%,seglen%*RA%) create_named_sliding_block(flaganchor%,RA%) Arecptr%=!recanchor%:flagptr%=!flaganchor%:balptr%=!balanchor% I%=0 RA%-1 flagptr%?I%=255 Bytes are changed from 255 to 0 where records are in use "Hourglass_On" file%=0 ptr%(file%)=recptr% top=8*file%+LH% . recs%(file%)= count_recs(key%,recptr%)-1 max%+=recs%(file%)+1 file% make_empty_index(RA%,key%, "Hourglass_LEDs",%11 file%=0 top=8*file%+LH% recs%(file%)>=0 recptr%=ptr%(file%) N%=1 N%=N%+N% N%>recs%(file%)+2 step%=N% N%=(N% 2)-1 start%=N% C%=0 start%=start% end%=N%-start%-1 step%=step% $ I%=start% end% step% 9 A%=recptr%+seglen%*(I%*(recs%(file%)+1) = balptr%!C%=!A%:$(balptr%+C%+4)=$(A%+4):!A%=-!A%-1 C%+=seglen% step%=2 % I%=0 C%-seglen% seglen% . REC%=balptr%!I%:KEY$=$(balptr%+I%+4) insert(KEY$,key%) done%+=1 6 "Hourglass_Percentage",(done%*100) max% I%=0 recs%(file%) # REC%=recptr%!(seglen%*I%) REC%>=0 ( KEY$=$(recptr%+seglen%*I%+4) insert(KEY$,key%) done%+=1 8 "Hourglass_Percentage",(done%*100) max% file% "Hourglass_LEDs",%00 keybase%=!keyanchor%(key%) nodesize%=8+KL%(key%)+1+4 avail%=!keybase% I%=0 highest% flagptr%?I%=255 + !(keybase%+avail%+8+KL%(key%)+1)=I% avail%+=nodesize% "Hourglass_Off" scrap_sliding_block(balanchor%) scrap_sliding_block(recanchor%) scrap_sliding_block(flaganchor%) save_keys newtree%= asterisk( write_log(-1,"Index "+Index$(key%)+" balanced") duplicates(key%) P$,S$,RP$,RS$,addr,top,RP%,RS%,count%,examined%,file%,flag% abort_dup: YTextName$=$database%+".PrintJobs.Dupl"+ Index$(key%),5)+ (file%):$SaveName%=TextName$ read_print_options Breportdest$="Window":format$="dup":Count%=0:LenLine%=KL%(0)+23 top "OS_Byte",229,0 P S$=$(!keyanchor%(key%)+addr+8):RS%=!(!keyanchor%(key%)+addr+9+KL%(key%)) = RS$= (RS%):RS$=" Record No."+ (RS$)," ")+RS$+" " S$<>P$ ' P$=S$:RP%=RS%:RP$=RS$:flag%= flag% line$=RP$+P$ I $(!lineanchor%)=line$: list_line(RP%,lineanchor%, (line$),32) flag%= line$=RS$+S$ G $(!lineanchor%)=line$: list_line(RS%,lineanchor%, (line$),32) examined%+=1 8 "Hourglass_Percentage",examined%*100 count% $ addr= neighbour(key%,addr,1) file% rule_off(32) "Hourglass_Off" screen_list abort_dup "Hourglass_Off" screen_list softerror("",67) wimp_error( >RAMtree Index handling ------------------------------------------------------ neighbour(key%,addr%,d%) R%,S%,p%,keybase% keybase%=!keyanchor%(key%) p%=d%*4 R%=!(keybase%+addr%+p%) R%<0 =-R% p%=4-p% addr%=R% S%=!(keybase%+addr%+p%) S%>0 R%=S% S%<=0 rec_no( k$,key%,addr%) %$#k$=$(!keyanchor%(key%)+addr%+8) %%-=!(!keyanchor%(key%)+addr%+8+KL%(key%)+1) scan_file(c$,key%,file%,action%,direc%) REC%,examined%,subtotal%,X%,Y%,n$,copy%,I% n$="0123456789." %*%subtotal%= count_recs(key%,zero%) (c$)= "OS_Byte",229,0 REC%= rec_no(k$,key%,P%) %.% readsmarray(dbasehandle%,REC%) examined%+=1 (Search$)= action% get_lengths format$="label" %5" copy%=1 labcopies% %6$ print_record(REC%,P%) copy% %8$ print_record(REC%,P%) %:/ 2:ptr%?REC%=file%: ### earmark ### %;? write_csv_rec(REC%,Form$,csvhandle%): poll: %<9 4:KEY$= key2(newkey%,1): insert(KEY$,newkey%) %= ### create index ### S$=F$(Menufield%) %AC New$,$ws%)>0:S$= wildcard_replace(S$,Old$,New$,$ws%) %BC New$,$wc%)>0:S$= wildcard_replace(S$,Old$,New$,$wc%) numeric%: X%=0:Y%=0 X%+=1 %F) (S$) S$,X%,1))>0 X%<= (S$) Y%=X% Y%+=1 %J+ (S$) S$,Y%,1))=0 %L9 S$= S$,X%-1)+ S$,X%,Y%-X%)+New$))+ S$,Y%) %M* Old$<>"": S$=Old$ S$=New$ :S$=New$ (S$)>TextLength% softerror("",10) F$(Menufield%)=S$ %T, writesmarray(dbasehandle%,REC%) %V! ### global change ### I%=1 fields% $Rf%(I%)=F$(I%) %[? update_calcs(0) writesmarray(dbasehandle%,REC%) %\: ### update time-dependent calcs on opening ### F$(F%)=sequenceval$ %_+ sequenceval$= (sequenceval$)+1) %`* writesmarray(dbasehandle%,REC%) %a1 $(!keyanchor%(key%)+P%+8)= key2(key%,1) %b %d# P%= neighbour(key%,P%,direc%) %e; "Hourglass_Percentage",(examined%*100) subtotal% wildcard_replace(S$,Old$,New$,type$) old$,new$,old2$,new2$,c$,L%,P%,R% type$ $ws%: %oD Old$,1)=$ws% New$,1)=$ws% Old$)=$ws% New$)=$ws%: %p' old$= Old$,2)):new$= New$,2)) P%= S$,old$) %r2 P%>0 S$,P%-1)+new$+ S$,P%+ (old$)) %s( Old$,1)=$ws% New$,1)=$ws%: %t/ old$= Old$,2):new$= New$,2)::R%= (old$) %u. S$,R%)=old$ (S$)-R%)+new$ %v$ Old$)=$ws% New$)=$ws%: %w* old$= Old$):new$= New$):L%= (old$) %x* S$,L%)=old$ S$=new$+ S$,L%+1) %y( Old$,$ws%)>0 New$,$ws%)>0: %zP P%= Old$,$ws%):old$= Old$,P%-1):L%= (old$):old2$= Old$,P%+1):R%= (old2$) %{9 P%= New$,$ws%):new$= New$,P%-1):new2$= New$,P%+1) %|* S$,L%)=old$ S$=new$+ S$,L%+1) %}0 S$,R%)=old2$ (S$)-R%)+new2$ $wc%: (Old$)= (New$) P%=1 (Old$) c$= Old$,P%,1) ; c$<>$wc% S$,P%,1) S$,P%,1)= New$,P%,1) search(S$,key%,M%) P%,found%,info$,keybase%,rec%,cond$ keybase%=!keyanchor%(key%) Z%=0:P%=top:ident%= L%=P% P%=!(keybase%+L%+Z%) P%<=0 P%=-L%:found%= info$=$(keybase%+P%+8) rec%= rec_no(k$,key%,P%) (val$+"(S$)="+val$+"LEFT$(info$,kl%)") 0:ident%=(key%=0) 1,3:found%= $ rec%=REC% found%= found% Z%=- (val$+"(S$)>="+val$+"(info$)")*4 found% ### M%=0 - Find leaf position at which to insert ### ### M%=1 - Find first match in tree (if there is one) ### ### M%=2 - Find exact matching record, checking for record no. ### insert( S$,key%) P%,avail%,kl%,keybase%,abort% S$="" null%(key%)= keybase%=!keyanchor%(key%) "kl%=KL%(key%):val$= type(key%) search(S$,key%,0) ident% ! selected(passW%,15): " softerror(S$,37):abort%= L selected(prefsW%,34) confirm( msg("Err45,"+S$)) abort%= abort% S$="*Failed*": nextfree%=!keybase% !(keybase%+nextfree%)<=0 incr%= ($Increment%) incr%>0 # change_length(RA%+incr%, S$="*Failed*" S$="*Failed*" softerror("",2): avail%=!(keybase%+nextfree%) .!(keybase%+nextfree%+Z%)=!(keybase%+P%+Z%) $!(keybase%+nextfree%+(4-Z%))=-P% $(keybase%+nextfree%+8)=S$ ,!(keybase%+nextfree%+8+KL%(key%)+1)=REC% !(keybase%+P%+Z%)=nextfree% !keybase%=avail% key%=0 RU%+=1 delete( S$,key%) P%,A%,kl%,keybase% S$="" null%(key%)= keybase%=!keyanchor%(key%) A%=!keybase% "kl%=KL%(key%):val$= type(key%) search(S$,key%,2) P%<0 softerror(S$+","+Index$(key%),1):S$="*Failed*": neighbour(key%,P%,0) neighbour(key%,P%,1) '!(keybase%+L%+Z%)=!(keybase%+P%+Z%) Q%=P% ZL%=4-Z% P1%=!(keybase%+P%+ZL%) P1%>0 info$=$(keybase%+P1%+8) P%=- search(info$,key%,0) !(keybase%+P%+Z%)=P1% !(keybase%+PR%+4)<=0 !(keybase%+PR%+4)=-SU% !(keybase%+SU%+0)<=0 !(keybase%+SU%+0)=-PR% !(keybase%+Q%)=A% !keybase%=Q% key%=0 RU%-=1 save_keys keyN% present%<>7 "Hourglass_On" refresh_dates 5keybase%=!keyanchor%(0):keybase%!4= ($Increment%) !keyanchor%(keyN%)>0 ! keybase%=!keyanchor%(keyN%) "SlidingHeap_DescribeBlock",slidingheapbase%,keyanchor%(keyN%) ,,filelength% keyN%=0 index$="" index$="Indices." "OS_File",10,$database%+"."+index$+Index$(keyN%),&7F0,,keybase%,keybase%+filelength% keyN%+=1 "Hourglass_Percentage",keyN%*100 (Keys%+1) "Hourglass_Off" readsmarray(filehandle%,REC%) loop% #filehandle%=REC%*Length% loop%=1 fields% F$(loop%)= #filehandle% loop% writesmarray(F, loop%,F$,L% #F=R%*Length% loop%=1 fields% ! F$=F$(loop%):L%=len%(loop%) (F$)<=L% #F,F$ L%,"!") loop% R%+=1 check_save(T%) time% T%=0 "OS_ReadMonotonicTime" time% (time% T%)<10 buttonfield%(0,19)>0 wi%=mainW%:ic%=field%(buttonfield%(0,19)) wi%=keypadW%:ic%=19 autosave% delay%= loop%=0 invert(wi%,ic%) delay%+=50 >delay% 1,-15,180,5 invert(wi%,ic%) delay%+=50 >delay% loop% invert(wi%,ic%) mouse(0,0,4,wi%,ic%) invert(wi%,ic%) Calculations --------------------------------------------------------- calc_link(T$,type%) ### Sets up calculation formula window & menu entry ### $CalcFunc%=T$ I%=1 T$= &&)$CalcTitle%=T$:calclink%=Fieldnumber% split_link(calclink%,real$,visible$) type% &)3 6,7:$CalcForm%=Tag$(calclink%)+"="+visible$ $CalcForm%=visible$ shade(calcW%,2,off%) deselect(calcW%,2) calc_formula(S$) ### Parses calculation formula (S$) & builds calc$(I%) ### I%,P%,t$,s$,C$,time%,date%,user% ic% close_window(wi%) &71 C$= ~(calclink%): calclink%<16 C$="0"+C$ &8% $CalcFunc%="Set base value" S$="" S$="0" &:" calc$(calclink%)=S$+"|"+S$ calc$(0)="LOADED" &< &=, P%= S$,"="):S$= S$,P%+1):visible$=S$ I%=fields% t$=Tag$(I%) t$<>"" P%=0 &C' user%=( S$,"FNU",P%+1)>0) P%= S$,t$,P%+1) P%>0 &F" chartype%(I%) &Ga 3,6,46,47,54,56,57: user% s$="$Rf%("+ (I%)+")" s$="VAL($Rf%("+ (I%)+"))" &H: 5:s$="FNdays($Rf%("+ (I%)+"))":date%= &I= 8:s$="FNseconds($Rf%("+ (I%)+"))":time%= &K+ chartype%(calclink%) &LL user% s$="$Rf%("+ (I%)+")" s$="FNn("+ (I%)+")" &M, 7:s$="$Rf%("+ (I%)+")" &P- S$= S$,P%-1)+s$+ S$,P%+ (t$)) update$(I%)+=C$ P%=0 &V/ visible$,"TIME$")>0 update$(0)+=C$ &W@ time%= chartype%(calclink%)=7 S$="FNtime("+S$+")" &XW date%= chartype%(calclink%)=7 S$="FNdate("+S$+","+ (len%(calclink%))+")" &Y# (S$)+ (visible$)+2<256 &Z. calc$(calclink%)="#"+S$+"#"+visible$ calc$(0)="LOADED" &\9 selected(calcW%,2) recalculate(calclink%) softerror("",44) &^ calclink%=0 asterisk( &b* (b% %111)=4 close_window(wi%) recalculate(F%) F,I%,R%,k$,P%,real$,visible$,subtotal%,zero%,examined% softerror(real$,73): split_link(F%,real$,visible$) confirm("Recalculate "+Tag$(F%)+"="+visible$+" for existing records?")= &l%subtotal%= count_recs(key%,zero%) "Hourglass_On" &n*dbasehandle%= ($database%+".Database") neighbour(key%,top,1) P%<>top R%= rec_no(k$,key%,P%) &r# readsmarray(dbasehandle%,R%) I%=1 fields% &t- chartype%(I%)<>40 $Rf%(I%)=F$(I%) chartype%(F%) F= (real$):F$= &y+ fix%(F%)>0 fix_point(F$,F%) 7:F$= (real$) &|# (F$)<=len%(F%) F$(F%)=F$ &}$ writesmarray(dbasehandle%,R%) P%= neighbour(key%,P%,1) examined%+=1 "Hourglass_Percentage",examined%*100 subtotal% "Hourglass_Off" close_file(dbasehandle%) I%=1 fields% chartype%(I%)<>40 $Rf%(I%)=field$(I%) display(key%,addr) asterisk( save_calcs calc$(0)="LOADED" cl= ($database%+".Calc") F%=1 fields% #cl,calc$(F%) close_file(cl) sums( F$,F%,type%) F$<>"" type% 8:V= seconds(F$) Sum(F%,0)+=1 Sum(F%,1)+=V Sum(F%,3)+=V*V V>Sum(F%,4) Sum(F%,4)=V V0 ' Sum(R%,2)=Sum(R%,1)/Sum(R%,0) 6 Sum(R%,3)= (Sum(R%,3)/Sum(R%,0)-Sum(R%,2)^2) ' Sum(R%,5)=10^30 Sum(R%,5)=0 J%=0 pos%=base% flag%>0 > N%=0:start%=1:F$= Lmargin%- (S$(J%))-1," ")+S$(J%)+" " N%=1:start%=3 & L%=Tab%(1)-Lmargin%- (spacer$) N L%>=7 F$=margin$+ tab(S$(J%),N%) F$=margin$+ S$(J%),L%),N%) heap_store(lineanchor%,LenLine%,0,pos%,0,F$) (Form$)>2 start%=1 $ I%=start% (Form$)-1 & F%= fnum( Form$,I%,2)):F$="" N%+=1 chartype%(F%) # 3,6,8,46,47,54,56,57: R%=calcrow%?F% Q chartype%(F%)=8 result$= time(Sum(R%,J%)) result$= (Sum(R%,J%)) T selected(pselectW%,R%*8+2+J%) justify(result$,N%,N%-1):f%(J%)=1 @ heap_store(lineanchor%,LenLine%,0,pos%,0, tab(F$,N%)) = f%(J%)=1 list_line(-1,lineanchor%,pos%-base%,32) (f%())>0 rule_off(45) margin_warn f%,F%,R%,J% fnum( Form$,2)) chartype%(F%) 3,6,8,46,47,54,56,57: R%=calcrow%?F% J%=0 0 selected(pselectW%,R%*8+2+J%) f%=F% f%>0 Lmargin%<9 softerror(Tag$(f%),92):=-1 tab(F$,N%) (F$)+ (spacer$) Tab%(N%)-Tab%(N%-1)-L%<=0 =F$+spacer$ ,=F$+ Tab%(N%)-Tab%(N%-1)-L%," ")+spacer$ justify(f$,x%,x1%) $L%=Tab%(x%)-Tab%(x1%)- (spacer$) (f$)>L% f$= f$,L%) (f$)," ")+f$ f$)="." f$=" "+ execute_file(F%) file$,d% link$(F%),1)="@" file$= link$(F%),2) "OS_File",5,file$ d%,,type% type%=(type%>>8) &fff type% % &fff: execute_script(file$) 8 block%!0=256:block%!12=0:block%!16=5:block%!20=0 7 block%!24=0:block%!28=0:block%!32=0:block%!36=0 / block%!40=type%:$(block%+44)=file$+ ) "Wimp_SendMessage",18,block%,0 execute_script(f$) F,P%,name$,command$,finished%,firstquery%,state% confirm( msg("Err68,"+ leaf(f$))) selected(printW%,39) reportdest$="File" reportdest$="Window" Script file signature junk$= abort_script: finished%) "OS_Byte",229,0 line$= space%= line$," ") space%=0 command$=line$:params$="" command$= line$,space%-1):params$= line$,space%+1):state%=(params$="ON") command$ "!COMMENT": "!SCRIPT": ImpCom$="" params$="END" finished%= < execute_script($database%+".PrintRes."+params$) "!DELETE": present%=7 RecF%= 0 params$="" key$= key$=params$ 3 select(searchW%,6): deselect(searchW%,5) addr= find(key$,0, RecF%= addr= shift(0,0,0) $ addr= moveto(key%,top,1) ' "!INSERT": present%=7 '#0 subfile%= (params$):top=8*subfile%+LH% make_new_rec loop%=1 fields% '&) $Rf%(loop%)= #F,len%(loop%)) write(fields%,key%) top=8*file%+LH% asterisk( '+ "!CHANGE": params$<>"" P%= params$,",") '/2 f$= params$,P%-1):params$= params$,P%+1) F%= field(f$, P%= params$,",") '25 from$= params$,P%-1):params$= params$,P%+1) '33 to$= params$,P%-1):$Query%= params$,P%+1) '4' changes(key%,F%,from$,to$, '5 "!QUERY": params$<>"" P%= params$,",") '95 $Query%= params$,P%+1):name$= params$,P%-1) ':H name$,"$")=0 f$=$database%+".PrintJobs."+name$ f$=name$ Search$= parse "Hourglass_On" reportdest$ '># "Window":TextName$=f$ '?& "File":texthandle%= ImpCom$<>"" 'B- firstquery%= :firstquery%= 'C' #texthandle%,ImpCom$ do_it(Search$,-1) 'H "!CSV": P%= params$,",") 'K3 $Query%= params$,P%+1):name$= params$,P%-1) 'LF name$,"$")=0 f$=$database%+".PrintJobs."+name$ f$=name$ write_csv(f$) "!SELECTION": params$<>"" 'P3 filename$=$database%+".PrintRes."+params$ 'Q- "OS_File",5,filename$ ,,ftype% 'R# ftype%=(ftype%>>8) &FFF 'S4 ftype%=&7F3 load_selection(filename$) clear_selection 'U "!PRINTOPTS": params$<>"" 'X3 filename$=$database%+".PrintRes."+params$ 'Y- "OS_File",5,filename$ ,,ftype% 'Z# ftype%=(ftype%>>8) &FFF '[9 ftype%=&7F5 get_options(printW%,filename$) ']? "OS_File",5,$database%+".PrintRes.PrtOptions" d%=1 '_C get_options(printW%,$database%+".PrintRes.PrtOptions") '`F get_options(printW%,".Resources.PrtOptions") 'b 'c- "!CASE": set_icon(queryW%,1,state%) 'd0 "!EXPAND": set_icon(printW%,11,state%) 'e. "!DATE": set_icon(printW%,19,state%) 'f/ "!UPPER": set_icon(printW%,12,state%) 'g0 "!HEADER": set_icon(printW%,47,state%) 'h0 "!FOOTER": set_icon(printW%,48,state%) 'i/ "!FIRST": set_icon(printW%,10,state%) 'j3 "!UNDERLINE": set_icon(printW%,29,state%) 'k0 "!SHRINK": set_icon(printW%,40,state%) 'l1 "!CONTROL": set_icon(printW%,42,state%) 'm- "!TITLE":$ text(printW%,18)=params$ 'n, "!PAGE":$ text(printW%,16)=params$ 'o1 "!LINESPACE":$ text(printW%,17)=params$ 'p/ "!LMARGIN":$ text(printW%,30)=params$ 'q/ "!TMARGIN":$ text(printW%,32)=params$ 'r. "!SPACER":$ text(printW%,43)=params$ 's0 "!COLWIDTH":$ text(printW%,45)=params$ 't1 "!TEXTWIDTH":$ text(printW%,34)=params$ "!HEADINGS": u(params$) 'w7 "D": select(printW%,2): deselect(printW%,1) 'x3 select(printW%,1): deselect(printW%,2) 'y "!PITCH": '{3 deselect(printW%, selected_esg(printW%,2)) (params$) '} select(printW%,4) '~! select(printW%,7) ! select(printW%,8) select(printW%,6) "!FORMAT": 3 deselect(printW%, selected_esg(printW%,3)) shade(printW%,15, Q P%= params$," "): P%>0 cols$= params$,P%+1):params$= params$,P%-1)) params$ * "VERTICAL": select(printW%,24) ' "TABLE": select(printW%,25) " $ text(printW%,15)=cols$ shade(printW%,15, ' "LABEL": select(printW%,26) select(printW%,23) "!DESTINATION": 3 deselect(printW%, selected_esg(printW%,4)) params$= u(params$) params$ 9 "FILE": select(printW%,39):reportdest$="File" ? "PRINTER": select(printW%,41):reportdest$="Printer" 2 select(printW%,38):reportdest$="Window" 8 TextName$=$database%+".PrintJobs."+ query$,10) "!LABEL": params$+="," I%=1 P%= params$,",") 4 par$= params$,P%-1):params$= params$,P%+1) 7 deselect(labelW%, selected_esg(labelW%,1)) par$ & "1": select(labelW%,0) & "2": select(labelW%,1) " select(labelW%,2) & text(labelW%,4)=par$ & text(labelW%,6)=par$ ' text(labelW%,10)=par$ ' text(labelW%,12)=par$ ' text(labelW%,17)=par$ , set_icon(labelW%,11,(par$<>"")) 4 shade(labelW%,12, selected(labelW%,11)) 5 set_icon(labelW%,13,( u(par$)="ON")) 5 set_icon(labelW%,16,( u(par$)="ON")) "!IMPRESSION": P%= params$," ") P%>0 = ImpCom$= params$,P%-1):modifier$= params$,P%+1)) modifier$ ' "NOT FIRST":firstquery%= ImpCom$=params$ softerror(command$,46) finished%= "Hourglass_Smash" close_file(F) abort_script close_file(F) softerror("",57) wimp_error( "Impulse" handling ----------------------------------------------- Impulse_command_received(token%,params%,object%) 4param$= getstr(params%):object$= getstr(object%) object$="" object$= leaf($database%) token% ### GetPathname. Returns full pathname of object ### leaf($database%) object$: < "Impulse_SendMessage",&202,$database%,,,,,mytask% "No data": D "Impulse_SendMessage",&202,"No database open",,,,,mytask% T "Impulse_SendMessage",&202,"Current database is not "+object$,,,,,mytask% ### Selection. Returns maximum data length ### ClientSep$= param$,1) ? ClientForm$= find_fields(param$,ClientSep$,ClientLength%) extend_named_sliding_block(transanchor%,ClientLength%+1) "Impulse_SendMessage",&202, (ClientLength%),,,,,mytask% ### ParseQuery. Returns title generated by FNparse ### ) $Query%=param$:ClientSearch$= parse "Impulse_SendMessage",&202,Title$,,,,,mytask% ### GetRecord. Returns data specified in Selection according to criteria specified in ParseQuery ### < datalength%= prepare_next_record(param$,!transanchor%) "Impulse_SendMessage",&202,"Ready to receive?",-1,,,transtag%,mytask%,Length% ### PutRecord ### "Impulse_SendMessage",&201,"GetRecord",,,,getrec%,mytask% ### ExpandCode ### P%= param$," ") . code$= param$,P%-1):table$= param$,P%+1) "Impulse_SendMessage",&202, expand(code$,table$,L%,SF$),,,,,mytask% 7,8: ### GetField, GetExpanded ### params%<>-1 D datalength%= prepare_next_field(token%,param$,!transanchor%) \ "Impulse_SendMessage",&202,"Ready to receive?",-1,,,transtag%,mytask%,datalength% : ### Max. length for a Powerbase field is 246 ### ### NextMatch ### move_on_and_continue(key%) move_on_and_continue(key%) S$,J% 7addr= next_match(addr,direction%,Filter$,finished%) finished% F$()="": J%=0 S$+=F$(KF%(key%,J%))+" " text(mergeW%,6)= S$,80): redraw_icon(mergeW%,6) Impulse_reply(replytag%,reply%) abort_merge: reply$= getstr(reply%) replytag% getrec%: ### Reply to GetRecord command. ### "Impulse_FetchData",!transanchor%,Length%,,,,,mytask% mergetag%: ### Merging application replies when all data in document merged ### selected(mergeW%,3) "Impulse_SendMessage",&201,":"+$mergewith%+"."+document$+" Print",,,,printtag%,mytask% printtag%: ### Merging application has printed the current document ### "OS_Byte",229,0 1 mergenum%+=1:$ text(mergeW%,7)= (mergenum%) redraw_icon(mergeW%,7) selected(mergeW%,3) finished% * addr= moveto(key%,addr,direction%) deselect(mergeW%,3) abort_merge close_file(dbasehandle%) addr=ClientPtr% deselect(mergeW%,3) close_it(mergeW%) softerror("",27) wimp_error( Impulse_send(tag%,maxsize%) "Impulse_TransmitData",!transanchor%,datalength%,,,,,mytask% datalength%=0 Impulse_receive(replytag%,expected%,received%) I%,F%,P% transbuff%=!transanchor% transbuff%?received%=13 data$=$transbuff% ### Acknowledge data received (get reason code 19 otherwise!) ### "Impulse_SendMessage",&202,,,,,replytag%,mytask% data$<>"" P%= data$,"#") REC%= data$,P%-1)) data$= data$,P%+1) REC%=-1 REC%=RA% (5. read(fields%,REC%<>RA%,REC%,$database%) (6! I%=1 (ClientForm$) (7$ F%= fnum( ClientForm$,I%,2)) (8< data$<>"" $Rf%(F%)= get_string(data$,ClientSep$) write(fields%,key%) (;R received%=0 "Impulse_SendMessage",&201,"GetRecord",,,,getrec%,mytask% get_string( S$,sep$) P%,F$ S$,sep$) P%>0 F$= S$,P%-1) S$= S$,P%+1) stripspaces(F$) prepare_next_record(key$,transbuff%) ok%,I%,F%,P% dbasehandle%=0 (K, dbasehandle%= ($database%+".Database") (L' ClientPtr%= neighbour(key%,top,1) P%=transbuff% key$ "***": close_file(dbasehandle%) $P%=key$:P%+= ($P%)+1 (T ok%= ClientPtr%<>top (U( REC%= rec_no(k$,key%,ClientPtr%) (V' readsmarray(dbasehandle%,REC%) (ClientSearch$)= (X$ $P%= (REC%)+"#":P%+= ($P%) (Y% I%=1 (ClientForm$) (Z( F%= fnum( ClientForm$,I%,2)) ([, $P%=F$(F%)+ClientSep$:P%+= ($P%) $P%+=ClientSep$:P%+=1 ok%= (_ (`0 ClientPtr%= neighbour(key%,ClientPtr%,1) (b1 P%=transbuff% close_file(dbasehandle%) (d" val$= type(key%):kl%= (key$) (e% ClientPtr%= search(key$,key%,1) ClientPtr%>=0 (g( REC%= rec_no(k$,key%,ClientPtr%) (h' readsmarray(dbasehandle%,REC%) (i" $P%= (REC%)+"#":P%+= ($P%) (j# I%=1 (ClientForm$) (k& F%= fnum( ClientForm$,I%,2)) (l* $P%=F$(F%)+ClientSep$:P%+= ($P%) $P%+=ClientSep$:P%+=1 =P%-transbuff% prepare_next_field(method%,S$,transbuff%) L%,F%,P%,len%,T$,F$,V%,R%,b$,k$,SF$ token% ### GetField ### (w& F%= field(S$, ):V%=chartype%(F%) (yC 0,1,2,3,4,5,6,7,8,46,47,48,49,50,51,52,53,54,55,56,57,58: L%= (F$(F%)) ({D extend_named_sliding_block(transanchor%,(L%+4) &FFFFFFFC) (| transbuff%=!transanchor% (}* $transbuff%=F$(F%):transbuff%?L%=0 36,39: R%= rec_no(k$,key%,addr) / L%= blob_path( ,$database%,R%,F%,V%,b$) L%>0 F extend_named_sliding_block(transanchor%,(L%+4) &FFFFFFFC) " transbuff%=!transanchor% ( "OS_File",255,b$,transbuff% L%=1 7 extend_named_sliding_block(transanchor%,256) " transbuff%=!transanchor% ?transbuff%=0 transbuff%?L%=0 ### GetExpanded ### + P%= S$," "):T$= S$,P%+1):S$= S$,P%-1) 2 F%= field(S$, ):F$= expand(F$(F%),T$,L%,SF$) extend_named_sliding_block(transanchor%,L%+1) transbuff%=!transanchor% 6 $transbuff%=F$:L%= ($transbuff%):transbuff%?L%=0 len%=(L%+4) &FFFFFFFC =len% start_merge ClientPtr%=addr Imp_wait%= text(mergeW%,1)=document$ $Query%="" text(mergeW%,6)="":$ text(mergeW%,7)="" position_window(mergeW%,0,0,0,0,0,0) set_caret(queryW%,0) merge_next(filter%,key%,P%) J%,S$ P%=top finished% selected(mergeW%,3) filter% . dbasehandle%= ($database%+".Database") # record%= rec_no(k$,key%,P%) * readsmarray(dbasehandle%,record%) ! close_file(dbasehandle%) J%=0 S$+=F$(KF%(key%,J%))+" " text(mergeW%,6)= S$,80) redraw_icon(mergeW%,6) "Impulse_SendMessage",&201,":"+$mergewith%+"."+document$+" Merge",,,,mergetag%,mytask% End of "Impulse" handling ------------------------------------------- Import/Export CSV files --------------------------------------------- start_import(type$,wi%) OK%,T%,filename$ "Wimp_GetPointerInfo",,block%:x%=!block%:y%=block%!4 present% fields%=0 OK%= softerror("",69) Modify% OK%= softerror("",14) softerror("",69) T%=0 LastTable% wi%=tableW%(T%) Tablenumber%=T% OK% wi% V select(csvW%,1): select(csvW%,4): shade(csvW%,4, ):csvfunc$="ImportMain" & mainW%:csvfunc$="ImportMain" 6 tableW%(Tablenumber%):csvfunc$="ImportTable" filename$=$ text(csvW%,13) shade(csvW%,0, ( $CSVTitle%="Import "+type$+" file" text(csvW%,9)="Import" wi%=mainW% 7 position_window(csvW%,x%-350,y%-260,0,570,0,0) - position_window(csvW%,0,0,0,0,0,0) auto_csv(on%) on% present%=7 9 autocsvhandle%= ($database%+".PrintJobs.NewData") " select_range(1,fields%, csvform$=printorder$ clear_selection autocsvhandle%>0 # close_file(autocsvhandle%) < "OS_File",18,$database%+".PrintJobs.NewData",&dfe write_csv(Filename$) writingcsv% printorder$<>"" Form$=printorder$ softerror("",34): P%,rec%,examined%,subtotal% end_csv: )csvhandle%= (Filename$):writingcsv%= selected(csvW%,1) csv_head *dbasehandle%= ($database%+".Database") Search$= parse "Hourglass_On" usekey%=-1 selected(savesubW%,6)= # direc%= selected(queryW%,4)+1 $ P%= neighbour(key%,top,direc%) scan_file("P%<>top",key%,file%,3,direc%) # P%= search(useval$,usekey%,1) P%>=0 k$=useval$: scan_file("P%<>top AND k$=useval$",usekey%,file%,3,1) "Hourglass_Off" close_file(csvhandle%) close_file(dbasehandle%) sep$="," type%=&dfe type%=&fff "OS_File",18,Filename$,type% writingcsv%= close_it(savesubW%) end_csv "Hourglass_Smash" close_file(csvhandle%) close_file(dbasehandle%) close_file(F) "OS_File",18,Filename$,&dfe writingcsv%= softerror("",41) wimp_error( csv_head I%,F%,f$,H$,Head$,N% I%=-1 (Form$)-1 ( I%+=2:F%= fnum( Form$,I%,2)):N%+=1 selected(printW%,2) Head$=$ text(mainW%,(desc%(F%))) Head$=Tag$(F%) selected(csvW%,4) Head$= (len%(F%))+" "+Head$+" (chartype%(F%)) chartype%(F%)<>3 chartype%(F%)<>6 selected(csvW%,0) Head$=""""+Head$+"""" N%>1 Head$=sep$+Head$ #csvhandle%,Head$; #csvhandle%,term$; write_csv_rec(R%,Form$,handle%) I%,F%,f$,F$,L%,N%,filename$,len%,base%,SF$ selected(csvW%,3) F$= key2(0,1) ) , selected(csvW%,0) F$=""""+F$+"""" #handle%,F$+sep$; selected(csvW%,22) #handle%, (REC%)+sep$; I%=-1:L%= (Form$)-1 I%0 selected(csvW%,2) )+( N%+=1: N%>1 #handle%,sep$; ),0 selected(csvW%,0) #handle%,""""; )-% blob_to_file(handle%,len%) ).0 selected(csvW%,0) #handle%,""""; )/ 3,6,46,47,54,56,57: F$=F$(F%):N%+=1 )2' F$<>"" selected(csvW%,2) N%>1 F$=sep$+F$ #handle%,F$; )5 41,42,43,44,45: F$=F$(F%):N%+=1 Z%= no_yes(F%,n$,y$) )9" F$=" " F$=y$ F$=n$ ):0 selected(csvW%,0) F$=""""+F$+"""" N%>1 F$=sep$+F$ #handle%,F$; )>! selected(printW%,11) )?/ F$= expand(F$(F%),link$(F%),Len%,SF$) F$=F$(F%) )A N%+=1 )C' F$<>"" selected(csvW%,2) )D0 selected(csvW%,0) F$=""""+F$+"""" N%>1 F$=sep$+F$ #handle%,F$; )G #handle%,term$; convert_csv(f$) k$,B%,J%,fld%,csvhandle%,toobighandle%,S$,sep%,sep2%,term%,term2%,F$,avail%,nextfree%,keybase%,base%,base2%,show%,done% importingcsv% importingcsv%= )Q3toobighandle%= ($database%+".PrintJobs.TooBig") stop_reading: size%=&100:inc%=size% extend_named_sliding_block(tempanchor%,size%) )V:sep%= (sep$): (sep$)=2 sep2%= sep$)) sep2%=255 )W@term%= (term$): (term$)=2 term2%= term$)) term2%=255 csvhandle%= present%=0 csv_to_dbase(f$) Form$= csv_importform "Hourglass_On" limit_actions( selected(csvW%,24) addr=top )`7 selected(csvW%,24): Modify exisitng records )a$ addr= neighbour(key%,addr,1) )b/ addr=top moan_err%, msg("Err131") )c" REC%= rec_no(k$,key%,addr) )d( read(fields%, ,REC%,$database%) )e2 selected(csvW%,22): With record number read_bytes REC%= ($base%) )h( read(fields%, ,REC%,$database%) )i/ selected(csvW%,3): With primary key read_bytes )k* addr= find( $base%,KL%(key%)),0, addr>0 )m$ REC%= rec_no(k$,key%,addr) )n* read(fields%, ,REC%,$database%) make_new_rec )p make_new_rec endline%= :J%=-1 )t# (Form$)-2 endline%= )u& J%+=2:fld%= fnum( Form$,J%,2)) )v! transfer_csv_field(fld%) )x2 fld%<=fields% endline% next_csv_rec write(fields%,key%) ){- selected(csvW%,11) redraw(mainW%) )|? "Hourglass_Percentage", #csvhandle%*100 #csvhandle% "OS_Byte",229,0 #csvhandle% "Hourglass_Off" close_file(csvhandle%) close_file(toobighandle%) scrap_sliding_block(tempanchor%) "OS_File",18,$database%+".PrintJobs.TooBig",&fff addr= moveto(key%,top,1) clear_selection asterisk( write_log(-1,"CSV data imported from "+f$) importingcsv%= limit_actions(Access%) make_new_rec /keybase%=!keyanchor%(0):nextfree%=!keybase% !(keybase%+nextfree%)<=0 incr%= ($Increment%) incr%>0 # change_length(RA%+incr%, # moan_err%, msg("Err66") )REC%=!(keybase%+nextfree%+8+KL%(0)+1) read(fields%, ,RA%,$database%) transfer_csv_field( fld%) chartype%(fld%) 36,39: read_bytes ptr%>0 3 Z%= blob_path( ,$database%,REC%,fld%,36,F$) $ Start%=base%:End%=base%+ptr% " save(F$,&fff,Start%,End%) selected(csvW%,11) chartype%(fld%) < set_blob_sprite(REC%,fld%,chartype%(fld%)) ' show_text_block(fld%) 41,42,43,44,45: read_bytes:c$= pos_neg($base%) 9 " ":$Rf%(fld%)=" ": select(mainW%,field%(fld%)) 9 "":$Rf%(fld%)="": deselect(mainW%,field%(fld%)) "@": #toobighandle%,"Rec."+ (REC%)+",Fld."+ (fld%)+","+$base%+" unsuitable data for check-box":$Rf%(fld%)="": deselect(mainW%,field%(fld%)) 0,1,2,3,4,5,6,7,8,46,47,48,49,50,51,52,53,54,55,56,57,58: len%(fld%)>0 read_bytes ; selected(csvW%,16) $base%= stripspaces($base%) ptr%<=len%(fld%): chartype%(fld%)=47 H selected(csvW%,23) $Rf%(fld%)=$base%:dontincrement%= $Rf%(fld%)=$base% ptr%<247: C #toobighandle%,"Rec."+ (REC%)+",Fld."+ (fld%)+","+$base% $Rf%(fld%)="@" #toobighandle%,"Rec."+ (REC%+1)+",Fld."+ (fld%)+" is more than 246 characters long. Data not saved. External field suggested." $Rf%(fld%)="@" fld%+=1 8 ### Zero-length field is probably just a label :fld%+=1 ### Can't put CSV data into Button, Sprite or Draw fields! ### read_bytes end$,B% base%=!tempanchor%:ptr%=-1 #csvhandle% B%=34 O end$="(B%=sep% OR B%=term% OR EOF#csvhandle%=TRUE) AND base%?(ptr%-1)=34" 7 end$="B%=sep% OR B%=term% OR EOF#csvhandle%=TRUE" #csvhandle%= #csvhandle%-1 B%= #csvhandle% ptr%+=1:base%?ptr%=B% ptr%=size% size%+=inc%: extend_named_sliding_block(tempanchor%,size%) (end$) base%?(ptr%-1)=34 ptr%-=1 base%?ptr%=13 sep%: skip_sep term%: skip_term next_csv_rec B%= #csvhandle% B%=term% skip_term skip_sep sep2%<>255 B%= #csvhandle% B%<>sep2% #csvhandle%= #csvhandle%-1 skip_term term2%<>255 B%= #csvhandle% B%<>term2% #csvhandle%= #csvhandle%-1 endline%= endline%= stop_reading "Hourglass_Off" close_file(csvhandle%) close_file(toobighandle%) close_file(dbasehandle%) "OS_File",18,$database%+".PrintJobs.TooBig",&fff scrap_sliding_block(tempanchor%) =17 softerror("",74) wimp_error( present%=7 addr= moveto(key%,top,1) clear_selection importingcsv%= limit_actions(Access%) csv_importform F%,f$,F$ endline%= selected(csvW%,1): ### Use header record to build form ### read_bytes F%= field($base%, 2 F%=0 moan_err%, msg("Err87,"+$base%) f$= ~(F%) (f$)=1 f$="0"+f$ F$+=f$ " invert(mainW%,field%(F%)) endline% printorder$<>"": ### Build form from highlighted fields, as in printing ### F$=printorder$ ### Assume entry into all fields, beginning with first ### F%=1 fields% f$= ~(F%) (f$)=1 f$="0"+f$ F$+=f$ csv_to_dbase(f$) F%,P%,Q%,FH%,S$,readpos% read_bytes:S$=$base%: #csvhandle%=0 ")=0 moan_err%, msg("Err89") leaf$= leaf(f$):csvconv%= $database%="No data" $database%=dbasepath$+".!"+leaf$ save($database%,0,0,0) fields%=0:endline%= fields%+=1 read_bytes:S$=$base% */" P%= "):Q%= ",P%+1) *0% Tag$(fields%)= S$,P%+1,Q%-P%-1) *1 len%(fields%)= S$,P%-1)) *2% chartype%(fields%)= S$,Q%+1)) endline% scrap_sliding_block(tempanchor%) ($database%+".Form") #FH%,fields% F%=1 fields% xd%=16:xf%=96 yd%=-(F%*52):yf%=yd% *:H #FH%,Tag$(F%),Tag$(F%),xd%,yd%,xf%,yf%,len%(F%),chartype%(F%),0,0 close_file(FH%) "OS_File",18,$database%+".Form",&7f2 fields%=0:Fieldnumber%=0 fields%= get_form(Fptr%) default_key readpos%= #csvhandle% no_of_recs defaults($database%,RA%,0) save_keys deselect(csvW%,1) create_named_sliding_block(tempanchor%,size%) csvhandle%= #csvhandle%=readpos% no_of_recs N%,B% #csvhandle% B%=term% #csvhandle% N%+=1 *Q? "Hourglass_Percentage", #csvhandle%*100 #csvhandle% #csvhandle% --- SLIDING HEAP 2.00 PROCEDURES requires SlidingHeap 2.00 module and PROCs Steven Haslam 1992 _heap_slotsize "Wimp_SlotSize",-1,-1 _heap_numtostr(d%,n%)= d%,"0")+ ~n%,d%) _heap_snumtostr(d%,n%)= d%," ")+ n%,d%) heapsinfo "OS_Heap",1,fixedheapbase% ,,bigbloc%,totfree% "Fixed heap" "----- ----" "Heap base : &"; _heap_numtostr(8,fixedheapbase%) "Heap size : "; _heap_bytes2(fixedheapsize%) "Largest free : "; _heap_bytes2(bigbloc%) "Total free : "; _heap_bytes2(totfree%) "Sliding heap" "------- ----" "SlidingHeap_HeapInfo",slidingheapbase% _heap_pageup(n%) "OS_ReadMemMapInfo" =(n%+R0%-1) (R0%-1) initheaps(heapsize%,slidingblocks%) fixedheapsize%=heapsize% *yLheap_trigger%= _heap_pageup( +fixedheapsize%+20+20*slidingblocks%-&8000) setslotsize(heap_trigger%) _heap_slotsizeheap_trigger% setslotsize(trysize%) _heap_slotsizeheap_trigger% setslotsize(trysize%) heap_trigger%=trysize% !anchor%=0 "SlidingHeap_VerifyHeap",slidingheapbase% setslotsize(newsize%) "Wimp_SlotSize",newsize%,-1 extend_named_sliding_block(anchor%,newsize%) !anchor%=0 create_named_sliding_block(anchor%,newsize%): !anchor%> _heap_nextfree 129,"Block beyond heap limits" $newsize%= _heap_wordup(newsize%) "SlidingHeap_DescribeBlock",slidingheapbase%,anchor% ,,oldsize% larger%=newsize%>oldsize% larger% G trysize%= _heap_pageup( _heap_nextfree+(newsize%-oldsize%)-&7FFC) trysize%>heap_trigger% setslotsize(trysize%) $ _heap_slotsizeheap_trigger% setslotsize(trysize%) heap_trigger%=trysize% "SlidingHeap_VerifyHeap",slidingheapbase% _heap_bytes(b%) end% "OS_ConvertFixedFileSize",b%,block%,block%+&100 ,end% ?end%=13 =$block% _heap_bytes2(b%) end% "OS_ConvertFileSize",b%,block%,block%+&100 ,end% ?end%=13 =$block% create_fixed_block(size%) pointer%,flag% "XOS_Heap",2,fixedheapbase%,,size% ,,pointer%;flag% flag% extendfixedheap "XOS_Heap",2,fixedheapbase%,,size% ,,pointer%;flag% =pointer% extendfixedheap nshb%,extend%,trysize% "OS_ReadMemMapInfo" extend% $trysize%= _heap_slotsize+extend% setslotsize(trysize%) _heap_slotsize.!Run") S$= S$,8)="WimpSlot" close_file(R) S$,"K")-3 #F,"Program + variables: "+ (N%)+"K (Wimpslot = "+ S$,P%,4)+")" @A%=indirectionmem% 1024:N%=((buff%-buffbase%)+1024) 1024 IM%=endbuff%-buff%: M%<1024 (M%)+" bytes" 1024)+"K" #F,"Icon indirection: "+ (A%)+"K allocated, "+M$+" left" + ;A%=menumem% 1024:N%=((menu_ptr%-menblk%)+1024) 1024 MM%=men_end%-menu_ptr%: M%<1024 (M%)+" bytes" 1024)+"K" #F,"Menus: "+ (A%)+"K allocated, "+M$+" left" close_file(F) "OS_File",18,f$,&fff debug(S$) wimp_error( ,254,0,S$)