Unit MidiText;
{
http://www.somascape.org/midi/tech/spec.html
}
INTERFACE

Uses Algemeen;

function Polyfoon(kanaal : integer; noten : verzameling) : string;
function Any_Event(riedel : bytes) : string;
function plukken(riedel : bytes) : string;

IMPLEMENTATION

function Program_Name(which : byte) : string;
{
  General Midi
}
type
  Namelist = array[0..127] of string;

const
  Lijst : Namelist = (
  'Acoustic Grand Piano','Bright Acoustic Piano','Electric Grand Piano',
  'Honky-tonk Piano','Rhodes Piano','Chorused Piano','Harpsichord','Clavinet',

  'Celesta','Glockenspiel','Music Box','Vibraphone',
  'Marimba','Xylophone','Tubular Bells','Dulcimer',

  'Hammond 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 fingered','Electric Bass picked',
  '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',

  'Strings','Slow Strings','Synth Strings 1','Synth Strings 2',
  'Choir Aahs','Voice Oohs','Synth Voice','Orchestra Hit',

  'Trumpet','Trombone','Tuba','Muted Trumpet',
  'French Horn','Brass Section','Synth Brass 1','Synth Brass 2',

  'Soprano Sax','Alto Sax','Tenor Sax','Baritone Sax',
  'Oboe','English Horn','Bassoon','Clarinet',

  'Piccolo','Flute','Recorder','Pan Flute',
  'Bottle Blow','Shakuhachi','Whistle','Ocarina',

  'Square Wave','Sawtooth','Synth Calliope','Chiffer Lead',
  'Charang','Solo Vox','5th Saw Wave','Bass + Lead',

  'New Age','Warm Pad','Polysynth','Space Voice',
  'Bowed Glass','Metal Pad','Halo Pad','Sweep Pad',

  'Ice Rain','Soundtrack','Crystal','Atmosphere',
  'Brightness','Goblins','Echo Drops','Sci-Fi',

  'Sitar','Banjo','Shamisen','Koto',
  'Kalimba','Bag Pipe','Fiddle','Shannai',

  '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','Gun Shot');

begin
  Program_Name := Lijst[which];
end;

function Drums_Name(which : byte) : string;
{
  General Midi
}
type
  Namelist = array[0..46] of string;
const
  Lijst : Namelist = (
  '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',
  'High 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','High Bongo','Low Bongo',
  'Mute High Conga','Open High Conga','Low Conga','High Timbale',
  'Low Timbale','High Agogo','Low Agogo','Cabasa','Maracas',
  'Short Whistle','Long Whistle','Short Guiro','Long Guiro','Claves',
  'High Wood Block','Low Wood Block','Mute Cuica','Open Cuica',
  'Mute Triangle','Open Triangle');
begin
  Drums_Name := Lijst[which-35];
end;

function Meta_Name(which : byte) : string;
{
http://www.omega-art.com/midi/mfiles.html#meta
}
var
  s : string;

begin
  s := 'Unknown';
  Case which of
   $00 : s := 'SeqNum';
   $01 : s := 'Text';
   $02 : s := 'CopyRight';
   $03 : s := 'TrkName';
   $04 : s := 'Instrument';
   $05 : s := 'Lyric';
   $06 : s := 'Marker';
   $07 : s := 'CuePoint';
   $0F : s := 'Dummy';         { NEW }
   $10..$1F : s := 'PolyText'; { NEW }
 { $20 : s := 'MIDI Channel Prefix'; }
   $21 : s := 'MidiPort';
   $2F : s := 'TrkEnd';
   $51 : s := 'Tempo';
   $54 : s := 'SMPTE';
   $58 : s := 'TimeSig';
   $59 : s := 'KeySig';
 { $7F : s := 'Sequencer Specific'; }
  end;
  Meta_Name := s;
end;

function Control_Name(which : byte) : string;

var
  s : string;

begin
  s := 'Undefined';
  Case which of
    $00 : s := 'Bank Select';
    $01 : s := 'Modulation';
    $02 : s := 'Breath';
    $04 : s := 'Foot';
    $05 : s := 'Portamento';
    $07 : s := 'Main Volume';
    $08 : s := 'Balance';
    $0A : s := 'Pan / Stereo';
    $0B : s := 'Expression';
    $40 : s := 'Sustain';
    $5B : s := 'Reverb';
    $5D : s := 'Chorus';
    $78 : s := 'Sounds Off';
    $79 : s := 'Reset All';
    $7B, $7C, $7D, $7E, $7F
        : s := 'Notes Off';
  end;
  Control_Name := s;
end;

function Arbitrary(offset : integer; dingen : bytes) : string;
var
  tel,k : integer;
  b : byte;
  s : string;
begin
  tel := Length(dingen);
  s := '';
  if tel > 0 then
  for k := offset to tel-1 do
  begin
    b := dingen[k];
    s := s + ' $' + byte2hex(b);
  end;
  Arbitrary := s;
end;

function uitspreekbaar(regel : string) : boolean;
{
  Windows-1252
}
const
  alfabet : set of byte =
  [$09,$0A,$0D,$20,$21,$22,$27,$28,$29,$2C,$2D,$2E,$3A,$3B,$3F
  { HT  LF  CR  SP  !   "   '   (   )   ,   -   .   :   ;   ? }
  ,$41..$5A,$60,$61..$7A,$8A,$8C,$8E,$9A,$9C,$9E,$A1,$BF,$C0..$CF
  { A .. Z   `   a .. z  non-ascii ..          }
  ,$D1..$D6,$D8..$DF,$E0..$EF,$F1..$F6,$F8..$FF];
var
  OK : boolean;
  L,k : integer;
begin
  OK := true;
  L := Length(regel);
  for k := 1 to L do
    OK := OK and (byte(regel[k]) in alfabet);
  uitspreekbaar := OK;
end;

procedure Lyriek(zaken : bytes; var s : string);
{
  Lyrics
}
var
  k,L : integer;
  txt : string;
begin
  txt := '';
  L := Length(zaken);
  if L > 2 then
  begin
  { Replace Carriage Return /
    Line Feed by slashes }
    for k := 2 to L-1 do
      if (zaken[k] = $0D)
      or (zaken[k] = $0A)
      then zaken[k] := byte('/');
  
  { Convert to string }
    Setlength(txt,L-2);
    for k := 2 to L-1 do
      txt[k-1] := char(zaken[k]);
    txt := vervang(txt,'//','/');
    if not uitspreekbaar(vervang(txt,'/',' '))
      then Writeln('Unspeakable Lyrics');
  
  { Replace any space with underscore }
    txt := vervang(txt,' ','_');
  end;
  s := s + ' ' + txt;
end;

procedure SeqNum(zaken : bytes; var s : string);
var
  veel : integer;
  v : string;
begin
  veel := zaken[2];
  veel := (veel shl 8) or zaken[3];
  Str(veel, v);
  s := s + ' ' + v;
end;

procedure TextLike(zaken : bytes; var s : string);
var
  k,L : integer;
  txt : string;
begin
  L := Length(zaken);
  Setlength(txt,L-2);
  for k := 2 to L-1 do
    txt[k-1] := char(zaken[k]);
  s := s + ' ' + '"' + txt + '"';
end;

procedure MidiPort(zaken : bytes; var s : string);
var
  t : char;
begin
  t := half2hex(zaken[2]);
  s := s + ' $' + t;
end;

procedure Tempo(zaken : bytes; var s : string);
var
  veel : integer;
  v : string;
  k : integer;
begin
  veel := 0;
  for k := 0 to 2 do
    veel := (veel shl 8) or zaken[k+2];
  Str(veel, v);
  s := s + ' ' + v;
end;

procedure SMPTE_Offset(zaken : bytes; var s : string);
var
  v : string;
  k : integer;
  t : char;
begin
  for k := 0 to 4 do
  begin
    t := ':';
    if k = 0 then t := ' ';
    if k = 3 then t := ' ';
    if k = 4 then t := '.';
    Str(zaken[k+2], v);
    s := s + t + v ;
  end;
end;

procedure TimeSig(zaken : bytes; var s : string);
{
This meta event is used to set a sequences time signature. The time signature
defined with 4 bytes, a numerator, a denominator, a metronome pulse and number
of 32nd notes per MIDI quarter-note. The numerator is specified as a literal 
value, but the denominator is specified as (get ready) the value to which the 
power of 2 must be raised to equal the number of subdivisions per whole note. 
For example, a value of 0 means a whole note because 2 to the power of 0 is 1 
(whole note), a value of 1 means a half-note because 2 to the power of 1 is 2 
(half-note), and so on. The metronome pulse specifies how often the metronome 
should click in terms of the number of clock signals per click, which come at 
a rate of 24 per quarter-note. For example, a value of 24 would mean to click 
once every quarter-note (beat) and a value of 48 would mean to click once every 
half-note (2 beats). And finally, the fourth byte specifies the number of 32nd 
notes per 24 MIDI clock signals. This value is usually 8 because there are 
usually 8 32nd notes in a quarter-note. At least one Time Signature Event 
should appear in the first track chunk (or all track chunks in a Type 2 file) 
before any non-zero delta time events. If one is not specified 4/4, 24, 8 
should be assumed. 
}
var
  v : string;
  m : byte;
  t : char;
  k : integer;
begin
  for k := 0 to 3 do
  begin
    t := ' ';
    if k = 1 then t := '/';
    m := zaken[k+2];
    Str(m, v);
    if k = 1 then Str(1 shl m, v);
    s := s + t + v;
  end;
end;

procedure KeySig(zaken : bytes; var s : string);
{
FF 59 02 sf mi  Key Signature
		sf = -7:  7 flats
		sf = -1:  1 flat
		sf = 0:  key of C
		sf = 1:  1 sharp
		sf = 7: 7 sharps

		mi = 0:  major key
		mi = 1:  minor key
}
const
  major_sharp : array[0..7] of string = 
  ('C','G','D','A','E','B','F#','C#');
  major_flat : array[0..7] of string =
  ('C','F','Bb','Eb','Ab','Db','Gb','B'); 
  minor_sharp : array[0..7] of string =
  ('a','e','b','f#','c#','g#','d#','a#'); 
  minor_flat : array[0..7] of string =
  ('a','d','g','c','f','bb','eb','ab');
var
  v : string;
  t : char;
  m,n : byte;
begin
  t := '+';
  m := zaken[2];
  n := zaken[3];
  if m > $F0 then t := '-';
  if m > $F0 then m := $FF - m + 1;
  Str(m, v);
  s := s + ' ' + t + v;

  if (m < 8) then
  begin
    if (t = '+') and (n = 0)
      then s := s + '(' + major_sharp[m] + ')';
    if (t = '-') and (n = 0)
      then s := s + '(' + major_flat[m] + ')';
    if (t = '+') and (n = 1)
      then s := s + '(' + minor_sharp[m] + ')';
    if (t = '-') and (n = 1)
      then s := s + '(' + minor_flat[m] + ')';
  end else s := s + '(??)';

  Str(n, v);
  s := s + ' ' + v;
  if (n = 0) then s := s + '(major)';
  if (n = 1) then s := s + '(minor)';
  if (n > 1) then s := s + '(error)';
end;

function Meta_Event(zaken : bytes) : string;
var
  s : string;
  kop : byte;
begin
  kop := zaken[1];
  s := 'Meta' + ' $' + byte2hex(kop);
  s := s + '(' + Meta_Name(kop) + ')';

  case kop of
  $00 : SeqNum(zaken,s);
  $01,$02,$03,$04,$06,$07,
  $08,$09,$0A,$0B,$0C,$0D,$0E: TextLike(zaken,s);
  $05 : Lyriek(zaken,s);
  $10..$1F : Lyriek(zaken,s);
  $21 : MidiPort(zaken,s);
  $51 : Tempo(zaken,s);
  $54 : SMPTE_Offset(zaken,s);
  $58 : TimeSig(zaken,s);
  $59 : KeySig(zaken,s);
  end;
  if Meta_Name(kop) = 'Unknown' then
    s := s + Arbitrary(2,zaken);
  Meta_Event := s;
end;

function Monofoon(stand,note,hard : byte) : string;
const
  kruis : string[12] = ' # #  # # # ';
  namen : string[12] = 'CCDDEFFGGAAB';
var
  toon : byte;
  ch : char;
  one, okt : string[1];
  n, h : string[3];
  s, t : string;
begin
  ch := half2hex(stand and $0F);
  s := 'ch$' + ch + ' ';

  toon := (note mod 12) + 1;
  one := kruis[toon];
  if one = ' ' then one := '';
  Str(note div 12, okt);
  Str(note, n);
  Str(hard, h);

  t := one + namen[toon] + okt;
{ if ch = '9' then t := Drums_Name(note); }
  s := s + n + '(' + t + ') ' + h;
  Monofoon := s;
end;

function Polyfoon(kanaal : integer; noten : verzameling) : string;
const
  kruis : string[12] = ' # #  # # # ';
  namen : string[12] = 'CCDDEFFGGAAB';
var
  riedel : bytes;
  note,toon : byte;
  k,L : integer;
  ch : char;
  one, okt : string[1];
  n : string[3];
  s, t : string;
begin
  ch := half2hex(kanaal and $0F);
  s := 'Notes ch$' + ch + ' ';
  riedel := Akkoord(noten,kanaal);
  L := Length(riedel);
  if L = 0 then s := '';
  if L > 0 then
  for k := 0 to L-1 do
  begin
    note := riedel[k];
    toon := (note mod 12) + 1;
    one := kruis[toon];
    if one = ' ' then one := '';
    Str(note div 12, okt);
    Str(note, n);
    t := one + namen[toon] + okt;
    if ch = '9' then t := Drums_Name(note);
    s := s + n + '(' + t + ') ';
  end;
  Polyfoon := s;
end;

function Control_Change(stand,p,q : byte) : string;
var
  ch : char;
  t : string[3];
  s : string;
begin
  ch := half2hex(stand and $0F);
  s := 'Control ch$' + ch + ' $';
  s := s + byte2hex(p) + '(' + Control_Name(p) + ') ';
  Str(q, t);
  Control_Change := s + t;
end;

function Program_Change(stand,p : byte) : string;
var
  ch : char;
  s : string;
begin
  ch := half2hex(stand and $0F);
  s := 'Program ch$' + ch + ' $';
  s := s + byte2hex(p) + '(' + Program_Name(p) + ') ';
  Program_Change := s;
end;

function Channel_Aftertouch(stand,p : byte) : string;
var
  ch : char;
  t : string[3];
  s : string;
begin
  ch := half2hex(stand and $0F);
  s := 'After ch$' + ch + ' ';
  Str(p, t);
  Channel_Aftertouch := s + t;
end;

function Pitch_Bend(stand,L,H : byte) : string;
var
  ch : char;
  t : string[5];
  s : string;
begin
  ch := half2hex(stand and $0F);
  s := 'Bend ch$' + ch + ' ';
  Str(128 * (H - 64) + L, t);
  Pitch_Bend := s + t;
end;
 
function Midi_Event(riedel : bytes) : string;
var
  deze : byte;
  uit : string;
begin
  deze := (riedel[0] shr 4);
  case deze of
    $8 : uit := 'Note ' + Monofoon(riedel[0],riedel[1],0);
    $9 : uit := 'Note ' + Monofoon(riedel[0],riedel[1],riedel[2]);
    $A : uit := 'Aftertouch ' + Monofoon(riedel[0],riedel[1],riedel[2]);
    $B : uit := Control_Change(riedel[0],riedel[1],riedel[2]);
    $C : uit := Program_Change(riedel[0],riedel[1]);
    $D : uit := Channel_Aftertouch(riedel[0],riedel[1]);
    $E : uit := Pitch_Bend(riedel[0],riedel[1],riedel[2]);
  end;
  Midi_Event := uit;
end;

function Any_Event(riedel : bytes) : string;
var
  let : byte;
  uit : string;
begin
  uit := '';
  if Length(riedel) > 0 then
  begin
    let := riedel[0];
    if ($80 <= let) and (let <= $EF)
      then uit := Midi_Event(riedel);
    if ($F0 <= let) and (let <= $F7)
      then uit := 'Hex' + Arbitrary(1,riedel);
    if ($F8 <= let) and (let <= $FE)
      then uit := byte2hex(riedel[0]);
    if (let = $FF)
      then uit := Meta_Event(riedel);
  end;
  Any_Event := uit;
end;
 
function plukken(riedel : bytes) : string;
var
  k,L : integer;
  S : string;
begin
  L := Length(riedel);
  SetLength(S,L-2);
  for k := 2 to L-1 do
    S[k-1] := char(riedel[k]);
  S := vervang(S,char(13)+char(10),'/');
  S := vervang(S,' ','_');
  plukken := S;
end;

END.