! gtaxisdefault.f90 - 軸操作
! Copyright (C) GFD Dennou Club, 2000.  All rights reserved

subroutine GTAxisOpen(this, base_var, dimno, vertical)
    use gtgraph_types, only: GT_AXIS
    use gtdata_types, only: GT_VARIABLE
    use gtdata_generic, only: Open, get, Inquire, get_attr, attr_true
    use dc_trace, only: message, beginsub, endsub
    use sysdep, only: abortprogram
    use dc_string
    implicit none
    type(GT_AXIS), intent(out):: this
    type(GT_VARIABLE), intent(in):: base_var
    integer, intent(in):: dimno
    logical, intent(in), optional:: vertical
    real, pointer:: values(:)
    character(*), parameter:: sub = 'GTAxisOpen'
    character(token):: positive
    character(token):: topology
    real :: modulo
    real, pointer :: range(:)
continue
    call beginsub(sub, 'var=%d dimno=%d', i=(/base_var%mapid, dimno/))
    call Open(this%var, base_var, dimno)

    ! 縦軸か横軸かを決定
    this%vertical = .FALSE.
    if (present(vertical)) this%vertical = vertical

    ! 軸の上下限推奨値設定
    call get(this%var, values)
    if (.not. associated(values)) then
       call abortprogram('gtaxisopen: read error of variable')
    endif
    ! まずは gt_graph_range 属性をチェック
    call get_attr(this%var, "gt_graph_range", range)
    if ( associated(range) )then
       if ( size(range).lt. 2 )then
          call message('dim. of gt_axis_range should be 2') 
          ! 上下 2 つの値が与えられなければ無視. 
       else
          this%lower=range(1) ; this%upper=range(2)
       endif
    else
       ! 周期的座標の処理. 範囲を周期から定める.
       call get_attr(this%var, "topology", topology)
       if ( topology == "circular" ) then 
          call get_attr(this%var, "modulo", modulo, 0.0 )
          if ( modulo == 0.0 ) then
             call abortprogram('gtaxisopen: cyclic axis does not have modulo attribute')
          else
             this%lower = minval(values)
             this%upper = minval(values) + modulo
          endif
       else  
          ! それでもダメなら範囲を軸データから定める.
          ! 切りのよい値への変換は DclScalingPoint にゆだねる。
          this%upper = maxval(values) 
          this%lower = minval(values)
       end if
    endif
    deallocate(values)

    ! 文字属性を取得
    call get_attr(this%var, 'long_name', this%title)
    if (this%title == '') call Inquire(this%var, name=this%title)
    ! 単位に関してはいずれ GT_VARIABLE が
    ! インターフェイスを持つべきである
    call get_attr(this%var, 'units', this%units)
    if (this%units == '') then
        call get_attr(this%var, 'unit', this%units, &
            default="units missing")
    endif

    ! フラグ
    this%logscale = attr_true(this%var, "gt_graph_logscale")
    call get_attr(this%var, "positive", positive)
    this%negative = (positive == "down")

    ! 二重描画を防止するためのフラグ
    this%drawn = .FALSE.
    ! 二重セーブを防止するためのフラグ
    this%saved = ""

    call endsub(sub, 'vert=%y upper=%r lower=%r', L=(/this%vertical/), &
        & r=(/this%upper, this%lower/))
end subroutine

! サブルーチン名 Axes は Axis の複数であることに注意。
! 現在のところ必ず座標軸は 2 つ対で描画されなければならない。

subroutine GTAxesDraw(h_axis, v_axis, parent, set_space)
    use gtgraph_types, only: GT_AXIS, GT_FIGURE
    use gtdata_generic, only: Get, get_attr
    use dc_trace, only: message
    use dc_string
    use dc_error
    use dcl
    use gtgraph_drawparam
    implicit none
    type(GT_AXIS), intent(inout):: h_axis, v_axis
    type(GT_FIGURE), intent(in):: parent
    logical, intent(in), optional:: set_space
    logical:: set_space_mode
    real, pointer:: value(:)
    type(VSTRING):: xtitle, ytitle, xunits, yunits
    real:: radius
    logical::llnintsave
    integer::index
    character(token):: topology

continue
    ! それはないだろう
    if (.not. associated(parent%h_axis)) return
    if (.not. associated(parent%v_axis)) return
    ! オプション処理
    set_space_mode = .FALSE.
    if (present(set_space)) set_space_mode = set_space
    call message("gtaxesdraw: h(%r %r) v(%r %r)", &
        r=(/h_axis%lower, h_axis%upper, v_axis%lower, v_axis%upper/))

    ! Dcl 変数設定
    call DclSetParm('LABEL_HEIGHT1', gt_axis_label_height1)
    call DclSetParm('TITLE_HEIGHT1', gt_axis_title_height1)

    ! 軸を描くということは空間設定でもある。
    call DclSetWindow(h_axis%lower, h_axis%upper, &
                      v_axis%lower, v_axis%upper)
    select case(parent%projection)
    case (1:4)
       ! 軸の向き設定変数
        call DclSetParmEx('INV_X_AXIS', h_axis%negative )
        call DclSetParmEx('INV_Y_AXIS', v_axis%negative )
        call DclFitScalingParm
        call DCLSetTransNumber(parent%projection)
        call local_draw_normal_axes
    case (5:6) 
       ! 双曲線座標の場合はノーチェック
       ! radius = (0.7 - 0.3) / 2 / h_axis%upper
        radius = min( gt_figure_vxmax-gt_figure_vxmin, &
                      gt_figure_vymax-gt_figure_vymin) &
                 / 2 / h_axis%upper
        call DCLSetSimilarity(radius, 0.0, 0.0)
        call DCLSetTransNumber(parent%projection)
    case (10:15)
        call DCLSetTransNumber(parent%projection)
        call DCLSetMapContactPoint(parent%stdlon, parent%stdlat, parent%rotate)
        call DCLSetParm('MAP:LGLOBE', .true.)
        call DCLFitMapParm
    case (20:23)
        call DCLSetParm('GRAPH:stlat1', 45.0)
        call DCLSetParm('GRAPH:stlat2', 30.0)
        call DCLSetTransNumber(parent%projection)
        call DCLSetMapContactPoint(parent%stdlon, parent%stdlat, parent%rotate)
        call DCLSetParm('MAP:LGLOBE', .true.)
        call DCLFitMapParm
    case (30:33)
        call DCLSetTransNumber(parent%projection)
        call DCLSetMapContactPoint(parent%stdlon, parent%stdlat, parent%rotate)
        call DCLSetParm('MAP:LGLOBE', .true.)
        call DCLFitMapParm
    case default
        call DCLSetTransNumber(1)
        call local_draw_normal_axes
    end select
    call DclSetTransFunction()

    ! GTContDraw などのために格子位置を設定
    if (set_space_mode) then
        call get(h_axis%var, value)
        ! 周期的座標の処理. 格子点を最後に一つ追加. 
        call get_attr(h_axis%var, "topology", topology)
        if ( topology == "circular" ) then
           call DclSetXGrid((/value,h_axis%upper/)) 
        else
           call DclSetXGrid(value)
        endif
        deallocate(value)
        call get(v_axis%var, value)
        ! 周期的座標の処理. 格子点を最後に一つ追加. 
        call get_attr(v_axis%var, "topology", topology)
        if ( topology == "circular" ) then
           call DclSetYGrid((/value,v_axis%upper/))
        else
           call DclSetYGrid(value)
        endif
        deallocate(value)
    endif
    select case(parent%projection)
        case(5)
           ! 外枠描画. まだ内外円弧のみ. 完全に囲うには cyclic 判定が必要.
            llnintsave=DCLGetLogical('GRAPH:LLNINT')
            index=DCLGetInteger('AXIS:INDEXT2')
            call DCLSetParm('GRAPH:LLNINT',.true.)
            call DCLDrawLine((/h_axis%lower,h_axis%lower/),&
                 (/v_axis%lower,v_axis%upper/),type=1,index=index)
            call DCLDrawLine((/h_axis%upper,h_axis%upper/),&
                 (/v_axis%lower,v_axis%upper/),type=1,index=index)
            call DCLSetParm('GRAPH:LLNINT',llnintsave)
        case(10:15, 20:23, 30:33)
            call DCLDrawLimb()
    end select
    return
contains

        ! まさしく軸の描画そのもの
    subroutine local_draw_normal_axes
        if (.not. (h_axis%drawn .or. v_axis%drawn)) then
            xtitle = GTStringQuoteForDcl(h_axis%title)
            ytitle = GTStringQuoteForDcl(v_axis%title)
            xunits = GTStringQuoteForDcl(h_axis%units)
            yunits = GTStringQuoteForDcl(v_axis%units)
            call DclSetTitle( &
                & vchar(xtitle, len(xtitle)), &
                & vchar(ytitle, len(ytitle)), &
                & vchar(xunits, len(xunits)), &
                & vchar(yunits, len(yunits)))
            ! 外向き目盛り
            call DclSetParm('AXIS:INNER', -1)
            call DclDrawScaledAxis()
        else if (.not. v_axis%drawn) then
            ytitle = GTStringQuoteForDcl(v_axis%title)
            yunits = GTStringQuoteForDcl(v_axis%units)
            call DclSetTitle("", vchar(ytitle, len(ytitle)), &
                & "", vchar(yunits, len(yunits)))
            call DclDrawScaledAxis(side="rl")
        else if (.not. h_axis%drawn) then
            xtitle = GTStringQuoteForDcl(h_axis%title)
            xunits = GTStringQuoteForDcl(h_axis%units)
            call DclSetTitle(vchar(xtitle, len(xtitle)), "", &
                & vchar(xunits, len(xunits)), "")
            call DclDrawScaledAxis(side="tb")
        endif
        h_axis%drawn = .TRUE.
        v_axis%drawn = .TRUE.
        return
    end subroutine

end subroutine

subroutine GTAxesDrawGrid(h_axis, v_axis, parent)
    use gtgraph_types, only: GT_AXIS, GT_FIGURE
    use gtdata_generic, only: Get, get_attr
    use dc_string
    use dcl
    type(GT_AXIS), intent(inout):: h_axis, v_axis
    type(GT_FIGURE), intent(in):: parent
    real, pointer:: hvalue(:)
    real, pointer:: vvalue(:)
    real, pointer:: tmpval(:)
    integer:: innersave,index, i
    real:: simfac,vtick,rtick,thetatick
    character(token):: topology

    call get(h_axis%var, hvalue)
    ! 周期的座標の処理. 格子点を最後に一つ追加. 
    call get_attr(h_axis%var, "topology", topology)
    if ( topology == "circular" ) then
       allocate(tmpval(size(hvalue)+1))
       tmpval(1:size(hvalue))=hvalue
       tmpval(size(hvalue)+1)=h_axis%upper
       deallocate(hvalue)
       allocate(hvalue(size(tmpval)))
       hvalue=tmpval
       deallocate(tmpval)
    endif

    call get(v_axis%var, vvalue)
    ! 周期的座標の処理. 格子点を最後に一つ追加. 
    call get_attr(v_axis%var, "topology", topology)
    if ( topology == "circular" ) then
       allocate(tmpval(size(vvalue)+1))
       tmpval(1:size(vvalue))=vvalue
       tmpval(size(vvalue)+1)=v_axis%upper
       deallocate(vvalue)
       allocate(vvalue(size(tmpval)))
       vvalue=tmpval
       deallocate(tmpval)
    endif

    select case(parent%projection)
        case(1:4)
           innersave=DCLGetInteger('AXIS:INNER')
           call DCLSetParm('AXIS:INNER',1)

           call UXPTMK('B',1,hvalue,size(hvalue))
           call UXPTMK('T',1,hvalue,size(hvalue))

           call UYPTMK('L',1,vvalue,size(vvalue))
           call UYPTMK('R',1,vvalue,size(vvalue))

           call DCLSetParm('AXIS:INNER',innersave)

        case(5:6)
           ! 2 次元極座標のみ
           vtick=DCLGetReal('AXIS:RSIZET1')
           simfac=DCLGetReal('GRAPH:SIMFAC')
           index=DCLGetInteger('AXIS:INDEXT1')

           ! 目盛長さ(動径)
           rtick=vtick/simfac 
           ! 角度座標軸目盛
           do i=1,size(vvalue)
              call DCLDrawLine( (/h_axis%upper,h_axis%upper-rtick/),&
                   (/vvalue(i),vvalue(i)/),1,index)
              call DCLDrawLine( (/h_axis%lower,h_axis%lower+rtick/),&
                   (/vvalue(i),vvalue(i)/),1,index)
           enddo

           ! 目盛長さ(角度)
           thetatick=(vtick/simfac/h_axis%upper)*180.0/3.1415926
           ! 動径座標軸目盛
           do i=1,size(hvalue)
              call DCLDrawLine( (/hvalue(i),hvalue(i)/),&
                   (/v_axis%lower,v_axis%lower+thetatick/),1,index)
              call DCLDrawLine( (/hvalue(i),hvalue(i)/),&
                   (/v_axis%upper,v_axis%upper-thetatick/),1,index)
           enddo

        case(10:15, 20:23, 30:33)
            call DCLDrawGrid()

    end select
end subroutine 

subroutine GTAxisClose(axis)
    use gtgraph_types, only: GT_AXIS
    use gtdata_generic, only: Close
    type(GT_AXIS), intent(inout):: axis
continue
    ! 判定が面倒なので var を多重 close してしまう。
    call Close(axis%var)
end subroutine
