10 ' Program: SOUNDEMO.BAS (Sound Demonstration Program)
20 ' Contributed to PC-SIG on 5 November, 1983
30 ' Written by John Walkenbach
40 '            1425 NW Highland
50 '            Corvallis, OR 97330
60 '
70 COLOR 7,0
80 KEY OFF
90 GOSUB 1280 'set up function keys
100 CLS
110 R1=6:C1=1:R2=23:C2=80:CLERE$="off":GOSUB 1380
120 R1=1:C1=1:R2=5:C2=80
130 GOSUB 1380
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"
150 FOR I=1 TO LEN(T$)
160 PRINT MID$(T$,I,1);
170 IF MID$(T$,I,1) <> " " THEN SOUND 300,.002
180 SOUND 100,0
190 FOR J=1 TO 30:NEXT
200 NEXT I
210 R1=10:C1=23:R2=19:C2=55:CLERE$="off":GOSUB 1380
220 LOCATE 11,28:PRINT"f1  ---";CHR$(16);" Random noise.":SOUND 600,.002
230 LOCATE 12,28:PRINT"f2  ---";CHR$(16);" Parakeet.":SOUND 700,.002
240 LOCATE 13,28:PRINT"f3  ---";CHR$(16);" Siren.":SOUND 800,.002
250 LOCATE 14,28:PRINT"f4  ---";CHR$(16);" Falling.":SOUND 900,.002
260 LOCATE 15,28:PRINT"f5  ---";CHR$(16);" Telephone.":SOUND 1000,.002
270 LOCATE 16,28:PRINT"f6  ---";CHR$(16);" Spaceship.":SOUND 1100,.002
280 LOCATE 17,28:PRINT"f7  ---";CHR$(16);" Clock.":SOUND 1200,.002
290 LOCATE 18,28:PRINT"f8  ---";CHR$(16);" Exit the program." :SOUND 1300,.002
300 LOCATE 25,1:COLOR 0,7:PRINT"";:COLOR 7
310 SOUND 5000,.5
320 GOTO 320
330 END
340 GOSUB 1690:LOCATE 11,37:COLOR 0,7:PRINT"Random noise.";:COLOR 7,0
350 GOSUB 1700
360 RANDOMIZE TIMER
370 FOR I=1 TO 90
380 IF INT(RND*2)=1 THEN 400
390 SOUND 100,0:SOUND RND*8000+440,100
400 SOUND 100,0:SOUND RND*3000+50,100
410 FOR K=1 TO INT(RND*100)+1:NEXT
420 NEXT I
430 SOUND 100,0
440 LOCATE 11,37:PRINT"Random noise.";
450 GOSUB 1710
460 GOSUB 1280:RETURN
470 GOSUB 1690:LOCATE 12,37:COLOR 0,7:PRINT"Parakeet.";:COLOR 7,0
480 GOSUB 1700
490 FOR J=1 TO 25
500 IF J=5 OR J=15 THEN FOR T=1 TO 200:NEXT
510 FOR I=9000 TO 3500 STEP -250
520 SOUND I,.125625
530 NEXT I:NEXT J
540 LOCATE 12,37:PRINT "Parakeet.";
550 GOSUB 1710
560 GOSUB 1280:RETURN
570 GOSUB 1690:LOCATE 13,37:COLOR 0,7:PRINT"Siren.";:COLOR 7,0
580 GOSUB 1700
590 FOR T=1 TO 2
600 FOR L=650 TO -650 STEP -4
610 SOUND 780-ABS(L),.3
620 L=L-2/650
630 NEXT L
640 NEXT T
650 LOCATE 13,37:PRINT"Siren.";
660 GOSUB 1710
670 GOSUB 1280:RETURN
680 GOSUB 1690:LOCATE 14,37:COLOR 0,7:PRINT"Falling.";:COLOR 7,0
690 GOSUB 1700
700 FOR K=4500 TO 400  STEP -20
710 SOUND K,K/4000
720 NEXT K
730 LOCATE 14,37:PRINT"Falling.";
740 GOSUB 1710
750 GOSUB 1280:RETURN
760 GOSUB 1690:LOCATE 15,37:COLOR 0,7:PRINT"Telephone.";:COLOR 7,0
770 GOSUB 1700
780 FOR R=1 TO 4
790 IF R=2 THEN LOCATE 25,50:PRINT"Answer the damn phone!";
800 FOR J=1 TO 80
810 IF J MOD 2 = 0 THEN SOUND 500,1
820 IF J MOD 2 <> 0 THEN SOUND 1500,1
830 FOR I=1 TO 10:NEXT
840 SOUND 100,0
850 IF R=4 AND J=40 THEN GOTO 890
860 NEXT J
870 FOR K=1 TO 2000:NEXT
880 NEXT R
890 LOCATE 25,50:PRINT"Hello...who is it??   ";
900 LOCATE 15,37:PRINT "Telephone.";
910 GOSUB 1710
920 GOSUB 1280
930 FOR T=1 TO 500:NEXT T:LOCATE 25,50:PRINT SPC(29);
940 RETURN
950 GOSUB 1690:LOCATE 16,37:COLOR 0,7:PRINT"Spaceship.";:COLOR 7,0
960 GOSUB 1700
970 FOR A=100 TO 3000 STEP 12
980 B=A+20
990 FOR L=A  TO B STEP 2
1000 SOUND L,.002
1010 NEXT L
1020 NEXT A
1030 FOR I=1 TO 8
1040 FOR A=4000 TO 50  STEP -100
1050 SOUND A,.002
1060 NEXT A
1070 NEXT I
1080 SOUND 100,0
1090 LOCATE 16,37:PRINT "Spaceship.";
1100 GOSUB 1710
1110 GOSUB 1280:RETURN
1120 GOSUB 1690:LOCATE 17,37:COLOR 0,7:PRINT"Clock.";:COLOR 7,0
1130 GOSUB 1700
1140 FOR TICK =1 TO 12
1150 FOR J=1 TO 400:NEXT J
1160 LOCATE 25,72:PRINT TIME$;
1170 SOUND 2000,.5
1180 FOR J=1 TO 400:NEXT J
1190 SOUND 1500,.5
1200 NEXT TICK
1210 SOUND 100,1000
1220 LOCATE 25,72:PRINT "WAKE UP!";
1230 FOR T=1 TO 4000:NEXT:SOUND 100,0:LOCATE 25,72:PRINT"        ";
1240 LOCATE 17,37:PRINT "Clock.";
1250 GOSUB 1710
1260 GOSUB 1280:RETURN
1270 COLOR 7,0:CLS:KEY ON:END
1280 FOR I=1 TO 8:KEY (I) ON:NEXT I
1290 ON KEY (1) GOSUB 340
1300 ON KEY (2) GOSUB 470
1310 ON KEY (3) GOSUB 570
1320 ON KEY (4) GOSUB 680
1330 ON KEY (5) GOSUB 760
1340 ON KEY (6) GOSUB 950
1350 ON KEY (7) GOSUB 1120
1360 ON KEY (8) GOSUB 1270
1370 RETURN
1380 'this subroutine draws a box on the screen.  Input is two sets of
1390 'coordinates: R1,C1 and R2,C2 (for row and column of upper-left
1400 'corner and lower-right corner, respectively).
1410 IF R1> 0 AND R1 < 25 AND C1 >0 AND C1<81 THEN 1420    ELSE 1430
1420 IF R10 AND R2 <25 AND C2>0 AND C2<81  THEN 1450
1430 PRINT"error in input parameters.":RETURN
1440 'upper left corner
1450 IF CLERE$<>"off" THEN CLS
1460 LOCATE R1,C1
1470 PRINT CHR$(201);
1480 ' top line
1490 FOR I=1 TO(C2-C1-1):PRINT CHR$(205);:NEXT
1500 'upper right corner
1510 LOCATE R1,C2:PRINT CHR$(187);
1520 'right side
1530 FOR K=1 TO (R2-R1-1)
1540 LOCATE R1+K,C2
1550 PRINT CHR$(186);
1560 NEXT K
1570 'lower right corner
1580 LOCATE R2,C2:PRINT CHR$(188);
1590 'left side
1600 FOR K=1 TO (R2-R1-1)
1610 LOCATE R1+K,C1
1620 PRINT CHR$(186);
1630 NEXT K
1640 'lower left corner
1650 LOCATE R2,C1:PRINT CHR$(200);
1660 'bottom line
1670 FOR I=1 TO (C2-C1-1):PRINT CHR$(205);:NEXT
1680 RETURN
1690 FOR J=1 TO 10: KEY(J) OFF:NEXT:RETURN
1700 LOCATE 25,1:PRINT"                           ";:RETURN
1710 LOCATE 25,1:COLOR 0,7:PRINT"";:COLOR 7,0:RETURN