*
* $Id$
*
* $Log$
* Revision 1.1  1996/02/15 17:49:59  mclareni
* Initial revision
*
*
#include "kerngen/pilot.h"
#if defined(CERNLIB_QS_DOS)
      SUBROUTINE PUTGET(EINSTR,LCHSTR,HISCMD,MAXCUR,HICMD)
*
*     PARAMETERS:
*
*     EINSTR  C  ENTERED COMMAND STRING
*     LCHSTR I   LENGTH OF THE INSTR
*     HISCMD C   STACK CONTAINING STRINGS ENTERED EARLIER
*     MAXCUR I   MAX CAPACITY OF THE STACK
*     HICMD  I   CURRENT POSITION INSIDE STACK
*
c
c       These are the keyboard scan codes used

        PARAMETER (k_ctrl_C = 3, k_ctrl_Z=26,k_ctrl_Q=17)
        PARAMETER (k_ctrl_K =11)
        PARAMETER (k_rt_arr = -77, k_lt_arr = -75)
        PARAMETER (k_up_arr = -72, k_dn_arr = -80)
        PARAMETER (k_PGUP = -73, k_PGDW = -81)
        PARAMETER (k_HOME = -71, k_END = -79)
        PARAMETER (k_INS = -82, k_DEL = -83, k_ENTER = 13)
        PARAMETER (k_CR = 13)
        PARAMETER (k_BS = 8, k_ESC = 27)
        PARAMETER (k_alt_H = -35)
        PARAMETER (k_beep = 7)

*
*
      INTEGER HICMD
      CHARACTER*(*) HISCMD(*)
      INTEGER*2    MAXCUR

      PARAMETER (ICRCOL = 2)
      integer*2 icur, lstr, ival, isym, iupdt, icurod, INS
      CHARACTER*(*) EINSTR
      CHARACTER*(255) INSTR
      CHARACTER*1 CURSOR,CURTYP(2)
#include "kerngen/grex.inc"
      ixg(ix) = ix*8
      iyg(iy) = iy*16+5
      IND(I) = ISHFT(I+2,-1)+1
*
      data ins /1/
     *     CURTYP / '','_'/
*
*     Init work
*
CCC      MAXLIN = min(LEN(EINSTR),LEN(INSTR))
      MAXLIN = LEN(INSTR)
      icur = 1
      lstr = icur
      ival = 0
      einstr = ' '
      instr = ' '
      ivideo =  get_video_mode(max_row,max_column)
**      WRITE(77,*) ' video MODE=',IVIDEO
      ier = get_cursor(ixc,iyc)
      ixc = ixc-1
      if (ivideo .ne. 3) then
        icurod = icur
        ier = magnify_text(1,1)
**        iii = get_clip_limits(imlimx,imlimy,ixlimx,ixlimy)
        iii = get_device_limits(limx,limy,limc)
        ier = set_clip_limits(0,0,limx,limy)
        CURSOR =CURTYP(IND(INS))
*
*       Set Graphic cursor
*
        ier=graphic_text(CURSOR,
     *                 ixg(icur+ixc),iyg(iyc),ICRCOL)
      ELSE
        ier = locate(icur+ixc,iyc)
      END IF

*
   10 continue
*
*       Reading next char from keyboard
*
      isym = pause()
      chone =char(isym)
***      write(77,222) '  Input char=',chone,' lstr=',lstr
***  222  format(3a,i2)
*
      IUPDT = -1
      if (isym .ge. 32 .AND. LSTR .LE. MAXLIN-2) then
        IF (INS.EQ.1) THEN
          do i=lstr,icur,-1
            j = i+1
            INSTR(j:j)=INSTR(i:i)
          end do
          INSTR(ICUR:ICUR)=chone
          LSTR = LSTR+1
*
*   Clear the next free positon
*
          INSTR(LSTR:LSTR)=' '
        ELSE
          INSTR(ICUR:ICUR)=chone
          IF (ICUR .EQ. LSTR) LSTR=LSTR+1
        END IF
        ICUR = ICUR+1
        isht = 1
        IUPDT = LSTR-isht
*
      else if (isym .eq. k_enter) then
        lstr = lstr-1
        go to 999
*
      else if (isym .eq. k_ctrl_Z) then
*        lstr = -lstr
        lstr = -1
        go to 999
*
*
      else if (isym .eq. k_up_arr) then
         if (ival .ge. maxcur) then
             ier = beep()
             go to 500
         end if
         ival = ival+1
         go to 20
*
      else if (isym .eq. k_dn_arr) then
        ival = ival-1
*******
   20   if (ival .gt. 0 .AND. HICMD .GT. 0) then
           I = HICMD - IVAL+1
           IF (I .LT. 1) I = MAXCUR+I
           LFUL = LENOCC(HISCMD(I))
           IF (LFUL .LT. MAXLIN) THEN
             IF (LFUL .GE. ICUR) THEN
*
*       Copy line from history into the current string
*
              INSTR(ICUR:LFUL)=HISCMD(I)(ICUR:LFUL)
              IF (LFUL .LT. LSTR) THEN
                INSTR(LFUL+1:LSTR) = ' '
              END IF
              IUPDT = MAX(LSTR,LFUL+1)
              LSTR  = LENOCC(INSTR)+1
             END IF
           ELSE
             ier = beep()
             go to 500
           END IF
        else
*
*    Clear line
*
          ier   = beep()
          IUPDT = LSTR
          ICUR  = 1
          LSTR  = ICUR
          INSTR = ' '
          IVAL  = 0
        end if
*
      else if (isym .eq. k_rt_arr) then
         icur = MIN(ICUR,LSTR)+1
         IF (ICUR .EQ. LSTR+1) THEN
           IER = BEEP()
           ICUR = ICUR - 1
         END IF
*
      else if (isym .eq. k_lt_arr) then
         icur = MAX(1,ICUR)-1
         IF (ICUR .EQ. 0) THEN
           IER = BEEP()
           ICUR = ICUR + 1
         END IF
*
      else if (isym .eq. k_DEL)    then
         IF (ICUR .LE. LSTR-1) THEN
           INSTR(ICUR:LSTR)=INSTR(ICUR+1:LSTR)//' '
           IUPDT = LSTR
           LSTR  = LSTR - 1
         ELSE
           IER = BEEP()
         END IF
*
      else if (isym .eq. k_BS)    then
         ICUR = ICUR-1
         IF (ICUR .GE. 1) THEN
           IUPDT = LSTR
           INSTR(ICUR:LSTR)=INSTR(ICUR+1:LSTR)//' '
           LSTR = MAX(ICUR,LSTR-1)
         ELSE
           IER = BEEP()
           ICUR = 1
         END IF
*
      else if (isym .eq. k_INS)    then
         INS = -INS
         IF (IVIDEO .GT. 3) THEN
           IER = SET_XOR(1)
*
*       Clear OLD Graphic cursor
*
           ier=graphic_text(CURSOR,
     *                 ixg(icur+ixc),iyg(iyc),ICRCOL)
           CURSOR = CURTYP(IND(INS))
*
*       Set NEW Graphic cursor
*
           ier=graphic_text(CURSOR,
     *                 ixg(icur+ixc),iyg(iyc),ICRCOL)
           IER = SET_XOR(0)
         END IF
*
      else if (isym .eq. k_END)    then
         ICUR = LSTR
*
      else if (isym .eq. k_HOME)   then
         ICUR = 1
*
      else if (isym .eq. k_ESC)    then
         IUPDT = LSTR
         ICUR = 1
         LSTR = ICUR
         INSTR = ' '
*
      else if (isym .eq. k_ctrl_K) then
         IUPDT = LSTR
         INSTR(ICUR:LSTR) = ' '
         LSTR = ICUR
*
      else if (isym .eq. k_ctrl_Q) then
*         CALL KIFLTH(2)
         LSTR = -2
         GO TO 999
*
      else if (isym .eq. k_ctrl_C) then
*         CALL KIFLTH(2)
         LSTR = -2
         GO TO 999
*
*
      else
         IER = BEEP()
      end if
*
*       Update the displaied line
*
      IF (ivideo .le. 3) THEN
         ier = locate(icur+ixc-ISHT,iyc)
      ELSE
*
*       Clear Graphic cursor
*
        IER = SET_XOR(1)
        ier=graphic_text(CURSOR,
     *                 ixg(icurod+ixc),iyg(iyc),ICRCOL)
        IER = SET_XOR(0)
      END IF
      if (IUPDT .GT. 0) then
        if (ivideo .le. 3) then
           call write_string(instr(icur-isht:iupdt))
           ier = locate(icur+ixc,iyc)
        else
           ls = iupdt-(icur-isht)+1
           icol = set_color(0)
**
           ier = filled_rectangle(
     *      ixg(icur+ixc-isht),iyg(iyc),
     *      ixg(icur+ixc-isht+ls),iyg(iyc+1))

           ier=graphic_text(instr(icur-isht:iupdt),
     *                 ixg(icur+ixc-isht),iyg(iyc),1)

           icol = set_color(1)
*           icol = set_color(icol)
        end if
        isht = 0
      end if
      IF (IVIDEO .GT. 3) THEN
*
*       Set Graphic cursor
*
        IER = SET_XOR(1)
        ier=graphic_text(CURSOR,
     *                 ixg(icur+ixc),iyg(iyc),ICRCOL)
        IER = SET_XOR(0)
        ICUROD = ICUR
      END IF
*
  500 go to 10

  999 continue
      IF (IVIDEO .GT. 3) THEN
*
*       Clear Graphic cursor
*
        IER = SET_XOR(1)
        ier=graphic_text(CURSOR,
     *                 ixg(icurod+ixc),iyg(iyc),ICRCOL)
        IER = SET_XOR(0)
      END IF
      IF (LSTR .GT. MAXLIN) LSTR=MAXLIN
      lchstr = lstr
CC      EINSTR(:lstr) = INSTR(:lstr)
      return
      end
#endif
