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