Sound Sensations!/sound_sensations.iso/miscprog/dumpster/dumpster.pas

Pascal/Delphi Source File | 1980-01-01 | 46.8 KB | 1,848 lines

{$U-,C-}

Program Dumpster;

(*        Data Dump Program By            Randy Grohs
                                     BBS: Midwest MIDI BBS
                                          1 [phone]   *)

Const
   Choices        = 4;
   MaxRecs        = 50;
   ByteBufferSize = 6400;

Var
      Ch,Ch2,Drive          :CHar;


(* Does System Exclusive Data Dumps directly to and from Disk *)

(* Special Keys ***********************************************)

Const
  F1   =   #59;
  F2   =   #60;
  F3   =   #61;
  F4   =   #62;
  F5   =   #63;
  F6   =   #64;
  F7   =   #65;
  F8   =   #66;
  F9   =   #67;
  F10  =   #68;
  ShiftF1  =   #84;
  ShiftF2  =   #85;
  ShiftF3  =   #86;
  ShiftF4  =   #87;
  ShiftF5  =   #88;
  ShiftF6  =   #89;
  ShiftF7  =   #90;
  ShiftF8  =   #91;
  ShiftF9  =   #92;
  ShiftF10 =   #93;
  CtrlF1   =   #94;
  CtrlF2   =   #95;
  CtrlF3   =   #96;
  CtrlF4   =   #97;
  CtrlF5   =   #98;
  CtrlF6   =   #99;
  CtrlF7   =   #100;
  CtrlF8   =   #101;
  CtrlF9   =   #102;
  CtrlF10  =   #103;
  AltF1    =   #104;
  AltF2    =   #105;
  AltF3    =   #106;
  AltF4    =   #107;
  AltF5    =   #108;
  AltF6    =   #109;
  AltF7    =   #110;
  AltF8    =   #111;
  AltF9    =   #112;
  AltF10   =   #113;
  LeftArrow      =   #75;
  RightArrow     =   #77;
  UpArrow        =   #72;
  DownArrow      =   #80;
  HomeKey        =   #71;
  EndKey         =   #79;
  PageUp         =   #73;
  PageDown       =   #81;
  CtrlLeftArrow  =   #115;
  CtrlRightArrow =   #116;
  CtrlHomeKey    =   #119;
  CtrlEndKey     =   #117;
  CtrlPageUp     =   #132;
  CtrlPageDown   =   #118;

Var PossibleChoicesSet:Set Of Char;




(* MPU Commands and Some Colors *****************************************)

Type
     AnyStr          =  String[255];
     CharSet         =  Set Of Char;
     Str2            =  string[2];
     Str8            =  string[8];
     Str10           =  String[10];
     Str12           =  String[12];
     Str20           =  String[20];
     Str25           =  String[25];
     Str40           =  String[10];
     Str80           =  string[80];

Const

  BlueColor       = 1;
  GreenColor      = 2;
  RedColor        = 12;
  WhiteColor      = 15;
  YellowColor     = 14;
  MagentaColor    = 5;
  BlackColor      = 0;
  Dsr             = $80;
  Drr             = $40;
  Ack             = $FE;
  DataPort        = $330;
  StatPort        = $331;
  EOX             = $F7;

  StartPlay           = $0A;
  ContinuePlay        = $0B;
  StartRecord         = $22;
  ContinueRecord      = $23;
  StopAll             = $15;
  StartOverdub        = $2A;
  IntClock            = $80;
  FskCLock            = $81;
  MidiClock           = $82;
  MetronomeOn         = $85;
  MetronomeOff        = $84;
  MidiThruOn          = $89;
  MidiThruOff         = $88;
  DataInStopOn        = $8B;
  DataInStopOff       = $8A;
  SendMeasureEndOff   = $8C;
  SendMeasureEndOn    = $8D;
  ConductorOff        = $8E;
  ConductorOn         = $8F;
  RealTimeAffOn       = $91;
  RealTimeAffOff      = $90;
  ClockToHostOn       = $95;
  ClockToHostOff      = $94;
  ExclusiveOn         = $97;
  ExclusiveOff        = $96;
  ClearPlayCounters   = $B8;
  ClearPlayMap        = $B9;
  ClearRecordCounters = $BA;
  SetTempo            = $E0;
  NoRealTime          = $32;
  ThruOff             = $33;
  WithTimingByte      = $34;
  ExclusiveThruOn     = $37;
  CommonOn            = $38;
  RealTimeOn          = $39;
  UartOn              = $3F;
  SystemReset         = $FF;
  SetActiveTracks     = $EC;
  BenderOn            = $87;
  BenderOff           = $86;


Function Power(I1,I2:Integer):Integer;
Var I,I3:Integer;
Begin
  For I:= 1 to I2 Do
    I3:=I3*I1;
  Power:=I3;
End;


Procedure ShortBeep;
Begin
  Sound(880);
  NoSound;
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;


(* These three subroutines (getdata, putdata and putcmd) should be       *)
(* modified for programs designed for real time use.  More specifically, *)
(* the Keypressed function slows down execution time considerably.       *)



Procedure GetData (Var MidiData:Byte);
  Var
    J:Byte;
  Begin
    J:= 0;
    Repeat
      J:=Port[StatPort];
    Until ((J and Dsr) = 0) or KeyPressed;
    If KeyPressed then Read(Kbd,CH);
    MidiData:=Port[Dataport];
    ShortBeep;
  End;

Procedure PutData (MidiData:Byte);
  Var J:Byte;
  Begin
    J := 0;
    Repeat
      J :=Port[StatPort];
      If (J and Dsr) = 0 Then Repeat
        GetData(J);
        J:= Port[Statport];
      Until ((J and Dsr) <> 0) or KeyPressed;
    Until ((J and Drr) = 0) or KeyPressed;
    If KeyPressed then Read(Kbd,CH);
    Port[DataPort] := MidiData;
    ShortBeep;
  End;

Procedure PutCmd (Cmd:Byte);
  Var I:Integer;
      J:Byte;
  Begin
    J:=0;
    IF (Cmd<>SystemReset) Then Repeat
      J:=Port[StatPort];
    Until ((J and Drr) = 0) or KeyPressed;
    If KeyPressed then Read(Kbd,CH);
    Port[StatPort]:=Cmd;
    ShortBeep;
    Repeat
      GetData(J);
    Until (J=Ack) OR KeyPressed Or ((J<>Ack) and (Cmd=SystemReset));
    If KeyPressed then Read(Kbd,CH);
  End;



function ConstStr(C : Char; N : Integer) : AnyStr;
var
  S : AnyStr;
begin
  if N < 0 then
    N := 0;
  S[0] := Chr(N);
  FillChar(S[1],N,C);
  ConstStr := S;
end;

(*  Beep sounds the terminal bell or beeper *)

procedure Beep;
begin
     Sound(220);Delay(50);
     Sound(440);Delay(50);
     Sound(880);Delay(100);
     NoSound;
end;


function UpcaseStr(S : AnyStr) : AnyStr;
var
  P : Integer;
begin
  for P := 1 to Length(S) do
    S[P] := Upcase(S[P]);
  UpcaseStr := S;
end;

(* Ascii Graphic Chars *****************************************)

Type
     GraphSetType = Record
                      LLCorner,
                      HLine,
                      VLine,
                      ULCorner,
                      URCorner,
                      LRCorner        :  Char;
                    End; {GraphSetType}
Var
     GraphSet : Array[1..2] Of GraphSetType;

Procedure SetGraphSet;
Begin
  With GraphSet[1] DO Begin
    LLCorner            := Chr(192);
    ULCorner            := chr(218);
    HLine               := chr(196);
    VLine               := Chr(179);
    LRCorner            := chr(217);
    URCorner            := chr(191);
  End; {With}
  With GraphSet[2] Do Begin
    LLCorner            := Chr(200);
    ULCorner            := Chr(201);
    HLine               := chr(205);
    VLine               := Chr(186);
    LRCorner            := chr(188);
    URCorner            := chr(187);
  End; {With}
End;


Procedure DrawTextBox( Lines       :Integer ; Prompt,BottomPrompt:AnyStr;
                       X1,Y1,X2,Y2 :Integer);
Var I:Integer;
Begin
  If (Lines>2) or (Lines<1) Then Lines:=2;
  With GraphSet[Lines] Do Begin
    GotoXY(X1,Y1);Write(ULCorner);
    For I:= X1+1 to X2-1 Do Write(HLine);
    Write(URCorner);
    For I:= Y1+1 to Y2-1 Do Begin
      GotoXY(X1,I);Write(VLine);
      GotoXY(X2,I);Write(VLine);
    End;{For}
    GotoXY(X1,Y2);Write(LLCorner);
    For I:= X1+1 to X2-1 Do Write(HLine);
    Write(LRCorner);
    GotoXY(X1+((X2-X1) Div 2)-(Length(Prompt) Div 2),Y1);Write(Prompt);
    GotoXY(X1+((X2-X1) Div 2)-(Length(BottomPrompt) Div 2),Y2);Write(BottomPrompt);
  End;{With}
End;{DrawBox}


(* Main Type and Var Declarations  ****************************************)

Type
    ByteBufferType = Array[1..ByteBufferSize] of Byte;
    VoiceType = Array[1..128] of Byte;
    FormatType = Array[1..6] of Byte;
    VoiceArrayType = Array[1..32] of VoiceType;
    VoiceNameArrayType = Array[1..32] of Str10;
    Str20ArrayType     = Array[1..100] of Str20;
    RequestType = Record
                    Notes         : Str20;
                    RL            : Integer;
                    RequestBuffer : Array[1..60] of Byte;
                  End;
    BankType = Record
                 NormalFormat : Boolean;
                 Buffer       : ByteBufferType;
                 Pos,
                 Len          : Integer;
                 BankName     : Str20;
                 Notes        : Str20;
                 VoiceName    : VoiceNameArrayType;
                 Voice        : VoiceArrayType;
                 CheckSum     : Byte;
                 Saved,
                 Exists       : Boolean;
               End;

Const
   VoiceFormatBytes : FormatType = ($F0,$43,$00,$09,$20,$00);
   FunctionFormatBytes : FormatType = ($F0,$43,$00,$02,$20,$00);

Var AString,FileName,Subdir,
    AFileName,DiskFileName:AnyStr;
    Choice,I,J,K,X,Y      :Integer;
    MaskStr,DefaultMaskStr:Str12;

    Bank                  :Array[1..2] of BankType;

    DumpRequestFile       :File of RequestType;

    TempBank,
    ThisBank              :BankType;

    B,AByte               :Byte;

    CurrentVoice,
    ThisVoice,
    Cluster               :VoiceType;


    AByteFile             :File of Byte;
    TestFile,
    DiskFile,
    AFile                 :File;
    ByteBuffer            :ByteBufferType;

    ThisFormat            :FormatType;

    ScreenNum,
    ActiveBank,
    NoOfRecsToRead,
    Remaining,
    BufferLength,
    Position              :Integer;

    EscapeNow,
    Exit,OverWriteYN,OK   :Boolean;
    TC,TC2                :Char;





(* Some screen I/O subroutines  ****************************************)

Procedure InverseColor;
Begin
  TextColor(WhiteColor);
  TextBackGround(BlueColor);
End;

Procedure NormalColor;
Begin
  TextColor(YellowColor);
  TextBackGround(BlackColor);
End;

Procedure SetRedColor;
Begin
  TextColor(WhiteColor);
  TextBackGround(RedColor);
End;

Procedure ClearBox( Code:Integer );
Var I,X,Y:Integer;
Begin
  If Code=3 Then
    I:=1
  Else
    I:=Code;
  Repeat
    X:=3+(40*(I-1));
    For Y:=6 to 21 do Begin
      GotoXY(X,Y);Write(ConstStr(' ',37));
    End;{For}
    I:=I+1;
  Until (I>2) or (Code<>3);
End;


Procedure Message ( Code : Integer;
                    Strn : AnyStr   );
Var CH:Char;
    X:Integer;
Begin
  If Code=2 Then
    SetRedColor
  Else
    InverseColor;
  GotoXY(1,24);
  Write(ConstStr(' ',39-(Length(Strn) Div 2)),Strn);
  X:=WhereX;
  Write(ConstStr(' ',80-X));
  If Code<>0 Then Beep;
  If Code=2 Then Begin
    Repeat Until KeyPressed;
    Read(Kbd,CH);
    EscapeNow := (CH=#27);
  End;
  NormalColor;
End;


Procedure GetString ( Prompt : AnyStr;
                  Var S      : AnyStr;
                      X,Y,L  : Integer);

const
  UnderScore  =  '_';

Var X2,Y2,PL,P,J:Integer;
    TC2,Ch:Char;
    First:Boolean;

Begin
  InverseColor;
  PL:=Length(Prompt);
  First:=true;
  X2:=X;Y2:=Y;
  GotoXY(X,Y);Write(ConstStr(UnderScore,PL+L));
  GotoXY(X,Y);Write(Prompt);
  X:=WhereX;Y:=WhereY;
  GotoXY(X,Y);Write(S);
  If Y=24 Then Write(ConstStr(' ',80-X));
  P := 0;
  CH:=#1;
  repeat
    Tc2:=#1;
    TextColor(WhiteColor);
    GotoXY(X+P,Y); Read(Kbd,Ch);
    case Ch of
      #1        : ;
      #27       : Begin
                     Read(kbd,Tc2);
                     case TC2 of
                       #83: if P < Length(S) then
                              begin
                               Delete(S,P + 1,1);
                               Write(Copy(S,P + 1,L),UnderScore);
                              end;
                       'K': If P>0 then P:=P-1;
                       'M': If P<Length(S) Then P:=P+1;
                   #1,#27 : EscapeNow:=True;
                     end;{case}
                  end;
      #32..#126 : if P < L then
                    begin
                      If First Then Begin
                        Write(Copy(S,P + 1,L),UnderScore);
                        Delete(S,P + 1,L);
                        GotoXY(X+P,Y);
                      End;{If}
                      First:=False;
                      if Length(S) = L then
                        Delete(S,L,1);
                      P := P + 1;
                      Delete(S,P,1);
                      Insert(Ch,S,P);
                      Write(Copy(S,P,L));
                    end
                  else
                    Beep;
      ^A        : P := 0;
      ^F        : P := Length(S);
      ^G        : if P < Length(S) then
                  begin
                    Delete(S,P + 1,1);
                    Write(Copy(S,P + 1,L),UnderScore);
                  end;
      ^H,#127   : if P > 0 then
                  begin
                    Delete(S,P,1);
                    Write(^H,Copy(S,P,L),UnderScore);
                    P := P - 1;
                  end
                  else Beep;
      ^Y        : begin
                    Write(ConstStr(UnderScore,Length(S) - P));
                    Delete(S,P + 1,L);
                  end;
      ^M        : ;
    Else
      Beep;
    end;  {of case}
  until (Ch = ^M) or EscapeNow;
  P := Length(S);
  NormalColor;
  GoTOXY(X2,Y2);Write(Prompt,S);
  GotoXY(X + P , Y);
  Write('' :L - P);
  If Y=24 Then Write(ConstStr(' ',80-X));
End;



Procedure GetChar (    Code   : Integer;
                       Prompt : AnyStr;
                  Var  Ch     : Char   );
Begin
  If Code=2 Then
    SetRedColor
  Else If Code=1 Then
    InverseColor
  Else
    NormalColor;
  GotoXY(1,24);
  Write(Prompt);
  If Code=2 Then Beep;
  Repeat Until Keypressed;
  Read(Kbd,CH);
  EscapeNow := (CH=#27);
  NormalColor;
End;

(* File and Buffer IO  ****************************************)


Function Other(I:Integer):Integer;
Begin
  Other:=(I Mod 2) + 1;
End;


Procedure CheckTheSum (      Voices : VoiceArrayType ;
                        Var SumByte : Byte                            );

Const Nums : Array[0..8] of Byte = ($0,$1,$2,$4,$8,$10,$20,$40,$80);

Var   J,I:Integer;
      B,B2,B3,B4:Byte;
(*  This CHECKSUM routine finds the Two's complement of the sum      *)
(*  of the databytes.                                                *)
Begin
  B:=0;
  For J:=1 to 32 do
    For I:=1 to 128 do
      B:=B + Voices[J,I];
  B:=B mod 128;
  B:=(Not B) + 1;
End;


Function DiskExist(AStr:AnyStr):Boolean;
Begin
  Assign(TestFile,ASTR);
  {$I-}
  Reset(TestFile);
  DiskExist:=(IOResult=0);
  {$I+}
  Repeat Until (IOResult=0);
  Close(TestFile);
End;


Function DiskValid(AStr:AnyStr):Boolean;
Begin
  Assign(TestFile,ASTR);
  {$I-}
  ReWrite(TestFile);
  DiskValid:=(IOResult=0);
  {$I+}
  Repeat Until (IOResult=0);
  Close(TestFile);
End;

Procedure Uart;
Var B:Byte;
Begin
  Port[StatPort]:=SystemReset;
  B:=Port[StatPort];
  If (B and Dsr) = 0 Then GetData(B);
  PutCmd(UartOn);
End;


Procedure GetByte (Var B:Byte);
Begin
  B:=ByteBuffer[Position];
  Position:=Position+1;
End;

Procedure PutByte (B:Byte);
Begin
  BufferLength:=BufferLength+1;
  ByteBuffer[BufferLength]:=B;
End;

Procedure GetBuffer( Source:Integer );
Var FS,Stat,I:Integer;
    J,B:Byte;
    Ch:Char;
    NormFmt:Boolean;
Begin
  NormFmt:=True;
  BufferLength:=0;
  Stat:=0;
  FillChar(ByteBUffer,SizeOf(ByteBuffer),$1D);
  I:=1;
  If (Source=1) Then Begin
    Repeat
      J:= 0;
      Repeat
        J:=Port[StatPort];
      Until ((J and Dsr) = 0);
      B:=Port[DataPort];
      If B<>ACK Then Begin
        Stat:=1;
        PutByte(B);
      End Else Begin
        If (Stat>0) Then Stat:=Stat+1;
      End;
    Until (B=EOX) or (Stat=30);
  End Else Begin
    Assign(AByteFile,DiskFileName);
    Reset(AByteFile);
    Read(AByteFile,B);
    Close(AByteFile);
    If (B=$F0) Then NormFmt:=False;
    Assign(AFile,DiskFileName);
    Reset(Afile);
    FillChar(ByteBuffer,SizeOf(ByteBuffer),$1D);
    If NormFmt Then Begin
      For I:= 1 to 6 do ByteBuffer[i]:=VoiceFormatBytes[I];
      {$I-}
      BlockRead(AFile,ByteBuffer[7],33);
      {$I+}
    End Else Begin
      FS:=FileSize(AFile);
      {$I-}
      BlockRead(AFile,ByteBuffer[1],FS)
      {$I+}
    End;{If}
    If (IOResult>0) or (Not Eof(AFile)) Then Begin
      CLose(AFile);
      Assign(AByteFile,DiskFileName);
      Reset(AByteFile);
      {$I-}
      Seek(AByteFile,4096);
      {$I+}
      If IOResult=0 Then Begin
        BufferLength:=4103;
        Read(AByteFile,B);
        PutByte(B);
        If Not Eof(ABYteFile) Then
        Repeat
          Read(AByteFile,B);
          PutByte(B);
        Until EOF(AByteFile);
      End;
      Close(AByteFile);
    End Else
      If NormFmt Then
        BufferLength:=4230
      Else
        BufferLength:=FS*128;
    Close(AFile);
  End;
End;{GetBUffer}

Procedure PutBuffer ( Destination:Integer );
Var I:Integer;
    J,B:Byte;
    CH:Char;
    NormFormat:Boolean;
    Recs:Integer;
Begin
  NormFormat:=Bank[ActiveBank].NormalFormat;
  IF (Destination = 1) Then Begin
    For I:= 1 to BufferLength do PutData(ByteBuffer[I]);
  End Else Begin
    Close(DiskFile);
    Assign(AFile,DiskFileName);
    ReWrite(AFile);
    If NormFormat Then
      Recs:=33
    Else Begin
      Recs:=BufferLength div 128;
      If BufferLength Mod 128 > 0 Then Recs:=Recs+1;
    End;
    BlockWrite(AFile,ByteBuffer,Recs);
    Close(AFile);
  End;
End;{PutBUffer}

(* Dump Request routines *)


Procedure SendDumpRequest;
Var X1,X2,J,K,RS,FP,FS,L,I,X,Y,Ok:Integer;
    ThisRequest:RequestType;
    Same,Adding,Finished,Edit:Boolean;
    S2,S:AnyStr;
    Ch:Char;
Begin
  Adding:=False;
  Finished:=False;
  Assign(DumpRequestFile,'DmpReqst.Dat');
  {$I-}
  Reset(DumpRequestFile);
  {$I+}
  If IOResult>0 Then Rewrite(DumpRequestFile);
  Repeat Until IOResult = 0;
  X1:=3+(40*(0));
  X2:=3+(40+(1));
  Repeat
    ClearBox(3);
    FS:=FileSize(DumpRequestFile);
    Seek(DumpRequestFile,0);
    If (FileSize(DumpRequestFile)>0) Then Begin
      For I:= 1 to FS do Begin
        If (I>12) Then Begin
          X:=X2;Y:=I-12+6;
        End Else Begin
          X:=X1;Y:=I+6;
        End;
        GotoXY(X,Y);
        Read(DumpRequestFile,ThisRequest);
        With ThisRequest do Write(I:3,' : ',Notes);
      End;
    End;
    Edit:=False;
    Repeat
      L:=0;
      RS:=0;
      S:='';
      GetString('Enter the number of the dump request to send (E to Edit) (C to Copy) : ',S,1,24,3);
      If (Length(S)>0) Then Ch:=Copy(S,1,1) Else Ch:=' ';
      If (Ch in ['e','E']) Then Edit:=True Else Val(S,RS,OK);
      If (Ch in ['c','C']) Then Begin
        Repeat
          S:='';
          GetString('Enter the number of the dump request to copy : ',S,1,24,3);
          Val(S,L,OK);
        Until (L in [1..FS]) or EscapeNow;
        Edit:=True;
        Seek(DumpRequestFile,L-1);
        Read(DumpRequestFile,ThisRequest);
        Seek(DumpRequestFile,FS);
        WRite(DumpRequestFile,ThisRequest);
        FS:=FS+1;
        L:=FS;
        RS:=0;
      End;{If}
    Until (RS in [1..FS]) or EscapeNow or Edit;
    If (Not EscapeNow) and Edit Then Begin
      If Not (L in [1..FS]) Then Repeat
        L:=0;
        S:='';
        GetString('Enter the number of the request to EDIT (0 to Add) : ',S,1,24,3);
        Val(S,L,Ok);
      Until (L in [0..FS]) or EscapeNow;
      If L=0 Then Begin
        Seek(DumpRequestFile,FS);
        FP:=FilePos(DumpRequestFile);
        FillChar(ThisRequest,SizeOf(ThisRequest),0);
        ThisRequest.Notes:='';
        ThisRequest.RL:=0;
      End Else Begin
        Seek(DumpRequestFile,L-1);
        FP:=FilePos(DumpRequestFile);
        Read(DumpRequestFile,ThisRequest);
      End;
      If FS>0 Then ClearBox(3);
      X:=X1;
      With ThisRequest do Begin
        GotoXY(X,6);Write(Notes);
        If (RL>0) Then For I:= 1 to RL do Begin
          If (I>12) Then Begin
            X:=X2;Y:=I-12+6;
          End Else Begin
            X:=X1;Y:=I+6;
          End;
          GotoXY(X,Y);Write('Byte Number ',I,' : $'+Hex(RequestBuffer[I]));
        End;
        S:=Notes;
        GetString('Notes : ',S,X1,6,20);
        Notes:=S;
        If Not EscapeNow Then
        Repeat
          S:='';
          L:=0;
          If (RL>0) Then Begin
            Repeat
              L:=0;
              GetString('Enter Number of Byte to Change (0 to Add) (<Esc> to Exit) : ',S,1,24,3);
              Val(S,L,Ok);
            Until (L in [0..RL]) or EscapeNow;
            Finished:=EscapeNow;
            EscapeNow:=False;
          End Else Adding:=True;
          If Not Finished Then Begin
            If (RL=0) or (L=0) Then Begin Adding:=True; End;
            Repeat
              If Adding Then Begin RL:=RL+1;L:=RL; End;
              Str(L,S2);
              S2:='Byte Number '+S2+' : ';
              S:='$'+Hex(RequestBuffer[L]);
              If (L>12) Then Begin
                X:=X2;Y:=L-12+6;
              End Else Begin
                X:=X1;Y:=L+6;
              End;
              GetString(S2,S,X,Y,3);
              If EscapeNow Then Begin
                If Adding Then RL:=RL-1;
              End Else Begin
                Val(S,J,Ok);
                RequestBuffer[L]:=J;
              End;
              If EscapeNow Then Adding:=False;
              EscapeNow:=False;
            Until (Not Adding);
          End;{If}
        Until Finished or (L>60);
      End;{With}
      Seek(DumpRequestFile,FP);
      Write(DumpRequestFile,ThisRequest);
    End;{If Edit}
  Until ((RS in [1..FS]) And (Not Edit)) or EscapeNow;
  Uart;
  If (Not EscapeNow) and (RS in [1..FS]) Then Begin
    ClearBox(3);
    Seek(DumpRequestFile,RS-1);
    Read(DumpRequestFile,ThisRequest);
    Close(DumpRequestFile);
    BufferLength:=0;
    X:=X1;
    With ThisRequest do Begin
      GotoXY(X,6);Write(Notes);
      If (RL>0) Then For I:= 1 to RL do Begin
        If (I>12) Then Begin
          X:=X2;Y:=I-12+6;
        End Else Begin
          X:=X1;Y:=I+6;
        End;
        GotoXY(X,Y);Write('Byte Number ',I,' : $'+Hex(RequestBuffer[I]));
      End;
      For I:= 1 to RL Do PutByte(RequestBuffer[I]);
      PutBuffer(1);
      GetBuffer(1);
      Same:=True;
      If (BufferLength=RL) Then Begin
        For I:= 1 to RL do Same:=Same And (RequestBuffer[I]=ByteBuffer[I]);
        If Same Then GetBuffer(1);
      End;
    End;{With}
  End Else
    EscapeNow := True;
End;






(* Main Procedures  ****************************************)

Procedure HighLightVoice( C,B,V:Integer );
Var I:Integer;
Begin
  If C=1 Then NormalColor Else SetRedColor;
  If (B=1) Then With Bank[1] DO Begin
    For I:= 1 to 16 do If V=I Then Begin
      GotoXY(5,I+5);
      Write(I:2,'. ',VoiceName[I]);
    End;{for}
    For I:= 17 to 32 do If V=I Then Begin
      GotoXY(24,I-11);
      Write(I:2,'. ',VoiceName[I]);
    End;{For}
  End;{With}
  If (B=2) Then With Bank[2] DO Begin
    For I:= 1 to 16 do If V=I Then Begin
      GotoXY(44,I+5);
      Write(I:2,'. ',VoiceName[I]);
    End;{for}
    For I:= 17 to 32 do If V=I Then Begin
      GotoXY(64,I-11);
      Write(I:2,'. ',VoiceName[I]);
    End;{For}
  End;{With}
End;{HighLightVoice}

Procedure DrawBoxes;
Var CBX1,CBX2,CBY1,CBY2,RBX1,RBX2,RBY1,RBY2,I,J,K,N,M:Integer;
Begin
  NormalColor;
  CBX1:=2;CBY1:=5;
  CBX2:=40;CBY2:=22;
  RBX1:=41;RBY1:=5;
  RBX2:=79;RBY2:=22;
  If ActiveBank=1 Then SetRedColor;
  DrawTextBox(1,Bank[1].BankName,Bank[1].Notes,CBX1,CBY1,CBX2,CBY2);
  NormalColor;
  If ActiveBank=2 Then SetRedColor;
  DrawTextBox(1,Bank[2].BankName,Bank[2].Notes,RBX1,RBY1,RBX2,RBY2);
  NormalColor;
End;

Procedure DrawVoices;
Var X,Y,B,I:Integer;
Begin
  DrawBoxes;
  For B:= 1 to 2 do Begin
    If Bank[B].NormalFormat Then
      For I := 1 to 32 do HighLightVoice(1,B,I)
    Else Begin
      X:=6+(40*(B-1));
      With Bank[B] do Begin
        GotoXY(X,8);Write('Status : ':25,Hex(Buffer[1]));
        GotoXY(X,9);Write('ID : ':25,Hex(Buffer[2]));
        GotoXY(X,10);Write('Sub Status : ':25,Hex(Buffer[3]));
        GotoXY(x,11);Write('Format Number : ':25,Hex(Buffer[4]));
        GotoXY(X,12);Write('Byte Count 1 : ':25,Hex(Buffer[5]));
        GotoXY(X,13);Write('Byte Count 2 : ':25,Hex(Buffer[6]));
        Y:=(Buffer[5]*128) + Buffer[6];
        GotoXY(X,14);Write('Byte Count   : ':25,Y);
        GotoXY(x,16);Write('Total Bytes in Buffer : ':25,Len);
      End;{With}
    End;{Else}
  End;{For}
End;{DrawVoices}



Type RegRec = record
                AX, BX, CX, DX, BP, SI, DI, DS, ES, Flags : Integer;
              end;






Function DiskSpace:Real;

var
  Tracks,                              { number of available Tracks }
  TotalTracks,                         { number of total Tracks }
  Drive,                               { Drive number }
  Bytes,                               { number of Bytes in one sector }
  Sectors              : Integer;      { number of total Sectors }
  Regs                 : RegRec;


   procedure DiskStatus( Drive : integer;  var Tracks, TotalTracks,
                         Bytes, Sectors : integer );
   begin
     Regs.AX := $3600;               { Get Disk free space }
     Regs.DX := Drive;               { Store Drive number }
     MSDos( Regs );                  { Call MSDos to get disk info }
     Tracks := Regs.BX;              { Get number of Tracks Used }
     TotalTracks := Regs.DX;         {  "    "    "  total Tracks }
     Bytes := Regs.CX;               {  "    "    "  Bytes per sector }
     Sectors := Regs.AX              {  "    "    "  Sectors per cluster }
   END; { of proc DiskStatus }

begin
  Drive:=0;
  DiskStatus( Drive, Tracks, TotalTracks, Bytes, Sectors );
  DiskSpace := ((Sectors * Bytes * 1.0) * Tracks);
end; {Function DiskSpace}






Procedure GetSubDir( Var SubDir:AnyStr );
Var Regs : RegRec;
    I    : Integer;
begin
  FillChar(Regs,SizeOf(Regs),0);
  FillChar(SubDir,SizeOf(SubDir),0);
  Regs.AX := $4700;          { Get Sub-directory info }
  Regs.DS := Seg( SubDir );
  Regs.SI := Ofs( SubDir )+1;
  MSDos(Regs);               { Execute MSDos call }
  I:=0;
  Repeat
    I:=I+1;
  Until (SubDir[I]=#0) or (I>64);
  SubDir[0]:=Chr(I-1);
end; { of procedure GetSubDir  }


Procedure GetDefaultDrive( Var Drive:Char );
Var Regs : RegRec;
    I    : Integer;
begin
  Regs.AX := $1900;                      { Get current Drive number }
  MSDos( Regs );                         { Call MSDos }
  I := (Regs.AX and $FF);                { Return value via function }
  Drive:=Chr(65+I);
END; { GetDefaultDrive }


Procedure ChangeSubdir;
type
  Int                  = -32767..32767;

var
  SubDir2  :AnyStr;
  Error                : Int;

       procedure ChangeDir2(Segment, Offset : Integer;
                                  var Error : Int );
       var
         Regs                  : RegRec;
       begin
         Regs.DS := segment;
         Regs.DX := offset;
         Regs.AX:= $3B00;
         MSDos( Regs );
         Error := Regs.AX and $FF;
       end;

begin
  GetString('Enter name of new directory: ',SubDir,1,24,40);
  For I:= 1 to Length(SubDir) do SubDir[I]:=UpCase(SubDir[I]);
  If (SubDir[2]<>':') Then SubDir:=Drive+':'+SubDir;
  If (SubDir[3]<>'\') then Insert('\',SubDir,3);
  If (SubDir[Length(SubDir)]='\') And (Length(SubDir)>3) Then Begin
    Delete(SubDir,Length(SubDir),1);
    Insert(#0,SubDir,Length(SubDir)+1);
  End;
  ChangeDir2( DSeg, Ofs( SubDir )+1, Error );
  if ( Error <> 0 ) then Message(2,'Directory not found.');
  GetSubDir(SubDir);
end; { of procedure ChangeDir }






Procedure ChangeDrive;
Type  Int       = -32767..32767;
var
  Error                : Int;
  Regs                 : RegRec;
  I,J                  : Integer;
  DDrive               : Char;
  ADrive               : AnyStr;
  TotDrives            : Integer;
Begin
  DDrive:=Drive;
  J:=Ord(Drive)-65;
  Regs.DX:= J;
  Regs.AX:= $E00;
  MSDos( Regs );
  TotDrives:=(Regs.AX Mod 256);
  Repeat
    ADrive:=Drive;
    GetString('Enter New Default Drive : ',ADrive,1,24,1);
    Drive := ADrive[1];
    Drive := Upcase(Drive);
    J:=Ord(Drive)-65;
    If (Not EscapeNow) and (Not ((J+1) in [1..TotDrives])) Then
      Message(2,'Not a legal drive!');
  Until ((J+1) in [1..TotDrives]) or EscapeNow;
  If Not EscapeNow Then Begin
    Regs.DX:= J;
    Regs.AX:= $E00;
    MSDos( Regs );
  End Else Drive := DDrive;
  GetSubDir(SubDir);
end; { of proc ChangeDrive }






Procedure DirList( Var FileList    : Str20ArrayType;
                   Var ListLength  : Integer);
type
  Char12arr            = array [ 1..12 ] of Char;
  String20             = string[ 20 ];

var
  Regs                 : RegRec;
  DTA                  : array [ 1..43 ] of Byte;
  Mask                 : Char12arr;
  NamR                 : String20;
  K,Error, I           : Integer;

begin { main body of program DirList }

  Message(1,'Processing Directory Information....');
  ListLength:=0;

  FillChar(DTA,SizeOf(DTA),0);        { Initialize the DTA buffer }
  FillChar(Mask,SizeOf(Mask),' ');      { Initialize the mask }
  FillChar(NamR,SizeOf(NamR),0);      { Initialize the file name }

  Regs.AX := $1A00;         { Function used to set the DTA }
  Regs.DS := Seg(DTA);      { store the parameter segment in DS }
  Regs.DX := Ofs(DTA);      {   "    "      "     offset in DX }
  MSDos(Regs);              { Set DTA location }
  Error := 0;
  If (Length(MaskStr)=0) then
    MaskStr:=DefaultMaskStr
  Else Begin
    If (Copy(MaskStr,Length(MaskStr),1)=':') or
       (Copy(MaskStr,Length(MaskStr),1)='\') Then Begin
       MaskStr:=MaskStr+'*.*';
    End;
  End;
  For I:= 1 to Length(MaskStr) do Mask[I]:=MaskStr[I];


  Regs.AX := $4E00;          { Get first directory entry }
  Regs.DS := Seg(Mask);      { Point to the file Mask }
  Regs.DX := Ofs(Mask);
  Regs.CX := 22;             { Store the option }
  MSDos(Regs);               { Execute MSDos call }
  Error := Regs.AX and $FF;  { Get Error return }
  I := 1;                    { initialize 'I' to the first element }
  if (Error = 0) then Begin
    repeat
      NamR[I] := Chr(Mem[Seg(DTA):Ofs(DTA)+29+I]);
      I := I + 1;
    until not (NamR[I-1] in [' '..'~']) or (I>20);
    NamR[0] := Chr(I-1);        { set string length because assigning }
                                { by element does not set length }
    If (Length(NamR)>1) and (NamR<>'..') Then Begin
      ListLength:=ListLength+1;
      FileList[ListLength]:=NamR;
    End;
  End;{If}
  while (Error = 0) do begin
    Error := 0;
    Regs.AX := $4F00;           { Function used to get the next }
                                { directory entry }
    Regs.CX := 22;              { Set the file option }
    MSDos( Regs );              { Call MSDos }
    Error := Regs.AX and $FF;   { get the Error return }
    I := 1;
    repeat
      NamR[I] := Chr(Mem[Seg(DTA):Ofs(DTA)+29+I]);
      I := I + 1;
    until not (NamR[I-1] in [' '..'~'] ) or (I > 20);
    NamR[0] := Chr(I-1);
    If (Error = 0) and (Length(NamR)>1) and (NamR<>'..') Then Begin
      ListLength:=ListLength+1;
      FileList[ListLength]:=NamR;
    End;{If}
  end;{While}
end; { of program DirList  }

Procedure DrawScreen;
Var S:AnyStr;
    I:Integer;
Begin
  If (ScreenNum=1) Then Begin
    ClrScr;
    InverseColor;
    GotoXY(2,2);Write
    ('  F1      F2      F3      F4      F5      F6      F7      F8      F9      F10 ');
    GotoXY(2,3);Write
    (' Midi    Midi    File    File   Toggle   Move   Change  Change   Drive    Exit');
    GotoXY(2,4);Write
    (' Load    Dump    Load    Save    Bank    Voice  V-Name   Notes    Menu        ');
  End Else If (ScreenNum=2) Then Begin
    InverseColor;
    GotoXY(2,2);Write
    ('    F1              F2              F3               F4             F10       ');
    GotoXY(2,3);Write
    ('  Change          Change          Change          Directory         Main      ');
    GotoXY(2,4);Write
    ('  Drive           SubDir           Mask            Listing          Menu      ');
  End;
  Str(DiskSpace:8:0,S);
  S:=Drive+':'+Subdir+'\'+MaskStr+'        '+S+' bytes available';
  DrawTextBox(2,'Randy''s Dx/Tx Dumpster',S,1,1,80,23);
  NormalColor;
End;


Procedure GetNames( Var ThisBank : BankType);
Var N,I:Integer;
    St:Str10;
Begin
  With ThisBank Do Begin
    For I:= 1 to 32 do Begin
      St[0]:=Chr(10);
      For N:= 1 to 10 do Begin
        St[N]:=Chr(Voice[I,118+N]);
        VoiceName[I]:=St;
      End;
    End;
  End;
End;

Procedure LoadBuffer(Source:Integer);
Var FormatOk,OverWriteYn:Boolean;
    OverWrite:Char;
    L,MidiError,I,J,K:Integer;
    AString,S1,S2:AnyStr;
    Ch:Char;
Begin
  ThisBank.NormalFormat:=True;
  If BufferLength>6 Then Begin
     MidiError:=0;
     Position:=1;
     Repeat
       GetByte(B);
     Until (B=$F0) or (Position>BufferLength);
     Message(0,'Processing Format Bytes');
     ThisFormat[1]:=$F0;
     For I:= 2 to 6 do Begin
       GetByte(ThisFormat[I]);
     End;{For}
     FormatOK:=True;
     For I:=1 to 6 do FormatOK:= FormatOK and (ThisFormat[i]=VoiceFormatBytes[I]);
     If Not FormatOK Then Begin
       ThisBank.NormalFormat:=False;
       MidiError:=1;
     End;
     If (MidiError=0) and ThisBank.NormalFormat Then With ThisBank do Begin
       Message(0,'Processing Voice Bytes');
       J:=1;
       Repeat
         I:=1;
         Repeat
           GetByte(Voice[j,i]);
           I:=I+1;
         Until (I>128) or KeyPressed;
         J:=J+1;
       Until (j>32) or KeyPressed;
       CheckTheSum(Voice,CheckSum);
       GetByte(B);
       If (B<>Checksum) Then Midierror:=2;
       If (Source=1) Then GetByte(B) Else B:=EOX;
       If (B<>EOX) Then Begin
         MidiError:=3;
       End;
       If (Source=2) Then Begin
         L:=0;
         For I:= 1 to 20 Do Begin
           GetByte(B);
           If (B in [32..127]) Then Begin
             L:=L+1;
             Notes[I]:=Chr(B);
           End;
         End;{for}
         If L=0 Then Notes:='' Else Notes[0]:=Chr(L-1);
       ENd Else
         Notes:='';
     End;{If/With}
     If Not ThisBank.NormalFormat Then With ThisBank do Begin
       Message(0,'Processing Bytes....    Not a DX/TX Format....');
       Buffer:=ByteBuffer;
       Len:=BufferLength;
       Position:=1;
       If (Source=2) Then Begin
         Repeat
           GetByte(B);
         Until (B=EOX);
         L:=0;
         For I:= 1 to 20 Do Begin
           GetByte(B);
           If (B in [32..127]) Then Begin
             L:=L+1;
             Notes[I]:=Chr(B);
           End;
         End;{for}
         If L=0 Then Notes:='' Else Notes[0]:=Chr(L-1);
       End Else
         Notes:='';
     End;{If/With}
     Case MidiError Of
       2 : Message(2,'Checksum Error !');
       3 : Message(2,'EOX Error');
     End;{Case}
     Bank[ActiveBank]:=ThisBank;
     With Bank[ActiveBank] do Begin
       Exists:=True;
       If Source=1 Then BankName:='MidiPort' Else BankName:=DiskFileName;
       If Source=1 Then Saved:=False Else Saved:=True;
     End;{With}
     If ThisBank.NormalFormat Then GetNames(Bank[ActiveBank]);
  End Else Begin
    Message(2,'No Sys-Ex Midi Data was received !');
  End;
End;{LoadBuffer}

Procedure GetDiskFile;
Var S,AString : AnyStr;
    ListLength,
    X,Y,J,Ok,
    X1,X2,X3,X4,
    Choice,
    I,L     : Integer;
    FileList: Str20ArrayType;

Begin
  Repeat
    DirList(FileList,ListLength);
    X1:=2;X2:=28;X3:=54;
    I:=1;
    If ListLength>0 Then Begin
      Repeat
        Repeat
          Y:=5;
          If X=X1 Then
            X:=X2
          Else if X=X2 Then
            X:=X3
          Else Begin
            ClrScr;
            DrawScreen;
            X:=X1;
          End;
          Repeat
            GotoXY(X,Y);
            Write(I:2,':',FileList[I]);
            I:=I+1;
            Y:=Y+1;
          Until (Y=23) or (I>ListLength);
        Until (X=X3) or (I>ListLength);
        Repeat
          DiskFileName:='';
          J:=0;
          GetString('Enter Number of File to Load : ',DiskFileName,1,24,4);
          If Not EscapeNow then Val(DiskFileName,J,OK);
          If (Ok>0) or (not J in [0..ListLength]) Then
            Message(2,'Illegal Number !');
        Until (OK=0) and (J in [0..ListLength]) or EscapeNow;
        If (I>ListLength) Then I:=1;
        X:=0;
      Until (J>0) or (EscapeNow);
      DiskFileName:=FileList[J];
    End Else Begin
      DiskFileName:='ksqivnks.8vm';
    End;
  Until (Length(DiskFileName)>1) or EscapeNow;
  If (Not EscapeNow) and (DiskExist(DiskFileName)) Then Begin
    Bank[ActiveBank].BankName:=DiskFileName;
    Assign(DiskFile,DiskFileName);
    Message(0,'Loading File From Disk .......');
    GetBuffer(2);
    LoadBuffer(2);
    Close(DiskFile);
  End Else Begin
    If Not EscapeNow Then Message(2,'File Does Not Exist !!! ');
  End;
End;{GetDiskFile}



Procedure SaveDiskFile;
Var S:AnyStr;
    OK:Boolean;
    Ch:Char;
Begin
  Ok:=False;
  Repeat
    DiskFileName:=Bank[ActiveBank].BankName;
    GetString('Enter Full File Name to Save to : ',DiskFileName,1,24,20);
    If DiskExist(DiskFilename) Then Begin
      GetChar(2,'File Already Exists !!!!     Replace  ?? ',Ch);
      If (CH in ['y','Y']) Then Begin
        OK:=True;
      End;
    End Else If Not DiskValid(DiskFileName) Then Begin
      If Not EscapeNow Then Message(2,'File Name is not Legal !');
    End Else
      OK:=True;
  Until EscapeNow or Ok;
  If Not EscapeNow Then Begin
    Bank[ActiveBank].BankName:=DiskFileName;
    DrawBoxes;
    Message(0,'Saving Active Bank to Disk.....');
    Assign(DiskFile,DiskFileName);
    Rewrite(DiskFile);
    FillChar(ByteBuffer,SizeOf(ByteBuffer),0);
    BufferLength:=0;
    With Bank[ActiveBank] do Begin
      If NormalFormat Then Begin
        J:=1;
        Repeat
          I:=1;
          Repeat
            PutByte(Voice[j,i]);
            I:=I+1;
          Until (I>128) or (Ch=^M) or KeyPressed;
          J:=J+1;
        Until (j>32) or (Ch=^M) or KeyPressed;
        CheckTheSum(Voice,CheckSum);
        PutByte(CheckSum);
        For I:= 1 to 20 Do PutByte(Ord(Notes[I]));
      End Else Begin
        ByteBuffer:=Buffer;
        BufferLength:=Len;
      End;
      Saved:=True;
      Exists:=True;
    End;{With}
    PutBuffer(2);
    Close(DiskFile);
  End;
  Str(DiskSpace:8:0,S);
  S:=Drive+':'+Subdir+'\'+MaskStr+'        '+S+' bytes available';
  DrawTextBox(2,'Randy''s Dx/Tx Dumpster',S,1,1,80,23);
End;{SaveDiskFile}


Procedure DumpToMidi;
Var X,Y,I,J,K:Integer;
    AName:AnyStr;
    ABank:BankType;
Begin
 If Not Bank[ActiveBank].Exists Then Begin
   GetDiskFile;
   DrawVoices;
 End;
 If Not EscapeNow Then Begin
  Message(0,'Dumping Current Bank to Midi .....');
  BufferLength:=0;
  With Bank[ActiveBank] do Begin
    If NormalFormat Then Begin
      CheckTheSum(Voice,CheckSum);
      For I:= 1 to 6 do PutByte(VoiceFormatBytes[i]);
      J:=1;
      Repeat
        I:=1;
        Repeat
          PutByte(Voice[j,i]);
          I:=I+1;
        Until (I>128) or KeyPressed;
        J:=J+1;
      Until (j>32) or KeyPressed;
      PutByte(CheckSum);
      PutByte(EOX);
    End Else Begin
      ByteBuffer:=Buffer;
      BufferLength:=Len;
    End;
  End;{With}
  PutBuffer(1);
 End;{If not EscapeNow};
End;{DumpToMidi}



Procedure CheckBanks;
Var Ch:Char;
Begin
  If ((ActiveBank=1) Or Exit) and (Not Bank[1].Saved) Then Begin
    GetChar(2,'Bank 1 not saved to disk !!  Do you want to save it ?',Ch);
    If (Ch in ['y','Y']) Then SaveDiskFile Else Bank[ActiveBank].Saved := True;
  End;{if}
  If ((ActiveBank=2) or Exit) And (Not Bank[2].Saved) Then Begin
    GetChar(2,'Bank 2 not saved to disk !!  Do you want to save it ?',Ch);
    If (Ch in ['y','Y']) Then SaveDiskFile Else Bank[ActiveBank].Saved := True;
  End;{if}
End;{CheckBanks}





Procedure SendMidiBank;
Begin
  DumpToMidi;
End;

Procedure GetMidiBank;
Var Ch:Char;
Begin
  CheckBanks;
  If Not EscapeNow THen Begin
    GetChar(1,'Do you want to Send/Edit a dump request ? ',Ch);
    If (Ch in ['y','Y']) Then
      SendDumpRequest
    Else Begin
      Message(1,'Go Ahead and Send Midi Sys-Ex.....');
      Uart;
      GetBuffer(1);
    End;
    If Not EscapeNow Then Message(1,'Midi Received');
    If Not EscapeNow Then LoadBuffer(1);
  End;
  DrawScreen;
  DrawVoices;
End;

Procedure ChooseBank;
Begin
  CheckBanks;
  If Not EscapeNow Then GetDiskFile;
  DrawScreen;
  DrawVoices;
End;

Procedure MoveVoices;
Var A,i,Ok,B1,B2,V1,V2:Integer;
    S,SB1,SB2,SV1,SV2:AnyStr;
    Ch:Char;
    A1,A2:Boolean;
Begin
  A:=0;
  For I := 1 to 2 do If Bank[I].NormalFormat Then A:=A+1;
  A1:=Bank[1].NormalFormat;
  A2:=Bank[2].NormalFormat;
  If A>1 Then
    Repeat
      SB1:='';
      GetString('Enter Source Bank # (1-2) : ',SB1,1,24,2);
      Val(SB1,B1,Ok);
    Until (B1 in [1,2]) or EscapeNow
  Else
    If A>0 Then
      If A1 Then B1:=1 Else B1:=2
    Else
      EscapeNow:=True;
  If Not EscapeNow Then Repeat
    SV1:='';
    GetString('Enter Source Voice # (1-32) : ',SV1,1,24,3);
    Val(SV1,V1,Ok);
  Until (V1 in [1..32]) or EscapeNow;
  If Not EscapeNow Then HighLightVoice(2,B1,V1);
  If Not EscapeNow Then
    If A>1 Then
      Repeat
        SB2:='';
        GetString('Enter Destination Bank # (1-2) : ',SB2,1,24,2);
        Val(SB2,B2,Ok);
      Until (B2 in [1,2]) or EscapeNow
    Else
      If A1 Then B2:=1 Else B2:=2;
  If Not EscapeNow Then Repeat
    SV2:='';
    GetString('Enter Destination Voice # (1-32) : ',SV2,1,24,3);
    Val(SV2,V2,Ok);
  Until (V2 in [1..32]) or EscapeNow;
  If Not EscapeNow Then Begin
    With Bank[B2] do Begin
      Voice[V2]:=Bank[B1].Voice[V1];
      VoiceName[V2]:=Bank[B1].VoiceName[V1];
      Exists:=True;
      Saved:=False;
      CheckTheSum(Voice,CheckSum);
    End;
    Message(0,'Moving....');
    HighlightVoice(1,B1,V1);
    HighlightVoice(1,B2,V2);
  End;
End;{MoveVoices}


Procedure GetVoiceName;
Var S:AnyStr;
    A,I,V,Ok,B:Integer;
    A1,A2:Boolean;
Begin
  A:=0;
  For I := 1 to 2 do If Bank[I].NormalFormat Then A:=A+1;
  A1:=Bank[1].NormalFormat;
  A2:=Bank[2].NormalFormat;
  If A>1 Then
    Repeat
      S:='';
      GetString('Enter Bank # : ',S,1,24,2);
      Val(S,B,Ok);
    Until (B in [1,2]) or EscapeNow
  Else
    If A>0 Then
      If A1 Then B:=1 Else B:=2
    Else
      EscapeNow:=True;
  If Not EscapeNow Then Repeat
    S:='';
    GetString('Enter Voice # : ',S,1,24,3);
    Val(S,V,Ok);
  Until (V in [1..32]) or EscapeNow;
  If Not EscapeNow Then Begin
    With Bank[B] Do Begin
      S:=VoiceName[V];
      GetString('Enter VoiceName : ',S,1,24,10);
      VoiceName[v]:=S;
      For I:= 1 to 10 do Voice[V,118+I]:=Ord(S[i]);
    End;{With}
    GetNames(Bank[B]);
    With Bank[B] do Begin
      CheckTheSum(Voice,CheckSum);
      Exists:=True;
      Saved:=False;
    End;{with}
  End;
  If Not EscapeNow Then HighLightVoice(1,B,V);
End;

Procedure GetNotes;
Var S:AnyStr;
    I,V,Ok,B:Integer;
Begin
  Repeat
    S:='';
    GetString('Enter Bank # : ',S,1,24,2);
    Val(S,B,Ok);
  Until (B in [1,2]) or EscapeNow;
  If Not EscapeNow Then Begin
    With Bank[B] Do Begin
      S:=Notes;
      GetString('Enter Notes : ',S,1,24,20);
      Notes:=S;
    End;{With}
    Bank[B].Exists:=True;
    Bank[B].Saved:=False;
    DrawBoxes;
  End;
End;

Procedure DoDirList(Var FilesExist:Boolean);
Var AString : AnyStr;
    CH      : Char;
    ListLength,
    X,Y,J,Ok,
    X1,X2,X3,X4,
    Choice,
    I,L     : Integer;
    FileList: Str20ArrayType;
Begin
  FilesExist:=True;
  FillChar(FileList,SizeOf(FileList),' ');
  DirList(FileList,ListLength);
  X1:=2;X2:=28;X3:=54;
  X:=0;
  I:=1;
  If ListLength>0 Then Begin
    Repeat
      Repeat
        Y:=5;
        If X=X1 Then
          X:=X2
        Else if X=X2 Then
          X:=X3
        Else Begin
          ClrScr;
          DrawScreen;
          X:=X1;
        End;
        Repeat
          GotoXY(X,Y);
          Write(I:2,':',FileList[I]);
          I:=I+1;
          Y:=Y+1;
        Until (Y=23) or (I>ListLength);
      Until (X=X3) or (I>ListLength);
      If (I<ListLength) or (ScreenNum = 1) Then
        Message(2,'Press Any Key To Continue');
    Until (I>ListLength);
  End Else Begin
    Message(2,'No files exist within the current Directory\Mask !!!');
    FilesExist:=False;
  End;
ENd;


Procedure ChangeMask;
Var S,S2:AnyStr;
    MaskOk:Boolean;
Begin
  S2:=MaskStr;
  Repeat
    S:=MaskStr;
    GetString('Enter Mask : ',S,1,24,12);
    MaskStr:=S;
    DoDirList(MaskOK);
  Until MaskOk or EscapeNow;
  If Not MaskOk Then MaskStr:=S2;
End;







Procedure ToggleBank;
Begin
  ActiveBank:=Other(ActiveBank);
  DrawBoxes;
End;



(* Voice Edit Procedures  ****************************************)

Procedure EditVoice;
Var S:AnyStr;
    I,V,Ok,B:Integer;
    ThisVoice:VoiceType;
Begin
  GetVoiceName;
  (*
     A voice editing menu would go here.  Haven't written it yet...
     For me, it is easier to program the dx7 from the dx7!!  (I got
     mine when they first came out and have gotten used to it).....
     If anyone writes some routines for this section, please send
     them to me!  They shouldn't be too hard!
  *)
End;



Procedure DiskMenu;
Var S:AnyStr;
    I:Integer;
    Bool:Boolean;
Begin
  ScreenNum:=2;
  DoDirList(Bool);
  Repeat
    Message(0,'Ready');
    TC:=#32;
    Repeat
      Repeat Read(Kbd,TC); Until TC=#27;
      Read(Kbd,TC2);
    Until (TC2 in [F1..F4,F10]);
    Case TC2 of
      F1 : ChangeDrive;
      F2 : ChangeSubDir;
      F3 : ChangeMask;
      F4 : DoDirList(Bool);
    End;{Case}
    If (Tc2 in [F1..F2]) Then DoDirList(Bool);
  Until (TC2=F10) or EscapeNow;
  ScreenNum:=1;
  DrawScreen;
  DrawVoices;
End;



Procedure MainMenu;
Begin
  EscapeNow:=False;
  Message(0,'Ready.');
  Repeat
    Repeat Read(Kbd,TC); Until TC=#27;
    Read(Kbd,TC2);
  Until (TC2 in PossibleChoicesSet);
  Case TC2 of
    F1     : GetMidiBank;
    F2     : SendMidiBank;
    F3     : ChooseBank;
    F4     : SaveDiskFile;
    F5     : ToggleBank;
    F6     : MoveVoices;
    F7     : EditVoice;
    F8     : GetNotes;
    F9     : DiskMenu;
    F10    : Exit:=True;
  End;{Case}
End; {MainMenu}


(* Main Program  *******************************************************)

Begin
  Uart;
  For I:= 1 to 2 do Begin
    FillChar(Bank[I],Sizeof(Bank[I]),0);
    With Bank[I] do Begin
      Saved:=True;
      Exists:=False;
      BankName:='Empty Bank';
      Notes:='';
    End;
  End;
  DiskFileName:='';
  DefaultMaskStr:='*.*';
  MaskStr:=DefaultMaskStr;
  GetSubDir(SubDir);
  GetDefaultDrive(Drive);
  ActiveBank:=1;
  SetGraphSet;
  Exit:=False;
  PossibleChoicesSet:=[F1..F10];
  ScreenNum:=1;
  DrawScreen;
  DrawVoices;
  Repeat
    Ok:=True;
    MainMenu;
  Until Exit;
  CheckBanks;
  ClrScr;
  GotoXY(1,3);
  Writeln('Have a nice night....');
End.