Subroutine Indata(Nvals,String,Val1,Val2,Val3,Val4,Val5,Val6) *********************************************************************** * * * Subroutine Indata - To input real and integer data from * * the keyboard. * * * * Programmed by Steven C. Fisher, DTNSRDC Code 1522 * * * *********************************************************************** 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) Call Inpt(Rvals,Ntot,If,2) Set variable to real value 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 Else Set variable to integer - first see if it isn't too large for a two byte number If ( Abs(Rvals(I)) .LE. 32768) Then Itemp = Rvals(I) Else Itemp = 32768 * Val/Abs(Rvals(I)) End If Nbytes = 2 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 Return End Subroutine Linedt(Line,Nchars,Maxlen,Iflag) *********************************************************************** * * * Subroutine Linedt - To enable the user to "EDIT" lines * * * * Programmed by Steven C. Fisher, DTNSRDC Code 1522 * * * *********************************************************************** Include 'Cflags' Byte Line(1),Char Equivalence (Char,I) 50 Format('+',1A1,$) Iecho = 1 See where the curser is - if it is in the first column, send a line feed to the terminal Call Chrpos(Irow,Icol) If (Icol .EQ. 1) Write(6,150) 10 Write out the line of test to "edit" Nchars = Nchars * Iflag If (Nchars .NE. 0) Then Write(6,100) (Line(I),I=1,Nchars) 00 Format('+',A1,$) Else If you don't write them out, blank them out Do 7 J=1,Maxlen Line(J) = ' ' 7 Continue End If Initialize locations Iesc = 0 Iloc = Nchars + 1 10 Continue Get the character input Call Ittinr(I) See if a return was entered If (Iabort .EQ. .TRUE.) Then If (Iaborta .EQ. 0) Then Call Abort Else Call Ctrl Write(6,150) 7,7,7 End If Go to 10 End If If (I .EQ. 13) Go To 40 See if arrow keys were pressed If (I .EQ. 27) Iesc = 1 If (I .EQ. 91 .AND. Iesc .EQ. 1) Iesc = 2 See if the character is in range If ((I .LT. 32 .OR. I .GT. 255) .AND. I .NE. 27 .AND. $ I .NE. 11 .AND. I .NE. 21) Go To 10 If (I .EQ. 127) Then Delete from the text Write(6,200) 27,27 00 Format('+',1A1,'[1D',1A1,'[1P',$) Update the character string 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) Else If (I .EQ. 11) Then Delete to end of line Write(6,275) 27l27,27 275 Format('+',1A1,'7',1A1,'[K',1A1,'8',$) Nchars = Iloc-1 Iloc = Max0(Iloc,1) Else If (I .EQ. 21) Then Delete to start of line 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(6,285) 27,Iloc-1,27,Iloc-1 85 Format('+',1A1,'[',I,'D',1A1,'[',I,'P',$) End If Nchars = Max0(Nchars - Iloc + 1,0) Iloc = 1 Else If (Iesc .EQ. 0) Then Add to the text If (Nchars .LT. Maxlen) Then If (Iloc .LE. Nchars) Then Write(6,250) 27,I,27 Else Write(6,150) I End If 50 Format('+',1A1,'[4h',2A1,'[4l',$) Update the character string Do 30 J=Nchars,Iloc,-1 Line(J+1) = Line(J) 30 Continue Line(Iloc) = I Nchars = Nchars + 1 Iloc = Iloc + 1 Else Write(6,150) 7 End If Else If (Iesc .EQ. 2) Then Move curser along the text string If (Iloc .GE. Nchars+1 .AND. (Char .EQ. 'C' .OR. Char .EQ. $ 'B')) Then Iesc = 0 Write(6,150) 7 Go To 10 Else If (Char .EQ. 'C') Then Write(6,350) 27,I 50 Format('+',1A1'[',1A1,$) Iloc = Iloc + 1 Else If (Char .EQ. 'D') Then Write(6,350) 27,I Iloc = Max0(Iloc - 1,1) Else If (Char .EQ. 'B') Then Write(6,350) (27,'C',J=1,Nchars-Iloc+1) Iloc = Nchars + 1 Else If (Char .EQ. 'A' .AND. Iloc .GT. 1) Then Write(6,350) (27,'D',J=1,Iloc-1) Iloc = 1 End If End If Turn off the arrow key flag If (Iesc .EQ. 2 .AND. I .NE. 91) Iesc = 0 Go To 10 40 Continue Move down a line, and turn on echos, and turn off single character activation Write(6,150) 13 Return End