CP/M/CPM_CDROM.iso/lambda/soundpot/p/pamphlet.lbr/PAMPHLET.PZS/PAMPHLET.PAS

Pascal/Delphi Source File | 1993-10-25 | 13.1 KB | 402 lines

PROGRAM Pamphlet;

(*          By Steve Wilcox
            1215 South Osceola
            Denver, CO 80219
            303-936-0440

     This program will take a WordStar text file
   of three pages or more and rearrange the
   pages in the needed order for printing a
   folded pamphlet. The program keeps track of
   WordStar print control toggles to keep them
   associated with only the page-half in which
   they were begun.
     The three user-input variables are the name
   of the source file, the name of the destination
   file, and the print column number that will be
   the left margin for the right-hand page.
     The entire source file is read into memory in
   a double-tiered linked list. Each page break
   is pointed to with a PagePointer, which in turn
   points to the beginning of the second linked
   list (BufferStorage), the actual text in that
   page.
     The text is stored in a series of consecutive
   arbitrary 128 byte records (BufferStorage) rather
   than line-by-line records which would have to
   be defined much larger than typically needed.
   As a result, the data is packed in memory with
   very little wasted space.
     If the number of pages in the file is not
   divisible by four (needed since there are
   two text pages on each side of the printed
   page), "extra" logical pages are added to the
   end.
     In the WriteToDisk procedure, the PageLoop
   alternately picks the highest and lowest
   numbered pages (the Pagepointers). Then, again
   alternately, as the PageLoop continues, those
   pages are assigned to the left and right sides
   of the output page.
     The text is read out of memory by following
   the BufferStorage linked lists for the left and
   right pages until WordStar's page-end character
   (#138) is encountered. The pages in the final
   file are assembled by outputting corrresponding
   lines from the left, then right pages with spaces
   between them for the center fold. After the
   output page is done, PageLoop is incremented
   for the next pair of pages.
     Screen prompts in this program are set for
   a 52 column screen.                    *)


{$I-}
TYPE
  StoragePointer=^BufferStorage;  (* The text of each page is  *)
  BufferStorage=Record            (* stored in LineStore       *)
    LineStore:String[128];
    StorageLink:StoragePointer
  End;

  PagePointer=^PageInfo;          (* Points to the beginning   *)
  PageInfo=Record                 (* BufferStorage for each    *)
    Start:StoragePointer;         (* text page                 *)
    PageLink:PagePointer
  End;

  UtilityString=String[50];

VAR
  I,RightPageColumn,BuffCounter,PageCounter,Pages:Byte;
  Ch:Char;
  InputFileName,OutputFileName:String[14];
  InputFile,OutputFile:Text;
  DotHeader,TempString:UtilityString;
  LPageLine,RPageLine,BuffPrevious,BuffNext:StoragePointer;
  PageHead,PagePrevious,PageNext:PagePointer;

  PROCEDURE AbortProgram (Code:Byte);
  (* Dumps out of program due to fatal condition *)
  CONST
    AbortMessage:Array[1..5] of String[22]=
      ('Source File not found ',
       'Source File too big   ',
       'Destination disk full ',
       'Page blocks overlap   ',
       '3 or more pages needed');
  Begin
    GotoXY(1,22);ClrEOL;
    WriteLn(#7,'>> Program Aborted <<');
    WriteLn(AbortMessage[Code]);
    Halt
  End;


  PROCEDURE Configuration;
  (* Gets input information from user *)

    PROCEDURE DrawLine (Row:Byte);
    (* Draws a dashed line across the screen at the specified ROW *)
    Begin
      GotoXY(1,Row);
      For I:=1 to 52 do Write('-')
    End;

  Begin (* Configuration *)
    Repeat
      ClrScr;

      GotoXY(19,2);
      Write('P A M P H L E T');
      DrawLine(3);
      DrawLine(20);

      GotoXY(1,6);
      WriteLn('Enter the name of the SOURCE file');
      ReadLn(InputFileName);

      GotoXY(1,11);
      WriteLn('Enter the name of the DESTINATION file');
      ReadLn(OutputFileName);

      Repeat
        GotoXY(1,16);
        WriteLn('Enter the STARTING COLUMN for the right page half');
        ReadLn(RightPageColumn)
      Until IOResult=0;   (* Assures numeric input *)
      (* now adjust RightPageColumn for the number of spaces needed to the right page *)
      RightPageColumn:=RightPageColumn-2;

      GotoXY(1,22);
      Write('Are all entries correct? (Y/N) ');
      Read(Kbd,Ch);
    Until UpCase(Ch)='Y';

    Assign(InputFile,InputFileName);
    Assign(OutputFile,OutputFileName)
  End;

  PROCEDURE ReadToMemory;
  (* Reads source file into memory, keeping track
     of page breaks and setting pointers to page
     starts in memory *)
  Begin
    GotoXY(1,22);ClrEOL;
    Write('Processing...');
    Reset(InputFile);
    If IOResult>0 then AbortProgram(1); (* Fatal error -- no return *)

    New(PageHead);
    PageNext:=PageHead;
    PageCounter:=0;

    DotHeader:='';
    Read(InputFile,Ch);
    While Ch='.' do
    (* if its a period, its a dot command *)
    Begin
      ReadLn(InputFile,TempString);                (* Saves any initial *)
      DotHeader:=DotHeader+Ch+TempString+#13#10;   (* dot commands or   *)
      Read(InputFile,Ch)                           (* print controls    *)
    End;                                           (* in DotHeader.     *)
    (* Ch is now first character of text *)

    While not EOF(InputFile) do
    Begin
      New(BuffNext);                           (* Set up pointers to next *)
      PagePrevious:=PageNext;                  (* page and initial storage*)
      New(PageNext);                           (* location for each page  *)
      PagePrevious^.PageLink:=PageNext;
      PageNext^.Start:=BuffNext;
      BuffCounter:=0;
      PageCounter:=Succ(PageCounter);

      If PageCounter=1 then   (* Stores Ch from above Dot Command search *)
      Begin
        BuffNext^.LineStore[1]:=Ch;
        BuffCounter:=1
      End;

      Repeat
        BuffCounter:=Succ(BuffCounter);
        Read(InputFile,Ch);
        If Ch=#30 then Ch:=#45; (* change "soft hyphen to "hard" *)
        BuffNext^.LineStore[BuffCounter]:=Ch;
        If BuffCounter>127 then  (* Create new record in memory *)
        Begin
          If (MemAvail<128) and (MemAvail>=0) then
            AbortProgram(2); (* Fatal -- no return *)
          BuffPrevious:=BuffNext;
          New(BuffNext);
          BuffPrevious^.StorageLink:=BuffNext;
          BuffCounter:=0
        End;
      Until
        (EOF(InputFile))
      or
        (BuffNext^.LineStore[BuffCounter]=#138); (* WordStar's Page End *)
      BuffNext^.LineStore[BuffCounter]:=#138     (* Sets page break at EOF *)
    End;
    If PageCounter<3 then AbortProgram(5);
    If PageCounter Mod 4 >0 then
      Pages:=PageCounter+(4-PageCounter Mod 4)  (* Rounds up to even 4 pages *)
    Else
      Pages:=PageCounter;
    Close(InputFile)
  End;


  PROCEDURE WriteToDisk;
  (* Combines pages in proper order and writes to disk *)
  TYPE
    LeftRight=(L,R);

  VAR
    LBuffPosCount,RBuffPosCount,PageLoop:Byte;
    LPageDone,RPageDone,RealPage:Boolean;
    UnderScore,BoldFace,DoubleStrike:Array [LeftRight] of Boolean;

    PROCEDURE WriteDisk (InString:UtilityString);
    (* Writes to OutputFile and checks for disk write error *)
    Begin
      Write(OutputFile,InString);
      If IOResult>0 then AbortProgram(3)  (* Fatal Error -- no return *)
    End;

    PROCEDURE SetHighPage;
    (* Finds pointer to highest page not yet used *)
    Begin
      PageNext:=PageHead;
      RealPage:=(Pages-PageLoop<PageCounter); (* "extra" pages are not real *)
      For I:=1 to (Pages-PageLoop)+1 do
        If I<=PageCounter then         (* "extra" pages don't have pointers *)
          PageNext:=PageNext^.PageLink;
      If Odd(PageLoop) then            (* Checks for "extra" end page and  *)
        LPageDone:=not RealPage        (* assigns them to the proper side. *)
      Else
        RPageDone:=not RealPage;

      If RealPage then                 (* If PageLoop is odd then the high *)
      Begin                            (* page goes on the left. If it is  *)
        If Odd(PageLoop) then          (* even, it goes on the right.      *)
          LPageLine:=PageNext^.Start
        Else
          RPageLine:=PageNext^.Start
      End
    End;

    PROCEDURE SetLowPage;
    (* Find pointer to lowest page not yet used *)
    Begin
      PageNext:=PageHead;
      For I:=1 to PageLoop do
        PageNext:=PageNext^.PageLink;
      If Odd(PageLoop) then            (* If PageLoop is odd then the low  *)
        RPageLine:=PageNext^.Start     (* page goes on the right. If it is *)
      Else                             (* even, it goes on the left.       *)
        LPageline:=PageNext^.Start
    End;

    PROCEDURE MergePages;
    (* Assembles output page from the chosen right and left pages *)
    VAR
      LineCharCount:Byte;

      FUNCTION SevenBit(InChar:Char):Char;
      (* Strips high-bit off WordStar formatting *)
      Begin
        SevenBit:=Chr(Ord(InChar) and 127)
      End;

      FUNCTION LBuffChar:Char;
      (* Retrieves text character from left page *)
      Begin
        LBuffChar:=LPageLine^.LineStore[LBuffPosCount];
        LBuffPosCount:=Succ(LBuffPosCount);
        If LBuffPosCount>128 then  (* get next BufferStorage *)
        Begin
          LPageLine:=LPageLine^.StorageLink;
          LBuffPosCount:=1
        End
      End;

      FUNCTION RBuffChar:Char;
      (* Retrieves text character from right page *)
      Begin
        RBuffChar:=RPageLine^.LineStore[RBuffPosCount];
        RBuffPosCount:=Succ(RBuffPosCount);
        If RBuffPosCount>128 then  (* get next BufferStorage *)
        Begin
          RPageLine:=RPageLine^.StorageLink;
          RBuffPosCount:=1
        End
      End;

      PROCEDURE ControlCheck (Side:LeftRight);
      (* Toggles WordStar Print Controls *)
      Begin
        Case SevenBit(Ch) of
          #19:UnderScore[Side]:=not UnderScore[Side];
          #02:BoldFace[Side]:=not BoldFace[Side];
          #04:DoubleStrike[Side]:=not DoubleStrike[Side]
        End
      End;

      PROCEDURE SetControls (Side:LeftRight);
      (* Inserts WordStar print controls at the beginning and end of lines *)
      Begin
        If UnderScore[Side] then WriteDisk(#19);
        If BoldFace[Side] then WriteDisk(#2);
        If DoubleStrike[Side] then WriteDisk(#4)
      End;



    Begin (* MergePages *)
      LBuffPosCount:=1;
      RBuffPosCount:=1;
      Repeat
        SetControls(L);
        LineCharCount:=0;

        If LPageDone then (* No text so print a blank line *)
        Begin
          For I:=1 to RightPageColumn+1 do
            WriteDisk(' ');
          LineCharCount:=RightPageColumn
        End
        Else  (* print the text line *)
        Begin
          Repeat
            Ch:=LBuffChar;
            If SevenBit(Ch)<#32 then  (* might be a control toggle *)
              ControlCheck(L)
            Else
              LineCharCount:=Succ(LineCharCount); (* increases for ASCII only *)
            If SevenBit(Ch)<>#13 then WriteDisk(Ch);
          Until SevenBit(Ch)=#13;    (* end of the line *)
          SetControls(L);
          If LineCharCount>Succ(RightPageColumn) then
            AbortProgram(4);    (* Fatal Error -- no return *)
          For I:=LineCharCount to RightPageColumn do
            WriteDisk(' ');     (* Print spaces over to start of right page *)
          Ch:=LBuffChar;        (* Checks for End of Page marker *)
          LPageDone:=(Ch=#138)  (* No more on Left Page *)
        End;

        If RPageDone then   (* No text, so terminate line *)
          WriteDisk(#13#10)
        Else    (* Print the text line *)
        Begin
          SetControls(R);
          Repeat
            Ch:=RBuffChar;
            If SevenBit(Ch)<#32 then   (* might be a control character *)
              ControlCheck(R);
            If SevenBit(Ch)=#13 then SetControls(R);
            WriteDisk(Ch);
            RPageDone:=(Ch=#138); (* No more on Right Page *)
          Until SevenBit(Ch)=#10  (* End of the line *)
        End;
      Until LPageDone and RPageDone
    End;



  Begin (* WriteToDisk *)
    UnderScore[L]:=False;
    UnderScore[R]:=False;
    BoldFace[L]:=False;
    BoldFace[R]:=False;
    DoubleStrike[L]:=False;
    DoubleStrike[R]:=False;

    ReWrite(OutputFile);
    If IOResult>0 then AbortProgram(3); (* Fatal Error -- no return *)
    WriteDisk(DotHeader);  (* Begins output file with original dot commands *)

    For PageLoop:=1 to Pages div 2 do (* Sets up a pair of pages per loop *)
    Begin
      LPageDone:=False;
      RPagedone:=False;

      SetHighPage; (* Queues up the high numbered page *)
      SetLowPage;  (* Queues up the low numbered page  *)

      MergePages   (* Pages are in queue, now put them together *)

    End;
    Close(OutputFile);
    GotoXY(1,21);
    WriteLn('The finished file is on <',OutputFileName,'>. The pages');
    WriteLn('may now be printed front-back, front-back, in order.')
  End;


Begin (* PAMPHLET *)
  Configuration;
  ReadToMemory;
  WriteToDisk
End.