home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PROGRAMS / UTILS / MOUSE / MSMOUSE1.ZIP / BAS.ZIP / PIANO.BAS < prev    next >
Encoding:
BASIC Source File  |  1989-02-10  |  9.6 KB  |  211 lines
  1. 1000 '
  2. 1010 '               THE VIRTUAL PIANO
  3. 1020 '
  4. 1030 '   COPYRIGHT (C) 1983 BY MICROSOFT CORPORATION
  5. 1040 '           WRITTEN BY CHRIS PETERS
  6. 1050 '
  7. 1060 '-----------------------------------------------
  8. 1070 '
  9. 1080 '  I N I T I A L I Z E
  10. 1090 '
  11. 1100 DEFINT A-Z
  12. 1110 DIM CURSOR(15,1),FREQ(27,2),MICROSOFT(839)
  13. 1120 KEY OFF
  14. 1130 PLAY"MF"
  15. 1140 SCREEN 1
  16. 1150 COLOR 1,1
  17. 1160 CLS
  18. 1170 '
  19. 1180 '  Read in the flat, normal, and sharp note frequencies
  20. 1190 '
  21. 1200 FOR J=0 TO 2
  22. 1210 FOR I=0 TO 6
  23. 1220 READ K
  24. 1230 FREQ(I,J)=K : FREQ(I+7,J)=K*2 : FREQ(I+14,J)=K*4 : FREQ(I+21,J)=K*8
  25. 1240 NEXT
  26. 1250 NEXT
  27. 1260 '
  28. 1270 '  Determine mouse driver location; if not found, quit
  29. 1280 '
  30. 1290 DEF SEG=0
  31. 1300 MSEG=256*PEEK(51*4+3)+PEEK(51*4+2)     ' Get mouse segment
  32. 1310 MOUSE=256*PEEK(51*4+1)+PEEK(51*4)      ' Get mouse offset
  33. 1320 IF MSEG OR (MOUSE-2) THEN 1370
  34. 1330 PRINT"Mouse driver not found"          ' Not found, so print error
  35. 1340 PRINT
  36. 1350 PRINT"Press any key to return to system"
  37. 1360 I$=INKEY$ : IF I$="" THEN 1360 ELSE SYSTEM
  38. 1370 DEF SEG=MSEG : MOUSE=MOUSE+2           ' Set mouse segment
  39. 1373 IF PEEK(MOUSE-2) = 207 THEN 1330       ' 207 is iret
  40. 1376                                        ' Mouse driver is there
  41. 1380 M1 = 0 : CALL MOUSE(M1,M2,M3,M4)       ' Initialize the mouse
  42. 1382 IF M1 = 0 THEN PRINT "Mouse not found":END
  43. 1390 '
  44. 1400 '  Set mouse sensitivity
  45. 1410 '
  46. 1420 M1 = 15 : M3=4 : M4=8
  47. 1430 CALL MOUSE(M1,M2,M3,M4)
  48. 1440 '
  49. 1450 '  Define the "logical and" cursor mask
  50. 1460 '
  51. 1470 CURSOR( 0,0)=&HFFFF         ' Binary 1111111111111111
  52. 1480 CURSOR( 1,0)=&HFFFF         ' Binary 1111111111111111
  53. 1490 CURSOR( 2,0)=&HFFFF         ' Binary 1111111111111111
  54. 1500 CURSOR( 3,0)=&HFFFF         ' Binary 1111111111111111
  55. 1510 CURSOR( 4,0)=&HFFFF         ' Binary 1111111111111111
  56. 1520 CURSOR( 5,0)=&HFFFF         ' Binary 1111111111111111
  57. 1530 CURSOR( 6,0)=&HFFFF         ' Binary 1111111111111111
  58. 1540 CURSOR( 7,0)=&HFFFF         ' Binary 1111111111111111
  59. 1550 CURSOR( 8,0)=&HFFFF         ' Binary 1111111111111111
  60. 1560 CURSOR( 9,0)=&HFFFF         ' Binary 1111111111111111
  61. 1570 CURSOR(10,0)=&HFFFF         ' Binary 1111111111111111
  62. 1580 CURSOR(11,0)=&HFFFF         ' Binary 1111111111111111
  63. 1590 CURSOR(12,0)=&HFFFF         ' Binary 1111111111111111
  64. 1600 CURSOR(13,0)=&HFFFF         ' Binary 1111111111111111
  65. 1610 CURSOR(14,0)=&HFFFF         ' Binary 1111111111111111
  66. 1620 CURSOR(15,0)=&HFFFF         ' Binary 1111111111111111
  67. 1630 '
  68. 1640 '  Define the "exclusive or" cursor mask
  69. 1650 '
  70. 1660 CURSOR( 0,1)=&H300          ' Binary 0000001100000000
  71. 1670 CURSOR( 1,1)=&H300          ' Binary 0000001100000000
  72. 1680 CURSOR( 2,1)=&HFC0          ' Binary 0000111111000000
  73. 1690 CURSOR( 3,1)=&HFC0          ' Binary 0000111111000000
  74. 1700 CURSOR( 4,1)=&H3FF0         ' Binary 0011111111110000
  75. 1710 CURSOR( 5,1)=&H3FF0         ' Binary 0011111111110000
  76. 1720 CURSOR( 6,1)=&HFCFC         ' Binary 1111110011111100
  77. 1730 CURSOR( 7,1)=&HC00C         ' Binary 1100000000001100
  78. 1740 CURSOR( 8,1)=&H0            ' Binary 0000000000000000
  79. 1750 CURSOR( 9,1)=&H0            ' Binary 0000000000000000
  80. 1760 CURSOR(10,1)=&H0            ' Binary 0000000000000000
  81. 1770 CURSOR(11,1)=&H0            ' Binary 0000000000000000
  82. 1780 CURSOR(12,1)=&H0            ' Binary 0000000000000000
  83. 1790 CURSOR(13,1)=&H0            ' Binary 0000000000000000
  84. 1800 CURSOR(14,1)=&H0            ' Binary 0000000000000000
  85. 1810 CURSOR(15,1)=&H0            ' Binary 0000000000000000
  86. 1820 '
  87. 1830 '  Set the mouse cursor shape
  88. 1840 '
  89. 1850 M1 = 9 : M2 = 6 : M3 = 0
  90. 1860 CALL MOUSE(M1,M2,M3,CURSOR(0,0))                   ' Mouse driver < 6.25
  91. 1862 'M4 = VARPTR(CURSOR(0,0)): CALL MOUSE(M1,M2,M3,M4) ' Mouse driver 6.25+
  92. 1870 '
  93. 1880 '  Draw the MICROSOFT logo from precalculated data
  94. 1890 '
  95. 1900 FOR I=0 TO 779
  96. 1910 READ MICROSOFT(I)
  97. 1920 NEXT
  98. 1930 PUT(62,0),MICROSOFT,PSET
  99. 1940 '
  100. 1950 '  Initialize keyboard size parameters
  101. 1960 '
  102. 1970 YL = 60 : WKL = 80 : BKL = 45 : KW = 15 : WKN = 21
  103. 1980 XL = 320-KW*WKN : YH = YL + WKL : XH = 319 : BKW2=KW\3
  104. 1990 QX = 272 : QY = 176
  105. 2000 '
  106. 2010 '  Draw the white keys
  107. 2020 '
  108. 2030 LINE (XL,YL)-(XH,YH),3,BF
  109. 2040 FOR I=XL TO XH STEP KW
  110. 2050 LINE (I,YL)-(I,YH),0
  111. 2060 NEXT
  112. 2070 '
  113. 2080 '  Draw the black keys
  114. 2090 '
  115. 2100 C=6
  116. 2110 FOR X=XL TO XH STEP KW
  117. 2120 C=C+1 : IF C=7 THEN C=0
  118. 2130 IF C=0 OR C=3 THEN 2150
  119. 2140 LINE(X-BKW2,YL)-(X+BKW2,YL+BKL),2,BF
  120. 2150 NEXT
  121. 2160 '
  122. 2170 '  Draw the quit box
  123. 2180 '
  124. 2190 LINE(QX,QY)-(319,199),3,B
  125. 2200 LOCATE 24,36 : PRINT"Quit";
  126. 2210 '
  127. 2220 '  Set mouse cursor location, then turn on cursor
  128. 2230 '
  129. 2240 M1 = 4 : M3 = 320 : M4 = 160 : CALL MOUSE(M1,M2,M3,M4)
  130. 2250 M1 = 1 : CALL MOUSE(M1,M2,M3,M4)
  131. 2260 '
  132. 2270 '  M A I N    L O O P
  133. 2280 '
  134. 2290 M1=3 : CALL MOUSE(M1,BT,MX,MY)    ' Get mouse location and button status
  135. 2300 IF (BT AND 2) THEN OTV=7 : GOTO 2340 ' If right button down, set high octave
  136. 2310 IF (BT AND 1) THEN OTV=0 : GOTO 2340 ' If left button down, set lower octave
  137. 2320 SOUND 442,0                       ' If both buttons up, turn off sound
  138. 2330 GOTO 2290                         ' Keep looping...
  139. 2340 MX = MX\2                         ' Correct for medium resolution screen
  140. 2350 IF MX <= XL OR MY < YL THEN 2320  ' If above keyboard, turn off sound
  141. 2360 IF MY <= YH THEN 2470             ' If on keyboard, play sound
  142. 2370 IF MY < QY OR MX < QX THEN 2320   ' If above quit box, turn off sound
  143. 2380 '
  144. 2390 '  Button down inside the quit box
  145. 2400 '
  146. 2410 M1=2 : CALL MOUSE(M1,M2,M3,M4)    ' Turn off mouse cursor
  147. 2420 CLS                               ' Clear screen
  148. 2430 END                               ' quit
  149. 2440 '
  150. 2450 '  Button down over keyboard, determine which key
  151. 2460 '
  152. 2470 WKY = (MX-XL)\KW+OTV : R = 1      ' Get which white key cursor is over
  153. 2480 IF MY > YL+BKL THEN 2560          ' Is it lower than the black keys?
  154. 2490 MK=(MX-XL) MOD KW                 ' No, get which side of key
  155. 2500 IF MK <= BKW2 THEN R=0 : GOTO 2560 ' Is it the left black key?
  156. 2510 IF MK >= KW-BKW2 THEN R=2         ' Is it the right black key?
  157. 2520 '
  158. 2530 '  Play the note. For BASIC interpreter duration = 2
  159. 2540 '                 For BASIC compiler    duration = 1
  160. 2550 '
  161. 2560 SOUND FREQ(WKY,R),2
  162. 2570 GOTO 2290                         ' Continue looping
  163. 2580 '
  164. 2590 '  Musical note frequencies
  165. 2600 '
  166. 2610 DATA 131,139,156,175,185,208,233
  167. 2620 DATA 131,147,165,175,196,220,247
  168. 2630 DATA 139,156,165,185,208,233,247
  169. 2640 '
  170. 2650 '  Data to draw the MICROSOFT logo
  171. 2660 '
  172. 2670 DATA 462,28,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  173. 2680 DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  174. 2690 DATA 0,0,0,-193,240,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
  175. 2700 DATA 0,0,0,0,0,768,-1,0,0,0,0,3840,-1,-16129,0,-253,0,0,-193,240
  176. 2710 DATA 0,0,0,0,0,0,0,0,0,-193,0,16128,4095,252,16128,-1,240,-256,-769,0
  177. 2720 DATA 0,0,0,0,-193,240,768,-1,255,768,-1,1023,-1,-1,240,0,0,0,-193,192
  178. 2730 DATA -256,4095,252,-253,-1,255,-256,-1,240,-253,-1,-1,768,-1,255,16128,-1,-3841,768,-1
  179. 2740 DATA 1023,-1,-1,240,0,0,0,-193,192,-256,4095,252,-193,-1,-3841,-256,-1,252,-1009,0
  180. 2750 DATA -256,4032,-1,-16129,-253,-1,-1,768,-1,1023,-1,-1,240,0,0,0,-193,240,-253,4095
  181. 2760 DATA 252,-3841,0,-961,-256,-1,255,0,0,0,3840,-1,-16129,-241,0,-253,960,-1,1023,-1
  182. 2770 DATA -1,240,0,0,0,-193,240,-253,4095,1020,255,0,-253,-256,4032,-16129,-1,-1,-1,4092
  183. 2780 DATA 4095,-16129,-4033,0,16128,1008,-1,1023,-1,-1,240,0,0,0,-193,252,-241,4095,1020,252
  184. 2790 DATA 0,-256,-256,960,-15361,252,0,0,4095,1023,-16129,-16321,0,3840,1008,255,0,3840,252,0
  185. 2800 DATA 0,0,0,-193,252,-241,4095,4092,240,0,16128,-64,192,-16129,0,0,0,3840,255,0
  186. 2810 DATA 255,0,768,1020,255,0,3840,252,0,0,0,0,-193,255,-193,4095,4092,240,0,16128
  187. 2820 DATA -64,192,-12289,-1,192,-241,-12289,-3841,0,255,0,768,1020,255,0,3840,252,0,0,0
  188. 2830 DATA 0,-193,255,-193,4095,16380,192,0,3840,-16,960,-12289,240,0,0,-15553,-1,768,252,0
  189. 2840 DATA 0,1023,255,0,3840,252,0,0,0,0,-193,-16129,-1,4095,16380,192,0,0,-256,4032
  190. 2850 DATA -16129,0,0,0,768,-1,1008,252,0,0,1023,-1,255,3840,252,0,0,0,0,-3265
  191. 2860 DATA -16129,-3073,4095,16380,192,0,0,-256,-1,4095,-1,0,-253,-16129,-1,1020,252,0,0,1023
  192. 2870 DATA -1,255,3840,252,0,0,0,0,-3265,-3073,-3073,4095,16380,192,0,0,-256,-1,4095,240
  193. 2880 DATA 0,0,-16321,-241,1023,252,0,0,1023,-1,255,3840,252,0,0,0,0,-4033,-3073,-15361
  194. 2890 DATA 4095,16380,192,0,0,-256,-1,252,0,0,0,0,16128,-15361,252,0,0,1023,-1,255
  195. 2900 DATA 3840,252,0,0,0,0,-4033,-1,-15361,4095,16380,192,0,0,-256,-1,4092,240,0,0
  196. 2910 DATA -16321,768,-3073,252,0,0,1023,255,0,3840,252,0,0,0,0,-4033,-193,1023,4095,4092
  197. 2920 DATA 240,0,0,-256,-64,4092,-1,192,-241,-16129,0,-3841,255,0,768,1020,255,0,3840,252
  198. 2930 DATA 0,0,0,0,-4033,-193,1023,4095,4092,240,0,16128,-64,4032,255,0,0,0,16128,252
  199. 2940 DATA -3841,255,0,768,1020,255,0,3840,252,0,0,0,0,-4033,-241,1020,4095,1020,252,0
  200. 2950 DATA -256,-256,960,1023,252,0,0,16383,1023,-3841,-16321,0,3840,1008,255,0,3840,252,0,0
  201. 2960 DATA 0,0,-4033,-241,1020,4095,1020,255,0,-253,-256,960,-16129,-1,-1,-1,16380,-1,-3841,-4033
  202. 2970 DATA 0,16128,1008,255,0,3840,252,0,0,0,0,-4033,-253,1008,4095,252,-3841,0,-961,-256
  203. 2980 DATA 192,-16129,0,0,0,3840,-1,-16129,-241,0,-253,960,255,0,3840,252,0,0,0,0
  204. 2990 DATA -4033,-253,1008,4095,252,-193,768,-3841,-256,192,-16129,-1009,0,-256,4032,-1,255,-253,240,-193
  205. 3000 DATA 768,255,0,3840,252,0,0,0,0,-4033,-256,960,4095,252,-253,-1,255,-256,192,-16129
  206. 3010 DATA -253,-1,-1,768,-1,252,16128,-1,-3841,768,255,0,3840,252,0,0,0,0,-4033,-256
  207. 3020 DATA 960,4095,252,16128,-1,240,-256,192,-16129,0,0,0,0,-193,192,768,-1,255,768,255
  208. 3030 DATA 0,3840,252,0,0,0,0,0,0,0,0,0,768,-1,0,0,0,0,3840,-1
  209. 3040 DATA -16129,0,0,0,0,-193,240,0,0,0,0,0,0,0,0,0,0,0,0,0
  210. 3050 DATA 0,0,0,0,0,0,0,0,-193,240,0,0,0,0,0,0,0,0,0,0
  211.