!-----------------------------------------------------------------------
! Support file for the magnify lens
!-----------------------------------------------------------------------
subroutine gtl_lens(line,error)
  use gtv_interfaces, except_this=>gtl_lens
  use gbl_message
  use gtv_buffers
  use gtv_protocol
  use gtv_types
  !---------------------------------------------------------------------
  ! @ private
  !  Support routine for command LENS
  !  Invoke the lens and suspend execution until the lens has been
  ! closed.
  ! ---
  !  Thread status: safe for reading from main thread
  !---------------------------------------------------------------------
  character(len=*), intent(in)    :: line   ! Input command line
  logical,          intent(inout) :: error  ! Logical error flag
  ! Local
  character(len=*), parameter :: rname='LENS'
  type(gt_directory), pointer :: dir_lens
  character(len=80) :: gpname
  integer(kind=4) :: nd
  integer(kind=address_length) :: genv
  !
  ! Non-sense if protocol is other than X
  if (cw_device%protocol.ne.p_x) then
    call gtv_message(seve%e,rname,'Available only with X device')
    error = .true.
    return
  endif
  !
  call gtv_open_segments_for_reading_from_main()
  !
  ! Invoke the lens in the current active window
  if (cw_directory%x%nbwin.eq.0) then
    ! No window here, zoom in first window of grand-pere
    dir_lens => cw_directory%ancestor
    call cree_chemin_dir(dir_lens,gpname,nd)
    call gtv_message(seve%i,rname,'Lens in directory '//gpname)
    !
    if (dir_lens%x%nbwin.eq.0) then
      call gtv_message(seve%e,rname,'No window found')
      error = .true.
      goto 100
    endif
  else
    ! Zoom in first window of current working directory
    dir_lens => cw_directory
  endif
  !
  genv = dir_lens%x%genv
  !
100 continue
  !
  call gtv_close_segments_for_reading_from_main()
  !
  if (error)  return
  !
  call x_lens(genv)
  !
end subroutine gtl_lens
!
subroutine lens_register(dir,genv_main,genv_lens,ier)
  use gildas_def
  use gtv_interfaces, except_this=>lens_register
  use gtv_protocol
  use gtv_types
  use gbl_message
  !---------------------------------------------------------------------
  ! @ private
  !  Register in the GTV structures the magnify lens which has already
  ! been opened. No need to create a new genv_array, there must be
  ! one since we zoom on an existing window.
  ! ---
  !  Thread status: safe to call from graphic thread.
  !---------------------------------------------------------------------
  type(gt_directory)                        :: dir        ! Parent directory
  integer(kind=address_length), intent(in)  :: genv_main  ! Genv of the window we zoom in
  integer(kind=address_length), intent(in)  :: genv_lens  ! Genv of the lens window
  integer(kind=4),              intent(out) :: ier        ! Error flag
  ! Local
  character(len=*), parameter :: rname='LENS_REGISTER'
  type(gt_display), pointer :: main_output,lens_output
  logical :: error,found
  !
  ier = 1  ! Error set
  error = .false.
  !
  ! Retrieve the parent output
  call get_slot_output_by_genv(genv_main,main_output,.true.,found,error)
  if (error)  return
  !
  ! Set a slot for the lens
  call get_free_slot_output(lens_output,error)
  if (error)  return
  !
  lens_output%dev => main_output%dev   ! Point on the shared X-protocol instance
  lens_output%color = .true.
  lens_output%background = lens_output%dev%background
  call x_display_reset(lens_output%x)  ! Default values
  lens_output%x%graph_env = genv_lens
  lens_output%x%name = 'LENS'
  !
  call create_window(lens_output,.false.,dir,.false.,.false.,error)
  if (error) then
    call gtv_message(seve%e,rname,'Cannot register new window')
    return
  endif
  !
  ier = 0  ! No error
  !
end subroutine lens_register
!
subroutine lens_limits(genv_main,genv_lens,pixxc,pixyc,zoom,ier)
  use gildas_def
  use gbl_message
  use gtv_interfaces, except_this=>lens_limits
  use gtv_protocol
  use gtv_types
  !---------------------------------------------------------------------
  ! @ private
  ! Redraw the lens according to the input center position (in pixels
  ! coordinates of the parent window) and the zooming factor.
  !---------------------------------------------------------------------
  integer(kind=address_length), intent(in)  :: genv_main  ! Genv of the window we zoom in
  integer(kind=address_length), intent(in)  :: genv_lens  ! Genv of the lens window
  integer, intent(in)  :: pixxc  ! X center (pixels)
  integer, intent(in)  :: pixyc  ! Y center (pixels)
  real,    intent(in)  :: zoom   ! Zoom factor
  integer, intent(out) :: ier    ! Error flag
  ! Local
  character(len=*), parameter :: rname='LENS'
  integer :: npixx,npixy
  real*4 :: wxc,wyc,wx,wy,wxz,wyz,wx1,wx2,wy1,wy2,gsclx,gscly
  type(gt_display), pointer :: main_output,lens_output
  logical :: error,found
  character(len=message_length) :: mess
  !
  ier = 1  ! Error set
  error = .false.
  !
  ! Find the lens instance
  call get_slot_output_by_genv(genv_lens,lens_output,.true.,found,error)
  if (error)  return
  !
  ! Find the parent window instance
  call get_slot_output_by_genv(genv_main,main_output,.true.,found,error)
  if (error)  return
  !
  ! Convert coordinates (center)
  call pixel_to_world(main_output,pixxc,pixyc,wxc,wyc)
  ! Convert coordinates (size)
  npixx = lens_output%px2
  npixy = max(lens_output%py1,lens_output%py2)
  call pixel_to_world_size(main_output,npixx/2.,npixy/2.,wx,wy)
  ! Apply zoom factor
  wxz = wx/zoom
  wyz = wy/zoom
  ! Compute X and Y ranges in world units
  wx1 = wxc-wxz
  wx2 = wxc+wxz
  if (lens_output%py1.lt.lens_output%py2) then
    wy1 = wyc-wyz
    wy2 = wyc+wyz
  else
    wy1 = wyc+wyz
    wy2 = wyc-wyz
  endif
  !
  ! Set the new clipping for the lens, redraw (in particular
  ! call gti_xforceupdate)
  if (wx1.ge.wx2 .or. wy1.ge.wy2) then
    print *,''
    call gtv_message(seve%w,rname,'Zoom limit reached. Nothing done.')
    !
    write(mess,101)  &
      'Center: X: ',pixxc,' px, Y: ',pixyc,' px (main window units)'
    call gtv_message(seve%w,rname,mess)
    !
    write(mess,102)  &
      'Center: X: ',wxc,  ' cm, Y: ',wyc,  ' cm (paper units)'
    call gtv_message(seve%w,rname,mess)
    !
    write(mess,102)  &
      'Half-width: X: ',npixx/2.,  ' px, Y: ',npixy/2.,  ' px (main window units)'
    call gtv_message(seve%w,rname,mess)
    !
    call get_scale_awd(main_output,gsclx,gscly)
    write(mess,102)  &
      'Scale: X: ',gsclx,  ', Y: ',gscly,  ' (px/cm)'
    call gtv_message(seve%w,rname,mess)
    !
    write(mess,102)  &
      'Half-width (before): X: ',wx,  ' cm, Y: ',wy,  ' cm (paper units)'
    call gtv_message(seve%w,rname,mess)
    !
    write(mess,102)  &
      'Zoom factor: ',zoom
    call gtv_message(seve%w,rname,mess)
    !
    write(mess,102)  &
      'Half-width (zoomed): X: ',wxz,  ' cm, Y: ',wyz,  ' cm (paper units)'
    call gtv_message(seve%w,rname,mess)
    !
    write(mess,103)  &
      'Ranges: X: ',wx1,wx2,  ' cm, Y: ',wy1,wy2,  ' cm (paper units)'
    call gtv_message(seve%w,rname,mess)
    !
    return
  endif
  call sp_gtwindow(lens_output,wx1,wx2,wy1,wy2)
  !
  ier = 0
  !
101 format(a,i0,      a,i0,     a)
102 format(a,1pg14.7, a,1pg14.7, a)
103 format(2(a,1pg12.7,1pg12.7), a)
  !
end subroutine lens_limits
