unit ranchlin;
{$O+,F+}
{ ************************************************************************* }
{ ***                                                                   *** }
{ *** UFO Communications Engine's Message Line Editor Function Library  *** }
{ ***                                                                   *** }
{ ************************************************************************* }
{            Specially modified Jan. 1, 1993 for Rancho Nevada!             }
{      Last updated: 94/03/27 - Increased message length to 24 lines        }

interface

const maxlin=75;
type linz=string[maxlin+8];
     line=^linz;

     messagerec=record
                  from,                       {Sender's Name             }
                  name:string[36];            {Recipient's Name          }
                  lines:byte;                 {Number of lines to display}
                  text:array[1..24] of linz;  {The Message               }
                end;

var message: array [1..24] of line;
    msgquo: array [1..24] of line; {Rancho has 24-line messages LION}
    quoted: boolean;
    index,thisline,bottomline,topline,topquo:integer;

    tempmsg:messagerec;
    msgfile:file of messagerec;

    cursorpos:byte;
    doneline,doneedit:boolean;
    templn,tl2,tl3:linz;
    tch,tch2:char; linestr:string;
    msgtmpfile:text;
    finito:boolean;
    quotestring:string[5];

procedure ditchmem;
procedure copyquote(firstlin,lastlin:string);
procedure listquo;
procedure readquo;
procedure copymsgtoquo(tempmsg:messagerec);
procedure savemsgtmp;
procedure contmsg;
procedure instxt(startlin:string);
procedure startmsg;
procedure listmsg;
procedure editlin(linenums:string);
procedure displin(linenums:string);
procedure dellin(firstlin,lastlin:string);

implementation

uses dos,crt,bbskv,bbskern,engine2,sys_msg;

procedure ditchmem;
var index:integer;
begin
  for index:=1 to 24 do
  begin
    dispose(message[index]);
    if quoted then dispose(msgquo[index]);
  end;
end;

procedure readquo;
var quofile:text;
    index:integer;
    temp:string;
begin
  for index:=1 to 24 do new(msgquo[index]);
  quoted:=true;
  index:=1; topquo:=index;
  assign(quofile,'msgquo');
  reset(quofile);
  repeat
    begin
      readln(quofile,temp);
      msgquo[index]^:=temp;
      inc(index);
    end
  until (index>24) or (eof(quofile)) or quitnow or lostcarrier;
  if lostcarrier then begin quitnow:=true; nocarrier; exit; end;
  if quitnow then exit;
  topquo:=index-1;
end;

procedure copymsgtoquo(tempmsg:messagerec);
var index:integer;
begin
  for index:=1 to 24 do new(msgquo[index]);
  for index:=1 to 24 do
  begin
    msgquo[index]^:=tempmsg.text[index];
    if
      tempmsg.text[index]=''
    then
      begin
        topquo:=index-1;
        exit;
      end;
  end;
end;

procedure savemsgtmp;
begin
  assign(msgtmpfile,'.\MSGTMP');
  rewrite(msgtmpfile);
  for index:=1 to topline do
  begin
    writeln(msgtmpfile,message[index]^);
  end;
  close(msgtmpfile);
  ditchmem;
  quoted:=false;
end;

procedure contmsg;
begin
  thisline:=topline+1;
  doneedit:=FALSE; templn:='';
  repeat
    begin
      str(thisline,linestr);
      linestr:='00'+linestr; linestr:=copy(linestr,length(linestr)-2,3);
      message[thisline]^:=templn;
      cursorpos:=length(templn)+1;
      send(crlf+'`G'+linestr+':`L'+templn);
      templn:='';
      doneline:=FALSE;
      repeat
        begin
          tch:=getchr;
          if quitnow then exit;
          if
            (tch=chr(13)) or (tch=chr(10))
          then
            if
              (cursorpos=1)
            or
              (thisline>24)
            then
              begin
                doneline:=TRUE;
                doneedit:=TRUE;
              end
            else
              begin
                tl2:=message[thisline]^;
                tl2[0]:=chr(cursorpos-1);
                message[thisline]^:=tl2;
                inc(thisline);
                if(thisline>24) then exit;
                if thisline>topline then topline:=thisline;
                doneline:=TRUE;
              end
          else
            if
              tch=chr(8)
            then
              begin
                if
                  cursorpos>1
                then
                  begin
                    send(chr(8)+' '+chr(8));
                    dec(cursorpos);
                  end;
               end
            else
              begin
                tl2:=message[thisline]^;
                tl2[cursorpos]:=tch;
                message[thisline]^:=tl2;
                send(tch);
                inc(cursorpos);
                if
                  cursorpos>maxlin
                then
                  begin
                    templn:='';
                    repeat
                      begin
                        dec(cursorpos);
                        send(chr(8)+chr(32)+chr(8));
                        tl2:=message[thisline]^;
                        tch:=tl2[cursorpos];
                        if tch<>' ' then templn:=tch+templn;
                        if cursorpos=1 then begin cursorpos:=maxlin; send(templn); templn:=''; tch:=' '; end;
                      end
                    until (tch=' ') or quitnow or lostcarrier;
                    if lostcarrier then begin quitnow:=true; nocarrier; exit; end;
                    if quitnow then exit;
                    tl2:=message[thisline]^;
                    tl2[0]:=chr(cursorpos-1);
                    message[thisline]^:=tl2;
                    inc(thisline);
                    if thisline>24 then doneedit:=true;
                    if not doneedit then topline:=thisline;
                    doneline:=TRUE;
                  end;
              end;
          end;
        until doneline or quitnow or lostcarrier;
        if lostcarrier then begin quitnow:=true; nocarrier; exit; end;
        if quitnow then exit;
      end;
  until doneedit or quitnow or lostcarrier;
  if lostcarrier then begin quitnow:=true; nocarrier; exit; end;
  if quitnow then exit;
  if (topline>1) and (message[topline]^='') then dec(topline);
end;

procedure instxt(startlin:string);
var start,shit,index:integer;
begin
  quoted:=false;
  val(startlin,start,shit);
  if
    (start>topline)
  or
    (start<bottomline)
  then
    nothing
  else
    begin
      thisline:=start;
      doneedit:=FALSE; templn:=''; tl3:=templn;
      repeat
       begin
          str(thisline,linestr);
          linestr:='00'+linestr; linestr:=copy(linestr,length(linestr)-2,3);
          tl3:=templn; cursorpos:=length(templn)+1; sendln(''); send(linestr+':'+templn);
          templn:='';
          doneline:=FALSE;
          repeat
            begin
              tch:=getchr;
              if quitnow then exit;
              if
                (tch=chr(13)) or (tch=chr(10))
              then
                if
                  cursorpos=1
                then
                  begin
                    doneline:=TRUE;
                    doneedit:=TRUE;
                  end
                else
                  begin
                    inc(topline);
                    if (topline>=24) then begin doneedit:=true; exit; end;
                    for index:=topline downto (thisline+1) do message[index]^:=message[index-1]^;
                    tl3[0]:=chr(cursorpos-1);
                    message[thisline]^:=tl3;
                    inc(thisline);
                    doneline:=TRUE;
                  end
              else
                if
                  tch=chr(8)
                then
                  begin
                    if
                      cursorpos>1
                    then
                      begin
                        send(chr(8)+' '+chr(8));
                        dec(cursorpos);
                      end;
                   end
                else
                  begin
                    tl3[cursorpos]:=tch;
                    send(tch);
                    inc(cursorpos);
                    if
                      cursorpos>maxlin
                    then
                      begin
                        templn:='';
                        repeat
                          begin
                            dec(cursorpos);
                            send(chr(8)+chr(32)+chr(8));
                            tch:=tl3[cursorpos];
                            if tch<>' ' then templn:=tch+templn;
                            if cursorpos=1 then begin cursorpos:=maxlin; send(templn); templn:=''; tch:=' '; end;
                          end
                        until (tch=' ') or quitnow or lostcarrier;
                        if lostcarrier then begin quitnow:=true; nocarrier; exit; end;
                        if quitnow then exit;
                        inc(topline);
                        for index:=topline downto (thisline+1) do message[index]^:=message[index-1]^;
                        tl3[0]:=chr(cursorpos-1);
                        message[thisline]^:=tl3;
                        inc(thisline);
                        doneline:=TRUE;
                      end;
                  end;
              end;
            until doneline or quitnow or lostcarrier;
            if lostcarrier then begin quitnow:=true; nocarrier; exit; end;
            if quitnow then exit;
          end;
      until doneedit or quitnow or lostcarrier;
      if lostcarrier then begin quitnow:=true; nocarrier; exit; end;
      if quitnow then exit;
      if (topline>1) and (message[topline]^='') then dec(topline);
    end;
end;

procedure startmsg;
begin
  topline:=0;
  for index:=1 to 24 do new(message[index]);
  bottomline:=1; thisline:=bottomline; doneedit:=FALSE; templn:='';
  contmsg;
end;

procedure listmsg;
var index:integer;
    linestr:string;
begin
  for index:=1 to topline do
    begin
      str(index,linestr);
      linestr:='00'+linestr; linestr:=copy(linestr,length(linestr)-2,3);
      sendln('`G'+linestr+':`L'+message[index]^);
    end
end;

procedure listquo;
var index:integer;
    linestr:string;
begin
  for index:=1 to topquo do
    begin
      str(index,linestr);
      linestr:='00'+linestr; linestr:=copy(linestr,length(linestr)-2,3);
      sendln('`C'+linestr+':`N'+msgquo[index]^);
    end
end;

procedure editlin(linenums:string);
var linenum,shit:integer;
begin
  val(linenums,linenum,shit);
  if
    (linenum>topline)
  or
    (linenum<bottomline)
  then
    nothing
  else
    begin
      str(linenum,linestr);
      linestr:='00'+linestr; linestr:=copy(linestr,length(linestr)-2,3);
      message[linenum]^:=templn; cursorpos:=length(templn)+1;
      send('`G'+linestr+':`O'+templn);
      templn:='';
      doneline:=FALSE;
      repeat
        begin
          tch:=getchr;
          if quitnow then exit;
          if
            (tch=chr(13)) or (tch=chr(10))
          then
            if
              cursorpos=1
            then
              doneline:=TRUE
            else
              begin
                tl2:=message[linenum]^;
                tl2[0]:=chr(cursorpos-1);
                message[linenum]^:=tl2;
                doneline:=TRUE;
              end
          else
            if
              tch=chr(8)
            then
              begin
                if
                  cursorpos>1
                then
                  begin
                    send(chr(8)+' '+chr(8));
                    dec(cursorpos);
                  end;
               end
            else
              begin
                tl2:=message[linenum]^;
                tl2[cursorpos]:=tch;
                message[linenum]^:=tl2;
                send(tch);
                inc(cursorpos);
                if
                  cursorpos>maxlin
                then
                  begin
                    templn:='';
                    repeat
                      begin
                        dec(cursorpos);
                        send(chr(8)+chr(32)+chr(8));
                        tl2:=message[linenum]^;
                        tch:=tl2[cursorpos];
                        if tch<>' ' then templn:=tch+templn;
                        if cursorpos=1 then begin cursorpos:=maxlin; send(templn); templn:=''; tch:=' '; end;
                      end
                    until (tch=' ') or quitnow or lostcarrier;
                    if lostcarrier then begin quitnow:=true; nocarrier; exit; end;
                    if quitnow then exit;
                    tl2:=message[linenum]^;
                    tl2[0]:=chr(cursorpos-1);
                    message[linenum]^:=tl2;
                    doneline:=TRUE;
                  end;
              end;
          end;
        until doneline or quitnow or lostcarrier;
        if lostcarrier then begin quitnow:=true; nocarrier; exit; end;
        if quitnow then exit;
    end;
end;

procedure displin(linenums:string);
var linenum,shit:integer;
begin
  val(linenums,linenum,shit);
  if
    (linenum>topline)
  or
    (linenum<bottomline)
  then
    nothing
  else
    begin
      str(linenum,linestr);
      linestr:='00'+linestr; linestr:=copy(linestr,length(linestr)-2,3);
      sendln('`G'+linestr+':`L'+message[linenum]^);
    end
end;

procedure dellin(firstlin,lastlin:string);
var diff,first,last,shit:integer;
begin
  val(firstlin,first,shit);
  val(lastlin,last,shit);
  if
    (first<bottomline)
  or
    (last<bottomline)
  or
    (first>topline)
  or
    (last>topline)
  or
    (first>last)
  then
    nothing
  else
    begin
      diff:=(last-first)+1;
      for index:=(last+1) to topline do
        begin
          message[index-diff]^:=message[index]^;
        end;
      topline:=topline-diff;
    end;
end;

procedure copyquote(firstlin,lastlin:string);
var dfx,first,last,shit:integer;
begin
  val(firstlin,first,shit);
  val(lastlin,last,shit);
  if
    (first<1)
  or
    (last<1)
  or
    (first>topquo)
  or
    (last>topquo)
  or
    (first>last)
  then
    nothing
  else
    begin
    dfx:=last-first+1;
    for index:=1 to dfx do
      begin
        shit:=first+index-1;
        inc(topline);
        message[topline]^:=quotestring+msgquo[shit]^;
      end;
    end;
end;

{ *** End of Message Line Editor Library Functions *** }

begin
  quoted:=false;
  quotestring:=' > ';
end.
