QB like PLAY plus more...

Zippy · Post by **Zippy** » May 25, 2009 14:26

The mystery deepens..

This play "cdefgab" and angros' code works for me. 7 distinct notes of equal length.

phishguy · Post by **phishguy** » May 25, 2009 15:24

Hmm. I'm using FB version 0.20.0 on windows XP pro. My computer is a 3.0 gHz pentium 4 with integrated Soundmax audio. This is puzzling since the code from Mysoft works with no problems at all.

angros47 · Post by **angros47** » May 25, 2009 16:29

Ehm... that's embarassing...

Find the lines:

Code: Select all

      Play_loop:

And add:

Code: Select all

      Play_loop:
      SLEEP 1

Test it again (the bug hits only computers faster than 1,3 GHz... that's why some of us don't see it)

Zippy · Post by **Zippy** » May 25, 2009 16:39

I hate it when this happens..

Using: fb Version 0.21.0 (01-25-2009)

On XPPro SP3, play "cdefgab" drops "e" and "b". I'd swear that the first time 6 notes played, only "e" dropped..

On Vista Biz SP1 all 7 notes play..

Unlikely that hardware is the issue (it would be if I tried this on my P233..). I'm pretty ignorant of Windows MMedia, but this seems to point to.. the version of mm.

angros' Sleep 1 fix didn't fix on XP. Both of my testbeds have cpus >2ghz. I don't think this is a fault of angros' code, but what do I know.

Would someone post a more elaborate test, something recognizable >7notes?

angros47 · Post by **angros47** » May 25, 2009 16:53

It seems that the problem is at:

Code: Select all

      For ch As Integer=0 To 15
        If stop_timer(ch)-timer<duration*(1.0-note_len_mod) Then midiNoteOff midiHandle, ch
      Next

These lines should stop notes while playng polyphonic tunes, try commenting them out (if you are playing a monophonic tune they shouldn't be necessary)
My idea is that, on very fast hardware, somehow the program stops a note just when it's being played, so you cannot hear it. So debugging the program is not easy, because a debug function (even some PRINTs, to keep trace of it) may slow it down enough to hide the bug.

phishguy · Post by **phishguy** » May 25, 2009 16:59

The sleep fixes it on my PC. Is there any way to change the length of the note other than the L command. In the version by mysoft you can send A16 B8 C4 etc.

Zippy · Post by **Zippy** » May 25, 2009 17:03

The sleep DID NOT fix for me & XP.

Commenting-out For/Next fixed for me & XP, does not break Vista.

The Vista box has a 2.67ghz Intel dual core, the XP a 2.67ghz Celery.

A more elaborate example? Something long enough to eliminate startup delays?

phishguy · Post by **phishguy** » May 25, 2009 19:55

Well, that fix wouldn't be very good for me. I really wanted polyphonic capabilities. I would especially like to be able to play different instruments at the same time.

Zippy · Post by **Zippy** » May 25, 2009 20:24

I give up..

Now "sleep 1" works on both OS without commenting anything out. This with the 7 note test. I can't test anything else without an example to test.. Echo echo echo.

phishguy · Post by **phishguy** » May 25, 2009 22:30

I too would like some examples. I can't seem to get sharps or flats to work and I don't understand what the h string does. Also, is it possible to play notes from different instruments at the same time?

angros47 · Post by **angros47** » May 26, 2009 11:03

The "h" commands change the playing voice, while the "i" command set the instrument for the current voice. So you can play two instruments at once with something like:

Code: Select all

PLAY "h1i1c h2i5d"

The parser will pause every time a note is played on a voice that has still not finished previous note (or pause), so to play two instruments at the same time you have to "flip" from a voice to another:

Code: Select all

PLAY "h1 c h2 e h1 a h2 d"

this should (I haven't FB on this computer, so I cannot test it now...) play two note at the same time, then another two.

I know that it's not very easy, but using different strings for every voice (like in MSX or in Commodore 128, for example) would have caused too many sync problems.

phishguy · Post by **phishguy** » May 26, 2009 11:54

OK, I get that now. How do you use sharps and flats? I can't seem to be able to get them to work.

angros47 · Post by **angros47** » May 26, 2009 20:03

You should use + and -, like:

Code: Select all

Play "cc+d"

Because of a little bug, it doesn't work. Here is the correct version:

Code: Select all


'subject: midi strings a-minor chord
'author : angros47 (based on works by vspickelen and Randy Keeling)
'code   : freebasic 0.20b win
#INCLIB "winmm"

'winapi prototypes
Declare Function midClose Alias "midiOutClose" (Byval hMidiOut As Integer) As Integer
Declare Function midiOpen Alias "midiOutOpen" (Byref lphMidiOut As Integer, Byval uDeviceID As Integer, Byval dwCallback As Integer, Byval dwInstance As Integer, Byval dwFlags As Integer) As Integer
Declare Function midiMsg Alias "midiOutShortMsg" (Byval hMidiOut As Integer, Byval dwMsg As Integer) As Integer
Declare Sub _fbplay_internal_PlayNote (Byval Note As Integer, Byval Octave As Integer, _ 
   Byval Duration As Single, Byval Instrument As Integer = 0, _ 
   Byval Volume As Integer = 127, Byval Channel As Integer = 0, _ 
   midiHandle As Integer) 
Declare Sub _fbplay_internal_thread ( Byval threadId As Integer ) 
Declare Function _fbplay_internal_translateNote(toTranslate As String) As Ubyte
Declare Sub midiNoteOn (Byval hmidiOut As Integer, Byval Note As Integer, _ 
   Octave As Integer = 4, Velocity As Integer = 127, Channel As Integer = 0)
Declare Sub midiNoteOff (Byval hmidiOut As Integer, Channel As Integer = 0)
Declare Sub midiSend(Byval hmidiOut As Integer, Byval statusmsg As Integer,_
   Byval data1msg As Integer, Byval data2msg As Integer = 0) 



Dim Shared _fbplay_internal_playstr As String 

Sub Play (playstr As String) 
   Dim thread_handle As Any Ptr
   Dim thread_count As Uinteger Ptr
    
   _fbplay_internal_playstr=trim(playstr) 
'   _fbplay_internal_thread 0 
'   thread_handle = threadcreate( @_fbplay_internal_thread, thread_Count) 
    
'   if thread_handle = 0 then    'thread creation failed for some reason 
'      midiError = "UNABLE TO CREATE THREAD"
'      exit sub      'quit quitly       
'   end if 
    
   If Lcase$(Left$(_fbplay_internal_playstr,2))="mf" Then    'supposed to play in foreground 
      _fbplay_internal_thread 0 
   Else
      thread_handle = threadcreate( @_fbplay_internal_thread, thread_Count)
   End If 
    
   thread_count+=1 
End Sub 
    

Sub _fbplay_internal_thread ( Byval threadId As Integer ) 
   
   'default tempo is 120 quarter notes per minute 
   'default note is a quarter note 
   'as default notes play their full length 
   'default octave is the 4th 
   'default instrument is acoustic grand piano |TODO: Find a instrument closer to QB's PLAY sound. 
   'maximum volume is default 
   'default channel is min channel
   
   Dim tempo As Uinteger = 120
   Dim note_len(15) As Ubyte 
   Dim note_len_mod As Double = 1
   Dim octave(15) As Ubyte 
   Dim instrument(15) As Ubyte  
   Dim volume(15) As Ubyte 
   Dim channel As Ubyte = 0
    
   Dim tmpOctave As Ubyte
   Dim tmpNote As Ubyte
   
   Dim freq As Double 
   Dim duration As Double
   Dim idx As Ubyte 
   
   Dim number As String
   Dim char As String*1 
   Dim tChar As String*1
   
   Dim pause_len As Ubyte 
   Dim stop_timer(15) As Double 
   Dim chords As Ubyte=0

   Dim midiHandle As Integer 
   Dim toTranslate As String
   
   Dim p As Integer 
   
   For p=0 To 15
     note_len(p)=4
     octave(p)=4
     volume(p)=127
   Next

   p=1

   midiOpen(midiHandle, -1, 0, 0, 0) 
   

   
   Do While p <= Len(_fbplay_internal_playstr)
      char=Lcase$(Mid$(_fbplay_internal_playstr, p, 1)) 
      p+=1
      Play_loop:
sleep 1
      For ch As Integer=0 To 15
        If stop_timer(ch)-timer<duration*(1.0-note_len_mod) Then midiNoteOff midiHandle, ch
      Next


      Select Case char 
      
      'basic playing 
         Case "n"      'plays note with next-comming number, if 0 then pause 
            number="" 
            Do 
               tchar=Mid$(_fbplay_internal_playstr, p, 1) 
               If Asc(tchar)>=48 And Asc(tchar)<=57 Then 
                    p+=1
                    number+=tchar 
               Else 
                  Exit Do 
               End If 
            Loop 
            idx=Val(number) 

            If idx=0 Then 'pause 
               If timer<stop_timer(channel) Then Goto Play_loop
               duration=60/tempo*(4/note_len(channel))*note_len_mod/60 
               stop_timer(channel)=Timer+duration
            Else 'note
               If timer<stop_timer(channel) Then Goto Play_loop
               duration=60/tempo*(4/note_len(channel))*note_len_mod
               tmpOctave=idx\12 
               tmpNote=idx-(tmpOctave*12) 
               _fbplay_internal_PlayNote tmpNote, tmpOctave, duration, instrument(channel), volume(channel), channel, midiHandle 
               stop_timer(channel)=Timer+duration 
            End If 
            
       
         Case "a" To "g"      'plays a to g in current octave          
            duration=60/tempo*(4/note_len(channel))'*note_len_mod 
             
            toTranslate=char 

            If chords=0 And timer<stop_timer(channel) Then Goto Play_loop
            If Lcase$(Mid$(_fbplay_internal_playstr, p, 1))="-" Then 
               toTranslate+="b" 
               p+=1 
            Elseif Lcase$(Mid$(_fbplay_internal_playstr, p, 1))="+" Then 
               toTranslate+="s" 
               p+=1 
            End If 
               _fbplay_internal_PlayNote _fbplay_internal_translateNote(toTranslate), octave(channel), duration, instrument(channel), volume(channel), channel, midiHandle
               stop_timer(channel)=Timer+duration 
       
         Case "p"      'pauses for next-comming number of quarter notes 
            If timer<stop_timer(channel) Then Goto Play_loop
            number="" 
            Do 
               char=Mid$(_fbplay_internal_playstr, p, 1) 
               If Asc(char)>=48 And Asc(char)<=57 Then 
                    p+=1 
                    number+=char 
               Else 
                  Exit Do 
               End If 
            Loop 
            pause_len=Val(number) 
            duration=60/tempo*pause_len*note_len_mod/60 
            stop_timer(channel)=Timer+duration 
             
       
      'octave handling 
         Case ">"      'up one octave 
            If octave(channel)<10 Then octave(channel)+=1
             
         Case "<"      'down one octave 
            If octave(channel)>0 Then octave(channel)-=1 
             
         Case "o"      'changes octave to next-comming number 
            number="" 
            Do 
               char=Mid$(_fbplay_internal_playstr, p, 1) 
               If Asc(char)>=48 And Asc(char)<=57 Then 
                    p+=1 
                    number+=char 
               Else 
                  Exit Do 
               End If 
            Loop 
            octave(channel)=Val(number) 
             
             
      'play control 
         Case "t"      'changes tempo (quarter notes per minute) 
            number="" 
            Do 
               char=Mid$(_fbplay_internal_playstr, p, 1) 
               If Asc(char)>=48 And Asc(char)<=57 Then 
                  p+=1 
                  number+=char 
               Else 
                  Exit Do 
               End If 
            Loop 
            tempo=Val(number) 

         Case "l"      'changes note length (1=full note, 4=quarter note, 8 eigth(?) note aso) 
            number="" 
            Do 
               char=Mid$(_fbplay_internal_playstr, p, 1) 
               If Asc(char)>=48 And Asc(char)<=57 Then 
                  p+=1 
                  number+=char 
               Else 
                  Exit Do 
               End If 
            Loop 
            note_len(channel)=Val(number) 
          
         Case "m"      'MS makes note last 3/4, MN is 7/8 and ML sets to normal length 
            char=Lcase$(Mid$(_fbplay_internal_playstr, p, 1)) 
            p+=1 
            If char="s" Then note_len_mod=3/4
            If char="n" Then note_len_mod=7/8 
            If char="l" Then note_len_mod=1 
          
          
      'new midi fucntions 
         Case "i" 
            number="" 
            Do 
                
               char=Mid$(_fbplay_internal_playstr, p, 1) 
               If Asc(char)>=48 And Asc(char)<=57 Then 
                    p+=1
                    number+=char 
               Else 
                  Exit Do 
               End If 
            Loop 
            instrument(channel)=Val(number)
            
          
         Case "v" 
            number="" 
            Do 
               char=Mid$(_fbplay_internal_playstr, p, 1) 
               If Asc(char)>=48 And Asc(char)<=57 Then 
                  p+=1
                  number+=char 
               Else 
                  Exit Do 
               End If 
            Loop 
            volume(channel)=Val(number) 
            
         Case "h" 
            number="" 
            Do 
               char=Mid$(_fbplay_internal_playstr, p, 1) 
               If Asc(char)>=48 And Asc(char)<=57 Then 
                  p+=1
                  number+=char 
               Else 
                  Exit Do 
               End If 
            Loop 
            channel=Val(number) 
         Case "{"      'enable chords (notes play simultaneously)
            If timer<stop_timer(channel) Then Goto Play_loop
            chords=1 
         Case "}"      'disable chords
            chords=0
        Case Else
            'midiError = "UNHANDLED VALUE AT LOCATION " + str$(p)
      End Select 
    Loop
   For channel=0 To 15
      While timer<stop_timer(channel): Wend 
   Next
   midClose midiHandle 
End Sub 

Function _fbplay_internal_translateNote(toTranslate As String) As Ubyte
   Dim translated As Ubyte

   Select Case toTranslate 
      Case "c"  : translated = 0 
       
      Case "cs" : translated = 1 
      Case "db" : translated = 1 
       
      Case "d"  : translated = 2 
       
      Case "ds" : translated = 3 
      Case "eb" : translated = 3 

      Case "e"  : translated = 4 
      Case "fb" : translated = 4 
       
      Case "f"  : translated = 5 
      Case "es" : translated = 5 
       
      Case "fs" : translated = 6 
      Case "gb" : translated = 6 
       
      Case "g"  : translated = 7 
       
      Case "gs" : translated = 8 
      Case "ab" : translated = 8 
       
      Case "a"  : translated = 9 
       
      Case "as" : translated = 10 
      Case "bb" : translated = 10 
       
      Case "b"  : translated = 11 
      Case "cb" : translated = 11 
   End Select 
    
   _fbplay_internal_translateNote = translated 
End Function 

Sub _fbplay_internal_PlayNote (Byval Note As Integer, Byval Octave As Integer, _ 
   Byval Duration As Single, Byval Instrument As Integer = 0, _ 
   Byval Volume As Integer = 127, Byval Channel As Integer = 0, _ 
   midiHandle As Integer) 
    
   Dim t As Single = 0

    
   'midiSetInstrument midiHandle, Instrument, Channel 

   midiSend midiHandle, &HC0 + Channel , Instrument

   midiNoteOn midiHandle,Note,Octave, Volume, Channel
    
   t = Timer + Duration 
'   do while t > timer 
'      sleep 10 
'   loop 
    
'   midiNoteOff midiHandle,  Channel
End Sub 


Sub midiNoteOn (Byval hmidiOut As Integer, Byval Note As Integer, _ 
   Octave As Integer = 4, Velocity As Integer = 127, Channel As Integer = 0)

   midiSend hmidiOut, &H90 + Channel, Octave * 12 + Note, Velocity
End Sub

Sub midiNoteOff (Byval hmidiOut As Integer, Channel As Integer = 0)

   midiSend hmidiOut, &HB0 + Channel, &H7B   'Octave * 12 + Note
End Sub

Sub midiSend(Byval hmidiOut As Integer, Byval statusmsg As Integer,_
   Byval data1msg As Integer, Byval data2msg As Integer = 0) 
   
   'added R.Keeling 24 March 05
  Dim midiMessage As Integer
  Dim lowint As Integer
  Dim highint As Integer

  lowint = (data1msg * &H100) + statusmsg 
  highint = (data2msg * &H100) * &H100 
  midiMessage = lowint + highint 
  midiMsg hmidiOut, midiMessage 
End Sub



Sub Sound (Byval frequency As Single, Byval Duration As Single, Channel As Integer = 2)
'the ratio between notes... 2 ^ (1 / 12)
Const RBN = 1.0594630943592952646

'the log(RBN)
Const LRBN = 0.057762265046662109118

'RBN squared minus 1
Const SRBNM = 0.1224620483093729814

'the Hertz Frequency of the lowest midi Note   
Const midiNoteZeroFreq = 8.1757989156437073336



   Dim f As Single
   Dim x As Integer
   Dim w As Single
   Dim k As Single
   Dim s As Single
   Dim msb As Integer
   Dim lsb As Integer
   Dim hmidi As Integer
      
   f = frequency
   midiOpen(hmidi, -1, 0, 0, 0)

   'we are only going to allow sound frequency between 10 and 14000 hertz
   'the average human with GOOD hearing can hear between 20-20000 hertz
   'so this isn't too bad
   '
   'besides, after 5000 its almost all the same :-) annoying
   If f < 10 Then f = 10
   If f > 14000 Then f = 14000
   
   'we use this a couple of times, so lets save it
   'b = midiNoteZeroFreq
   
   s = f / midiNoteZeroFreq
   
   'LRBN is the Log of the Ration Between Two Notes, i.e. the Log(n)
   x = Int(Log(s)/LRBN)
   w = RBN^x
   k = 64 * ((s - w)/(w*SRBNM))
   
   msb = Int(k) + 64
   lsb = Int((k - Int(k)) * 127)
   
   'do the midi stuff
   'the channel, I used 2, because the default play note is on 0
   Dim o As Integer
   Dim n As Integer
   Dim t As Single
   n = x Mod 12
   o = (x-n)/12
'   midiOpen(hmidi, -1, 0, 0, 0)
'   midiSetMainVolume hmidi, 127, 2
'   midiSetInstrument hmidi, Voice, 2
'   midiSetPitchBend hmidi, lsb, msb, 2   

   midiSend hmidi, &HC0 + Channel , 56

   midiSend hmidi, &HE0 + Channel, lsb, msb
   midiNoteOn hmidi, n, o, 127, 2

   t = Timer + duration
   Do While t > Timer
'      sleep 10
   Loop
   midiNoteOff hmidi, 2
   midiSend hmidi, &HE0 + Channel, 0, 64
   midClose hmidi
End Sub

phishguy · Post by **phishguy** » May 26, 2009 20:52

Thanks! I'll try it out when I get home.

TESLACOIL · Post by **TESLACOIL** » Feb 29, 2012 16:20

cant compile the code above , i get this warning

warning 3(1): Passing different pointer types, at parameter 1 of THREADCREATE()

QB like PLAY plus more...

Re: QB like PLAY plus more...