home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Audio 4.94 - Over 11,000 Files
/
audio-11000.iso
/
msdos
/
music
/
chrstmas
/
chrstmas.bas
< prev
next >
Wrap
BASIC Source File
|
1987-05-06
|
13KB
|
276 lines
500 REM CHRISTMA.BAS
505 REM
510 REM Based on IBM DOS 2.0 supplementary program MUSIC.BAS
525 REM Plays Christmas music and draws a tree, instead.
530 REM
531 REM To get all features
535 REM (1) Use BASICA interpreter
540 REM (2) Use color/graphics adapter/monitor
543 REM
544 REM Suggested .BAT
545 REM ECHO OFF
548 REM CLS
550 REM BASICA <path>CHRISTMA
555 REM
560 REM Following the name of a song in the DATA section,
570 REM input for three new variables (S,TN,TD) is added.
575 REM These are normally set to 0,1,1. Reset S to change key,
580 REM or reset TN,TD to change tempo. See line 1545 and 1546.
585 REM
590 REM For faster loading, SAVE without the ,a switch
595 REM
600 REM HAVE A MERRY CHRISTMAS AND A HAPPY NEW YEAR
610 REM
910 DEFINT A-Z
920 DIM M(88),O(70)
975 DEF SEG: POKE 106,0
1000 CLS:KEY OFF:LOCATE 1,1,0:GOSUB 5000 'INTRODUCTORY BACKGROUND MUSIC
1010 KEY OFF:SCREEN 0,1:COLOR 15,0,0:WIDTH 40:CLS:LOCATE 5,19,0
1141 ON ERROR GOTO 1148
1142 PLAY "mf"
1143 GOTO 1149
1148 RESUME 1149
1149 ON ERROR GOTO 0
1150 SCREEN 0,1:WIDTH 40:COLOR 15,1,1:CLS
1160 LOCATE 15,1:PRINT " ------------- selections -------------"
1170 LOCATE 16,1:PRINT " A-Silent E-Deck The I-O Tanen "
1180 LOCATE 17,1:PRINT " B-Little Twn F-O Holy J-Away In A "
1190 LOCATE 18,1:PRINT " C-What Child G-Joy To The K-Drummer "
1191 LOCATE 19,1:PRINT " D-First Noel H-O Come All L-Rudolph "
1200 COLOR 15,0
1210 FOR I=0 TO 15:FOR J=0 TO 8
1220 LOCATE 5+J,5+I*2:PRINT CHR$(219);CHR$(221);
1230 NEXT:NEXT
1240 FOR I=0 TO 12:FOR J=0 TO 4
1250 IF I=2 OR I=6 OR I=9 OR I=13 THEN 1270
1260 LOCATE 5+J,8+I*2:PRINT CHR$(32);CHR$(222);
1270 NEXT:NEXT
1280 FOR J=0 TO 9
1290 LOCATE 4+J,4:COLOR 4,0:PRINT CHR$(221);:LOCATE 4+J,36:COLOR 15,0
1300 PRINT CHR$(221);:COLOR 4,1:PRINT CHR$(221);
1310 NEXT
1320 COLOR 4,1:LOCATE 4,4
1330 FOR I=0 TO 32:PRINT CHR$(219);:NEXT
1340 PRINT CHR$(221);:LOCATE 13,4
1350 FOR I=0 TO 32:PRINT CHR$(219);:NEXT
1360 PRINT CHR$(221);:COLOR 0,7
1370 FOR I=7 TO 88:M(I) = 36.8*(2^(1/12))^(I-6):NEXT
1380 FOR I=0 TO 6:M(I) = 32767:NEXT
1390 O(0) = 0
1400 O(39)=5:O(40)=7:O(41)=8:O(42)=9
1410 O(43)=10:O(44)=11:O(45)=13:O(46)=14
1420 O(47)=15:O(48)=16:O(49)=17:O(50)=18
1430 O(51)=19:O(52)=21:O(53)=22:O(54)=23
1440 O(55)=24:O(56)=25:O(57)=27:O(58)=28
1450 O(59)=29:O(60)=30:O(61)=31:O(62)=32
1460 O(63)=33:O(64)=35:O(65)=36:O(66)=37
1470 O(67)=38:O(68)=39:O(69)=40:O(70)=42
1480 GOTO 1630
1490 READ J,K
1500 CMD$ = INKEY$:IF CMD$="" THEN 1540
1510 IF CMD$=CHR$(27) THEN RETURN
1520 POKE 106,0
1530 REM
1540 IF J = -1 THEN RETURN
1545 IF J>0 THEN J=J+S
1546 K=(K*TN)/TD
1550 Q = O(J)
1560 IF J>64 OR J<39 THEN 1590
1570 IF SCREEN(5,Q)<>32 THEN COLOR 0,7:LOCATE 11,Q:PRINT CHR$(14);:COLOR 15,0:GOTO 1590
1580 COLOR 15,0:LOCATE 7,Q:PRINT CHR$(14);:COLOR 0,7
1590 SOUND M(J),K:IF J=0 AND K=1 THEN 1600:'SKIP NEXT FOR STACCATTO
1595 SOUND 32767,1
1600 IF J>64 OR J<39 THEN 1490
1610 IF SCREEN(5,Q) = 32 THEN COLOR 15,0:LOCATE 7,Q:PRINT CHR$(32);:GOTO 1490
1620 COLOR 15,0:LOCATE 11,Q:PRINT CHR$(219);:GOTO 1490
1630 LOCATE 21,5:PRINT " ";
1640 LOCATE 21,5:PRINT "ENTER SELECTION [or ESC] ==>";
1650 IF INKEY$ <> "" THEN 1650
1660 CMD$=INKEY$:IF CMD$="" THEN 1660
1670 IF CMD$=CHR$(27) THEN 1860
1680 IF CMD$="A" OR CMD$="a" THEN S$= "":RESTORE 4000:GOTO 1770
1690 IF CMD$="B" OR CMD$="b" THEN S$= "":RESTORE 4100:GOTO 1770
1700 IF CMD$="C" OR CMD$="c" THEN S$= "":RESTORE 3700:GOTO 1770
1710 IF CMD$="D" OR CMD$="d" THEN S$= "":RESTORE 4300:GOTO 1770
1720 IF CMD$="E" OR CMD$="e" THEN S$= "":RESTORE 3500:GOTO 1770
1730 IF CMD$="F" OR CMD$="f" THEN S$= "":RESTORE 3200:GOTO 1770
1740 IF CMD$="G" OR CMD$="g" THEN S$= "":RESTORE 3600:GOTO 1770
1750 IF CMD$="H" OR CMD$="h" THEN S$= "":RESTORE 3900:GOTO 1770
1755 IF CMD$="I" OR CMD$="i" THEN S$= "":RESTORE 4500:GOTO 1770
1757 IF CMD$="J" OR CMD$="j" THEN S$= "":RESTORE 3300:GOTO 1770
1761 IF CMD$="K" OR CMD$="k" THEN S$= "":RESTORE 4400:GOTO 1770
1765 IF CMD$="L" OR CMD$="l" THEN S$= "":RESTORE 4600:GOTO 1770
1769 GOTO 1640
1770 PRINT " ";CMD$
1780 READ D
1800 READ S$:LOCATE 23,1+(40.5-LEN(S$))/2
1805 COLOR 15,4:PRINT S$;:COLOR 0,7
1807 SOUND 21767,12:SOUND 32767,1:READ S,TN,TD
1810 GOSUB 1490
1820 S$=STRING$(39," "):LOCATE 23,1:COLOR 4,1:PRINT S$:COLOR 0,7
1830 GOTO 1630
1840 END
1860 SCREEN 0,1:COLOR 7,0,0:CLS:GOSUB 6000:GOSUB 7000:SYSTEM
3200 DATA -2,"O HOLY NIGHT",0,1,1
3210 DATA 0,24,45,12,45,9,45,3, 48,21,48,3,50,9,50,3,46,9,50,3
3215 DATA 53,24,48,6,0,3,48,3,45,9,43,3, 41,12,45,9,46,3,48,12,46,9,43,3
3220 DATA 41,36,0,12
3225 DATA 0,24,45,12,45,9,45,3, 48,21,48,3,50,9,50,3,46,9,50,3
3230 DATA 53,24,48,6,0,3,48,3,46,9,45,3, 52,12,48,9,50,3,52,12,55,1,53,9,52,3
3235 DATA 45,24,0,18,48,6
3240 DATA 48,12,50,12,43,12,48,12, 50,9,48,3,53,9,45,3,50,12,48,9,48,3
3245 DATA 48,12,50,12,43,12,48,12, 50,9,48,3,53,9,45,3,48,18,0,6
3250 DATA 53,36,52,9,50,3, 52,36,52,12, 55,33,50,3,50,9,50,3
3255 DATA 53,24,53,12,0,6,53,6, 57,42,48,6, 53,36,52,9,50,3
3260 DATA 48,24,48,9,48,3,50,9,48,3, 48,36,53,12, 55,36,0,6,48,6
3265 DATA 57,36,55,12, 53,24,52,12,53,9,55,3, 53,36
3270 DATA -1,-1
3300 DATA -2,"AWAY IN A MANGER",0,1,1
3310 DATA 52,12, 52,18,50,6,49,12, 49,12,47,12,45,12, 45,12,44,12,42,12
3320 DATA 40,24,40,12, 40,18,42,6,40,12, 40,12,47,12,44,12, 42,12,40,12,45,12
3330 DATA 49,24,52,12, 52,18,50,6,49,12, 49,12,47,12,45,12, 45,12,44,12,42,12
3340 DATA 40,24,40,12, 50,18,49,6,47,12, 49,12,47,12,45,12, 47,12,42,12,44,12
3350 DATA 45,36
3370 DATA -1,-1
3500 DATA -2,"DECK THE HALLS",0,1,1
3510 DATA 52,9,50,3,49,6,47,6, 45,6,47,6,49,6,45,6
3520 DATA 47,3,49,3,50,3,47,3,49,9,47,3, 45,6,44,6,45,12
3530 DATA 52,9,50,3,49,6,47,6, 45,6,47,6,49,6,45,6
3540 DATA 47,3,49,3,50,3,47,3,49,9,47,3, 45,6,44,6,45,12
3550 DATA 47,9,49,3,50,6,47,6, 49,9,50,3,52,6,47,6
3560 DATA 49,3,51,3,52,6,54,3,56,3,57,6, 56,6,54,6,52,12
3570 DATA 52,9,50,3,49,6,47,6, 45,6,47,6,49,6,45,6
3580 DATA 54,3,54,3,54,3,54,3,52,9,50,3, 49,6,47,6,45,12
3590 DATA -1,-1
3600 DATA -2,"JOY TO THE WORLD",0,1,1
3610 DATA 54,10,53,7,51,2, 49,15,47,5, 46,10,44,10, 42,15,49,5, 51,15,51,5
3620 DATA 53,15,53,5, 54,30,54,5, 54,5,53,5,51,5,49,5, 49,7,47,2,46,5,54,5
3630 DATA 54,5,53,5,51,5,49,5, 49,7,47,2,46,5,46,5, 46,5,46,5,46,5,46,2,47,2
3640 DATA 49,15,47,2,46,2, 44,5,44,5,44,5,44,2,46,2, 47,15,46,2,44,2
3650 DATA 42,5,54,10,51,5, 49,7,47,2,46,5,47,5, 46,10,44,10, 42,20
3670 DATA -1,-1
3700 DATA -2,"WHAT CHILD IS THIS? [GREENSLEEVES]",0,1,1
3710 DATA 44,10, 47,20,49,10,51,15,52,5,51,10, 49,20,46,10,42,15,44,5,46,10
3720 DATA 47,20,44,10,44,15,43,5,44,10, 46,30,39,20,44,10
3730 DATA 47,20,49,10,51,15,52,5,51,10, 49,20,46,10,42,15,44,5,46,10
3740 DATA 47,15,46,5,44,10,43,15,41,5,43,10, 44,30,44,30
3750 DATA 54,30,54,15,52,5,51,10, 49,20,46,10,42,15,44,5,46,10
3760 DATA 47,20,44,10,44,15,43,5,44,10, 46,20,42,10,39,30
3770 DATA 54,30,54,15,52,5,51,10, 49,20,46,10,42,15,44,5,46,10
3780 DATA 47,15,46,5,44,10,43,15,41,5,43,10, 44,30,44,30
3810 DATA -1,-1
3900 DATA -2,"O COME, ALL YE FAITHFUL",0,1,1
3910 DATA 49,8, 49,16,44,8,49,8, 51,16,44,16, 53,8,51,8,53,8,54,8
3920 DATA 53,16,51,8,49,8, 49,16,48,8,46,8, 48,8,49,8,51,8,53,8
3930 DATA 48,16,46,12,44,4, 44,32, 56,16,54,8,53,8
3940 DATA 54,16,53,16, 51,8,53,8,49,8,51,8, 48,12,46,4,44,8,49,8
3950 DATA 49,8,48,8,49,8,51,8, 49,16,44,8,53,8
3960 DATA 53,8,51,8,53,8,54,8, 53,16,51,8,53,8, 54,8,53,8,51,8,49,8
3970 DATA 48,16,49,8,54,8, 53,16,51,12,49,4, 49,24
3990 DATA -1,-1
4000 DATA -2,"SILENT NIGHT [STILLE NACHT] - GRUBER",0,1,1
4010 DATA 47,18,49,6,47,12,44,36, 47,18,49,6,47,12,44,36
4020 DATA 54,24,54,12,51,36, 52,24,52,12,47,36
4030 DATA 49,24,49,12,52,18,51,6,49,12, 47,18,49,6,47,12,44,24,0,12
4040 DATA 49,24,49,12,52,18,51,6,49,12, 47,18,49,6,47,12,44,24,0,12
4050 DATA 54,24,54,12,57,18,54,6,51,12, 52,36,56,24,0,12
4060 DATA 52,18,47,6,44,12,47,18,45,6,42,12, 40,72
4080 DATA -1,-1
4090 REM -- C, 6/8, 91.5 bpm
4100 DATA -2,"O LITTLE TOWN OF BETHLEHEM",0,1,1
4110 DATA 49,12, 49,12,49,12,48,12,49,12, 52,12,50,12,42,12,47,12
4120 DATA 45,12,44,6,45,6,47,12,40,12, 49,36,49,12, 49,12,49,12,54,12,52,12
4130 DATA 52,12,50,12,42,12,47,12, 45,12,44,6,45,6,49,12,47,12, 45,36
4140 DATA 49,12, 49,12,49,12,47,12,45,12, 44,24,44,12,44,12
4150 DATA 42,12,44,12,45,12,47,12, 49,36,49,12, 49,12,49,12,48,12,49,12
4160 DATA 52,12,50,12,42,12,54,12, 52,12,45,12,49,18,47,6, 45,36
4200 DATA -1,-1
4300 DATA -2,"THE FIRST NOEL",0,1,1
4310 DATA 46,5,44,5, 42,15,44,5,46,5,47,5, 49,20,51,5,53,5, 54,10,53,10,51,10
4320 DATA 49,20,51,5,53,5, 54,10,53,10,51,10, 49,10,51,10,53,10
4330 DATA 54,10,49,10,47,10, 46,20,46,5,44,5, 42,15,44,5,46,5,47,5
4340 DATA 49,20,51,5,53,5, 54,10,53,10,51,10, 49,20,51,5,53,5
4350 DATA 54,10,53,10,51,10, 49,10,51,10,53,10, 54,10,49,10,47,10
4360 DATA 46,20,46,5,44,5, 42,15,44,5,46,5,47,5, 49,20,54,5,53,5
4370 DATA 51,20,51,10, 49,30, 54,10,53,10,51,10, 49,10,51,10,53,10
4380 DATA 54,10, 49,10, 47,10, 46,20
4390 DATA -1,-1
4400 DATA -2,"THE LITTLE DRUMMER BOY tm",0,1,1
4410 DATA 45,18,47,6, 49,12,49,6,49,6, 50,3,49,3,50,6,49,30,0,6
4420 DATA 0,6,45,6,45,6,47,6, 49,6,49,6,49,6,49,6, 50,3,49,3,50,6,49,30,0,6
4430 DATA 0,6,47,6,49,6,50,6, 52,6,52,6,52,6,54,6
4440 DATA 52,3,50,3,49,6,47,30,0,6
4450 DATA 0,6,47,6,49,6,50,6, 52,6,52,6,52,6,54,6
4460 DATA 55,3,54,3,52,6,50,12, 54,3,52,3,50,6,49,12
4470 DATA 52,3,50,3,49,6,47,30,0,6, 45,18,47,6
4480 DATA 49,6,49,6,49,6,49,6,50,3,49,3,50,6,49,30,0,6,47,3,45,3,47,6,45,30,0
4490 DATA 6,-1,-1
4500 DATA -2,"O TANENBAUM",0,1,1
4510 DATA 40,12, 45,9,45,3,45,18,47,6, 49,9,49,3,49,18,49,6
4520 DATA 47,6,49,6,50,12,44,12, 47,12,45,12,0,6
4530 DATA 40,12, 45,9,45,3,45,18,47,6, 49,9,49,3,49,18,49,6
4540 DATA 47,6,49,6,50,12,44,12, 47,12,45,12,0,6
4550 DATA 52,6, 52,6,49,6,54,18,52,6, 52,6,50,6,50,18,50,6
4560 DATA 50,6,47,6,52,18,50,6, 50,6,49,6,49,12,0,6, 40,12
4570 DATA 45,9,45,3,45,18,47,6, 49,9,49,3,49,18,49,6
4580 DATA 47,6,49,6,50,12,44,12, 47,12,45,12
4590 DATA -1,-1
4600 DATA -2,"RUDOLPH, THE RED-NOSED REINDEER tm",0,1,1
4605 DATA 49,5,51,5, 52,5,49,10,45,5,51,5,47,10,44,5,49,5,45,10,42,5,49,5,47
4610 DATA 15,52,5,49,10,45,5,51,5,47,10,44,5, 49,5,45,10,42,5,49,5,47,15
4615 DATA 44,10,44,10,44,10,44,10, 49,30,49,5,51,5
4620 DATA 52,10,52,10,52,10,51,10,49,5, 47,40
4625 DATA 47,4,49,8,47,4,44,8,52,8, 49,8,47,24, 47,4,49,4,47,4,49,4,47,8,52,8
4630 DATA 51,32, 45,4,47,8,45,4,42,8,51,8, 49,8,47,24
4635 DATA 47,4,49,4,47,4,49,4,47,8,49,8,44,32
4640 DATA 47,4,49,8,47,4,44,8,52,8, 49,8,47,24, 47,4,49,4,47,4,49,4,47,8,52,8
4645 DATA 51,32, 45,4,47,8,45,4,42,8,51,8, 49,8,47,24
4650 DATA 47,4,49,4,47,4,49,4,47,8,54,8,52,32
4655 DATA 49,8,49,8,52,8,49,8, 47,8,44,8,47,16, 45,8,49,8,47,8,45,8, 44,32
4660 DATA 42,8,44,8,47,8,49,8, 51,8,51,8,51,16, 52,8,52,8,51,8,49,8
4665 DATA 47,8,45,4,42,20
4670 DATA 47,4,49,8,47,4,44,8,52,8, 49,8,47,24, 47,4,49,4,47,4,49,4,47,8,52,8
4675 DATA 51,32, 45,4,47,8,45,4,42,8,51,8, 49,8,47,24
4680 DATA 47,8,49,8,47,8,49,8,47,16,54,16,52,56
4695 DATA -1,-1
5000 REM -- "We Wish You a Merry Christmas" INTRODUCTION
5010 ON ERROR GOTO 5090
5020 SETUP$="MB O3 T136 L4"
5060 VERSE$="DGG8A8G8F+8EEEAA8B8A8G8F+DDBB8>C8<B8A8GED8D8EAF+G2"
5070 PLAY SETUP$+VERSE$
5080 GOTO 6070
5090 RESUME 5100
5100 PRINT "Use BASICA next time"
5110 FOR I=1 TO 1000 : NEXT I
5120 GOTO 6070
6000 REM -- exit flourish
6010 ON ERROR GOTO 5090
6020 VERSE$="DGGGF+2F+GF+ED2ABA8A8G8G8>D<DD8D8EAF+G2"
6060 PLAY SETUP$+VERSE$
6070 ON ERROR GOTO 0
6080 RETURN
7000 REM --- exit picture
7002 WIDTH 80 : CLS
7004 DEF SEG=0 : IF (PEEK(&H410) AND &H30)=&H30 THEN 7006
7005 DISPLAY$="color": SCREEN ,,1,0: COLOR 0,7: CLS: LOCATE 1,1,0: GOTO 7010
7006 DISPLAY$="mono" : LOCATE 10,12,0
7007 PRINT "You should ask Santa for a color display this Christmas."
7008 FOR I=1 TO 1000 : NEXT I
7010 STAR$=CHR$(15): TRUNK$=CHR$(219): LEAF$=CHR$(14): FILL$=CHR$(177)
7015 BOTR=24: BOTC=40: WIDE=20
7020 COLOR 6,0 : FOR J = 0 TO 2
7025 LOCATE BOTR-J,BOTC-1: FOR I=1 TO 3: PRINT TRUNK$;: NEXT I : NEXT J
7030 IF DISPLAY$="mono" THEN LOCATE 10,12,0: FOR I= 1 TO 60: PRINT " ";:NEXT I
7035 BOTR=BOTR-3
7040 FOR I=BOTR TO 2 STEP -1
7045 LOCATE I,BOTC-WIDE
7048 COLOR 4,7 : PRINT LEAF$;
7050 COLOR 2,0 : FOR J=2*WIDE-2 TO 0 STEP -1:PRINT FILL$;:NEXT J
7052 COLOR 4,7 : PRINT LEAF$;
7055 WIDE=WIDE-1: NEXT I
7060 LOCATE 1,BOTC: COLOR 31,7 : PRINT STAR$;
7065 LOCATE 1,1,0 : COLOR ,,7 : IF DISPLAY$="color" THEN SCREEN ,,1,1
7070 CMD$=INKEY$: IF CMD$="" THEN 7070
7072 IF DISPLAY$="color" THEN SCREEN ,,0,0 : COLOR 7,0,0
7075 RETURN