Home
JAQForum Ver 20.06
Log In or Join  
Active Topics
Local Time 23:46 05 Mar 2024 Privacy Policy
Jump to

Notice. New forum software under development. It's going to miss a few functions and look a bit ugly for a while, but I'm working on it full time now as the old forum was too unstable. Couple days, all good. If you notice any issues, please contact me.

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

Author Message
TassyJim

Guru

Joined: 07/08/2011
Location: Australia
Posts: 5841
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: 5841
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: 5841
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.

© JAQ Software 2024