program KawaiBankSaver;
{
Saves internal bank from K3 to disk file and restores it.
  NOTE: there are several subroutines that were used for debugging, etc
        and have no current implementation.
}

const
  dataport = $330;                  {These are port addresses for the}
  statport = $331;                  {IBM version of the MPU-401      }
  drs = $80;                        {They must be changed for other  }
  drr = $40;                        {machines                        }
  ack = $fe;

  BytesPerPatch = 34; {Patch consists of 34 bytes + chksum}
  PatchesPerBank= 50; {each bank has 50 patches}
  Banks         =  2; {There are two banks}

type
  str1 = string[1];
  str2 = string[2];
  str8 = string[8];
  AnyStringType=String[255];
  PatchType = array[1.. BytesPerPatch] of Byte;
  BankType = array[1..PatchesPerBank] of PatchType;

  {Kawai stuff}

var
  EscAbort:Boolean;
  j,MidiData: byte;
  Direction:Char;

procedure GetData (var MidiData:byte);  {Get one byte from MPU}
  var
    j:byte;
  begin
   j := 0;
   repeat                               {Loop until Data Ready to Receive}
     j := port[statport];               {has correct value; then get     }
   until (j and drs) = 0;               {MidiData from DataPort          }
   MidiData := port [dataport];
  end;

procedure PutData (MidiData:byte);  {Puts one byte to MPU}
  begin
    j := 0;
    repeat                          {Loop until Data Ready to Send   }
      j := port [statport]          {has correct value; then send    }
    until (j and drr) = 0;          {MidiData to DataPort            }
    port [dataport] := MidiData;
    repeat
      GetData(j);
    until (j = ack);
  end;

procedure PutCmd (cmd:byte);            {Sends command to MPU}
begin
  j := 0;
  repeat                              {Loop until Data Ready to Receive}
    j := port [statport];             {has correct value; then send    }
  until (j and drr) = 0;              {command to MPU                  }
  port [statport] := cmd;
  repeat                              {Wait in loopuntil MPU send byte }
    GetData(j);                       {to acknowledge receipt of command}
  until j = ack;
end;

function Hex(b:byte):str2;
const
  h : array [0..15] of char = '0123456789ABCDEF';
begin
  Hex := h [b shr 4] + h [b and 15];
end;

Function Bin (Val:Byte):Str8;
Var
  Mask:Byte;
  Hold:Str8;
Begin
  Hold:='';
  Mask:=$80;
  Repeat
    Hold := Hold + Chr(48 + ord( (Val and Mask) > 0 ) );
    Mask := Mask shr 1;
  Until Mask=0;
  Bin := Hold;
End;

Function Int2Str(I:Integer):AnyStringType;
Var
  Temp:AnyStringType;
Begin
  Str(I,Temp);
  Int2Str:=Temp;
End;

Procedure Info(Phrase:anystringtype);
Begin
  GotoXY(1,25);
  Write(Con,Phrase);
  ClrEOL;
End;

Function MergeBytes(Hi,Lo:Byte):Byte;
{ The result is the low nibble of Hi moved to the high nibble, plus
                the low nibble of Lo.

  ie:     ---Hi--- and ---Lo--- yield  Merge2Bytes
   bin:   0000abcd  ,  0000efgh  ==>    abcdefgh
   hex:     $0F     ,    $03     ==>      $F3

  (This is the method the Kawai K3 uses to send a byte of data)  }
Begin
  MergeBytes := (Hi shl 4) + (Lo and $0F);
End;

Procedure UnMergeBytes( Input:Byte;
                        Var
                          Hi,Lo:Byte);
{ Breaks a byte (Input) into 2 bytes, Hi containing the high nibble,
  and Lo containing the low nibble. (reverse of MergeBytes) }
Begin
  Lo := Input and $0F;
  Hi := Input shr 4;
End;

Procedure SeeMidiStream;
Var
  MidiDAta:Byte;
  Ch:Char;
Begin
  repeat                               {Begin Loop}
    GetData (MidiData);                {Get MidiData from MPU   }
    if MidiData <> $FE then              {If it's not an active sensing byte}
        write (bin (MidiData),'  ');      {..then write it to the screen     }
    If keyPressed then
    Begin
      Read(kbd,Ch);
      EscAbort:=Ch=#27;
      Write(ch);
    End;
  until EscAbort
End;

Procedure CountMidiStream;
Var
  MidiDAta:Byte;
  Ch:Char;
  Count:Integer;
Begin
  Count:=0;
  repeat                               {Begin Loop}
    GetData (MidiData);                {Get MidiData from MPU   }
    if MidiData <> $FE then              {If it's not an active sensing byte}
    Begin
      Count:=Succ(Count);
    end
    Else If Count>0 then
    Begin
      Writeln(Count,' bytes received before $FE.');
      Count:=0;
    End;
    If keyPressed then
    Begin
      Read(kbd,Ch);
      EscAbort:=Ch=#27;
      Write(ch);
    End;
  until EscAbort
End;

Procedure UpdatePos(PatchNumber:Byte;UpDated:Boolean);
Var
  Temp,
  Bank,
  X,Y:Integer;
Begin
  Temp := PatchNumber -1;
  Bank := Temp div 50;
  X := 1 + (Temp div 3) * 3;
  Y := 1 + Bank * 11 + ((PatchNumber - 1) mod 3) * 2;
  If UpDated then HighVideo;
  GotoXY(X,Y);
  Write(PatchNumber);
  LowVideo;
End;

Procedure RequestDataDump;
Const
  Length=8;{Number of bytes in this request command}
  DumpBankArray : array[1..Length] of Byte = ($F0,$40,$00,$01,$00,$01,$00,$FE);
Var
  I:Integer;
Begin
  For I:=1 to Length do PutData(DumpBankArray[I]);
End;

Procedure PutSysExHeader;
Const
  Length=7; {Number of bytes in this request command}
  DumpBankArray : array[1..Length] of Byte = ($F0,$40,$00,$21,$00,$01,$00);
Var
  I:Integer;
Begin
  For I:=1 to Length do PutData(DumpBankArray[I]); {Send SysEx Header}
End;

Procedure GetFileName(Var Name:AnyStringType);
{Gets a file name}
Begin
  Write('Enter file name:');
  Readln(Name);
End;

Procedure ReadBankFromFile(Var Bank:BankType);
Var
  FileName:AnyStringType;
  BankFile:File of BankType;
Begin
  GetFileName(FileName);
  Assign(BankFile,FileName);
  Reset(BankFile);
  Read(BankFile,Bank);
  Close(Bankfile);
End;

Procedure WriteBankToFile(Bank:BankType);
Var
  FileName:AnyStringType;
  BankFile:File of BankType;
Begin
  GetFileName(FileName);
  Assign(BankFile,FileName);
  Rewrite(BankFile);
  Write(BankFile,Bank);
  Close(BankFile);
End;

Procedure GetBankFromKeyboard;
{Gets a bank from keyboard and saves it to a file}
Var
  Hi,Lo,
  MidiData:Byte;
  ChkSum,       {note: in THIS procedure, ChkSum is an integer varable}
  Bite,
  Patch:Integer;
  Ch:Char;
  Bank:BankType;
Begin {GetBankFromKeyboard}
  ClrScr;
  RequestDataDump;
  Repeat {Wait for sysex}
    GetData(MidiData);
    If keyPressed then
    Begin
      Read(kbd,Ch);
      EscAbort:=Ch=#27;
      Write(ch);
    End;
  Until EscAbort or ( MidiData=$F0 );
  Info('System Exclusive Received');
  GetData(MidiData); Info('Kawai ID received');
  GetData(MidiData); Info('Midi Channel (0-15) is :'+Int2Str(MidiData) );
  GetData(MidiData); Info('Function Number:'+int2Str(MidiData) );
  GetData(MidiData); Info('Group number is:'+int2Str(MidiData) );
  GetData(MidiData); Info('ID is: '+int2Str(MidiData) );
  GetData(MidiData); Info('SubCommand = $'+hex(MidiData) );
  For Patch:=1 to PatchesPerBank do
  Begin
    ChkSum:=0;
    For Bite:=1 to BytesPerPatch do
    Begin
      GetData(Hi); GetData(Lo);
      Bank[Patch,Bite]:=MergeBytes(Hi,Lo);
      ChkSum:=ChkSum+Bank[Patch,Bite];
    End;
    GetData(Hi); GetData(Lo);
    If (ChkSum and $00FF) <> MergeBytes(Hi,Lo) Then
             Writeln('Patch #',Patch,' did not pass check sum. Data is bad.');
  End;
  GetData(MidiData); If MidiData<>$FE Then
                 Writeln('End of Exclusive not received when expected.');
  Writeln;
  WriteBankToFile(Bank);
  Writeln('Bank saved.');
End;

Procedure PutBankToKeyboard;
{Send a bank to keyboard}
Const
  Length=7;{Number of bytes in this request command}
  DumpBankArray : array[1..Length] of Byte = ($F0,$40,$00,$21,$00,$01,$00);
Var
  ChkSum,  {note: in THIS procedure, ChkSum is a byte variable}
  Hi,Lo,
  MidiData:Byte;
  Bite,
  Patch:Integer;
  Ch:Char;
  Bank:BankType;
Begin {PutBankToKeyboard}
  ReadBankFromFile(Bank);
  PutSysExHeader;  For Patch:=1 to PatchesPerBank do
  Begin
    ChkSum:=0;
    GotoXY(1,WhereY); Write(Patch);
    For Bite:=1 to BytesPerPatch do
    Begin
      ChkSum := ChkSum + Bank[Patch,Bite];
      UnMergeBytes( Bank[Patch,Bite], Hi, Lo );
      PutData(Hi);
      PutData(Lo);
    End;
    UnMergeBytes(ChkSum,Hi,Lo);
    PutData(Hi);
    PutData(Lo);
  End;
  PutData($FE); {Send end of exclusive}
  Writeln;
  Writeln('File sent');
End;

{ **** MAIN PROGRAM **** }
begin
  for J:=1 to 2000 do mididata:=Port[$330];{clear MPU}
  EscAbort:=False;
  LowVideo;
  PutCmd ($3F);                        {Put MPU into UART mode.  }
  Writeln;
  While not EscAbort do
  Begin
    Writeln('To or From keyboard');
    While not keypressed do;
    Read(kbd,Direction);
    Case Upcase(direction) of
      'T':PutBankToKeyboard;
      'F':GetBankFromKeyboard;
      #27:EscAbort:=True;
    End;{case}
  End;{While}
  PutData ($FF);                       {Reset MPU            }
end.