C PORTACALC MAIN PROGRAM
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 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	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
	EXTERNAL LIB$FIXUP_FLT						!CJD2
	INTEGER*2 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*2 ICREF,IRREF,FOOBAR
	COMMON/MIRROR/ICREF,IRREF
	COMMON/FOOBAR/FOOBAR
	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 kdrw,kdcl
	common/DOT/Kdrw,kdcl
	INTEGER*2 PROW,PCOL,DROW,DCOL,DRWV,DCLV
	INTEGER*2 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*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
	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*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
	INTEGER*2 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*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
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=0
	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
	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' )
      OPEN ( UNIT = 6, FILE='SYS$OUTPUT:'
     1  ,CARRIAGECONTROL = 'NONE' )
	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)
	WRITE(6,3010)
3010	FORMAT('Analyti!Calc-VX')
	CALL UVT100(CUP,6,12)
	WRITE(6,3278)
3278	FORMAT('V23-01A')
	CALL UVT100(CUP,7,15)
	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-1987')
	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)
	WRITE(6,3003)
3003	FORMAT('Alter Display Windows [Y/N]:')
	READ(IOLVL,3006,END=5600,ERR=5600)FORM
	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,3109)
3109	FORMAT('Enter length of display in lines (nominally 24):')
	READ(IOLVL,3004,END=5600,ERR=5600)III
	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
	WRITE(6,2410)
2410	FORMAT('Change Annotate command from "EDIT " [Y/N]:')
	READ(IOLVL,3006,END=5600,ERR=5600)FORM
	IF(FORM(1).NE.'Y'.AND.FORM(1).NE.'y')goto 2450
	write(6,2411)
2411	format('Give new edit command:')
	Read(IOLVL,3006,end=5600,err=5600)ednam
	ednam(16)=32
c ensure one space at end of command
2450	continue
	WRITE(6,3008)
3008	FORMAT('Reset display to Upper Left of sheet [Y/N]:')
	READ(IOLVL,3006,END=5600,ERR=5600)FORM
	IF(FORM(1).NE.'Y'.AND.FORM(1).NE.'y')KMAP=0
	WRITE(6,7800)
7800	FORMAT('Modify Extended Addressing Mapping [Y/N]:')
	READ(IOLVL,3006,END=5600,ERR=5600)FORM
	IF(FORM(1).NE.'Y'.AND.FORM(1).NE.'y')GOTO 3000
	WRITE(6,7801)RCL
7801	FORMAT('How many columns should we move over on row over '
     1  ,I4)
	READ(IOLVL,3004,END=5600,ERR=5600)ICREF
	IF(ICREF.LT.0.OR.ICREF.GT.RRW)ICREF=RRW/10
	WRITE(6,7802)RRW
7802	FORMAT('How many rows should we move down on col over '
     1  ,I4)
	READ(IOLVL,3004,END=5600,ERR=5600)IRREF
	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)
	WRITE(6,3588)
3588	FORMAT('Enter new floating numeric format default [Y/N]:')
	READ(IOLVL,3006,END=5600,ERR=5600)FORM
	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 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)
	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 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 PORTACALC 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...
	CLOSE(UNIT=1)
	KLVL=1
	IPRSSS=PROW
	IPCSSS=PCOL
	CALL CALC
	PROW=IPRSSS
	PCOL=IPCSSS
C CLOSE CONSOLE LUN USED BY CALC.
	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
	WRITE(6,5020)
5020	FORMAT(/'Type return to continue, Hn for other Help pages:')
	ASSIGN 9308 TO ERRRET						!CJD2
	READ(IOLVL,3006,END=5600,ERR=5600)(FORM2(K),K=1,4)
	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 PORTACALC-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.
	REWIND 5
	CLOSE(UNIT=3)
C GUARANTEE TT: GETS OPENED FOR INPUT ON EOF ON INPUT.
	IOLVL=5
	FOOBAR=0
	CLOSE(UNIT=5)
	OPEN(UNIT=5,FILE='SYS$COMMAND:',READONLY,
     1	STATUS='OLD',							!CJD2
     1  CARRIAGECONTROL='NONE')
	GOTO ERRRET							!CJD2
9999	CONTINUE							!CJD2
	END
	SUBROUTINE IN2AS(ROW,CHRS)
	INTEGER*2 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
	SUBROUTINE HELP(LVL)
C PRINT HELP INFO ON SCREEN USING FIRST 22 LINES. ASSUME XQTCMD INVALIDATES
C THE DISPLAY.
      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
      PARAMETER TMREFN = 1
	LOGICAL*1 FORM(120)
	INCLUDE '($TT2DEF)'						!CJD1
	INTEGER*4 TERMBF(3)						!CJD1
	COMMON/OLDTER/TERMBF						!CJD1
	CALL UVT100(ANSI)
	CALL UVT100(ED,2)
C	CALL UVT100(RM,8)
C	CALL UVT100(RM,5)
C LEVEL 0 (LEVELS NOT YET IMPLEMENTED)
	CALL UVT100(CUP,1,1)
	INCLUDE 'PCHELP.FVX'						!CJD1
	WRITE(6,100)
	CALL UVT100(CUP,2,1)
	WRITE(6,101)
	CALL UVT100(CUP,3,1)
	WRITE(6,102)
	CALL UVT100(CUP,4,1)
	WRITE(6,103)
	CALL UVT100(CUP,5,1)
	WRITE(6,104)
	CALL UVT100(CUP,6,1)
	WRITE(6,105)
	CALL UVT100(CUP,7,1)
	WRITE(6,106)
	CALL UVT100(CUP,8,1)
	WRITE(6,107)
	CALL UVT100(CUP,9,1)
	WRITE(6,108)
	CALL UVT100(CUP,10,1)
	WRITE(6,109)
	CALL UVT100(CUP,11,1)
	WRITE(6,110)
	CALL UVT100(CUP,12,1)
	WRITE(6,111)
	CALL UVT100(CUP,13,1)
	WRITE(6,112)
	CALL UVT100(CUP,14,1)
	WRITE(6,113)
	CALL UVT100(CUP,15,1)
	WRITE(6,114)
	CALL UVT100(CUP,16,1)
	WRITE(6,122)
	CALL UVT100(CUP,17,1)
	WRITE(6,115)
	CALL UVT100(CUP,18,1)
	WRITE(6,116)
	CALL UVT100(CUP,19,1)
	WRITE(6,117)
	CALL UVT100(CUP,20,1)
	WRITE(6,118)
	CALL UVT100(CUP,21,1)
	WRITE(6,119)
	CALL UVT100(CUP,22,1)
	WRITE(6,120)
	CALL UVT100(CUP,23,1)
	WRITE(6,121)
9000	CONTINUE
	CALL UVT100(CUP,24,1)
100	FORMAT('EN expression - Insert expression at '
     1 'current pos.')
101	FORMAT('M1,M2,M3, or M4 - Motion up, down, left, right (auto)')
102	FORMAT('DL var1:var2 Rn:m (or Cn:m) - Display Loc phys to '
     1   'row/col n-m')
103	FORMAT('DF var1:var2 [format] - set display format.'
     1 ' A or L shows text, else #')
104	FORMAT('DT var1:var2 F or I - Set display number type to'
     1 ' flt or int')
105	FORMAT('DW n,m - set width of column n of display to m chars')
106	FORMAT('DB c,r - Set display bounds at c cols, r rows (chars)')
109	FORMAT('L var - Move cursor to var named (phys.)'
     1  ' OA var or OR var=move displ. origin')
107	FORMAT('V - redraw screen. VF - Disply. formulae. VM=no auto.'
     1  ' redraw')
108	FORMAT('K - Drop into interactive calc. *E returns to sheet.')
110	FORMAT('ZA - zero all. ZE var1:var2 - zero var1 to var2')
111	FORMAT('X - exit program. W write screen to file or printer')
112	FORMAT('CV v1:v2 v3:v4 copy value from v1:v2 to v3:v4 range;'
     1 'CR=copy and relocate vars.')
113	FORMAT('CD v1:v2 v3:v4 copy display format. CF=copy formula'
     1  '. CA=copy all')
114	FORMAT('P Put screen to file. G=get screen from file at curr.loc')
115	FORMAT('1,2,3,4 - move cursor Up,Down,Left,Right. '
     1  'A[A/R]n[R/C] Add abs/reloc n Row/Col')
116	FORMAT('Variable ranges are var1[:var2]. Var names P#+n#+m or')
117	FORMAT('D#+n#+m are current Phys or Display locs + or - offsets')
118	FORMAT('Expressions may use multiple stmts, use \ separators.')
119	FORMAT('Use std FORTRAN  function names + MIN, MAX, AVG, STD')
120	FORMAT('or SUM. IF stmt format is IF [v1.REL.v2]yes-expr|else'
     1  ' expr.')
121	FORMAT('Rels are .LT.,.GT.,.EQ.,.NE.,.GE.,.LE.')
122	FORMAT('R Recompute sheet. RM Recompute Manually only (R resets)')
	RETURN
	END