C
C FIRST CUT TRY AT REMOVING ONE TIME CODE FROM MAIN PROGRAM
C HERE (FOR PDP11 VERSION OF PORTACALC). SPREDSHT.PR1 IS
C MAIN PROGRAM, SPREDSHT.PR2 IS SUBROUTINES SPLIT OUT
C OF IT.
C
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.
	IKONS=0
	CALL INITA1(KMAP,KWID,ICODE)
3002	CONTINUE
	CALL INITA2(KMAP,KWID,ICODE,IKONS)
	IKONS=1
3000	CONTINUE
	CALL INITB(KMAP,KWID,ICODE)
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)
3006	FORMAT(80A1)
	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
	LOGICAL*1 FORM(100)
	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