BBC BASIC Programmers' Reference

This page is read only. You can view the source, but not change it. Ask your administrator if you think this is wrong.
=====QBASIC-compatible music=====

//by Richard Russell, March 2014//\\ \\  The code below implements a QBASIC-compatible **PLAY** command, which allows you to play simple tunes; it makes use of the //BBC BASIC// **SOUND** and **ENVELOPE** statements available in LBB. The example tune is from Beethoven's //Ode to Joy//:\\ \\ 
<code lb>
      CALL QBplay "L8eefggfedccdeL6eL16dL4d"
      CALL QBplay "L8eefggfedccdeL6dL16cL4c"
      CALL QBplay "L8ddecdL16efL8ecdL16efL8edcdL4<g>"
      CALL QBplay "L8eefggfedccdeL6dL16cL4c"
      END

  SUB QBplay play$
      GLOBAL QBoct, QBdur, QBtem, QBenv
      IF QBoct = 0 THEN QBoct = 3
      IF QBdur = 0 THEN QBdur = 4
      IF QBtem = 0 THEN QBtem = 90
      IF QBenv = 0 THEN
        QBenv = 2
        !ENVELOPE 1,1,0,0,0,0,0,0,127,-1,-1,-1,100,0
        !ENVELOPE 2,1,0,0,0,0,0,0,127,-2,-4,-4,100,0
        !ENVELOPE 3,1,0,0,0,0,0,0,127,-4,-8,-8,100,0
      END IF
      play$ = upper$(play$)
      DO
        cmd$ = LEFT$(play$,1)
        play$ = MID$(play$,2)
        e = INSTR(play$,"E")
        IF e THEN q = VAL(LEFT$(play$,e-1)) ELSE q = VAL(play$)
        SELECT CASE cmd$
          CASE "L": QBdur = q
          CASE "T": QBtem = q
          CASE "O": QBoct = q
          CASE "<": IF QBoct > 0 THEN QBoct = QBoct - 1
          CASE ">": IF QBoct < 6 THEN QBoct = QBoct + 1
          CASE "N":
            IF q THEN
              !SOUND 1, QBenv, q*4-44, 6000/QBdur/QBtem
            ELSE
              !SOUND 1, QBenv, 0, 6000/QBdur/QBtem
            END IF
          CASE "P":
            !SOUND 1, QBenv, 0, 6000/q/QBtem
          CASE "M":
          SELECT CASE LEFT$(play$,1)
            CASE "L": QBenv = 1
            CASE "N": QBenv = 2
            CASE "S": QBenv = 3
          END SELECT
          play$ = MID$(play$,2)
          CASE "A","B","C","D","E","F","G":
          IF q THEN d = 6000/q/QBtem ELSE d = 6000/QBdur/QBtem
          q = 8 * INSTR("CDEFGAB", cmd$) - 8 : IF q >= 24 THEN q = q - 4
          IF LEFT$(play$,1) = "#" THEN play$ = MID$(play$,2) : q = q + 4
          IF LEFT$(play$,1) = "+" THEN play$ = MID$(play$,2) : q = q + 4
          IF LEFT$(play$,1) = "-" THEN play$ = MID$(play$,2) : q = q - 4
          IF LEFT$(play$,1) = "." THEN play$ = MID$(play$,2) : d = d*3/2
          IF LEFT$(play$,1) = "." THEN play$ = MID$(play$,2) : d = d*7/6
          q = QBoct*48 + q - 44
          WHILE q <= 0  : q = q + 48 : WEND
          WHILE q > 255 : q = q - 48 : WEND
          !SOUND 1, QBenv, q, d+0.5
        END SELECT
      LOOP UNTIL play$ = ""
  END SUB
</code>