SUBROUTINE DSPSHT(ICODE) C COPYRIGHT (C) 1983 GLENN EVERHART C PERMISSION IS GIVEN TO ANYONE TO USE, DISTRIBUTE, OR COPY THIS C PROGRAM FREELY BUT NOT TO SELL IT COMMERICALLY. C DISPLAY SPREAD SHEET ON SCREEN OR IN FILE IF ICODE=10 C USES UVT100 TO TWEAK THE VT100. NO WRAP IS ASSUMED SO C OUTPUT UP TO 132 COLS BY 24 LINES IS OK. ONLY CHECK C MODIFIED FOR VAX TO ALLOW UP TO 512 CHARS WIDE OUT. C WIDTH TO ALLOW VT100 LOOKALIKES WITH MORE DISPLAY LINES TOO. INCLUDE 'VKLUGPRM.FTN' C PARAMETER RRCL=RRW*RCL PARAMETER CUP = 1, CUU = 2, CUD = 3, CUF = 4, CUB = 5, DECDWL = 6 $, DECDHL = 7, DECRC = 8, DECSC = 9, DECSWL = 10, ED = 11, EL = 12 $, SGR = 13, NEL = 14, SCS = 15, SM = 16, RM = 17, ANSI = 18 C NOTE: THROUGHOUT, ROWS ARE ACTUALLY DOWN, COLUMNS ACROSS ON C SCREEN. ROW 0 IN DISPLAY IS THE 27 ACCUMULATORS A-Z AND %, WITH C % BEING THE LAST-COMPUTED VALUE FROM THE CALC PROGRAM, WHICH C KNOWS HOW TO ACCESS THE DATA BUT IS JUST PASSED COMMAND STRINGS C FROM THE DISK BASED FILE HERE. INTEGER*2 IDOL1,IDOL2,IDOL3,IDOL4,IDOL5,IDOL6 COMMON/DOLLR/IDOL1,IDOL2,IDOL3,IDOL4,IDOL5,IDOL6 LOGICAL*1 FORM,FVLD,CMDLIN(132),PRTLIN(512) LOGICAL*1 PRTLIX(524) EQUIVALENCE(PRTLIN(1),PRTLIX(1)) C PRTLIX JUST GIVES A FEW EXTRA SPACES FOR SAFETY INTEGER*4 VNLT,FVLDTP LOGICAL*1 LBEL(4) LOGICAL*1 LET1,LET2,FORM2(128),NMSH(80) COMMON/NMSH/NMSH C FLAG BORDR=1 IF WE WANT TO OMIT BORDERS ON DRAWING C THE SCREEN DISPLAY TO A FILE. INTEGER*2 BORDR,TOMT C COMMON ICPOS ALLOWS UVT100 ROUTINE ACCESS TO DISPLAYED NUMBERS C FOR USES SUCH AS SETTING COLORS... INTEGER*2 IC1POS,IC2POS COMMON/ICPOS/IC1POS,IC2POS INTEGER*2 IOLVL COMMON/IOLVL/IOLVL REAL*8 XVBLS(RRWP,RCLP),VDSP,VCLC LOGICAL*1 DFE(12) DIMENSION FORM(128),FVLD(RRWP,RCLP) C FVLD FLAG 0 = NO FORMULA, -1= DISPLAY FORMULA ITSELF, NOT VALUE C 1=VALID ACTIVE FORMULA THERE TO EVALUATE. INITIALLY ALL 0'S C SO INITIALLY IGNORE. C C ROUTINE IN2AS COMPUTES ASCII CHARACTER NAMES OF SUBSCRIPTS IN1,IN2 C SO DISPLAY CAN HAVE THEM. IT MUST BE THE INVERSE OF VARSCN. INTEGER*2 PROW,PCOL,DROW,DCOL,DRWV,DCLV INTEGER*2 LLCMD,LLDSP COMMON/DCTL/PROW,PCOL,DROW,DCOL,DRWV,DCLV,LLCMD,LLDSP DIMENSION NRDSP(DRW,DCL),NCDSP(DRW,DCL) COMMON/D2R/NRDSP,NCDSP INTEGER*2 ILNFG,ILNCT,RCF LOGICAL*1 ILINE(106) COMMON/ILN/ILNFG,ILNCT,ILINE INTEGER LENTL(5),LOCOL(5) LOGICAL*1 FILINE(600) LOGICAL*1 OARRY(100) INTEGER*2 OSWIT,OCNTR COMMON/OAR/OSWIT,OCNTR,OARRY C COMMON OAR SWITCHES OUTPUT OFF IF OSWIT=2 INTEGER*2 TYPE(RRWP,RCLP),VLEN(9) LOGICAL*1 AVBLS(20,27),VBLS(8,RRWP,RCLP) EQUIVALENCE(XVBLS(1,1),VBLS(1,1,1)) COMMON/V/TYPE,AVBLS,VBLS,VLEN INTEGER *2 FORMFG,RCFGX COMMON/FFGG/FORMFG,RCFGX C C DISPLAY ARRAY WILL KEEP A COPY OF VARIABLES DISPLAYED AND FORMATS C USED LOCALLY WHICH DISPLAY ROUTINE CAN USE TO SEE WHAT ACTUALLY C NEEDS TO BE REFRESHED ON SCREEN. DRWV AND DCLV ARE COLS, ROWS OF C DISPLAY ACTUALLY USED FOR SCREEN. INTEGER*2 CWIDS(DRW) C CWIDS IS WIDTHS IN CHARACTERS OF COLUMNS ON DISPLAY. NOTE THAT BECAUSE C OF PECULIAR INVERSION WHICH I AM TOO LAZY TO CORRECT IT IS DIMENSIONED C AS DRW NOT DCL. REAL*8 DVS(DRW,DCL) INTEGER*4 LDVS(2,DRW,DCL) EQUIVALENCE(LDVS(1,1,1),DVS(1,1)) COMMON /FVLDC/FVLD C LOGICAL*1 DFMTS(10,DRW,DCL) C 10 CHARACTERS PER ENTRY. C COMMON/DSPCMN/DVS,DFMTS,CWIDS COMMON/DSPCMN/DVS,CWIDS C THISRW,THISCL = CURRENT DISPLAYED LOCS. INTEGER*2 THISRW,THISCL C NOTE ROWS ARE DOWN, COLS ACROSS INTERNALLY. C COLUMN 2 = NUMBERS. DISPLAY COLS 2-22 WITH COL 1=TITLE C COL 23,24 FOR COMMANDS.(LCMDR (PARAMETER) ACTUALLY.) C ROW OFFSET BY 6 FOR NUMBERS. C C MAINTAIN AN "INITIALIZED" BITMAP HERE TO USE TO AVOID GOING TO C DISK FOR FVLD. C LOGICAL*1 IBITMP C DIMENSION IBITMP(BRRCL) C COMMON/INITD/IBITMP C NOTE BITMAP IS ZEROED IN SPREDSHT MAIN PROGRAM (OR AT SAVE CMD) C AND IS SET HERE (AND HERE ONLY). ONLY USED HERE TOO... INTEGER*2 NULAST,LFVD COMMON/NULXXX/NULAST,LFVD INTEGER*2 RRWACT,RCLACT COMMON/RCLACT/RRWACT,RCLACT C RRWACT AND RCLACT ARE MAX ACTIVE ROW, COL NUMBERS. ALL CELLS BEYOND C THAT ARE EMPTY (OF FORMULA AT LEAST) LOGICAL*1 LBITS(8) DATA LBITS/1,2,4,8,16,32,64,128/ IF(ICODE.NE.10)GOTO 3000 CALL UVT100(CUP,LLCMD,1) CALL UVT100(EL,2) WRITE(6,25) 25 FORMAT('Enter print file spec., / after to omit borders>') READ(IOLVL,26,END=510,ERR=510)ISZ,FORM2 26 FORMAT(Q,128A1) ISZ=MIN0(127,ISZ) FORM2(ISZ+1)=0 BORDR=0 TOMT=0 DO 4111 N=1,ISZ C IF FILENAME HAS / AFTERWARDS, OMIT BORDER IF(FORM2(N).EQ.'/')BORDR=1 C NULL OUT THE / SO THAT FILENAME WILL PARSE CORRECTLY. IF(FORM2(N).EQ.'/')FORM2(N)=0 IF(FORM2(N).EQ.'%')TOMT=1 4111 CONTINUE OPEN(UNIT=8,FILE=FORM2,CARRIAGECONTROL='LIST', 1 RECL=600,ERR=9916) C CALL ASSIGN(8,FORM2) DO 27 N=1,512 27 PRTLIN(N)=32 ENCODE(7,2,PRTLIN) GOTO 3766 3000 CONTINUE C FLAG FOR REDISPLAY THAT BOTTOM LINE GETS UPDATED. NULAST=-4 3766 CONTINUE CALL UVT100(SGR,0) IF(TOMT.EQ.0.AND.ICODE.EQ.10)CALL PLW(NMSH,80) IF(ICODE.EQ.10)GOTO 2000 IF(ICODE.NE.2)GOTO 1000 C DRAW LABELS FIRST CALL UVT100(CUP,1,1) CALL UVT100(EL,2) IF(ICODE.NE.10)WRITE(6,17)NMSH CALL UVT100(CUP,2,1) CALL UVT100(EL,2) C ERASE TOP LINE, START AT COL 7 WRITE(6,2) 2 FORMAT('ROW/COL') C NOTE EXACTLY 7 CHARACTERS IN FORMAT #2 2000 CONTINUE J=8 CALL UVT100(SGR,7) DO 1 N1=1,DRWV LR=NRDSP(N1,1) C NOTE PHYS SHEET OFFSET BY 1 (SEE VARSCN) C DISPLAY SHEET NUMBERS START AT 1 IF(ICODE.NE.10)CALL UVT100(CUP,2,J) CALL IN2AS(LR,LBEL) IF(ICODE.EQ.10)GOTO 2020 WRITE(6,3)LBEL 3 FORMAT(4A1) IF(LBEL(4).EQ.32.AND.LBEL(3).EQ.32)CALL UVT100(CUP,2,J+2) IF(LBEL(4).EQ.32.AND.LBEL(3).NE.32)CALL UVT100(CUP,2,J+3) WRITE(6,7)N1 7 FORMAT('=',I2) GOTO 2030 2020 CONTINUE IF((J+CWIDS(N1)-7).GT.500)GOTO 2030 ICWD=MAX0(7,CWIDS(N1)) ENCODE(ICWD,2021,PRTLIN(J),ERR=2030),LBEL,N1 2021 FORMAT(4A1,'=',I2) 2030 CONTINUE J=J+CWIDS(N1) IF(J.GT.MPWD)GOTO 40 1 CONTINUE 40 CONTINUE C NOW COL LBLS DONE C DO NUMBERS ACROSS LEFT. C ONLY DO SO ON SCREEN. IF(BORDR.EQ.0.AND.ICODE.EQ.10)CALL PLW(PRTLIN,512) DO 2031 KKK=1,600 2031 FILINE(KKK)=32 DO 5031 KKK=1,512 5031 PRTLIN(KKK)=32 C 32 IS ASCII SPACE IF(ICODE.EQ.10)GOTO 1000 CALL UVT100(SGR,7) MCX=MIN0(LLCMD-1,DCLV)+2 C LLVL=0 C ROWS ARE JUST OFFSET...NO MONKEY BUSINESS. DO 6 N1=3,MCX M1=N1-2 LC=NCDSP(1,M1)-1 C N1=DISPLAY ROW CALL UVT100(CUP,N1,1) WRITE(6,8)LC 8 FORMAT(I5,'>') 6 CONTINUE C NOW DISPLAY VALUES. 1000 CONTINUE CALL UVT100(SGR,0) DO 10 N2=1,DCLV C JP IS CURRENT LOC. JPL IS CHARACTERS LEFT ACROSS. JP=8 JPL=504 DO 110 N1=1,DRWV M1=NRDSP(N1,N2) M2=NCDSP(N1,N2) C M1,M2 = PHYS SHEET COORDS OF WHAT IS DISPLAYED. M2M1=M2-1 C *** IF NORMAL DISPLAY, SKIP IF PAST ACTIVE AREA. C *** FOR FULL UPDATE KEEP THE COMPLETE LOGIC, HOWEVER, IN CASE C *** VALUES BEYOND MAX FORMULA AREA GET CHANGED. CC IF(ICODE.NE.2.AND.ICODE.NE.10.AND.IDOL4.EQ.0.AND. CC 1 (M1.GT.RRWACT.OR.M2.GT.RCLACT))GOTO 100 C IF(ICODE.NE.10.AND.IDOL4.EQ.0.AND. C 1 (M1.GT.RRWACT.OR.M2.GT.RCLACT))GOTO 100 IF(BORDR.EQ.0.AND.ICODE.EQ.10)ENCODE(6,8,PRTLIN)M2-1 C *** EXPERIMENTAL *** CALL FVLDGT(M1,M2,FVLD(1,1)) IF(ICODE.NE.2.AND.ICODE.NE.10.AND.IDOL4.EQ.0.AND.FVLD(1,1) 1 .EQ.0)GOTO 100 C SKIP DISPLAY OR UPDATE OF TOTALLY UNINITED CELLS C *** END EXPERIMENTAL SECTION VDSP=DVS(N1,N2) CALL XVBLGT(M1,M2,VCLC) C VCLC=XVBLS(M1,M2) C SEE IF DISPLAYED AND CALCULATED NUMBERS ARE IDENTICAL. C ONLY DISPLAY IF CHANGED. C *** OVERRRIDDEN IN MS MODE (IDOL4 <> 0 ). IF(IDOL4.NE.0)GOTO 620 IF(VDSP.EQ.VCLC.AND.ICODE.NE.2.AND.ICODE.NE.10)GOTO 100 620 IC1POS=M1 IC2POS=M2 C FALL THRU HERE IF WE NEEDTO DISPLAY A NUMBER IN ROW 3+N2, COL N1 C THEN RE-ESTABLISH FORMAT, ETC. M23=N2+2 J=8 DO 11 N11=1,N1 C GET THE COORDS OF OUR CELL. 11 J=J+CWIDS(N11) J=J-CWIDS(N1) C CURRENT CHARACTER COL NUMBER IS NOW J. C CALL UVT100(CUP,M23,J) C NO EFFECT HERE ANYWAY...FORGET IT. C DO 12 N11=1,CWIDS(N1) C12 WRITE(6,137) C137 FORMAT(X) CC BLANK OUT CELL ABOVE. C CALL UVT100(CUP,M23,J) C IRX=(M2-1)*RRW+M1 CALL REFLEC(M2,M1,IRX) C C BITMAP CODE C C ONLY READ DISK FOR SHEET DISPLAY IF THE BITMAP BIT FOR C THIS ENTRY IS 0 INDICATING IT HAS NOT BEEN SET ALREADY. C USE LBITS BITS ARRAY TO INDEX INTO BITS WITHIN THE MAP. C ******** BEWARE ********* C THIS SECTION RELIES ON FORTRAN DOING BOOLEAN OPERATIONS C WITH MASKING INSTRUCTIONS. THIS IS TRUE IN DEC FORTRAN, C AND USUALLY IN IBM FORTRAN BUT NOT ALWAYS IN IBM OR OTHER C PLACES... CC IR8=(IRX-1).AND.7 CC IR8=IR8+1 C IR8 IS SUBSCRIPT WITHIN THE BYTE OF THE BITMAP C IRS IS BITMAP ARRAY SUBSCRIPT C 100 IS TGT IF FVLD=0 & BMP 1 CC IRS=(IRX+7)/8 CC KKK=IBITMP(IRS).AND.LBITS(IR8) C TURN ON THE INITIALIZED BIT IN ANY CASE NOW CC IBITMP(IRS)=IBITMP(IRS).OR.LBITS(IR8) C THE NEXT LINE IS THE TEST THAT SAVES OUR READS: C IF THERE'S NOTHING THERE TO DISPLAY AND WE KNOW THE C CELL HAS BEEN READ OFF THE FILE, DON'T READ THE FILE C AGAIN BUT JUST SKIP THE DISPLAY. C ... DO HOWEVER RESET DVS THOUGH. CC CALL FVLDGT(M1,M2,FVLD(1,1)) CCCC IF(FVLD(1,1).EQ.0.AND.KKK.NE.0)GOTO 13 CC IF(IDOL4.EQ.0.AND.FVLD(1,1).EQ.0)GOTO 13 C C CALL WRKFIL(IRX,FORM,0) C READ(7'IRX)FORM C ALLOW FOR FVLD TO HAVE CONSTANT VS FORMULA SIGNIFICANCE IF(FORM(119).LT.-1)FORM(119)=-3 IF(FORM(119).GT.1)FORM(119)=3 C C FVLD VALUES OF 2 INDICATE ALREADY-COMPUTED CONSTANTS.DON'T C FORCE THEM TO BE REDONE. OTHERWISE DO FILL IN HOWEVER. CALL FVLDGT(M1,M2,FVLD(1,1)) C TRY COMMENTING OUT THIS RESET OF FVLD - REALLY NOT NEEDED OR C DESIRABLE. C IF(FVLD(1,1).NE.2)CALL FVLDST(M1,M2,FORM(119)) CC FVLD(M1,M2)=FORM(119) C IF(FORM(120).LE.0)CALL FVLDST(M1,M2,0) C CALL FVLDGT(M1,M2,FVLD(1,1)) FVLDTP=FVLD(1,1) C C CODE FOR WINDOW TILING AND FILE READIN... C &%FILENAME,NSKIP,NLEN READS FILE SKIPPING NSKIP RECS AND C GETS NLEN RECS IN C C &&%FILENAME,NSKIP,NLEN JUST INSERTS FILE INTO PRINTOUT IF(IDOL4.EQ.0)GOTO 9880 LFTMST=J C NEED TO DO IT HERE... C FORM ARRAY HAS FILE NAME INFO, IF ANY... LLA=INDEX(FORM,'&') IF(LLA.LE.0.OR.LLA.GT.100)GOTO 9882 IF(FORM(LLA+1).EQ.'&')GOTO 9881 C CHECK &% FORM IF(FORM(LLA+1).NE.'%')GOTO 9882 C GOT &% FORM HERE. IF(LLVL.EQ.0.OR.LLVLF.EQ.1)GOTO 9885 DO 9886 LNNN=1,LLVL LLVLN=LLVL+10 CLOSE(UNIT=LLVLN,ERR=9886) 9886 CONTINUE LLVL=0 9885 CONTINUE LTST=LLA+2 LLVLF=1 C OPEN LLVL CALL GETFNL(FORM(LTST),LSKIP,LLEN) IF(LLEN.LE.0)GOTO 9882 LLVL=LLVL+1 LLU=LLVL+10 IF(LLVL.GT.4)GOTO 9931 OPEN(UNIT=LLU,NAME=FORM(LTST),TYPE='OLD',READONLY, 1 ERR=9931) GOTO 9930 9931 CONTINUE LENTL(LLVL)=0 LOCOL(LLVL)=0 CLOSE(UNIT=LLU) LLVL=LLVL-1 LLU=LLVL+10 GOTO 9882 9930 CONTINUE LOCOL(LLVL)=LFTMST LENTL(LLVL)=LLEN IF(LSKIP.LE.0)GOTO 9906 DO 9907 LL=1,LSKIP 9907 READ(LLU,9889,END=9909,ERR=9909)FILINE DO 9910 N=1,600 9910 FILINE(N)=32 GOTO 9911 9909 CONTINUE C EOF SO CLOSE LUN LENTL(LLVL)=0 CLOSE(UNIT=LLU) LLVL=LLVL-1 IF(LLVL.LE.0)GOTO 9880 LLU=LLVL+10 9911 CONTINUE 9906 CONTINUE C FILE SET UP NOW... READ IN AT 9982... C RECORD COL # OVER FOR THIS RECURSION LEVEL GOTO 9882 9881 CONTINUE C HERE LOOK FOR && FORM. IF NONE SEEN, SKIP THIS IF(FORM(LLA+1).NE.'&'.OR.FORM(LLA+2).NE.'%')GOTO 9882 C HERE HAVE A FORM &&%FILE,NS,NL C SO CLOSE OFF ALL WINDOWS IN USE AND READ IN FIRST LEVEL FILE SEEN. IF(LLVL.EQ.0.OR.LLVLF.EQ.2)GOTO 9884 DO 9883 LNN=1,LLVL LNN1=LNN+10 CLOSE(UNIT=LNN1,ERR=9883) 9883 CONTINUE C NOW ALL OPEN UNITS CLOSED LLVLF=2 LLVL=0 9884 CONTINUE LTST=LLA+3 C OPEN LLVL 9937 CALL GETFNL(FORM(LTST),LSKIP,LLEN) IF(LLEN.LE.0)GOTO 9882 LLVL=LLVL+1 LLU=LLVL+10 IF(LLVL.GT.4)GOTO 9933 OPEN(UNIT=LLU,NAME=FORM(LTST),TYPE='OLD',READONLY, 1 ERR=9933) GOTO 9934 9933 CONTINUE LLVL=LLVL-1 LLU=LLVL+10 GOTO 9882 9934 CONTINUE LOCOL(LLVL)=LFTMST LENTL(LLVL)=LLEN IF(LSKIP.LE.0)GOTO 9888 DO 9887 LL=1,LSKIP 9887 READ(LLU,9889,ERR=9901,END=9901)FILINE 9889 FORMAT(200A1,200A1,200A1) DO 9908 N=1,600 9908 FILINE(N)=32 C PUT IN LEADING SPACES INTO FILINE GOTO 9902 9901 CONTINUE CLOSE(UNIT=LLU) LLVL=LLVL-1 IF(LLVL.LE.0)GOTO 9880 LLU=LLVL+10 C HIT EOF ON READ, SO BACK UP A LEVEL 9902 CONTINUE C NOW GO AHEAD & READ... GOT PAST SKIP STUFF. 9888 CONTINUE C RECORD COL # OVER FOR THIS RECURSION LEVEL 9904 IF(LENTL(LLVL).LE.0) GOTO 9901 READ(LLU,9889,END=9901,ERR=9901)(FILINE(IV),IV=LOCOL(LLVL),600) LENTL(LLVL)=lentl(llvl)-1 c update lines left to read in C LOOK FOR RECURSIVE CALLS TO DEEPER NESTED FILES TO INCLUDE LTST=INDEX(FILINE,'&')+3 LFTMST=LTST-3 C UPDATE SO IF IT IS A CALL,WE CAN GO HANDLE IT TILL ITS EOF OR A DEEPER CALL IF(LTST.GT.0.AND.LTST.LT.207.AND.FILINE(LTST+1).EQ.'&' 1 .AND.FILINE(LTST+2).EQ.'%') GOTO 9937 C WELL, NOT A DEEPER LEVEL SO JUST GO ON AND READ THIS LEVEL TILL DONE. IF(ICODE.EQ.10)CALL PLW(FILINE,600) C LIMIT TT WRITES TO 132 CHARS WRITE(6,9889,ERR=9904)(FILINE(IVV),IVV=1,132) GOTO 9904 9882 CONTINUE C HERE HANDLE OLD WINDOW READS IN PROCESS OR JUST EXIT WITHOUT DOING MUCH IF(LLVLF.NE.1)GOTO 9880 C ONLY HANDLE "OVERLAY" STYLE READS HERE. C NORMAL OR-ING IN OF WINDOWS C LOOK FOR LUN SUCH THAT J=LOCOL(LUN) INDICATING IT STARTS HERE. C READ THIS CELL INTO IT AND FAKE OUT FVLD(1,1) TO GET IT DISPLAYED. IF(LLVL.LE.0)GOTO 9880 DO 9912 N=1,LLVL LLM=N+10 IF(J.EQ.LOCOL(N))GOTO 9913 9912 CONTINUE GOTO 9880 9913 CONTINUE C NOW READ THE FILE INTO "THIS" CELL (DISPLAY PURPOSES ONLY!) C AND FLAG FVLD LENTL(LLM-10)=LENTL(LLM-10)-1 IF(LENTL(LLM-10).GT.0) 1 READ(LLM,9889,END=9940,ERR=9940)(FORM(IV),IV=1,109) IF(LENTL(LLM-10).GT.0)FVLDTP=-1 IF(LENTL(LLM-10).LT.0)GOTO 9940 C -1 FLAGS THIS AS A "TEXT" CELL DISPLAY. GOTO 9880 9940 CONTINUE LENTL(LLM-10)=0 LOCOL(LLM-10)=0 CLOSE(UNIT=LLM,ERR=9880) 9880 CONTINUE C THIS SETTING OF FVLD ALLOWS THE Q OPTION TO WORK. IF(FVLDTP.NE.0)CALL UVT100(CUP,M23,J) 13 CONTINUE CALL XVBLGT(M1,M2,DVS(N1,N2)) C DVS(N1,N2)=XVBLS(M1,M2) IF(FVLDTP.EQ.0)GOTO 100 IF(FORMFG.GT.0.OR.(FVLDTP.LT.0)) 1 ENCODE(100,17,FORM2)(FORM(II),II=1,100) 17 FORMAT(100A1,200A1,200A1,34A1) IF(FORMFG.NE.0)GOTO 4321 DO 6304 KKKK=1,9 KKKKK=FORM(KKKK+119) C KKKKK=DFMTS(KKKK,N1,N2) 6304 DFE(KKKK+1)=MAX0(32,KKKKK) DFE(11)=32 DFE(1)='(' DFE(12)=')' CALL TYPGET(M1,M2,TYPE(1,1)) IF(TYPE(1,1).EQ.2.AND.FVLDTP.GT.0) 1 ENCODE(100,DFE,FORM2,ERR=4321)DVS(N1,N2) IF(TYPE(1,1).NE.2.AND.FVLDTP.GT.0) 1 ENCODE(100,DFE,FORM2,ERR=4321)LDVS(1,N1,N2) 4321 CONTINUE KWID=CWIDS(N1) C *** FIND OUT HOW MUCH ROOM THERE IS NOW. WE KNOW WHERE WE'RE DISPLAYING, SO C *** ALLOW NULL CELLS TO BE SHOWN PROVIDED WE ARE: C 1. DISPLAYING TEXT IN THE CELL, OR C 2. IN VIEW FORMULA MODE, AND THE NEXT CELL(S) OVER ARE NULL (FVLD=0) IF(FORMFG.EQ.0.AND.FVLDTP.GE.0)GOTO 8444 III=N1+1 IF(III.GT.DRWV)GOTO 8446 DO 8445 II=III,DRWV C FOLLOW ALONG WITH THE DISPLAY'S MAPPING TO SHEET. IIII=NRDSP(II,N2) IIIII=NCDSP(II,N2) CALL FVLDGT(IIII,IIIII,FVLD(1,1)) IF(FVLD(1,1).NE.0)GOTO 8444 KWID=KWID+CWIDS(II) 8445 CONTINUE 8446 CONTINUE C TEST IF LAST CELL IS NULL 8444 CONTINUE KWID=MIN0(KWID,JPL) C MINIMIZE WITH 110 TO RESTRICT TO PRINTIONG ONE CELL FORMULA C MAX KWID=MIN0(KWID,110) C ****** END OF MODS FOR PRINTING INTO ADJACENT NULL CELLS. IF(ICODE.NE.10)WRITE(6,17,ERR=5560)(FORM2(II),II=1,KWID) 5560 IF(ICODE.NE.10)GOTO 100 IF(JPL-KWID.LT.0)GOTO 115 ENCODE(KWID,17,PRTLIN(JP),ERR=100)(FORM2(II),II=1,KWID) 100 CONTINUE 115 CONTINUE C HERE KEEP TRACK OF AMOUNT PRINTED. JP=JP+CWIDS(N1) JPL=JPL-CWIDS(N1) 110 CONTINUE IF(ICODE.NE.10)GOTO 10 DO 634 KKKQ=1,512 IF(PRTLIN(KKKQ).LT.32)PRTLIN(KKKQ)=32 634 CONTINUE CALL PLW(PRTLIN,512) C WRITE(8,18,ERR=5561)(PRTLIN(II),II=1,JP) 18 FORMAT(100A1,200A1,200A1,34A1) 5561 CONTINUE DO 19 LN1=1,512 19 PRTLIN(LN1)=32 10 CONTINUE IF(ICODE.EQ.10)CLOSE(UNIT=8) C IF(LLVL.LE.0)RETURN C DO 9915 N=1,LLVL IF(IDOL4.EQ.0)RETURN DO 9915 N=1,4 LLU=N+10 CLOSE(UNIT=LLU,ERR=9915) 9915 CONTINUE 9916 CONTINUE LLVL=0 RETURN 510 IF(IOLVL.EQ.5)REWIND 5 CLOSE(UNIT=3) FOOBAR=0 IOLVL=5 CLOSE(UNIT=5) OPEN(UNIT=5,FILE='SYS$COMMAND:',CARRIAGECONTROL='NONE') RETURN END SUBROUTINE GETFNL(LINE,LSKP,LLEN) C PARSE OUT FILENAME AND GET LSKP, LLEN NUMBERS LOGICAL*1 LINE(80) INTEGER*2 LSKP,LLEN,LO,HI LSKP=0 LLEN=32000 C SET INITIAL NUMBERS TO READ WHOLE FILE N=INDEX(LINE,',') IF(N.LE.0.OR.N.GT.78)RETURN C IF CANNOT FIND COMMA, JUST SKIP OUT & TRY TO CATCH ERRORS ON OPEN. LINE(N)=0 C NULL TERMINATE FILENAME LO=N+1 HI=LO+20 CALL GN(LO,HI,LSKP,LINE) LO=N+1 N=INDEX(LINE(LO),',') IF(N.LE.0.OR.N.GT.30)RETURN LO=LO+N HI=LO+20 CALL GN(LO,HI,LLEN,LINE) C SHOULD HAVE NUMBERS NOW RETURN END SUBROUTINE PLW(PL,NPL) DIMENSION PL(512) LOGICAL*1 PL INTEGER*2 NPL DO 1 N=1,NPL NN=NPL-N+1 IF(PL(NN).GT.32)GOTO 2 1 CONTINUE C THIS ROUTINE FINDS LAST NONSPACE AND WRITES PL C TO LUN 8 FROM BEGINNING TO END SO FOUND. AVOIDS C WRITING OUTPUT FILES OF HUGE LONG RECORDS CONTAINING C MOSTLY SPACES. 2 CONTINUE WRITE(8,3,ERR=4)(PL(N),N=1,NN) 3 FORMAT(100A1,100A1,100A1,100A1,100A1,100A1,100A1) 4 RETURN END