! fplot_vector_field_plot_data.f90
! REF:
    ! http://www.gnuplotting.org/vector-field-from-data-file/
    ! http://gnuplot.sourceforge.net/demo_5.4/vector.html
    ! http://www.gnuplot.info/docs_5.4/Gnuplot_5_4.pdf (pg 79)

module fplot_vector_field_plot_data
    use iso_fortran_env
    use fplot_plot_data
    use fplot_errors
    use fplot_colors
    use ferror
    use strings
    implicit none
    private
    public :: vector_field_plot_data

    type, extends(plot_data_colored) :: vector_field_plot_data
        !! Defines a two-dimensional vector-field plot data set.
        real(real64), private, allocatable, dimension(:,:,:) :: m_data
            !! An M-by-N-by-4 array containing the x, y, dx, and dy plot
            !! data points.  Optionally, a 5th page can be added to define the
            !! color for each arrow.
        real(real64), private :: m_arrowSize = 1.0d0
            !! The vector size (scaling factor).
        logical, private :: m_filledHeads = .false.
            !! Fill the arrow heads?
    contains
        procedure, public :: get_data_string => vfpd_get_data_cmd
        procedure, public :: get_command_string => vfpd_get_cmd
        procedure, public :: define_data => vfpd_define_data
        procedure, public :: get_arrow_size => vfpd_get_arrow_size
        procedure, public :: set_arrow_size => vfpd_set_arrow_size
        procedure, public :: get_fill_arrow => vfpd_get_fill_arrow
        procedure, public :: set_fill_arrow => vfpd_set_fill_arrow
        procedure, public :: get_use_data_dependent_colors => &
            vfpd_get_use_data_dependent_colors
        procedure, public :: clear_data => vfpd_clear_data
    end type

contains
! ------------------------------------------------------------------------------
    function vfpd_get_data_cmd(this) result(x)
        !! Gets the GNUPLOT command string containing the actual data to plot.
        class(vector_field_plot_data), intent(in) :: this
            !! The vector_field_plot_data object.
        character(len = :), allocatable :: x
            !! The command string.

        ! Local Variables
        type(string_builder) :: str
        integer(int32) :: i, j, m, n
        character :: delimiter, nl
        real(real64) :: scaling

        ! Initialization
        call str%initialize()
        delimiter = achar(9)    ! tab delimiter
        nl = new_line(nl)
        scaling = this%get_arrow_size()
        
        ! Fix later
        if (.not.allocated(this%m_data)) then
            x = ""
            return
        end if
        m = size(this%m_data, 1)
        n = size(this%m_data, 2)

        ! Need a quick return in the event no data exists

        ! Process
        if (this%get_use_data_dependent_colors()) then
            do j = 1, n
                do i = 1, m
                    ! ORDER: X, Y, DX, DY
                    call str%append(to_string(this%m_data(i,j,1)))
                    call str%append(delimiter)
                    call str%append(to_string(this%m_data(i,j,2)))
                    call str%append(delimiter)
                    call str%append(to_string(scaling * this%m_data(i,j,3)))
                    call str%append(delimiter)
                    call str%append(to_string(scaling * this%m_data(i,j,4)))
                    call str%append(delimiter)
                    call str%append(to_string(this%m_data(i,j,5)))
                    call str%append(nl)
                end do
            end do
        else
            do j = 1, n
                do i = 1, m
                    ! ORDER: X, Y, DX, DY
                    call str%append(to_string(this%m_data(i,j,1)))
                    call str%append(delimiter)
                    call str%append(to_string(this%m_data(i,j,2)))
                    call str%append(delimiter)
                    call str%append(to_string(scaling * this%m_data(i,j,3)))
                    call str%append(delimiter)
                    call str%append(to_string(scaling * this%m_data(i,j,4)))
                    call str%append(nl)
                end do
            end do
        end if

        ! End
        x = char(str%to_string())
    end function

! ------------------------------------------------------------------------------
    function vfpd_get_cmd(this) result(x)
        !! Gets the GNUPLOT command string to represent this
        !! vector_field_plot_data object.
        class(vector_field_plot_data), intent(in) :: this
            !! The vector_field_plot_data object.
        character(len = :), allocatable :: x
            !! The command string.

        ! Local Variables
        type(string_builder) :: str
        integer(int32) :: n
        type(color) :: clr
        
        ! Initialization
        call str%initialize()

        ! Data Block
        call str%append(" $")
        call str%append(this%get_datablock_name())

        ! Title
        n = len_trim(this%get_name())
        if (n > 0) then
            call str%append(' title "')
            call str%append(this%get_name())
            call str%append('"')
        else
            call str%append(' notitle')
        end if

        ! Property Definition
        call str%append(" with vectors")

        if (this%get_fill_arrow()) then
            call str%append(" filled head")
        end if

        if (this%get_use_data_dependent_colors()) then
            call str%append(" lc palette")
        else
            clr = this%get_line_color()
            call str%append(' lc rgb "#')
            call str%append(clr%to_hex_string())
            call str%append('"')
        end if

        ! End
        x = char(str%to_string())
    end function

! ------------------------------------------------------------------------------
    subroutine vfpd_define_data(this, x, y, dx, dy, c, err)
        !! Defines the data set.
        class(vector_field_plot_data), intent(inout) :: this
            !! The vector_field_plot_data object.
        real(real64), intent(in), dimension(:,:) :: x
            !! An M-by-N matrix containing the x-locations of each arrow's 
            !! origin.
        real(real64), intent(in), dimension(:,:) :: y
            !! An M-by-N matrix containing the y-locations of each arrow's 
            !! origin.
        real(real64), intent(in), dimension(:,:) :: dx
            !! An M-by-N matrix containing the x-direction of each arrow.
        real(real64), intent(in), dimension(:,:) :: dy
            !! An M-by-N matrix containing the y-direction of each arrow.
        real(real64), intent(in), dimension(:,:), optional :: c
            !! An optional M-by-N matrix containing information on how to color 
            !! the arrows.  The colors are determined by the active colormap.
        class(errors), intent(inout), optional, target :: err
            !! An error handling object.

        ! Local Variables
        integer(int32) :: i, j, m, n, flag
        type(errors), target :: deferr
        class(errors), pointer :: errmgr
        character(len = 256) :: errmsg

        ! Set up error handling
        if (present(err)) then
            errmgr => err
        else
            errmgr => deferr
        end if

        ! Input Checking
        m = size(x, 1)
        n = size(x, 2)
        if (size(y, 1) /= m .or. size(y, 2) /= n) then
            call report_matrix_size_mismatch_error(errmgr, "vfpd_define_data", &
                "y", m, n, size(y, 1), size(y, 2))
            return
        end if
        if (size(dx, 1) /= m .or. size(dx, 2) /= n) then
            call report_matrix_size_mismatch_error(errmgr, "vfpd_define_data", &
                "dx", m, n, size(dx, 1), size(dx, 2))
            return
        end if
        if (size(dy, 1) /= m .or. size(dy, 2) /= n) then
            call report_matrix_size_mismatch_error(errmgr, "vfpd_define_data", &
                "dy", m, n, size(dy, 1), size(dy, 2))
            return
        end if
        if (present(c)) then
            if (size(c, 1) /= m .or. size(c, 2) /= n) then
                call report_matrix_size_mismatch_error(errmgr, &
                    "vfpd_define_data", "c", m, n, size(c, 1), size(c, 2))
                return
            end if
        end if

        ! Create a name
        if (len(this%get_datablock_name()) == 0) then
            call this%create_unique_datablock_name()
        end if

        ! Allocate space for the data
        if (allocated(this%m_data)) deallocate(this%m_data)
        if (present(c)) then
            allocate(this%m_data(m, n, 5), stat = flag)
        else
            allocate(this%m_data(m, n, 4), stat = flag)
        end if
        if (flag /= 0) then
            call report_memory_error(errmgr, "vfpd_define_data", flag)
            return
        end if

        ! Store the data
        if (present(c)) then
            do concurrent(j = 1:n)
                do i = 1, m
                    this%m_data(i,j,1) = x(i,j)
                    this%m_data(i,j,2) = y(i,j)
                    this%m_data(i,j,3) = dx(i,j)
                    this%m_data(i,j,4) = dy(i,j)
                    this%m_data(i,j,5) = c(i,j)
                end do
            end do
        else
            do concurrent(j = 1:n)
                do i = 1, m
                    this%m_data(i,j,1) = x(i,j)
                    this%m_data(i,j,2) = y(i,j)
                    this%m_data(i,j,3) = dx(i,j)
                    this%m_data(i,j,4) = dy(i,j)
                end do
            end do
        end if

        ! End
        return
    end subroutine

! ------------------------------------------------------------------------------
    pure function vfpd_get_arrow_size(this) result(rst)
        !! Gets the scaling factor used to determine the arrow size.
        class(vector_field_plot_data), intent(in) :: this
            !! The vector_field_plot_data object.
        real(real64) :: rst
            !! The scaling factor.
        rst = this%m_arrowSize
    end function

! --------------------
    subroutine vfpd_set_arrow_size(this, x)
        !! Sets the scaling factor used to determine the arrow size.
        class(vector_field_plot_data), intent(inout) :: this
            !! The vector_field_plot_data object.
        real(real64), intent(in) :: x
            !! The scaling factor.
        this%m_arrowSize = x
    end subroutine

! ------------------------------------------------------------------------------
    pure function vfpd_get_fill_arrow(this) result(rst)
        !! Gets a value determining if the arrow heads should be filled.
        class(vector_field_plot_data), intent(in) :: this
            !! The vector_field_plot_data object.
        logical :: rst
            !! True if the arrow heads should be filled; else, false.
        rst = this%m_filledHeads
    end function

! --------------------
    subroutine vfpd_set_fill_arrow(this, x)
        !! Sets a value determining if the arrow heads should be filled.
        class(vector_field_plot_data), intent(inout) :: this
            !! The vector_field_plot_data object.
        logical, intent(in) :: x
            !! True if the arrow heads should be filled; else, false.
        this%m_filledHeads = x
    end subroutine

! ------------------------------------------------------------------------------
    pure function vfpd_get_use_data_dependent_colors(this) result(rst)
        !! Gets a value indicating if data-dependent coloring should be
        !! used.  This is defined by supplying information on how to scale the
        !! coloring when calling define_data.
        class(vector_field_plot_data), intent(in) :: this
            !! The vector_field_plot_data object.
        logical :: rst
            !! Returns true if data-dependent coloring is being used; else,
            !! false.
        rst = .false.
        if (.not.allocated(this%m_data)) return
        rst = size(this%m_data, 3) >= 5
    end function

! ------------------------------------------------------------------------------
    subroutine vfpd_clear_data(this)
        !! Clears the data from the data set.
        class(vector_field_plot_data), intent(inout) :: this
            !! The vector_field_plot_data object.
        if (allocated(this%m_data)) deallocate(this%m_data)
    end subroutine

! ------------------------------------------------------------------------------
end module
