module cubedag_digraph
  use gkernel_interfaces
  use cubetools_parameters
  use cubedag_node_class
  use cubedag_messaging
  use cubedag_walker_types

  public :: cubedag_digraph_create
  private

  integer(kind=4) :: lun,mode
  logical :: noroot

contains
  !
  subroutine cubedag_digraph_create(start,childwalk,ofile,imode,error,inoroot)
    !-------------------------------------------------------------------
    ! Build the digraph (.dot file) by recursing children from the root
    !-------------------------------------------------------------------
    class(cubedag_node_object_t), intent(in)    :: start
    logical,                      intent(in)    :: childwalk
    character(len=*),             intent(in)    :: ofile
    integer(kind=4),              intent(in)    :: imode
    logical,                      intent(inout) :: error
    logical, optional,            intent(in)    :: inoroot
    ! Local
    character(len=*), parameter :: rname='DIGRAPH>CREATE'
    integer(kind=4) :: ier
    class(cubedag_node_object_t), pointer :: object
    type(parentwalker_t) :: parentwalker
    type(childwalker_t) :: childwalker
    !
    mode = imode
    if (present(inoroot)) then
      noroot = inoroot
    else
      noroot = .true.
    endif
    !
    ier = sic_getlun(lun)
    if (mod(ier,2).eq.0) then
      call cubedag_message(seve%e,rname,'Cannot allocate LUN')
      error = .true.
      return
    endif
    ier = sic_open(lun,ofile,'NEW',.false.)
    if (ier.ne.0) then
      call putios('E-SIC, ',ier)
      error = .true.
      return
    endif
    !
    write(lun,'(A)')  'digraph CUBE {'
    write(lun,'(A)')  '  rankdir=BT;'
    write(lun,'(A)')  '  node [shape = ellipse];'
    !
    if (childwalk) then
      call childwalker%reset(start,cubedag_digraph_link,error)
      if (error)  return
      do while (childwalker%next(object))
        ! print *,'Found child: ',object%node%id
      enddo
    else
      call parentwalker%reset(start,cubedag_digraph_link,error)
      if (error)  return
      do while (parentwalker%next(object))
        ! print *,'Found parent: ',object%node%id
      enddo
    endif
    !
    write(lun,'(A)')  '}'
    !
    ier = sic_close(lun)
    call sic_frelun(lun)
  end subroutine cubedag_digraph_create
  !
  subroutine cubedag_digraph_link(par,chi,error)
    !-------------------------------------------------------------------
    ! Link a parent to its child in the digraph
    !-------------------------------------------------------------------
    class(cubedag_node_object_t), intent(in)    :: par
    class(cubedag_node_object_t), intent(in)    :: chi
    logical,                      intent(inout) :: error
    !
    if (noroot .and. (par%node%id.eq.0 .or. chi%node%id.eq.0) )  return
    !
    write(lun,'(5A)')  '  "',trim(cubedag_digraph_nodename(chi,error)),  &
                    '" -> "',trim(cubedag_digraph_nodename(par,error)),'";'
  end subroutine cubedag_digraph_link
  !
  function cubedag_digraph_nodename(no,error)
    use cubetools_flag_types
    !-------------------------------------------------------------------
    ! Return the node name under various format depending on 'mode'
    ! 1:  id
    ! 2:  family\n
    !     flag1,flag2,flag3
    ! 3:  id: family\n
    !     flag1,flag2,flag3
    ! 4:  id: family\n
    !     flag1,\n
    !     flag2,\n
    !     flag3
    !-------------------------------------------------------------------
    character(len=base_l) :: cubedag_digraph_nodename
    class(cubedag_node_object_t), intent(in)    :: no
    logical,                      intent(inout) :: error
    ! Local
    character(len=8) :: id
    character(len=128) :: flagoneline,flagsevline
    character(len=base_l) :: family
    integer(kind=4) :: nc,iflag
    type(flag_t), pointer :: flag
    !
    write(id,'(I0)')  no%node%id
    family = no%node%family
    flagoneline = ''
    flagsevline = ''
    if (no%node%flag%n.gt.0) then
      !
      flagoneline(1:2) = '\n'
      call no%node%flag%repr(flagoneline(3:),nc,error)
      if (error)  return
      !
      nc = 0
      do iflag=1,no%node%flag%n
        flag => cubetools_flag_ptr(no%node%flag%list(iflag)%p,error)
        if (error)  return
        flagsevline = trim(flagsevline)//'\n'//flag%get_name()
      enddo
    endif
    !
    select case (mode)
    case (1)
      cubedag_digraph_nodename = id
    case (2)
      cubedag_digraph_nodename = trim(family)//flagoneline
    case (3)
      cubedag_digraph_nodename = trim(id)//': '//trim(family)//flagoneline
    case (4)
      cubedag_digraph_nodename = trim(id)//': '//trim(family)//flagsevline
    case default
      cubedag_digraph_nodename = id
    end select
  end function cubedag_digraph_nodename
  !
end module cubedag_digraph
