SUBROUTINE MAIN LOGICAL*1 FIL(40), LIN(512) INTEGER NXTFIL INTEGER BEGBLK, GETARG, GETLIN, STMODE, NOTE INTEGER I, MARKER(2), MAXLEN, MAXLVL, NDX, OMODE, JUNK COMMON / CFD / IFD, OFD INTEGER IFD INTEGER OFD CALL QUERY( 42Husage: box [-e] [-d{device}] [-] file ... ) CALL BOXARG OFD = 2 OMODE = STMODE( OFD, 1) CALL PUTCH( 10, OFD) NDX = 1 23000 CONTINUE IFD = NXTFIL( FIL, NDX) NDX = NDX + 1 IF (.NOT.( IFD .EQ. -1 ))GOTO 23003 GOTO 23002 23003 CONTINUE 23005 IF (.NOT.( GETLIN( LIN, IFD) .NE. -1 ))GOTO 23006 IF (.NOT.( BEGBLK(LIN) .EQ. 0 ))GOTO 23007 I = 1 23009 IF (.NOT.(LIN(I) .NE. 0 ))GOTO 23011 IF (.NOT.( LIN(I) .NE. 10 ))GOTO 23012 CALL PUTCH( LIN(I), OFD) GOTO 23013 23012 CONTINUE IF (.NOT.( OMODE .NE. 0 ))GOTO 23014 CALL PUTCH( 13, OFD) 23014 CONTINUE CALL PUTCH( 10, OFD) 23013 CONTINUE 23010 I = I + 1 GOTO 23009 23011 CONTINUE GOTO 23008 23007 CONTINUE JUNK = NOTE ( MARKER, IFD) CALL MEASUR( MAXLEN, MAXLVL) CALL SEEK( MARKER, IFD) CALL PROCES( MAXLEN, MAXLVL) 23008 CONTINUE GOTO 23005 23006 CONTINUE IF (.NOT.( IFD .NE. 1 ))GOTO 23016 CALL CLOSE(IFD) 23016 CONTINUE 23001 GOTO 23000 23002 CONTINUE OMODE = STMODE( OFD, 0) RETURN END INTEGER FUNCTION BEGBLK(LIN) LOGICAL*1 LIN(512) INTEGER I I = 1 23018 IF (.NOT.((LIN(I) .EQ. 32 .OR. LIN(I) .EQ. 9) .AND. LIN(I) .NE. 0 *))GOTO 23020 23019 I = I + 1 GOTO 23018 23020 CONTINUE IF (.NOT.( LIN(I) .EQ. 123 ))GOTO 23021 BEGBLK=(1) RETURN 23021 CONTINUE BEGBLK=(0) RETURN 23022 CONTINUE END SUBROUTINE BOXARG INTEGER I INTEGER EQUAL, GETARG LOGICAL*1 ARG(40) COMMON / CBOX / ENTABF, GRFOFF(3), GRFON(3), GRFPRF, GRFBLK, NWCOR *N, NECORN, SWCORN, SECORN, HEDGE, VEDGE INTEGER ENTABF LOGICAL*1 GRFOFF LOGICAL*1 GRFON LOGICAL*1 GRFPRF LOGICAL*1 GRFBLK LOGICAL*1 NWCORN LOGICAL*1 NECORN LOGICAL*1 SWCORN LOGICAL*1 SECORN LOGICAL*1 HEDGE LOGICAL*1 VEDGE COMMON / CTABS / TABS(512) INTEGER TABS DATA GRFOFF(1) / 0 / DATA GRFON(1) / 0 / DATA GRFPRF / 0 / DATA GRFBLK / 32 / DATA NWCORN / 43 / DATA NECORN / 43 / DATA SWCORN / 43 / DATA SECORN / 43 / DATA HEDGE / 45 / DATA VEDGE / 124 / DATA ENTABF / 0 / CALL SETTAB( 0, TABS) I = 1 23023 IF (.NOT.(GETARG( I, ARG, 40) .NE. -1 ))GOTO 23025 IF (.NOT.( ARG(1) .EQ. 45 .AND. ARG(2) .NE. 0 ))GOTO 23026 CALL FOLD(ARG) IF (.NOT.( ARG(2) .EQ. 100 ))GOTO 23028 IF (.NOT.( EQUAL( ARG(3), 5Hvt100) .EQ. 1 ))GOTO 23030 CALL STRCPY( 2H(0, GRFON) CALL STRCPY( 2H(B, GRFOFF) GRFPRF = 27 GRFBLK = 95 NWCORN = 108 NECORN = 107 SWCORN = 109 SECORN = 106 HEDGE = 113 VEDGE = 120 GOTO 23031 23030 CONTINUE IF (.NOT.( EQUAL( ARG(3), 3Hh19) .EQ. 1 ))GOTO 23032 CALL STRCPY( 1HF, GRFON) CALL STRCPY( 1HG, GRFOFF) GRFPRF = 27 GRFBLK = 32 NWCORN = 102 NECORN = 99 SWCORN = 101 SECORN = 100 HEDGE = 97 VEDGE = 96 GOTO 23033 23032 CONTINUE CALL BOXERR( 21HI don't know about a , ARG(3), 8H device.) 23033 CONTINUE 23031 CONTINUE GOTO 23029 23028 CONTINUE IF (.NOT.( ARG(2) .EQ. 101 ))GOTO 23034 ENTABF = 1 GOTO 23035 23034 CONTINUE CALL BOXERR( 21HI don't know about a , ARG(2), 8H option.) 23035 CONTINUE 23029 CONTINUE CALL DELARG(I) I = I - 1 23026 CONTINUE 23024 I = I + 1 GOTO 23023 23025 CONTINUE RETURN END SUBROUTINE BOXERR( STR1, STR2, STR3) LOGICAL*1 STR1(100), STR2(100), STR3(100) LOGICAL*1 BOXSTR(8) LOGICAL*1 QST1(3) LOGICAL*1 QST2(3) DATA BOXSTR(1)/63/,BOXSTR(2)/32/,BOXSTR(3)/66/,BOXSTR(4)/111/,BOXS *TR(5)/120/,BOXSTR(6)/58/,BOXSTR(7)/32/,BOXSTR(8)/0/ DATA QST1(1)/96/,QST1(2)/96/,QST1(3)/0/ DATA QST2(1)/39/,QST2(2)/39/,QST2(3)/0/ CALL PUTLIN( BOXSTR, 3) CALL PUTLIN( STR1, 3) CALL PUTLIN( QST1, 3) CALL PUTLIN( STR2, 3) CALL PUTLIN( QST2, 3) CALL REMARK( STR3) CALL PUTCH( 10, 3) RETURN END SUBROUTINE BOXLIN(INPLIN) LOGICAL*1 INPLIN(100), LIN(512) INTEGER I COMMON / CBOX / ENTABF, GRFOFF(3), GRFON(3), GRFPRF, GRFBLK, NWCOR *N, NECORN, SWCORN, SECORN, HEDGE, VEDGE INTEGER ENTABF LOGICAL*1 GRFOFF LOGICAL*1 GRFON LOGICAL*1 GRFPRF LOGICAL*1 GRFBLK LOGICAL*1 NWCORN LOGICAL*1 NECORN LOGICAL*1 SWCORN LOGICAL*1 SECORN LOGICAL*1 HEDGE LOGICAL*1 VEDGE COMMON / CFD / IFD, OFD INTEGER IFD INTEGER OFD COMMON / CTABS / TABS(512) INTEGER TABS IF (.NOT.( ENTABF .EQ. 1 ))GOTO 23036 CALL ENTABL( INPLIN, LIN, TABS) GOTO 23037 23036 CONTINUE CALL STRCPY( INPLIN, LIN) 23037 CONTINUE I = 1 23038 IF (.NOT.(LIN(I) .NE. 0 ))GOTO 23040 IF (.NOT.( LIN(I) .EQ. 1 ))GOTO 23041 CALL GRAFIC( GRFON, OFD) CALL PUTCH( NWCORN, OFD) I = I + 1 23043 IF (.NOT.(LIN(I) .EQ. 5 ))GOTO 23045 CALL PUTCH( HEDGE, OFD) 23044 I = I + 1 GOTO 23043 23045 CONTINUE IF (.NOT.( LIN(I) .EQ. 2 ))GOTO 23046 CALL PUTCH( NECORN, OFD) GOTO 23047 23046 CONTINUE I = I - 1 23047 CONTINUE CALL GRAFIC( GRFOFF, OFD) GOTO 23042 23041 CONTINUE IF (.NOT.( LIN(I) .EQ. 3 ))GOTO 23048 CALL GRAFIC( GRFON, OFD) CALL PUTCH( SWCORN, OFD) I = I + 1 23050 IF (.NOT.(LIN(I) .EQ. 5 ))GOTO 23052 CALL PUTCH( HEDGE, OFD) 23051 I = I + 1 GOTO 23050 23052 CONTINUE IF (.NOT.( LIN(I) .EQ. 4 ))GOTO 23053 CALL PUTCH( SECORN, OFD) GOTO 23054 23053 CONTINUE I = I - 1 23054 CONTINUE CALL GRAFIC( GRFOFF, OFD) GOTO 23049 23048 CONTINUE IF (.NOT.( LIN(I) .EQ. 6 ))GOTO 23055 CALL GRAFIC( GRFON, OFD) 23057 IF (.NOT.(LIN(I) .EQ. 6 .OR. LIN(I) .EQ. 32 ))GOTO 23059 IF (.NOT.( LIN(I) .EQ. 32 ))GOTO 23060 CALL PUTCH( GRFBLK, OFD) GOTO 23061 23060 CONTINUE CALL PUTCH( VEDGE, OFD) 23061 CONTINUE 23058 I = I + 1 GOTO 23057 23059 CONTINUE CALL GRAFIC( GRFOFF, OFD) I = I - 1 GOTO 23056 23055 CONTINUE CALL PUTCH( LIN(I), OFD) 23056 CONTINUE 23049 CONTINUE 23042 CONTINUE 23039 I = I + 1 GOTO 23038 23040 CONTINUE RETURN END SUBROUTINE DETABL( IN, OUT, TABS) LOGICAL*1 IN(100), OUT(100) INTEGER I, J, ONDX, TABS(100) INTEGER TABPOS ONDX = 1 I = 1 23062 IF (.NOT.(IN(I) .NE. 0 ))GOTO 23064 IF (.NOT.( IN(I) .EQ. 9 ))GOTO 23065 J = I 23067 CONTINUE CALL CHCOPY( 32, OUT, ONDX) J = J + 1 IF (.NOT.( TABPOS( J, TABS) .EQ. 1 ))GOTO 23070 GOTO 23069 23070 CONTINUE 23068 GOTO 23067 23069 CONTINUE GOTO 23066 23065 CONTINUE CALL CHCOPY( IN(I), OUT, ONDX) 23066 CONTINUE 23063 I = I + 1 GOTO 23062 23064 CONTINUE OUT(ONDX) = 0 RETURN END INTEGER FUNCTION DOBOT( LIN, START, STOP) LOGICAL*1 LIN(100) INTEGER I, START, STOP I = START CALL CHCOPY( 3, LIN, I) 23072 IF (.NOT.(I .LE. STOP ))GOTO 23074 LIN(I) = 5 23073 I = I + 1 GOTO 23072 23074 CONTINUE LIN(I) = 4 DOBOT=(I+1) RETURN END INTEGER FUNCTION DOLEFT( LIN, NDX, COUNT) LOGICAL*1 LIN(100) INTEGER COUNT, I, N, NDX I = NDX N = COUNT 23075 IF (.NOT.(N .GT. 0 ))GOTO 23077 CALL CHCOPY( 6, LIN, I) LIN(I) = 32 I = I + 1 23076 N = N - 1 GOTO 23075 23077 CONTINUE DOLEFT=(I) RETURN END INTEGER FUNCTION DORITE( LIN, NDX, COUNT) LOGICAL*1 LIN(100) INTEGER COUNT, I, N, NDX I = NDX N = COUNT 23078 IF (.NOT.(N .GT. 0 ))GOTO 23080 CALL CHCOPY( 32, LIN, I) CALL CHCOPY( 6, LIN, I) 23079 N = N - 1 GOTO 23078 23080 CONTINUE DORITE=(I) RETURN END INTEGER FUNCTION DOTOP( LIN, START, STOP) LOGICAL*1 LIN(100) INTEGER I, START, STOP I = START CALL CHCOPY( 1, LIN, I) 23081 IF (.NOT.(I .LE. STOP ))GOTO 23083 LIN(I) = 5 23082 I = I + 1 GOTO 23081 23083 CONTINUE LIN(I) = 2 DOTOP=(I+1) RETURN END INTEGER FUNCTION ENDBLK(LIN) LOGICAL*1 LIN(512) INTEGER I I = 1 23084 IF (.NOT.((LIN(I) .EQ. 32 .OR. LIN(I) .EQ. 9 ) .AND. LIN(I).NE.0 ) *)GOTO 23086 23085 I = I + 1 GOTO 23084 23086 CONTINUE IF (.NOT.( LIN(I) .EQ. 125 ))GOTO 23087 ENDBLK=(1) RETURN 23087 CONTINUE ENDBLK=(0) RETURN 23088 CONTINUE END SUBROUTINE ENTABL( IN, OUT, TABS) LOGICAL*1 IN(100), OUT(100) INTEGER COL, NEWCOL, ONDX, TABS(100) INTEGER TABPOS ONDX = 1 COL = 1 23089 IF (.NOT.(IN(COL) .NE. 0 ))GOTO 23091 NEWCOL = COL 23092 IF (.NOT.( IN(NEWCOL) .EQ. 32 ))GOTO 23093 NEWCOL = NEWCOL + 1 IF (.NOT.( TABPOS( NEWCOL, TABS) .EQ. 1 ))GOTO 23094 CALL CHCOPY( 9, OUT, ONDX) COL = NEWCOL 23094 CONTINUE GOTO 23092 23093 CONTINUE 23096 IF (.NOT.(COL .LT. NEWCOL ))GOTO 23098 CALL CHCOPY( 32, OUT, ONDX) 23097 COL = COL + 1 GOTO 23096 23098 CONTINUE CALL CHCOPY( IN(COL), OUT, ONDX) 23090 COL = COL + 1 GOTO 23089 23091 CONTINUE RETURN END SUBROUTINE GRAFIC( STR, FD) LOGICAL*1 STR(100) INTEGER FD COMMON / CBOX / ENTABF, GRFOFF(3), GRFON(3), GRFPRF, GRFBLK, NWCOR *N, NECORN, SWCORN, SECORN, HEDGE, VEDGE INTEGER ENTABF LOGICAL*1 GRFOFF LOGICAL*1 GRFON LOGICAL*1 GRFPRF LOGICAL*1 GRFBLK LOGICAL*1 NWCORN LOGICAL*1 NECORN LOGICAL*1 SWCORN LOGICAL*1 SECORN LOGICAL*1 HEDGE LOGICAL*1 VEDGE IF (.NOT.( GRFPRF .NE. 0 ))GOTO 23099 CALL PUTCH( GRFPRF, FD) CALL PUTLIN( STR, FD) 23099 CONTINUE RETURN END SUBROUTINE MEASUR( MAXLEN, MAXLVL) INTEGER I, LEVEL, LINLEN, MAXLEN, MAXLVL INTEGER READLN LOGICAL*1 LIN(512) MAXLEN = 0 MAXLVL = 0 LEVEL = 1 23101 IF (.NOT.(LEVEL .GT. 0 ))GOTO 23103 IF (.NOT.( LEVEL .GT. MAXLVL ))GOTO 23104 MAXLVL = LEVEL 23104 CONTINUE IF (.NOT.( LINLEN .GT. MAXLEN ))GOTO 23106 MAXLEN = LINLEN 23106 CONTINUE 23102 LINLEN = READLN( LIN, LEVEL) GOTO 23101 23103 CONTINUE RETURN END INTEGER FUNCTION NXTFIL( FIL, NDX) LOGICAL*1 FIL(100) INTEGER FD INTEGER NDX INTEGER GETARG, OPEN IF (.NOT.( GETARG( NDX, FIL, 40) .NE. -1 ))GOTO 23108 IF (.NOT.( FIL(1) .EQ. 45 .AND. FIL(2) .EQ. 0 ))GOTO 23110 NXTFIL=(1) RETURN 23110 CONTINUE FD = OPEN( FIL, 1) IF (.NOT.( FD .EQ. -3 ))GOTO 23112 CALL CANT(FIL) GOTO 23113 23112 CONTINUE NXTFIL=(FD) RETURN 23113 CONTINUE GOTO 23109 23108 CONTINUE IF (.NOT.( NDX .EQ. 1 ))GOTO 23114 NXTFIL=(1) RETURN 23114 CONTINUE NXTFIL=(-1) RETURN 23115 CONTINUE 23109 CONTINUE END SUBROUTINE PROCES( MAXLEN, MAXLVL) LOGICAL*1 LIN(512) INTEGER I, J, MAXLEN, MAXLVL INTEGER DOBOT, DOLEFT, DORITE, DOTOP INTEGER LCIL INTEGER FCIL INTEGER LEVEL, LINLEN INTEGER BEGBLK, ENDBLK, READLN LOGICAL*1 LBRNL(3) LOGICAL*1 CRLF(3) DATA LBRNL(1)/123/,LBRNL(2)/10/,LBRNL(3)/0/ DATA CRLF(1)/13/,CRLF(2)/10/,CRLF(3)/0/ CALL STRCPY( LBRNL, LIN) LEVEL = 1 23116 IF (.NOT.(LEVEL .GT. 0 ))GOTO 23118 FCIL = LEVEL * 2 - 1 LCIL = MAXLEN + (MAXLVL - LEVEL) * 2 + 2 IF (.NOT.( BEGBLK(LIN) .EQ. 1 ))GOTO 23119 I = 1 I = DOLEFT( LIN, I, LEVEL - 1 ) I = DOTOP( LIN, I, LCIL - 1) I = DORITE( LIN, I, LEVEL - 1) CALL SCOPY( CRLF, 1, LIN, I) CALL BOXLIN(LIN) GOTO 23120 23119 CONTINUE IF (.NOT.( ENDBLK(LIN) .EQ. 1 ))GOTO 23121 I = 1 I = DOLEFT( LIN, I, LEVEL) I = DOBOT( LIN, I, LCIL - 3) I = DORITE( LIN, I, LEVEL) CALL SCOPY( CRLF, 1, LIN, I) CALL BOXLIN(LIN) GOTO 23122 23121 CONTINUE I = 1 I = DOLEFT( LIN, I, LEVEL) IF (.NOT.( I .LE. LINLEN ))GOTO 23123 I = LINLEN + 1 23123 CONTINUE 23125 IF (.NOT.(I .LE. LCIL - 2 ))GOTO 23127 LIN(I) = 32 23126 I = I + 1 GOTO 23125 23127 CONTINUE I = DORITE( LIN, I, LEVEL) CALL SCOPY( CRLF, 1, LIN, I) CALL BOXLIN(LIN) 23122 CONTINUE 23120 CONTINUE 23117 LINLEN = READLN( LIN, LEVEL) GOTO 23116 23118 CONTINUE I = 1 23128 IF (.NOT.(I .LT. FCIL ))GOTO 23130 LIN(I) = 32 23129 I = I + 1 GOTO 23128 23130 CONTINUE I = 1 I = DOLEFT( LIN, I, LEVEL) I = DOBOT( LIN, I, LCIL - 1) CALL SCOPY( CRLF, 1, LIN, I) CALL BOXLIN(LIN) RETURN END INTEGER FUNCTION READLN( LIN, LEVEL) LOGICAL*1 INPLIN(512), LIN(512) INTEGER I, LEVEL INTEGER BEGBLK, ENDBLK, GETLIN, LENGTH COMMON / CTABS / TABS(512) INTEGER TABS COMMON / CFD / IFD, OFD INTEGER IFD INTEGER OFD LOGICAL*1 LBRNL(3) LOGICAL*1 RBRNL(3) DATA LBRNL(1)/123/,LBRNL(2)/10/,LBRNL(3)/0/ DATA RBRNL(1)/125/,RBRNL(2)/10/,RBRNL(3)/0/ IF (.NOT.( GETLIN( INPLIN, IFD) .NE. -1 ))GOTO 23131 CALL DETABL( INPLIN, LIN, TABS) IF (.NOT.( BEGBLK(LIN) .EQ. 1 ))GOTO 23133 LEVEL = LEVEL + 1 CALL STRCPY( LBRNL, LIN) READLN=(1) RETURN 23133 CONTINUE IF (.NOT.( ENDBLK(LIN) .EQ. 1 ))GOTO 23135 LEVEL = LEVEL - 1 CALL STRCPY( RBRNL, LIN) READLN=(1) RETURN 23135 CONTINUE I = LENGTH(LIN) IF (.NOT.( LIN(I) .EQ. 10 .AND. I .GT. 1 ))GOTO 23137 I = I - 1 23137 CONTINUE IF (.NOT.( LIN(I) .EQ. 35 ))GOTO 23139 I = I - 1 23141 IF (.NOT.((LIN(I) .EQ. 32 .OR. LIN(I) .EQ. 35) .AND. I .GT. 1 ))GO *TO 23143 23142 I = I - 1 GOTO 23141 23143 CONTINUE LIN(I+1) = 10 LIN(I+2) = 0 23139 CONTINUE READLN=(I) RETURN 23136 CONTINUE 23134 CONTINUE GOTO 23132 23131 CONTINUE CALL REMARK( 51HPremature EOF encountered. EndBlock line inserted *.) LEVEL = LEVEL - 1 CALL STRCPY( RBRNL, LIN) READLN=(1) RETURN 23132 CONTINUE END