Three Routines to ease use of Printer There are three things that involve the printer that I have found useful and would like to share. The first involves spooling from within a program. The second is a subroutine to change the horizontal pitch and margin from within a program, and the third is a self contained program that allows one to give commands that make several changes on the printer somewhat similar to what the previously mentioned subroutine allows you to do except these commands are given directly to MCR. 1. SPOOLING SUBROUTINE DEC provides a Macro to spool output to a line printer but the Macro cannot be called directly from a Fortran program. This subroutine allows spooling from within a Fortran program. In order to use the subroutine, a file must be opened which will be written to during the course of the program. The statement for opening a file is: CALL ASSIGN(LUN,'NAME.DMP') Where LUN is the logical unit number to be written to for any text that is later to be spooled. NAME is the name of the file. Within the program each write statement should be the same as if you were writing to a terminal except the logical unit number as defined in the CALL ASSIGN statement is used. At the point in the program when spooling is desired, include the statement: CALL SPOOL (LUN,[IERR]) where IERR is an error number that you can look at or not depending on your mood. We use an LA120 as the printer to spool to. I assume that any printer will work. One MCR command that must be given before using this subroutine is: ASN TTN:=LP: where N is the terminal number of the printer. .TITLE SPOOL SUBROUTINE FOR FORTRAN ; ; FORTRAN CALL: ; CALL SPOOL(LUN,IERR) ; ; WHERE LUN = LOGICAL UNIT NUMBER ; ; RETURN: ; IERR = FCS ERROR CODE FROM FDB ; IF IERR ARGUMENT IS NOT INCLUDED, STATUS CAN ; BE PICKED UP AS FUNCTIONAL VALUE (FROM R0) ; AUTHOR: Chris Heinz while employed by DEC under contract with ; U. S. Forest Service, Berea, KY ; ; NOTE: ; FILE MUST BE OPEN ; .MCALL PRINT$ ; SEE CH. 8 OF I/O OP. MANUAL ; .GLOBL $FCHNL,$OTSV ; .ENABL LSB SPOOL:: MOV @2(R5),R2 ;GET LUN MOV @#$OTSV,R3 ;GET WORK AREA ADDRESS JSR PC,$FCHNL ;FIND FDB ADDRESS MOV R0,R1 ;SAVE ADR OF FORTRAN FDB ADD #14,R0 ;GET TO RSX FDB PRINT$ R0 ;SPOOL FILE BCS ERR ;ERROR? MOV #66,R0 ;THIS MANY WORDS TO ZERO 1$: CLR (R1)+ ;MAKE THIS LUN REUSABLE DEC R0 BNE 1$ 2$: CMPB (R5),#1 ;ONLY ONE ARGUMENT? BEQ 3$ ;NO STATUS IN ERR ARG CMP 4(R5),#-1 ;ERR ARGUMENT DEFAULTED? BEQ 3$ ;NO STATUS IN ERR ARG MOV R0,@4(R5) ;STORE ERROR CODE OR 0 3$: RTS PC ;AND RETURN TO CALLER ; ERR: MOVB F.ERR(R0),R0 ;GET FCS ERR CODE FROM FDB BR 2$ ;AND USE COMMON RETURN .DSABL LSB .END 2. SUBROUTINE TO CHANGE SIZE AND MARGIN Another desirable feature is to be able to change the print size (horizontal pitch) and the margin from within a fortran program. My first attempt to do this resulted in a subroutine that worked fine as long as the output wasn't being spooled but didn't work any time the print out was being spooled. This subroutine, called CSIZE, changes both size and margin simultaneously and works irregardless of whether the print out is spooled or not. To use it have the line in the program: CALL CSIZE(LUN,SIZE,MARGIN) where LUN is the logical unit number, SIZE is an integer number from 1 through 8 where 1 is smallest print size (16 characters/inch) and 8 is the largest print size (5 characters/inch). The largest margin that this subroutine allows is a margin of 9. The subroutine can easily be modified, if a larger margin is desired. Before the change in margin will take effect, there must be a carriage return output to the printer. Usually, people want the change to take effect immediately and so to accomplish this, the subroutine outputs that carriage return. The only time you would not want the change in margin to take effect immediately is when you want to change the print size in the middle of a line. In this case, modify the subroutine so that you do not output the CR at the end of the code. The comments in the subroutine show one way to modify it so the CR is not sent. With this modified version, the print size can be changed as often as desired within the same line and no change in margin occurs until you send the CR as part of your program. C CSIZE.FTN C C SETS THE CHARACTER SIZE AND MARGIN ON THE PRINTER C LUN IS LOGICAL UNIT NO. ASSIGNED TO THE PRINTER C IF ANY SIZE OTHER THAN 1 - 8 IS ENTERED, IT WILL SET SIZE TO C SIZE 3 IF ANY MARGIN, OTHER THAN 1 - 9 IS ENTERED, IT WILL SET C THE MARGIN TO 5 CAUTION: A CARRIAGE RETURN IS ISSUED AFTER THE C MARGIN IS CHANGED. THIS IS NECESSARY IN ORDER THAT THE NEXT C PRINTING HAS THE DESIRED MARGIN. AUTHOR: RAYMOND WILLIS, C U. S. FOREST SERVICE, BEREA, KY C SUBROUTINE CSIZE(LUN,SIZE,MARGIN) BYTE NULL,PLUS,S1(4),SCODE(8),MAR(4) INTEGER LUN,SIZE DATA S1,SCODE/27,91,52,119,52,51,50,49,56,55,54,53/ DATA MAR,PLUS/27,91,53,115,43/ IF(MARGIN.LE.0) MARGIN=5 IF(MARGIN.GT.9) MARGIN=5 MAR(3)=48+MARGIN IF(SIZE.LE.0) SIZE=3 IF(SIZE.GT.8) SIZE=3 S1(3)=SCODE(SIZE) IF (LUN .LT. 1) LUN=6 IF (LUN .GT. 9) LUN=6 C WRITE(LUN,100)NULL,S1,MAR ! USE THIS TO CHANGE CHARACTER C ! SIZE IN MIDDLE OF LINE WRITE(LUN,100)PLUS,S1,MAR ! USE THIS IF YOU DON'T WANT TO CHANGE C ! CHARACTER SIZE IN MIDDLE OF LINE 100 FORMAT(9A1) C A WORD OF EXPLANATION IS PROBABLY IN ORDER HERE. THE FIRST C CHARACTER IN THE ABOVE STRING IS THE PLUS SYMBOL WHICH CAUSES A C CR TO BE OUTPUT AT THE END OF THE STRING. THIS IS NECESSARY C BECAUSE A CHANGE IN THE MARGIN DOES NOT TAKE EFFECT UNTIL A CR C HAS BEEN RECEIVED. IF YOU WERE TO SEND THE STRING WITHOUT THE C CR AT THE END, YOU COULD CHANGE CHAR SIZE IN THE MIDDLE OF A C LINE. THE FORTRAN MANUAL SHOWS HOW YOU CAN SEND A LINE WITH CR C BUT NO LINE FEED, OR LINE FEED WITH NO CR BUT DOES NOT SAY HOW C YOU CAN SEND A LINE WITH NEITHER CR NOR LINE FEED. THE I/O C OPERATIONS MANUAL, SEC 2.8 (FOR RSX 3.2) POINTS OUT THAT A NULL C CHARACTER TAKES AWAY BOTH CR AND LINE FEED. BY CHANGING THE C VARIABLE PLUS TO THE VARIABLE NULL IN THE LINE ABOVE YOU WOULD C BE ABLE TO CHANGE CHARACTER SIZE IN THE MIDDLE OF A LINE. RETURN END 3. COMMANDS THAT ALLOW PRINTER CHANGES TO BE MADE The third useful submission is a program that allows any one of several commands to be given to the computer to allow changes to be made for the LA120. The following commands will work: PRI LM n Set the left margin at position n on the printer. PRI CS n Set the character size (horizontal pitch) to size n where n=1 is the smallest size (16 ch/in) and 8 is the largest (5 ch/in). If n is omitted or is any value other than 1 through 8, the default of 3 (12 ch/in) is selected. PRI PA Advance to the next page. (Do a form feed.) ; PRI.MAC ; ; A PROGRAM TO SET CERTAIN PARAMETERS ON THE LA120 PRINTER. THE ; FOLLOWING COMMANDS CAN BE USED: ; ; PRI PA ADVANCE TO NEXT PAGE ; PRI CS n SET THE CHARACTER SIZE AT SIZE n. n = 1 IS THE ; SMALLEST. n = 8 IS THE LARGEST. IF n = 0 OR NO ; CHARACTER, SETS TO THE DEFAULT (12 CHAR/INCH, SAME ; AS 3) ; PRI LM n SETS LEFT MARGIN AT VALUE n. ; Change the 5 in the ALUN$ macro to correspond to the terminal ; number of your LA120 printer. ; When task building, use the option ; TASK=...PRI ; After taskbuilding, install the task. ; Author: Raymond Willis, U. S. Forest Service, Berea, KY ; .MCALL GMCR$,QIOW$S,EXIT$S,DIR$,QIOW$C,ALUN$S GMCR: GMCR$ OPT: .ASCII /PACSLM/ ; PG ADV, CHAR SIZE, LEFT MAR, R MAR START: ALUN$S #4,#"TT,#5 ; LOG UNIT 4 IS THE PRINTER DIR$ #GMCR ; GET COMMAND LINE MOV #GMCR+6,R0 ; BEGINNING OF CHOICES MOV R0,R1 ; SAVE IT IN R1 MOV #OPT,R2 ; GET BEGINNING OF OPTIONS CLR R4 LET1: CMPB (R1)+,(R2)+ ; IS FIRST LETTER ENTERED = 1ST LET ; ; THIS CHOICE? BEQ LET2 ; IT IS. INC R2 ; SET FOR NEXT OPTION BR NEXOPT LET2: CMPB (R1)+,(R2)+ ; IS 2ND LETTER O.K.? BEQ CHOI ; IT IS, SUCCESS. NEXOPT: INC R4 ; LOOK AT NEXT OPTION. CMP R4,#3 ; LOOKED AT ALL? BEQ ERR ; WE HAVE MOV R0,R1 ; GET BEGINNING OF BUFFER BACK BR LET1 CHOI: ADD R4,R4 ; DOUBLE R4 INC R1 ; R1 NOW POINTS TO 1ST CHAR OF SIZE JMP @TABLE(R4) ; GO TO THE RIGHT CHOICE ERR: QIOW$S #IO.WVB,#5,#1,,,,<#MES1,#LM1,#40> ; SYNTAX ERROR JMP STOP SIZER: QIOW$C IO.WVB,5,1,,,, ; WRONG SIZE JMP STOP ; ; CHOICE 1: SEND A FORMFEED ; CHO1: QIOW$C IO.WVB,4,1,,,, ; PUT A FORMFEED TO PRINTER JMP STOP ; ; CHOICE 2: SET THE CHARACTER SIZE ; CHO2: MOVB (R1),R1 ; SIZE SHOULD NOW BE IN R1 CMPB R1,#60 BLE S3 CMPB R1,#71 BGE SIZER SUB #61,R1 ADD R1,R1 ; DOUBLE R1 JMP @SIZE(R1) S1: MOVB #64,SIZSTR+2 BR SIZGO S2: MOVB #63,SIZSTR+2 BR SIZGO S3: MOVB #62,SIZSTR+2 BR SIZGO S4: MOVB #60,SIZSTR+2 BR SIZGO S5: MOVB #70,SIZSTR+2 BR SIZGO S6: MOVB #67,SIZSTR+2 BR SIZGO S7: MOVB #66,SIZSTR+2 BR SIZGO S8: MOVB #65,SIZSTR+2 BR SIZGO SIZGO: QIOW$C IO.WVB,4,1,,,, BR STOP ; ; CHOICE 3: SET THE LEFT MARGIN ; CHO3: MOV #SIZSTR,R2 ADD #2,R2 C32: MOVB (R1)+,(R2)+ CMPB (R1),#60 BGE C32 MOVB #163,(R2)+ MOVB #15,(R2)+ SUB #SIZSTR,R2 QIOW$S #IO.WVB,#4,#1,,,,<#SIZSTR,R2> ; ; STOP: EXIT$S TABLE: .WORD CHO1,CHO2,CHO3 SIZE: .WORD S1,S2,S3,S4,S5,S6,S7,S8 MES1: .ASCII /SYNTAX ERROR/ LM1=.-MES1 MES2: .ASCII /THIS IS AN ILLEGAL CHAR SIZE/ LM2=.-MES2 FF: .BYTE 14 ; THE FORMFEED SIZSTR: .BYTE 33,133,60,167,15 ; ESC, [, 0, w .END START The following example illustrates the use of the two subroutines. In this case the version of CSIZE that allows the print size to be changed in the middle of a line was used.  C C TEST.FTN C BYTE NULL DATA NULL/0/ CALL ASSIGN(2,'JUNK.DMP;1') CALL CSIZE(2,3,6) WRITE(2,100) 100 FORMAT(/,' THIS TEXT IS SIZE 3 WITH A MARGIN OF 6',/, 1' THE LINE THAT FOLLOWS SHOWS THE EFFECT OF REPLACING THE 2 PLUS CHARACTER',/,' WITH THE NULL CHARACTER IN THE CSIZE 3 SUBROUTINE.') CALL CSIZE(2,1,6) WRITE(2,110) ! SEND A LINE FEED AT THE BEGINNING 110 FORMAT('$SIZE 1') ! BUT NO CARRIAGE RETURN CALL CSIZE(2,3,6) WRITE(2,120)NULL 120 FORMAT(A1,' SIZE 3') CALL CSIZE(2,5,6) WRITE(2,130)NULL 130 FORMAT(A1,' SIZE 5') CALL CSIZE(2,7,6) WRITE(2,140)NULL 140 FORMAT(A1,' SIZE 7') CALL CSIZE(2,8,9) WRITE(2,150) ! A CR IS SENT AT END OF THIS LINE 150 FORMAT('+ SIZE 8') ! WHICH CAUSES NEXT LINE TO HAVE MARGIN 9 CALL CSIZE(2,3,9) WRITE(2,160) 160 FORMAT(' THIS IS ON A NEW LINE AND BACK TO SIZE 1 3 WITH MARGIN 9') CALL SPOOL(2,IERR) C IERR WILL CONTAIN ANY ERROR CODE FROM THE SPOOLING CALL EXIT END Here is the output from the program.