Guru
Joined: 07/08/2011
Location: AustraliaPosts: 6546
| Posted: 07:52pm 17 Oct 2022 |
A few years ago, I wrote programs for the CMM2 to play QuickBasic sounds and Nocia phone sounds.
Both programs should run on the pico.
Edit: The pico doesn't seem to trigger an interrupt at the end of a TONE, only at the end of playing a WAV file. This means the program can be used to convert to another format but not play in the background on a pico.
You can either use them to play the source as is or convert sound tracks to the format use in other program.
The QB sound program
' playQB by TassyJim August 2020
' To PLAY Quick Basic style sound strings.
' you can either use the function in your program directly or,
' more likely, use it to convert QBasic sound strings to DATA listings
' and use PLAY TONE in your progams
'
OPTION EXPLICIT
DIM playdone, p
DIM dl$(150) ' array to store the converted data lines
dl$(0) = "ToneData:" ' label for DATA
p = 1
dl$(p) = " DATA "
' samples taken from QBasic games
PLAYQB "MBT120L64O4cP32dP32eP32fP32gP32fP32eP32dP32c"'"T180 o2 P2 P8 L8 GGG L2 E-"+"P24 P8 L8 FFF L2 D"
melodyEnd
PAUSE 500
PLAYQB "MBMST220L64O1B"'"T120MLO2L1Eee"
melodyEnd
PAUSE 500
PLAYQB "MBMST220L64O6B"'"t120o1l16b9n0baan0bn0bn0baaan0b9n0baan0b"
melodyEnd
PAUSE 500
PLAYQB "o2l16e-9n0e-d-d-n0e-n0e-n0e-d-d-d-n0e-9n0e-d-d-n0e-"
melodyEnd
PAUSE 500
PLAYQB "o2l16g-9n0g-een0g-n0g-n0g-eeen0g-9n0g-een0g-"
melodyEnd
PAUSE 500
PLAYQB "o2l16b9n0baan0g-n0g-n0g-eeen0o1b9n0baan0b"
melodyEnd
'"MBT120L64O4cP32dP32eP32fP32gP32fP32eP32dP32c"
"MBMST220L64O1B"
"MBMST220L64O1B"
"MBMST220L64O6B"
printOutput
END
SUB playQB notation$
' play a quickbasic string
LOCAL ch$, item$, shift$= " "
LOCAL AS INTEGER nNum, tempo, quarter, value, n
LOCAL AS FLOAT pl, pauseTime, dur, ext, nTone
LOCAL octave = 2
notation$ = notation$ + " "
tempo = 120
quarter = 500 ' length of quarter note in mS
dur = quarter
pl = 7/8 ' normal note length
playdone = 1
FOR n = 1 TO LEN(notation$)
'print item$;
ch$ = MID$(notation$,n,1)
SELECT CASE ch$
CASE "0","1","2","3","4","5","6","7","8","9"
value = value * 10 + VAL(ch$)
CASE ">"
IF octave < 6 THEN octave = octave + 1
CASE "<"
IF octave > 0 THEN octave = octave - 1
CASE "#","+"
shift$ = "#"
CASE "-"
shift$ = "-"
CASE "."
IF ext = 0 THEN
ext = dur/2
ELSE
ext = dur*3/4
ENDIF
CASE "X"
' ignore
CASE ELSE
' print "Value = ";value 'DEBUG
SELECT CASE item$
CASE "A","B","C","D","E","F","G"
nNum = Note2nNum(item$+shift$, octave+2)
nTone = nNum2Tone(nNum)
DO : LOOP UNTIL playdone <> 0 : playdone=0
PLAY TONE nTone, nTone, (dur + ext) * pl, playint
dl$(p)=dl$(p)+STR$(nTone,4,1)+","+STR$((dur + ext) * pl,5,1)
IF LEN(dl$(p)) < 65 THEN ' check for new line required
dl$(p)=dl$(p)+","
ELSE
p = p+1
dl$(p) = " DATA "
ENDIF
IF pl < 1 THEN
DO : LOOP UNTIL playdone <> 0 : playdone=0
PLAY TONE 0, 0, (dur + ext) * (1 - pl), playint
dl$(p)=dl$(p)+STR$(0,4,1)+","+STR$((dur + ext) * (1 - pl),5,1)
IF LEN(dl$(p)) < 65 THEN ' check for new line required
dl$(p)=dl$(p)+","
ELSE
p = p+1
dl$(p) = " DATA "
ENDIF
ENDIF
ext = 0
item$ = UCASE$(ch$)
value = 0
CASE "T"
tempo = value
quarter = 60000 / tempo
item$ = UCASE$(ch$)
value = 0
' print "quarter = ";quarter 'DEBUG
CASE "L"
dur = quarter * 4 / value
item$ = UCASE$(ch$)
value = 0
' print "duration = ";duration 'DEBUG
CASE "O"
octave = value
item$ = UCASE$(ch$)
value = 0
CASE "P"
pauseTime = quarter * 4 / value
DO : LOOP UNTIL playdone <> 0 : playdone=0
PLAY TONE 0, 0, pausetime, playint
dl$(p)=dl$(p)+STR$(0,4,1)+","+STR$(pausetime,5,1)
IF LEN(dl$(p)) < 65 THEN ' check for new line required
dl$(p)=dl$(p)+","
ELSE
p = p+1
dl$(p) = " DATA "
ENDIF
item$ = UCASE$(ch$)
value = 0
CASE "T"
tempo = value
quarter = 60000/tempo
item$ = UCASE$(ch$)
value = 0
CASE "M"
IF UCASE$(ch$) = "N" THEN pl = 7/8
IF UCASE$(ch$) = "L" THEN pl = 1
IF UCASE$(ch$) = "S" THEN pl = 3/4
item$ = " "
value = 0
' if ucase$(ch$) = "F" then ' foreground
' if ucase$(ch$) = "B" then ' background
CASE "N"
IF value = 0 THEN
DO : LOOP UNTIL playdone <> 0 : playdone=0
PLAY TONE 0, 0, (dur + ext) , playint
dl$(p)=dl$(p)+STR$(0,4,1)+","+STR$((dur + ext),5,1)
IF LEN(dl$(p)) < 65 THEN ' check for new line required
dl$(p)=dl$(p)+","
ELSE
p = p+1
dl$(p) = " DATA "
ENDIF
ELSE
nTone = nNum2Tone(value+24)
DO : LOOP UNTIL playdone <> 0 : playdone=0
PLAY TONE nTone, nTone, (dur + ext) * pl, playint
dl$(p)=dl$(p)+STR$(nTone,4,1)+","+STR$((dur + ext) * pl,5,1)
IF LEN(dl$(p)) < 65 THEN ' check for new line required
dl$(p)=dl$(p)+","
ELSE
p = p+1
dl$(p) = " DATA "
ENDIF
IF pl < 1 THEN
DO : LOOP UNTIL playdone <> 0 : playdone=0
PLAY TONE 0, 0, (dur + ext) * (1 - pl), playint
dl$(p)=dl$(p)+STR$(0,4,1)+","+STR$((dur + ext) * (1 - pl),5,1)
IF LEN(dl$(p)) < 65 THEN ' check for new line required
dl$(p)=dl$(p)+","
ELSE
p = p+1
dl$(p) = " DATA "
ENDIF
ENDIF
ext = 0
ENDIF
item$ = UCASE$(ch$)
value = 0
CASE ELSE
item$ = UCASE$(ch$)
value = 0
END SELECT
shift$ = " "
END SELECT
NEXT n
DO : LOOP UNTIL playdone <> 0 : playdone=0
END SUB
SUB playint 'end of tone interrupt
playdone=1
END SUB
SUB melodyEnd
dl$(p) = dl$(p)+" 0, 0"
p = p+1
dl$(p) = " "
p = p+1
dl$(p) = " DATA "
END SUB
FUNCTION Note2nNum(Note$, octave AS INTEGER) AS INTEGER
' given music note and octave, return piano key number
LOCAL allNotes$ = "C C#D D#E F F#G G#A A#B "
LOCAL altNotes$ = "C D-D E-E F G-G A-A B-B "
LOCAL flat
IF INSTR(Note$,"-") > 0 THEN
flat = 1
Note$ = MID$(Note$,1,1)
ENDIF
IF LEN(Note$) < 2 THEN Note$ = Note$+" "
IF Note$ = "E#" THEN Note$ = "F " ' correct for 2 undefined sharps
IF Note$ = "B#" THEN Note$ = "C " : octave = octave + 1
IF Note$ = "F-" THEN Note$ = "E " ' correct for 2 undefined flats
IF Note$ = "C-" THEN Note$ = "B " : octave = octave - 1
IF INSTR(Note$,"-")>0 THEN
Note2nNum = INSTR(altNotes$,Note$)/2 +octave*12 - 9 - flat
ELSE
Note2nNum = INSTR(allNotes$,Note$)/2 +octave*12 - 9 - flat
ENDIF
IF Note2nNum < 1 THEN Note2nNum = Note2nNum + 1 ' correct for negative numbers
END FUNCTION
FUNCTION nNum2Tone(noteN AS INTEGER) AS FLOAT
' given piano key number return note frequency
nNum2Tone = 440 * 2^((noteN-49)/12)
END FUNCTION
FUNCTION nNum2Octave(noteN AS INTEGER) AS INTEGER
' given piano key number, return octave number
' if noteN <98 and noteN > 88 then noteN = noteN - 97
IF noteN > 87 THEN : nNum2Octave = 8
ELSEIF noteN > 75 THEN : nNum2Octave = 7
ELSEIF noteN > 63 THEN : nNum2Octave = 6
ELSEIF noteN > 51 THEN : nNum2Octave = 5
ELSEIF noteN > 39 THEN : nNum2Octave = 4
ELSEIF noteN > 27 THEN : nNum2Octave = 3
ELSEIF noteN > 15 THEN : nNum2Octave = 2
ELSEIF noteN > 3 THEN : nNum2Octave = 1
ELSE : nNum2Octave = 0
ENDIF
END FUNCTION
FUNCTION nNum2Note(noteN AS INTEGER) AS STRING
' given piano key number, return music note
LOCAL allnotes$ = "G#A A#B C C#D D#E F F#G G#A "
noteN = noteN + 12
IF noteN > 0 THEN
nNum2Note = MID$(allnotes$,(noteN MOD 12) * 2 +1,2)
ENDIF
END FUNCTION
SUB printOutput
LOCAL p
PRINT
DO
PRINT dl$(p)
p = p + 1
LOOP UNTIL dl$(p) = ""
END SUB
' To PLAY Quick Basic style sound strings.
' you can either use the function in your program directly or,
' more likely, use it to convert QBasic sound strings to DATA listings
' and use PLAY TONE in your progams
'
OPTION EXPLICIT
DIM playdone, p
DIM dl$(150) ' array to store the converted data lines
dl$(0) = "ToneData:" ' label for DATA
p = 1
dl$(p) = " DATA "
' samples taken from QBasic games
PLAYQB "MBT120L64O4cP32dP32eP32fP32gP32fP32eP32dP32c"'"T180 o2 P2 P8 L8 GGG L2 E-"+"P24 P8 L8 FFF L2 D"
melodyEnd
PAUSE 500
PLAYQB "MBMST220L64O1B"'"T120MLO2L1Eee"
melodyEnd
PAUSE 500
PLAYQB "MBMST220L64O6B"'"t120o1l16b9n0baan0bn0bn0baaan0b9n0baan0b"
melodyEnd
PAUSE 500
PLAYQB "o2l16e-9n0e-d-d-n0e-n0e-n0e-d-d-d-n0e-9n0e-d-d-n0e-"
melodyEnd
PAUSE 500
PLAYQB "o2l16g-9n0g-een0g-n0g-n0g-eeen0g-9n0g-een0g-"
melodyEnd
PAUSE 500
PLAYQB "o2l16b9n0baan0g-n0g-n0g-eeen0o1b9n0baan0b"
melodyEnd
'"MBT120L64O4cP32dP32eP32fP32gP32fP32eP32dP32c"
"MBMST220L64O1B"
"MBMST220L64O1B"
"MBMST220L64O6B"
printOutput
END
SUB playQB notation$
' play a quickbasic string
LOCAL ch$, item$, shift$= " "
LOCAL AS INTEGER nNum, tempo, quarter, value, n
LOCAL AS FLOAT pl, pauseTime, dur, ext, nTone
LOCAL octave = 2
notation$ = notation$ + " "
tempo = 120
quarter = 500 ' length of quarter note in mS
dur = quarter
pl = 7/8 ' normal note length
playdone = 1
FOR n = 1 TO LEN(notation$)
'print item$;
ch$ = MID$(notation$,n,1)
SELECT CASE ch$
CASE "0","1","2","3","4","5","6","7","8","9"
value = value * 10 + VAL(ch$)
CASE ">"
IF octave < 6 THEN octave = octave + 1
CASE "<"
IF octave > 0 THEN octave = octave - 1
CASE "#","+"
shift$ = "#"
CASE "-"
shift$ = "-"
CASE "."
IF ext = 0 THEN
ext = dur/2
ELSE
ext = dur*3/4
ENDIF
CASE "X"
' ignore
CASE ELSE
' print "Value = ";value 'DEBUG
SELECT CASE item$
CASE "A","B","C","D","E","F","G"
nNum = Note2nNum(item$+shift$, octave+2)
nTone = nNum2Tone(nNum)
DO : LOOP UNTIL playdone <> 0 : playdone=0
PLAY TONE nTone, nTone, (dur + ext) * pl, playint
dl$(p)=dl$(p)+STR$(nTone,4,1)+","+STR$((dur + ext) * pl,5,1)
IF LEN(dl$(p)) < 65 THEN ' check for new line required
dl$(p)=dl$(p)+","
ELSE
p = p+1
dl$(p) = " DATA "
ENDIF
IF pl < 1 THEN
DO : LOOP UNTIL playdone <> 0 : playdone=0
PLAY TONE 0, 0, (dur + ext) * (1 - pl), playint
dl$(p)=dl$(p)+STR$(0,4,1)+","+STR$((dur + ext) * (1 - pl),5,1)
IF LEN(dl$(p)) < 65 THEN ' check for new line required
dl$(p)=dl$(p)+","
ELSE
p = p+1
dl$(p) = " DATA "
ENDIF
ENDIF
ext = 0
item$ = UCASE$(ch$)
value = 0
CASE "T"
tempo = value
quarter = 60000 / tempo
item$ = UCASE$(ch$)
value = 0
' print "quarter = ";quarter 'DEBUG
CASE "L"
dur = quarter * 4 / value
item$ = UCASE$(ch$)
value = 0
' print "duration = ";duration 'DEBUG
CASE "O"
octave = value
item$ = UCASE$(ch$)
value = 0
CASE "P"
pauseTime = quarter * 4 / value
DO : LOOP UNTIL playdone <> 0 : playdone=0
PLAY TONE 0, 0, pausetime, playint
dl$(p)=dl$(p)+STR$(0,4,1)+","+STR$(pausetime,5,1)
IF LEN(dl$(p)) < 65 THEN ' check for new line required
dl$(p)=dl$(p)+","
ELSE
p = p+1
dl$(p) = " DATA "
ENDIF
item$ = UCASE$(ch$)
value = 0
CASE "T"
tempo = value
quarter = 60000/tempo
item$ = UCASE$(ch$)
value = 0
CASE "M"
IF UCASE$(ch$) = "N" THEN pl = 7/8
IF UCASE$(ch$) = "L" THEN pl = 1
IF UCASE$(ch$) = "S" THEN pl = 3/4
item$ = " "
value = 0
' if ucase$(ch$) = "F" then ' foreground
' if ucase$(ch$) = "B" then ' background
CASE "N"
IF value = 0 THEN
DO : LOOP UNTIL playdone <> 0 : playdone=0
PLAY TONE 0, 0, (dur + ext) , playint
dl$(p)=dl$(p)+STR$(0,4,1)+","+STR$((dur + ext),5,1)
IF LEN(dl$(p)) < 65 THEN ' check for new line required
dl$(p)=dl$(p)+","
ELSE
p = p+1
dl$(p) = " DATA "
ENDIF
ELSE
nTone = nNum2Tone(value+24)
DO : LOOP UNTIL playdone <> 0 : playdone=0
PLAY TONE nTone, nTone, (dur + ext) * pl, playint
dl$(p)=dl$(p)+STR$(nTone,4,1)+","+STR$((dur + ext) * pl,5,1)
IF LEN(dl$(p)) < 65 THEN ' check for new line required
dl$(p)=dl$(p)+","
ELSE
p = p+1
dl$(p) = " DATA "
ENDIF
IF pl < 1 THEN
DO : LOOP UNTIL playdone <> 0 : playdone=0
PLAY TONE 0, 0, (dur + ext) * (1 - pl), playint
dl$(p)=dl$(p)+STR$(0,4,1)+","+STR$((dur + ext) * (1 - pl),5,1)
IF LEN(dl$(p)) < 65 THEN ' check for new line required
dl$(p)=dl$(p)+","
ELSE
p = p+1
dl$(p) = " DATA "
ENDIF
ENDIF
ext = 0
ENDIF
item$ = UCASE$(ch$)
value = 0
CASE ELSE
item$ = UCASE$(ch$)
value = 0
END SELECT
shift$ = " "
END SELECT
NEXT n
DO : LOOP UNTIL playdone <> 0 : playdone=0
END SUB
SUB playint 'end of tone interrupt
playdone=1
END SUB
SUB melodyEnd
dl$(p) = dl$(p)+" 0, 0"
p = p+1
dl$(p) = " "
p = p+1
dl$(p) = " DATA "
END SUB
FUNCTION Note2nNum(Note$, octave AS INTEGER) AS INTEGER
' given music note and octave, return piano key number
LOCAL allNotes$ = "C C#D D#E F F#G G#A A#B "
LOCAL altNotes$ = "C D-D E-E F G-G A-A B-B "
LOCAL flat
IF INSTR(Note$,"-") > 0 THEN
flat = 1
Note$ = MID$(Note$,1,1)
ENDIF
IF LEN(Note$) < 2 THEN Note$ = Note$+" "
IF Note$ = "E#" THEN Note$ = "F " ' correct for 2 undefined sharps
IF Note$ = "B#" THEN Note$ = "C " : octave = octave + 1
IF Note$ = "F-" THEN Note$ = "E " ' correct for 2 undefined flats
IF Note$ = "C-" THEN Note$ = "B " : octave = octave - 1
IF INSTR(Note$,"-")>0 THEN
Note2nNum = INSTR(altNotes$,Note$)/2 +octave*12 - 9 - flat
ELSE
Note2nNum = INSTR(allNotes$,Note$)/2 +octave*12 - 9 - flat
ENDIF
IF Note2nNum < 1 THEN Note2nNum = Note2nNum + 1 ' correct for negative numbers
END FUNCTION
FUNCTION nNum2Tone(noteN AS INTEGER) AS FLOAT
' given piano key number return note frequency
nNum2Tone = 440 * 2^((noteN-49)/12)
END FUNCTION
FUNCTION nNum2Octave(noteN AS INTEGER) AS INTEGER
' given piano key number, return octave number
' if noteN <98 and noteN > 88 then noteN = noteN - 97
IF noteN > 87 THEN : nNum2Octave = 8
ELSEIF noteN > 75 THEN : nNum2Octave = 7
ELSEIF noteN > 63 THEN : nNum2Octave = 6
ELSEIF noteN > 51 THEN : nNum2Octave = 5
ELSEIF noteN > 39 THEN : nNum2Octave = 4
ELSEIF noteN > 27 THEN : nNum2Octave = 3
ELSEIF noteN > 15 THEN : nNum2Octave = 2
ELSEIF noteN > 3 THEN : nNum2Octave = 1
ELSE : nNum2Octave = 0
ENDIF
END FUNCTION
FUNCTION nNum2Note(noteN AS INTEGER) AS STRING
' given piano key number, return music note
LOCAL allnotes$ = "G#A A#B C C#D D#E F F#G G#A "
noteN = noteN + 12
IF noteN > 0 THEN
nNum2Note = MID$(allnotes$,(noteN MOD 12) * 2 +1,2)
ENDIF
END FUNCTION
SUB printOutput
LOCAL p
DO
PRINT dl$(p)
p = p + 1
LOOP UNTIL dl$(p) = ""
END SUB
The Nocia phone program.
' playNokia by TassyJim August 2020
' play Nokia ringtones and convert to tone - duration pairs of DATA
'
'
OPTION EXPLICIT
DIM playdone, n
DIM source$(11) ' array for the source tune
DIM dl$(150) ' array to store the converted data lines
DIM newName$
DIM d=4, o=5, b=120, pl = 7/8 ' normal note length
'input "Default length, octave, beats (4,5,120): ";d,o,b
RESTORE testtune 'jinglebells
PRINT
' read the source data into a string array
' output is DATA statements in array dl$()
DO
n = n + 1
READ source$(n)
IF source$(n) = "" THEN EXIT DO
LOOP
playNokia
printOutput
END
SUB playNokia
' play a nokia string
' and convert it to tone, duration DATA pairs
LOCAL ch$, item$, shift$= " "
LOCAL AS INTEGER nNum, tempo, quarter, value, n, k, p, lastone
LOCAL AS FLOAT dur, ext, nTone
LOCAL octave
k = INSTR(source$(1),":") ' look for file header
IF k>0 THEN ' get name and settings
newName$ = LEFT$(source$(1),k-1)
k = INSTR(source$(1),"d=") ' default note duration
IF k THEN
n = INSTR(k,source$(1),",")-k-2
d = VAL(MID$(source$(1), k+2,n))
ENDIF
k = INSTR(source$(1),"o=") ' default octave
IF k THEN
n = INSTR(k,source$(1),",")-k-2
o = VAL(MID$(source$(1), k+2,n))
ENDIF
k = INSTR(source$(1),"b=") ' default tempo
IF k THEN
n = INSTR(k,source$(1),":")-k-2
b = VAL(MID$(source$(1), k+2,n))
ENDIF
source$(1) = MID$(source$(1),k+n+3) ' strip off header
' print newName$, d, o, b 'DEBUG
' print source$(1) 'DEBUG
ELSE
newName$ = "Test"
ENDIF
dl$(0) = newName$+":" ' label for DATA
p = 1
dl$(p) = " DATA "
tempo = b
octave = o
quarter = 60000 / tempo ' length of quarter note in mS
dur = quarter * 4 / d
'pl = 7/8 ' normal note length
playdone = 1
FOR k = 1 TO 11
IF LEN(source$(k)) = 0 THEN
source$(k) = "," 'add final comma
lastone = 1 'and set flag
ENDIF
FOR n = 1 TO LEN(source$(k))
ch$ = UCASE$(MID$(source$(k),n,1))
SELECT CASE ch$
CASE "0","1","2","3","4","5","6","7","8","9"
value = value * 10 + VAL(ch$)
CASE "A","B","C","D","E","F","G","P"
item$ = ch$
IF value = 0 THEN
dur = quarter * 4 / d
ELSE
dur = quarter * 4 / value
ENDIF
value = 0
CASE "#","+"
shift$ = "#"
CASE "-"
shift$ = "-"
CASE "."
IF ext = 0 THEN
ext = dur/2
ELSE
ext = dur*3/4
ENDIF
CASE " "
' skip
CASE ","
IF value = 0 THEN
octave = o
ELSE
octave = value
ENDIF
'playdone=0
IF item$ = "P" THEN ' rest
DO : LOOP UNTIL playdone<> 0 : playdone=0
PLAY TONE 0, 0, (dur + ext), playint
dl$(p)=dl$(p)+STR$(0,4,1)+","+STR$((dur + ext),5,1)
IF LEN(dl$(p)) < 65 THEN ' check for new line required
dl$(p)=dl$(p)+","
ELSE
p = p+1
dl$(p) = " DATA "
ENDIF
ELSE
nNum = Note2nNum(item$+shift$, octave-1)
nTone = nNum2Tone(nNum)
DO : LOOP UNTIL playdone<> 0 : playdone=0
PLAY TONE nTone, nTone, (dur + ext) * pl, playint
dl$(p)=dl$(p)+STR$(nTone,4,1)+","+STR$((dur + ext)* pl,5,1)
IF LEN(dl$(p)) < 65 THEN
dl$(p)=dl$(p)+","
ELSE
p = p+1
dl$(p) = " DATA "
ENDIF
IF pl < 1 THEN
DO : LOOP UNTIL playdone<> 0 : playdone=0' wait for current tone to finish
PLAY TONE 0, 0, (dur + ext) * (1 - pl), playint
dl$(p)=dl$(p)+STR$(0,4,1)+","+STR$((dur + ext)* (1 - pl),5,1)
IF LEN(dl$(p)) < 65 THEN
dl$(p)=dl$(p)+","
ELSE
p = p+1
dl$(p) = " DATA "
ENDIF
ENDIF
ENDIF
value = 0
shift$ = " "
ext = 0
END SELECT
NEXT n
IF lastone = 1 THEN EXIT FOR ' all done!
NEXT k
dl$(p) = LEFT$(dl$(p),LEN(dl$(p))-1)+", 0,0"
dl$(p+1) = "' End of "+newName$
dl$(p+2) = ""
DO : LOOP UNTIL playdone<> 0 : playdone=0' wait for current tone to finish
END SUB
SUB printOutput
LOCAL p
PRINT
DO
PRINT dl$(p)
p = p + 1
LOOP UNTIL dl$(p) = ""
END SUB
SUB playint 'end of tone interrupt
playdone=1
END SUB
SUB melodyEnd
PRINT "DATA 0, 00"
PRINT
END SUB
FUNCTION Note2nNum(Note$, octave AS INTEGER) AS INTEGER
' given music note and octave, return piano key number
LOCAL allNotes$ = "C C#D D#E F F#G G#A A#B "
LOCAL altNotes$ = "C D-D E-E F G-G A-A B-B "
LOCAL flat
IF INSTR(Note$,"-") > 0 THEN
flat = 1
Note$ = MID$(Note$,1,1)
ENDIF
IF LEN(Note$) < 2 THEN Note$ = Note$+" "
IF Note$ = "E#" THEN Note$ = "F " ' correct for 2 undefined sharps
IF Note$ = "B#" THEN Note$ = "C " : octave = octave + 1
IF Note$ = "F-" THEN Note$ = "E " ' correct for 2 undefined flats
IF Note$ = "C-" THEN Note$ = "B " : octave = octave - 1
IF INSTR(Note$,"-")>0 THEN
Note2nNum = INSTR(altNotes$,Note$)/2 +octave*12 - 9 - flat
ELSE
Note2nNum = INSTR(allNotes$,Note$)/2 +octave*12 - 9 - flat
ENDIF
IF Note2nNum < 1 THEN Note2nNum = Note2nNum + 1 ' correct for negative numbers
END FUNCTION
FUNCTION nNum2Tone(noteN AS INTEGER) AS FLOAT
' given piano key number return note frequency
nNum2Tone = 440 * 2^((noteN-49)/12)
END FUNCTION
FUNCTION nNum2Octave(noteN AS INTEGER) AS INTEGER
' given piano key number, return octave number
' if noteN <98 and noteN > 88 then noteN = noteN - 97
IF noteN > 87 THEN : nNum2Octave = 8
ELSEIF noteN > 75 THEN : nNum2Octave = 7
ELSEIF noteN > 63 THEN : nNum2Octave = 6
ELSEIF noteN > 51 THEN : nNum2Octave = 5
ELSEIF noteN > 39 THEN : nNum2Octave = 4
ELSEIF noteN > 27 THEN : nNum2Octave = 3
ELSEIF noteN > 15 THEN : nNum2Octave = 2
ELSEIF noteN > 3 THEN : nNum2Octave = 1
ELSE : nNum2Octave = 0
ENDIF
END FUNCTION
FUNCTION nNum2Note(noteN AS INTEGER) AS STRING
' given piano key number, return music note
LOCAL allnotes$ = "G#A A#B C C#D D#E F F#G G#A "
noteN = noteN + 12
IF noteN > 0 THEN
nNum2Note = MID$(allnotes$,(noteN MOD 12) * 2 +1,2)
ENDIF
END FUNCTION
JingleBells:
'd=4,o=5,b=125
DATA "JingleBells:d=4,o=5,b=125:8g,8e6,8d6,8c6,2g,8g,8e6,8d6,8c6,2a,8a,8f6,8e6"
DATA "8d6,8b,8g,8b,8d6,8g.6,16g6,8f6,8d6,2e6,8g,8e6,8d6,8c6,2g,16f#,8g,8e6"
DATA "8d6,8c6,2a,8a,8f6,8e6,8d6,8g6,16g6,16f#6,16g6,16f#6,16g6,16g#6,8a.6"
DATA "16g6,8e6,8d6,c6,g6,8e6,8e6,8e.6,16d#6,8e6,8e6,8e.6,16d#6,8e6,8g6,8c.6"
DATA "16d6,2e6,8f6,8f6,8f.6,16f6,8f6,8e6,8e6,16e6,16e6,8e6,8d6,8d6,8e6,2d6"
DATA ""
DATA "g,c7,g,e,g,c.7,8c7,c7,e7,d7,c7,b,c7,2d.7,g,c7,g,e,c,g.,8g,g,e7,d7,c7,b"
DATA "a,2g,p,g,a.,8b,c7,a,2g,8e,e,g,a,c7,f7,e7,2d7"
DATA ""
testtune:
DATA "g,g,a,f#.,8g,a,b,b,c6,b.,8a,g,a,g,f#,g.,8a,8b,8c6,d6,d6,d6,d.6,8c6,b,c6"
DATA "c6,c6,c.6,8b,a,b,8c6,8b,8a,8g,b.,8c6,d6,8e6,8c6,b,a,g."
DATA ""
DATA "8c#,8d,e,c#,d,b4,c#,a4,b4,p,16c#6,16p,16d6,16p,8e6,8p,8c#6,8p,8d6,8p"
DATA "8b,8p,8c#6,8p,8a,8p,b,p,a4,a4,b4,c#,a4,c#,b4,p,8a,8p,8a,8p,8b,8p,8c#6"
DATA "8p,8a,8p,8c#6,8p,8b"
DATA ""
' play Nokia ringtones and convert to tone - duration pairs of DATA
'
'
OPTION EXPLICIT
DIM playdone, n
DIM source$(11) ' array for the source tune
DIM dl$(150) ' array to store the converted data lines
DIM newName$
DIM d=4, o=5, b=120, pl = 7/8 ' normal note length
'input "Default length, octave, beats (4,5,120): ";d,o,b
RESTORE testtune 'jinglebells
' read the source data into a string array
' output is DATA statements in array dl$()
DO
n = n + 1
READ source$(n)
IF source$(n) = "" THEN EXIT DO
LOOP
playNokia
printOutput
END
SUB playNokia
' play a nokia string
' and convert it to tone, duration DATA pairs
LOCAL ch$, item$, shift$= " "
LOCAL AS INTEGER nNum, tempo, quarter, value, n, k, p, lastone
LOCAL AS FLOAT dur, ext, nTone
LOCAL octave
k = INSTR(source$(1),":") ' look for file header
IF k>0 THEN ' get name and settings
newName$ = LEFT$(source$(1),k-1)
k = INSTR(source$(1),"d=") ' default note duration
IF k THEN
n = INSTR(k,source$(1),",")-k-2
d = VAL(MID$(source$(1), k+2,n))
ENDIF
k = INSTR(source$(1),"o=") ' default octave
IF k THEN
n = INSTR(k,source$(1),",")-k-2
o = VAL(MID$(source$(1), k+2,n))
ENDIF
k = INSTR(source$(1),"b=") ' default tempo
IF k THEN
n = INSTR(k,source$(1),":")-k-2
b = VAL(MID$(source$(1), k+2,n))
ENDIF
source$(1) = MID$(source$(1),k+n+3) ' strip off header
' print newName$, d, o, b 'DEBUG
' print source$(1) 'DEBUG
ELSE
newName$ = "Test"
ENDIF
dl$(0) = newName$+":" ' label for DATA
p = 1
dl$(p) = " DATA "
tempo = b
octave = o
quarter = 60000 / tempo ' length of quarter note in mS
dur = quarter * 4 / d
'pl = 7/8 ' normal note length
playdone = 1
FOR k = 1 TO 11
IF LEN(source$(k)) = 0 THEN
source$(k) = "," 'add final comma
lastone = 1 'and set flag
ENDIF
FOR n = 1 TO LEN(source$(k))
ch$ = UCASE$(MID$(source$(k),n,1))
SELECT CASE ch$
CASE "0","1","2","3","4","5","6","7","8","9"
value = value * 10 + VAL(ch$)
CASE "A","B","C","D","E","F","G","P"
item$ = ch$
IF value = 0 THEN
dur = quarter * 4 / d
ELSE
dur = quarter * 4 / value
ENDIF
value = 0
CASE "#","+"
shift$ = "#"
CASE "-"
shift$ = "-"
CASE "."
IF ext = 0 THEN
ext = dur/2
ELSE
ext = dur*3/4
ENDIF
CASE " "
' skip
CASE ","
IF value = 0 THEN
octave = o
ELSE
octave = value
ENDIF
'playdone=0
IF item$ = "P" THEN ' rest
DO : LOOP UNTIL playdone<> 0 : playdone=0
PLAY TONE 0, 0, (dur + ext), playint
dl$(p)=dl$(p)+STR$(0,4,1)+","+STR$((dur + ext),5,1)
IF LEN(dl$(p)) < 65 THEN ' check for new line required
dl$(p)=dl$(p)+","
ELSE
p = p+1
dl$(p) = " DATA "
ENDIF
ELSE
nNum = Note2nNum(item$+shift$, octave-1)
nTone = nNum2Tone(nNum)
DO : LOOP UNTIL playdone<> 0 : playdone=0
PLAY TONE nTone, nTone, (dur + ext) * pl, playint
dl$(p)=dl$(p)+STR$(nTone,4,1)+","+STR$((dur + ext)* pl,5,1)
IF LEN(dl$(p)) < 65 THEN
dl$(p)=dl$(p)+","
ELSE
p = p+1
dl$(p) = " DATA "
ENDIF
IF pl < 1 THEN
DO : LOOP UNTIL playdone<> 0 : playdone=0' wait for current tone to finish
PLAY TONE 0, 0, (dur + ext) * (1 - pl), playint
dl$(p)=dl$(p)+STR$(0,4,1)+","+STR$((dur + ext)* (1 - pl),5,1)
IF LEN(dl$(p)) < 65 THEN
dl$(p)=dl$(p)+","
ELSE
p = p+1
dl$(p) = " DATA "
ENDIF
ENDIF
ENDIF
value = 0
shift$ = " "
ext = 0
END SELECT
NEXT n
IF lastone = 1 THEN EXIT FOR ' all done!
NEXT k
dl$(p) = LEFT$(dl$(p),LEN(dl$(p))-1)+", 0,0"
dl$(p+1) = "' End of "+newName$
dl$(p+2) = ""
DO : LOOP UNTIL playdone<> 0 : playdone=0' wait for current tone to finish
END SUB
SUB printOutput
LOCAL p
DO
PRINT dl$(p)
p = p + 1
LOOP UNTIL dl$(p) = ""
END SUB
SUB playint 'end of tone interrupt
playdone=1
END SUB
SUB melodyEnd
PRINT "DATA 0, 00"
END SUB
FUNCTION Note2nNum(Note$, octave AS INTEGER) AS INTEGER
' given music note and octave, return piano key number
LOCAL allNotes$ = "C C#D D#E F F#G G#A A#B "
LOCAL altNotes$ = "C D-D E-E F G-G A-A B-B "
LOCAL flat
IF INSTR(Note$,"-") > 0 THEN
flat = 1
Note$ = MID$(Note$,1,1)
ENDIF
IF LEN(Note$) < 2 THEN Note$ = Note$+" "
IF Note$ = "E#" THEN Note$ = "F " ' correct for 2 undefined sharps
IF Note$ = "B#" THEN Note$ = "C " : octave = octave + 1
IF Note$ = "F-" THEN Note$ = "E " ' correct for 2 undefined flats
IF Note$ = "C-" THEN Note$ = "B " : octave = octave - 1
IF INSTR(Note$,"-")>0 THEN
Note2nNum = INSTR(altNotes$,Note$)/2 +octave*12 - 9 - flat
ELSE
Note2nNum = INSTR(allNotes$,Note$)/2 +octave*12 - 9 - flat
ENDIF
IF Note2nNum < 1 THEN Note2nNum = Note2nNum + 1 ' correct for negative numbers
END FUNCTION
FUNCTION nNum2Tone(noteN AS INTEGER) AS FLOAT
' given piano key number return note frequency
nNum2Tone = 440 * 2^((noteN-49)/12)
END FUNCTION
FUNCTION nNum2Octave(noteN AS INTEGER) AS INTEGER
' given piano key number, return octave number
' if noteN <98 and noteN > 88 then noteN = noteN - 97
IF noteN > 87 THEN : nNum2Octave = 8
ELSEIF noteN > 75 THEN : nNum2Octave = 7
ELSEIF noteN > 63 THEN : nNum2Octave = 6
ELSEIF noteN > 51 THEN : nNum2Octave = 5
ELSEIF noteN > 39 THEN : nNum2Octave = 4
ELSEIF noteN > 27 THEN : nNum2Octave = 3
ELSEIF noteN > 15 THEN : nNum2Octave = 2
ELSEIF noteN > 3 THEN : nNum2Octave = 1
ELSE : nNum2Octave = 0
ENDIF
END FUNCTION
FUNCTION nNum2Note(noteN AS INTEGER) AS STRING
' given piano key number, return music note
LOCAL allnotes$ = "G#A A#B C C#D D#E F F#G G#A "
noteN = noteN + 12
IF noteN > 0 THEN
nNum2Note = MID$(allnotes$,(noteN MOD 12) * 2 +1,2)
ENDIF
END FUNCTION
JingleBells:
'd=4,o=5,b=125
DATA "JingleBells:d=4,o=5,b=125:8g,8e6,8d6,8c6,2g,8g,8e6,8d6,8c6,2a,8a,8f6,8e6"
DATA "8d6,8b,8g,8b,8d6,8g.6,16g6,8f6,8d6,2e6,8g,8e6,8d6,8c6,2g,16f#,8g,8e6"
DATA "8d6,8c6,2a,8a,8f6,8e6,8d6,8g6,16g6,16f#6,16g6,16f#6,16g6,16g#6,8a.6"
DATA "16g6,8e6,8d6,c6,g6,8e6,8e6,8e.6,16d#6,8e6,8e6,8e.6,16d#6,8e6,8g6,8c.6"
DATA "16d6,2e6,8f6,8f6,8f.6,16f6,8f6,8e6,8e6,16e6,16e6,8e6,8d6,8d6,8e6,2d6"
DATA ""
DATA "g,c7,g,e,g,c.7,8c7,c7,e7,d7,c7,b,c7,2d.7,g,c7,g,e,c,g.,8g,g,e7,d7,c7,b"
DATA "a,2g,p,g,a.,8b,c7,a,2g,8e,e,g,a,c7,f7,e7,2d7"
DATA ""
testtune:
DATA "g,g,a,f#.,8g,a,b,b,c6,b.,8a,g,a,g,f#,g.,8a,8b,8c6,d6,d6,d6,d.6,8c6,b,c6"
DATA "c6,c6,c.6,8b,a,b,8c6,8b,8a,8g,b.,8c6,d6,8e6,8c6,b,a,g."
DATA ""
DATA "8c#,8d,e,c#,d,b4,c#,a4,b4,p,16c#6,16p,16d6,16p,8e6,8p,8c#6,8p,8d6,8p"
DATA "8b,8p,8c#6,8p,8a,8p,b,p,a4,a4,b4,c#,a4,c#,b4,p,8a,8p,8a,8p,8b,8p,8c#6"
DATA "8p,8a,8p,8c#6,8p,8b"
DATA ""
There are plenty of Nocia tunes out there on the 'net and plenty of QuickBasic programs have sound effects embedded in them.
Jim
Edited 2022-10-18 06:39 by TassyJim