zOs/REXX.O08/TREE

/* copy tree begin ****************************************************/
treeCopy: procedure expose m.
parse arg m, nx
    if nx > length(m.treeCopy.m.src) then
        qx = length(m.treeCopy.m.src)
    else
        qx = nx - 1
    dst = m.treeCopy.m.dest
    if dst ^= '' & m.treeCopy.m.read then do
        v = left(m.treeCopy.m.src, qx)
        if v ^= '' then
            call treeAdd dst, , v
        end
    m.treeCopy.m.src = overlay('', m.treeCopy.m.src, 1, qx)
    return
endProcedure treeCopy

treeCopyDest: procedure expose m.
parse arg m, nx, dst
    call treeCopy m, nx
    m.treeCopy.m.dest = dst
    return
endProcedure treeCopyDest

treeCopyRead: procedure expose m.
parse arg m, rdr, var
    if m.treeCopy.m.read then
        call treeCopy m, 1 + length(m.treeCopy.m.src)
    m.treeCopy.m.read = ooRead(rdr, var)
    if m.treeCopy.m.read then
        m.treeCopy.m.src = m.var
    return m.treeCopy.m.read
endProcedure treeCopyRead

treeCopyOpen: procedure expose m.
parse arg m, rdr, keep
    call ooDefRead m, 'res = treeCopyRead("'m'", "'rdr'", var);'
    if key ^== 1 then do
        m.treeCopy.m.read = 0
        m.treeCopy.m.dest = ''
        end
    return m
endProcedure treeCopyOpen

treeRoot: procedure expose m.
parse arg ro, ky, va
    if ro == '' then
        ro = ooNew()
    m.ro = va
    m.ro.key = ky
    m.ro.0 = 0
    return ro
endProcedure treeRoot

treeAdd: procedure expose m.
parse arg pa, ky, va
    if ky ^== '' & symbol('m.pa.index.ky') == 'VAR' then
        call err 'add existing key' ky 'to node' pa
    cx = m.pa.0 + 1
    m.pa.0 = cx
    m.pa.cx.0 = 0
    m.pa.cx = va
    m.pa.cx.key = ky
    if ky ^== '' then
        m.pa.index.ky = pa'.'cx
    return pa'.'cx
endProcedure treeAdd

treePut: procedure expose m.
parse arg pa, ky, va
    if symbol('m.pa.index.ky') == 'VAR' then do
        ch = m.pa.index.ky
        m.ch = va
        end
    else do
        call treeAdd pa, ky, va
        end
    return
endProcedure treePut

treeGetCh: procedure expose m.
parse arg pa, ky
    if symbol('m.pa.index.ky') ^== 'VAR' then
        return ''
    return m.pa.index.ky
endProcedure treeGetChild

treeGetVa: procedure expose m.
parse arg pa, ky
    if symbol('m.pa.index.ky') ^== 'VAR' then
        return ''
    ch = m.pa.index.ky
    return m.ch
endProcedure treeGetVa

treeGetChNo: procedure expose m.
parse arg pa, no
    if symbol('m.pa.no') ^== 'VAR' then
        return ''
    return pa'.'ch
endProcedure treeGetChNo

treeRemoveCh: procedure expose m.
parse arg pa, rmPar
    do cx=1 to m.pa.0
        ky = m.pa.cx.key
        drop m.pa.index.ky
        call treeRemoveCh pa'.'cx, 1
        end
    m.pa.0 = 0
    if rmPar = 1 then do
        drop m.pa m.pa.key m.pa.0
        end
    return
endProcedure treeRemoveCh

treeShow: procedure expose m.
parse arg nd, lv
    if lv = '' then
        lv = 0
    say left('', lv)nd m.nd.key'='strip(m.nd, 't')
    if symbol('m.nd.0') == 'VAR' then do
        do cx=1 to m.nd.0
            call treeShow nd'.'cx, lv+1
            end
        end
    return
endProcedure treeShow
/* copy tree end   ****************************************************/