!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubetopology_spapos_types
  use cubetools_parameters
  use cubetools_structure
  use cubetools_axis_types
  use cubetools_spapro_types
  use cubetools_keywordlist_types
  use cubetopology_messaging
  !
  public :: spapos_comm_t,spapos_user_t,spapos_prog_t
  private
  !
  ! Coordinate types
  character(len=8), parameter :: ctypes(3) = [strg_star//'       ','relative','absolute']
  !
  type spapos_comm_t
     type(option_t),           pointer, private :: comm
     type(keywordlist_comm_t), pointer, private :: ctype
   contains
     procedure, public :: register => cubetopology_spapos_comm_register
     procedure, public :: parse    => cubetopology_spapos_comm_parse
  end type spapos_comm_t
  !
  type spapos_user_t
     logical,               public  :: present = .false. ! Present or absent?
     character(len=argu_l), private :: x = strg_star     ! Position along x-axis
     character(len=argu_l), private :: y = strg_star     ! Position along y-axis
     character(len=argu_l), private :: type = strg_star  ! Absolute or relative coordinates?
     character(len=argu_l), private :: unit = strg_star  ! Position unit, context dependent
   contains
     procedure, public  :: init   => cubetopology_spapos_user_init
     procedure, public  :: toprog => cubetopology_spapos_user_toprog
     procedure, public  :: list   => cubetopology_spapos_user_list
  end type spapos_user_t
  !
  !***JP: This could be a generic pixel_t
  type spapos_prog_t
     type(spapro_t), pointer, private :: spapro => null() ! Cube spatial projection
     type(axis_t),   pointer, private :: xaxis  => null() ! Cube X axis
     type(axis_t),   pointer, private :: yaxis  => null() ! Cube Y axis
     real(kind=coor_k),       public  :: p(2) = 0d0       ! [pix|chan] Values
   contains
     procedure, public :: nearest_pixel      => cubetopology_spapos_prog_nearest_pixel
     procedure, public :: nearest_entry      => cubetopology_spapos_prog_nearest_entry
     procedure, public :: offset             => cubetopology_spapos_prog_offset
     procedure, public :: absolute           => cubetopology_spapos_prog_absolute
     procedure, public :: axes_are_projected => cubetopology_spapos_prog_axes_are_projected
     procedure, public :: list               => cubetopology_spapos_prog_list
     procedure, public :: userstruct         => cubetopology_spapos_prog_userstruct
  end type spapos_prog_t
  !
contains
  !
  subroutine cubetopology_spapos_comm_register(comm,name,abstract,error)
    !------------------------------------------------------------------------
    !
    !------------------------------------------------------------------------
    class(spapos_comm_t), intent(out)   :: comm
    character(len=*),     intent(in)    :: name
    character(len=*),     intent(in)    :: abstract
    logical,              intent(inout) :: error
    !
    type(standard_arg_t) :: stdarg
    type(keywordlist_comm_t)  :: wordlistarg
    character(len=*), parameter :: rname='SPAPOS>COMM>REGISTER'
    !
    call cubetopology_message(toposeve%trace,rname,'Welcome')
    !
    call cubetools_register_option(&
         name,'xpos ypos type [unit]',&
         abstract,&
         'Describe a position in terms of relative or absolute&
         & coordinates. In case of relative coordinates they are&
         & relative to the current projection center, the possible&
         & units for a relative position are FOV units. Absolute&
         & positions can be given in three possible units: Equatorial&
         & (sexagesimal strings in the current spatial frame), Radian&
         & or Degree.',&
         comm%comm,&
         error)
    if (error) return
    call stdarg%register(&
         'xpos',&
         'Position along the X coordinate',&
         '"*" uses projection-center coordinate for absolute coordinates, ie,&
         & x = 0 for relative coordinates.',&
         code_arg_mandatory,&
         error)
    if (error) return
    call stdarg%register(&
         'ypos',&
         'Position along the Y coordinate',&
         '"*" uses projection-center coordinate for absolute coordinates, ie,&
         & y = 0 for relative coordinates.',&
         code_arg_mandatory,&
         error)
    if (error) return
    call wordlistarg%register(&
         'type',&
         'Coordinate type',&
         '"*", "relative", or "absolute" are accepted tokens. "*" is equivalent to&
         & relative coordinates.',&
         code_arg_mandatory,&
         ctypes,&
         .not.flexible,&
         comm%ctype,&
         error)
    if (error) return
    call stdarg%register(&
         'unit',&
         'Unit for xpos and ypos',&
         'Available units depend on the coordinate type:'//strg_cr//&
         '- FOV units for relative coordinates,'//strg_cr//&
         '- equatorial (i.e. sexagesimal hour angles and degrees if&
         & equatorial system, both sexagesimal degrees if galactic system),&
         & degrees or radians for absolute coordinates.',&
         code_arg_optional,&
         error)
    if (error) return
  end subroutine cubetopology_spapos_comm_register
  !
  subroutine cubetopology_spapos_comm_parse(comm,line,user,error)
    !----------------------------------------------------------------------
    ! /POS x y type [unit]
    !----------------------------------------------------------------------
    class(spapos_comm_t), intent(in)    :: comm
    character(len=*),     intent(in)    :: line
    type(spapos_user_t),  intent(out)   :: user  ! intent(out) => Initialized
    logical,              intent(inout) :: error
    !
    character(len=*), parameter :: rname='SPAPOS>PARSE'
    !
    call cubetopology_message(toposeve%trace,rname,'Welcome')
    !
    call comm%comm%present(line,user%present,error)
    if (error) return
    if (user%present) then
       call cubetools_getarg(line,comm%comm,1,user%x,mandatory,error)
       if (error) return
       call cubetools_getarg(line,comm%comm,2,user%y,mandatory,error)
       if (error) return
       call cubetools_getarg(line,comm%comm,3,user%type,mandatory,error)
       if (error) return
       call cubetools_getarg(line,comm%comm,4,user%unit,.not.mandatory,error)
       if (error) return
    endif
  end subroutine cubetopology_spapos_comm_parse
  !
  !------------------------------------------------------------------------
  !
  subroutine cubetopology_spapos_user_init(user,error)
    !----------------------------------------------------------------------
    ! Initialize by setting the intent of user to out
    !----------------------------------------------------------------------
    class(spapos_user_t), intent(out)   :: user 
    logical,              intent(inout) :: error
    !
    character(len=*), parameter :: rname='SPAPOS>USER>INIT'
    !
    call cubetopology_message(toposeve%trace,rname,'Welcome')
  end subroutine cubetopology_spapos_user_init
  !
  subroutine cubetopology_spapos_user_toprog(user,cube,prog,error)
    use cubetuple_format_class
    use cubetools_header_methods
    use cubetools_disambiguate
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(spapos_user_t), intent(in)    :: user
    class(format_t),      intent(in)    :: cube
    type(spapos_prog_t),  intent(inout) :: prog
    logical,              intent(inout) :: error
    !
    integer(kind=4) :: ikey
    character(len=12) :: type
    character(len=*), parameter :: rname='SPAPOS>USER>TOPROG'
    !
    call cubetopology_message(toposeve%trace,rname,'Welcome')
    !
    call cubetools_header_point2spapro(cube%head,prog%spapro,error)
    if (error) return
    call cubetools_header_point2axis(cube%head%set%il,cube%head,prog%xaxis,error)
    if (error) return
    call cubetools_header_point2axis(cube%head%set%im,cube%head,prog%yaxis,error)
    if (error) return
    !
    call cubetools_disambiguate_strict(user%type,ctypes,ikey,type,error)
    if (error) return
    select case(type)
    case (strg_star,'RELATIVE')
       call user_toprog_relative(user,prog,error)
       if (error) return
    case ('ABSOLUTE')
       call user_toprog_absolute(user,prog,error)
       if (error) return
    case default
       call cubetopology_message(seve%e,rname,'Unknown coordinate type: '//trim(type))
       error = .true.
       return
    end select
    !
  contains
    !
    subroutine user_toprog_absolute(user,prog,error)
      use gkernel_interfaces
      use cubetools_user2prog
      use cubetools_unit
      !----------------------------------------------------------------------
      !
      !----------------------------------------------------------------------
      type(spapos_user_t), intent(in)    :: user
      type(spapos_prog_t), intent(inout) :: prog
      logical,             intent(inout) :: error
      !
      integer(kind=4) :: ival
      real(kind=coor_k) :: absolute(2),offset(2)
      type(unit_user_t) :: userunit
      character(len=unit_l) :: unit
      character(len=*), parameter :: units(4)=&
           [strg_star//'         ','equatorial','radian    ','degree    ']
      integer(kind=ndim_k), parameter :: ix=1,iy=2
      character(len=*), parameter :: rname='USER>TOPROG>ABSOLUTE'
      !
      call cubetopology_message(toposeve%trace,rname,'Welcome')
      !
      ! Get absolute position
      call cubetools_disambiguate_strict(user%unit,units,ival,unit,error)
      if (error) return
      select case(unit)
      case(strg_star,'EQUATORIAL')
         call sic_decode(user%x,absolute(ix),24,error)
         if (error) return
         call sic_decode(user%y,absolute(iy),360,error)
         if (error) return
      case('RADIAN','DEGREE')
         ! Unit is pang because we need either radian or degree
         call userunit%get_from_name_for_code(unit,code_unit_pang,error)
         if (error) return
         call cubetools_user2prog_resolve_star(user%x,userunit,prog%spapro%l0,absolute(ix),error)
         if (error) return
         call cubetools_user2prog_resolve_star(user%y,userunit,prog%spapro%m0,absolute(iy),error)
         if (error) return      
      case default
         call cubetopology_message(seve%e,rname,'Unknown unit type: '//trim(unit))
         error = .true.
         return
      end select
      ! From absolute to fractional pixel
      call prog%spapro%absolute2offset(absolute,offset,error)
      if (error) return
      call prog%xaxis%offset2pixel(offset(ix),prog%p(ix),error)
      if (error) return
      call prog%yaxis%offset2pixel(offset(iy),prog%p(iy),error)
      if (error) return
    end subroutine user_toprog_absolute
    !
    subroutine user_toprog_relative(user,prog,error)
      !----------------------------------------------------------------------
      !
      !----------------------------------------------------------------------
      type(spapos_user_t), intent(in)    :: user
      type(spapos_prog_t), intent(inout) :: prog
      logical,             intent(inout) :: error
      !
      integer(kind=ndim_k), parameter :: ix=1,iy=2
      character(len=*), parameter :: rname='USER>TOPROG>RELATIVE'
      !
      call cubetopology_message(toposeve%trace,rname,'Welcome')
      !
      call user_toprog_relative_for_axis(prog%xaxis,user%unit,user%x,prog%p(ix),error)
      if (error) return
      call user_toprog_relative_for_axis(prog%yaxis,user%unit,user%y,prog%p(iy),error)
      if (error) return
    end subroutine user_toprog_relative
    !
    subroutine user_toprog_relative_for_axis(axis,userunit,userval,progpix,error)
      use cubetools_unit
      use cubetools_user2prog
      use cubetools_axis_types
      !----------------------------------------------------------------------
      ! If it is covered by the cube, default position is the reference pixel.
      ! Else default position is the center of the axis
      !----------------------------------------------------------------------
      type(axis_t),      intent(inout) :: axis
      character(len=*),  intent(in)    :: userunit      
      character(len=*),  intent(in)    :: userval
      real(kind=coor_k), intent(out)   :: progpix
      logical,           intent(inout) :: error
      !
      type(unit_user_t) :: default_unit,user_unit
      real(kind=coor_k) :: default,offset
      !
      ! Default value
      if (axis%inside(0.d0)) then
         ! Reference pixel when inside
         default = axis%ref
      else
         ! Axis center else
         default = 0.5d0*axis%n
      endif
      !
      !***JP: This code block is identical to the one in cubetopology_sperange_user_toprog
      ! Default unit will depend on the axis kind
      call default_unit%get_from_code(axis%kind,error)
      if (error) return
      ! Get user unit from user input
      call user_unit%get_from_name(userunit,error)
      if (error) return
      !
      select case(user_unit%kind%code)
      case(code_unit_chan,code_unit_pixe)
         ! Directly resolve
         call cubetools_user2prog_resolve_star(userval,user_unit,default,progpix,error)
         if (error) return
      case(code_unit_unk)
         ! Use default axis unit
         ! 1. Convert default values from pixel to offset
         call cubetools_axis_pixel2offset(axis,default,default,error)
         if (error) return
         ! 2. Resolve between user and default values taking into account the user2prog unit conversion
         call cubetools_user2prog_resolve_star(userval,default_unit,default,offset,error)
         if (error) return
         ! 3. Convert back from offset to pixel
         call cubetools_axis_offset2pixel(axis,offset,progpix,error)
         if (error) return
      case default
         ! Check whether user and default units are consistent
         call user_unit%is_consistent_with(default_unit,error)
         if (error) return
         ! If yes, use them
         ! 1. Convert default values from pixel to offset
         call cubetools_axis_pixel2offset(axis,default,default,error)
         if (error) return
         ! 2. Resolve between user and default values taking into account the user2prog unit conversion
         call cubetools_user2prog_resolve_star(userval,user_unit,default,offset,error)
         if (error) return
         ! Convert back from offset to pixel
         call cubetools_axis_offset2pixel(axis,offset,progpix,error)
         if (error) return
      end select
      !***JP: This code block is identical to the one in cubetopology_sperange_user_toprog       
    end subroutine user_toprog_relative_for_axis
  end subroutine cubetopology_spapos_user_toprog
  !
  subroutine cubetopology_spapos_user_list(user,error)
    !----------------------------------------------------------------------
    ! Mostly for debugging
    !----------------------------------------------------------------------
    class(spapos_user_t), intent(in)    :: user 
    logical,              intent(inout) :: error
    !
    character(len=mess_l) :: mess
    character(len=*), parameter :: rname='SPAPOS>USER>LIST'
    !
    call cubetopology_message(toposeve%trace,rname,'Welcome')
    !
    write(mess,'(6a,x,a)') &
         'Position  : (',trim(user%x),',',trim(user%y),') ',&
         trim(user%type),trim(user%unit)
    call cubetopology_message(seve%r,rname,mess)
  end subroutine cubetopology_spapos_user_list
  !
  !------------------------------------------------------------------------
  !
  function cubetopology_spapos_prog_nearest_pixel(prog) result(pixel)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(spapos_prog_t), intent(in) :: prog
    integer(kind=pixe_k)             :: pixel(2) ! intent(out)
    !
    !***JP: Is there something cleverer in the axis type?
    pixel = nint(prog%p)
  end function cubetopology_spapos_prog_nearest_pixel
  !
  function cubetopology_spapos_prog_nearest_entry(prog) result(ie)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(spapos_prog_t), intent(in) :: prog
    integer(kind=entr_k)             :: ie   ! intent(out)
    !
    integer(kind=pixe_k) :: pix,piy
    integer(kind=ndim_k), parameter :: ix=1,iy=2
    !
    pix = nint(prog%p(ix))
    piy = nint(prog%p(iy))
    if ( (pix.lt.1).or.(pix.gt.prog%xaxis%n).or. &
         (piy.lt.1).or.(piy.gt.prog%yaxis%n) ) then
       ie = 0
    else
       ie = pix + (piy-1)*prog%xaxis%n
    endif    
  end function cubetopology_spapos_prog_nearest_entry
  !
  subroutine cubetopology_spapos_prog_offset(prog,offset,error)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(spapos_prog_t), intent(in)    :: prog
    real(kind=coor_k),    intent(out)   :: offset(2) ! [rad]
    logical,              intent(inout) :: error
    !
    integer(kind=ndim_k), parameter :: ix=1,iy=2
    !
    call cubetools_axis_pixel2offset(prog%xaxis,prog%p(ix),offset(ix),error)
    if (error) return
    call cubetools_axis_pixel2offset(prog%yaxis,prog%p(iy),offset(iy),error)
    if (error) return
  end subroutine cubetopology_spapos_prog_offset
  !
  subroutine cubetopology_spapos_prog_absolute(prog,absolute,error)
    !----------------------------------------------------------------------
    ! Convert to absolute coordinates when possible
    !----------------------------------------------------------------------
    class(spapos_prog_t), intent(in)    :: prog
    real(kind=coor_k),    intent(out)   :: absolute(2) ! [rad]
    logical,              intent(inout) :: error
    !
    integer(kind=ndim_k), parameter :: ix=1,iy=2
    character(len=*), parameter :: rname='SPAPOS>PROG>ABSOLUTE'
    !
    if ((prog%p(ix).eq.prog%xaxis%ref).and.(prog%p(iy).eq.prog%yaxis%ref)) then
       ! Straightforward, and support any projection including non
       ! supported ones, or NONE.
       absolute(ix) = prog%spapro%l0
       absolute(iy) = prog%spapro%m0
    else
       call prog%spapro%offset2absolute(prog%p,absolute,error)
       if (error) return
    endif
  end subroutine cubetopology_spapos_prog_absolute
  !
  function cubetopology_spapos_prog_axes_are_projected(prog,severity) result(projected)
    use cubetools_unit, only: code_unit_fov
    !----------------------------------------------------------------------
    ! Check whether X and Y axes are genuinely projected axes.
    !----------------------------------------------------------------------
    class(spapos_prog_t), intent(in) :: prog
    integer(kind=code_k), intent(in) :: severity
    logical                          :: projected ! intent(out)
    !
    character(len=*), parameter :: rname='SPAPOS>PROG>ABSOLUTE'
    !
    projected = (prog%xaxis%kind.eq.code_unit_fov).and.(prog%yaxis%kind.eq.code_unit_fov)
    if (.not.projected) call cubetopology_message(severity,rname,&
         'Spatial axes are not projected => absolute coordinates are unavailable')
  end function cubetopology_spapos_prog_axes_are_projected
  !
  subroutine cubetopology_spapos_prog_list(prog,error)
    use cubetools_unit
    use cubetools_format
    !----------------------------------------------------------------------
    ! User feedback
    !----------------------------------------------------------------------
    class(spapos_prog_t), intent(in)    :: prog 
    logical,              intent(inout) :: error
    !
    type(unit_user_t) :: unit
    real(kind=coor_k) :: offset(2),absolute(2)
    character(len=mess_l) :: mess
    character(len=*), parameter :: rname='SPAPOS>PROG>LIST'
    !
    call cubetopology_message(toposeve%trace,rname,'Welcome')
    !
    if (prog%axes_are_projected(seve%d)) then
       call prog%absolute(absolute,error)
       if (error) return
       call cubetools_format_radec(absolute,mess,error)
       if (error) return
       call cubetopology_message(seve%r,rname,mess)
    else
       !***JP: The following is not generic enough. We should take into account
       !***JP: the axis unit in case it's not a fov!
       call unit%get_from_code(code_unit_fov,error)
       if (error) return
       call prog%offset(offset,error)
       if (error) return
       offset = offset*unit%user_per_prog    
       call cubetools_format_offset(offset,unit%name,mess,error)
       if (error) return
       call cubetopology_message(seve%r,rname,mess)
    endif
  end subroutine cubetopology_spapos_prog_list
  !
    subroutine cubetopology_spapos_prog_userstruct(prog,name,error)
    use cubetools_unit
    use cubetools_userspace
    use cubetools_userstruct
    !---------------------------------------------------------------------
    !***JP: The following is not generic enough. We should take into account
    !***JP: the axis unit in case it's not a fov!
    !---------------------------------------------------------------------
    class(spapos_prog_t), intent(in)    :: prog
    character(len=*),     intent(in)    :: name
    logical,              intent(inout) :: error
    !
    real(kind=coor_k) :: offset(2)
    type(unit_user_t) :: unit
    type(userstruct_t) :: userstruct
    integer(kind=ndim_k), parameter :: ix=1
    integer(kind=ndim_k), parameter :: iy=2
    character(len=*), parameter :: rname='SPAPOS>PROG>USERSTRUCT'
    !
    call cubetopology_message(toposeve%trace,rname,'Welcome')
    !
    call unit%get_from_code(code_unit_fov,error)
    if (error) return
    call prog%offset(offset,error)
    if (error) return
    offset = offset*unit%user_per_prog
    call userstruct%create(name,global,overwrite_prog,error)
    if (error) return
    call userstruct%set_member('x',offset(ix),error)
    if (error) return
    call userstruct%set_member('y',offset(iy),error)
    if (error) return
    call userstruct%set_member('type','relative',error)
    if (error) return
    call userstruct%set_member('unit',unit%name,error)
    if (error) return
  end subroutine cubetopology_spapos_prog_userstruct
end module cubetopology_spapos_types
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
