Rosetta Code - ABC Problem, GUI

NoMainWin
global blocks$
dim block(20,2), block$(20,2)
'numeric blocks, col 0 flags used block
'default blocks
block(1,1)=asc("B")-64: block(1,2)=asc("O")-64 ' (B O)
block(2,1)=asc("X")-64: block(2,2)=asc("K")-64 ' (X K)
block(3,1)=asc("D")-64: block(3,2)=asc("Q")-64 ' (D Q)
block(4,1)=asc("C")-64: block(4,2)=asc("P")-64 ' (C P)
block(5,1)=asc("N")-64: block(5,2)=asc("A")-64 ' (N A)
block(6,1)=asc("G")-64: block(6,2)=asc("T")-64 ' (G T)
block(7,1)=asc("R")-64: block(7,2)=asc("E")-64 ' (R E)
block(8,1)=asc("T")-64: block(8,2)=asc("G")-64 ' (T G)
block(9,1)=asc("Q")-64: block(9,2)=asc("D")-64 ' (Q D)
block(10,1)=asc("F")-64: block(10,2)=asc("S")-64 ' (F S)
block(11,1)=asc("J")-64: block(11,2)=asc("W")-64 ' (J W)
block(12,1)=asc("H")-64: block(12,2)=asc("U")-64 ' (H U)
block(13,1)=asc("V")-64: block(13,2)=asc("I")-64 ' (V I)
block(14,1)=asc("A")-64: block(14,2)=asc("N")-64 ' (A N)
block(15,1)=asc("O")-64: block(15,2)=asc("B")-64 ' (O B)
block(16,1)=asc("E")-64: block(16,2)=asc("R")-64 ' (E R)
block(17,1)=asc("F")-64: block(17,2)=asc("S")-64 ' (F S)
block(18,1)=asc("L")-64: block(18,2)=asc("Y")-64 ' (L Y)
block(19,1)=asc("P")-64: block(19,2)=asc("C")-64 ' (P C)
block(20,1)=asc("Z")-64: block(20,2)=asc("M")-64 ' (Z M)
 
[FillAlphaBlocks]
'blocks$="BO XK DQ CP NA GT RE TG QD FS JW HU VI AN OB ER FS LY PC ZM"
blocks$=""
for x=1 to 20
    for y=1 to 2
        blocks$=blocks$+chr$(block(x,y)+64)
    next y
    if x<20 then blocks$=blocks$+" "
next x
if NewBlocks then call DisplayBlocks: wait
 
'set up the word list
dim w$(25)
w$(1)="A"
w$(2)="BARK"
w$(3)="BOOK"
w$(4)="TREAT"
w$(5)="COMMON"
w$(6)="SQUAD"
w$(7)="CONFUSE"
 
WindowWidth = 800 : WindowHeight = 600
BackgroundColor$="191 191 255"
'statictext #win.debug, "Debug Line", 0, 0, 785, 17
statictext #win.Title, "Rosetta Code - ABC Problem", 55, 35, 277, 45
stylebits #win.BlockSet, _ES_READONLY, _WS_HSCROLL or _WS_VSCROLL or _WS_DLGFRAME, 0, 0
texteditor #win.BlockSet, 55, 100, 160, 240
statictext #win.Caption1, "Block Set", 100, 350, 100, 25
button #win.NewBlocks, "New Blocks", [NewBlocksClick], ul, 230, 100, 130, 40
textbox #win.NewWord, 380, 110, 157, 25
combobox #win.WordList, w$(), [ListClick], 380, 160, 174, 21
button #win.Enter, "Enter New Word", [EnterClick], ul, 590, 100, 120, 40
button #win.Quit, "Quit", QuitClick, ul, 590, 160, 120, 40
statictext #win.Result, "", 240, 240, 315, 30
stylebits #win.Solution, _ES_READONLY, _WS_HSCROLL or _WS_DLGFRAME, 0, 0
texteditor #win.Solution, 235, 285, 475, 220
 
open "Rosetta Code - ABC Problem" for dialog_nf as #win
#win "TrapClose QuitClick"
#win "Font Ariel 10"
#win.BlockSet "!Font Courier_New 12"
#win.Title "!Font Ariel 14 Bold"
#win.NewWord "!Font Courier_New 12"
#win.WordList "!Reload"
#win.WordList "!Word List"
#win.Result "!Font Ariel 12 Bold"
#win.Solution "!Font Courier_New 12"
 
call DisplayBlocks
wait
 
[EnterClick]
#win.NewWord "!SelectAll"
#win.NewWord "!Contents? x$"
w$=""
x$=upper$(x$)
for x=1 to len(x$)
    y$=mid$(x$,x,1)
    if y$>="A" and y$<="Z" then w$=w$+y$
next x
goto [StartWord]
 
[ListClick]
#win.WordList "Selection? w$"
 
[StartWord]
x=canDo(w$,blocks$)
#win.Result w$; "  ";
if x then #win.Result w$+"   True" else #win.Result w$+"   False"
wait
 
[NewBlocksClick]
    dim block(20,2)
    for x=1 to 20 'A to T go on side 1 of all blocks
        block(x,1)=x
    next x
    for x=21 to 26 'U to Z go on side 2 of random blocks
        [a]
        y=RandomBlock()
        if block(y,2)=0 then block(y,2)=x else goto [a]
    next x
    for x=1 to 25 'Vowels go on side 2 of random blocks
        [b]
        y=RandomBlock()
        select case x
            case 1, 5, 9, 15, 21, 25 'A E I O U and Y
                if block(y,2)=0 and block(y,1)<>x then
                    block(y,2)=x
                else
                    goto [b]
                end if
        end select
    next x
    x$="BCDFGHJKLMNPQRST"
    for x=1 to 8 'random consonants go on side 2 of remaining blocks
        [c]
        z=RandomNumber(1,16)
        if mid$(x$,z,1)=" " then goto [c]
        w=asc(mid$(x$,z,1))-64
        mid$(x$,z,1)=" "
        [d]
        y=RandomBlock()
        if block(y,2)=0 and block(y,1)<>w then
            block(y,2)=w
        else
            goto [d]
        end if
    next x
    x$="ABCDEFGHIJKLMNOPQRST"
    for x=1 to 20 'shuffle the new blocks
        [e]
        z=RandomNumber(1,20)
        if mid$(x$,z,1)=" " then goto [e]
        w=asc(mid$(x$,z,1))-64
        mid$(x$,z,1)=" "
        block(x,0)=w
    next x
    sort block(), 1, 20, 0
    for x=1 to 20
        block(x,0)=0
    next x
    #win.WordList "SelectIndex 0"
    #win.WordList "!Word List"
    #win.Result ""
    #win.Solution "!cls"
    NewBlocks=1
    goto [FillAlphaBlocks]
 
'- - - - - - - - - S U B R O U T I N E S   &   F U N C T I O N S - - - - - - -
 
function canDo(text$,blocks$)
'print  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
 
sub QuitClick CallingHandle$
close #win
end
end sub
 
function RandomBlock()
    RandomBlock=RandomNumber(1,20)
end function
 
function RandomNumber(min, max)
    RandomNumber = (int(rnd(1)*(max-min+1))+1)+min-1
end function
 
sub DisplayBlocks
'blocks$="BO XK DQ CP NA GT RE TG QD FS JW HU VI AN OB ER FS LY PC ZM"
    #win.BlockSet "!cls"
    for x=1 to 60 step 6
            #win.BlockSet "("; mid$(blocks$, x, 1);
            #win.BlockSet " "; mid$(blocks$, x+1, 1); ")   ";
            #win.BlockSet "("; mid$(blocks$, x+3, 1);
            #win.BlockSet " "; mid$(blocks$, x+4, 1); ")   "
    next x
    #win.NewWord "!SetFocus"
end sub