PROCEDURE generate_postscript_banner, genpb (
  input, i: record
      system_file_name: name 19..19
      password: string 1..31
      file: file = $optional
    recend = $required
  output, o: file = $required
  data_mode, dm: key
      (coded, c)
      (transparent, t)
    keyend = $required
  status)

" GENERATE_POSTSCRIPT_BANNER.
"
"   This procedure creates a file with a leading portrait banner page for
"   PostScript printers.  This banner page is actually a PostScript
"   program.  This procedure is NOT sensitve to the printer's
"   BANNER_HIGHLIGHT field; ROUTING_BANNER is always highlighted.  The
"   OUTPUT from this procedure is in the mode specidfied by DATA_MODE.

  VAR
    banner_file: file
    block: array 1..4 of string 1..8 = (' ', ' ', ' ', ' ')
    block_string: string 31
    ignore: status
    mode: key
    (coded, c)
    (transparent, t)
    keyend = data_mode
  VAREND

  IF data_mode = transparent THEN
    banner_file = $unique($local)
    WHEN exit DO
      delete_file banner_file status=ignore
    WHENEND
  ELSE
    banner_file = output
  IFEND

" Obtain time file was CREATED.

  created = $string($job_output(input.system_file_name, ost))
  created(11, 1) = ' ' " Blank out excess '.'

" Prefix all '(' and ')' characters in SITE_INFORMATION with a '\'

  site_info = $job_output(input.system_file_name, si)
  byte = 1
  FOR i = 1 TO $size(site_info) DO
    IF (site_info(byte) = '(') OR (site_info(byte) = ')') THEN
      site_info = site_info(1, byte-1)//'\'//site_info(byte, all)
      byte = byte + 1
    IFEND
    byte = byte + 1
  FOREND

" Prefix all '(' and ')' characters in COMMENT_BANNER with a '\'

  comment_banner = $job_output(input.system_file_name, cb)
  byte = 1
  FOR i = 1 TO $size(comment_banner) DO
    IF (comment_banner(byte) = '(') OR (comment_banner(byte) = ')') THEN
      comment_banner = comment_banner(1, byte-1)//'\'//comment_banner(byte, all)
      byte = byte + 1
    IFEND
    byte = byte + 1
  FOREND

" Process ROUTING_BANNER.  This is printed in up to 4 lines of 8 block letters.
" If the ROUTING_BANNER is 8 characters or less it is centered on the second
" line.

  block_size = $size($job_output(input.system_file_name, rb))
  IF (block_size <= 8) THEN
    pad = $substring('', 1, ((8-block_size)/2))
    block(2) = pad//$job_output(input.system_file_name, rb)
  ELSE
    block_string = $job_output(input.system_file_name, rb)
    block(1) = block_string(1, 8)
    block(2) = block_string(9, 8)
    block(3) = block_string(17, 8)
    block(4) = block_string(25, 7)
  IFEND

" Prefix all '(' and ')' characters in ROUTING_BANNER with a '\'

  FOR line = 1 TO 4 DO
    byte = 1
    FOR i = 1 TO $size(block(line)) DO
      IF (block(line)(byte) = '(') OR (block(line)(byte) = ')') THEN
        block(line) = block(line)(1, byte-1)//'\'//block(line)(byte, all)
        byte = byte + 1
      IFEND
      byte = byte + 1
    FOREND
  FOREND

COLLECT_TEXT banner_file sm='?'
/saveps save def
mark
/Courier findfont
12 scalefont
setfont
/savevm save def
200 700 moveto (?site_info?) show
200 676 moveto (PRINTED        = ?$date(iso)? ?$time(hms)?) show
200 664 moveto (CREATED        = ?created?) show
200 652 moveto (LOGIN FAMILY   = ?$job_output(input.system_file_name, lf)?) show
200 640 moveto (LOGIN USER     = ?$job_output(input.system_file_name, lu)?) show
200 628 moveto (USER JOB NAME  = ?$job_output(input.system_file_name, ujn)?) show
200 616 moveto (USER FILE NAME = ?$job_output(input.system_file_name, ufn)?) show
200 604 moveto (FILE SIZE      = ?$job_output(input.system_file_name, fs)? bytes) show
200 580 moveto (?comment_banner?) show
/Courier-Bold findfont
110 scalefont
0.6 setgray
setfont
40 450 moveto (?block(1)?) show
40 330 moveto (?block(2)?) show
40 210 moveto (?block(3)?) show
40  90 moveto (?block(4)?) show
/Courier-Bold findfont
160 scalefont
0.6 setgray
setfont
1 55 moveto (_______) show
showpage savevm restore cleartomark saveps restore
**

  IF data_mode = transparent THEN
    preprocess_postscript_file (input.system_file_name, ' ', banner_file) ..
          o=output dm=mode
  IFEND

  IF $field(input, file, initialized) THEN
    copy_file input.file output.$eoi
  ELSE
    copy_output_file input.system_file_name output.$eoi
  IFEND

PROCEND generate_postscript_banner
