program miniterm;

{define simulate}

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

const header = 'MiniTerm  Version 1.0  (c) 1997 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;

      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;


procedure setcolors(fg,bg:byte);
begin
   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 proginit;
var  ok    : boolean;
     datas : DataBitsType;
     stops : StopBitsType;
     bauds : BaudType;
     parit : ParityType;
     compt : ComType;
     rate  : longint;
     i     : integer;
begin
     textcolor(yellow);
     textbackground(blue);
     writeln;
     writeln;
     writeln(header);
     writeln;

     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 --}
    writeln('Initializing Com-port ',comport,' ...');
    {$ifndef simulate}
    initcom(comport,bauds,parit,datas,stops);
    {$endif}
    writeln;
    writeln('Ok. You can abort the program with ALT-F10...');
    writeln('or get help with ALT-F1 ...');
    writeln;
    setcolors(textfarbe,hgfarbe);
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;

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

procedure scrollregion(w:word);
begin
    scrollbeg := w shr 8;
    scrollend := w and $ff;
end;

procedure intgotoxy(x,y:byte);
begin
   if y>=scrollend then begin
        gotoxy(1,1);
        write('x',x,'y',y,'sb',scrollbeg,'se',scrollend,'|');
        window(1,scrollbeg,80,scrollend);
        gotoxy(80,scrollend-scrollbeg+1);
        writeln;
        dec(y);
        end
   else if y<scrollbeg then begin
        window(1,scrollbeg,80,scrollend);
        gotoxy(1,1);
        insline;
        end;
   window(1,1,80,25);
   gotoxy(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,'   ');
}
    if x<1 then begin
       x:=x+80;
       dec(y);
       end;
    if x>80 then begin
       x:=x-80;
       inc(y);
       end;
    if y<1 then y:=1;
    if y>25 then y:=25;
    intgotoxy(x,y);
end;

procedure dellinepart(a,z:byte);
var x,y : byte;
begin
    x:=wherex;
    y:=wherey;
    if (y=25) and (z=80) then z:=79;
    if (a<=80) then begin
       gotoxy(a,y);
       while (a<=z) do begin
             write(' ');
             inc(a);
             end;
       end;
    gotoxy(x,y);
end;

procedure delrestofscreen;
var x,y,l : byte;
begin
    x:=wherex;
    y:=wherey;
    dellinepart(x,80);
    l:=y+1;
    while (l<=25) do begin
          gotoxy(1,l);
          dellinepart(1,80);
          inc(l);
          end;
    gotoxy(x,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>25 then y:=25;
    intgotoxy(x,y);
end;

procedure sendescape(s:string); forward;

procedure escapeoutput;
var no : word;
begin
    escapeactive:=false;
         if getcode('[m',no)    then setcolors(textfarbe,hgfarbe)
    else if getcode('[*m',no)   then begin
              if no=0 then setcolors(boldtextfarbe,boldhgfarbe)
         else if no=4 then setcolors(undltextfarbe,undlhgfarbe)
         else if no=5 then setcolors(currenttext or blink,currentback)
         else if no=7 then setcolors(revtextfarbe,revhgfarbe)
         end
    else if getcode('[*;*m',no) then setcolors(no and $f,hgfarbe)
    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('[*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('[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('[2J',no)   then clrscr
    else if getcode('[J',no)    then delrestofscreen
    else if getcode('[K',no)    then dellinepart(wherex,80)
    else if getcode('[1K',no)   then dellinepart(1,wherex)
    else if getcode('[2K',no)   then dellinepart(1,80)
    else if getcode('[*~',no)   then begin
              if no=1 then gotoxy(1,wherey)  { Pos 1  }
         else if no=4 then gotoxy(80,wherey) { End    }
         else if no=5 then gotoxy(wherex,1)  { page u }
         else if no=6 then gotoxy(wherex,25) { page d }
         end
    else if getcode('[5n',no)   then sendescape('[0n') { status ?  OK ! }
    else if getcode('[6n',no)   then
         sendescape('['+itxt(wherey)+';'+itxt(wherex)+'R') { cursorposition }
    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 escapeactive then begin
        escapebuffer:=escapebuffer+ch;
        ch:=upcase(ch);
        if ((ch>='A') and (ch<='Z')) or (ch='~') then escapeoutput;
        end
   else if ch=#9 then begin  { tab }
        gotoxy(round((wherex)/6+0.5)*6,wherey);
        end
   else begin
{        if (oldchar=#13) and (ch<>#10) then writeln;}
        write(ch);
        if ch=#10 then gotoxy(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;
begin
    textcolor(yellow);
    textbackground(blue);
    writeln;
    writeln(header);
    writeln;
    writeln('   ALT-F1    (this) Help');
    if echo then txt:='ON' else txt:='OFF';
    writeln('   ALT-F2    switch local echo (it is now switched ',txt,')');
    if dolog then txt:='ON' else txt:='OFF';
    writeln('   ALT-F3    switch logging (it is now switched ',txt,')');
    writeln('   ALT-F4    send ''clear screen''');
    writeln('   ALT-F10   exit program');
{    writeln('   ESC   exit program');     }
    textcolor(textfarbe);
    textbackground(hgfarbe);
    writeln;
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);
       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 dolog:=not dolog
            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=#75 then sendescape('[D')     { Csr u }
            else if ch=#77 then sendescape('[C')     { Csr d }
            else if ch=#72 then sendescape('[A')     { Csr l }
            else if ch=#80 then sendescape('[B')     { 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.