Test of midiOutShortMsg()

Windows specific questions.
Post Reply
D.J.Peters
Posts: 8586
Joined: May 28, 2005 3:28
Contact:

Test of midiOutShortMsg()

Post by D.J.Peters »

Simple test for sendProgramChange(), sendPitchWheelControl(), SendNoteOn(), SendNoteOff()

If you don't have any connected MIDI playback device the Windows software MIDI device are used.

Joshy

Code: Select all

#include "windows.bi"
#include "win/mmsystem.bi"

#macro inrange(v,l,h)
  if v<l then
    v=l
  elseif v>h then
    v=h
  end if
#endmacro
   
enum PatchNames
' Piano
  GrandPiano
  BrightPiano
  EGrandPiano
  HonkytonkPiano
  EPiano1
  EPiano2
  Harpsichord
  Clavi

' Chromatic Perc
  Celesta
  Glockenspiel
  MusicBox
  Vibraphone
  Marimba
  Xylophone
  TubularBells
  Dulcimer

' Organ
  DrawbarOrgan
  PercusionOrgan
  RockOrgan
  ChurchOrgan
  ReedOrgan
  Accordion
  Harmonica
  TangoAccordion

' Guitar
  NylonstrGuitar
  SteelstrGuitar
  JazzGuitar
  CleanGuitar
  MutedGuitar
  OverdriveGuitar
  DistortionGuitar
  GuitarHarmonics

' Bass
  AcousticBass
  FingeredBass
  PickedBass
  FretlessBass
  SlapBass1
  SlapBass2
  SynthBass1
  SynthBass2

' Strings/Orch
  Violin
  Viola
  Cello
  Contrabass
  TremoloStrings
  PizzictoStrings
  Harp
  Timpani

' Ensemble
  Strings1
  Strings2
  SynthStrings1
  SynthStrings2
  ChoirAahs
  VoiceOohs
  SynthVoice
  OrchestraHit

' Brass
  Trumpet
  Trombone
  Tuba
  MutedTrumpet
  FrenchHorn
  BrassSection
  SynthBrass1
  SynthBrass2

' Reed
  SopranoSax
  AltoSax
  TenorSax
  BaritoneSax
  Oboe
  EnglishHorn
  Bassoon
  Clarinet

' Pipe
  Piccolo
  Flute
  Recorder
  PanFlute
  BlownBottle
  Shakuhachi
  Whistle
  Ocarina

' Synth Lead
  SquareLead
  SawLead
  CalliopeLead
  ChiffLead
  CharangLead
  VoiceLead
  FifthLead
  BassLead

' Synth Pad
  NewAgePad
  WarmPad
  PolysynthPad
  ChoirPad
  BowedPad
  MetallicPad
  HaloPad
  SweepPad

' Synth FX
  Rain
  Soundtrack
  Crystal
  Atmosphere
  Brightness
  Goblins
  Echoes
  SciFi

' Ethnic
  Sitar
  Banjo
  Shamisen
  Koto
  Kalimba
  Bagpipe
  Fiddle
  Shanai

' Percussive
  TinkleBell
  Agogo
  SteelDrums
  Woodblock
  TaikoDrum
  MelodicDrum
  SynthDrum
  RevCymbal

' Special FX
  GtrFretNoise
  BreathNoise
  Seashore
  BirdTweet
  Telephone
  Helicopter
  Applause
  Gunshot
end enum

enum Channels
  channel1 = 0
  channel2
  channel3
  channel4
  channel5
  channel6
  channel7
  channel8
  channel9
  channel10
  channel11
  channel12
  channel13
  channel14
  channel15
  channel16
end enum

enum ControlModeChanges       ' Byte1  , Byte2
	BankSelectHi                  = &H00 ' 0-127 MSB
  ModulationwheelHi                    ' 0-127 MSB
  BreathControlHi                      ' 0-127 MSB
  UndefinedHi1                         ' 0-127 MSB
  FootControllerHi                     ' 0-127 MSB
  PortamentoTimeHI                     ' 0-127 MSB
  DataEntryHi                          ' 0-127 MSB
  ChannelVolumeHi                      ' 0-127 MSB
  BalanceHi                            ' 0-127 MSB
  
  PanHi                         = &H0A ' 0-127 MSB 
  ExpressionControllerHi               ' 0-127 MSB
  EffectControl1Hi 	                   ' 0-127 MSB
  EffectControl2Hi                     ' 0-127 MSB

  GeneralPurposeController1Hi   = &H10 ' 0-127 MSB
  GeneralPurposeController2Hi          ' 0-127 MSB
  GeneralPurposeController3Hi          ' 0-127 MSB
  GeneralPurposeController4Hi          ' 0-127 MSB

  BankSelectLo                  = &H20 ' 0-127 LSB
  ModulationWheelLo                    ' 0-127 LSB
  BreathControlLo                      ' 0-127 LSB

  FootControllerLo              = &H24 ' 0-127 LSB
  PortamentoTimeLo                     ' 0-127 LSB
  DataEntryLo                          ' 0-127 LSB
  ChannelVolumeLo                      ' 0-127 LSB
  BalanceLo                            ' 0-127 LSB

  PanLo                         = &H42 ' 0-127 LSB
  ExpressionControllerLo               ' 0-127 LSB
  EffectControl1Lo                     ' 0-127 LSB
  EffectControl2Lo                     ' 0-127 LSB

  GeneralPurposeControllerLo1   = &H30 ' 0-127 LSB
  GeneralPurposeControllerLo2          ' 0-127 LSB
  GeneralPurposeControllerLo3          ' 0-127 LSB
  GeneralPurposeControllerLo4          ' 0-127 LSB 

  DamperPedal                   = &H40 ' Sustain <63=off >64=on
  Portamento                           ' on/off  <63=off >64=on
  Sustenuto                            ' on/off  <63=off >64=on
  SoftPedal                            ' on/off  <63=off >64=on
  LegatoFootSwitch                     ' on/off  <63=off >64=on
  Hold2                                ' on/off  <63=off >64=on

  SoundController1Lo                   ' Variation  0-127 LSB
  SoundController2Lo                   ' Timbre     0-127 LSB
  SoundController3Lo                   ' Release 	  0-127 LSB
  SoundController4Lo                   ' Attack     0-127 LSB
  SoundController5Lo                   ' Brightness 0-127 LSB

  SoundController6Lo                   ' 0-127 LSB
  SoundController7Lo                   ' 0-127 LSB
  SoundController8Lo                   ' 0-127 LSB
  SoundController9Lo                   ' 0-127 LSB
  SoundController10Lo                  ' 0-127 LSB

  GeneralPurposeController5Lo          ' 0-127 LSB
  GeneralPurposeController6Lo          ' 0-127 LSB
  GeneralPurposeController7Lo          ' 0-127 LSB
  GeneralPurposeController8Lo          ' 0-127 LSB
  PortamentoControlLo                  ' 0-127 Source Note

  Effects1DepthLo               = &H5B ' 0-127 LSB
  Effects2DepthLo                      ' 0-127 LSB
  Effects3DepthLo                      ' 0-127 LSB
  Effects4DepthLo                      ' 0-127 LSB
  Effects5DepthLo                      ' 0-127 LSB
  DataEntryInc                         '= +1 	(none)
  DataEntryDec                         '= -1 	(none)
  NonRegisteredParameterNumberLo       ' 0-127 LSB
  NonRegisteredParameterNumberHi       ' 0-127 MSB
     RegisteredParameterNumberLo       ' 0-127 LSB
     RegisteredParameterNumberHi       ' 0-127 MSB

  AllSoundOff                   = &H78 ' 0
  ResetAllControllers 	               ' 0
  LocalControl                         ' 0=off 127=on 
  AllNotesOff                          ' 0
  OmniModeOff                          ' (+ all notes off) 	0
  OmniModeOn                           ' (+ all notes off) 	0
  PolyModeOnOff                        ' (+ all notes off)
  PolyModeOn                           ' (incl mono=off +all notes off) 	0
end enum    

enum MIDIEVENTS        ' statusbyte       data byte1       data byte2
  NoteOff              = &H80 'b1000:chn  note 0-127       (none)
  NoteOn               = &H90 'b1001:chn  note 0-127       velocity   0-127 
  PolyphonicAftertouch = &HA0 'b1010:chn  note 0-127       aftertouch 0-127
  ControlMode          = &HB0 'b1011:chn  (see ControlModeChanges)
  ProgramChange        = &HC0 'b1100:chn  program    0-127 (none)
  ChannelAftertouch    = &HD0 'b1101:chn  Aftertouch 0-127 (none)
  PitchWheelControl    = &HE0 'b1110:chn  LSB 0-127        MSB 0-127
  SysEx                = &HF0 'b1111:0000

  MIDITimeCode         = &HF1 'b1111:0001 

  SongPositionPointer  = &HF2 'b1111:0010
  SongSelect           = &HF3 'b1111:0011
  Undefined1           = &HF4 'b1111:0100
  Undefined2           = &HF5 'b1111:0101
  TuneRequest          = &HF6 'b1111:0110
  EOFSysEx             = &HF7 'b1111:0111
  TimingClock          = &HF8 'b1111:1000
  Undefined3           = &HF9 'b1111:1001

  MIDIStart            = &HFA 'b1111:1010
  MIDIContinue         = &HFB 'b1111:1011
  MIDIStop             = &HFC 'b1111:1100

  Undefined4           = &HFD 'b1111:1101
  ActiveSensing        = &HFE 'b1111:1110 
  SystemReset          = &HFF 'b1111:1111
end enum
              '      +1=C# +3=D#      +6=F# +8=G# +10=A#
enum OCTAVES  '    +0=C  +2=D  +4=E +5=F  +7=G  +9A   +11=B or H
  octaveM =   0 ' minus 1
  octave0 =  12
  octave1 =  24
  octave2 =  36
  octave3 =  48
  octave4 =  60 ' midle C
  octave5 =  72
  octave6 =  84
  octave7 =  96
  octave8 = 108
  octave9 = 120
end enum

enum NOTES
  _C   =  0
  _Cis =  1
  _D   =  2
  _E   =  3
  _Eis =  4
  _F   =  5
  _Fis =  6
  _G   =  7
  _Gis =  8
  _A   =  9
  _Ais = 10
  _B   = 11 ' or H
  _H   = _B 
end enum

type EVENT
  union
    as byte  bytes(3)
    as ulong event
  end union
end type

'see PatchNames for prg numbers
function sendProgramChange(hDev as HMIDIOUT, _
                           Chn  as ubyte, _
                           prg  as ubyte) as MMRESULT
  dim as EVENT ev
  inRange(chn,0, 15)
  inRange(prg,0,127)
  ev.bytes(0)=ProgramChange or Chn
  ev.bytes(1)=Prg
  return midiOutShortMsg(hDev,ev.event) 
end function 


' 7low and 7hi bits=14 bits (0 - 16383)
function sendPitchWheelControl(hDev as HMIDIOUT, _
                               chn  as ubyte , _
                               num  as ushort) as MMRESULT
  dim as EVENT ev
  inRange(chn,0,   15)
  inRange(num,0,16383)
  ev.bytes(0)=PitchWheelControl or Chn
  ev.bytes(1)=num and &H7F:num shr=7
  ev.bytes(2)=num and &H7F
  return midiOutShortMsg(hDev,ev.event) 
end function 

function SendNoteOn(hDev as HMIDIOUT, _
                    Chn  as ubyte   , _
                    Note as ubyte   , _
                    Vel  as ubyte) as MMRESULT
  dim as EVENT ev
  inRange(Chn ,0,  15)
  inRange(Note,0, 127)
  inRange(Vel ,0, 127)
  ev.bytes(0)=NoteOn or Chn
  ev.bytes(1)=Note
  ev.bytes(2)=Vel
  return midiOutShortMsg(hDev,ev.event) 
end function 

function SendNoteOff(hDev as HMIDIOUT, _
                     Chn  as ubyte, _
                     Note as ubyte) as MMRESULT
  dim as EVENT ev
  inRange(Chn ,0, 15)
  inRange(Note,0,127)
  ev.bytes(0)=NoteOff or Chn
  ev.bytes(1)=Note
  return midiOutShortMsg(hDev,ev.event) 
end function

dim as UINT_PTR uIndex = midiOutGetNumDevs()
if uIndex<1 then
  ? "error: sorry no midi output on this system!"
  beep:sleep:end
end if

dim as HMIDIOUT hDevice
if midiOutOpen(@hDevice,uIndex-1,0,0,0) then
  ? "error can't open MIDI device[!" & uIndex-1 & "] !"
  beep:sleep:end
end if


? "PitchWheel on channel 1 progam Strings2 note 60"
sendProgramChange(hDevice,Channel1,Strings2)
sleep 100
SendNoteOn(hDevice,0,60,127)
for w as single=0 to 6.28*2 step 0.1
  dim as short pitch=sin(w)*8152+8152
  ? "pitch=" & pitch
  SendPitchWheelControl(hDevice,Channel1,pitch)
  sleep 100
next
print
SendPitchWheelControl(hDevice,Channel1,0)
SendNoteOff(hDevice,Channel1,60)
? "Drum test on channel 10"
dim as ubyte velocity=100
for note as ubyte=27 to 89  
  ? "key=" & note,
  SendNoteOn(hDevice,Channel10,note,velocity)  
  sleep 500
  ' SendNoteOff(hDevice,Channel10,note)  
  
next
?
? "sound test on channel 2"
? "any key for quit ..."
dim as integer r=1
dim as ubyte prog=5,note=32
while inkey=""

  print "note " & note,
  sendNoteOn(hDevice,Channel2,note,127)
  sleep 300
  sendNoteOff(hDevice,Channel2,note)
  if r=1 then
    note+=1 
    if note=65 then
      note=63:r=-1
    end if  
  else
    note-=1 
    if note=31 then
      note=33 : r= 1
      prog+=1 : if prog=128 then prog=0
      print:print "ProgramChange: " & prog
      sendProgramChange(hDevice,Channel2,prog)
    end if  
  end if
wend

midiOutClose hDevice
grymmjack
Posts: 3
Joined: Jan 10, 2023 1:23
Location: MI, USA
Contact:

Re: Test of midiOutShortMsg()

Post by grymmjack »

NICE! Thank you. Question; is there a midiIn to complement this? Thank you for your efforts.
Post Reply