C AnalytiCalc MAIN PROGRAM
C SPREAD SHEET DRIVER PROGRAM
C COPYRIGHT (C) 1983-1991 GLENN and MARY EVERHART
C PERMISSION IS GIVEN TO ANYONE TO USE, DISTRIBUTE, OR COPY THIS
C PROGRAM FREELY BUT NOT TO SELL IT COMMERCIALLY.
	INCLUDE 'VKLUGPRM.FTN'
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 Modifications Record:
C ---------------------
C	31-Jul-87
C	Delete starting spaces in some output FORMATs, to start ALL in col 1.
C	Change FORMAT 3001 to mixed case, like others.
C CJD1	Use PCHELP.FVX instead of PCHELP.FOR (terminal-dependent keypad diagram).
C CJD2	Correct crash on EOF or error on input from SYS$COMMAND, and faults
C	  found while investigating it:-
C	  a) LIB$ESTABLISH arguments must be declared EXTERNAL.
C	  b) There can only be one LIB$ESTABLISH -- change underflow trap to
C	     an ERRSET.
C	  c) ReOPEN SYS$COMMAND with STATUS='OLD' in recovery code at label 5600.
C	     (The root cause of the problem was inconsistency between
C	      READONLY and STATUS='NEW' defaulted by /NOF77).
C	  d) Need context-dependent recovery continuation points after terminal
C	     errors (inc EOF).
C
C CJD3	Oct-90, Chris Doran, Sira
C	SMG modifications
C	Remove ALL of SUBROUTINE HELP to PCHELP.xxx
C
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
     $, DECKPAM = 0, DECKPNM = 0, DECCOLM = 3				!CJD3
C      PARAMETER TMREFN = 1
	EXTERNAL LIB$FIXUP_FLT						!CJD2
	InTEgeR*4 PRL(6)
      BYTE NOWRAP ( 2 )
	LOGICAL*1 FORM,FVLD,CMDLIN(132)
	INTEGER*4 VNLT
	INTEGER*4 ERRRET						!CJD2
	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*4 ICREF,IRREF,FOOBAR
	COMMON/MIRROR/ICREF,IRREF
	COMMON/FOOBAR/FOOBAR
	InTEgeR*4 RRWACT,RCLACT
	COMMON/RCLACT/RRWACT,RCLACT
	InTEgeR*4 idol1,idol2,idol3,idol4,idol5,idol6,
     1  IDOL7,IDOL8
	common/dollr/idol1,idol2,idol3,idol4,idol5,idol6,
     1  IDOL7,IDOL8
	InTEgeR*4 kdrw,kdcl
	common/DOT/Kdrw,kdcl
	InTEgeR*4 PROW,PCOL,DROW,DCOL,DRWV,DCLV
	InTEgeR*4 LLCMD,LLDSP
	COMMON/DCTL/PROW,PCOL,DROW,DCOL,DRWV,DCLV,LLCMD,LLDSP
C LLCMD, LLDSP ARE CURRENTLY USED COMMAND, DISPLAY ROWS...
	DIMENSION NRDSP(DRW,DCL),NCDSP(DRW,DCL)
	COMMON/D2R/NRDSP,NCDSP
	InTEgeR*4 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*4 OSWIT,OCNTR
	COMMON/OAR/OSWIT,OCNTR,OARRY
C COMMON OAR SWITCHES OUTPUT OFF IF OSWIT=2
	InTEgeR*4 TYPE(RRWP,RCLP),VLEN(9)
	InTEgeR*4 KLVL
	COMMON/KLVL/KLVL
	InTEgeR*4 NCEL,NXINI
	COMMON/NCEL/NCEL,NXINI
	InTEgeR*4 IOLVL
	COMMON/IOLVL/IOLVL
	LOGICAL*1 EDNAM(16)
	COMMON/EDNAM/EDNAM
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*4 XTCFG,IPSET,XTNCNT
   	LOGICAL*1 XTNCMD(80)
   	COMMON/XCMD/XTNCNT,XTNCMD,XTCFG,IPSET
C VARY FLAG ITERATION COUNT
	INTEGER KALKIT
	COMMON/VARYIT/KALKIT
	InTEgeR*4 FORMFG,RCFGX,PZAP
	InTEgeR*4 RCONE,RCMODE,IRCE1,IRCE2
	COMMON/FFGG/FORMFG,RCFGX,PZAP,RCONE,
     1  RCMODE,IRCE1,IRCE2
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*4 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
C	DATATRIEVE DATA BLOCKS HERE...
	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 CONTROLS SCROLL ENABLE, 1 IF ON, 0 IF OFF
	IDOL7=1
C SETUP INITIAL DISPLAY LIMITS ACTUALLY USED.
	CALL DTRINI
C SET UP DATATRIEVE INTERFACE...
	KDRW=1
	KDCL=1
	RRWACT=1
	FOOBAR=1							!CJD3
	RCLACT=1
	RCMODE=2
C INITIALLY RCMODE=2, SET UP RECALCULATION OF DISPLAY + ENTRY
C
C RCMODE =0 - OLD MODE, RECALC ALL
C	=1 - RECALC ENTRY ONLY (RE CMD)
C	=2 - RECALC ENTRY AND DISPLAY ONLY
C	NEGATIVE, ONE-TIME FLAG TO DO ALL, THEN GO TO ABS VALUE
C
	IRCE1=0
	IRCE2=0
	IOLVL=5
	DRWV=MXCOLS
	DCLV=MXROWS
	KLVL=1
	KALKIT=0
	ICODE=0
	NCEL=0
	NXINI=0
	idol3=0
	idol4=0
	DO 1407 N=1,16
1407	EDNAM(N)=32
	EDNAM(1)='E'
	EDNAM(2)='D'
	EDNAM(3)='I'
	EDNAM(4)='T'
C INITIALIZE EDIT NAME
	LLCMD=LCMDR
	LLDSP=LDSPR
	ICREF=RRW/10
	IRREF=RCL/10
	idol5=32000
	idol6=32000
	RCFGX=0
	FORMFG=0
C      CALL GETADR ( PRL, NOWRAP )
      PRL ( 2 ) = 2
C WTQIO issues I/O to set multiple characteristics of your terminal
C to turn off system's auto-wrap. If this is different either set it
C first by hand or modify.
C      CALL WTQIO ( SFSMC, 5, 2,,, PRL )
C	CALL ASSIGN(6,'TI:')
C	CALL ASSIGN(5,'TI:')
C must be able to turn off FORTRAN carriage control somehow.
      OPEN ( UNIT = 5, FILE='SYS$INPUT:'
     1 ,CARRIAGECONTROL = 'NONE'
     1 ,STATUS = 'OLD', READONLY )					!CJD3
CJD3      OPEN ( UNIT = 6, FILE='SYS$OUTPUT:'
CJD3     1  ,CARRIAGECONTROL = 'NONE' )
CJD3	open(unit=1,file='TT:',carriagecontrol='NONE')
	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
c prevent as many Fortran errors as possible for VAX only.
	DO 2068 KK=20,57
	CALL ERRSET(KK,.TRUE.,.FALSE.,.TRUE.,.FALSE.,30000)
2068	CONTINUE
	DO 6067 KK=59,68
	IF (KK.EQ.65)GOTO 6067
	CALL ERRSET(KK,.TRUE.,.FALSE.,.TRUE.,.FALSE.,30000)
6067	CONTINUE
C Ignore underflow:							!CJD2
	CALL ERRSET(74,.TRUE.,.FALSE.,,.FALSE.,30000)			!CJD2
	CALL LIB$ESTABLISH(LIB$FIXUP_FLT)
C END VAX ERRSET CALLS......
C	CALL UVT100(RM,8)
	CALL UVT100(ED,2)
	CALL UVT100(SCS,0,1)
	CALL UVT100(SCS,1,2)
	CALL UVT100(CUP,5,8)
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)
	CALL LWRITE(6,17HAnalytiCalc-GIANT,17)				!CJD3
	CALL UVT100(CUP,6,12)
	CALL LWRITE(6,7HV23-02B,7)					!CJD3
	CALL UVT100(CUP,7,15)
	CALL UVT100(SGR,0)
	CALL UVT100(CUP,10,3)
	CALL LWRITE(6,22H... The Analyst's Tool,22)			!CJD3
	CALL UVT100(CUP,11,5)
	CALL LWRITE(6,41Hby Glenn and Mary Everhart, (C) 1983-1990,41)	!CJD3
	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
C ^Z (or error) on startup is EXIT					!CJD2
	ASSIGN 9999 TO ERRRET						!CJD2
	GOTO 3000
3002	CONTINUE
C  EOF (or error) = do it all again					!CJD2
	ASSIGN 3002 TO ERRRET						!CJD2
	CALL UVT100(CUP,1,1)
	CALL LWRITE(6,29HAlter Display Windows [Y/N]: ,29)		!CJD3
	IF (LREAD(IOLVL,FORM,130).LT.0) GOTO 5600			!CJD3
	IF(FORM(1).NE.'Y'.AND.FORM(1).NE.'y')GOTO 3000
C ALTER MAPPING DESIRED
	CALL LWRITE(6,38HEnter new global column width, 1-120: ,38)	!CJD3
	LRD=LREAD(IOLVL,FORM,3)						!CJD3
	IF (LRD.LT.0) GOTO 5600						!CJD3
	DECODE(LRD,3004,FORM,ERR=5600) KWID				!CJD3
3004	FORMAT(I3)
	IF(KWID.LT.1.OR.KWID.GT.120)KWID=10
	CALL LWRITE(6,
     1	49HEnter length of display in lines (nominally 24): ,49)	!CJD3
	LRD=LREAD(IOLVL,FORM,3)						!CJD3
	IF (LRD.LT.0) GOTO 5600						!CJD3
	DECODE(LRD,3004,FORM,ERR=5600) III				!CJD3
	IF(III.LE.2.OR.III.GT.999)III=24
C RESET DISPLAY SIZE IN S COMMAND QUESTIONS AS NEEDED.
	LLDSP=III
	LLCMD=III-1
	CALL LWRITE(6,							!CJD3
     1	43HChange Annotate command from "EDIT " [Y/N]: ,43)		!CJD3
	IF (LREAD(IOLVL,FORM,120).LT.0) GOTO 5600			!CJD3
	IF(FORM(1).NE.'Y'.AND.FORM(1).NE.'y')goto 2450
	CALL LWRITE(6,23HGive new edit command: ,23)			!CJD3
	IF (LREAD(IOLVL,EDNAM,130).LT.0) GOTO 5600			!CJD3
	ednam(16)=32
c ensure one space at end of command
2450	continue
	CALL LWRITE(6,							!CJD3
     1	44HReset display to Upper Left of sheet [Y/N]: ,44)		!CJD3
	IF (LREAD(IOLVL,FORM,130).LT.0) GOTO 5600			!CJD3
	IF(FORM(1).NE.'Y'.AND.FORM(1).NE.'y')KMAP=0
	CALL LWRITE(6,							!CJD3
     1	42HModify Extended Addressing Mapping [Y/N]: ,42)		!CJD3
	IF (LREAD(IOLVL,FORM,130).LT.0) GOTO 5600			!CJD3
	IF(FORM(1).NE.'Y'.AND.FORM(1).NE.'y')GOTO 3000
	ENCODE(53,7801,FORM,ERR=5600) RCL				!CJD3
7801	FORMAT('How many columns should we move over on row over '
     1  ,I4)
	CALL LWRITE(6,FORM,53)						!CJD3
	LRD=LREAD(IOLVL,FORM,3)						!CJD3
	IF (LRD.LT.0) GOTO 5600						!CJD3
	DECODE(LRD,3004,FORM,ERR=5600) ICREF				!CJD3
	IF(ICREF.LT.0.OR.ICREF.GT.RRW)ICREF=RRW/10
	ENCODE(50,7802,FORM,ERR=5600) RRW				!CJD3
7802	FORMAT('How many rows should we move down on col over '
     1  ,I4)
	CALL LWRITE(6,FORM,50)						!CJD3
	LRD=LREAD(IOLVL,FORM,3)						!CJD3
	IF (LRD.LT.0) GOTO 5600						!CJD3
	DECODE(LRD,3004,FORM,ERR=5600) IRREF				!CJD3
	IF(IRREF.LT.0.OR.IRREF.GE.RCL)IRREF=RCL/10
3000	CONTINUE
	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)
	CALL LWRITE(6,							!CJD3
     1	49HEnter new floating numeric format default [Y/N]: ,49)	!CJD3
	IF (LREAD(IOLVL,FORM,130).LT.0) GOTO 5600			!CJD3
	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
	CALL LWRITE(6,33HEnter new format. Suggest F10.2> ,33)		!CJD3
	IF (LREAD(IOLVL,FORM,130).LT.0) GOTO 5600			!CJD3
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 FORM COMPLETELY INIT'D
3591	DEFFMT(N1)=KKK
C CHECK ITS LEGALITY BY TRYING TO USE IT ONCE.
	XX=3.14159
	ENCODE(78,DVFMT,FORM,ERR=6888)XX
C IF IT FAILS, PROGRAM WILL CRASH AND FILE WON'T GET CLOBBERED.
3589	CONTINUE
	CALL UVT100(CUP,15,1)
	CALL LWRITE(6,22HTitle of Spreadsheet: ,22)			!CJD3
	IF (LREAD(IOLVL,FORM,130).LT.0) GOTO 5600			!CJD3
	FOOBAR=0							!CJD3
	IF(FORM(1).LE.32.AND.FORM(2).LE.32)GOTO 3804
C SKIP ENTERING NEW NAME IF HE ENTERS NOTHING
	DO 3805 III=1,80
C USE ~ CHARACTER IN TITLE TO FLAG TO READ SYS$INPUT
	IF(FORM(III).EQ.'~')FOOBAR=1
C LEAVE ~ CHARACTERS OUT OF TITLE...
	IF(FORM(III).EQ.'~')FORM(III)=32
3805	NMSH(III)=FORM(III)
3804	CONTINUE
3006	FORMAT(80A1,50A1)
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 ******
D	CALL UVT100(CUP,16,1)
D	WRITE(6,2056)
D2056	FORMAT('Give Max Rows to be used:')
	KR=RCL
	KC=RRW
D	READ(IOLVL,7202,END=5600,ERR=5600)KR
D	IF(KR.LE.0)KR=RCL
D	CALL UVT100(CUP,17,1)
D	WRITE(6,2057)
D2057	FORMAT('Give Max Cols to be used:')
D	READ(IOLVL,7202,END=5600,ERR=5600)KC
D	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.
	IPGMOD=KKK/4
	LPGMOD=KKK/4
C COMPUTED ABOVE THE MIN # OF K FOR DISK FILES
D	CALL UVT100(CUP,18,1)
D	WRITE(6,2058)XKDN,XKDF
D2058	FORMAT('Mins=',F9.0' K Value file, ',F9.0,' K Formula file')
C KKK IS MAX INDEX TO BE USED HERE.
D	CALL UVT100(CUP,21,1)
D	WRITE(6,7201)
D7201	FORMAT('Give disk size (K) for Value Memory:')
	IPGMAX=XKDN
D	READ(IOLVL,7202,END=5600,ERR=5600)IPGMAX
7202	FORMAT(I6)
D	IPGMOD=KKK
	IF(IPGMAX.LT.0)IPGMOD=0
	IPGMAX=IABS(IPGMAX)
	IF(IPGMAX.LE.0.OR.IPGMAX.GT.512)IPGMAX=1
D	CALL UVT100(CUP,22,1)
D	WRITE(6,7203)
D7203	FORMAT('Give disk size (K) for Formula Memory:')
	LPGMXF=(XKDF*4.)
D	READ(IOLVL,7202,END=5600,ERR=5600)LPGMXF
D	LPGMOD=KKK
D	IF(LPGMXF.LT.0)LPGMOD=0
D	LPGMXF=IABS(LPGMXF)
C IF NUMBERS ARE ENTERED NEGATIVE, SET MODE TO "SLOW, FILE-SPACE
C CONSERVING" PACKING, SCATTERING PAGES ACROSS FILE.
D	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 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
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 AnalytiCalc PC.
	IF(ICODE.EQ.-4)CALL WRKFIL(1,FORM,2)
3009	IF(ICODE.EQ.-4)GOTO 1
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
2000	CONTINUE
C DRAW OUR LABELS AND OTHERWISE INITIALIZE DISPLAY SHEET
	KZPPD=0
	IF(IPSET.NE.0)GOTO 1000
	IF(PZAP.EQ.0)CALL UVT100(ED,2)
	CALL UVT100(CUP,1,1)
	OSWIT=20
	IPRSS=PROW
	IPCSS=PCOL
	IDRW=DROW
	IDCL=DCOL
	IF(LINIZZ.LE.1)CALL RECALC
	IF(PZAP.EQ.0)CALL DSPSHT(2)
	DCOL=IDCL
	DROW=IDRW
	PROW=IPRSS
	PCOL=IPCSS
C
1000	CONTINUE
	ASSIGN 1000 TO ERRRET						!CJD2
	IPSET=0
	LINIZZ=LINIZZ+1
	OSWIT=20
C ISSUE A PROMPT FOR COMMAND AND DO A COMMAND
	ICODE=0
	CALL XQTCMD(ICODE)
	IF(ICODE.LT.30)GOTO 1843
C HELP COMMAND AND SIMILAR...
	IF(ICODE.NE.400)GOTO 1847
	CALL DSPSHT(10)
	ICODE=1
C CODE 10 IS PRINT SECRET CODE TO DSPSHT.
	GOTO 1843
1847	CONTINUE
	IF(ICODE.NE.420)GOTO 1849
C CLOSE UNIT 1 JUST IN CASE...
CJD3	CLOSE(UNIT=1)
	KLVL=1
	IPRSSS=PROW
	IPCSSS=PCOL
	CALL UVT100(RM, DECKPNM)					!CJD3
	CALL CALC
	CALL UVT100(SM, DECKPAM)					!CJD3
	PROW=IPRSSS
	PCOL=IPCSSS
C CLOSE CONSOLE LUN USED BY CALC.
CJD3	CLOSE(UNIT=1)
C CLOSE ANY OTHER LUNS CALC MAY HAVE USED...
	CLOSE(UNIT=2)
	CLOSE(UNIT=3)
C SET UP FOR REDRAW WHEN BACK...
	ICODE=-1
	GOTO 1843
1849	CONTINUE
	IF(ICODE.NE.430)GOTO 1845
C TEST FUNCTION, TESTING EXPRESSION.
C INHIBIT RECALCULATION...
C COMMAND IS IN "XTNCMD" STRING.
	LLST=MIN0(80,XTNCNT)
	LFST=1
	CALL DOENTR(XTNCMD,LFST,LLST)
C THIS SETS % VARIABLE AND WILL DO A CALC DIRECTLY. THEREFORE
C WE MUST INHIBIT AUTO RECALCULATION.
C NOTE WE HAVE TO CALL THIS FROM THE ROOT SINCE THE RECALC OVERLAY
C TREE OVERWRITES THE XQTCMD ONE.
	ICODE=1
	GOTO 1843
1845	CONTINUE
	IVVV=ICODE-30
9308	CALL HELP(IVVV)
	IVVV=0
	CALL LWRITE(6,							!CJD3
     1	50HType return to continue, Hn for other Help pages: ,50)	!CJD3
	ASSIGN 9308 TO ERRRET						!CJD2
	IF (LREAD(IOLVL,FORM2,4).LT.0) GOTO 5600			!CJD3
	IVVVV=FORM2(2)
	IF(IVVVV.GE.48.AND.IVVVV.LE.57)IVVV=IVVVV-48
	IF(FORM2(1).EQ.'H'.OR.FORM2(1).EQ.'h')GOTO 9308
	ASSIGN 1000 TO ERRRET						!CJD2
C NOW CLEAR SCREEN AND TRY MORE COMMANDS AS BEFORE...
	ICODE=6
C
1843	CONTINUE
	OSWIT=20
	IPRSS=PROW
	IPCSS=PCOL
	IDRW=DROW
	IDCL=DCOL
	IF(LINIZZ.LE.1)CALL RECALC
	IF(IPSET.NE.0)GOTO 4110
	DCOL=IDCL
	DROW=IDRW
	PROW=IPRSS
	PCOL=IPCSS
4110	CONTINUE
	IPSET=0
	IF(ICODE.EQ.-1)GOTO 2000
C IN AnalytiCalc-VM, S COMMAND ALLOWS DEFAULT FORMAT CHANGE AND
C TITLE CHANGE, BUT DOES NOT ALTER SHEET IN MEMORY... DON'T ALLOW
C SCRATCH FILE SAVE STUFF...
C	IF(ICODE.EQ.-2)CALL WRKFIL(1,FORM,3)
C	IF (ICODE.EQ.-2)CALL CLOSE(7)
	IF(ICODE.LE.-2)GOTO 3002
C
C RECALCULATE SHEET NOW AUTOMAGICALLY
C IF ICODE=1, COMMAND JUST MOVES ON DISPLAY, SO NO NEED TO RECALCULATE
C THE ENTIRE SHEET.
C LIMIT NUMBER OF ITERATIONS AT ANY ONE TIME TO 20 HOWEVER
	KKMAX=20
3670	CONTINUE
	IF(ICODE.EQ.5.OR.ICODE.EQ.1.OR.
     1  RCFGX.EQ.1.OR.ICODE.EQ.6)GOTO 3671
	CALL RECALC
	IPSET=0
	KKMAX=KKMAX-1
C IMPLEMENT VARY LOOP...
C ASSUME USRFCT MUSTR CONTOL KALKIT VARIABLE THEN TO GET LOOP TO
C TERMINATE SOMETIME.
	KKMAX=MIN0(KKMAX,KALKIT)
	IF(KKMAX.GT.0)GOTO 3670
3671	CONTINUE
C	IF(ICODE.NE.1.AND.RCFGX.NE.1)CALL RECALC
C
C DISPLAY SHEET NOW. ONLY ALTERS ENTRIES INVALIDATED BY COMMAND.
	IF(ICODE.NE.2.AND.ICODE.NE.6)GOTO 21
C ICODE=2 = REFRESH DISPLAY. ZERO ALL NUMBERS AND CAUSE TOTAL REDISPLAY.
	DO 22 N1=1,DRW
	DO 22 N2=1,DCL
C SET NUMBER DISPLAYED TO WEIRD VALUE.
22	DVS(N1,N2)=DVS(N1,N2)+.000000000034
	IF(PZAP.EQ.0)CALL UVT100(ED,2)
	CALL UVT100(CUP,1,1)
21	CONTINUE
	IF(ICODE.EQ.6)ICODE=2
	IF(ICODE.NE.5.AND.PZAP.EQ.0)CALL DSPSHT(ICODE)
	DCOL=IDCL
	DROW=IDRW
	PROW=IPRSS
	PCOL=IPCSS
	GOTO 1000
5600	CONTINUE
C ERROR ON READ FROM IOLVL HANDLED HERE.
CJD3	REWIND 5
	CLOSE(UNIT=3)
C GUARANTEE TT: GETS OPENED FOR INPUT ON EOF ON INPUT.
	IOLVL=5
	FOOBAR=0
	CLOSE(UNIT=5)
CJD3	OPEN(UNIT=5,FILE='SYS$COMMAND:',READONLY,
CJD3     1	STATUS='OLD',							!CJD2
CJD3     1  CARRIAGECONTROL='NONE')
	GOTO ERRRET							!CJD2
9999	CONTINUE							!CJD2
	END
	SUBROUTINE IN2AS(ROW,CHRS)
	InTEgeR*4 ROW
	LOGICAL*1 CHRS(4)
	INTEGER*4 AC,AC1,AC2
	DO 1 N1=1,4
1	CHRS(N1)=32
C CONVERT ROW TO LETTERS. ASSUMES COL=2 OR MORE. ROW 1=A-Z
C ROW 2=AA-AZ, THEN BA-BZ ETC.
	AC=ROW
	DO 2 N=1,4
	M=5-N
C CONVERT BACKWARDS INTO CHRS
	AC1=(AC/26)
	AC2=AC1*26
	IX=AC-AC2
	IF(.NOT.(IX.EQ.0.AND.AC1.GT.0))GOTO 772
C CORRECT SO WE GET Z, NOT A<NULL> FOR LABELS.
	IX=26
	AC1=AC1-1
772	CONTINUE
	IF(IX.GT.0)CHRS(M)=IX+64
C CONVERT TO ASCII A-Z CHARACTER
	AC=AC1
2	CONTINUE
C JUST IGNORE ANY OVERFLOW.
	RETURN
	END
