"token fbc.bas"

#lang "fb"

'"Token FBC.BAS" is supposed to scan a string for collisions with a list of dynamic length delimiters in the form of a token by index or otherwise the count of such.

#define  __DEBUG_TOKEN__

'Token fbc routines by Tim Keal & Mysoft

declare sub token_test()

declare sub token_by_delimiter(buffer as string, sep() as string, s() as long, byref o as long, byref d as long)

declare function token_count(subject as string, sep() as string, index as string="ct") as long

declare function token_by_index(subject as string, sep() as string, index as string="1") as string

declare function token overload (subject as string, sep() as string, index as string="1") as string

declare function token(subject as string, sep as string=",", index as string="1") as string

token_test

sub token_test()

    dim as string subject, sep, index

    do

        input "subject:", subject

        if len(subject)=0 then
            subject="hello world!"
            print "subject:"; subject
        end if

        if subject = "exit" then exit do

        input "sep:", sep
        input "index:", index

        print "token:";token(subject, sep, index)
        print "---"

    loop

end sub


sub token_by_delimiter(buffer as string, sep() as string, s() as long, byref o as long,byref d as long)

    dim as long n

    redim as long s(lbound(sep, 1) to ubound(sep, 1))

    for n = lbound(sep, 1) to ubound(sep, 1)
        s(n) = instr(1, buffer, sep(n))
    next n

    d = lbound(sep, 1)

    for n = lbound(sep, 1) to ubound(sep, 1)
        if s(n) <= s(d) and s(n) > 0 then

            o = s(n)
            d = n

        end if
    next n

end sub

function token_count(subject as string, sep() as string, index as string="ct") as long

    dim as string buffer, Ln, c, tok
    dim as long o, t, i, n, d
    dim as long s(lbound(sep, 1) to ubound(sep, 1))

    buffer = subject

    t = 0

    do while o <> 0

        c = inkey : if c = chr(27) then exit do

        t = t + 1

        token_by_delimiter buffer, sep(), s(), o, d

        if o > len(buffer) then
            tok = buffer
            o = 0
            exit do
        end if

        Ln = left(buffer, o - 1)

        #ifdef  __DEBUG_TOKEN__
            print Ln;",";
        #endif

        if o > 0 then
            buffer = mid(buffer,o + len(sep(d)))
        else
            buffer = space(0)
        end if

        #ifdef  __DEBUG_TOKEN__
            print "t:";t;",o:";o;",sz:";len(buffer)
        #endif

        if (o = 0) or (len(buffer) = 0) then exit do

    loop

    token_count=t

end function

function token_by_index(subject as string, sep() as string, index as string="1") as string

    dim as string buffer, Ln, c, tok
    dim as long o, t, i, n, d
    dim as long s(lbound(sep, 1) to ubound(sep, 1))

    buffer = subject

    t = 0

    do
        c = inkey : if c = chr(27) then exit do

        if len(buffer)=0 then exit do

        t = t + 1

        token_by_delimiter buffer, sep(), s(), o, d

        Ln = left(buffer, o - 1)

        if o > 0 then
            Ln = left(buffer, o - 1)
        else
            Ln = buffer
        end if

        if o > len(buffer) then
            tok = buffer
            o = 0
            exit do
        end if

        if o > 0 then
            buffer = mid(buffer,o + len(sep(d)))
        else
            buffer = space(0)
        end if

        #ifdef  __DEBUG_TOKEN__
            print "t:";t;",o:";o;",sz:";len(buffer)
        #endif
        if (t = i) or (o = 0) or (len(buffer) = 0) then exit do

    loop

    token_by_index = Ln

end function

function token overload (subject as string, sep() as string, index as string="1") as string
    dim as string buffer, Ln, c, tok
    dim as long o, t, i, n, d
    dim as long s(lbound(sep, 1) to ubound(sep, 1))

    buffer = subject

    if index="ct" then
        i=0
    else
        i=val(index)
    end if

    o = len(buffer)+1

    select case i

    case is > 0

        tok = token_by_index(subject, sep(), index)

    case is = 0

        tok = str(token_count(subject, sep(), "ct"))

    case else

        tok = space(0)

    end select

    #ifdef  __DEBUG_TOKEN__
        print "tok:";tok
    #endif

    token = tok

end function

function token(subject as string, sep as string=",", index as string="1") as string

  dim as string sTemp(0 to 0) : sTemp(0) = sep

  return token(subject, sTemp(), index)

end function