subroutine gtx_truncate(output,ax,ay)
  use gtv_protocol
  !---------------------------------------------------------------------
  ! @ private
  !  Forces AX and AY within the clipping area
  !---------------------------------------------------------------------
  type(gt_display), intent(in)    :: output  ! 'gt_display' instance
  real,             intent(inout) :: ax,ay   !
  !
  ax = max(ax,output%gx1)
  ax = min(ax,output%gx2)
  ay = max(ay,output%gy1)
  ay = min(ay,output%gy2)
  !
end subroutine gtx_truncate
!
subroutine gtg_screen(qx1,qx2,qy1,qy2)
  use gtv_interfaces, except_this=>gtg_screen
  use gtv_protocol
  !---------------------------------------------------------------------
  ! @ public
  !  Returns the coordinates of the end pixels of the physical screen
  ! (world units). Very useful for interactive zooming. Works on the
  ! Current Working Output.
  !---------------------------------------------------------------------
  real, intent(out) :: qx1,qx2  !
  real, intent(out) :: qy1,qy2  !
  !
  call gtg_screen_sub(cw_output,qx1,qx2,qy1,qy2)
  !
end subroutine gtg_screen
!
subroutine gtg_screen_sub(output,qx1,qx2,qy1,qy2)
  use gtv_graphic
  use gtv_interfaces, except_this=>gtg_screen_sub
  use gtv_protocol
  use gbl_message
  !---------------------------------------------------------------------
  ! @ private
  !  Returns the coordinates of the end pixels of the physical screen
  ! (world units). Very useful for interactive zooming. Works on the
  ! input instance
  !---------------------------------------------------------------------
  type(gt_display), intent(in)  :: output   ! 'gt_display' instance
  real,             intent(out) :: qx1,qx2  !
  real,             intent(out) :: qy1,qy2  !
  ! Local
  character(len=*), parameter :: rname='GTG_SCREEN'
  !
  if (.not.awake .or. output%dev%protocol.eq.p_null) then
    call gtv_message(seve%e,rname,'No output device')
    call gtx_err
    qx1 = 0.
    qx2 = 0.
    qy1 = 0.
    qy2 = 0.
    return
  endif
  !
  if (error_condition) then
    call gtv_message(seve%e,rname,'Library in error condition')
    call gtx_err
    qx1 = 0.
    qx2 = 0.
    qy1 = 0.
    qy2 = 0.
    return
  endif
  !
  call pixel_to_world(output,output%px1,output%py1,qx1,qy1)
  call pixel_to_world(output,output%px2,output%py2,qx2,qy2)
  !
end subroutine gtg_screen_sub
!
function gtg_curs()
  use gtv_interfaces, except_this=>gtg_curs
  use gtv_protocol
  !---------------------------------------------------------------------
  ! @ public
  !   Informs if a cursor is available on the current device
  !---------------------------------------------------------------------
  logical :: gtg_curs  ! Function value on return
  !
  gtg_curs = gtg_curs_sub(cw_device)
  !
end function gtg_curs
!
function gtg_curs_sub(dev)
  use gtv_types
  use gtv_graphic
  !---------------------------------------------------------------------
  ! @ private
  !   Informs if a cursor is available on the input device
  !---------------------------------------------------------------------
  logical         :: gtg_curs_sub  ! Function value on return
  type(gt_device) :: dev           ! Device
  !
  if (awake .and. .not.error_condition) then
    gtg_curs_sub = dev%hardw_cursor
  else
    gtg_curs_sub = .false.
  endif
end function gtg_curs_sub
!
subroutine gtcurs(xcm,ycm,ch,error)
  use gbl_message
  use gtv_buffers
  use gtv_interfaces, except_this=>gtcurs
  use gtv_protocol
  !---------------------------------------------------------------------
  ! @ public
  ! Same as gtcurs_sub but works on the Current Working Output
  !---------------------------------------------------------------------
  real,             intent(inout) :: xcm,ycm  !
  character(len=*), intent(out)   :: ch       !
  logical,          intent(inout) :: error    !
  ! Local
  character(len=*), parameter :: rname='GTCURS'
  type(gt_display), pointer :: out
  type(gt_directory), pointer :: dir
  !
  if (cw_device%protocol.eq.p_x) then
    if (cw_directory%x%nbwin.eq.0) then
      ! Current working directory has no window, let see in the
      ! ancestor...
      dir => cw_directory%ancestor
      ! call cree_chemin_dir(dir_zoom,gpname,nd)
      ! call gtv_message(seve%i,rname,'Call cursor in directory '//gpname)
      if (dir%x%nbwin.eq.0) then
        call gtv_message(seve%e,rname,'No window found')
        error = .true.
        return
      endif
      ! Call cursor in first window of grand-pere
      call get_slot_output_by_num(dir,0,out,error)
      if (error)  return
    else
      ! Call cursor in current working window
      out => cw_output
    endif
  else
    out => cw_output
  endif
  !
  call gtcurs_sub(out,xcm,ycm,ch)
  !
end subroutine gtcurs
!
subroutine gicurs(xcm,ycm,rect_xw_cm,rect_yw_cm,ch,error)
  use gbl_message
  use gtv_buffers
  use gtv_interfaces, except_this=>gicurs
  use gtv_protocol
  !---------------------------------------------------------------------
  ! @ public
  ! Same as gicurs_sub but works on the Current Working Output
  !---------------------------------------------------------------------
  real(kind=4),     intent(inout) :: xcm,ycm                !
  real(kind=4),     intent(in)    :: rect_xw_cm,rect_yw_cm  !
  character(len=*), intent(out)   :: ch                     !
  logical,          intent(inout) :: error                  !
  ! Local
  character(len=*), parameter :: rname='GICURS'
  type(gt_display), pointer :: out
  type(gt_directory), pointer :: dir
  !
  if (cw_device%protocol.eq.p_x) then
    if (cw_directory%x%nbwin.eq.0) then
      ! Current working directory has no window, let see in the
      ! ancestor...
      dir => cw_directory%ancestor
      ! call cree_chemin_dir(dir_zoom,gpname,nd)
      ! call gtv_message(seve%i,rname,'Call cursor in directory '//gpname)
      if (dir%x%nbwin.eq.0) then
        call gtv_message(seve%e,rname,'No window found')
        error = .true.
        return
      endif
      ! Call cursor in first window of grand-pere
      call get_slot_output_by_num(dir,0,out,error)
      if (error)  return
    else
      ! Call cursor in current working window
      out => cw_output
    endif
  else
    out => cw_output
  endif
  !
  call gicurs_sub(out,xcm,ycm,rect_xw_cm,rect_yw_cm,ch)
  !
end subroutine gicurs
!
subroutine gtcurs_sub(output,xcm,ycm,ch)
  use gtv_graphic
  use gtv_interfaces, except_this=>gtcurs_sub
  use gtv_protocol
  use gtv_types
  use gbl_message
  !---------------------------------------------------------------------
  ! @ private
  !	Activates the cursor. CH contains the character struck
  !	and XCM YCM are the adresses of the cursor position, in
  !	plot units with respect to the current origin.
  !	Preset the cursor position at XCM YCM if possible
  !
  !	Does not modify the virtuel pen position and the immediate
  !	pen position.
  !---------------------------------------------------------------------
  type(gt_display), intent(in)    :: output   ! Output instance
  real,             intent(inout) :: xcm,ycm  !
  character(len=*), intent(out)   :: ch       !
  ! Local
  character(len=*), parameter :: rname='GTCURS'
  character(len=1) :: cc               ! For X_CURS
  integer :: rect_xw,rect_yw,ix,iy,fzoom
  real*4 :: rect_xw_cm,rect_yw_cm
  !
  ! "Pick up a value" mode. Draw a cross only for selecting a position.
  ! No rectangle size defined since it will be ignored in this mode.
  fzoom = 0
  goto 10
  !
entry gicurs_sub(output,xcm,ycm,rect_xw_cm,rect_yw_cm,ch)
  ! Zoom mode. Draw cross + rectangle for zooming. Define the size (in
  ! world units) of the rectangle which defines the zooming area.
  fzoom = 1
  !
10 continue
  !
  if (.not.awake) then
    call gtv_message(seve%e,rname,'Library sleeping')
    call gtx_err
    return
  endif
  if (error_condition) then
    call gtv_message(seve%e,rname,'Library in error condition')
    call gtx_err
    return
  endif
  !
  ! Same problem for device without cursor hardware
  if (.not.output%dev%hardw_cursor) then
    call gtv_message(seve%e,rname,'No cursor available on current device')
    call gtx_err
    return
    !
  elseif (output%dev%protocol.eq.p_x) then
    if (output%x%graph_env.eq.0) then
      call gtv_message(seve%e,rname,  &
        'No active window in current working GTV directory')
      call gtx_err
      return
    endif
    !
    ! Not quite portable...
    cc = ' '
    if (fzoom.eq.1) then
      call world_to_pixel_size(output,rect_xw_cm,rect_yw_cm,rect_xw,rect_yw)
    else
      rect_xw = 0
      rect_yw = 0
    endif
    call x_curs(output%x%graph_env,fzoom,rect_xw,rect_yw,ix,iy,cc)
    ch = cc
    !
    call pixel_to_world(output,ix,iy,xcm,ycm)
    return
    !
  else
    ! Could become available for Display Postscript
    call gtv_message(seve%e,rname,'No cursor available on current device')
    call gtx_err
    return
  endif
  !
end subroutine gtcurs_sub
