home *** CD-ROM | disk | FTP | other *** search
- PROGRAM FANFOLD;
-
- CONST
- BELL = #$7; { RING THE BELL }
- ESC = ^[; {ESCAPE CODE}
-
- TYPE
- ANYSTRING = STRING[14];
-
- VAR
- Source,Destination1,Destination2 : TEXT;
-
- SourceName,SourceName1,OddTxt,EvenTxt,PageStr : ANYSTRING;
-
- Pages1,PageNum,PageLength,NumtoRead,Size1,Cpi,
- MarginNum,Headlns,Footlns,LineLength,Spaces,Spaces1,
- Pitch,Lines,Sheets1,MaxLength,MaxLength1,I,Dot : INTEGER;
-
- Size,Pages,Sheets : REAL;
-
- PagePosAns,MarginAns,Ans,Ans1,Ans2,Drive : CHAR;
-
- FooterLine,SpaceString,Header,Replace : STRING[136];
- Linest : STRING[255];
- Place,Margin : STRING[30];
- Buffer : ARRAY [1..99] OF STRING[136] ;{ Assume no more than 9 LPI and 136 CHARS.}
-
- FUNCTION SetUpCase(SourceName:ANYSTRING): ANYSTRING;
- { Function to convert filename to uppercase}
- BEGIN
- I :=1;
- for I := 1 to Length(SourceName) do
- SourceName[I] := upcase(SourceName[I]);
- SetUpCase := SourceName
- END; {SetUpCase}
-
- PROCEDURE DefaultFormat; {*** PRINTER OUTPUT PARAMETERS}
- BEGIN
- PageLength := 66;
- PagePosAns := 'C';
- Pagenum := 1; {Start with ODD page first}
- Place := ' with Page # in CORNER ';
- LineLength := 80;
- Pitch := 8;
- Spaces:= 7;
- HeadLNS := 4;
- FootLNS := 4;
- Margin :='';
- END; {DEFAULTFORMAT}
-
- PROCEDURE SendPrinterCode; {*** SET PRINTER (GEMINI10X) TO PARARMETERS}
- BEGIN
- CASE LineLength OF
- 80 :begin
- write(lst,(ESC+'A'+#$1)); {10 CPI}
- end;
- 96 :begin
- write(Lst,(ESC+'B'+#$2)); {12 CPI}
- end;
- 136 :begin
- writeln(Lst,(ESC+'B'+#$3)); {17 CPI}
- end;
- end;
-
- CASE (PageLength) of
- 66 :begin
- write(Lst,(ESC+'2')); {6 LPI}
- end;
- 88 :begin
- write(Lst,(ESC+'0')); {8 LPI}
- end;
- 99 :begin
- write(Lst,(ESC+'A'+#$8)); {9 LPI}
- end;
- end; {pagelength}
- END; {SendPrinterCode}
-
- PROCEDURE Information;
- BEGIN
- clrscr;
- writeln('FANFOLD.COM TurboPascal 3.0 [C] l985, Ron Rock, Chicago,IL.');
- writeln(' Released for Nonprofit Public Domain Use, October,1985'^M^J);
- writeln(' FANFOLD permits printing a text file on both sides of fanfold paper.');
- writeln(' Two files will be created filename.ODD and filename.EVE; the source ');
- writeln(' file will not be altered. Printout set for Gemini10X . ');
- writeln(' To further conserve paper,formfeeds will have no effect. ');
-
- writeln;
- END; {Information}
-
- PROCEDURE CheckTxt; { If Margin or text test misses give info. }
- BEGIN
- IF (MaxLength > 136) THEN
- BEGIN
- writeln('CAUTION: Line(s) OVER 136 CHARS !',^M^J);
- writeln(SourceName,' may not be standard ASCII TEXT FILE. EXIT NOW [Y/N] ?');
- Read(KBD,Ans1);
- IF (upcase(Ans1) = 'Y') THEN { Failed check -Abort now }
- BEGIN
- close(Source); { If non-standard, close Source and quit. }
- writeln('EXITING');
- HALT;
- END ;
- END;
- END;{CheckTxt}
-
- PROCEDURE GetFileName; {get the name of the file to prepare for output }
- LABEL
- again; { Permit getting filename again if errors in entry. }
- BEGIN
- again:
- I := 1;
- write('Source File Name: ');
- Readln(SourceName);
- SourceName := (Setupcase(SourceName)); { Make sure it is uppercase for clarity. }
- assign(Source,SourceName);
- {$I-}reset(Source){$I+};
- IF not(IORESULT = 0) THEN { If file name is incorrect }
- BEGIN { permit additional entries }
- writeln('FILE ',SourceName,' NOT FOUND '); { until correct }
- writeln('Usage d:fn.ext ',^M^J);
- writeln('Enter a ^C to quit OR: '); { or quit trying }
- GOTO again;
- END;
- Readln(Source,Linest); { Preliminary file check for standard ASCII text}
- { By looking at a Line, will catch 90% of non-standard files}
- MaxLength := Length(Linest);
- CHECKTXT; {Check out the results}
- reset(Source); { Pointer at beginning again}
- END;
-
- PROCEDURE ParseIt; { Convert the SourceName into the output file names }
- LABEL
- AGAIN;
- BEGIN
- SourceName1 := SourceName; { Name the output files. }
- IF(Pos('.',SourceName1) = 0) THEN { See if a '.' is present in SourceName1 }
- { If not, then add '.' }
- BEGIN
- SourceName1 := SourceName1 + '.';
- END; {NO EXTENT}
- { Now check for redirection of the output files to another Drive.}
- BEGIN
- AGAIN:
- write(^M^J,'Write output to another Drive [Y/N] ?');
- Read(kbd,Ans1);
- IF upcase(Ans1) = 'Y' THEN
- BEGIN
- write(' Drive letter [ A,B,C, etc.] - ');
- Read(Drive);
- Drive := upcase(Drive);
- BEGIN { Now place the Drive letter in the SourceName1. }
- {Use Dot again after reset }
-
- IF ( Pos(':',SourceName1) = 0 )THEN { If no ':' in SourceName1 add it. }
- BEGIN
- SourceName1 := (':'+ SourceName1);
- END;
- { Now ':' is in Position 1 or 2 }
- BEGIN {Add the Drive letter to the file names}
- { Now use Dot to find : in SourceName1.}
- Dot := 0;
- Dot := Pos(':',SourceName1);
- SourceName1 := (Drive + (copy(SourceName1,Dot,14)));
- {EvenTxt :=(Drive + (copy(SourceName1,Dot,14)));}
- END; { Add Letter }
- END; { Add : }
- END; { Get New Drive }
- END; { Redirection Option }
-
- BEGIN { Now NEW Drive is present; add new extents. }
- Dot := Pos('.',SourceName1);
- OddTxt := COPY(SourceName1,1,Dot) + 'ODD';
- EvenTxt := COPY(SourceName1,1,Dot) + 'EVE';
- END; {WITH EXTENT}
-
- BEGIN {Show the output file names}
- write(^M^J'Output files are: ',OddTxt,' and ',EvenTxt);
- write(' > O.K [Y/N] ?');
- Read(KBD,Ans1);
- IF (upcase(Ans1) = 'N') then GOTO again;
- END;
- END; { ParseIt }
-
- PROCEDURE SetFiles;
- BEGIN { NOW OPEN AND SET THE FILES }
- ParseIt;
- ASSIGN(Destination1, OddTxt);
- ASSIGN(Destination2, EvenTxt);
- REWRITE(Destination1);
- REWRITE(Destination2);
- ClrScr;
- END; {SetFiles}
-
- PROCEDURE CloseFiles;
- BEGIN
- CLOSE(Source); {Close all }
- CLOSE(Destination1); { the }
- CLOSE(Destination2); { files. }
- END;
-
-
- PROCEDURE SetMargin;
- BEGIN
- Margin := '';
- I := 0;
- I := Spaces;
- WHILE (I <> 0) DO
- BEGIN
- Margin := (Margin + ' ');
- I := (I - 1);
- END;
- END;
-
- PROCEDURE PrinterSetup;
- BEGIN
- IF MaxLength > 136 THEN
- BEGIN
- writeln('Printer CANNOT print LONGEST LINE CORRECTLY: start over !!!');
- CloseFiles;
- HALT;
- END ELSE
- BEGIN
- IF MaxLength > 96 THEN
- BEGIN
- LineLength := 136;
- PageLength := 99;
- Spaces := 12;
- END
- ELSE
- BEGIN
- LineLength := 96;
- PageLength := 88;
- Spaces := 9;
- END;
- SetMargin;
- END;
- END;
-
- PROCEDURE NewMargin;
- LABEL AGAIN;
- BEGIN
- I := 0;
- Margin := '';
- write('SET 3/4 inch HOLE PUNCH Margin [Y/N] ? ');
- Read(KBD,MarginAns);
- IF (upcase(MarginAns) <> 'N') THEN
- BEGIN
- SetMargin;
- END
- ELSE
- BEGIN
- Spaces1 := Spaces;
- write(^M);CLREOL;
- BEGIN
- AGAIN:
- GoToXY(1,20);
- write('SET HOLE PUNCH Margin TO : [ 0 TO 30 + <CR> ] > ');
- Readln(Spaces);
- END;
- MaxLength1 := ((MaxLength - Spaces1) + Spaces);
- IF MaxLength1 > 136 then
- BEGIN
- writeln(BELL,'Lines will exceed 136 Chars by ',(MaxLength1 - 136),' ; Re-enter margin');
- goto again;
- END
- else
- SetMargin;
- END;
- write(^M);clreol; {clear the line from screen }
- END;
-
- PROCEDURE NewHeader;
- LABEL again;
- BEGIN
- Header := SourceName; {Put the old sourcename into Header for use}
- Replace :=''; {clear the string Replace}
- again: {Come back here for more changes}
- GoToXY(1,20);CLREOL; {position the "write" and clear it }
- write('Current Header is:'); {show it on screen }
- writeln(^M^J^M^J,Margin+Header,^M^J); {These are the 3 Header Lines.}
- write(' O.K. (Y/N)');
- Read(Kbd,Ans1);
- if (upcase(Ans1) <> 'Y') then {if not O.K. then change it}
- begin
- GoToXY(1,20);
- write('(A)dd to or (R)eplace >');CLREOL; {permit adding to or replacing headerline}
- Read(Kbd,Ans1);
- CASE (upcase(Ans1)) OF
- 'A' : BEGIN
- GoToXY(1,21);CLREOL;{position the "write" and clear it }
- write(^M^J + Margin ,Header);
- ReadLN(Replace);
- Header := (Header+Replace);
- goto again; {show the added to header}
- END;
- 'R' : BEGIN
- GoToXY(1,21);CLREOL;{position the "write" and clear it }
- write(^M^J + Margin);
- Readln(Replace);
- Header := Replace;
- goto again; {show the new header}
- END;
- END;
- END;
- END; {NewHeader}
-
- PROCEDURE PageNumPos; {choose position of the page # }
- BEGIN
- CASE (PagePosAns) OF
- 'C' : BEGIN
- PLACE := ' with Page # in CORNERS '; {write into format screen}
- IF ODD(PageNum) THEN
- writeln(Destination1,('Page '+PageStr):LineLength) {Right corner for ODD}
- ELSE
- writeln(Destination2,('Page '+PageStr)); {Left corner for EVE}
- END;
- 'M' : BEGIN {put in middle }
- PLACE :=' with Page # in MIDDLE ';
- IF ODD(PageNum) THEN
- writeln(Destination1,('Page '+PageStr):((LineLength div 2)+4))
- ELSE
- writeln(Destination2,('Page '+PageStr):((LineLength div 2)+4));
- END;
- 'N' : BEGIN {no Page Number }
- PLACE := ' with NO Page Numbers ';
- IF ODD(PageNum) THEN
- writeln(Destination1)
- ELSE
- writeln(Destination2);
- END;
- END;
- END; {PageNumPos}
-
- PROCEDURE NewFooter;
- BEGIN
- CLREOL;
- write('Page # in lower (C)orner,(M)iddle or (N)one ? > ');
- ReadLN(PagePosAns);
- PagePosAns := upcase(PagePosAns);
- PageNumPos; {do the changes }
- END;
-
- PROCEDURE SetPageLength;
- LABEL
- AGAIN;
- BEGIN
- AGAIN:
- GoToXY(1,20); { position line at lower screen }
- write('How many Lines per Page < 8 Lines are reserved > ? ');
- Readln(PageLength);
- IF not (PageLength in[ 66,88,99 ]) THEN { Show the o.k. range Setting permitted. }
- BEGIN
- writeln('Page Length must be 66, 88 or 99 Lines. ');
- GOTO again; { Try,try again. }
- END;
- Pages :=(Size / (PageLength - 8)); { Calculate the Number of }
- Pages1 :=round(Pages + 0.5); { Pages and Sheets of paper}
- Sheets1 := (round((Pages /2)+0.5)); { needed for printout. }
- GoToXY(1,21); { position line at lower screen }
- write('That will give ',Pages1, ' Pages.');
- write(' which will print on ',Sheets1,' Sheets;');
- write(' O.K. [Y/N] ?'); {Permit change if desired. }
- Read(Kbd,Ans1);
- write(^M);CLREOL;
- IF upcase(Ans1)<>'Y' THEN { Is choice o.k. or redo}
- BEGIN
- write(^M);CLREOL; {clear last line on screen}
- GOTO again; {if not O.K. start again }
- END;
- GoToXY(1,20);write(^M);CLREOL;
- END;
-
- PROCEDURE GetSize; { Get the file Size in Lines and Chars/Line of text in Source}
- BEGIN
- writeln(^M^J^M^J,'Counting in ',SourceName);
- Lines:=0;
- MaxLength := 1;
- WHILE not eof(Source) DO { check the whole file }
- BEGIN
- Readln(Source,Linest); { Line by Line }
- Lines := Lines + 1;
- IF ((Length(Linest) + Spaces) > MaxLength ) THEN
- BEGIN
- MaxLength := (Length(Linest) + Spaces);
- END;
- END; { Lines AND CHARS/Line }
- Size:=0;
- Size := Lines ;
- Size1 := trunc(Size); { Make Size1 an integer }
- write(^M^J,'File ',SourceName,' contains ',Size1,' Lines.');
- writeln(' The LONGEST of which is ',MaxLength,' chars.',^M^J);
- CHECKTXT; {does it still fit }
- IF MaxLength > LineLength THEN { Pass along new size }
- BEGIN
- write(^M);clreol;
- PrinterSetup;{reset default to size found}
- END;
- Reset(Source);
- END; {GetSize}
-
- PROCEDURE ReadToBuffer; {Reading into a Buffer Set to the PageLength.}
- BEGIN
- I:=1;
- FOR I := 1 TO NumtoRead DO
- BEGIN
- ReadLN(Source,Buffer[I]);
- IF (COPY(Buffer[I],1,1) = (^L)) THEN Buffer[I] := ' '; { take out formfeeds}
- END; { OR Pages will be off}
- END; {ReadTOBuffer}
-
- PROCEDURE FindLineLength; {Find the longest printing Line}
- BEGIN
- IF (Length(Buffer[I])+Spaces) > MaxLength THEN
- MaxLength := (Length(Buffer[I])+Spaces);
- END;
-
- PROCEDURE PageCopy; { Do the actual copy operation. First .ODD then .EVE }
- BEGIN { .ODD Pages FIRST}
- clreol;write(^M,'DOING Page ',PageNum); {Tell what's going on}
- STR(PageNum,PageStr); {Convert PageNum to string for footer use}
- BEGIN { Get the Number of actual Lines to Read per Page. }
- NumtoRead:=(PageLength - 8);
- { Calculate actual Number - less Header and Footer Lines. }
- writeln(Destination1); {These are the 4 .ODD Header Lines.}
- writeln(Destination1);
- writeln(Destination1,Margin+Header);
- writeln(Destination1);
- ReadToBuffer; { Fill the Buffer with Lines of text from Source. }
- I:=1;
- FOR I := 1 TO NumtoRead DO { Write Lines to files }
- BEGIN
- writeln(Destination1,Margin,Buffer[I]);
- END;
- BEGIN { 4 Footer Lines}
- writeln(Destination1);
- PageNumPos;
- writeln(Destination1);
- writeln(Destination1);
- END;
- PageNum := (PageNum + 1); {Increment Page# for next Page.}
- END; {Odd page is finished}
-
- {Do the even Page write}
- BEGIN { There will always be a final EVEN Page. This permits}
- { printing either file first with the same result. }
- NumtoRead := (PageLength - 8);
- write(^M,'DOING Page ', PageNum );
- STR(PageNum,PageStr); {change to string}
- writeln(Destination2); { 4 Line Header here but no margin on even page }
- writeln(Destination2);
- writeln(Destination2,Header);
- writeln(Destination2);
- ReadToBuffer; {Another page }
- I:= 1;
- FOR I:= 1 TO NumtoRead DO
- BEGIN
- writeln(Destination2,Buffer[I]); {write it to .EVE }
- END; {FOR}
- BEGIN
- writeln(Destination2); {First line of even footer }
- PageNumPos; {Page number line }
- writeln(Destination2);
- writeln(Destination2); {Last line of even footer }
- END;
- PageNum := PageNum + 1; {Increment for next pass }
- END; {even pages}
- END; {PageCopy}
-
- PROCEDURE NewLineLength; {set the chars in a line }
- BEGIN
- write('ENTER [ 10,12, or 17 ] Chars per Inch >');
- Repeat Readln(Cpi) Until (Cpi in [10,12,17]);write(^M);Clreol;
- LineLength := (cpi * 8);
- END;
-
- PROCEDURE ClearBottom; {Clear the lower screen }
- BEGIN
- I := 20; {Loop}
- For I := 20 to 24 do { just these }
- begin
- GoToXY(1,I);clreol;
- end;
- end;
-
- PROCEDURE FormatChange; {Change Output Parameters}
- LABEL AGAIN;
- BEGIN
- Header := SourceName;{Default header}
- AGAIN:
- GoToXY(1,9);
- writeln(^M^J'THE FORMAT FOR THE OUTPUT FILES IS AS FOLLOWS :');
- writeln(^M^J'1. Page Length Set TO ',PageLength,' LINES per PAGE [ ',
- (PageLength DIV 11),' LPI ]: Giving ',
- (Size1 div (pagelength-8)),' Pages ');
- writeln('2. A ',Headlns,' Line Header with " ',Header,' " at LINE 2 ');
- writeln('3. A ',Footlns,' Line Footer', Place); {"Place" fills in the selected position}
- writeln('4. ',LineLength,' CHARACTERS PER Line [ ',(LineLength div Pitch),' CHARS PER INCH ] ');
- writeln('5. A LEFT margin offset of ',Spaces,' chars on ODD Pages for HOLE PUNCHING ');
- writeln;
- write('ENTER NUMBER OF ITEM YOU WISH TO CHANGE OR < 0 > IF ALL O.K > ',Ans,^H); {show last entry}
- Repeat Read(kbd,Ans) until (Ans in['0'..'5']); {make sure valid entry }
- ClearBottom;
- GoToXY(1,20); {Lower screen}
- CASE Ans OF { CHOICE }
- '1' : BEGIN
- SetPageLength;
- CheckTxt;
- GOTO Again; {permit another entry}
- END;
- '2' : BEGIN
- NewHeader;
- {ClrScr;}
- GOTO Again;
- END;
- '3' : BEGIN
- GoToXY(1,20);
- NewFooter;
- GOTO Again;
- END;
- '4' : BEGIN
- NewLineLength;
- IF (MaxLength > LineLength ) THEN
- BEGIN
- WRITE(^M'CAUTION: LINE LENGTHS EXCEED MAXIMUM PRINTER SETTING, RESET LINELENGTH ');
- ans := '4';
- END;
- GOTO AGAIN;
- END;
- '5' : BEGIN
- NewMargin;
- CheckTxt; {Fit O.K.?}
- IF (MaxLength > LineLength ) THEN
- BEGIN
- WRITE(^M'CAUTION: LINE LENGTHS EXCEED CURRENT PRINTER SETTING, RESET MARGIN or LINELENGTH ');
- ans := '5';
- END;
- GOTO AGAIN;
- END;
- '0' : BEGIN
- END;
- END;{CASE}
- END;{FormatChange}
-
- PROCEDURE CheckSourceParm;
- BEGIN
- ClrScr;
- GetSize; { Read the file and count the Lines & Lengths. }
- Reset(Source); { Set the pointer back to start of file. }
- write(^M^J' Press Any Key To Continue ',BELL);
- Repeat until KeyPressed ;
- write(^M);clreol; {clear last Line displayed }
- END;
-
- PROCEDURE PrintOut;
- BEGIN
- writeln(BELL,^M^J^M^J^M^J^M^J^M^J,
- 'DONE!! Print ',OddTxt,' first;turn over at Page 1 and print ', EvenTxt,^M^J);
- CheckTxt; {check again; may be to long with margins finally used }
- IF Ans <> 'Y' THEN Sheets1 := (round((PageNum-1)/2)); { Get the # of Sheets if no Linecount. }
- writeln('*** Have > ',Sheets1,' Sheets of paper in your Printer. ***');
- write(^M^J'To PRINT NOW; turn Printer ON and LOAD PAPER [ Y/N + <CR>] ? ');
- Ans1 := ' ';
- Readln(Ans1);
- IF (upcase(Ans1) <> 'Y') then {make default a NO }
- halt ELSE
- reset(Destination1);{return pointer to start of files}
- reset(Destination2);
- SendPrinterCode;
- While not EOF(Destination1) DO
- BEGIN
- Readln(Destination1,Linest);{write out the whole file to the printer}
- writeln(lst,Linest);
- END;
- CLRSCR;
- write(BELL,'TURN PAPER OVER ; START SIDE 2 [ Y + <CR>] ');
- Readln(Ans1);
- IF upcase(Ans1) = 'Y' then
- BEGIN
- WHILE not eof(Destination2) DO {now do the even side}
- BEGIN
- Readln(Destination2,Linest);
- writeln(lst,Linest);
- END;
- END;
- END;
-
- BEGIN; {MAIN PROGRAM}
-
- DefaultFormat; {set defaults}
- Information; {Initial information.}
- GetFileName; {Get the Source file }
- SetFiles; {Set the output files.}
- ClrScr;
- PrinterSetup;
- CheckSourceParm;{Check Parms vs. Source}
- FormatChange; {display the calculated format and get changes }
-
- WHILE not eof(Source) DO {Write the files }
- BEGIN
- PageCOPY; { Do the copying to the odd and even Page files.}
- END;
- CloseFiles; {finished with the files}
- ClrScr;
- PrintOut;
- CloseFiles;
- END.
- { END OF FANFOLD.PAS }