Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/PCGDOOR.ZIP/READ41B.PAS

Pascal/Delphi Source File | 1987-04-21 | 13.7 KB | 396 lines

program reader_41b;
{for pcg201 and above
Herein resides the source code and various comments for READER.COM.
 READER 4.1 is used to view PC Gazette issue 2.01 and later online on BBS's.
 Code written by Robert Flores...PC Gazette, 155 East C St. Suite D,
                                    Upland, CA 91786}


type
    strtype    = string[15];
    filelabel  = string[12];
    str80      = string[80];
    yesansi    = boolean;

var
   i,j,x,y,px,px1,m1,
   max,lftside,
   rtside,p,
   plx,prx,
   curpage,
   lastpage,
   curpart,
   lastpart,
   maxparts,
   code,m2,
   i1,j1,i2,j2   : integer;
   t1            : array[1..500] of str80;
   Strng         : string[90];
   blank,
   dosline       : str80;
   file0,
   file3,
   file2         : text;
   pagetop,
   filename2     : strtype;
   filestrng,
   filename3     : str80;
   filename,
   pagefile      : array[1..6] of filelabel;
   scrollfile    : array[1..6,0..9] of filelabel;
   t2            : array[0..9,1..25] of string[80];
   hlp           : str80;
   numpage,
   maxpages      : array[1..6] of integer;
   secondpage,
   scrollpage    : array[1..6,0..9] of integer;
   scrolling,
   bothsides,
   ok            : boolean;
   fileline      : strtype;
   file1         : file;
   getchar       : char;




procedure loadfile(filevar:filelabel); {load scroll file for scrolling long articles}
  begin
     assign(file2,filevar);
     {$i-} reset(file2) {$I+};
     ok:=(ioresult=0);
     if ok then begin
     max:=1;
     if scrollpage[curpart,curpage]=1 then begin m2:=79;m1:=21 end
      else begin m2:=40;m1:=42 end;
     while not eof(file2) do begin
           readln(file2,strng);
           if length(strng)<m2 then strng:=strng+copy(blank,1,m2-length(strng));
           t1[max]:=strng;
           max:=max+1;
     end;
     end;
     close(file2);
     lftside:=1;rtside:=80;bothsides:=true;
     px:=secondpage[curpart,curpage];j:=0;plx:=1;prx:=1;
  end;

procedure getparm;        {get parameter for command line}
    var parms: str80 absolute cseg:$80;
        s:str80;
    begin
      s:='';
      while (length(parms)>0) and (parms[1]=' ') do delete(parms,1,1);
      while (length(parms)>0) and (parms[1]<>' ') do begin
            s:=s+parms[1];delete(parms,1,1);
      end;
      if length(s)>0 then filename3:=s else filename3:='COM1';
    end;

procedure writefile(var fileline:str80);
    var ry : integer;
    begin
         for ry:=1 to length(fileline) do write(file0,copy(fileline,ry,1));
         write(file0,#13#10);
    end;
procedure writefile1(var fileline:str80);
    var ry : integer;
    begin
         for ry:=1 to length(fileline) do write(file0,copy(fileline,ry,1));
    end;


procedure Fwrite(col,row : integer ;scrnline : str80);
  begin
       gotoxy(col,row);                    {left over from original program}
       write(scrnline);
  end;

procedure writepage;
  begin
       filestrng:=pagetop;
       writefile(filestrng);

       for i:=1 to 23 do begin
           writefile(t2[curpage,i]);

       end;
  end;



procedure scroller;       {scrolling routine}
  begin
   if bothsides=true then begin plx:=px;prx:=px end;
   filestrng:=pagetop;
   writefile(filestrng);
   filestrng:=t2[curpage,1];
   writefile(filestrng);
   writefile(t2[curpage,2]);
    for j:=px to px+20 do begin
        writefile1(t1[j]);
        if scrollpage[curpart,curpage]=2 then begin
             filestrng:=copy(t1[j+21],1,39);
             writefile1(filestrng);
        end;
        filestrng:=#13+#10;
        if j<px+20 then writefile1(filestrng);
    end;
  end;

procedure scrollup;

    begin
    if px<1 then px:=1;
    scroller;
    end;

procedure scrolldown;

    begin
    if px>max-m1 then px:=max-m1;
    if px<1 then px:=1;
    scroller;
    end;


procedure getpart;         {load a section of pagetops into memory}
   begin

        filestrng:='      Loading Section into memory. . . .     ';
        if lastpage<>-1 then filestrng:=pagetop+filestrng;
        writefile(filestrng);
        assign(file2,pagefile[curpart]);
        reset(file2);
        for i:=0 to maxpages[curpart] do begin
            for j:=1 to 25 do readln(file2,t2[i,j]);
        end;
        close(file2);
        curpage:=0;
        if lastpage<>-1 then lastpage:=0;
        if lastpage<>-1 then writepage;
   end;


procedure startoff;              {Find out what files will be used}
   var ifile : filelabel;
   begin

        curpage:=0;lastpage:=-1;curpart:=1;lastpart:=1;scrolling:=false;
        pagetop:=#27+'[2J'+#8+#8+#8+#8;
        assign(file2,'reader.opt');
        reset(file2);
        readln(file2,maxparts);                  {read number of sections}
        for i:=1 to maxparts do begin
            readln(file2,pagefile[i]);           {read name of section file}
            readln(file2,maxpages[i]);           {number of pages in section}
            for j:=0 to maxpages[i] do begin
               readln(file2,scrollpage[i,j]); {check to see if page can scroll}
               if scrollpage[i,j]>0 then begin    {0=no;1=full pg;2=dbl.column}
                   readln(file2,scrollfile[i,j]); {name of scroll file}
                   readln(file2,secondpage[i,j]); {line number for 1st scroll}
                end;
            end;
        end;
        close(file2);

   end;

Function getkey(var functionkey : boolean):char;     {check keypress & see if it is a function key}
   var ch : char;
   begin
     repeat
        read(FILE3,ch);
        ch:=upcase(ch);
     until ch in [#9,#10,#13,#32,'0'..'9','?','A'..'F','L','N','P','Q','S','T'];
     getkey:=ch;
   end;

procedure movepage;  {Determine what do do with keypress and execute}
   var
      inkey:char;
      functionkey:boolean;
   procedure pagemove(inkey:char; functionkey:boolean);

      begin
           case upcase(inkey) of
           '0'..'9': val(inkey,curpage,code);    {change page}
           'A'..'F': begin                       {change section}
                       case upcase(inkey) of
                       'A' : if curpart<>1 then curpart:=1;
                       'B' : if (maxparts>1) and (curpart<>2) then curpart:=2;
                       'C' : if (maxparts>2) and (curpart<>3) then curpart:=3;
                       'D' : if (maxparts>3) and (curpart<>4) then curpart:=4;
                       'E' : if (maxparts>4) and (curpart<>5) then curpart:=5;
                       'F' : if (maxparts>5) and (curpart<>6) then curpart:=6;
                       end;
                       if lastpart<>curpart then getpart;
                       lastpart:=curpart;
                     end;
           'P'     :begin                              {to previous scroll}
                         if scrolling then begin
                          if px>1 then begin
                            px:=px-m1;
                            scrollup;
                          end;
                         end
                         else curpage:=curpage-1;      {or previous page}
                    end;
   #32,#13,'N'     :begin                              {to next scroll}
                         if scrolling then begin

                          if px<max-m1 then begin
                            px:=px+m1;
                            scrolldown;
                          end;
                         end
                         else curpage:=curpage+1;      {or next page}
                         if lastpage=-1 then curpage:=0;
                    end;
           #9,'S'  :begin                              {start/end scroll}
                         if scrolling then begin
                            inkey:=#255;
                            scrolling :=false;
                            writepage;
                         end
                         else begin
                          if scrollpage[curpart,curpage]>0 then begin
                            scrolling:=true;
                            filestrng:=pagetop+'                                                            ';
                            writefile(filestrng);
                            filestrng:='   One moment while rest of page is loaded into memory...   ';
                            writefile(filestrng);
                            filestrng:='                                                            ';
                            loadfile(scrollfile[curpart,curpage]);
                            scroller;
                           end
                           else begin
                             filestrng:=#7;
                             writefile1(filestrng);
                           end;
                          end;
                    end;
           #10,'Q'  :begin                       {stop scroll/program}
                       if scrolling then begin
                          inkey:=#255;
                          scrolling:=false;
                          curpage:=curpage+1;
                          if curpage>maxpages[curpart] then curpage:=0;
                          lastpage:=curpage;
                          writepage;
                       end
                       else begin
                         clrscr;
                         filestrng:='Exiting PC Gazette door....';
                         writefile(filestrng);
                         close(file0);
                         close(file3);
                         halt;
                       end;
                    end;
           'T'    : begin                      {to 1st page or top of scroll}
                       if scrolling then begin
                        if px>1 then begin
                          px:=1;
                          scroller;
                        end;
                       end
                       else curpage:=0;
                    end;
           'L'    : begin           {to last page or last of scroll}
                       if scrolling then begin
                        if px<max-m1 then begin
                          px:=max-m1;
                          if px<1 then px:=1;
                          scroller;
                        end;
                       end
                       else curpage:=maxpages[curpart];
                     end;
           '?'    : begin                     {request help}
                         assign(file2,'reader.hlp');
                         reset(file2);
                         for i:=1 to 15 do begin
                             readln(file2,hlp);
                             if i=1 then hlp:=pagetop+hlp;
                             writefile(hlp);
                         end;
                         close(file2);
                    end;
           end;
      end;
      procedure increment;                  {change page}
         begin
              if curpage>maxpages[curpart] then curpage:=maxpages[curpart];
              if curpage<0 then curpage:=0;
              if curpage<>lastpage then begin
                  writepage;
               end;
              lastpage:=curpage;
         end;
   begin
        repeat
              inkey:=#255;
              read(file3,inkey);
              inkey:=upcase(inkey);
              if inkey in [#9,#10,#13,#32,'0'..'9','?','A'..'F','L','N','P','Q','S','T'] then begin
                 pagemove(inkey,functionkey);
                 increment;
              end;
        until upcase(inkey) in [#10,^C];
   end;

begin
     blank:='                                                                                ';
     clrscr;
     getparm;          {find out if COM1: or COM2: or CON: will be used}
     assign(file0,filename3);
     rewrite(file0);
     if (filename3='con') or (filename3='CON') then filename3:='kbd:';
     assign(file3,filename3);
     reset(file3);
filestrng:=' ';          {let everyone know what this is and who made it}
writefile(filestrng);
filestrng:='                Aaron A. Aardvark and the Platypus Patrol present';
writefile(filestrng);
filestrng:='═══════════════════════════════════════════════════════════════════════════════';
writefile(filestrng);
filestrng:='   ░░░░░▄░░░░░▄    ░░░░░▄░░░░░▄░░░░░▄░░░░░▄░░░░░▄░░░░░▄░░░░░▄';
writefile(filestrng);
filestrng:='   ░░░█░█░░░█▀▀    ░░░█▀▀░░░█░█ ▀░░░█░░░█▀▀ ░░░█▀ ░░░█▀░░░█▀▀        The';
writefile(filestrng);
filestrng:='   ░░░█░█░░░█      ░░░█░▄░░░█░█ ░░░█▀░░░░░▄ ░░░█  ░░░█ ░░░░░▄     Electronic';
writefile(filestrng);
filestrng:='   ░░░░░█░░░█      ░░░█░█░░░░░█░░░█▀ ░░░█▀▀ ░░░█  ░░░█ ░░░█▀▀      Journal';
writefile(filestrng);
filestrng:='   ░░░█▀▀░░░░░▄    ░░░░░█░░░█░█░░░░░▄░░░░░▄ ░░░█  ░░░█ ░░░░░▄';
writefile(filestrng);
filestrng:='    ▀▀▀   ▀▀▀▀▀     ▀▀▀▀▀ ▀▀▀ ▀ ▀▀▀▀▀ ▀▀▀▀▀  ▀▀▀   ▀▀▀  ▀▀▀▀▀';
writefile(filestrng);
filestrng:='═══════════════════════════════════════════════════════════════════════════════';
writefile(filestrng);
filestrng:=' ';
writefile(filestrng);
filestrng:='                            created by Robert Flores';
writefile(filestrng);
filestrng:=' ';    {modification credit could go here...but let me know first}
writefile(filestrng);
filestrng:='                         Copyright 1987  Robert Flores';
writefile(filestrng);
filestrng:='                          A User-supported Newsletter';
writefile(filestrng);
filestrng:=' ';
writefile(filestrng);
filestrng:='                              Reader version 4.1b';
writefile(filestrng);
startoff;
filestrng:=' ';
writefile(filestrng);
writefile(filestrng);
getpart;
filestrng:='                             Press Enter to begin.';
writefile(filestrng);
        getchar:=#255;
     movepage;
end.               {That's all, folks!! R.F}