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 format="lb" CALL QBplay "L8eefggfedccdeL6eL16dL4d" CALL QBplay "L8eefggfedccdeL6dL16cL4c" CALL QBplay "L8ddecdL16efL8ecdL16efL8edcdL4" 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