TITLE 'FORMAT $FTP FILE FOR PRINTING'
*++
*
* EXPAND TABS, FIX CARRIAGE CONTROL.
*
* $CONTROL *PRINT* MARGIN=0 LINES=66 MAY BE USEFUL IF THE
* FILE HAS NO FORM FEEDS.
*
* -*- ASMH -*-
*
* MAY 09/93    JMBW    CREATED.
* DEC 04/94    JMBW    MORE GENERAL FORMATTING, OVERPRINTING.
*
*--
A        EQU   2                  ;INPUT LINE PTR
B        EQU   3                  ;OUTPUT LINE PTR
C        EQU   4                  ;INPUT LINE CTR
D        EQU   5                  ;TEMP
E        EQU   6                  ; "
*
         MACRO
&LAB     JSYS  &DEST,&ARGS,&ERR   ;JUMP TO SYSTEM
&LAB     L     15,=V(&DEST)
         AIF   ('&ARGS' EQ '').NOARGS
         LA    1,&ARGS
.NOARGS  BASR  14,15
         AIF   ('&ERR' EQ '').NOPUNT
         LTR   15,15
         BNZ   &ERR
.NOPUNT  MEND
*
START    ENTER 12,SA=REGS
         MVI   CC,C' '            ;INIT CARR. CONTROL
IN       JSYS  SCARDS,=A(IBUF,LEN,ZERO,DUMMY),DONE ;GET A LINE
         L     A,=A(IBUF)         ;PT AT INPUT BUF
         XR    B,B                ;AND OUTPUT BUF OFFSET
         LH    C,LEN              ;GET LENGTH
         LTR   C,C                ;ANYTHING?
         BZ    OUTLIN             ;WRITE BLANK LINE IF NOT
CHAR     CLI   0(A),X'05'         ;TAB?
         BE    TAB
         CLI   0(A),X'0C'         ;FORM FEED?
         BE    FF
         CLI   0(A),X'0D'         ;CARRIAGE RETURN?
         BE    CARRET
         CLI   0(A),X'16'         ;BACKSPACE?
         BE    BKSPC
         CLI   0(A),X'25'         ;LINE FEED?
         BE    LNFD
         IC    D,0(A)             ;NONE OF THE ABOVE, COPY
         STC   D,OBUF(B)
         LA    B,1(B)             ;ADVANCE OUTPUT INDEX
NEXT     LA    A,1(A)             ;ADVANCE INPUT PTR
         BCT   C,CHAR             ;LOOP THROUGH LINE
OUTLIN   BAS   10,OUT             ;FLUSH LINE
         B     IN
DONE     EXIT  ,                  ;LATER
*
* TAB, ADVANCE TO NEXT TAB STOP.
*
TAB      LA    D,OBUF(B)          ;PT AT OUTPUT POSN
         MVC   0(8,D),=C'        ' ;UP TO 8 BLANKS
         LA    B,8(B)             ;AS I SAID
         N     B,=F'-8'           ;DOWN TO 8-BYTE BOUNDARY
         B     NEXT
*
* FORM FEED, USE '1' CARRIAGE CONTROL ON NEXT LINE, OR ON THIS ONE IF
* WE HAVEN'T WRITTEN ANYTHING IN IT YET.
*
FF       LTR   B,B                ;WRITTEN ANYTHING YET?
         BNZ   FF1
         MVI   CC,C'1'            ;NO, FORM FEED BEFORE THIS LINE
         B     NEXT
FF1      BAS   10,OUT             ;YES, FLUSH LINE
         MVI   CC,C'1'            ;NOW SET CARR CTRL
         B     BLANK              ;BLANKS UP TO THIS COL
*
* CARRIAGE RETURN, OVERPRINT REST OF LINE.
*
CARRET   BAS   10,OUT             ;FLUSH CURRENT LINE
         MVI   CC,C'+'            ;OVERPRINT NEXT LINE
         XR    B,B                ;REINIT OUTPUT PTR
         B     NEXT
*
* BACKSPACE, OVERPRINT REST OF LINE ONE SPACE TO THE LEFT.
*
BKSPC    LTR   B,B                ;AT LEFT MARG?
         BZ    NEXT               ;NO OP IF SO
         BAS   10,OUT             ;OTHERWISE FLUSH LINE
         BCTR  B,0                ;BACK UP
         MVI   CC,C'+'            ;OVERPRINT REST OF LINE
         B     BLANK              ;BLANK IT OUT UP TO CARRIAGE POSN
*
* LINE FEED, START NEXT LINE AT THIS COLUMN.
*
LNFD     BAS   10,OUT             ;FLUSH LINE
*
* CLEAR OUTPUT LINE UP TO POINTER (AFTER LF, FF, BS), THEN LOOP.
*
BLANK    LTR   E,B                ;GET # CHARS IN BUF
         BZ    NEXT               ;NONE
         LA    D,OBUF             ;POINT AT IT
BLANK1   MVI   0(D),C' '          ;BLANK IT OUT
         LA    D,1(D)             ;SKIP IT
         BCT   E,BLANK1
         B     NEXT
*+
*
* FLUSH OUTPUT LINE.  CALLED THROUGH R10.
*
*-
OUT      LTR   B,B                ;GOT ANYTHING?
         BNZ   OUT1
         CLI   CC,C'+'            ;NO, OVERWRITING NOTHING?
         BE    OUT2               ;WHY BOTHER
OUT1     LA    B,1(B)             ;FIND LENGTH INCLUDING CC
         STH   B,LEN              ;SAVE
         JSYS  SPRINT,=A(CC,LEN,ZERO,DUMMY)
         BCTR  B,0                ;-1 AGAIN
OUT2     MVI   CC,C' '            ;RESET CC
         BR    10                 ;RETURN
*
         LTORG                    ;LITS
ZERO     DC    F'0'               ;MODIFIER BITS
DUMMY    DS    F                  ;CATCH LINE #
REGS     DS    18F                ;R13 SAVE AREA
LEN      DS    H                  ;LENGTH
CC       DS    C                  ;CARRIAGE CONTROL
OBUF     DS    32767C             ;OUTPUT BUFFER
IBUF     DS    32767C             ;INPUT BUFFER
*
         END   START