home *** CD-ROM | disk | FTP | other *** search
/ Club Amiga de Montreal - CAM / CAM_CD_1.iso / files / 167.lha / SysReqst.bas (.txt) < prev    next >
AmigaBASIC Source Code  |  1988-04-28  |  5KB  |  186 lines
  1. REM   * This program has a good routine for requestors in AmigaBASIC
  2. REM   * so I included the basic code in the arc. Feel free to use this
  3. REM   * requestor listing in your programs. The button gadgets do return 
  4. REM   * a value of 1 or 2, for button 1 or button 2, to the main
  5. REM   * program so they may be put to practical use.
  6. REM   * Enjoy........Michael Fahrion
  7.  
  8.  
  9. REM   * To run in AmigaBASIC you must have an output window. The small
  10. REM   * window created here is lost in the upper left of the workbench.
  11. REM   * There is no way to prevent basic from opening a full size window
  12. REM   * when it is loaded.  I have deleteed the WINDOW line in the compiled
  13. REM   * version so there is no window except the requestors. If you are 
  14. REM   * using this requestor coding in your program just delete it.
  15.  
  16. WINDOW 1,"",(0,0)-(5,5),0
  17.  
  18.  
  19. REM  * These globle arrays and variables should be initialized at
  20. REM  * at the beginning of your program.
  21.  
  22. DEFINT a-z
  23. DIM work%(400)
  24. DIM x1(20),y1(20),x2(20),y2(20)
  25. ScrId=-1:which=0:BoxIndex=1:maxlen=15
  26. RANDOMIZE TIMER
  27.  
  28.  
  29. REM  * This is the main loop. It sets up a random length pause of 5 to 10  
  30. REM  * seconds and randomly picks a requestor to display.
  31. REM  * Note the use of TIMER and a WHILE:WEND loop. This method of pausing
  32. REM  * will always give you a specifed pause in seconds no matter if the
  33. REM  * program is compiled, run with an excellerator board or not.
  34.  
  35. WhichOne:
  36. nsec=INT(RND*5)+5                           
  37. pause&=TIMER:WHILE pause&+nsec>TIMER:WEND
  38. wr=INT(RND*12)+1
  39. IF onebfor = wr OR twobefor = wr THEN WhichOne     REM * Check for repeats
  40. twobefor=1befor:onebefor = wr
  41. ON wr GOSUB 10,20,30,40,50,60,70,80,90,100,110,120
  42. GOTO WhichOne
  43.  
  44.  
  45. REM  * CALL calls the subroutine "ReQuest" and passes the variables to it.
  46. REM  * Usage ("Message1","Message2","Button1","Button2",Variable returned)
  47.  
  48. 10 :
  49. CALL ReQuest("Insert Volumn XXI","in drive DF23:   ","CANCEL","RESUME",which)
  50. RETURN
  51.  
  52. 20 :
  53. CALL ReQuest("Is it OK to explode","your Amiga now?    ","YES","NO",which)
  54. RETURN
  55.  
  56. 30 :
  57. CALL ReQuest("Not that disk dummy","I want the blue one","CANCEL","RESUME",which)
  58. RETURN
  59.  
  60. 40 :
  61. CALL ReQuest("Pick either button"," I won't do it anyway","CANCEL","RESUME",which)
  62. RETURN
  63.  
  64. 50 :
  65. CALL ReQuest("Why did you do that","???????????","CANCEL","BECAUSE",which)
  66. RETURN
  67.  
  68. 60 :
  69. CALL ReQuest("ROM is corrupted","Sorry about that","TRY","CRY",which) 
  70. RETURN
  71.  
  72. 70 :
  73. CALL ReQuest("Not a DO$ disk   ","Use expesive type","CANCLE","RESUME",which)
  74. RETURN
  75.  
  76. 80 :
  77. CALL ReQuest(" Disk write-protected"," Close little window ","OPEN","CLOSE",which)
  78. RETURN
  79.  
  80. 90 :
  81. CALL ReQuest("Disk is full    ","        ","BURP","BELCH",which)
  82. RETURN
  83.  
  84. 100 :
  85. CALL ReQuest("Object in use    ","You can't have it","NO-NO","NO-NO",which)
  86. RETURN
  87.  
  88. 110 :
  89. CALL ReQuest("Object not found","Try the tan disk","MAYBE","BLUE?",which)
  90. RETURN
  91.  
  92. 120 :
  93. CALL ReQuest("The only workbench","still with EDIT!  ","DELETE","DELETE",which)
  94. RETURN
  95.  
  96. WINDOW CLOSE 1
  97. CLEAR             REM  * Clears the memory of variables
  98. SYSTEM            REM  * returns memory to system
  99. END
  100.  
  101.  
  102. REM  *** This is the requestor sub program ***
  103.  
  104. SUB ReQuest(msg1$,msg2$,b1$,b2$,which) STATIC
  105. SHARED BoxIndex,ScrId
  106. SHARED x1(),y1(),x2(),y2()
  107. BoxIndex=1:height=PEEKW(WINDOW(8)+58)
  108. winwidth=20*(8-2*(height=9))+35
  109. WINDOW 2,"System Request",(0,0)-(winwidth,50),7,ScrId
  110. LINE(0,0)-(winwidth,50),1,bf:COLOR 0,1
  111. PRINT :PRINT TAB(11-LEN(msg1$)/2);msg1$
  112. PRINT TAB(11-LEN(msg2$)/2);msg2$:PRINT 
  113. LOCATE ,2:TxBox b1$
  114. PRINT TAB(20-LEN(b2$));:TxBox b2$:which=0
  115. CALL WaitBox(which)
  116. CALL FlashRelease(which)
  117. WINDOW CLOSE 2
  118. END SUB
  119.  
  120.  
  121. REM  * Another sub program to make gadget buttons to fit text
  122.  
  123. SUB TxBox(msg$) STATIC       
  124. SHARED x1(),y1(),x2(),y2()
  125. SHARED BoxIndex
  126. x1=WINDOW(4):y1=WINDOW(5)-10
  127. PRINT  " ";msg$;" ";
  128. x2=WINDOW(4):y2=y1+14
  129. CALL box(BoxIndex,x1,y1,x2,y2)
  130. BoxIndex=BoxIndex+1
  131. PRINT SPC(1);
  132. END SUB
  133.  
  134.  
  135. REM  * Draws boxes around gadgets
  136.  
  137. SUB box(i,x1,y1,x2,y2) STATIC      
  138. SHARED x1(),y1(),x2(),y2()
  139. IF x2<x1 THEN SWAP x1,x2
  140. LINE (x1,y1)-(x2,y2),1-(WINDOW(6)>1),b
  141. LINE (x1-2,y1-2)-(x2+2,y2+2),3,b
  142. x1(i)=x1:y1(i)=y1:x2(i)=x2:y2(i)=y2
  143. END SUB
  144.  
  145.  
  146. REM  * Wait routine till a button is clicked
  147.  
  148. SUB WaitBox(which) STATIC    
  149. which=0
  150. WHILE which=0
  151.   CALL WhichBox(which)
  152. WEND
  153. EXIT SUB
  154. RETURN
  155. END SUB
  156.  
  157.  
  158. REM  * Flashes the selected gadget
  159.  
  160. SUB FlashRelease(which) STATIC       
  161. SHARED x1(),y1(),x2(),y2(),work%()
  162. SHARED RelVerify
  163. GET (x1(which),y1(which))-(x2(which),y2(which)),work%
  164. PUT (x1(which),y1(which)),work%,PRESET
  165. ix=MOUSE(1):iy=MOUSE(2):RelVerify=-1
  166. WHILE MOUSE(0)<>0
  167. IF MOUSE(1)<>ix OR MOUSE(2)<>iy THEN RelVerify=0
  168. WEND
  169. PUT (x1(which),y1(which)),work%,PSET
  170. END SUB
  171.  
  172.  
  173. REM  * Sets value of variable for which button clicked
  174.  
  175. SUB WhichBox(which) STATIC           
  176. SHARED x1(),y1(),x2(),y2(),BoxIndex
  177. IF MOUSE(0)=0 THEN EXIT SUB
  178. x=MOUSE(1):y=MOUSE(2):i=1
  179. WHILE i < BoxIndex AND NOT (x>x1(i) AND x<x2(i) AND y>y1(i) AND y<y2(i))
  180.   i=i+1
  181. WEND
  182. which=i:IF i=BoxIndex THEN which=0
  183. END SUB
  184.   
  185.  
  186.