home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
RISC DISC 1
/
RISC_DISC_1.iso
/
pd_share
/
apps
/
powerbase
/
!Powerbase
/
!RunImage
(
.txt
)
< prev
next >
Encoding:
Amiga
Atari
Commodore
DOS
FM Towns/JPY
Macintosh
Macintosh JP
Macintosh to JP
NeXTSTEP
RISC OS/Acorn
Shift JIS
UTF-8
Wrap
RISC OS BBC BASIC V Source
|
1994-09-17
|
242.3 KB
|
11,119 lines
><PBase$Dir>.!RunImage
!RunImage for !Powerbase database
D.L. & S.R. Haslam
Heap Manager (module + BASIC)
S.R. Haslam
Interface Manager (v.2)
Simon Huntingdon
!version$="5.07 (12-Sep-1994)"
,intversion$="Interface Manager (v.2.00)"
"OS_Byte",202,0,255
,kbdstatus%
fatal_err%=255:moan_err%=254
present%=
,"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$)
wimp_error(
quit%
close_down
"OS_Byte",229,1:
"OS_Byte",124
"Wimp_Poll",mask%,block%
reason%
"Interface_Poll",reason%,,mytask%
reason%
autosave%>0
Access%=
check_save(saveint%*6000)
Imp_wait%
merging%
start_merge
flash%>0
flash(mainW%,field%(flash%))
redraw(!block%)
"Wimp_OpenWindow",,block%
perform_close(!block%)
hourglass(
hourglass(
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%
;M
&200,&201:
token%<>-1
Impulse_command(token%,params%,object%)
</
&202:
Impulse_reply(token%,params%)
=.
&203:
Impulse_send(token%,object%)
>9
&204:
Impulse_receive(token%,params%,object%)
?
message
not_acknowledged
hourglass(on%)
(indexing%
printing%)
!block%=keypadW%
on%
"Hourglass_On"
"Hourglass_Off"
flash(wi%,ic%)
time%
"OS_ReadMonotonicTime"
time%
(time%
50)=0
invert(wi%,ic%)
Shutdown routines ---------------------------------------------------
close_down
:$block%="TASK":
"Wimp_CloseDown",mytask%,!block%:
"Interface_CloseDown",mytask%,!block%:
,"L0 error: "+
$+" during closedown at line "+
"Hourglass_Smash"
exit(0)
"Interface_CloseDown",mytask%
"Impulse_CloseDown",mytask%
$block%="TASK"
"Wimp_CloseDown",mytask%,!block%
"OS_Byte",202,kbdstatus%
exit(exittype%)
flag%
"Hourglass_Smash"
present%=7
check_change
exittype%
warn%
ram%
flag%=
confirm(
msg(63))
flag%=
warn%
flag%=
confirm(
msg(62))
flag%=
flag%=
close_files
exittype%=0
design%
save_form($database%+".Form")
link$(0)="LOADED"
o lk=
($database%+".Link")
F%=1
fields%
#lk,link$(F%)
calc$(0)="LOADED"
u cl=
($database%+".Calc")
F%=1
fields%
#cl,calc$(F%)
key%=0
Keys%
date(key%)
key%
Access%=
present%=7
mouse(0,0,4,keypadW%,19)
close_log("<Log$Dir>.Log")
hide_windows
delete_icons(mainW%,0)
delete_icons(datadicW%,0)
delete_icons(pselectW%,1)
delete_icons(keypadW%,37)
recover_memory
init_vars
I%=0
MaxTabs%
printrel$(I%)=""
field$()=""
$Password%=""
present%=
exit%=
lit(menu%(0),1,
lit(menu%(0),2,
lit(menu%(0),3,
lit(menu%(0),4,
lit(menu%(2),1,
):ptr%=menu%(2)+52:ptr%!4=-1
lit(menu%(6),6,
lit(menu%(6),7,
lit(menu%(6),8,
set_auto(
set_autobalance(
tick(menu%(2),3,
tick(menu%(2),4,
$dbase%="No data"
$database%="No data"
redraw_icon(-2,pbaseicon%)
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(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(undoanchor%)
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(tablemenuanchor%)
I%=0
MaxTabs%
scrap_sliding_block(tabanchor%(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%!8=0:block%!12=wi%:block%!16=ic%
"Interface_SlabButton",,block%
block%!0=err%
return%
err%<>fatal_err%
err%=moan_err%
< type%=&11:
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%)
$(block%+4)=
msg(E%)+E$
!block%=255
"Wimp_ReportError",block%,&11,"Report from Powerbase"
msg(E%)
errorblock%=errormsg%
E%>1
$ errorblock%+=
($errorblock%)+1
E%-=1
$errorblock%,4)
Program initialisation ----------------------------------------------
setup
F,A%,I%,J%,V%,valid$
("<Pbase$Dir>.Resources.Config")
MaxFields%=
MaxFields%>127
fatal_err%,
msg(61)
MaxKeys%=
MaxTabs%=
#F)-1
datesep$=
#F,1)
timesep$=
#F,1)
#F:P%=
S$," "):kill%=
S$,P%-1)="YES")
#F:P%=
S$," "):commoncase%=(
S$,P%-1)="YES")
#F:P%=
S$," "):common%=(
S$,P%-1)="YES")
#F:P%=
S$," "):leftmenu%=(
S$,P%-1)="YES")
#F:P%=
S$," "):
S$,P%-1)="YES"
caps%=128
caps%=16
winback%=
#F:P%=
S$," "):mergewith$=
S$,P%-1)
#F:P%=
S$," "):blankrec%=(
S$,P%-1)="YES")
close_file(F)
dim_arrays(MaxFields%,MaxKeys%,MaxTabs%)
init_vars
------------------ Initialise Wimp ----------------------------
$block%="TASK"
mask%=(1<<11)
"Wimp_Initialise",200,!block%,"Powerbase"
version%,mytask%
version%>=316
RISCOS3=
RISCOS3=
"Impulse_Initialise",003,mytask%,"Powerbase",-1
"Interface_Initialise",mytask%
#Mpbaseicon%=
create_icon(-1,0,-16,144,110,&1700312B,"",dbase%,psprite%,10)
--------- Set up Heap Manager. Load error messages -----------
initheaps(128,128)
"OS_File",5,"<PBase$Dir>.Resources.Messages"
,,,,len%
''errormsg%=
create_fixed_block(len%)
"OS_File",255,"<PBase$Dir>.Resources.Messages",errormsg%
I%=0
len%
errormsg%?I%=10
errormsg%?I%=13
getscreensize(ScreenWidth%,ScreenHeight%)
"OS_Byte",135
,,mode%
mode%
12,15,16,17,35,36:f$="Sprites"
:f$="Sprites22"
"OS_File",5,"<PBase$Dir>.Resources."+f$
,,,,len%
3(sprites%=
create_fixed_block(len%+4)
!sprites%=len%+4
"OS_File",255,"<PBase$Dir>.Resources."+f$,sprites%+4
6&undoanchor%=
create_anchor("Undo")
7)headanchor%=
create_anchor("Heading")
8*lineanchor%=
create_anchor("TextLine")
9&textanchor%=
create_anchor("Text")
:&formanchor%=
create_anchor("Form")
;.sprsanchor%=
create_anchor("DbaseSprites")
<&tempanchor%=
create_anchor("Temp")
=(balanchor%=
create_anchor("Balance")
>'flaganchor%=
create_anchor("Flags")
?/transanchor%=
create_anchor("DataTransfer")
@)selanchor%=
create_anchor("PrintSel")
A*recanchor%=
create_anchor("RecordNum")
B,saveanchor%=
create_anchor("SaveBuffer")
C&logoanchor%=
create_anchor("Logo")
D0fieldmenuanchor%=
create_anchor("FieldMenu")
E0tablemenuanchor%=
create_anchor("TableMenu")
I%=0
MaxKeys%+1
G3 keyanchor%(I%)=
create_anchor("Key #"+
(I%))
I%=0
MaxTabs%
J6 tabanchor%(I%)=
create_anchor("VTable #"+
(I%))
--------------- Read validation strings etc -----------------------
("<Pbase$Dir>.Resources.ValStrings")
vstrings%=
vname$(vstrings%),valid%(vstrings%),rvalid%(vstrings%),hvalid%(vstrings%)
I%=0
vstrings%
vname$(I%)=
#V,4)
valid$=
(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%
close_file(V)
---------------------------------------------------------------
Method structure
PASS=0
P%=methodtable%
[OPT PASS
equd 0
^)
method(0,1,"GetPathname","")
_'
method(0,2,"Selection","")
`(
method(0,3,"ParseQuery","")
a'
method(0,4,"GetRecord","")
b'
method(0,5,"PutRecord","")
c(
method(0,6,"ExpandCode","")
d&
method(0,7,"GetField","")
e)
method(0,8,"GetExpanded","")
f
method(-1,-1,"","")
PASS
create_windows
make_menus
set_auto(
set_autobalance(
get_choices("<Pbase$Dir>.Resources.Choices")
method(Flags,Token,Method$,Syntax$)
[OPT PASS
equd Flags
equd Token
u equs Method$+
v equs Syntax$+
align
y =PASS
dim_arrays(F%,K%,T%)
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),KF%(K%+1,1),KW%(K%+1,3),key$(K%+1),case%(K%+1),incspace%(K%+1),WD%(3),Ext%(10)
Label$(10,2)
Sum(30,5)
key 256,date% 6,calcrow% F%
menu%(22),choice$(4)
table$(T%+1),tabfieldlen%(9),fcol%(6),ncol%(6)
rel%(6)
buttonfield%(22)
MC%=30:
L%(MC%)
-------------------- Allocate buffers ------------------------------
(indirectionmem%=&7000:menumem%=&1400
Mi% 20,Mo% 20
block% &1000,savebuff% &100,choices% &100
buff% indirectionmem%:endbuff%=buff%+indirectionmem%
menblk% menumem%:men_end%=menblk%+menumem%:menu_ptr%=menblk%
hand% 16:$hand%="Pptr_hand,12,8"
paint% 8:$paint%="file_ff9"
writep% 16:$writep%="Pptr_write,4,4"
tick% 12:$tick%="Snull,yes"
dbase% 10:$dbase%="No data"
psprite% 15:$psprite%="S!Powerbase"
menspr% 15,mentxt% 1:$menspr%="Smenu;Z0":$mentxt%=""
winspr% 15,wintxt% 1:$winspr%="Swindow;Z0":$wintxt%=""
methodtable% 256
------------- Indirection addresses for Heap Manager ---------------
keyanchor%(K%+1)
tabanchor%(T%)
printrel$(T%)
box% 16,box2% 16,matrix% 16,origin% 8
init_vars
$getrec%=213:ClientSearch$="TRUE"
>Imp_wait%=
:Impref%=-1:merging%=
:mergenum%=0:document$=""
-mergetag%=214:transtag%=215:printtag%=216
>flash%=
:dup%=
:filter%=
:logosloaded%=
:logging%=
:acl%=
5accessbutton%=0:stop%=
:customise%=
:tablemenu%=0
&displayed%=-1:scratchpad$="":k$=""
TSearch$="TRUE":Filter$="TRUE":searchformula$="ALL":REC%=-1:usekey%=-1:useval$=""
Sreal$="":visible$="":reform$="":val$="":calcfield%=0:savefunc$="":savetofile%=
5password$="":pw%=0:myref%=-1:Type%=0:fieldtype%=1
4printing%=
:indexing%=
:validate%=
:relations%=
;delwarn%=
:autosave%=
:export%=
:csvconv%=
:saveint%=10
&autobalance%=0:balint%=25:added%=0
.present%=0:fields%=0:template%=0:adjust%=
(Listed%=
:writingcsv%=
:calcerror%=
tlk=0:cl=0:V=0:F=0:FH%=0:dbasehandle%=0:csvhandle%=0:texthandle%=0:text%=0:toobighandle%=0:loghandle%=0:handle%=0
$date%=
"movetype%=8:movetype$="Move
hquit%=
:exit%=
:matching%=
:newrec%=
:val%=
:ram%=
:Access%=
:Modify%=
:warn%=
:design%=
:newtree%=
/LenLine%=0:Count%=0:Start%=0:End%=0:Fptr%=0
4Fieldnumber%=0:calclink%=0:Keyfld0%=0:Keyfld1%=0
BLastTable%=-1:Tablenumber%=-1:TabsLoaded$="Tables":table$()=""
5Rows%=0:TabFields%=0:Rec%=0:Match_tag%=1:fast%=10
?keylimit%=1:keylen%=1:LH%=90:file%=0:key%=0:top=8*file%+LH%
+keyfunc$="":fieldfunc$="":Keys%=0:RU%=0
1printorder$="":Form$="":ImpCom$="":margin$=""
uon$=
(27)+
(%10001000)
,Filename$="":extrakeys$="":extratabs$=""
2months$="JanFebMarAprMayJunJulAugSepOctNovDec"
pitch$=
(31)+"9001"
Window handling -----------------------------------------------------
create_windows
"Wimp_OpenTemplate",,"<Pbase$Dir>.Resources.Templates"
'infoW%=
new_window("info",sprites%)
text(infoW%,7)=version$
text(infoW%,8)=intversion$
<keypadW%=
new_window("keypad",sprites%):Title%=block%!72
zsavesubW%=
new_window("savesub",sprites%):SubName%=
text(savesubW%,3):SubSprite%=
val(savesubW%,1):SubTitle%=block%!72
UsaveW%=
new_window("save",1):SaveName%=
text(saveW%,0):SaveSprite%=
val(saveW%,1)
AdatadicW%=
new_window("datadic",sprites%):TabTitle%=block%!72
xaccessW%=
new_window("access",sprites%):UserID%=
text(accessW%,0):Password%=
text(accessW%,1):AccessTitle%=block%!72
qpassW%=
new_window("password",sprites%):Read%=
text(passW%,2):Write%=
text(passW%,3):Manager%=
text(passW%,5)
(aclW%=
new_window("aclist",sprites%)
:mainW%=
new_window("main",sprites%):RecInfo%=block%!72
?keyW%=
new_window("changekey",sprites%):KeyTitle%=block%!72
1F1dkey%=
text(keyW%,0):F2dkey%=
text(keyW%,1)
Wkey%(3)
word%=0
' Wkey%(word%)=
text(keyW%,word%+2)
word%
/Lkey%=
text(keyW%,26):KeyNo%=
text(keyW%,6)
BchangeW%=
new_window("change",sprites%):ChangeTitle%=block%!72
'moveW%=
new_window("move",sprites%)
)tableW%=
new_window("table",sprites%)
linkW%=
new_window("link",sprites%):LinkTitle%=block%!72:Tablename%=
text(linkW%,0):fieldnum%=
text(linkW%,2):expand%=
text(linkW%,10)
VmiscW%=
new_window("misc",sprites%):database%=
text(miscW%,1):$database%="No data"
ic%=2
$ Date%(ic%-2)=
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%)
'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%)
_mergeW%=
new_window("merge",sprites%):ImpulseApp%=
text(mergeW%,16):$ImpulseApp%=mergewith$
PsizeW%=
new_window("size",sprites%):Records%=
text(sizeW%,1):$Records%="100"
.Increment%=
text(sizeW%,3):$Increment%="0"
=csvW%=
new_window("csvfile",sprites%):CSVTitle%=block%!72
"Wimp_CloseTemplate"
common%
commonbuffers
commonbuffers
common(keypadW%,29,matchW%,0)
common(moveW%,7,matchW%,0)
common(changeW%,3,matchW%,0)
common(savesubW%,0,matchW%,0)
common(mergeW%,3,matchW%,0)
common(wi%,ic%,wic%,icc%)
Formula%=
text(wic%,icc%)
;!block%=wi%:block%!4=ic%:
"Wimp_GetIconState",,block%
"Wimp_DeleteIcon",,block%
#block%!28=Formula%:block%!4=wi%
"Wimp_CreateIcon",,block%+4
handle%
commoncase(wi%,ic%)
commoncase%
selected(wi%,ic%)
set_icon(matchW%,16,on%)
set_icon(keypadW%,32,on%)
set_icon(moveW%,9,on%)
set_icon(changeW%,5,on%)
set_icon(savesubW%,5,on%)
set_icon(mergeW%,12,on%)
new_window(name$,sp%)
handle%
"Wimp_LoadTemplate",,block%,buff%,endbuff%,-1,name$,0
,,buff%
name$="main"
block%?35=winback%
block%!64=sp%
"Wimp_CreateWindow",,block%
handle%
=handle%
show_windows
open_window(mainW%)
(present%
7)=7
selected(passW%,9)
9 !block%=keypadW%:
"Wimp_GetWindowState",,block%
5 block%!12=block%!4+660:block%!8=block%!16-328
, block%!20=0:block%!24=0:block%!28=-1
$
"Wimp_OpenWindow",,block%
addr=
moveto(key%,top,1)
Listed%
open_window(listW%)
show_keypad
selected(passW%,9)
$7 !block%=keypadW%:
"Wimp_GetWindowState",,block%
block%!28=-1
"Wimp_OpenWindow",,block%
open_window(whandle%)
block%!0=whandle%
"Wimp_GetWindowState",,block%
block%!28=-1
"Wimp_OpenWindow",,block%
set_height(handle%,height%)
24!block%=handle%:
"Wimp_GetWindowState",,block%
block%!16=block%!8+height%
"Wimp_OpenWindow",,block%
perform_close(wi%)
wi%
mainW%:
close_window(keypadW%)
matchW%:matching%=
calcW%:calclink%=0
keyW%:
design%=
:newtree%=
!block%=0:block%!4=-700
block%!8=506:block%!12=0
"Wimp_SetExtent",keyW%,block%
!block%=keyW%
mergeW%:
"Impulse_SendMessage",&200,":"+mergewith$+"."+document$+" Edit On",,,,-1,mytask%
merging%=
close_window(wi%)
hide_windows
perform_close(mainW%)
perform_close(keypadW%)
perform_close(datadicW%)
perform_close(listW%)
perform_close(matchW%)
perform_close(relateW%)
perform_close(keyW%)
perform_close(reformW%)
perform_close(calcW%)
perform_close(mergeW%)
perform_close(csvW%)
perform_close(passW%)
close_window(whandle%)
!block%=whandle%
"Wimp_CloseWindow",,block%
redraw(handle%)
(margin$)
!block%=handle%
"Wimp_RedrawWindow",,block%
more%
get_origin(block%,x0%,y0%)
more%
draw(x0%,y0%)
handle%<>datadicW%
"Interface_Render3dWindow",,block%
"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%
listW%
y1%=-(block%!40-y0%)
y2%=-(block%!32-y0%)
y1%=y1%
32+1
y2%=y2%
32+1
w. TextPtr%=(!textanchor%)+(y1%-1)*LenLine%
y2%>Count%
y2%=Count%
I%=y1%
draw_line(I%)
TextPtr%+=LenLine%
draw_line(Line%)
x0%,y0%-(Line%-1)*32-4
TextPtr%?L%=12
"OS_WriteN",TextPtr%,LenLine%
Menu handling -------------------------------------------------------
make_menus
menu%(10)=
create_menu(menu_ptr%,260,"Field,Index field...,Analyse months,Global changes>"+
(changeW%)+",Link to table...,Combine fields>"+
(calcW%)+",Start editing,Clear contents,Warn of delete,Save contents>"+
(saveW%)+",Undo changes")
Omenic%=menu%(10)+28+(1*24):AnalyseFunc%=menic%!12:menic%!16=-1:menic%!20=14
Lmenic%=menu%(10)+28+(4*24):CalcFunc%=menic%!12:menic%!16=-1:menic%!20=14
?menu%(13)=
create_menu(menu_ptr%,120,"Interval:,"+
13,"0"))
menic%=menu%(13)+28
>Interval%=menic%!12:menic%!16=buff%:$buff%="A0-9":buff%+=5
0?menic%=?menic%
(1<<2):$Interval%="10 min"
smenu%(12)=
create_menu(menu_ptr%,160,"Save indices,Automatic>"+
(menu%(13))+",Warning>"+
(menu%(13))+",Manual")
menu%(2)=
create_menu(menu_ptr%,265,"Validation,Create table...,~Display table,Show table files,Validate input,Show relations")
tick(menu%(2),3,
tick(menu%(10),7,
menu%(7)=
create_menu(menu_ptr%,260,"Misc.,Batch delete!"+
(moveW%)+",Set passwords...,Colours!"+
(colW%)+",Save indices>"+
(menu%(12))+",Edit template")
Nmenu%(15)=
create_menu(menu_ptr%,90,"Separator,Comma,TAB,CR,LF,"+
13,"0"))
menic%=menu%(15)+28+(4*24)
-Delim%=menic%!12:menic%!16=-1:menic%!20=3
'?menic%=?menic%
(1<<2):$Delim%=""
]menu%(20)=
create_menu(menu_ptr%,90,"Terminator,CR,LF,LF CR,CR LF,CR CR,LF LF,"+
13,"0"))
menic%=menu%(20)+28+(6*24)
.Termin%=menic%!12:menic%!16=-1:menic%!20=3
(?menic%=?menic%
(1<<2):$Termin%=""
string$="Print,Match,Show resources,Show jobs done,Options...,Save options!"+
(saveW%)+",Save query!"+
(saveW%)+",~Numeric fields>"+
(pselectW%)+",~Save selection!"+
(saveW%)+",~Clear selection"
>menu%(6)=
create_menu(menu_ptr%,260,string$+",Select all")
zstring$="Powerbase,Information!"+
(miscW%)+",Field: ''>"+
(menu%(10))+",Print>"+
(menu%(6))+",Validation>"+
(menu%(2))
string2$=",Current key...,Miscellaneous>"+
(menu%(7))+",Show keypad,Export subset!"+
(savesubW%)+",Export CSV!"+
(savesubW%)+",CSV options...,Save choices,Undo changes,Help"
9menu%(1)=
create_menu(menu_ptr%,236,string$+string2$)
#Fieldpos%=menu%(1)+28+(1*24)+12
Jmenu%(4)=
create_menu(menu_ptr%,200,"Print tree,Totals only,Complete")
<menu%(22)=
create_menu(menu_ptr%,120,"Every:,"+
13,"0"))
menic%=menu%(22)+28
;Every%=menic%!12:menic%!16=buff%:$buff%="A0-9":buff%+=5
.?menic%=?menic%
(1<<2):$Every%="25 recs"
Umenu%(21)=
create_menu(menu_ptr%,160,"Balance,Right now,Automatic>"+
(menu%(22)))
menu%(3)=
create_menu(menu_ptr%,300,"Utilities,New primary key...,Adjust format,New record format,Merge database,~Change length>"+
(sizeW%)+",Balance index>"+
(menu%(21))+",Print index>"+
(menu%(4))+",Find duplicates,Warn of duplicates")
menu%(0)=
create_menu(menu_ptr%,266,"\Powerbase,Information>"+
(infoW%)+",New database!"+
(saveW%)+",~Utilities>"+
(menu%(3))+",~Close database,~Abandon database,Save choices,Default choices,Help,Quit")
menu%(9)=
create_menu(menu_ptr%,270,"New database,Design field...,~_Default database,~Save form file!"+
(saveW%)+",~Database size>"+
(sizeW%)+",~Primary key...,~Quit design")
jmenu%(17)=
create_menu(menu_ptr%,200,"Table,Clear,Save!"+
(saveW%)+",Print,Sort,Undo change,Undo all")
Vmenu%(18)=
create_menu(menu_ptr%,250,"List,Save as text!"+
(saveW%)+",Sort,Scrap")
menu$="Data"
I%=0
menu$+=","+vname$(I%)
Bmenu%(8)=
create_menu(menu_ptr%,200,menu$):
tick(menu%(8),1,
menu$="External"
I%=36
menu$+=","+vname$(I%)
Dmenu%(11)=
create_menu(menu_ptr%,180,menu$):
tick(menu%(11),0,
menu$="Check box"
I%=41
menu$+=","+vname$(I%)
Dmenu%(14)=
create_menu(menu_ptr%,180,menu$):
tick(menu%(14),0,
menu$="Stamp"
I%=46
menu$+=","+vname$(I%)
Dmenu%(16)=
create_menu(menu_ptr%,250,menu$):
tick(menu%(16),0,
menu$="Button"
I%=9
menu$+=","+vname$(I%)
Dmenu%(19)=
create_menu(menu_ptr%,270,menu$):
tick(menu%(19),0,
ybar%=96+9*44
field_menu(N%)
F%,P%,L%,D$,F$,icptr%,textptr%
extend_named_sliding_block(fieldmenuanchor%,N%*41+30)
5icptr%=!fieldmenuanchor%:textptr%=icptr%+N%*24+28
$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
F%=1
" F$=
(F%):F$=
(F$)," ")+F$
7 D$=
text(mainW%,desc%(F%)),7):D$+=
(D$)," ")
& F$+=" "+D$+" "+Tag$(F%):L%=
\ !icptr%=0:icptr%!4=-1:icptr%!8=&7000121:icptr%!12=textptr%:icptr%!16=-1:icptr%!20=L%+1
! $textptr%=F$:textptr%+=L%+1
icptr%+=24
icptr%!-24=icptr%!-24
=!fieldmenuanchor%
create_menu(
menu%,width%,list$)
start%,choice$,entries%,item%,P%,Q%,S%,shaded%
start%=menu%
list$,1)="\"
(RISCOS3=
leftmenu%=
list$=
list$,2)
list$,",")
$menu%=
list$,P%-1)
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
Q%=P%+1
P%=
list$,",",Q%)
P%>0
!item%=0:shaded%=0
choice$=
list$,Q%,P%-Q%)
?
choice$,1)="~"
choice$=
choice$,2):shaded%=(1<<22)
A
choice$,1)="_"
choice$=
choice$,2):?item%=?item%
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)
(choice$)<=12
$(item%+12)=choice$
item%!8=&7000021
L%=
(choice$)+1
I item%!12=buff%:$buff%=choice$:buff%+=L%:item%!16=-1:item%!20=L%
item%!8=&7000121
! item%!8=item%!8
shaded%
item%+=24
entries%+=1
P%=0
item%!-24=item%!-24
menu%=item%
menu%>men_end%
0,"Not enough room for menus (internal error code 50)"
=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%
Icon handling -------------------------------------------------------
create_icon(whandle%,xmin%,ymin%,width%,height%,iconflags%,text$,d1%,d2%,d3%)
handle%
block%!0=whandle%
1!block%!4=xmin%:block%!8=ymin%
22block%!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%
B*block%!8=0:block%!12=wi%:block%!16=ic%
icon_bit(bit%,wi%,ic%,on%)
!block%=wi%
block%!4=ic%
on%
:block%!8=0:block%!12=1<<bit%
:block%!8=1<<bit%:block%!12=1<<bit%
"Wimp_SetIconState",,block%
select(wi%,ic%)
!block%=wi%:block%!4=ic%
Q"block%!8=1<<21:block%!12=1<<21
"Wimp_SetIconState",,block%
deselect(wi%,ic%)
!block%=wi%:block%!4=ic%
W block%!8=0:block%!12=(1<<21)
"Wimp_SetIconState",,block%
invert(wi%,ic%)
selected(wi%,ic%)
deselect(wi%,ic%)
select(wi%,ic%)
set_icon(wi%,ic%,on%)
on%
select(wi%,ic%)
deselect(wi%,ic%)
selected(wi%,ic%)
!block%=wi%:block%!4=ic%
"Wimp_GetIconState",,block%
=((block%!24)
(1<<21))>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_writeable(wi%,ic%,d%,r%)
P%,E%,next%
"Wimp_WhichIcon",wi%,block%,&00C0E000,(14<<12)
E%+=4
block%!E%=-1
block%!P%<>ic%
P%<E%
P%+=4
P%=E%
P%-=4
r%=1
P%+4=E%
0:P%=E%
2:P%=-4
:P%+=4*d%
E%:next%=!block%
-4: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))
set_caret(handle%,ic%)
ic%=-1
"Wimp_SetCaretPosition",handle%,ic%
"Wimp_SetCaretPosition",handle%,ic%,0,0,-1,
text_length(handle%,ic%)
alter_flags(dfg%,ffg%,bfg%)
ic%,F%
!block%=mainW%
ic%=0
fields%*2-1
F%=(ic%+1)
1 block%!4=ic%:
"Wimp_GetIconState",,block%
(ic%
2)=1
chartype%(F%)
U
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%
'
39:block%!8=ffg%:len%(F%)=0
B
logosloaded%
block%!8=&0000611E
block%!8=ffg%
:block%!8=bfg%
block%!8=dfg%
block%!12=&FFFFFFFF
"Wimp_SetIconState",,block%
limit_actions(off%)
icon_bit(22,keypadW%,ic%,off%)
buttonfield%(ic%)>0
icon_bit(22,mainW%,field%(buttonfield%(ic%)),off%)
ic%=-1
lit(menu%(10),0,off%)
lit(menu%(10),1,off%)
lit(menu%(10),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%)
validate%
$
chartype%(Fieldnumber%)
/
Leave keyboard status unchanged
&
2,4:
"OS_Byte",202,0,239
#
"OS_Byte",202,16,111
"OS_Byte",118
first_field
I%+=1
(len%(I%)>0
chartype%(I%)<6)
I%>fields%
I%>fields%
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%
(b%
2)<>2
(design%
(wi%=mainW%))
"Interface_SlabButton",,block%
wi%
iconbar_click
accessW%:accessbutton%=ic%
aclW%:
mainW%:
main_click
keypadW%:
keypad_click(wi%,ic%,b%)
saveW%,savesubW%:
save_click(wi%,ic%,b%)
keyW%:
key_click
tableW%:
create_table
linkW%:
link_to_table
passW%:
passwords
printW%:
print_click
matchW%:
match_click(b%,wi%,ic%)
createW%:
create_click
datadicW%:
datadic_click
changeW%:
change_click
moveW%:
move_click
listW%:
list_click(x%,y%,b%,wi%)
colW%:
set_colours
calcW%:
ic%=1
calc_formula($CalcForm%)
labelW%:
ic%
;
icon_bit(22,labelW%,12,
selected(labelW%,11))
%
"Wimp_CreateMenu",,-1
mergeW%:
merge_click
sizeW%:
size_click
csvW%:
csv_click
pselectW%,relateW%,reformW%,infoW%,miscW%:
### No action on these ###
special_click
*block%!8=0:block%!12=wi%:block%!16=ic%
"Interface_SlabButton",,block%
change_click
(b%
%111)=4
ic%
changes(key%)
commoncase(wi%,ic%)
move_click
(b%
%111)=4
ic%
clear
commoncase(wi%,ic%)
csv_click
(b%
%111)
2,4:
ic%
0
show_menu(menu%(15),oldx%+32,oldy%)
0
show_menu(menu%(20),oldx%+32,oldy%)
(b%
%111)
ic%
%6
icon_bit(22,csvW%,4,(
selected(csvW%,1)))
&*
convert_csv($
text(csvW%,13))
'!
close_window(csvW%)
merge_click
(b%
%111)=4
z%=1
z%=-1
ic%
4:ClientPtr%=
merge_next(ClientPtr%,z%)
9:ClientPtr%=
merge_next(ClientPtr%,-z%)
11:ClientPtr%=
merge_next(top,z%)
10:ClientPtr%=
merge_next(top,-z%)
commoncase(wi%,ic%)
"Impulse_SendMessage",&201,":"+mergewith$+"."+document$+" Print",,,,printtag%,mytask%
mergewith$=$ImpulseApp%
"Impulse_SendMessage",&200,":"+mergewith$+"."+document$+" Edit Off",,,,-1,mytask%
mergenum%=0
:C ClientSearch$=
parse($
text(mergeW%,3),
selected(mergeW%,12))
;# ClientPtr%=
merge_next(top,1)
perform_close(mergeW%)
size_click
($Records%)<=0:
softerror("",71)
D, $Records%="100":
redraw_icon(sizeW%,1)
($Increment%)<0
softerror("",72)
G- $Increment%="25":
redraw_icon(sizeW%,3)
present%=7
change_length(
($Records%),
"Wimp_CreateMenu",,-1
datadic_click
ic%>=0
tablefield%=(ic%
(TabFields%+1))
tablefield%=0
%111
R8 !block%=datadicW%:
"Wimp_GetWindowState",,block%
"Wimp_SetCaretPosition",datadicW%,ic%,x%-block%!4+block%!20,y%,-1,-1
show_menu(menu%(17),x%-64,y%-20)
invert(wi%,tablefield%)
field$=
(tablefield%)
selected(wi%,tablefield%)
Y' printrel$(Tablenumber%)+=field$
Z
[+ P%=
printrel$(Tablenumber%),field$)
\] printrel$(Tablenumber%)=
printrel$(Tablenumber%),P%-1)+
printrel$(Tablenumber%),P%+1)
list_click(x%,y%,b%,wi%)
(b%
%111)
2:mousex%=x%:
show_menu(menu%(18),x%-64,y%-20)
!block%=wi%
"Wimp_GetWindowState",,block%
h, line%=(block%!16-block%!24-y%+32)
i* column%=(x%-block%!4+block%!20)
RecPtr%=!recanchor%
R%=RecPtr%!(line%*4)
E%=
(Form$)
R%>=0
n& addr=
find("#"+
(R%),key%,1,
format$
"horiz","table"
N%+=1
s&
Tab%(N%)>column%+1
N%=E%
t$ F%=
fnum(
Form$,N%*2-1,2))
"vert":
N%+=1:line%-=1
x)
RecPtr%!(line%*4)<>R%
N%=E%
y$ F%=
fnum(
Form$,N%*2-1,2))
z"
"tree":F%=KF%(tkey%,0)
"dup":F%=KF%(0,0)
|
};
chartype%(F%)<=10
set_caret(mainW%,field%(F%))
Fieldnumber%=F%
match_click(b%,wi%,ic%)
not%,and%,or%
b%=2
show_menu(menu%(1),x%-64,y%-20):
selected_esg(printW%,4)
38:reportdest$="Window"
39:reportdest$="File"
41:reportdest$="Printer"
ic%
commoncase(wi%,ic%)
selected(wi%,27)
text(wi%,25)="Number found"
text(wi%,25)="Time taken"
redraw_icon(wi%,25)
M searchformula$=$
text(wi%,0):
searchformula$=""
searchformula$="ALL"
D Search$=
parse(searchformula$,
selected(wi%,16)):displayed%=-1
Search$<>"FALSE"
$
text(wi%,14)=""
redraw_icon(wi%,14)
? $SaveName%=$database%+".PrintJobs."+
searchformula$,10)
reportdest$
"Window","Printer":
$
do_it(Search$,displayed%)
"File":
savefunc$="Save list"
4 $SaveSprite%="sfile_fff;Pptr_hand,12,8;B3"
6 !block%=wi%:
"Wimp_GetWindowState",,block%
, xmin%=block%!4+200:ymax%=block%!16
9 !block%=saveW%:
"Wimp_GetWindowState",,block%
; block%!12=xmin%+block%!12-block%!4:block%!4=xmin%
; block%!8=ymax%-block%!16+block%!8:block%!16=ymax%
3 block%!28=-1:
"Wimp_OpenWindow",,block%
set_caret(saveW%,0)
(b%
%111)=4
selected(wi%,27)
close_window(wi%):
set_caret(mainW%,-1)
21,22:
(b%
%111)=4
z%=1
(b%
%111)=1
z%=-1
ic%=21
Match_tag%+=z%
Match_tag%-=z%
Match_tag%>fields%
Match_tag%=1
Match_tag%<1
Match_tag%=fields%
text(wi%,3)=Tag$(Match_tag%)
redraw_icon(wi%,3)
tick_one(fieldmenu%,0,fields%-1,Match_tag%-1)
show_menu(fieldmenu%,oldx%+32,oldy%)
op%=
selected_esg(wi%,1)
op%
5:op$="="
6:op$="{"
7:op$="<"
8:op$=">"
15:op$="<>"
18:op$=">="
19:op$="<="
20:op$="}{"
, not%=
selected(wi%,4):
deselect(wi%,4)
. and%=
selected(wi%,12):
deselect(wi%,12)
- or%=
selected(wi%,13):
deselect(wi%,13)
tag$=$
text(wi%,3)
contents$=$
text(wi%,9)
new$=tag$+op$+contents$
not%
new$="NOT ("+new$+")"
and%
new$+=" AND "
or%
new$+=" OR "
text(wi%,0)=$
text(wi%,0)+new$:
redraw_icon(wi%,0)
text(wi%,9)="":
redraw_icon(wi%,9)
1 $SaveName%=$database%+".PrintJobs."+key$(0)
do_it("",REC%)
(b%
%111)=4
selected(wi%,27)
close_window(wi%):
set_caret(mainW%,-1)
28:$
text(wi%,0)=searchformula$:
redraw_icon(wi%,0):
set_caret(wi%,0)
iconbar_click
%111
selected(passW%,12)
close_window(saveW%)
(
show_menu(menu%(0),x%-64,ybar%)
$dbase%="No data"
$SaveName%="!DataBase"
2 $SaveSprite%="snew_appl;Pptr_hand,12,8;B3"
savefunc$=choice$(1)
1
"Wimp_CreateMenu",,saveW%,x%-50,y%+300
show_windows
main_click
P%,F%,H$,L%,T%,N$,field$
present%=7
adjust%=
validate(Fieldnumber%,T%,N$)=
update_calcs(Fieldnumber%)
flash%
deselect(mainW%,field%(flash%)):flash%=
present%
0,3:
design_field
first_field>0
default_key
design_field
5,7:
adjust%
design_field
identify_field(ic%)
&
relations%=
relations(
2047
close_window(saveW%)
,
selected(passW%,11)
Modify%
set_up_field_menu
,
show_menu(menu%(1),x%-64,y%-20)
&
chartype%(Fieldnumber%)
41,42,43,44,45:
invert(wi%,ic%)
( col%=
get_icon_cols(wi%,ic%)
4 col%=((col%>>4)
(col%<<4))
%11111111
(
set_icon_cols(wi%,ic%,col%)
% boxon%=((col%
%1111)<2)
%
update_selection(boxon%)
&
chartype%(Fieldnumber%)
9
filter(mainW%,field%(buttonfield%(22)))
41,42,43,44,45:
(-2)
)
invert(wi%,ic%):
enter_tag
S
selected(wi%,ic%)
$Rf%(Fieldnumber%)=" "
$Rf%(Fieldnumber%)=""
relations(
256:
&
chartype%(Fieldnumber%)
J
0,1,2,3,4,5,6,7,8,36,39,46,47,48,49,50,51,52,53,54,55,56,57:
invert(wi%,ic%)
1
update_selection(
selected(wi%,ic%))
}
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)
1024:
(-2)
2 block%!8=0:block%!12=wi%:block%!16=ic%
-
"Interface_SlabButton",,block%
enter_tag
(
chartype%(Fieldnumber%)
0,1,2,3,4,5,8:
Fieldnumber%>0
? !block%=mainW%:
"Wimp_GetWindowState",,block%
`
Access%
"Wimp_SetCaretPosition",mainW%,ic%,x%-block%!4+block%!20,y%,-1,-1
{
link$(Fieldnumber%),1)="@"
"OS_CLI","Filer_OpenDir "+
link$(Fieldnumber%),2)
softerror("",91)
I
36,37,38:
edit_blob(Fieldnumber%,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)
match
exit(0)
34:quit%=
'
enter_tag
"Wimp_GetCaretPosition",,block%
wi%=!block%:ic%=block%!4
wi%
matchW%:
ic%<>0
wi%=0
keypadW%:
ic%<>29
wi%=0
mergeW%:
ic%<>3
wi%=0
:wi%=0
wi%<>0
6) $
text(wi%,ic%)+=Tag$(Fieldnumber%)
set_caret(wi%,ic%)
redraw_icon(wi%,ic%)
set_up_field_menu
I%,tabmen%
tabmen%=(LastTable%<>-1)
tabmen%
tick_one(tablemenu%,0,LastTable%,LastTable%+1)
Fieldnumber%>0
lit(menu%(1),1,
$AnalyseFunc%="Analyse"
C- $Fieldpos%="Field: "+Tag$(Fieldnumber%)
$LinkTitle%=Fieldname$
E' $CalcForm%=Tag$(Fieldnumber%)+"="
I%=0
lit(menu%(10),I%,
I V%=chartype%(Fieldnumber%)
5,50,51:
L& isadate%=
lit(menu%(10),1,
M& $AnalyseFunc%="Analyse months"
:isadate%=
is_a_key(Fieldnumber%)>=0
lit(menu%(10),1,
R_
isadate%=
selected(mainW%,field%(Fieldnumber%))
$AnalyseFunc%="Analyse index"
0,1,2,3,4,5:
V!
lit(menu%(10),0,Access%)
W!
lit(menu%(10),2,Access%)
X+
lit(menu%(10),3,Access%
tabmen%)
Y!
lit(menu%(10),4,Modify%)
Z!
lit(menu%(10),5,Access%)
[4 Keyfld0%=Fieldnumber%:Keyfld1%=0:$F2dkey%=""
\# $F1dkey%=Tag$(Fieldnumber%)
]( keylimit%=TextLength%:$KeyNo%=""
^! WD%()=0:keylen%=keylimit%
$Lkey%=
(keylimit%)
J%=0
$Wkey%(J%)=
(WD%(J%))
c* $ChangeTitle%="Field: "+Fieldname$
$
text(changeW%,1)=""
e+
common%
text(changeW%,3)=""
link_status
h!
lit(menu%(10),4,Modify%)
i+
lit(menu%(10),3,Access%
tabmen%)
j!
lit(menu%(10),2,Access%)
k$
calc_link("Calculations",6)
link_status
n!
lit(menu%(10),4,Modify%)
o+
lit(menu%(10),3,Access%
tabmen%)
p!
lit(menu%(10),2,Access%)
q&
calc_link("Combine fields",7)
link_status
s.
46,47,48,49,50,51,52,53,54,55,56,57:
V%=47
u#
lit(menu%(10),4,Modify%)
v)
calc_link("Set base value",47)
w
x!
lit(menu%(10),0,Access%)
y4 Keyfld0%=Fieldnumber%:Keyfld1%=0:$F2dkey%=""
zt
Fieldname$<>Tag$(Fieldnumber%)
$F1dkey%=
Fieldname$,8)+" ("+Tag$(Fieldnumber%)+")"
$F1dkey%=Fieldname$
{( keylimit%=TextLength%:$KeyNo%=""
|! WD%()=0:keylen%=keylimit%
$Lkey%=
(keylimit%)
J%=0
$Wkey%(J%)=
(WD%(J%))
36,39:
D
blob_path(
,$database%,REC%,Fieldnumber%,V%,object$)>=0
#
lit(menu%(10),6,Access%)
lit(menu%(10),7,
lit(menu%(10),8,
$SaveName%="TextFile"
4 $SaveSprite%="sfile_fff;Pptr_hand,12,8;B3"
savefunc$="Save text"
37,40:
D
blob_path(
,$database%,REC%,Fieldnumber%,V%,object$)>=0
#
lit(menu%(10),6,Access%)
lit(menu%(10),7,
lit(menu%(10),8,
$SaveName%="Sprite"
4 $SaveSprite%="sfile_ff9;Pptr_hand,12,8;B3"
! savefunc$="Save sprite"
D
blob_path(
,$database%,REC%,Fieldnumber%,V%,object$)>=0
#
lit(menu%(10),6,Access%)
lit(menu%(10),7,
lit(menu%(10),8,
$SaveName%="DrawFile"
4 $SaveSprite%="sfile_aff;Pptr_hand,12,8;B3"
savefunc$="Save draw"
lit(menu%(1),1,
):$Fieldpos%="Field: ''"
update_selection(add%)
P%,SP%,F%,SF%
"F%=Fieldnumber%:SF%=(F%
128)
-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(menu%(6),7,
lit(menu%(6),8,
$ 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(menu%(6),7,
lit(menu%(6),8,
print_click
(b%
%111)
selected(printW%,26)
show_menu(labelW%,x%-500,y%+200)
1,4:
ic%
23,24,25:
6
icon_bit(22,printW%,15,
selected(printW%,25))
6
icon_bit(22,printW%,45,
selected(printW%,25))
6
icon_bit(22,printW%,15,
selected(printW%,25))
6
icon_bit(22,printW%,45,
selected(printW%,25))
)
show_menu(labelW%,x%-500,y%+200)
=
load_options("<Pbase$Dir>.Resources.PrintOpts")
close_window(printW%)
6
(b%
%111)=1
open_window(matchW%):
match
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$)=
update_calcs(Fieldnumber%)
(b%
%111)
1,4:
(b%
%111)=4
z%=1
z%=-1
ic%
,
scan(z%,
text(keypadW%,23)))
1:stop%=
%
2:addr=
moveto(key%,top,z%)
&
3:addr=
moveto(key%,top,-z%)
&
4:addr=
moveto(key%,addr,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%)
-
rotate:addr=
moveto(key%,top,1)
"
allow_search(wi%,z%)
display(key%,-1)
#
15:addr=
shift(z%,key%,0)
(-1)
* addr=
find("#"+
(REC%),key%,0,
display(key%,addr)
$
16:addr=
shift(-z%,key%,0)
(-1)
* addr=
find("#"+
(REC%),key%,0,
display(key%,addr)
6
17:addr=
shift(0,key%,1):
display(key%,addr)
val_help
6
check_change:
save_keys:
save_all_tables
store
retrieve
!
filter(keypadW%,22)
S$=$
text(keypadW%,27)
#
chartype%(KF%(key%,0))
5,50,51:
?
check_date(S$,1,date$)=
reverse_date(date$)
6
S$<>""
addr=
find(
S$,KL%(key%)),key%,1,
z%=1
!
selected(passW%,9)
= !block%=keypadW%:
"Wimp_GetWindowState",,block%
9 block%!12=block%!4+660:block%!16=block%!8+328
# block%!20=0:block%!24=0
(
"Wimp_OpenWindow",,block%
%
close_window(keypadW%)
#
text(keypadW%,29)<>""
D Filter$=
parse($
text(keypadW%,29),
selected(keypadW%,32))
filter%=
# addr=
moveto(key%,top,z%)
filter%=
!
commoncase(wi%,ic%)
H
"OS_Byte",202,0,239:
show_menu(specmenu%,oldx%+32,oldy%)
$
open_window(specialW%)
scan(z%,s%)
stop%=
addr=
moveto(key%,addr,z%)
K%=
stop%
store
wi%,ic%
"Wimp_GetCaretPosition",,block%
wi%=!block%:ic%=block%!4
wi%=mainW%
scratchpad$=$
text(wi%,ic%)
retrieve
wi%,ic%,field%
"Wimp_GetCaretPosition",,block%
wi%=!block%:ic%=block%!4
scratchpad$<>""
wi%=mainW%
field%=
get_field(ic%)
20 $
text(wi%,ic%)=
scratchpad$,len%(field%))
redraw_icon(wi%,ic%)
### Binary Large Objects (B.L.O.B.s) ###
blob_path(create%,f$,R%,F%,V%,
O$,main$,level1$,level2$,d%,L%
36,39:O$=".Memo"
37,40:O$=".Sprite"
38:O$=".Draw"
main$=f$+O$+
A"level1$=main$+"."+
4900)
B"level2$=level1$+"."+
b$=level2$+"."+
"OS_File",5,b$
d%,,,,L%
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$
N#L%=
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%)
L%>0
"OS_GBPB",2,F,!tempanchor%,L%
copy_blob(source$,dest$,RS%,RD%,FS%,FD%,V%)
L%,Z%,bs$,bd$
[+L%=
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%
delwarn%=
"OS_CLI","Delete "+F$:flag%=
confirm("Delete object? Are you sure?")
g(
"OS_CLI","Delete "+F$:flag%=
flag%
chartype%(F%)
l)
36:$
val(wi%,ic%)="Z0;Ssm!edit"
m*
37:$
val(wi%,ic%)="Z0;Ssm!paint"
n)
38:$
val(wi%,ic%)="Z0;Ssm!draw"
39:$
text(wi%,ic%)=""
redraw_icon(wi%,ic%)
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%))="Z0;Pptr_ext,8,4;S"+sprite$
redraw_icon(mainW%,field%(F%))
edit_blob(F%,V%)
wi%,ic%,b$,O$,val$
check_change
wi%=mainW%:ic%=field%(F%)
36:O$="Memo":val$="Z0;Ssmall_fff":ftype%=&fff
37:O$="Sprite":val$="Z0;Ssmall_ff9":ftype%=&ff9
38:O$="Draw":val$="Z0;Ssmall_aff":ftype%=&aff
blob_path(
,$database%,REC%,F%,V%,b$)<0
val(wi%,ic%)=val$
"OS_CLI","Copy <PBase$Dir>.Resources.Objects."+O$+" "+b$+" ~C~V"
redraw_icon(wi%,ic%)
4block%!0=256:block%!12=0:block%!16=5:block%!20=0
3block%!24=0:block%!28=0:block%!32=0:block%!36=0
)block%!40=ftype%:$(block%+44)=b$+
"Wimp_SendMessage",18,block%,0
transfer_blob(wi%,ic%,file$,ft%)
F%,V%,L%,W%,b$
wi%<>mainW%
check_change
#F%=(ic%+1)
2:V%=chartype%(F%)
ft%=-1
link$(F%)="@"+file$:link$(0)="LOADED"
ft%=&fff
install_blob:$
val(wi%,ic%)="Z0;Ssmall_fff"
ft%=&ff9
install_blob:$
val(wi%,ic%)="Z0;Ssmall_ff9"
ft%=&aff
install_blob:$
val(wi%,ic%)="Z0;Ssmall_aff"
ft%=&fff
install_blob:
show_text_block(F%)
ft%=&ff9
install_blob:
show_picture(F%)
redraw_icon(wi%,ic%)
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%
<x%=block%!8:y%=block%!12:w%=block%!16-x%:h%=block%!20-y%
"Wimp_DeleteIcon",,block%
len%>=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%,ic%)
h%,ox%,oy%
wi%
keypadW%:h%=530:ox%=0:oy%=0
mainW%:h%=200:ox%=0:oy%=-330
selected(wi%,ic%)
7 !block%=keypadW%:
"Wimp_GetWindowState",,block%
2 block%!12=block%!4+660:block%!8=block%!16-h%
! block%!20=ox%:block%!24=oy%
"Wimp_OpenWindow",,block%
common%
text(keypadW%,29)=""
set_caret(keypadW%,29)
text(keypadW%,29)<>""
B Filter$=
parse($
text(keypadW%,29),
selected(keypadW%,32))
filter%=
! addr=
moveto(key%,top,z%)
filter%=
wi%=keypadW%
9 !block%=keypadW%:
"Wimp_GetWindowState",,block%
5 block%!12=block%!4+660:block%!8=block%!16-330
block%!20=0:block%!24=0
$
"Wimp_OpenWindow",,block%
!
close_window(keypadW%)
filter%=
fast_wind(T%,P%,D%)
fast%=
text(keypadW%,23))
D%=(D%+1)
P%<>T%
I%<fast%
filter%
next_match(P%,D%,Filter$)
neighbour(key%,P%,D%)
I%+=1
P%=T%
filter%
7:P%=
neighbour(key%,P%,1-D%)
display(key%,P%)
subfile(dir%)
file%+=dir%
file%=6
file%=0
file%=-1
file%=5
top=8*file%+LH%
addr=
moveto(key%,top,1)
allow_search(wi%,e%)
w%,ox%,oy%
select(keypadW%,24):
deselect(keypadW%,25)
select(keypadW%,25):
deselect(keypadW%,24)
deselect(keypadW%,22)
buttonfield%(22)>0
deselect(mainW%,field%(buttonfield%(22)))
filter%=
text(keypadW%,27)="":$
text(keypadW%,36)=""
text(keypadW%,33)=Index$(key%)
wi%
keypadW%:w%=1000:ox%=0:oy%=0
mainW%:w%=340:ox%=660:oy%=0
5!block%=keypadW%:
"Wimp_GetWindowState",,block%
0block%!12=block%!4+w%:block%!8=block%!16-328
block%!20=ox%:block%!24=oy%
"Wimp_OpenWindow",,block%
set_caret(keypadW%,27)
val_help
name$
Fieldnumber%>0
! name$=
link$(Fieldnumber%))
(name$)<58
(name$)<>-1
name$=
name$,2)
' Tablenumber%=
table_number(name$)
Tablenumber%<>-1
show_table(Tablenumber%)
val_on_off
validate%=
validate%
tick(menu%(2),3,validate%)
I%=1
validate%
+$
:$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":
A Type%=&fff:savetofile%=
"Save text":
Type%=&fff:
D= len%=
blob_path(
,$database%,REC%,Fieldnumber%,36,f$)
E7
extend_named_sliding_block(saveanchor%,len%+1)
F(
"OS_File",255,f$,!saveanchor%
G, Start%=!saveanchor%:End%=Start%+len%
"Save sprite":
Type%=&ff9
J= len%=
blob_path(
,$database%,REC%,Fieldnumber%,37,f$)
K7
extend_named_sliding_block(saveanchor%,len%+1)
L(
"OS_File",255,f$,!saveanchor%
M, Start%=!saveanchor%:End%=Start%+len%
"Save draw":
Type%=&aff
P= len%=
blob_path(
,$database%,REC%,Fieldnumber%,38,f$)
Q7
extend_named_sliding_block(saveanchor%,len%+1)
R(
"OS_File",255,f$,!saveanchor%
S, Start%=!saveanchor%:End%=Start%+len%
"Save options":
Type%=&7f5
"Save query":
WC Start%=
text(matchW%,0):End%=Start%+
($Start%)+1:Type%=&7f4
"Save selection":
Y1 P%=savebuff%:$P%=printorder$:P%+=
($P%)+1
T%=0
LastTable%
[' $P%=printrel$(T%):P%+=
($P%)+1
]> Start%=savebuff%:End%=Start%+P%-savebuff%+1:Type%=&7F3
"Save table":
_G $TabTitle%=
table_info(T%,Rows%,TabFields%,Rec%,tabfieldlen%())
`D Start%=!tabanchor%(T%):End%=Start%+160+Rows%*Rec%:Type%=&7f1
"Save form file":
Type%=&7f2
lit(menu%(9),3,
lit(menu%(9),4,
e3
adjust%=
first_field>0
default_key
savesubW%:
savefunc$
"Export subset":
j# Filename$=$SubName%:Type%=0
"Export CSV":
l& Filename$=$SubName%:Type%=&dfe
ic%
(b%
%11110000)>0
init_drag(wi%,ic%,5)
Filename$,".")>0
tY
butt%<>2
save(Filename$,Type%,Start%,End%):
write_log(-1,Filename$+" saved")
u,
butt%=4
"Wimp_CreateMenu",,-1
softerror("",33)
butt%=2
butt%=4
show_menu(menu%(15),x%-64,y%-20)
butt%=2
butt%=4
show_menu(menu%(20),x%-64,y%-20)
commoncase(wi%,ic%)
key_click
%111
4:z%=1
1:z%=-1
ic%
kcycle(Keyfld0%,F1dkey%,0,z%)
kcycle(Keyfld0%,F1dkey%,0,-z%)
kcycle(Keyfld1%,F2dkey%,1,z%)
kcycle(Keyfld1%,F2dkey%,1,-z%)
tick_one(fieldmenu%,0,fields%-1,Keyfld0%-1)
show_menu(fieldmenu%,oldx%+32,oldy%):fieldfunc$="first"
tick_one(fieldmenu%,0,fields%-1,Keyfld1%-1)
show_menu(fieldmenu%,oldx%+32,oldy%):fieldfunc$="second"
shade_key_icons(
selected(keyW%,24),
selected(keyW%,24),
selected(keyW%,24)
set_caret(keyW%,26)
set_caret(keyW%,2)
keyfunc$<>"Current key"
/ keylimit%=len%(Keyfld0%)+len%(Keyfld1%)
J%=0
WD%(J%)=
($Wkey%(J%))
9 keylen%=
(WD%()):
keylen%=0
keylen%=
($Lkey%)
/
keylen%>keylimit%:
softerror("",26)
(
keylen%=0:
softerror("",105)
keyfunc$
"Primary key":
key%=0
copy_keydata(key%)
* RA%=
($Records%):f$=$database%
&
make_empty_index(RA%,0,
*
save_recs(f$+".Database",RA%)
! present%=7:
save_keys
$ design%=
get_it_in(f$)
0
"New primary key":
new_tree(file%)
)
"Index field":
create_index
keyfunc$=""
close_window(keyW%)
shade_key_icons(con%,wd%,len%,case%)
icon_bit(22,keyW%,20,case%)
icon_bit(22,keyW%,26,len%)
I%=16
icon_bit(22,keyW%,I%,con%)
icon_bit(22,keyW%,7,con%)
icon_bit(22,keyW%,21,con%)
icon_bit(22,keyW%,22,con%)
icon_bit(22,keyW%,24,con%)
icon_bit(22,keyW%,28,con%)
I%=2
icon_bit(22,keyW%,I%,wd%)
kcycle(
F%,T%,icon%,z%)
F%+=z%
F%>fields%
F%=0
F%<0
F%=fields%
F%>0
$T%=Tag$(F%)
$T%=""
redraw_icon(keyW%,icon%)
tick_one(fieldmenu%,0,fields%-1,F%-1)
copy_keydata(key%)
-KF%(key%,0)=Keyfld0%:KF%(key%,1)=Keyfld1%
KL%(key%)=keylen%
J%=0
KW%(key%,J%)=WD%(J%)
#case%(key%)=
selected(keyW%,20)
set_keydata(key%)
J%,S$
-Keyfld0%=KF%(key%,0):Keyfld1%=KF%(key%,1)
$F1dkey%=Tag$(Keyfld0%)
KF%(key%,1)>0
$F2dkey%=Tag$(Keyfld1%)
$F2dkey%=""
'keylen%=KL%(key%):$Lkey%=
(keylen%)
J%=0
0 WD%(J%)=KW%(key%,J%):$Wkey%(J%)=
(WD%(J%))
$KeyNo%=
(key%)
set_icon(keyW%,20,case%(key%))
set_icon(keyW%,24,
(WD%())=0)
set_icon(keyW%,28,incspace%(key%))
key_select(D%)
colour(key%,2)
+1:key%=(key%+1)
(Keys%+1)
-1:key%-=1:
key%<0
key%=Keys%
colour(key%,1)
set_keydata(key%)
text(keypadW%,33)=Index$(key%):
redraw_icon(keypadW%,33)
top=8*file%+LH%
addr=
moveto(key%,top,1)
set_colours
ic%
0,1,2,3,4,5,6:
col%=ncol%(ic%)
fb%=
selected_esg(colW%,2)
fb%
#
11:col%=(col%
&F):fb%=1
(
12:col%=((col%>>4)
&F):fb%=0
%111
" col%-=1:
col%<0
col%=15
$
dcolour(colW%,ic%,col%,fb%)
col%=(col%+1)
$
dcolour(colW%,ic%,col%,fb%)
* ncol%(ic%)=
get_icon_cols(colW%,ic%)
9,10:
fcol%()=ncol%()
I%=0
Keys%
colour(I%,2)
colour(0,0)
colour(key%,1)
I%=1
fields%
D
link$(I%)<>""
set_icon_cols(mainW%,field%(I%),ncol%(6))
ic%=10
write_colours
"Wimp_CreateMenu",,-1
read_colours("<Pbase$Dir>.Resources.Colours")
I%=0
*
set_icon_cols(colW%,I%,ncol%(I%))
create_click
Calc$
butt%=(b%
%111)
butt%
2,4:
ic%=36
show_menu(menu%(menunumber%),oldx%+32,oldy%)
butt%=4
z%=1
butt%=1
z%=-1
ic%
set_limits(0,0,8,8)
set_limits(36,36,40,11)
set_limits(9,9,35,19)
set_limits(41,41,45,14)
set_limits(46,46,59,16)
change_type(z%,menunumber%)
change_type(-z%,menunumber%)
create_field(
($InsText%),posx%,posy%,Calc$)
remove_field(Fieldnumber%,
,Calc$)
create_field(Fieldnumber%,posx%,posy%,Calc$)
remove_field(Fieldnumber%,
,Calc$)
icon_bit(22,createW%,13,(
selected(createW%,14)))
F%=
($InsText%)
F%>0
F%<=fields%
-(
F%<Fieldnumber%
Z%=-1
Z%=1
.(
re_sequence(Fieldnumber%,F%,Z%)
close_window(createW%)
swap_fields(Fieldnumber%,
($InsText%))
update_box
(present%
4)=0
lit(menu%(9),1,(fields%>0))
ic%
18,29,30:
butt%=4
close_window(createW%)
9
:#
icon_bit(22,createW%,18,
;+
icon_bit(22,createW%,30,
adjust%)
<#
icon_bit(22,createW%,29,
Fieldnumber%=fields%
update_box
fieldtype%
0,1,2,3,4,5,6,7,46,47:
adjust%
icon_bit(22,createW%,6,
icon_bit(22,createW%,6,
icon_bit(22,createW%,14,(fieldtype%=3
fieldtype%=6))
icon_bit(22,createW%,13,(fieldtype%=3
fieldtype%=6)
selected(createW%,14))
icon_bit(22,createW%,15,(fieldtype%=3
fieldtype%=47))
icon_bit(22,createW%,25,(fieldtype%=3))
icon_bit(22,createW%,26,
adjust%)
adjust%
lit(menu%(9),2,(fields%>0))
M $ValText%=vname$(fieldtype%)
redraw_icon(createW%,28)
set_limits(t%,f%,l%,m%)
fieldtype%=t%
firsttype%=f%
lasttype%=l%
menunumber%=m%
tick_one(menu%(m%),0,l%-f%,t%-f%)
update_box
change_type(d%,m%)
1:fieldtype%+=1
fieldtype%>lasttype%
fieldtype%=firsttype%
-1:fieldtype%-=1
fieldtype%<firsttype%
fieldtype%=lasttype%
tick_one(menu%(m%),0,lasttype%-firsttype%,fieldtype%-firsttype%)
update_box
passwords
ic%
$Write%=""
$Write%=$Read%
$Manager%=""
$Manager%=$Write%
k F=
($database%+".Colours")
#F=35
m" S$=
encrypt($Read%,
#F,S$
n# S$=
encrypt($Write%,
#F,S$
o% S$=
encrypt($Manager%,
#F,S$
I%=9
q
selected(passW%,I%)
close_file(F)
lit(menu%(1),6,
selected(passW%,9))
lit(menu%(1),7,
selected(passW%,13))
lit(menu%(1),8,
selected(passW%,13))
lit(menu%(1),2,
selected(passW%,14))
lit(menu%(3),8,
selected(passW%,15))
selected(passW%,9)
close_window(keypadW%)
|
}9 !block%=keypadW%:
"Wimp_GetWindowState",,block%
~5 block%!12=block%!4+660:block%!8=block%!16-328
block%!20=0:block%!24=0
$
"Wimp_OpenWindow",,block%
close_window(passW%)
warn%=
selected(passW%,16)
$
open_log("<Log$Dir>.Log",
%
close_log("<Log$Dir>.Log")
selected(passW%,16)
write_log(-1,"Logging disabled")
text(aclW%,0)="":$
text(aclW%,1)=""
open_window(aclW%):
set_caret(aclW%,0)
F,id$,p$,p%,ptr%,user$,passwd$
(b%
%111)
ic%
!
close_window(aclW%)
5
text(aclW%,0)<>""
text(aclW%,1)<>""
.
text(aclW%,1)=$
text(aclW%,12)
1 user$=
encrypt(
text(aclW%,0)),
3 passwd$=
encrypt(
text(aclW%,1)),
acl%
" F=
("<Acl$Dir>.acl")
ptr%=
#F,id$,p$,p%
" found%=(id$=user$)
found%
2
found%
#F=ptr%:
(id$),"Z")
$
("<Acl$Dir>.acl")
acl%=
6
#F,user$,passwd$,
selected_esg(aclW%,1)-3
close_file(F)
(b%
%111)=1
3 $
text(aclW%,0)="":$
text(aclW%,1)=""
9
redraw_icon(aclW%,0):
redraw_icon(aclW%,1)
!
set_caret(aclW%,0)
$
close_window(aclW%)
softerror("",108)
2 $
text(aclW%,1)="":$
text(aclW%,12)=""
8
redraw_icon(aclW%,1):
redraw_icon(aclW%,12)
set_caret(aclW%,1)
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$Dir>.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"
B $SaveName%=$database%+".PrintJobs.DateAn"+Tag$(Fieldnumber%)
/ Title$="Analysis of index: "+Index$(key%)
8 Heading$=
pad(margin$+"Contents",Tab%(0))+"Number"
A $SaveName%=$database%+".PrintJobs.IndAn"+Tag$(Fieldnumber%)
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"
close_window(datadicW%)
Count%=0
list_head(0)
"Hourglass_On"
func%<0
analyse_date
analyse_index
"Hourglass_Off"
rule_off(45)
;Line$=
pad(margin$+"Total",Tab%(0))+
justify(
(N%),1,0)
@$(!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%)
0E
k$<>K$
ptr%+=1:K$=k$:S$(ptr%)=K$:N%(ptr%)=1
N%(ptr%)+=1
1 P%=
neighbour(key%,P%,1)
I%=1
ptr%
4I S$=S$(I%):
S$=""
S$="<null>"
isadate%
reverse_date(S$)
5H Line$=margin$+S$:Line$=
pad(Line$,Tab%(0))+
justify(
(N%(I%)),1,0)
6B $(!lineanchor%)=Line$:
list_line(-1,lineanchor%,
(Line$),32)
N%+=N%(I%)
analyse_date
S$(12),N%(12)
=YS$()="<null>","Jan","Feb","Mar","Apr","May","Jun","Jul","Aug","Sep","Oct","Nov","Dec"
>*dbasehandle%=
($database%+".Database")
neighbour(key%,top,1)
P%<>top
R%=
rec_no(k$,key%,P%)
B#
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
ML Line$=margin$+S$(I%):Line$=
pad(Line$,Tab%(0))+
justify(
(N%(I%)),1,0)
NB $(!lineanchor%)=Line$:
list_line(-1,lineanchor%,
(Line$),32)
N%+=N%(I%)
update_stats
$filesize%=
(RA%)
$Records%=
(RA%)
$used%=
(RU%)
W#$percent%=
(RU%*100/RA%))+"%"
Keypress processing --------------------------------------------------
set_keyboard(wi%,ic%)
validate%
wi%
mainW%:
`!
chartype%((ic%+1)
a-
Leave keyboard status unchanged
b$
2,4:
"OS_Byte",202,0,239
c!
"OS_Byte",202,16,111
e'
accessW%:
"OS_Byte",202,0,239
f"
"OS_Byte",202,caps%,111
"OS_Byte",118
process_key
printing%
indexing%
T%,N$
"Wimp_GetCaretPosition",,block%
o4wi%=block%!0:ic%=block%!4:key_pressed%=block%!24
wi%
mainW%:
main_press
keypadW%:
keypad_press
passW%:
dbox_press(4)
aclW%:
dbox_press(9)
changeW%:
dbox_press(4)
tableW%:
dbox_press(26)
saveW%:
dbox_press(2)
x
datadicW%:
datadic_press
printW%:
dbox_press(20)
labelW%:
dbox_press(15)
createW%:
create_press
accessW%:
dbox_press(3)
keyW%:
dbox_press(7)
~
savesubW%:
dbox_press(2)
matchW%:
match_press
moveW%:
dbox_press(8)
calcW%:
dbox_press(1)
mergeW%:
dbox_press(7)
sizeW%:
dbox_press(4)
csvW%:
dbox_press(9)
keypad_press
key_pressed%=13
ic%
!
mouse(0,0,4,wi%,28)
!
mouse(0,0,4,wi%,30)
"Wimp_ProcessKey",key_pressed%
main_press
selected(passW%,10)
"Wimp_ProcessKey",key_pressed%:
icon%
flash%
deselect(mainW%,field%(flash%)):flash%=
key_pressed%<>392
validate(Fieldnumber%,T%,N$)=
update_calcs(Fieldnumber%)
key_pressed%
394:
show_keypad
wi%
mainW%:
"
Fieldnumber%=fields%
#
close_window(relateW%)
display(key%,-1)
E Fieldnumber%+=1:
Fieldnumber%>fields%
Fieldnumber%=1
( c%=chartype%(Fieldnumber%)
2
len%(Fieldnumber%)>0
(c%<6
c%=8)
& icon%=field%(Fieldnumber%)
$
set_caret(mainW%,icon%)
*
relations%=
relations(
398:
? Fieldnumber%+=1:
Fieldnumber%>fields%
Fieldnumber%=1
" c%=chartype%(Fieldnumber%)
len%(Fieldnumber%)>0
(c%<6
c%=8)
icon%=field%(Fieldnumber%)
set_caret(mainW%,icon%)
relations%=
relations(
399:
? Fieldnumber%-=1:
Fieldnumber%<1
Fieldnumber%=fields%
" c%=chartype%(Fieldnumber%)
len%(Fieldnumber%)>0
(c%<6
c%=8)
icon%=field%(Fieldnumber%)
set_caret(mainW%,icon%)
relations%=
relations(
389:
Access%
show_menu(changeW%,500,600)
405:
(printorder$)=2
B Fieldnumber%=
fnum(printorder$):V%=chartype%(Fieldnumber%)
36,39:
F
blob_path(
,$database%,REC%,Fieldnumber%,V%,object$)>=0
set_up_field_menu
&
show_menu(saveW%,500,600)
408:
val_on_off
387:
mouse(0,0,4,keypadW%,2)
403:
mouse(0,0,4,keypadW%,3)
386:
mouse(0,0,4,keypadW%,4)
402:
mouse(0,0,4,keypadW%,5)
391:
mouse(0,0,4,keypadW%,6)
407:
mouse(0,0,4,keypadW%,7)
393:
mouse(0,0,4,keypadW%,8)
409:
mouse(0,0,4,keypadW%,9)
388:
mouse(0,0,4,keypadW%,10)
404:
mouse(0,0,4,keypadW%,11)
420:
mouse(0,0,4,keypadW%,12)
385:
mouse(0,0,4,keypadW%,13)
401:
mouse(0,0,1,keypadW%,13)
458:
mouse(0,0,4,keypadW%,14)
390:
mouse(0,0,4,keypadW%,15)
406:
mouse(0,0,4,keypadW%,16)
422:
mouse(0,0,4,keypadW%,17)
392:
mouse(0,0,4,keypadW%,18)
384:
print_this
400:
match
416:
open_window(printW%)
"Wimp_ProcessKey",key_pressed%
validate%
chartype%(Fieldnumber%)
-
Leave keyboard status unchanged
$
2,4:
"OS_Byte",202,0,239
!
"OS_Byte",202,16,111
"OS_Byte",118
"OS_Byte",15,0
dbox_press(ok%)
key_pressed%
next_writeable(wi%,ic%,1,1)=
mouse(0,0,4,wi%,ok%)
close_window(wi%):
set_caret(mainW%,-1)
398:f%=
next_writeable(wi%,ic%,1,0)
399:f%=
next_writeable(wi%,ic%,-1,0)
"Wimp_ProcessKey",key_pressed%
datadic_press
icons%
icons%=Rows%*(TabFields%+1)
key_pressed%
ic%<icons%-1
set_caret(datadicW%,ic%+1)
398:
ic%<icons%-TabFields%-1
set_caret(datadicW%,ic%+TabFields%+1)
399:
ic%>=TabFields%+1
set_caret(datadicW%,ic%-TabFields%-1)
"Wimp_ProcessKey",key_pressed%
create_press
shaded(wi%,29):
shaded(wi%,18)
dbox_press(18)
shaded(wi%,29)
dbox_press(29)
match_press
key_pressed%
mouse(0,0,4,matchW%,1)
close_window(matchW%):
"Wimp_SetCaretPosition",mainW%,-1
384:
print_this
"Wimp_ProcessKey",key_pressed%
menu_select
handle%,P%,Q%,I%
&choice1%=!block%:choice2%=block%!4
(choice3%=block%!8:choice4%=block%!12
"Wimp_DecodeMenu",,menuhandle%,block%,choices%
I%=1
Q%=
$choices%,".",P%+1)
& choice$(I%)=
$choices%,P%,Q%-P%)
P%=Q%+1
"Wimp_GetPointerInfo",,block%
redo%=block%!8=1
menuhandle%
menu%(0):
choice$(1)
8
"Help":
"Wimp_StartTask","<Pbase$Dir>.!Help"
!G
"Save choices":
save_choices("<Pbase$Dir>.Resources.Choices")
"J
"Default choices":
get_choices("<Pbase$Dir>.Resources.Defaults")
"Utilities":
choice$(2)
"New primary key":
$KeyTitle%=choice$(2)
'- keyfunc$=choice$(2):
set_keydata(0)
(I
shade_key_icons(
selected(keyW%,24),
selected(keyW%,24),
(present%
2)=2
*/
select(keyW%,8):
deselect(keyW%,9)
+;
icon_bit(22,keyW%,8,
icon_bit(22,keyW%,9,
-/
select(keyW%,9):
deselect(keyW%,8)
.;
icon_bit(22,keyW%,8,
icon_bit(22,keyW%,9,
0
set_height(keyW%,700)
1J
selected(keyW%,24):
set_caret(keyW%,26)
set_caret(keyW%,2)
2
"New record format":
3!
close_window(reformW%)
4
confirm(
msg(28))
reform$="Reformat"
6. $RefmTitle%="Change record format"
7%
set_height(reformW%,220)
"Adjust format":
adjust_on(
open_window(mainW%)
display(key%,-1)
=5
alter_flags(&17016731,&07006535,&1700653B)
"Merge database":
?!
close_window(reformW%)
reform$="Merge"
A& $RefmTitle%="Merge database"
B#
set_height(reformW%,360)
"Balance index":
choice$(3)
"Automatic":
choice4%=0
G!
set_autobalance(
H8
set_autobalance(
ticked(menu%(21),0))
J(
"Right now":
balance(key%)
"Print index":
choice$(3)
"Complete":
O)
print_tree(key%,file%,"ALL")
"Totals only":
Q,
print_tree(key%,file%,"TOTALS")
S5
"Find duplicates":
duplicates(key%,file%)
TC
"Warn of duplicates":dup%=
dup%:
tick(menu%(3),8,dup%)
U
V#
"Close database":
exit(0)
W%
"Abandon database":
exit(1)
"Quit":quit%=
menu%(1):
choice$(1)
"CSV options"
$CSVTitle%=choice$(1)
icon_bit(22,csvW%,0,
_6 !block%=csvW%:
"Wimp_GetWindowState",,block%
`- block%!4=oldx%:block%!12=block%!4+390
a8 block%!8=200:block%!16=block%!8+420:block%!28=-1
b$
"Wimp_OpenWindow",,block%
"Miscellaneous":
choice$(2)
e0
"Set passwords":
open_window(passW%)
f9
"Edit template":template%=1:
display(key%,-1)
g0
"Save indices":
set_auto(2-choice3%)
h
"Current key":
j1 $KeyTitle%=choice$(1):keyfunc$=choice$(1)
set_keydata(key%)
l8
shade_key_icons(
set_height(keyW%,590)
"Print":
choice$(2)
"Match":
match
p'
"Show resources":*Resources
qB
"Options":
open_window(printW%):
set_caret(printW%,16)
"Save options":
s5 $SaveName%=$database%+".PrintRes.PrintOpts"
t6 savefunc$=choice$(2):
save_click(saveW%,2,4)
"Save query":
v1 $SaveName%=$database%+".PrintRes.Query"
w6 savefunc$=choice$(2):
save_click(saveW%,2,4)
"Save selection":
y5 $SaveName%=$database%+".PrintRes.Selection"
z6 savefunc$=choice$(2):
save_click(saveW%,2,4)
{&
"Show jobs done":*JobsDone
|.
"Clear selection":
clear_selection
}$
"Select all":
select_all
match
"Validation":
choice$(2)
F
"Create table":
open_window(tableW%):
set_caret(tableW%,0)
"Display table":
choice3%>=0
! Tablenumber%=choice3%
%
show_table(Tablenumber%)
&
"Show table files":*Tables
(
"Validate input":
val_on_off
Q
"Show relations":relations%=
relations%:
tick(menu%(2),4,relations%)
$
"Show keypad":
show_keypad
=
"Save choices":
save_choices($database%+".Choices")
%
"Undo changes":
restore_rec
8
"Help":
"Wimp_StartTask","<Pbase$Dir>.!Help"
choice$(2)
"Index field":
3 $KeyTitle%=choice$(2):keyfunc$=choice$(2)
/
deselect(keyW%,20):
select(keyW%,24)
#
shade_key_icons(
set_height(keyW%,590)
J
selected(keyW%,24):
set_caret(keyW%,26)
set_caret(keyW%,2)
=
"Analyse index":
analyse(
is_a_key(Fieldnumber%))
)
"Analyse months":
analyse(-1)
0
"Link to table":
open_window(linkW%)
"Start editing":
) starthere%=field%(Fieldnumber%)
3
Access%
set_caret(mainW%,starthere%)
[
"Clear contents":
delete_blob(Fieldnumber%,object$,mainW%,field%(Fieldnumber%))
(
chartype%(Fieldnumber%)=40
Q
show_picture(Fieldnumber%):
redraw_icon(mainW%,field%(Fieldnumber%))
0
"Warn of delete":delwarn%=
delwarn%
%
tick(menu%(10),7,delwarn%)
7
"Undo changes":
restore(Fieldnumber%,"",-1)
menu%(9):
choice$(1)
F
"Design field":
open_window(createW%):
set_caret(createW%,4)
"Save form file":
% $SaveName%=$database%+".Form"
4 savefunc$=choice$(1):
save_click(saveW%,2,4)
"Default database":
&
save_form($database%+".Form")
get_it_in($database%)
first_field>0
default_key
%
defaults($database%,100,0)
softerror("",35)
"Primary key":
$KeyTitle%=choice$(1)
keyfunc$=choice$(1)
" case%(0)=
set_keydata(0)
-
deselect(keyW%,20):
select(keyW%,24)
!
shade_key_icons(
set_height(keyW%,590)
H
selected(keyW%,24):
set_caret(keyW%,26)
set_caret(keyW%,2)
"Quit design":
adjust_on(
&
save_form($database%+".Form")
get_it_in($database%)
menu%(17):
" T%=
table_number($menu%(17))
choice$(1)
"Save":
6 $SaveName%=$database%+".ValTables."+table$(T%)
6 savefunc$="Save table":
save_click(saveW%,2,4)
"
"Clear":
clear_table(T%)
"
"Print":
print_table(T%)
,
"Sort":
sort_table(T%,tablefield%)
/
"Undo all":
restore_table(T%,tablen%)
)
"Undo change":
restore_tabfield
menu%(18):
choice$(1)
"Save as text":
4 savefunc$=choice$(1):
save_click(saveW%,2,4)
"Sort":
sort_list
"Scrap":
lose_list
menu%(15):
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)
menu%(20):
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)
menu%(8),menu%(11),menu%(14),menu%(16),menu%(19):
$ fieldtype%=firsttype%+choice1%
tick_one(menuhandle%,0,lasttype%-firsttype%,choice1%)
update_box
tablemenu%:
Tablenumber%=choice1%
& $Tablename%=table$(Tablenumber%)
tick_one(menuhandle%,0,LastTable%,choice1%)
redraw_icon(linkW%,0)
fieldmenu%:
fieldfunc$
"match":
Match_tag%=choice1%+1
B $
text(matchW%,3)=Tag$(Match_tag%):
redraw_icon(matchW%,3)
2
tick_one(fieldmenu%,0,fields%-1,choice1%)
"first":
#
keyfunc$<>"Current key"
*
ticked(fieldmenu%,choice1%)
8 Keyfld0%=0:$F1dkey%="":
redraw_icon(keyW%,0)
(
tick(fieldmenu%,choice1%,
Keyfld0%=choice1%+1
9 $F1dkey%=Tag$(Keyfld0%):
redraw_icon(keyW%,0)
6
tick_one(fieldmenu%,0,fields%-1,choice1%)
"second":
#
keyfunc$<>"Current key"
*
ticked(fieldmenu%,choice1%)
8 Keyfld1%=0:$F2dkey%="":
redraw_icon(keyW%,1)
(
tick(fieldmenu%,choice1%,
Keyfld1%=choice1%+1
9 $F2dkey%=Tag$(Keyfld1%):
redraw_icon(keyW%,1)
6
tick_one(fieldmenu%,0,fields%-1,choice1%)
special_select
quit%
redo%
show_menu(menuhandle%,menux%,menuy%)
init_drag(wi%,ic%,dragtype%)
getscreensize(W%,H%)
!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
%!block%!12+=y%:miny%=block%!12
&!block%!16+=x%:maxx%=block%!16
'!block%!20+=y%:maxy%=block%!20
dragtype%=6
)5 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%
dragging%=
wi%
saveW%,savesubW%:
RISCOS3
4M
wi%=saveW%
sprite$=
$SaveSprite%,2,8)
sprite$=
$SubSprite%,2,8)
55
"DragASprite_Start",&C5,1,sprite$,block%+8
6#
"Wimp_DragBox",,block%
"Wimp_DragBox",,block%
wi%=mainW%
ficon%=ic%
end_drag(start%,end%)
wi%,ic%
dragging%=
datasize%=end%-start%
"Wimp_GetPointerInfo",,block%
wi%=block%!12:ic%=block%!16
D7block%!32=block%!4:block%!28=block%!0:block%!24=ic%
block%!20=wi%:block%!16=1
F3block%!12=0:block%!36=datasize%:block%!40=Type%
design%
adjust_field(dragbutt%)
Filename$<>""
wi%<>mainW%
K% $(block%+44)=
leaf(Filename$)
!block%=60
M/
"Wimp_SendMessage",17,block%,wi%,ic%
ramptr%=start%
O
"Wimp_CreateMenu",,-1
encrypt(S$,Z%)
I%,R%
(-12817)
I%=1
R%=
(58)-1
R%=58-R%
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(39)
DataLoad failed, so delete scrapfile (if ours)
block%!8=myref%
"OS_File",6,block+44
moan_err%,
msg(39)
&80142:
moan_err%,
msg(90)
message
task%,ref%,myref%
| 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$Scrap>"+
/
"Wimp_SendMessage",17,block%,task%
### DataSaveAck ###
save(
getstr(block%+44),Type%,Start%,End%):
write_log(-1,
getstr(block%+44)+" saved")
8 myref%=ref%:block%!12=ref%:block%!16=3:!block%=256
"Wimp_SendMessage",18,block%,task%
"Wimp_CreateMenu",,-1
### DataLoad ###
, myref%=block%!12:f$=
getstr(block%+44)
get_it_in(f$)
myref%<>0
"OS_CLI","Remove <Wimp$Scrap>"
### DataLoadAck ###
block%!12=Impref%
merging%
start_merge
### DataOpen - response to file double click ###
block%!40
&7f1,&7f3,&7f4,&7f5:
present%=7
0 block%!0=20:block%!12=ref%:block%!16=4
)
"Wimp_SendMessage",17,block%
(
get_it_in(
getstr(block%+44))
&2000:
kill%
present%=0
2
### Is it a Powerbase application? ###
* f$=
getstr(block%+44)+".Colours"
'
"OS_File",5,f$
d%,,type%
! type%=(type%>>8)
&fff
d%=1
type%=&ffd
2 block%!0=20:block%!12=ref%:block%!16=4
+
"Wimp_SendMessage",17,block%
*
get_it_in(
getstr(block%+44))
savefunc$<>"Save list"
savefunc$<>"Export CSV"
ram_transmit
10:
### Desktop boot file
F
"OS_GSTrans","Run <PBase$Dir>",block%+&100,&f00
,bootcmd$
#block%!20,bootcmd$
&502:
help_message(block%!32,block%!36)
&400C2:
getscreensize(ScreenWidth%,ScreenHeight%)
&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%
menu%(0):
choice$(1)
"New database":
$SaveName%="!DataBase"
2 $SaveSprite%="snew_appl;Pptr_hand,12,8;B3"
savefunc$=choice$(1)
menu%(1):
choice$(1)
6
"Information":
count(key%,RU%):
update_stats
"Print":
choice$(2)
"Save options":
5 $SaveName%=$database%+".PrintRes.PrintOpts"
4 $SaveSprite%="sfile_7f5;Pptr_hand,12,8;B3"
"Save query":
1 $SaveName%=$database%+".PrintRes.Query"
4 $SaveSprite%="sfile_7f4;Pptr_hand,12,8;B3"
"Save selection":
5 $SaveName%=$database%+".PrintRes.Selection"
4 $SaveSprite%="sfile_7f3;Pptr_hand,12,8;B3"
savefunc$=choice$(2)
"Miscellaneous":
choice$(2)
"Batch delete":
C
select(moveW%,2):
deselect(moveW%,1):
deselect(moveW%,0)
+
common%
text(moveW%,7)=""
"Colours":
ncol%()=fcol%()
I%=0
.
set_icon_cols(colW%,I%,ncol%(I%))
8 !block%=colW%:
"Wimp_GetWindowState",,block%
# width%=block%!12-block%!4
/ block%!4=xmin%:block%!12=xmin%+width%
0 block%!8=ymax%-height%:block%!16=ymax%
"Export subset":
A export%=
:$SubTitle%="Export subset":savefunc$=choice$(1)
V $SubName%=$database%+".PrintJobs.!Subset":
common%
text(savesubW%,0)=""
1 $SubSprite%="snew_appl;Pptr_hand,12,8;B3"
"Export CSV":
9 $SubTitle%="Export CSV file":savefunc$=choice$(1)
:
sep$=","
t$="dfe":f$="CSV"
t$="fff":f$="Sep"
Y $SubName%=$database%+".PrintJobs."+f$+"file":
common%
text(savesubW%,0)=""
4 $SubSprite%="sfile_"+t$+";Pptr_hand,12,8;B3"
menu%(9):
choice$(1)
"Save form file":
% $SaveName%=$database%+".Form"
2 $SaveSprite%="sfile_7f2;Pptr_hand,12,8;B3"
savefunc$=choice$(1)
menu%(17):
choice$(1)
"Save":
& T%=
table_number($menuhandle%)
6 $SaveName%=$database%+".ValTables."+table$(T%)
2 $SaveSprite%="sfile_7f1;Pptr_hand,12,8;B3"
savefunc$="Save table"
menu%(18):
choice$(1)
"Save as text":
2 $SaveSprite%="sfile_fff;Pptr_hand,12,8;B3"
savefunc$=choice$(1)
"Wimp_CreateSubMenu",,handle%,xmin%,ymax%
help_message(wi%,ic%)
wi%
send_help(75)
infoW%:
send_help(76)
miscW%:
send_help(77)
mainW%:
design%
ic%>=0
F%=(ic%+1)
chartype%(F%)
A
0,1,2,3,4,5,6,7,8,36,39,41,42,43,44,45:
send_help(78)
+
"Interface_SendHelp",,block%
pselectW%:
send_help(79)
relateW%:
send_help(80)
listW%:
send_help(81)
datadicW%:
send_help(82)
saveW%:
send_help(83)
savesubW%:
send_help(84)
accessW%:
send_help(85)
mergeW%:
send_help(86)
"Interface_SendHelp",,block%
send_help(M%)
!block%=256
block%!12=ref%
block%!16=&503
$(block%+20)=
msg(M%)
"Wimp_SendMessage",17,block%,block%!4
File saving --------------------------------------------------------
save_all_tables
"Hourglass_On"
T%<=LastTable%
=, f$=$database%+".ValTables."+table$(T%)
>E $TabTitle%=
table_info(T%,Rows%,TabFields%,Rec%,tabfieldlen%())
?7 Start%=!tabanchor%(T%):End%=Start%+160+Rows%*Rec%
save(f$,&7f1,Start%,End%)
T%+=1
"Hourglass_Percentage",T%*100
(LastTable%+1)
"Hourglass_Off"
save_options
F,I%,ic%
I%=1
selected(printW%,ic%)
I%=1
text(printW%,ic%)
I%=1
selected(printW%,ic%)
I%=1
selected(labelW%,ic%)
I%=1
text(labelW%,ic%)
I%=1
selected(labelW%,ic%)
close_file(F)
"OS_File",18,f$,&7f5
1,2,4,6,7,8,23,24,25,26,38,39,41:REM Radio buttons
15,16,17,18,30,32,34,43,45:REM Writable fields
10,11,12,19,29,40,42:REM Option switches
In Label Definition window
0,1,2:REM Radio buttons
4,6,10,12,17:REM Writeable fields
11,13,16:REM Option switches
save(f$,ft%,start%,end%)
ft%
leaf$=
leaf(f$)
leaf$,1)<>"!"
leaf$="!"+leaf$
u" f$=dbasepath$+"."+
leaf$,10)
"OS_File",8,f$:
Create new database directory
"OS_File",8,f$+".Indices"
"OS_File",8,f$+".ValTables"
"OS_File",8,f$+".PrintRes"
"OS_File",8,f$+".PrintJobs"
"OS_CLI","Copy <PBase$Dir>.Resources.Temp.!Run "+f$+".!Run ~C~V"
"OS_CLI","Copy <PBase$Dir>.Resources.Temp.!Boot "+f$+".!Boot ~C~V"
"OS_CLI","Copy <PBase$Dir>.Resources.chkspr "+f$+".chkspr ~C~V"
"OS_CLI","Copy <PBase$Dir>.Resources.Colours "+f$+".Colours ~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(menu%(0),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$):
get_it_in($database%)
&7f5:
save_options
&dfe:
write_csv(f$,$
text(savesubW%,0),
selected(savesubW%,5))
savetofile%:
texthandle%=
"
do_it(Search$,displayed%)
+
"OS_File",10,f$,ft%,,start%,end%
)
scrap_sliding_block(saveanchor%)
warn%=
getstr(p%)
?p%>31
p$+=
(?p%)
p%+=1
Validation tables ----------------------------------------------------
create_table
I%,title$,Rec%,L%
Iname$=$
text(tableW%,0):L%=
(name$):
name$=""
softerror("",103):
?Rows%=
text(tableW%,1)):
Rows%=0
softerror("",104):
#TabFields%=
text(tableW%,2))
%111
ic%
LastTable%=MaxTabs%
&
softerror(
(MaxTabs%+1),32)
LastTable%+=1
! Tablenumber%=LastTable%
" table$(LastTable%)=name$
I%=0
TabFields%
6 tabfieldlen%(I%)=
text(tableW%,I%*2+4))
$ Rec%+=tabfieldlen%(I%)+1
tablen%=160+Rows%*Rec%
O
create_named_sliding_block(tabanchor%(LastTable%),(tablen%+3)
) tabptr%=!tabanchor%(LastTable%)
2 $tabptr%=
(Rows%):tabptr%+=
($tabptr%)+1
7 $tabptr%=
(TabFields%):tabptr%+=
($tabptr%)+1
I%=0
TabFields%
? $tabptr%=
(tabfieldlen%(I%)):tabptr%+=
($tabptr%)+1
( head$=$
text(tableW%,I%*2+3)
; title$+=head$+
tabfieldlen%(I%)-
(head$)+2," ")
= $tabptr%=title$:tabptr%=!tabanchor%(LastTable%)+160
row%=1
Rows%
I%=0
TabFields%
5 $tabptr%="":tabptr%+=tabfieldlen%(I%)+1
row%
!
show_table(LastTable%)
! Tablenumber%=LastTable%
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=140:tableiconptr%!20=44:tableiconptr%!24=0
tableiconptr%+=28
A ptr%=menu%(2)+52:ptr%!4=tablemenu%:
lit(menu%(2),1,
!tableiconptr%=128
C
!tableiconptr%=0:tableiconptr%+=24:!tableiconptr%=128
~ tableiconptr%!4=-1:tableiconptr%!8=&7000121:tableiconptr%!12=tabletextptr%:tableiconptr%!16=-1:tableiconptr%!20=L%+1
2 $tabletextptr%=name$:tabletextptr%+=L%+1
close_window(tableW%)
clear_table(T%)
confirm(
msg(47))=
R%,F%,ind%,Rows%,TabFields%,start%,Rec%
table_info(T%,Rows%,TabFields%,Rec%,tabfieldlen%())
#start%=!tabanchor%(T%)+160-Rec%
R%=1
Rows%
ind%=start%+R%*Rec%
F%=0
TabFields%
) $ind%="":ind%+=tabfieldlen%(F%)+1
redraw(datadicW%)
show_table(T%)
ind%,start%,iflags%,I%,pos%,p$
T%<0
delete_icons(datadicW%,0)
name$=table$(T%)
$Tablename%=name$
$menu%(17)=name$
"SlidingHeap_DescribeBlock",slidingheapbase%,tabanchor%(T%)
,,tablen%
extend_named_sliding_block(undoanchor%,tablen%+1)
"Wimp_TransferBlock",mytask%,!tabanchor%(T%),mytask%,!undoanchor%,tablen%+1
C$TabTitle%=
table_info(T%,Rows%,TabFields%,Rec%,tabfieldlen%())
ind%=!tabanchor%(T%)+160
iflags%=&07003531
"Hourglass_On"
row%=1
Rows%
pos%=80
I%=0
TabFields%
v R%=
create_icon(datadicW%,pos%,-row%*36,(tabfieldlen%(I%)+1)*16,32,iflags%,"",ind%,writep%,tabfieldlen%(I%)+1)
% pos%+=(tabfieldlen%(I%)+2)*16
ind%+=tabfieldlen%(I%)+1
"Hourglass_Percentage",row%*100
Rows%
row%
"Hourglass_Off"
p$=printrel$(T%)
p$<>""
I%=1
'
select(datadicW%,
p$,I%,1)))
"!block%=0:block%!4=-Rows%*36-4
%block%!8=(Rec%+10)*16:block%!12=0
"Wimp_SetExtent",datadicW%,block%
!block%=datadicW%
"Wimp_GetWindowState",,block%
#block%!12=block%!4+(Rec%+10)*16
Rows%<20
# block%!16=block%!8+Rows%*36+4
block%!16=block%!8+36*20+4
"Wimp_OpenWindow",,block%
redraw(datadicW%)
Access%
set_caret(datadicW%,0)
restore_table(T%,L%)
"Wimp_TransferBlock",mytask%,!undoanchor%,mytask%,!tabanchor%(T%),L%+1
redraw(datadicW%)
restore_tabfield
source%,dest%
"Wimp_GetCaretPosition",,block%:wi%=!block%:ic%=block%!4
wi%=datadicW%
+ dest%=
text(datadicW%,ic%)
,: source%=!undoanchor%+dest%-!tabanchor%(Tablenumber%)
$dest%=$source%
redraw_icon(datadicW%,ic%)
sort_table(T%,field%)
tablen%,ind%,Rec%,Rows%,row%,TabFields%,pos%,dest%
4?title$=
table_info(T%,Rows%,TabFields%,Rec%,tabfieldlen%())
5,pos%=
table_field(field%,tabfieldlen%())
6&ind%=!tabanchor%(T%)+160-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%)+160,Rows%*Rec%
scrap_sliding_block(tempanchor%)
redraw(datadicW%)
print_table(T%)
printing%
indexing%
start%,ptr%,Line$,title$,rowsused%
L=$SaveName%=$database%+".PrintJobs."+
"Tab"+table$(T%),10)
read_print_options
format$="horiz"
O?title$=
table_info(T%,Rows%,TabFields%,Rec%,tabfieldlen%())
P!LenLine%=Lmargin%+
(title$)+2
Q0Heading$=margin$+title$+
Rec%-
(title$)," ")
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"
close_window(datadicW%)
Count%=0
list_head(0)
"Hourglass_On"
I%=1
Rows%
^% start%=!tabanchor%(T%)+160-Rec%
Line$=margin$
ptr%=start%+I%*Rec%
J%=0
TabFields%
bD
$ptr%<>""
Line$+=$ptr%+
tabfieldlen%(J%)-
($ptr%)+2," ")
c ptr%+=tabfieldlen%(J%)+1
Line$<>margin$
rowsused%+=1
gD $(!lineanchor%)=Line$:
list_line(-1,lineanchor%,
(Line$),32)
"Hourglass_Percentage",I%*100
Rows%
"Hourglass_Off"
rule_off(45)
S$=margin$+
(Rows%)+" rows"
n:$(!lineanchor%)=S$:
list_line(-1,lineanchor%,
(S$),32)
o#S$=margin$+
(rowsused%)+" used"
p:$(!lineanchor%)=S$:
list_line(-1,lineanchor%,
(S$),32)
rule_off(45)
screen_list
pitch$=
pitch("0")
lit(menu%(18),1,
write_log(-1,"Table printed: "+table$(T%))
table_number(N$)
T%,P%
N$=""
{ T%=-1
T%+=1
table$(T%)=N$
T%>LastTable%
T%>LastTable%
table_info(T%,
RL%,L%())
P%,I%
P%=!tabanchor%(T%)
($P%):P%+=
($P%)+1
($P%):P%+=
($P%)+1
RL%=0
I%=0
L%(I%)=
($P%):P%+=
($P%)+1
RL%+=L%(I%)+1
table_field(F%,L%())
I%,P%
I%<F%
P%+=L%(I%)+1
I%+=1
load_table(f$)
pos%,name$,d%,L%
Tablenumber%=-1
name$=
leaf(f$):L%=
(name$)
TabsLoaded$,name$)>0
"OS_File",5,f$
d%,,,,tablen%
LastTable%=MaxTabs%
extratabs$,name$)=0
extratabs$+=name$+","
LastTable%+=1
create_named_sliding_block(tabanchor%(LastTable%),(tablen%+3)
"OS_File",255,f$,!tabanchor%(LastTable%)
table$(LastTable%)=name$
Tablenumber%=LastTable%
TabsLoaded$+=","+name$
!tablemenuanchor%=0
D
extend_named_sliding_block(tablemenuanchor%,MaxTabs%*35+65)
e 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=140:tableiconptr%!20=44:tableiconptr%!24=0
tableiconptr%+=28
= ptr%=menu%(2)+52:ptr%!4=tablemenu%:
lit(menu%(2),1,
!tableiconptr%=128
?
!tableiconptr%=0:tableiconptr%+=24:!tableiconptr%=128
z tableiconptr%!4=-1:tableiconptr%!8=&7000121:tableiconptr%!12=tabletextptr%:tableiconptr%!16=-1:tableiconptr%!20=L%+1
. $tabletextptr%=name$:tabletextptr%+=L%+1
link_to_table
icon%
%111
2,4:
ic%=13
7
tick_one(tablemenu%,0,LastTable%,Tablenumber%)
-
show_menu(tablemenu%,oldx%+32,oldy%)
%111
1,4:
(b%
%111)=4
z%=1
z%=-1
ic%
tcycle(z%)
tcycle(-z%)
!
fcycle(z%,fieldnum%)
"
fcycle(-z%,fieldnum%)
fcycle(z%,expand%)
!
fcycle(-z%,expand%)
icon%=10
8
icon_bit(22,linkW%,icon%,
selected(linkW%,9))
icon%
" icon%=field%(Fieldnumber%)
1
selected(linkW%,4)
$Tablename%<>""
4 link$(Fieldnumber%)=$Tablename%+$fieldnum%
/
set_icon_cols(mainW%,icon%,fcol%(6))
R
selected(linkW%,9)
link$(Fieldnumber%)=$expand%+link$(Fieldnumber%)
link$(Fieldnumber%)=""
(
set_icon_cols(mainW%,icon%,7)
link$(0)="LOADED"
/
(b%
%111)=4
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%())
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$,name1$,field$,expand$,ic%
name$=link$(Fieldnumber%)
(name$)<58
(name$)<>-1
expand$=
name$,1):name$=
name$,2)
!field$=
name$):name1$=
name$)
(name1$<>""
TabsLoaded$,name1$)>0)
; $Tablename%=name1$:$fieldnum%=field$:$expand%=expand$
( Tablenumber%=
table_number(name1$)
select(linkW%,4)
Tablenumber%=0
& $Tablename%=table$(Tablenumber%)
deselect(linkW%,4):$fieldnum%="0"
expand$<>""
select(linkW%,9):$expand%=expand$
deselect(linkW%,9):$expand%="0"
ic%=10
icon_bit(22,linkW%,ic%,
selected(linkW%,9))
redraw_icon(linkW%,0):
redraw_icon(linkW%,2):
redraw_icon(linkW%,10)
End of Validation table routines ------------------------------------
changes(key%)
M$,K%,index%
<Search$=
parse($
text(changeW%,3),
selected(changeW%,5))
New$=$
text(changeW%,1)
New$=""
n$="<null>"
n$=New$
New$<>""
"+-*/",
New$,1))>0
numeric%=
numeric%=
is_a_key(Fieldnumber%)
K%=key%
softerror("",12):
"Wimp_CreateMenu",,-1:
K%>=0
msg(107)
M$=""
Title$,". "):Title$=
Title$,P%+2)
Title$<>"All records"
Title$=" when "+Title$
Title$=" for "+Title$
8Title$="Change "+Fieldname$+" to "+n$+Title$+". "+M$
confirm(Title$)=
' subtotal%=
count_recs(key%,zero%)
"Hourglass_On"
, dbasehandle%=
($database%+".Database")
P%=
neighbour(key%,top,1)
scan_file("P%<>top",key%,5)
close_file(dbasehandle%)
$Date%(file%)=
date%?file%=1
display(key%,addr)
"Hourglass_Off"
K%>=0
index%=K%
Keys%-1
$! Index$(K%)=Index$(K%+1)
index%
&/
scrap_sliding_block(keyanchor%(Keys%))
Index$(Keys%)=""
Keys%-=1
write_log(-1,Title$)
"Wimp_CreateMenu",,-1
is_a_key(F%)
key%,flag%
flag%=-1
key%=0
Keys%
KF%(key%,0)=F%
KF%(key%,1)=F%
flag%=key%
key%
=flag%
read(N%,K%,R%,f$)
I%,key%,dbasehandle%
9"dbasehandle%=
(f$+".Database")
:%$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%))
A!
show_text_block(I%)
show_picture(I%)
41,42,43,44,45:
DT
field$(I%)=" "
select(mainW%,field%(I%))
deselect(mainW%,field%(I%))
E,
R%=RA%
$Rf%(I%)=
(nextrec%)
F9
R%=RA%
split_link(I%,R$,V$):$Rf%(I%)=R$
G'
R%=RA%
$Rf%(I%)=
H(
R%=RA%
$Rf%(I%)=
$,15)
I1
R%=RA%
$Rf%(I%)=
convert_date(2)
J1
R%=RA%
$Rf%(I%)=
convert_date(4)
K#
R%=RA%
$Rf%(I%)=
L'
R%=RA%
$Rf%(I%)=
M)
R%=RA%
$Rf%(I%)=
$,5,2)
N)
R%=RA%
$Rf%(I%)=
$,8,3)
OJ
R%=RA%
$,8,3):P%=
months$,M$):$Rf%(I%)=
((P%+2)
P*
R%=RA%
$Rf%(I%)=
$,12,4)
key%=0
Keys%
key$(key%)=
key(key%)
key%
close_file(dbasehandle%)
cfield$()=field$()
update_calcs(N%)
design%
$Rf%(N%)=cfield$(N%)
I%,C%,L%,F,F$,Form$,S$,SF$
Form$=update$(N%)
Form$=0
calc_error:
I%=1
(Form$)-1
F%<>N%
F%=
fnum(
Form$,I%,2))
g&
split_link(F%,real$,visible$)
chartype%(F%)
j@ F=
(real$):F$=
fix%(F%)>0
fix_point(F$,F%)
F$=
(real$)
m9
N%=0
expand(F$,link$(F%),L%,SF$):F$=SF$
n
o\
(F$)<=len%(F%)
$Rf%(F%)=F$:cfield$(N%)=$Rf%(N%):
redraw_icon(mainW%,field%(F%))
update_calcs(F%)
calc_error
### Division by zero. Ignore ###
softerror(calc$(I%),73)
check_change
F%,flag%
F%<fields%
flag%=
F%+=1
chartype%(F%)
0,1,2,3,4,5,6,7,8:
?Rf%(F%)=32
$Rf%(F%)=$(Rf%(F%)+1)
chartype%(F%)
+
0,1,2,3,4,5,6,7,8,41,42,43,44,45:
(
$Rf%(F%)<>field$(F%)
flag%=
flag%
write(fields%,key%):warn%=
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$):val$=
type(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%)
key%=0
$
confirm(
msg(48))=
* kl%=
(KEY$):val$=
type(key%)
delete(key$(0),0)
insert(KEY$,0)
key$(0)=KEY$
k%=0
addr=F%
' dontalter%=
restore_rec
dontalter%=
0 kl%=
(key$(key%)):val$=
type(key%)
&
delete(key$(key%),key%)
kl%=
(KEY$)
insert(KEY$,key%)
key$(key%)=KEY$
!
k%=key%
addr=F%
key%
dontalter%
$Date%(file%)=
date%?file%=1
newtree%
write_dbase(REC%,N%,
newrec%
autobalance%
added%+=1
added%=balint%
key%=0
Keys%
balance(key%)
key%
added%=0
write_dbase(R%,N%,logchanges%)
I%,F$,dbasehandle%,flag%
*dbasehandle%=
($database%+".Database")
#dbasehandle%=R%*Length%
logchanges%
newrec%
]
write_log(R%,"New record: Subfile "+
(file%)+" "+$Rf%(KF%(0,0))+" "+$Rf%(KF%(0,1)))
*
write_log(R%,logentry$):flag%=
I%=1
chartype%(I%)
39,40:F$=""
T
47:F$=$Rf%(I%):
split_link(I%,R$,V$):S%=
(R$):S%+=1:calc$(I%)=V$+"|"+
58:F$=
:F$=$Rf%(I%)
#dbasehandle%,F$
flag%=
F$<>field$(I%)
%
F$=""
D$="<null>"
D$=F$
5
field$(I%)=""
S$="<null>"
S$=field$(I%)
3
write_log(-1,Tag$(I%)+": "+S$+" ---> "+D$)
field$(I%)=F$
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%,N%,P%,S%,S$,T$,f0%,f1%,L%,C$,n%,t$
(P%=1:f0%=KF%(key%,0):f1%=KF%(key%,1)
loc%
S$=$Rf%(f0%)+" "+$Rf%(f1%)
S$=F$(f0%)+" "+F$(f1%)
S$=" "
S$)<>" "
S$+=" "
I%=0
L%+=KW%(key%,I%)
L%>0
I%=0
N%=KW%(key%,I%)
N%<>0
P%<>
(S$)
S%=
S$," ",P%+1)
'
S%-P%<N%
n%=S%-P%
n%=N%
t$=
S$,P%,n%)
2
incspace%(key%)=
t$+=
(t$)," ")
T$+=t$
P%=S%+1
C$=
S$,1):S$=
S$,2)
.
C$<>" "
incspace%(key%)=
T$+=C$
(T$)=KL%(key%)
C$=""
KL%(key%)-
(T$),"#")
chartype%(f0%)
5,51,52:T$=
reverse_date(T$)
case%(key%)
u(T$)
u(N$)
I%,B%
$key=N$
I%=0
(N$)-1
B%=key?I%
B%>96
B%<123
key?I%=B%
$ =$key
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
5) $(!keyanchor%(key%)+8+9*I%)=
$Date%(I%)=
check_date(D$,place%,
date$)
I%,D%,M%,Y%,L%,P%,Q%,U$,d$,m$,y$
L%=0
I%=1
C$=
D$,I%,1)
C$<"0"
C$>"9"
P%=0
P%=I%
Q%=I%
P%=0
Q%=0
restore(Fieldnumber%," (day, month & year must be separated by non-numeral)",4):=
D$,P%-1))
D$,P%+1,Q%-P%-1))
D$,Q%+1))
Y%<0
D%<1
restore(Fieldnumber%,"",4):=
M%<1
M%>12
restore(Fieldnumber%," (month out of range)",4):=
400=0:U$="312931303130313130313031"
100<>0
4=0:U$="312931303130313130313031"
:U$="312831303130313130313031"
U$,2*M%-1,2)
(DM$)
restore(Fieldnumber%," (day out of range - max="+DM$+")",4):=
R"d$=
(D%):
(d$)=1
d$="0"+d$
S"m$=
(M%):
(m$)=1
m$="0"+m$
T"y$=
(Y%):
(y$)=1
y$="0"+y$
(y$)<>2
(y$)<>4
restore(Fieldnumber%," (year not 2 or 4 digits)",4):=
(y$)=4
len%(Fieldnumber%)<10
y$,2)
W$date$=d$+datesep$+m$+datesep$+y$
place%=0
(date$)>len%(Fieldnumber%)
restore(Fieldnumber%," (too long for field)",4):=
place%
[H $Rf%(Fieldnumber%)=date$:
redraw_icon(mainW%,field%(Fieldnumber%))
]9 $
text(keypadW%,27)=date$:
redraw_icon(keypadW%,27)
convert_date(L%)
d$,m$,y$,M$,M%
$,5,2)
$,8,3)
months$,M$)
M%=(P%+2)
g m$=
(M%):
M%<10
m$="0"+m$
$,16-L%,L%)
=d$+datesep$+m$+datesep$+y$
reverse_date(K$)
sep$
(K$)
sep$=
K$,3,1)
p. K$=
K$,2)+sep$+
K$,4,2)+sep$+
K$,2)
(K$)<100
sep$=
K$,3,1)
t+ K$=
K$,4)+sep$+
K$,4,2)+sep$+
K$,2)
u
sep$=
K$,5,1)
w+ K$=
K$,2)+sep$+
K$,6,2)+sep$+
K$,4)
seconds(time$,place%)
I%,L%,P%,Q%,H%,M%,S%,secs%,h$,m$,s$,C$
(time$)
L%=0
I%=1
C$=
time$,I%,1)
C$<"0"
C$>"9"
P%=0
P%=I%
Q%=I%
P%=0
Q%=0
restore(Fieldnumber%," (hours, minutes and seconds must be separated by a non-numeral).",94):=-1
time$,P%-1)):
H%<0
H%>23
restore(Fieldnumber%," (hours out of range).",94):=-1
time$,P%+1,Q%-P%-1)):
M%<0
M%>59
restore(Fieldnumber%," (minutes out of range).",94):=-1
time$,Q%+1)):
S%<0
S%>59
restore(Fieldnumber%," (seconds out of range).",94):=-1
(H%):
(h$)=1
h$="0"+h$
(M%):
(m$)=1
m$="0"+m$
(S%):
(s$)=1
s$="0"+s$
$time$=h$+timesep$+m$+timesep$+s$
secs%=H%*3600+M%*60+S%
place%=0
$Rf%(Fieldnumber%)=time$:
redraw_icon(mainW%,field%(Fieldnumber%))
=secs%
time(secs%)
H%,M%,S%,h$,m$,s$
&H%=secs%
3600:secs%=secs%
3600
M%=secs%
S%=secs%
(H%):
(h$)=1
h$="0"+h$
(M%):
(m$)=1
m$="0"+m$
(S%):
(s$)=1
s$="0"+s$
=h$+timesep$+m$+timesep$+s$
validate(F%,
TabFields%,
name$)
validate%
row%,field%,Rows%,Rec%,ind%,eind%,pos%,start%,rel%,exp%,epos%,date$
fix%(F%)>0
$Rf%(F%)=
fix_point($Rf%(F%),F%):
redraw_icon(mainW%,field%(F%))
chartype%(F%)=3
check_val(calc$(F%),$Rf%(F%))
chartype%(F%)=5
check_date($Rf%(F%),0,date$)
chartype%(F%)=8
seconds($Rf%(F%),0)>=0)
$Rf%(F%)=field$(F%)
TabFields%=0
3name$=link$(F%):Tablenumber%=-1:rel%=TabFields%
name$=""
name$,1)="#"
#field%=
name$)):name$=
name$)
Hexp%=-1:
(name$)<58
(name$)<>-1
exp%=
(name$):name$=
name$,2)
table_number(name$):
T%<0
table_info(T%,Rows%,TabFields%,Rec%,tabfieldlen%())
,pos%=
table_field(field%,tabfieldlen%())
exp%<0
epos%=pos%
epos%=
table_field(exp%,tabfieldlen%())
#start%=!tabanchor%(T%)+160-Rec%
'ind%=start%+pos%:eind%=start%+epos%
row%+=1
ind%+=Rec%:eind%+=Rec%
row%>Rows%
$ind%=$Rf%(F%)
$eind%=$Rf%(F%)
row%>Rows%
rel%=0
restore(F%," ("+name$+")",5):=
row%>Rows%
ind%=start%+row%*Rec%
I%=0
TabFields%
, rel%(I%)=ind%:ind%+=tabfieldlen%(I%)+1
exp%>=0
expand$=$eind%:
(expand$)<=len%(F%)
$Rf%(F%)=expand$:
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(menu%)
F%,I%,W%,L%,N$,row%,col%,flags%
F%=-1
&row%=
validate(Fieldnumber%,F%,N$)
!col%=
link$(Fieldnumber%)))
row%>0
delete_icons(relateW%,0)
I%=0
7
I%=col%
flags%=&0B000531
flags%=&07000531
L%=
($rel%(I%))
T R%=
create_icon(relateW%,0,-I%*36-36,L%*16+16,32,flags%,"",rel%(I%),-1,L%+1)
L%>W%
W%=L%
$RelTitle%=N$
menu%
xmax%=x%-32:ymax%=y%
9 !block%=keypadW%:
"Wimp_GetWindowState",,block%
) xmax%=block%!12+2:ymax%=block%!16
7 !block%=relateW%:
"Wimp_GetWindowState",,block%
& width%=W%*16+16:height%=F%*36+36
+ block%!4=xmax%:block%!12=xmax%+width%
, block%!8=ymax%-height%:block%!16=ymax%
block%!28=-1
menu%
$
"Wimp_OpenWindow",,block%
/
"Wimp_CreateMenu",,relateW%,x%-32,y%
$
"Wimp_OpenWindow",,block%
redraw(relateW%)
close_window(relateW%)
fix_point(F$,F%)
F$=""
@%=&01020009+fix%(F%)*256
(F$))
@%=&90A
F$,len%(F%))
moveto(key%,P%,D%)
D%=(D%+1)
filter%
# P%=
next_match(P%,D%,Filter$)
P%=
neighbour(key%,P%,D%)
P%=top
7:P%=
neighbour(key%,P%,D%)
display(key%,P%)
next_match(P%,D%,S$)
REC%
*dbasehandle%=
($database%+".Database")
P%=
neighbour(key%,P%,D%)
P%<>top
REC%=
rec_no(k$,key%,P%)
'
readsmarray(dbasehandle%,REC%)
(S$)=
P%=top
P%=top
softerror("",38)
close_file(dbasehandle%)
display(key%,P%)
check_change
template%=1
template%=2
template%=0
I%,L%,S%,S$,k$,ok%,nextrec%
$ keybase%=!keyanchor%(key%)
avail%=!keybase%
&, nextrec%=!(keybase%+avail%+8+KL%(0)+1)
(:
!(keybase%+avail%)>0,template%=2,design%=
:ok%=
incr%=
($Increment%)
incr%>0
,+
change_length(RA%+incr%,
):ok%=
softerror("",2)
.
ok%
2:
design%:$RecInfo%="Make adjustments to fields"
3a
template%=2:$RecInfo%="Enter data which you want to appear by default on new records"
4U
:REC%=nextrec%:$RecInfo%="Subfile="+
(file%)+". Record="+
(REC%)+". (New)"
5
6'
read(fields%,
,RA%,$database%)
top:
9 keybase%=!keyanchor%(key%)
avail%=!keybase%
;( REC%=!(keybase%+avail%+8+KL%(0)+1)
read(fields%,
,RA%,$database%)
=# $RecInfo%="Subfile="+
(file%)
7:$RecInfo%="Subfile="+
(file%)+". Record="+
(REC%)+". (New)"
REC%=
rec_no(k$,key%,P%)
read(fields%,
,REC%,$database%)
key$(key%)=k$
k$)="#"
k$=
FC $RecInfo%="Subfile="+
(file%)+". Record="+
(REC%)+". Key="+k$
H&L%=
text_length(mainW%,starthere%)
Access%
set_caret(mainW%,starthere%)
identify_field(starthere%)
update_calcs(0)
LHlogentry$="Subfile "+
(file%)+" "+$Rf%(KF%(0,0))+" "+$Rf%(KF%(0,1))
redraw(mainW%)
-------------------- Icon colours -------------------------------
colour(key%,type%)
change_field_cols(key%,type%,0)
KF%(key%,1)>0
change_field_cols(key%,type%,1)
change_field_cols(key%,type%,fld%)
col%=fcol%(type%*2)
type%=0
key%>0
(key%=0
fcol%(0)=&17)
set_icon_cols(mainW%,desc%(KF%(key%,fld%)),col%)
col%=fcol%(type%*2+1)
\7col2%=
get_icon_cols(mainW%,field%(KF%(key%,fld%)))
(col2%
%1111)<>fcol%(6)
type%=0
key%>0
(key%=0
fcol%(1)=&07)
set_icon_cols(mainW%,field%(KF%(key%,fld%)),col%)
get_icon_cols(wi%,ic%)
c;!block%=wi%:block%!4=ic%:
"Wimp_GetIconState",,block%
=block%?27
set_icon_cols(wi%,ic%,col%)
gD!block%=wi%:block%!4=ic%:block%!8=(col%<<24):block%!12=&FF000000
"Wimp_SetIconState",,block%
dcolour(wi%,ic%,col%,fb%)
l;!block%=wi%:block%!4=ic%:
"Wimp_GetIconState",,block%
fb%
0:block%!8=col%<<28:block%!12=&F0000000
1:block%!8=col%<<24:block%!12=&0F000000
"Wimp_SetIconState",,block%
read_colours(f$)
ic%=0
#F,fcol%(ic%)
ncol%()=fcol%()
close_file(F)
write_colours
($database%+".Colours")
ic%=0
#F,fcol%(ic%)
close_file(F)
find(S$,key%,m%,disp%)
P%,F%,H%,num%,abort%,cond$
case%(key%)
u(S$)
S$,1)="#"
check_change
REC%=
S$,2))
REC%>=0
REC%<RA%
(
read(fields%,
,REC%,$database%)
! S$=key$(key%):H%=1:num%=
3
select(keypadW%,25):
deselect(keypadW%,24)
-
softerror(" ("+S$+")",56):abort%=
abort%
=addr
val$=
type(key%)
val$="VAL"
kl%=KL%(key%)
S$=
stripspaces(S$)
kl%=
search(S$,key%,1+H%)
P%<0
selected(keypadW%,25)
F%=file%
file%=(file%+1)
top=8*file%+LH%
P%=
search(S$,key%,1+H%)
P%>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
num%:RecF%=
:addr=P%
P%>=0:RecF%=
(cond$)
P%=
neighbour(key%,P%,0)
\ P%=
neighbour(key%,P%,1):addr=P%:
### Scan back to FIRST match & point addr at it ###
(cond$)
matches%+=1
P%=
neighbour(key%,P%,1)
num%:
softerror(" (#"+
(REC%)+")",55)
7:flash%=KF%(key%,0):addr=
text(keypadW%,36)=
(matches%)+" found":
redraw_icon(keypadW%,36)
disp%
display(key%,addr)
=addr
get_it_in(filename$)
"OS_File",5,filename$
d%,,ftype%
9ftype%=(ftype%>>8)
&fff:wi%=block%!20:ic%=block%!24
ftype%
&7f1:
LastTable%=MaxTabs%
softerror(
(MaxTabs%+1),32)
load_table(filename$):
show_table(Tablenumber%)
&7f3:
load_selection(filename$)
&7f4:
load_query(filename$)
&7f5:
load_options(filename$)
&dfe:
start_import("CSV",block%!20)
&ff9,&aff:
transfer_blob(block%!20,block%!24,filename$,ftype%)
&bc5:
ready_to_merge
&fff:
/ F=
(filename$):header$=
close_file(F)
wi%
mainW%,-1:
(
header$="!SCRIPT POWERBASE":
/
present%=7:
execute_file(filename$)
F
ic%>0:
transfer_blob(block%!20,block%!24,filename$,ftype%)
%
start_import("text",wi%)
&
customise%
special_drop
wi%
reformW%:
reform$
1
"Merge":
merge_files(filename$,file%)
+
"Reformat":
reformat(filename$)
d%=2
#
leaf(filename$),1)
"!":
3
### Is it an Impression document? ###
5
"OS_File",5,filename$+".!DocData"
d%=1
ready_to_merge
6
### Is it a Powerbase application? ###
=
"OS_File",5,filename$+".Colours"
d%,,type%
% type%=(type%>>8)
&fff
#
d%=1
type%=&ffd
'
present%>0
exit(0)
( $Title%=
leaf(filename$)
&
open_files(filename$)
7
### It's an ordinary directory folder ###
<
transfer_blob(block%!20,block%!24,filename$,-1)
ready_to_merge
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=&2000:$(block%+44)=filename$
"Wimp_SendMessage",18,block%,0
Impref%=block%!8
softerror("" ,106)
open_files(f$)
I%,J%,F%,A$
"OS_File",5,f$+".!Paths"
d%=0
"OS_CLI","Set Acl$Dir "+f$
"OS_CLI","Set Log$Dir "+f$
"OS_FSControl",4,f$+".!Paths"
"OS_File",5,f$+".Dbase"
d%=1
fatal_err%,
msg(42)
"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$
present%
0,1,5:Access%=
:Modify%=
resume_opening
access(f$)
resume_opening
wimp_error(
,254,0,
msg(24))
access(f$)
L%,P%,keybase%,login%
(f$+".Colours")
F=0
fatal_err%,f$+"."+
msg(18)
#F=35
#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)
$Manager%=""
Access%=
:Modify%=
"OS_File",5,"<Acl$Dir>.acl"
d%:acl%=(d%=1)
29$AccessTitle%="!Powerbase opening "+
leaf($database%)
35!block%=accessW%:
"Wimp_GetWindowState",,block%
acl%
5* block%!16=block%!8+310:block%!24=110
refuse$="Access denied"
8( block%!16=block%!8+200:block%!24=0
9" refuse$="Password not known"
;#block%!4=(ScreenWidth%
2)-250
"Wimp_OpenWindow",,block%
=5!block%=accessW%:
"Wimp_GetWindowState",,block%
block%!4,block%!8,block%!12-block%!4,block%!16-block%!8
@( cancel%=
:login%=
:accessbutton%=0
$Password%="":$UserID%=""
redraw_icon(accessW%,1):
redraw_icon(accessW%,0)
C0 $
text(accessW%,5)="Type in your password"
acl%
set_caret(accessW%,0)
set_caret(accessW%,1)
accessbutton%>0
accessbutton%
IA
2:cancel%=
"OS_Byte",202,caps%,111:
"OS_Byte",118
K3 password$=
u($Password%):user$=
u($UserID%)
acl%
F=
("<Acl$Dir>.acl")
O!
#F,id$,personal$,pw%
PX
id$=
encrypt(user$,
personal$=
encrypt(password$,
pw%>0
login%=
login%
close_file(F)
password$
U&
$Manager%:pw%=3:login%=
V$
$Write%:pw%=2:login%=
W#
$Read%:pw%=1:login%=
Y
(login%
cancel%)
]" $
text(accessW%,5)=refuse$
^!
dcolour(accessW%,5,11,1)
delay%=
`
>delay%
c
dcolour(accessW%,5,7,1)
login%
cancel%
login%
Access%=(pw%>1):Modify%=(pw%>2)
close_window(accessW%)
getscreensize(W%,H%)
0,0,W%,H%
=login%
resume_opening
"Hourglass_On"
selected(passW%,16)
open_log("<Log$Dir>.Log",
"OS_File",5,f$+".UserFuncs"
d%=1
f$+".UserFuncs"
read_colours($database%+".Colours")
"OS_File",5,f$+".PrintRes.PrintOpts"
d%=1
load_options(f$+".PrintRes.PrintOpts")
load_options("<Pbase$Dir>.Resources.PrintOpts")
f$,3)="RAM"
ram%=
"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"
lit(menu%(0),1,
lit(menu%(0),3,
lit(menu%(0),4,
lit(menu%(1),6,
selected(passW%,9))
lit(menu%(3),8,
selected(passW%,15))
lit(menu%(7),0,Access%)
lit(menu%(7),1,Modify%)
lit(menu%(7),2,Access%)
lit(menu%(7),3,Access%)
lit(menu%(7),4,Access%)
lit(menu%(2),0,Access%)
lit(menu%(0),2,Modify%)
lit(menu%(10),0,Access%)
lit(menu%(10),2,Access%)
lit(menu%(10),3,Access%)
lit(menu%(13),0,Access%)
lit(menu%(17),0,Access%)
lit(menu%(3),0,((present%
4)>0))
lit(menu%(9),1,((present%
4)=0))
I%=1
lit(menu%(3),I%,(present%=7))
limit_actions(Access%)
present%<4
design%=
present%=5
adjust_on(
lit(menu%(9),5,
fields%=
get_form(Fptr%)
fields%>0
% starthere%=field%(
first_field)
% fieldmenu%=
field_menu(fields%)
create_named_sliding_block(transanchor%,Length%+1)
adjust%
lit(menu%(9),2,(fields%>0))
load_calcs
present%
- $RecInfo%="No record design exists yet"
I%=1
lit(menu%(9),I%,
open_window(mainW%)
!formanchor%=0
2
extend_named_sliding_block(formanchor%,0)
Fptr%=!formanchor%
fields%=0:Fieldnumber%=0
8 $RecInfo%="Record design exists, but no datafiles"
first_field>0
lit(menu%(9),3,
lit(menu%(9),4,
open_window(mainW%)
6 $RecInfo%="No primary key index file exists yet"
"OS_File",5,$database%+".Database"
,,,,len%
- RA%=(len%
Length%)-1:$Records%=
(RA%)
first_field>0
open_window(mainW%)
lit(menu%(1),7,
selected(passW%,13))
lit(menu%(1),8,
selected(passW%,13))
lit(menu%(1),2,
selected(passW%,14))
"OS_File",5,$database%+".Database"
,,,,len%
- RA%=(len%
Length%)-1:$Records%=
(RA%)
open_index($database%+".PrimaryKey",0,
$ key%=0:file%=0:top=8*file%+LH%
set_keydata(key%)
l keybase%=!keyanchor%(0):
keybase%!4<=100
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,0):
colour(0,1)
get_tables
key%=0
count(key%,RU%):
update_stats
show_windows
"Hourglass_Off"
$dbase%=
$Title%,2)
redraw_icon(-2,pbaseicon%)
f$=$database%+".Choices"
"OS_File",5,f$
d%=1
get_choices(f$)
"OS_File",5,$database%+".Special"
d%=1
$database%+".Special":
customise
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_choices(f$)
F,S$,C$,P%
2 S$=
#F:P%=
S$," "):C$=
S$,P%+1):S$=
S$,P%-1)
D
"Validate":validate%=(C$="ON"):
tick(menu%(2),3,validate%)
G
"Relations":relations%=(C$="ON"):
tick(menu%(2),4,relations%)
B
"Warning":delwarn%=(C$="ON"):
tick(menu%(10),7,delwarn%)
"Autosave":
C$,4)
.
"OFF ":mode%=0:$Interval%="10 min"
,
"WARN":mode%=1:$Interval%=
C$,5)
,
"AUTO":mode%=2:$Interval%=
C$,5)
set_auto(mode%)
"Autobalance":
C$,4)
&
"OFF ":
set_autobalance(
5
"AUTO":$Every%=
C$,5):
set_autobalance(
"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(menu%(15),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(menu%(20),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")
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")
"CaseSpecific":
'
set_icon(matchW%,16,(C$="ON"))
(
set_icon(savesubW%,5,(C$="ON"))
'
set_icon(changeW%,5,(C$="ON"))
%
set_icon(moveW%,9,(C$="ON"))
'
set_icon(mergeW%,12,(C$="ON"))
(
set_icon(keypadW%,32,(C$="ON"))
"Duplication":
- dup%=(C$="ON"):
tick(menu%(3),8,dup%)
icon_bit(22,csvW%,4,(
selected(csvW%,1)))
close_file(F)
save_choices(f$)
F,C$
validate%=
C$="ON"
C$="OFF"
#F,"Validate "+C$
relations%=
C$="ON"
C$="OFF"
#F,"Relations "+C$
delwarn%=
C$="ON"
C$="OFF"
#F,"Warning "+C$
autosave%
0:C$="OFF "
1:C$="WARN"+$Interval%
2:C$="AUTO"+$Interval%
#F,"Autosave "+C$
autobalance%
0:C$="OFF "
1:C$="AUTO"+$Every%
#F,"Autobalance "+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%,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(matchW%,16),
selected(savesubW%,5),
selected(changeW%,5),
selected(moveW%,9),
selected(mergeW%,12),
selected(keypadW%,32):C$="ON"
:C$="OFF"
#F,"CaseSpecific "+C$
dup%
C$="ON"
C$="OFF"
#F,"Duplication "+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
n% $Date%(I%)=$(keybase%+8+9*I%)
KF%(key%,0)=keybase%!62
KF%(key%,1)=keybase%!66
KL%(key%)=keybase%?70
t!case%(key%)=(keybase%?71=255)
u%incspace%(key%)=(keybase%?72=255)
keybase%!62>0
### Old key structure applies ###
KF%(key%,0)=keybase%!62
KF%(key%,1)=keybase%!66
I%=0
{( KW%(key%,I%)=!(keybase%+74+I%*4)
words%=
I%=0
W%=!(keybase%+74+I%*4)
chars%=W%
1 word%=(W%>>16)
255:
word%>0
words%=
field%=(W%>>24)
KW%(key%,I%)=chars%
.
I%=0
field%>0
KF%(key%,0)=field%
.
I%=1
field%>0
KF%(key%,1)=field%
words%
KW%(key%,0)=0
get_tables
lk,F%,d%,R4%,f$,name$
$f$=$database%+".ValTables":R4%=0
"OS_File",5,$database%+".Tables"
d%=2
fatal_err%,
msg(18)
close_file(lk):
wimp_error(
($database%+".Link")
lk>0
!block%=mainW%
F%+=1
#lk,link$(F%)
name$=
link$(F%))
name$,1)<>"@"
name$<>""
+
(name$)<58
name$=
name$,2)
6
set_icon_cols(mainW%,field%(F%),fcol%(6))
.
d%=0
load_table(f$+"."+name$)
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
F%,F1%,P%,calc$
update$()=""
($database%+".Calc")
cl>0
+ F%+=1:F$=
~(F%):
F%<16
F$="0"+F$
"
#cl,calc$:calc$(F%)=calc$
chartype%(F%)
6,7:
! P%=
calc$,"$Rf%(",P%)
?
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)
get_form(
Fptr%)
F,L%,N%,I%,V%,x%,y%,xlim%,ylim%,text%
buttonfield%()=0
design%
dflg%=(winback%<<28)+&7016731:dval%=hand%:func%=1
dflg%=(winback%<<28)+&7010731:dval%=-1:func%=0
($database%+".Form")
F>0
#F,N%
N%>127
fatal_err%,
msg(98)
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%
/
bbox%=0
len%=0:width%=0:height%=0
0
bbox%=0:width%=len%*16+16:height%=48
6
bbox%<&10000: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%)
=
char%>8
char%<32:fval%=
val(keypadW%,char%-9)
!
:fval%=valid%(char%)
" x%=xf%+width%+32:y%=yf%-16
x%>xlim%
xlim%=x%
y%<ylim%
ylim%=y%
' y%=yd%-16:
y%<ylim%
ylim%=y%
Length%+=len%+1
F
design%=
char%=39
len%=(height%
40)*((width%
16)-4)
7 len%(I%)=len%:chartype%(I%)=char%:fix%(I%)=fix%
L%=
(Desc$)
1
Fptr%-!formanchor%+L%+len%+2>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,48,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%
h
9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31:buttonfield%(char%-9)=I%
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
setup_select(N%)
N%=0
(present%
4)=0
xlim%=1279:ylim%=-1023
!block%=0:block%!4=ylim%
block%!8=xlim%:block%!12=0
"Wimp_SetExtent",mainW%,block%
!block%=mainW%
"Wimp_GetWindowState",,block%
block%!4=0
ylim%>-840
block%!8=900+ylim%
block%!8=184
xlim%<1240
block%!12=xlim%
block%!12=1240
block%!16=900
"Wimp_OpenWindow",,block%
setup_select(fields%)
S$,I%,J%,Fptr%,rows%
&selectlen%=&200:selinc%=selectlen%
create_named_sliding_block(selanchor%,selectlen%)
Fptr%=!selanchor%
I%=1
fields%
Fptr%-!selanchor%+144>selectlen%
selectlen%+=selinc%
:
extend_named_sliding_block(selanchor%,selectlen%)
chartype%(I%)
3,6,8,46,47,54,56,57:
# rows%+=1:
lit(menu%(6),6,
W handle%=
create_icon(pselectW%,16,-rows%*48-56,240,48,&17000531,"",Fptr%,-1,15)
# S$=$
text(mainW%,desc%(I%))
!7
(S$)>8
S$,8)+" "
S$+=
(S$)," ")
"- $Fptr%=S$+Tag$(I%):Fptr%+=
($Fptr%)+1
J%=0
$a handle%=
create_icon(pselectW%,278+J%*80,-rows%*48-52,44,44,&0740B13B,"",Fptr%,tick%,1)
$Fptr%="":Fptr%+=1
calcrow%?I%=rows%
:calcrow%?I%=0
+#!block%=0:block%!4=-rows%*48-56
block%!8=700:block%!12=0
"Wimp_SetExtent",pselectW%,block%
enable_row(R%,on%)
R%>0
I%=R%*7-5
R%*7
4&
icon_bit(22,pselectW%,I%,on%)
save_form(f$)
F,I%,xd%,yd%,xf%,yf%,w%,h%,bbox%,type%
fields%=0
Length%=0
!block%=mainW%
#F,fields%
I%=1
fields%
A( dicon%=desc%(I%):ficon%=field%(I%)
B4 block%!4=dicon%:
"Wimp_GetIconState",,block%
C xd%=block%!8:yd%=block%!12
Desc$=$(block%!28)
E4 block%!4=ficon%:
"Wimp_GetIconState",,block%
F xf%=block%!8:yf%=block%!12
G2 w%=block%!16-block%!8:h%=block%!20-block%!12
bbox%=(h%<<16)+w%
#F,Desc$,Tag$(I%),xd%,yd%,xf%,yf%,len%(I%),chartype%(I%),fix%(I%),bbox%
Length%+=len%(I%)+1
KA field$(I%)="":
Rf%(I%)>0
chartype%(I%)<>40
$Rf%(I%)=""
close_file(F)
"OS_File",18,f$,&7f2
lit(menu%(0),3,
lit(menu%(0),4,
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=KF%(key%,0)
keybase%!66=KF%(key%,1)
keybase%?70=KL%(key%)
selected(keyW%,20)
keybase%?71=255:case%(key%)=
selected(keyW%,28)
keybase%?72=255:incspace%(key%)=
keybase%?73=0
I%=0
e( !(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$
r# !(keybase%+P%+KL%(key%)+9)=I%
P%+=KLM%
!(keybase%+P%)=0
!(keybase%+P%+4)=0
$(keybase%+P%+8)=S$
x !(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"
clear
REC%,action$,ex%,ptr%
8Search$=
parse($
text(moveW%,7),
selected(moveW%,9))
"Wimp_WhichIcon",moveW%,block%,&003F0000,&00210000
movetype%=!block%-1
Title$,". ")+2:Title$=
Title$,P%)
Title$<>"All records"
Title$=" when "+Title$
Title$=" "+Title$
9action$=
"Move
DeleteMove
",movetype%*6+7,6)+Title$
confirm(action$)
"Hourglass_On"
*dbasehandle%=
($database%+".Database")
earmark
close_file(dbasehandle%)
ptr%=!tempanchor%
%subtotal%=
count_recs(key%,zero%)
REC%=0
RA%-1
< ex%+=1:
"Hourglass_Percentage",(ex%*100)
subtotal%
ptr%?REC%=255
(
read(fields%,
,REC%,$database%)
% addr=
shift(movetype%,key%,0)
REC%
scrap_sliding_block(tempanchor%)
"Hourglass_Off"
"Wimp_CreateMenu",,-1
addr=
moveto(key%,top,1)
export_subset(f$)
I%,F,R%,recs%,ptr%,count%,subtotal%,blobs%,ex%,Z%,len%,source$,dest$,O$
"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%+".Colours "+f$+".Colours ~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"
"Hourglass_On"
"blobs%=
find_blobs($database%)
>Search$=
parse($
text(savesubW%,0),
selected(savesubW%,5))
*dbasehandle%=
($database%+".Database")
earmark
(f$+".Database")
ptr%=!tempanchor%
%subtotal%=
count_recs(key%,zero%)
I%=0
RA%-1
ptr%?I%=255
ex%=-1
ex%<blobs%
ex%+=1:F%=Ext%(ex%)
@
copy_blob($database%,f$,I%,recs%,F%,F%,chartype%(F%))
<
readsmarray(dbasehandle%,I%):
writesmarray(F,recs%)
count%+=1
:
"Hourglass_Percentage",(count%*100)
subtotal%
scrap_sliding_block(tempanchor%)
=F$()="":
writesmarray(F,recs%):
#F=Length%*recs%:recs%-=1
K%=0
Keys%
, KL%(MaxKeys%+1)=KL%(K%):val$=
type(K%)
! KF%(MaxKeys%+1,0)=KF%(K%,0)
! KF%(MaxKeys%+1,1)=KF%(K%,1)
I%=0
% KW%(MaxKeys%+1,I%)=KW%(K%,I%)
make_empty_index(recs%,MaxKeys%+1,
REC%=0
recs%-1
readsmarray(F,REC%)
KEY$=
key2(K%,1)
insert(KEY$,MaxKeys%+1)
4
"Hourglass_Percentage",(REC%*100)
recs%
REC%
& keybase%=!keyanchor%(MaxKeys%+1)
"SlidingHeap_DescribeBlock",slidingheapbase%,keyanchor%(MaxKeys%+1)
,,filelength%
K%>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"
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
I%,P%
tempanchor%
scrap_sliding_block(tempanchor%)
create_named_sliding_block(tempanchor%,RA%)
ptr%=!tempanchor%
I%=0
RA%-1
ptr%?I%=0
neighbour(key%,top,1)
scan_file("P%<>top",key%,2)
rotate
Access%
confirm(
msg(49))=
keybase%
I%,L%,Z%,Q%,R%,S%,key%
key%=0
Keys%
keybase%=!keyanchor%(key%)
S%=LH%+40
Z%=keybase%!S%
I%=S%-8
S%-40
) L%=keybase%!I%:R%=keybase%!(I%+4)
=
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%
! PR%=
neighbour(key%,I%,0)
! SU%=
neighbour(key%,I%,1)
'
PR%>S%
keybase%!(PR%+4)=-I%
#
SU%>S%
keybase%!SU%=-I%
key%
$date%=
warn%=
write_log(-1,"Subfiles rotated")
create_index
indexing%
printing%
Keys%=MaxKeys%
softerror(
(Keys%),95):
file%,top,P%,KEY$,REC%,val$,zero%,abort%,replace%
newkey%=0
;f$=Tag$(Keyfld0%):
Keyfld1%>0
f$+="+"+Tag$(Keyfld1%)
newkey%+=1
Index$(newkey%)=f$
newkey%>Keys%
newkey%<=Keys%:
$
confirm(
msg(50))=
%3
scrap_sliding_block(keyanchor%(newkey%))
replace%=
abort%=
(
Keys%>MaxKeys%:Keys%-=1:
softerror("",31):abort%=
:Keys%=newkey%
abort%
-*block%!8=0:block%!12=keyW%:block%!16=7
"Interface_SlabButton",,block%
copy_keydata(newkey%)
Index$(newkey%)=f$
1-f$=$database%+".Indices."+Index$(newkey%)
make_empty_index(RA%,newkey%,
lit(menu%(0),2,
limit_actions(
abort_index(f$):
7*dbasehandle%=
($database%+".Database")
indexing%=
:Search$="TRUE"
update_stats
file%=0
top=file%*8+LH%
P%=
neighbour(key%,top,1)
val$=
type(newkey%)
"Hourglass_On"
scan_file("P%<>top",key%,4)
file%
end_index
colour(newkey%,2)
warn%=
write_log(-1,"Index "+Index$(newkey%)+" created")
abort_index(f$)
end_index
replace%
open_index(f$,newkey%,
index%=newkey%
Keys%
N) 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(menu%(0),2,Modify%)
close_file(dbasehandle%)
shift(t%,k%,m%)
a%,key%,fi%,I%,F$,action$
Access%
=addr
REC%=RA%
=addr
t%=0
m%=1
confirm(
msg(51))=
=addr
key%=0
Keys%
i2 N$=
key(key%):kl%=KL%(key%):val$=
type(key%)
delete(N$,key%)
N$="*Failed*"
=addr
key%=k%
a%=SU%
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:
vR
blob_path(
,$database%,REC%,I%,V%,F$)>=0
"OS_CLI","Delete "+F$
9,37:
xR
blob_path(
,$database%,REC%,I%,V%,F$)>=0
"OS_CLI","Delete "+F$
zR
blob_path(
,$database%,REC%,I%,V%,F$)>=0
"OS_CLI","Delete "+F$
~6
insert(N$,key%):date%?fi%=1:$Date%(fi%)=
top=8*file%+LH%
date%?file%=1
$Date%(file%)=
key%
blankrec%=
I%=1
fields%
$Rf%(I%)=""
$
write_dbase(REC%,fields%,
& action$=" Deleted and blanked"
action$=" Deleted"
:action$=" ===> subfile "+
(fi%)
write_log(REC%,logentry$+action$)
warn%=
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%,(1<<0)+(1<<1)+(1<<4),"Powerbase: please confirm:"
,result%
=result%=1
getscreensize(
S_Width%,
S_Height%)
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)
match
check_change
common%
text(matchW%,0)=""
redraw_icon(matchW%,0)
open_window(matchW%)
set_caret(matchW%,0)
text(matchW%,3)=Tag$(Match_tag%)
tick_one(fieldmenu%,0,fields%-1,Match_tag%-1)
redraw_icon(matchW%,3)
text(matchW%,14)=""
redraw_icon(matchW%,14)
selected(matchW%,27)
text(matchW%,25)="Number found"
text(matchW%,25)="Time taken"
redraw_icon(matchW%,25)
"fieldfunc$="match":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%,24)
clear_selection
deselect(printW%,24)
select(printW%,old%)
do_it(Search$,displayed%)
printing%
zero%,P%,rec%,REC%,copy%
lit(menu%(18),1,
Form$=printorder$
Form$=""
W%=0
KF%(0,W%)>0
: F$=
~(KF%(0,W%)):
(F$)=1
F$="0"+F$:Form$+=F$
}
selected(matchW%,27)
select(mainW%,field%(KF%(0,W%))):printorder$+=F$:
lit(menu%(6),7,
lit(menu%(6),8,
#Heading$="":Hlongest%=0:Sum()=0
I%=1
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
,numfirst%=
margin_warn:
numfirst%<0
list_head(0)
"Wimp_GetPointerInfo",,block%
limit_actions(
lit(menu%(0),2,0)
printing%=
"OS_ReadMonotonicTime"
stime%
abort_printing:
*dbasehandle%=
($database%+".Database")
"Hourglass_On"
displayed%>=0:
readsmarray(dbasehandle%,displayed%)
format$="label"
copy%=1
labcopies%
#
print_record(displayed%)
copy%
#
print_record(displayed%)
usekey%=-1
selected(matchW%,23)=
< P%=
neighbour(key%,top,1):
scan_file("P%<>top",key%,1)
# P%=
search(useval$,usekey%,1)
P%>=0
k$=useval$:
scan_file("P%<>top AND k$=useval$",usekey%,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%,27)
text(matchW%,14)=
(printed%)
text(matchW%,14)=
(time%
100)+"."+
(time%
100)+" sec"
redraw_icon(matchW%,14)
"Hourglass_Smash"
format$<>"label"
displayed%=-1
total_list
reportdest$
"Window":
selected(matchW%,27)
screen_list
extend_named_sliding_block(textanchor%,Count%*LenLine%)
"File":
close_file(texthandle%):
"OS_File",18,f$,&fff
close_window(saveW%)
"Printer":
extend_named_sliding_block(textanchor%,Count%*LenLine%)
B Start%=!textanchor%:End%=Start%+Count%*LenLine%+1:Type%=&fff
) $Start%=pitch$:?(End%-1)=0:?End%=12
; block%!0=256:block%!12=0:block%!16=&80142:block%!20=0
D 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(menu%(0),2,Modify%)
limit_actions(Access%)
close_file(dbasehandle%)
write_log(-1,"List printed: "+searchformula$)
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
selected(matchW%,23)=
2! P%=
neighbour(key%,top,1)
3$
scan_file("P%<>top",key%,0)
4
5% P%=
search(useval$,usekey%,1)
P%>=0
k$=useval$
88
scan_file("P%<>top AND k$=useval$",usekey%,0)
9
"Hourglass_LEDs",%00
"Hourglass_Off"
close_file(dbasehandle%)
get_lengths
I%,L%,F%,l%,F$
I%=-1:L%=
(Form$)-1
I%<L%
E5 I%+=2:F%=
fnum(
Form$,I%,2)):F$=F$(F%):l%=
l%>maxlen%(F%)
maxlen%(F%)=l%
end_find_max
"Hourglass_Smash"
close_file(dbasehandle%)
maxlen%()=len%()
softerror("",70)
wimp_error(
print_record(REC%)
I%,F%,N%,Z%,F$,SF$,Tab%,n$,y$,base%,pos%
format$<>"label"
printed%+=1
selected(matchW%,27)
X-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%)
a!
selected(printW%,11)
b/ F$=
expand(F$(F%),link$(F%),Len%,SF$)
d# F$=F$(F%):Len%=len%(F%)+2
chartype%(F%)
41,42,43,44,45:
g Z%=
no_yes(F%,n$,y$)
h$
F$=" "
F$=y$
F$=n$
i#
3,6,8,46,47,54,56,57:
j/
sums(F$,calcrow%?F%,chartype%(F%))
format$="vert"
l( F$=
len%(F%)-
(F$)," ")+F$
m'
justify(F$,N%,N%-1)
p
selected(printW%,12)
u(F$)
chartype%(F%)
37:F$="<Sprite>"
38:F$="<Drawfile>"
format$
"horiz","table":
y>
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%<LenLine%
9
heap_store(lineanchor%,LenLine%,0,pos%,0,F$)
:
list_line(REC%,lineanchor%,hdlen%+datlen%,32)
A L%=LenLine%-hdlen%-1:F$+=" ":H$=
hdlen%," "):first%=
(F$)>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
N $(!lineanchor%)=margin$+
(12):
list_line(-1,lineanchor%,Lmargin%+1,32)
>
list_head(1)::
lit(menu%(18),1,
selected(printW%,10))
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%
)
B%=10
L%=LenLine%-3
#text%
'
B%=10:rem$="":Line$=
Line$)
#text%:rem$=""
2
:rem$=
Line$,sp%+1):Line$=
Line$,sp%-1)
pos%=base%
8
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%
*len%=
load_blob($database%,REC%,F%,36)
len%>0
! case%=
selected(matchW%,16)
base%=!tempanchor%:ptr%=-1
line$=""
& ptr%+=1:line$+=
(base%?ptr%)
"
(line$)>250
ptr%=len%
#
case%
line$=
u(line$)
!
line$,s$)>0
found%=
ptr%=len%
=found%
print_labels
I%,Line$,S$,linesprinted%,pos%
I%=0
labrepl%-1
Line$=margin$
K%=0
thislab%-1
S$=Label$(I%,K%)
!
selected(labelW%,11)
9
I%=labsubst%
S$=""
S$=Label$(labrepl%,K%)
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
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%<labdepth%
rule_off(32)
linesprinted%+=1
&thislab%=0:thisrow%=-1:Label$()=""
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$)
03Lmargin%=
text(printW%,30)):Tab%(0)=Lmargin%
margin$=
Lmargin%," ")
2"Tmargin%=
text(printW%,32))
3#TextLine%=
text(printW%,34))
4#linefeed%=
text(printW%,17))
5#colwidth%=
text(printW%,45))
6*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"
B9 LinesPerPage%=(pagelength%-Tmargin%-15)
linefeed%
24:format$="vert"
DJ LinesPerPage%=(pagelength%-Tmargin%-15)
(linefeed%*(
(Form$)
format$="table"
G$ columns%=
text(printW%,15))
H0 column$=
columns%,"|"+
colwidth%," "))+"|"
I9 LinesPerPage%=(pagelength%-Tmargin%-15)
linefeed%
format$="label"
L) labwidth%=
text(labelW%,4))*cpi%
M& labdepth%=
text(labelW%,6))*6
N1 labrows%=(pagelength%-Tmargin%)
labdepth%
rows_printed%=0
PA labup%=
selected_esg(labelW%,1):
### Value is 0,1 or 2 ###
Q$ labrepl%=
text(labelW%,10))
R' labsubst%=
text(labelW%,12))-1
S& labcopies%=
text(labelW%,17))
T% Title$="":Title1$="":Title2$=""
selected_esg(printW%,4)
38:reportdest$="Window"
39:reportdest$="File"
41:reportdest$="Printer"
LinesPerPage%=0
LinesPerPage%=1
pitch(p$)
selected(printW%,42)
(31)+"9"+p$+"01"
list_head(place%)
place%=0
reportdest$
"Window","Printer":
RU%=
($used%)
fO
RU%<5
textblocksize%=5*LenLine%
textblocksize%=(RU%
5)*LenLine%
g$ textblockinc%=textblocksize%
h?
extend_named_sliding_block(textanchor%,textblocksize%)
TextPtr%=!textanchor%
recblocksize%=400
k=
extend_named_sliding_block(recanchor%,recblocksize%)
l%
"File":
#texthandle%,pitch$
extra_lines(Tmargin%,0)
displayed%=-1
send_title(Title$)
send_title(Title1$)
send_title(Title2$)
format$
"horiz":
selected(printW%,29)
yV
selected(printW%,42)
$(!lineanchor%)=uon$:
list_line(-1,lineanchor%,2,32)
z.
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%
/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
C%,L%,base%,pos%,L$
#L$=margin$+"Total "+
(printed%)
!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(menu%(6),7,
send_title(T$)
C$,L$,P%,L%
T$=""
L%=LenLine%-Lmargin%-1
(T$)>=L%
P%=
P%-=1:C$=
T$,P%,1)
"= ,.;:",C$)>0
P%<L%)
P%=0
P%=0
' L$=margin$+
T$,L%-1):T$=
T$,L%)
)
L$=margin$+
T$,P%):T$=
T$,P%+1)
$(!lineanchor%)=L$
list_line(-1,lineanchor%,
(L$),32)
$(!lineanchor%)=margin$+T$
list_line(-1,lineanchor%,Lmargin%+
(T$),32)
screen_list
!!block%=0:block%!4=-Count%*32
(block%!8=(LenLine%-1)*16:block%!12=0
"Wimp_SetExtent",listW%,block%
!block%=listW%
"Wimp_GetWindowState",,block%
;x%=(block%!12+block%!4)
2:y%=(block%!16+block%!8)
"block%!12=block%!4+LenLine%*16
Count%<28
" block%!16=block%!8+Count%*32
block%!16=block%!8+32*28
"Wimp_CloseWindow",,block%
open_window(listW%)
Listed%=
show_menu(menu%(18),x%,y%)
sort_list
I%,N%,E%
(Form$)
!block%=listW%
"Wimp_GetWindowState",,block%
-column%=(mousex%-block%!4+block%!20)
N%+=1
Tab%(N%)>column%+1
N%=E%
N%-=1
>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%)
lose_list
close_window(listW%)
scrap_sliding_block(textanchor%)
scrap_sliding_block(recanchor%)
Listed%=
parse(S$,case%)
val%,I%,P%,F%,f%,t%,flag%,left%,right%,search$,field$,op$,bo$,target$,targ$,f$,t$,E$,E1$,TitFd$,TitTg$,simple%,date$,SF$
usekey%=-1:useval$=""
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(60)
strip_brackets
(W$)>0
#* flag%=
:TitFd$="":TitTg$="":op$=""
%5
"AND","OR","NOT":E$=W$:Title$+=" "+E$+" "
&+
"&":E$="AND":Title$+=" "+E$+" "
E$=""
split
(field$)>0
+$ f$=
word(field$,","))
f%=
field(f$,
f$="F$("+
(f%)+")"
.(
case%
f$="FNu("+f$+")"
/%
val%
f$="VAL("+f$+")"
chartype%(f%)
13
5,51,52:f$="FNreverse_date("+f$+")"
targ$=target$
(targ$)>0
5' t$=
word(targ$,","):u$=t$
6B
flag%
TitTg$+=
expand(t$,link$(f%),L%,SF$)+","
7
chartype%(f%)
80
41,42,43,44,45:t$=
pos_neg(t$)
5,51,52:
:K
check_date(t$,2,date$)=
reverse_date(date$):u$=t$
t$=""""+t$+""""
='
val%
t$="VAL("+t$+")"
f%=0
op$
@;
"{","=":E1$="FNany("+t$+","""+op$+""")"
A.
"}{":
moan_err%,
msg(100)
B.
"<>":
moan_err%,
msg(101)
C7
moan_err%,""""+op$+""""+
msg(102)
op$
"{":
H$
chartype%(f%)
IC
36,39:E1$=" FNinmemo("+
(f%)+","+t$+")=TRUE "
J2
:E1$="INSTR("+f$+","+t$+")>0"
"}{":
M$
chartype%(f%)
ND
36,39:E1$=" FNinmemo("+
(f%)+","+t$+")=FALSE "
O2
:E1$="INSTR("+f$+","+t$+")=0"
"=":
E1$=f$+op$+t$
S,
simple%=
usekey%=-1
T+ foundkey%=
is_a_key(f%)
U@
foundkey%>=0
KL%(foundkey%)=len%(f%)
V2 usekey%=foundkey%:useval$=u$
Y!
:E1$=f$+op$+t$
\@
(E$)+
(E1$)>255
moan_err%,
msg(6)
E$+=E1$
]@
(E$)+
(bo$)>255
moan_err%,
msg(6)
E$+=bo$
flag%=
E$=
(E$)-
(bo$))
E$,bo$)>0
c=
(E$)>253
moan_err%,
msg(6)
E$="("+E$+")"
e
add_brackets
E$+=" "
(search$)+
(E$)>255
moan_err%,
msg(6)
search$+=E$
build_title
o,Title$=
leaf($database%),2)+". "+Title$
usekey%>=0
q* kl%=KL%(usekey%):val$=
type(usekey%)
deselect(matchW%,23):
deselect(savesubW%,6)
=search$
pos_neg(s$)
"+","y","Y","*","
","T","t":s$=" "
"-","n","N","x","X","F","f":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%),(P%>Q2%
Q2%>0):
5 S$=
S$,Q1%-1)+
S$,Q1%+1,Q2%-Q1%-1)+
S$,Q2%+1)
9 P%=Q2%-2:
### S$ is now 2 characters shorter ###
)
Q1%>0
Q2%=0:
softerror("",93)
S$=
S$,Q1%-1)+
S$,Q1%+1)
Q1%+Q2%=0
P%<Q1%
S$,P%-1)
S$,P%+1)
any(targ$,op$)
F%,found%,case%,F$
case%=
selected(matchW%,16)
F%+=1:F$=F$(F%)
case%
u(F$)
op$
"{":
chartype%(F%)
36,39:
(
inmemo(F%,targ$)
found%=
%
F$,targ$)>0
found%=
#
"=":
F$=targ$
found%=
found%
F%=fields%
=found%
split
X$,Q%,I%
8X$=">=>=,<=<=,<>,}{,>=,<=,==,>>,<<,{{,=,<,>,{,":P%=0
(X$)>0
P%=0
, Q%=
X$,","):op$=
X$,Q%-1):X$=
X$,Q%+1)
P%=
W$,op$)
P%>0
field$=
W$,P%-1)
target$=
W$,P%+
(op$))+","
case%
target$=
u(target$)
field$=
exp_field
op$
"<>","}{":bo$="AND"
"<=",">=":bo$="OR"
"<=<=",">=>=":
op$=
op$,2):bo$="AND"
"==","<<",">>","{{":
op$=
op$,1):bo$="AND"
:bo$="OR"
moan_err%,
msg(40)
exp_field
P%,I%,F1%,F2%,F$
field$,"-")
P%=0
F$=field$+","
! F1%=
field(
field$,P%-1),
! F2%=
field(
field$,P%+1),
F1%>F2%
F1%,F2%
I%=F1%
F$+=Tag$(I%)+","
fnum(S$)
("&"+S$)
newline%=((N%
128)>0)
=(N%
127)
field(f$,Z%)
I%,F%,desc$
f$="@"
TitFd$="Any field ":=0
val%=
f$,1)="["
f$)="]"
f$),2):val%=
I%<fields%
I%+=1
u(Tag$(I%))=
u(f$)
F%=I%
F%>0
$ desc$=$
text(mainW%,desc%(F%))
desc$<>""
TitFd$+=desc$+","
TitFd$+=f$+","
F%=0
moan_err%,
msg(8)+" ("+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
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$="{"
I
change%
TitTg$="Any of:"+TitTg$
TitTg$="All of:"+TitTg$
op$
"{":op$=" contains "
"}{":op$=" does not contain "
Title$+=TitFd$+op$+TitTg$
expand(string$,table$,
ExpLen%,
subst$)
p$,s$,start%,F%,I%,T%,ind%,row%,Rec%,Rows%,TabFields%,field%,sfield%,pos%,spos%
subst$=string$
table$=""
ExpLen%=0:=string$:
### Not linked ###
*&field%=
table$)):table$=
table$)
(table$)<58
(table$)<>-1
sfield%=
(table$):table$=
table$,2)
sfield%=-1
table_number(table$)
T%<0
ExpLen%=0:=string$:
### Table not found ###
p$=printrel$(T%)
/;T$=
table_info(T%,Rows%,TabFields%,Rec%,tabfieldlen%())
0,pos%=
table_field(field%,tabfieldlen%())
sfield%>=0
spos%=
table_field(sfield%,tabfieldlen%())
p$<>""
ExpLen%=0
I%=1
F%=
p$,I%,1))
6# ExpLen%+=tabfieldlen%(F%)+2
ExpLen%-=2
ExpLen%=tabfieldlen%(1)
;4start%=!tabanchor%(T%)+160-Rec%:ind%=start%+pos%
row%+=1:ind%+=Rec%
row%>Rows%
$ind%=string$
row%>Rows%
subst$="":=string$:
## String not in table ###
@=ind%=start%+row%*Rec%:
sfield%>=0
subst$=$(ind%+spos%)
p$<>""
I%=1
F%=
p$,I%,1))
D, pos%=
table_field(F%,tabfieldlen%())
E4 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%,name$,table$,S$
link$(F%)=""
S$=$Rf%(F%)
name$=link$(F%)
Q$field%=
name$)):table$=
name$)
(table$)<58
(table$)<>-1
table$=
table$,2)
S/table%=
table_number(table$):
table%<0
T?T$=
table_info(table%,Rows%,TabFields%,Rec%,tabfieldlen%())
TabFields%=field%
softerror("",54):=0
V,pos%=
table_field(field%,tabfieldlen%())
W1valpos%=
table_field(field%+1,tabfieldlen%())
X'start%=!tabanchor%(table%)+160-Rec%
row%+=1
Z ind%=start%+row%*Rec%+pos%
row%>Rows%
S$=$ind%
row%<=Rows%
]# ind%=start%+row%*Rec%+valpos%
N%=
($ind%)
N%=0
pad(s$,L%)
(s$)<L%
s$+=" "
include_fields
Hdlen%,Datlen%,hlm%,dlm%,I%,F%,f$,Head$,limit%,pad%,col%,fail%,n$,y$,SF$,memo%,base%,pos%,blocksize%,blockinc%
k'blocksize%=256:blockinc%=blocksize%
extend_named_sliding_block(headanchor%,blocksize%)
m!base%=!headanchor%:pos%=base%
heap_store(headanchor%,blocksize%,blockinc%,pos%,0,margin$)
selected(matchW%,29)
Form$="00"+Form$
I%=1
(Form$)-1
F%=
fnum(
Form$,I%,2))
chartype%(F%)
s0
36,39:dlm%=TextLine%:memo%=
set_vert
41,42,43,44,45:
u! Datlen%=
no_yes(F%,n$,y$)
vE
### Get data length for strings printed for check boxes ###
selected(printW%,11)
y/ f$=
expand("@#*",link$(F%),Datlen%,SF$)
z)
Datlen%=0
Datlen%=maxlen%(F%)
{
Datlen%=maxlen%(F%)
selected(printW%,2)
Head$=$
text(mainW%,(desc%(F%)))
Head$=Tag$(F%)
F%=0
Head$="RECORD":Datlen%=6
Datlen%>dlm%
dlm%=Datlen%
Hdlen%=
(Head$)
Hdlen%>hlm%
hlm%=Hdlen%
format$
"horiz","table":
- pad%=Datlen%-Hdlen%:
pad%<0
pad%=0
chartype%(F%)
c
3,6,46,47,54,56,57:
selected(printW%,11)
Head$+=
pad%," ")
Head$=
pad%," ")+Head$
A
### Right justify numbers unless Expand option on ###
:Head$+=
pad%," ")
J
heap_store(headanchor%,blocksize%,blockinc%,pos%,0,Head$+spacer$)
# Tab%((I%+1)
2)=pos%-base%
format$
"horiz":L%=pos%-base%+2
"vert":L%=TextLine%+5:Tab%(1)=hlm%
"table":
col%=
(column$)
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%
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
load_selection(f$)
F%,I%,T%,F
printorder$=
T%=-1
T%+=1
printrel$(T%)=
close_file(F)
F%=1
fields%
chartype%(F%)>40
. col%=
get_icon_cols(mainW%,field%(F%))
E
(col%
%1111)<2
col%=((col%>>4)
(col%<<4))
%11111111
.
set_icon_cols(mainW%,field%(F%),col%)
&
deselect(mainW%,field%(F%))
I%=1
(printorder$)-1
" F%=
fnum(
printorder$,I%,2))
chartype%(F%)>40
. col%=
get_icon_cols(mainW%,field%(F%))
0 col%=((col%>>4)
(col%<<4))
%11111111
.
set_icon_cols(mainW%,field%(F%),col%)
$
select(mainW%,field%(F%))
lit(menu%(6),7,
lit(menu%(6),8,
select_all
F%,T%,F$
printorder$=""
F%=1
fields%
chartype%(F%)
41,42,43,44,45:
. col%=
get_icon_cols(mainW%,field%(F%))
F
(col%
%1111)>=2
col%=((col%>>4)
(col%<<4))
%11111111
.
set_icon_cols(mainW%,field%(F%),col%)
' F$=
~(F%):
(F$)=1
F$="0"+F$
printorder$+=F$
0,1,2,4,5,7,8:
len%(F%)>0
) F$=
~(F%):
(F$)=1
F$="0"+F$
printorder$+=F$
$
select(mainW%,field%(F%))
(
36,39,48,49,50,51,52,53,55,58:
' F$=
~(F%):
(F$)=1
F$="0"+F$
printorder$+=F$
"
select(mainW%,field%(F%))
3,6,46,47,54,56,57:
' F$=
~(F%):
(F$)=1
F$="0"+F$
printorder$+=F$
"
select(mainW%,field%(F%))
"
enable_row(calcrow%?F%,
lit(menu%(6),7,
lit(menu%(6),8,
clear_selection
F%,T%
F%=1
fields%
chartype%(F%)
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%
printrel$(T%)=""
lit(menu%(6),7,
lit(menu%(6),8,
load_query(f$)
F%,I%,Q$
selected(keypadW%,22)
"OS_File",255,f$,
text(keypadW%,29)
set_caret(keypadW%,29)
redraw_icon(keypadW%,29)
"OS_File",255,f$,
text(matchW%,0)
open_window(matchW%)
set_caret(matchW%,0)
redraw_icon(matchW%,0)
load_options(f$)
F,I%,set%,ic%
end_load:
I%=1
#F,set%:
set_icon(printW%,ic%,set%)
I%=1
text(printW%,ic%)
redraw_icon(printW%,ic%)
I%=1
#F,set%:
set_icon(printW%,ic%,set%)
I%=1
#F,set%:
set_icon(labelW%,ic%,set%)
I%=1
text(labelW%,ic%)
I%=1
#F,set%:
set_icon(labelW%,ic%,set%)
close_file(F)
icon_bit(22,printW%,15,
selected(printW%,25))
icon_bit(22,printW%,45,
selected(printW%,25))
icon_bit(22,labelW%,12,
selected(labelW%,11))
1,2,4,6,7,8,23,24,25,26,38,39,41:REM Radio buttons
15,16,17,18,30,32,34,43,45:REM Writable fields
10,11,12,19,29,40,42:REM Option switches
In Label Definition window
0,1,2:REM Radio buttons
4,6,10,12,17:REM Writable fields
11,13,16:REM Option switches
end_load
close_file(F)
222:
wimp_error(
,fatal_err%,
,f$+" not found")
6,223:
### 6="Type mismatch", 223="End of file" ###
wimp_error(
,moan_err%,
,f$+" is too old and is being deleted")
"OS_CLI","Delete "+f$
leaf(f$)="PrintOpts"
load_options("<Pbase$Dir>.Resources.PrintOpts")
wimp_error(
,moan_err%,
design_field
w%,h%
posx%=x%:posy%=y%
^3!block%=mainW%:
"Wimp_GetWindowState",,block%
x%+=block%!20-block%!4
y%+=block%!24-block%!16
%1111111
(ic%
2)=1
drag%=6:dragbutt%=16
drag%=5:dragbutt%=64
init_drag(mainW%,ic%,drag%)
$InsText%=""
deselect(createW%,
selected_esg(createW%,1))
ic%>=0
lit(menu%(9),0,
jB !block%=mainW%:block%!4=ic%:
"Wimp_GetIconState",,block%
kM x%=block%!8:y%=block%!12:w%=block%!16-block%!8:h%=block%!20-block%!12
l$ Fieldnumber%=
get_field(ic%)
m% type%=chartype%(Fieldnumber%)
type%
0,1,2,3,4,5,6,7,8:
select(createW%,21)
set_limits(0,0,8,8)
36,37,38,39,40:
select(createW%,22)
t"
set_limits(36,36,40,11)
41,42,43,44,45:
select(createW%,24)
w"
set_limits(41,41,45,14)
x6
46,47,48,49,50,51,52,53,54,55,56,57,58,59:
select(createW%,35)
z"
set_limits(46,46,59,16)
select(createW%,23)
}
set_limits(9,9,35,19)
~
fieldtype%=type%
R
tick_one(menu%(menunumber%),0,lasttype%-firsttype%,fieldtype%-firsttype%)
4 $FtitleText%="Modify field "+
(Fieldnumber%)
5 $DescText%=$
text(mainW%,desc%(Fieldnumber%))
$ $TagText%=Tag$(Fieldnumber%)
' $LenText%=
(len%(Fieldnumber%))
$ $ValText%=vname$(fieldtype%)
l
fix%(Fieldnumber%)>0
$Fixpt%=
(fix%(Fieldnumber%)):
select(createW%,14)
deselect(createW%,14)
:
icon_bit(22,createW%,13,(
selected(createW%,14)))
?
icon_bit(22,createW%,14,(fieldtype%=3
fieldtype%=6))
#
icon_bit(22,createW%,18,
[
icon_bit(22,createW%,6,(fieldtype%<9
fieldtype%=46
fieldtype%=47)
adjust%)
+
icon_bit(22,createW%,30,
adjust%)
#
icon_bit(22,createW%,29,
@
icon_bit(22,createW%,15,(fieldtype%=3
fieldtype%=47))
0
icon_bit(22,createW%,25,(fieldtype%=3))
* C$=calc$(Fieldnumber%):P%=
C$,"|")
8
P%>0
$mintext%=
C$,P%-1):$maxtext%=
C$,P%+1)
I%=21
-
icon_bit(22,createW%,I%,
adjust%)
+
icon_bit(22,createW%,35,
adjust%)
+
icon_bit(22,createW%,39,
adjust%)
+
icon_bit(22,createW%,40,
adjust%)
"
lit(menu%(9),0,
adjust%)
select(createW%,21)
set_limits(0,0,8,8)
. $FtitleText%="New field "+
(fields%+1)
/ $DescText%="":$TagText%="":$LenText%=""
- $Fixpt%="2":$mintext%="":$maxtext%=""
deselect(createW%,14)
#
icon_bit(22,createW%,13,
#
icon_bit(22,createW%,14,
#
icon_bit(22,createW%,15,
#
icon_bit(22,createW%,25,
#
icon_bit(22,createW%,29,
#
icon_bit(22,createW%,30,
#
icon_bit(22,createW%,39,
#
icon_bit(22,createW%,40,
+
icon_bit(22,createW%,18,
adjust%)
9 $boxX%=
(x%):$boxY%=
(y%):$boxW%=
(w%):$boxH%=
close_window(createW%)
show_menu(menu%(9),posx%-64,posy%-20)
init_drag(mainW%,ic%,5):dragbutt%=64
remove_field(Field%,con%,
Calc$)
con%
confirm(
msg(53))=
)!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%
fields%=MaxFields%
softerror(
(MaxFields%),23):
$DescText%=""
$TagText%=""
fieldtype%<=8
($DescText%):LF%=
($LenText%)
LF%>246
softerror("",64):
($boxX%):y%=
($boxY%):width%=
($boxW%):height%=
($boxH%)
fieldtype%
39,40,59:
LF%=0
width%=0
width%=48
height%=0
height%=48
41,42,43,44,45: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%,14)
fix%(fields%)=
($Fixpt%)
fix%(fields%)=0
extend_named_sliding_block(formanchor%,Fptr%-!formanchor%+L%+6)
kdesc%(fields%)=
create_icon(mainW%,x%-L%*16-16,y%,L%*16+8,48,(winback%<<28)+&7016731,"",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:valptr%=hand%
: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%<fields%
Before%>0
re_sequence(fields%,Before%,-1)
adjust_field(b%)
Dptr%,Fptr%
"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$)
"Wimp_DeleteIcon",,block%
"Wimp_GetWindowState",,block%
- x%=block%!20-block%!4+newx%-oldx%+minx%
. y%=block%!24-block%!16+miny%+newy%-oldy%
[ desc%(Fieldnumber%)=
create_icon(mainW%,x%,y%,L%*16+8,48,&17016731,"",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%
F width%=maxx%-minx%+newx%-oldx%:height%=maxy%-miny%+oldy%-newy%
G !block%=mainW%:block%!4=ficon%-1:
"Wimp_GetIconState",,block%
0 Dptr%=block%!28:Desc$=$Dptr%:L%=
(Desc$)
$
"Wimp_DeleteIcon",,block%
C !block%=mainW%:block%!4=ficon%:
"Wimp_DeleteIcon",,block%
(
"Wimp_GetWindowState",,block%
8 x%=block%!20-block%!4+newx%-oldx%+minx%-L%*16-16
0 y%=block%!24-block%!16+miny%+newy%-oldy%
k desc%(Fieldnumber%)=
create_icon(mainW%,x%,y%,L%*16+8,48,(winback%<<28)+&7016731,"",Dptr%,hand%,L%)
(
"Wimp_GetWindowState",,block%
/ x%=block%!20-block%!4+newx%-oldx%+minx%
0 y%=block%!24-block%!16+miny%+newy%-oldy%
. width%=maxx%-minx%:height%=maxy%-miny%
!( fieldtype%=chartype%(Fieldnumber%)
fieldtype%
#V
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%
%%
:valptr%=hvalid%(fieldtype%)
icon_design(fieldtype%,1,width%,height%)
(_ field%(Fieldnumber%)=
create_icon(mainW%,x%,y%,width%,height%,iflags%,"",Fptr%,valptr%,4)
fieldtype%=40
Rf%(Fieldnumber%)=
create_anchor("Picture"+
(Fieldnumber%))
+@$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%)
field%(F1%),field%(F2%)
len%(F1%),len%(F2%)
chartype%(F1%),chartype%(F2%)
fix%(F1%),fix%(F2%)
calc$(F1%),calc$(F2%)
close_window(createW%)
re_sequence(F1%,F2%,Z%)
?wD%=desc%(F1%):T$=Tag$(F1%):F%=field%(F1%):L%=len%(F1%):C%=chartype%(F1%):f%=fix%(F1%):
Calc$=""
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%
0:bfg%=&1700A53B:ffg%=&0700A535:
logosloaded%
lfg%=&0000011A
lfg%=ffg%
1:bfg%=&1700653B:ffg%=&07006535:
logosloaded%
lfg%=&0000611E
lfg%=ffg%
char%
9,10,11,12,13,14,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%
32,33,34:w%=112:h%=44:iflags%=bfg%
35:w%=80:h%=64:iflags%=bfg%
31:w%=44:h%=44:iflags%=&1700B53B
36,37,38:w%=48:h%=44:iflags%=bfg%
39:iflags%=ffg%
func%=0
iflags%=&0700A53E
iflags%=ffg%
41,42,43,44,45:w%=52:h%=52:iflags%=&1700B53B
59:iflags%=lfg%
: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(menu%(9),5,on%)
lit(menu%(9),1,
on%)
lit(menu%(9),2,
on%)
lit(menu%(9),3,
on%)
lit(menu%(9),4,
on%)
icon_bit(22,createW%,6,
on%)
change_length(NL%,msg%)
EX%,klm%,S$,N%
EX%=NL%-RA%
EX%=0
p*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%=
#dbasehandle%
I%=0
EX%-1
#dbasehandle%=end%+I%*Length%
J%=1
fields%
#dbasehandle%,""
#dbasehandle%=end%+EX%*Length%
RA%=NL%
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(52))=
P%=LH%+48+NL%*KLM%
!(keybase%+P%)=0
!(keybase%+P%+4)=0
$(keybase%+P%+8)=S$
" !(keybase%+P%+KL%(key%)+9)=0
key%
#dbasehandle%=Length%*(NL%+1)
RA%=NL%
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%,"<PBase$Dir>.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%,"<PBase$Dir>.Resources.Temp.!Sprites22"
"OS_SpriteOp",&11A,sprites%,"new_appl",leaf$
"OS_SpriteOp",&10C,sprites%,path$+".!Sprites22"
scrap_sliding_block(sprsanchor%)
defaults(f$,N%,key%)
$Records%=
make_empty_index(N%,key%,
save_recs(f$+".Database",N%)
present%=7:
save_keys
design%=
get_it_in(f$)
lit(menu%(0),2,
default_key
first_field
chartype%(F%)=3:KL%(0)=len%(F%)
len%(F%)>3:KL%(0)=4
:KL%(0)=len%(F%)
Index$(0)="PrimaryKey"
key%=0
(KW%()=0:KF%(key%,0)=F%:KF%(key%,1)=0
set_keydata(key%)
new_tree(f%)
REC%,I%,ptr%,file%,old$
old$="Length: "+
(KL%(0))+", Field(s): "+Tag$(KF%(0,0))+" "+Tag$(KF%(0,1))+", Chars: "+
(KW%(0,0))+","+
(KW%(0,1))+","+
(KW%(0,2))+","+
(KW%(0,3))
selected(keyW%,9):s%=
selected(keyW%,8)
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)
RA%=VAL($Records%)
"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"
*dbasehandle%=
($database%+".Database")
REC%=0
RA%-1
file%=ptr%?REC%
file%<>255
top=8*file%+LH%
'
readsmarray(dbasehandle%,REC%)
KEY$=
key2(0,1)
kl%=KL%(0):val$=
type(0)
$
KEY$<>""
insert(KEY$,0)
"Hourglass_Percentage",(REC%*100)
REC%
close_file(dbasehandle%)
"newtree%=
:design%=
:adjust%=
scrap_sliding_block(tempanchor%)
Index$(0)="PrimaryKey"
"Hourglass_Off"
present%=7
write_log(-1,"Primary key altered. Previous structure was: "+old$)
"Wimp_CreateMenu",,-1
*block%!8=0:block%!12=wi%:block%!16=ic%
"Interface_SlabButton",,block%
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)
f$=$database%:
softerror("",36)
$ blobs%=
find_blobs($database%)
(f$+".Form")
#F,dfields%
DTag$(dfields%),F%(dfields%),F1%(fields%),L%(dfields%),l$(dfields%),c$(dfields%)
I%=1
dfields%
F
#F,Desc$,DTag$(I%),xd%,yd%,xf%,yf%,L%(I%),char%,extra%,extra%
DLength%+=L%(I%)+1
chdd=
(f$+".Database")
compare
"Hourglass_On"
REC%=0
#chdd=REC%*DLength%
((
read(fields%,
,REC%,$database%)
I%=1
dfields%
S$=field$(F%(I%))
+)
(S$)>L%(I%)
S$,L%(I%))
#chdd,S$
ex%=-1
ex%<blobs%
ex%+=1:F%=Ext%(ex%)
1F
copy_blob($database%,f$,REC%,REC%,F%,F1%(F%),chartype%(F%))
2
32
"Hourglass_Percentage",(REC%*100)
REC%
"Hourglass_Off"
close_file(chdd)
"OS_File",18,f$+".Database",&7f2
"OS_CLI","Copy "+$database%+".PrimaryKey "+f$+".PrimaryKey ~C~V"
"OS_CLI","Copy "+$database%+".Colours "+f$+".Colours ~C~V"
"OS_CLI","Copy "+$database%+".ValTables "+f$+".ValTables ~CR~V"
"OS_CLI","Copy "+$database%+".Indices "+f$+".Indices ~CR~V"
"OS_CLI","Copy "+$database%+".PrintRes "+f$+".PrintRes ~CR~V"
link$(0)="LOADED"
lk=
(f$+".Link")
F%=1
dfields%
#lk,l$(F%)
close_file(lk)
calc$(0)="LOADED"
cl=
(f$+".Calc")
F%=1
dfields%
#cl,c$(F%)
close_file(cl)
close_window(reformW%)
reform$=""
write_log(-1,"Record structure changed")
compare
source%,dest%
dest%=1
dfields%
source%=fields%+1
source%-=1
source%=0
Tag$(source%)=DTag$(dest%)
X* F%(dest%)=source%:F1%(source%)=dest%
source%>0
Z l$(dest%)=link$(source%)
[ c$(dest%)=calc$(source%)
dest%
merge_files(f$,fi%)
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)
h7 s%=
selected(reformW%,2):d%=
selected(reformW%,3)
fi%=0
M$="Merge "+f$+" with "
M$+="corresponding subfiles"
M$+="subfile "+
(fi%)
l M$+=" of current database"
M$+=", also restoring deleted records"
M$+=". WARNING! Indices will need rebuilding!"
confirm(M$)=
p0
"OS_File",5,f$+".Database"
,,,,len%
RAM%=(len%
Length%)-1
rI
### Load primary key of file to be merged into a spare slot ###
s2
open_index(f$+".PrimaryKey",MaxKeys%+1,
t@
### Mark which subfile each new record is to go in ###
u0
mark_files(MaxKeys%+1,RAM%,
d%,s%,fi%)
v( keybase%=!keyanchor%(MaxKeys%+1)
wF
### Count how many record actually used in fiel to merge ###
x-
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%
Rec%=0
RAM%-1
file%=ptr%?Rec%
file%<>255
top=8*file%+LH%
$
read(fields%,
,Rec%,f$)
write(fields%,key%)
ex%=-1
ex%<blobs%
! ex%+=1:F%=Ext%(ex%)
E
copy_blob(f$,$database%,Rec%,REC%,F%,F%,chartype%(F%))
7
"Hourglass_Percentage",(Rec%*100)
RUM%
Rec%
"Hourglass_Off"
close_window(reformW%)
)
scrap_sliding_block(tempanchor%)
4
scrap_sliding_block(keyanchor%(MaxKeys%+1))
! file%=fi%:top=8*file%+LH%
addr=
moveto(key%,top,1)
reform$=""
write_log(-1,"Records merged from "+f$)
identical
I%,F,dfields%,different%
(f$+".Form")
#F,dfields%
dfields%<>fields%
different%=
I%<fields%
different%
I%+=1
#F,Desc$,Tag$,xd%,yd%,xf%,yf%,len%,char%,extra%,extra%
len%<>len%(I%)
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%
E$SaveName%=$database%+".PrintJobs.Tree"+
Index$(key%),5)+
(file%)
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%)
0
(M$)>5
M$=BL$
(M$)," ")+M$
H$+=L$:H1$+=M$
rule_off(45)
:$(!lineanchor%)=H$:
list_line(-1,lineanchor%,
(H$),32)
<$(!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(menu%(18),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
"count%=
count_recs(key%,zero%)
Dtextblocksize%=(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$="<null>"
S$)="#"
S$=
%rec%=!(keybase%+P%+8+KL%(key%)+1)
L%(COL%-1)=L%(COL%-1)+1
PR$="ALL"
COL%<=40
* string$=
COL%*6+10-
(S$)," ")+S$
L $(!lineanchor%)=string$:
list_line(rec%,lineanchor%,
(string$),32)
1 string$=" "+S$+" (level "+
(COL%-1)+")"
L $(!lineanchor%)=string$:
list_line(rec%,lineanchor%,
(string$),32)
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%
5. 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
F
start%=start%
end%=N%-start%-1
step%=step%
J$
I%=start%
end%
step%
K9 A%=recptr%+seglen%*(I%*(recs%(file%)+1)
L= balptr%!C%=!A%:$(balptr%+C%+4)=$(A%+4):!A%=-!A%-1
C%+=seglen%
step%=2
P& kl%=KL%(key%):val$=
type(key%)
Q%
I%=0
C%-seglen%
seglen%
R. REC%=balptr%!I%:KEY$=$(balptr%+I%+4)
insert(KEY$,key%)
done%+=1
U6
"Hourglass_Percentage",(done%*100)
max%
I%=0
recs%(file%)
X# REC%=recptr%!(seglen%*I%)
REC%>=0
Z( 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
h+ !(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%=
write_log(-1,"Index "+Index$(key%)+" balanced")
duplicates(dkey%,dfile%)
P$,S$,RP$,RS$,daddr,dtop,RP%,RS%,count%,examined%
abort_dup:
yE$SaveName%=$database%+".PrintJobs.Dupl"+
Index$(key%),5)+
(file%)
z"count%=
count_recs(key%,zero%)
read_print_options
|Breportdest$="Window":format$="dup":Count%=0:LenLine%=KL%(0)+23
}<textblocksize%=100*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%)
close_window(datadicW%)
rule_off(32)
aline$=" Duplicated primary keys":$(!lineanchor%)=line$:
list_line(-1,lineanchor%,
(line$),32)
rule_off(45)
dtop=8*dfile%+LH%
"daddr=
neighbour(dkey%,dtop,1)
"Hourglass_On"
daddr<>dtop
"OS_Byte",229,0
S S$=$(!keyanchor%(dkey%)+daddr+8):RS%=!(!keyanchor%(dkey%)+daddr+9+KL%(dkey%))
; RS$=
(RS%):RS$=" Record No."+
(RS$)," ")+RS$+" "
S$=P$
line$=RP$+P$
E $(!lineanchor%)=line$:
list_line(RP%,lineanchor%,
(line$),32)
line$=RS$+S$
E $(!lineanchor%)=line$:
list_line(RS%,lineanchor%,
(line$),32)
P$=S$:RP%=RS%:RP$=RS$
examined%+=1
"Hourglass_Percentage",examined%*100
count%
% daddr=
neighbour(dkey%,daddr,1)
rule_off(32)
"Hourglass_Off"
screen_list
abort_dup
"Hourglass_Off"
screen_list
softerror("",67)
wimp_error(
stripspaces(s$)
s$)=" "
s$=
>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%,action%)
REC%,examined%,subtotal%,X%,Y%,n$,copy%
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"
"
copy%=1
labcopies%
!
print_record(REC%)
copy%
!
print_record(REC%)
-
2:ptr%?REC%=255:
### earmark ###
.
write_csv_rec(REC%):
poll:
9
4:KEY$=
key2(newkey%,1):
insert(KEY$,newkey%)
### create index ###
S$=F$(Fieldnumber%)
numeric%
X%=0:Y%=0
X%+=1
)
(S$)
S$,X%,1))>0
X%<=
(S$)
Y%=X%
Y%+=1
+
(S$)
S$,Y%,1))=0
9 S$=
S$,X%-1)+
S$,X%,Y%-X%)+New$))+
S$,Y%)
S$=New$
(S$)>TextLength%
softerror("",10)
F$(Fieldnumber%)=S$
,
writesmarray(dbasehandle%,REC%)
!
### global change ###
P%=
neighbour(key%,P%,1)
"Hourglass_Percentage",(examined%*100)
subtotal%
search(S$,key%,M%)
P%,found%,info$,keybase%,rec%
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: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%
keybase%=!keyanchor%(key%)
kl%=KL%(key%)
search(S$,key%,0)
ident%
!
selected(passW%,15):
+
softerror(" ("+S$+")",37):abort%=
>
dup%
confirm(
msg(45)+" ("+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%
keybase%=!keyanchor%(key%)
A%=!keybase%
kl%=KL%(key%)
search(S$,key%,2)
P%<0
softerror(" ("+S$+": "+Index$(key%)+" index)",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"
N5keybase%=!keyanchor%(0):keybase%!4=
($Increment%)
!keyanchor%(keyN%)>0
P! keybase%=!keyanchor%(keyN%)
keybase%?73=0
"SlidingHeap_DescribeBlock",slidingheapbase%,keyanchor%(keyN%)
,,filelength%
keyN%
index$="Indices."
index$=""
"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%
g! F$=F$(loop%):L%=len%(loop%)
(F$)<=L%
#F,F$
L%,"!")
loop%
j R%+=1
check_save(T%)
time%
"OS_ReadMonotonicTime"
time%
(time%
T%)<10
buttonfield%(19)>0
wi%=mainW%:ic%=buttonfield%(19)
wi%=keypadW%:ic%=19
autosave%
delay%=
loop%=0
delay%+=50
w0 block%!8=1:block%!12=wi%:block%!16=ic%
x+
"Interface_SlabButton",,block%
>delay%
1,-15,180,5
block%!8=0
|+
"Interface_SlabButton",,block%
delay%+=50
>delay%
loop%
!
mouse(0,0,4,wi%,ic%)
set_auto(mode%)
tick_one(menu%(12),0,2,2-mode%)
autosave%=mode%
8saveint%=
($Interval%):$Interval%=
(saveint%)+" min"
set_autobalance(status%)
tick(menu%(21),0,status%)
autobalance%=status%
autobalance%
$Every%="25 recs"
:balint%=
($Every%):$Every%=
(balint%)+" recs":added%=0
Calculations ---------------------------------------------------------
calc_link(T$,type%)
### Sets up calculation formula window & menu entry ###
$CalcFunc%=T$
)$CalcTitle%=T$:calclink%=Fieldnumber%
split_link(calclink%,real$,visible$)
type%
6,7:$CalcForm%=Tag$(calclink%)+"="+visible$
$CalcForm%=visible$
icon_bit(22,calcW%,2,off%)
deselect(calcW%,2)
calc_formula(S$)
### Parses calculation formula (S$) & builds calc$(I%) ###
I%,P%,t$,s$,C$,time%
~(calclink%):
calclink%<16
C$="0"+C$
$CalcFunc%="Set base value"
S$=""
S$="0"
calc$(calclink%)=S$+"|"+S$
calc$(0)="LOADED"
* P%=
S$,"="):S$=
S$,P%+1):visible$=S$
I%=1
fields%
t$=Tag$(I%)
t$<>""
P%=0
P%=
S$,t$,P%+1)
P%>0
chartype%(I%)
>
3,6,46,47,54,56,57:s$="VAL($Rf%("+
(I%)+"))"
=
8:s$="FNseconds($Rf%("+
(I%)+"),1)":time%=
)
chartype%(calclink%)
)
6:s$="FNn("+
(I%)+")"
*
7:s$="$Rf%("+
(I%)+")"
+ S$=
S$,P%-1)+s$+
S$,P%+
(t$))
update$(I%)+=C$
P%=0
visible$,"TIME$")>0
update$(0)+=C$
time%=
chartype%(calclink%)=7
S$="FNtime("+S$+")"
(S$)+
(visible$)+2<256
, calc$(calclink%)="#"+S$+"#"+visible$
calc$(0)="LOADED"
7
selected(calcW%,2)
recalculate(calclink%)
softerror("",44)
calclink%=0
(b%
%111)=4
"Wimp_CreateMenu",,-1
recalculate(F%)
F,I%,R%,k$,P%,real$,visible$,subtotal%,zero%,examined%
split_link(F%,real$,visible$)
confirm("Recalculate "+Tag$(F%)+"="+visible$+" for existing records?")=
%subtotal%=
count_recs(key%,zero%)
"Hourglass_On"
*dbasehandle%=
($database%+".Database")
neighbour(key%,top,1)
P%<>top
R%=
rec_no(k$,key%,P%)
readsmarray(dbasehandle%,R%)
I%=1
fields%
$Rf%(I%)=F$(I%)
chartype%(F%)
F=
(real$):F$=
+
fix%(F%)>0
fix_point(F$,F%)
(
softerror(real$,73):
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%
$Rf%(I%)=field$(I%)
display(key%,addr)
sums(
F$,F%,type%)
F$<>""
type%
8:V=
seconds(F$,1)
Sum(F%,0)+=1
Sum(F%,1)+=V
Sum(F%,3)+=V*V
V>Sum(F%,4)
Sum(F%,4)=V
V<Sum(F%,5)
Sum(F%,5)=V
ctotals(flag%)
F%,I%,J%,N%,R%,S%,base%,pos%,F$
S$(),f%()
S$(5),f%(5)
base%=!lineanchor%
3S$()="Items","Sum","Mean","St.Dev.","Max","Min"
I%=1
(Form$)-1
F%=
fnum(
Form$,I%,2))
R%=calcrow%?F%
chartype%(F%)
3,6,8,46,47,54,56,57:
Sum(R%,0)>0
' 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%*7-5+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,46,47,54,56,57:
R%=calcrow%?F%
J%=0
8.
selected(pselectW%,R%*5-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$
B,=F$+
Tab%(N%)-Tab%(N%-1)-L%," ")+spacer$
justify(f$,x%,x1%)
F$L%=Tab%(x%)-Tab%(x1%)-
(spacer$)
(f$)>L%
f$=
f$,L%)
(f$)," ")+f$
f$)="."
f$=" "+
execute_file(f$)
F,P%,name$,command$,finished%,firstquery%,state%
confirm(
msg(68))
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%=
b:
execute_file($database%+".PrintRes."+params$)
c
"!DELETE":
present%=7
RecF%=
g0
params$=""
key$=
key$=params$
h5
select(keypadW%,25):
deselect(keypadW%,24)
i addr=
find(key$,0,0,
RecF%=
addr=
shift(0,0,0)
l$ addr=
moveto(key%,top,1)
n
"!INSERT":
present%=7
subfile%=
(params$)
r)
read(fields%,
,RA%,$database%)
loop%=1
fields%
t) $Rf%(loop%)=
#F,len%(loop%))
write(fields%,key%)
w
"!QUERY":
params$<>""
P%=
params$,",")
{6 formula$=
params$,P%+1):name$=
params$,P%-1)
|0 f$=$database%+".PrintJobs."+
name$,10)
}$ Search$=
parse(formula$,
~$ $
text(matchW%,0)=formula$
!
redraw_icon(matchW%,0)
"Hourglass_On"
reportdest$
$
"Window":$SaveName%=f$
&
"File":texthandle%=
ImpCom$<>""
-
firstquery%=
:firstquery%=
'
#texthandle%,ImpCom$
do_it(Search$,-1)
"!CSV":
P%=
params$,",")
4 formula$=
params$,P%+1):name$=
params$,P%-1)
. f$=$database%+".PrintJobs."+
name$,10)
6
write_csv(f$,formula$,
selected(savesubW%,5))
"!SELECTION":
params$<>""
3 filename$=$database%+".PrintRes."+params$
-
"OS_File",5,filename$
,,ftype%
# ftype%=(ftype%>>8)
&FFF
4
ftype%=&7F3
load_selection(filename$)
clear_selection
"!PRINTOPTS":
params$<>""
3 filename$=$database%+".PrintRes."+params$
-
"OS_File",5,filename$
,,ftype%
# ftype%=(ftype%>>8)
&FFF
2
ftype%=&7F5
load_options(filename$)
<
load_options("<Pbase$Dir>.Resources.PrintOpts")
"!CASE":
B
set_icon(matchW%,16,state%):
set_icon(savesubW%,5,state%)
"!INDEX":
B
set_icon(matchW%,23,state%):
set_icon(savesubW%,6,state%)
0
"!EXPAND":
set_icon(printW%,11,state%)
.
"!DATE":
set_icon(printW%,19,state%)
/
"!UPPER":
set_icon(printW%,12,state%)
/
"!FIRST":
set_icon(printW%,10,state%)
3
"!UNDERLINE":
set_icon(printW%,29,state%)
0
"!SHRINK":
set_icon(printW%,40,state%)
-
"!TITLE":$
text(printW%,18)=params$
,
"!PAGE":$
text(printW%,16)=params$
1
"!LINESPACE":$
text(printW%,17)=params$
/
"!LMARGIN":$
text(printW%,30)=params$
/
"!TMARGIN":$
text(printW%,32)=params$
.
"!SPACER":$
text(printW%,43)=params$
0
"!COLWIDTH":$
text(printW%,45)=params$
"!HEADINGS":
u(params$)
7
"D":
select(printW%,2):
deselect(printW%,1)
3
select(printW%,1):
deselect(printW%,2)
"!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))
"
icon_bit(22,printW%,15,
M 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$
$
icon_bit(22,printW%,15,
'
"LABEL":
select(printW%,26)
select(printW%,23)
"!DESTINATION":
3
deselect(printW%,
selected_esg(printW%,4))
params$
9
"FILE":
select(printW%,39):reportdest$="File"
?
"PRINTER":
select(printW%,41):reportdest$="Printer"
#
"CSV":reportdest$="csv"
4
select(printW%,38):reportdest$="Window"
"!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$
,
set_icon(labelW%,11,(par$<>""))
:
icon_bit(22,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
9 ImpCom$=
params$,P%-1):modifier$=
params$,P%+1)
u(modifier$)
'
"NOT FIRST":firstquery%=
ImpCom$=params$
softerror("",46)
finished%=
"Hourglass_Smash"
close_file(F)
abort_script
close_file(F)
softerror("",57)
wimp_error(
"Impulse" handling -----------------------------------------------
Impulse_command(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 ###
$ ClientSearch$=
parse(param$,
"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%
+2
Max. length for a Powerbase field is 246
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%,6)
"Impulse_SendMessage",&201,":"+mergewith$+"."+document$+" Print",,,,printtag%,mytask%
printtag%:
### Merging application has printed the current document ###
"OS_Byte",229,0
>2 mergenum%+=1:$
text(mergeW%,14)=
(mergenum%)
redraw_icon(mergeW%,14)
selected(mergeW%,6)
ClientPtr%<>top
A, ClientPtr%=
merge_next(ClientPtr%,1)
deselect(mergeW%,6)
abort_merge
close_file(dbasehandle%)
ClientPtr%=top
deselect(mergeW%,6)
perform_close(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%
read(fields%,REC%<>RA%,REC%,$database%)
I%=1
(ClientForm$)
f$ F%=
fnum(
ClientForm$,I%,2))
g<
data$<>""
$Rf%(F%)=
get_string(data$,ClientSep$)
write(fields%,key%)
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
z, dbasehandle%=
($database%+".Database")
{' ClientPtr%=
neighbour(key%,top,1)
P%=transbuff%
key$
"***":
close_file(dbasehandle%)
$P%=key$:P%+=
($P%)+1
ok%=
ClientPtr%<>top
( REC%=
rec_no(k$,key%,ClientPtr%)
'
readsmarray(dbasehandle%,REC%)
(ClientSearch$)=
$ $P%=
(REC%)+"#":P%+=
($P%)
%
I%=1
(ClientForm$)
( F%=
fnum(
ClientForm$,I%,2))
, $P%=F$(F%)+ClientSep$:P%+=
($P%)
$P%+=ClientSep$:P%+=1
ok%=
0 ClientPtr%=
neighbour(key%,ClientPtr%,1)
P%=transbuff%
close_file(dbasehandle%)
" val$=
type(key%):kl%=
(key$)
% ClientPtr%=
search(key$,key%,1)
ClientPtr%>=0
( REC%=
rec_no(k$,key%,ClientPtr%)
'
readsmarray(dbasehandle%,REC%)
" $P%=
(REC%)+"#":P%+=
($P%)
#
I%=1
(ClientForm$)
& F%=
fnum(
ClientForm$,I%,2))
* $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%
& F%=
field(S$,
):V%=chartype%(F%)
C
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%,ClientPtr%)
/ 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
+ 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
Imp_wait%=
:merging%=
text(mergeW%,1)=document$
common%
text(mergeW%,3)=""
open_window(mergeW%)
set_caret(mergeW%,3)
merge_next(P%,D%)
D%=(D%+1)
next_match(P%,D%,ClientSearch$)
P%<>top
, S$=F$(KF%(key%,0))+" "+F$(KF%(key%,1))
text(mergeW%,13)=
S$,80)
redraw_icon(mergeW%,13)
"Impulse_SendMessage",&201,":"+mergewith$+"."+document$+" Merge",,,,mergetag%,mytask%
End of "Impulse" handling -------------------------------------------
Import/Export CSV files ---------------------------------------------
start_import(type$,wi%)
present%
fields%=0
OK%=
softerror("",69)
Modify%
OK%=
softerror("",14)
softerror("",69)
OK%
text(csvW%,13)=filename$
icon_bit(22,csvW%,0,
4 !block%=csvW%:
"Wimp_GetWindowState",,block%
) block%!4=800:block%!12=block%!4+390
) block%!8=150:block%!16=block%!8+716
( $CSVTitle%="Import "+type$+" file"
"Wimp_OpenWindow",,block%
set_caret(csvW%,13)
write_csv(Filename$,formula$,case%)
writingcsv%
printorder$<>""
Form$=printorder$
softerror("",34):
P%,rec%,examined%,subtotal%
end_csv:
csvhandle%=
(Filename$)
selected(csvW%,1)
csv_head
*dbasehandle%=
($database%+".Database")
"Search$=
parse(formula$,case%)
"Hourglass_On"
usekey%=-1
selected(savesubW%,6)=
P%=
neighbour(key%,top,1)
scan_file("P%<>top",key%,3)
# P%=
search(useval$,usekey%,1)
P%>=0
k$=useval$:
scan_file("P%<>top AND k$=useval$",usekey%,3)
"Hourglass_Off"
close_file(csvhandle%)
close_file(dbasehandle%)
sep$=","
type%=&dfe
type%=&fff
"OS_File",18,Filename$,type%
writingcsv%=
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%)
I%,F%,f$,F$,L%,N%,filename$,len%,base%,SF$
selected(csvW%,3)
F$=
key2(0,1)
),
selected(csvW%,0)
F$=""""+F$+""""
#csvhandle%,F$+sep$;
I%=-1:L%=
(Form$)-1
I%<L%
." I%+=2:F%=
fnum(
Form$,I%,2))
chartype%(F%)
36,39:
1, len%=
load_blob($database%,R%,F%,36)
2'
len%>0
selected(csvW%,2)
3+ N%+=1:
N%>1
#csvhandle%,sep$;
43
selected(csvW%,0)
#csvhandle%,"""";
5(
blob_to_file(csvhandle%,len%)
63
selected(csvW%,0)
#csvhandle%,"""";
7
3,6,46,47,54,56,57:
F$=F$(F%):N%+=1
:'
F$<>""
selected(csvW%,2)
N%>1
F$=sep$+F$
#csvhandle%,F$;
=
41,42,43,44,45:
F$=F$(F%):N%+=1
Z%=
no_yes(F%,n$,y$)
A"
F$=" "
F$=y$
F$=n$
B0
selected(csvW%,0)
F$=""""+F$+""""
N%>1
F$=sep$+F$
#csvhandle%,F$;
F!
selected(printW%,11)
G/ F$=
expand(F$(F%),link$(F%),Len%,SF$)
F$=F$(F%)
I
N%+=1
K'
F$<>""
selected(csvW%,2)
L0
selected(csvW%,0)
F$=""""+F$+""""
N%>1
F$=sep$+F$
#csvhandle%,F$;
O
#csvhandle%,term$;
convert_csv(f$)
k$,B%,J%,fld%,csvhandle%,toobighandle%,S$,sep%,sep2%,term%,term2%,F$,avail%,nextfree%,keybase%,base%,base2%,show%,done%
stop_reading:
size%=&100:inc%=size%
extend_named_sliding_block(tempanchor%,size%)
[:sep%=
(sep$):
(sep$)=2
sep2%=
sep$))
sep2%=255
\@term%=
(term$):
(term$)=2
term2%=
term$))
term2%=255
csvhandle%=
present%=0
csv_to_dbase(f$)
Form$=
csv_importform
`3toobighandle%=
($database%+".PrintJobs.TooBig")
"Hourglass_On"
selected(csvW%,3):
read_bytes
f, addr=
find(
$base%,KL%(key%)),0,1,
g" REC%=
rec_no(k$,key%,addr)
h(
read(fields%,
,REC%,$database%)
j3 keybase%=!keyanchor%(0):nextfree%=!keybase%
k$
!(keybase%+nextfree%)<=0
incr%=
($Increment%)
incr%>0
n'
change_length(RA%+incr%,
o"
moan_err%,
msg(66)
q
r- REC%=!(keybase%+nextfree%+8+KL%(0)+1)
s'
read(fields%,
,RA%,$database%)
endline%=
:J%=-1
v#
(Form$)-2
endline%=
w& J%+=2:fld%=
fnum(
Form$,J%,2))
x!
transfer_csv_field(fld%)
z2
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
close_window(csvW%)
write_log(-1,"CSV data imported from "+f$)
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$=$base%
W
*YESyesYes",c$)>0
c$<>""):$Rf%(fld%)=" ":
select(mainW%,field%(fld%))
M
"NnXxNOnoNo-",c$)>0):$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:
len%(fld%)>0
read_bytes
;
selected(csvW%,16)
$base%=
stripspaces($base%)
.
ptr%<=len%(fld%):$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$,flag%,B%,nq%
base%=!tempanchor%:ptr%=-1
#csvhandle%
B%=34
flag%=
:nq%=1
c end$="(base%?(ptr%-1)=34 AND (nq% MOD 2)=0) AND (B%=sep% OR B%=term% OR EOF#csvhandle%=TRUE)"
#csvhandle%=
#csvhandle%-1
7 end$="B%=sep% OR B%=term% OR EOF#csvhandle%=TRUE"
+ B%=
#csvhandle%:ptr%+=1:base%?ptr%=B%
B%=34
nq%+=1
ptr%=size%
size%+=inc%:
extend_named_sliding_block(tempanchor%,size%)
(end$)
flag%
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%)
"OS_File",18,$database%+".PrintJobs.TooBig",&fff
scrap_sliding_block(tempanchor%)
*block%!8=0:block%!12=csvW%:block%!16=9
"Interface_SlabButton",,block%
=17
softerror("",74)
wimp_error(
present%=7
addr=
moveto(key%,top,1)
clear_selection
csv_importform
F%,f$,F$
endline%=
selected(csvW%,1):
### Use header record to build form ###
read_bytes
F%=
field($base%,
%
F%=0
moan_err%,
msg(87)
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$
! B
### 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%
selected(csvW%,4)
selected(csvW%,1))
moan_err%,
msg(88)
read_bytes:S$=$base%:
#csvhandle%=0
")=0
moan_err%,
msg(89)
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)
% Tag$(fields%)=
S$,P%+1,Q%-P%-1)
! len%(fields%)=
S$,P%-1))
!!% 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
!@?
"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%
!hLheap_trigger%=
_heap_pageup(
+fixedheapsize%+20+20*slidingblocks%-&8000)
setslotsize(heap_trigger%)
_heap_slotsize<heap_trigger%
130,"Unable to initialise heap"
fixedheapbase%=
!l%slidingheapbase%=
+fixedheapsize%
"OS_Heap",0,fixedheapbase%,,fixedheapsize%
"SlidingHeap_Create",slidingheapbase%,2,slidingblocks%
"SlidingHeap_VerifyHeap",slidingheapbase%
_heap_nextfree
nextfree%
"SlidingHeap_NextFree",slidingheapbase%
nextfree%
=nextfree%
destroyheaps
setslotsize(
-&8000)
_heap_wordup(x%)=(x%+3)
create_anchor(name$)
space%
space% 4+
name$+1
!space%=0
$(space%+4)=name$
=space%
create_named_sliding_block(anchor%,size%)
trysize%
size%=
_heap_wordup(size%)
7trysize%=
_heap_pageup(
_heap_nextfree+size%-&7FF4)
trysize%>heap_trigger%
setslotsize(trysize%)
_heap_slotsize<trysize%
%
setslotsize(heap_trigger%)
F
131,"Not enough room to create block """+$(anchor%+4)+""""
heap_trigger%=trysize%
"SlidingHeap_NewBlock",slidingheapbase%,anchor%,size%,anchor%+4
"SlidingHeap_VerifyHeap",slidingheapbase%
scrap_sliding_block(anchor%)
!anchor%=0
"SlidingHeap_ScrapBlock",slidingheapbase%,anchor%
1trysize%=
_heap_pageup(
_heap_nextfree-&7FFC)
trysize%<>heap_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%
H trysize%=
_heap_pageup(
_heap_nextfree+(newsize%-oldsize%)-&7FFC)
trysize%>heap_trigger%
setslotsize(trysize%)
&
_heap_slotsize<trysize%
(
setslotsize(heap_trigger%)
@
132,"Not enough room to extend block #"+
~anchor%
# heap_trigger%=trysize%
"SlidingHeap_ExtendBlock",slidingheapbase%,anchor%,newsize%
1trysize%=
_heap_pageup(
_heap_nextfree-&7FFC)
trysize%<>heap_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<trysize%
255,"No room to extend fixed heap"
"nshb%=slidingheapbase%+extend%
"SlidingHeap_ShiftHeap",slidingheapbase%,nshb%
"OS_Heap",5,fixedheapbase%,,extend%
fixedheapsize%+=extend%
slidingheapbase%=nshb%
"SlidingHeap_VerifyHeap",slidingheapbase%