program vt;
{ uebersetzt die folgenden VT220-Kontrollcodes in VIDEO80-Steuercodes.

  VT200          VIDEO80      Bedeutung  (n=ASCII-Integer)
  <ESC>[nA       Ctrl/K       Cursor up  (Default n=1)
  <ESC>[nB       Ctrl/J       Cursor down
  <ESC>[nC       Ctrl/I       Cursor forward
  <ESC>[nD       Ctrl/H       Cursor backward
  <ESC>[l;cH     <ESC>Fyx     Cursor position (Default l,c=0)
  <ESC>[l;cf     dito

  <ESC>[nL       <ESC>\       Insert line
  <ESC>[nM       <ESC>]       Delete line
  <ESC>[0K       <ESC>Z       Erase end of line
  <ESC>[0J       <ESC>[       Erase end of screen

  <ESC>[1m       <ESC>R       Bold (Dim)
  <ESC>[4m       <ESC>T       Underline (Blink)
  <ESC>[7m       <ESC>J       Reverse
  <ESC>[0m       <ESC>D       All attributes off (Restore Attr.Status,
  <ESC>[m        dito         erfordert zuvor <ESC>E = Store Attr.Status)
  }

type zustand = (text,escape,trans,param1,param2);
     ASCII = set of char;

const controls: ASCII = ['[',';'];
      digits:  ASCII = ['0'..'9'];
      f1codes: ASCII = ['A','B','C','D'];
      f2codes: ASCII = ['L','M','K','J','m','H','f'];

const esc = #$40;

var iin,iout: integer;
    status: zustand;
    fcodes: ASCII;
    par1,par2: integer;
    instr,outstr: string[80];
    ch: char;

procedure put(ch: char);
begin
if ch=esc then
    begin
    insert('<ESC>',outstr,iout+1);
    iout:=iout+5;
    end
else begin
     iout:=iout+1;
     outstr[iout]:=ch;
     end;
end; { put }

procedure translate(var ch: char);
begin
writeln('Translating ',ch);
if ch in f1codes then
    begin
    if par1=0 then par1:=1;
    while par1>0 do
        begin
        put('^');
        case ch of
        'A': put('K');
        'B': put('J');
        'C': put('I');
        'D': put('H')
        end;
        par1:=par1-1;
        end;
    end
else if ch in f2codes then
    begin
    if ch in ['L','M'] then
        begin
        if par1=0 then par1:=1;
        while par1>0 do
            begin
            put('@');
            case ch of
            'L': put('\');
            'M': put(']');
            end;
            par1:=par1-1;
            end;
        end
    else if ch in ['K','J'] then
        begin
        if par1=0 then
            begin
            put('@');
            case ch of
            'K': put('Z');
            'J': put('[');
            end;
            end;
        end
    else if ch='m' then
        begin
        put('@');
        case par1 of
         1: put('R');
         4: put('T');
         7: put('J');
         else put('D');
        end;
        end
    else begin        { 'H' oder 'f' }
         put('@');
         put('F');
         put(char(32+par1));
         put(char(32+par2));
         end;
    end;
end; { translate }

begin {vt}

fcodes := f1codes + f2codes;
repeat
  write('Input string ');
  readln(instr);
  iin:=1; iout:=0;
  status:=text;
  while iin<=length(instr) do
    begin
    ch:=instr[iin];

    case status of
    text:   if ch=esc then
               begin status:=escape; ch:=#0; end;
    escape: begin
            if ch='[' then
                begin status:=trans; par1:=0; par2:=0; end
            else status:=text;
            ch:=#0;
            end;
    trans:  begin
            if ch in digits then
                 begin
                 status:=param1;
                 par1:=ord(ch)-ord('0');
                 end
            else
                 begin
                 if ch=';' then status:=param2
                 else
                     begin
                     if ch in fcodes then translate(ch);
                     status:=text;
                     end;
                 end;
            ch:=#0;
            end;
    param1: begin
            if ch in digits then
                 par1:=10*par1 + ord(ch)-ord('0')
            else
                 begin
                 if ch=';' then status:=param2
                 else if ch in fcodes then translate(ch);
                 status:=text;
                 end;
            ch:=#0;
            end;
    param2: begin
            if ch in digits then
                 par2:=10*par2 + ord(ch)-ord('0')
            else
                 begin
                 if ch in f2codes then translate(ch);
                 status:=text;
                 end;
            ch:=#0;
            end;
    end; {case}
    if ch<>#0 then put(ch);
    iin:=iin+1;
    end; {while}
  writeln('Outstr= ',copy(outstr,1,iout));
  until length(instr)=0;

end.
