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