home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / sigm / vols000 / vol081 / print.pas < prev    next >
Pascal/Delphi Source File  |  1984-04-29  |  7KB  |  292 lines
  1. { Print utility for I.D.S. 460G "Paper Tiger" }
  2.  
  3. { Author:  Peter Grogono }
  4.  
  5. program print;
  6.  
  7. const
  8.  
  9. {$ICONSTS.PAS }
  10.  
  11. printername = 'LST:';
  12. namelength = 14;                      { Length of file name buffer }
  13. bufferlength = 80;                    { Length of command buffer }
  14.  
  15. type
  16.  
  17. {$ITYPES.PAS }
  18.  
  19. nametype = array [1..namelength] of char;
  20.  
  21. var
  22.  
  23. filename : nametype;
  24. infile, LP : text;
  25.  
  26. firstline, lastline, linenumber,
  27. firstpage, lastpage, num, numcopies : integer;
  28. charsperinch, linespacing, tabgap, margin, pagelen : byte;
  29.  
  30. textproc, boldface, varspacing : boolean;
  31.  
  32. { Set default values of parameters }
  33.  
  34. procedure setdefaults;
  35. begin
  36. charsperinch := 12; firstline := 1; lastline := maxint; linespacing := 8;
  37. margin := 0; tabgap := 8; linenumbers := 0; pagelen := 60; boldface := false;
  38. varspacing := false; textproc := false; firstpage := 1; lastpage := maxint;
  39. numcopies := 1
  40. end; { setdefaults }
  41.  
  42. { Read file name and instructions from console }
  43.  
  44. procedure readinstructions;
  45.  
  46. var
  47.  
  48. buffer : array [1..bufferlength] of char;
  49. pos : byte;
  50. ch, option : char;
  51. parval : integer;
  52.  
  53. { Display instructions for use of program }
  54.  
  55. procedure instructions;
  56. begin
  57. writeln;
  58. write('Enter name of file to be printed,');
  59. writeln(' and options as required.');
  60. writeln('All input should be on one line.');
  61. writeln('Use an asterisk (*) to denote a large number.');
  62. writeln;
  63. writeln('Option  Default  Function');
  64. writeln;
  65. writeln('B         off    Boldface (double-width characters)');
  66. writeln('Cn        12     n = 10, 12, or 16 ch/inch');
  67. writeln('Em,n      0,*    Print from line m to line n');
  68. writeln('Gm        8      Set tab positions');
  69. writeln('Ln        8      n/48 inches between lines (n >= 6)');
  70. writeln('Mn        0      Left margin n columns wide');
  71. writeln('Nn        0      Line numbers with n digits');
  72. writeln('                 Default (n = 0): no line numbers');
  73. writeln('Pn        60     n lines per page');
  74. writeln('                 n = 0 suppresses page control');
  75. writeln('Tm,n      1,*    Print file generated by TP');
  76. writeln('                    from page m to page n');
  77. writeln('V         off    Proportional spacing');
  78. writeln('Xn        1      Make n copies');
  79. writeln;
  80. write('Enter instructions: ')
  81. end; { instructions }
  82.  
  83. { Get a character from the buffer }
  84.  
  85. procedure getchar;
  86. begin
  87. if ch <> chr(0) then
  88. begin pos := pos + 1; ch := buffer[pos] end
  89. end; { getchar }
  90.  
  91. { Get a number from the buffer. * -> Maxint }
  92.  
  93. procedure getnum (var numval : integer);
  94. begin
  95. if ch = '*' then
  96. begin numval := maxint; getchar end
  97. else
  98. begin numval := 0;
  99. while ch in ['0'..'9'] do
  100. begin numval := 10 * numval + ord(ch) - ord('0'); getchar end
  101. end
  102. end; { getnum }
  103.  
  104. begin { readinstructions }
  105. if eoln(0) then instructions;
  106. for pos := 1 to namelength do filename[pos] := blank;
  107. pos := 0;
  108. repeat read(ch) until ch <> blank;
  109. while ch <> blank do
  110. begin
  111. if pos < namelength then
  112. begin pos := pos + 1; filename[pos] := ch end;
  113. if eoln(0) then ch := blank else read(ch)
  114. end; { while }
  115. writeln('Reading from: ',filename);
  116.  
  117. { Move parameters into buffer }
  118.  
  119. pos := 0;
  120. while not eoln(0) do
  121. begin
  122. read(ch);
  123. if (ch <> blank) and (pos < bufferlength - 1) then
  124. begin
  125. pos := pos + 1;
  126. if ch in ['a'..'z']
  127. then buffer[pos] := chr(ord(ch)
  128. - ord('a') + ord('A'))
  129. else buffer[pos] := ch
  130. end
  131. end; { while }
  132. buffer[pos+1] := chr(0); { Terminate buffer with null }
  133.  
  134. { Scan buffer and interpret parameters }
  135.  
  136. pos := 0; getchar;
  137. repeat
  138. if ch in ['B','C','E','G','L','M','N','P','T','V','X']
  139. then
  140. begin
  141. option := ch; getchar; getnum(parval);
  142. case option of
  143. 'B' : boldface := true;
  144. 'C' : charsperinch := parval;
  145. 'E' : begin firstline := parval; getchar; getnum(lastline) end;
  146. 'G' : begin tabgap := parval; if tabgap = 0 then tabgap := 1 end;
  147. 'L' : linespacing := parval;
  148. 'M' : margin := parval;
  149. 'N' : linenumbers := parval;
  150. 'P' : pagelen := parval;
  151. 'T' : begin
  152. textproc := true;
  153. if parval >= 1 then
  154. begin
  155. firstpage := parval; getchar; getnum(parval);
  156. if parval >= 1 then lastpage := parval
  157. end
  158. end;
  159. 'V' : varspacing := true;
  160. 'X' : numcopies := parval;
  161. end { case }
  162. end
  163. else if ch <> chr(0) then getchar
  164. until ch = chr(0)
  165. end; { readinstructions }
  166.  
  167. { Print the file }
  168.  
  169. procedure printfile;
  170.  
  171. var
  172.  
  173. ch : char;
  174. line, textline, page : integer;
  175. col, pos, cnt : byte;
  176.  
  177. { Print page heading }
  178.  
  179. procedure printheading;
  180. begin
  181. if page > 0 then write(LP,chr(FF));
  182. page := page + 1;
  183. writeln(LP,filename,blank:40,'Page ',page:1);
  184. writeln(LP) 
  185. end; { printheading }
  186.  
  187. { Assembly language procedure used to copy TP files }
  188.  
  189. procedure copy (var infile : text;
  190. firstpage, lastpage : integer);
  191. external;
  192.  
  193. begin { printfile }
  194.  
  195. reset(filename,infile);
  196. if eof(infile) 
  197. then writeln('Input file empty.')
  198. else
  199. begin
  200.  
  201. { Set up LP }
  202.  
  203. rewrite(printername,LP);
  204.  
  205. { -------------------------- Printer dependent code ------------------------ }
  206.  
  207. case charsperinch of
  208. 10 : write(LP,chr(29));
  209. 12 : write(LP,chr(30));
  210. 16 : write(LP,chr(31))
  211. end; { case }
  212. case boldface of
  213. false : write(LP,chr(2));
  214. true  : write(LP,chr(1))
  215. end; { case }
  216. case varspacing of
  217. false : write(LP,chr(6));
  218. true  : write(LP,chr(16))
  219. end; { case }
  220. write(LP,chr(ESC),'B');
  221. write(LP,linespacing:1,chr(CR));
  222.  
  223. { ---------------------- End of printer dependent code --------------------- }
  224.  
  225. { Print the file }
  226.  
  227. for num := 1 to numcopies do
  228. if textproc then copy(infile,firstpage,lastpage) else
  229. begin
  230. line := 0; textline := 0; page := 0;
  231. writeln(LP,chr(FF));
  232. while not eof(infile) do
  233. begin
  234. textline := textline + 1;
  235. if (firstline <= textline) and (textline <= lastline)
  236. then
  237. begin
  238. if (pagelen > 0) and (line mod pagelen = 0)
  239. then printheading;
  240. if margin > 0 then write(LP,blank:margin);
  241. if linenumbers > 0 then write(LP,textline:linenumbers,blank);
  242. col := 1;
  243. while not eoln(infile) do
  244. begin
  245. read(infile,ch); 
  246. if ch = chr(TAB) then
  247. begin
  248. pos := 0;
  249. while pos < col do pos := pos + tabgap;
  250. for cnt := col to pos do
  251. begin
  252. write(LP,blank);
  253. col := col + 1
  254. end
  255. end
  256. else
  257. begin
  258. write(LP,ch);
  259. col := col + 1
  260. end
  261. end; { while }
  262. writeln(LP);
  263. line := line + 1
  264. end;
  265. readln(infile)
  266. end; { while }
  267. if num < numcopies then reset(filename,infile)
  268. end;
  269. if not textproc then
  270. begin
  271. write(page:1,' page');
  272. if page > 1 then write('s');
  273. writeln(', ',line:1,' lines printed.')
  274. end;
  275.  
  276. { ------------------------ Printer dependent code -------------------------- }
  277.  
  278. write(LP,chr(30),chr(2),chr(6),chr(ESC),'B8',chr(CR))
  279.  
  280. { ---------------------End of printer dependent code ----------------------- }
  281.  
  282. end
  283. end; { printfile }
  284.  
  285. { Main program }
  286.  
  287. begin { print }
  288. setdefaults;
  289. readinstructions;
  290. printfile
  291. end. { print }
  292.