asmidi.pas

unit asmidi;

{ **************************************************************************** }
{ Rejbrand AlgoSim MIDI note generation library                                }
{ Copyright © 2017 Andreas Rejbrand                                            }
{ https://english.rejbrand.se/                                                 }
{ **************************************************************************** }

{$WARN SYMBOL_PLATFORM OFF}
{$WARN DUPLICATE_CTOR_DTOR OFF}

interface

uses
  SysUtils, Windows, Types, Classes, MMSystem;

type
  EMIDIException = class(Exception);

  TMIDIInstrumentFamily = (ifPiano, ifChromaticPercussion, ifOrgan, ifGuitar,
    ifBass, ifStrings, ifEnsemble, ifBrass, ifReed, ifPipe, ifSynthLead,
    ifSynthPad, ifSynthEffects, ifEthnic, ifPercussive, ifSoundEffects);

  TMIDIInstrument = (midiAcousticGrandPiano, midiBrightAcousticPiano,
    midiElectricGrandPiano, midiHonkytonkPiano, midiElectricPiano1,
    midiElectricPiano2, midiHarpsichord, midiClavi, midiCelesta,
    midiGlockenspiel, midiMusicBox, midiVibraphone, midiMarimba, midiXylophone,
    midiTubularBells, midiDulcimer, midiDrawbarOrgan, midiPercussiveOrgan,
    midiRockOrgan, midiChurchOrgan, midiReedOrgan, midiAccordion, midiHarmonica,
    midiTangoAccordion, midiAcousticGuitarNylon, midiAcousticGuitarSteel,
    midiElectricGuitarJazz, midiElectricGuitarClean, midiElectricGuitarMuted,
    midiOverdrivenGuitar, midiDistortionGuitar, midiGuitarharmonics,
    midiAcousticBass, midiElectricBassFinger, midiElectricBassPick,
    midiFretlessBass, midiSlapBass1, midiSlapBass2, midiSynthBass1,
    midiSynthBass2, midiViolin, midiViola, midiCello, midiContrabass,
    midiTremoloStrings, midiPizzicatoStrings, midiOrchestralHarp, midiTimpani,
    midiStringEnsemble1, midiStringEnsemble2, midiSynthStrings1,
    midiSynthStrings2, midiChoirAahs, midiVoiceOohs, midiSynthVoice,
    midiOrchestraHit, midiTrumpet, midiTrombone, midiTuba, midiMutedTrumpet,
    midiFrenchHorn, midiBrassSection, midiSynthBrass1, midiSynthBrass2,
    midiSopranoSax, midiAltoSax, midiTenorSax, midiBaritoneSax, midiOboe,
    midiEnglishHorn, midiBassoon, midiClarinet, midiPiccolo, midiFlute,
    midiRecorder, midiPanFlute, midiBlownBottle, midiShakuhachi, midiWhistle,
    midiOcarina, midiLead1Square, midiLead2Sawtooth, midiLead3Calliope,
    midiLead4Chiff, midiLead5Charang, midiLead6Voice, midiLead7Fifths,
    midiLead8BassLead, midiPad1Newage, midiPad2Warm, midiPad3Polysynth,
    midiPad4Choir, midiPad5Bowed, midiPad6Metallic, midiPad7Halo, midiPad8Wweep,
    midiFX1Rain, midiFX2Soundtrack, midiFX3Crystal, midiFX4Atmosphere,
    midiFX5Brightness, midiFX6Goblins, midiFX7Echoes, midiFX8SciFi, midiSitar,
    midiBanjo, midiShamisen, midiKoto, midiKalimba, midiBagpipe, midiFiddle,
    midiShanai, midiTinkleBell, midiAgogo, midiSteelDrums, midiWoodblock,
    midiTaikoDrum, midiMelodicTom, midiSynthDrum, midiReverseCymbal,
    midiGuitarFretNoise, midiBreathNoise, midiSeashore, midiBirdTweet,
    midiTelephoneRing, midiHelicopter, midiApplause, midiGunshot);

  TMIDIPercussionKey = (midiAcousticBassDrum = 35, midiBassDrum1, midiSideStick,
    midiAcousticSnare, midiHandClap, midiElectricSnare, midiLowFloorTom,
    midiClosedHiHat, midiHighFloorTom, midiPedalHiHat, midiLowTom,
    midiOpenHiHat, midiLowMidTom, midiHiMidTom, midiCrashCymbal1,
    midiHighTom, midiRideCymbal1, midiChineseCymbal, midiRideBell, midiTambourine,
    midiSplashCymbal, midiCowbell, midiCrashCymbal2, midiVibraslap,
    midiRideCymbal2, midiHiBongo, midiLowBongo, midiMuteHiConga, midiOpenHiConga,
    midiLowConga, midiHighTimbale, midiLowTimbale, midiHighAgogo, midiLowAgogo,
    midiCabasa, midiMaracas, midiShortWhistle, midiLongWhistle, midiShortGuiro,
    midiLongGuiro, midiClaves, midiHiWoodBlock, midiLowWoodBlock, midiMuteCuica,
    midiOpenCuica, midiMuteTriangle, midiOpenTriangle);

const
  MIDI_INSTRUMENT_FAMILIES: array[TMIDIInstrumentFamily] of string =
    ('Piano', 'Chromatic Percussion', 'Organ', 'Guitar', 'Bass', 'Strings',
     'Ensemble', 'Brass', 'Reed', 'Pipe', 'Synth Lead', 'Synth Pad',
     'Synth Effects', 'Ethnic', 'Percussive', 'Sound Effects');

  MIDI_INSTRUMENT_NAMES: array[TMIDIInstrument] of string =
    ('Acoustic Grand Piano', 'Bright Acoustic Piano', 'Electric Grand Piano',
     'Honky-tonk Piano', 'Electric Piano 1', 'Electric Piano 2', 'Harpsichord',
     'Clavi', 'Celesta', 'Glockenspiel', 'Music Box', 'Vibraphone', 'Marimba',
     'Xylophone', 'Tubular Bells', 'Dulcimer', 'Drawbar Organ',
     'Percussive Organ', 'Rock Organ', 'Church Organ', 'Reed Organ',
     'Accordion', 'Harmonica', 'Tango Accordion', 'Acoustic Guitar (nylon)',
     'Acoustic Guitar (steel)', 'Electric Guitar (jazz)',
     'Electric Guitar (clean)', 'Electric Guitar (muted)', 'Overdriven Guitar',
     'Distortion Guitar', 'Guitar harmonics', 'Acoustic Bass',
     'Electric Bass (finger)', 'Electric Bass (pick)', 'Fretless Bass',
     'Slap Bass 1', 'Slap Bass 2', 'Synth Bass 1', 'Synth Bass 2', 'Violin',
     'Viola', 'Cello', 'Contrabass', 'Tremolo Strings', 'Pizzicato Strings',
     'Orchestral Harp', 'Timpani', 'String Ensemble 1', 'String Ensemble 2',
     'SynthStrings 1', 'SynthStrings 2', 'Choir Aahs', 'Voice Oohs',
     'Synth Voice', 'Orchestra Hit', 'Trumpet', 'Trombone', 'Tuba',
     'Muted Trumpet', 'French Horn', 'Brass Section', 'SynthBrass 1',
     'SynthBrass 2', 'Soprano Sax', 'Alto Sax', 'Tenor Sax', 'Baritone Sax',
     'Oboe', 'English Horn', 'Bassoon', 'Clarinet', 'Piccolo', 'Flute',
     'Recorder', 'Pan Flute', 'Blown Bottle', 'Shakuhachi', 'Whistle', 'Ocarina',
     'Lead 1 (square)', 'Lead 2 (sawtooth)', 'Lead 3 (calliope)',
     'Lead 4 (chiff)', 'Lead 5 (charang)', 'Lead 6 (voice)', 'Lead 7 (fifths)',
     'Lead 8 (bass + lead)', 'Pad 1 (new age)', 'Pad 2 (warm)',
     'Pad 3 (polysynth)', 'Pad 4 (choir)', 'Pad 5 (bowed)', 'Pad 6 (metallic)',
     'Pad 7 (halo)', 'Pad 8 (sweep)', 'FX 1 (rain)', 'FX 2 (soundtrack)',
     'FX 3 (crystal)', 'FX 4 (atmosphere)', 'FX 5 (brightness)', 'FX 6 (goblins)',
     'FX 7 (echoes)', 'FX 8 (sci-fi)', 'Sitar', 'Banjo', 'Shamisen',
     'Koto', 'Kalimba', 'Bag pipe', 'Fiddle', 'Shanai', 'Tinkle Bell', 'Agogo',
     'Steel Drums', 'Woodblock', 'Taiko Drum', 'Melodic Tom', 'Synth Drum',
     'Reverse Cymbal', 'Guitar Fret Noise', 'Breath Noise', 'Seashore',
     'Bird Tweet', 'Telephone Ring', 'Helicopter', 'Applause', 'Gunshot');

  • = True;
  ◦ = False;

  MIDI_INSTRUMENT_NEED_NOTE_OFF: array[TMIDIInstrument] of Boolean =
    {0  1  2  3  4  5  6  7  8  9 10 11 12 13 14 15 16 17 18 19 20 21 22 23}
    (◦, ◦, ◦, ◦, ◦, ◦, ◦, ◦, ◦, ◦, ◦, ◦, ◦, ◦, ◦, ◦, •, •, •, •, •, •, •, •,
   {24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47}
     ◦, ◦, ◦, ◦, ◦, •, •, ◦, ◦, ◦, ◦, ◦, ◦, ◦, ◦, ◦, •, •, •, •, •, ◦, ◦, ◦,
   {48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71}
     •, •, •, •, •, •, •, ◦, •, •, •, •, •, •, •, •, •, •, •, •, •, •, •, •,
   {72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95}
     •, •, •, •, •, •, •, •, •, •, •, •, •, •, •, •, •, •, •, •, •, ◦, •, •,
   {96 97 98 99 00 01 02 03 04 05 06 07 08 09 10 11 12 13 14 15 16 17 18 19}
     ◦, ◦, ◦, ◦, ◦, ◦, ◦, ◦, ◦, ◦, ◦, ◦, ◦, •, •, •, ◦, ◦, ◦, ◦, ◦, ◦, ◦, ◦,
   {20 21 22 23 24 25 26 27}
     ◦, ◦, •, ◦, •, •, •, ◦);

  MIDI_PERCUSSION_INSTRUMENTS: array[TMIDIPercussionKey] of string =
    ('Acoustic Bass Drum', 'Bass Drum 1', 'Side Stick', 'Acoustic Snare',
     'Hand Clap', 'Electric Snare', 'Low Floor Tom', 'Closed Hi Hat',
     'High Floor Tom', 'Pedal Hi-Hat', 'Low Tom', 'Open Hi-Hat', 'Low-Mid Tom',
     'Hi-Mid Tom', 'Crash Cymbal 1', 'High Tom', 'Ride Cymbal 1',
     'Chinese Cymbal', 'Ride Bell', 'Tambourine', 'Splash Cymbal', 'Cowbell',
     'Crash Cymbal 2', 'Vibraslap', 'Ride Cymbal 2', 'Hi Bongo', 'Low Bongo',
     'Mute Hi Conga', 'Open Hi Conga', 'Low Conga', 'High Timbale',
     'Low Timbale', 'High Agogo', 'Low Agogo', 'Cabasa', 'Maracas',
     'Short Whistle', 'Long Whistle', 'Short Guiro', 'Long Guiro', 'Claves',
     'Hi Wood Block', 'Low Wood Block', 'Mute Cuica', 'Open Cuica',
     'Mute Triangle', 'Open Triangle');

type
  TMIDIInt = 0..127;

  TMIDIInstrumentData = record
    InstrumentFamily: string;
    InstrumentName: string;
    case IsPercussionChannel: Boolean of
      False:
        (ProgramNumber: TMIDIInt);
      True:
        (NoteNumber: TMIDIInt);
  end;

function GetMIDIInstrumentData(const AInstrument: TMIDIInstrument): TMIDIInstrumentData;
function GetMIDIPercussionInstrumentData(const APercussionKey: TMIDIPercussionKey): TMIDIInstrumentData;

const
  MIDI_NOTE_NAMES: array[TMIDIInt] of string =
    ('C₋₁', 'C♯₋₁', 'D₋₁', 'D♯₋₁', 'E₋₁', 'F₋₁', 'F♯₋₁', 'G₋₁', 'G♯₋₁', 'A₋₁', 'A♯₋₁', 'B₋₁',
     'C₀', 'C♯₀', 'D₀', 'D♯₀', 'E₀', 'F₀', 'F♯₀', 'G₀', 'G♯₀', 'A₀', 'A♯₀', 'B₀',
     'C₁', 'C♯₁', 'D₁', 'D♯₁', 'E₁', 'F₁', 'F♯₁', 'G₁', 'G♯₁', 'A₁', 'A♯₁', 'B₁',
     'C₂', 'C♯₂', 'D₂', 'D♯₂', 'E₂', 'F₂', 'F♯₂', 'G₂', 'G♯₂', 'A₂', 'A♯₂', 'B₂',
     'C₃', 'C♯₃', 'D₃', 'D♯₃', 'E₃', 'F₃', 'F♯₃', 'G₃', 'G♯₃', 'A₃', 'A♯₃', 'B₃',
     'C₄', 'C♯₄', 'D₄', 'D♯₄', 'E₄', 'F₄', 'F♯₄', 'G₄', 'G♯₄', 'A₄', 'A♯₄', 'B₄',
     'C₅', 'C♯₅', 'D₅', 'D♯₅', 'E₅', 'F₅', 'F♯₅', 'G₅', 'G♯₅', 'A₅', 'A♯₅', 'B₅',
     'C₆', 'C♯₆', 'D₆', 'D♯₆', 'E₆', 'F₆', 'F♯₆', 'G₆', 'G♯₆', 'A₆', 'A♯₆', 'B₆',
     'C₇', 'C♯₇', 'D₇', 'D♯₇', 'E₇', 'F₇', 'F♯₇', 'G₇', 'G♯₇', 'A₇', 'A♯₇', 'B₇',
     'C₈', 'C♯₈', 'D₈', 'D♯₈', 'E₈', 'F₈', 'F♯₈', 'G₈', 'G♯₈', 'A₈', 'A♯₈', 'B₈',
     'C₉', 'C♯₉', 'D₉', 'D♯₉', 'E₉', 'F₉', 'F♯₉', 'G₉');

type
  TNotePlayer = record
  strict private const
    CHANNEL_MESSAGE = 1 shl 7;
    NOTE_OFF = 0;
    NOTE_ON = 1;
    PROGRAM_CHANGE = 4;
    CHANNEL_MODE = 3;
    CHANNEL_MODE_ALL_SOUNDS_OFF = $78;
    CHANNEL_MODE_ALL_NOTES_OFF = $7B;
    PERCUSSION_CHANNEL = 9;
  class var
    FMIDIOut: HMIDIOUT;
    FInstrument: TMIDIInstrument;
    FVolume: Word;
    class procedure SetInstrument(const Value: TMIDIInstrument); static;
    class procedure SetVolume(const Value: Word); static;
    class function ChannelMessage(AMessage, AChannel, AData1, AData2: Byte): Cardinal; static;
  public
    class procedure SendMessage(const AMethodName: string;
      const AMessage: Cardinal); static;
    class procedure Init; static;
    class procedure CloseHandle; static;
    class procedure Reset; static;
    class property Instrument: TMIDIInstrument read FInstrument write SetInstrument;
    class property Volume: Word read FVolume write SetVolume;
    class procedure NoteOn(ANote, AIntensity: TMIDIInt); static;
    class procedure NoteOff(ANote, AIntensity: TMIDIInt); static;
    class procedure PercussionNoteOn(ANote: TMIDIPercussionKey;
      AIntensity: TMIDIInt); static;
    class procedure PercussionNoteOff(ANote: TMIDIPercussionKey;
      AIntensity: TMIDIInt); static;
    class procedure Silence; static;
    class procedure ForcedSilence; static;
  end;

implementation

function GetMIDIInstrumentData(const AInstrument: TMIDIInstrument): TMIDIInstrumentData;
begin
  Result.InstrumentFamily := MIDI_INSTRUMENT_FAMILIES[TMIDIInstrumentFamily(Ord(AInstrument) div 8)];
  Result.InstrumentName := MIDI_INSTRUMENT_NAMES[AInstrument];
  Result.IsPercussionChannel := False;
  Result.ProgramNumber := Ord(AInstrument);
end;

function GetMIDIPercussionInstrumentData(const APercussionKey: TMIDIPercussionKey): TMIDIInstrumentData;
begin
  Result.InstrumentFamily := 'Percussion channel instrument';
  Result.InstrumentName := MIDI_PERCUSSION_INSTRUMENTS[APercussionKey];
  Result.IsPercussionChannel := True;
  Result.NoteNumber := Ord(APercussionKey);
end;

{ TNotePlayer }

class function TNotePlayer.ChannelMessage(AMessage, AChannel, AData1, AData2: Byte): Cardinal;
begin
  Result := CHANNEL_MESSAGE or AChannel or (AMessage shl 4) or (AData1 shl 8) or (AData2 shl 16);
end;

class procedure TNotePlayer.CloseHandle;
var
  mmerr: MMRESULT;
begin

  if FMIDIOut = 0 then
    Exit;

  mmerr := midiOutClose(FMIDIOut);

  case mmerr of
    MMSYSERR_NOERROR:
      FMIDIOut := 0;
    MIDIERR_STILLPLAYING:
      raise EMIDIException.Create('TNotePlayer.CloseHandle: Buffers are still in the queue.');
    MMSYSERR_INVALHANDLE:
      raise EMIDIException.Create('TNotePlayer.CloseHandle: The specified device handle is invalid.');
    MMSYSERR_NOMEM:
      raise EMIDIException.Create('TNotePlayer.CloseHandle: The system is unable to load mapper string description.');
  else
    raise EMIDIException.CreateFmt('TNotePlayer.CloseHandle: Unknown error (Code: %x).', [mmerr]);
  end;

end;

class procedure TNotePlayer.Init;
var
  mmerr: MMRESULT;
begin

  if FMIDIOut <> 0 then
    CloseHandle;

  mmerr := midiOutOpen(@FMIDIOut, 0, 0, 0, CALLBACK_NULL);

  case mmerr of
    MMSYSERR_NOERROR: ;
    MIDIERR_NODEVICE:
      raise EMIDIException.Create('TNotePlayer.Init: No MIDI port was found.');
    MMSYSERR_ALLOCATED:
      raise EMIDIException.Create('TNotePlayer.Init: The specified resource is already allocated.');
    MMSYSERR_BADDEVICEID:
      raise EMIDIException.Create('TNotePlayer.Init: The specified device identifier is out of range.');
    MMSYSERR_INVALPARAM:
      raise EMIDIException.Create('TNotePlayer.Init: The specified pointer or structure is invalid.');
    MMSYSERR_NOMEM:
      raise EMIDIException.Create('TNotePlayer.Init: The system is unable to allocate or lock memory.');
  else
    raise EMIDIException.CreateFmt('TNotePlayer.Init: Unknown error (Code: %x).', [mmerr]);
  end;

  Instrument := midiAcousticGrandPiano;
  Volume := High(Word);

end;

class procedure TNotePlayer.SendMessage(const AMethodName: string;
  const AMessage: Cardinal);
var
  mmerr: MMRESULT;
begin

  if FMIDIOut = 0 then
    Exit;

  mmerr := midiOutShortMsg(FMIDIOut, AMessage);

  case mmerr of
    MMSYSERR_NOERROR: ;
    MIDIERR_BADOPENMODE:
      raise EMIDIException.CreateFmt('TNotePlayer.%s: The application sent a message without a status byte to a stream handle.', [AMethodName]);
    MIDIERR_NOTREADY:
      raise EMIDIException.CreateFmt('TNotePlayer.%s: The hardware is busy with other data.', [AMethodName]);
    MMSYSERR_INVALHANDLE:
      raise EMIDIException.CreateFmt('TNotePlayer.%s: The specified device handle is invalid.', [AMethodName]);
  else
    raise EMIDIException.CreateFmt('TNotePlayer.%s: Unknown error (Code: %x).', [AMethodName, mmerr]);
  end;

end;

class procedure TNotePlayer.NoteOff(ANote, AIntensity: TMIDIInt);
begin
  SendMessage('NoteOff', ChannelMessage(NOTE_OFF, 0, ANote, AIntensity))
end;

class procedure TNotePlayer.NoteOn(ANote, AIntensity: TMIDIInt);
begin
  SendMessage('NoteOn', ChannelMessage(NOTE_ON, 0, ANote, AIntensity))
end;

class procedure TNotePlayer.PercussionNoteOff(ANote: TMIDIPercussionKey;
  AIntensity: TMIDIInt);
begin
  SendMessage('NoteOff', ChannelMessage(NOTE_OFF, PERCUSSION_CHANNEL, Ord(ANote),
    AIntensity))
end;

class procedure TNotePlayer.PercussionNoteOn(ANote: TMIDIPercussionKey;
  AIntensity: TMIDIInt);
begin
  SendMessage('NoteOn', ChannelMessage(NOTE_ON, PERCUSSION_CHANNEL, Ord(ANote),
    AIntensity))
end;

class procedure TNotePlayer.Silence;
begin
  SendMessage('Silence', ChannelMessage(CHANNEL_MODE, 0,
    CHANNEL_MODE_ALL_NOTES_OFF, 0));
end;

class procedure TNotePlayer.ForcedSilence;
begin
  SendMessage('ForcedSilence', ChannelMessage(CHANNEL_MODE, 0,
    CHANNEL_MODE_ALL_SOUNDS_OFF, 0));
end;

class procedure TNotePlayer.Reset;
var
  mmerr: MMRESULT;
begin

  if FMIDIOut = 0 then
    Exit;

  mmerr := midiOutReset(FMIDIOut);

  case mmerr of
    MMSYSERR_NOERROR: ;
    MMSYSERR_INVALHANDLE:
      raise EMIDIException.Create('TNotePlayer.Reset: The specified device handle is invalid.');
  else
    raise EMIDIException.CreateFmt('TNotePlayer.Reset: Unknown error (Code: %x).', [mmerr]);
  end;

end;

class procedure TNotePlayer.SetInstrument(const Value: TMIDIInstrument);
begin
  SendMessage('SetInstrument', ChannelMessage(PROGRAM_CHANGE, 0, Ord(Value), 0));
  FInstrument := Value;
end;

class procedure TNotePlayer.SetVolume(const Value: Word);
var
  mmerr: MMRESULT;
begin

  if FMIDIOut = 0 then
    Exit;

  mmerr := midiOutSetVolume(FMIDIOut, Value or (Value shl 16));

  case mmerr of
    MMSYSERR_NOERROR:
      FVolume := Value;
    MMSYSERR_INVALHANDLE:
      raise EMIDIException.Create('TNotePlayer.SetVolume: The specified device handle is invalid.');
    MMSYSERR_NOMEM:
      raise EMIDIException.Create('TNotePlayer.SetVolume: The system is unable to allocate or lock memory.');
    MMSYSERR_NOTSUPPORTED:
      raise EMIDIException.Create('TNotePlayer.SetVolume: The function is not supported.');
  else
    raise EMIDIException.CreateFmt('TNotePlayer.SetVolume: Unknown error (Code: %x).', [mmerr]);
  end;

end;

end.