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 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 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 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) 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. LOGICAL*1 IBITMP DIMENSION IBITMP(BRRCL) 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... LOGICAL*1 LBITS(8) DATA LBITS/1,2,4,8,16,32,64,128/ IF(ICODE.NE.10)GOTO 3000 CALL UVT100(CUP,LCMDR,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',RECL=250) 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+CWIDS(N1)-7).GT.121)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)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 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 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 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... IR8=(IRX-1).AND.7 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 IRS=(IRX+7)/8 KKK=IBITMP(IRS).AND.LBITS(IR8) C TURN ON THE INITIALIZED BIT IN ANY CASE NOW 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. IF(FVLD(M1,M2).EQ.0.AND.KKK.NE.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. IF(FVLD(M1,M2).NE.2)FVLD(M1,M2)=FORM(119) C FVLD(M1,M2)=FORM(119) IF(FORM(120).LE.0)FVLD(M1,M2)=0 C THIS SETTING OF FVLD ALLOWS THE Q OPTION TO WORK. IF(FVLD(M1,M2).NE.0)CALL UVT100(CUP,M23,J) 13 CONTINUE DVS(N1,N2)=XVBLS(M1,M2) 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,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)=')' IF(TYPE(M1,M2).EQ.2.AND.FVLD(M1,M2).GT.0) 1 ENCODE(100,DFE,FORM2,ERR=4321)DVS(N1,N2) IF(TYPE(M1,M2).NE.2.AND.FVLD(M1,M2).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.FVLD(M1,M2).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) IF(FVLD(IIII,IIIII).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 ****** END OF MODS FOR PRINTING INTO ADJACENT NULL CELLS. IF(ICODE.NE.10)WRITE(6,17)(FORM2(II),II=1,KWID) 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 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