zOs/REXX.O13/FTAB

/* copy fTab begin ****************************************************/
fTabReset: procedure expose m.
parse arg m, m.m.titBef, m.m.titAft
    m.m.generated = ''
    m.m.0 = 0
    m.m.len = 0
    m.m.cols = ''
    m.m.tit.0 = words(m.m.titBef m.m.titAft) + 5
    m.m.set.0 = 0
    do tx=1 to m.m.tit.0
        m.m.tit.tx = ''
        end
    return m
endProcedure fTabReset

/* add a piece to title tx at current pos */
fTabAddTit: procedure expose m.
parse arg m, tx, t1
    m.m.generated = ''
    m.m.tit.tx = left(m.m.tit.tx, m.m.len) || t1
    return m
endProcedure fTabAddTit

/*--- set the infos for one column -----------------------------------*/
fTabSet: procedure expose m.
parse arg m, c1 aDone, f1, l1
    sx = m.m.set.0 + 1
    m.m.set.0 = sx
    m.m.set.sx = c1 aDone
    m.m.set.sx.fmt = f1
    m.m.set.sx.label = l1
    m.m.set.c1 = sx
    return
endProcedure fTabSet

fTabAdd: procedure expose m.
parse arg m, c1 aDone, f1, l1
    cx = m.m.0 + 1
    m.m.generated = ''
    m.m.0 = cx
    m.m.cols = m.m.cols c1
    if words(m.m.cols) <> cx then
        call err 'mismatch of column number' cx 'col' c1
    if length(aDone) > 1 | wordPos('<'aDone'>', '<> <0> <1>') < 1 then
        call err 'bad done' length(aDone) '<'aDone'> after c1' c1
    m.m.cx.col = c1
    m.m.cx.done = aDone \== 0
    if l1 == '' then
        m.m.cx.label = c1
    else
        m.m.cx.label = l1
    px = pos('%', f1)
    ax = pos('@', f1)
    if px < 1 | (ax > 0 & ax < px) then
        m.m.cx.fmt = f1
    else
        m.m.cx.fmt = left(f1, px-1)'@'c1 || substr(f1, px)
    m.fTabTst.c1 = m.m.cx.label
    t1 = f(f1, m.m.cx.label)
    if pos(strip(t1), m.m.cx.label) < 1 then
        t1 = left(left('', max(0, verify(t1, ' ') -1))m.m.cx.label,
           , length(t1))
    m.m.cx.len = length(t1)
    call fTabAddTit m, 1, t1
    do tx=2 to arg()-3
        if arg(tx+3) \== '' then
            call fTabAddTit m, tx, arg(tx+3)
        end
    m.m.len = m.m.len + length(t1)
    return m
endProcedure fTabAdd

fTabGenerate: procedure expose m.
parse arg m
    f = ''
    do kx=1 to m.m.0
        f = f || m.m.kx.fmt
        end
    m.m.fmt = m'.fmtKey'
    call fGen f, m.m.fmt

    cSta = m.m.tit.0+3
    do cEnd=cSta until kx > m.m.0
        cycs = ''
        do cx=cSta to cEnd
            m.m.tit.cx = ''
            cycs = cycs cx
            end
        cx = cSta
        ll = 0
        do kx=1 to m.m.0 while length(m.m.tit.cx) < max(ll,1)
            m.m.tit.cx = left(m.m.tit.cx, ll)m.m.kx.col
            cx = cx + 1
            if cx > cEnd then
                cx = cSta
            ll = ll + m.m.kx.len
            end
        end
    m.m.cycles = strip(cycs)
    m.m.tit.1 = translate(lefPad(m.m.tit.1, m.m.len), '-', ' ')'---'
    m.m.generated = m.m.generated't'
    return
endProcedure fTabGenerate

fTabColGen: procedure expose m.
parse arg m
    do kx=1 to m.m.0
        l = if(m.m.kx.label == m.m.kx.col, , m.m.kx.label)
        f = lefPad(l, 10) lefPad(m.m.kx.col, 18)
        if length(f) > 29 then
           if length(l || m.m.kx.col) < 29 then
               f = l || left('', 29 - length(l||m.m.kx.col))m.m.kx.col
           else
               f = lefPad(strip(l m.m.kx.col), 29)
        g = strip(m.m.kx.fmt)
        o = right(g, 1)
        if pos(o, 'dief') > 0 then
            f = f '@'m.m.kx.col'%12e @'m.m.kx.col'%18c'
        else if o = 'C' then
            f = f left(g, length(g)-1)'c'
        else
            f = f g
        m.m.kx.colFmt = f
        end
    m.m.generated = m.m.generated'c'
    return
endProcedure fTabColGen

fTab: procedure expose m.
parse arg m
    call fTabBegin m
    do forever
        i = inO()
        if i == '' then
           leave
        call out f(m.m.fmt, i)
        end
    return fTabEnd(m)
endProcedure fTab

fTabCol: procedure expose m.
parse arg m, i
    if pos('c', m.m.generated) < 1 then
        call fTabColGen m
    do cx=1 to m.m.0
        call out f(m.m.cx.colFmt, i)
        end
    return 0
endProcedure fTabCol

fTabBegin: procedure expose m.
parse arg m
    if pos('t', m.m.generated) < 1 then
        call fTabGenerate m
    return fTabTitles(m, m.m.titBef)

fTabEnd: procedure expose m.
parse arg m
    return fTabTitles(m, m.m.titAft)

fTabTitles: procedure expose m.
parse arg m, list
    list = repAll(list, 'c', m.m.cycles)
    do tx=1 to words(list)
        t1 = word(list, tx)
        call out m.m.tit.t1
        end
    return m
endProcedure fTabTitles
/* copy fTab end   ****************************************************/