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