	program test
	implicit none
c
c A test program to demonstrate the * read function
c
	character*20 line
	integer*4 nk,istat
	integer*4 get_hidden_string
c
c Wriet a prompt, the cursor will remain just after the :
c
10	write(*,1000)
1000	format('$Question:')
c
c Get the string, chars will echoed as *
c
	istat = get_hidden_string(line,nk)
c
c Tell the result
C
	write(*,1010) istat,nk,line(1:nk)
1010	format(' Status %X',z8.8,' nk = ',i2,' line = ',a)
c
c If status is oke, continue
c
	if(istat) goto 10
	end

	function get_hidden_string(line,nk) 
	implicit none
c
c Get a string from the terminal
c  characters are not echo'ed but * instead
c The max length is the length of string
c
c  Supported characters are
c   space .. char(126) : Insert text
c   ^H                 : goto the beginning og the line
c   ^E                 : goto the end of the line
c   ^A                 : Toggle insert/overstrike, initial setttin from terminal
c   ^Z                 : Abort, return ss$_endoffile
c   ^U or LINEFEED (^J): Clean buffer 
c   RETURN             : Return buildupt text
c   <- (left arrow)    : one position to the left
c   -> (Right arrow)   : one position to the right
c   DELETE             : Remove one character
c
	character*(*) line		!:o: the typed string
	integer*4 nk			!:o: actual length (0..len(line))
	logical*4 get_hidden_string	!:f: function result
c
c Include files
c
	include '($ssdef)'
	include '($dvidef)'
	include '($trmdef)'
c
c Local variables
c
c
	integer*2 chan
	integer*4 istat,nb ,k
	logical*4 insert_mode
	integer*4 ipos
	character*20 buffer
c
c Parameters 
c
	character*(*) CSI,ESCAPE,CTRLH,CTRLE,CTRLU,DELETE,RETURN,LINEFEED
	character*(*) CTRLA,CTRLZ
	parameter (CSI      = char(128+27))
	parameter (ESCAPE   = char(27))
	parameter (CTRLA    = char(ichar('A') - ichar('A') + 1))
	parameter (CTRLE    = char(ichar('E') - ichar('A') + 1))
	parameter (CTRLH    = char(ichar('H') - ichar('A') + 1))
	parameter (CTRLU    = char(ichar('U') - ichar('A') + 1))
	parameter (CTRLZ    = char(ichar('Z') - ichar('A') + 1))
	parameter (DELETE   = char(127))
	parameter (RETURN   = char(13))
	parameter (LINEFEED = char(10))
c
c 2 ansi sequences for left/right arrow
c
	character*(*) left_string,right_string
	parameter (left_string = ESCAPE//'[D')
	parameter (right_string = ESCAPE//'[C')
c
c Functions
c
	integer*4 sys$assign
	integer*4 lib$getdvi
	integer*4 get_hidden_string_read
	integer*4 get_hidden_string_write
c
c Assign a channel to the terminal (sys$command)
c
	istat = sys$assign('SYS$COMMAND',chan,,,)
	if(istat) then
c
c Get The the current insert/overstrike setting
c
	  istat = lib$getdvi(dvi$_tt_insert,chan,,insert_mode)
	  if(.not. istat) goto 80
c
c We have no characters yet
c  nk   = 0..len(line)
c  ipos = 1..len(length)+1
c
	  nk   = 0
	  ipos = 1
c
c Main loop, get char/function key
c
10	  istat = get_hidden_string_read(chan,buffer,nb)
	  if(.not. istat) goto 80
c
c Now handle various possibilities
c
	  if(buffer(1:nb) .eq. left_string) then
c
c Left arrow, if not at position 1, skip one to the left
c
	    if(ipos .gt. 1) then
	      ipos =ipos - 1
	      istat = get_hidden_string_write(chan,left_string)
	    endif
	  elseif(buffer(1:nb) .eq. right_string) then
c
c Right arrow, if not at position nk+1, skip one to the right
c
	    if(ipos .le. nk) then
	      ipos = ipos + 1	    
	      istat = get_hidden_string_write(chan,right_string)
	    endif
	  elseif(buffer(1:nb) .eq. CTRLA) then
c
c ^A toggle insert mode
c
	    insert_mode = .not. insert_mode
	  elseif(buffer(1:nb) .eq. CTRLH) then
c
c ^H got the begin of the line (leave text intact)
c 
	    do k=2,ipos
	      istat = get_hidden_string_write(chan,left_string)
	      if(.not. istat) goto 80
	    end do
	    ipos = 1
	  elseif(buffer(1:nb) .eq. CTRLZ) then
c
c ^Z abort
c
	    istat = get_hidden_string_write(chan,LINEFEED//RETURN)
	    if(istat) istat = ss$_endoffile
	  elseif(buffer(1:nb) .eq. CTRLE) then
c
c ^E goto the end of the line
c
	    do k=ipos,nk
	      istat = get_hidden_string_write(chan,right_string)
	      if(.not. istat) goto 80
	    enddo
	    ipos = nk+1
	  elseif(buffer(1:nb) .eq. RETURN) then
c
c  RETURN : Return with all characters in the buffer
c
	    istat = get_hidden_string_write(chan,LINEFEED//RETURN)
	    goto 80
	  elseif(buffer(1:nb) .eq. CTRLU .or. 
     1           buffer(1:nb) .eq. LINEFEED) then
c
c ^U,LINEFEED(=^J) : clear out the whole buffer
c
	    do k=2,ipos
	      istat = get_hidden_string_write(chan,left_string)
	      if(.not. istat) goto 80
	    end do
	    line = ' '
	    istat = get_hidden_string_write(chan,line(1:nk))
	    if(.not. istat) goto 80
	    do k=1,nk
	      istat = get_hidden_string_write(chan,left_string)
	      if(.not. istat) goto 80
	    end do
	    nk   = 0
	    ipos = 1
	  elseif(buffer(1:nb) .eq. DELETE ) then
c
c Delete char, if at pos 1 do nothing
c
	    if(ipos .gt. 1) then
	      line(ipos-1:) = line(ipos:)
	      nk = nk - 1
c
c And now whipe one asteriks
c
	      if(ipos .gt. nk) then
c
c We are beyond the end
c
	        istat = get_hidden_string_write(chan,left_string)
	        if(.not. istat) goto 80
	      elseif(ipos .lt. nk) then
c
c We are not yet at the end
c
	        do k=ipos,nk
	          istat = get_hidden_string_write(chan,right_string)
	          if(.not. istat) goto 80
	        end do	 
	      endif
c
c Whipe the *
c
	      istat = get_hidden_string_write(chan,' ')
	      if(.not. istat) goto 80
c
c And go back to the original position
c
	      do k=ipos,nk+2
	        istat = get_hidden_string_write(chan,left_string)
	        if(.not. istat) goto 80
	      end do
	    endif
	  elseif((nb .eq.  1) .and.
     1            (buffer(1:1) .ge. ' ' .and. 
     1             buffer(1:1) .le. char(126))) then
c
c Insert character
c
	    if(insert_mode) then
c
c Insert mode
c
	      if(nk .lt. len(line)) then
	        line(ipos:) = buffer(1:1)//line(ipos:)
	        nk = nk + 1
	        do k=ipos,nk
	          istat = get_hidden_string_write(chan,'*')
	          if(.not. istat) goto 80
	        end do
	        do k=ipos,nk-1
	          istat = get_hidden_string_write(chan,left_string)
	          if(.not. istat) goto 80
	        end do
	        ipos = ipos + 1
	      endif
	    else
c
c Overstrike mode, 
c
	      if(ipos .le. len(line)) then
	        line(ipos:ipos) = buffer(1:1)
	        if(ipos .gt. nk) then
	          istat = get_hidden_string_write(chan,'*')
	          nk = ipos
	        else
	          istat = get_hidden_string_write(chan,right_string)
	        endif
	        ipos = ipos + 1
	      endif
	    endif
	  endif
c
c If istat still oke, continue
c
	  if(istat) goto 10
c
c Clear the channel to the terminal
c
80	  call sys$dassgn(%val(chan),)
	endif
c
c And return with the status
c
90	get_hidden_string = istat
	return
	end
	function get_hidden_string_read(chan,buffer,nb)
	implicit none
c
c  Read a character from the terminal
c  since some keys heve multiple char returns (function keys)
c  this is a little bit tricky
c
	integer*2 chan			!:i: chan for terminal
	character*(*) buffer            !:o: data
	integer*4 nb                    !:o: nb read
	integer*4 get_hidden_string_read!:f: function result 
c
c Includes
c
	include '($trmdef)'
	include '($efndef)'
	include '($iodef)'
c
c Structures
c
	structure /iosb/
	  integer*2 status
	  integer*2 nbyte
	  integer*2 term
	  integer*2 nbterm
	end structure
c
	structure /item/
	  integer*2 buflen,opcode
	  integer*4 bufadr,retadr
	end structure
c
c Parameters
c
	character*(*) CSI,ESCAPE
	parameter (CSI   =char(128+27))
	parameter (ESCAPE=char(27))
c
c Variables
c
	record /iosb/ iosb
	record /item/ items(4)
	integer*4 terms(8),nit,opcode,istat
c
c Functions
c
	integer*4 sys$qiow	
c
c Signal all chars as terminator
c terms is a bits mask for each character
c There a 256 possible characters so we need 256 bits = 32 bytes
c  term is table of 8 4 byte integers 
c
	do nit=1,8
	  terms(nit) = -1
	enddo
c
c Build an item list (do not echo, do no echo terminator
c   do not interprete one of the characters
c
	nit = 0
        nit = nit +1
        items(nit).opcode = trm$_modifiers
        items(nit).buflen = 0
        items(nit).bufadr = trm$m_tm_nofiltr .or.
     1                      trm$m_tm_noecho .or.
     1                      trm$m_tm_trmnoecho .or.
     1                      trm$m_tm_norecall .or.
     1                      trm$m_tm_escape .or.
     1                      trm$m_tm_noedit
        items(nit).retadr = 0
c
c And set all characters as terminators
c
        nit = nit +1
        items(nit).opcode = trm$_term
        items(nit).buflen = sizeof(terms)
        items(nit).bufadr = %loc(terms)
        items(nit).retadr = 0
c
        nit = nit * sizeof(items(1))
c
	opcode = io$_readvblk .or. io$m_extend
c
c Start reading data from the terminal
c
	istat = sys$qiow(%val(efn$c_enf),
     1                   %val(chan),
     1                   %val(opcode),iosb,,,
     1                   %ref(buffer),%val(len(buffer)),
     1                   ,,items,%val(nit))
	if(istat) istat = iosb.status
	if(istat) then
c
c Now .nbyte will always be 0 (all chars are terminator) 
c  but .nbterm will contain the terminator (a character or a functionkey code)
c
	  nb = iosb.nbyte + iosb.nbterm
c
c Now change the 8 bits variants of the function keys to the 7bits
c f.e. left key can be returned as
c  <CSI>D
c  or as <ESC>[D
c in the calling program we expect the 7bit versions
c
	  if(buffer(1:1) .eq. CSI) then
	    buffer = ESCAPE//'['//buffer(2:nb)
	    nb = nb + 1
	  endif
	endif
	get_hidden_string_read = istat
	return
	end
        function get_hidden_string_write(chan,kars)
        implicit none
c
c Write a string to the terminal
c
	integer*2 chan
        character*(*) kars      !:i: the data
        integer*4 get_hidden_string_write
c#
        include '($iodef)'
        include '($efndef)'
c
        integer*4 istat,opcode
        integer*4 sys$qiow
c
c IOsb for terminal io
c
	structure /iosb/
	  integer*2 status
	  integer*2 nb
	  integer*2 term
	  integer*2 nbterm
	end structure
        record /iosb/ iosb
c
        opcode = io$_writevblk .or. io$m_noformat
c
c All chars to the terminal
c
        istat = sys$qiow(%val(efn$c_enf),
     1                   %val(chan),
     1                   %val(opcode),iosb,,,
     1                   %ref(kars),%val(len(kars)),,,,)
c
        if(istat) istat = iosb.status
	get_hidden_string_write = istat
        return
        end
