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