PROGRAM Pamphlet; (* version 1.3 *)

(*          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.                    *)


(* 1/14/86  Fixed error in "soft" hyphen handling *)

(* 6/23/86  Fixed problem in handling files that
            don't end with a carriage return. The
            program now appends a CR/PageBreak
            sequence at the end of the file if
            it doesn't have one. The buffer code in
            ReadToMemory was moved to the new
            Store procedure to accommodate storing
            characters from different code
            locations. *)

(* 8/27/86  The above fix also unknowningly
            corrected a problem that occurred when
            the LineStore buffer filled exactly
            at a page break. The result was that
            a page of the source file was
            occasionally discarded.
              However, that realization brought to
            light a similar, though undoubtedly rare
            problem if a LineStore buffer is filled
            exactly at EOF. The check for a full
            buffer in the Store procedure now comes
            before the byte is stored. Originally
            the creation of a new buffer came after
            storage.
              Added provision in  ControlCheck to
            adjust LineCharCount for certain
            sub-printable ASCII characters that are
            printable in WordStar. Originally no
            character below ASCII 31 would be
            counted as a printing character, thus
            the column justification would be
            wrong if special characters were
            used.
              Modified how the initial dot commands
            are handled. They now are written
            directly to the output file as they
            are read rather than stored and written
            later. This accommodates much larger
            headers.
              Modified the AbortProgram procedure
            to close and erase the output file
            rather than leave it partially written.
             *)

{$I-}
CONST
  LF=#10;                         (* Line Feed Character *)
  CR=#13;                         (* Carriage Return character *)
  PageBreak=#138;                 (* WordStar's Page Break character *)

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;

  WriteString=String[02];         (* used for WriteDisk procedure *)

VAR
  I,RightPageColumn,BuffCounter,PageCounter,Pages:Byte;
  Ch:Char;
  InputFileName,OutputFileName:String[14];
  InputFile,OutputFile:Text;
  TempString:String[255];
  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]);
    Close(OutputFile);
    Erase(OutputFile);
    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(16,2);
      Write('P A M P H L E T   1.3');
      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) ');
      Repeat
        Read(Kbd,Ch)
      Until UpCase(Ch) in ['Y','N'];
    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 *)

    PROCEDURE Store (InChar:Char);
    (* stores character and allocates buffer space *)
    Begin
      BuffCounter:=Succ(BuffCounter);
      If BuffCounter>128 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:=1
      End;
      BuffNext^.LineStore[BuffCounter]:=InChar
    End;

  Begin (* ReadToMemory *)
    GotoXY(1,22);ClrEOL;
    Write('Processing...');
    Reset(InputFile);
    If IOResult>0 then AbortProgram(1); (* Fatal error -- no return *)
    ReWrite(OutputFile);
    If IOResult>0 then AbortProgram(3); (* Fatal Error -- no return *)

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

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

    While not EOF(InputFile) do
    Begin
      If (MemAvail<136) and (MemAvail>=0) then
        AbortProgram(2); (* Fatal -- no return *)
      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 *)
        Store(Ch);

      Repeat
        Read(InputFile,Ch);
        Store(Ch)
      Until (Ch=PageBreak) or (EOF(InputFile))
    End;

    If (Ch<>LF) and (Ch<>PageBreak) then (* EOF needs CR/PB *)
    Begin
      Store(CR);
      Store(PageBreak)
    End
    Else (* be sure that last character is PageBreak *)
      BuffNext^.LineStore[BuffCounter]:=PageBreak;

    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:WriteString);
    (* 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 and recognizes some as printable *)
      Begin
        Case SevenBit(Ch) of
          #19:UnderScore[Side]:=not UnderScore[Side];
          #02:BoldFace[Side]:=not BoldFace[Side];
          #04:DoubleStrike[Side]:=not DoubleStrike[Side];
        End;

        If SevenBit(Ch) in [#06,#07,#15] then
          (* Printables: Phantom Space, Phantom Rubout, Non-Break space *)
          LineCharCount:=Succ(LineCharCount);
        If SevenBit(Ch)=#08 then
          (* backspace, so decrement *)
          LineCharCount:=Pred(LineCharCount)
      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)<#31 then  (* might be a control toggle *)
              ControlCheck(L)
            Else
              LineCharCount:=Succ(LineCharCount); (* increases for ASCII only *)
            If SevenBit(Ch)<>CR then WriteDisk(Ch);
          Until SevenBit(Ch)=CR;    (* 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=PageBreak)  (* No more on Left Page *)
        End;

        If RPageDone then   (* No text, so terminate line *)
          WriteDisk(CR+LF)
        Else    (* Print the text line *)
        Begin
          SetControls(R);
          Repeat
            Ch:=RBuffChar;
            If SevenBit(Ch)<#31 then   (* might be a control character *)
              ControlCheck(R);
            If SevenBit(Ch)=CR then SetControls(R);
            WriteDisk(Ch);
            RPageDone:=(Ch=PageBreak); (* No more on Right Page *)
          Until SevenBit(Ch)=LF  (* 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;


    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.