10REM Program Twelve Days Of Christma s 20REM Version B 0.4 30REM Author Douglas Nunn 40REM BEEBUG December 1992 50REM Program subject to Copyright 60: 70REMISS OF ME NOT TO WISH EVERYONE A VERY MERRY XMAS AND A HAPPY NEW YEAR 80: 90REMARKABLY WELL PUT - Ed. 100: 110MODE 7:ON ERROR ON ERROR OFF:MODE7: REPORT:PRINT" at line ";ERL:END 120PROCstart 130PROCmusic 140VDU28,0,24,39,0 150VDU23;11,255,0;0;0; 160END 170: 1000DEF PROCstart 1010PROCinit 1020PROCdata 1030PROCfrontpage 1040VDU23;11,0,0;0;0; 1050ENDPROC 1060: 1070DEF PROCinit 1080DIM A$(10),S$(2),P$(11) 1090Z%=4:WIDTH0 1100FOR E%=6TO8:REPEAT UNTIL ADVAL(-E%) =15:NEXT 1110ENDPROC 1120: 1130DEF PROCdata 1140FOR E%=0TO10:READS$:A$(E%)=S$+","+C HR$10+CHR$13:NEXT 1150A$(3)="Five"+CHR$131+"gold"+CHR$135 +"rings,"+CHR$10+CHR$13 1160FOR E%=0TO11:READ P$(E%):NEXT 1170T%=139 1180ENDPROC 1190: 1200DEF PROCfrontpage 1210FORI%=0TO1:PRINTTAB(0,I%);:VDU129,1 57,130,141:PRINTTAB(8,I%);"Twelve Days o f Christmas";:NEXT I%:VDU28,2,24,39,2 1220REPEAT:CLS:INPUT'"Enter volume ( 1= soft : 15=loud )"V%:UNTIL V%<16 AND V%>0 :CLS 1230ENDPROC 1240: 1250DEF PROCmusic 1260FOR D%=1TO12 1270IF D%=12THEN PROCtwelve:GOTO1310 1280PROCfirst:IF D%=1THEN1330 1290IF D%<5 PROCplay("@-","7-","$-"):FO R E%=D%TO2STEP-1:PROCunder5:PRINTA$(E%-2 );:NEXT:PROCplay("@-",";-","7-"):GOTO133 0 1300PROCplay("@-","7-","$-") 1310IF D%>5 THEN FOR E%=D%TO6STEP-1:PRO Cover5:NEXT 1320PROCfive 1330IF D%=12 PROCplay("@-C-H-H-H!","4-< -@-@-@!","+-(-$-$-$!"):PRINT'TAB(14)"< T HE END "; ELSE PROClast:IF (D%+1)MOD3=0 PROCplay("<-<-","6-6-",",-,-"):T%=T%-4 E LSE PROCplay("<-<-","4-4-","$-$-") 1340NEXT D% 1350ENDPROC 1360: 1370DEF PROCtwelve 1380Z%=8:PROCplay(" -7!7!7-7-<!<!"," -7 !5!4-5-4-7-"," - - - -2-0-/-"):PRINT''"O n the"CHR$129P$(D%-1)CHR$135"day of Chri stmas"'" my true love gave to me," 1390PROCplay("<-<!<-||<!","<-;-9-||7-", "--+-)-||(-") 1400Z%=Z%/2:PROCplay(">->-@-@-A-A->->-" ,"9-;-9-7-8-:-8-6-",")-+-)-(-)-+-,-.-"): Z%=Z%*3:PROCplay("@-@-@-@-@-@-@-@-","7-; -9-<-6-6-6-6-","0!0-0---&-&-&-&-") 1410PROCplay(" -"," -"," -"):Z%=2 1420ENDPROC 1430: 1440DEFPROCfirst 1450PROCplay("7!7!7-7-"," - -4-4-"," - -$-$-") 1460PRINT''"On the"CHR$(129+D%MOD6)P$(D %-1)CHR$135"day of Christmas"'" my true love gave to me," 1470PROCplay("<!<!<-<!<!<!>-@-A->-@-@-@ -"," - -4-4- -;-9-9- -5-7-7-7-"," - -$-$ - - -$-$- -+-$-$-$-") 1480ENDPROC 1490: 1500DEFPROClast 1510PROCplay("A-C-C-E-",";-<-;-9-","&-( -(-)-") 1520IFD%-1PRINT"and "; 1530PRINT"a partridge in a pear tree." 1540PROCplay("A-@-<->->-<-<-<-<-",">-<- 7-7-5-4-4-4-4-",")-+-+-+-+-$-$-$-$-") 1550ENDPROC 1560: 1570DEFPROCunder5 1580PROCplay("C-C->-@-A-A-","<-<->-<-;- ;-","(-(-)-)-+-+-") 1590ENDPROC 1600: 1610DEFPROCfive 1620IFD%=12 THEN Z%=4 1630PROCplay("C-C-C-C-E-",";-;-;-;-9-", "(-(-(-(-&-"):PRINTA$(3);:PROCplay("B-B- B-C-C-C-C-C-C-C-C-","6->-<-;-9-;-<->-<-; -9-","&-&-&-+-&-+---/---+-)-") 1640IF D%=12 THEN Z%=6 1650PROCplay("C-A-@->-<-<-",";-;-7-;-9- 9-","(-(-(-(-----"):PRINTA$(2);:PROCplay ("A-A-9-9-<-<-"," - -5-5-7-7-"," - -&-&- (-(-"):PRINTA$(1);:IF D%=12 GOTO1670 ELS E PROCplay(">-<-;-9-7-","6-4-2-0-/-","*- *-&-&-+!"):PRINTA$(0);:PROCplay("7-@-"," 2-7-","+-+-") 1660ENDPROC 1670PROCplay(">-<-;-9-7-","2-7-7-0-/-", "&-'-(-*-+!"):PRINTA$(0);:PROCplay(" -@- A-C-C-E-A-"," -7-9-:!:-9-<-","+-+-)-(-(- )-&-") 1680PRINT"and a partridge in a pear tre e." 1690PROCplay("@-<->->-<-<-<-<-<!","7-9- ;-5-4-4-4-4-4-4!","+-+!+-+-$-$-$-$-$!") 1700ENDPROC 1710: 1720DEFPROCover5 1730PROCplay("C-C->-@-A-","<-9-9-:-;-", "(-)-)-*-+-"):PRINTA$(E%-2);:PROCplay("> -",";!","+-") 1740ENDPROC 1750: 1760DEFPROCplay(S$(0),S$(1),S$(2)) 1770LOCAL E%,F%,N%,P%,Q%,N%,V 1780FOR E%=1TOLENS$(0)STEP2 1790FOR F%=0TO2 1800P%=ASC(MID$(S$(F%),E%)):Q%=ASC(MID$ (S$(F%),E%+1)) 1810N%=4*P%-T%:V=V%*(P%<>32) 1820IF Q%=ASC"|" SOUND1+F%,0,0,1:GOTO18 40 1830IF Q%=ASC"-" SOUND1+F%,V,N%,Z% ELSE SOUND1+F%,V,N%,Z%-1:SOUND1+F%,0,0,1 1840NEXT F%:NEXT E% 1850ENDPROC 1860: 1870DATATwo turtle doves,Three french h ens,Four calling birds,!,Six geese a-lay ing,Seven swans a-swimming,Eight maids a -milking,Nine ladies dancing,Ten lords a -leaping,Eleven pipers piping,Twelve dru mmers drumming 1880DATAfirst,second,third,fourth,fifth ,sixth,seventh,eighth,ninth,tenth,eleven th,twelfth