{
  Author : Mike Cariotoglou, CIS 10012,1767
  Date   : 01-May-1991
  See SYSEX.DOC file for operation
}


program sysex;

uses crt,umpu;

const maxbuf    =50000;
      sysexstart=$F0;
      sysexend  =$F7;
      txtext    ='.TXT';
      binext    ='.SYX';

var fname1,fname2:string;
    buffer:array[0..maxbuf-1] of byte;
    Bp:word;
    convert,manual:boolean;

procedure flushkbd;
 begin
  while keypressed do if readkey=#0 then if readkey=#0 then;
 end;

procedure error(i:integer);
 begin
  flushkbd;
  case i of
   0:;
   1:writeln('Input file not found');
   2:writeln('File too large');
   3:writeln('Format error, missing Start of Exclusive');
   4:writeln('Too many data in');
   5:writeln('Cannot create dest');
   6:begin
      writeln;
      writeln('Syntax : SYSEX filename1 [filename2] /c|m');
      writeln(' filename 1  : file to send');
      writeln(' filename 2  : file to receive (optional)');
      writeln(' options  /C : Convert file1 to file2 format');
      writeln('          /M : Start dump manually');
      writeln;
      writeln('File names ending in .TXT are assumed SYSEX TXT format');
      writeln('All others are assumed standard MIDIEX format');
      writeln;
      writeln('Ascii format metacommands : ');
      writeln(' ''text''   : Insert characters in text format');
      writeln(' ?Prompt  : Prompted input');
      writeln(' |        : OR of next two bytes');
      writeln(' @        : Begin checksum calculation');
      writeln(' #        : Insert checksum');
      writeln(' ;        : Rest of line is comment');
     end;
   else writeln('Error : ',i);
  end;
  send_command_to_mpu(mpu_reset);
  halt
 end;

function fixname(a:string):string;
 begin
  if pos('.',a)=0 then a:=a+binext;
  fixname:=a;
 end;

procedure getparms;
 var i,j:integer;
     a:string;
 begin
  if paramcount=0 then error(6);
  fname1:='';
  fname2:='';
  convert:=false;
  manual:=false;
  for i:=1 to paramcount do
   begin
    a:=paramstr(i);
    for j:=1 to length(a) do a[j]:=upcase(a[j]);
    if a[1] in ['-','/'] then
     begin
      delete(a,1,1);
      while a>'' do
       begin
        case upcase(a[1]) of
         'C':convert:=true;
         'M':manual:=true;
         else error(6);
        end;
        delete(a,1,1)
       end
     end
    else if fname1='' then fname1:=fixname(a) else fname2:=fixname(a);
   end;
  if (manual and (fname2>'')) or
     (convert and (fname2='')) or
     (manual and convert) then error(6);
 end;

FUNCTION Hex(NUM,WIDTH:longint):STRing;
 VAR I:INTEGER;
     A:STRing;
 BEGIN
  A:='';
  WHILE LENGTH(A)<WIDTH DO
   BEGIN
    I:=NUM and $f;
    IF I>9 THEN I:=I+7;
    A:=CHR(48+I)+A;
    NUM:=NUM shr 4
   END;
  Hex:=A
 END;

procedure readbuf(fname:string);

 var f1:file;
     f2:text;
     a,b:string;
     i,j,expected,pp,sum:integer;
     p:array[0..1] of integer;

 function getword(var a,b:string):boolean;
  var i:integer;
      delim:char;
  begin
   getword:=false;
   while (a>'') and (a[1]=' ') do delete(a,1,1);
   if a='' then exit;
   if a[1]='''' then delim:='''' else delim:=' ';
   i:=2;
   while (i<=length(a)) and (a[i]<>delim) do inc(i);
   b:=copy(a,1,i-1);
   delete(a,1,i);
   getword:=b>''
  end;

 procedure add(b:byte);
  begin
   if expected=0 then
    begin
     if bp=maxbuf then error(2);
     buffer[bp]:=b;
     inc(bp);
     sum:=(sum+b) and $7f
    end
   else
    begin
     p[pp]:=b;
     inc(pp);
     if pp=expected then
      begin
       expected:=0;
       add(p[0] or p[1]);
      end
    end
  end;

 begin {readbuf}
  if pos(txtext,fname)=0 then
   begin
    assign(f1,fname); reset(f1,1); if ioresult<>0 then error(1);
    Bp:=filesize(f1); if Bp>maxbuf then error(2);
    blockread(f1,buffer,Bp);
    close(F1);
    exit
   end;
  assign(f2,fname); reset(f2); if ioresult<>0 then error(1);
  bp:=0;
  sum:=0;
  expected:=0;
  while not eof(f2) do
   begin
    readln(f2,a);
    if a='' then exit;
    while getword(a,b) do
     case b[1] of
      '''':for I:=2 to length(b) do add(ord(b[i]));
      ';':a:=''; {comment}
      '?':begin
           delete(b,1,1);
           write(b,' : '); readln(b);
           val(b,i,j);
           add(i)
          end;
      '|':begin
           expected:=2;
           pp:=0
          end;
      '@':sum:=0;
      '#':add((-sum) and $7f);
      else
       begin
        val('$'+b,i,j);
        add(i)
       end
     end {case};
   end {while not eof};
  close(f2);
 end;

procedure WriteBuf(fname:string);
 var f1:file;
     f2:text;
     i,j:integer;
 begin
  if pos(txtext,fname)=0 then
   begin
    assign(f1,fname); rewrite(f1,1); if ioresult<>0 then error(5);
    blockwrite(f1,buffer,Bp);
    close(F1);
    exit
   end;
  assign(f2,fname); rewrite(f2); if ioresult<>0 then error(5);
  j:=0;
  for i:=0 to bp-1 do
   begin
    if j=20 then
     begin
      writeln(f2);
      j:=0
     end;
    write(f2,Hex(buffer[i],2),' ');
    inc(j)
   end;
  writeln(f2);
  close(f2)
 end;

procedure sendbuf;
 var i,count,block:word;
     t:longint;
     b:byte;

  procedure wait;
   var t1:longint;
   begin
     {more to send, calculate delay,
      calculate ticks this should have taken,
      round up,add three for min delay of 110 ms  (trial & error value)
      use 19 as approx of 18.2
      actual formula is count*(time per byte) / time per tick}
    t1:=t+(longint(count)*19+(3125 div 2)) div 3125+3;
    while systemtick<t1 do;
   end;

 begin
  i:=0;
  block:=0;
  while i<Bp do
   begin
    if buffer[i]<>sysexstart then error(3);
    t:=systemtick;
    count:=0;
    repeat
     b:=buffer[i];
     send_data_to_mpu(b);
     inc(i);
     inc(count);
    until (i=Bp) or (b=sysexend);
    inc(block);
    writeln('Block : ',block,' Bytes : ',count);
    if i<Bp then wait
   end;
 end;

procedure recbuf;
 var b:byte;
     pp:word;

 procedure add(b:byte);
  begin
   if Bp=maxbuf then error(4);
   buffer[Bp]:=b;
   inc(Bp)
  end;

 begin {recbuf}
  flushkbd;
  writeln('Waiting for data, hit any key to stop');
  repeat
   if keypressed then error(0);
  until get_data_from_mpu(b) and (b=sysexstart);
  writeln('Receiving data, hit any key to stop');
  Bp:=0;
  add(b);
  pp:=0;
  repeat
   if get_data_from_mpu(b) then if b<>$F8 then add(b) else
   else if pp<>Bp then
    begin
     write(#13,Bp:6);
     pp:=Bp
    end
  until keypressed;
  flushkbd;
 end;

begin {main}
 clearmpuin;
 getparms;
 if manual then
  begin
   recbuf;
   writebuf(fname1)
  end
 else if convert then
  begin
   readbuf(fname1);
   writebuf(fname2);
  end
 else
  begin
   readbuf(fname1);
   sendbuf;
   if fname2>'' then
    begin
     recbuf;
     writebuf(fname2)
    end
  end;
 error(0);
end.

notes:
------

txt input format:

xx 'ascii' | ?name  @ #

xx      = hex digits
'ascii' = ascii chars
|       = OR of next two bytes
?name   = prompt for byte
@       = begin chksum
#       = put chksum
;       = test of line is comment