User Tools

Site Tools


qbasic-compatible_20music

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:

      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
This website uses cookies. By using the website, you agree with storing cookies on your computer. Also you acknowledge that you have read and understand our Privacy Policy. If you do not agree leave the website.More information about cookies
qbasic-compatible_20music.txt · Last modified: 2024/01/05 00:21 by 127.0.0.1