Getting PLAY to Work in FreeBasic

[davidshq]

Hi Folks,

A few years ago I asked about getting PLAY statements or something similar to work in FreeBasic.

At the time the recommendation was to use FreeBasic-Portal.de's modified version of yetifoot's sound.bas.

I ran into a problem when integrating it with my application - namely, it appears to need -lang to be one of the more modern dialects and not qb, whereas my app is using the qb lang option.

What I'm wondering is if there is a way for me to get this up and running under lang qb? My code is ready to run except for a few minor details relating to loading image files and the sound. There are a number of changes I'd have to make to get it running under lang fb. I'd like to eventually get there, but I'm hoping for a solution in the interim. Any ideas?

I'm also opening to using other code / library for this purpose. I've looked at several, but thus far I haven't found anything that seemed like it would be a better option...several handle audio files, but all I need is really basic PLAY statement support.

Thanks,
Dave

P.S. I inherited this software and am moving it from QB 4.5 to FreeBasic. While I have rights to redevelop the software, I haven't been given permission to release the source code and thus need a library that is under a permissive license or that can be dynamically linked to avoid requiring source code release for this app.

[Tourist Trap]

Hi,

you may check this topic : http://www.freebasic.net/forum/viewtopi ... =7&t=12995. It seems to deal with a PLAY command implementation for fb, though not an official one.

[Lothar Schirm]

I haven't been given permission to release the source code and thus need a library that is under a permissive license or that can be dynamically linked to avoid requiring source code release for this app.

I think there should not be a problem for you with my "PLAY" software. FBPSL (FreeBASIC-Portal-Standardlizenz) section 3 says only that it is not allowed to release source code or downloads under the license FBPSL on web sides or web portals which are similiar to the FreeBasic Portal regarding functionality and/or appearance. Or do you mean an other software?

[srvaldez]

the link by Tourist Trap points to Mysoft's implementation, I prefer the second version since it does not use inline asm, you can compile either version by Mysoft to a library and then you can use it in your qb compatible code.

[Lothar Schirm]

@davidshq,

if you want to work with lang qb, you could also use QB64 which is fully compatible with QuickBASIC (also regarding the PLAY function). I mean, translating all your QB45 stuff to lang fb is much more work than using QB64. (On the other hand, I am not a friend of that old QB style.)

[davidshq]

@Lothar - I've actually used QB64 quite a bit. I started this work years ago on FreeBasic and then moved to QB64 because of the ease of writing code...however, QB64's sound implementation utilizes LGPL licensed software which requires that any software it is integrated into be open source unless it is dynamically linked.

QB64, unfortunately, does not have a simple way to use its sound implementation in this form, meaning I'd have to open source the code, which as I mentioned above is not within the scope of license provided me. :-(

Thanks for the suggestion!

[Lothar Schirm]

I do not want to cause any problems for anybody who wants to use my downloads on FreeBASIC Portal. You can use all codes for whatever you want. The download "PLAY in FreeBASIC" can now be used without any restrictions, all my downlaods are now licensed under WTFPL http://www.wtfpl.net/.

[dodicat]

Windows.
Here is Lothar's sound for lang qb
With one of his examples-- soundtest.bas
(Somebody drowning I think!)

Code: Select all

#lang "qb"
Declare Function sound Alias"Beep"(Byval f As Integer,Byval d As Integer) As Integer
SUB Play (Melodie  AS STRING)
' Spielen einer Melodie. Subset aus dem PLAY-Befehls von QBASIC.
' Melodie ist ein String aus folgenden Kommandos (Gross- oder Kleinbuchstaben):
' - Tn = Tempo = Anzahl von Viertelnoten pro Minute (n = 32 bis 255, 
'   Default 120). Beispiel: "T180"
' - On = aktuelle Oktave (n = 0 bis 5). Beispiel: "O3"
' - < = eine Oktave tiefer
' - > eine Oktave hoeher
' - C, D, E, F, G, A, B: Noten in der aktuellen Oktave. Moegliche Suffixe:
'   + oder # Erhoehung um einen halben Ton. Beispiel: "C#" 
'   - Erniedrigung um einen halben Ton. Beispiel: "D-"
' - . = Eineinhalbfache Notenlaenge. Beispiele: "C.", "C+." oder "D-."
' - Ln = Laenge einer Note (n = 1 bis 64,  1 = ganze Note, 2 = halbe Note, 
'   4 = Viertelnote usw). Beispiel: "L4". (Individuelle Notenlaengen (Beispiel "C4")
'   werden nicht unterstuetzt.)
' - Pn = Laenge einer Pause (n = 1 bis 64,  1 = ganze Pause, 2 = halbe Pause, 
'   4 = Viertelpause usw). Beispiel: "P4"
' Beispiel: Alle meine Entchen schwimmen auf dem See 
' Play("O3 L8 CDEF L4 GG O3 L8 AAAA L2 G")

  'Tonfrequenzen in Hertz:
  #macro fill(arr,a,b,c,d,e,f)
arr(0)=a
arr(1)=b
arr(2)=c
arr(3)=d
arr(4)=e
arr(5)=f
#endmacro

Dim As Integer C(5):fill(c, 65, 131, 262, 523, 1046, 2093)
Dim As Integer Cis(5):fill(cis, 69, 139, 277, 554, 1109, 2217)
Dim As Integer  D(5):fill(d,73, 147, 294, 587, 1175, 2349)
Dim As Integer  Dis(5):fill(dis, 78, 155, 311, 622, 1244, 2489)
Dim As Integer  E(5):fill(e,82, 165, 330, 659, 1328, 2637)
Dim As Integer  F(5):fill(f,87, 175, 349, 698, 1397, 2794)
Dim As Integer  Fis(5):fill(fis,92, 185, 370, 740, 1480, 2960)
Dim As Integer  G(5):fill(g,98, 196, 392, 784, 1568, 3136)
Dim As Integer  Gis(5):fill(gis,104, 208, 415, 831, 1661, 3322)
Dim As Integer  A(5):fill(a,110, 220, 440, 880, 1760, 3520)
Dim As Integer  Ais(5):fill(ais,116, 233, 466, 932, 1865, 3729)
Dim As Integer  B(5):fill(b,123, 245, 494, 988, 1975, 3951)
 
                 
  DIM AS STRING s, s1, s2
  DIM AS INTEGER k, Wert, Okt, LWert, Tempo, Pause, freq, dur1, dur2, dur
  
  'Default-Werte:
  Okt = 3
  LWert = 4
  Tempo = 120
  dur = 60000 / (LWert * Tempo)
  dur1 = (7 / 8) * dur
  dur2 = dur - dur1
  
  s = __TRIM(Melodie)
  
  'Alle Leerzeichen entfernen (repariert Fehleingaben wie "L 16" oder "O 3"):
  DO
    k = INSTR(s, " ")
    s = LEFT$(s, k - 1) + RIGHT$(s, LEN(s) - k)
  LOOP UNTIL k = 0
  
  DO
    
    k = INSTR(s, ANY "OCDEFGABLPTocdefgablpt<>")
    'Eventuellen Schrott vorn entfernen (kann durch Formatfehler entstehen,
    'z.B. "C32", oder ungueltige Zeichen)
    IF k > 1 THEN s = RIGHT$(s, LEN(s) - k + 1)
    s1 = UCASE$(LEFT$(s, 1))
    s2 = ""
                
    SELECT CASE s1
            
    CASE "T", "L", "P"
      k = 0
      DO
        k = k + 1
        s2 = MID$(s, 1 + k, 1)
        'Wenn s2 eine Ziffer 0 bis 9 ist, an "T" dranhaengen:
        IF ASC(s2) >=48 AND ASC(s2) <=57 THEN s1 = s1 + s2
      LOOP UNTIL ASC(s2) < 48 OR ASC(s2) > 57
      IF LEN(s1) > 1 THEN
        Wert = VAL(RIGHT$(s1, LEN(s1) - 1))
        IF LEFT$(s1, 1) = "T" THEN
          Tempo = Wert
          IF Tempo < 32 THEN Tempo = 32
          IF Tempo > 255 THEN Tempo = 255
          dur = 4 * 60000 / (LWert * Tempo)
          dur1 = (7 / 8) * dur
          dur2 = dur - dur1          
        ELSEIF LEFT$(s1, 1) = "L" THEN
          LWert = Wert
          IF LWert > 64 THEN LWert = 64
          IF LWert < 1 THEN LWert = 1
          dur = 4 * 60000 / (LWert * Tempo)
          dur1 = (7 / 8) * dur
          dur2 = dur - dur1
        ELSEIF LEFT$(s1, 1) = "P" THEN
          Pause = Wert
          IF Pause > 64 THEN Pause = 64
          IF Pause < 1 THEN Pause = 1        
          'Pause spielen:
          __SLEEP 4 * 60000 / (Pause * Tempo)
        END IF
      END IF
      
    CASE "O"
      s2 = MID$(s, 2, 1)
      IF ASC(s2) >=48 AND ASC(s2) <=57 THEN
        s1 = s1 + s2
        Okt = VAL(s2)
        IF Okt < 0 THEN Okt = 0
        IF Okt > 5 THEN Okt = 5
      END IF
      
    CASE ">"
      IF Okt < 5 THEN Okt = Okt + 1
      
    CASE "<"
      IF Okt > 0 THEN Okt = Okt - 1
      
    CASE "C", "D", "E", "F", "G", "A", "B"
      s2 = MID$(s, 2, 1)
      IF s2 = "+" OR s2 = "#" THEN
        SELECT CASE s1
        CASE "C": freq = Cis(Okt)
        CASE "D": freq = Dis(Okt)
        CASE "E": freq = F(Okt)
        CASE "F": freq = Fis(Okt)
        CASE "G": freq = Gis(Okt)
        CASE "A": freq = Ais(Okt)
        CASE "B": IF Okt < 5 THEN freq = C(Okt + 1)
        END SELECT
        s1 = s1 + s2
      ELSEIF s2 = "-" THEN
        SELECT CASE s1
        CASE "C": IF Okt > 0 THEN freq = B(Okt - 1) 
        CASE "D": freq = Cis(Okt)
        CASE "E": freq = Dis(Okt)
        CASE "G": freq = Fis(Okt)
        CASE "A": freq = Gis(Okt)
        CASE "B": freq = Ais(Okt)
        END SELECT
        s1 = s1 + s2
      ELSE
        SELECT CASE s1
        CASE "C": freq = C(Okt)
        CASE "D": freq = D(Okt)
        CASE "E": freq = E(Okt)
        CASE "F": freq = F(Okt)
        CASE "G": freq = G(Okt)
        CASE "A": freq = A(Okt)
        CASE "B": freq = B(Okt)
        END SELECT
      END IF
      IF s2 = "." OR MID$(s, 3, 1) = "." THEN
        'Ton spielen:
        Sound(freq, 1.5 * dur1)
        __SLEEP 1.5 * dur2 
        s1 = s1 + "."
      ELSE
        'Ton spielen:
        Sound(freq, dur1)
        __SLEEP dur2
      END IF
           
    END SELECT
    
    'Ausgewerteten Teil des Strings s vorn abtrennen:
    s = __TRIM(s)
    s = RIGHT$(s, LEN(s) - LEN(s1))
    
  LOOP UNTIL LEN(s) = 0
  
END SUB
'============================================
'=============================================


'example (SoundTest)



dim as single t1, t2
dim as integer i

PRINT "Test der Sound-Funktion: Langsame Tonleiter, C3 bis C4"
t1 = timer
Sound(523, 500)  'C3
Sound(587, 500)  'D3
Sound(659, 500)  'E3
Sound(698, 500)  'F3
Sound(784, 500)  'G3
Sound(880, 500)  'A3
Sound(988, 500)  'B3
Sound(1046, 500) 'C4
t2 = timer
PRINT "Dauer (Soll: 4 Sekunden): "; t2 - t1
PRINT

PRINT "Test der PLAY-Funktion, Tonleiter C4 bis C5:"
Play("T130 L4 O4 CDEFG AB O5 C")
PRINT

PRINT "Und nun ein kleines Liedchen:"
PRINT "Alle meine Entchen"
Play("O3 L8 CDEF L4 GG")
FOR i = 1 TO 2
  PRINT "schwimmen auf dem See"
  Play("O3 L8 AAAA L2 G")
NEXT i
PRINT "Koepfchen in das Wasser, Schwaenzchen in die Hoeh"
Play("O3 L8 FFFF L4 EE L8 DDDDC")

sleep

 

[davidshq]

Thanks everyone! I'll give these a try and let you know what happens!

[Lothar Schirm]

Just for fun: Play keyboard with the mouse!

Code: Select all

'===============================================================================
' Keyboard.bas
' Created Dec 07, 2016
'===============================================================================

#Include "windows.bi"

Type TKey
	'Type definition for a key
	x As Integer
	y As Integer
	w As Integer
	h As Integer
	colour As Integer	'black or white
End Type

Dim As Integer i, mx, my, mb, freq(11) 
Dim As Tkey	key(11)


Sub DrawKey(Byref key As TKey)
	'Draw a key
	
	With key
		Line (.x, .y) - (.x + .w, .y + .h), .colour, BF	'filled rectangle
		Line (.x, .y) - (.x + .w, .y + .h),, B	'border
  End With
	
End Sub


'Define frequencies:
freq(0) = 523		'C
freq(1) = 554		'C#
freq(2) = 587		'D
freq(3) = 622		'D#
freq(4) = 659		'E
freq(5) = 698		'F
freq(6) = 740		'F#
freq(7) = 784		'G
freq(8) = 831		'G#
freq(9) = 880		'A
freq(10) = 932	'A#
freq(11) = 988	'B

'Define y, w, h and colour for all keys:
For i = 0 To 11
	With key(i)
    .y = 20
    Select Case i
    Case 0, 2, 4, 5, 7, 9, 11
      'white keys:
      .w = 40
      .h = 150
      .colour = &HFFFFFF
    Case Else
      'black keys:
      .w = 30
      .h = 100
      .colour = 0	'black
    End Select
  End With
Next

'Define x for white keys:
key(0).x = 20
key(2).x = key(0).x + key(0).w
key(4).x = key(2).x + key(2).w
key(5).x = key(4).x + key(5).w
key(7).x = key(5).x + key(7).w
key(9).x = key(7).x + key(7).w
key(11).x = key(9).x + key(11).w

'Define x for black keys:
key(1).x = key(2).x - key(1).w/2
key(3).x = key(4).x - key(3).w/2
key(6).x = key(7).x - key(6).w/2
key(8).x = key(9).x - key(8).w/2
key(10).x = key(11).x - key(10).w/2 

'Draw window:
Screenres 320, 200, 32
Windowtitle("Keyboard")
Color 0, &HAABB00
Cls
Draw String (20, 180), "Click keys with the mouse!"

'Draw white keys:
DrawKey(key(0))
DrawKey(key(2))
DrawKey(key(4))
DrawKey(key(5))
DrawKey(key(7))
DrawKey(key(9))
DrawKey(key(11))

'Draw black keys:
DrawKey(key(1))
DrawKey(key(3))
DrawKey(key(6))
DrawKey(key(8))
DrawKey(key(10))

'Play music:
Do
	For i = 0 To 11
		Getmouse(mx, my,, mb)
    With key(i)
      If mb = 1 And (mx > .x) And (mx < .x + .w) And (my > .y) And (my < .y + .h) _
      And Point(mx, my) = .colour Then Beep_(freq(i), 500)
    End With
  Next
	Sleep 1
Loop Until Inkey = Chr(255, 107)

End