! gtfig.f90 - Definitions of Gtool Figure Subroutines
! Copyright (C) TOYODA Eizi, 2000.  All rights reserved.

! GTFigPutCont, GTFigPutLine はそれぞれ
! gtcontlib.f90, gtlinelib.f90 にある。

subroutine GTFigOpen(fig)
    use gtgraph_types, only: GT_FIGURE
    use dc_string
    use dc_trace, only: beginsub, endsub
    implicit none
    type(GT_FIGURE), intent(out):: fig
    call beginsub('gtfigopen')
    nullify(fig%h_axis)
    nullify(fig%v_axis)
    nullify(fig%contours)
    nullify(fig%vectors)
    nullify(fig%line)
    fig%animate = .FALSE.
    fig%title = 'untitled'
    fig%projection = 1
    fig%stdlon = 180.0
    fig%stdlat = 0.0
    fig%rotate = 0.0
    fig%aspect = 0.0
    fig%fill = 0.6
    fig%shift = 0.025
    fig%ceil = 0.65
    call endsub('gtfigopen')
end subroutine

subroutine GtFigOption(fig, optname, value, err)
    use gtgraph_types, only: GT_FIGURE
    use gtgraph_generic, only: Option
    use dc_string, only: assignment(=)
    use dc_string, only: stoi, stod, toUpper, get_array
    use dc_trace, only: beginsub, endsub, message
    implicit none
    type(GT_FIGURE), intent(inout):: fig
    character(len = *), intent(in):: optname
    character(len = *), intent(in):: value
    character(len = len(optname)):: uc_name
    logical, intent(out):: err
continue
    call beginsub('gtfigoption', '<%c>=<%c>', c1=optname, c2=value)
    err = .FALSE.
    uc_name = optname
    call toUpper(uc_name)
    select case(uc_name)
    case("TITLE")
        fig%title = value
    case("-ANIMATE")
        fig%animate = .TRUE.
        call message('figure animation enabled')
    case("-NEXT")
        if (fig%animate) then
            call internal_next_slice
        else
            call message('figure animation disabled, so -next ignored')
            err = .TRUE.
        endif
    case('PROJ', '-PROJ', 'FIG/PROJ')
        fig%projection = stoi(value)
    case('STDLON', '-STDLON', 'PJX', 'FIG/PJX')
        fig%stdlon = stod(value)
    case('STDLAT', '-STDLAT', 'PJY', 'FIG/PJY')
        fig%stdlat = stod(value)
    case('ROTATE', '-ROTATE', 'ROT', 'FIG/ROT')
        fig%rotate = stod(value)
    case('ASPECT', '-ASPECT', 'ASP', 'FIG/ASP')
        fig%aspect = stod(value)
    case('FILL', '-FILL', 'FIL', 'FIG/FIL')
        fig%fill = stod(value)
    case('SHIFT', '-SHIFT', 'SHF', 'FIG/SHF')
        fig%shift = stod(value)
    case('CEIL', '-CEIL', 'CEL', 'FIG/CEL')
        fig%ceil = stod(value)
    case default
        err = .TRUE.
    end select
    call endsub('gtfigoption')
    return
contains

    subroutine internal_next_slice
        integer:: i
        logical:: alleof
        alleof = .TRUE.
        if (associated(fig%contours)) then
            do, i = 1, size(fig%contours)
                call Option(fig%contours(i), optname, value, err)
                if (.not. err) alleof = .FALSE.
            enddo
        endif
        if (associated(fig%line)) then
            do, i = 1, size(fig%line)
                call Option(fig%line(i), optname, value, err)
                if (.not. err) alleof = .FALSE.
            enddo
        endif
        err = alleof
    end subroutine

end subroutine

    ! 今のところ持ち物のうち axis だけを閉じる。なぜかというと axis 以外は
    ! 変数の reopen をサボっているので、ここで閉じるとおかしなことになるから。
subroutine GTFigClose(fig)
    use gtgraph_types, only: GT_FIGURE
    use gtgraph_generic, only: Close
    use dc_trace, only: beginsub, endsub
    implicit none
    type(GT_FIGURE), intent(out):: fig
    call beginsub('gtfigclose')
    if (associated(fig%h_axis)) then
        call Close(fig%h_axis)
        deallocate(fig%h_axis)
    endif
    if (associated(fig%v_axis)) then
        call Close(fig%v_axis)
        deallocate(fig%v_axis)
    endif
    if (associated(fig%vectors)) then
        deallocate(fig%vectors)
    endif
    if (associated(fig%contours)) then
        deallocate(fig%contours)
    endif
    if (associated(fig%line)) then
        deallocate(fig%line)
    endif
    call endsub('gtfigclose')
end subroutine

subroutine GTFigBindAxis(fig, axis, vertical)
    use gtgraph_types, only: GT_FIGURE, GT_AXIS
    use dc_trace, only: beginsub, endsub
    implicit none
    type(GT_FIGURE), intent(inout):: fig
    type(GT_AXIS), pointer:: axis
    logical, intent(in), optional:: vertical
continue
    if (present(vertical)) axis%vertical = vertical
    call beginsub('gtfigbindaxis')
    !
    ! 今は縦軸になるかどうかは最初から決定しているが、
    ! 将来はここで軸の立ちたがり度を勝負させる
    !
    if (axis%vertical) then
        if (.not. associated(fig%v_axis)) allocate(fig%v_axis)
        fig%v_axis => axis
    else
        if (.not. associated(fig%h_axis)) allocate(fig%h_axis)
        fig%h_axis => axis
    endif
    call endsub('gtfigbindaxis', 'vertical=%y', L=(/axis%vertical/))
end subroutine

subroutine GTFigDraw(fig, parent)
    use gtgraph_types, only: GT_FRAME, GT_FIGURE
    use gtgraph_generic, only: Draw, Option
    use dc_error
    !use dcl, only: DclNewFig, DclSetViewport, 
    use dcl
    use dc_string
    use dc_trace, only: beginsub, endsub
    use gtgraph_drawparam
    implicit none
    type(GT_FRAME), intent(in):: parent
    type(GT_FIGURE), intent(out):: fig
    ! 昔は  real:: vxmin=0.25, vxmax=0.80, vymin=0.15, vymax=0.52  に詰めた
    real:: vx0, vy0, vx1, vy1, vxlen, vylen
    real:: width, height
    real:: frame_width, frame_height
    integer:: i
    character(len = 30):: title

    call beginsub('gtfigdraw')

    if (.not. associated(fig%h_axis)) then
        call StoreError(GT_EFIGNOHAXIS, 'GTFigDraw')
        goto 999
    else if (.not. associated(fig%v_axis)) then
        call StoreError(GT_EFIGNOVAXIS, 'GTFigDraw')
        goto 999
    endif
    if (.not. parent%first_figure) then 
        call DclNewFig
    endif

    if (fig%aspect == 0.0) then
       vx0 = gt_figure_vxmin; vx1 = gt_figure_vxmax
       vy0 = gt_figure_vymin; vy1 = gt_figure_vymax
    else
       frame_width  = gt_figure_vxmax - gt_figure_vxmin
       frame_height = gt_figure_vymax - gt_figure_vymin
       if ( frame_height * fig%aspect > frame_width ) then
          vx0 = gt_figure_vxmin; vx1 = gt_figure_vxmax
          vy0 =  (gt_figure_vymin + gt_figure_vymax)/2 &
                - frame_width / fig%aspect/2
          vy1 =  (gt_figure_vymin + gt_figure_vymax)/2 &
                + frame_width / fig%aspect/2
       else
          vy0 = gt_figure_vymin; vy1 = gt_figure_vymax
          vx0 =  (gt_figure_vxmin + gt_figure_vxmax)/2 &
                - frame_height*fig%aspect/2
          vx1 =  (gt_figure_vxmin + gt_figure_vxmax)/2 &
                + frame_height*fig%aspect/2
       endif
    endif

!!$    if (fig%ceil == 0.0) fig%ceil = 0.65
!!$    if (fig%aspect == 0.0) fig%aspect = 1.0 / fig%ceil
!!$
!!$    ! 水平と鉛直の充填率が小さいほうを選ぶ
!!$    width = min(fig%fill, fig%fill / fig%aspect / fig%ceil)
!!$    height = fig%fill / fig%aspect
!!$    vx0 = 0.5 - width * 0.5 + fig%shift
!!$    vx1 = 0.5 + width * 0.5 + fig%shift
!!$    vy0 = (0.5 + fig%shift) * fig%ceil - 0.5 * height
!!$    vy1 = (0.5 + fig%shift) * fig%ceil + 0.5 * height
    call DCLSetViewPort(vx0, vx1, vy0, vy1)

    fig%h_axis%drawn = .FALSE.
    fig%v_axis%drawn = .FALSE.
    call Draw(fig%h_axis, fig%v_axis, parent=fig)
    if (associated(fig%contours)) then
        do, i = 1, size(fig%contours)
            call Draw(fig%contours(i), parent=fig)
        enddo        
    endif
    if (associated(fig%vectors)) then
        do, i = 1, size(fig%vectors)
            call Draw(fig%vectors(i), parent=fig)
        enddo        
    endif
    if (associated(fig%line)) then
        do, i = 1, size(fig%line)
            call Draw(fig%line(i), parent=fig)
        enddo        
    endif

!  現在のところ frame title と同じになるのでコメントアウト
!  (2002/09/22 S.Takehiro)
!    call DclDrawTextNormalized &
!         ( gt_figure_title_vx, gt_figure_title_vy, &
!           GTStringQuoteForDcl(fig%title), &
!           height=gt_figure_title_height, index=gt_figure_title_index, &
!           centering=gt_figure_title_centering )

999 continue
    call endsub('gtfigdraw')

end subroutine
