Christmas Carol

[DDRM]

BBC BASIC has good built-in musical possibilities. Write a program to play a Christmas carol! Bonus points for polyphony, and / or showing the text at the same time, or for using the ENVELOPE statement to customise the sound.
Using *PLAY midifile.mid is cheating, but sending generated notes to a midi interface is allowed!

[DDRM]

Code: Select all

      *TEMPO 135 :REM Set channel 0 for music
      DIM m$(3,3) :REM 4 lines x 4 voices

      m$(0,0)="D8O2cffD4gaD8ffD4a%bD8O3ccdD16O2%b"
      m$(0,1)="D8O2cccD4deD8fcD4fgD8aaaD16g"
      m$(0,2)="D4O2cO1%bD8aaD4%bO2cD8O1aaO2cD12fD4dD8edc"
      m$(0,3)="D4O1agD8fffffffffD16f"

      m$(1,0)="O2D4gaD8%b%bO3cO2aaD4faD8gdfD16e"
      m$(1,1)="O2D8dD4gagfD8gfcfD12dD4cD8dD16c"
      m$(1,2)="O1D4%baD8gO2cO1gO2ccdO1babO2D16c"
      m$(1,3)="O1D8feeefedgggD16c"

      m$(2,0)="O2D8cffD4gaD8ffD4a%bD8O3ccdD16O2%b"
      m$(2,1)="O2D8cD12cD4cdefdD8cD4fga%bagfeD16d"
      m$(2,2)="O2DcD4cO1%bD8aD4%bO2cO1a%bO2cdedD8cD4O1fgD8aD4%bO2cdc"
      m$(2,3)="O2D4cO1%bagfedcfga%bO2cO1%bagfedfga%ba"

      m$(3,0)="O2D4gaD8%b%bO3cO2aaD4faD8gdeD16f"
      m$(3,1)="O2D8dD4gfgefgagfeD8dD4dcD8dD4cO1%bD16a"
      m$(3,2)="O1D4%baD8gO2cO1gO2ccO1aO2dD4cO1%bagD16f"
      m$(3,3)="O1D4gfedecdefgD8aD4dcD8O0%bgO1cO0D16f"

      DIM words$(3,2)  :REM 4 lines in each of 3 verses
      words$(0,0)="Away in a manger, no crib for a bed,"
      words$(1,0)="The little Lord Jesus laid down his sweet head."
      words$(2,0)="The stars in the bright sky looked down where he lay,"
      words$(3,0)="The little Lord Jesus, asleep on the hay."

      words$(0,1)="The cattle are lowing, the baby awakes,"
      words$(1,1)="But little Lord Jesus no crying he makes."
      words$(2,1)="I love thee Lord Jesus! Look down from the sky,"
      words$(3,1)="And stay by my side until morning is nigh."

      words$(0,2)="Be near me, Lord Jesus; I ask thee to stay"
      words$(1,2)="Close by me for ever, and love me, I pray."
      words$(2,2)="Bless all the dear children in thy tender care,"
      words$(3,2)="And fit us for heaven, to live with thee there."

      ENVELOPE 1, 2,0,0,0,0,0,0,50,-5,-1,-10,100,90
      ENVELOPE 2, 2,0,0,0,100,100,100,40,-5,-1,-10,80,70

      FOR verse%=0 TO 2
        IF verse%=1 THEN V$="V-1" ELSE V$="V-2"    :REM Use envelopes 1 or 2
  
        FOR line%=0 TO 3
          t%=FALSE
          t2%=FALSE
          t3%=FALSE
          t4%=FALSE
          PRINT words$(line%,verse%)
          REPEAT
            IF NOT t% THEN t%= FNplay(V$+m$(line%,0),1)
            IF NOT t2% THEN t2%= FNplay(V$+m$(line%,1),2)
            IF NOT t3% THEN t3%= FNplay(V$+m$(line%,2),3)
            IF NOT t4% THEN t4%= FNplay(V$+m$(line%,3),0)
          UNTIL t% AND t2% AND t3% AND t4%
          REPEAT
            WAIT 1
          UNTIL ADVAL(-5) = 16 AND  ADVAL(-6) = 16 ANDADVAL(-7) = 16 ANDADVAL(-8) = 16
        NEXT line%
        WAIT 100
        PRINT
      NEXT verse%
      END
      :
      DEFFNplay(m$,channel%)
      REM Routine to read in musical notes and play them
      REM Designed to be called repeatedly (e.g. in a "game loop"), to top up the buffers as needed,
      REM So something else can be happening in the program most of the time.

      REM Note names indicated by lower case letter. Note each octave runs c - b, not a - g!
      REM sharps indicated by preceding note by #, flats by preceding with %
      REM To set duration use D followed by 1-99. Feels about right with crotchet = 8
      REM to set volume, use V followed by 0 to 15
      REM To set octave, use O followed by 0 TO 5 (only c and d in octave 5)
      PRIVATE flag%,n%,acc%,amp%(),dur%(),c$,x%(),oct%(),notes%()
      IF flag%=0 THEN
        flag%=1
        DIM x%(3),dur%(3),amp%(3),oct%(3),notes%(6)
        notes%()=4,12,20,24,32,40,48
        dur%()=2
        amp%()=8
        x%()=1
        oct%()=3
      ENDIF
      LOCAL finished%
      finished%=FALSE
      IF m$="F" THEN SOUND channel%+&10,0,4,1:x%(channel%)=1:finished%=TRUE:=finished%
      acc%=0
      WHILE ADVAL(-5-channel%)>7
        c$=MID$(m$,x%(channel%),1)
        CASE c$ OF
          WHEN "#":acc%=4
          WHEN "%":acc%=-4
          WHEN "O":
            oct%(channel%)=VAL(MID$(m$,x%(channel%)+1,1))
            x%(channel%)+=1
          WHEN "D":
            dur%(channel%)=VAL(MID$(m$,x%(channel%)+1))
            x%(channel%)+=1
            IF dur%(channel%)>9 THEN x%(channel%)+=1
          WHEN "C":
            channel%=VAL(MID$(m$,x%(channel%)+1,1))
            x%(channel%)+=1
          WHEN "V":
            amp%(channel%)=VAL(MID$(m$,x%(channel%)+1))
            x%(channel%)+=1
            IF amp%(channel%)>9 THEN x%(channel%)+=1
          WHEN "a","b"
            n%=5 +ASC(c$)-ASC("a")
            SOUND channel%,amp%(channel%)*-1,notes%(n%)+acc%+48*oct%(channel%),dur%(channel%)
            acc%=0
          WHEN "c","d","e","f","g"
            n%= ASC(c$)-ASC("c")
            SOUND channel%,amp%(channel%)*-1,notes%(n%)+acc%+48*oct%(channel%),dur%(channel%)
            acc%=0
        ENDCASE
        x%(channel%)+=1
        IF x%(channel%)>LEN(m$) THEN x%(channel%)=1:finished%=TRUE
      ENDWHILE
      =finished%
      :
      DEFFNFindLength(m$)
      REM A little helper routine to check that each line is the same length for each part!
      LOCAL dt%,x%,sum%
      dt%=2
      WHILE m$<>""
        c$=LEFT$(m$,1)
        m$=MID$(m$,2)
        IF c$="D" THEN dt%=VAL(m$)
        IF c$>="a" AND c$<="g" THEN sum%+=dt%
      ENDWHILE
      =sum%