program Sendacommand;

{ ************************************************************** }
{ Program:  Sendacommand					 }
{ Author :  Jay Sissom 						 }
{ Date   :  4-26-88						 }
{ Purpose:  Send commands to the MPU				 }
{ ************************************************************** }

uses Crt;

const
  Dataport = $330;
  Comport  = $331;
  Statport = $331;
  DSR      = $80;
  DRR      = $40;
  UART     = $3F;
  ACK      = $FE;
  RST      = $FF;
  THRU_ON  = $89;
  THRU_OFF = $88;

type
  lstr     = string[100];

var
  X        : integer;
  j        : char;

procedure send_command(cmd : byte);

var
  stat : byte;
  ackn : byte;

begin
  ackn := 0;
  while (ackn <> $FE) do
    begin
      stat := 0;
      while (stat and DRR) = DRR do stat := port[Statport];
      port[Comport] := cmd;
      stat := 0;
      while (stat and DSR) = DSR do stat := port[Statport];
      ackn := port[Dataport]
    end
end;

function send_data(d : byte) : boolean;

const
  timeout = 255;

var
  t : integer;

{ I added the timeout stuff because the program kept locking up }
{ bit 6 of Statport will never go to 0.  It doesn't happen all  }
{ the time.  Usually the 2nd byte sent of the third run, when I }
{ tested it.                                                    }

begin
  write('B ');
  t := 0;
  while ((Port[Statport] and DRR) = DRR) and (t < timeout) do inc(t);
  if t = timeout
     then send_data := false
     else begin
            port[Dataport] := d;
            writeln('A')
          end
end;

procedure error(msg : lstr);

begin
  writeln;
  writeln(msg);
  halt(1)
end;

begin
  send_command(RST);
  send_command(UART);
  FOR X := 50 to 70 do
    begin
      { Send the data on Channel 2 }
      if not send_data($91) then error('Timeout on note on');
      if not send_data(X)   then error('Timeout on on data');
      if not send_data(10)  then error('Timeout on on velocity');
      delay(129);
      if not send_data($91) then error('Timeout on note off');
      if not send_data(X)   then error('Timeout on off data');
      if not send_data(0)   then error('Timeout on off velocity')
    end;
  send_command(RST)
end.