SUBROUTINE DSPSHT(ICODE) 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 WIDTH TO ALLOW VT100 LOOKALIKES WITH MORE DISPLAY LINES TOO. INCLUDE 'VKLUGPRM.FTN' C PARAMETER MPWD = 132 C PARAMETER RRW = 32 C PARAMETER RCL = 32 ! REAL ROWS, COLS C PARAMETER DRW = 8 C PARAMETER DCL = 8 ! DISPLAY MAX ROWS, COLS. C PARAMETER RRCL = 1024 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. LOGICAL*1 FORM,FVLD,CMDLIN(132),PRTLIN(132) INTEGER*4 VNLT 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 REAL*8 XVBLS(RRW,RCL) LOGICAL*1 DFE(12) DIMENSION FORM(128),FVLD(RRW,RCL) 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 COMMON/DCTL/PROW,PCOL,DROW,DCOL,DRWV,DCLV 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 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(RRW,RCL),VLEN(9) LOGICAL*1 AVBLS(100,27),VBLS(8,RRW,RCL) 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) COMMON /FVLDC/FVLD LOGICAL*1 DFMTS(10,DRW,DCL) C 10 CHARACTERS PER ENTRY. COMMON/DSPCMN/DVS,DFMTS,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. C ROW OFFSET BY 6 FOR NUMBERS. IF(ICODE.NE.10)GOTO 3000 CALL UVT100(CUP,23,1) CALL UVT100(EL,2) WRITE(6,25) 25 FORMAT('Enter print file spec., / after to omit borders>') READ(5,26)ISZ,FORM2 26 FORMAT(Q,128A1) ISZ=MIN0(127,ISZ) FORM2(ISZ+1)=0 BORDR=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 4111 CONTINUE OPEN(UNIT=8,FILE=FORM2,CARRIAGECONTROL='LIST') C CALL ASSIGN(8,FORM2) DO 27 N=1,132 27 PRTLIN(N)=32 ENCODE(7,2,PRTLIN) 3000 CONTINUE CALL UVT100(SGR,0) IF(ICODE.EQ.10)WRITE(8,17)NMSH 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.GT.121)GOTO 2030 ENCODE(CWIDS(N1),2021,PRTLIN(J)),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)WRITE(8,18)PRTLIN DO 2031 KKK=1,132 2031 PRTLIN(KKK)=32 IF(ICODE.EQ.10)GOTO 1000 CALL UVT100(SGR,7) MCX=MIN0(20,DCLV)+2 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 JP=8 JPL=125 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 IF(BORDR.EQ.0.AND.ICODE.EQ.10)ENCODE(6,8,PRTLIN)M2-1 VDSP=DVS(N1,N2) VCLC=XVBLS(M1,M2) C SEE IF DISPLAYED AND CALCULATED NUMBERS ARE IDENTICAL. C ONLY DISPLAY IF CHANGED. IF(VDSP.EQ.VCLC.AND.ICODE.NE.2.AND.ICODE.NE.10)GOTO 100 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) 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) IRX=(M2-1)*RRW+M1 READ(7'IRX)FORM FVLD(M1,M2)=FORM(119) C IF(FORM(118).NE.15)FVLD(M1,M2)=0 IF(FORM(120).LE.0)FVLD(M1,M2)=0 DVS(N1,N2)=XVBLS(M1,M2) DO 13 N11=1,9 13 DFMTS(N11,N1,N2)=FORM(N11+119) DFMTS(10,N1,N2)=0 IF(FORM(120).LE.0)FVLD(M1,M2)=0 IF(FVLD(M1,M2).EQ.0)GOTO 100 IF(FORMFG.GT.0.OR.(FVLD(M1,M2).LT.0)) 1 ENCODE(100,17,FORM2)(FORM(II),II=1,100) 17 FORMAT(100A1,34A1) IF(FORMFG.NE.0)GOTO 4321 DO 6304 KKKK=1,10 KKKKK=DFMTS(KKKK,N1,N2) 6304 DFE(KKKK+1)=MAX0(32,KKKKK) DFE(1)='(' DFE(12)=')' IF(FVLD(M1,M2).GT.0)ENCODE(100,DFE,FORM2)DVS(N1,N2) 4321 IF(ICODE.NE.10)WRITE(6,17)(FORM2(II),II=1,CWIDS(N1)) IF(ICODE.NE.10)GOTO 100 IF(JPL-CWIDS(N1).LT.0)GOTO 115 ENCODE(CWIDS(N1),17,PRTLIN(JP))(FORM2(II),II=1,CWIDS(N1)) 100 CONTINUE 115 CONTINUE JP=JP+CWIDS(N1) JPL=JPL-CWIDS(N1) 110 CONTINUE IF(ICODE.NE.10)GOTO 10 DO 634 KKKQ=1,132 IF(PRTLIN(KKKQ).LT.32)PRTLIN(KKKQ)=32 634 CONTINUE WRITE(8,18)(PRTLIN(II),II=1,JP) 18 FORMAT(100A1,34A1) DO 19 LN1=1,132 19 PRTLIN(LN1)=32 10 CONTINUE IF(ICODE.EQ.10)CLOSE(UNIT=8) RETURN END