home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / lambda / soundpot / f / fanfold.lbr / FANFOLD.PZS / FANFOLD.PAS
Encoding:
Pascal/Delphi Source File  |  1993-10-26  |  18.6 KB  |  608 lines

  1. PROGRAM FANFOLD;
  2.  
  3. CONST
  4. BELL = #$7; { RING THE BELL }
  5. ESC = ^[;   {ESCAPE CODE}
  6.  
  7. TYPE
  8. ANYSTRING = STRING[14];
  9.  
  10. VAR
  11. Source,Destination1,Destination2                    : TEXT;
  12.  
  13. SourceName,SourceName1,OddTxt,EvenTxt,PageStr       : ANYSTRING;
  14.  
  15. Pages1,PageNum,PageLength,NumtoRead,Size1,Cpi,
  16. MarginNum,Headlns,Footlns,LineLength,Spaces,Spaces1,
  17. Pitch,Lines,Sheets1,MaxLength,MaxLength1,I,Dot      : INTEGER;
  18.  
  19. Size,Pages,Sheets                                   : REAL;
  20.  
  21. PagePosAns,MarginAns,Ans,Ans1,Ans2,Drive            : CHAR;
  22.  
  23. FooterLine,SpaceString,Header,Replace               : STRING[136];
  24. Linest                                              : STRING[255];
  25. Place,Margin                                        : STRING[30];
  26. Buffer : ARRAY [1..99] OF STRING[136] ;{ Assume no more than 9 LPI and 136 CHARS.}
  27.  
  28. FUNCTION SetUpCase(SourceName:ANYSTRING): ANYSTRING;
  29. { Function to convert filename to uppercase}
  30. BEGIN
  31.     I :=1;
  32.     for I := 1 to Length(SourceName) do
  33.     SourceName[I] := upcase(SourceName[I]);
  34.     SetUpCase := SourceName
  35. END;  {SetUpCase}
  36.  
  37. PROCEDURE DefaultFormat;       {*** PRINTER OUTPUT PARAMETERS}
  38. BEGIN
  39. PageLength := 66;
  40. PagePosAns := 'C';
  41. Pagenum := 1; {Start with ODD page first}
  42. Place := ' with Page # in CORNER      ';
  43. LineLength := 80;
  44. Pitch := 8;
  45. Spaces:= 7;
  46. HeadLNS := 4;
  47. FootLNS := 4;
  48. Margin :='';
  49. END; {DEFAULTFORMAT}
  50.  
  51. PROCEDURE SendPrinterCode;     {*** SET PRINTER (GEMINI10X) TO PARARMETERS}
  52. BEGIN
  53. CASE LineLength OF
  54.   80   :begin
  55.        write(lst,(ESC+'A'+#$1)); {10 CPI}
  56.        end;
  57.   96  :begin
  58.       write(Lst,(ESC+'B'+#$2)); {12 CPI}
  59.       end;
  60.  136  :begin
  61.       writeln(Lst,(ESC+'B'+#$3)); {17 CPI}
  62.       end;
  63. end;
  64.  
  65. CASE (PageLength) of
  66.  66   :begin
  67.       write(Lst,(ESC+'2')); {6 LPI}
  68.       end;
  69.  88   :begin
  70.       write(Lst,(ESC+'0')); {8 LPI}
  71.       end;
  72.  99   :begin
  73.       write(Lst,(ESC+'A'+#$8)); {9 LPI}
  74.       end;
  75. end; {pagelength}
  76. END; {SendPrinterCode}
  77.  
  78. PROCEDURE Information;
  79. BEGIN
  80. clrscr;
  81. writeln('FANFOLD.COM   TurboPascal 3.0    [C] l985,       Ron Rock, Chicago,IL.');
  82. writeln('              Released for Nonprofit Public Domain Use, October,1985'^M^J);
  83. writeln('         FANFOLD permits printing a text file on both sides of fanfold paper.');
  84. writeln('         Two files will be created filename.ODD and filename.EVE; the source ');
  85. writeln('         file will not be altered.               Printout set for Gemini10X . ');
  86. writeln('           To further conserve paper,formfeeds will have no effect.   ');
  87.  
  88. writeln;
  89. END;  {Information}
  90.  
  91. PROCEDURE CheckTxt; { If Margin or text test misses give info. }
  92. BEGIN
  93.   IF (MaxLength > 136) THEN
  94.     BEGIN
  95.     writeln('CAUTION: Line(s) OVER  136 CHARS !',^M^J);
  96.     writeln(SourceName,' may not be standard ASCII TEXT FILE.  EXIT NOW [Y/N] ?');
  97.     Read(KBD,Ans1);
  98.     IF (upcase(Ans1) = 'Y') THEN  { Failed check -Abort now }
  99.        BEGIN
  100.        close(Source); { If non-standard, close Source and quit. }
  101.        writeln('EXITING');
  102.        HALT;
  103.        END ;
  104.     END;
  105. END;{CheckTxt}
  106.  
  107. PROCEDURE GetFileName;   {get the name of the file to prepare for output }
  108. LABEL
  109.     again; { Permit getting filename again if errors in entry. }
  110. BEGIN
  111.  again:
  112.  I := 1;
  113.  write('Source File Name: ');
  114.  Readln(SourceName);
  115.  SourceName := (Setupcase(SourceName)); { Make sure it is uppercase for clarity. }
  116.   assign(Source,SourceName);
  117.   {$I-}reset(Source){$I+};
  118.   IF not(IORESULT = 0) THEN                      { If file name is incorrect }
  119.      BEGIN                                     { permit additional entries }
  120.      writeln('FILE ',SourceName,' NOT FOUND ');  { until correct }
  121.      writeln('Usage  d:fn.ext ',^M^J);
  122.      writeln('Enter a ^C to quit OR:  ');        { or quit trying }
  123.      GOTO again;
  124.      END;
  125.   Readln(Source,Linest); { Preliminary file check for standard ASCII text}
  126.                          { By looking at a Line, will catch 90% of non-standard files}
  127.    MaxLength := Length(Linest);
  128.    CHECKTXT; {Check out the results}
  129.    reset(Source); { Pointer at beginning again}
  130.   END;
  131.  
  132. PROCEDURE ParseIt;  { Convert the SourceName into the output file names }
  133.      LABEL
  134.       AGAIN;
  135.      BEGIN
  136.      SourceName1 := SourceName;           { Name the output files. }
  137.       IF(Pos('.',SourceName1) = 0) THEN   { See if a '.' is present in SourceName1 }
  138.                                           { If not, then add '.' }
  139.         BEGIN
  140.         SourceName1 := SourceName1 + '.';
  141.         END;  {NO EXTENT}
  142.               { Now check for redirection of the output files to another Drive.}
  143.         BEGIN
  144.         AGAIN:
  145.         write(^M^J,'Write output to another Drive [Y/N] ?');
  146.         Read(kbd,Ans1);
  147.         IF upcase(Ans1) = 'Y' THEN
  148.           BEGIN
  149.           write(' Drive letter [ A,B,C, etc.] - ');
  150.           Read(Drive);
  151.           Drive := upcase(Drive);
  152.             BEGIN   { Now place the Drive letter in the SourceName1. }
  153.                               {Use Dot again after reset }
  154.  
  155.             IF ( Pos(':',SourceName1) = 0 )THEN          { If no ':' in SourceName1 add it. }
  156.               BEGIN
  157.               SourceName1 := (':'+ SourceName1);
  158.               END;
  159.              { Now ':' is in Position 1 or 2 }
  160.                BEGIN                     {Add the Drive letter to the file names}
  161.               { Now use Dot to find : in SourceName1.}
  162.                Dot := 0;
  163.                Dot := Pos(':',SourceName1);
  164.                SourceName1 := (Drive + (copy(SourceName1,Dot,14)));
  165.              {EvenTxt :=(Drive + (copy(SourceName1,Dot,14)));}
  166.               END;  { Add Letter }
  167.            END;  { Add  : }
  168.          END;  { Get New Drive }
  169.        END;  { Redirection Option }
  170.  
  171.        BEGIN { Now NEW Drive is present; add new extents. }
  172.        Dot := Pos('.',SourceName1);
  173.        OddTxt := COPY(SourceName1,1,Dot) + 'ODD';
  174.        EvenTxt := COPY(SourceName1,1,Dot) + 'EVE';
  175.        END;  {WITH EXTENT}
  176.  
  177.        BEGIN {Show the output file names}
  178.        write(^M^J'Output files are: ',OddTxt,' and ',EvenTxt);
  179.        write(' >  O.K [Y/N] ?');
  180.        Read(KBD,Ans1);
  181.        IF (upcase(Ans1) = 'N') then GOTO again;
  182.        END;
  183. END;  { ParseIt }
  184.  
  185. PROCEDURE SetFiles;
  186.  BEGIN         { NOW OPEN AND SET THE FILES }
  187.      ParseIt;
  188.      ASSIGN(Destination1, OddTxt);
  189.      ASSIGN(Destination2, EvenTxt);
  190.      REWRITE(Destination1);
  191.      REWRITE(Destination2);
  192.      ClrScr;
  193. END;  {SetFiles}
  194.  
  195. PROCEDURE CloseFiles;
  196. BEGIN
  197. CLOSE(Source);            {Close all }
  198. CLOSE(Destination1);      {  the     }
  199. CLOSE(Destination2);      { files.   }
  200. END;
  201.  
  202.  
  203. PROCEDURE SetMargin;
  204. BEGIN
  205. Margin := '';
  206. I := 0;
  207. I := Spaces;
  208. WHILE (I <> 0) DO
  209.  BEGIN
  210.  Margin  := (Margin + ' ');
  211.  I := (I - 1);
  212.  END;
  213. END;
  214.  
  215. PROCEDURE PrinterSetup;
  216. BEGIN
  217.   IF  MaxLength > 136  THEN
  218.    BEGIN
  219.    writeln('Printer CANNOT print LONGEST LINE CORRECTLY: start over !!!');
  220.    CloseFiles;
  221.    HALT;
  222.    END ELSE
  223.      BEGIN
  224.       IF MaxLength > 96 THEN
  225.         BEGIN
  226.         LineLength := 136;
  227.         PageLength := 99;
  228.         Spaces := 12;
  229.         END
  230.         ELSE
  231.         BEGIN
  232.         LineLength := 96;
  233.         PageLength := 88;
  234.         Spaces := 9;
  235.         END;
  236.     SetMargin;
  237.     END;
  238. END;
  239.  
  240. PROCEDURE NewMargin;
  241. LABEL AGAIN;
  242. BEGIN
  243. I := 0;
  244. Margin := '';
  245. write('SET 3/4 inch HOLE PUNCH Margin [Y/N] ? ');
  246. Read(KBD,MarginAns);
  247. IF (upcase(MarginAns) <> 'N') THEN
  248.  BEGIN
  249.  SetMargin;
  250.  END
  251.  ELSE
  252.  BEGIN
  253.  Spaces1 := Spaces;
  254.  write(^M);CLREOL;
  255.   BEGIN
  256.   AGAIN:
  257.   GoToXY(1,20);
  258.   write('SET HOLE PUNCH Margin TO : [ 0 TO 30 + <CR> ] > ');
  259.   Readln(Spaces);
  260.   END;
  261. MaxLength1 := ((MaxLength - Spaces1) + Spaces);
  262. IF MaxLength1  > 136 then
  263.   BEGIN
  264.   writeln(BELL,'Lines will exceed 136 Chars by ',(MaxLength1 - 136),' ; Re-enter margin');
  265.   goto again;
  266.   END
  267. else
  268. SetMargin;
  269. END;
  270. write(^M);clreol; {clear the line from screen }
  271. END;
  272.  
  273. PROCEDURE NewHeader;
  274. LABEL again;
  275. BEGIN
  276. Header := SourceName; {Put the old sourcename into Header for use}
  277. Replace :='';  {clear the string Replace}
  278. again:         {Come back here for more changes}
  279. GoToXY(1,20);CLREOL; {position the "write" and clear it }
  280. write('Current Header is:'); {show it on screen }
  281. writeln(^M^J^M^J,Margin+Header,^M^J);       {These are the 3 Header Lines.}
  282. write(' O.K. (Y/N)');
  283. Read(Kbd,Ans1);
  284. if (upcase(Ans1) <> 'Y') then  {if not O.K. then change it}
  285. begin
  286. GoToXY(1,20);
  287. write('(A)dd to or (R)eplace >');CLREOL; {permit adding to or replacing headerline}
  288. Read(Kbd,Ans1);
  289. CASE (upcase(Ans1))  OF
  290. 'A' : BEGIN
  291.       GoToXY(1,21);CLREOL;{position the "write" and clear it }
  292.       write(^M^J + Margin ,Header);
  293.       ReadLN(Replace);
  294.       Header := (Header+Replace);
  295.       goto again; {show the added to header}
  296.       END;
  297. 'R' : BEGIN
  298.       GoToXY(1,21);CLREOL;{position the "write" and clear it }
  299.       write(^M^J + Margin);
  300.       Readln(Replace);
  301.       Header := Replace;
  302.       goto again; {show the new header}
  303.       END;
  304.     END;
  305.   END;
  306. END; {NewHeader}
  307.  
  308. PROCEDURE PageNumPos;  {choose position of the page # }
  309. BEGIN
  310.   CASE (PagePosAns) OF
  311.       'C' : BEGIN
  312.             PLACE := ' with Page # in CORNERS         '; {write into format screen}
  313.             IF ODD(PageNum) THEN
  314.             writeln(Destination1,('Page '+PageStr):LineLength) {Right corner for ODD}
  315.             ELSE
  316.             writeln(Destination2,('Page '+PageStr)); {Left corner for EVE}
  317.             END;
  318.       'M' : BEGIN                                 {put in middle }
  319.             PLACE :=' with Page # in MIDDLE           ';
  320.             IF ODD(PageNum) THEN
  321.             writeln(Destination1,('Page '+PageStr):((LineLength div 2)+4))
  322.             ELSE
  323.             writeln(Destination2,('Page '+PageStr):((LineLength div 2)+4));
  324.             END;
  325.       'N' : BEGIN                                  {no Page Number }
  326.             PLACE := ' with NO Page Numbers          ';
  327.             IF ODD(PageNum) THEN
  328.             writeln(Destination1)
  329.             ELSE
  330.             writeln(Destination2);
  331.             END;
  332.   END;
  333. END; {PageNumPos}
  334.  
  335. PROCEDURE NewFooter;
  336. BEGIN
  337. CLREOL;
  338. write('Page # in lower (C)orner,(M)iddle or (N)one ? > ');
  339. ReadLN(PagePosAns);
  340. PagePosAns := upcase(PagePosAns);
  341. PageNumPos; {do the changes }
  342. END;
  343.  
  344. PROCEDURE SetPageLength;
  345. LABEL
  346. AGAIN;
  347.  BEGIN
  348.  AGAIN:
  349.  GoToXY(1,20); { position line at lower screen }
  350.  write('How many Lines per Page < 8 Lines are reserved > ? ');
  351.  Readln(PageLength);
  352.   IF not (PageLength in[ 66,88,99 ]) THEN   { Show the o.k. range Setting permitted. }
  353.     BEGIN
  354.     writeln('Page Length must be 66, 88 or 99 Lines. ');
  355.     GOTO again; { Try,try again. }
  356.     END;
  357.   Pages :=(Size / (PageLength - 8));  { Calculate the Number of  }
  358.   Pages1 :=round(Pages + 0.5);        { Pages and Sheets of paper}
  359.   Sheets1 := (round((Pages /2)+0.5)); { needed for printout.     }
  360.   GoToXY(1,21); { position line at lower screen }
  361.   write('That will give ',Pages1, ' Pages.');
  362.   write(' which will print on ',Sheets1,' Sheets;');
  363.   write(' O.K. [Y/N] ?'); {Permit change if desired. }
  364.   Read(Kbd,Ans1);
  365.   write(^M);CLREOL;
  366.   IF upcase(Ans1)<>'Y' THEN   { Is choice  o.k. or redo}
  367.     BEGIN
  368.     write(^M);CLREOL;  {clear last line on screen}
  369.     GOTO again; {if not O.K. start again }
  370.     END;
  371.   GoToXY(1,20);write(^M);CLREOL;
  372.   END;
  373.  
  374. PROCEDURE GetSize; { Get the file Size in Lines and Chars/Line of text in Source}
  375.  BEGIN
  376.  writeln(^M^J^M^J,'Counting in ',SourceName);
  377.  Lines:=0;
  378.  MaxLength := 1;
  379.   WHILE not eof(Source) DO { check the whole file }
  380.    BEGIN
  381.      Readln(Source,Linest); { Line by Line }
  382.      Lines := Lines + 1;
  383.      IF ((Length(Linest) + Spaces) > MaxLength ) THEN
  384.        BEGIN
  385.        MaxLength := (Length(Linest) + Spaces);
  386.        END;
  387.      END;  { Lines AND CHARS/Line }
  388. Size:=0;
  389. Size := Lines ;
  390. Size1 := trunc(Size); { Make Size1 an integer }
  391. write(^M^J,'File ',SourceName,' contains ',Size1,' Lines.');
  392. writeln(' The LONGEST of which is ',MaxLength,' chars.',^M^J);
  393. CHECKTXT; {does it still fit }
  394. IF MaxLength > LineLength THEN  { Pass along new size  }
  395.   BEGIN
  396.   write(^M);clreol;
  397.   PrinterSetup;{reset default to size found}
  398.   END;
  399. Reset(Source);
  400. END;  {GetSize}
  401.  
  402. PROCEDURE  ReadToBuffer; {Reading into a Buffer Set to the PageLength.}
  403. BEGIN
  404. I:=1;
  405. FOR I := 1 TO NumtoRead DO
  406.   BEGIN
  407.   ReadLN(Source,Buffer[I]);
  408.   IF (COPY(Buffer[I],1,1) = (^L)) THEN  Buffer[I] := ' '; { take out formfeeds}
  409.   END;                                                    { OR Pages will be off}
  410. END;   {ReadTOBuffer}
  411.  
  412. PROCEDURE FindLineLength;  {Find the longest printing Line}
  413. BEGIN
  414. IF (Length(Buffer[I])+Spaces) > MaxLength THEN
  415. MaxLength := (Length(Buffer[I])+Spaces);
  416. END;
  417.  
  418. PROCEDURE PageCopy;  { Do the actual copy operation. First .ODD then .EVE }
  419. BEGIN                { .ODD Pages FIRST}
  420. clreol;write(^M,'DOING Page ',PageNum); {Tell what's going on}
  421. STR(PageNum,PageStr); {Convert PageNum to string for footer use}
  422.     BEGIN  { Get the Number of actual Lines to Read per Page. }
  423.     NumtoRead:=(PageLength - 8);
  424.                { Calculate actual Number - less Header and Footer Lines. }
  425.     writeln(Destination1);      {These are the  4 .ODD  Header Lines.}
  426.     writeln(Destination1);
  427.     writeln(Destination1,Margin+Header);
  428.     writeln(Destination1);
  429.     ReadToBuffer; { Fill the Buffer with Lines of text from Source. }
  430.     I:=1;
  431.     FOR I := 1 TO NumtoRead DO { Write Lines to files }
  432.       BEGIN
  433.       writeln(Destination1,Margin,Buffer[I]);
  434.       END;
  435.     BEGIN { 4 Footer Lines}
  436.     writeln(Destination1);
  437.     PageNumPos;
  438.     writeln(Destination1);
  439.     writeln(Destination1);
  440.     END;
  441.     PageNum := (PageNum + 1);  {Increment Page# for next Page.}
  442.     END; {Odd page is finished}
  443.  
  444.     {Do the even Page write}
  445.     BEGIN { There will always be a final EVEN Page.  This permits}
  446.           { printing either file first with the same result. }
  447.     NumtoRead := (PageLength - 8);
  448.     write(^M,'DOING Page ', PageNum );
  449.     STR(PageNum,PageStr); {change to string}
  450.     writeln(Destination2);  { 4 Line Header here but no margin on even page }
  451.     writeln(Destination2);
  452.     writeln(Destination2,Header);
  453.     writeln(Destination2);
  454.     ReadToBuffer; {Another page }
  455.      I:= 1;
  456.       FOR I:= 1 TO NumtoRead DO
  457.         BEGIN
  458.         writeln(Destination2,Buffer[I]); {write it to .EVE }
  459.         END; {FOR}
  460.     BEGIN
  461.     writeln(Destination2);   {First line of even footer }
  462.     PageNumPos;              {Page number line     }
  463.     writeln(Destination2);
  464.     writeln(Destination2);   {Last line of even footer }
  465.     END;
  466.     PageNum := PageNum + 1;  {Increment for next pass }
  467.     END; {even pages}
  468. END;  {PageCopy}
  469.  
  470. PROCEDURE NewLineLength; {set the chars in a line }
  471. BEGIN
  472. write('ENTER [ 10,12, or 17 ] Chars per Inch >');
  473. Repeat Readln(Cpi) Until (Cpi in [10,12,17]);write(^M);Clreol;
  474. LineLength := (cpi * 8);
  475. END;
  476.  
  477. PROCEDURE ClearBottom; {Clear the lower screen }
  478. BEGIN
  479. I := 20; {Loop}
  480. For I := 20 to 24 do { just these }
  481.  begin
  482.  GoToXY(1,I);clreol;
  483.  end;
  484. end;
  485.  
  486. PROCEDURE FormatChange; {Change Output Parameters}
  487. LABEL AGAIN;
  488. BEGIN
  489. Header := SourceName;{Default header}
  490. AGAIN:
  491. GoToXY(1,9);
  492. writeln(^M^J'THE FORMAT FOR THE OUTPUT FILES IS AS FOLLOWS :');
  493. writeln(^M^J'1. Page Length Set TO ',PageLength,' LINES per PAGE [ ',
  494.        (PageLength DIV 11),' LPI ]: Giving ',
  495.        (Size1 div (pagelength-8)),' Pages ');
  496. writeln('2. A ',Headlns,' Line Header with " ',Header,' " at LINE 2          ');
  497. writeln('3. A ',Footlns,' Line Footer', Place); {"Place" fills in the selected position}
  498. writeln('4. ',LineLength,' CHARACTERS PER Line  [ ',(LineLength div Pitch),' CHARS PER INCH ]       ');
  499. writeln('5. A LEFT margin offset of ',Spaces,' chars on ODD Pages for HOLE PUNCHING       ');
  500. writeln;
  501. write('ENTER NUMBER OF ITEM YOU WISH TO CHANGE OR < 0 > IF ALL O.K  > ',Ans,^H); {show last entry}
  502. Repeat Read(kbd,Ans) until (Ans in['0'..'5']); {make sure valid entry }
  503. ClearBottom;
  504. GoToXY(1,20); {Lower screen}
  505. CASE Ans OF  { CHOICE }
  506.    '1' : BEGIN
  507.          SetPageLength;
  508.          CheckTxt;
  509.          GOTO Again;  {permit another entry}
  510.          END;
  511.    '2' : BEGIN
  512.          NewHeader;
  513.          {ClrScr;}
  514.          GOTO Again;
  515.          END;
  516.    '3' : BEGIN
  517.          GoToXY(1,20);
  518.          NewFooter;
  519.          GOTO Again;
  520.          END;
  521.    '4' : BEGIN
  522.          NewLineLength;
  523.          IF (MaxLength > LineLength ) THEN
  524.          BEGIN
  525.          WRITE(^M'CAUTION: LINE LENGTHS EXCEED MAXIMUM PRINTER SETTING, RESET LINELENGTH ');
  526.          ans := '4';
  527.          END;
  528.          GOTO AGAIN;
  529.          END;
  530.    '5' : BEGIN
  531.          NewMargin;
  532.          CheckTxt; {Fit O.K.?}
  533.          IF (MaxLength > LineLength ) THEN
  534.          BEGIN
  535.          WRITE(^M'CAUTION: LINE LENGTHS EXCEED CURRENT PRINTER SETTING, RESET MARGIN or LINELENGTH ');
  536.          ans := '5';
  537.          END;
  538.          GOTO AGAIN;
  539.          END;
  540.    '0' : BEGIN
  541.          END;
  542.    END;{CASE}
  543. END;{FormatChange}
  544.  
  545. PROCEDURE CheckSourceParm;
  546. BEGIN
  547. ClrScr;
  548. GetSize;  { Read the file and count the Lines & Lengths. }
  549. Reset(Source); { Set the pointer back to start of file. }
  550. write(^M^J' Press Any Key To Continue ',BELL);
  551. Repeat until KeyPressed ;
  552. write(^M);clreol; {clear last Line displayed }
  553. END;
  554.  
  555. PROCEDURE PrintOut;
  556. BEGIN
  557. writeln(BELL,^M^J^M^J^M^J^M^J^M^J,
  558.   'DONE!! Print ',OddTxt,' first;turn over at Page 1 and print ', EvenTxt,^M^J);
  559. CheckTxt; {check again; may be to long with margins finally used }
  560. IF Ans <> 'Y' THEN Sheets1 := (round((PageNum-1)/2)); { Get the # of Sheets if no Linecount. }
  561. writeln('*** Have > ',Sheets1,' Sheets of paper in your Printer. ***');
  562. write(^M^J'To PRINT NOW; turn Printer ON and LOAD PAPER  [ Y/N + <CR>] ? ');
  563. Ans1 := ' ';
  564. Readln(Ans1);
  565. IF (upcase(Ans1) <> 'Y') then {make default a NO }
  566. halt ELSE
  567. reset(Destination1);{return pointer to start of files}
  568. reset(Destination2);
  569. SendPrinterCode;
  570. While not EOF(Destination1) DO
  571. BEGIN
  572. Readln(Destination1,Linest);{write out the whole file to the printer}
  573. writeln(lst,Linest);
  574. END;
  575. CLRSCR;
  576. write(BELL,'TURN PAPER OVER ; START SIDE 2 [ Y + <CR>] ');
  577. Readln(Ans1);
  578. IF upcase(Ans1) = 'Y' then
  579.   BEGIN
  580.   WHILE not eof(Destination2) DO {now do the even side}
  581.    BEGIN
  582.    Readln(Destination2,Linest);
  583.    writeln(lst,Linest);
  584.    END;
  585.   END;
  586. END;
  587.  
  588. BEGIN; {MAIN PROGRAM}
  589.  
  590. DefaultFormat;  {set defaults}
  591. Information;    {Initial information.}
  592. GetFileName;    {Get the Source file }
  593. SetFiles;       {Set the output files.}
  594. ClrScr;
  595. PrinterSetup;
  596. CheckSourceParm;{Check Parms vs. Source}
  597. FormatChange; {display the calculated format and get changes }
  598.  
  599. WHILE not eof(Source) DO  {Write the files }
  600.   BEGIN
  601.   PageCOPY; { Do the copying to the odd and even Page files.}
  602.   END;
  603. CloseFiles; {finished with the files}
  604. ClrScr;
  605. PrintOut;
  606. CloseFiles;
  607. END.
  608.                           {  END OF FANFOLD.PAS }