C SUBROUTINES FOR SPREDSHT.PR1 C FILE SPREDSHT.PR2 C INITIALIZER SEGMENTS OF SPREADSHEET SUBROUTINE INITA1(KMAP,KWID,ICODE) C SPREAD SHEET DRIVER PROGRAM 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. INCLUDE 'VKLUGPRM.FTN' C PARAMETER MXCOLS=6,MXROWS=20 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 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. C C VT100 DISPLAY CONTROL PARAMETER DEFINITIONS C 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 PARAMETER TMREFN = 1 INTEGER*2 PRL(6) BYTE NOWRAP ( 2 ) LOGICAL*1 FORM,FVLD,CMDLIN(132) INTEGER*4 VNLT 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 RRWACT,RCLACT COMMON/RCLACT/RRWACT,RCLACT INTEGER*2 ICREF,IRREF COMMON/MIRROR/ICREF,IRREF integer*2 idol1,idol2,idol3,idol4,idol5,idol6, 1 IDOL7,IDOL8 common/dollr/idol1,idol2,idol3,idol4,idol5,idol6, 1 IDOL7,IDOL8 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 IPGMAX,LPGMXF,IPGMOD,LPGMOD COMMON/FILEMX/IPGMAX,LPGMXF,IPGMOD,LPGMOD C LENGTHS (IN K) OF FILES FOR VALUES OR FORMULAS ARE IPGMAX,LPGMXF C IPGMOD AND LPGMOD CONTROL PACKING MODE IN THE CORRESPONDING FILES LOGICAL*1 OARRY(100),FORM2(4) 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) INTEGER*2 KLVL COMMON/KLVL/KLVL INTEGER*2 IOLVL COMMON/IOLVL/IOLVL C IOLVL IS LUN FOR XQTCMD TO USE (NORMALLY 3 FOR INDIRECT FILES OR 5 C FOR TERMINAL. WE USE 5,6 FOR TERMINAL INPUT, OUTPUT NORMALLY. LOGICAL*1 AVBLS(20,27),VBLS(8,RRWP,RCLP) REAL*8 XXV(RRWP,RCLP) EQUIVALENCE(XXV(1,1),VBLS(1,1,1)) COMMON/V/TYPE,AVBLS,VBLS,VLEN C DEFFMT IS THE DEFAULT FORMAT FOR NUMERICS. INITIALLY IT WILL BE F9.2 LOGICAL*1 DEFFMT(10),DVFMT(12) EQUIVALENCE(DVFMT(2),DEFFMT(1)) COMMON/DEFVBX/DVFMT LOGICAL*1 NMSH(80) COMMON/NMSH/NMSH INTEGER*2 XTCFG,IPSET,XTNCNT LOGICAL*1 XTNCMD(80) COMMON/XCMD/XTNCNT,XTNCMD,XTCFG,IPSET C VARY FLAG ITERATION COUNT INTEGER KALKIT COMMON/VARYIT/KALKIT INTEGER*2 FORMFG,RCFGX,PZAP COMMON/FFGG/FORMFG,RCFGX,PZAP C FORMFG FLAGS FORMAT OF DISPLAY GLOBALLY C RCFGX FLAGS WHETHER TO DO AUTO RECALCULATION. IF 1, INHIBITS C AUTO RECALC (USE R COMMAND TO DO A CALC.). RM COMMAND TURNS C RCFGX ON. C PZAP CONTROLS WHETHER TO REDRAW SCREEN. IF ZERO, NORMAL. IF 1 C (NONZERO ANYHOW), INHIBITS RE DISPLAY. V COMMAND RESETS TO 0 C AND VM INHIBITS. (SETS TO 1). 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. INTEGER*4 I4TMP REAL*8 DVS(DRW,DCL) COMMON /FVLDC/FVLD C BITMAP C LOGICAL*1 IBITMP C DIMENSION IBITMP(BRRCL) C COMMON/INITD/IBITMP C LOGICAL*1 DFMTS(10,DRW,DCL) C 10 CHARACTERS PER ENTRY. COMMON/DSPCMN/DVS,CWIDS DATA NOWRAP / "24,0 / C INITIAL DEFAULT FORMAT FOR NUMERICS is set at runtime C SET UP TERMINAL C SET IT NOWRAP, NO CARRIAGE CONTROL. C IDOL7=1 IF SCROLLING ENABLED IDOL7=1 C SETUP INITIAL DISPLAY LIMITS ACTUALLY USED. RRWACT=1 RCLACT=1 IOLVL=5 DRWV=MXCOLS DCLV=MXROWS KLVL=1 KALKIT=0 ICODE=0 ICREF=RRW/10 IRREF=RCL/10 idol3=0 idol4=0 idol5=20000 idol6=20000 RCFGX=0 FORMFG=0 C must be able to turn off FORTRAN carriage control somehow. OPEN ( UNIT = 5, FILE='TI:',CARRIAGECONTROL = 'NONE' ) OPEN ( UNIT = 6, FILE='TI:',CARRIAGECONTROL = 'NONE' ) C CHANGE TI: TO TT: FOR VMS CALL UVT100(ANSI) C PERFORM SYSTEM DEPENDENT INITIALIZATION CALL TTYINI C C PERFORM ERROR TRAPPER CALLS HERE AS NEEDED. C SET MOST ERRORS TO CONTINUE, WITH FILE ERRORS CONTINUATION ON ERR= C PROCESSING. C FOR THE MOMENT COMMENT OUT AND FILL IN WITH VERSION C TAILORED TO DESIRED OS DO 6988 KK=68,94 IF(KK.EQ.69.OR.KK.EQ.85.OR.(KK.GE.76.AND.KK.LE.79) 1 .OR.(KK.GE.87.AND.KK.LE.90))GOTO 6988 CALL ERRSET(KK,.TRUE.,.FALSE.,.FALSE.,.FALSE.,15) 6988 CONTINUE CALL ERRSET(59,.TRUE.,.FALSE.,.FALSE.,.FALSE.,15) CALL ERRSET(61,.TRUE.,.FALSE.,.FALSE.,.FALSE.,15) CALL ERRSET(63,.TRUE.,.FALSE.,.FALSE.,.FALSE.,15) CALL ERRSET(64,.TRUE.,.FALSE.,.FALSE.,.FALSE.,15) C CC SET UP ENDFILE TO USE ERR= TYPE RETURN CALL ERRSET(24,.TRUE.,.TRUE.,.FALSE.,.FALSE.,15) CC NO SUCH FILE USES ERR= TOO. CALL ERRSET(29,.TRUE.,.TRUE.,.FALSE.,.FALSE.,15) CC THAT'S IT. ERRSET ROUTINE WON'T ALWAYS ACCEPT NO ERR= RETURN CC BUT THAT'S AS IT SHOULD BE. NOTICE THIS CLEANS THE DISPLAY VERY CC CONSIDERABLY AND MAKES PROGRAM CRASHES DUE TO USER ERRORS MUCH CC LESS LIKELY. C CALL UVT100(RM,8) CALL UVT100(ED,2) CALL UVT100(SCS,0,1) CALL UVT100(SCS,1,2) CALL UVT100(CUP,5,10) C ZERO THE VARIABLES TO START OFF WITH. DO 2070 KK=1,20 DO 2070 KKK=1,27 2070 AVBLS(KK,KKK)=0 C SKIP ZEROING VARIABLES... C CALL WSSET C WSSET SETS UP WORK SPACE C DO 2071 KK=1,RRW C DO 2071 KKK=1,RCL C2071 XXV(KK,KKK)=0. C SET UP WORK ARRAY BITMAP CALL WRKFIL(1,FORM,2) CALL UVT100(SGR,7) WRITE(6,3010) 3010 FORMAT('Analyti!Calc-PRO') CALL UVT100(CUP,6,12) WRITE(6,3278) 3278 FORMAT('V20-01Q') CALL UVT100(SGR,0) CALL UVT100(CUP,10,3) WRITE(6,3013) 3013 FORMAT(' .... The Analyst''s Tool') CALL UVT100(CUP,11,5) WRITE(6,3014) 3014 FORMAT(' by Glenn and Mary Everhart, (C) 1983') CALL UVT100(CUP,12,1) C NOW GET ON WITH USEFUL WORK. PRL ( 2 ) = 1 PRL ( 3 ) = 0 CALL UVT100 ( ANSI ) C RESET MODE 8 (VT100 AUTOREPEAT) C CALL UVT100 ( RM, 8 ) C RESET MODE 5 (I.E., SCREEN TO BLACK BACKGROUND). C CALL UVT100 ( RM, 5 ) KWID=10 KMAP=1 RETURN END SUBROUTINE INITA2(KMAP,KWID,ICODE,IKONS) C SPREAD SHEET DRIVER PROGRAM 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. INCLUDE 'VKLUGPRM.FTN' C PARAMETER MXCOLS=6,MXROWS=20 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 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. C C VT100 DISPLAY CONTROL PARAMETER DEFINITIONS C 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 PARAMETER TMREFN = 1 INTEGER*2 PRL(6) BYTE NOWRAP ( 2 ) LOGICAL*1 FORM,FVLD,CMDLIN(132) INTEGER*4 VNLT 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 RRWACT,RCLACT COMMON/RCLACT/RRWACT,RCLACT integer*2 idol1,idol2,idol3,idol4,idol5,idol6, 1 IDOL7,IDOL8 common/dollr/idol1,idol2,idol3,idol4,idol5,idol6, 1 IDOL7,IDOL8 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 IPGMAX,LPGMXF,IPGMOD,LPGMOD COMMON/FILEMX/IPGMAX,LPGMXF,IPGMOD,LPGMOD C LENGTHS (IN K) OF FILES FOR VALUES OR FORMULAS ARE IPGMAX,LPGMXF C IPGMOD AND LPGMOD CONTROL PACKING MODE IN THE CORRESPONDING FILES LOGICAL*1 OARRY(100),FORM2(4) 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) INTEGER*2 KLVL COMMON/KLVL/KLVL INTEGER*2 IOLVL COMMON/IOLVL/IOLVL C IOLVL IS LUN FOR XQTCMD TO USE (NORMALLY 3 FOR INDIRECT FILES OR 5 C FOR TERMINAL. WE USE 5,6 FOR TERMINAL INPUT, OUTPUT NORMALLY. LOGICAL*1 AVBLS(20,27),VBLS(8,RRWP,RCLP) REAL*8 XXV(RRWP,RCLP) EQUIVALENCE(XXV(1,1),VBLS(1,1,1)) COMMON/V/TYPE,AVBLS,VBLS,VLEN C DEFFMT IS THE DEFAULT FORMAT FOR NUMERICS. INITIALLY IT WILL BE F9.2 LOGICAL*1 DEFFMT(10),DVFMT(12) EQUIVALENCE(DVFMT(2),DEFFMT(1)) COMMON/DEFVBX/DVFMT LOGICAL*1 NMSH(80) COMMON/NMSH/NMSH INTEGER*2 XTCFG,IPSET,XTNCNT INTEGER*2 ICREF,IRREF COMMON/MIRROR/ICREF,IRREF LOGICAL*1 XTNCMD(80) COMMON/XCMD/XTNCNT,XTNCMD,XTCFG,IPSET C VARY FLAG ITERATION COUNT INTEGER KALKIT COMMON/VARYIT/KALKIT INTEGER*2 FORMFG,RCFGX,PZAP COMMON/FFGG/FORMFG,RCFGX,PZAP C FORMFG FLAGS FORMAT OF DISPLAY GLOBALLY C RCFGX FLAGS WHETHER TO DO AUTO RECALCULATION. IF 1, INHIBITS C AUTO RECALC (USE R COMMAND TO DO A CALC.). RM COMMAND TURNS C RCFGX ON. C PZAP CONTROLS WHETHER TO REDRAW SCREEN. IF ZERO, NORMAL. IF 1 C (NONZERO ANYHOW), INHIBITS RE DISPLAY. V COMMAND RESETS TO 0 C AND VM INHIBITS. (SETS TO 1). 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. INTEGER*4 I4TMP REAL*8 DVS(DRW,DCL) COMMON /FVLDC/FVLD C BITMAP C LOGICAL*1 IBITMP C DIMENSION IBITMP(BRRCL) C COMMON/INITD/IBITMP C LOGICAL*1 DFMTS(10,DRW,DCL) C 10 CHARACTERS PER ENTRY. COMMON/DSPCMN/DVS,CWIDS DATA NOWRAP / "24,0 / C KMAP=1 IF(IKONS.EQ.0)GOTO 3000 3002 CONTINUE CALL UVT100(CUP,1,1) WRITE(6,3003) 3003 FORMAT(' Alter Display Windows [Y/N]:') READ(IOLVL,3006,END=5600,ERR=5600)FORM 3006 FORMAT(80A1,50A1) IF(FORM(1).NE.'Y'.AND.FORM(1).NE.'y')GOTO 3000 C ALTER MAPPING DESIRED WRITE(6,3001) 3001 FORMAT(' ENTER NEW GLOBAL COLUMN WIDTH, 1-120:') READ(IOLVL,3004,END=5600,ERR=5600)KWID 3004 FORMAT(I3) IF(KWID.LT.1.OR.KWID.GT.120)KWID=10 WRITE(6,3008) 3008 FORMAT(' Reset display to Upper Left of sheet [Y/N]:') READ(IOLVL,3006,END=5600,ERR=5600)FORM KMAP=1 IF(FORM(1).NE.'Y'.AND.FORM(1).NE.'y')KMAP=0 WRITE(6,7802) 7802 FORMAT(' Modify extended mapping (Reply N if extended area' 1 ' not empty):') READ(IOLVL,3006,END=5600,ERR=5600)FORM IF(FORM(1).NE.'Y'.AND.FORM(1).NE.'y')GOTO 3000 WRITE(6,7800)RCL 7800 FORMAT(' How many Cols to move over on row over ',I4) READ(IOLVL,3004,END=5600,ERR=5600)ICREF IF(ICREF.LT.0.OR.ICREF.GT.RRW)ICREF=RRW/10 WRITE(6,7801)RRW 7801 FORMAT(' How many Rows to move down on col over ',I4) READ(IOLVL,3004,END=5600,ERR=5600)IRREF IF(IRREF.LT.0.OR.IRREF.GT.(RCL-1))IRREF=RCL/10 C 3000 CONTINUE RETURN 5600 CONTINUE IOLVL=5 CLOSE(UNIT=3) REWIND 5 RETURN END SUBROUTINE INITB(KMAP,KWID,ICODE) INCLUDE 'VKLUGPRM.FTN' C PARAMETER MXCOLS=6,MXROWS=20 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 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. C C VT100 DISPLAY CONTROL PARAMETER DEFINITIONS C 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 PARAMETER TMREFN = 1 INTEGER*2 PRL(6) BYTE NOWRAP ( 2 ) LOGICAL*1 FORM,FVLD,CMDLIN(132) INTEGER*4 VNLT 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 RRWACT,RCLACT COMMON/RCLACT/RRWACT,RCLACT integer*2 idol1,idol2,idol3,idol4,idol5,idol6, 1 IDOL7,IDOL8 common/dollr/idol1,idol2,idol3,idol4,idol5,idol6, 1 IDOL7,IDOL8 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 IPGMAX,LPGMXF,IPGMOD,LPGMOD COMMON/FILEMX/IPGMAX,LPGMXF,IPGMOD,LPGMOD C LENGTHS (IN K) OF FILES FOR VALUES OR FORMULAS ARE IPGMAX,LPGMXF C IPGMOD AND LPGMOD CONTROL PACKING MODE IN THE CORRESPONDING FILES LOGICAL*1 OARRY(100),FORM2(4) 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) INTEGER*2 KLVL COMMON/KLVL/KLVL INTEGER*2 IOLVL COMMON/IOLVL/IOLVL C IOLVL IS LUN FOR XQTCMD TO USE (NORMALLY 3 FOR INDIRECT FILES OR 5 C FOR TERMINAL. WE USE 5,6 FOR TERMINAL INPUT, OUTPUT NORMALLY. LOGICAL*1 AVBLS(20,27),VBLS(8,RRWP,RCLP) REAL*8 XXV(RRWP,RCLP) EQUIVALENCE(XXV(1,1),VBLS(1,1,1)) COMMON/V/TYPE,AVBLS,VBLS,VLEN C DEFFMT IS THE DEFAULT FORMAT FOR NUMERICS. INITIALLY IT WILL BE F9.2 LOGICAL*1 DEFFMT(10),DVFMT(12) EQUIVALENCE(DVFMT(2),DEFFMT(1)) COMMON/DEFVBX/DVFMT LOGICAL*1 NMSH(80) COMMON/NMSH/NMSH INTEGER*2 XTCFG,IPSET,XTNCNT LOGICAL*1 XTNCMD(80) COMMON/XCMD/XTNCNT,XTNCMD,XTCFG,IPSET C VARY FLAG ITERATION COUNT INTEGER KALKIT COMMON/VARYIT/KALKIT INTEGER*2 FORMFG,RCFGX,PZAP COMMON/FFGG/FORMFG,RCFGX,PZAP C FORMFG FLAGS FORMAT OF DISPLAY GLOBALLY C RCFGX FLAGS WHETHER TO DO AUTO RECALCULATION. IF 1, INHIBITS C AUTO RECALC (USE R COMMAND TO DO A CALC.). RM COMMAND TURNS C RCFGX ON. C PZAP CONTROLS WHETHER TO REDRAW SCREEN. IF ZERO, NORMAL. IF 1 C (NONZERO ANYHOW), INHIBITS RE DISPLAY. V COMMAND RESETS TO 0 C AND VM INHIBITS. (SETS TO 1). 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. INTEGER*4 I4TMP REAL*8 DVS(DRW,DCL) COMMON /FVLDC/FVLD C BITMAP C LOGICAL*1 IBITMP C DIMENSION IBITMP(BRRCL) C COMMON/INITD/IBITMP C LOGICAL*1 DFMTS(10,DRW,DCL) C 10 CHARACTERS PER ENTRY. COMMON/DSPCMN/DVS,CWIDS DATA NOWRAP / "24,0 / C idol5=20000 idol6=20000 C INITIALLY SET JRCL TO RCL = NO. OF ROWS TO BE IN WORK FILE JRCL=RCL PZAP=0 XTCFG=0 IPSET=0 C ZERO BITMAP C DO 36 N1=1,BRRCL C36 IBITMP(N1)=0 LINIZZ=0 CALL UVT100(CUP,14,1) WRITE(6,3588) 3588 FORMAT('Enter new floating numeric format default [Y/N]:') READ(IOLVL,3006,END=5600,ERR=5600)FORM 3006 FORMAT(80A1,50A1) IF(FORM(1).NE.'Y'.AND.FORM(1).NE.'y')GOTO 3589 C ENTER NEW DEFAULT. 6888 CALL UVT100(CUP,14,1) CALL UVT100(EL,2) C LINE NOW ERASED... GET NEW FORMAT WRITE(6,3590) 3590 FORMAT('Enter new format. Suggest F10.2>') READ(IOLVL,3006,END=5600,ERR=5600)FORM C NOW HAVE HIS DESIRED FORMAT. COPY INTO THE DEFAULT ARRAY. C DEFFMT IS THAT. DO 3591 N1=1,10 KKK=FORM(N1) KKK=MAX0(32,KKK) C ASSUME NMSH COMPLETELY INIT'D 3591 DEFFMT(N1)=KKK C CHECK ITS LEGALITY BY TRYING TO USE IT ONCE. XX=3.14159 ENCODE(78,DVFMT,NMSH,ERR=6888)XX C FAILSAFE: RE-ASK IF IT CAN'T ENCODE PI. C IF IT FAILS, PROGRAM WILL CRASH AND FILE WON'T GET CLOBBERED. 3589 CONTINUE CALL UVT100(CUP,15,1) WRITE(6,3005) 3005 FORMAT(' Title of Spreadsheet:') READ(IOLVL,3006,END=5600,ERR=5600)FORM IF(FORM(1).LE.32.AND.FORM(2).LE.32)GOTO 7801 DO 7802 III=1,80 7802 NMSH(III)=FORM(III) 7801 CONTINUE C ****** IF S OPTION GIVEN THEN ICODE=-2 C THEREFORE, DON'T ASK DISK SIZE ETC, BUT ALLOW RESET OF TITLE C AND DEFAULT FORMATS. IF(ICODE.EQ.-2) GOTO 7831 C ****** CALL UVT100(CUP,16,1) WRITE(6,2056) 2056 FORMAT(' Give Max Rows to be used:') READ(IOLVL,7202,END=5600,ERR=5600)KR IF(KR.LE.0)KR=RCL CALL UVT100(CUP,17,1) WRITE(6,2057) 2057 FORMAT(' Give Max Cols to be used:') READ(IOLVL,7202,END=5600,ERR=5600)KC IF(KC.LE.0)KC=RRW C KKK=(KR-1)*RRW+KC CALL REFLEC(KR,KC,KKK) XKKKK=KR*KC XKDF=XKKKK/64. XKDN=XKKKK/100. C COMPUTED ABOVE THE MIN # OF K FOR DISK FILES CALL UVT100(CUP,18,1) WRITE(6,2058)XKDN,XKDF 2058 FORMAT(' Mins=',F9.0' K Value file, ',F9.0,' K Formula file') C KKK IS MAX INDEX TO BE USED HERE. CALL UVT100(CUP,21,1) WRITE(6,7201) 7201 FORMAT(' Give disk size (K) for Value Memory:') READ(IOLVL,7202,END=5600,ERR=5600)IPGMAX 7202 FORMAT(I6) IPGMOD=KKK IF(IPGMAX.LT.0)IPGMOD=0 IPGMAX=IABS(IPGMAX) IF(IPGMAX.LE.0.OR.IPGMAX.GT.512)IPGMAX=1 CALL UVT100(CUP,22,1) WRITE(6,7203) 7203 FORMAT(' Give disk size (K) for Formula Memory:') READ(IOLVL,7202,END=5600,ERR=5600)LPGMXF LPGMOD=KKK IF(LPGMXF.LT.0)LPGMOD=0 LPGMXF=IABS(LPGMXF) C IF NUMBERS ARE ENTERED NEGATIVE, SET MODE TO "SLOW, FILE-SPACE C CONSERVING" PACKING, SCATTERING PAGES ACROSS FILE. IF(LPGMXF.LE.0.OR.LPGMXF.GT.1024)LPGMXF=(IPGMAX*3)/2 C NULL TERMINATE ALL FORMAT STRINGS. C SET MAX WIDTH FOR PRINT TO DIMENSION OF THE BUFFER. NOTE THIS IS THE C USUAL HARDWARE MAXIMUM SO WE DON'T WORRY TOO MUCH ABOUT IT. NOTE C BILL TABOR'S PROGRAM TO PRINT PASTE-ABLE VERSIONS OF THE SHEET FROM C SAVE FILES EXISTS, SO WE NEEDN'T WORRY TOO MUCH EITHER ABOUT USING C DISPLAY FOR DOUBLE DUTY. MXL=132 C INITIALIZE WORK STORAGE FOR FORMULAS AND VARIABLES CALL WSSET 7831 CONTINUE C C NOW SET UP NRDSP, NCDSP IF(KMAP.EQ.0)GOTO 3009 DO 5 N1=1,DRW DO 5 N2=1,DCL C INITIALLY WE DISPLAY THE UPPER LEFT PART OF THE SYSTEM. C ESTABLISH ASSOCIATION INITIALLY THEREFORE OF DISPLAY TO UPPER C LEFT OF PHYSICAL SHEET. NRDSP(N1,N2)=N1 NCDSP(N1,N2)=N2+1 DVS(N1,N2)=.00000031 5 CONTINUE C FOR S OPTION USE SECRET -4 CODE TO RESET SHEET. STILL NEEDS WORK C IN PORTACALC PC. C3009 CONTINUE IF(ICODE.EQ.-4)CALL WRKFIL(1,FORM,2) 3009 IF(ICODE.EQ.-4)GOTO 1 C SET DEFAULT WIDTHS OF COLUMNS TO 10. MAY BE ALTERED BELOW FOR DIFFERENT C DEFAULT IF DESIRED. DO 16 N1=1,DRW CWIDS(N1)=KWID 16 CONTINUE C43 CALL UVT100(CUP,21,1) KZPPD=0 CMDLIN(1)=0 IOLDFL=0 3017 FORMAT(Q,80A1,80A1) MXL=1 CMDLIN(MXL+1)=0 3572 FORMAT(I6) CALL UVT100(SGR,0) C SET UP RANDOM FILE AS NEEDED FOR SHEET C EACH RECORD HAS: C CHARS 1-110 FORMULAS C CHARS 120-128 DISPLAY FORMAT (INITIALLY F9.2) C CHAR 119 VALID FLAG (ALLOWS HANDLING READS.) C values: -3, -2: Numeric-only text (or special chars) C -1 : Alphanumeric text C 0 : Uninitialized C 1 : Alphanumeric formula C +2 : Number or pure numeric formula with value calculated C +3 : Number or pure numeric formula, value not yet computed C CHAR 118 MAGIC NUMBER 15 (CHECKS ALL WELL) C READ A RECORD, IF ERROR, CREATE EMPTY FILE. C IF(IOLDFL.EQ.0)GOTO 1 CC IF IOLDFL NONZERO IT MEANS USER CLAIMS THERE EXISTS A FILE. IF 0 IT'S NEW. CC HERE IT'S OLD SO LET'S BE SURE IT REALLY IS OK. 1 CONTINUE C HIT EOF OR ERROR. MUST BE A NEW FILE. THEREFORE ZERO IT TO OUR NEEDS. C AT THIS POINT WE ARE CREATING A NEW FILE AND NEED TO ZERO IT. C DO 3 N=1,128 FORM(N)=0 3 CONTINUE DO 3592 N=1,9 C SET UP DEFAULT FORMAT 3592 FORM(119+N)=DEFFMT(N) FORM(118)=15 FORM(1)='0' FORM(2)='.' C CREATE NULL FILE INITIALLY BY RESETTING ALL. JRRCL=RRW*JRCL KZPPD=1 C 2 CONTINUE C COMMON POINT WITH FILE PREPARED. PCOL=2 PROW=1 DCOL=1 DROW=1 C IF(IOLDFL.GT.1)GOTO 2000 RETURN 5600 CONTINUE IOLVL=5 CLOSE(UNIT=3) REWIND 5 RETURN END