(*****************************************************************************)
(*                               DefKeys.pas                                 *)
(*****************************************************************************)

{$C-}

{$I B:Hex.inc}
{$I B:Move.inc}
{$I B:Input.inc}

Const  Bin     : Array[0..7] of Byte=(1,2,4,8,16,32,64,128);
       Tables  : Array[0..2] of String[9]=(' NORMAL  ','  SHIFT  ',' CONTROL ');
       Options : Array[1..6] of String[12]=(' EDIT-CODE  ',' EDIT-REPEAT',
                                            ' SET-EXPAND ',' LOAD-TABLE ',
                                            ' SAVE-TABLE ','  END-EDIT  ');

Var    OldExp                       : Array[0..160] of Byte;
       Buff                         : String[60];
       Expand                       : Array[0..160] of Byte;
       Rep                          : Array[0..9] of Byte;
       Keys                         : Array[0..2,0..79] of Byte;
       FN                           : File;
       FName                        : String[14];
       Err,Rec                      : Integer;
       NSC,I,E,Opt,Opt1,Byt,BuffPos : Byte;
       Ein,Ch                       : Char;

Procedure NextCh;
Begin
  Repeat
    BuffPos:=BuffPos+1;
    If BuffPos<=Ord(Buff[0]) then Ch:=Buff[BuffPos] else Ch:=#13;
  Until (Ch<>' ') or (Ein='$');
End;

Function TestKey(Nr:Byte):Boolean;
Begin
  Inline(
    $3A/Nr/          (*           LD    A,(Nr)        *)
    $CD/$5A/$FC/     (*           CALL  FC5A          *)
    $1E/$BB/         (*           .WO   BB1E          *)
    $26/00/          (*           LD    H,00          *)
    $2E/00/          (*           LD    L,00          *)
    $28/$01/         (*           JR    Z,L0          *)
    $2C/             (*           INC   L             *)
    $C9);            (*L0:        RET                 *)
End;

Procedure DefKeys;
Begin
  GotoXY(35,3);Write(^['p',Tables[NSC],^['q');
  GotoXY(1,10);
  For I:=0 to 7 do
  Begin
    ClrEol;
    Write(I,' : ');For E:=0 to 9 do Write(Hex(Keys[NSC,E+I*10]),' ');Write('  ');
    For E:=0 to 9 do
    Begin
      If Keys[NSC,E+I*10]<32 then Write(^[);Write(Chr(Keys[NSC,E+I*10]),' ');
    End;
    Write('  ');
    For E:=0 to 9 do
      If Rep[(E+I*10) shr 3] and Bin[(E+I*10) and 7]=0 then Write('0 ') else Write('1 ');
    WriteLn;
  End;
End;

Procedure EditCode;
Begin
  I:=0;E:=0;
  Repeat
    GotoXY(5+E*3,10+I*1);
    Read(KBD,Ein);If KeyPressed then Read(KBD,Ein);
    Ein:=UpCase(Ein);
    If Ein in ['0'..'9','A'..'F'] then
    Begin
      Write(Ein);Byt:=Ord(Ein)-48;If Byt>=10 then Byt:=Byt-7;
      Byt:=Byt shl 4;
      Repeat
        Read(KBD,Ein);Ein:=UpCase(Ein);
      Until Ein in ['0'..'9','A'..'F'];
      If Ein<'A' then Byt:=Byt+(Ord(Ein)-48) else Byt:=Byt+(Ord(Ein)-55);
      Keys[NSC,E+I*10]:=Byt;Write(Ein);
      GotoXY(37+E*2,10+I*1);If Byt<32 then Write(^[);Write(Chr(Byt));
      E:=Succ(e);
    End else
    If TestKey(0)=True then I:=Pred(i) else
    If TestKey(2)=True then I:=Succ(i) else
    If TestKey(8)=True then E:=Pred(e) else
    If TestKey(1)=True then E:=Succ(e);
    If e>200 then Begin;e:=9;i:=Pred(i);End else
      If e>9 then Begin;e:=0;i:=Succ(i);End;
    If i>200 then i:=7 else If i>7 then i:=0;
  Until TestKey(66)=True;
End;

Procedure EditRepeat;
Begin
  I:=0;E:=0;
  Repeat
    GotoXY(59+E*2,10+I*1);
    Read(KBD,Ein);If KeyPressed then Read(KBD,Ein);
    If Ein in ['0','1'] then
    Begin
      Write(Ein);
      If Ein='1' then
        Rep[(E+I*10) shr 3]:=Rep[(E+I*10) shr 3] or Bin[(E+I*10) and 7] else
        Rep[(E+I*10) shr 3]:=Rep[(E+I*10) shr 3] and (255-Bin[(E+I*10) and 7]);
        E:=Succ(E);
    End else
    If TestKey(0)=True then I:=Pred(i) else
    If TestKey(2)=True then I:=Succ(i) else
    If TestKey(8)=True then E:=Pred(e) else
    If TestKey(1)=True then E:=Succ(e);
    If e>200 then Begin;e:=9;i:=Pred(i);End else
      If e>9 then Begin;e:=0;i:=Succ(i);End;
    If i>200 then i:=7 else If i>7 then i:=0;
  Until TestKey(66)=True;
End;

Procedure SetExpand;
Begin
  Repeat
    GotoXY(1,19);Write('Expand-Nr. : ',^['K');Buff:='';Input(Buff,60,1);
    Val(Buff,Rec,Err);If (Rec>31) or (Rec<0) then Err:=1;
    If Err<>0 then Write(^G);
  Until Err=0;
  I:=0;For E:=1 to Rec do If Expand[I]<>0 then I:=I+Expand[I]+1;
  Byt:=Expand[I];Ein:=' ';GotoXY(1,20);Write('Old Expand : ');
  For E:=1 to Byt do
  Begin
    Byt:=Expand[I+E];
    If Byt in [32..127] then
    Begin
      If Ein=' ' then Write('''');Ein:='$';Write(Chr(Byt));
    End else
    Begin
      If Ein='$' then Write('''');Ein:=' ';If E>1 then Write(',');
      Write(Hex(Byt));If E<Expand[I] then Write(',');
    End;
  End;
  If Ein='$' then Write('''');
  Repeat
    GotoXY(1,21);Write('New Expand : ',^['K');Buff:='';Input(Buff,60,1);
    If Buff='' then Exit else If Buff='0' then Buff:='';
    Err:=0;Ein:=' ';BuffPos:=0;NextCh;I:=0;
    While (Ch<>#13) and (Err=0) do
    Begin
      If Ein='$' then If Ch='''' then Ein:=' ' else
      Begin
        I:=I+1;Buff[I]:=Ch;
      End else If (Ch=',') or (BuffPos=1) then
      Begin
        If Ch=',' then NextCh;Ch:=UpCase(Ch);
        If Ch in ['0'..'9','A'..'F'] then
        Begin
          Byt:=Ord(Ch)-48;If Byt>=10 then Byt:=Byt-7;Byt:=Byt shl 4;
          NextCh;Ch:=UpCase(Ch);
          If Ch in ['0'..'9','A'..'F'] then
            If Ch<'A' then Byt:=Byt+(Ord(Ch)-48) else Byt:=Byt+(Ord(Ch)-55)
              else Begin;BuffPos:=BuffPos-2;NextCh;End;
          I:=I+1;Buff[I]:=Chr(Byt);
        End else If Ch='''' then Ein:='$' else Err:=1;
      End else Err:=1;
      NextCh;
    End;
    If Ein='$' then Err:=1;
    If Err<>0 then Write(^G);
  Until Err=0;
  Inline(
    $3A/REC/         (*           LD    A,(REC)       *)
    $47/             (*           LD    B,A           *)
    $3A/I/           (*           LD    A,(I)         *)
    $4F/             (*           LD    C,A           *)
    $21/BUFF+1/      (*           LD    HL,BUFF+1     *)
    $CD/$FC5A/       (*           CALL  $FC5A         *)
    $BB0F);          (*           DEFW  $BB0F         *)
  MoveB0_B1($B590,Addr(Expand),161);
End;

Procedure LoadTable;
Begin
  GotoXY(1,20);Write('Name : ');FName:='';Input(FName,14,1);
  If FName<>'' then
  Begin
    MoveB1_B0(Addr(OldExp),$B590,161);
    Assign(FN,FName);{$I-}Reset(FN);{$I+}
    If not (IOresult=0) then
    Begin
      Write(#13,'ERROR: File not found !',^['K',^G);Delay(1000);
    End else
    Begin
      BlockRead(FN,Keys,4,Rec);
      Close(FN);
      MoveB1_B0(Addr(Expand),$B590,161);
    End;
  End;
  Write(#13);ClrEol;NSC:=0;DefKeys;
End;

Procedure SaveTable;
Begin
  GotoXY(1,20);Write('Name : ');FName:='';Input(FName,14,1);
  If FName<>'' then
  Begin
    MoveB1_B0(Addr(OldExp),$B590,161);
    Assign(FN,FName);Rewrite(FN);
    BlockWrite(FN,Keys,4);
    Close(FN);
    MoveB1_B0(Addr(Expand),$B590,161);
  End;
  Write(#13);ClrEol;
End;


Begin
  MoveB0_B1($B496,Addr(Keys),413);MoveB0_B1($B590,Addr(OldExp),161);
  ClrScr;GotoXY(22,1);Write('***** DEFKEYS V3.0 - CP/M PLUS *****');
  GotoXY(30,4);Write(' TRANSLATION-TABLE ');
  GotoXY(1,6);
  WriteLn('             Code-Table                 ASCII-Table           Repeat-Table');
  WriteLn('    -----------------------------   -------------------   -------------------');
  WriteLn('    0  1  2  3  4  5  6  7  8  9    0 1 2 3 4 5 6 7 8 9   0 1 2 3 4 5 6 7 8 9');
  WriteLn('    -----------------------------   -------------------   -------------------');
  NSC:=0;Opt:=1;Opt1:=1;DefKeys;GotoXY(1,24);For I:=1 to 6 do Write(Options[I],' ');
  Repeat
    If Opt<>Opt1 then
      Begin;GotoXY((Opt1-1)*13+1,24);Write(Options[Opt1]);Opt1:=Opt;End;
    GotoXY((Opt-1)*13+1,24);Write(^['p',Options[Opt],^['q');
    While not KeyPressed do;
    Read(KBD,Ein);If KeyPressed then Read(KBD,Ein);
    If TestKey(0)=True then
      Begin;If NSC<2 then Begin;NSC:=NSC+1;DefKeys;End;End else
    If TestKey(2)=True then
      Begin;If NSC>0 then Begin;NSC:=NSC-1;DefKeys;End;End else
    If TestKey(8)=True then Begin;If Opt>1 then Opt:=Opt-1;End else
    If TestKey(1)=True then Begin;If Opt<6 then Opt:=Opt+1;End else
    If TestKey(18)=True then
    Case Opt of
      1 : EditCode;
      2 : EditRepeat;
      3 : Begin;SetExpand;GotoXY(1,19);Write(^['K',#10,^['K',#10,^['K');End;
      4 : LoadTable;
      5 : SaveTable;
      6 : Opt:=0;
    End;
  Until Opt=0;
  MoveB1_B0(Addr(OldExp),$B590,161);ClrScr;
End.