print "Rosetta Code - ABC problem (recursive solution)"
print
blocks$="BO XK DQ CP NA GT RE TG QD FS JW HU VI AN OB ER FS LY PC ZM"
data "A"
data "BARK", "BOOK", "TREAT", "COMMON", "SQUAD", "CONFUSE"
data "XYZZY"

do
    read text$
    if text$="XYZZY" then exit do
    print ">>> can_make_word("; chr$(34); text$; chr$(34); ")"
    if canDo(text$,blocks$) then print "True" else print "False"
loop while 1
print "Program complete."
end

function canDo(text$,blocks$)
    'endcase
    if len(text$)=1 then canDo=(instr(blocks$,text$)<>0): exit function
    'get next letter
    ltr$=left$(text$,1)
    'cut
    if instr(blocks$,ltr$)=0 then canDo=0: exit function
    'recursion
    text$=mid$(text$,2) 'rest
    'loop by all word in blocks. Need to make "newBlocks" - all but taken
    'optimisation: take only fitting blocks
    wrd$="*"
    i=0
    while wrd$<>""
        i=i+1
        wrd$=word$(blocks$, i)
        if instr(wrd$, ltr$) then
            'newblocks without wrd$
            pos=instr(blocks$,wrd$)
            newblocks$=left$(blocks$, pos-1)+mid$(blocks$, pos+3)
            canDo=canDo(text$,newblocks$)
            'first found cuts
            if canDo then exit while
        end if
    wend
end function