TheBackShed.com

Forum Index : Microcontroller and PC projects : Resurecting old sounds.

Author

Message

TassyJim

Guru

Joined: 07/08/2011
Location: Australia
Posts: 5917

Posted: 07:36am 16 Aug 2020

Copy link to clipboard

Print this post

This first offering reads QB style sound strings and converts them into DATA statements.
You can either use the function directly in your program or use it as a utility to convert QB strings to use later.

' 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 "T180 o2 P2 P8 L8 GGG L2 E-"+"P24 P8 L8 FFF L2 D"
melodyEnd
PAUSE 500
PLAYQB "T120MLO2L1Eee"
melodyEnd
PAUSE 500
PLAYQB "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

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

Jim

VK7JH
MMedit MMBasic Help

TassyJim

Guru

Joined: 07/08/2011
Location: Australia
Posts: 5917

Posted: 07:38am 16 Aug 2020

Copy link to clipboard

Print this post

The next one takes Nokia RTL ring tones and does the same - converts them to DATA statements.

' 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 ""

Jim

VK7JH
MMedit MMBasic Help

capsikin
Guru

Joined: 30/06/2020
Location: Australia
Posts: 341

Posted: 10:50am 16 Aug 2020

Copy link to clipboard

Print this post

Cool. Just to check, this just plays a note 3 times for 2 seconds each right, almost the same as playing it for 6 seconds?

PLAYQB "T120MLO2L1Eee"

I liked the other sound strings.
To me they sound better as square waves than sine waves though.
Edited 2020-08-16 21:00 by capsikin

Womble

Senior Member

Joined: 09/07/2020
Location: United Kingdom
Posts: 267

Posted: 01:07pm 16 Aug 2020

Copy link to clipboard

Print this post

TassyJim said This first offering reads QB style sound strings and converts them into DATA statements.
You can either use the function directly in your program or use it as a utility to convert QB strings to use later.

TassyJim said The next one takes Nokia RTL ring tones and does the same - converts them to DATA statements.

Nice work Jim
I had been looking at the QBasic PLAY command and wondering how to port something similar

TassyJim

Guru

Joined: 07/08/2011
Location: Australia
Posts: 5917

Posted: 09:05pm 16 Aug 2020

Copy link to clipboard

Print this post

capsikin said Cool. Just to check, this just plays a note 3 times for 2 seconds each right, almost the same as playing it for 6 seconds?

PLAYQB "T120MLO2L1Eee"

Yes
It was a test to make sure that there was no audible gap between notes.
I also think that there was a maximum play time for individual notes.

I wrote these functions 10 months ago and forget some of the sources.
Most of the QB ones come from "Gorilla", something that I started converting and will get back to sometime.

Jim

VK7JH
MMedit MMBasic Help

Womble

Senior Member

Joined: 09/07/2020
Location: United Kingdom
Posts: 267

Posted: 09:10pm 16 Aug 2020

Copy link to clipboard

Print this post

TassyJim said Most of the QB ones come from "Gorilla", something that I started converting and will get back to sometime.

"GORILLA.BAS" classic QBasic game. I was looking at doing Reversi/Othello

Good work with the sounds stuff Jim

Print this page

To reply to this topic, you need to log in.