C+ C NAME: C sprint C PURPOSE: C Copy a specified file to another file, with selected format, C ready to be printed C CATEGORY: C I/O C CALLING SEQUENCE: program SPRINT C run $exe:sprint (vms) C $ $exe:sprint filename (vms) C $exe/sprint (linux) C INPUTS: C filename Name of text file to be processed (optional) C If no file name is specified, user is prompted C C The program attempts to read the following global DCL symbols (only C the page length indicator is mandatory): C LIB__LS_PAGEL # lines per page, minus 3 (for the header) C LIB__LS_PRNT the VMS-DCL or Linux-bash command which submits the file C for printing C LIB__LS_START initialize sequence for printer (1st line of print file) C LIB__LS_STOP soft reset sequence for printer (last line) C LIB__LS_FF if set to "YES" an explicit formfeed is written at C the end of each page (if the page length set in C LIB__LS_PAGEL exactly matches the intrinsic page length C of the printer this may not be necessary). C OUTPUTS: C ?.las Scratch file to be send to printed and deleted C INCLUDE: include 'dirspec.h' include 'filparts.h' include 'openfile.h' C CALLS: C ForeignArg,iSearch,itrim,OSExitCmd,iOSSpawnCmd,iGetSymbol,LocFirst, Say C cTime2System,iUniqueName,iOSDeleteFile,iOSRenameFile, bOpenFile C iFreeLun, uppercase, iHideLogical, iGetLogical, iSetFileSpec, iGetFileSpec C PROCEDURE: C > The input text file is processed record by record and are written to C an output scratch file. The scratch file is printed and deleted. C > The output file '?.las' is created in SYS$SCRATCH C > Wild cards are permitted in the input file name C > If the second calling sequence is used ($SPRINT), then a comma separated C list of arguments is permitted. Each argument can contain a wild card. C > By default the output file includes line numbers. C C Command line switches (preceded by "/"): C > /NOLINENUMBERS: the line numbers are suppressed. C > /MARGIN (only used in combination with /NOLINENUMBERS): C add a margin of one tab (8 characters) on the left. C > /COUNTONLY: only a page count is given. Nothing is actually printed. C > /NOCRLFFF: an output file with a higher version number C (same directory and name as input file) is created with trailing CR,LF C and/or FF remove. I.e. no header is added, and no printer initialize C and reset string. C > /FORTRAN: the scratch file send to the printer is C identical to the input file except for an additional header (consisting C of the ALL initialize string, the system time and the file name) and C an additional trailer (the RSP reset string). This option is useful C for printing files with FORTRAN carriagecontrol. C > /CRLF: CR and LF's are explicitly processed. By default they are C stripped out and ignored. C > /LANDSCAPE: printing is in landscape mode C > /DELETE: the original input file is deleted after processing C (NOTE: whether the scratch file is deleted depends on the print command) C > /HELP: display few lines of help C C > The landscape option uses the global symbols LIB__LS_LAND and C LIB__LS_LANDL instead of LIB__LS_START and LIB__LS_PAGEL, respectively. C These symbols are available for the HP Laserjet printer, but is C currently not of much use, since it only prints a maximum of 132 C characters per line (only a few characters more than in portrait mode) C > On Linux the script $com/sprint_setup adds the required symbols to C the file ~/LOGFIL.TXT. C MODIFICATION HISTORY: C Original HC.FOR by George L. Huszar May, 1991 C OCT-1991, Paul Hick (UCSD), modified to accept external input C MAR-1992, Paul Hick (UCSD), added loop for wild-card specification C FEB-1993, Paul Hick (UCSD), C - option to suppress line numbers C - option to get page count without actually printing C - added removal of trailing CR,LF and FF C - option to retain file with CR,LF and FF removed C - option to print files with FORTRAN carriagecontrol C MAR-1995, Paul Hick (UCSD), added option to delete the original input C file after processing C MAR-1995, Paul Hick (UCSD), introduced command line switches to C differentiate between various options (used to be numericals C appended to the list of file names) C AUG-2000, Kevin Nguyen, Paul Hick (UCSD) C Adapted for Linux. The main change was the addition of an C explicit carriage return after all text output to the scratch C file before sending it to the printer. The current print command C is lpr -Php -r. All required LIB__* symbols are set up by C the script $com/sprint_setup. C- parameter (LBUF = FIL__LENGTH) ! Length of the output (char) buffer integer LFN / 76/ ! Length of input filename in header integer NCPL /183/ ! Number of Characters Per Line integer STI ! Auxiliary Status-indicator, used during Input integer CLIF ! Current Line In File, as the input file is being read integer NPIF ! Pages In File (from a pre-scan) integer DS / 2/ ! Date Start column number, in the page-header line integer FS / 28/ ! Filename Start column number, in the page-header line integer PS /102/ ! Page number Start column number, in the page-header line integer TS / 9/ ! Text Start column number, in each text-line output integer LS / 2/ ! Line-number Start column number, in each text-line output integer IP ! DO loop Index : Page counting integer IL ! IL=DO loop Index : Line counting character FNI *(LBUF) ! FileName : Input character FNI0*(LBUF) character FNI1*(LBUF) character FNO *(LBUF) /' '/ ! FileName : Output character BUF*(LBUF) ! Processing buffer character RSP*80 /' '/ ! Printer-reset (reads LIB__LS_STOP) character ALL*80 /' '/ ! Printer-initialize (reads LIB__LS_START) character FF /12/ ! Form feed character LF /10/ ! Line feed character CR /13/ ! Carriage return character CRtmp integer IGARBAGE / 3/ character GARBAGE(3) /12,10,13/ integer ICNT / 0/ ! # Files integer NPAG / 0/ ! Total # pages integer NLHEAD / 3/ ! # Lines in header integer nVar /10/ character cVar(10)*80 character cArg*200 character PRC*120 /' '/ ! Read symbol LIB__LS_PRNT character CNLPP*3 /' '/ ! Read symbols LIB__LS_PAGEL, LIB__LS_FF !character CARRIAGE*7 character cFrmt*4 character cSay*6 /'sprint'/ logical DOLINE logical DOPRINT logical DOSTRIP logical DOFORTR logical DOCOUNT logical DOLAND logical DODELETE logical DOQUEUE logical bOutOpen /.FALSE./ logical bWriteFF /.FALSE./ logical bInsertALL /.TRUE. / logical bNextFile /.FALSE./ logical bOpenFile character cTimeFmt*19 /'YYYY/MN/DD hh:mm:ss'/ character cTime2System*80 integer Str2Str iAct0 = OPN__TEXT+OPN__TRYINPUT+OPN__ONEPASS+OPN__STOP call ForeignArg(',',nVar,cVar,cArg) if (nVar .gt. 0 .and. cVar(nVar) .eq. '?') cArg(itrim(cArg)+1:) = '/HELP' call uppercase(cArg) if (LocFirst(cSwitch//'HELP',cArg) .ne. 0 .or. LocFirst(cSwitch//'?',cArg) .ne. 0) then write (*,'(1X,A)') & ' '//cSay//' '//cSwitch//'switch1'//cSwitch//'switch2 file1,file2', & ' no switches print with line numbers', & ' '//cSwitch//'nolinenumbers suppress line numbers', & ' '//cSwitch//'landscape print in landscape mode', & ' '//cSwitch//'margin add left margin (with /nolinenumbers only)', & ' '//cSwitch//'countonly page count only (no print)', & ' '//cSwitch//'FFCR do not ignore FF,CR', & ' '//cSwitch//'noFFCRLF remove trailing FF,CR,LF (do not print)', & ' '//cSwitch//'fortran print file with Fortran carriage control', & ' '//cSwitch//'delete delete the input file after processing', & ' '//cSwitch//'help this help listing' call Say(cSay,'I','StopPlay','StopPlay') end if DOLAND = LocFirst(cSwitch//'LAND',cArg) .ne. 0 ! Landscape DOFORTR = LocFirst(cSwitch//'FOR' ,cArg) .ne. 0 ! Fortran carr.cntrl DODELETE = LocFirst(cSwitch//'DEL' ,cArg) .ne. 0 ! Delete input file DOSTRIP = LocFirst(cSwitch//'NOFF',cArg) .ne. 0 ! Strip trailing FF DOLINE = LocFirst(cSwitch//'NOLI',cArg) .eq. 0 .and. .not. DOSTRIP DOPRINT = LocFirst(cSwitch//'COUN',cArg) .eq. 0 .and. .not. DOSTRIP DOCOUNT = LocFirst(cSwitch//'FFCR',cArg) .eq. 0 ! Don't ignore explicit LF,FF DOQUEUE = DOPRINT .and. LocFirst(cSwitch//'NOQ' ,cArg) .eq. 0 if (DOLAND) then ! Landscape write (*,*) ' Printing in landscape mode' FS = FS+20 PS = PS+20 end if if (.not. DOLINE) then TS = 1 ! Start text at column 1 if (LocFirst(cSwitch//'MARG',cArg) .ne. 0) TS = 9 end if ! Start text at column 9 ! Printer reset string nRSP = iGetSymbol('LIB__LS_STOP',RSP) ALL = RSP nALL = nRSP if (DOLAND) then ! Landscape pagelength if (iGetSymbol('LIB__LS_LANDL',CNLPP) .eq. 0) & call Say(cSay,'E','Page','length not determined (global symbol LIB__LS_LANDL)') ! Landscape printer initialization if (iGetSymbol('LIB__LS_LAND',ALL(nALL+1:)) .eq. 0) & call Say(cSay,'E','Landscape','not available (global symbol LIB__LS_LAND)') else ! Portrait pagelength if (iGetSymbol('LIB__LS_PAGEL',CNLPP) .eq. 0) & call Say(cSay,'E','Page','length not determined (global symbol LIB__LS_PAGEL)') ! Printer initialization I = iGetSymbol('LIB__LS_START',ALL(nALL+1:)) end if nALL = itrim(ALL) J = itrim(CNLPP) write (cFrmt,'(A,I1,A)') '(I',J,')' read (CNLPP(:J),cFrmt,iostat=I) NLPP ! # lines per page if (I .ne. 0) call Say(cSay,'E','Error','reading page length from symbol LIB__LS_PAGEL') NLPP = NLPP-NLHEAD ! # lines without header ! Print command I = iGetSymbol('LIB__LS_PRNT',PRC) if (iGetSymbol('LIB__LS_FF',CNLPP) .ne. 0) bWriteFF = CNLPP .eq. 'YES' CRtmp = ' ' ! Tested on Linux only: add a CR to each line if (cOpSys .eq. OS__UNIX .or. cOpSys .eq. OS__LINUX) CRtmp = CR iVar = 0 ! Counter for command line arguments 10 continue ! Main loop : ask for the next filename to print FNI = ' ' if (nVar .gt. 0) then ! Loop over command line args iVar = iVar+1 if (iVar .le. nVar) FNI = cVar(iVar) else ! No command line args, prompt for input write (*,'(A,$)') ' Input file (RETURN/^Z=end of files) : ' read (*,'(A)',end=990,err=990) FNI end if if (FNI .eq. ' ') go to 990 ! If it's the end of all the files, exit if (iSearch(1,FNI,FNI0) .ne. 1) go to 10 ! Check for input-file existence 11 continue ! Sub loop for FNI containing wild card nFNI0 = itrim(FNI0) nFNI1 = iHideLogical(FNI0,FNI1) !------- ! This section was inserted to handle files using FORTRAN ! carriagecontrol. The scratch file has the same carriagecontrol as the ! input file and starts with the ALL string and a header consisting only ! of the system time. The input file is appended as a whole. Then the ! RSP string ends the scratch file. if (DOFORTR) then if (bOutOpen) then bNextFile = .TRUE. else I = iGetLogical(cTemp,FNO) ! Make unique name for output I = iUniqueName('?.las',FNO(I+1:)) ! This is a remnant from VMS. It should probably be part of a FileInfo subroutine ! Set OPN__FORTRAN only if FileOpen returns .TRUE. for fortran carriagecontrol. !inquire (file=FNI0,carriagecontrol=CARRIAGE) !LUO = iGetLun(FNO) !open (LUO,file=FNO,carriagecontrol=CARRIAGE,status='NEW') !inquire (LUO,name=FNO) !bOutOpen = .TRUE. bOutOpen = bOpenFile(iAct0+OPN__NEW+OPN__FORTRAN,LUO,FNO,iRecl) end if !------- ! First write all the header information for file FNO BUF = ' ' BUF(DS:DS+len(cTimeFmt)-1) = cTime2System(cTimeFmt) ! Insert the current date/time if (nFNI1 .le. LFN) then ! Insert the page number I = (LFN-nFNI1)/2 BUF(FS+I:FS+I+LFN-1) = FNI1 else BUF(FS:FS+LFN-1) = '...'//FNI1(nFNI1+1-(LFN-3):nFNI1) end if if (bInsertALL .and. nALL .ne. 0) then write (LUO,'(A)') ' '//ALL(:nALL)//' '//BUF(:PS+5+3+1+3-1)//CRtmp bInsertALL = .FALSE. else if (bNextFile) then ! Next file: insert FF write (LUO,'(A)') ' '//FF//BUF(:PS+5+3+1+3-1)//CRtmp bNextFile = .FALSE. else write (LUO,'(A)') ' '//BUF(:PS+5+3+1+3-1)//CRtmp end if ! Output the header line do I=2,NLHEAD write (LUO,'(A)') ' '//CRtmp ! Empty lines in header end do !------- ! Close FNO, then append to whole file by spawning proper command. LUO = iFreeLun(LUO) ! Close FNO to prepare for append if (cOpSys .eq. OS__VMS) then iI = iOSSpawnCmd('append/nolog '//FNI0(:nFNI0)//' '//FNO,0) else if (cOpSys .eq. OS__DOS) then if (ICNT .eq. 0) then iI = iOSSpawnCmd('type '//FNO(:itrim(FNO))//' > '//FNI0,0) else iI = iOSSpawnCmd('type '//FNO(:itrim(FNO))//' >> '//FNI0,0) end if else if (ICNT .eq. 0) then iI = iOSSpawnCmd('cat '//FNO(:itrim(FNO))//' > '//FNI0,0) else iI = iOSSpawnCmd('cat '//FNO(:itrim(FNO))//' >> '//FNI0,0) end if end if ! Open FNO again?? if (bOpenFile(iAct0+OPN__APPEND,LUO,FNO,iRecl)) continue ICNT = ICNT+1 ! # files already appended go to 101 end if !------- ! OPEN and pre-read the input file, to determine the number of pages if (.not. bOpenFile(iAct0+OPN__READONLY,LUI,FNI0,iRecl)) continue if (DOCOUNT) then I = 0 read (LUI,'(A)',iostat=STI) BUF do while (STI .ge. 0) ! Loop until EOF is reached I = I+1 ! Count lines read (LUI,'(A)',iostat=STI) BUF end do NPIF = (I+NLPP-1)/NLPP ! # pages else I = 0 NPIF = 0 ! Page counter read (LUI,'(A)',iostat=STI) BUF do while (STI .ge. 0) ! Loop until EOF is reached JL = itrim(BUF) ! Effective length of buffer do while (JL .ge. 0) if (JL .eq. 0) then ! Whole record processed: JLF = 1 ! .. pretend LF in 1st pos J = JLF JFF = JLF+1 ! .. and FF in 2nd pos else JLF = index(BUF(:JL),LF) ! Position LF JFF = index(BUF(:JL),FF) ! Position FF if (JLF .eq. 0) JLF = JL+1 if (JFF .eq. 0) JFF = JL+2 J = min(JLF,JFF) ! Whatever comes first end if if (J .eq. JLF) then ! Linefeed first I = I+1 ! Increase line counter if (I .eq. NLPP) JFF = J ! Page full: pretend LF is FF end if if (J .eq. JFF) then ! Formfeed first NPIF = NPIF+1 ! Increase page counter I = 0 end if if (J .eq. JL) J = JL+1 ! FF or LF in last position if (J .lt. JL) BUF = BUF(J+1:JL) ! Step past LF/FF JL = JL-J ! Remaining length end do read (LUI,'(A)',iostat=STI) BUF end do if (I .ne. 0) NPIF = NPIF+1 end if LUI = iFreeLun(LUI) ! Close input file again if (nFNI1 .le. 57) then ! Insert the file name BUF = FNI1 else BUF = '...'//FNI1(nFNI1+1-(57-3):nFNI1) end if if (NPIF .eq. 1) then write (*,'(2X,A,T60,A,I4,A)') BUF(:itrim(BUF)),' (',NPIF,' page )' else write (*,'(2X,A,T60,A,I4,A)') BUF(:itrim(BUF)),' (',NPIF,' pages)' end if if (NPIF .eq. 0) go to 101 ! Empty file: don't create output file NPAG = NPAG+NPIF ! Total # pages ICNT = ICNT+1 ! # Files if (.not. DOPRINT .and. .not. DOSTRIP) go to 101 ! No printing: don't create output file !------- ! OPEN the input file again, to get ready for the text-read ! OPEN output file; write the printer-control character-string if (.not. bOpenFile(iAct0+OPN__READONLY,LUI,FNI0,iRecl)) continue if (bOutOpen) then ! Output file open already bNextFile = .TRUE. else ! Open output file if (DOSTRIP) then I = iSetFileSpec(FNI0) I = iGetFileSpec(0,FIL__DIRECTORY,FNO) else I = iGetLogical(cTemp,FNO) end if I = iUniqueName('?.las',FNO(I+1:)) bOutOpen = bOpenFile(iAct0+OPN__NEW,LUO,FNO,NCPL) end if !------- ! Main loop, to output the headers and each line : NEW_BUF = 1 ! Read line from input file IP = 0 ! Page counter CLIF = 0 ! Counter for total # of lines do while (IP .lt. NPIF) ! Next Page IP = IP+1 if (DOPRINT) then ! Encode and format the header line BUF = ' ' ! Insert the current date/time BUF(DS:DS+len(cTimeFmt)-1) = cTime2System(cTimeFmt) if (nFNI1 .le. LFN) then! Insert the file name I = (LFN-nFNI1)/2 BUF(FS+I:FS+I+LFN-1) = FNI1 else BUF(FS:FS+LFN-1) = '...'//FNI1(nFNI1+1-(LFN-3):nFNI1) end if ! Insert the page number write (BUF(PS+5:),'(I3,A,I3)') IP,'/',NPIF ! 1st record to output file if (bInsertALL .and. nALL .ne. 0) then write (LUO,'(A)') ALL(:nALL)//' '//BUF(:PS+5+3+1+3-1)//CRtmp bInsertALL = .FALSE. ! Next file: insert FF else if (bNextFile) then write (LUO,'(A)') ' '//FF//BUF(:PS+5+3+1+3-1)//CRtmp bNextFile = .FALSE. else write (LUO,'(A)') ' '//BUF(:PS+5+3+1+3-1)//CRtmp end if ! Output the header line do I=2,NLHEAD write (LUO,'(A)') ' '//CRtmp! Empty lines in header end do end if !------- ! Read each input-file line, format it and output it IL = 0 ! Page Line counter do while (IL .lt. NLPP) ! Next Line on Page !------- ! Read the next line from the input file. if (NEW_BUF .eq. 1) then BUF = ' ' read (LUI,'(A)',iostat=STI) BUF(TS:) if (STI .lt. 0) go to 100 ! EOF ? Finished ! JL = TS-1+itrim(BUF(TS:)) ! Effective length of buffer if (DOCOUNT) then ! Remove garbage (LF,CR,FF) do I=1,IGARBAGE JLG = 0 ! Assume no garbage present if (JL .gt. 0) JLG = index(BUF(:JL),GARBAGE(I)) do while (JLG .ne. 0) ! Garbage located in pos JLG if (JLG .eq. 1) then ! Garbage in 1st pos if (JLG .eq. JL) then BUF = ' ' ! 1st = last position else BUF = BUF(JLG+1:JL) end if ! Pick up trailing part else if (JLG .eq. JL) then BUF(JLG:) = ' ' ! Pick up leading part else BUF(JLG:) = BUF(JLG+1:JL) end if ! Pick up trailing & leading part JL = JL-1 ! Adjust buffer length JLG = 0 ! Assume no garbage present if (JL .gt. 0) JLG = index(BUF(:JL),GARBAGE(I)) end do end do end if else NEW_BUF = 1 ! Read new record end if do while (JL .ge. TS-1) if (JL .eq. TS-1) then JLF = TS J = JLF JFF = JLF+1 else JLF = index(BUF(:JL),LF) JFF = index(BUF(:JL),FF) if (JLF .eq. 0) JLF = JL+1 if (JFF .eq. 0) JFF = JL+2 J = min(JLF,JFF) end if if (J .eq. JLF) then if (DOLINE) then CLIF = CLIF+1 ! Encode/insert the line number write (BUF(LS:LS+4-1),'(I4)') CLIF end if IL = IL+1 ! # lines on current page if (JLF .gt. 1) then write (LUO,'(A)') BUF(:min(NCPL,JLF-1))//CRtmp else if (JL .eq. 0) then write (LUO,'(A)') ' '//CRtmp end if if (IL .eq. NLPP) JFF = J ! Page full end if if (J .eq. JFF .and. IL .gt. 0) then ! FF and start new page !------- ! If the pagelength in LIB__LS_PAGEL exactly matches the ! intrinsic printer page length, it is not really necessary ! to explicitly add a formfeed. if (DOPRINT .and. bWriteFF) write (LUO,'(A)') FF IL = NLPP ! Back to create page header end if if (J .eq. JL) J = JL+1 ! FF or LF in last position if (J .lt. JL) BUF(TS:JL) = BUF(J+1:JL) JL = JL-J+TS-1 if (IL .eq. NLPP .and. JL .ge. TS-1) NEW_BUF = 0 end do end do ! `Next Line' loop end do ! `Next Page' loop 100 continue ! Input-file : End-of-File exit !------ ! Output "Soft Terminal Reset", to return printer to normal font (if available) LUI = iFreeLun(LUI) ! Close input file if (DODELETE) I = iOSDeleteFile(FNI0) if (DOSTRIP) then LUO = iFreeLun(LUO) ! Close output file bOutOpen = .FALSE. if (cOpSys .eq. OS__VMS) then I = iOSRenameFile(FNO,FNI0(:index(FNI0,';')-1)) else if (iOSDeleteFile(FNI0) .eq. 1) I = iOSRenameFile(FNO,FNI0) end if end if 101 continue if (iSearch(0,FNI,FNI0) .eq. 1) go to 11 ! Get next file of wild-card FNI go to 10 ! Get the next file 990 continue ! No more files to send if (bOutOpen) then if (nRSP .ne. 0) write (LUO,'(A)') RSP(:nRSP) LUO = iFreeLun(LUO) end if if (ICNT .gt. 1 .and. .not. DOFORTR) then ! More than 1 file: show total # pages write (*,'(1X,T60,A)') ' ------------' write (*,'(1X,T55,A,T60,A,I4,A)') 'Total',' (',NPAG,' pages)' end if !------- ! Conditions for submitting a print job ! PRC .ne. ' ' : there must be a print command available ! ICNT .gt. 0 : there must be at least one file to print ! DOPRINT .eq. .TRUE. : hardcopies are explicitly requested if (ICNT .gt. 0 .and. DOQUEUE) then I = itrim(PRC)+1 I = I+Str2Str(FNO,PRC(I+1:)) if (cOpSys .eq. OS__VMS) then call OSExitCmd(PRC,1) else if (cOpSys .eq. OS__DOS) then C call DosPrint(PRC) else if (cOpSys .eq. OS__UNIX .or. cOpSys .eq. OS__LINUX) then I = iOSSpawnCmd(PRC,1) end if end if call Say(cSay,'S','STOP',' ') end