home *** CD-ROM | disk | FTP | other *** search
/ Vectronix 2 / VECTRONIX2.iso / FILES_01 / LATTIC_3.LZH / WTEST / WTEST.BAS < prev    next >
BASIC Source File  |  1988-08-31  |  5KB  |  208 lines
  1. ' WERCS example program for HiSoft BASIC and Power BASIC
  2. defint a-z
  3. library "gemaes"
  4.  
  5. ' 10k should be plenty to Leave, variable checks on, no window
  6. rem $option l10,v+,y+,u+
  7.  
  8. ' the GEMAES.BH file must be accessable
  9. REM $INCLUDE GEMAES.BH
  10.  
  11. ' additional constants
  12. CONST type_tree=0,type_object=1,type_string=5,ob_sizeof=24
  13. CONST FMD_START=0, FMD_GROW=1, FMD_SHRINK=2, FMD_FINISH=3
  14.  
  15. ' get the header file created with WERCS
  16. REM $INCLUDE WRSC.BH
  17.  
  18. ' global variables
  19. DIM SHARED junk,deskflag,menu&,finished,checked
  20. DIM SHARED screenx,screeny,screenw,screenh,edit$,radio
  21.  
  22. DEF FNobject&(tree&,object)=tree&+object*ob_sizeof
  23.  
  24. SUB INITIALISE
  25. ' firstly load the resource file
  26. IF FNrsrc_load("WRSC.RSC")=0 THEN
  27.     ' this alert can't be in the resource file of course..
  28.     junk=FNform_alert(1,"[3][Resource file error][ Quit ]")
  29.     SYSTEM
  30. END IF
  31.  
  32. ' now install the menu
  33. deskflag=0
  34. junk=FNrsrc_gaddr(type_tree,Menu1,menu&)
  35. menu_bar menu&,1
  36.  
  37. ' get the screen size
  38. junk=FNwind_get(0,WF_WORKXYWH,screenx,screeny,screenw,screenh)
  39.  
  40. graf_mouse 0,0
  41.  
  42. ' set default values for dialog box
  43. edit$=""
  44. radio=DRadio1
  45. END SUB
  46.  
  47. ' set or reset the desktop pattern
  48. SUB SETDESK(newdesk&)
  49. junk=FNwind_set(0,wf_newdesk,PEEKW(VARPTR(newdesk&)),PEEKW(VARPTR(newdesk&)+2),0,0)
  50. ' cause the AES to re-draw the whole screen
  51. form_dial FMD_FINISH,0,0,0,0,screenx,screeny,screenw,screenh
  52. END SUB
  53.  
  54. SUB DEINITIALISE
  55. IF deskflag THEN SETDESK(0) : deskflag=0
  56. menu_bar menu&,0
  57. junk=FNrsrc_free
  58. END SUB
  59.  
  60.  
  61. ' a general routine to produce a dialog box and handle interaction
  62. ' the return result is the exit object number
  63. DEF FNhandle_dialog(d&,editnum)
  64. STATIC x,y,w,h,but,t&
  65. form_center d&,x,y,w,h
  66. form_dial FMD_START,0,0,0,0,x,y,w,h
  67. form_dial FMD_GROW,x+w\2,y+h\2,0,0,x,y,w,h
  68. junk=FNobjc_draw(d&,0,10,x,y,w,h)
  69. but=FNform_do(d&,editnum)
  70. form_dial FMD_SHRINK,x+w\2,y+h\2,0,0,x,y,w,h
  71. form_dial FMD_FINISH,0,0,0,0,x,y,w,h
  72. t&=FNobject&(d&,but)
  73. IF PEEKB(t&+ob_type+1)=G_BUTTON THEN
  74.     POKEW t&+ob_state,PEEKW(t&+ob_state) AND (NOT mask_selected)
  75. END IF
  76. FNhandle_dialog=but
  77. END DEF
  78.  
  79. ' set a tedinfo record
  80. ' NOTE: does not handle complex templates
  81. SUB set_tedinfo(tree&,object,newted$)
  82. STATIC t&,max,i
  83. t&=PEEKL(tree&+object*ob_sizeof+ob_spec)
  84. max=PEEKW(t&+te_txtlen)-1                    '-1 for the null
  85. IF LEN(newted$)<max THEN max=LEN(newted$)
  86. t&=PEEKL(t&)
  87. FOR i=1 TO max
  88.     POKEB t&,ASC(MID$(newted$,i,1))
  89.     INCR t&
  90. NEXT i
  91. POKEB t&,0                                    'must end in null
  92. END SUB
  93.  
  94. ' extract a tedinfo record
  95. ' NOTE: does not handle complex templates
  96. DEF FNget_tedinfo$(tree&,object)
  97. STATIC t&,a$
  98. a$=""
  99. t&=PEEKL(tree&+object*ob_sizeof+ob_spec)
  100. t&=PEEKL(t&)
  101. WHILE PEEKB(t&)
  102.     a$=a$+CHR$(PEEKB(t&))
  103.     INCR t&
  104. WEND
  105. FNget_tedinfo$=a$
  106. END DEF
  107.  
  108. ' select a particular radio button in a group
  109. SUB set_button(tree&,parent,button)
  110. STATIC b,t&
  111. b=PEEKW(FNobject&(tree&,parent)+ob_head)        'head object number
  112. DO UNTIL b=parent
  113.     t&=FNobject&(tree&,b)+ob_state
  114.     POKEW t&,PEEKW(t&) AND (NOT mask_selected)        'unlite it
  115.     IF b=button THEN POKEW t&,PEEKW(t&) OR mask_selected    'lite special one
  116.     b=PEEKW(FNobject&(tree&,b)+ob_next)
  117. LOOP
  118. END SUB
  119.  
  120. ' return which button of a group is selected
  121. DEF FNget_button(tree&,parent)
  122. STATIC b
  123. b=PEEKW(FNobject&(tree&,parent)+ob_head)        'head object number
  124. DO UNTIL b=PARENT
  125.     IF PEEKW(FNobject&(tree&,b)+ob_state) AND mask_selected THEN
  126.         FNget_button=b: EXIT DEF
  127.     ELSE
  128.         b=PEEKW(FNobject&(tree&,b)+ob_next)
  129.     END IF
  130. LOOP
  131. END DEF
  132.  
  133. ' a routine to handle a particular dialog box
  134. SUB test_dialog
  135. STATIC dlog&,result
  136. junk=FNrsrc_gaddr(type_tree,TestDialog,dlog&)
  137. set_tedinfo dlog&,DEditable,edit$
  138. set_button dlog&,DParent,radio
  139. result=FNhandle_dialog(dlog&,DEditable)
  140. IF result=DOK THEN
  141.     edit$=FNget_tedinfo$(dlog&,DEditable)
  142.     radio=FNget_button(dlog&,DParent)
  143. END IF
  144. END SUB
  145.  
  146. ' handle a given menu click
  147. SUB handle_menu(title,item)
  148. STATIC temp&
  149. SELECT CASE item
  150.     =MAbout
  151.         junk=FNrsrc_gaddr(type_string,AAlert,temp&)
  152.         junk=FNnewform_alert(1,temp&)
  153.     =MQuit
  154.         finished=1
  155.     =MCheckme
  156.         checked=checked XOR 1
  157.         menu_icheck menu&,MCheckme,checked
  158.     =MDialog
  159.         test_dialog
  160.     =MInstall
  161.         IF deskflag THEN
  162.             deskflag=0
  163.             SETDESK 0            'reset it
  164.         ELSE
  165.             deskflag=1
  166.             junk=FNrsrc_gaddr(0,NewDesktop,temp&)
  167.             POKEW temp&+ob_x,screenx: POKEW temp&+ob_y,screeny
  168.             POKEW temp&+ob_width,screenw: POKEW temp&+ob_height,screenh
  169.             SETDESK temp&
  170.         END IF
  171. END SELECT
  172. menu_tnormal menu&,title,1        'restore to normal state
  173. END SUB
  174.  
  175. ' the main loop of the application, the procedure ends when Quit
  176. ' is selected
  177. SUB MAIN
  178. LOCAL mess(7),event
  179. finished=0: checked=0
  180. DO
  181. evnt_mesag VARPTR(mess(0))        'we can avoid the dreaded evnt_multi!
  182. event=mess(0)
  183. SELECT CASE event
  184.     =MN_SELECTED : handle_menu mess(3),mess(4)
  185. ' a complete program would have other cases here
  186. END SELECT
  187. LOOP UNTIL finished
  188. END SUB
  189.  
  190.  
  191. ' the main program starts here
  192.  
  193. INITIALISE
  194. MAIN
  195. DEINITIALISE
  196. SYSTEM
  197.  
  198. ' an additional GEM call is needed as the built-in FNform_alert expects a
  199. ' BASIC-style string, not a pointer to a C-type string
  200. DEF FNnewform_alert(button,addr&)
  201.     POKEW PEEKL(GB+8),button    'int_in
  202.     POKEL PEEKL(GB+16),addr&    'addr_in
  203.     GEMSYS(52)
  204.     FNnewform_alert=PEEKW(PEEKL(GB+20))
  205. END DEF
  206.  
  207. ' that's all folks
  208.