home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / mbug / mbug117.arc / FOLD2.PZS / FOLD2.PAS
Pascal/Delphi Source File  |  1979-12-31  |  8KB  |  296 lines
  1. PROGRAM FOLDFILE;
  2. {-----------------------------------------------------------------------------}
  3. {Programme to page a file like this:                                          }
  4. {                                                                             }
  5. { line 1 \     / line 1            line pageLength+1    line 2*pageLength+1   }
  6. { line 2 |     | line 2             ...                  ...                  }
  7. { line 3 |     | line 3             ...                  ...                  }
  8. { line 4 |     |  ...                                                         }
  9. {  ...   | --> |  ...                                                         }
  10. {        |     |                                                              }
  11. {        |     |                                                              }
  12. {  ...   |     |  ...               ...                                       }
  13. { line n /     \ line pageLength   line 2*pageLength                          }
  14. {                                                                             }
  15. {-----------------------------------------------------------------------------}
  16.  
  17. {$C+}
  18. {$R+}
  19.  
  20. CONST
  21.    defPageWidth = 79;   {default values}
  22.    defPageLength = 22;
  23.    defNumCols = 3;
  24.    defBorderChar = '-';
  25.    maxPageLength = 100; {as big as the memory limitations allow}
  26.    asciiFF = ^l;
  27.  
  28. TYPE
  29.    CPMname = string[14];
  30.    fcbname = string[11];
  31.    anyStr = string[255];
  32.    pageArray = array [1..maxPageLength] of anyStr;
  33.  
  34. VAR
  35.    pageWidth,pageLength : integer;
  36.    inFile,outFile : text;
  37.    inFname,outFname : CPMname;
  38.    lineNumber: integer;
  39.    lineNumbers : boolean;
  40.    currPage : pageArray;
  41.    bordered : boolean; {whether pages are separated by a line of chars}
  42.    borderChar : char; {appears between pages}
  43.    numCols : integer;
  44.    ffeeds : boolean;
  45. {$I linemsgs.inc}
  46. {$I cline.inc}
  47.  
  48. PROCEDURE showSummary;
  49. begin
  50. writeln ('*****************************************************************************');
  51. writeln;
  52. writeln ('command: FOLD - A programme that folds files into pages of columns.');
  53. writeln;
  54. writeln ('syntax:  FOLD in.ext out.ext  {-b{c}} {-n} {-cn} {-ln} {-wn} {-f}');
  55. writeln ('                               |       |    |     |     |     |');
  56. writeln (' page border char -------------+       |    |     |     |     |');
  57. writeln ('   turn on line numbering -------------+    |     |     |     |');
  58. writeln ('     n columns per page [3] ----------------+     |     |     |');
  59. writeln ('       n lines per page [22] ---------------------+     |     |');
  60. writeln ('         n chars per line (excess truncated) [80] ------+     |');
  61. writeln ('           form feed character after each page ---------------+');
  62. writeln;
  63. writeln ('example: FOLD PROG.PAS LST: -L60 -C2 -W132 -D+ -N -F');
  64. writeln;
  65. writeln ('Sam Lander 1988');
  66. writeln;
  67. writeln ('*****************************************************************************');
  68. end;
  69.  
  70. FUNCTION checkFile(filename : CPMname) : boolean;
  71. var
  72.    checkfl :file;
  73. begin
  74. assign(checkfl,filename);
  75.    {$I-}
  76.    reset(checkfl);
  77.    close(checkfl);
  78.    {$I+}
  79. checkFile:= (IOresult = 0);
  80. end;
  81.  
  82. FUNCTION defaultDrive: char;
  83. begin
  84. DefaultDrive:= chr(Mem[4] + 65);
  85. end;
  86.  
  87. PROCEDURE showSettings;
  88. begin
  89. writeln ('Folding file ',inFname,' to file ',outFname,' using the following settings:');
  90. writeln;
  91. writeln ('   ',numcols,' columns across the page.');
  92. writeln ('   Page width: ',pageWidth,' characters.');
  93. writeln ('   Page length: ',pageLength,' lines.');
  94. write('   Line numbering ');
  95. if linenumbers then
  96.    writeln('on.') else writeln('off.');
  97. if bordered then
  98.    writeln ('   Border character "',borderChar,'".')
  99. else
  100.    writeln ('   No border between pages.');
  101. if ffeeds then
  102.    writeln ('   Pages separated by form feed characters.');
  103. writeln;
  104. end;
  105.  
  106. PROCEDURE handleCommandFlags;
  107. {Looks at the command line and changes global variables}
  108. var
  109.    borderString: string[1];
  110.    i : integer;
  111. begin
  112. pageWidth := flagValue('w');
  113. if pageWidth = -1 then
  114.    pagewidth := defPageWidth;
  115. pageLength := flagValue ('l');
  116. if pageLength = -1 then
  117.    pageLength := defPageLength;
  118. numCols := flagValue ('c');
  119. if numCols = -1 then
  120.    numCols := defNumCols;
  121. if flagset('b') then
  122.    begin
  123.    bordered := true;
  124.    borderString := flagString ('b');
  125.    if borderString = '' then
  126.       borderChar := defBorderChar
  127.    else
  128.       borderChar := borderString[1];
  129.    end
  130. else
  131.    bordered := false;
  132. if flagSet ('n') then
  133.    linenumbers := true
  134. else
  135.    linenumbers := false;
  136. if flagSet ('f') then
  137.    ffeeds := true
  138. else
  139.   ffeeds := false;
  140. showSettings;
  141. end;
  142.  
  143. PROCEDURE init;
  144. begin
  145. lineNumber := 1;
  146. end;
  147.  
  148. PROCEDURE padOut (var s: anyStr; c: char; n: byte);
  149. {fills the string s out to n characters with c}
  150. var
  151.    i,oldlen : byte;
  152. begin
  153. oldlen := length(s);
  154. s[0] := chr(n);
  155. for i := oldlen+1 to n do
  156.    s[i] := c;
  157. end;
  158.  
  159. PROCEDURE getLine(len: integer; var s: anyStr);
  160. var
  161.    errStr:string[40];
  162. begin
  163. s:='';
  164. if not eof(infile) then
  165.    readln (inFile,s)
  166. else
  167.    padout (s,' ',len);
  168. if length(s) > len then
  169.    begin
  170.    errStr := s; {some is truncated off}
  171.    if length (errStr) = 40 then
  172.       warning('Truncated "'+errStr+'..."')
  173.    else
  174.       warning('Truncated "'+errStr+'"');
  175.    s[0] := chr(len);
  176.    end
  177. else
  178.    padout (s,' ',len);
  179. end;
  180.  
  181. PROCEDURE openFiles;
  182. var
  183.    present : boolean;
  184. begin
  185. inFname := stringArg(1);
  186. if inFname = '' then
  187.    begin
  188.    showSummary;
  189.    error ('no input file supplied');
  190.    end;
  191. present := checkFile (inFname);
  192. if not present then
  193.    begin
  194.    showsummary;
  195.    error('cannot find file '+inFname);
  196.    end;
  197. assign (inFile,inFname);
  198. reset (inFile);
  199. outFname := stringArg(2);
  200. if outFname = '' then
  201.    begin
  202.    showSummary;
  203.    error ('no output file supplied');
  204.    end;
  205. present := checkFile (outFname);
  206. if present then
  207.    waitForAck ('overwriting file '+outFname+'.');
  208. assign (outFile,outFname);
  209. rewrite (outFile);
  210. end;
  211.  
  212. PROCEDURE closeFiles;
  213. begin
  214. close (inFile);
  215. close(outFile);
  216. end;
  217.  
  218. PROCEDURE writePage(var p:pageArray); {var parameter to save time and space}
  219. var
  220.    pageLine : integer;
  221. begin
  222. pageLine := 1;
  223. for pageLine := 1 to pageLength do
  224.    begin
  225.    writeln (outFile,p[pageLine]);
  226.    if (outFname = 'lst:')or(outFname ='LST:') then
  227.    delay (1200); {I have a dodgy printer that needs a rest}
  228.    end;
  229. {now, we might want a form feed character}
  230. if ffeeds then
  231.    write(outFile,asciiFF);
  232. end;
  233.  
  234. PROCEDURE blankPage (var p: pagearray);
  235. var i: integer;
  236. begin
  237. for i := 1 to maxPageLength do
  238.    p[i] := '';
  239. end;
  240.  
  241. PROCEDURE getPage(var p: pageArray);
  242. var
  243.    temp : anyStr;
  244.    extras: byte;
  245.    prefix : string[5];
  246.    pageLine,colWidth,colNum : integer;
  247.    i,start : integer;
  248. begin
  249. blankpage(p);
  250. {first, fix up a page boundary}
  251. if bordered then
  252.    begin
  253.    p[1][0] := chr(pageWidth);
  254.    for i := 1 to pageWidth do
  255.       p[1][i] := borderChar;
  256.    start := 2;
  257.    end
  258. else
  259.    start := 1;
  260. if lineNumbers then
  261.    extras := numCols*6 + numcols  {digits and a space for a separator}
  262. else
  263.    extras := numcols; {for a separator}
  264. colwidth := trunc((pageWidth-extras) / numCols) - 1;
  265. for colNum := 1 to numCols do
  266.    for pageLine := start to pageLength do
  267.       begin
  268.       getline (colwidth,temp);
  269.       if lineNumbers then
  270.          begin
  271.          str(lineNumber:5,prefix);
  272.          temp := prefix+' '+temp;
  273.          end;
  274.       temp := temp + ' ';
  275.       p[pageline] := p[pageline] + temp;
  276.       lineNumber := lineNumber+1;
  277.       end;
  278. end;
  279. {---   Main bit   ------------------------------------------------------------}
  280. begin
  281. findargs;
  282. init;
  283. openFiles;
  284. handleCommandFlags;
  285. while not eof(infile) do
  286.    begin
  287.    getpage(currPage);
  288.    writePage(currPage);
  289.    end;
  290. closeFiles;
  291. end.
  292.  
  293.  
  294.  
  295.  
  296.