PROGRAM SLVPLY !SoLVe PoLYnomial equations C C VT100 feature display program C C S.C. CRIBBS 83/05/16 version #2 C C Link SLVPLM,TCFL.MTT C C Remember to SET TT NOCRLF C IMPLICIT INTEGER(A-Z) BYTE INITT(23),FNLT(18) DATA INITT /"33,'<',"33,'(','B',"33,'=',"33,'[','?','1','h', # "33,'[','?','3','l',"33,'[','?','5','l',"200/ DATA FNLT /"33,'[','?','1','l',"33,'>',"33,'[','2','J',"33, # '[','1',';','1','H',"200/ CALL GTTRM !Allocate a terminal C C Insist the program must use a recognized video terminal. C (VT100,VT102,VT105,VK100,VT125) C IF(KTRMID(1,IDC,LPRV).LE.0 .OR. # (IDC.NE.1.AND.IDC.NE.5.AND.IDC.NE.6.AND.IDC.NE.12) .OR. # LPRV.EQ.0) # STOP 'This program requires a VT100 type video terminal' C CALL SCCA(I) !Trap Control_C C C Define terminals operating conditions: C -Respond to ANSI control commands C -Set keyboard to send American-English (G0 set) C -Keypad Application mode C -Set Cursor key mode C -80 column screen C -Screen background black CALL OUTTZ(INITT) C CALL TTMDE(3) !Switch console to character mode, Lower case CALL PLATE1 !Tell user what we do CALL INTRAC !Do it C C Return terminal to power-up conditions, clear screen, home cursor: C -Reset Cursor key mode C -Keypad Numeric mode CALL OUTTZ(FNLT) C CALL TTMDE(0) !Change console back to line mode CALL SCCA !Reset Control_C trap CALL EXIT !Quiet termination END SUBROUTINE GTTRM INTEGER LUN,MTSC(4) C C Terminal initialization code C TYPE 100 100 FORMAT(1H0,'Terminal# = ',$) ACCEPT 200, LUN 200 FORMAT(I) IF(MTATCH(LUN) .NE. 0) STOP '?GTTRM-F-MTATCH failure' IF(MTGET(LUN,MTSC) .NE. 0) STOP '?GTTRM-F-MTGET failure' MTSC(1) = MTSC(1) .AND. "177775 ! No IF(MTSET(LUN,MTSC) .NE. 0) STOP '?GTTRM-F-MTSET failure' CALL LUNTRM(LUN) !Tell TCFL which port to use RETURN END SUBROUTINE POSCUR(COMAND,IPL,ERROR) !Program SLVPLY INTEGER LINE,COLM,COMAND,IPL LOGICAL*1 ERROR BYTE BEEP,PRSTR COMMON /SLVP2/ LINE(7),COLM(7),BEEP(3),PRSTR(16,5) ERROR = .FALSE. 5 IPL = KCURP(NL,NC) IF(IPL .LT. 0) STOP 'KCURP - no response from terminal' IF(IPL .EQ. 0) GO TO 5 !Hang till correct response received DO 1000 IPL = 1,7 IF(NL .EQ. LINE(IPL)) GO TO 10 1000 CONTINUE CALL CUP(24,24) CALL CLRLIN CALL OUTTZN(BEEP) CALL OUTTZN('Cursor was illegally positioned') ERROR = .TRUE. IPL = 1 GO TO 40 10 IF(COMAND .NE. 1) GO TO 20 !UP IF(IPL .EQ. 1) GO TO 30 IPL = IPL - 1 IF(IPL .EQ. 5) IPL = IPL - 1 GO TO 40 20 IF(IPL .EQ. 7) GO TO 30 !DOWN IPL = IPL + 1 IF(IPL .EQ. 5) IPL = IPL + 1 GO TO 40 30 CALL OUTTZN(BEEP) 40 RETURN END SUBROUTINE GTENTR !Program SLVPLY BYTE STRING COMMON /SLVP1/ STRING(81) CALL CUP(24,27) CALL OUTTZN('To continue: Press ') CALL SGR(5,7) CALL OUTTZN('ENTER') CALL SGR(0) 10 IF(LESCSQ(STRING) .LE. 0) GO TO 10 IF(KITCC(STRING(2),STRING(1)) .LE. 0 .OR. STRING(1) .NE. "15) # GO TO 10 RETURN END SUBROUTINE INTRAC !Program SLVPLY DOUBLE PRECISION DPCSTR(2) REAL PRVALU(5),EMPTYV,EMESG(10,8) INTEGER LINE,COLM,COMAND,IPL,I,LESCSQ,KITCC,EXPPOS,KVALID,KN LOGICAL*1 ERROR,PRDFND,EXPFND BYTE BEEP,STRING,PRSTR,EMPTYS(16),CSTRNG(16),BKSPBK(4) BYTE PERIOD,DELETE,SPACE,RETRN,LNFEED COMMON /SLVP1/ STRING(81) COMMON /SLVP2/ LINE(7),COLM(7),BEEP(3),PRSTR(16,5) EQUIVALENCE (DPCSTR(1),CSTRNG(1)) DATA EMPTYV /-1.0E-38/, EMPTYS /15*' ',0/ BEEP /"7,"7,0/ DATA SPACE,RETRN,LNFEED,PERIOD,DELETE /"40,"15,"12,"56,"177/ DATA BKSPBK/"10,' ',"10,0/ DATA LINE /4,6,8,10,12,16,18/, COLM /3*39,34,45,24,24/ DATA EMESG/'Inva','lid ','term','inal',' con','trol',' req', # 'uest',0.0,0.0,'Inva','lid ','DELE','TE c','hara','ract', # 'er r','eque','st ',0.0,'Inva','lid ','fiel','d te', # 'rmin','atio','n re','ques','t ',0.0,'Inva','lid ','char', # 'acte','r in',' num','eric',' fie','ld ',0.0,'Atte','mpt ', # 'to i','nser','t a ','seco','nd p','erio','d ',0.0,'Atte', # 'mpt ','to i','nser','t a ','seco','nd "','E" ',0.0,0.0, # 'Inva','lid ','posi','tion',' for',' a +',' or ','- si', # 'gn ',0.0,'Nume','ric ','valu','e to','o la','rge ','or s', # 'mall',0.0,0.0/ C C Preset Initial values of coefficients & X C DO 1000 I = 1,5 PRVALU(I) = EMPTYV CALL SCOPY(EMPTYS,PRSTR(1,I)) 1000 CONTINUE CALL PLATE2 ERROR = .FALSE. KVALID = 0 !Allow both Numerics & Commands IPL = 1 !Point to top line of PLATE2 CALL SGR(7) !Echo input numerics in reverse video CALL SETERR(10,128) !Program will catch Floating Overflow CALL SETERR(11,128) !Program will catch Floating Underflow C C Position cursor to a new field & initialize flags C 10 CALL CUP(LINE(IPL),COLM(IPL)) DPCSTR(1) = 0.0D0 !Initialize character workspace DPCSTR(2) = 0.0D0 KN = 0 !No Numerics received PRDFND = .FALSE. !No periods found EXPFND = .FALSE. !No exponential sign found C C Get keyboard input, watch for Escape sequences C 20 I = LESCSQ(STRING) IF(I .LT. 0) GO TO 20 IF(.NOT. ERROR .OR. (I.EQ.0 .AND. STRING(1).EQ.LNFEED)) GO TO 30 CALL SAVCUR CALL CUP(24,1) CALL CLRLIN !Erase the last error message CALL RESCUR ERROR = .FALSE. 30 IF(I .EQ. 0) GO TO 50 !Must be a numeric character C C Catch input from the Numeric Keypad C I = KITCC(STRING(2),STRING(1)) !Check for terminal control commands IF(I .LT. 0) GO TO 991 IF(I .EQ. 0) GO TO 50 !Numeric typed on keypad COMAND = STRING(1) IF(COMAND .GT. 2) GO TO 40 IF(KVALID .GT. 0) GO TO 991 !Only numerics allowed CALL POSCUR(COMAND,IPL,ERROR) KVALID = 0 !Allow both numerics & commands IF(IPL .GE. 6) KVALID = -1 !Only allow commands GO TO 10 40 IF(COMAND .EQ. RETRN) GO TO 60 !Must have been Keypad ENTER GO TO 991 C C DELETE character C 50 IF(STRING(1) .NE. DELETE) GO TO 60 IF(KN .EQ. 0 .OR. KVALID .EQ. -1) GO TO 992 IF(STRING(KN) .EQ. PERIOD) PRDFND = .FALSE. IF(STRING(KN) .EQ. 'E') EXPFND = .FALSE. KN = KN - 1 CALL OUTTZN(BKSPBK) IF(KN .NE. 0) GO TO 20 CALL OUTTZN(PRSTR(1,IPL)) KVALID = 0 !Accept both numerics & commands GO TO 10 C C RETURN or ENTER characters C 60 IF(STRING(1) .NE. RETRN) GO TO 70 IF(KVALID .NE. -1 .OR. I .NE. 1) GO TO 64 !Traps in lines 6 & 7 IF(IPL .NE. 6) GO TO 62 !Line 6 CALL SGR(0) CALL PLATE1 CALL PLATE2 CALL SGR(7) IPL = 6 GO TO 10 62 CALL SGR(0) !Line 7 RETURN 64 IF(IPL .GT. 4) GO TO 993 IF(KN .NE. 0) GO TO 66 CALL SCOPY('0.0',CSTRNG) CALL OUTTZN('0.0 ') VALUE = 0.0 GO TO 68 66 CSTRNG(KN+1) = 0 !Install a trailing null CALL CONCAT(CSTRNG,' ',CSTRNG,15) DECODE(KN,100,CSTRNG,ERR=90) VALUE 100 FORMAT(F15.0) 68 CALL SCOPY(CSTRNG,PRSTR(1,IPL)) PRVALU(IPL) = VALUE IPL = IPL + 1 IF(IPL .GT. 4) IPL = 4 KVALID = 0 !Allow both numeric & command input DO 3000 I = 1,4 !Make sure 3 coefficients & X value exist IF(PRVALU(I) .EQ. EMPTYV) GO TO 10 3000 CONTINUE CALL ERRSNS() !Zero error count TVAL = PRVALU(2) * PRVALU(4) CALL ERRSNS(I,J) IF(I .NE. 0) GO TO 92 PRVALU(5) = PRVALU(3) + TVAL CALL ERRSNS(I,J) IF(I .NE. 0) GO TO 92 TVAL = PRVALU(4)**2 CALL ERRSNS(I,J) IF(I .NE. 0) GO TO 92 TVAL = TVAL * PRVALU(1) CALL ERRSNS(I,J) IF(I .NE. 0) GO TO 92 PRVALU(5) = PRVALU(5) + TVAL CALL ERRSNS(I,J) IF(I .NE. 0) GO TO 92 ENCODE(15,200,PRSTR(1,5),ERR=92) PRVALU(5) 200 FORMAT(G) PRSTR(16,5) = 0 !Install a trailing null CALL CUP(LINE(5),COLM(5)) CALL OUTTZN(PRSTR(1,5)) GO TO 10 !Return to last input line C C Numeric, Sign, Exponential sign, period, or Linefeed character C 70 IF(STRING(1) .EQ. LNFEED) GO TO 20 !Always ignore IF(STRING(1) .EQ. 'e') STRING(1) = 'E' !Catch Lower case IF(IPL.GT.4 .OR. INDEX('+-.0123456789E',STRING(1)).EQ.0 .OR. # KN.EQ.15) GO TO 994 IF(STRING(1) .NE. PERIOD) GO TO 72 IF(PRDFND) GO TO 995 PRDFND = .TRUE. GO TO 76 72 IF(STRING(1) .NE. 'E') GO TO 74 IF(EXPFND) GO TO 996 EXPFND = .TRUE. EXPPOS = KN + 1 !Save char. position of 'E' GO TO 76 74 IF(STRING(1) .NE. '+' .AND. STRING(1) .NE. '-') GO TO 76 IF(KN .NE. 0 .AND. .NOT. EXPFND) GO TO 997 IF(EXPFND .AND. EXPPOS .NE. KN) GO TO 997 76 KN = KN + 1 CSTRNG(KN) = STRING(1) IF(KN .NE. 1) GO TO 78 CALL OUTTZN(EMPTYS) CALL CUP(LINE(IPL),COLM(IPL)) 78 CALL OUTTZN(CSTRNG(KN)) KVALID = 1 !Allow only numeric input GO TO 20 C C ERROR Routines C 90 PRVALU(IPL) = EMPTYV !Handle DECODE errors CALL SCOPY(EMPTYS,PRSTR(1,IPL)) CALL CUP(LINE(IPL),COLM(IPL)) CALL OUTTZN(PRSTR(1,IPL)) GO TO 94 92 PRVALU(5) = EMPTYV !Handle Math & ENCODE errors CALL SCOPY(EMPTYS,PRSTR(1,5)) CALL CUP(LINE(5),COLM(5)) CALL OUTTZN(PRSTR(1,5)) 94 CALL CUP(LINE(IPL),COLM(IPL)) KVALID = 0 DPCSTR(1) = 0.0D0 !Initialize character workspace DPCSTR(2) = 0.0D0 KN = 0 !No Numerics received PRDFND = .FALSE. !No periods found EXPFND = .FALSE. !No exponential sign found GO TO 998 991 I = 1 GO TO 999 992 I = 2 GO TO 999 993 I = 3 GO TO 999 994 I = 4 GO TO 999 995 I = 5 GO TO 999 996 I = 6 GO TO 999 997 I = 7 GO TO 999 998 I = 8 999 ERROR = .TRUE. CALL SAVCUR CALL CUP(24,17) CALL OUTTZN(BEEP) CALL SGR(0,5) CALL OUTTZN('** ERROR ** ') CALL OUTTZN(EMESG(1,I)) CALL SGR(0,7) CALL RESCUR GO TO 20 END SUBROUTINE PLATE2 !Program SLVPLY INTEGER LINE,COLM,I BYTE STRING,BEEP,PRSTR COMMON /SLVP1/ STRING(81) COMMON /SLVP2/ LINE(7),COLM(7),BEEP(3),PRSTR(16,5) CALL CLRALL DO 1000 I = 1,3 CALL CUP(LINE(I),24) CALL OUTTZN('Coefficient ') CALL SGR(1,7) CALL OUTTZN("140+I) ! a,b,c CALL SGR(0) CALL OUTTZN(' = ') CALL CUP(LINE(I),COLM(I)) CALL SGR(7) CALL OUTTZN(PRSTR(1,I)) CALL SGR(0) 1000 CONTINUE CALL CUP(LINE(4),24) CALL SGR(1,7) CALL OUTTZN('X') CALL SGR(0) CALL OUTTZN(' value = ') CALL CUP(LINE(4),COLM(4)) CALL SGR(7) CALL OUTTZN(PRSTR(1,4)) CALL SGR(0) CALL CUP(LINE(5),20) CALL OUTTZN('The calculated ') CALL SGR(1,7) CALL OUTTZN('Y') CALL SGR(0) CALL OUTTZN(' value = ') CALL CUP(LINE(5),COLM(5)) CALL SGR(7) CALL OUTTZN(PRSTR(1,5)) CALL SGR(0) CALL CUP(LINE(6),COLM(6)) CALL SGR(7) CALL OUTTZN(' ') CALL SGR(0) CALL OUTTZN(' HELP') CALL CUP(LINE(7),COLM(7)) CALL SGR(7) CALL OUTTZN(' ') CALL SGR(0) CALL OUTTZN(' EXIT') RETURN END SUBROUTINE PLATE1 !Program SLVPLY BYTE EQN(17),STRING COMMON /SLVP1/ STRING(81) DATA EQN /'Y',' ','=',' ','a','X',' ',' ','+',' ','b','X', # ' ','+',' ','c',0/ CALL CLRALL CALL CUP(3,28) CALL OUTTZ('This program solves the') CALL CUP(4,30) CALL OUTTZ('Polynomial Equation:') CALL CUP(6,18) CALL DWL CALL OUTTZ('2') CALL CUP(7,12) CALL BIGTOP CALL OUTTZ(EQN) CALL CUP(8,12) CALL BIGBOT CALL OUTTZ(EQN) CALL CUP(11,15) CALL OUTTZ('You will be prompted for the coefficients') CALL CUP(12,15) CALL SGR(1,7) CALL OUTTZN('a') CALL SGR(0) CALL OUTTZN(', ') CALL SGR(1,7) CALL OUTTZN('b') CALL SGR(0) CALL OUTTZN(', & ') CALL SGR(1,7) CALL OUTTZN('c') CALL SGR(0) CALL OUTTZN(' and a value for ') CALL SGR(1,7) CALL OUTTZN('X') CALL SGR(0) CALL OUTTZ('. The') CALL CUP(13,15) CALL OUTTZ('program then solves the equation and reports') CALL CUP(14,15) CALL OUTTZN('the ') CALL SGR(1,7) CALL OUTTZN('Y') CALL SGR(0) CALL OUTTZ(' solution.') CALL CUP(16,15) CALL OUTTZ('After all the coefficients have been entered once,') CALL CUP(17,15) CALL OUTTZ('you may modify one or all of them at any time') CALL CUP(18,15) CALL OUTTZ('by positioning the cursor to the appropriate line.') CALL GTENTR CALL CLRALL CALL CUP(2,34) CALL SGR(4) CALL OUTTZ('Input Format') CALL SGR(0) CALL CUP(4,12) CALL OUTTZN('Numeric input may be typed on either the ') CALL OUTTZ('keypad or the main') CALL CUP(6,7) CALL OUTTZN('keyboard numeric keys. The numbers are ') CALL OUTTZ('treated as floating point') CALL CUP(8,7) CALL OUTTZN('decimal values. FORTRAN exponential format ') CALL OUTTZ('["E"] is recognized') CALL CUP(10,7) CALL OUTTZN('and accepted. Changes to numeric fields must ') CALL OUTTZ('be limited to 15') CALL CUP(12,7) CALL OUTTZN('characters or less and may be terminated with ') CALL OUTTZN('either a ') CALL SGR(7) CALL OUTTZN('RETURN') CALL SGR(0) CALL OUTTZ(' or') CALL CUP(14,7) CALL SGR(7) CALL OUTTZN('ENTER') CALL SGR(0) CALL OUTTZN(' keystroke. The values may be preceeded by an ') CALL OUTTZN('optional ') CALL SGR(7) CALL OUTTZN('+') CALL SGR(0) CALL OUTTZ(' or') CALL CUP(16,7) CALL SGR(7) CALL OUTTZN('-') CALL SGR(0) CALL OUTTZN(' sign character. Exponential formatted input may ') CALL OUTTZ('also optionally') CALL CUP(18,7) CALL OUTTZ('include a sign character preceeding the exponent.') CALL GTENTR CALL CLRALL CALL CUP(7,27) CALL SGR(4) CALL OUTTZ('Correcting Typing Mistakes') CALL SGR(0) CALL CUP(9,12) CALL OUTTZN('The ') CALL SGR(7) CALL OUTTZN('DELETE') CALL SGR(0) CALL OUTTZN(' key may be used to repair typing mistakes') CALL OUTTZ('. If the') CALL CUP(11,7) CALL OUTTZN('character deleted is the first character in') CALL OUTTZ(' the field, the previous') CALL CUP(13,7) CALL OUTTZN('field value is restored. Errors in numeric') CALL OUTTZ(' strings are detected as') CALL CUP(15,7) CALL OUTTZN('they are typed. The character in error is ') CALL OUTTZ('rejected and you will be') CALL CUP(17,7) CALL OUTTZN('alerted by both an audible alarm and visual') CALL OUTTZ(' message.') CALL GTENTR CALL CLRALL CALL CUP(7,32) CALL SGR(4) CALL OUTTZ('Field Addressing') CALL SGR(0) CALL CUP(9,10) CALL OUTTZN('Cursor positioning has been rigidly ') CALL OUTTZ('restricted to defined fields.') CALL CUP(11,5) CALL OUTTZN('It may be moved between the input fields by ') CALL OUTTZ('using the up_arrow and') CALL CUP(13,5) CALL OUTTZN('down_arrow keys. Attempts to move the cursor') CALL OUTTZ(' above or below the') CALL CUP(15,5) CALL OUTTZN('defined limits are ignored, although an ') CALL OUTTZ('audible warning is given.') CALL GTENTR CALL CLRALL CALL CUP(1,31) CALL SGR(4) CALL OUTTZ('Auxiliary Commands') CALL SGR(0) CALL CUP(3,9) CALL OUTTZN('Two non-numeric fields may be referenced ') CALL OUTTZ('through use of the cursor') CALL CUP(5,4) CALL OUTTZN('positioning keys. The first of these is a ') CALL SGR(1,4,7) CALL OUTTZN('HELP') CALL SGR(0) CALL OUTTZ(' request which will') CALL CUP(7,4) CALL OUTTZN('re-display these assisstance messages. ') CALL SGR(1,4,7) CALL OUTTZN('HELP') CALL SGR(0) CALL OUTTZ(' may be requested before') CALL CUP(9,4) CALL OUTTZN('each field modification but not during a ') CALL OUTTZ('change to a numeric entry.') CALL CUP(11,4) CALL OUTTZN('Current values of all fields are preserved ') CALL OUTTZN('during a ') CALL SGR(1,4,7) CALL OUTTZN('HELP') CALL SGR(0) CALL OUTTZ(' request. The') CALL CUP(13,4) CALL SGR(1,4,7) CALL OUTTZN('EXIT') CALL SGR(0) CALL OUTTZN(' request terminates program execution, turns ') CALL OUTTZ('off the optional VT100') CALL CUP(15,4) CALL OUTTZN('features that have been used, clears the ') CALL OUTTZ('screen and returns to the RT-11') CALL CUP(17,4) CALL OUTTZN('monitor. The cursor will be positioned to the ') CALL OUTTZ('top left hand corner of') CALL CUP(19,4) CALL OUTTZN('the screen.To protect the user from ') CALL OUTTZ('inadvertently executing these two') CALL CUP(21,4) CALL OUTTZN('requests, you ') CALL SGR(4) CALL OUTTZN('must') CALL SGR(0) CALL OUTTZN(' press the ') CALL SGR(7) CALL OUTTZN('ENTER') CALL SGR(0) CALL OUTTZ(' key to select them.') CALL GTENTR RETURN END