QB like PLAY plus more...

Post your FreeBASIC tips and tricks here. Please don’t post your code without including an explanation.
Mysoft
Posts: 751
Joined: Jul 28, 2005 13:56
Location: Brazil, Santa Catarina, Indaial (ouch!)
Contact:

QB like PLAY plus more...

Postby Mysoft » Dec 25, 2008 3:45

so i have 2 different PLAY versions...

this one is using FMOD and generate squarewave sounds like QB does... soundcard output (like you get with dosbox)...

Code: Select all

#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


so just include it in your project and use the PLAY like in freebasic... but
you may want to use the FlushPlay function at the end of your code... to make flush the buffer (especially if you're in background mode) i make it to avoid the need of that but... if anything got wrong you can try it :P

and this one uses the same PLAY syntax... but uses mmsystem (midi) so it does much better than plain squarewaves... i have added instrument selection as well...

Code: Select all

#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


same thing... just add into the project and use the PLAY command...
and here is a example of music that uses many of the PLAY capabilities so i found it to be good... is the brazillian theme music... (it's adding the PlayMidi.bas version but it will work the same with the fmod version as well)

Code: Select all

#include "playmidi.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"


so finally... for those who are doesnt know the qb PLAY syntax here it goes:

Syntax:
play "Commands"

Octave and Tone Commands:

On - Sets the current octave (0 to 6)
< or > - increase/decrease octave
A-G - play the note in current octave
# or + - make the precedent note sharp
- - make the precedent note flat
In - Sets the current instrument (0 to 127) MIDI version only
here you can find the list of instruments:
Instrument list from MSDN

Duration and tempo commands:

Ln - set the length of a note (1-64) where 64 is a 1/64 length
you can use A-Gn to specify the length of the note (L is the default)
preceding a note with . will increase the duration in 50%
Pn - pause for determined length (1-64) where 64 is 1/64
Tn - set the number of quarter notes per minute (120 default)
ML - set the legato mode (notes play full length)
MS - set the staccato mode (notes play half length)
MN - set the normal mode (notes play 3/4)

Other commands:

MF - play in foreground mode (waits for a note to be done before start another)
MB - play in background mode (enqueue subsequent notes up to (7 seconds))

use PlayFlush function in FMOD mode to play the last enqueued notes...

---------------------------------------------
so that's all... have fun!
VonGodric
Posts: 997
Joined: May 27, 2005 9:06
Location: London
Contact:

Postby VonGodric » Dec 25, 2008 4:08

thats very cool. nicely done. I like the sample music :)
angros47
Posts: 1421
Joined: Jun 21, 2005 19:04

Postby angros47 » Dec 25, 2008 9:55

This has been already done many times. I tried even to port it to DOS... but I haven't yet seen a version for Linux. Anyone know how to do MIDI in Linux?
Mysoft
Posts: 751
Joined: Jul 28, 2005 13:56
Location: Brazil, Santa Catarina, Indaial (ouch!)
Contact:

Postby Mysoft » Dec 25, 2008 11:07

well i have seen none of them that are compatible with the QB o.o
rolliebollocks
Posts: 2655
Joined: Aug 28, 2008 10:54
Location: new york

Postby rolliebollocks » Dec 25, 2008 11:25

Dude-

Play "CB CB CB CB"

Truncates the first argument (the first CB)...

It is only returning 3/4, 2/3, 1/2, 0/1...

I tried the non-midi square wave version.

Check it out.

Very nice though. This is the first of these that actually works for me on Vista.
Mysoft
Posts: 751
Joined: Jul 28, 2005 13:56
Location: Brazil, Santa Catarina, Indaial (ouch!)
Contact:

Postby Mysoft » Dec 25, 2008 11:38

@rolliebollocks hum... isnt the first... is the last one that got truncated (cuz when the app exits it stop playing), adding a sleep in the end fix the problem... but yeah i tought to add a "destructor" to wait the remaining playing notes before exit ^^"
angros47
Posts: 1421
Joined: Jun 21, 2005 19:04

Postby angros47 » Dec 26, 2008 13:18

well i have seen none of them that are compatible with the QB o.o


Here is it one...

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:
      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 lcase$(mid$(_fbplay_internal_playstr, p+1, 1))="-" then
               toTranslate+="b"
               p+=1
            elseif lcase$(mid$(_fbplay_internal_playstr, p+1, 1))="+" then
               toTranslate+="s"
               p+=1
            end if
               if chords=0 and timer<stop_timer(channel) then goto Play_loop
               _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



you can use multiple instruments (I command), change channel do do poliphonic (H command) and even play chords (use curly brackets, i.e {ABC} play three notes at the same time)
Mysoft
Posts: 751
Joined: Jul 28, 2005 13:56
Location: Brazil, Santa Catarina, Indaial (ouch!)
Contact:

Postby Mysoft » Dec 26, 2008 18:22

the improvements are good as well... i didnt added anything (excluding instrument) cuz i did the compatibility first but... try the "example" that i gave with mine (translated from QB) with the one you posted... and tell if its compatible or not
angros47
Posts: 1421
Joined: Jun 21, 2005 19:04

Postby angros47 » Dec 27, 2008 10:33

I understand: it still needs some changes in the SUB Play... but first I'd like to get it works on other platforms, not only windows.

BTW, have you checked my SOUND subroutine? It seems that everyone tries to port PLAY commands to FB, adding improvements, but even the SOUND command can be improved (I added FM synthesis to it)
technoweasel
Posts: 70
Joined: Aug 06, 2008 22:47

Postby technoweasel » Jan 04, 2009 23:49

RollieBollocks, did you have trouble with the OUT example in the FB manual? Whenever I ran it, I found that err = 8, which means "no privileges." The solution is to run the program as an administrator. Of course, clicking the user account control window all the time would get annoying, so I will definitely use MySoft's method, which is great, by the way. I copied the 2nd example, added a PLAY("A,B,C,D,E,F,G,F,E,D,C,B,A") to the end, and my laptop became a piano! I am probably too enthusiastic, but for someone who has had to survive with BEEP, this was amazing. Thanks, guys.
phishguy
Posts: 1201
Joined: May 05, 2006 16:12
Location: West Richland, Wa

Postby phishguy » May 23, 2009 13:47

I'm sorry to bring up an old thread. But, I am trying the code from angros47 and am having issues. The first issue is when I play "abcdefg", the 4th and last notes don't play. This varies depending on the note length and string. Also, it is mentioned that putting notes within brackets {abd} will play a chord. This also doesn't function for me. What am I doing wrong?
angros47
Posts: 1421
Joined: Jun 21, 2005 19:04

Postby angros47 » May 24, 2009 16:41

I've just tested it, it seems to work for me. Can you please provide your code?
phishguy
Posts: 1201
Joined: May 05, 2006 16:12
Location: West Richland, Wa

Postby phishguy » May 24, 2009 19:44

It is the code you listed and variations of the play. A simple one that doesn't work for me is:

play "cdefgab"

That will skip the second and last note.

Perhaps I'm not using the correct string format. I can't even seem to change the length of the note.
angros47
Posts: 1421
Joined: Jun 21, 2005 19:04

Postby angros47 » May 25, 2009 11:28

Try PLAY "c d e f g a b " (with a final space) : if it works, the problem should be in the string parser, else the bug could be in the main play routine.

Also, try PLAY "cdefgab " (with final space), and play "d d d" (by your examples, seems that the "d" note is the one giving problem)
phishguy
Posts: 1201
Joined: May 05, 2006 16:12
Location: West Richland, Wa

Postby phishguy » May 25, 2009 12:42

Ok, I was incorrect. It actually skips the third note. It doesn't matter what notes I use and it doesn't matter if I use spaces after the notes. If I change the length of the notes with the L commend, the position of the notes that doesn't play changes. I can't change the length of a note using the note ffollowed by a number (B16).

Can you verify if you posted the correct working version of your code?

BTW, the example from Mysoft works without any problems. I was just hoping to be able to play multiple notes/instruments at the same time.

Return to “Tips and Tricks”

Who is online

Users browsing this forum: No registered users and 1 guest