module mrtindex_table
  use gbl_message
  !---------------------------------------------------------------------
  ! This module offers a convenient tool to declare a table, dump header
  ! and write any many lines as desired, dealing with column alignment.
  !---------------------------------------------------------------------

  public :: table_t,line_t
  private

  integer(kind=4), parameter :: mcol=50      ! Up to 50 columns
  integer(kind=4), parameter :: line_l=1024  ! Max line length
  integer(kind=4), parameter :: colu_l=20    ! Max column width
  !
  type :: column_t
    character(len=colu_l) :: name
    character(len=colu_l) :: unit
    integer(kind=4)       :: width
    character(len=10)     :: format
  end type column_t
  !
  ! Buffer for 1 line
  type :: line_t
    integer(kind=4),       private :: icol=0  ! Last column printed in buffer
    character(len=line_l), private :: line=''
    integer(kind=4),       private :: ipos=1  ! Position in line buffer
  contains
    procedure, private :: new_cc    => line_new_cc
    procedure, private :: new_i4    => line_new_i4
    procedure, private :: new_r4    => line_new_r4
    procedure, private :: new_r8    => line_new_r8
    generic,   public  :: new_value => new_cc,new_i4,new_r4,new_r8
    procedure, public  :: list      => line_list
    procedure, public  :: reset     => line_reset
  end type line_t
  !
  type :: table_t
    integer(kind=4), private :: ncol=0
    type(column_t),  private :: col(mcol)
  contains
    procedure, public :: register_column => table_register_column
    procedure, public :: header          => table_header
  end type table_t
  !
contains
  !
  subroutine table_register_column(tab,name,unit,width,format,error)
    !-------------------------------------------------------------------
    ! Register a new column
    !-------------------------------------------------------------------
    class(table_t),   intent(inout) :: tab     !
    character(len=*), intent(in)    :: name    ! e.g. "Angle"
    character(len=*), intent(in)    :: unit    ! e.g. "[deg]"
    integer(kind=4),  intent(in)    :: width   ! e.g. 12 characters
    character(len=*), intent(in)    :: format  ! e.g. "1pg12.4"
    logical,          intent(inout) :: error   !
    ! Local
    character(len=*), parameter :: rname='REGISTER>COLUMN'
    !
    if (tab%ncol.ge.mcol) then
      call mrtindex_message(seve%e,rname,'Maximum number of columns exhausted')
      error = .true.
      return
    endif
    tab%ncol = tab%ncol+1
    tab%col(tab%ncol)%name = name
    tab%col(tab%ncol)%unit = unit
    tab%col(tab%ncol)%width = width
    tab%col(tab%ncol)%format = format
  end subroutine table_register_column
  !
  subroutine table_header(tab,olun,error)
    !-------------------------------------------------------------------
    ! Display the header, i.e. several comment lines with:
    !   - column numbers
    !   - column names
    !   - column units
    !-------------------------------------------------------------------
    class(table_t),  intent(in)    :: tab
    integer(kind=4), intent(in)    :: olun
    logical,         intent(inout) :: error
    !
    character(len=line_l) :: line1,line2,line3
    character(len=colu_l) :: tmp
    integer(kind=4) :: ipos,icol,wid
    logical :: first
    !
    line1 = '!'
    line2 = '!'
    line3 = '!'
    first  = .true.
    ipos = 2
    do icol=1,tab%ncol
      wid = tab%col(icol)%width
      ! Numbering
      write(tmp,'(i0)')  icol
      line1(ipos:ipos+wid-1) = recenter(tmp,wid)
      ! Name
      line2(ipos:ipos+wid-1) = recenter(tab%col(icol)%name,wid)
      ! Name
      line3(ipos:ipos+wid-1) = recenter(tab%col(icol)%unit,wid)
      if (first) then
        ipos = ipos+wid  ! Because we shifted the alignment by 1 because of the leading '!'
        first = .false.
      else
        ipos = ipos+wid+1
      endif
    enddo
    !
    line1(1:1) = '!'
    line2(1:1) = '!'
    line3(1:1) = '!'
    !
    write(olun,'(a)')  line1(1:ipos)
    write(olun,'(a)')  line2(1:ipos)
    write(olun,'(a)')  line3(1:ipos)
  end subroutine table_header
  !
  function recenter(string,width)
    !-------------------------------------------------------------------
    ! Return a string so that the input string is centered among 'width'
    ! characters.
    !-------------------------------------------------------------------
    character(len=colu_l) :: recenter  ! Function value on return
    character(len=*), intent(in) :: string
    integer(kind=4),  intent(in) :: width
    !
    integer(kind=4) :: nc,fc
    !
    nc = len_trim(string)
    if (nc.ge.width) then
      recenter = string(1:nc)
      return
    endif
    !
    fc = (width-nc)/2+1
    recenter(1:fc-1) = ' '
    recenter(fc:) = string(1:nc)
  end function recenter
  !
  subroutine line_new_cc(line,tab,cc,error)
    !-------------------------------------------------------------------
    ! Print a new value in the line buffer
    !-------------------------------------------------------------------
    class(line_t),    intent(inout) :: line
    type(table_t),    intent(in)    :: tab
    character(len=*), intent(in)    :: cc
    logical,          intent(inout) :: error
    ! Local
    character(len=*), parameter :: rname='LINE>NEW>CC'
    integer(kind=4) :: wid
    !
    if (line%icol.ge.tab%ncol) then
      call mrtindex_message(seve%e,rname,'Maximum number of values exhausted')
      error = .true.
      return
    endif
    !
    line%icol = line%icol+1
    wid = tab%col(line%icol)%width
    write(line%line(line%ipos:line%ipos+wid-1),tab%col(line%icol)%format) cc
    line%ipos = line%ipos+wid+1
  end subroutine line_new_cc
  !
  subroutine line_new_i4(line,tab,i4,error)
    !-------------------------------------------------------------------
    ! Print a new value in the line buffer
    !-------------------------------------------------------------------
    class(line_t),   intent(inout) :: line
    type(table_t),   intent(in)    :: tab
    integer(kind=4), intent(in)    :: i4
    logical,         intent(inout) :: error
    ! Local
    character(len=*), parameter :: rname='LINE>NEW>I4'
    integer(kind=4) :: wid
    !
    if (line%icol.ge.tab%ncol) then
      call mrtindex_message(seve%e,rname,'Maximum number of values exhausted')
      error = .true.
      return
    endif
    !
    line%icol = line%icol+1
    wid = tab%col(line%icol)%width
    write(line%line(line%ipos:line%ipos+wid-1),tab%col(line%icol)%format) i4
    line%ipos = line%ipos+wid+1
  end subroutine line_new_i4
  !
  subroutine line_new_r4(line,tab,r4,error)
    !-------------------------------------------------------------------
    ! Print a new value in the line buffer
    !-------------------------------------------------------------------
    class(line_t), intent(inout) :: line
    type(table_t), intent(in)    :: tab
    real(kind=4),  intent(in)    :: r4
    logical,       intent(inout) :: error
    ! Local
    character(len=*), parameter :: rname='LINE>NEW>R4'
    integer(kind=4) :: wid
    !
    if (line%icol.ge.tab%ncol) then
      call mrtindex_message(seve%e,rname,'Maximum number of values exhausted')
      error = .true.
      return
    endif
    !
    line%icol = line%icol+1
    wid = tab%col(line%icol)%width
    write(line%line(line%ipos:line%ipos+wid-1),tab%col(line%icol)%format) r4
    line%ipos = line%ipos+wid+1
  end subroutine line_new_r4
  !
  subroutine line_new_r8(line,tab,r8,error)
    !-------------------------------------------------------------------
    ! Print a new value in the line buffer
    !-------------------------------------------------------------------
    class(line_t), intent(inout) :: line
    type(table_t), intent(in)    :: tab
    real(kind=8),  intent(in)    :: r8
    logical,       intent(inout) :: error
    ! Local
    character(len=*), parameter :: rname='LINE>NEW>R8'
    integer(kind=4) :: wid
    !
    if (line%icol.ge.tab%ncol) then
      call mrtindex_message(seve%e,rname,'Maximum number of values exhausted')
      error = .true.
      return
    endif
    !
    line%icol = line%icol+1
    wid = tab%col(line%icol)%width
    write(line%line(line%ipos:line%ipos+wid-1),tab%col(line%icol)%format) r8
    line%ipos = line%ipos+wid+1
  end subroutine line_new_r8
  !
  subroutine line_list(line,olun,error)
    !-------------------------------------------------------------------
    ! Dump the current line buffer
    !-------------------------------------------------------------------
    class(line_t),   intent(inout) :: line
    integer(kind=4), intent(in)    :: olun
    logical,         intent(inout) :: error
    !
    write(olun,'(a)') line%line(1:line%ipos)
    line%icol = 0
    line%line = ''
    line%ipos = 1
  end subroutine line_list
  !
  subroutine line_reset(line,error)
    !-------------------------------------------------------------------
    !-------------------------------------------------------------------
    class(line_t),   intent(out)   :: line
    logical,         intent(inout) :: error
    ! Done with intent(out)
  end subroutine line_reset
end module mrtindex_table
