home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Vectronix 2
/
VECTRONIX2.iso
/
FILES_07
/
LATTIC_3.ZIP
/
WTEST
/
WTEST.BAS
< prev
next >
Wrap
BASIC Source File
|
1988-08-31
|
5KB
|
208 lines
' WERCS example program for HiSoft BASIC and Power BASIC
defint a-z
library "gemaes"
' 10k should be plenty to Leave, variable checks on, no window
rem $option l10,v+,y+,u+
' the GEMAES.BH file must be accessable
REM $INCLUDE GEMAES.BH
' additional constants
CONST type_tree=0,type_object=1,type_string=5,ob_sizeof=24
CONST FMD_START=0, FMD_GROW=1, FMD_SHRINK=2, FMD_FINISH=3
' get the header file created with WERCS
REM $INCLUDE WRSC.BH
' global variables
DIM SHARED junk,deskflag,menu&,finished,checked
DIM SHARED screenx,screeny,screenw,screenh,edit$,radio
DEF FNobject&(tree&,object)=tree&+object*ob_sizeof
SUB INITIALISE
' firstly load the resource file
IF FNrsrc_load("WRSC.RSC")=0 THEN
' this alert can't be in the resource file of course..
junk=FNform_alert(1,"[3][Resource file error][ Quit ]")
SYSTEM
END IF
' now install the menu
deskflag=0
junk=FNrsrc_gaddr(type_tree,Menu1,menu&)
menu_bar menu&,1
' get the screen size
junk=FNwind_get(0,WF_WORKXYWH,screenx,screeny,screenw,screenh)
graf_mouse 0,0
' set default values for dialog box
edit$=""
radio=DRadio1
END SUB
' set or reset the desktop pattern
SUB SETDESK(newdesk&)
junk=FNwind_set(0,wf_newdesk,PEEKW(VARPTR(newdesk&)),PEEKW(VARPTR(newdesk&)+2),0,0)
' cause the AES to re-draw the whole screen
form_dial FMD_FINISH,0,0,0,0,screenx,screeny,screenw,screenh
END SUB
SUB DEINITIALISE
IF deskflag THEN SETDESK(0) : deskflag=0
menu_bar menu&,0
junk=FNrsrc_free
END SUB
' a general routine to produce a dialog box and handle interaction
' the return result is the exit object number
DEF FNhandle_dialog(d&,editnum)
STATIC x,y,w,h,but,t&
form_center d&,x,y,w,h
form_dial FMD_START,0,0,0,0,x,y,w,h
form_dial FMD_GROW,x+w\2,y+h\2,0,0,x,y,w,h
junk=FNobjc_draw(d&,0,10,x,y,w,h)
but=FNform_do(d&,editnum)
form_dial FMD_SHRINK,x+w\2,y+h\2,0,0,x,y,w,h
form_dial FMD_FINISH,0,0,0,0,x,y,w,h
t&=FNobject&(d&,but)
IF PEEKB(t&+ob_type+1)=G_BUTTON THEN
POKEW t&+ob_state,PEEKW(t&+ob_state) AND (NOT mask_selected)
END IF
FNhandle_dialog=but
END DEF
' set a tedinfo record
' NOTE: does not handle complex templates
SUB set_tedinfo(tree&,object,newted$)
STATIC t&,max,i
t&=PEEKL(tree&+object*ob_sizeof+ob_spec)
max=PEEKW(t&+te_txtlen)-1 '-1 for the null
IF LEN(newted$)<max THEN max=LEN(newted$)
t&=PEEKL(t&)
FOR i=1 TO max
POKEB t&,ASC(MID$(newted$,i,1))
INCR t&
NEXT i
POKEB t&,0 'must end in null
END SUB
' extract a tedinfo record
' NOTE: does not handle complex templates
DEF FNget_tedinfo$(tree&,object)
STATIC t&,a$
a$=""
t&=PEEKL(tree&+object*ob_sizeof+ob_spec)
t&=PEEKL(t&)
WHILE PEEKB(t&)
a$=a$+CHR$(PEEKB(t&))
INCR t&
WEND
FNget_tedinfo$=a$
END DEF
' select a particular radio button in a group
SUB set_button(tree&,parent,button)
STATIC b,t&
b=PEEKW(FNobject&(tree&,parent)+ob_head) 'head object number
DO UNTIL b=parent
t&=FNobject&(tree&,b)+ob_state
POKEW t&,PEEKW(t&) AND (NOT mask_selected) 'unlite it
IF b=button THEN POKEW t&,PEEKW(t&) OR mask_selected 'lite special one
b=PEEKW(FNobject&(tree&,b)+ob_next)
LOOP
END SUB
' return which button of a group is selected
DEF FNget_button(tree&,parent)
STATIC b
b=PEEKW(FNobject&(tree&,parent)+ob_head) 'head object number
DO UNTIL b=PARENT
IF PEEKW(FNobject&(tree&,b)+ob_state) AND mask_selected THEN
FNget_button=b: EXIT DEF
ELSE
b=PEEKW(FNobject&(tree&,b)+ob_next)
END IF
LOOP
END DEF
' a routine to handle a particular dialog box
SUB test_dialog
STATIC dlog&,result
junk=FNrsrc_gaddr(type_tree,TestDialog,dlog&)
set_tedinfo dlog&,DEditable,edit$
set_button dlog&,DParent,radio
result=FNhandle_dialog(dlog&,DEditable)
IF result=DOK THEN
edit$=FNget_tedinfo$(dlog&,DEditable)
radio=FNget_button(dlog&,DParent)
END IF
END SUB
' handle a given menu click
SUB handle_menu(title,item)
STATIC temp&
SELECT CASE item
=MAbout
junk=FNrsrc_gaddr(type_string,AAlert,temp&)
junk=FNnewform_alert(1,temp&)
=MQuit
finished=1
=MCheckme
checked=checked XOR 1
menu_icheck menu&,MCheckme,checked
=MDialog
test_dialog
=MInstall
IF deskflag THEN
deskflag=0
SETDESK 0 'reset it
ELSE
deskflag=1
junk=FNrsrc_gaddr(0,NewDesktop,temp&)
POKEW temp&+ob_x,screenx: POKEW temp&+ob_y,screeny
POKEW temp&+ob_width,screenw: POKEW temp&+ob_height,screenh
SETDESK temp&
END IF
END SELECT
menu_tnormal menu&,title,1 'restore to normal state
END SUB
' the main loop of the application, the procedure ends when Quit
' is selected
SUB MAIN
LOCAL mess(7),event
finished=0: checked=0
DO
evnt_mesag VARPTR(mess(0)) 'we can avoid the dreaded evnt_multi!
event=mess(0)
SELECT CASE event
=MN_SELECTED : handle_menu mess(3),mess(4)
' a complete program would have other cases here
END SELECT
LOOP UNTIL finished
END SUB
' the main program starts here
INITIALISE
MAIN
DEINITIALISE
SYSTEM
' an additional GEM call is needed as the built-in FNform_alert expects a
' BASIC-style string, not a pointer to a C-type string
DEF FNnewform_alert(button,addr&)
POKEW PEEKL(GB+8),button 'int_in
POKEL PEEKL(GB+16),addr& 'addr_in
GEMSYS(52)
FNnewform_alert=PEEKW(PEEKL(GB+20))
END DEF
' that's all folks