FreeBASIC MIDI 音を再生

'Thanks to Mysoft who showed, how to use MIDI on Windows
'Link : https://www.freebasic.net/forum/viewtopic.php?t=12995
'Title: QB like PLAY plus more...

#include once "windows.bi"
#include once "win\mmsystem.bi"

Const screenwidth=320
Const screenheight=240
Screenres screenwidth, screenheight, 32

Const gridwidth=320
Const gridheight=24*8+2
Dim Shared GridImg As Any Ptr
GridImg= ImageCreate(gridwidth, gridheight, RGB(0, 0, 0))

type MidiMessage field=1 
  Number as UByte
  ParmA as UByte
  ParmB as UByte
  Reserved as UByte
end Type

Dim Shared As UByte grid(16,24)
Dim Shared As Integer gridx=6
Dim Shared As Integer gridy=16

Const maxframes=12
Dim Shared As Integer frameShift(maxframes)
Dim Shared As Integer numframes
Dim Shared As Integer frame

Dim Shared As UByte program
Dim Shared As Integer noteshift
Dim Shared As Integer play
Dim Shared As Integer mute

Sub display
  Dim As String msg
  msg="     Instr:"+str(program)
  If play Then msg+=" Play:"+str(frame+1)
  msg+=" +"+str(noteshift)
  If mute Then msg+=" Mute"
  Line (0,214) - Step (screenwidth-1,8), 0, BF
  Draw String (0,214),(msg)
End Sub

Const helpmax=6
Dim Shared As Integer helpcounter
Dim Shared As String*40 help(helpmax) => { _
  "   ESC:       Quit Program              ", _
  "   Space:     Mute                      ", _
  "   0..9:      Note Offset (Chord)       ", _
  "   +/-:       Instrument                ", _
  "   p:         Play Blues Scheme         ", _
  "   Alt+Enter: Fullscreen                ", _
  "       (C) by oog / proog.de            " _
}

Sub display_help
  Dim As String msg
  Line (0,226) - Step (screenwidth-1,8), 0, BF
  Draw String (0,226),help(helpcounter Shr 1),&h408040
  helpcounter+=1
  If (helpcounter-1)>(helpmax*2) Then helpcounter=0
End Sub


#define MidiSendMessage(MSGVAR) midiOutShortMsg(MYPLAYDEVICE, *cptr(integer ptr,@MSGVAR))

dim shared as HMIDIOUT MYPLAYDEVICE     '// MIDI device interface for sending MIDI output

' init
  var FLAG = midiOutOpen(@MYPLAYDEVICE, MIDI_MAPPER, 0, 0, null)
  if (FLAG <> MMSYSERR_NOERROR) Then
    print "Error opening MIDI Output."
  end If

Dim Shared as MidiMessage MidiMsg
MidiMsg.Reserved = 0

Sub NoteOn(channel As UByte, note As UByte, velocity As UByte)
  'note on
  MidiMsg.Number = &h90 + (channel And &hf)
  MidiMsg.ParmA = (note And &h7f)   'NOTE
  MidiMsg.ParmB = (velocity And &h7f) 'volume
  MidiSendMessage(MidiMsg)
End Sub

Sub NoteOff(channel As UByte, note As UByte, velocity As UByte)
  'note on
  MidiMsg.Number = &h80 + (channel And &hf)
  MidiMsg.ParmA = (note And &h7f)   'NOTE
  MidiMsg.ParmB = (velocity And &h7f) 'volume
  MidiSendMessage(MidiMsg)
End Sub

Sub ProgramChange(channel As UByte, program As UByte)
  'note on
  MidiMsg.Number = &hc0 + (channel And &hf)
  MidiMsg.ParmA = (program And &h7f)
  MidiMsg.ParmB = 0
  MidiSendMessage(MidiMsg)
End Sub

Sub showgrid(cursor As Integer)
  Dim As Integer x,y
  Dim As uint bg,fg
  For x=0 To 15
    If cursor=x Then
      bg=rgb(40,40,40)
      fg=rgb(200,40,40)
    Else
      bg=rgb(20,20,20)
      fg=rgb(255,60,60)
    EndIf
    'Line (10+2+x*20, 10-2) - Step (3,243), rgb(10,10,10),BF
    For y=0 To 23
      If grid(x,y)=0 Then
        Line GridImg,(1+x*20, 1+y*8) - Step (6,6), bg, BF
      Else
        Line GridImg,(1+x*20, 1+y*8) - Step (6,6), fg, BF
      EndIf
    Next y
  Next x
End Sub


Sub playgrid(cursor As Integer)
  Dim As Integer x,x0,y,bg,fg
  x=cursor
  x0=cursor-1
  If x0<0 Then x0=15
  For y=0 To 23
    If grid(x0,y)<>0 Then NoteOff(0,57-y+23+noteshift,127)
  Next y
  
  'next frame
  If play Then
    If cursor=15 Then
      frame+=1
      If frame=numframes Then frame=0
    EndIf
    If cursor=0 Then
      noteshift=frameShift(frame)
      display
    EndIf
  Else
    frame=0
  EndIf
  
  For y=0 To 23
    If (grid(x,y)<>0) AndAlso (Mute=0) Then NoteOn(0,57-y+23+noteshift,127)
  Next y
End Sub


Dim Shared As Integer mxnote, mynote
Function CheckMouse(x As Integer, y As Integer) As Integer
  Dim As Integer tx, px, ty, py
  tx=(x-gridx) Mod 20
  px=(x-gridx)/20
  If (px>=0) AndAlso (px<=15) AndAlso (tx>=1) AndAlso (tx<=9) Then
    ty=(y-5-gridy) Mod 8
    py=(y-5-gridy)/8
    If (py>=0) AndAlso (py<=23) Then
      mxnote=px
      mynote=py
      Return -1
    Else
      Return 0
    EndIf
  EndIf
End Function


Dim Shared As Integer mx, my, mw, mb
Dim Shared As Integer mx0, my0, mw0, mb0
Sub domouse
  mx0=mx: my0=my: mw0=mw: mb0=mb
  GetMouse(mx, my, mw, mb)
  
  Line GridImg,(mxnote*20,mynote*8) - Step (9,9), 0, B
  If CheckMouse(mx0,my0) Then
    Line GridImg,(mxnote*20,mynote*8) - Step (9,9), RGB(128,128,128), B
    If ((mb And 1)=0) AndAlso ((mb0 And 1)=1) Then
      If grid (mxnote,mynote)=1 Then
        grid (mxnote,mynote)=0
      Else
        grid (mxnote,mynote)=1
        NoteOn(0,57-mynote+23,127)
      EndIf
    EndIf
  EndIf
  
End Sub


Cls

var x=0
var bpm=120
var bpm_sleep=(60*1000*4/16/bpm)
Dim Shared As Double nextEvent
Dim Shared As String key

'set initial instrument
program=4
ProgramChange(0,program)
'mute=-1
play=-1

Dim As String msgt
msgt="ToneGrid 1"
Draw String (screenwidth/2-Len(msgt)*4,1),msgt
display

'demo song - riff
grid(0,6)=1
grid(3,11)=1
grid(4,9)=1
grid(6,14)=1
grid(8,16)=1
grid(10,18)=1
'grid(12,18)=1

'demo song - blues chords
numframes=12
frameShift(0)=0
frameShift(1)=0
frameShift(2)=0
frameShift(3)=0
frameShift(4)=5
frameShift(5)=5
frameShift(6)=0
frameShift(7)=0
frameShift(8)=7
frameShift(9)=5
frameShift(10)=0
frameShift(11)=0

nextEvent=Timer

Do
  domouse
  key=inkey
  If Timer>=nextEvent Then
    nextEvent+=(bpm_sleep/1000.0)
    Line GridImg,(0,0) - Step (gridwidth-1,gridheight-1), RGB(0,0,0), BF
    showgrid(x)
    playgrid(x)
    x+=1
    If x>15 Then
      x=0
      display_help
    EndIf
    Sleep 1
  EndIf
  Select Case key
  Case " ":
    mute=(mute=0)
    display
  Case "p":
    play=(play=0)
    If play Then
      x=0
      mute=0
    EndIf
    display
  Case "0" to "9":
    noteshift=Asc(key)-Asc("0")
    display
  Case "+":
    program=(program+1) And &h7f
    ProgramChange(0,program)
    display
  Case"-":
    program=(program-1) And &h7f
    ProgramChange(0,program)
    display
  Case chr(27):
    Exit Do
  Case chr(255)+chr(107):
    Exit Do
  End Select
  Put (gridx,gridy), GridImg, PSet
'  If key<>"" Then
'    Line (200,220) - Step (screenwidth-201,8), 0, BF
'    var s=str(Asc(key))
'    If Len(key)>1 Then s+=","+str(Asc(mid(key,2,1)))
'    Draw String (200,220),s
'  EndIf
Loop

ImageDestroy GridImg

#include "PlayMidi.bas"
'#include "PlayFMOD.bas"

dim as string NOTE,NNOT
dim as integer VIR

play "MFT110I10"
Cls
do
  read NOTE
  if NOTE = "FIM" then exit do


  do
    VIR = instr(1,NOTE,",")
    if VIR then
      NNOT = left$(NOTE,VIR-1)
      NOTE = mid$(NOTE,VIR+1)
    else
      NNOT = NOTE
    end if
    
    play NNOT
    print NNOT; ",";
    
    if inkey$ = chr$(27) then exit do,do
    
  loop until VIR = 0 
  
loop

print:print "Done!"
sleep

data "L32,O3,F16,FG,FG,F16,EF,L64,O1,B-,O2,B-,O3,DF,B-16,P16,B-16,L32"
data "B-,O4C,O3,B-,O4C,O3,B-16,AB-,O1D,O2D,O3,B-,O4D,P16,D16,DE-,DB-"
data "D16,C+D,L16,O1F,O2F,O4,F8,L32,O1,B-,O2,DF,B-,O4,DF,B-4.."
data "E3,F8,F16,L8,B-,A16,O4,C,O3,B-16,O4,D,C16,E-,D16,L64,O1,A,O2,C"
data "E-,F,O3,B8,O1,A,O2,C,E-,F,O4,C8,P8,O3,G16,L32,G,A,G,A,G16,F+,G"
data "O1,C,O2,C,O3,G,O4,C,P16,C16,C,D,C,D,C16,O3,B,O4,C,O1,E-,O2,E-,O4,C,E-"
data "P16,L32,E-16,E-,F,E-,F,E-16,D,E-,L16,O1,G,O2,G,O4,G8,O2,C,E-,G,O3,C"
data "O4,E-,G,O5,C8,C8,O4,B-8,O5,C,O4,B-,A8,B-,A,G8,A,G,F8,G,F,E-8,O2,B-"
data "O3,D,O4,C+,O2,B-,O3,D,O4,D,P8,O3,F,L32,F,G,F,G,F16,E,F,O0,B-,O1,B-"
data "O3,B-16,P16,B-16,B-,O4,C,O3,B-,O4,C,O3,B-16,A,B-,D,O4,D16,P16"
data "O3,B-16,O3,B-,O4,C,O3,B-,O4,C,O3,B-16,A,B-,O2,E-,B,O3,G16,P16,O4,C16"
data "C,D,C,D,C16,O3,B,O4,C,O3,C,E-,O4,E-16,P16,C16,C,D,C,D,C16,O3,B-,O4,C"
data "O2,F,A,O3,L16,A,P16,O4,D,L32,D,E-,D,E-,D16,C+,D,O3,D,F,O4,L16,F,P16,D"
data "L32,D,E-,D,E-,D16,C,D,O2,G,B-,O3,B-16,P16,O4,E-16,E-,F,E-,F,E-16,D,E-"
data "O2,A,O3,C,O4,C16,P16,F16,F,G,F,G,F16,E,F,O2,B-16,O3,D16,O4,D8,O2,L16E"
data "G,B-,O3,D-,O4,D-,G,B-8,A8,G,O2,F,B-,O3,D,O4,F,P4,O2,L32,F,A,O3,C,E-"
data "F,A16,P4,L16,O1,B-,O2,D,F8,O1,B-,O2,D,F8,O1,B-,O2,D,F8"
data "O3,F4,B-8,A,B-8,O4,C,D8,C,D8,E-,E4,F,D,O3,B-4,F8,F,B-B,A,O4,C8"
data "O3,B-,O4,D8,C,E-8,D,L4,O3,B,O4,C,O1,L16,A,O2,C,E-,F,O3,F4,L16,O4C8"
data "O3,B,O4,C8,D,E-6,D,E-8,F,F+4,G,E-,C4,O3,F,B,F,O4,C8,O3,B,O4,D8,C"
data "E-8,D,F8,E-,L4,C+,D,O1,B-16,O2,D16,F8,O4,D,B,O5,D8,L8,O4,E-,O5,E-"
data "O4,D,O5,D,P8,O4,D,F16,E-,D16,D4,O1,G32,B-32,O2,D32,G32,O3,B-16,O4,B-16"
data "O2,C16,E-16,O4,G8,G16,F16,E-8,L64,O2,D,O4,F32,E-16,O3,D,O4,D8,O2,D"
data "O4,E-32,D16,O3,C,O4,C8,O2,D,O4,D32,C16,O2,B-O3,B-8,O2,D,O4,C32,O3"
data "B-16,O2,A,B-,A,O2,L32,G,O3,G,O2,G,O3,G,L16,O2,D,O3,G,O1,B-,O3,G,O1,G"
data "O2,B-,O3,D,G,O5,C8,D4,C4,P8,O4,C8,E,D8,C,C4,F2,E8,D8,L64,O2,C,O4,E32"
data "D16,O3,A,O4,C8,O2,C,O4,D32,C16,O2,B-,O3,B-8,O2,C,O4,C32,O3,B-16,O2,A"
data "O3,A8,O2,C,O3,B-32,A16,O2,G,O3,G8,L16,A,O2,F,O3,G8,L32,O1,F,A,O2,C,F"
data "O3,F,A,O4,C,F8,O3,L32,G,F,E,F,L8,A,O4,C,E-,L16,O3,F,G,A,B-,O4,C,D,E-8"
data "F,G,A,B-,O5,C,D,L8,E-,C,O4,A,F,E-,C,O3,A,F,L16,O4,B-8,A,B-8,O5,C"
data "D8,C,D8,E-,E4,F,D,O4,B-4,F8,F,B-8,O4,A,O5,C8,O4,B-,O5,D8,C"
data "E-8,D,O4,B4,O5,C4,O1,A,O2,C,F,O4,F4,O5,C8,O4,B,O5,C8"
data "D,E-8,D,E-8,F+4,G,E-,C4,O4,F8,F,O5,C8,O4,B,O5,D8,C,E-8,D,F8,E-"
data "C+4,D4,O1,B-,O2,D,P8,O4,B-,O5,C8,O4,B-,A6,B-,A8,B-,O5,D,C8,O4,B-"
data "B-4,O5,C,D,E-4,O2,B-E-B-O5,C,D8,C,O4,O6,O5,C,O4,B8,O5,C,E,D8,C"
data "C3,D,E,F4,O3,C,O2,F,O3,C,O5,D,E-8"
data "D,C+8,D,C+8,D,F,E-8,D,L8,D4,G4,F,E-,O4,G,O5,D,C,C4,O4,B-4,P4,A,B-"
data "O5,C8,E-,D,O4,A,B-,F+,G,O5,E-,C,C4,O4,B-4,P8,O5,C,D,E-,E,F,D,O4,B-,G"
data "A,B-,O5,C,D,E-,L16,D8,E,D-,C,O4,B-,A,G,L8,F,A,G,F,G,A","FIM"

#include once "fmod.bi"

const PLAYRATE = 44100
const PLAYMODES = FSOUND_LOOP_OFF or FSOUND_8BITS or FSOUND_MONO or FSOUND_SIGNED
const PLAYBUFLEN = PLAYRATE*8

enum PlayModes
  pmLegato = 1
  pmNormal = 2
  pmStacato = 4
  pmPercentage = 7
  pmBackground = 16  
end enum

' init
if FSOUND_Init(PLAYRATE,4,FSOUND_STREAMABLE) = 0 then 
  print "Error Loading fmod...":sleep:end
end if

' *** Addnote to queue buffer ***
sub AddNote(FREQUENCY as single,DURATION as uinteger, MODE as integer)
  
  static as integer PCHAN,LAMP=64,FLUSH
  static as integer NOTSZ,PASZ,TMPC
  static as uinteger OUTLEN,ZFREQ,LPPT
  static as any ptr BUFPTR,CURPTR,ENDPTR,TMP
  static as FSOUND_SAMPLE ptr SAMA,SAMB  'Sample handles
  
  ' *** allocating buffers ****
  if BUFPTR = 0 then
    SAMA = FSOUND_Sample_Alloc(FSOUND_FREE,PLAYBUFLEN,PLAYMODES,PLAYRATE,128,0,0)
    SAMB = FSOUND_Sample_Alloc(FSOUND_FREE,PLAYBUFLEN,PLAYMODES,PLAYRATE,128,0,0)
    if SAMA=0 or SAMB = 0 then 
      print "Error Allocating samples!":sleep:end
    end if
    FSOUND_Sample_Lock(SAMA,0,PLAYBUFLEN,@BUFPTR,@TMP,@OUTLEN,@TMP)
    ENDPTR = BUFPTR+OUTLEN
    CURPTR = BUFPTR
    PCHAN = -1
  end if
  
  if DURATION=0 and FLUSH<>0 then FLUSH = -1
  
  ' *** swapping buffers if flush or almost full ***
  if (CURPTR+DURATION) > ENDPTR or FLUSH=-1 then
    FSOUND_Sample_Unlock(SAMA,BUFPTR,0,OUTLEN,0)    
    FSOUND_Sample_SetLoopPoints(SAMA,0,CURPTR-BUFPTR)    
    while PCHAN<>-1 andalso FSOUND_IsPlaying(PCHAN) 
      if FSOUND_GetCurrentPosition(PCHAN) >= LPPT then exit while
      sleep 1      
    wend        
    LPPT=(CURPTR-BUFPTR)-PLAYRATE*(1/64): TMPC=PCHAN
    PCHAN = FSOUND_PlaySound(FSOUND_FREE,SAMA)        
    if TMPC <> -1 then FSOUND_StopSound(TMPC)
    swap SAMA,SAMB
    FSOUND_Sample_Lock(SAMA,0,PLAYBUFLEN,@BUFPTR,@TMP,@OUTLEN,@TMP)
    ENDPTR = BUFPTR+OUTLEN
    CURPTR = BUFPTR
    FLUSH=0
  end if
  
  ' *** after swap status ***
  if DURATION=0 then 
    exit sub 
  else
    FLUSH = 1
    if (MODE and pmLegato)=0 or FREQUENCY = 0 then
      if (MODE and pmBackground) = 0 then    
        FLUSH = -1        
      end if    
    end if    
  end if
  
  ' *** computing frequency/duration details ***
  if FREQUENCY = 0 then
    ZFREQ=0
    NOTSZ=0
    PASZ=DURATION
  else
    ZFREQ = (PLAYRATE/FREQUENCY)*65536
    select case MODE and pmPercentage
    case pmLegato:  NOTSZ = DURATION
    case pmNormal:  NOTSZ = DURATION*.875
    case pmStacato: NOTSZ = DURATION*.75
    case else:      NOTSZ = DURATION*.875
    end select 
    PASZ=DURATION-NOTSZ    
  end if
  
  ' *** adding note ***
  asm
    mov edi,[CURPTR]         'Output Sample pointer
    mov esi,[NOTSZ]          'Lenght pointer
    mov edx,[ZFREQ]          'Change rate of sample
    mov eax,[LAMP]           'Default amplitude
    or esi,esi               ' \
    jz _SC_SKIP_LEN_         ' / skip if zero
    xor ecx,ecx              ' clear counter
    _SC_NEXT_PART_:       'next block
    xor al,255               'invert amplitude
    add ecx,edx              'get rate lenght
    mov bx,cx                'store remainder
    shr ecx,16               'fixed point to integer
    sub esi,ecx              'decrease remaining counter
    rep stosb                'store samples
    mov cx,bx                'retrieve remainder
    cmp esi,0                'there are more?
    jg _SC_NEXT_PART_        'yes? go process those
    _SC_SKIP_LEN_:        'skipping note
    mov [LAMP],eax           'save amplitude
    mov ecx,[PASZ]           'Pause
    or ecx,ecx               '\ skip if zero
    jz _SC_SKIP_PAUSE_       '/
    mov eax,0                'Silent
    rep stosb                'Store
    _SC_SKIP_PAUSE_:      'skipping pause
    mov [CURPTR],edi         'saving actual pointer
  end asm
  
end sub

' *** Flush Buffer when idle ***
sub PlayFlush(LASTNOTE as double ptr)
  do
    if abs(timer-*LASTNOTE) > 1 then
      AddNote(0,0,0)
    end if
    sleep 50
  loop
end sub

' *******************************************************************
' *******************************************************************
' *******************************************************************

sub Play(TEXT as string)
  
  ' notes frequencies
  static as single PLAYNOTES(142) = { 30.867, _ ' B-1 
  0,32.703   ,0,36.708   ,0,41.203   ,0,43.653   ,0,48.999   ,0,55   ,0,61.735   , _ 'C0 B0
  0,65.406   ,0,73.416   ,0,82.406   ,0,87.307   ,0,97.998   ,0,110  ,0,123.470  , _ 'C1 B1
  0,130.812  ,0,146.832  ,0,164.813  ,0,174.614  ,0,195.997  ,0,220  ,0,246.941  , _ 'C2 B2
  0,261.625  ,0,293.664  ,0,329.627  ,0,349.228  ,0,391.995  ,0,440  ,0,493.883  , _ 'C3 B3
  0,523.251  ,0,587.329  ,0,659.255  ,0,698.456  ,0,783.990  ,0,880  ,0,987.766  , _ 'C4 B4
  0,1046.502 ,0,1174.659 ,0,1318.510 ,0,1396.912 ,0,1567.981 ,0,1760 ,0,1975.533 , _ 'C5 B5
  0,2093.004 ,0,2349.318 ,0,2637.020 ,0,2793.825 ,0,3135.963 ,0,3520 ,0,3951.066 , _ 'C6 B6
  0,4186.008 ,0,4698.636 ,0,5274.040 ,0,5587.651 ,0,6271.926 ,0,7040 ,0,7902.131 , _ 'C7 B7
  0,8372.016 ,0,9397.270 ,0,10548.083,0,11175.301,0,12543.855,0,14080,0,15804.263, _ 'C8 B8
  0,16744.033,0,18794.542,0,21096.166,0,22350.605,0,25087.710,0,28160,0,31608.527, _ 'C9 B9
  0,32768 }
  
  ' middle frequencies
  if PLAYNOTES(1)=0 then
    for C as integer = 1 to 141 step 2
      PLAYNOTES(C) = (PLAYNOTES(C-1)+PLAYNOTES(C+1))/2 'semitons
    next C 
  end if
  
  'read number macros
  #define CheckNote() if STPARM then STPLAY=1:goto _PlayNote_
  #macro ReadNumber(NUMB)
  NUMBSZ=0:NUMB=0:D=C+2
  while C<TXSZ andalso TEXT[C+1] >= 48 andalso TEXT[C+1] <= 57
    NUMBSZ += 1: C += 1
  wend  
  NUMB = valint(mid$(TEXT,D,NUMBSZ))
  #endmacro
  
  #ifdef MyDebug
  dim as string NOTENAME(13) = { "C","C#","D","D#","E","E#","F","F#","G","G#","A","A#","B","B#" }
  #endif
  static as integer PT=120        'Playing quartes notes per minute
  static as integer PL=4          'Note length 1/2^(PL-1)
  static as integer PM=pmNormal   'play mode
  static as integer PO=3,PI       'Oitave
  static as integer NOTE=-1       'Note Playing
  static as integer STPARM        'Waiting Parameters
  static as integer STSIZE        'Already have size
  static as integer STCHG         'Already changed size
  static as single EXTRAATU=.5    'Extra size
  static as single EXTRATOT=1     'Extra total
  static as double LASTNOTE=0
  dim as integer STPLAY,EXTRA     'Go play!
  dim as integer TXSZ,NUMBSZ,C,D
  dim as integer NLEN,PLEN        'Calculated length
  dim as single  FREQ             'Note frequency  
  
  if LASTNOTE = 0 then ThreadCreate(cptr(any ptr,@PlayFlush),cptr(any ptr,@LASTNOTE))
    
  TEXT = ucase$(TEXT)
  TXSZ = len(TEXT)-1
  
  for C = 0 to TXSZ    
    _PlayNote_:    
    if STPLAY then
      if STSIZE=0 then STSIZE=PL
      NLEN = (((PLAYRATE*60)/(PT shr 2))*(1/STSIZE))*EXTRATOT
      LASTNOTE = timer
      if NOTE <> -1 then
        NOTE += STCHG
        #ifdef MyDebug
        print "Note: " & NOTENAME(NOTE)+string$(EXTRA,"."), _
        "  Octave: " & PO & "  Lenght: " & STSIZE
        #endif
        FREQ = PLAYNOTES(2+((PO+2)*14)+NOTE)
        AddNote(FREQ,NLEN,PM)
      else
        AddNote(0,NLEN,PM)
      end if
      STPARM=0:STSIZE=0:STCHG=0:STPLAY=0:NOTE=-1
      EXTRAATU=.5:EXTRATOT=1:EXTRA=0
    end if
    
    
    select case as const TEXT[C]    
    case asc("M")               'MODES
      CheckNote()
      C += 1: if C > TXSZ then exit for      
      select case TEXT[C]
      case asc("B"),asc("F")    ' -> Background/Foreground
        if TEXT[C]=asc("B") then 
          PM or= pmBackground
        else
          PM and= (not pmBackground)
        end if
      case asc("L")             ' -> Legato
        PM= (PM and (not pmPercentage)) or pmLegato
        'print "Mode Legato"
      case asc("N")             ' -> Normal
        PM= (PM and (not pmPercentage)) or pmNormal
        'print "Mode Normal" 
      case asc("S")             ' -> Staccato
        PM= (PM and (not pmPercentage)) or pmStacato
        'print "Mode Stacato"
      end select    
    case asc("T")              'TEMPO
      CheckNote()
      ReadNumber(PT)      
      if NUMBSZ then if PT < 32 or PT > 255 then PT = 120      
      'print "Tempo " & PT
    case asc("L")              'Length
      CheckNote()
      ReadNumber(PL)
      if NUMBSZ then if PL < 1 or PL > 64 then PL = 4
      'print "Length " & PL
    case asc("I")
      CheckNote()
      ReadNumber(PI)
      if NUMBSZ then if PI < 0 or PI > 127 then PI=0
    case asc("O")              'Octave
      CheckNote()
      ReadNumber(PO)
      if NUMBSZ then if PO < 0 or PO > 6 then PO = 3
      'print "Octave " & PO
    case asc(">")              'Increase Octave
      CheckNote()
      if PO < 6 then PO += 1
      'print "Octave " & PO
    case asc("<")              'Decrease Octave
      CheckNote()
      if PO > 0 then PO -= 1
      'print "Octave " & PO
    case asc("P")              'Pause
      CheckNote()
      ReadNumber(STSIZE)
      if STSIZE > 0 and STSIZE < 64 then
        'print "Pause: " & STSIZE
        NOTE=-1: STPLAY = 1: goto _PlayNote_
      else
        STSIZE=0
      end if
    case asc("C") to asc("G")  'Notes C-G
      CheckNote()
      STPARM = -1
      NOTE = (TEXT[C]-asc("C"))*2
      'print "Note: " & NOTE
    case asc("A") to asc("B")  'Notes A-B
      CheckNote()
      STPARM = -1
      NOTE = (TEXT[C]-asc("A")+5)*2
      'print "Note: " & NOTE
    case asc("#"),asc("+")     'Above note (sutenido)
      if STPARM andalso STCHG=0 then 
        STCHG=1
      end if      
    case asc("-")              'Below note (bemol)
      if STPARM andalso STCHG=0 then 
        STCHG=-1
        'print "Bemol"
      end if
    case asc(".")              'extra 50%
      if STPARM then 
        EXTRATOT += EXTRAATU:EXTRAATU /= 2
        EXTRA += 1
        'print "Extra: " & fix(EXTRATOT*100)
      end if
    case asc("0") to asc("9")  'notesize
      if STPARM and STSIZE=0 then
        C -= 1
        ReadNumber(STSIZE)        
        if STSIZE < 1 or STSIZE > 64 then STSIZE=0        
      end if
    end select
    
  next C  
  
  if STPARM then
    if STSIZE=0 then STSIZE=PL
    NLEN = (((PLAYRATE*60)/(PT shr 2))*(1/STSIZE))*EXTRATOT
    LASTNOTE = timer
    if NOTE <> -1 then
      NOTE += STCHG
      #ifdef MyDebug
      print "Note: " & NOTENAME(NOTE)+string$(EXTRA,"."), _
      "  Octave: " & PO & "  Lenght: " & STSIZE
      #endif
      FREQ = PLAYNOTES(2+((PO+2)*14)+NOTE)
      AddNote(FREQ,NLEN,PM)
    else
      AddNote(0,NLEN,PM)
    end if
    STPARM=0:STSIZE=0:STCHG=0:STPLAY=0:NOTE=-1
    EXTRAATU=.5:EXTRATOT=1:EXTRA=0
  end if

end sub

#include once "windows.bi"
#include once "win\mmsystem.bi"

type MidiMessage field=1  
  Number as ubyte
  ParmA as ubyte
  ParmB as ubyte
  Reserved as ubyte
end type     
#define MidiSendMessage(MSGVAR) midiOutShortMsg(MYPLAYDEVICE, *cptr(integer ptr,@MSGVAR))
#define MidiSetMessage(MSGVAR,NUMB,PAA,PBB) MSGVAR.Number=NUMB:MSGVAR.ParmA=PAA:MSGVAR.ParmB=PBB

const PLAYRATE = 1

enum PlayModes
  pmLegato = 1
  pmNormal = 2
  pmStacato = 4
  pmPercentage = 7
  pmBackground = 16  
end enum

declare sub AddNote(NOTE as short,DURATION as double,MODE as integer)
declare sub Play(TEXT as string)

dim shared as HMIDIOUT MYPLAYDEVICE     '// MIDI device interface for sending MIDI output

scope
  dim as MidiMessage MIDICONFIG
  MidiSetMessage(MIDICONFIG,&hC0,0,0)
  MidiSendMessage(MIDICONFIG)
  MidiSetMessage(MIDICONFIG,&hC1,0,0)
  MidiSendMessage(MIDICONFIG)
end scope

' init
scope
  dim as integer FLAG
  FLAG = midiOutOpen(@MYPLAYDEVICE, MIDI_MAPPER, 0, 0, null)
  if (FLAG <> MMSYSERR_NOERROR) then
    print "Error opening MIDI Output."
  end if
end scope

sub PlayFlush()
  rem nada :P
end sub

sub AddNote(NOTE as short,DURATION as double, MODE as integer)
  
  static as MidiMessage MYNOTE
  static as double TMRNOTE,NOTSZ,PASZ
  static as integer LEGATO,HADLEGA
  dim as integer FLAG
  
  if DURATION=0 then exit sub
    
  if NOTE < 1 then    
    NOTSZ=0
    PASZ=DURATION
  else
    LEGATO=0
    select case MODE and pmPercentage  
    case pmLegato:  NOTSZ = DURATION:LEGATO=1
    case pmNormal:  NOTSZ = DURATION*.75
    case pmStacato: NOTSZ = DURATION*.5
    case else:      NOTSZ = DURATION*.75
    end select 
    PASZ=DURATION-NOTSZ    
  end if
  
  with MYNOTE
    .Number = &h90+LEGATO
    .ParmA = NOTE
    .ParmB = 127  'volume
    .Reserved = 0
  end with
  
  'if abs(timer-TMRNOTE) > 1/64 then 
  TMRNOTE = timer
  if NOTSZ > 0 then
    FLAG = MidiSendMessage(MYNOTE)
    if (FLAG <> MMSYSERR_NOERROR) then
      print "Error Playing note!":sleep:end
    end if    
    while (timer-TMRNOTE) <= NOTSZ
      sleep 1
    wend
    TMRNOTE += NOTSZ
  end if  
  if HADLEGA>1 andalso LEGATO then HADLEGA=1
  if HADLEGA=1 then 
    MYNOTE.Number = &h80+HADLEGA
    MidiSendMessage(MYNOTE)
  end if
  if HADLEGA then HADLEGA -= 1
  
  MYNOTE.Number = &h80+LEGATO  
  if LEGATO = 0 then    
    FLAG = MidiSendMessage(MYNOTE)
    if (FLAG <> MMSYSERR_NOERROR) then
      print "Error Playing note!":sleep:end
    end if
  end if    
  while (timer-TMRNOTE) <= PASZ
    sleep 1
  wend
  TMRNOTE += PASZ  
  if LEGATO andalso HADLEGA=0 then HADLEGA = 1
  
end sub

' *******************************************************************
' *******************************************************************
' *******************************************************************

sub Play(TEXT as string) 'Thread(ID as any ptr)
  
  static as short  MIDINOTES(142) = { 23    , _ ' B-1 
  0,24      ,25,26      ,27,28       ,0,29      ,30,31      ,32,33  ,34,35       , _ 'C0 B0
  0,36      ,37,38      ,39,40       ,0,41      ,42,43      ,44,45  ,46,47       , _ 'C1 B1
  0,48      ,49,50      ,51,52       ,0,53      ,54,55      ,56,57  ,58,59       , _ 'C2 B2
  0,60      ,61,62      ,63,64       ,0,65      ,66,67      ,68,69  ,70,71       , _ 'C3 B3
  0,72      ,73,74      ,75,76       ,0,77      ,78,79      ,80,81  ,82,83       , _ 'C4 B4
  0,84      ,85,86      ,87,88       ,0,89      ,90,91      ,92,93  ,94,95       , _ 'C5 B5
  0,96      ,97,98      ,99,100      ,0,101    ,102,103    ,104,105,106,107      , _ 'C6 B6
  0,108    ,109,110    ,111,112      ,0,113    ,114,115    ,116,117,118,119      , _ 'C7 B7
  0,120    ,121,122    ,123,124      ,0,125    ,126,127    ,128,129,130,131      , _ 'C8 B8
  0,132    ,133,134    ,135,136      ,0,137    ,138,139    ,140,141,142,143      , _ 'C9 B9
  0,144   }
  
  #define CheckNote() if STPARM then STPLAY=1:goto _PlayNote_
  #macro ReadNumber(NUMB)
  NUMBSZ=0:NUMB=0:D=C+2
  while C<TXSZ andalso TEXT[C+1] >= 48 andalso TEXT[C+1] <= 57
    NUMBSZ += 1: C += 1
  wend  
  NUMB = valint(mid$(TEXT,D,NUMBSZ))
  #endmacro
  
  #macro AddNewNote()
  if STSIZE=0 then STSIZE=PL
  NLEN = (((PLAYRATE*60)/(PT shr 2))*(1/STSIZE))*EXTRATOT
  if NOTE <> -1 then
    NOTE += STCHG
    #ifdef MyDebug
    TMPSTR = str$(STSIZE)
    if STSIZE < 10 then TMPSTR = " "+TMPSTR
    print "Note: " & NOTENAME(NOTE)+string$(EXTRA,"."), _
    "  Oct: " & PO & "  Lnt: " & TMPSTR & _
    "  Mode: " & MODENAME(PM and pmPercentage) & _
    "  " & INSTRUMENT(PI)
    #endif
    FREQ = MIDINOTES(2+((PO+1)*14)+NOTE)
    AddNote(FREQ,NLEN,PM)
  else
    AddNote(0,NLEN,PM)
  end if
  STPARM=0:STSIZE=0:STCHG=0:STPLAY=0:NOTE=-1
  EXTRAATU=.5:EXTRATOT=1:EXTRA=0
  #endmacro
  
  #ifdef MyDebug
  static as zstring*3 NOTENAME(13) = { _
  "C","C#","D","D#","E","E#","F","F#","G","G#","A","A#","B","B#" }
  static as zstring*10 MODENAME(4) = {"","Legato  ","Normal  ","","Stacatto"}
  '"A Piano","B Chromatic Percussion","C Organ","D Guitar","E Bass", _
  '"F Strings","G Ensemble","H Brass","I Reed","J Pipe", _
  '"K Synth Lead","L Synth Pad","M","N","O","P Sound Effects" _
  static as zstring*30 INSTRUMENT(127) = { _
  "A0 Acoustic grand piano"      ,"A1 Bright acoustic piano"     , _
  "A2 Electric grand piano"      ,"A3 Honky-tonk piano"          , _
  "A4 Rhodes piano"              ,"A5 Chorused piano"            , _
  "A6 Harpsichord"               ,"A7 Clavinet"                  , _
  "B8 Celesta"                   ,"B9 Glockenspiel"              , _
  "B10 Music box"                ,"B11 Vibraphone"               , _
  "B12 Marimba"                  ,"B13 Xylophone"                , _
  "B14 Tubular bells"            ,"B15 Dulcimer"                 , _
  "C16 Hammond organ"            ,"C17 Percussive organ"         , _
  "C18 Rock organ"               ,"C19 Church organ"             , _
  "C20 Reed organ"               ,"C21 Accordion"                , _
  "C22 Harmonica"                ,"C23 Tango accordion"          , _
  "D24 Acoustic guitar (nylon)"  ,"D25 Acoustic guitar (steel)"  , _
  "D26 Electric guitar (jazz)"   ,"D27 Electric guitar (clean)"  , _
  "D28 Electric guitar (muted)"  ,"D29 Overdriven guitar"        , _
  "D30 Distortion guitar"        ,"D31 Guitar harmonics"         , _
  "E32 Acoustic bass"            ,"E33 Electric bass (finger)"   , _
  "E34 Electric bass (pick)"     ,"E35 Fretless bass"            , _
  "E36 Slap bass 1"              ,"E37 Slap bass 2"              , _
  "E38 Synth bass 1"             ,"E39 Synth bass 2"             , _
  "F40 Violin"                   ,"F41 Viola"                    , _
  "F42 Cello"                    ,"F43 Contrabass"               , _
  "F44 Tremolo strings"          ,"F45 Pizzicato strings"        , _
  "F46 Orchestral harp"          ,"F47 Timpani"                  , _
  "G48 String ensemble 1"        ,"G49 String ensemble 2"        , _
  "G50 Synth. strings 1"         ,"G51 Synth. strings 2"         , _
  "G52 Choir Aahs"               ,"G53 Voice Oohs"               , _
  "G54 Synth voice"              ,"G55 Orchestra hit"            , _
  "H56 Trumpet"                  ,"H57 Trombone"                 , _
  "H58 Tuba"                     ,"H59 Muted trumpet"            , _
  "H60 French horn"              ,"H61 Brass section"            , _
  "H62 Synth. brass 1"           ,"H63 Synth. brass 2"           , _
  "I64 Soprano sax"              ,"I65 Alto sax"                 , _
  "I66 Tenor sax"                ,"I67 Baritone sax"             , _
  "I68 Oboe"                     ,"I69 English horn"             , _
  "I70 Bassoon"                  ,"I71 Clarinet"                 , _
  "J72 Piccolo"                  ,"J73 Flute"                    , _
  "J74 Recorder"                 ,"J75 Pan flute"                , _
  "J76 Bottle blow"              ,"J77 Shakuhachi"               , _
  "J78 Whistle"                  ,"J79 Ocarina"                  , _
  "K80 Lead 1 (square)"          ,"K81 Lead 2 (sawtooth)"        , _
  "K82 Lead 3 (calliope lead)"   ,"K83 Lead 4 (chiff lead)"      , _
  "K84 Lead 5 (charang)"         ,"K85 Lead 6 (voice)"           , _
  "K86 Lead 7 (fifths)"          ,"K87 Lead 8 (brass + lead)"    , _
  "L88 Pad 1 (new age)"          ,"L89 Pad 2 (warm)"             , _
  "L90 Pad 3 (polysynth)"        ,"L91 Pad 4 (choir)"            , _
  "L92 Pad 5 (bowed)"            ,"L93 Pad 6 (metallic)"         , _
  "L94 Pad 7 (halo)"             ,"L95 Pad 8 (sweep)"            , _
  "M96"  ,"M97"  ,"M98"  ,"M99"  ,"M100" ,"M101" ,"M102" ,"M103" , _
  "N104" ,"N105" ,"N106" ,"N107" ,"N108" ,"N109" ,"N110" ,"N111" , _
  "O112" ,"O113" ,"O114" ,"O115" ,"O116" ,"O117" ,"O118" ,"O119" , _
  "P120 Guitar fret noise"       ,"P121 Breath noise"            , _
  "P122 Seashore"                ,"P123 Bird tweet"              , _
  "P124 Telephone ring"          ,"P125 Helicopter"              , _
  "P126 Applause"                ,"P127 Gunshot" }
  dim as string TMPSTR
  #endif
  
  static as integer PT=120        'Playing quartes notes per minute
  static as integer PL=4          'Note length 1/2^(PL-1)
  static as integer PM=pmNormal   'play mode
  static as integer PO=3          'Oitave
  static as integer PI=1          'Play instrument
  static as integer NOTE=-1       'Note Playing
  static as integer STPARM        'Waiting Parameters
  static as integer STSIZE        'Already have size
  static as integer STCHG         'Already changed size
  static as single EXTRAATU=.5    'Extra size
  static as single EXTRATOT=1     'Extra total
  static as MidiMessage MIDICONFIG
  dim as integer STPLAY,EXTRA     'Go play!
  dim as integer TXSZ,NUMBSZ,C,D
  dim as double NLEN,PLEN        'Calculated length
  dim as single  FREQ             'Note frequency
  
  TEXT = ucase$(TEXT)
  TXSZ = len(TEXT)-1
  
  for C = 0 to TXSZ
    
    _PlayNote_:    
    if STPLAY then
      AddNewNote()
    end if
    
    select case as const TEXT[C]    
    case asc("M")               'MODES
      CheckNote()
      C += 1: if C > TXSZ then exit for      
      select case TEXT[C]
      case asc("B"),asc("F")    ' -> Background/Foreground
        if TEXT[C]=asc("B") then 
          PM or= pmBackground
        else
          PM and= (not pmBackground)
        end if
      case asc("L")             ' -> Legato
        PM= (PM and (not pmPercentage)) or pmLegato
        'print "Mode Legato"
      case asc("N")             ' -> Normal
        PM= (PM and (not pmPercentage)) or pmNormal
        'print "Mode Normal" 
      case asc("S")             ' -> Staccato
        PM= (PM and (not pmPercentage)) or pmStacato
        'print "Mode Stacato"
      end select
    case asc("T")              'TEMPO
      CheckNote()
      ReadNumber(PT)      
      if NUMBSZ then if PT < 32 or PT > 255 then PT = 120      
      'print "Tempo " & PT
    case asc("L")              'Length
      CheckNote()
      ReadNumber(PL)
      if NUMBSZ then if PL < 1 or PL > 64 then PL = 4
      'print "Length " & PL
    case asc("O")              'Octave
      CheckNote()
      ReadNumber(PO)
      if NUMBSZ then if PO < 0 or PO > 6 then PO = 3
      'print "Octave " & PO
    case asc("I")
      CheckNote()
      ReadNumber(PI)      
      MidiSetMessage(MIDICONFIG,&hC0,PI,0)
      MidiSendMessage(MIDICONFIG)
      MidiSetMessage(MIDICONFIG,&hC1,PI,0)
      MidiSendMessage(MIDICONFIG)
    case asc(">")              'Increase Octave
      CheckNote()
      if PO < 6 then PO += 1
      'print "Octave " & PO
    case asc("<")              'Decrease Octave
      CheckNote()
      if PO > 0 then PO -= 1
      'print "Octave " & PO
    case asc("P")              'Pause
      CheckNote()
      ReadNumber(STSIZE)
      if STSIZE > 0 and STSIZE < 64 then
        'print "Pause: " & STSIZE
        NOTE=-1: STPLAY = 1: goto _PlayNote_
      else
        STSIZE=0
      end if
    case asc("C") to asc("G")  'Notes C-G
      CheckNote()
      STPARM = -1
      NOTE = (TEXT[C]-asc("C"))*2
      'print "Note: " & NOTE
    case asc("A") to asc("B")  'Notes A-B
      CheckNote()
      STPARM = -1
      NOTE = (TEXT[C]-asc("A")+5)*2
      'print "Note: " & NOTE
    case asc("#"),asc("+")     'Above note (sutenido)
      if STPARM andalso STCHG=0 then 
        STCHG=1
      end if      
    case asc("-")              'Below note (bemol)
      if STPARM andalso STCHG=0 then 
        STCHG=-1
        'print "Bemol"
      end if
    case asc(".")              'extra 50%
      if STPARM then 
        EXTRATOT += EXTRAATU:EXTRAATU /= 2
        EXTRA += 1
        'print "Extra: " & fix(EXTRATOT*100)
      end if
    case asc("0") to asc("9")  'notesize
      if STPARM and STSIZE=0 then
        C -= 1
        ReadNumber(STSIZE)        
        if STSIZE < 1 or STSIZE > 64 then STSIZE=0        
      end if
    end select
    
  next C  
  
  if STPARM then
    AddNewNote()
  end if
  
end sub

#Include "MidiStringsA-minorChord.bas"

Print "MFt40i56{ACE}": Play "MFt40i56{ACE}"
Sleep
Print "MFt10i56 L64O4{o4GDo5G}{o4GDo5G}{o4GDo5G}L8O3{o4D#A#o5D#} L64O4{o4Fo5CF}{o4Fo5CF}{o4Fo5CF}L8O3{o4DAo5D}": Play "MFt10i56 L64O4{o4GDo5G}{o4GDo5G}{o4GDo5G}L8O3{o4D#A#o5D#} L64O4{o4Fo5CF}{o4Fo5CF}{o4Fo5CF}L8O3{o4DAo5D}"
Sleep
Print "cc+d"         : Play "cc+d"
Sleep
Print "h1i1c h2i5g"  : Play "h1i1c h2i5g"
Sleep
Print "h1 c h2 e h1 a h2 f"      : Play "h1 c h2 e h1 a h2 f"
Sleep
Print "MFt120 l8o4 cdefgab o5 c" : Play "MFt120 l8o4 cdefgab o5 c"
Sleep
Print "ネコふんじゃった0"        : Play "MFt32L50e-d-<g-4>g-rg-4e-d-<g-4>g-rg-4e-d-<g-4>g-4<e-4>g-4<d-4>frf4" _
& "e-d-<d-4>frf4e-d-<d-4>frf4e-d-<d-4>f4<e-4>f4<g-4>g-rg-4"
Sleep
Print "ネコふんじゃった1"         : Play "MFt32L64e-d-L32<g-4>g-rg-4L64e-d-L32<g-4>g-rg-4L64e-d-L32<g-4>g-4<e-4>g-4<d-4>frf4" _
& "L64e-d-L32<d-4>frf4L64e-d-L32<d-4>frf4L64e-d-L32<d-4>f4<e-4>f4<g-4>g-rg-4"
Sleep

'https://www.freebasic.net/forum/viewtopic.php?f=7&t=12995&start=15
'
'subject: midi strings a-minor chord
'author : angros47, May 26, 2009 20:03 (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