home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / PASCAL / PT03.ZIP / PRINTF.AR < prev    next >
Encoding:
Text File  |  1983-09-06  |  2.9 KB  |  137 lines
  1. -h- fprint.prt 800
  2. { fprint -- print file "name" from fin }
  3. procedure fprint (var name : string; fin : filedesc;
  4.       var sdate,stime  : string);
  5. const
  6.  MARGIN1 = 2;
  7.  MARGIN2 = 2;
  8.  BOTTOM = 64;
  9.  PAGELEN = 66;
  10. var
  11.  line : string;
  12.  lineno, pageno : integer;
  13. {$include:'skip.prt'}
  14. {$include:'head.prt'}
  15. begin
  16.  pageno := 1;
  17.  skip(MARGIN1);
  18.  head(name, pageno, sdate, stime);
  19.  skip(MARGIN2);
  20.  lineno := MARGIN1 + MARGIN2 + 1;
  21.  while (getline(line, fin, MAXSTR)) do begin
  22.   if (lineno = 0) then begin
  23.    skip(MARGIN1);
  24.    pageno := pageno + 1;
  25.    head(name, pageno, sdate, stime);
  26.    skip(MARGIN2);
  27.    lineno := MARGIN1 + MARGIN2 + 1
  28.   end;
  29.   putstr(line, STDOUT);
  30.   lineno := lineno + 1;
  31.   if (lineno >= BOTTOM) then begin
  32.    skip(PAGELEN-lineno);
  33.    lineno := 0
  34.   end
  35.  end;
  36.  if (lineno > 0) then
  37.   skip(PAGELEN-lineno)
  38. end;
  39.  
  40. -h- head.prt 572
  41. { head -- print top of page header }
  42. procedure head (var name : string; pageno : integer;
  43.       var sdate,stime: string);
  44. var
  45.  page : string; { set to '  Page ' }
  46. begin
  47.  { setstring(page, '  Page '); }
  48.   page[1] := ord(' ');
  49.   page[2] := ord(' ');
  50.   page[3] := ord('P');
  51.   page[4] := ord('a');
  52.   page[5] := ord('g');
  53.   page[6] := ord('e');
  54.   page[7] := ord(' ');
  55.   page[8] := ENDSTR;
  56.  putstr(name, STDOUT);
  57.  putstr(page, STDOUT);
  58.  putdec(pageno, 1);
  59.  putc(BLANK);
  60.  putc(BLANK);
  61.  putstr(sdate, STDOUT);
  62.  putc(BLANK);
  63.  putc(BLANK);
  64.  putstr(stime, STDOUT);
  65.  putc(NEWLINE)
  66. end;
  67.  
  68. -h- printf.prt 601
  69. { print (default input STDIN) -- print files with headings }
  70. procedure print;
  71. var
  72.  name : string;
  73.  null : string; { value '' }
  74.  i : integer;
  75.  fin : filedesc;
  76.  junk : boolean;
  77.  sdate : string;
  78.  stime : string;
  79. {$include:'fprint.prt'}
  80. begin
  81.  gdate(sdate);
  82.  gtime(stime);
  83.  stime[6] := ENDSTR;  { Don't want to print out seconds }
  84.  { setstring(null, ''); }
  85.   null[1] := ENDSTR;
  86.  if (nargs = 0) then
  87.   fprint(null, STDIN, sdate, stime)
  88.  else
  89.   for i := 1 to nargs do begin
  90.    junk := getarg(i, name, MAXSTR);
  91.    fin := mustopen(name, IOREAD);
  92.    fprint(name, fin, sdate, stime);
  93.    xclose(fin)
  94.   end
  95. end;
  96.  
  97. -h- skip.prt 128
  98. { skip -- output n blank lines }
  99. procedure skip (n : integer);
  100. var
  101.  i : integer;
  102. begin
  103.  for i := 1 to n do
  104.   putc(NEWLINE)
  105. end;
  106. -h- printf.pas 482
  107. {$debug-}
  108. program outer (input,output);
  109.  
  110. {$include:'globcons.inc'}
  111. {$include:'globtyps.inc'}
  112.  
  113. {$include:'initio.dcl'}
  114. {$include:'flush.dcl' }
  115.  
  116. {$include:'getarg.dcl'  }
  117. {$include:'nargs.dcl'   }
  118. {$include:'mustopen.dcl'}
  119. {$include:'close.dcl'   }
  120. {$include:'getline.dcl' }
  121. {$include:'putstr.dcl'  }
  122. {$include:'putdec.dcl'  }
  123. {$include:'putc.dcl'    }
  124. {$include:'gdate.dcl'   }
  125. {$include:'gtime.dcl'   }
  126.  
  127. {$include:'printf.prt'   }
  128. BEGIN
  129.   minitio; initio;
  130.   print;
  131.   flush(0);
  132. END.
  133. -h- printf.mak 129
  134. printf+initio+getfcb+error+getarg+nargs+mustopen+open+
  135. close+getline+getcf+getc+putstr+putdec+putc+flush+
  136. putcf+itoc+gtime+gdate
  137.