(* Chat wrote by Amorphis for the first Lucid way back *)

{$R-,S-,I-,D+,F+,V-,B-,N-,L+,O+ }

unit chat;        (* Chat Mode and F2 Keys *)

interface
USES DOS,CRT;
procedure Callchat(ChatType : Byte);
implementation

USES IO,Records,GenStr,Protcomm,barinfo,filehandle;

type CHATREC=record
              CX1  : array[1..30] of 1..80;
              CX2  : array[1..30] of 1..80;
               CY  : array[1..30] of 1..25;
              MAXY : 1..25;
             end;
var
 lclchat,usrchat : chatrec;
 TX,TY      : 1..80;
 Usercolor  : Byte;
 SysOpColor : Byte;


procedure Callchat(ChatType : Byte);
var k           : char;
    StartedTime : Word;
    cnt         : byte;
    ingetstr    : boolean;
    quit,carrierloss,fromkbd:boolean;
    baudstr,commstr:string[25];
    xsys     :byte;
    ysys     :byte;
    xusr     :byte;
    yusr     :byte;
    ec       :byte;
    linebufs :string[80];
    linebufu :string[80];
    localcurline:byte;
    modemcurline:byte;

var cr:chatrec;



Procedure LoadChatDat;
var T:TEXT;
    D:string;
    x,LMAX,UMAX:BYTE;

Procedure GetCol(Str:String; VAR T:Byte);
Var P   : Byte;
    Temp: String[20];
Begin
 P := Pos(Str,D)+Length(Str);
 Temp:=Copy(D,P,3);
 While Not (Temp[Length(Temp)] in ['0'..'9']) Do Temp[0]:=Pred(Temp[0]);
 T:=Valu(Temp);
End;

Begin
 Assign(T,Config.Data_Dir + 'CHATDAT.'+Strr(ChatType));
 LMax := 0;UMax := 0;
 Reset(T);
 repeat
  Readln(T, D);
  If Pos('USERCOLOR=',D) > 0 then GetCol('USERCOLOR=',UserColor);
  If Pos('SYSOPCOLOR=',D) > 0 then GetCol('SYSOPCOLOR=',SysOpColor);
  case D[1] of
   'L','l': begin
             INC (LMAX);
             LCLCHAT.MAXY      := LMAX;
             LCLCHAT.CY[LMAX]  := valu(copy(D,3,2));
             LCLCHAT.CX1[LMAX] := valu(copy(D,6,2));
             LCLCHAT.CX2[LMAX] := valu(copy(D,9,2));
            end;
   'M','m': begin
             INC (UMAX);
             USRCHAT.MAXY := UMAX;
             USRCHAT.CY [UMAX] := valu (copy (D, 3, 2));
             USRCHAT.CX1[UMAX] := valu (copy (D, 6, 2));
             USRCHAT.CX2[UMAX] := valu (copy (D, 9, 2));
            end;
  end;
 until EOF(T);
 system.close (T);
End;

procedure init;
begin
 loadchatdat;
 printfile(Config.Textfile_Dir+'CHAT.1',basicmci,False);
 localcurline := 1;
 xsys := lclchat.cx1[1];
 ysys := lclchat.cy[1];
 modemcurline := 1;
 xusr := usrchat.cx1[1];
 yusr := usrchat.cy[1];
 ec := 1;
 linebufs := '';
 linebufu := '';
end;

procedure sendxy(x,y:byte);
begin
 swrite(#27+'['+strr(y)+';'+strr(x)+ 'H');
end;

procedure clearbox (I: BYTE);

var Y,x:BYTE; s:string[80];

begin
     case i of
          0: begin
               for y := 1 to lclchat.maxy do begin
                    s := '';
                    for x := 1 to (lclchat.cx2[y] - lclchat.cx1[y]) + 1 do s := s + ' ';
                    GOXY (LCLCHAT.CX1[y], LCLCHAT.CY[y]);
                    swrite (s);
               end;
          end;
          1: begin
               for y := 1 to usrchat.maxy do begin
                    s := '';
                    for x := 1 to (usrchat.cx2[y] - usrchat.cx1[y]) + 1 do s := s + ' ';
                    GOXY (usrCHAT.CX1[y], usrCHAT.CY[y]);
                    swrite (s);
               end;
          end;
     end;
end;

procedure setc;
begin
 if fromkbd then ec := SysOpColor else ec := UserColor;{urec.inputcolor}
end;

procedure wordwrap (s: string; var wrap: string);
var
  index:integer;
begin
     index := length (s);
     while (s[index] <> ' ') and (index > 0) do dec (index);
     if index = 0 then index := length (s);
     wrap := s;
     delete (wrap, 1, index);
end;

procedure locate;
 var wrap,linelocaldelete,linemodemdelete:string[80];
     x:BYTE;
 begin
      linelocaldelete := '';
      linemodemdelete := '';
      if fromkbd then begin
           if (xsys = lclchat.cx2[localcurline] + 1) and (ysys < lclchat.cy[lclchat.maxy]) then begin
                wordwrap (linebufs, wrap);
                dec (xsys, length (wrap));
                for x := 1 to length (wrap) do linelocaldelete := linelocaldelete + ' ';
                sendxy (xsys, ysys);
                swrite (linelocaldelete);
                linebufs := '';
                inc (localcurline);
                ysys := lclchat.cy[localcurline];
                xsys := lclchat.cx1[localcurline];
                sendxy (xsys, ysys);
                swrite (wrap);
                xsys := xsys + (length (wrap));
           end;
           if ((ysys = lclchat.cy[lclchat.maxy]) and (xsys = lclchat.cx2[lclchat.maxy] + 1))
                     or (ysys > (lclchat.cy[lclchat.maxy])) then begin
                wordwrap (linebufs, wrap);
                CLEARBOX (0);
                localcurline := 1;
                ysys := lclchat.cy[localcurline];
                xsys := lclchat.cx1[localcurline];
                sendxy (xsys, ysys);
                swrite (wrap);
                xsys := xsys + length (wrap);
           end;
           sendxy (xsys, ysys);
           inc (xsys);
      end;
      if not fromkbd then begin
           if (xusr = usrchat.cx2[modemcurline] + 1) and (yusr < usrchat.cy[usrchat.maxy]) then begin
                wordwrap (linebufu, wrap);
                dec (xusr, length (wrap));
                for x := 1 to length (wrap) do linemodemdelete := linemodemdelete + ' ';
                sendxy (xusr, yusr);
                swrite (linemodemdelete);
                linebufu := '';
                inc (modemcurline);
                yusr := usrchat.cy[modemcurline];
                xusr := usrchat.cx1[modemcurline];
                sendxy (xusr, yusr);
                swrite (wrap);
                xusr := xusr + (length (wrap));
           end;
           if ((yusr = usrchat.cy[usrchat.maxy]) and (xusr = usrchat.cx2[usrchat.maxy] + 1))
                     or (yusr > usrchat.cy[usrchat.maxy]) then begin
                wordwrap (linebufu, wrap);
                CLEARBOX (1);
                modemcurline := 1;
                yusr := usrchat.cy[modemcurline];
                xusr := usrchat.cx1[modemcurline];
                sendxy (xusr, yusr);
                swrite (wrap);
                xusr := xusr + length (wrap);
           end;
           sendxy (xusr, yusr);
           inc (xusr);
      end;
 end;
{TYPE CHAR}
  procedure typedchar (k: char);
  begin
       locate;
       if fromkbd then linebufs := linebufs+k
                  else if not fromkbd then linebufu:=linebufu+k;
       SetC;AnsiColor(EC);swrite(k)
  end;


begin
 TX := WhereX;TY := WhereY;
{ Window(1,1,80,25);}
 SAVESCREEN;
 if not Fileexist (config.data_dir + 'CHATDAT.'+STRR(ChatType)) then EXIT;
 INIT;
 carrierloss := false;
 quit := false;
 textcolor (15);
 repeat
  Repeat until Keypressed or (DataAvailable){)};
  fromkbd := keypressed;
  ingetstr := true;
  if fromkbd then k := readkey else k := Chr(Getchar);
  if k = #127 then k := #8;
   case ord (k) of
     8: begin
         if (xsys > lclchat.cx1[localcurline]) and fromkbd then
          begin
           if xsys > lclchat.cx1[localcurline] then dec (xsys);
           sendxy (xsys, ysys);
           swrite (' ');
           sendxy (xsys, ysys);
           if length (linebufs) > 0 then linebufs := copy(linebufs,1,length(linebufs)-1);
          end;
          if (xusr > usrchat.cx1[modemcurline]) and not fromkbd then
           begin
            if xusr > usrchat.cx1[modemcurline] then dec(xusr);
            sendxy(xusr, yusr);
            swrite(' ');
            sendxy(xusr, yusr);
            if length(linebufu) > 0 then linebufu := copy(linebufu,1,length(linebufu)-1);
           end;
        end;
    27: QUIT := TRUE;
     0:;
    13: begin
         if fromkbd then begin
                         inc (localcurline);
                         xsys := lclchat.cx1[localcurline];
                         ysys := lclchat.cy[localcurline];
                         if localcurline > LCLCHAT.MAXY then begin
                              CLEARBOX (0);
                              localcurline := 1;
                              ysys := lclchat.cy[localcurline];
                              xsys := lclchat.cx1[localcurline];
                              sendxy (xsys, ysys);
                         end;
                         sendxy (xsys, ysys);
                         linebufs := '';
                    end;

                    if not fromkbd then begin
                         inc (modemcurline);
                         xusr := USRCHAT.cx1[modemcurline];
                         yusr := USRCHAT.cy[modemcurline];
                         if modemcurline > USRCHAT.MAXY then begin
                              CLEARBOX (1);
                              modemcurline := 1;
                              yusr := usrchat.cy[modemcurline];
                              xusr := usrchat.cx1[modemcurline];
                              sendxy (xusr, yusr);
                         end;
                         sendxy (xusr, yusr);
                         linebufu := '';
                    end;
               end;
               32..255:typedchar (k);
               1..31:if fromkbd and carrier then swrite(k);
          end
     until quit ;
 AnsiColor(7);
 SHOWSCREEN;
end;

begin
end.
