Subroutine Indata(Nvals,String,Val1,Val2,Val3,Val4,Val5,Val6) c c *********************************************************************** c * * c * Subroutine Indata - To input real and integer data from * c * the keyboard. * c * * c * Programmed by Steven C. Fisher, DTNSRDC Code 1522 * c * * c *********************************************************************** c Byte String(6),Val1(1),Val2(1),Val3(1),Val4(1),Val5(1),Val6(1), $ Temp(4) Dimension Rvals(40) Equivalence (Temp(1),Rtemp),(Temp(1),Itemp) c Call Inpt(Rvals,Ntot,If,2) c c Set variable to real value c Do 20 I=1,Nvals If (Ntot .LT. I) Then 5 Continue Call Inpt(Rvals(I),N,If,2) If (N .EQ. 0) Go To 5 Ntot = Ntot + N End If If (String(I) .EQ. 'R') Then Rtemp = Rvals(I) Nbytes = 4 c Else c c Set variable to integer - first see if it c isn't too large for a two byte number c If ( Abs(Rvals(I)) .LE. 32768) Then Itemp = Rvals(I) Else Itemp = 32768 * Val/Abs(Rvals(I)) End If Nbytes = 2 c End If Do 10 J=1,Nbytes If (I .EQ. 1) Val1(J) = Temp(J) If (I .EQ. 2) Val2(J) = Temp(J) If (I .EQ. 3) Val3(J) = Temp(J) If (I .EQ. 4) Val4(J) = Temp(J) If (I .EQ. 5) Val5(J) = Temp(J) If (I .EQ. 6) Val6(J) = Temp(J) 10 Continue 20 Continue c Return End Subroutine Linedt(Line,Nchars,Maxlen,Iflag) c c *********************************************************************** c * * c * Subroutine Linedt - To enable the user to "EDIT" lines * c * * c * Programmed by Steven C. Fisher, DTNSRDC Code 1522 * c * * c *********************************************************************** c Byte Line(1),Char Equivalence (Char,I) Include 'Cflags' c c Set bits 12 and 6 of the JSW to 1 c Call Ipoke("44,"10040 .OR. Ipeek("44)) c c Set the echo to off, and single character activation c c Iact = Ispy(-4) (Assuming Iact is 29) Write(7,150) 29,'F',29,'S' 150 Format('+',1A1,$) Iecho = 1 c c See where the curser is - if it is in the first column, c send a line feed to the terminal c Write(7,175) 27 175 Format('+',1A1,'[6n',$) 5 Continue c c Evaluate string from terminal with the curser location c I = Ittinr() If (Char .EQ. ';') Then I = Ittinr() If (Char .EQ. '1') Then I = Ittinr() If (Char .EQ. 'R') Write(7,150) 10 End If End If If (Char .NE. 'R') Go To 5 c c Write out the line of test to "edit" c Nchars = Nchars * Iflag If (Nchars .NE. 0) Then Write(7,100) (Line(I),I=1,Nchars) 100 Format('+',A1,$) Else c c If you don't write them out, blank them out c Do 7 J=1,Maxlen Line(J) = ' ' 7 Continue End If c c Initialize locations c Iesc = 0 Iloc = Nchars + 1 c 10 Continue c c Get the character input c I = Ittinr() c c See if a return was entered c If (I .EQ. 3) Then If (Iabort .EQ. 0) Then Call Abort Else Write(7,150) 7,7,7 End If Go to 10 End If If (I .EQ. 13) Go To 40 c c See if arrow keys were pressed c If (I .EQ. 27) Iesc = 1 If (I .EQ. 91 .AND. Iesc .EQ. 1) Iesc = 2 c c See if the character is in range c If (I .LT. 0 .OR. I .GT. 255) Go To 10 c If (I .EQ. 127) Then c c Delete from the text c Write(7,200) 27,27 200 Format('+',1A1,'[1D',1A1,'[1P',$) c c Update the character string c If (Nchars .GT. 1) Then Do 20 J=Iloc,Nchars Line(J-1) = Line(J) 20 Continue End If Nchars = Max0(Nchars - 1,0) Iloc = Max0(Iloc - 1,1) c Else If (I .EQ. 11) Then c c Delete to end of line c Write(7,275) 27,27,27 275 Format('+',1A1,'7',1A1,'[K',1A1,'8',$) Nchars = Iloc-1 Iloc = Max0(Iloc,1) c Else If (I .EQ. 21) Then c c Delete to start of line c Do 35 J=Iloc,Nchars Line(J-Iloc+1) = Line(J) 35 Continue If (Iloc .GT. 1) Then I1 = Int(Log10(Iloc-1.)) + 1 Write(7,285) 27,Iloc-1,27,Iloc-1 285 Format('+',1A1,'[',I,'D',1A1,'[',I,'P',$) End If Nchars = Max0(Nchars - Iloc + 1,0) Iloc = 1 c Else If (Iesc .EQ. 0) Then c c Add to the text c If (Nchars .LT. Maxlen) Then If (Iloc .LE. Nchars) Then Write(7,250) 27,I,27 Else Write(7,150) I End If 250 Format('+',1A1,'[4h',2A1,'[4l',$) c c Update the character string c Do 30 J=Nchars,Iloc,-1 Line(J+1) = Line(J) 30 Continue Line(Iloc) = I Nchars = Nchars + 1 Iloc = Iloc + 1 Else Write(7,150) 7 End If c Else If (Iesc .EQ. 2) Then c c Move curser along the text string c If (Iloc .GE. Nchars+1 .AND. (Char .EQ. 'C' .OR. Char .EQ. $ 'B')) Then Iesc = 0 Write(7,150) 7 Go To 10 Else If (Char .EQ. 'C') Then Write(7,350) 27,I 350 Format('+',1A1'[',1A1,$) Iloc = Iloc + 1 Else If (Char .EQ. 'D') Then Write(7,350) 27,I Iloc = Max0(Iloc - 1,1) Else If (Char .EQ. 'B') Then Write(7,350) (27,'C',J=1,Nchars-Iloc+1) Iloc = Nchars + 1 Else If (Char .EQ. 'A' .AND. Iloc .GT. 1) Then Write(7,350) (27,'D',J=1,Iloc-1) Iloc = 1 End If c End If c c Turn off the arrow key flag c If (Iesc .EQ. 2 .AND. I .NE. 91) Iesc = 0 c Go To 10 c 40 Continue c c Move down a line, and turn on echos, and c turn off single character activation c I = Ittinr() Write(7,150) 29,'T',29,'E',27,'E' Iecho = 0 Return End