Getting PLAY to Work in FreeBasic

New to FreeBASIC? Post your questions here.
davidshq
Posts: 52
Joined: Oct 29, 2008 3:28
Contact:

Getting PLAY to Work in FreeBasic

Postby davidshq » Dec 01, 2016 7:09

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
Posts: 2756
Joined: Jun 02, 2015 16:24

Re: Getting PLAY to Work in FreeBasic

Postby Tourist Trap » Dec 02, 2016 10:33

Hi,

you may check this topic : viewtopic.php?f=7&t=12995. It seems to deal with a PLAY command implementation for fb, though not an official one.
Lothar Schirm
Posts: 333
Joined: Sep 28, 2013 15:08
Location: Bavaria, Germany

Re: Getting PLAY to Work in FreeBasic

Postby Lothar Schirm » Dec 02, 2016 15:08

davidshq wrote: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
Posts: 1892
Joined: Sep 25, 2005 21:54

Re: Getting PLAY to Work in FreeBasic

Postby srvaldez » Dec 02, 2016 17:17

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
Posts: 333
Joined: Sep 28, 2013 15:08
Location: Bavaria, Germany

Re: Getting PLAY to Work in FreeBasic

Postby Lothar Schirm » Dec 03, 2016 15:55

@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
Posts: 52
Joined: Oct 29, 2008 3:28
Contact:

Re: Getting PLAY to Work in FreeBasic

Postby davidshq » Dec 03, 2016 16:08

@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
Posts: 333
Joined: Sep 28, 2013 15:08
Location: Bavaria, Germany

Re: Getting PLAY to Work in FreeBasic

Postby Lothar Schirm » Dec 03, 2016 16:29

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/.
Last edited by Lothar Schirm on Dec 06, 2016 15:32, edited 3 times in total.
dodicat
Posts: 5703
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Getting PLAY to Work in FreeBasic

Postby dodicat » Dec 03, 2016 17:38

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
Posts: 52
Joined: Oct 29, 2008 3:28
Contact:

Re: Getting PLAY to Work in FreeBasic

Postby davidshq » Dec 03, 2016 20:40

Thanks everyone! I'll give these a try and let you know what happens!
Lothar Schirm
Posts: 333
Joined: Sep 28, 2013 15:08
Location: Bavaria, Germany

Re: Getting PLAY to Work in FreeBasic

Postby Lothar Schirm » Dec 07, 2016 15:00

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

Return to “Beginners”

Who is online

Users browsing this forum: No registered users and 2 guests