!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
! *** JP For historical reasons, center is still used in some places
! *** JP As a matter of fact, this is a more generic notion of spatial position
! *** JP It could be a center or something else.
! *** JP Where center is still hardtyped, we should have the possibility to customize
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubetopology_spapos_types
  use cubetools_parameters
  use cubetools_structure
  use cubetools_keywordlist_types
  use cubetopology_messaging
  !
  public :: spapos_comm_t,spapos_user_t,spapos_prog_t
  private
  !
  character(len=8), parameter :: ctypes(3) = [strg_star//'       ','Relative','Absolute']
  !
  type spapos_comm_t
     type(option_t),           pointer, private :: key
     type(keywordlist_comm_t), pointer, private :: coortype
   contains
     procedure, public :: register => cubetopology_spapos_register
     procedure, public :: parse    => cubetopology_spapos_parse
  end type spapos_comm_t
  !
  type spapos_user_t
      ! ***JP: Most of these ones are misused. They should be private
     logical,               public :: present = .false. ! Present or absent?
     character(len=argu_l), public :: x = strg_star     ! Position along x-axis
     character(len=argu_l), public :: y = strg_star     ! Position along y-axis
     character(len=argu_l), public :: type = strg_star  ! Absolute or relative coordinates?
     character(len=argu_l), public :: unit = strg_star  ! Position unit, context dependent
   contains
     procedure, public  :: init        => cubetopology_spapos_user_init
     procedure, public  :: from_line   => cubetopology_spapos_user_from_line
     procedure, public  :: toprog      => cubetopology_spapos_user_toprog
     procedure, private :: toprog_rela => cubetopology_spapos_user_toprog_rela
     procedure, private :: toprog_abso => cubetopology_spapos_user_toprog_abso
     procedure, public  :: list        => cubetopology_spapos_user_list
  end type spapos_user_t
  !
  !***JP: The spapos_prog_t is too simple or too complex. It should only
  !***JP: have the absolute coordinates in radian, and methods to convert
  !***JP: to relative, frac, pixe, ie, depending on the image to which the
  !***JP: absolute coordinates are applied.
  type spapos_prog_t
     real(kind=coor_k),    public :: abso(2) = (/ 0d0,0d0 /) ! [rad]
     real(kind=coor_k),    public :: rela(2) = (/ 0d0,0d0 /) ! [rad]
     real(kind=coor_k),    public :: frac(2) = (/ 0d0,0d0 /) ! Pixel fractional position
     integer(kind=pixe_k), public :: pixe(2) = (/   0,0   /) ! Nearest integer pixel
     integer(kind=entr_k), public :: ie                      ! Closest Matching entry
   contains
     procedure :: list => cubetopology_spapos_prog_list
  end type spapos_prog_t
  !
contains
  !
  subroutine cubetopology_spapos_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)  :: keyarg
    character(len=*), parameter :: rname='SPAPOS>REGISTER'
    !
    call cubetopology_message(toposeve%trace,rname,'Welcome')
    !
    call cubetools_register_option(&
         name,'lpos mpos 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%key,error)
    if (error) return
    call stdarg%register(&
         'lpos',&
         'Position in L coordinate',&
          '"*" or "=" mean current projection center',&
          code_arg_mandatory,error)
    if (error) return
    call stdarg%register(&
         'mpos',&
         'Position in m coordinate',&
         '"*" or "=" mean current projection center',&
         code_arg_mandatory,&
         error)
    if (error) return
    call keyarg%register(&
         'type',&
         'Coordinates type',&
         strg_id,&
         code_arg_mandatory,&
         ctypes,&
         .not.flexible,&
         comm%coortype,&
         error)
    if (error) return
    call stdarg%register(&
         'unit',&
         'Unit for lpos and mpos',&
         'Available units depend on center type:'//strg_cr//&
         '- FOV units for relative,'//strg_cr//&
         '- equatorial (i.e. sexagesimal hour angles and degrees if &
         &equatorial system, both sexagesimal degrees if galactic system), &
         &degrees or radians for absolute.',&
         code_arg_optional, error)
    if (error) return
  end subroutine cubetopology_spapos_register
  !
  subroutine cubetopology_spapos_parse(comm,line,user,error)
    !----------------------------------------------------------------------
    ! /POS l m type [unit]
    !----------------------------------------------------------------------
    class(spapos_comm_t), intent(in)    :: comm
    character(len=*),     intent(in)    :: line
    type(spapos_user_t),  intent(out)   :: user
    logical,              intent(inout) :: error
    !
    character(len=*), parameter :: rname='SPAPOS>PARSE'
    !
    call cubetopology_message(toposeve%trace,rname,'Welcome')
    !
    user%x = strg_star
    user%y = strg_star
    user%type = strg_star
    user%unit = strg_star    
    !
    call comm%key%present(line,user%present,error)
    if (error) return
    if (user%present) then
       call cubetools_getarg(line,comm%key,1,user%x,mandatory,error)
       if (error) return
       call cubetools_getarg(line,comm%key,2,user%y,mandatory,error)
       if (error) return
       call cubetools_getarg(line,comm%key,3,user%type,mandatory,error)
       if (error) return
       call cubetools_getarg(line,comm%key,4,user%unit,.not.mandatory,error)
       if (error) return
    endif
  end subroutine cubetopology_spapos_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_from_line(user,line,error)
    use gkernel_interfaces
    !----------------------------------------------------------------------
    ! ***JP: SIC parsing code should not be here but in cubetools
    !----------------------------------------------------------------------
    class(spapos_user_t), intent(out)   :: user
    character(len=*),     intent(in)    :: line
    logical,              intent(inout) :: error
    !
    character(len=mess_l) :: mess
    character(len=100) :: reline
    integer(kind=4) :: pos,len,nc
    character(len=*), parameter :: rname='SPAPOS>USER>FROM_LINE'
    !
    call cubetopology_message(toposeve%trace,rname,'Welcome')
    !
    pos = 1
    reline=trim(adjustl(line))
    len = len_trim(reline)
    if (len.eq.0) then
       call cubetopology_message(seve%e,rname,'Line is empty')
       error = .true.
       return
    endif
    call sic_next(reline(pos:len),user%x,nc,pos)
    if (pos.ge.len) then
       error = .true.
       mess = 'Only 1 argument, at least 3 expected'
       goto 10
    endif
    call sic_next(reline(pos:len),user%y,nc,pos,dotab=.true.)
    if (pos.ge.len) then
       error = .true.
       mess = 'Only 2 arguments, at least 3 expected'
       goto 10
    endif
    if (pos.lt.len) call sic_next(reline(pos:len),user%type,nc,pos,dotab=.true.)
    if (pos.lt.len) call sic_next(reline(pos:len),user%unit,nc,pos,dotab=.true.)
10  if (error) then
       call cubetopology_message(seve%e,rname,mess)
       call cubetopology_message(seve%e,rname,'Offending line:')
       call cubetopology_message(seve%r,rname,'  '//line)
       return
    endif
    user%present = .true.
  end subroutine cubetopology_spapos_user_from_line
  !
  subroutine cubetopology_spapos_user_toprog(user,cube,prog,error)
    use cubetuple_format
    use cubetools_shape_types
    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(out)   :: prog
    logical,              intent(inout) :: error
    !
    type(shape_t) :: n
    integer(kind=4) :: ikey
    character(len=12) :: type
    character(len=*), parameter :: rname='SPAPOS>USER>TOPROG'
    !
    call cubetopology_message(toposeve%trace,rname,'Welcome')
    !
    if (user%present) then
       call cubetools_disambiguate_strict(user%type,ctypes,ikey,type,error)
       if (error) return
       select case(type)
       case('ABSOLUTE')
          call user%toprog_abso(cube,prog,error)
          if (error) return
       case(strg_star,'RELATIVE')
          call user%toprog_rela(cube,prog,error)
          if (error) return
       end select      
    else
       prog%rela(:) = 0d0
       call user%toprog_rela(cube,prog,error)
       if (error) return
    endif
    !
    ! Get pixel values
    call cubetools_header_spatial_offset2pixel(cube%head,prog%rela,prog%frac,error)
    if (error) return
    prog%pixe(:) = nint(prog%frac(:))
    call cubetools_header_get_array_shape(cube%head,n,error)
    if (error) return
    prog%ie = prog%pixe(1)+(prog%pixe(2)-1)*n%l
  end subroutine cubetopology_spapos_user_toprog
  !
  subroutine cubetopology_spapos_user_toprog_abso(user,cube,prog,error)
    use gkernel_interfaces
    use gkernel_types
    use cubetuple_format
    use cubetools_header_interface
    use cubetools_user2prog
    use cubetools_disambiguate
    use cubetools_unit
    use cubetools_spapro_types
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(spapos_user_t), intent(in)    :: user
    class(format_t),      intent(in)    :: cube
    type(spapos_prog_t),  intent(out)   :: prog
    logical,              intent(inout) :: error
    !
    type(projection_t) :: gproj
    type(unit_user_t) :: posunit
    character(len=unit_l) :: unit
    integer(kind=4) :: ikey
    character(len=*), parameter :: units(4)=&
         [strg_star//'         ','Equatorial','Radian    ','Degree    ']
    character(len=*), parameter :: rname='SPAPOS>USER>TOPROG>ABSO'
    !
    call cubetopology_message(toposeve%trace,rname,'Welcome')
    !
    call cubetools_disambiguate_strict(user%unit,units,ikey,unit,error)
    if (error) return
    select case(unit)
    case(strg_star,'EQUATORIAL') ! Use sic_decode
       select case(cube%head%spa%fra%code)
       case(code_spaframe_equatorial,code_spaframe_icrs)
          call sic_decode(user%x,prog%abso(1),24,error)
          if (error) return
       case (code_spaframe_galactic)
          call sic_decode(user%x,prog%abso(1),360,error)
          if (error) return
       case default
          call cubetopology_message(seve%e,rname,'Unknown spatial frame code')
          error = .true.
          return
       end select
       call sic_decode(user%y,prog%abso(2),360,error)
       if (error) return
    case('RADIAN','DEGREE')
       ! Unit is Pang because we need either Radian or Degree
       call posunit%get_from_name_for_code(unit,code_unit_pang,error)
       if (error) return
       call cubetools_user2prog_resolve_star(user%x,posunit,cube%head%spa%pro%l0,prog%abso(1),error)
       if (error) return
       call cubetools_user2prog_resolve_star(user%y,posunit,cube%head%spa%pro%m0,prog%abso(2),error)
       if (error) return      
    end select
    !
    ! Convert to relative
    if ((prog%abso(1).eq.cube%head%spa%pro%l0).and.  &
        (prog%abso(2).eq.cube%head%spa%pro%m0)) then
       ! Straightforward, and support any projection including non supported ones, or NONE.
       prog%rela(1) = 0.d0
       prog%rela(2) = 0.d0
    else
       call cubetools_spapro_gwcs(cube%head%spa%pro,gproj,error)
       if (error) return
       call abs_to_rel(gproj,prog%abso(1),prog%abso(2),prog%rela(1),prog%rela(2),1)
    endif
  end subroutine cubetopology_spapos_user_toprog_abso
  !
  subroutine cubetopology_spapos_user_toprog_rela(user,cube,prog,error)
    use gkernel_interfaces
    use gkernel_types
    use cubetuple_format
    use cubetools_spapro_types
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    class(spapos_user_t), intent(in)    :: user
    class(format_t),      intent(in)    :: cube
    type(spapos_prog_t),  intent(out)   :: prog
    logical,              intent(inout) :: error
    !
    integer(kind=4), parameter :: ix = 1
    integer(kind=4), parameter :: iy = 2
    type(projection_t) :: gproj
    character(len=*), parameter :: rname='SPAPOS>USER>TOPROG>RELA'
    !
    call cubetopology_message(toposeve%trace,rname,'Welcome')
    !
    call coord_user2prog(cube%head%spa%l,user%unit,user%x,prog%rela(ix),error)
    if (error) return
    call coord_user2prog(cube%head%spa%m,user%unit,user%y,prog%rela(iy),error)
    if (error) return
    !
    ! Convert to absolute
    if ((prog%rela(ix).eq.0.d0).and.(prog%rela(iy).eq.0.d0)) then
       ! Straightforward, and support any projection including non
       ! supported ones, or NONE.
       prog%abso(ix) = cube%head%spa%pro%l0
       prog%abso(iy) = cube%head%spa%pro%m0
    else
       call cubetools_spapro_gwcs(cube%head%spa%pro,gproj,error)
       if (error) return
       call rel_to_abs(gproj,&
            prog%rela(ix),prog%rela(iy),&
            prog%abso(ix),prog%abso(iy),1)
    endif
    !
  contains
    !
    subroutine coord_user2prog(axis,userunit,userval,progval,error)
      use cubetools_unit
      use cubetools_user2prog
      use cubetools_axis_types
      !----------------------------------------------------------------------
      ! If it is covered by the cube, default position is (0,0).
      ! Else center of the covered field of view.
      !----------------------------------------------------------------------
      type(axis_t),      intent(inout) :: axis
      character(len=*),  intent(in)    :: userunit      
      character(len=*),  intent(in)    :: userval
      real(kind=coor_k), intent(out)   :: progval
      logical,           intent(inout) :: error
      !
      real(kind=coor_k) :: default
      type(unit_user_t) :: unit
      !
      ! ***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_name_for_code(userunit,code_unit_fov,error)
      if (error) return
      !
      ! Default in prog unit as per the cubetools_user2prog_resolve_star_r8 API
      if (axis%inside(0.d0)) then
         default = 0d0
      else
         default = (axis%get_min()+axis%get_max())/2.d0
      endif
      !
      call cubetools_user2prog_resolve_star(userval,unit,default,progval,error)
      if (error) return
    end subroutine coord_user2prog
  end subroutine cubetopology_spapos_user_toprog_rela
  !
  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
  !
  !------------------------------------------------------------------------
  !
  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)
    character(len=mess_l) :: mess
    character(len=*), parameter :: rname='SPAPOS>PROG>LIST'
    !
    call cubetopology_message(toposeve%trace,rname,'Welcome')
    !
    !***JP: Not generic enough
    call cubetools_format_radec(prog%abso,mess,error)
    if (error) return
    call cubetopology_message(seve%r,rname,mess)
    !
    !***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
    offset = prog%rela*unit%user_per_prog    
    call cubetools_format_offset(offset,unit%name,mess,error)
    if (error) return
    call cubetopology_message(seve%r,rname,mess)
!!$
!!$    print *,'Absolute         ',prog%abso
!!$    print *,'Relative         ',prog%rela
!!$    print *,'Fractional pixel ',prog%frac
!!$    print *,'Integer    pixel ',prog%pixe
!!$    print *,'Entry            ',prog%ie
  end subroutine cubetopology_spapos_prog_list
end module cubetopology_spapos_types
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
