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	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 INITIAL DEFAULT FORMAT FOR NUMERICS is set at runtime
C	SET UP TERMINAL
C SET IT NOWRAP, NO CARRIAGE CONTROL.
	IDOL7=1
C IDOL7=1 MEANS SCROLL ENABLED
C SETUP INITIAL DISPLAY LIMITS ACTUALLY USED.
	RRWACT=1
	RCLACT=1
	IOLVL=5
	DRWV=MXCOLS
	DCLV=MXROWS
	KLVL=1
	KALKIT=0
	ICODE=0
	idol3=0
	idol4=0
	idol5=20000
	idol6=20000
	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='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-11')
	CALL UVT100(CUP,6,12)
	WRITE(6,3278)
3278	FORMAT('V12-08A')
	CALL UVT100(CUP,7,15)
	CALL UVT100(SGR,0)
c	WRITE(6,3011)
c3011	FORMAT('or')
c	CALL UVT100(CUP,9,11)
c	WRITE(6,3012)
c3012	FORMAT('AnalytiCalc')
	CALL UVT100(CUP,11,3)
	WRITE(6,3013)
3013	FORMAT('  .... The Analyst''s Tool')
	CALL UVT100(CUP,13,5)
	WRITE(6,3014)
3014	FORMAT(' by Glenn and Mary Everhart, (C) 1983')
	CALL UVT100(CUP,16,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
C	KMAP=1
C	GOTO 3000
3002	CONTINUE
C	CALL UVT100(CUP,1,1)
C	WRITE(6,3003)
C3003	FORMAT(' Alter Display Windows [Y/N]:')
C	READ(IOLVL,3006,END=5600,ERR=5600)NMSH
C	IF(NMSH(1).NE.'Y'.AND.NMSH(1).NE.'y')GOTO 3000
CC ALTER MAPPING DESIRED
C	WRITE(6,3001)
C3001	FORMAT(' ENTER NEW GLOBAL COLUMN WIDTH, 1-120:')
C	READ(IOLVL,3004,END=5600,ERR=5600)KWID
C3004	FORMAT(I3)
C	IF(KWID.LT.1.OR.KWID.GT.120)KWID=10
C	WRITE(6,3008)
C3008	FORMAT(' Reset display to Upper Left of sheet [Y/N]:')
C	READ(IOLVL,3006,END=5600,ERR=5600)NMSH
C	IF(NMSH(1).NE.'Y'.AND.NMSH(1).NE.'y')KMAP=0
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)NMSH
	IF(NMSH(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)NMSH
C NOW HAVE HIS DESIRED FORMAT. COPY INTO THE DEFAULT ARRAY.
C DEFFMT IS THAT.
	DO 3591 N1=1,10
	KKK=NMSH(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)NMSH
3006	FORMAT(80A1)
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.OR.KR.GT.RCL)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.OR.KC.GT.RRW)KC=RRW
	KKK=(KR-1)*RRW+KC
	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 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 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
C
C NOW SET UP NRDSP, NCDSP
C	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.
3009	IF(ICODE.EQ.-4)CALL WRKFIL(1,FORM,2)
	IF(ICODE.EQ.-4)GOTO 1
7831	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
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
	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:')
	READ(IOLVL,3006,END=5600,ERR=5600)(FORM2(K),K=1,4)
	IVVVV=FORM2(2)
	ivvx=form2(3)
	IF(IVVVV.GE.48.AND.IVVVV.LE.57)IVVV=IVVVV-48
	if(ivvx.lt.48.or.ivvx.gt.57)goto 9381
c implement 2 digit help code.
	ivvvx=ivvx-48
	ivvv=(ivvv*10)+ivvvx
9381	continue
	ivvv=min0(ivvv,maxhlp)
	IF(FORM2(1).EQ.'H')GOTO 9308
C NOW CLEAR SCREEN AND TRY MORE COMMANDS AS BEFORE...
	ICODE=2
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.RCFGX.EQ.1)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)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.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)
	IOLVL=5
	GOTO 1000
	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
D	LOGICAL*1 FORM(80)
	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.FOR'
	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. formulas. 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 thru 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
