home *** CD-ROM | disk | FTP | other *** search
/ Millennium Time Capsule / AC2000.BIN / disks / ac4_disk / hbasic / demos / aesdemo.bas next >
BASIC Source File  |  1987-07-27  |  9KB  |  304 lines
  1. '   An AES demo program written in HiSoft BASIC
  2. '   by Dave Nutkins
  3. ' Note that this will not compile immediately since it uses
  4. ' GEMAES.BH on Disc 2. See Chapter 8 for more details.
  5.  
  6. rem $option v
  7.  
  8. DEFINT a-z
  9. LIBRARY "gemvdi","gemaes"
  10. REM $INCLUDE gemaes.bh
  11.  
  12. ' some constants for WINDOW GET/READ etc commands
  13. CONST window_hslide=0, window_vslide=1, window_hsize=2, window_vsize=3
  14. CONST window_front=4, read_window_handle=5, read_window_id=6
  15.  
  16. CONST get_usable=0,get_total=1,get_max=2,get_first=3,get_next=4
  17.  
  18. 'initialise the data structures used for storing the characters
  19. text=-1    ' -1 if written to this string 0 if only set attributes
  20. string_max=100
  21. DIM types(string_max,1),strings$(string_max)
  22. store_info 0,10    '10 point to start
  23. store_info 1,0    ' no effects
  24.  
  25. 'the data for the point sizes
  26. DIM points(2)
  27. FOR i=0 to 2: read points(i): next i
  28. DATA 10,18,24
  29.  
  30.  
  31. menu$="[ Desk |  About me...][ File | Quit ]"
  32. menu$=menu$+"[ Style |  10 point \  18 point \  24 point \(---------------\  Bold \  Grey \  Italic \  Underline \  Outline ]"
  33.  
  34. ' the menu title menus
  35. CONST file_title=4,style_title=5, about=8, quit=17
  36. point10=19
  37. bold=point10+4
  38. outline=bold+4
  39.  
  40.  
  41. menu_pointer&=FNmenu&(menu$)
  42.  
  43. ' this piece of code would disable the desk accessories
  44. 'for i=10 to 15
  45. '            menu_ienable menu_pointer&,i,0
  46. 'next i
  47.  
  48. CONST our_window=2
  49.  
  50. DIM d(9)' only used to store the distances in print_string
  51. DIM mess(7)    'for the messages
  52.  
  53.  
  54. WINDOW OFF        ' program is controlling the windows not the runtimes
  55.  
  56. WINDOW READ our_window,read_window_handle,our_aeshandle
  57. WINDOW GET our_window,get_total,bigx,bigy,bigw,bigh
  58. 'bigx,bigy,bigw,bigh hold the maximum size of our window
  59.  
  60. MOUSE 0 
  61.  
  62. moved_window    ' to initialise the window sizes etc
  63. ' i.e. (topx,topy,botx,boty) VDI rectangle for our_window
  64. ' curx,cury position to write text at (starts at topx,topy)
  65.  
  66.  
  67.  
  68. 'oldx,oldy,oldw,oldh hold the size to return to after the full box
  69. ' is clicked twice
  70.  
  71. oldx=bigx: oldy=bigy: oldw=bigw: oldh=bigh
  72.  
  73. 'use the top left corner for text alignment; this makes the calculations
  74. ' easy but doesn't look good with different sizes.
  75. vst_alignment 0,5
  76.  
  77.  
  78. DO
  79.     e=FNevnt_multi(MU_MESAG+MU_KEYBD,0,0,0,0,0,0,0,0,0,0,0,0,0,_
  80.                     varptr(mess(0)),0,0,0,0,0,k,0)
  81.  
  82.     
  83.     IF e AND MU_MESAG THEN do_message mess(0)  'there was a message
  84.     IF e AND MU_KEYBD THEN    ' a character was typed.
  85.         junk=FNwind_update(1)
  86.         char=k AND 255        ' the actual ASCII character
  87.         IF char=27 THEN        'escape
  88.             redraw topx,topy,botx-topx-1,boty-topy-1
  89.         ELSEIF char=17 THEN    'ctrl Q
  90.              junk=FNwind_update(0)
  91.             goto finished
  92.         ELSE
  93.             MOUSE -1
  94.             print_string chr$(char)
  95.             MOUSE 0
  96.             store_string chr$(char)
  97.         END IF
  98.          junk=FNwind_update(0)
  99.     END IF
  100. LOOP
  101. finished:    stop    -1    ' stop without asking for a key
  102.  
  103. SUB do_message(val mes_type)
  104. SHARED mess(1),menu_pointer&,point10,bold,outline,our_aeshandle
  105. SHARED topx,topy,botx,boty,oldx,oldy,oldw,oldh,bigx,bigy,bigh,bigw
  106. STATIC title,item,junk,x,y,w,h,cur_front
  107.  IF mes_type>=WM_TOPPED AND mes_type<=WM_MOVED THEN
  108.     IF mess(3)<>our_aeshandle THEN EXIT SUB    'its not our window
  109.  END IF
  110.  SELECT CASE mes_type
  111.  CASE MN_SELECTED:
  112.     ' its a menu
  113.     WINDOW READ 0,window_front,cur_front
  114.     title=mess(3)
  115.     IF cur_front=our_window THEN
  116.         ' we are at the front
  117.         item=mess(4)
  118.         SELECT CASE item
  119.         CASE about: junk=FNform_alert(1,"[0][ An Example Program Written  |      in HiSoft BASIC ][ OK ]") 
  120.         CASE quit : goto finished
  121.         CASE point10 TO point10+3:    do_points item
  122.         CASE bold TO outline:do_effects item
  123.         END SELECT
  124.     END IF
  125.     ' un-highlight the menu item even if not at front
  126.     menu_tnormal menu_pointer&,title,1
  127.  CASE WM_REDRAW:
  128.     redraw mess(4),mess(5),mess(6),mess(7)
  129.  CASE WM_TOPPED:
  130.     full_redraw
  131.  CASE WM_CLOSED: goto finished
  132.  CASE WM_SIZED,WM_MOVED:
  133.     make_window mess(4),mess(5),mess(6),mess(7)
  134.  CASE WM_FULLED:
  135.     WINDOW GET our_window,get_total,x,y,w,h    'current size
  136.     IF bigw<>w OR bigh<>h OR bigx<>x OR bigy<>y THEN
  137.             ' make as large as possible
  138.             make_window bigx,bigy,bigw,bigh
  139.             oldx=x: oldy=y: oldw=w:oldh=h
  140.     ELSE
  141.             ' make to the old size
  142.             make_window oldx,oldy,oldw,oldh
  143.     END IF
  144.  END SELECT
  145. END SUB
  146.  
  147. ' actually writes x$ to the screen
  148. SUB print_string(x$)
  149. SHARED curx,cury,maxy,topx,botx,d(1)
  150.     vqt_extent x$,d()         'd() now contains the dimensions required to print this
  151.     IF curx+d(4)>botx THEN
  152.             ' new line required
  153.             curx=topx: cury=cury+maxy: maxy=0
  154.     END IF
  155.     IF d(5)>maxy THEN maxy=d(5)        ' taller character than any we have had
  156.     v_gtext curx,cury,x$        ' write the text
  157.     curx=curx+d(4)                ' update the x co-ordinate
  158. END SUB
  159.  
  160. ' The points parts of the menu
  161. SUB do_points(m)
  162. SHARED menu_pointer&,points(1),point10
  163. STATIC cur_point_menu
  164.     menu_icheck menu_pointer&,cur_point_menu,0    ' untick the old item
  165.     cur_point_menu=m                ' remember for unticking next time
  166.     vst_point points(m-point10)        ' set the size
  167.     menu_icheck menu_pointer&,m,1    ' tick the new size
  168.     store_info 0,points(m-point10)  ' store in data structure
  169. END SUB
  170.  
  171. 'The style parts of the menu
  172. SUB do_effects(m)
  173. SHARED menu_pointer&,bold
  174. STATIC newmask,effects,state
  175.     newmask=FNtwo(m-bold)    'the mask we are setting or removing
  176.     state=effects AND newmask
  177.     IF state THEN
  178.                 ' was set before now off
  179.         menu_icheck menu_pointer&,m,0
  180.         effects=effects-newmask    ' update effects
  181.     ELSE
  182.         menu_icheck menu_pointer&,m,1
  183.         effects=effects+newmask    ' on
  184.     END IF        
  185.     vst_effects effects        'set new effects
  186.     store_info 1,effects    ' remember info
  187. END SUB
  188.  
  189. ' returns 2^i
  190. DEF FNtwo(i)
  191. STATIC k,j
  192. j=1
  193. for k=1 to i: j=j*2: next k
  194. FNtwo=j
  195. END def
  196.  
  197. ' The next 2 routines store the internal data structure
  198. ' This consists of a collection of strings each with the same effects
  199. ' and size info.
  200. ' There are topstr strings
  201. ' the strings themselves are in strings$ and the
  202. '  types(x,0) stores the points, types(x,1) the effects for this string
  203. ' -1 in these fields indicates un-used
  204. ' if text=-1 then we have added some characters to this string
  205.  
  206. 'store_string adds x$ to the current string
  207. SUB store_string(x$)
  208. SHARED topstr,text,strings$(1)
  209.   text=-1
  210.   strings$(topstr)=strings$(topstr)+x$
  211. END SUB
  212.  
  213. ' sets the current effects
  214. SUB store_info(type,value)
  215. SHARED topstr,text,types(2)
  216. IF text THEN
  217. ' new string needed
  218. ' default leave alone
  219.     topstr=topstr+1: types(topstr,0)=-1: types(topstr,1)=-1
  220.     text=0
  221. END IF
  222.  types(topstr,type)=value
  223. END SUB
  224.  
  225.  
  226. ' The redraw routines
  227.  
  228. 'redraw is called when the AES sends a redraw message and takes note
  229. ' of the update rectangles
  230. SUB redraw(val x,val y,val w,val h)
  231. SHARED botx,boty,topx,topy
  232. STATIC junk
  233. STATIC x1,y1,w1,h1,x2,y2,w2,h2
  234. MOUSE -1
  235. junk=FNwind_update(1)
  236. WINDOW GET our_window,get_first,x1,y1,w1,h1
  237. DO
  238.     IF w1=0 or h1=0 THEN EXIT LOOP
  239.     INTERSECTION x,y,w,h,x1,y1,w1,h1,x2,y2,w2,h2
  240.     base_redraw x2,y2,w2,h2
  241.     WINDOW GET our_window,get_next,x1,y1,w1,h1
  242. LOOP
  243. vs_clip 1,topx,topy,botx,boty    'restore the clipping rectangle
  244. junk=FNwind_update(0)
  245. MOUSE 0
  246. END SUB
  247.  
  248. ' redraws the entire screen regardless of the update rectangle
  249. SUB full_redraw
  250. SHARED topx,topy,botx,boty
  251. STATIC junk
  252.     WINDOW CONTRL our_window,window_front,0 ' make us the front
  253.     MOUSE -1
  254.     junk=FNwind_update(1)
  255.     base_redraw topx,topy,botx-topx-1,boty-topy-1
  256.     junk=FNwind_update(0)
  257.     MOUSE 0
  258. END SUB
  259.  
  260. ' the low level redraw routine which does not remove the mouse etc
  261.  
  262. SUB base_redraw(x2,y2,w2,h2)
  263. SHARED curx,topx,cury,topy,maxy,types(2),strings$(1),topstr
  264. STATIC i,j
  265.     IF w2>0 AND h2>0 THEN
  266.         vsf_color 0            ' fill with white
  267.  
  268. ' set the clipping rectangle and clear it
  269.         vs_clip 1,x2,y2,x2+w2-1,y2+h2-1
  270.         vr_recfl x2,y2,x2+w2-1,y2+h2-1
  271. ' reset the pointers for the string drawing
  272.         curx=topx: cury=topy: maxy=0
  273.  
  274.         FOR i=1 TO topstr
  275.             ' set the size and effects for this string
  276.             IF types(i,0)>-1 THEN vst_point types(i,0)
  277.             IF types(i,1)>-1 THEN vst_effects types(i,1)    
  278.             
  279.             ' write the string one character at a time
  280.             FOR j=1 TO len(strings$(i))
  281.                 print_string mid$(strings$(i),j,1)
  282.             NEXT j
  283.         NEXT i
  284.     END IF
  285. END SUB
  286.  
  287. ' called when the window is moved or changes size
  288. SUB make_window(x,y,w,h)
  289. WINDOW LOCATE our_window,x,y,w,h
  290. moved_window
  291. full_redraw
  292. END SUB
  293.  
  294.  
  295. ' update the window variables after the window has moved.
  296. SUB moved_window
  297. SHARED topx,topy,botx,boty,curx,cury,maxy
  298. WINDOW GET our_window,get_usable,topx,topy,botx,boty
  299. botx=botx+topx+1
  300. boty=boty+topy+1
  301. maxy=0    ' maxy is the highest character printed on the current line
  302. curx=topx: cury=topy
  303. END SUB
  304.