unit gelin;
{$O+,F+}
{$N+,E+}
{ ************************************************************************* }
{ ***                                                                   *** }
{ *** 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        }
{                 De-modified 96/09/17 for Galactic Empire                  }
{                     Tweaked again 96/11/20 for Rancho                     }

interface

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

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

    cursorpos:byte;
    doneline,doneedit:boolean;
    templn,tl2,tl3:linz;
    tch,tch2:char; linestr:string;
    msgtmpfile:text;
    finito:boolean;
    quotestring:string[5];
    fromnum,tonum:integer;
    tousername,
    fromusername:string[49];
    dontsave:boolean;

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 readmsgs;
procedure entermsg(i:integer);
function  checkemail:boolean;
procedure sysmsg2message(msg:integer);

implementation

uses dos,crt,bbskv,bbskern,engine2,cheaplok,nanocore,iconfig,textunit,rgoods,sys_msg;

procedure readquo;
var quofile:text;
    index:integer;
    temp:string;
begin
  quoted:=true;
  index:=1; topquo:=index;
  assign(quofile,'msgquo');
  reset(quofile);
  repeat
    begin
      readln(quofile,temp);
      msgquo[index]^:=temp;
      inc(index);
    end
  until (index>40) 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 40 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);
  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>40)
            then
              begin
                doneline:=TRUE;
                doneedit:=TRUE;
              end
            else
              begin
                tl2:=message[thisline]^;
                tl2[0]:=chr(cursorpos-1);
                message[thisline]^:=tl2;
                inc(thisline);
                if(thisline>40) 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>40 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>=40) 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;
  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 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 *** }

procedure savemessage;
var exmsg:boolean;
    filename:string;
    outfile:text;
    i:integer;
begin
  sendln(crlf+'`MSending your message to `O'+tousername);
  filename:='MAIL-'+int2str(tonum)+'.DAT';
  if not waitlock(filename) then unlock(filename);
  lock(filename);
  exmsg:=exist(filename);
  assign(outfile,filename);
  if exmsg then append(outfile) else rewrite(outfile);
  writeln(outfile,'`P===-`O-`M-`E-----------------------------------------------------------`E-`M-`O-`P-===');
  writeln(outfile,'`O'+fromusername+'`M wrote you this:');
  writeln(outfile,'');
  i:=1;
  while i<=topline do begin writeln(outfile,'  `O'+message[i]^); inc(i); end;
  writeln(outfile,'');
  writeln(outfile,'`R'+int2str(fromnum)+' '+fromusername);
  close(outfile);
  unlock(filename);
end;

procedure sysmsg2message(msg:integer);
var exmsg:boolean;
    filename:string;
    outfile:text;
    i:integer;
begin
  filename:='MAIL-'+int2str(tonum)+'.DAT';
  if not waitlock(filename) then unlock(filename);
  lock(filename);
  exmsg:=exist(filename);
  assign(outfile,filename);
  if exmsg then append(outfile) else rewrite(outfile);
  writeln(outfile,'`P===-`O-`M-`E-----------------------------------------------------------`E-`M-`O-`P-===');
  writeln(outfile,g_sysmsg(msg));
  i:=1;
  writeln(outfile,'');
  writeln(outfile,'`N');
  close(outfile);
  unlock(filename);
end;

procedure entermsg(i:integer);
var tch,tch2:char;
begin
  fromnum:=thisusernumber; fromusername:=user.name;
  tonum:=i; tousername:=userlog^[i].name;
  startmsg;
  repeat
    send(crlf+crlf+'`(S`)`Mend `(C`)`Montinue `(A`)`Mbort `(L`)`Mist `þ');
    tch:=upcase(getchr);
    case tch of
      'S': begin sendln('`LSend!'); savemessage; exit; end;
      'C': begin
             sendln('`LContinue!'); contmsg;
           end;
      'A': begin
             sendln('`LAbort!');
             send(crlf+'`LAre you sure? `By`L/`KN `þ');
             tch2:=upcase(getchr);
             if tch2='Y' then begin sendln('`JYes'); exit; end;
             sendln('`KNo');
           end;
      'L': begin
             sendln('`LList');
             listmsg;
           end;
      'E': begin
             {editmsg}
           end;
    else
      sendln('');
    end;
  until false;
end;

procedure readmsgs;
var filename:string;
    f:text;
    tstr:string;
    returnnum:integer;
    tch2,tch:char;
    i,j:integer;
    returnname:String;
    savepos:longint;
    amount:comp;
    crap:integer;
label _repnext;
begin
  for i:=1 to 40 do msgquo[i]^:=''; topquo:=0;
  fromnum:=thisusernumber; fromusername:=user.name;
  filename:='MAIL-'+int2str(fromnum)+'.DAT';
  if
    not exist(filename)
  then
    begin
      sendln(crlf+'`JNo messages.');
      exit;
    end;
  savepos:=0;
  if not waitlock(filename) then unlock(filename);
  lock(filename);
  assign(f,filename);
  reset(f); textseek(f,savepos);
  while not eof(f) do
    begin
      readln(f,tstr);
      if
        tstr[1]=#96
      then
        begin
          case upcase(tstr[2]) of
            '%': if
                   (wherex=1)
                 then
                   begin
                     if
                       (copy(tstr,3,2))='B+'
                     then
                       begin
                         delete(tstr,1,4);
                         val(tstr,amount,crap);
                         readuserlog;
                         user.bankgp:=user.bankgp+amount;
                         writeuserlog;
                       end;

                     {Insert other email embeddeds here}

                   end;
            'N': begin   {Next prompt}
                   savepos:=textfilepos(f); close(f); unlock(filename);
                   Send('`(N`)`Oext `þ');
                   tch:=getchr;
                   sendln('`KNext');
                   waitlock(filename); lock(filename); reset(f); textseek(f,savepos);
                   for i:=1 to 40 do msgquo[i]^:=''; topquo:=0;
                 end;
            'R': begin   {Reply prompt}
                   savepos:=textfilepos(f); close(f); unlock(filename);
                   linein:=tstr; parse;
                   returnnum:=str2int(copy(parses[1],3,99));
                   returnname:=restofline;
_repnext:
                   send('`(R`)`Oeply `(N`)`Oext `þ');
                   tch:=getchr;
                   case upcase(tch) of
                     'R': begin
                            sendln('`KReply');
                            send(crlf+'`GQuote what '
                                     +getgen(userlog^[returnnum].gender,1)
                                     +' said? `M(Enter=Y/N) `þ');
                            tch2:=upcase(getchr);
                            if
                              (tch2<>'N')
                            then
                              begin
                                dontsave:=false;
                                sendln('`JYes'+crlf);
                                for i:=1 to topquo do message[i]^:=msgquo[i]^;
                                inc(topquo); message[topquo]^:='';
                                topline:=topquo;
                                listmsg;
                                contmsg;
                                tonum:=returnnum;
                                tousername:=returnname;
                                if not dontsave then savemessage;
                              end
                            else
                              begin
                                sendln('`JNo');
                                entermsg(returnnum);
                                tonum:=returnnum;
                                tousername:=returnname;
                              end;
                            for i:=1 to 40 do msgquo[i]^:=''; topquo:=0;
                          end; {Reply}
                     #13,'N': begin
                            sendln('`KNext');
                            for i:=1 to 40 do msgquo[i]^:=''; topquo:=0;
                          end; {next}
                   else
                     begin
                       sendln('');
                       goto _repnext;
                     end;
                   end; {inner case}
                   waitlock(filename); lock(filename); reset(f); textseek(f,savepos);
                 end;
          end; {Case}
        end
      else
        begin
          sendln(tstr);
          if
            topquo<30
          then
            begin
              j:=pos('>',tstr);
              if
                ((j=0) or (j>10)) and (copy(tstr,1,4)='  `O')
              then
                begin
                  inc(topquo);
                  delete(tstr,1,4);
                  msgquo[topquo]^:='`L> `G'+tstr;
                end;
            end;
        end;
    end;
  close(f);
  sendln(crlf+'`LEnd of messages!');
  nuke(filename);
  unlock(filename);
end;

function checkemail:boolean;
var mailfilename:string;
begin
  checkemail:=false;
  mailfilename:='MAIL-'+int2str(thisusernumber)+'.DAT';
  if
    exist(mailfilename)
  then
    begin
      checkemail:=true;
      sendln(crlf+'`LYour cellphone rings, it seems you have voice mail:');
      sendln('');
      readmsgs;
    end;
end;

begin
  quoted:=false;
  quotestring:='`P >`L ';
  for index:=1 to 40 do begin new(msgquo[index]); msgquo[index]^:=''; end;
  for index:=1 to 40 do begin new(message[index]); message[index]^:=''; end;
end.

