subroutine curse(line,error)
  use gildas_def
  use phys_const
  use gbl_format
  use gbl_message
  use greg_dependencies_interfaces
  use greg_interfaces, except_this=>curse
  use sic_types
  use greg_kernel
  use greg_pen
  use greg_rg
  use greg_wcs
  !---------------------------------------------------------------------
  ! @ private
  ! GREG	Support routine for command
  !	DRAW	Code
  !		LINE	[X Y]	[/USER]	[/BOX]	[/CHARACTER] [/CLIP]
  !		MARKER
  !		ARROW
  !		TEXT	[X Y "texte a ecrire" [Center [Orientation]]]
  !		VALUE
  ! Uses the interactive cursor to perform various functions.
  !	The cursor routine of GREG is GR_CURS
  ! Arguments :
  !	LINE	C*(*)	Command line		Input
  !	ERROR	L	Logical error flag	Output
  !
  ! Force the line style to solid for the end of an arrow	PV, 17-jul-87
  !---------------------------------------------------------------------
  character(len=*) :: line          !
  logical :: error                  !
  ! Global
  include 'gbl_memory.inc'
  ! Local
  character(len=*), parameter :: rname='DRAW'
  character(len=1) :: c,cucode,code
  character(len=80) :: chain
  character(len=10) :: cc
  character(len=256) :: string,string1,string2
  real(kind=4) :: value,fact,xtmp,ytmp
  real(kind=8) :: x,y,angsav
  integer(kind=4) :: nchar,i,lire,nl,ibox,kbox,jbox,icom,n,length,w_angle
  integer(kind=4) :: savangle,nc
  logical :: cursormode,doclip_soft,doclip_hard
  character(len=12) :: clipmode,keyword
  character(len=256) :: dummy
  integer(kind=4) :: ndiv,ier
  character(len=1), parameter :: backslash=char(92)
  integer(kind=4), parameter :: ntextclipmodes=2
  character(len=*), parameter :: textclipmodes(ntextclipmodes) = (/ 'SOFT','HARD' /)
  integer(kind=4), parameter :: nmodes=7
  character(len=*), parameter :: modes(nmodes) = (/  &
   'ARROW   ','CENTER  ','LINE    ','MARKER  ','RELOCATE','TEXT    ','VALUE   ' /)
  integer(kind=4), parameter :: max_integ=2147483647
  ! Array support
  type(sic_descriptor_t) :: desc,desc1,desc2
  type(sic_descriptor_t) :: inca1,inca2,inca3
  integer(kind=address_length) :: ipt,ipx,ipy
  integer(kind=4) :: lpt,lpx,lpy,istart
  integer(kind=index_length) :: ii,npx,npy,npt
  logical :: found,opened
  real(kind=4) :: rrr
  integer(kind=4) :: icc
  real(kind=8) :: sux,suy
  !
  error = .false.
  !
  ! MUST initialize NPX and the INCARNATIONS...
  npx = 0
  !
  inca1%type = 0
  inca1%readonly = .false.
  inca1%addr = 0
  inca1%ndim = 0
  inca1%dims(:) = 0
  inca1%size = 0
  inca1%status = 0
  !
  inca2%type = 0
  inca2%readonly = .false.
  inca2%addr = 0
  inca2%ndim = 0
  inca2%dims(:) = 0
  inca2%size = 0
  inca2%status = 0
  !
  inca3%type = 0
  inca3%readonly = .false.
  inca3%addr = 0
  inca3%ndim = 0
  inca3%dims(:) = 0
  inca3%size = 0
  inca3%status = 0
  !
  w_angle=u_angle
  savangle=u_angle
  ndiv=360
  if (i_system.eq.type_eq .or. i_system.eq.type_ic) ndiv=24
  ! no use working if command is not appropriate:
  if (sic_present(0,3)) then
    call sic_ke (line,0,1,dummy,nc,.true.,error)
    if (error) return
    call sic_ambigs(rname,dummy,keyword,i,modes,nmodes,error)
    if (error)  return
    code = dummy(1:1)
  endif
  !
  ! Turn off clipping by default. Turn on clipping with option /CLIP.
  noclip = .not.sic_present(4,0)  ! Global variable
  lire = sic_lire()
  !
  call draw_parse_coordmode(line,kbox,ibox,error)
  if (error)  goto 999
  jbox = ibox  ! ibox = 0 means auto corner choice => jbox will be the chosen corner
  !
  ! Find factor
  if (kbox.eq.0) then
    fact = 1.
  elseif (kbox.eq.1) then
    fact = cdef*expand
  endif
  !
  ! Insufficient arguments : call the cursor
  icom = 0
  if (.not.sic_present(0,3)) then
    if (gtg_curs()) then
      cursormode= .true.
      call sic_ke (line,0,1,dummy,nc,.false.,error)
      code = dummy(1:1)
      goto 20
    else
      call greg_message(seve%e,rname,'Cursor not available on this device')
      goto 999
    endif
  else
    call sic_ke (line,0,1,dummy,nc,.false.,error)
    if (error) goto 999
    code = dummy(1:1)
    cursormode = .false.
    !
    if (kbox.eq.-1.or.kbox.le.-3) then  ! USER Coordinates
      ! X
      npx = 0
      call sic_ch(line,0,2,dummy,nc,.true.,error)
      if (error) goto 999
      if (dummy.eq.'*') then  ! Current pen X position
        ! No transformation, just ensure globals are updated. Use kbox==2 for this.
        call draw_setcursor_relative('X',dble(xp),2,0,error)
        if (error)  goto 999
      else
        found = .false.
        call sic_descriptor (dummy,desc,found)
        if (.not.found .or. desc_nelem(desc).le.1) then
          ! Not a Sic variable, or a scalar variable, or an array variable
          ! with single element
          call sic_r8(line,0,2,x,.false.,error)
          if (error) goto 999
          call draw_setcursor_relative('X',x,kbox,ibox,error)
          if (error)  goto 999
        else
          ! Array variable
          npx = desc%dims(1)
          call sic_incarnate(fmt_r8,desc,inca1,error)
          if (error) then
            call greg_message(seve%e,rname,'Invalid X Array Format')
            goto 999
          endif
          ipx = gag_pointer(inca1%addr,memory)
          lpx = 2
        endif
      endif
      ! Y
      npy = 0
      call sic_ch(line,0,3,dummy,nc,.true.,error)
      if (error) goto 999
      if (dummy.eq.'*') then  ! Current pen Y position
        ! No transformation, just ensure globals are updated. Use kbox==2 for this.
        call draw_setcursor_relative('Y',dble(yp),2,0,error)
        if (error)  goto 999
      else
        found = .false.
        call sic_descriptor(dummy,desc,found)
        if (.not.found .or. desc_nelem(desc).le.1) then
          ! Not a Sic variable, or a scalar variable, or an array variable
          ! with single element
          call sic_r8 (line,0,3,y,.false.,error)
          if (error) goto 999
          call draw_setcursor_relative('Y',y,kbox,ibox,error)
          if (error)  goto 999
        else
          ! Array variable
          npy = desc%dims(1)
          call sic_incarnate(fmt_r8,desc,inca2,error)
          if (error) then
            call greg_message(seve%e,rname,'Invalid Y Array Format')
            goto 999
          endif
          ipy = gag_pointer(inca2%addr,memory)
          lpy = 2
          if ( (npx.eq.0.and.npy.gt.0) .or. (npx.gt.0.and.npy.eq.0)) then
            call greg_message(seve%e,rname,'Two arrays or none')
            goto 999
          endif
          if (npy.ne.npx) then
            call greg_message(seve%e,rname,'Inconsistent sizes')
            goto 999
          endif
        endif
      endif
      !
    elseif (kbox.eq.-2) then  ! USER with ABSOLUTE
      ! X
      npx = 0
      lpx = 0
      ipx = 0
      call sic_ch(line,0,2,dummy,nc,.true.,error)
      if (error) goto 999
      found = .false.
      call sic_descriptor (dummy,inca1,found)
      if (.not.found) then
        call sic_ch(line,0,2,string1,length,.true.,error)
        if (error) goto 999
      else
        if (inca1%type.le.0) then
          call greg_message(seve%e,rname,'X Array must be of type CHAR')
          goto 999
        endif
        desc1%type=inca1%type
        desc1%addr=inca1%addr
        call destoc(desc1%type,desc1%addr,string1)
        if (inca1%ndim.gt.0) then
          npx = inca1%dims(1)
          lpx = inca1%type
          ipx = gag_pointer(inca1%addr,memory)
        endif
      endif
      ! Y
      npy = 0
      lpy = 0
      ipy = 0
      call sic_ch(line,0,3,dummy,nc,.true.,error)
      if (error) goto 999
      found = .false.
      call sic_descriptor (dummy,inca2,found)
      if (.not.found) then
        call sic_ch (line,0,3,string2,length,.true.,error)
        if (error) goto 999
      else
        if (inca2%type.le.0) then
          call greg_message(seve%e,rname,'Y Array must be of type CHAR')
          goto 999
        endif
        desc2%type=inca2%type
        desc2%addr=inca2%addr
        call destoc(desc2%type,desc2%addr,string2)
        if (inca2%ndim.gt.0) then
          npy = inca2%dims(1)
          lpy = inca2%type
          ipy = gag_pointer(inca2%addr,memory)
        endif
      endif
      if ( (npx.eq.0.and.npy.gt.0) .or. (npx.gt.0.and.npy.eq.0)) then
        call greg_message(seve%e,rname,'Two arrays or none')
        goto 999
      endif
      if (npy.ne.npx) then
        call greg_message(seve%e,rname,'Inconsistent sizes')
        goto 999
      endif
      if (npx.eq.0) then
        call draw_setcursor_absolute(string1,string2,kbox,error)
        if (error)  goto 999
      endif
      !
    else  ! BOX Coordinates or CHARACTER
      npx = 0  ! Arrays not supported
      npy = 0
      !
      ! Parse X value
      call sic_ch(line,0,2,dummy,nc,.true.,error)
      if (error) goto 999
      if (dummy.eq.'*') then  ! Current pen X position
        ! No transformation, just ensure globals are updated. Use kbox==2 for this.
        call draw_setcursor_relative('X',dble(xp),2,0,error)
        if (error)  goto 999
      else
        call sic_r8 (line,0,2,x,.true.,error)
        if (error) goto 999
        call draw_setcursor_relative('X',x,kbox,ibox,error)
        if (error)  goto 999
      endif
      ! Parse Y value
      call sic_ch (line,0,3,dummy,nc,.true.,error)
      if (error) goto 999
      if (dummy.eq.'*') then  ! Current pen Y position
        ! No transformation, just ensure globals are updated. Use kbox==2 for this.
        call draw_setcursor_relative('Y',dble(yp),2,0,error)
        if (error)  goto 999
      else
        call sic_r8 (line,0,3,y,.true.,error)
        if (error) goto 999
        call draw_setcursor_relative('Y',y,kbox,ibox,error)
        if (error)  goto 999
      endif
    endif
  endif
  !
  ! XCURSE,YCURSE Paper coordinates, UCURSE(1),UCURSE(2) User coordinates and
  ! Code are now defined if We are not in array mode (i.e., npx=0 , array mode
  ! not supported for /CHAR or /BOX modes)
10 continue
  if (sic_present(0,1)) then
    cursormode = .false.
  else
    code = cucode
  endif
  !
  ! Position
  if (code.eq.'R') then
    if (npx.eq.0) then         ! normal mode
      !!Print *,'Calling RELOCATE ',xcurse,ycurse
      call grelocate(xcurse,ycurse)
      error = gterrtst()
      if (error) goto 999
      call print_line(line,kbox,jbox,'RELOCATE',fact)
    else
      do ii=1,npx
        if (kbox.ne.-2) then
          call arraydraw1(code,memory(ipx),memory(ipy),kbox)
          ipx=ipx+lpx
          ipy=ipy+lpy
        else
          call arraydraw2(code,string1,lpx,string2,lpy,error)
          if (error) goto 999
          desc1%addr=desc1%addr+lpx
          call destoc(desc1%type,desc1%addr,string1)
          desc2%addr=desc2%addr+lpy
          call destoc(desc2%type,desc2%addr,string2)
        endif
      enddo
    endif
    !
    ! Line
  elseif (code.eq.'L') then
    call gtsegm('LINE',error)
    if (penupd) call setpen (cpen)
    icom = icom+1
    if (npx.eq.0) then         ! normal mode
      !!Print *,'Calling DRAW ',xcurse,ycurse
      call gdraw(xcurse,ycurse)
      error = gterrtst()
      if (error) goto 999
      call print_line(line,kbox,jbox,'LINE',fact)
    else                       ! array mode
      do ii=1,npx
        if (kbox.ne.-2) then
          call arraydraw1(code,memory(ipx),memory(ipy),kbox)
          ipx=ipx+lpx
          ipy=ipy+lpy
        else
          call arraydraw2(code,string1,lpx,string2,lpy,error)
          if (error) goto 999
          desc1%addr=desc1%addr+lpx
          call destoc(desc1%type,desc1%addr,string1)
          desc2%addr=desc2%addr+lpy
          call destoc(desc2%type,desc2%addr,string2)
        endif
      enddo
    endif
    call gtsegm_close(error)
    !
    ! Marker
  elseif (code.eq.'M') then
    call gtsegm('MARKER',error)
    if (penupd) call setpen(cpen)
    call setdas(1)
    icom = icom+1
    if (npx.eq.0) then
      call grelocate(xcurse,ycurse)
      call gr_point(nsides,istyle)
      error = gterrtst()
      if (error) goto 999
      call print_line(line,kbox,jbox,'MARKER',fact)
    else
      do ii=1,npx
        if (kbox.ne.-2) then
          call arraydraw1(code,memory(ipx),memory(ipy),kbox)
          ipx=ipx+lpx
          ipy=ipy+lpy
        else
          call arraydraw2(code,string1,lpx,string2,lpy,error)
          if (error) goto 999
          desc1%addr=desc1%addr+lpx
          call destoc(desc1%type,desc1%addr,string1)
          desc2%addr=desc2%addr+lpy
          call destoc(desc2%type,desc2%addr,string2)
        endif
      enddo
    endif
    call gtsegm_close(error)
    !
    ! Arrow
  elseif (code.eq.'A') then
    call gtsegm('ARROW',error)
    if (penupd) call setpen(cpen)
    if (npx.eq.0) then
      icom = icom+2            ! Creates two segments
      call garrow(xcurse,ycurse)
      error = gterrtst()
      if (error) goto 999
      call print_line(line,kbox,jbox,'ARROW',fact)
    else
      icom = icom+1            ! Creates one segment only!
      do ii=1,npx
        if (kbox.ne.-2) then
          call arraydraw1(code,memory(ipx),memory(ipy),kbox)
          ipx=ipx+lpx
          ipy=ipy+lpy
        else
          call arraydraw2(code,string1,lpx,string2,lpy,error)
          if (error) goto 999
          desc1%addr=desc1%addr+lpx
          call destoc(desc1%type,desc1%addr,string1)
          desc2%addr=desc2%addr+lpy
          call destoc(desc2%type,desc2%addr,string2)
        endif
      enddo
    endif
    call gtsegm_close(error)
    !
    ! Help
  elseif (code.eq.'H') then
    line = ' '
    call grelocate(xp,yp)
    error = gterrtst()
    if (error) goto 999
    noclip = .false.
    call greg_message(seve%i,rname,'Type HELP DRAW if you are lost...')
    cursormode = .false.
    goto 20
    !
    ! Exit
  elseif (code.eq.'E') then
    line = ' '
    call grelocate(xp,yp)
    error = gterrtst()
    if (error) goto 999
    noclip = .false.
    cursormode = .false.
    goto 20
    !
  elseif (code.eq.'T'.or.code.eq.'C') then  ! Text and Centered Text
    if (noclip) then
      doclip_soft = .false.
      doclip_hard = .false.
    else
      dummy = 'SOFT'  ! Default
      call sic_ke(line,4,1,dummy,nc,.false.,error)
      if (error)  return
      call sic_ambigs('DRAW /CLIP',dummy,clipmode,n,textclipmodes,ntextclipmodes,error)
      if (error)  return
      doclip_soft = clipmode.eq.'SOFT'
      doclip_hard = clipmode.eq.'HARD'
    endif
    !
    i = icente
    if (.not.sic_present(0,4)) then
      call sic_wprn('Text :',string,nchar)
      if (nchar.eq.0.and.npx.ne.0) then
        goto 999
      elseif (nchar.eq.0) then
        goto 20
      else
        ipt = 0
        npt = 0
        lpt = 0
      endif
    else
      call sic_ch (line,0,4,string,nc,.true.,error)
      if (error) goto 999
      ! Small patch to avoid to translate "A" even if A is a known
      ! variable...
      istart = sic_start(0,4)
      if (line(istart:istart).eq.'"') then
        found = .false.
        !
        ! Same patch if an implicit formatting was used
      elseif  (line(istart:istart).eq.'''') then
        found = .false.
      else
        found = .false.
        call sic_descriptor (string,inca3,found)
      endif
      if (.not.found) then
        nchar = nc
        ipt = 0
        npt = 0
        lpt = 0
      else
        ! Found a Sic variable
        npt = desc_nelem(inca3)
        ipt = gag_pointer(inca3%addr,memory)
        lpt = inca3%type
        if (npt.eq.1) then  ! Scalar-like character variable
          ! We can as well write a numeric variable as a formatted string...
          if (lpt.le.0) then
            ! Will write in shortest format the Array value:
            if (lpt.eq.fmt_r4) then
              call r4tor4(memory(ipt),rrr,1)
            elseif (lpt.eq.fmt_r8) then
              call r8tor4(memory(ipt),rrr,1)
            elseif (lpt.eq.fmt_i4) then
              call i4tor4(memory(ipt),rrr,1)
            else
              goto 998
            endif
            call conecd(rrr,string,nchar)
          else
            desc%type = lpt
            desc%addr = inca3%addr
            call destoc(desc%type,desc%addr,string)  ! First string is present
            nchar=lpt  ! or LENC(STRING) ?
          endif
          npt=0
          ipt=0
          lpt=0
        else  ! Array variable
          if (npx.eq.0) then
            call greg_message(seve%e,rname,'Three arrays or none')
            goto 999
          endif
          if (npt.ne.npx) then
            call greg_message(seve%e,rname,'Inconsistent sizes')
            goto 999
          endif
          if (lpt.le.0) then  ! Numeric array
            ! Will write in shortest format the numeric Array value:
            if (lpt.eq.fmt_r4) then
              call r4tor4(memory(ipt),rrr,1)
            elseif (lpt.eq.fmt_r8) then
              call r8tor4(memory(ipt),rrr,1)
            elseif (lpt.eq.fmt_i4) then
              call i4tor4(memory(ipt),rrr,1)
            else
              goto 998
            endif
            call conecd(rrr,string,nchar)
          else  ! Character array
            desc%type = lpt
            desc%addr = inca3%addr
            call destoc(desc%type,desc%addr,string)  ! First string is present
            nchar=lpt
          endif
        endif
      endif
    endif
    ! Find centering option
    if (code.eq.'C') then
      if (.not.sic_present(0,5)) then
        call sic_wprn('Centering code [0-9] :',cc,i)
        if (i.ne.0) then
          length = lenc(cc)
          i = 0
          read(cc(1:length),*,iostat=ier) i
          if (ier.ne.0 .or. i.lt.0 .or. i.gt.9) then
            call greg_message(seve%e,rname,'Invalid Centering Code')
            goto 20
          endif
        else
          i = icente
        endif
      else
        call sic_i4 (line,0,5,i,.true.,error)
        if (error) goto 999
      endif
    else
      ! centering option optional in text mode
      call sic_i4 (line,0,5,i,.false.,error)
      if (error) goto 999
    endif
    ! Orientation
    angsav = tangle
    if (sic_present(0,6)) then
      call sic_r8 (line,0,6,tangle,.true.,error)
      if (error) return
    endif
    !
    if (penupd) call setpen (cpen)
    icom = icom+1
    opened = .false.
    !
    if (npx.eq.0) then
      if (doclip_hard) then
        call grclip(xcurse,ycurse,icc)
      else
        icc = 0
      endif
      if (icc.ne.0) then
        call greg_message(seve%w,rname,'"'//string(1:nchar)//'"  was clipped')
      else
        call gtsegm('TEXT',error)
        if (error)  goto 999
        opened = .true.
        ! --- Almost identical to draw_text_relative, except coordinates ---
        ! --- are already translated from KBOX to physical ---
        if (i.eq.0) i = centre(xcurse,ycurse)
        call grelocate(xcurse,ycurse)
        call putlabel(nchar,string,i,tangle,doclip_soft)
        ! ---
        call print_text(line,kbox,jbox,'TEXT',fact,string(1:nchar),i,tangle)
      endif
    else
      do ii=1,npx
        !
        ! Text string
        if (lpt.ne.0) then
          if (lpt.lt.0) then
            if (lpt.eq.fmt_r4) then
              call r4tor4(memory(ipt),rrr,1)
            elseif (lpt.eq.fmt_r8) then
              call r8tor4(memory(ipt),rrr,1)
            elseif (lpt.eq.fmt_i4) then
              call i4tor4(memory(ipt),rrr,1)
            endif
            call conecd(rrr,string,nchar)
          else
            call destoc(desc%type,desc%addr,string)
          endif
        endif
        !
        ! Coordinates
        if (kbox.ne.-2) then
          ! Relative coordinates
          call r8tor8(memory(ipx),x,1)
          call r8tor8(memory(ipy),y,1)
        else
          ! Absolute coordinates converted to relative
          call destoc(desc1%type,desc1%addr,string1)
          call sic_sexa(string1,lpx,x,error)
          if (error)  goto 999
          if (i_system.eq.type_eq .or. i_system.eq.type_ic) then
            x = x*pi/12.0d0
          else
            x = x*pi/180.0d0
          endif
          call destoc(desc2%type,desc2%addr,string2)
          call sic_sexa(string2,lpy,y,error)
          if (error)  goto 999
          y = y*pi/180.0d0
          sux = x
          suy = y
          call abs_to_rel(gproj,sux,suy,x,y,1)
        endif
        !
        if (doclip_hard) then
          call us8_to_int(x,y,xtmp,ytmp,1)
          call grclip(xtmp,ytmp,icc)
        else
          icc = 0
        endif
        if (icc.ne.0) then
          call greg_message(seve%w,rname,'"'//string(1:nchar)//'"  was clipped')
        else
          if (.not.opened) then
            call gtsegm('TEXT',error)
            if (error)  goto 999
            opened = .true.
          endif
          call draw_text_relative(x,y,string,nchar,kbox,i,doclip_soft)
        endif
        !
        ! Next positions
        if (kbox.ne.-2) then
          ipx=ipx+lpx
          ipy=ipy+lpy
        else
          desc1%addr=desc1%addr+lpx
          desc2%addr=desc2%addr+lpy
        endif
        ! Next text string
        if (lpt.ne.0) then
          if (lpt.lt.0) then
            ! Will write in shortest format the Array value
            if (lpt.eq.fmt_r4 .or. lpt.eq.fmt_i4) then
              ipt=ipt+1
            elseif (lpt.eq.fmt_r8 .or. lpt.eq.fmt_i8) then
              ipt=ipt+2
            endif
          else
            desc%addr=desc%addr+lpt
          endif
        endif
      enddo
    endif
    tangle = angsav
    if (opened)  call gtsegm_close(error)
    !
    ! Map value
  elseif (code.eq.'V') then
    if (npx.eq.0)then
      if (rg%status.ne.code_pointer_null) then
        ! Regval is used
        call regval(rg%data,ucurse(1),ucurse(2),value,.true.)
      endif
      call print_position(w_angle)
    endif
    goto 20
    !
    ! Delete
  elseif (code.eq.'D' .and. icom.gt.0 .and. cursormode) then
    call gtdls
    penupd = .true.            ! To get proper pen attributes later
    gxp = -1e10
    gyp = -1e10
    error = gterrtst()
    if (error) goto 999
    call gtview('Update')  ! A segment was deleted: redraw all windows
    !
    icom = icom-1
    if (lire.eq.0) then
      chain = 'GTVL'//backslash//'CLEAR SEGMENT'
      call sic_log (chain,18,lire)
      call sic_insert (chain)
    endif
    goto 20
    !
    ! Anything else
  else
    if (code.eq.'0') then
      w_angle=u_radian
    elseif (code.eq.'1') then
      w_angle=u_degree
    elseif (code.eq.'2') then
      w_angle=u_minute
    elseif (code.eq.'3') then
      w_angle=u_second
    endif
    call print_position (w_angle)
    !     Pas de log:
    goto 20
  endif
  !
  ! Update the LOG file for this command
  if (lire.eq.0) then
    nl = lenc(line)
    call sic_blanc(line,nl)
    nl = nl+1
    line(nl:nl) = ' '
    nl = nl+1
    if (npx.eq.0) then         ! not in array mode
      if (kbox.eq.-3) then
        line(nl:) = ' /USER DEGREES'
        nl = nl+14
      elseif (kbox.eq.-4) then
        line(nl:) = ' /USER MINUTES'
        nl = nl+14
      elseif (kbox.eq.-5) then
        line(nl:) = ' /USER SECONDS'
        nl = nl+14
      elseif (kbox.eq.-2) then
        line(nl:) = ' /USER ABSOLUTE'
        nl = nl+15
      elseif (kbox.eq.-1) then
        line(nl:) = ' /USER'
        nl = nl+6
      elseif (kbox.eq.0) then
        c = char(jbox+ichar('0'))
        line(nl:) = ' /BOX '//c
        nl = nl+7
      else
        c = char(jbox+ichar('0'))
        line(nl:) = ' /CHARACTER '//c
        nl = nl+13
      endif
      if (sic_present(4,0)) then
        line(nl:) = ' /CLIP'
        nl = nl+6
      endif
    endif
    call sic_log (line,nl,lire)
    call sic_insert (line(1:nl))
  endif
  !
  ! Return if complete command
20 continue
  if (cursormode) then
    ! Else loop over with the cursor
    call gr_curs(ucurse(1),ucurse(2),xcurse,ycurse,cucode)
    error = (gterrtst().or.code.eq.char(3).or.sic_ctrlc())
    if (error) goto 999
    ! map codes returned by ButtonPress events to keycodes
    if (cucode.eq.'^') then
      cucode = 'R'
    elseif (code.eq.'&') then
      cucode = 'L'
    elseif (code.eq.'*') then
      cucode = 'E'
    endif
    ! Find position
    if (ibox.eq.0) jbox = voisin(xcurse,ycurse)
    cursor_code = cucode
    goto 10
  else
    if (rg%status.ne.code_pointer_null) then
      if (rg%xinc.ne.0) then
        x = (ucurse(1)-rg%xval)/rg%xinc + rg%xref
      else
        x = 0
      endif
      if (rg%yinc.ne.0) then
        y = (ucurse(2)-rg%yval)/rg%yinc + rg%yref
      else
        y = 0
      endif
      !     defines the PIX_CURS SIC variable associated, since we exit to
      !     the main program where this variable may be examined.
      if (abs(x).le.max_integ.and.abs(y).le.max_integ) then
        pixcurse(1) = nint(x)
        pixcurse(2) = nint(y)
      else
        pixcurse(1) = 0
        pixcurse(2) = 0
      endif
    else
      pixcurse(1) = 0
      pixcurse(2) = 0
    endif
    noclip =.false.
    ! Volatilize the incarnations
    call sic_volatile(inca3)
    call sic_volatile(inca2)
    call sic_volatile(inca1)
    return
  endif
  !
998 call greg_message(seve%e,rname,'Unsupported Array-to-Text Conversion')
999 error = .true.
  noclip =.false.
  ! Volatilize the incarnations
  call sic_volatile(inca3)
  call sic_volatile(inca2)
  call sic_volatile(inca1)
  return
end subroutine curse
!
subroutine draw_parse_coordmode(line,kbox,ibox,error)
  use gbl_message
  use greg_dependencies_interfaces
  use greg_interfaces, except_this=>draw_parse_coordmode
  use greg_kernel
  use greg_wcs
  !---------------------------------------------------------------------
  ! @ private
  ! Parse command line to retrieve the coordinates conversion mode, i.e.
  ! how the input coordinates have to be understood
  !
  !  kbox < 0: user coordinates
  !  kbox = 0: physical coordinates from box "corner"
  !  kbox = 1: character coordinates from box "corner"
  !
  !  ibox = -1   irrelevant
  !  ibox = 1-9  the box "corner" to be used if relevant
  !  ibox = 0    automatic corner choice if cursor mode, corner 1 otherwise
  !---------------------------------------------------------------------
  character(len=*), intent(in)    :: line
  integer(kind=4),  intent(out)   :: kbox
  integer(kind=4),  intent(out)   :: ibox
  logical,          intent(inout) :: error
  ! Local
  character(len=*), parameter :: rname='DRAW'
  integer(kind=4) :: n,nc
  logical :: user,box,car
  character(len=12) :: argum,name
  character(len=8), parameter :: ctype(5) = (/  &
    'ABSOLUTE','SECONDS ','MINUTES ','DEGREES ','RADIANS ' /)
  integer(kind=4), parameter :: optuser=1
  integer(kind=4), parameter :: optbox =2
  integer(kind=4), parameter :: optchar=3
  !
  user = sic_present(optuser,0)
  box  = sic_present(optbox, 0)
  car  = sic_present(optchar,0)
  !
  ! Parse conflicting options
  ! /USER       (1,0)
  ! /BOX        (2,0)
  ! /CHAR       (3,0)
  ! /CLIP (4,0)
  !
  if ((user.and.car).or.(user.and.box).or.(car.and.box)) then
    call greg_message(seve%e,rname,'Conflicting options')
    error = .true.
    return
  endif
  !
  ! /USER [Unit]
  if (user) then
    ! Patch [Unit]
    ibox = -1  ! Irrelevant
    ! Change U_ANGLE units into (silly) KBOX units
    kbox = u_angle-6
    if (kbox.gt.-3) kbox=-1    ! see definition of U_SECOND, etc..
    !
    if (sic_present(optuser,1)) then
      if (gproj%type.eq.p_none.and.i_system.eq.type_un) then
        call greg_message(seve%e,rname,'USER unit ignored when no projection')
        error = .true.
        return
      else
        call sic_ke (line,optuser,1,argum,nc,.true.,error)
        if (error)  return
        call sic_ambigs('DRAW /USER',argum,name,n,ctype,5,error)
        if (error)  return
        if (n.eq.1) then
          kbox = -2            ! Absolute
        elseif (n.eq.2) then
          kbox = -5            ! Seconds
        elseif (n.eq.3) then
          kbox = -4            ! Minutes
        elseif (n.eq.4) then
          kbox = -3            ! Degrees
        elseif (n.eq.5) then
          kbox = -1            ! Radians
        endif
      endif
    endif
    !
  elseif (box) then  ! /BOX I
    ibox = 0
    call sic_i4 (line,optbox,1,ibox,.false.,error)
    if (error)  return
    ibox = min(max(ibox,0),9)
    kbox = 0
    !
  elseif (car) then  ! /CHAR I
    ibox = 0
    call sic_i4 (line,optchar,1,ibox,.false.,error)
    if (error)  return
    ibox = min(max(ibox,0),9)
    kbox = 1
    !
  else  ! Default mode: use SET COORDINATES
    ibox = iboxd
    if (ibox.ge.0) then  ! Coordinates are from reference corner
      kbox = ibox/10
      ibox = mod(ibox,10)
    else                 ! Coordinates are USER (IBOXD=-1), put KBOX according to SET ANGLE
      ibox = -1
      ! Change U_ANGLE units into (silly) KBOX units
      kbox = u_angle-6
      if (kbox.gt.-3) kbox=-1  ! see definition of U_SECOND, etc..
    endif
  endif
  !
end subroutine draw_parse_coordmode
!
subroutine draw_setcursor_relative(ckind,v,kbox,ibox,error)
  use phys_const
  use gbl_message
  use greg_dependencies_interfaces
  use greg_interfaces, except_this=>draw_setcursor_relative
  use greg_kernel
  !---------------------------------------------------------------------
  ! @ private
  ! Set the current cursor position (user and physical) according to
  ! relative coordinate 'v' and system of coordinates (kbox,ibox)
  !
  !  kbox < 0: user coordinates
  !  kbox = 0: physical coordinates from box "corner"
  !  kbox = 1: character coordinates from box "corner"
  !  kbox = 2: absolute physical coordinates on page
  !---------------------------------------------------------------------
  character(len=*), intent(in)    :: ckind  ! Coordinate kind ('X' or 'Y')
  real(kind=8),     intent(in)    :: v
  integer(kind=4),  intent(in)    :: kbox,ibox
  logical,          intent(inout) :: error
  ! Local
  character(len=*), parameter :: rname='DRAW_SETCURSOR_RELATIVE'
  real(kind=4) :: fact,gx,gy
  !
  if (kbox.eq.-1 .or. kbox.le.-3) then  ! /USER, all except ABSOLUTE
    if (ckind.eq.'X') then
      if (kbox.eq.-3) then
        ucurse(1) = v*pi/180.0d0
      elseif (kbox.eq.-4) then
        ucurse(1) = v*pi/180.0d0/60.0d0
      elseif (kbox.eq.-5) then
        ucurse(1) = v*pi/180.0d0/3600.0d0
      else
        ucurse(1) = v  ! ZZZ
      endif
      if (axis_xlog) then
        if (ucurse(1).gt.0) then
          xcurse = gx1 + gux * (log(ucurse(1))-lux)
        else if (gux.gt.0) then
          xcurse = gx1
        else
          xcurse = gx2
        endif
      else
        xcurse = gx1 + gux * (ucurse(1)-gux1)
      endif
    elseif (ckind.eq.'Y') then
      if (kbox.eq.-3) then
        ucurse(2) = v*pi/180.0d0
      elseif (kbox.eq.-4) then
        ucurse(2) = v*pi/180.0d0/60.0d0
      elseif (kbox.eq.-5) then
        ucurse(2) = v*pi/180.0d0/3600.0d0
      else
        ucurse(2) = v  ! ZZZ
      endif
      if (axis_ylog) then
        if (ucurse(2).gt.0) then
            ycurse = gy1 + guy * (log(ucurse(2))-luy)
        else if (guy.gt.0) then
            ycurse = gy1
        else
            ycurse = gy2
        endif
      else
        ycurse = gy1 + guy * (ucurse(2)-guy1)
      endif
    endif
    !
  elseif (kbox.eq.0 .or. kbox.eq.1) then  ! /BOX or /CHAR
    if (kbox.eq.1) then
      fact = cdef*expand
    else
      fact = 1.
    endif
    call corner(max(ibox,1),gx,gy)  ! Corner offset
    !
    if (ckind.eq.'X') then
      xcurse = v*fact + gx
      if (axis_xlog) then
        ucurse(1) = exp((xcurse-gx1)/gux + lux)
      else
        ucurse(1) = (xcurse-gx1)/gux + gux1
      endif
    elseif (ckind.eq.'Y') then
      ycurse = v*fact + gy
      if (axis_ylog) then
        ucurse(2) = exp((ycurse-gy1)/guy + luy)
      else
        ucurse(2) = (ycurse-gy1)/guy + guy1
      endif
    endif
    !
  elseif (kbox.eq.2) then  ! Absolute physical coordinates on page
    if (ckind.eq.'X') then
      xcurse = v
      if (axis_xlog) then
        ucurse(1) = exp((xcurse-gx1)/gux + lux)
      else
        ucurse(1) = (xcurse-gx1)/gux + gux1
      endif
    elseif (ckind.eq.'Y') then
      ycurse = v
      if (axis_ylog) then
        ucurse(2) = exp((ycurse-gy1)/guy + luy)
      else
        ucurse(2) = (ycurse-gy1)/guy + guy1
      endif
    endif
    !
  else
    call greg_message(seve%e,rname,'Not supported KBOX')
    error = .true.
    return
  endif
  !
end subroutine draw_setcursor_relative
!
subroutine draw_setcursor_absolute(xc,yc,kbox,error)
  use phys_const
  use gbl_message
  use greg_dependencies_interfaces
  use greg_interfaces, except_this=>draw_setcursor_absolute
  use greg_wcs
  !---------------------------------------------------------------------
  ! @ private
  ! Set the current cursor position (user and physical) according to
  ! absolute coordinates (xc,yc) and system of coordinates (kbox)
  !---------------------------------------------------------------------
  character(len=*), intent(in)    :: xc,yc  ! Sexagesimal absolute coordinates
  integer(kind=4),  intent(in)    :: kbox   !
  logical,          intent(inout) :: error  !
  ! Local
  character(len=*), parameter :: rname='DRAW_SETCURSOR_ABSOLUTE'
  real(kind=8) :: x,y,sux,suy
  !
  if (kbox.eq.-2) then
    ! X
    call sic_sexa(xc,len_trim(xc),x,error)
    if (error)  return
    if (i_system.eq.type_eq .or. i_system.eq.type_ic) then
      x = x*pi/12.0d0
    else
      x = x*pi/180.0d0
    endif
    ! Y
    call sic_sexa(yc,len_trim(yc),y,error)
    if (error)  return
    y = y*pi/180.0d0
    ! Absolute to relative
    sux = x
    suy = y
    call abs_to_rel(gproj,sux,suy,x,y,1)
    ! Final job. Use kbox=-1, i.e. coordinates are now RADIANS
    call draw_setcursor_relative('X',x,-1,0,error)
    if (error)  return
    call draw_setcursor_relative('Y',y,-1,0,error)
    if (error)  return
    !
  else
    call greg_message(seve%e,rname,'Not supported KBOX')
    error = .true.
    return
  endif
  !
end subroutine draw_setcursor_absolute
!
subroutine gr_curs(xa,ya,x,y,code)
  use greg_dependencies_interfaces
  use greg_interfaces, except_this=>gr_curs
  use greg_kernel
  !---------------------------------------------------------------------
  ! @ public
  !	Gives the cursor position in both coordinate systems
  !	The cursor is preset at plot position (X,Y).
  !	Code is always one upper case letter.
  ! Arguments :
  !	XA,YA	R*8	User coordinates		Output
  !	X,Y	R*4	Plot coordinates		Input/Output
  !	CODE	C*1	Character stroke		Output
  !---------------------------------------------------------------------
  real(kind=8) :: xa                      !
  real(kind=8) :: ya                      !
  real(kind=4) :: x                       !
  real(kind=4) :: y                       !
  character(len=*) :: code          !
  ! Local
  logical :: error
  !
  error = .false.
  call gtcurs(x,y,code,error)
  if (error) then
    code = 'E'
    return
  endif
  call gr8_phys_user(x,y,xa,ya,1)
  call sic_upper(code)
end subroutine gr_curs
!
subroutine arrow(xa,ya)
  use gildas_def
  use phys_const
  use greg_dependencies_interfaces
  use greg_interfaces, except_this=>arrow
  use greg_kernel
  use greg_pen
  !---------------------------------------------------------------------
  ! @ private
  ! GREG	Internal routine
  !	Draws an arrow from current pen position to (XA,YA) (User)
  !	Entry GARROW does the same thing for paper coordinates (XZ,YZ)
  ! Arguments :
  !	XA,YA	R*8	User coordinates		Input
  !	XZ,YZ	R*4	Plot coordinates		Input
  ! Subroutines :
  !	GDRAW
  !
  ! Force the line style to solid for the end of an arrow	PV, 17-jul-87
  !---------------------------------------------------------------------
  real(kind=8) :: xa                      !
  real(kind=8) :: ya                      !
  ! Local
  real(kind=4) :: xz,yz,x,y,size,size2,alpha,x0,y0
  real(kind=4) :: x_head(5),y_head(5),x_head_c(8),y_head_c(8)
  integer(kind=size_length) :: npts
  logical :: error
  !
  ! Convert to plot coordinates
  if (axis_xlog) then
    x = gx1 + gux * (log(xa)-lux)
  else
    x = gx1 + gux * (xa-gux1)
  endif
  if (axis_ylog) then
    y = gy1 + guy * (log(ya)-luy)
  else
    y = gy1 + guy * (ya-guy1)
  endif
  goto 10
  !
entry garrow(xz,yz)
  x = xz
  y = yz
  !
10 x0 = xp
  y0 = yp
  if (x.lt.x0) then
    alpha = atan((y-y0)/(x-x0))
  elseif (x.eq.x0) then
    if (y.gt.y0) then
      alpha=-pis/2.
    elseif (y.eq.y0) then
      alpha= pis
    elseif (y.lt.y0) then
      alpha= pis/2.
    endif
  else
    alpha = atan((y-y0)/(x-x0)) + pis
  endif
  !
  ! Current segment : draw the line
  !
  size = csymb * expand * 0.5
  size2 = size * 0.707
  call gdraw (x+size2*cos(alpha),y+size2*sin(alpha))
  ! Close the current segment...
  error = .false.
  call gtsegm_close(error)
  !
  ! ..and open a new one to plot the end ( with solid line style )
  call gtsegm('ARROW',error)
  if (penupd) call setpen(cpen)
  call setdas(1)
  ! Define arrow head polygon
  x_head(1) = x+size2*cos(alpha)
  y_head(1) = y+size2*sin(alpha)
  x_head(2) = x+size*1.732*cos(alpha+pis/6.)
  y_head(2) = y+size*1.732*sin(alpha+pis/6.)
  x_head(3) = x
  y_head(3) = y
  x_head(4) = x+size*1.732*cos(alpha-pis/6.)
  y_head(4) = y+size*1.732*sin(alpha-pis/6.)
  x_head(5) = x+size2*cos(alpha)
  y_head(5) = y+size2*sin(alpha)
  !
  ! Plot the head (clip if needed)
  npts = 5
  if (noclip) then
    x_head_c(1:5) = x_head(1:5)
    y_head_c(1:5) = y_head(1:5)
  else
    call clip_poly(npts,x_head,y_head,x_head_c,y_head_c)
  endif
  ! call grpoly(npts,x_head_c,y_head_c)
  call gr_fillpoly(npts,x_head_c,y_head_c)
  !
  call grelocate (x,y)
end subroutine arrow
!
subroutine regval(z,xa,ya,value,lecri)
  use gbl_message
  use greg_interfaces, except_this=>regval
  use greg_rg
  !---------------------------------------------------------------------
  ! @ private
  ! GREG 	Internal routine
  !	Computes the Regular Grid array value at user coordinates XA,YA
  ! Arguments :
  !	Z	R*4 (*)	Regular grid array		Input
  !	XA	R*8	X user coordinate 		Input
  !	YA	R*8	Y user coordinate		Input
  !	VALUE	R*4	Value at this position		Output
  !	LECRI	L	Logical flag for writing	Input
  !---------------------------------------------------------------------
  real(kind=4) :: z(*)                    !
  real(kind=8) :: xa                      !
  real(kind=8) :: ya                      !
  real(kind=4) :: value                   !
  logical :: lecri                  !
  ! Local
  real(kind=8) :: tmp
  integer(kind=4) :: i,j
  character(len=message_length) :: chain
  !
  ! Compute I and J corresponding to XA and YA
  tmp = (xa-rg%xval)/rg%xinc + rg%xref
  i = nint(tmp)
  tmp = (ya-rg%yval)/rg%yinc + rg%yref
  j = nint(tmp)
  if (i.le.rg%nx .and. j.le.rg%ny .and. i.gt.0 .and. j.gt.0) then
    value = z((j-1)*rg%nx+i)
    if (lecri) then
      write (chain,300) i,j,value
      call greg_message(seve%r,'VALUE',chain)
    endif
  endif
300 format('Map Value at Pixel (',i5,',',i5,')  = ',1pg11.4)
end subroutine regval
!
function voisin(x,y)
  use greg_kernel
  !---------------------------------------------------------------------
  ! @ private
  !  Find the nearest of the 9 significant points in BOX
  !---------------------------------------------------------------------
  integer(kind=4) :: voisin        !
  real(kind=4), intent(in) :: x,y  ! Absolute position of point
  ! Local
  integer(kind=4) :: i,j
  !
  if (x.lt.(0.75*gx1+0.25*gx2)) then
    i = 1
  elseif (x.gt.(0.75*gx2+0.25*gx1)) then
    i = 3
  else
    i = 2
  endif
  !
  if (y.lt.(0.75*gy1+0.25*gy2)) then
    j = 0
  elseif (y.gt.(0.75*gy2+0.25*gy1)) then
    j = 2
  else
    j = 1
  endif
  !
  voisin = 3*j+i
end function voisin
!
subroutine corner(k,x,y)
  use greg_interfaces, except_this=>corner
  use greg_kernel
  !---------------------------------------------------------------------
  ! @ private
  !  Returns the coordinate of the significant point number K
  !---------------------------------------------------------------------
  integer(kind=4), intent(in)  :: k    ! Point number
  real(kind=4),    intent(out) :: x,y  ! Coordinates
  ! Local
  integer(kind=4) :: i
  !
  i = mod(k,3)
  if (i.eq.1) then
    x = gx1
  elseif (i.eq.2) then
    x = 0.5*(gx1+gx2)
  else
    x = gx2
  endif
  if (i.eq.0) then
    i = k/3
  else
    i = k/3+1
  endif
  if (i.eq.1) then
    y = gy1
  elseif (i.eq.2) then
    y = 0.5*(gy1+gy2)
  else
    y = gy2
  endif
end subroutine corner
!
function centre(x,y)
  use greg_kernel
  !---------------------------------------------------------------------
  ! @ private
  ! Find the appropriate centering option
  !---------------------------------------------------------------------
  integer(kind=4) :: centre        !
  real(kind=4), intent(in) :: x,y  ! Absolute position of point
  ! Local
  integer(kind=4) :: i,j
  !
  if (x.lt.gx1) then
    i = 1
  elseif (x.gt.gx2) then
    i = 3
  else
    i = 2
  endif
  !
  if (y.lt.gy1) then
    j = 1
  elseif (y.gt.gy2) then
    j = 3
  else
    j = 2
  endif
  centre = 3*(j-1)+i
end function centre
!
subroutine arraydraw1(code,x,y,kbox)
  use phys_const
  use greg_interfaces
  use greg_kernel
  !---------------------------------------------------------------------
  ! @ no-interface (because of argument type mismatch)
  !     Draw what CODE indicates, at position X,Y in coordinate system KBOX
  !
  !     CODE    C*(*)    Drawing action (Relocate, Line, Marker, Arrow)
  !     X,Y     R*8      Coordinates
  !     KBOX    I        Coordinate system
  !---------------------------------------------------------------------
  character(len=1) :: code
  real(kind=8) :: x
  real(kind=8) :: y
  integer(kind=4) :: kbox
  !
  ucurse(1)=x
  ucurse(2)=y
  if (kbox.eq.-3) then
    ucurse(1)=x*pi/180.0d0
    ucurse(2)=y*pi/180.0d0
  elseif (kbox.eq.-4) then
    ucurse(1)=x*pi/180.0d0/60.0d0
    ucurse(2)=y*pi/180.0d0/60.0d0
  elseif (kbox.eq.-5) then
    ucurse(1)=x*pi/180.0d0/3600.0d0
    ucurse(2)=y*pi/180.0d0/3600.0d0
  endif
  if (axis_xlog) then
    xcurse = gx1 + gux * (log(ucurse(1))-lux)
  else
    xcurse = gx1 + gux * (ucurse(1)-gux1)
  endif
  if (axis_ylog) then
    ycurse = gy1 + guy * (log(ucurse(2))-luy)
  else
    ycurse = gy1 + guy * (ucurse(2)-guy1)
  endif
  if (code.eq.'R') then
    call grelocate(xcurse,ycurse)
  elseif (code.eq.'L') then
    call gdraw(xcurse,ycurse)
  elseif (code.eq.'M') then
    call grelocate(xcurse,ycurse)
    call gr_point(nsides,istyle)
  elseif (code.eq.'A') then
    call garrow2(xcurse,ycurse)
  endif
end subroutine arraydraw1
!
subroutine arraydraw2(code,cra,la,cdec,ld,error)
  use phys_const
  use greg_dependencies_interfaces
  use greg_interfaces, except_this=>arraydraw2
  use greg_kernel
  use greg_wcs
  !---------------------------------------------------------------------
  ! @ private
  !     Draw what CODE indicates, at absolute position defined by
  !     CRA and CDEC.
  !
  !     CODE    C*(*)    Drawing action (Relocate, Line, Marker, Arrow)
  !     CRA     C*(*)    String for X position
  !     LA      I        Length of CRA
  !     CDEC    C*(*)    String for Y position
  !     LD      I        Length of CDEC
  !---------------------------------------------------------------------
  character(len=1)                :: code   !
  character(len=*)                :: cra    !
  integer(kind=4)                 :: la     !
  character(len=*)                :: cdec   !
  integer(kind=4)                 :: ld     !
  logical,          intent(inout) :: error  ! Logical error flag
  !
  real(kind=8) :: sux,suy
  !
  call sic_sexa(cra,la,ucurse(1),error)
  if (error) return
  if (i_system.eq.type_eq .or. i_system.eq.type_ic) then
    ucurse(1) = ucurse(1)*pi/12.0d0
  else
    ucurse(1) = ucurse(1)*pi/180.0d0
  endif
  call sic_sexa(cdec,ld,ucurse(2),error)
  if (error) return
  ucurse(2) = ucurse(2)*pi/180.0d0
  sux = ucurse(1)
  suy = ucurse(2)
  call abs_to_rel(gproj,sux,suy,ucurse(1),ucurse(2),1)
  if (axis_xlog) then
    xcurse = gx1 + gux * (log(ucurse(1))-lux)
  else
    xcurse = gx1 + gux * (ucurse(1)-gux1)
  endif
  if (axis_ylog) then
    ycurse = gy1 + guy * (log(ucurse(2))-luy)
  else
    ycurse = gy1 + guy * (ucurse(2)-guy1)
  endif
  if (code.eq.'R') then
    call grelocate(xcurse,ycurse)
  elseif (code.eq.'L') then
    call gdraw(xcurse,ycurse)
  elseif (code.eq.'M') then
    call grelocate(xcurse,ycurse)
    call gr_point(nsides,istyle)
  elseif (code.eq.'A') then
    call garrow2(xcurse,ycurse)
  endif
end subroutine arraydraw2
!
subroutine draw_text_relative(x,y,string,nchar,kbox,ic,doclip_soft)
  use phys_const
  use greg_interfaces, except_this=>draw_text_relative
  use greg_kernel
  use greg_wcs
  !---------------------------------------------------------------------
  ! @ private
  !  Draw a TEXT, at position X,Y in coordinate system KBOX
  !---------------------------------------------------------------------
  real(kind=8),     intent(in) :: x,y          ! Coordinates
  character(len=*), intent(in) :: string       ! Text to be drawn
  integer(kind=4),  intent(in) :: nchar        ! Length of STRING
  integer(kind=4),  intent(in) :: kbox         ! Coordinate system
  integer(kind=4),  intent(in) :: ic           ! Centering code
  logical,          intent(in) :: doclip_soft  ! Soft clipping enabled?
  ! Local
  integer(kind=4) :: ii
  !
  if (kbox.eq.-3) then
    ucurse(1)=x*pi/180.0d0
    ucurse(2)=y*pi/180.0d0
  elseif (kbox.eq.-4) then
    ucurse(1)=x*pi/180.0d0/60.0d0
    ucurse(2)=y*pi/180.0d0/60.0d0
  elseif (kbox.eq.-5) then
    ucurse(1)=x*pi/180.0d0/3600.0d0
    ucurse(2)=y*pi/180.0d0/3600.0d0
  else
    ucurse(1)=x
    ucurse(2)=y
  endif
  if (axis_xlog) then
    xcurse = gx1 + gux * (log(ucurse(1))-lux)
  else
    xcurse = gx1 + gux * (ucurse(1)-gux1)
  endif
  if (axis_ylog) then
    ycurse = gy1 + guy * (log(ucurse(2))-luy)
  else
    ycurse = gy1 + guy * (ucurse(2)-guy1)
  endif
  call grelocate(xcurse,ycurse)
  ii = ic
  if (ii.eq.0) ii = centre(xcurse,ycurse)
  call putlabel(nchar,string,ii,tangle,doclip_soft)
end subroutine draw_text_relative
!
subroutine garrow2(xz,yz)
  use phys_const
  use greg_interfaces, except_this=>garrow2
  use greg_kernel
  use greg_pen
  !---------------------------------------------------------------------
  ! @ private
  ! GREG	Internal routine
  !	Draws an arrow from current pen position to (XZ,YZ)
  !	in paper coordinates (XZ,YZ)
  ! Arguments :
  !	XZ,YZ	R*4	Plot coordinates		Input
  !
  ! Does not change the line style to solid for the end of an arrow
  ! since it would create spurious segments
  !---------------------------------------------------------------------
  real(kind=4) :: xz                      !
  real(kind=4) :: yz                      !
  ! Local
  real(kind=4) :: x,y,size,size2,alpha,x0,y0
  !
  x = xz
  y = yz
  !
  x0 = xp
  y0 = yp
  if (x.lt.x0) then
    alpha = atan((y-y0)/(x-x0))
  elseif (x.eq.x0) then
    if (y.gt.y0) then
      alpha=-pis/2.
    elseif (y.eq.y0) then
      alpha= pis
    elseif (y.lt.y0) then
      alpha= pis/2.
    endif
  else
    alpha = atan((y-y0)/(x-x0)) + pis
  endif
  ! everything is drawn in the current segment, with same pen.
  size = csymb * expand * 0.5
  size2 = size * 0.707
  call gdraw (x+size2*cos(alpha),y+size2*sin(alpha))
  call gdraw (x+size*1.732*cos(alpha+pis/6.),y+size*1.732*sin(alpha+pis/6.) )
  call gdraw (x,y)
  call gdraw (x+size*1.732*cos(alpha-pis/6.),y+size*1.732*sin(alpha-pis/6.) )
  call gdraw (x+size2*cos(alpha),y+size2*sin(alpha) )
  call grelocate (x,y)
end subroutine garrow2
!
subroutine print_position (w_angle)
  use phys_const
  use greg_interfaces, except_this=>print_position
  use greg_kernel
  use greg_wcs
  use gbl_message
  !---------------------------------------------------------------------
  ! @ private
  !     Print current cursor position
  !
  !     W_ANGLE  I        Coordinate system                         Input
  !---------------------------------------------------------------------
  integer(kind=4) :: w_angle                !
  ! Local
  character(len=80) :: chain
  !
  write (chain,100) xcurse,ycurse
  call greg_message(seve%r,'VALUE',chain)
  if (gproj%type.ne.p_none.or.i_system.ne.type_un) then
    if (w_angle.eq.u_degree) then
      write (chain,200) ucurse(1)*180.0d0/pi,ucurse(2)*180.0d0/pi,' (Arc. Deg.)'
    elseif (w_angle.eq.u_minute) then
      write (chain,200) ucurse(1)*10800.0d0/pi,ucurse(2)*10800.0d0/pi,  &
      ' (Arc. Min.)'
    elseif (w_angle.eq.u_second) then
      write (chain,200) ucurse(1)*6.48d5/pi,ucurse(2)*6.48d5/pi,' (Arc. Sec.)'
    else
      write (chain,200) ucurse(1),ucurse(2),' (Rad.)'
    endif
    call sexfor (ucurse(1),ucurse(2))
  else
    write (chain,200) ucurse(1),ucurse(2)
  endif
  call greg_message(seve%r,'VALUE',chain)
  !
100 format('Physical Coordinates: ',1pg15.4,2x,1pg15.4)
200 format('    User Coordinates: ',1pg15.8,2x,1pg15.8,a)
end subroutine print_position
!
subroutine print_line(line,kbox,ibox,chain,fact)
  use phys_const
  use greg_dependencies_interfaces
  use greg_interfaces, except_this=>print_line
  use greg_kernel
  use greg_wcs
  !---------------------------------------------------------------------
  ! @ private
  !  Re-write the command line for a DRAW Code action
  !
  !  kbox < 0: user coordinates
  !  kbox = 0: physical coordinates from box "corner"
  !  kbox = 1: character coordinates from box "corner"
  !  kbox = 2: absolute physical coordinates on page
  !---------------------------------------------------------------------
  character(len=*), intent(out) :: line   ! Command line
  integer(kind=4),  intent(in)  :: kbox   ! Coordinate system
  integer(kind=4),  intent(in)  :: ibox   ! Box corner (if relevant according to KBOX)
  character(len=*), intent(in)  :: chain  ! Code of action (all but TEXT)
  real(kind=4),     intent(in)  :: fact   ! Scaling factor
  ! Local
  character(len=1), parameter :: backslash=char(92)
  character(len=13) :: sexag1,sexag2
  real(kind=8) :: x,y
  integer(kind=4) :: ndiv
  real(kind=4) :: gx,gy
  !
  if (kbox.eq.-1) then
    write(line,201) backslash,chain,ucurse(1),ucurse(2)
  elseif (kbox.eq.-5) then
    write(line,201) backslash,chain,ucurse(1)*6.48d5/pi,ucurse(2)*6.48d5/pi
  elseif (kbox.eq.-4) then
    write(line,201) backslash,chain,ucurse(1)*1.08d4/pi,ucurse(2)*1.08d4/pi
  elseif (kbox.eq.-3) then
    write(line,201) backslash,chain,ucurse(1)*180.0d0/pi,ucurse(2)*180.0d0/pi
  elseif (kbox.eq.-2) then
    call rel_to_abs(gproj,ucurse(1),ucurse(2),x,y,1)
    if (i_system.eq.type_eq .or. i_system.eq.type_ic) then
      ndiv=24
    else
      ndiv=360
    endif
    call sexag(sexag1,x,ndiv)
    call sexag(sexag2,y,360)
    write(line,301) backslash,chain,sexag1,sexag2
  else
    ! Coordinates from box corner
    call corner(max(ibox,1),gx,gy)
    write(line,101) backslash,chain,(xcurse-gx)/fact,(ycurse-gy)/fact
  endif
  !
101 format('GREG1',a1,'DRAW ',a,' ',1pg11.4,' ',1pg11.4)
201 format('GREG1',a1,'DRAW ',a,' ',1pg15.8,' ',1pg15.8)
301 format('GREG1',a1,'DRAW ',a,' ',a13,' ',a13)
end subroutine print_line
!
subroutine print_text(line,kbox,ibox,chain,fact,string,ic,ang)
  use phys_const
  use greg_dependencies_interfaces
  use greg_interfaces, except_this=>print_text
  use greg_kernel
  use greg_wcs
  !---------------------------------------------------------------------
  ! @ private
  !  Re-write the command line for a DRAW TEXT action
  !
  !  kbox < 0: user coordinates
  !  kbox = 0: physical coordinates from box "corner"
  !  kbox = 1: character coordinates from box "corner"
  !  kbox = 2: absolute physical coordinates on page
  !---------------------------------------------------------------------
  character(len=*), intent(out) :: line    ! Command line
  integer(kind=4),  intent(in)  :: kbox    ! Coordinate system
  integer(kind=4),  intent(in)  :: ibox    ! Box corner (if relevant according to KBOX)
  character(len=*), intent(in)  :: chain   ! Code of action (all but TEXT)
  real(kind=4),     intent(in)  :: fact    ! Scaling factor
  character(len=*), intent(in)  :: string  ! Text to be drawn
  integer(kind=4),  intent(in)  :: ic      ! Centering code
  real(kind=8),     intent(in)  :: ang     ! Orientation of text
  ! Local
  character(len=1), parameter :: backslash=char(92)
  character(len=13) :: sexag1,sexag2
  real(kind=8) :: x,y
  integer(kind=4) :: ndiv
  real(kind=4) :: gx,gy
  !
  if (kbox.eq.-1) then
    write(line,205) backslash,ucurse(1),ucurse(2),string,ic,ang
  elseif (kbox.eq.-3) then
    write(line,205) backslash,ucurse(1)*180.0d0/pi,ucurse(2)*180.0d0/pi,  &
    string,ic,ang
  elseif (kbox.eq.-4) then
    write(line,205) backslash,ucurse(1)*1.08d4/pi,ucurse(2)*1.08d4/pi,string,  &
    ic,ang
  elseif (kbox.eq.-5) then
    write(line,205) backslash,ucurse(1)*6.48d5/pi,ucurse(2)*6.48d5/pi,string,  &
    ic,ang
  elseif (kbox.eq.-2) then
    call rel_to_abs(gproj,ucurse(1),ucurse(2),x,y,1)
    call sexag(sexag1,x,ndiv)
    call sexag(sexag2,y,360)
    write(line,305) backslash,sexag1,sexag2,string,ic,ang
  else
    ! Coordinates from box corner
    call corner(max(ibox,1),gx,gy)
    write(line,105) backslash,(xcurse-gx)/fact,(ycurse-gy)/fact,string,ic,ang
  endif
  !
105 format('GREG1',a1,'DRAW TEXT ',1pg11.4,' ',1pg11.4,' "',a,'" ',i1,1x,1pg11.4)
205 format('GREG1',a1,'DRAW TEXT ',1pg15.8,' ',1pg15.8,' "',a,'" ',i1,1x,1pg11.4)
305 format('GREG1',a1,'DRAW TEXT ',a13,    ' ',a13,    ' "',a,'" ',i1,1x,1pg11.4)
end subroutine print_text
!
subroutine glook(line,error)
  use greg_dependencies_interfaces
  use greg_interfaces, except_this=>glook
  use greg_kernel
  use greg_pen
  use greg_rg
  !---------------------------------------------------------------------
  ! @ private
  ! GREG
  !     Support for command
  !     LOOK "command"
  !
  ! Calls the cursor, and execute the specified command each time it is
  ! pressed. The command can be a procedure (e.g. @my_look) and can test
  ! the pressed character which is added at the end as first argument.
  !---------------------------------------------------------------------
  character(len=*)                :: line   !
  logical,          intent(inout) :: error  !
  ! Local
  character(len=512) :: command
  character(len=1) :: cucode
  real(kind=8) :: x,y
  integer(kind=4) :: nc
  integer(kind=4), parameter :: max_integ=2147483647
  !
  if (.not.gtg_curs()) return
  call sic_ch(line,0,1,command,nc,.true.,error)
  if (error) return
  !
  ! Loop over with the cursor
  do while(.true.)
    call gr_curs(ucurse(1),ucurse(2),xcurse,ycurse,cucode)
    error = (gterrtst().or.cucode.eq.char(3).or.sic_ctrlc())
    if (error) return
    ! Codes returned by ButtonPress events to keycodes
    !         IF (CUCODE.EQ.'^') CUCODE = 'R'
    !         IF (CUCODE.EQ.'&') CUCODE = 'L'
    ! Remap * to Exit
    if (cucode.eq.'*') cucode = 'E'
    cursor_code = cucode
    !
    ! Return if EXIT
    if (cucode.eq.'E') exit
    !
    ! defines the PIX_CURS SIC variable if associated
    if (rg%status.ne.code_pointer_null) then
      if (rg%xinc.ne.0) then
        x = (ucurse(1)-rg%xval)/rg%xinc + rg%xref
      else
        x = 0
      endif
      if (rg%yinc.ne.0) then
        y = (ucurse(2)-rg%yval)/rg%yinc + rg%yref
      else
        y = 0
      endif
      if (abs(x).le.max_integ.and.abs(y).le.max_integ) then
        pixcurse(1) = nint(x)
        pixcurse(2) = nint(y)
      else
        pixcurse(1) = 0
        pixcurse(2) = 0
      endif
    else
      pixcurse(1) = 0
      pixcurse(2) = 0
    endif
    !
    command(nc+1:nc+4) = ' "'//cucode//'"'
    call exec_program(command)
  enddo
  call sic_insert(line)
end subroutine glook
