home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / basic / library / gwbasic / spiele / soundemo.bas < prev    next >
Encoding:
BASIC Source File  |  1991-05-15  |  5.3 KB  |  172 lines
  1. 10 ' Program: SOUNDEMO.BAS (Sound Demonstration Program)
  2. 20 ' Contributed to PC-SIG on 5 November, 1983
  3. 30 ' Written by John Walkenbach
  4. 40 '            1425 NW Highland
  5. 50 '            Corvallis, OR 97330
  6. 60 '
  7. 70 COLOR 7,0
  8. 80 KEY OFF
  9. 90 GOSUB 1280 'set up function keys
  10. 100 CLS
  11. 110 R1=6:C1=1:R2=23:C2=80:CLERE$="off":GOSUB 1380
  12. 120 R1=1:C1=1:R2=5:C2=80
  13. 130 GOSUB 1380
  14. 140 LOCATE 3,14:T$= "S O U N D   D E M O N S T R A T I O N   P R O G R A M"
  15. 150 FOR I=1 TO LEN(T$)
  16. 160 PRINT MID$(T$,I,1);
  17. 170 IF MID$(T$,I,1) <> " " THEN SOUND 300,.002
  18. 180 SOUND 100,0
  19. 190 FOR J=1 TO 30:NEXT
  20. 200 NEXT I
  21. 210 R1=10:C1=23:R2=19:C2=55:CLERE$="off":GOSUB 1380
  22. 220 LOCATE 11,28:PRINT"f1  ---";CHR$(16);" Random noise.":SOUND 600,.002
  23. 230 LOCATE 12,28:PRINT"f2  ---";CHR$(16);" Parakeet.":SOUND 700,.002
  24. 240 LOCATE 13,28:PRINT"f3  ---";CHR$(16);" Siren.":SOUND 800,.002
  25. 250 LOCATE 14,28:PRINT"f4  ---";CHR$(16);" Falling.":SOUND 900,.002
  26. 260 LOCATE 15,28:PRINT"f5  ---";CHR$(16);" Telephone.":SOUND 1000,.002
  27. 270 LOCATE 16,28:PRINT"f6  ---";CHR$(16);" Spaceship.":SOUND 1100,.002
  28. 280 LOCATE 17,28:PRINT"f7  ---";CHR$(16);" Clock.":SOUND 1200,.002
  29. 290 LOCATE 18,28:PRINT"f8  ---";CHR$(16);" Exit the program." :SOUND 1300,.002
  30. 300 LOCATE 25,1:COLOR 0,7:PRINT"<Press a function key...>";:COLOR 7
  31. 310 SOUND 5000,.5
  32. 320 GOTO 320
  33. 330 END
  34. 340 GOSUB 1690:LOCATE 11,37:COLOR 0,7:PRINT"Random noise.";:COLOR 7,0
  35. 350 GOSUB 1700
  36. 360 RANDOMIZE TIMER
  37. 370 FOR I=1 TO 90
  38. 380 IF INT(RND*2)=1 THEN 400
  39. 390 SOUND 100,0:SOUND RND*8000+440,100
  40. 400 SOUND 100,0:SOUND RND*3000+50,100
  41. 410 FOR K=1 TO INT(RND*100)+1:NEXT
  42. 420 NEXT I
  43. 430 SOUND 100,0
  44. 440 LOCATE 11,37:PRINT"Random noise.";
  45. 450 GOSUB 1710
  46. 460 GOSUB 1280:RETURN
  47. 470 GOSUB 1690:LOCATE 12,37:COLOR 0,7:PRINT"Parakeet.";:COLOR 7,0
  48. 480 GOSUB 1700
  49. 490 FOR J=1 TO 25
  50. 500 IF J=5 OR J=15 THEN FOR T=1 TO 200:NEXT
  51. 510 FOR I=9000 TO 3500 STEP -250
  52. 520 SOUND I,.125625
  53. 530 NEXT I:NEXT J
  54. 540 LOCATE 12,37:PRINT "Parakeet.";
  55. 550 GOSUB 1710
  56. 560 GOSUB 1280:RETURN
  57. 570 GOSUB 1690:LOCATE 13,37:COLOR 0,7:PRINT"Siren.";:COLOR 7,0
  58. 580 GOSUB 1700
  59. 590 FOR T=1 TO 2
  60. 600 FOR L=650 TO -650 STEP -4
  61. 610 SOUND 780-ABS(L),.3
  62. 620 L=L-2/650
  63. 630 NEXT L
  64. 640 NEXT T
  65. 650 LOCATE 13,37:PRINT"Siren.";
  66. 660 GOSUB 1710
  67. 670 GOSUB 1280:RETURN
  68. 680 GOSUB 1690:LOCATE 14,37:COLOR 0,7:PRINT"Falling.";:COLOR 7,0
  69. 690 GOSUB 1700
  70. 700 FOR K=4500 TO 400  STEP -20
  71. 710 SOUND K,K/4000
  72. 720 NEXT K
  73. 730 LOCATE 14,37:PRINT"Falling.";
  74. 740 GOSUB 1710
  75. 750 GOSUB 1280:RETURN
  76. 760 GOSUB 1690:LOCATE 15,37:COLOR 0,7:PRINT"Telephone.";:COLOR 7,0
  77. 770 GOSUB 1700
  78. 780 FOR R=1 TO 4
  79. 790 IF R=2 THEN LOCATE 25,50:PRINT"Answer the damn phone!";
  80. 800 FOR J=1 TO 80
  81. 810 IF J MOD 2 = 0 THEN SOUND 500,1
  82. 820 IF J MOD 2 <> 0 THEN SOUND 1500,1
  83. 830 FOR I=1 TO 10:NEXT
  84. 840 SOUND 100,0
  85. 850 IF R=4 AND J=40 THEN GOTO 890
  86. 860 NEXT J
  87. 870 FOR K=1 TO 2000:NEXT
  88. 880 NEXT R
  89. 890 LOCATE 25,50:PRINT"Hello...who is it??   ";
  90. 900 LOCATE 15,37:PRINT "Telephone.";
  91. 910 GOSUB 1710
  92. 920 GOSUB 1280
  93. 930 FOR T=1 TO 500:NEXT T:LOCATE 25,50:PRINT SPC(29);
  94. 940 RETURN
  95. 950 GOSUB 1690:LOCATE 16,37:COLOR 0,7:PRINT"Spaceship.";:COLOR 7,0
  96. 960 GOSUB 1700
  97. 970 FOR A=100 TO 3000 STEP 12
  98. 980 B=A+20
  99. 990 FOR L=A  TO B STEP 2
  100. 1000 SOUND L,.002
  101. 1010 NEXT L
  102. 1020 NEXT A
  103. 1030 FOR I=1 TO 8
  104. 1040 FOR A=4000 TO 50  STEP -100
  105. 1050 SOUND A,.002
  106. 1060 NEXT A
  107. 1070 NEXT I
  108. 1080 SOUND 100,0
  109. 1090 LOCATE 16,37:PRINT "Spaceship.";
  110. 1100 GOSUB 1710
  111. 1110 GOSUB 1280:RETURN
  112. 1120 GOSUB 1690:LOCATE 17,37:COLOR 0,7:PRINT"Clock.";:COLOR 7,0
  113. 1130 GOSUB 1700
  114. 1140 FOR TICK =1 TO 12
  115. 1150 FOR J=1 TO 400:NEXT J
  116. 1160 LOCATE 25,72:PRINT TIME$;
  117. 1170 SOUND 2000,.5
  118. 1180 FOR J=1 TO 400:NEXT J
  119. 1190 SOUND 1500,.5
  120. 1200 NEXT TICK
  121. 1210 SOUND 100,1000
  122. 1220 LOCATE 25,72:PRINT "WAKE UP!";
  123. 1230 FOR T=1 TO 4000:NEXT:SOUND 100,0:LOCATE 25,72:PRINT"        ";
  124. 1240 LOCATE 17,37:PRINT "Clock.";
  125. 1250 GOSUB 1710
  126. 1260 GOSUB 1280:RETURN
  127. 1270 COLOR 7,0:CLS:KEY ON:END
  128. 1280 FOR I=1 TO 8:KEY (I) ON:NEXT I
  129. 1290 ON KEY (1) GOSUB 340
  130. 1300 ON KEY (2) GOSUB 470
  131. 1310 ON KEY (3) GOSUB 570
  132. 1320 ON KEY (4) GOSUB 680
  133. 1330 ON KEY (5) GOSUB 760
  134. 1340 ON KEY (6) GOSUB 950
  135. 1350 ON KEY (7) GOSUB 1120
  136. 1360 ON KEY (8) GOSUB 1270
  137. 1370 RETURN
  138. 1380 'this subroutine draws a box on the screen.  Input is two sets of
  139. 1390 'coordinates: R1,C1 and R2,C2 (for row and column of upper-left
  140. 1400 'corner and lower-right corner, respectively).
  141. 1410 IF R1> 0 AND R1 < 25 AND C1 >0 AND C1<81 THEN 1420    ELSE 1430
  142. 1420 IF R1<R2 AND C1<C2 AND R2>0 AND R2 <25 AND C2>0 AND C2<81  THEN 1450
  143. 1430 PRINT"error in input parameters.":RETURN
  144. 1440 'upper left corner
  145. 1450 IF CLERE$<>"off" THEN CLS
  146. 1460 LOCATE R1,C1
  147. 1470 PRINT CHR$(201);
  148. 1480 ' top line
  149. 1490 FOR I=1 TO(C2-C1-1):PRINT CHR$(205);:NEXT
  150. 1500 'upper right corner
  151. 1510 LOCATE R1,C2:PRINT CHR$(187);
  152. 1520 'right side
  153. 1530 FOR K=1 TO (R2-R1-1)
  154. 1540 LOCATE R1+K,C2
  155. 1550 PRINT CHR$(186);
  156. 1560 NEXT K
  157. 1570 'lower right corner
  158. 1580 LOCATE R2,C2:PRINT CHR$(188);
  159. 1590 'left side
  160. 1600 FOR K=1 TO (R2-R1-1)
  161. 1610 LOCATE R1+K,C1
  162. 1620 PRINT CHR$(186);
  163. 1630 NEXT K
  164. 1640 'lower left corner
  165. 1650 LOCATE R2,C1:PRINT CHR$(200);
  166. 1660 'bottom line
  167. 1670 FOR I=1 TO (C2-C1-1):PRINT CHR$(205);:NEXT
  168. 1680 RETURN
  169. 1690 FOR J=1 TO 10: KEY(J) OFF:NEXT:RETURN
  170. 1700 LOCATE 25,1:PRINT"                           ";:RETURN
  171. 1710 LOCATE 25,1:COLOR 0,7:PRINT"<Press a function key...>";:COLOR 7,0:RETURN
  172.