subroutine gtl_create(line,error)
  use gtv_dependencies_interfaces
  use gtv_interfaces, except_this=>gtl_create
  use gtv_tree
  use gtv_buffers
  use gbl_message
  !---------------------------------------------------------------------
  ! @ private
  !   Support routine for command
  ! CREATE WINDOW|DIRECTORY|PENLUT|LUT [/SIZE SizeX SizeY] [/PIXEL Px Py]
  !---------------------------------------------------------------------
  character(len=*), intent(in)    :: line   ! Input command line
  logical,          intent(inout) :: error  ! Logical error flag
  ! Local
  character(len=*), parameter :: rname='CREATE'
  integer, parameter :: nvocab=4
  character(len=12) :: vocab(nvocab),to_check,comm
  integer :: ncom
  !
  data vocab /'DIRECTORY','PENLUT','LUT','WINDOW'/
  !
  call sic_ke (line,0,1,to_check,ncom,.true.,error)
  if (error) return
  !
  ! Check if type of variable is known
  call sic_ambigs(rname,to_check,comm,ncom,vocab,nvocab,error)
  if (error) return
  !
  select case (comm)
  case('DIRECTORY')
    call gtl_mkdir(line,error)
    !
  case('PENLUT')
    call gtv_penlut(error)
    !
  case('LUT')
    call gtv_lut(error)
    !
  case('WINDOW')
    call gtl_create_window(line,error)
    !
  case default
    call gtv_message(seve%e,rname,'CREATE '//trim(comm)//' not yet implemented')
    error = .true.
    return
  end select
  !
end subroutine gtl_create
!
subroutine gtl_create_window(line,error)
  use gildas_def
  use gtv_buffers
  use gtv_graphic
  use gtv_dependencies_interfaces
  use gtv_interfaces, except_this=>gtl_create_window
  use gtv_protocol
  use gbl_message
  !---------------------------------------------------------------------
  ! @ private
  ! Support routine for command
  !  CREATE WINDOW  [WHITE|BLACK] [NAME Name] /PIXEL Px Py
  !---------------------------------------------------------------------
  character(len=*), intent(in)    :: line   !
  logical,          intent(inout) :: error  ! Logical error flag
  ! Local
  character(len=*), parameter :: rname='CREATE WINDOW'
  real :: ax,ay,bx,by
  integer :: backg,ncom,iarg,nc,sever
  integer, parameter :: nvocab=3
  character(len=12) :: comm,vocab(nvocab),argum,argx,argy
  real(kind=4), parameter :: margin=.05  ! Margin size, as a fraction.
  real(kind=4) :: xmargin,ymargin
  type(x_output) :: xdisplay
  ! Data
  data vocab /'BLACK','WHITE','NAME'/
  !
  ! 0) Basic checks
  if (cw_device%protocol.ne.p_x) then
    call gtv_message(seve%w,rname,'Ignored when not using X-Window')
    return
  endif
  if (associated(cw_directory,root)) then
    call gtv_message(seve%e,rname,'Cannot create window under root <')
    error = .true.
    return
  endif
  if (sic_present(1,0)) then
    call gtv_message(seve%e,rname,'Option /SIZE is invalid in this context')
    error = .true.
    return
  endif
  !
  ! 1) Get the window characteristics
  !
  call x_display_reset(xdisplay)  ! Default values
  !
  ! CREATE WINDOW arguments
  iarg = 2
  backg = -1
  do while (iarg.le.sic_narg(0))
    call sic_ke (line,0,iarg,argum,nc,.true.,error)
    if (error) return
    call sic_ambigs(rname,argum,comm,ncom,vocab,nvocab,error)
    if (error) return
    if (comm.eq.'BLACK') then
      backg = 0
    elseif (comm.eq.'WHITE') then
      backg = 1
    elseif (comm.eq.'NAME') then
      iarg = iarg+1
      call sic_ch (line,0,iarg,xdisplay%name,nc,.true.,error)
      if (error) return
    endif
    iarg = iarg+1
  enddo
  !
  ! /GEOMETRY arguments
  if (sic_present(3,0)) then
    call sic_ch(line,3,1,argx,nc,.true.,error)
    if (error) return
    call sic_ch(line,3,2,argy,nc,.true.,error)
    if (error) return
    call decode_coordinates(xdisplay%geometry,argx,argy,error)
    if (error)  return
  endif
  !
  ! /POSITION arguments
  if (sic_present(4,0)) then
    call sic_ch(line,4,1,argx,nc,.true.,error)
    if (error) return
    call sic_ch(line,4,2,argy,nc,.true.,error)
    if (error) return
    call decode_coordinates(xdisplay%position,argx,argy,error)
    if (error)  return
  endif
  !
  ! /PIXEL arguments (obsolete since 05-oct-2010)
  if (sic_present(2,0)) then
    if (strict2011) then
      sever = seve%e
    else
      sever = seve%w
    endif
    call gtv_message(sever,rname,  &
      'CREATE WINDOW /PIXEL is obsolete. Use /GEOMETRY instead.')
    if (strict2011) then
      error = .true.
      return
    endif
    !
    call sic_r4(line,2,1,xdisplay%geometry%x,.true.,error)
    if (error) return
    xdisplay%geometry%unitx = 'p'  ! pixels
    !
    call sic_r4(line,2,2,xdisplay%geometry%y,.true.,error)
    if (error) return
    xdisplay%geometry%unity = 'p'  ! pixels
  endif
  !
  ! 2) Prepare the directory
  xmargin = (cw_directory%gen%minmax(2)-cw_directory%gen%minmax(1))*margin
  ax = max(cw_directory%gen%minmax(1)-xmargin,0.)
  bx = min(cw_directory%gen%minmax(2)+xmargin,cw_directory%phys_size(1))
  !
  ymargin = (cw_directory%gen%minmax(4)-cw_directory%gen%minmax(3))*margin
  ay = max(cw_directory%gen%minmax(3)-ymargin,0.)
  by = min(cw_directory%gen%minmax(4)+ymargin,cw_directory%phys_size(2))
  !
  ! 3) Now create it. A new window will be attached to the output instances
  !    list:
  call get_free_slot_output(cw_output,error)
  if (error)  return
  cw_output%dev => cw_device      ! Point on the shared X-protocol instance
  cw_output%color = .true.
  if (backg.eq.-1) then
    ! Use the device default color
    cw_output%background = cw_output%dev%background
  else
    ! Override the device default color
    cw_output%background = backg
  endif
  cw_output%x = xdisplay
  !
  call create_window(cw_output,.false.,cw_directory,.true.,.true.,error)
  if (error)  return
  !
  ! 4) Set up the scaling for the new window, and redraw:
  call gtwindow(cw_output,ax,bx,ay,by)
  !
end subroutine gtl_create_window
!
subroutine create_window(output,first,dir,default,frommain,error)
  use gildas_def
  use gtv_buffers
  use gtv_graphic
  use gtv_interfaces, except_this=>create_window
  use gtv_protocol
  use gtv_tree
  use gtv_types
  use gbl_message
  !---------------------------------------------------------------------
  ! @ private
  !  Create a new window and register it in the GTV tree. If 'output'
  ! already knows a non-null graph_env, we assume the window as already
  ! been created and we only need to register it.
  ! ---
  !  Thread status: safe to call from main or graphic thread.
  !---------------------------------------------------------------------
  type(gt_display), intent(inout) :: output    ! Output instance
  logical,          intent(in)    :: first     ! Very first window of the device?
  type(gt_directory)              :: dir       ! Directory to which the window is attached
  logical,          intent(in)    :: default   ! Make it the default window of the directory?
  logical,          intent(in)    :: frommain  ! Call from main or graphic thread?
  logical,          intent(inout) :: error     ! Logical error flag
  ! Local
  character(len=*), parameter :: rname='CREATE WINDOW'
  integer(kind=address_length) :: graph_env
  character(len=32) :: argx,argy
  character(len=gtvpath_length) :: name,dirname
  integer :: ldir,geomx,geomy,posx,posy
  integer*4 :: win_num_c,win_num_user
  character(len=message_length) :: mess
  logical :: created
  !
  if (output%dev%protocol.eq.p_null) then
    ! No device, nothing to do
    return
    !
  elseif (output%dev%protocol.ne.p_x) then
    call gtv_message(seve%e,rname,'Not available for device other than X')
    error = .true.
    return
  endif
  !
  if (frommain) then
    call gtv_open_segments_for_writing_from_main()
  else
    call gtv_open_segments_for_writing_from_graph()
  endif
  !
  created = .false.
  !
  call cree_chemin_dir(dir,dirname,ldir)
  !
  ! Check if the maximum number of windows is reached
  if (dir%x%nbwin.ge.mwindows) then
    write(mess,'(A,I2,2A)') 'Can not attach more than ',mwindows,  &
      ' windows to directory ',dirname
    call gtv_message(seve%e,rname,mess)
    error = .true.
    goto 100
  endif
  !
  ! Compute the new window number (as seen by user)
  win_num_user = create_window_number(dir,error)
  if (error)  goto 100
  !
  if (output%x%graph_env.eq.0) then
    ! Create a new window.
    ! The name of the x window is the directory name and the window number,
    ! unless otherwise specified in the calling arguments
    if (output%x%name.eq.' ') then
      if (win_num_user.eq.1) then
        ! Hide the window number for window #1, most of users are not aware
        ! that a directory can have several windows.
        name = dirname
      else
        write(name,'(A,1X,I0)') trim(dirname),win_num_user
      endif
      output%x%name = name
    else
      name = output%x%name
    endif
    !
    ! WINDOW GEOMETRY
    if (output%x%geometry%x.le.0. .or. output%x%geometry%y.le.0.) then
      ! Try to use user's logical WINDOW_GEOMETRY
      call sic_getlog_coordinates('WINDOW_GEOMETRY',argx,argy,error)
      if (error)  goto 100
      call decode_coordinates(output%x%geometry,argx,argy,error)
      if (error)  goto 100
    endif
    if (output%x%geometry%x.le.0. .or. output%x%geometry%y.le.0.) then
      ! Use internal device default
      output%x%geometry%x = max(output%dev%px1,output%dev%px2)
      output%x%geometry%unitx = 'p'
      output%x%geometry%y = max(output%dev%py1,output%dev%py2)
      output%x%geometry%unity = 'p'
    endif
    ! Coordinates conversion
    call compute_coordinates_geometry(rname,output%x%geometry,geomx,geomy,error)
    if (error)  goto 100
    !
    if (dir%x%nbwin.eq.0) then
      ! This will be a new window in a directory with no windows.
      ! Create a new table for the addresses of the graphical environments,
      ! put the address of the table in the directory descriptor
      dir%x%genv_array = c_new_genv_array(mwindows)
    endif
    !
    ! Now create the window
    call createwindow(output%background,graph_env,name,geomx,geomy,  &
      dir,len_trim(name))
    output%x%graph_env = graph_env
    ! Store the actual size of the window
    call get_win_pixel_info(output%x%graph_env,output%px1,output%py1,  &
      output%px2,output%py2)
    !
    ! WINDOW POSITION
    if (first) then
      !  Try to read the logical WINDOW_POSITION, only for the first
      ! window of the device (else each new window will overlap the other
      ! ones)
      if (output%x%position%x.le.0. .or. output%x%position%y.le.0.) then
        ! Try to use user's logical WINDOW_POSITION
        call sic_getlog_coordinates('WINDOW_POSITION',argx,argy,error)
        if (error)  goto 100
        call decode_coordinates(output%x%position,argx,argy,error)
        if (error)  goto 100
      endif
    endif
    if (output%x%position%x.lt.0. .or. output%x%position%y.lt.0.) then
      ! No internal default! Let the window manager decide.
      continue
    else
      ! Coordinates conversion
      call compute_coordinates_position(output,posx,posy,error)
      if (error) then
        ! Ignore. Window position will be erroneous (only). And we have
        ! to finish its registration!
        error = .false.
      endif
      ! Move
      call x_move_window(output%x%graph_env,posx,posy)
    endif
    !
    created = .true.
  else
    ! The window already exists (e.g. the lens). Just store the actual
    ! size of the window
    call get_win_pixel_info(output%x%graph_env,output%px1,output%py1,  &
      output%px2,output%py2)
  endif
  !
  output%dev%hardw_cursor = .true.
  !
  ! If this is the (new) default window, put the address of the graphical
  ! environment in the directory descriptor
  if (default)  dir%x%genv = output%x%graph_env
  !
  ! Put the address of the graphical environment in the table of addresses for
  ! all the windows in the directory (the table is ordered by window number)
  win_num_c = dir%x%nbwin  ! C numbering starts from 0
  call c_set_win_genv(dir%x%genv_array,win_num_c,output%x%graph_env)
  !
  ! Set the window number, and the current window and the total number of
  ! windows in the directory descriptor
  output%x%number = win_num_user
  if (default)  dir%x%curwin = win_num_c
  dir%x%nbwin = dir%x%nbwin+1
  !
100 continue
  if (frommain) then
    call gtv_close_segments_for_writing_from_main()
  else
    call gtv_close_segments_for_writing_from_graph()
  endif
  !
  if (created)  call createwindow_wait()
  !
end subroutine create_window
!
function create_window_number(dir,error)
  use gtv_interfaces, except_this=>create_window_number
  use gtv_protocol
  use gtv_types
  !---------------------------------------------------------------------
  ! @ private
  !---------------------------------------------------------------------
  integer(kind=4) :: create_window_number     ! Function value on return
  type(gt_directory), intent(in)    :: dir    ! Parent directory
  logical,            intent(inout) :: error  ! Logical error flag
  ! Local
  type(gt_display), pointer :: output
  integer :: iwin,win_num(mwindows)
  !
  create_window_number = 0
  win_num = 0
  !
  do iwin=0,dir%x%nbwin-1
    call get_slot_output_by_num(dir,iwin,output,error)
    if (error)  return
    !
    win_num(output%x%number) = 1
  enddo
  !
  do iwin=1,mwindows
    if (win_num(iwin).eq.0) then
      create_window_number = iwin
      return
    endif
  enddo
  !
  error = .true.
  return
  !
end function create_window_number
!
subroutine decode_coordinates(xcoord,argx,argy,error)
  use gtv_interfaces, except_this=>decode_coordinates
  use gbl_message
  use gtv_types
  !---------------------------------------------------------------------
  ! @ private
  !
  !---------------------------------------------------------------------
  type(x_coordinates), intent(inout) :: xcoord  !
  character(len=*),    intent(in)    :: argx    ! X value
  character(len=*),    intent(in)    :: argy    ! Y value
  logical,             intent(inout) :: error  ! Logical error flag
  ! Local
  character(len=*), parameter :: rname='WINDOW'
  character(len=32) :: argum
  integer :: nc,ier
  !
  if (argx.ne.' ') then
    ! Read the X unit
    nc = len_trim(argx)
    if (argx(nc:nc).eq.'p' .or. argx(nc:nc).eq.'P' .or.  &
        argx(nc:nc).eq.'r' .or. argx(nc:nc).eq.'R' .or.  &
        argx(nc:nc).eq.'%') then
      xcoord%unitx = argx(nc:nc)
      argum = argx(1:nc-1)
    else
      xcoord%unitx = 'p'  ! Default is pixels
      argum = argx
    endif
    !
    ! Read the X value
    read (argum,*,iostat=ier) xcoord%x
    if (ier.ne.0) then
      call gtv_message(seve%e,rname,'Error decoding argument '''//trim(argx)//'''')
      error = .true.
      return
    endif
  endif
  !
  if (argy.ne.' ') then
    ! Read the Y unit
    nc = len_trim(argy)
    if (argy(nc:nc).eq.'p' .or. argy(nc:nc).eq.'P' .or.  &
        argy(nc:nc).eq.'r' .or. argy(nc:nc).eq.'R' .or.  &
        argy(nc:nc).eq.'%') then
      xcoord%unity = argy(nc:nc)
      argum = argy(1:nc-1)
    else
      xcoord%unity = 'p'  ! Default is pixels
      argum = argy
    endif
    !
    ! Read the Y value
    read (argum,*,iostat=ier) xcoord%y
    if (ier.ne.0) then
      call gtv_message(seve%e,rname,'Error decoding argument '''//trim(argy)//'''')
      error = .true.
      return
    endif
  endif
  !
end subroutine decode_coordinates
!
subroutine sic_getlog_coordinates(logic_in,argx,argy,error)
  use gtv_dependencies_interfaces
  use gtv_interfaces, except_this=>sic_getlog_coordinates
  use gbl_message
  !---------------------------------------------------------------------
  ! @ private
  !
  !---------------------------------------------------------------------
  character(len=*), intent(in)    :: logic_in  ! SIC logical
  character(len=*), intent(out)   :: argx      !
  character(len=*), intent(out)   :: argy      !
  logical,          intent(inout) :: error     ! Logical error flag
  ! Local
  character(len=*), parameter :: rname='SIC_GETLOG_COORD'
  character(len=32) :: logic
  integer(kind=4) :: ier
  !
  ! Default
  argx = ' '
  argy = ' '
  !
  ier = sic_getlog(logic_in,logic)
  if (ier.ne.0)  return  ! SIC LOGICAL is unset
  !
  read(logic,*,iostat=ier) argx,argy
  if (ier.ne.0) then
    call gtv_message(seve%e,rname,'Could not decode user-defined '//  &
      trim(logic_in)//' logical variable: '''//trim(logic)//'''')
    error = .true.
    return
  endif
  !
end subroutine sic_getlog_coordinates
!
subroutine compute_coordinates_geometry(rname,xcoord,npixx,npixy,error)
  use gtv_dependencies_interfaces
  use gtv_interfaces, except_this=>compute_coordinates_geometry
  use gbl_message
  use gtv_types
  !---------------------------------------------------------------------
  ! @ private
  !
  !---------------------------------------------------------------------
  character(len=*),    intent(in)    :: rname   ! Caller name
  type(x_coordinates), intent(in)    :: xcoord  !
  integer(kind=4),     intent(out)   :: npixx   !
  integer(kind=4),     intent(out)   :: npixy   !
  logical,             intent(inout) :: error   ! Logical error flag
  ! Local
  real(kind=4) :: x,y
  character(len=1) :: unitx,unity
  integer :: screenx,screeny
  !
  x     = xcoord%x
  unitx = xcoord%unitx
  y     = xcoord%y
  unity = xcoord%unity
  if (unitx.eq.'r' .and. unity.eq.'r') then
    call gtv_message(seve%e,rname,  &
      'Units can not be both ''ratio'' with /GEOMETRY')
    error = .true.
    return
  endif
  !
  call sic_lower(unitx)
  call sic_lower(unity)
  !
  if (unitx.eq.'%' .or. unity.eq.'%') then
    call x_screen_size(screenx,screeny)
    if (screenx.le.0 .or. screeny.le.0) then
      ! Most likely no screen (batch job) or GTK missing
      call gtv_message(seve%e,rname,  &
        'Could not retrieve screen size: % unit can not be used for device geometry')
      error = .true.
      return
    endif
  endif
  !
  ! X values:
  select case (unitx)
  case ('p')
    npixx = nint(x)
  case ('%')
    npixx = nint(screenx*x/100.)
  case ('r')
    continue  ! Will be set after npixy
  case (' ')
    call gtv_message(seve%e,rname,'Internal error: X unit value is unset')
    error = .true.
    return
  case default
    call gtv_message(seve%e,rname,'Unknown X unit '''//unitx//'''')
    error = .true.
    return
  end select
  !
  ! Y values:
  select case (unity)
  case ('p')
    npixy = nint(y)
  case ('%')
    npixy = nint(screeny*y/100.)
  case ('r')
    npixy = npixx * y
  case (' ')
    call gtv_message(seve%e,rname,'Internal error: Y unit value is unset')
    error = .true.
    return
  case default
    call gtv_message(seve%e,rname,'Unknown Y unit '''//unity//'''')
    error = .true.
    return
  end select
  !
  if (unitx.eq.'r')  npixx = npixy * x
  !
end subroutine compute_coordinates_geometry
!
subroutine compute_coordinates_position(output,npixx,npixy,error)
  use gtv_dependencies_interfaces
  use gtv_interfaces, except_this=>compute_coordinates_position
  use gbl_message
  use gtv_types
  !---------------------------------------------------------------------
  ! @ private
  !
  !---------------------------------------------------------------------
  type(gt_display), intent(inout) :: output  !
  integer(kind=4),  intent(out)   :: npixx   !
  integer(kind=4),  intent(out)   :: npixy   !
  logical,          intent(inout) :: error   ! Logical error flag
  ! Local
  character(len=*), parameter :: rname='CREATE WINDOW'
  real(kind=4) :: x,y
  character(len=1) :: unitx,unity
  integer :: screenx,screeny,windowx,windowy
  !
  x     = output%x%position%x
  unitx = output%x%position%unitx
  y     = output%x%position%y
  unity = output%x%position%unity
  windowx = output%px2
  windowy = output%py1
  if (unitx.eq.'r' .or. unity.eq.'r') then
    call gtv_message(seve%e,rname,  &
      'Units can not be ''ratio'' with /POSITION')
    error = .true.
    return
  endif
  !
  call sic_lower(unitx)
  call sic_lower(unity)
  !
  if (unitx.eq.'%' .or. unity.eq.'%' .or. unity.eq.'p') then
    call x_screen_size(screenx,screeny)
    if (screenx.le.0 .or. screeny.le.0) then
      ! Most likely no screen (batch job) or GTK missing
      call gtv_message(seve%e,rname,  &
        'Could not retrieve screen size: % or p unit can not be used for device position')
      error = .true.
      return
    endif
  endif
  !
  ! X values:
  select case (unitx)
  case ('p')
    npixx = nint(x)
  case ('%')
    npixx = nint(screenx*x/100. - windowx*x/100.)
  case ('r')
    continue  ! Will be set after npixy
  case (' ')
    call gtv_message(seve%e,rname,'Internal error: X unit value is unset')
    error = .true.
    return
  case default
    call gtv_message(seve%e,rname,'Unknown X unit '''//unitx//'''')
    error = .true.
    return
  end select
  !
  ! Y values:
  select case (unity)
  case ('p')
    y = screeny-y
    npixy = nint(y - windowy)
  case ('%')
    y = 100.-y
    npixy = nint(screeny*y/100. - windowy*y/100.)
  case ('r')
    npixy = npixx * y
  case (' ')
    call gtv_message(seve%e,rname,'Internal error: Y unit value is unset')
    error = .true.
    return
  case default
    call gtv_message(seve%e,rname,'Unknown Y unit '''//unity//'''')
    error = .true.
    return
  end select
  !
  if (unitx.eq.'r')  npixx = npixy * x
  !
end subroutine compute_coordinates_position
