! Copyright (C) GFD Dennou Club, 2000.  All rights reserved.

subroutine GtObjClear(obj)
    use gtgraph_types, only: GT_OBJECT
    use dc_trace, only: beginsub, endsub
    implicit none
    type(GT_OBJECT), intent(out):: obj
    call beginsub('gtobjclear')
    nullify(obj%axis, obj%cont, obj%line)
    nullify(obj%fig, obj%frame, obj%next)
    call endsub('gtobjclear')
end subroutine

subroutine GtObjOpen(obj)
    use gtgraph_types, only: GT_OBJECT
    use dc_trace, only: beginsub, endsub
    implicit none
    type(GT_OBJECT), intent(out):: obj
    call beginsub('gtobjopen')
    call GtObjClear(obj)
    call endsub('gtobjopen')
end subroutine

recursive subroutine GTObjLoadC(obj, varname, slice_spec)
    use gtgraph_types, only: GT_OBJECT
    use gtgraph_generic, only: Load
    use gtdata_types, only: GT_VARIABLE
    use gtdata_generic, only: Open, Slice
    use dc_trace, only: beginsub, endsub
    use dc_types, only: STRING
    implicit none
    type(GT_OBJECT), intent(out):: obj
    character(len = STRING), intent(in):: varname
    character(len = string), intent(in), optional:: slice_spec
    type(GT_VARIABLE):: var
    logical:: err
    call beginsub('gtobjload', '%c', c1=trim(varname))
    call Open(var, varname)
    if (present(slice_spec)) then
        if (slice_spec /= "") then
            call slice(var, slice_spec, err)
        endif
    endif
    call Load(obj, var)
    call endsub('gtobjload')
end subroutine

recursive subroutine GTObjLoadVar(obj, var)
    use gtgraph_types, only: GT_OBJECT
    use gtdata_types, only: GT_VARIABLE
    use gtdata_generic, only: get_attr, inquire
    use gtgraph_generic, only: Open, Clear, Load
    use dc_string, only: VSTRING, operator(==)
    use dc_trace, only: beginsub, endsub, message
    use dc_error
    implicit none
    type(GT_OBJECT), intent(out):: obj
    type(GT_VARIABLE), intent(in):: var
    type(VSTRING):: var_class
    integer:: ndims
continue
    call beginsub('gtobjloadvar', 'var.mapid=%d', i=(/var%mapid/))
    call Clear(obj)
    call get_attr(var, "gt_structure_class", var_class, default="data")
    if (var_class == "frame") then
        allocate(obj%frame)
        call Open(obj%frame)
        call Load(obj%frame, var)
    else if (var_class == "figure") then
        allocate(obj%fig)
        call Open(obj%fig)
        call Load(obj%fig, var)
    else if (var_class == "contours") then
        allocate(obj%cont)
        call Load(obj%cont, var)
    else if (var_class == "line") then
        allocate(obj%line)
        call Load(obj%line, var)
    else if (var_class == "axis") then
        allocate(obj%axis)
        call Load(obj%line, var)
    else
        call inquire(var, rank=ndims)
        call message('# rank = %d', i=(/ndims/))
        select case(ndims)
        case(1)
            allocate(obj%line)
            call Open(obj%line, var)
        case(2:)
            allocate(obj%cont)
            call Open(obj%cont, var)
        case default
            call StoreError(GT_EFAKE, 'GtObjLoadVar(ndims = 0)')
        end select
    endif
    call endsub('gtobjloadvar')
end subroutine

recursive subroutine GtObjClose(obj)
    use gtgraph_types, only: GT_OBJECT
    use gtgraph_generic, only: GTAxisClose, GTLineClose, GTContClose, &
        & GTFigClose, GTFrameClose
    use dc_trace, only: beginsub, endsub, message
    implicit none
    type(GT_OBJECT), intent(out):: obj
    call beginsub('gtobjclose')
    if (associated(obj%next)) then
        call GtObjClose(obj%next)
        deallocate(obj%next)
    endif
    if (associated(obj%axis)) then
        deallocate(obj%axis)
        call GTAxisClose(obj%axis)
    endif
    if (associated(obj%cont)) then
        deallocate(obj%cont)
        call GTContClose(obj%cont)
    endif
    if (associated(obj%line)) then
        deallocate(obj%line)
        call GTLineClose(obj%line)
    endif
    if (associated(obj%fig)) then
        deallocate(obj%fig)
        call GTFigClose(obj%fig)
    endif
    if (associated(obj%frame)) then
        deallocate(obj%frame)
        call GTFrameClose(obj%frame)
    endif
    call endsub('gtobjclose')
end subroutine

subroutine GtObjInquire(obj, type)
    use gtgraph_types, only: GT_OBJECT
    use dc_trace, only: beginsub, endsub, message
    implicit none
    type(GT_OBJECT), intent(in):: obj
    character(len = *), intent(out), optional:: type
    call beginsub('gtobjinquire')
    if (present(type)) then
        if (associated(obj%axis)) then
            type = "axis"
        else if (associated(obj%cont)) then
            type = "contours"
        else if (associated(obj%line)) then
            type = "line"
        else if (associated(obj%fig)) then
            type = "figure"
        else if (associated(obj%frame)) then
            type = "frame"
        else
            type = ""
        endif
    endif
    call endsub('gtobjinquire')
end subroutine

subroutine GtObjOption(obj, optname, value, err)
    use gtgraph_types, only: GT_OBJECT
    use gtgraph_generic, only: Option
    use dc_trace, only: beginsub, endsub, message
    implicit none
    type(GT_OBJECT), intent(inout):: obj
    character(len = *), intent(in):: optname
    character(len = *), intent(in):: value
    logical, intent(out):: err
continue
    call beginsub('gtobjoption', '<%c=%c>', c1=optname, c2=value)
    if (associated(obj%cont)) then
        call message('forwarding obj to cont')
        call Option(obj%cont, optname, value, err)
    else if (associated(obj%line)) then
        call message('forwarding obj to line')
        call Option(obj%line, optname, value, err)
    else if (associated(obj%fig)) then
        call message('forwarding obj to fig')
        call Option(obj%fig, optname, value, err)
    else
        err = .TRUE.
    endif
    call endsub('gtobjoption')
end subroutine

    ! --- GtObjBindObj --- 
    ! bind の原則
    !  child と parent のうち上位のクラスのものが保持される。
    !  同位クラスの場合は直上クラスを作成し両者を突っ込む。
    !  (両者ともに frame の場合は next に連鎖)
subroutine GTObjBindObj(parent, child)
    use gtgraph_types, only: GT_OBJECT
    use gtgraph_generic, only: Inquire, Bind, Clear, Open
    use dc_trace, only: beginsub, endsub, message
    implicit none
    type(GT_OBJECT), intent(inout), target:: parent
    type(GT_OBJECT), intent(inout):: child
    character(len = 8):: child_type, parent_type
    type(GT_OBJECT), pointer:: objp
continue
    call beginsub('gtobjbindobj')
    call Inquire(child, type=child_type)
    call Inquire(parent, type=parent_type)
    ! --- どちらかが空なら空でないほうを parent に ---
    if (child_type == "") return
    if (parent_type == "") then
        ! 親が空ならただ移すだけ
        parent = child
        call Clear(child)
        return
    endif
    ! --- next を誰かがもつ場合 ---
    ! とりあえず省略ね
    ! --- 図形要素どうしの操作 ---
    if (parent_type == "frame") then
        ! 親子ともに枠なら連鎖、それ以外のものは枠内に設置
        select case(child_type)
        case("frame")
            goto 1000
        case("figure")
            call Bind(parent%frame, child%fig)
        case("contours")
            allocate(child%fig)
            call Bind(child%fig, child%cont)
            call Bind(parent%frame, child%fig)
        case("line")
            allocate(child%fig)
            call Bind(child%fig, child%line)
            call Bind(parent%frame, child%fig)
        case("axis")
            allocate(child%fig)
            call Bind(child%fig, child%axis)
            call Bind(parent%frame, child%fig)
        end select
    else if (child_type == "frame") then
        ! 親は枠以下なので子の中に設置
        select case(parent_type)
        case("figure")
            call Bind(child%frame, parent%fig)
        case("contours")
            allocate(parent%fig)
            call Bind(parent%fig, parent%cont)
            call Bind(child%frame, parent%fig)
        case("line")
            allocate(parent%fig)
            call Bind(parent%fig, parent%line)
            call Bind(child%frame, parent%fig)
        case("axis")
            allocate(parent%fig)
            call Bind(parent%fig, parent%axis)
            call Bind(child%frame, parent%fig)
        end select
        call Clear(parent)
        parent%frame => child%frame
    else if (parent_type == "figure") then
        select case(child_type)
        case("figure")
            allocate(parent%frame)
            call Open(parent%frame)
            call Bind(parent%frame, parent%fig)
            nullify(parent%fig)
            call Bind(parent%frame, child%fig)
        case("contours")
            call Bind(parent%fig, child%cont)
        case("line")
            call Bind(parent%fig, child%line)
        case("axis")
            call Bind(parent%fig, child%axis)
        end select
    else if (child_type == "figure") then
        ! 親は図以下なので子の図の中に親の要素を置く
        select case(parent_type)
        case("contours")
            call Bind(child%fig, parent%cont)
        case("line")
            call Bind(child%fig, parent%line)
        case("axis")
            call Bind(child%fig, parent%axis)
        end select
        call Clear(parent)
        parent%fig => child%fig
    else
        ! 親も子も図以下の場合はとにかく図を作って両方投入
        allocate(parent%fig)
        call Open(parent%fig)
        select case(parent_type)
        case("contours")
            call Bind(parent%fig, parent%cont)
            nullify(parent%cont)
        case("line")
            call Bind(parent%fig, parent%line)
            nullify(parent%line)
        case("axis")
            call Bind(parent%fig, parent%axis)
            nullify(parent%axis)
        end select
        select case(child_type)
        case("contours")
            call Bind(parent%fig, child%cont)
        case("line")
            call Bind(parent%fig, child%line)
        case("axis")
            call Bind(parent%fig, child%axis)
        end select
    endif
    call Clear(child)
    call endsub('gtobjbindobj')
    return

    1000 continue
        objp => parent
        do
            if (.not. associated(objp%next)) exit
            objp => objp%next
        enddo
        ! child へのポインタは当サブルーチンを抜けると無効になるので、
        ! 別実体を割り当ててから代入する。所詮数個のポインタ代入なので高速。
        allocate(objp%next)
        objp%next = child
        call Clear(child)
        call endsub('gtobjbindobj')
    return
end subroutine
