home *** CD-ROM | disk | FTP | other *** search
/ Vectronix 2 / VECTRONIX2.iso / FILES_01 / HISOFT.LZH / HISOFT_A.MSA / TUTORIAL / DEMO.BAS < prev    next >
BASIC Source File  |  1991-10-07  |  3KB  |  131 lines
  1. REM A Demonstration Program showing screen blitting in HiSoft BASIC 2
  2.  
  3. ' Run the program, then use the mouse to select a section of the
  4. ' picture, by clicking on the top left and dragging down and to
  5. ' the right. The section will spin round the screen. Press any key to
  6. ' pause it, or Ctrl-C to break out
  7. ' needs medium or high res
  8.  
  9. library "gemaes","gemvdi","xbios"
  10.  
  11. rem $option b+        ' break checks on (Ctrl-C)
  12. defint a-z            ' define integers as default
  13.  
  14. CONST transparent=2
  15.  
  16. window    off            ' program controls events not BASIC 
  17. window fullw : cls    ' make GEM window fill screen
  18. dim g(17000)        ' for the image
  19.  
  20. res=peekw(systab)    ' get screen resolution
  21. if res=4 then
  22.     dummy=form_alert(1,"[3][This doesn't run in|low res][ Quit ]")
  23.     system
  24. end if
  25.  
  26. screen_height=400\res
  27. screen_width=640
  28.  
  29. GrabRect g(),w,h    ' grab an image
  30.  
  31. if res=1 then
  32.     ch=13
  33.     margin=136    '120
  34.     ystep=20
  35. else
  36.     ch=6
  37.     margin=134    '118
  38.     ystep=15
  39. end if
  40.  
  41. vst_height ch
  42.  
  43. cls
  44. vswr_mode transparent
  45.  
  46.  
  47. ' write out the HiSoft BASIC messages on the side of the screen
  48. for i=ystep to screen_height step ystep
  49.     if i mod 2*ystep then
  50.         vst_effects 2    'light intensity i.e. grey
  51.     else
  52.         vst_effects 0    'normal intensity
  53.         v_rbox 0,i-ystep,margin-5,i ' rounded rectangle
  54.     end if
  55.     v_gtext 10,i-5,"HiSoft BASIC 2"    ' the text
  56. next i
  57.  
  58.     vst_effects 0    'back to normal
  59.  
  60. mouse -1            ' hide mouse
  61.  
  62. ' now rotate the image around the screen
  63.  
  64. xradius=(screen_width-w-margin)\2
  65. yradius=(screen_height-h-18)\2
  66.  
  67. a$="                  Compiled with HiSoft BASIC 2        Press SPACE for options"
  68. show_text a$
  69.  
  70. repeat forever
  71.     for theta!=0 to 2*3.14159 step 0.1
  72.     put (xradius+margin+xradius*cos(theta!),yradius+yradius*sin(theta!)),g,pset
  73.     if inkey$=" " then call checkstop
  74.     next theta!
  75. end repeat forever
  76.  
  77. SUB checkstop STATIC
  78. local click,bl
  79. mouse 0            ' show mouse, arrow form
  80. click=form_alert(1,"[3][ |Blitter Demo Program][ Quit | On | Off ]")
  81. select on click
  82.     =1: system
  83.     =2: bl=blitmode(-1) AND 2        'bl=non zero if blitter attached
  84.         if bl then
  85.             bl=blitmode(1)
  86.         else
  87.             click=form_alert(1,"[1][ |Sorry, no blitter!][ Shame ]")
  88.         end if
  89.     =3:    bl=blitmode(0)
  90. end select
  91.  
  92. mouse -1        ' hide mouse
  93. END SUB
  94.  
  95.  
  96. ' this loads a screen image, and lets you select it
  97. ' it returns the result in the array, together with the
  98. ' width and height
  99.  
  100. SUB GrabRect(image%(1),w%,h%)
  101. SHARED res,text_x,text_y
  102. STATIC x,y,a
  103.  
  104. mouse -1                ' hide mouse
  105. if res=2 then
  106.     BLOAD "\tutorial\jackmed.scr",logbase&    ' load picture
  107. else
  108.     BLOAD "\tutorial\jack.scr",logbase&        ' load picture
  109. end if
  110.  
  111. show_text "Select an area by clicking and dragging"
  112. mouse 4                    ' mouse=hand
  113. a= Evnt_button(1,1,1,x,y,0,0)            ' wait for single click on left
  114. Graf_Rubberbox x,y,10,10,w,h            ' and select a box
  115. linef x,y,x+w,y: linef x+w,y,x+w,y+h    ' draw a box around it
  116. linef x+w,y+h,x,y+h: linef x,y+h,x,y    ' using ST BASIC graphic calls
  117. get (x,y)-(x+w,y+h),image%        ' and Grab it
  118.  
  119. END SUB
  120.  
  121. SUB show_text(a$)
  122. SHARED screen_height,screen_width
  123. STATIC x
  124. LOCAL junk(7)
  125.  
  126. vqt_extent a$,junk()
  127. x=(screen_width-junk(2)-junk(0))\2
  128. v_gtext x,screen_height-2,a$
  129.  
  130. END SUB
  131.