UNIT MSGAREA;

interface

Uses Records;

var   msgbasef:file of messagebaserec;
      msgbase_rec: messagebaserec;

 Function   Num_msgbase:integer;
 Procedure  Seek_msgbase(i:integer);
 Procedure  Remove_msgbase(i,msg_curconf:integer);
 Procedure  Add_msgbase(msg_curconf:integer);
 function   postit(reply:boolean;sx:longint):boolean;
 procedure  msgarealist;
 procedure  readmessages;
Implementation

uses dos,crt,io,genstr,protcomm,filehandle;

           type
               cc=array[1..80] of char;

               bb=array[1..255] of cc;

           CONST
               currentbase  : integer=1;
               currentmsg   : integer=1;

           var msgm         : mcis;
               message      : ^bb;
               messy,messx  : integer;
               currentline  : integer;
               bot          : byte;
               insert       : boolean;
               temp         : cc;
               messagedone  : boolean;
               total        : byte;
               xpos,ypos    : integer;
               s            : string;
               c            : char;
               msgx         : integer;
{ ******************************************************* }
{ Message reading                                         }
{ ******************************************************* }

function totallines:integer;
var xx:boolean;
    x,y,z:integer;

begin
z:=0;
totallines:=0;
for y:=1 to 255 do
begin
for x:=1 to 80 do if message^[y][x]{.c}<>#0 then begin;
                                               xx:=true;
                                               x:=80;
                                               inc(z);
                                               end;
end;
totallines:=z;
end;

function gettotalmsg(xr:integer):integer;
var f:file;
    g:file;
    i:messagebaserec;
    m:messagerec;
    x,y,z:integer;
    C:char;
    gg:array[1..80] of char;
begin
z:=0;

nassign(g,config.data_dir+'message.dat');
nseek(g,xr*sizeof(i)-sizeof(i));
nread(g,i,sizeof(i));
nclose(G);

nassign(f,config.board_dir+i.datafile+'.IDX');

if filesize(f)=0 then begin;
                      gettotalmsg:=0;
                      nclose(f);
                      exit;
                      end;
z:=FILESIZE(f) div sizeof(m);
GETTOTALmsg:=z;
end;

Procedure Read_Msg(i:integer;var idx:messagerec);
    var
    idxf:file;
    dataf:file;
    mbase:messagebaserec;
    y,x:longint;

begin
nassign(idxf,config.data_dir+'message.dat');
nseek(idxf,currentbase*sizeof(mbase)-sizeof(mbase));
nread(idxf,mbase,sizeof(mbase));
nclose(idxf);

  nassign(idxf,config.board_dir+mbase.datafile+'.IDX');
  nseek(idxf,i*sizeof(idx));
  nread(idxf,idx,sizeof(idx));
  nclose(idxf);

  nassign(dataf,config.board_dir+mbase.datafile+'.DAT');
  nseek(dataf,idx.position);

  for y:=1 to idx.numlines do
  begin
  for x:=1 to 80 do nread(dataf,message^[y][x],sizeof(message^[y][x]));
  write(message^[y][x]);
  end;
  readkey;
  nclose(dataf);
  end;

Procedure writemsg;
var
    idx:messagerec;
    idxf:file;
    dataf:file;
    mbase:messagebaserec;
    y,x:longint;
begin
     nassign(idxf,config.data_dir+'message.dat');
     nseek(idxf,currentbase*sizeof(mbase)-sizeof(mbase));
     nread(idxf,mbase,sizeof(mbase));
     nclose(idxf);

  nassign(dataf,config.board_dir+mbase.datafile+'.DAT');

idx.author:=user.alias;
idx.status:=0;
idx.position:=filesize(dataf);;
idx.numlines:=totallines;
idx.tofield:=msgm[1].str;
idx.usernote:=user.usernote;
idx.datetime:=date;
idx.subject:=msgm[3].str;

  nassign(idxf,config.board_dir+mbase.datafile+'.IDX');
  nseek(idxf,filesize(idxf));
  nwrite(idxf,idx,sizeof(idx));
  nclose(idxf);

  nseek(dataf,filesize(Dataf));
  for y:=1 to idx.numlines do
  for x:=1 to 80 do nwrite(dataf,message^[y][x],sizeof(message^[y][x]));
  nclose(Dataf);

end;

procedure readmessages;
var  msgread    : mcis;
     minfo      : messagerec;
begin
fillchar(msgread,sizeof(msgread),#0);
msgread[1].mci:='~DT'; { DATE }
msgread[2].mci:='~TI'; { TIME }
msgread[3].mci:='~MN'; { DUNNO }
msgread[4].mci:='~ST'; { DUNNO }
msgread[5].mci:='~MT'; { SUBJECT}
msgread[6].mci:='~SN'; { FROM }
msgread[7].mci:='~RN'; { TO }
msgread[8].mci:='~ML'; { lines }
msgread[9].mci:='%CM'; { current msg }
msgread[10].mci:='%CT'; { total msg }
msgread[9].str:=strr(msgx);
msgread[10].str:=strr(gettotalmsg(currentbase));
read_msg(0,minfo);
readkey;
end;
(*
    var
    x,y        : integer;
    totallines : integer;
    msgread    : mcis;
    done       : boolean;
    C          : char;
    p          : pointer;
    tx         : 0..80;
    ss         : string[80];
    tempx      : longint;
    LINER      : BYTE;
    mrl        : array[1..80] of char;
    skip       : string[4];
    charx      : 0..4;
    m          : messagerec;
    lines      : string[80];

begin
LINER:=1;
msgx:=1;
mark(p);
fillchar(msgread,sizeof(msgread),#0);
msgread[1].mci:='~DT'; { DATE }
msgread[2].mci:='~TI'; { TIME }
msgread[3].mci:='~MN'; { DUNNO }
msgread[4].mci:='~ST'; { DUNNO }
msgread[5].mci:='~MT'; { SUBJECT}
msgread[6].mci:='~SN'; { FROM }
msgread[7].mci:='~RN'; { TO }
msgread[8].mci:='~ML'; { lines }
msgread[9].mci:='%CM'; { current msg }
msgread[10].mci:='%CT'; { total msg }
msgread[9].str:=strr(msgx);
msgread[10].str:=strr(gettotalmsg(currentbase));


if gettotalmsg(currentbase)=0 then begin
                              Println('|B0|12 There are no messages!');
                              exit;
                              end;


msgx:=0;
Repeat
read_msg(msgx,m);
msgread[9].str:=strr(msgx);
msgread[10].str:=strr(gettotalmsg(currentbase));

msgread[1].str:=m.datetime;
msgread[2].str:='';
msgread[3].str:='';
msgread[4].str:='';
msgread[5].str:=m.subject;
msgread[6].str:=m.author;
msgread[7].str:=m.tofield;
msgread[8].str:=strr(m.numlines);
printfile(config.textfile_dir+'mailhead.ans',msgread,false);
liner:=1;
for y:=1 to m.numlines do
    begin

    INC(LINER);
    IF (liner=16)THEN BEGIN
                     Animated_HoldScreen;
                     GOXY(1,WHEREY);
                     SWRITE(#27+'[K');
                     restorecolor;
                     LINER:=1;
                     goxy(1,wherey-1);
                     println('');
                     END;
    end;
buflen:=255;
println(''+#13#10);
printfile(config.textfile_dir+'mailbot.ans',msgread,false);
s:='';
buflen:=4;
charx:=1;

repeat
c:=sreadkey;
case c of
#8: if charx>1 then
    begin
    swrite(#8+' '+#8);
    dec(s[0]);
    dec(charx);
    end;
'0'..'9': if charx<5 then
          begin
          inc(charx);
          s:=s+c;
          write(C);
          awrite(C);
          end;
end;
until (upcase(c) in ['Q','R','A','D',#13,'+','-']) OR ((Not Carrier) AND (Not Localon)) or (hungup) or (loggedoff);;

if c<>#13 then swrite(c);
{if s<>'' then jumpmessage(valu(s));}

case upcase(c) of
   'Q':DONE:=TRUE;
   'R':begin;
       if postit(true,tempx) then inc(total);
       end;
   'A':;
   'D':;
   #13,'+':inc(msgx);
   '-':BEGIN
       dec(msgx);
       if msgx=0 then msgx:=1;
       end;
END;
until (done) OR ((Not Carrier) AND (Not Localon)) or (hungup) or (loggedoff);
end;*)

{ ******************************************************* }
{ Message saving                                          }
{ ******************************************************* }


procedure msgarealist;
var msgarea:mcis;
    h,f:file;
    i:MessageBaseRec;
    x,y:integer;
    fa:string[3];
begin
fillchar(msgarea,sizeof(msgarea),#0);
msgarea[1].mci:='~AN';
msgarea[2].mci:='~AT';
msgarea[3].mci:='~NM';
msgarea[4].mci:='~SP';
nassign(f,config.data_dir+'message.dat');
x:=1;
printfile(Config.Textfile_Dir+'marea.top',msgarea,false);
repeat
nread(f,i,sizeof(i));
nassign(h,config.data_dir+i.datafile);
msgarea[1].str:=strr(x);
msgarea[2].str:=i.description;
msgarea[3].str:=strr(gettotalmsg(x));
msgarea[4].str:='none';
printfile(Config.Textfile_Dir+'marea.mid',msgarea,false);
inc(X);
nclose(h);
until eof(f);
dec(x);
printfile(Config.Textfile_Dir+'marea.bot',msgarea,false);
PRINT('|B0|12Message Base ..-> ');
buflen:=3;
sreadln(fa);
buflen:=255;
if valu(fa) in [1..x] then currentbase:=valu(fa);
nCLOSE(f);

end;

Function Num_msgbase:integer;
begin
 num_msgbase:=filesize(msgbasef);
end;

Procedure Seek_msgbase(i:integer);
begin
 seek(msgbasef,i-1);
end;

Procedure Assign_Msgbase(msg_curconf:integer);
begin
 assign(msgbasef,config.text_dir+'MSGBASE.'+strr(msg_curconf));
end;

Procedure Remove_Msgbase(i,msg_curconf:integer);
var ii:integer;
  begin
    assign_msgbase(msg_curconf);
    reset (msgbasef);
    for ii:=i to num_msgbase-1 do begin
      seek_msgbase(ii+1);
      read(msgbasef,msgbase_rec);
      seek_msgbase(ii);
      write(msgbasef,msgbase_rec);
    end;
    seek_msgbase(num_msgbase);
    truncate(msgbasef);
    close(msgbasef);
   end;

Procedure Add_Msgbase(msg_curconf:integer);
var i:integer;
  begin
    assign_msgbase(msg_curconf);
{$i-}  reset (msgbasef); {$i+}
    if ioresult<>0 then rewrite(msgbasef);
    i:=num_msgbase+1;
    with msgbase_rec do
     begin
      Description := 'Temporary';
      Sponsor     := 'SysOp';
      ListAccess  := '';
      ReadAccess  := '';
      PostAccess  := '';
      Password    := '';
      MaxMessages := 1000;
      Echomaildir := '';
      NetAddress  := 0;
      OriginLine  := 0;
      EchoTag     := '';
      NetID       := '';
      Kill_Kludge := False;
      Kill_seenby := False;
      Kill_TearLn := False;
     end;
    seek_msgbase(i);
    write(msgbasef,msgbase_Rec);
    close(msgbasef);
   end;

procedure clearbox;
var i:integer;
begin
for i:=msgm[4].y to msgm[5].y do begin
                                 goxy(msgm[4].x,i);
                                 swrite('[0m[K');
                                 end;
end;

function findlast(line:byte):byte;
var i:integer;
    ii:integer;
begin
 for i:=80 downto 1 do begin
                      if message^[line][i]{.c}<>#0 then begin
                                       ii:=i;
                                       findlast:=ii;
                                       exit;
                                       end;
                      end;
findlast:=0;
end;

procedure show;
var s:string[79];
    t:Byte;
    g:byte;
begin
g:=textattr;
for t:=1 to 80 do s[t]:=temp[t]{.c};
write(s);
ansicolor(g);
end;

procedure display(start1,start2:integer);
var i:integer;
    x,y:integer;
begin
x:=start1;
for i:=msgm[4].y to msgm[5].y do begin
                                 goxy(msgm[4].x,i);
 {                                FILLCHAR(TS,SIZEOF(TS),#0);}
                                  for y:=1 to 80 do swrite(message^[x][y]{.c});
{                                 for y:=1 to 80 do temp[y].c:=message[x][y].c;
                                 show;}
                                 inc(x);
                                 end;
end;


function post:boolean;

VAR G:INTEGER;

procedure down;forward;
PROCEDURE update;
var c:string[3];
    s:byte;
    tt:byte;
begin

if msgm[6].used then begin
                     {updates currentline}
                     s:=textattr;
                     savexy;
                     goxy(msgm[6].x,msgm[6].y);
                     if currentline in [1..9] then c:='00'+strr(currentline) else
                     if currentline in [10..99] then c:='0'+strr(currentline) else
                     if currentline in [100..255] then c:=strr(currentline);
                     ansicolor(msgm[6].Back shl 4 + msgm[6].Fore);
                     swrite(c);
                     goxy(Savedx,savedy);
                     ansicolor(s);
                     end;
if msgm[7].used then begin
                     {updates X pos}
                     if xpos=81 then begin
                                     xpos:=1;
                                     down;
                                     end;
                     s:=textattr;
                     savexy;
                     goxy(msgm[7].x,msgm[7].y);
                     c:='00';
                     if xpos in [1..9] then c:='0'+strr(xpos) else
                     if xpos in [10..80] then c:=strr(xpos);
                     ansicolor(msgm[7].Back shl 4 + msgm[7].Fore);
                     swrite(c);
                     goxy(Savedx,savedy);
                     ansicolor(s);
                     end;
if msgm[8].used then begin
                     {updates insert}
                     s:=textattr;
                     savexy;
                     goxy(msgm[9].x,msgm[9].y);
                     ansicolor(msgm[9].Back shl 4 + msgm[9].Fore);
                     swrite(yn(insert));
                     goxy(Savedx,savedy);
                     ansicolor(s);
                     end;
end;

procedure killchar(t:boolean);
var s:string;
    y,G:INTEGER;

begin
if (currentline=1) and (xpos=0) then exit;
if t=true then dec(xpos);
if xpos=0 then begin
               if currentline=1 then exit;
               dec(currentline);
               messx:=80;
               dec(messy);
               move(currentline,s,80);
               xpos:=findlast(currentline);
               messx:=xpos;
               message^[currentline][xpos]{.c}:=#0;
               goxy(messx,messy);
               Swrite(' '+#8);
               goxy(messx,messy);
{               xpos:=80;}
                xpos:=findlast(currentline)+1;
               update;
               exit;
               end;
               messx:=xpos;
               message^[currentline][xpos]{.c}:=#0;
               messx:=xpos;
               goxy(messx,messy);
               Swrite(' '+#8);
               FOR G:=XPOS TO 79 DO MESSAGE^[CURRENTLINE][G]:=MESSAGE^[CURRENTLINE][G+1];
               GOXY(1,MESSY);
               MESSAGE^[CURRENTLINE][80]{.C}:=#0;
               goxy(1,messy);
               for y:=1 to 80 do Swrite(message^[CURRENTLINE][y]{.c});
               swrite(#27+'[K');
               goxy(messx,messy);
               update;
               end;

procedure toggleinsert;
begin
if insert=true then insert:=false else insert:=true;
update;
end;

procedure down;
var i:byte;
begin
if currentline=255 then exit;
if messy=msgm[5].y then begin
{for i:=msgm[4].y to msgm[5].y do begin
                                 goxy(msgm[4].x,i);
                                 clreol;
                                 end;   }
                                 clearbox;

                        savexy;
                        goxy(1,msgm[4].y);
                        display(currentline-BOT,currentline-1);
                        inc(currentline);
                        goxy(1,msgm[5].y);
                        xpos:=1;
                        end else
                        begin
                        messx:=1;
                        inc(messy);
                        inc(currentline);
                        goxy(1,messy);
                        xpos:=1;
                        end;
end;
procedure up;
var i:byte;
begin
if currentline=1 then exit;
if messy=msgm[4].y then begin
                        clearbox;
                        savexy;
                        goxy(1,msgm[4].y);
                        display(currentline-1,currentline+BOT);
                        dec(currentline);
                        goxy(1,msgm[4].y);
                        xpos:=1;
                        end else
                        begin
                        dec(messy);
                        dec(currentline);
                        goxy(1,messy);
                        xpos:=1;
                        end;
                        UPDATE;
end;

procedure left;
begin
if (currentline=1) and (xpos=1) then exit;
dec(xpos);
if xpos=0 then begin
               if messy=msgm[4].y then
                 begin
                 up;
                 messx:=1;
                 xpos:=findlast(currentline)+1;
                 messx:=xpos;
                 goxy(messx,messy);
                 exit;
                 end;
               dec(currentline);
               dec(messy);
               messx:=1;
               xpos:=findlast(currentline)+1;
               goxy(xpos,messy);
               end
                 else
                   begin
                   messx:=xpos;
                   goxy(messx,messy);
                   end;
                    UPDATE;
               end;

procedure right;
begin
if (currentline=255) and (xpos=79) then exit;
inc(xpos);
if xpos{=80}>=findlast(currentline)+2{} then begin
               if messy=msgm[5].y then
                 begin
                 down;
                 update;
                 messx:=1;
                 exit;
                 end;
               inc(currentline);
               messx:=1;
               inc(messy);
               move(currentline,s,80);
               xpos:=1;
               goxy(xpos,messy);
               end
                 else
                   begin
                   messx:=xpos;
                   goxy(xpos,messy);
                   end;
                    UPDATE;
               end;

PROCEDURE COMMAND;
VAR G:CHAR;
BEGIN
savexy;
IF XPOS>1 THEN BEGIN;
               MESSAGE^[CURRENTLINE][XPOS]{.C}:='/';
               SWRITE('/');
               INC(XPOS);
               UPDATE;
               EXIT;
               END;
repeat
SAVEXY;
GOXY(MSGM[8].X,MSGM[8].Y);
G:=SREADKEY;
case upcase(g) of

'S':begin
      {savemessage;}
      writemsg;
      messagedone:=true;
      post:=true;
    end;
'A':begin
    messagedone:=true;
    post:=false;
    end;

#27: goxy(savedx,savedy);


END;
until (upcase(g) in ['S',#27,'A']) OR ((Not Carrier) AND (Not Localon)) or (hungup) or (loggedoff);;
END;

var count:byte;
    C2:CHAR;
    y:integer;
begin
bot:=(msgM[5].y-msgM[4].y)-1;
messx:=msgm[4].x;
messy:=msgm[4].y;
goxy(messx,messy);
{currentline:=1;}
s:='';
xpos:=1;
DISPLAY(currentline,currentline+25);
GOXY(MSGM[4].X,MSGM[4].Y);
repeat

    REPEAT
    UNTIL (DATAAVAILABLE) or (keypressed) OR ((Not Carrier) AND (Not Localon)) or (hungup) or (loggedoff);;

    IF DATAAVAILABLE THEN c:=CHR(GETCHAR) ELSE

    IF KEYPRESSED THEN C:=READKEY;
    CASE C OF
    #0 : BEGIN
            C2:=READKEY;
            CASE C2 OF
             #72:up;
             #80:begin; down; update; end;
             #75:left;
             #77:right;
             #83:KILLCHAR(false);
         END;
         END;
     ^V:toggleinsert;
    #13:begin; down; update; end;
     #8:KILLCHAR(TRUE);
    '/':COMMAND;
    #27: BEGIN
           C:=SREADKEY;
           IF C='[' THEN C:=SREADKEY;
           if c='A' then up;
           if c='B' then begin; down; update; end;
           if c='C' then right;
           If c='D' then left;
           END;
        else
        if (currentline<256) then
           begin

        if insert then
             begin
             move(message^[currentline][xpos],message^[currentline][xpos+1],80-xpos);
             savexy;
             goxy(1,messy);
             for y:=1 to 80 do Swrite(message^[currentline][y]{.c});
             goxy(savedx,savedy);
             end;

     Swrite(C);
     message^[currentline][xpos]{.c}:=c;
     inc(xpos);
     update;
     end;
end;

until (messageDONE) OR ((Not Carrier) AND (Not Localon)) or (hungup) or (loggedoff);;
end;

function   postit(reply:boolean;sx:longint):boolean;
var too:string[30];
    desc:string[30];
    p:pointer;
    i:messagebaserec;
    m:messagerec;
    f:file;
    x,y:byte;
    C:char;
    quote:String[80];
    st,sp:integer;
    tempb:string[3];
begin
           gettotalmsg(currentbase);
           messageDONE:=FALSE;
           mark(p);
           new(message);
           fillchar(message^,sizeof(message^),#0);
           print('|B0|07');
           if reply=false then begin
                               ansiclr;
                               currentline:=1;
                               fillchar(msgm,sizeof(msgm),#0);
                               println('');
                               print('|B0(|09Message |09To|01) ');
                               buflen:=20;
                               sreadln(too);
                               print('|B0(|09Message Description|01) ');
                               sreadln(desc);
                               buflen:=255;
                               msgm[1].str:=too;
                               msgm[2].str:=user.alias;
                               msgm[3].str:=desc;
                               MSGM[6].STR:='001';
                               MSGM[7].STR:='01';
                               MSGM[9].str:=yn(insert);
                               end else
                               begin
                               nassign(f,config.data_dir+'message.dat');
                               nseek(f,currentbase*sizeof(i)-sizeof(i));
                               nread(f,i,sizeof(i));
                               nclose(F);
                               nassign(f,config.board_dir+i.datafile);
                               nseek(f,sx);
                               blockread(f,m,sizeof(m));

                               quote:='< '+m.author+' said >';
                               println('|B0|15');
                               println('|B0|15Total Lines [1..'+Strr(m.numlines)+']');
                               print('|B0|13Quote Line start > ');
                               buflen:=3;
                               sreadln(tempb);

{                               if tempb='' then begin
                                                dec(msgx);
                                                nseek(f,mcc);
                                                end;         }
                               st:=valu(tempb);
                               print('|B0|13Quote Line stop > ');
                               buflen:=3;
                               sreadln(tempb);
                               sp:=valu(tempb);
                               if st>m.numlines then st:=1 else
                               if sp<1 then sp:=m.numlines else
                               if sp<st then sp:=m.numlines else
                               if st>sp then st:=1 else
                               if sp>m.numlines then sp:=m.numlines;

                               move(quote,message^[1],length(quote)+1);
                               for y:=st to sp do
                               for x:=1 to 80 do
                               begin
                               blockread(f,c,sizeof(C));
                               message^[y+1][x]{.c}:=c;
                               end;
                               quote:='< '+user.alias+' said >';
                               currentline:=sp+2; {mlines}
                               move(quote,message^[currentline],length(quote)+1);
                               inc(currentline);
                               nclose(f);
                               msgm[1].str:=m.author;
                               msgm[2].str:=user.alias;
                               msgm[3].str:=m.subject;
                               MSGM[6].STR:='001';
                               MSGM[7].STR:='01';
                               MSGM[9].str:=yn(insert);
                               end;

           msgm[1].mci:='%MT';
           msgm[2].mci:='%MF';
           msgm[3].mci:='%MS';
           msgm[4].mci:='%MH';
           msgm[5].mci:='%MB';
           msgm[6].mci:='%MC';
           msgm[7].mci:='%MX';
           msgm[8].mci:='%MM';
           msgm[9].mci:='%MI';
           printfile(config.textfile_dir+'post.ans',msgm,false);
           ansicolor(msgm[4].Back shl 4 + msgm[4].Fore);
           postit:=post;
           dispose(message);
           release(p);
end;

begin
end.
