zOs/REXX.O08/J

/* copy j begin *******************************************************
    the j framework
         jReset
         jOpen
         jClose
         jRead
         jWrite
***********************************************************************/
jRead: procedure expose m.
parse arg m, var
    if m.m.jReading then
        interpret oObjMethod(m, 'jRead')
    else
        call err 'jRead('m',' var') but not opened r'
endProcedure jRead

jWrite: procedure expose m.
parse arg m, line
    if m.m.jWriting then
        interpret oObjMethod(m, 'jWrite')
    else
        call err 'jWrite('m',' line') but not opened w'
    return
endProcedure jWrite

jWriteAll: procedure expose m.
parse arg m, opt, rdr
    interpret oObjMethod(m, 'jWriteAll')
    return
endProcedure jWriteAll

jWriteAllImpl: procedure expose m.
parse arg m, opt, rdr
    if pos('-', opt) < 1 then
        call jOpen rdr, catOpt(opt)
    do while jRead(rdr, line)
        call jWrite m, m.line
        end
    if pos('-', opt) < 1 then
        call jClose rdr
    return
endProcedure jWriteAll

jReset: procedure expose m.
parse arg m, arg
    call jClose m
    interpret oObjMethod(m, 'jReset')
    return m
endProcedure jOpen

jOpen: procedure expose m.
parse arg m, arg
    interpret oObjMethod(m, 'jOpen')
    return m
endProcedure jOpen

jClose: procedure expose m.
parse arg m
    if m.m.jReading = 1 | m.m.jWriting = 1 then
        interpret oObjMethod(m, 'jClose')
    m.m.jReading = 0
    m.m.jWriting = 0
    return m
endProcedure jClose

/*--- analyze an option in oOpt and oVal -----------------------------*/
jOpt: procedure expose m.
parse arg src, alone, val
    m.j.oOpt = ''
    if left(src, 1) ^== '-' then do
        m.j.oVal = src
        return 0
        end
    sx = 2
    if alone ^== '' then do
        sx = verify(src, alone, 'n', sx)
        if sx = 0  then
            sx = length(src)+1
        end
    if length(src) < sx then
        m.j.oVal = ''
    else if val == '' then
        call err 'bad opt "'src'" should contain only "'alone'"'
    else if pos(substr(src, sx, 1), val) < 1 then
        call err 'bad opt "'src'" should contain only "'alone'"' ,
                        'and/or 1 of "'val'" with value'
    else do
        sx = sx + 1
        m.j.oVal = substr(src, sx)
        end
    m.j.oOpt = substr(src, 2, sx-2)
    return 1
endProcedure jOpt

jIni: procedure expose m.
    if m.j.ini == 1 then
        return
    m.j.ini = 1
    call oIni
    call oDecMethods oNewClass("JRW"),
        , "jRead  call err 'jRead('m',' var') but not opened r'",
        , "jWrite call err 'jWrite('m',' line') but not opened w'",
        , "jWriteAll call jWriteAllImpl m, opt, rdr",
        , "jRead drop m.arg; return 0",
        , "jWrite say 'jOut:' line",
        , "jReset ;",
        , "jOpen ;",
        , "jClose ;"
    x = oNew("JRW")
    m.j.jIn = x
    m.x.jReading = 1
    m.x.jWriting = 0
    x = oNew("JRW")
    m.j.jOut = x
    m.x.jReading = 0
    m.x.jWriting = 1
    call oDecMethods oNewClass("Jbuf", "JRW"),
        , "jOpen return jBufOpen(m, arg)",
        , "jReset return jBufReset(m, arg)",
        , "oSetTypePara call jBufSetTypePara m, type",
        , "jRead return jBufRead(m, var)",
        , "jWrite call jBufWrite m, line"
    return
endProcedure jInit

jIn: procedure expose m.
parse arg arg
    return jRead(m.j.jIn, arg)
endProcedur jIn

jOut: procedure expose m.
parse arg arg
    call jWrite m.j.jOut, arg
    return
endProcedure jOut

/*--- jBuf: buffer read or write (supports datataypes) ---------------*/
jBuf: procedure expose m.
    m = oNew('Jbuf')
    call jBufReset m
    do ax=1 to arg()
        m.m.buf.ax = arg(ax)
        end
    m.m.buf.0 = ax-1
    return m
endProcedure jBuf

jBufReset: procedure expose m.
parse arg m
    m.m.stem = m'.BUF'
    m.m.buf.0 = 0
    call oSetTypePara m
    do ax=1 to arg() - 1
        m.m.buf.ax = arg(ax+1)
        m.m.buf.0 = ax
        end
    return m
endProcedure jBufReset

jBufSetTypePara: procedure expose m.
parse arg m, type
    if m.m.buf.0 <> 0 then
        call err 'jBufSetTypePara but not empty'
    return
endProcedure jBufSetTypePara

jBufOpen: procedure expose m.
parse arg m, opt
    call jClose m
    if opt == 'r' then do
        m.m.readIx = 0
        m.m.jReading = 1
        return m
        end
    if opt == 'w' then
        m.m.buf.0 = 0
    else if opt ^== 'a' then
        call err 'jBufOpen('m',' opt') with bad opt'
    m.m.jWriting = 1
    return m
endProcedure jBufOpen

jBufRead: procedure expose m.
parse arg m, var
    nx = m.m.readIx + 1
    if nx > m.m.buf.0 then
        return 0
    m.m.readIx = nx
    ty = oGetTypePara(m)
    if abbrev(ty, '=') then
        m.var = m.m.buf.nx
    else
        call oTyCopy ty, var, m'.BUF.'nx
    return 1
endProcedure jBufRead

jBufWrite: procedure expose m.
parse arg m, line
    nx = mInc(m'.BUF.0')
    ty = oGetTypePara(m)
    if abbrev(ty, '=') then
       m.m.buf.nx = line
    else
        call oTyCopy ty, m'.BUF.'nx, line
    return 1
endProcedure jBufRead
/* copy j end *********************************************************/