! gtlinelib.f90 - 線オブジェクトの取り扱い

subroutine GTLineOpen(result, var)
    use gtgraph_types, only: GT_LINE
    use gtgraph_generic, only: GOpen => Open
    use gtdata_types, only: GT_VARIABLE
    use gtdata_generic, only: Open
    use dc_trace, only: beginsub, endsub
    implicit none
    type(GT_LINE), intent(out):: result
    type(GT_VARIABLE), intent(in):: var
continue
    call beginsub('gtlineopen')
    call Open(result%var, var, 0)
    allocate(result%h_axis, result%v_axis)
    call GOpen(result%v_axis, var, 0)
    call GOpen(result%h_axis, var, 1)
    result%index = 1
    result%type = 1
    result%mark = 0
    result%animate = .false.
    call endsub('gtlineopen')
end subroutine

subroutine GtLineClose(Line)
    use gtgraph_types, only: GT_Line
    use gtgraph_generic, only: GClose => Close
    use gtdata_generic, only: Close
    use dc_trace, only: beginsub, endsub
    implicit none
    type(GT_Line), intent(inout):: Line
    call beginsub('gtlineclose')
    call GClose(Line%h_axis)
    call GClose(Line%v_axis)
    deallocate(Line%h_axis, Line%v_axis)
    call Close(Line%var)
    call endsub('gtlineclose')
end subroutine

subroutine GtLineOption(line, optname, value, err)
    use gtdata_generic, only: slice_next
    use gtgraph_types, only: GT_LINE
    use dc_string, only: StoI, toUpper, get_array
    use gt_args, only: GtOptionLineIndex
    use dc_trace, only: beginsub, endsub, message
    use dc_error, only: GT_ENOMOREDIMS, DC_NOERR
    implicit none
    type(GT_LINE), intent(inout):: line
    character(len = *), intent(in):: optname
    character(len = *), intent(in):: value
    character(len = len(optname)):: uc_optname
    character(len = len(value)):: uc_value
    logical, intent(out):: err
    real, pointer:: rp(:)
    integer:: stat
continue
    err = .TRUE.
    call beginsub('gtlineoption', '<%c=%c>', c1=optname, c2=value)
    uc_optname = optname
    uc_value = value
    call toUpper(uc_optname)
    call toUpper(uc_value)
    call GtOptionLineIndex(line%index, uc_optname, uc_value, err)
    if (.not. err) then
        goto 999
    endif
    if (uc_optname == "-ANIMATE") then
        line%animate = .true.
        err = .FALSE.
    else if (uc_optname == "-NEXT") then
        if (line%animate) then
            call slice_next(line%var, stat=stat)
            err = (stat /= DC_NOERR)
            call message('line next okay=%y stat=%d', L=(/.not. err/), i=(/stat/))
        else
            err = .TRUE.
        endif
    else if (uc_optname == "TYPE") then
        select case(uc_value)
        case("SOLID")
            line%type = 1
        case("DASH", "DASHED")
            line%type = 2
        case("DOT", "DOTTED")
            line%type = 3
        case("DOTDASHED")
            line%type = 4
        case default
            line%type = stoi(value)
        end select
        err = .FALSE.
    else if (uc_optname == "MARK") then
        if (index("0123456789", uc_value(1:1)) >= 1) then
            line%mark = stoi(value)
        else
            line%mark = iachar(value(1:1))
        endif
        err = .FALSE.
    else if (uc_optname == "RANGE") then
        call get_array(rp, value)
	if (.not. associated(rp)) return
	if (size(rp) < 2) return
	line%v_axis%upper = rp(2)
	line%v_axis%lower = rp(1)
	call message('line range %r %r', r=(/line%v_axis%lower, line%v_axis%upper/))
	err = .FALSE.
    endif
999 continue
    call endsub('gtlineoption', 'err=%y', L=(/err/))
end subroutine

subroutine GTFigBindLine(fig, line)
    use gtgraph_types, only: GT_FIGURE, GT_LINE
    use gtdata_generic, only: get_attr, inquire
    use gtgraph_generic, only: close, operator(.equivalent.)
    use dc_types, only: STRING
    use dc_error
    use dc_trace, only: beginsub, endsub
    implicit none
    type(GT_FIGURE), intent(inout):: fig
    type(GT_LINE), intent(in):: line
    type(GT_LINE), pointer:: newlines(:)
    character(STRING):: title
    integer:: nlines, stat
    real:: h_lower, h_upper, v_lower, v_upper
    
    call beginsub('gtfigbindline')
    stat = GT_EFAKE
    if (associated(fig%h_axis) .or. associated(fig%v_axis)) then
        if (.not. associated(fig%h_axis)) goto 999
        if (.not. associated(fig%v_axis)) goto 999
        if (.not. (fig%h_axis .equivalent. line%h_axis)) goto 999
        if (.not. (fig%v_axis .equivalent. line%v_axis)) goto 999
        h_lower = min(line%h_axis%lower, fig%h_axis%lower)
        v_lower = min(line%v_axis%lower, fig%v_axis%lower)
        h_upper = max(line%h_axis%upper, fig%h_axis%upper)
        v_upper = max(line%v_axis%upper, fig%v_axis%upper)
        fig%h_axis => line%h_axis
        fig%v_axis => line%v_axis
        fig%h_axis%lower = h_lower
        fig%h_axis%upper = h_upper
        fig%v_axis%lower = v_lower
        fig%v_axis%upper = v_upper
    else
        fig%h_axis => line%h_axis
        fig%v_axis => line%v_axis
    endif
    !
    call get_attr(line%var, 'long_name', title)
    if (title == '') call Inquire(line%var, name=title)
    if (fig%title == "untitled") then
        fig%title = title
    else
        fig%title = trim(fig%title) // ", " // title
    endif
    if (line%animate) fig%animate = .true.
    !
    if (associated(fig%line)) then
        nlines = size(fig%line)
        allocate(newlines(nlines + 1))
        newlines(1: nlines) = fig%line(1: nlines)
        deallocate(fig%line)
    else
        nlines = 0
        allocate(newlines(1))
    endif
    newlines(nlines + 1) = line
    fig%line => newlines
    stat = 0
    999 continue
    call endsub('gtfigbindline')
    call StoreError(stat, 'GTFigPutLine')
end subroutine

subroutine GTLineDraw(line, parent)
    use gtgraph_types, only: GT_LINE, GT_FIGURE
    use gtgraph_generic, only: Draw
    use gtdata_generic, only: Get, get_attr
    use dc_trace, only: beginsub, endsub
    use dc_string
    use dcl
    implicit none
    type(GT_LINE), intent(inout):: line
    type(GT_FIGURE), intent(in):: parent
    real, pointer:: value(:)
    real, pointer:: abscissa(:)
    real, pointer:: tmpval(:)
    character(token):: topology

    call beginsub('gtlinedraw')
    call Get(line%var, value)
    call Get(line%h_axis%var, abscissa)

   ! 周期的座標の処理. データ格子点を最後に一つ追加. 
    call get_attr(line%h_axis%var, "topology", topology)
    if ( topology == "circular" ) then
       allocate(tmpval(size(abscissa)+1))

       tmpval(1:size(abscissa)) = abscissa
       tmpval(size(abscissa)+1) = line%h_axis%upper
       deallocate(abscissa)
       allocate(abscissa(size(tmpval)))
       abscissa = tmpval

       tmpval(1:size(value)) = value
       tmpval(size(value)+1) = value(1)
       deallocate(value)
       allocate(value(size(tmpval)))
       value = tmpval
       deallocate(tmpval)
    endif

    ! 線グラフの描画
    if (line%index /= 0) then
        call DclDrawLine(abscissa, value, index=line%index, type=line%type)
    endif
    if (line%mark /= 0) then
        call DclDrawMarker(abscissa, value, index=line%index, type=line%mark)
    endif
    deallocate(abscissa, value)
    call endsub('gtlinedraw')
end subroutine
