C**********************************************************************
C
C Tprint
C
C This program will read and print a file to a printer attatched
C to a terminal.
C
C Version 1.0           Eugene J Suchyta                24 Jun 86
C
C**********************************************************************
C
C                    Eugene J. Suchyta
C                    The Detroit Edison Company
C                    2000 Second Ave
C                    Detroit, MI  48226
C
C                    June 24, 1986
C
C**********************************************************************
C
C Version 1.0     -     Original version.
C
C**********************************************************************
C
C TPRINT
C
C   The TPRINT command will allow a user to output a file to a printer
C   connected to the user's terminal.  The command allows printing in 
C   either draft or letter quality, in either pica (10 cpi) or elite
C   (12 cpi).  The command also allows for specifying different sets of
C   printer parameters.
C
C   Format:
C
C     TPRINT file-spec[,...]
C
C Parameters
C
C  file-spec                       
C
C    Specifies one or more files to be printed.  If you  specify  two  or
C    more  files,  separate the file specifications with either commas or
C    plus signs.
C
C    Note that wildcards may not be used in the file specification.
C
C    If the file specification does not contain a file type, the TPRINT 
C    command assumes a default type of DAT. 
C
C Command_Qualifiers
C
C  /ALTERNATE
C
C   /ALTERNATE
C
C    Specifies that the alternate print font will be used to print the
C    file.  If not specified, the file will be printed in draft quality.
C
C  /ELITE
C
C   /ELITE
C
C    Specifies that Elite pitch (12 cpi) will be used to print the
C    file.  If not specified, the file will be printed in Pica pitch
C    (10 cpi).
C
C  /CONFIGURATION
C
C   /CONFIGURATION=(file_spec)
C
C    Specifies an alternate terminal printer configuration file. The file
C    should contain definitions for escape sequences used by the printer
C    attatched to the current terminal.  The default specification is
C    the defined to the logical name TPRINTPARMS.
C
C  /TERMINAL
C
C   /TERMINAL=(file_spec)
C
C    Specifies an alternate terminal configuration file. The file
C    should contain definitions for escape sequences used by the terminal
C    attatched to the current terminal.  The default specification is
C    the defined to the logical name TPRINTPARMS.
C
C**********************************************************************
C
C Make everything an integer.
      IMPLICIT INTEGER ( a - z )
C         
C Declare local variables.
      INTEGER*4
     *    status,              ! Returned status from function
     *    channel,             ! I/O channel assign to SYS$OUTPUT
     *    set(3),              ! Characteristics to set this device to
     *    reset(3),            ! Characteristics to reset this device to
     *    off_len,             ! Printer turn-off string len
     *    on_len,              ! Printer turn-on string len
     *    alt_stat,            ! Presence of Alternate in command line
     *    elite_stat,          ! Presence of Elite in command line
     *    command_len,         ! Length of command line
     *    foreign_len,         ! Length of foreign line
     *    conf_len,            ! Length of printer configuration file name
     *    term_len,            ! Length of terminal configuration file name
     *    init_len,            ! Length of printer initialization string
     *    end_len,             ! Length of printer ending string
     *    file_len,            ! Length of file to printed's name
     *    more_files           ! Status indicating more files to print
      CHARACTER*256
     *    printer_off,         ! Printer turn-off string
     *    printer_on,          ! Printer turn-on string
     *    command_line,        ! Command line
     *    foreign_line,        ! Foreign line
     *    conf_file,           ! Printer configuration file name
     *    term_file,           ! Terminal configuration file name
     *    init_str,            ! Printer initialization string
     *    file_name,           ! Name of file to be printed
     *    end_str              ! Printer ending string
C
C External definition parameters.
      INCLUDE '($CLIDEF)'
      INCLUDE '($LIBDEF)'
      INCLUDE '($SSDEF)'
      INCLUDE '($STRDEF)'
C
C External modules.
      EXTERNAL
     *    LIB$GET_INPUT,
     *    TPRINT_TABLE,
     *    CLI$_ABSENT
C
C Declare local constants.
      CHARACTER*(*)
     *    Image_name,          ! Name of this image
     *    Space                ! A space.
      PARAMETER (
     *    Image_name = 'TPRINT',
     *    Space = ' ' )
C
C Put the printer turn-off string in a common block for the CTRL-C error
C handler.
      COMMON
     *    /termblk/ off_len,printer_off
C
C Put the device reset characteristics in a common block for the CTRL-C
C error handler.
      COMMON 
     *    /qioblk/   reset
C
C Put the printer ending length and string into a common block for the
C CTRL-C error handler.
      COMMON
     *    /endblk/   end_len,end_str
C
C Get the characteristics of the device this is executing from.
      CALL BUILD_CHAR ( 'SYS$OUTPUT', channel, set, reset )
C
C Define the CTRL-C exit routine.
      CALL DEFINE_CTRL_C 
C
C Get the foreign command line used to activate this image.
      status = LIB$GET_FOREIGN ( foreign_line, , foreign_len )
      IF ( .NOT. status ) CALL LIB$SIGNAL ( %VAL ( status ) )
C
C If the length of the foreign command line is zero, initialize the
C command line to the name of the image.
      IF ( foreign_len .EQ. 0 ) THEN
          status = STR$CONCAT ( command_line, Image_name )
          IF ( .NOT. status ) CALL LIB$SIGNAL ( %VAL ( status ) )
          command_len = LEN ( Image_name )
C
C Otherwise, build the command line by concatenating the image name,
C a space, and the foreign line.
      ELSE
          status = STR$CONCAT ( command_line, Image_name, Space,
     *      foreign_line(1:foreign_len))
          IF ( .NOT. status ) CALL LIB$SIGNAL ( %VAL ( status ) )
          command_len = LEN ( Image_name ) + LEN ( Space ) + foreign_len
      END IF
C
C Parse the command line.
      status = CLI$DCL_PARSE ( command_line, TPRINT_TABLE,
     *  LIB$GET_INPUT, LIB$GET_INPUT, '_$' )
      IF ( .NOT. status ) CALL LIB$SIGNAL ( %VAL ( status ) )
C
C Get the name of the file containing the printer configuration strings.
      status = CLI$GET_VALUE ( 'CONFIGURATION', conf_file, conf_len )
      IF ( .NOT. status ) CALL LIB$SIGNAL ( %VAL ( status ) )
C
C Get the name of the file containing the terminal configuration strings.
      status = CLI$GET_VALUE ( 'TERMINAL', term_file, term_len )
      IF ( .NOT. status ) CALL LIB$SIGNAL ( %VAL ( status ) )
C                                  
C Find out if the alternate print font is desired.
      alt_stat = CLI$PRESENT ( 'ALTERNATE' )
C
C Find out if elite pitch is desired.
      elite_stat = CLI$PRESENT ( 'ELITE' )
C
C Build the printer initalization strings.
      CALL GET_INIT_STRING ( conf_file, conf_len, alt_stat,
     *  elite_stat, init_str, init_len, end_str, end_len )
C
C Get the printer turn-on and -off strings.
      CALL GET_TERM_STRINGS ( term_file, term_len, printer_off,
     *  off_len, printer_on, on_len )
C
C Get the file to be locally printed.
      more_files = CLI$GET_VALUE ( 'FILE', file_name, file_len )
C
C Process files while there are more left.
      DO WHILE ( more_files .NE. %LOC(CLI$_ABSENT))
C
C    Print the files.
          CALL PRINT_FILE ( file_name, file_len, init_str, init_len,
     *      end_str, end_len, printer_off, off_len, printer_on,
     *      on_len, channel, set, reset )
C
C    Get the next file to be locally printed.
          more_files = CLI$GET_VALUE ( 'FILE', file_name, file_len )
      END DO
C
C Return to the user.
      CALL EXIT
      END
C**********************************************************************
C
C Subroutine GET_INIT_STRING
C
C This subroutine will parse the file containing the printer configuration
C strings and build and return the printer initialization string.
C
C**********************************************************************
C
      SUBROUTINE GET_INIT_STRING ( conf_file, conf_len, alt_stat,
     *  elite_stat, init_str, init_len, end_str, end_len ) 
C
C Make everything an integer.
      IMPLICIT INTEGER ( a - z )
C
C Declare passed variables.
      CHARACTER*(*)
     *    conf_file,           ! Printer configuration file name
     *    init_str,            ! Printer initialization string
     *    end_str              ! Printer ending string
      INTEGER*4
     *    alt_stat,            ! Presence of Alternate in command line
     *    elite_stat,          ! Presence of Elite in command line
     *    conf_len,            ! Length of printer configuration file name
     *    init_len,            ! Printer initialization string length
     *    end_len              ! Printer ending string length
C         
C Declare local variables.
      INTEGER*4
     *    status,              ! Returned status from function
     *    file_unit,           ! FORTRAN unit number for file
     *    byte_cnt,            ! Number of bytes in printer string.
     *    this_len,            ! Length of the text value of this byte
     *    this_val,            ! Integer value of this byte.
     *    string_len,          ! Length of the string just read
     *    val_len,             ! Length of the value's name
     *    comment_strt         ! Start of comment in string
      CHARACTER*5
     *    this_byte            ! Text decimal value of this byte
      CHARACTER*256
     *    pr_string,           ! Printer string.
     *    string,              ! String read from the configuration file
     *    v_string,            ! String with phony verb in front.
     *    val_name             ! Value's name.
C
C Declare printer control strings and lengths.             
      CHARACTER*5
     *    pr_ff,               ! Printer form feed.
     *    pr_reset,            ! Printer reset control sequence
     *    pr_qual,             ! Printer print quality control sequence
     *    pr_pitch             ! Printer print pitch control sequence
      INTEGER*4
     *    ff_len,              ! Printer form feed length
     *    reset_len,           ! Printer reset control sequence length
     *    qual_len,            ! Printer print quality control sequence length
     *    pitch_len            ! Printer print pitch control sequence length
C
C External definition parameters.
      INCLUDE '($OTSDEF)'
      INCLUDE '($STRDEF)'
C
C External modules.
      EXTERNAL
     *    CLI$_PRESENT,
     *    CLI$_ABSENT
C
C Declare local constants.
      CHARACTER*(*)
     *    Nothing,             ! Nothing
     *    Comment              ! Comment character
      PARAMETER (
     *    Nothing = CHAR(0),
     *    Comment = '!' )
C
C Format statements for reading.
 1000 FORMAT ( A )
C
C Format statements for writing.
 2000 FORMAT ( ' %TPRINT-W-PRICONFIL, Specified terminal printer ',
     *  'configuration file not found'/ )
C Initialize each final control sequence to null strings with a length
C of 1.
      pr_ff = Nothing
      ff_len = 1
C
      pr_reset = Nothing
      reset_len = 1
C
      pr_qual = Nothing
      qual_len = 1
C
      pr_pitch = Nothing
      pitch_len = 1
C
C Get a free unit number for accessing the printer configuration file.
      CALL LIB$GET_LUN ( file_unit )
C                               
C Open the file containing the strings.
      OPEN ( UNIT = file_unit, FILE = conf_file(1:conf_len),
     *  ORGANIZATION = 'SEQUENTIAL', RECORDTYPE = 'VARIABLE',
     *  FORM = 'FORMATTED', STATUS = 'OLD', ACCESS = 'SEQUENTIAL',
     *  ERR = 300 )
C
C Read the first line of the file.
  100 string = Nothing
      READ ( UNIT = file_unit, FMT = 1000, END = 200 ) string
C
C    If there is comment on the line, remove the comment part of the
C    line.
          comment_strt = STR$FIND_FIRST_IN_SET ( string, Comment )
          IF ( comment_strt .NE. 0 ) string = string(1:comment_strt-1)
C
C    Trim the string.
          status = STR$TRIM ( string, string, string_len )
          IF ( .NOT. status ) CALL LIB$SIGNAL ( %VAL ( status ) )
C
C    If it the string is null, go read the next line.
          IF ( string_len .EQ. 0 ) GOTO 100
C
C    Get the value name from the string and make sure it's uppercase.
          CALL REMOVE ( string, string_len, val_name, val_len )
          status = STR$UPCASE ( val_name, val_name )
          IF ( .NOT. status ) CALL LIB$SIGNAL ( %VAL ( status ) )
C
C    Try to get bytes while there is less than five and theres still room
C    in the string:
          byte_cnt = 0
          pr_string = Nothing
          DO WHILE ( ( string_len .GT. 0 ) .AND. ( byte_cnt .LT. 5 ) )
C
C        Get the next byte from the string.
              CALL REMOVE ( string, string_len, this_byte, this_len )
C
C        Get the value of this byte and put it in the printer string.
              byte_cnt = byte_cnt + 1
              status = OTS$CVT_TI_L ( this_byte(1:this_len), this_val )
              IF ( .NOT. status ) CALL LIB$SIGNAL ( %VAL ( status ) )
              pr_string(byte_cnt:byte_cnt) = CHAR ( this_val )
          END DO
C
C    Adjust the byte count in the event that there is a null string.
          IF ( byte_cnt .EQ. 0 ) byte_cnt = 1
C
C    Search through all the possible value names to find the right one.
C    When found, set the value string equal to the one just built.
          IF ( val_name(1:val_len) .EQ. 'FORM_FEED' ) THEN
              pr_ff = pr_string
              ff_len = byte_cnt
          ELSE IF ( val_name(1:val_len) .EQ. 'RESET' ) THEN
              pr_reset = pr_string
              reset_len = byte_cnt
          ELSE IF ( ( val_name(1:val_len) .EQ. 'DRAFT' ) .AND.
     *      ( alt_stat .EQ. %LOC(CLI$_ABSENT) ) ) THEN
              pr_qual = pr_string
              qual_len = byte_cnt
          ELSE IF ( ( val_name(1:val_len) .EQ. 'ALTERNATE' ) .AND.
     *      ( alt_stat .EQ. %LOC(CLI$_PRESENT) ) ) THEN
              pr_qual = pr_string
              qual_len = byte_cnt
          ELSE IF ( ( val_name(1:val_len) .EQ. 'PICA' ) .AND.
     *      ( elite_stat .EQ. %LOC(CLI$_ABSENT) ) ) THEN
              pr_pitch = pr_string
              pitch_len = byte_cnt
          ELSE IF ( ( val_name(1:val_len) .EQ. 'ELITE' ) .AND.
     *      ( elite_stat .EQ. %LOC(CLI$_PRESENT) ) ) THEN
              pr_pitch = pr_string
              pitch_len = byte_cnt
          END IF
C
C Read the next line of the file.
          GOTO 100
C
C Close the file and free up the unit number used for the file.
  200 CLOSE ( UNIT = file_unit )
      CALL LIB$FREE_LUN ( file_unit )
C
C Put together the printer initialization string consisting of
C reset, print quality and pitch.
      status = STR$CONCAT ( init_str, pr_reset(1:reset_len),
     *  pr_qual(1:qual_len), pr_pitch(1:pitch_len) )
      IF ( .NOT. status ) CALL LIB$SIGNAL ( %VAL ( status ) )
      status = STR$TRIM ( init_str, init_str, init_len )
      IF ( .NOT. status ) CALL LIB$SIGNAL ( %VAL ( status ) )
C
C Put together the printer ending string consisting of a form
C feed and reset.
      status = STR$CONCAT ( end_str, pr_ff(1:ff_len),
     *  pr_reset(1:reset_len) )
      IF ( .NOT. status ) CALL LIB$SIGNAL ( %VAL ( status ) )
      status = STR$TRIM ( end_str, end_str, end_len )
      IF ( .NOT. status ) CALL LIB$SIGNAL ( %VAL ( status ) )
C
C Return to the caller.
      RETURN
C
C An error occured while opening the file. Flag it and return.
  300 WRITE ( UNIT=*, FMT=2000 )
      CALL LIB$FREE_LUN ( file_unit )
      RETURN
C
      END
C**********************************************************************
C
C Subroutine GET_TERM_STRINGS
C
C This subroutine will parse the file containing the terminal configuration
C strings and get and return the terminal -on -off strings.
C
C**********************************************************************
C
      SUBROUTINE GET_TERM_STRINGS ( term_file, term_len, printer_off,
     *  off_len, printer_on, on_len )
C
C Make everything an integer.
      IMPLICIT INTEGER ( a - z )
C
C Declare passed variables.
      CHARACTER*(*)
     *    term_file,           ! Terminal configuration file name
     *    printer_off,         ! Printer turn-off string
     *    printer_on           ! Printer turn-on string
      INTEGER*4
     *    term_len,            ! Length of terminal configuration file name
     *    off_len,             ! Printer turn-off string len
     *    on_len               ! Printer turn-on string len
C         
C Declare local variables.
      INTEGER*4
     *    status,              ! Returned status from function
     *    file_unit,           ! FORTRAN unit number for file
     *    byte_cnt,            ! Number of bytes in printer string.
     *    this_len,            ! Length of the text value of this byte
     *    this_val,            ! Integer value of this byte.
     *    string_len,          ! Length of the string just read
     *    val_len,             ! Length of the value's name
     *    comment_strt         ! Start of comment in string
      CHARACTER*5
     *    this_byte            ! Text decimal value of this byte
      CHARACTER*256
     *    tr_string,           ! Terminal string.
     *    string,              ! String read from the configuration file
     *    v_string,            ! String with phony verb in front.
     *    val_name             ! Value's name.
C
C External definition parameters.
      INCLUDE '($OTSDEF)'
      INCLUDE '($STRDEF)'
C
C Declare local constants.
      CHARACTER*(*)
     *    Nothing,             ! Nothing
     *    Comment              ! Comment character
      PARAMETER (
     *    Nothing = CHAR(0),
     *    Comment = '!' )
C
C Format statements for reading.
 1000 FORMAT (A)
C
C Format statements for writing.
 2000 FORMAT ( ' %TPRINT-E-TERCONFIL, Specified terminal ',
     *  'configuration file not found'/ )
C Initialize each final control sequence to null strings with a length
C of 1.
      printer_off = Nothing
      off_len = 1
C
      printer_on = Nothing
      on_len = 1
C
C Get a free unit number for accessing the configuration file.
      CALL LIB$GET_LUN ( file_unit )
C                               
C Open the file containing the strings.
      OPEN ( UNIT = file_unit, FILE = term_file(1:term_len),
     *  ORGANIZATION = 'SEQUENTIAL', RECORDTYPE = 'VARIABLE',
     *  FORM = 'FORMATTED', STATUS = 'OLD', ACCESS = 'SEQUENTIAL',
     *  ERR = 300 )
C
C Read the first line of the file.
  100 string = Nothing
      READ ( UNIT = file_unit, FMT = 1000, END = 200 ) string
C
C    If there is comment on the line, remove the comment part of the
C    line.
          comment_strt = STR$FIND_FIRST_IN_SET ( string, Comment )
          IF ( comment_strt .NE. 0 ) string = string(1:comment_strt-1)
C
C    Trim the string.
          status = STR$TRIM ( string, string, string_len )
          IF ( .NOT. status ) CALL LIB$SIGNAL ( %VAL ( status ) )
C
C    If it the string is null, go read the next line.
          IF ( string_len .EQ. 0 ) GOTO 100
C
C    Get the value name from the string and make sure it's uppercase.
          CALL REMOVE ( string, string_len, val_name, val_len )
          status = STR$UPCASE ( val_name, val_name )
          IF ( .NOT. status ) CALL LIB$SIGNAL ( %VAL ( status ) )
C
C    Try to get bytes while there is less than ten and theres still room
C    in the string:
          byte_cnt = 0
          tr_string = Nothing
          DO WHILE ( ( string_len .GT. 0 ) .AND. ( byte_cnt .LT. 10 ) )
C
C        Get the next byte from the string.
              CALL REMOVE ( string, string_len, this_byte, this_len )
C
C        Get the value of this byte and put it in the printer string.
              byte_cnt = byte_cnt + 1
              status = OTS$CVT_TI_L ( this_byte(1:this_len), this_val )
              IF ( .NOT. status ) CALL LIB$SIGNAL ( %VAL ( status ) )
              tr_string(byte_cnt:byte_cnt) = CHAR ( this_val )
          END DO
C
C    Adjust the byte count in the event that there is a null string.
          IF ( byte_cnt .EQ. 0 ) byte_cnt = 1
C
C    Search through all the possible value names to find the right one.
C    When found, set the value string equal to the one just built.
          IF ( val_name(1:val_len) .EQ. 'PRINTER_OFF' ) THEN
              printer_off = tr_string
              off_len = byte_cnt
          ELSE IF ( val_name(1:val_len) .EQ. 'PRINTER_ON' ) THEN
              printer_on = tr_string
              on_len = byte_cnt
          END IF
C
C Read the next line of the file.
          GOTO 100
C
C Close the file and free up the unit number used for the file.
  200 CLOSE ( UNIT = file_unit )
      CALL LIB$FREE_LUN ( file_unit )
C
C Return to the caller.
      RETURN
C
C An error occured while opening the file. Flag it and return.
  300 WRITE ( UNIT=*, FMT=2000 )
      CALL LIB$FREE_LUN ( file_unit )
      RETURN
C
      END
C**********************************************************************
C
C Subroutine REMOVE
C
C This subroutine will remove a the next substring from a string.
C
C**********************************************************************
C
      SUBROUTINE REMOVE ( string, string_len, substring,
     *  substring_len )
C
C Make everything an integer.
      IMPLICIT INTEGER ( a - z )
C
C Declare passed variables.
      CHARACTER*(*)
     *    string,              ! String to be extracted
     *    substring            ! Substring removed from the string
      INTEGER*4
     *    string_len,          ! String length
     *    substring_len        ! Substring length
C         
C Declare local variables.
      INTEGER*4
     *    start,               ! Start of substring in string
     *    end,                 ! End of substring in string
     *    length               ! Length of substring in string
C
C Declare local constants.
      CHARACTER*(*)
     *    Nothing,             ! Nothing
     *    Split_chars          ! Characters indicating a split
      PARAMETER (
     *    Nothing = CHAR(0),
     *    Split_chars = CHAR(9)//' =,' )
C
C Find the start of the substring and the alleged length of the substring
C in the string.
      substring = Nothing
      start = STR$FIND_FIRST_NOT_IN_SET ( string(1:string_len),
     *  split_chars )
      length = STR$FIND_FIRST_IN_SET ( string(start:string_len),
     *  split_chars )
C
C If the alleged length of the substring is 0, this is the last substring
C in the string.
      IF ( length .EQ. 0 ) THEN
          end = string_len
          substring = string(start:end)
          substring_len = end - start + 1
          string = Nothing
          string_len = 0
C
C However, if the alleged length of the substring is not 0, there are still
C substrings left in the string.
      ELSE
          end = start + length - 2
          substring = string(start:end)
          substring_len = length - 1
          string = string(end+1:string_len)
          string_len = string_len - end
      END IF
C
C Return to user.
      RETURN
      END
C**********************************************************************
C
C Subroutine PRINT_FILE
C
C This subroutine will parse the command line to get the files to be
C printed, and will print them out.
C
C**********************************************************************
C
      SUBROUTINE PRINT_FILE ( file_name, file_len, init_str,
     *  init_len, end_str, end_len, printer_off, off_len,
     *  printer_on, on_len, channel, set, reset )
C
C Make everything an integer.
      IMPLICIT INTEGER ( a - z )
C
C Declare passed variables.
      CHARACTER*(*)
     *    file_name,           ! Name of file to be printed
     *    init_str,            ! Printer initialization string
     *    end_str,             ! Printer ending string
     *    printer_off,         ! Printer turn-off string
     *    printer_on           ! Printer turn-on string
      INTEGER*4
     *    file_len,            ! Length of the file's name
     *    init_len,            ! Printer initialization string length
     *    end_len,             ! Printer ending string length
     *    off_len,             ! Printer turn-off string len
     *    on_len,              ! Printer turn-on string len
     *    channel,             ! I/O channel for this device.
     *    set(*),              ! Characteristics to set device to
     *    reset(*)             ! Characteristics to reset device to
C
C Declare local variables.
      CHARACTER*8
     *    control              ! Carriage control for the file to be printed
      CHARACTER*256
     *    string               ! A string read from the file to be printed
      INTEGER*4
     *    string_len,          ! Length of the string just read
     *    status,              ! Returned status from function
     *    prt_fmt,             ! Format number for printing files.
     *    file_unit            ! FORTRAN unit number for file
C
C External definition parameters.
      INCLUDE '($STRDEF)'
C
C Declare local constants.
      CHARACTER*(*)
     *    Nothing              ! Nothing
      PARAMETER (
     *    Nothing = CHAR(0) )
C
C Format statements for writing.
 1100 FORMAT ( '+', A )
 1200 FORMAT ( A )
 1300 FORMAT ( ' ', A )
 1400 FORMAT ( ' %TPRINT-E-FILNOTFOU, File ', A, ' not found'/ )
C
C Format statements for reading.
 2000 FORMAT (A)
C
C Set the terminal for printing this stuff out.
      CALL SET_TERM ( 'SET', channel, set, printer_on, on_len )
C
C Open the file to be printed. If the file is not found, print
C the error and get another file name.
      CALL LIB$GET_LUN ( file_unit )
      OPEN ( UNIT = file_unit, FILE = file_name(1:file_len),
     *  ORGANIZATION = 'SEQUENTIAL', RECORDTYPE = 'VARIABLE',
     *  FORM = 'FORMATTED', STATUS = 'OLD',
     *  ACCESS = 'SEQUENTIAL', ERR = 300 )
C
C Get the record attributes for the file to be printed, and decide which
C format statement to use when printing the file.
      INQUIRE ( UNIT = file_unit, CARRIAGECONTROL = control )
      IF ( control .EQ. 'NONE' ) THEN
          ASSIGN 1100 TO prt_fmt
      ELSE IF ( control .EQ. 'FORTRAN' ) THEN
          ASSIGN 1200 TO prt_fmt
      ELSE IF ( control .EQ. 'LIST' ) THEN
          ASSIGN 1300 TO prt_fmt
      ELSE
          ASSIGN 1300 TO prt_fmt
      END IF
C
C Print the printer initialization string out to the printer.
      WRITE ( UNIT=*, FMT=1100 ) init_str(1:init_len)
C
C Read and print the first line of the file.
      string = Nothing
      READ ( UNIT = file_unit, FMT=2000, END=200 ) string
      status = STR$TRIM ( string, string, string_len )
      IF ( .NOT. status ) CALL LIB$SIGNAL ( %VAL ( status ) )
      WRITE ( UNIT=*, FMT=1100 ) string(1:string_len)
C
C Read the next line of the file.
  100 string = Nothing
      READ ( UNIT = file_unit, FMT=2000, END=200 ) string
C
C    Trim the string.
          status = STR$TRIM ( string, string, string_len )
          IF ( .NOT. status ) CALL LIB$SIGNAL ( %VAL ( status ) )
C
C    Print the line using the proper format.
          WRITE ( UNIT=*, FMT=prt_fmt ) string(1:string_len)
C
C    Go read the next line of the file.
          GOTO 100
C
C Send the ending string to the printer.
  200 WRITE ( UNIT=*, FMT=1100 ) end_str(1:end_len)
C
C Reset the terminal.
      CALL SET_TERM ( 'RESET', channel, reset, printer_off, off_len )
C
C Close the file and free up the unit number used for the file.
      CLOSE ( UNIT = file_unit )
      CALL LIB$FREE_LUN ( file_unit )
C                                                                   
C Return to the user.
      RETURN
C
C An error occured while opening the file. Flag it and return.
  300 CALL SET_TERM ( 'RESET', channel, reset, printer_off, off_len )
      WRITE ( UNIT=*, FMT=1400 ) file_name(1:file_len)
      CALL LIB$FREE_LUN ( file_unit )
      RETURN
C
      END
C**********************************************************************
C
C Subroutine SET_TERM
C
C This subroutine will set and reset the terminal for proper printing of
C the file.
C
C**********************************************************************
C
      SUBROUTINE SET_TERM ( function, channel, buffer, crt_str,
     *   str_len )
C
C Make everything an integer.
      IMPLICIT INTEGER ( a - z )
C
C Declare passed variables.
      CHARACTER*(*)
     *    function,            ! Function to be performed.
     *    crt_str              ! String to turn-on or -off printer on crt
      INTEGER*4
     *    channel,             ! I/O channel.
     *    buffer(*),           ! Device characteristics.
     *    str_len              ! Crt string len
C
C Declare local variables.
      INTEGER*4
     *    status               ! Returned status from function
C
C External definition parameters.
      INCLUDE '($IODEF)'
      INCLUDE '($SSDEF)'
C
C Print format.
 1000     FORMAT ( '+', A )
C
C If the function is to set the terminal,
      IF ( function .EQ. 'SET' ) THEN
C
C    Make sure the terminal will pass thru the control characters, and
C    turn the printer on.
          status = SYS$QIOW ( , %VAL(channel), %VAL(IO$_SETMODE),
     *       , , , buffer, 12, , , , )
          IF ( .NOT. status ) CALL LIB$SIGNAL ( %VAL ( status ) )
          WRITE ( UNIT=*, FMT=1000 ) crt_str(1:str_len)
C
C But, if the function is to reset the terminal,
      ELSE IF ( function .EQ. 'RESET' ) THEN
C
C Turn the printer off and allow the CRT to pass thru all control
C characters.
          WRITE ( UNIT=*, FMT=1000 ) crt_str(1:str_len)
          status = SYS$QIOW ( , %VAL(channel), %VAL(IO$_SETMODE),
     *       , , , buffer, 12, , , , )
          IF ( .NOT. status ) CALL LIB$SIGNAL ( %VAL ( status ) )
      END IF
C
C Return to the user.
      RETURN
      END
C**********************************************************************
C
C Subroutine BUILD_CHAR
C
C This subroutine will build the characteristic buffers for this device.
C
C**********************************************************************
C
      SUBROUTINE BUILD_CHAR ( device, channel, set_buf, reset_buf )
C     
C Make everything an integer.
      IMPLICIT INTEGER ( a - z )
C
C Declare passed variables.
      CHARACTER*(*)
     *    device               ! Device to build the characteristics for
      INTEGER*4
     *    channel,             ! I/O channel to assign to this device
     *    set_buf(*),          ! Characteristic buffer for setting the device
     *    reset_buf(*)         ! Characteristic buffer for resetting the device
C
C External definition parameters.
      INCLUDE '($DCDEF)'
      INCLUDE '($DVIDEF)'
      INCLUDE '($IODEF)'
      INCLUDE '($SSDEF)'
      INCLUDE '($TTDEF)'
      INCLUDE '($TT2DEF)'
C
C Assign an I/O channel to the device.
      status = SYS$ASSIGN ( 'SYS$OUTPUT', channel, , )
      IF ( .NOT. status ) CALL LIB$SIGNAL ( %VAL ( status ) )
C
C Get the class of this device.
      status = LIB$GETDVI ( DVI$_DEVCLASS, channel, , class )
      IF ( .NOT. status ) CALL LIB$SIGNAL ( %VAL ( status ) )
C
C Get the type of this device.
      status = LIB$GETDVI ( DVI$_DEVTYPE, channel, , type )
      IF ( .NOT. status ) CALL LIB$SIGNAL ( %VAL ( status ) )
C
C Get the bufsiz of this device.
      status = LIB$GETDVI ( DVI$_DEVBUFSIZ, channel, , bufsiz )
      IF ( .NOT. status ) CALL LIB$SIGNAL ( %VAL ( status ) )
C
C Get the device dependent characteristics.
      status = LIB$GETDVI ( DVI$_DEVDEPEND, channel, , depend )
      IF ( .NOT. status ) CALL LIB$SIGNAL ( %VAL ( status ) )
C
C Get the additional device dependent characteristics.
      status = LIB$GETDVI ( DVI$_DEVDEPEND2, channel, , depend2 )
      IF ( .NOT. status ) CALL LIB$SIGNAL ( %VAL ( status ) )
C
C Build the reset buffer.
      reset_buf(1) = ISHFT(bufsiz,16) + ISHFT(type,8) + class
      reset_buf(2) = depend
      reset_buf(3) = depend2
C
C The first word of the set buffer is the same as the first word of the
C reset buffer.
      set_buf(1) = reset_buf(1)
C
C If the device is a terminal, build the set buffer with NOBROADCAST,
C and MECHFORM set, WRAP not set.
      IF ( class .EQ. DC$_TERM ) THEN
          set_buf(2) = ( depend .OR. TT$M_NOBRDCST .OR. TT$M_MECHFORM )
     *      .AND. .NOT. TT$M_WRAP
          set_buf(3) = depend2
C
C However, if the device is not a terminal, don't change the last two words.
      ELSE
          set_buf(2) = reset_buf(2)
          set_buf(3) = reset_buf(3)
      END IF
C
C Return to the caller.
      RETURN
      END
C**********************************************************************
C
C Subroutine DEFINE_CTRL_C
C
C This subroutine will define the CTRL-C exit handling routine.
C
C**********************************************************************
C
      SUBROUTINE DEFINE_CTRL_C
C     
C Make everything an integer.
      IMPLICIT INTEGER ( a - z )
C
C External definition parameters.
      INCLUDE '($IODEF)'
      INCLUDE '($SSDEF)'
C
C Name of the CTRL-C exit handler.
      EXTERNAL
     *    CTRLC_EXIT
C
C Assign a channel.
      status = SYS$ASSIGN ( 'SYS$INPUT', channel, , )
      IF ( .NOT. status ) CALL LIB$SIGNAL ( %VAL ( status ) )
C
C Set up the handler.
      function = IO$_SETMODE .OR. IO$M_CTRLCAST
      status = SYS$QIOW ( , %VAL(channel), %VAL(function),
     *       , , , CTRLC_EXIT, , , , , )
      IF ( .NOT. status ) CALL LIB$SIGNAL ( %VAL ( status ) )
C
C Return to caller.
      RETURN
      END
C**********************************************************************
C
C Subroutine CTRLC_EXIT
C
C This subroutine will exit the program if a CTRL-C has been executed.
C
C**********************************************************************
C
      SUBROUTINE CTRLC_EXIT
C     
C Make everything an integer.
      IMPLICIT INTEGER ( a - z )
C
C External definition parameters.
      INCLUDE '($IODEF)'
      INCLUDE '($SSDEF)'
C
C Common block containing the printer turn-off string. 
      INTEGER*4
     *    off_len
      CHARACTER*256
     *    printer_off
      COMMON
     *    /termblk/ off_len,printer_off
C
C Common block containing device reset characteristics for this device.
      INTEGER
     *    reset(3)
      COMMON 
     *    /qioblk/   reset
C
C Common block containing the printer ending length and string.
      CHARACTER*256
     *    end_str
      INTEGER*4
     *    end_len
      COMMON
     *    /endblk/   end_len,end_str
C
C Print format.
 1000 FORMAT ( '+', A, A )
C
C Get a free unit number
      CALL LIB$GET_LUN ( file_unit )
C
C Open SYS$OUPUT for output.
      OPEN ( UNIT = file_unit, FILE = 'SYS$OUTPUT',
     *  ORGANIZATION = 'SEQUENTIAL', RECORDTYPE = 'VARIABLE',
     *  FORM = 'FORMATTED', STATUS = 'OLD', ACCESS = 'SEQUENTIAL' )
C
C Send the ending string to the printer, and turn the printer off.
      WRITE ( UNIT=file_unit, FMT=1000 ) end_str(1:end_len),
     *  printer_off(1:off_len)
C
C Free up the unit number.
      CALL LIB$FREE_LUN ( file_unit )
C
C Assign a channel to SYS$OUTPUT.
      status = SYS$ASSIGN ( 'SYS$OUTPUT', channel, , )
      IF ( .NOT. status ) CALL LIB$SIGNAL ( %VAL ( status ) )
C
C Do a qio to this channel with the reset characteristics.
      status = SYS$QIOW ( , %VAL(channel), %VAL(IO$_SETMODE),
     *   , , , reset, 12, , , , )
      IF ( .NOT. status ) CALL LIB$SIGNAL ( %VAL ( status ) )
C
C Exit.
      CALL EXIT
      END
