home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1994 #1 / monster.zip / monster / PROG_BAS / MOSNHOS.ZIP / FEATURES.BAS < prev    next >
BASIC Source File  |  1994-01-17  |  6KB  |  267 lines
  1. DECLARE SUB BoxDraw (text$, length!, deep!, row!, col!, attr!)
  2. DECLARE SUB Button (text$, row, col, attr)
  3. DECLARE SUB CursorChoice (shape)
  4. DECLARE SUB Features ()
  5. DECLARE SUB Mouse (ax%, bx%, cx%, dx%)
  6. DECLARE SUB MouseHide ()
  7. DECLARE SUB MousePaws (Squeeks)
  8. DECLARE SUB MousePlace (row%, col%)
  9. DECLARE SUB MouseQuit ()
  10. DECLARE SUB MouseSpeed (speed)
  11. DECLARE SUB MouseStart ()
  12. DECLARE SUB MouseThere ()
  13. DECLARE SUB MouseTrap (ulc%, lrc%, ulr%, lrr%)
  14. DECLARE SUB Placer ()
  15. DECLARE SUB qwk (text$, row, col, attr)
  16. DECLARE SUB Speeder ()
  17. DECLARE SUB Trap ()
  18. DECLARE SUB UnButton (text$, row, col, char, attr, battr)
  19. ' $INCLUDE: 'C:\QB\QB.BI'
  20. ' Above statement vital to operation of program; path setting up to you
  21.  
  22. LOCATE , , 0              'control hardware cursor
  23. MouseQuit                 'erase soft cursor from any lingering mouse operations
  24. Mouse ax%, bx%, cx%, dx%  'call the mouse
  25. MouseThere                'check to see if mouse present
  26. MouseStart                'if present, start mouse operation
  27. MouseSpeed 15             'mouse movement setting
  28.  
  29. Features                  'call the sub
  30.  
  31. SUB BoxDraw (text$, length, deep, row, col, attr)
  32. qwk "┌" + STRING$(length, "─") + "┐", row, col, attr
  33. FOR x = 1 TO deep
  34. qwk "│" + SPACE$(length) + "│", x + row, col, attr
  35. NEXT
  36. qwk text$, row + 1, col + 1, attr
  37. qwk "└" + STRING$(length, "─") + "┘", row + deep, col, attr
  38. END SUB
  39.  
  40. SUB Button (text$, row, col, attr)
  41. qwk "┌" + STRING$(LEN(text$) + 2, "─") + "┐", row - 1, col, attr
  42. qwk "│" + SPACE$(1) + text$ + SPACE$(1) + "│", row, col, attr
  43. qwk "└" + STRING$(LEN(text$) + 2, "─") + "┘", row + 1, col, attr
  44. qwk STRING$(LEN(text$) + 2, 220), row + 1, col + 1, attr
  45. END SUB
  46.  
  47. SUB CursorChoice (shape)
  48. SELECT CASE shape
  49. CASE 0: Mouse 10, 0, &H0, &H7700
  50. CASE 1: MouseChar = 4
  51. CASE 2: MouseChar = 8
  52. CASE 3: MouseChar = 15
  53. CASE 4: MouseChar = 23
  54. CASE 5: MouseChar = 24
  55. CASE 6: MouseChar = 25
  56. CASE 7: MouseChar = 26
  57. CASE 8: MouseChar = 27
  58. CASE 9: MouseChar = 35
  59. CASE 10: MouseChar = 36
  60. CASE 11: MouseChar = 48
  61. CASE 12: MouseChar = 63
  62. CASE 13: MouseChar = 88
  63. CASE 14: MouseChar = 178
  64. CASE 15: MouseChar = 197
  65. CASE 16: MouseChar = 220
  66. CASE 17: MouseChar = 237
  67. CASE 18: MouseChar = 239
  68. CASE 19: MouseChar = 251
  69. CASE 20: MouseChar = 254
  70. END SELECT
  71. dx% = &H7000 + MouseChar
  72. Mouse 10, 0, &H0, dx%
  73. END SUB
  74.  
  75. SUB Features
  76. MouseQuit                 'erase cursor from any lingering mouse operations
  77. MouseHide
  78. MouseStart                'if present, start mouse operation
  79. CursorChoice 2            'select text cursor shape; 20 = ASCII 254
  80. qwk STRING$(80, 177), 1, 1, 47
  81. FOR x = 1 TO 23
  82. qwk "▒" + SPACE$(78) + "▒", x + 1, 1, 47
  83. NEXT
  84. qwk STRING$(80, 177), 24, 1, 47
  85.  
  86. Button "MOUSEPLACE", 4, 12, 31
  87. Button "MOUSESPEED", 4, 29, 31
  88. Button "MOUSETRAP", 4, 46, 31
  89. Button "EXIT", 4, 62, 31
  90. MouseStart
  91. char = 0
  92. attr = 31
  93. battr = 47
  94. DO
  95. Mouse 3, bx%, cx%, dx%
  96. IF bx% > 0 THEN
  97. column = cx% / 8 + 1
  98. row = dx% / 8 + 1
  99. END IF
  100. IF row = 4 THEN
  101. SELECT CASE column
  102. CASE 11 TO 22
  103. UnButton "MOUSEPLACE", 4, 12, char, attr, battr
  104. Placer
  105. CASE 28 TO 39
  106. UnButton "MOUSESPEED", 4, 29, char, attr, battr
  107. Speeder
  108. CASE 45 TO 55
  109. UnButton "MOUSETRAP", 4, 46, char, attr, battr
  110. Trap
  111. CASE 61 TO 66
  112. UnButton "EXIT", 4, 62, char, attr, battr
  113. END
  114. END SELECT
  115. END IF
  116. LOOP UNTIL INKEY$ = CHR$(27)
  117. END
  118. END SUB
  119.  
  120. SUB Mouse (ax%, bx%, cx%, dx%)
  121. DIM inregs AS RegType, outregs AS RegType
  122. inregs.ax = ax%
  123. inregs.bx = bx%
  124. inregs.cx = cx%
  125. inregs.dx = dx%
  126. INTERRUPT &H33, inregs, outregs
  127. ax% = outregs.ax
  128. bx% = outregs.bx
  129. cx% = outregs.cx
  130. dx% = outregs.dx
  131. END SUB
  132.  
  133. SUB MouseHide
  134. Mouse 2, bx%, cx%, dx%
  135. END SUB
  136.  
  137. SUB MousePaws (Squeeks)
  138. DEF SEG = 0
  139. FOR I = 1 TO Squeeks
  140. Now = PEEK(&H46C)
  141. DO: LOOP WHILE PEEK(&H46C) = Now
  142. NEXT
  143. END SUB
  144.  
  145. SUB MousePlace (row%, col%)
  146. Mouse 4, bx%, row%, col%
  147. END SUB
  148.  
  149. SUB MouseQuit
  150. Mouse 0, bx%, cx%, dx%
  151. END SUB
  152.  
  153. SUB MouseSpeed (speed)
  154. cx% = speed
  155. dx% = speed * 2
  156. Mouse 15, 0, cx%, dx%
  157. END SUB
  158.  
  159. SUB MouseStart
  160. Mouse 1, 0, 0, 0
  161. END SUB
  162.  
  163. SUB MouseThere
  164. ax% = 0
  165. Mouse ax%, bx%, cx%, dx%
  166. IF NOT ax% THEN
  167. CLS
  168. qwk " Mouse not installed -- Press any key to exit program ", 10, 15, 78
  169. WHILE INKEY$ = "": WEND
  170. SYSTEM
  171. END IF
  172. END SUB
  173.  
  174. SUB MouseTrap (ulc%, lrc%, ulr%, lrr%)
  175. Mouse 7, bx%, ulc%, ulr%
  176. Mouse 8, bx%, lrc%, lrr%
  177. END SUB
  178.  
  179. SUB Placer
  180. MouseQuit
  181. BoxDraw "", 40, 7, 13, 20, 0
  182. MouseStart
  183. MousePlace 310, 105
  184. qwk " CURSOR PLACED AT ROW 13, COLUMN 35 ", 16, 22, 78
  185. qwk " CLICK INSIDE DARK AREA TO EXIT ", 18, 24, 78
  186. DO
  187. Mouse 3, bx%, cx%, dx%
  188. IF bx% > 0 THEN
  189. column = cx% / 8 + 1
  190. row = dx% / 8 + 1
  191. END IF
  192. IF row > 11 AND row < 21 THEN
  193. SELECT CASE column
  194. CASE 20 TO 60
  195. Features
  196. END SELECT
  197. END IF
  198. LOOP
  199. END SUB
  200.  
  201. SUB qwk (text$, row, col, attr)
  202. DIM ireg AS RegTypeX, oreg AS RegTypeX
  203. ireg.ax = &H1300
  204. ireg.bx = attr
  205. ireg.cx = LEN(text$)
  206. ireg.dx = (row - 1) * 256 + (col - 1)
  207. ireg.bp = SADD(text$)
  208. ireg.es = VARSEG(text$)
  209. INTERRUPTX &H10, ireg, oreg
  210. END SUB
  211.  
  212. SUB Speeder
  213. BoxDraw " Mouse Speed = 10 ", 18, 2, 10, 4, 78
  214. BoxDraw " Mouse Speed = 25 ", 18, 2, 10, 30, 78
  215. BoxDraw " Mouse Speed = 50 ", 18, 2, 10, 56, 78
  216. qwk "  CLICK INSIDE BOX TO CHANGE SPEED  ", 16, 25, 31
  217. qwk "    PRESS ESC TO EXIT MOUSE SPEED   ", 17, 25, 31
  218. DO
  219. Mouse 3, bx%, cx%, dx%
  220. IF bx% > 0 THEN
  221. column = cx% / 8 + 1
  222. row = dx% / 8 + 1
  223. END IF
  224. IF row > 9 AND row < 13 THEN
  225. SELECT CASE column
  226. CASE 4 TO 23
  227. MouseSpeed 10
  228. CASE 30 TO 49
  229. MouseSpeed 25
  230. CASE 56 TO 75
  231. MouseSpeed 50
  232. END SELECT
  233. END IF
  234. LOOP UNTIL INKEY$ = CHR$(27)
  235. Features
  236. END SUB
  237.  
  238. SUB Trap
  239. BoxDraw "", 70, 12, 7, 5, 120
  240. BoxDraw " CLICK TO TRAP CURSOR INSIDE BIG BOX; ESC TO EXIT ", 50, 2, 12, 15, 31
  241. DO
  242. Mouse 3, bx%, cx%, dx%
  243. IF bx% > 0 THEN
  244. column = cx% / 8 + 1
  245. row = dx% / 8 + 1
  246. END IF
  247. IF row > 6 AND row < 20 THEN
  248. SELECT CASE column
  249. CASE 5 TO 75
  250. MouseTrap 600, 53, 33, 150
  251. END SELECT
  252. END IF
  253. LOOP UNTIL INKEY$ = CHR$(27)
  254. Features
  255. END SUB
  256.  
  257. SUB UnButton (text$, row, col, char, attr, battr)
  258. qwk SPACE$(1) + text$ + SPACE$(1), row, col + 1, 8
  259. qwk "└" + STRING$(LEN(text$) + 2, "─") + "┘", row + 1, col, attr
  260. qwk CHR$(char), row + 2, col + LEN(text$) + 4, battr
  261. MousePaws 12
  262. qwk STRING$(LEN(text$) + 2, 220), row + 1, col + 1, attr
  263. qwk SPACE$(1) + text$ + SPACE$(1), row, col + 1, attr
  264. MousePaws 12
  265. END SUB
  266.  
  267.