(*****************************************************************************)
(*>                                                                         <*)
(*>  SYSOP5  .PAS -  Written by Eric Oman                                   <*)
(*>                                                                         <*)
(*>  SysOp functions: Text file base editor, Voting question editor, and    <*)
(*>  Vote printer.                                                          <*)
(*>                                                                         <*)
(*****************************************************************************)
{$A+,B+,D-,E+,F+,I+,L+,N-,O+,R-,S+,V-}
unit sysop5;

interface

uses
  crt, dos,

  {rcg11172000 no overlay under Linux.}
  {overlay,}

  common;

procedure tfileedit;

implementation

var f1:file of byte;

procedure tfileedit;
var b,b1:tfilerec;
    gfil:file of tfilerec;
    s:astr;
    ok,done,abort,next,changed:boolean;
    gftit:array[1..150] of record
      tit:string[40];
      filen:string[12];
      arn:integer;
      gfile:boolean;
      acs,ulacs:acstring;
      gdate:string[8];
    end;
    gfs:array[0..100] of record
      tit:string[40];
      arn:integer;
      acs,ulacs:acstring;
      gdate:string[8];
    end;
    numgentrys,numgsecs,lgftn,numgft,c:integer;
    c1,c2,c3,c4:integer;
    s1,s2,s3,s4:astr;
    ch:char;
    i:integer;

function align(fn:astr):astr;
var f,e,t:astr; c,c1:integer;
begin
  c:=pos('.',fn);
  if c=0 then begin
    f:=fn; e:='   ';
  end else begin
    f:=copy(fn,1,c-1); e:=copy(fn,c+1,3);
  end;
  while length(f)<8 do f:=f+' ';
  while length(e)<3 do e:=e+' ';
  if length(f)>8 then f:=copy(f,1,8);
  if length(e)>3 then e:=copy(e,1,3);
  c:=pos('*',f); if c<>0 then for c1:=c to 8 do f[c1]:='?';
  c:=pos('*',e); if c<>0 then for c1:=c to 3 do e[c1]:='?';
  c:=pos(' ',f); if c<>0 then for c1:=c to 8 do f[c1]:=' ';
  c:=pos(' ',e); if c<>0 then for c1:=c to 3 do e[c1]:=' ';
  align:=f+'.'+e;
end;

  procedure gettit(n:integer);
  var r:integer; b:tfilerec;
  begin
    numgft:=0;
    r:=n+1;
    if r<=numgentrys then begin
      seek(gfil,r); read(gfil,b);
      while (r<=numgentrys) and (b.filen[1]<>#1) do begin
        inc(numgft);
        gftit[numgft].tit:=b.title;
        gftit[numgft].filen:=b.filen;
        gftit[numgft].arn:=r;
        gftit[numgft].gfile:=TRUE;
        gftit[numgft].acs:=b.acs;
        gftit[numgft].ulacs:=b.ulacs;
        gftit[numgft].gdate:=b.gdate;
        inc(r);
        if (r<=numgentrys) then begin seek(gfil,r); read(gfil,b); end;
      end;
    end;
    gftit[numgft+1].arn:=r;
  end;

  procedure getsec;
  var r:integer; b:tfilerec;
  begin
    numgsecs:=0;
    gfs[0].tit:='Main Section';
    gfs[0].arn:=0;
    for r:=1 to numgentrys do begin
      seek(gfil,r); read(gfil,b);
      if b.filen[1]=#1 then begin
        inc(numgsecs);
        gfs[numgsecs].tit:=b.title;
        gfs[numgsecs].arn:=r;
        gfs[numgsecs].acs:=b.acs;
        gfs[numgsecs].ulacs:=b.ulacs;
        gfs[numgsecs].gdate:=b.gdate;
      end;
    end;
    gfs[numgsecs+1].arn:=numgentrys+1;
  end;

  procedure lgft;
  var i:integer;
      b:tfilerec;
      s:astr;
  begin
    if numgft=0 then print('** No T-Files **')
    else begin
      abort:=FALSE; next:=FALSE;
      i:=1;
(*
NNN:Description                             :Filename    :SL :AR:Date
===:========================================:============:===:==:========

NNN:Description                             :Filename    :Date    :ACS
===:========================================:============:========:==========
*)
      printacr(#3#0+'NNN'+sepr2+'Description                             '+
               sepr2+'Filename    '+sepr2+'Date    '+sepr2+'ACS',abort,next);
      printacr(#3#4+'===:========================================:============:========:==========',abort,next);
      while (i<=numgft) and (not abort) do begin
        seek(gfil,gftit[i].arn); read(gfil,b);
        s:=#3#0+mn(i,3)+' '+#3#3+mln(b.title,40)+' '+#3#3+align(b.filen)+' '+
           mln(b.gdate,8)+' '+mln(b.acs,10);
        printacr(s,abort,next);
        inc(i);
      end;
    end;
  end;

  procedure gfed;
  var sel,i,j,k:integer;
  begin
    prt('Section number to delete? (1-'+cstr(numgsecs)+') : '); inu(sel);
    if ((sel>=1) and (sel<=numgsecs)) then begin
      nl;
      sprompt(#3#3+gfs[sel].tit);
      if pynq('   Delete it? ') then begin
        if sel=numgsecs then j:=numgentrys+1 else j:=gfs[sel+1].arn;
        i:=(j-gfs[sel].arn);
        for k:=j to numgentrys do begin
          seek(gfil,k); read(gfil,b);
          seek(gfil,k-i); write(gfil,b);
        end;
        seek(gfil,0);
        dec(numgentrys,i); b.gdaten:=numgentrys;
        write(gfil,b);
      end;
    end
    else print('Illegal section number.');
  end;

  function newindexno:longint;
  var b:tfilerec;
      i,j:integer;
  begin
    reset(gfil);
    j:=-1;
    for i:=1 to filesize(gfil) do begin
      read(gfil,b);
      if (b.permindx>j) then j:=b.permindx;
    end;
    inc(j);
    newindexno:=j;
  end;

  procedure gfei;
  var sel,i:integer;
      c:char;
  begin
    prt('Section number to insert before? (1-'+cstr(numgsecs+1)+') : '); inu(sel);
    if (sel>=1) and (sel<=(numgsecs+1)) then begin
      if (sel<=numgsecs) then sel:=gfs[sel].arn else sel:=numgentrys+1;
      b.gdate:=date;
      b.gdaten:=daynum(date);
      b.tbstat:=[];
      b.permindx:=newindexno;
      b.tbdepth:=0;
      prt('Section title: '); inputwc(b.title,40);
      prt('Section ACS: '); inputl(b.acs,20);

      b.filen:=#1#0#0#0#0#0;
      for i:=numgentrys downto sel do begin
        seek(gfil,i); read(gfil,b1);
        seek(gfil,i+1); write(gfil,b1);
      end;
      seek(gfil,sel); write(gfil,b);
      inc(numgentrys); b.gdaten:=numgentrys;
      seek(gfil,0); write(gfil,b);
    end
    else print('Illegal section number.');
  end;

  procedure gfem;
  var i1,i2,ii:integer;
      c:char;
      s:astr;
      c1,c2,c3,c4:integer;
      bb:byte;
      bbb:boolean;

    procedure gfedi(i:integer);
    var j:integer;
    begin
      i:=gftit[i].arn;
      for j:=i+1 to numgentrys do begin
        seek(gfil,j); read(gfil,b);
        seek(gfil,j-1); write(gfil,b);
      end;
      seek(gfil,0); read(gfil,b);
      dec(b.gdaten);
      seek(gfil,0); write(gfil,b);
      dec(numgentrys);
      getsec;
    end;

    procedure gfeii(i:integer; b:tfilerec);
    var j,k:integer;
    begin
      j:=gftit[i].arn;
      for k:=numgentrys downto j do begin
        seek(gfil,k); read(gfil,b1);
        seek(gfil,k+1); write(gfil,b1);
      end;

      seek(gfil,j); write(gfil,b);
      inc(numgentrys);
      seek(gfil,0); read(gfil,b);
      inc(b.gdaten);
      seek(gfil,0); write(gfil,b);
      getsec;

      seek(gfil,gfs[ii].arn); read(gfil,b);
      b.gdate:=date;
      b.gdaten:=daynum(date);
      seek(gfil,gfs[ii].arn); write(gfil,b);          {* update section date *}
      getsec;
    end;

    procedure gfepi;
    var i,j,k:integer;
    begin
      prt('Move which entry? (1-'+cstr(numgft)+') : '); inu(i);
      if (i>=1) and (i<=numgft) then begin
        prt('Move before which entry? (1-'+cstr(numgft+1)+') : '); inu(j);
        if (j>=1) and (j<=numgft+1) and (j<>i) and (j<>i+1) then begin
          seek(gfil,gftit[i].arn); read(gfil,b);
          gfeii(j,b);
          if j>i then gfedi(i) else gfedi(i+1);
        end;
      end;
    end;

  begin
    prt('Begin editing at which? (1-'+cstr(numgsecs)+') : '); inu(ii);
    c:=' ';
    if (ii>=1) and (ii<=numgsecs) then begin
      getsec;
      while (c<>'Q') and (not hangup) do begin
        repeat
          if c<>'?' then begin
            cls;
            print('Tfile section #'+cstr(ii)+' of '+cstr(numgsecs));
            nl;
            abort:=FALSE; next:=FALSE;
            printacr('1. Section title: '+#3#3+gfs[ii].tit,abort,next);
            printacr('2. Section ACS  : "'+gfs[ii].acs+'"',abort,next);
            printacr('3. Upload ACS   : "'+gfs[ii].ulacs+'"',abort,next);
            printacr('4. Section date : '+gfs[ii].gdate,abort,next);
            nl;
            gettit(gfs[ii].arn);
            lgft;
          end;
          nl;
          prt('Tfile edit (?=help) : ');
          onek(c,'Q?[]DFIJLMPT1234'^M);
          nl;
          case c of
            '?':begin
                  sprint(#3#1+'<CR>Redisplay screen');
                  lcmds(25,3,'[Back section',']Forward section');
                  lcmds(25,3,'Jump to section','First section in list');
                  lcmds(25,3,'Quit and save','Last section in list');
                  lcmds(25,3,'1Title change','2Section ACS change');
                  lcmds(25,3,'3Upload ACS change','4Date change');
                  lcmds(25,3,'Insert Tfile','Delete Tfile');
                  lcmds(25,3,'Position Tfile','Modify individual entries');
                  lcmds(25,3,'Type file to screen','');
                end;
            'M':begin
                  prt('Begin editing at which? (1-'+cstr(numgft)+') : '); ini(bb);
                  if (not badini) and (bb>=1) and (bb<=numgft) then begin
                    i2:=bb;
                    while (c<>'Q') and (not hangup) do begin
                      repeat
                        if (c<>'?') then begin
                          cls;
                          print('Tfile section #'+cstr(ii)+' of '+cstr(numgsecs));
                          print('Tfile #'+cstr(i2)+' of '+cstr(numgft));
                          nl;
                          with gftit[i2] do begin
                            sprint('1. Title       : '+#3#3+tit);
                            print('2. Filename    : '+filen);
                            print('3. ACS required: "'+acs+'"');
                            print('4. Date        : '+gdate);
                          end;
                        end;
                        nl;
                        prt('Edit menu: (?=help) : ');
                        onek(c,'Q?1234[]'^M);
                        nl;
                        case c of
                          '?':begin
                                sprint(' #:Modify item  <CR>Redisplay screen');
                                lcmds(14,3,'[Back Tfile',']Forward Tfile');
                                lcmds(14,3,'Quit and save','');
                              end;
                          '1'..'4':begin
                                seek(gfil,gftit[i2].arn); read(gfil,b);
                                case c of
                                  '1':begin
                                        prt('New title: ');
                                        inputwnwc(b.title,40,changed);
                                      end;
                                  '2':begin
                                        prt('New filename: ');
                                        input(b.filen,12);
                                      end;
                                  '3':begin
                                        prt('New ACS: ');
                                        inputwn(b.acs,20,bbb);
                                      end;
                                  '4':begin
                                        prt('New date: '); input(s,8);
                                        if (s<>'') and (daynum(s)>0) then begin
                                          b.gdate:=s;
                                          b.gdaten:=daynum(s);
                                        end;
                                      end;
                                end;
                                seek(gfil,gftit[i2].arn); write(gfil,b);
                                gettit(gfs[ii].arn);
                              end;
                          '[':if i2>1 then dec(i2) else c:=' ';
                          ']':if i2<numgft then inc(i2) else c:=' ';
                        end;
                      until (c in ['Q','[',']']) or (hangup);
                    end;
                  end;
                  c:=' ';
                end;
            'D':begin
                  gettit(gfs[ii].arn);
                  prt('Delete which? (1-'+cstr(numgft)+') : '); inu(c1);
                  if (c1>=1) and (c1<=(numgft)) then begin
                    nl;
                    sprompt(#3#3+gftit[c1].tit);
                    if pynq('   Delete it? ') then begin
                      seek(gfil,gftit[c1].arn); read(gfil,b);
                      assign(f1,systat.tfilepath+b.filen);
                      {$I-} reset(f1); {$I+}
                      if ioresult=0 then begin
                        close(f1);
                        if pynq('"'+b.filen+'" - Erase file too? ') then erase(f1);
                      end;

                      gfedi(c1);
                    end;
                  end;
                end;
            'I':begin
                  gettit(gfs[ii].arn);
                  prt('Insert before which (1-'+cstr(numgft+1)+') ['+
                      cstr(numgft+1)+'] : ');
                  input(s1,3);
                  if (s1='') then c1:=numgft+1 else c1:=value(s1);
                  if (c1>=1) and (c1<=numgft+1) then begin
                    nl;
                    prt('Enter filename : ');
                    mpl(12); input(b.filen,12);

                    ok:=TRUE;
                    if b.filen='' then ok:=FALSE;
                    if pos('.',b.filen)<>0 then begin
                      ok:=FALSE;
                      assign(f1,systat.tfilepath+b.filen);
                      {$I-} reset(f1); {$I+}

                      ok:=(ioresult=0);
                      if ok then close(f1);
                    end;

                    if ok then begin
                      nl;
                      b.gdate:=date;
                      b.gdaten:=daynum(date);
                      b.tbstat:=[];
                      b.permindx:=newindexno;
                      b.tbdepth:=0;
                      prt('Enter title : '); inputwc(b.title,40);
                      prt('Enter ACS : '); inputl(b.acs,20);

                      gfeii(c1,b);

                      systat.tfiledate:=date;
                      savesystat;
                    end else begin
                      print('Illegal filename.');
                      pausescr;
                    end;
                  end;
                end;
            'P':gfepi;
            'T':begin
                  gettit(gfs[ii].arn);
                  prt('Type which? (1-'+cstr(numgft)+') : '); inu(c1);
                  if (c1>=1) and (c1<=(numgft)) then begin
                    seek(gfil,gftit[c1].arn); read(gfil,b);
                    nofile:=FALSE;
                    if pos('.',b.filen)=0 then
                      printf(systat.tfilepath+b.filen)
                    else begin
                      assign(f1,systat.tfilepath+b.filen);
                      {$I-} reset(f1); {$I+}
                      nofile:=(ioresult<>0);
                      if (not nofile) then begin
                        close(f1);
                        pfl(systat.tfilepath+b.filen,abort,next,TRUE);
                      end;
                    end;
                    if nofile then print('File not found!');
                    pausescr;
                  end;
                end;
            '1'..'4':begin
                  seek(gfil,gfs[ii].arn); read(gfil,b);
                  case c of
                    '1':begin
                          prt('New title: ');
                          inputwnwc(b.title,40,changed);
                        end;
                    '2':begin
                          prt('New ACS: ');
                          inputwn(b.acs,20,bbb);
                        end;
                    '3':begin
                          prt('New Upload ACS: ');
                          inputwn(b.ulacs,20,bbb);
                        end;
                    '4':begin
                          prt('New date: '); mpl(8); input(s,8);
                          if (daynum(s)>0) then begin
                            b.gdate:=s;
                            b.gdaten:=daynum(s);
                          end;
                        end;
                  end;
                  seek(gfil,gfs[ii].arn); write(gfil,b);
                  getsec;
                end;
            '[':if (ii>1) then dec(ii) else c:=' ';
            ']':if (ii<numgsecs) then inc(ii) else c:=' ';
            'F':if (ii<>1) then ii:=1 else c:=' ';
            'J':begin
                  prt('Jump to entry: ');
                  input(s,3);
                  if ((value(s)>=1) and (value(s)<=numgsecs)) then
                    ii:=value(s) else c:=' ';
                end;
            'L':if (ii<>numgsecs) then ii:=numgsecs else c:=' ';
          end;
        until ((c in ['Q','[',']','F','J','L']) or (hangup));
      end;
    end;
  end;

begin
  assign(gfil,systat.gfilepath+'gfiles.dat');
  {$I-} reset(gfil); {$I+}
  if ioresult<>0 then begin
    rewrite(gfil);
    b.gdaten:=0;
    write(gfil,b);
  end;
  seek(gfil,0); read(gfil,b);
  numgentrys:=b.gdaten;

  repeat
    if (ch<>'?') then begin
      getsec;
      cls; done:=FALSE; abort:=FALSE; next:=FALSE;

(*
NNN:Section Name                            :SL :AR:Date
===:========================================:===:==:========

NNN:Section Name                            :Date    :ACS       :UL ACS
===:========================================:========:==========:==========
*)

      printacr(#3#0+'NNN'+sepr2+'Section Name                            '+
               sepr2+'Date    '+sepr2+'ACS       '+sepr2+'UL ACS',abort,next);
      printacr(#3#4+'===:========================================:========:==========:==========',abort,next);
      i:=1;
      while (i<=numgsecs) and (not abort) do
        with gfs[i] do begin
          s:=#3#0+mn(i,3)+' '+#3#3+mln(tit,40)+' '+#3#3+mln(gdate,8)+' '+
             #3#9+mln(acs,10)+' '+mln(ulacs,10);
          printacr(s,abort,next);
          inc(i);
        end;
    end;
    nl;
    prt('Text-file base editor (?=help) : ');
    onek(ch,'QDIM?'^M);
    case ch of
      '?':begin
            nl;
            print('<CR>Redisplay screen');
            lcmds(12,3,'Delete base','Insert base');
            lcmds(12,3,'Modify base','Quit');
          end;
      'Q':done:=TRUE;
      'D':gfed;
      'I':gfei;
      'M':gfem;
    end;
  until (done) or (hangup);
  close(gfil);
end;

end.