!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubedag_index_iterator_tool
  use cubedag_parameters
  use cubedag_messaging
  use cubedag_node_class
  use cubedag_link_type
  use cubedag_dag_buffer

  public :: code_iter_unknown,ncode_iter,iter_names,iter_abstracts
  public :: index_iterator_t
  private
  !
  ! --- Public iteration codes -----------------------------------------
  integer(kind=code_k), parameter :: code_iter_unknown     = 0
  integer(kind=code_k), parameter :: code_iter_current     = 1
  integer(kind=code_k), parameter :: code_iter_next        = 2
  integer(kind=code_k), parameter :: code_iter_previous    = 3
  integer(kind=code_k), parameter :: code_iter_first       = 4
  integer(kind=code_k), parameter :: code_iter_last        = 5
  integer(kind=code_k), parameter :: code_iter_beforefirst = 6
  integer(kind=code_k), parameter :: code_iter_afterlast   = 7
  integer(kind=code_k), parameter :: ncode_iter = code_iter_afterlast
  !
  character(len=*), parameter :: iter_names(ncode_iter) = [&
       'CURRENT    ',&
       'NEXT       ','PREVIOUS   ',&
       'FIRST      ','LAST       ',&
       'BEFOREFIRST','AFTERLAST  ']
  !
  character(len=*), parameter :: iter_abstracts(ncode_iter) = [&
       'current     ',&
       'next        ','previous    ',&
       'first       ','last        ',&
       'before first','afterlast   ']
  ! --------------------------------------------------------------------

  integer(kind=code_k), parameter :: start_noninitialized=1
  integer(kind=code_k), parameter :: start_before=2
  integer(kind=code_k), parameter :: start_current=3
  integer(kind=code_k), parameter :: start_after=4

  ! Private type which saves the iterator status
  type :: index_internal_t
    type(cubedag_link_t), pointer, private :: optx
    integer(kind=code_k),          private :: start = start_noninitialized
    integer(kind=iden_l),          private :: current_id
  contains
    procedure, private :: current_num => index_iterator_current_num
  end type index_internal_t
  ! Keep the iterator status in a private instance
  type(index_internal_t) :: gbl_iter

  ! Public methods to which interact with the internal iterator
  type :: index_iterator_t
  contains
    procedure, nopass, public :: get        => index_iterator_get
    procedure, nopass, public :: put        => index_iterator_put
    procedure, nopass, public :: is_current => index_iterator_is_current
  end type index_iterator_t

contains

  subroutine index_iterator_get(what,out,error)
    !-------------------------------------------------------------------
    ! Return the identifier suited for the given "what" code
    !-------------------------------------------------------------------
    integer(kind=code_k), intent(in)    :: what
    integer(kind=iden_l), intent(out)   :: out
    logical,              intent(inout) :: error
    !
    integer(kind=entr_k), parameter :: entry_none=-1
    integer(kind=entr_k), parameter :: entry_first=2  ! Skip root
    integer(kind=entr_k) :: newent
    character(len=mess_l) :: mess
    class(cubedag_node_object_t), pointer :: obj
    character(len=*), parameter :: rname='GET>CURRENT'
    !
    ! call cubedag_message(dagseve%trace,rname,'Welcome')
    !
    if (.false.) then  ! ZZZ Need a way to customize the target
      gbl_iter%optx => cx
    else
      gbl_iter%optx => ix
    endif
    !
    select case (what)
    case (code_iter_beforefirst)
      gbl_iter%start = start_before
      newent = entry_none
    case (code_iter_afterlast)
      gbl_iter%start = start_after
      newent = entry_none
    case (code_iter_current)
      call gbl_iter%current_num(newent,error)
      if (error)  return
    case (code_iter_first)
      newent = entry_first
    case (code_iter_last)
      newent = gbl_iter%optx%n
    case (code_iter_next)
      if (gbl_iter%start.eq.start_noninitialized .or.  &
          gbl_iter%start.eq.start_before) then
        newent = entry_first
      else
        call gbl_iter%current_num(newent,error)
        if (error)  return
        newent = newent+1
      endif
      if (newent.gt.gbl_iter%optx%n) then  ! ZZZ Loop mode?
        call cubedag_message(seve%e,rname,'Reached end of index')
        error = .true.
        return
      endif
    case (code_iter_previous)
      if (gbl_iter%start.eq.start_noninitialized .or.  &
          gbl_iter%start.eq.start_after) then
        newent = gbl_iter%optx%n
      else
        call gbl_iter%current_num(newent,error)
        if (error)  return
        newent = newent-1
      endif
      if (newent.lt.entry_first) then  ! ZZZ Loop mode?
        call cubedag_message(seve%e,rname,'Reached start of index')
        error = .true.
        return
      endif
    case default
      call cubedag_message(seve%e,rname,'Unexpected iterator code')
      error = .true.
      return
    end select
    !
    if (newent.eq.entry_none) then
      call cubedag_message(seve%d,rname,'No entry to get here')
      out = code_null
    elseif (newent.lt.entry_first .or. newent.gt.gbl_iter%optx%n) then
      ! Should not happen
      write(mess,'(a,i0,a)')  'No entry number ',newent,' in index'
      call cubedag_message(seve%e,rname,mess)
      error = .true.
      return
    else
      write(mess,'(a,i0)')  'Getting entry number ',newent
      call cubedag_message(seve%d,rname,mess)
      obj => cubedag_node_ptr(gbl_iter%optx%list(newent)%p,error)
      if (error)  return
      out = obj%get_id()
      call index_iterator_put(out,error)
      if (error)  return
    endif
  end subroutine index_iterator_get
  !
  subroutine index_iterator_put(id,error)
    !-------------------------------------------------------------------
    ! Set the current identifier in the iterator
    !-------------------------------------------------------------------
    integer(kind=iden_l), intent(in)    :: id
    logical,              intent(inout) :: error
    !
    gbl_iter%current_id = id
    gbl_iter%start = start_current  ! A valid current ID is now defined
  end subroutine index_iterator_put
  !
  subroutine index_iterator_current_num(iter,num,error)
    !-------------------------------------------------------------------
    ! Dynamically get the entry number from the current ID, as the entry
    ! number in the index might change if e.g. other nodes are removed.
    ! This assumes the identifiers in the index are numerically sorted.
    !-------------------------------------------------------------------
    class(index_internal_t), intent(inout) :: iter
    integer(kind=entr_k),    intent(out)   :: num
    logical,                 intent(inout) :: error
    !
    integer(kind=iden_l) :: found_id
    character(len=mess_l) :: mess
    character(len=*), parameter :: rname='ITERATOR>CURRENT>NUM'
    !
    num = 0
    !
    if (iter%start.ne.start_current) then
      call cubedag_message(seve%e,rname,'No current entry defined')
      error = .true.
      return
    endif
    !
    call iter%optx%entrynum(iter%current_id,found_id,num,error)
    if (error)  return
    !
    if (found_id.ne.iter%current_id) then
      ! It may have disappeared e.g. after an UNDO
      write(mess,'(3(a,i0))')  &
        'Current entry id. ',iter%current_id, &
        ' not found in index, using entry id. ',found_id,' as fallback'
      call cubedag_message(seve%w,rname,mess)
    endif
  end subroutine index_iterator_current_num

  function index_iterator_is_current(id)
    !-------------------------------------------------------------------
    ! Return .true. if the passed ID matches the gbl_iter current ID.
    !-------------------------------------------------------------------
    logical :: index_iterator_is_current
    integer(kind=iden_l), intent(in) :: id
    !
    index_iterator_is_current = gbl_iter%start.eq.start_current .and. &
                                gbl_iter%current_id.eq.id
  end function index_iterator_is_current

end module cubedag_index_iterator_tool
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
