(*****************************************************************************)
(*                               DefLet.pas                                  *)
(*****************************************************************************)

{$C-}

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

Const  Bin     : Array[0..7] of Byte=(128,64,32,16,8,4,2,1);
       Options : Array[1..6] of String[12]=(' EDIT-LETTER',' COPY-LETTER',
                                            ' CHANGE-LET ',' LOAD-LETTER',
                                            ' SAVE-LETTER','  END-EDIT  ');

Var    OL                 : Array[0..255,0..7] of Byte;
       NL                 : Array[0..255,0..7] of Byte;
       NLO                : Array[0..7] of Byte;
       FName              : String[14];
       FN                 : File;
       Rec,LetO           : Integer;
       Ein                : Char;
       x,y,Opt,Opt1,Let,I : Byte;

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 SetLet;
Begin
  MoveB1_B0(Addr(NL[Let]),$8400,$8);
  GotoXY(43+Let and $F shl 1,6+Let shr 4);Write(#128,#8);
End;

Procedure DefLet(mx,my:Byte);
Var    dx,dy   : Byte;
Begin
  SetLet;
  For dy:=0 to 7 do
  Begin
    GotoXY(mx,my+dy);
    For dx:=0 to 7 do
      If NL[Let,dy] and Bin[dx]<>0 then Write('O') else Write(' ');
  End;
  For dx:=0 to 7 do Begin;GotoXY(20,6+dx);Write(Hex(NL[Let,dx]));End;
  GotoXY(3+mx,18);Write(#128);
  GotoXY(19,18);Write(Let:3);
End;

Procedure InstLet;
Begin
  For Let:=0 to 255 do SetLet;
  Let:=0;DefLet(6,6);
  MoveB1_B0(Addr(OL[128]),$8400,$8);
End;

Procedure EditLetter;
Begin
  x:=Let and $F;y:=Let shr 4;LetO:=-1;
  Repeat
    Let:=x+y shl 4;DefLet(6,6);SetLet;Read(KBD,Ein);
    If KeyPressed then Read(KBD,Ein);
    If TestKey(0)=True then y:=Pred(y) else
    If TestKey(2)=True then y:=Succ(y) else
    If TestKey(8)=True then x:=Pred(x) else
    If TestKey(1)=True then x:=Succ(x) else
    If TestKey(18)=True then
    Case opt of
    1:Begin
      Rec:=x shl 8+y;For I:=0 to 7 do NLO[I]:=NL[Let,I];
      DefLet(28,6);x:=0;y:=0;
      Repeat
        GotoXY(28+x,6+y);Read(KBD,Ein);If KeyPressed then Read(KBD,Ein);
        If TestKey(0)=True then y:=Pred(y) else
        If TestKey(2)=True then y:=Succ(y) else
        If TestKey(8)=True then x:=Pred(x) else
        If TestKey(1)=True then x:=Succ(x) else
        If TestKey(47)=True then
        Begin
          If NL[Let,y] and Bin[x]=0 then Write('O') else Write(' ');
          NL[Let,y]:=NL[Let,y] xor Bin[x];x:=Succ(x);SetLet;
          GotoXY(20,6+y);Write(Hex(NL[Let,y]));GotoXY(31,18);Write(#128);
        End else
        If TestKey(79)=True then
        Begin
          For I:=0 to 7 do NL[Let,I]:=0;DefLet(28,6);
        End else
        If TestKey(16)=True then
        Begin
          NL[Let,y]:=0;DefLet(28,6);
        End else
        If TestKey(9)=True then
        Begin
          For I:=0 to 7 do NL[Let,I]:=NLO[I];DefLet(28,6);
        End;
        If x>200 then Begin;x:=7;y:=Pred(y);End else
          If x>7 then Begin;x:=0;y:=Succ(y);End;
        If y>200 then y:=7 else If y>7 then y:=0;
      Until TestKey(66)=True;
      For y:=0 to 7 do Begin;GotoXY(28,6+y);Write('        ');End;
      GotoXY(31,18);Write(' ');DefLet(6,6);y:=Rec and $F;x:=Rec shr 8;
    End;
    2:If LetO<0 then
    Begin
      LetO:=Let;SetLet;
    End else
    Begin
      I:=Let;Let:=LetO;SetLet;Let:=I;
      For I:=0 to 7 do NL[Let,I]:=NL[LetO,I];SetLet;DefLet(6,6);LetO:=-1;
    End;
    3:If LetO<0 then
    Begin
      LetO:=Let;SetLet;
    End else
    Begin
      For I:=0 to 7 do
      Begin
        NLO[I]:=NL[Let,I];NL[Let,I]:=NL[LetO,I];NL[LetO,I]:=NLO[I];
      End;
      I:=Let;Let:=LetO;SetLet;Let:=I;SetLet;DefLet(6,6);LetO:=-1;
    End;
    End;
    If x>200 then Begin;x:=15;y:=Pred(y);End else
      If x>15 then Begin;x:=0;y:=Succ(y);End;
    If y>200 then y:=15 else If y>15 then y:=0;
  Until TestKey(66)=True;
  MoveB1_B0(Addr(OL[128]),$8400,$8);
End;

Procedure LoadTable;
Begin
  GotoXY(1,21);Write(' Name : ');FName:='';Input(FName,14,1);Rec:=0;
  If FName<>'' then
  Begin
    Assign(FN,FName);{$I-}Reset(FN);{$I+}
    If not (IOresult=0) then
    Begin
      Write(#13,' ERROR: File not found !',^G);Delay(1000);
    End else
    Begin
      BlockRead(FN,NL,16,Rec);
      Close(FN);
    End;
  End;
  Write(#13);Write('                        ');
  If Rec<>0 then InstLet;
End;

Procedure SaveTable;
Begin
  GotoXY(1,21);Write(' Name : ');FName:='';Input(FName,14,1);
  If FName<>'' then
  Begin
    Assign(FN,FName);Rewrite(FN);
    BlockWrite(FN,NL,16);
    Close(FN);
  End;
  Write(#13);Write('                        ');
End;


Begin
  ClrScr;GotoXY(21,1);Write('***** DEFLETTER V3.0 - CP/M PLUS *****');
  MoveB0_B1($8000,Addr(NL),$800);MoveB0_B1($8000,Addr(OL),$800);
  GotoXY(5,4);Write('OLD-LETTER');Box(5,5,14,14);
  GotoXY(19,4);Write('CODE');Box(19,5,22,14);
  GotoXY(27,4);Write('NEW-LETTER');Box(27,5,36,14);
  GotoXY(7,16);Write('CHAR');Box(7,17,11,19);
  GotoXY(19,16);Write('Nr.');Box(18,17,22,19);
  GotoXY(29,16);Write('CHAR');Box(29,17,33,19);
  GotoXY(52,3);Write('CHAR-TABLE');Box(42,5,74,22);
  GotoXY(43,4);For x:=0 to 15 do Write(Copy(Hex(x),2,1),' ');
  For x:=0 to 15 do Begin;GotoXY(41,6+x);Write(Copy(Hex(x),2,1));End;
  GotoXY(1,24);For x:=1 to 6 do Write(Options[x],' ');
  Opt:=1;Opt1:=1;InstLet;
  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(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..3 : EditLetter;
      4    : LoadTable;
      5    : SaveTable;
      6    : Opt:=0;
    End;
  Until Opt=0;
  ClrScr;
End.