program miniterm;

{define simulate}

uses crt,dos,xv24,config,minitool,rwptool,vdirekt;

const header = 'MiniTerm  Version 1.1  (c) 1997-1998 by rwp';

const comport    : integer = 1;
      baudrate   : string = '9600';   { 1200, 2400, 4800, 9600, }
                                      { 19200, 38400, 57600, 115200 }
      parity     : string = 'None';  { 0=None, 1=Odd, 2=Even }
      databits   : integer = 8;
      stopbits   : integer = 1;
      beenden    : boolean = false;
      showcode   : boolean = false;
      echo       : boolean = false;
      statusshown: boolean = false;
      charoffset : byte = 0;
      savex      : byte = 1;
      savey      : byte = 1;

      textfarbe     : word = black;
      hgfarbe       : word = lightgray;
      revtextfarbe  : word = lightgray;
      revhgfarbe    : word = black;
      undltextfarbe : word = blue;
      undlhgfarbe   : word = lightgray;
      boldtextfarbe : word = lightblue;
      boldhgfarbe   : word = lightgray;
      currenttext   : word = black;
      currentback   : word = lightgray;
      bright        : word = 0;

      csrup         : string[3] = '[A';
      csrdown       : string[3] = '[B';
      csrright      : string[3] = '[C';
      csrleft       : string[3] = '[D';

var speicher : bildinhalt;

const scrollbeg : byte = 1;
      scrollend : byte = 24;

procedure setcolors(fg,bg:byte);
begin
   if fg=bg then begin
      if bg=0 then fg:=white
              else fg:=red;
      end;
   dsetcolors(fg,bg);
   textcolor(fg);
   textbackground(bg);
   currenttext:=fg;
   currentback:=bg;
end;

procedure makeupcase(var s : string);
var i:integer;
begin
     if length(s)>0 then for i:=1 to length(s) do s[i]:=upcase(s[i]);
end;

procedure statusline;
var x,y : byte;
    txt : string[3];
begin
    x:=dwherex;
    y:=dwherey;
    gotoxy(1,25);
    textcolor(yellow);
    textbackground(blue);
    if dolog then txt:='ON' else txt:='OFF';
    write(' press ALT-F1 for help | Log '+txt
          +' | COM'
          +itxt(comport)+'  '+baudrate+' Baud   | Cursorpos '+
          +itxt(dwherex)+','+itxt(dwherey)+' '
          +itxt(scrollbeg)+'-'+itxt(scrollend));
    setcolors(currenttext,currentback);
    dgotoxy(x,y);
end;

procedure proginit;
var  ok    : boolean;
     datas : DataBitsType;
     stops : StopBitsType;
     bauds : BaudType;
     parit : ParityType;
     compt : ComType;
     rate  : longint;
     i     : integer;
begin
     textbackground(black);
     clrscr;
     dsetcolors(yellow,blue);
     dclrscr;
     dgotoxy(1,1);
     dwriteln('');
     dwriteln('');
     dwriteln(header);
     dwriteln('');

     configname:='miniterm.cfg';
                ok:=defconfig('ComPort',   @comport,   inte);
     if ok then ok:=defconfig('BaudRate',  @baudrate,  stri);
     if ok then ok:=defconfig('Parity'  ,  @parity,    stri);
     if ok then ok:=defconfig('DataBits',  @databits,  inte);
     if ok then ok:=defconfig('StopBits',  @stopbits,  inte);
     if ok then ok:=defconfig('LocalEcho', @echo,      bool);
     if ok then ok:=defconfig('TextColor', @textfarbe, inte);
     if ok then ok:=defconfig('BackColor', @hgfarbe,   inte);
     if ok then ok:=defconfig('UnderlineTextColor', @undltextfarbe, inte);
     if ok then ok:=defconfig('UnderlineBackColor', @undlhgfarbe,   inte);
     if ok then ok:=defconfig('ReverseTextColor', @revtextfarbe, inte);
     if ok then ok:=defconfig('ReverseBackColor', @revhgfarbe,   inte);
     if ok then ok:=defconfig('BoldTextColor', @boldtextfarbe, inte);
     if ok then ok:=defconfig('BoldBackColor', @boldhgfarbe,   inte);
     if ok then ok:=defconfig('WriteLogFile', @dolog,  bool);
     if ok then ok:=defconfig('LogFile',   @logfile,   stri);
     if not ok then begin
        writeln('Not enough Memory !');
        halt(1);
        end;
     readconfig;
     {---------------------------------------------------- Log-File ------}
     assign(lf,logfile);
     if dolog then openlogfile;
     {---------------------------------------------------- Farben --------}
     if (textfarbe<0) or (textfarbe>16) then textfarbe:=black;
     if (hgfarbe<0)   or (hgfarbe>8)    then hgfarbe:=lightgray;
     {---------------------------------------------------- Com - Port ----}
     case comport of
          1 : Compt:=Com1;
          2 : Compt:=Com2;
          3 : Compt:=Com3;
          4 : Compt:=Com4;
     else startlog('Wrong Comport_Number !  Using Com2.');
          Compt:=Com2;
          comport:=2;
     end;
     {---------------------------------------------------- Data-Bits ----}
     case databits of
          5 : datas:=d5;
          6 : datas:=d6;
          7 : datas:=d7;
          8 : datas:=d8;
     else startlog('Wrong No. of DataBits !  Using 8.');
          datas:=d8;
          databits:=8;
     end;
     {---------------------------------------------------- Stop-Bits ----}
     case stopbits of
          1 : stops:=s1;
          2 : stops:=s2;
     else startlog('Wrong No. of StopBits !  Using 1.');
          stops:=s1;
          stopbits:=1;
     end;
     {---------------------------------------------------- Parity-Text --}
     makeupcase(parity);
          if pos(parity,'SPACE')=1 then parit:=Space
     else if pos(parity,'ODD')=1   then parit:=Odd
     else if pos(parity,'MARK')=1  then parit:=Mark
     else if pos(parity,'EVEN')=1  then parit:=Even
     else if pos(parity,'NONE')=1  then parit:=None
     else begin
          startlog('Wrong Parity-Type! Using ''None''');
          parit:=None;
          parity:='None';
          end;
     {---------------------------------------------------- Baud-Text --}
     makeupcase(baudrate);
     val(baudrate,rate,i);
          if rate=110 then bauds:=b110
     else if rate=150 then bauds:=b150
     else if rate=300 then bauds:=b300
     else if rate=600 then bauds:=b600
     else if rate=1200 then bauds:=b1200
     else if rate=2400 then bauds:=b2400
     else if rate=4800 then bauds:=b4800
     else if rate=9600 then bauds:=b9600
     else if rate=19200 then bauds:=b19200
     else if rate=38400 then bauds:=b38400
     else if rate=57600 then bauds:=b57600
     else if rate=115200 then bauds:=b115200
     else begin
          startlog('Wrong Baud-Rate! Using 9600 Baud');
          bauds := b9600;
          baudrate:='9600';
          end;
    {---------------------------------------------------- init --}
    dwriteln('Initializing Com-port '+itxt(comport)+' ...');
    {$ifndef simulate}
    initcom(comport,bauds,parit,datas,stops);
    {$endif}
    dwriteln('');
    dwriteln('Ok. You can abort the program with ALT-F10...');
    dwriteln('or get help with ALT-F1 ...');
    dwriteln('');
    setcolors(textfarbe,hgfarbe);
    delay(1000);
    dclrscr;
    dgotoxy(1,1);
    statusline;
end;

procedure progdone;
begin
     DisableCom;
     writeconfig;
     closelogfile;
end;

(*************************************************************************)

const oldchar : char = ' ';

const escapebuffer : string = '';
      escapeactive : boolean = false;


function getcode(s:string; var no : word):boolean;
var is,ie,count : byte;
    ok,allequal : boolean;
    i  : integer;
    w  : word;
    fc : char;
    t  : string;
begin
    if s=escapebuffer then begin
         no:=0;
         getcode:=true;
         end
    else begin
         is:=1;
         ie:=1;
         no:=0;
         count:=0;
         allequal:=false;
         repeat
           ok:=(s[is]=escapebuffer[ie]);
           if ok then begin  inc(is);  inc(ie);  end;
           allequal := (is>length(s)) and (ie>length(escapebuffer));
           if (not allequal) and (not ok)  then begin
              { d.h. das ende ist noch nicht bei beiden erreicht
                und
                die Zeichen sind verschieden!                     }
              ok := (is<=length(s)) and (ie<=length(escapebuffer))
                    and (s[is]='*');
              { nur unter dieser Bedingung wird eine Ungleichheit
                akzeptiert. (es muá eine Zahl eingelesen werden.) }
              if ok then begin
                 inc(is);
                 fc:=s[is];
                 t:='';
                 repeat
                   t:=t+escapebuffer[ie];
                   inc(ie);
                   ok := (ie<=length(escapebuffer));
                 until (not ok) or (escapebuffer[ie]=fc);
                 end;
              if ok then begin
                 val (t,w,i);
                 ok := (i=0);
                 end;
              if ok then begin
                 inc(count);
                 if count=2 then no := no shl 8;
                 no := no or w;
                 end;
              end;
         until allequal or (not ok);
         getcode:=allequal;
         if allequal then escapebuffer:='';
         end;
end;


procedure scrollregion(w:word);
begin
    scrollbeg := (w shr 8);
    scrollend := (w and $ff);
{    if (scrollbeg=2) and (scrollend=23) then begin
       scrollbeg:=1;
       scrollend:=23;
       end;
}
end;

procedure intgotoxy(x,y:byte);
begin
{    writelogfile(#13+#10+'GOTO "'+itxt(x)+':'+itxt(y)+'"'+'  '+itxt(scrollbeg)+':'+itxt(scrollend)+#13+#10);
}
   if scrollend<24 then if y=scrollend then inc(y);
   if (y>scrollend) then begin
        scrollup(scrollbeg-1,scrollend-1);
        y:=scrollend;
        end
   else if (y<scrollbeg) and (scrollend<>pagelen) then begin
        scrolldown(scrollbeg-1,scrollend-1);
        inc(y);
        end;
   if x<1 then x:=1;
   if y<1 then y:=1;
   dgotoxy(x,y);
end;

procedure gocursor(dx,dy :integer);
var x,y : integer;
begin
    x:=dx+wherex;
    y:=dy+wherey;
{    gotoxy(1,1);
    write(x,' ',y,'   ');
}
    while x<1 do begin
       x:=x+80;
       dec(y);
       end;
    while x>80 do begin
       x:=x-80;
       inc(y);
       end;
    if y<1 then y:=1;
{    if y>pagelen then y:=pagelen;}
    if y>scrollend then y:=scrollend;
    dgotoxy(x,y);
end;

procedure gobegline(dy :integer);
var y : integer;
begin
    y:=dy+wherey;
    if y<1 then y:=1;
{    if y>pagelen then y:=pagelen;}
    if y>scrollend then y:=scrollend;
    dgotoxy(1,y);
end;



procedure xgotoxy(w:word);
var x,y : byte;
begin
    y := w shr 8;
    x := w and $ff;
    if x<1 then x:=1;
    if x>80 then x:=80;
    if y<1 then y:=1;
    if y>24 then y:=24;
    intgotoxy(x,y);
end;

procedure setcolortype(no:word);
begin
   if no = 5 then bright := bright + blink;
   if no < 2 then bright := no*8; { = 8 oder 0 ; macht textfarben ggf. hell }
        if no= 0 then setcolors(textfarbe,hgfarbe)           { normal }
   else if no= 1 then setcolors(boldtextfarbe,boldhgfarbe)   { fett }
   else if no= 4 then setcolors(undltextfarbe,undlhgfarbe)   { unterstrichen }
   else if no= 5 then setcolors(currenttext or blink,currentback) { blinkend }
   else if no= 7 then setcolors(revtextfarbe,revhgfarbe)     { invers }
   else if no= 8 then setcolors(currentback,currentback)     { unsichtbar }
   else if no=30 then setcolors(bright+black,currentback)
   else if no=31 then setcolors(bright+red,currentback)
   else if no=32 then setcolors(bright+green,currentback)
   else if no=33 then setcolors(bright+brown,currentback)
   else if no=34 then setcolors(bright+blue,currentback)
   else if no=35 then setcolors(bright+magenta,currentback)
   else if no=36 then setcolors(bright+cyan,currentback)
   else if no=37 then setcolors(bright+lightgray,currentback)
   else if no=40 then setcolors(currenttext,black)
   else if no=41 then setcolors(currenttext,red)
   else if no=42 then setcolors(currenttext,green)
   else if no=43 then setcolors(currenttext,brown)
   else if no=44 then setcolors(currenttext,blue)
   else if no=45 then setcolors(currenttext,magenta)
   else if no=46 then setcolors(currenttext,cyan)
   else if no=47 then setcolors(currenttext,lightgray)
end;

procedure setaltmode;
begin
      csrup     := 'OA';
      csrdown   := 'OB';
      csrright  := 'OC';
      csrleft   := 'OD';
end;

procedure setnormmode;
begin
      csrup     := '[A';
      csrdown   := '[B';
      csrright  := '[C';
      csrleft   := '[D';
end;

procedure sendescape(s:string); forward;

procedure escapeoutput;
var i,no : word;
begin
    writelogfile(#13+#10+'ESC "'+escapebuffer+'"'+#13+#10);
    escapeactive:=false;
         if getcode('[m',no)    then setcolortype(0)
    else if getcode('[M',no)    then setcolortype(0)
    else if getcode('[*M',no)   then setcolortype(no)
    else if getcode('[*m',no)   then setcolortype(no)
    else if getcode('[*;*m',no) then begin
                                     setcolortype(no shr 8);
                                     setcolortype(no and $FF);
                                     end
    else if getcode('[A',no)    then gocursor(0,-1)
    else if getcode('[B',no)    then gocursor(0,1)
    else if getcode('[C',no)    then gocursor(1,0)
    else if getcode('[D',no)    then gocursor(-1,0)
    else if getcode('[E',no)    then gobegline(0)
    else if getcode('[F',no)    then gobegline(0)
    else if getcode('[G',no)    then begin end
    else if getcode('[*A',no)   then gocursor(0,-no)
    else if getcode('[*B',no)   then gocursor(0,no)
    else if getcode('[*C',no)   then gocursor(no,0)
    else if getcode('[*D',no)   then gocursor(-no,0)
    else if getcode('[*E',no)   then gobegline(no)
    else if getcode('[*F',no)   then gobegline(-no)
    else if getcode('[*G',no)   then dgotoxy(no,dwherey) {goto column}
    else if getcode('[H',no)    then xgotoxy($0101)
    else if getcode('[*;*H',no) then xgotoxy(no)
    else if getcode('[*;*F',no) then xgotoxy(no)
    else if getcode('[*;*f',no) then xgotoxy(no)
    else if getcode('[*;*r',no) then scrollregion(no)
    else if getcode('[*;*R',no) then scrollregion(no)
    else if getcode('[2J',no)   then dclrscr
    else if getcode('[J',no)    then deltoendofscreen
    else if getcode('[1J',no)   then deltobegofscreen
    else if getcode('[K',no)    then deltoeol
    else if getcode('[1K',no)   then delbegline
    else if getcode('[2K',no)   then delthisline
    else if getcode('[*L',no)   then for i:=1 to no do begin  { insert Line(s) }
                                     scrolldown(wherey-1,scrollend-1);
                                     gobegline(0);
                                     deltoeol;
                                     end
    else if getcode('[*~',no)   then begin
              if no=1 then dgotoxy(1,dwherey)  { Pos 1  }
         else if no=4 then dgotoxy(80,dwherey) { End    }
         else if no=5 then dgotoxy(dwherex,1)  { page u }
         else if no=6 then dgotoxy(dwherex,24) { page d }
         end
    else if getcode('[c',no)    then sendescape('[?1;2c') { type ? vt100 ! }
    else if getcode('[5n',no)   then sendescape('[0n') { status ?  OK ! }
    else if getcode('[6n',no)   then
         sendescape('['+itxt(dwherey)+';'+itxt(dwherex)+'R')
                       { cursorposition }
    else if getcode('M',no)     then begin scrolldown(wherey-1,scrollend-1); end { reverse index }
    else if getcode('D',no)     then begin end { index }
    else if getcode('7',no)     then begin savex:=dwherex;savey:=dwherey; end
    else if getcode('8',no)     then gotoxy(savex,savey)
    else if getcode('=',no)     then setaltmode
    else if getcode('>',no)     then setnormmode
    else if getcode('(B',no)    then begin end { G0 - ISO 8859-1 - mapping }
    else if getcode('(0',no)    then begin end { G0 - vt100 - mapping }
    else if getcode('(K',no)    then begin end { G0 - user - mapping }
    else if getcode('(U',no)    then begin end { G0 - null - mapping }
    else if getcode(')B',no)    then begin end { G1 - ISO 8859-1 - mapping }
    else if getcode(')0',no)    then begin end { G1 - vt100 - mapping }
    else if getcode(')K',no)    then begin end { G1 - user - mapping }
    else if getcode(')U',no)    then begin end { G1 - null - mapping }
    else if getcode(']R',no)    then begin end { reset palette }
    else escapeactive:=true;
    if escapeactive then write(escapebuffer);
    escapeactive:=false;
    escapebuffer:='';
end;

procedure bildschirm(ch:char);
var och : integer;
begin
   och := ord(ch);

   if och=27 then begin
        escapeactive:=true;
        escapebuffer:='';
        end
   else if och=$9b then begin  { is equivalent to ESC [ }
        escapeactive:=true;
        escapebuffer:='[';
        end
   else if escapeactive then begin
        escapebuffer:=escapebuffer+ch;
        ch:=upcase(ch);
        if     ((ch>='A') and (ch<='Z'))
            or (ch='r')
            or (ch='~')
            or ( ((ch='=') or (ch='>') or (ch='7') or (ch='8'))
                  and (length(escapebuffer)=1))
            then escapeoutput;
        end
(*
   else if ch=#9 then begin  { tab }
        dgotoxy(round((dwherex)/6+0.5)*6,dwherey);
        end
*)
   else if ch=#14 then begin  { shiftout }
        charoffset:=$82;
        end
   else if ch=#15 then begin  { shiftout }
        charoffset:=$00;
        end
   else begin
{        if (oldchar=#13) and (ch<>#10) then writeln;}
        if (upcase(ch)>='A') and (upcase(ch)<='Z') and (charoffset<>0) then
           ch := chr( (ord(ch)+charoffset) and $FF );
        dwrite(ch);
{        if ch=#10 then dgotoxy(1,wherey);}
        end;

   if dolog then begin
      if (och=10) then begin end
      else if (och=13) then begin
           writelogfile(#13+#10+Uhrzeittext+' ');
           end
      else if (och>=32) then begin
           writelogfile(ch);
           end
      else if (och<32) then begin
           writelogfile('#'+hextxt(och));
           end;
      end;
   oldchar := ch;
end;

(*************************************************************************)
(*************************************************************************)
(*************************************************************************)

procedure help;
var txt : string;
    x,y : byte;
begin
    x:=dwherex;
    y:=dwherey;
    savewindow(speicher);
    dsetcolors(yellow,blue);
    dclrscr;
    dgotoxy(1,1);
    dwriteln('');
    dwriteln(header);
    dwriteln('');
    dwriteln('   ALT-F1    (this) Help');
    if echo then txt:='ON' else txt:='OFF';
    dwriteln('   ALT-F2    switch local echo (it is now switched '+txt+')');
    if dolog then txt:='ON' else txt:='OFF';
    dwriteln('   ALT-F3    switch logging (it is now switched '+txt+')');
    dwriteln('   ALT-F4    send ''clear screen''');
    dwriteln('   ALT-F10   exit program');
{    writeln('   ESC   exit program');     }
    dwriteln('');
    dwriteln(' press any key to continue...');
    repeat until keypressed;
    while keypressed do readkey;
    setwindow(speicher);
    setcolors(textfarbe,hgfarbe);
    dgotoxy(x,y);
end;

(*************************************************************************)

procedure sendstring(s:string);
var i : byte;
begin
    if length(s)>0 then for i:=1 to length(s) do begin
       {$ifdef simulate}
       bildschirm(s[i]);
       {$else}
       sendbyte(comport,ord(s[i]));
       {$endif}
       if echo then bildschirm(s[i]);
       end;
end;

procedure sendescape(s:string);
begin
    sendstring(#27+s);
end;

(*************************************************************************)

procedure work;
var ch : char;
begin
    if v24dataavail(comport) then begin
         ch:=chr(v24getbyte(comport));
         bildschirm(ch);
         statusshown:=false;
         end
    else begin
         if not statusshown then begin
            statusline;
            statusshown:=true;
            end;
         end;
    if keypressed then begin
       ch:=readkey;
       if ch=#0 then begin
            ch:=readkey;
                 if (ch=#104) {or (ch=#59)} then help
            else if (ch=#105) {or (ch=#60)} then echo:=not echo
            else if (ch=#106) {or (ch=#61)} then begin
                                                 dolog:=not dolog;
                                                 statusshown:=false;
                                                 end
            else if (ch=#113) {or (ch=#68)} then beenden:=true
            else if (ch=#112) then showcode := not showcode
            else if (ch=#107) then sendescape('[2J')
            else if (ch=#108) then sendescape('[K')
            else if ch=#72 then sendescape(csrup)    { Csr u }
            else if ch=#80 then sendescape(csrdown)  { Csr d }
            else if ch=#75 then sendescape(csrleft)  { Csr l }
            else if ch=#77 then sendescape(csrright) { Csr r }
            else if ch=#71 then sendescape('[1~')    { Pos 1 }
            else if ch=#82 then sendescape('[2~')    { Einfg }
            else if ch=#83 then sendescape('[3~')    { Entf  }
            else if ch=#79 then sendescape('[4~')    { End   }
            else if ch=#73 then sendescape('[5~')    { Pag u }
            else if ch=#81 then sendescape('[6~')    { Pag d }
            else if ch=#59 then sendescape('[11~')   { F 1   }
            else if ch=#60 then sendescape('[12~')   { F 2   }
            else if ch=#61 then sendescape('[13~')   { F 3   }
            else if ch=#62 then sendescape('[14~')   { F 4   }
            else if ch=#63 then sendescape('[15~')   { F 5   }
            else if ch=#64 then sendescape('[17~')   { F 6   }
            else if ch=#65 then sendescape('[18~')   { F 7   }
            else if ch=#66 then sendescape('[19~')   { F 8   }
            else if ch=#67 then sendescape('[20~')   { F 9   }
            else if ch=#68 then sendescape('[21~')   { F 10  }
            ;
            if showcode then begin
               highvideo;
               write(ord(ch));
               lowvideo;
               end;
            end
       else if ch=#27 then sendescape(#27)
       else begin
            {$ifdef simulate}
            bildschirm(ch);
            {$else}
            Sendbyte(comport,ord(ch));
            {$endif}
            if echo then bildschirm(ch);
            end;
       end;
end;

(*************************************************************************)
(*************************************************************************)
(*************************************************************************)

(*    Hauptroutine   *)

begin
    proginit;
    repeat
      work;
    until beenden;
    progdone;
end.