134 lines
3.9 KiB
Plaintext
134 lines
3.9 KiB
Plaintext
print "Rosetta Code - ABC problem (procedural solution)"
|
|
print
|
|
w$(1)="A"
|
|
w$(2)="BARK"
|
|
w$(3)="BOOK"
|
|
w$(4)="TREAT"
|
|
w$(5)="COMMON"
|
|
w$(6)="SQUAD"
|
|
w$(7)="CONFUSE"
|
|
|
|
for x=1 to 7
|
|
print ">>> can_make_word("; chr$(34); w$(x); chr$(34); ")"
|
|
if CanMakeWord(w$(x)) then print "True" else print "False"
|
|
next x
|
|
print "Program complete."
|
|
end
|
|
|
|
function CanMakeWord(x$)
|
|
global DoneWithWord, BlocksUsed, LetterOK, Possibility
|
|
dim block$(20,2), block(20,2)
|
|
'numeric blocks, col 0 flags used block
|
|
block(1,1)=asc("B")-64: block(1,2)=asc("O")-64
|
|
block(2,1)=asc("X")-64: block(2,2)=asc("K")-64
|
|
block(3,1)=asc("D")-64: block(3,2)=asc("Q")-64
|
|
block(4,1)=asc("C")-64: block(4,2)=asc("P")-64
|
|
block(5,1)=asc("N")-64: block(5,2)=asc("A")-64
|
|
block(6,1)=asc("G")-64: block(6,2)=asc("T")-64
|
|
block(7,1)=asc("R")-64: block(7,2)=asc("E")-64
|
|
block(8,1)=asc("T")-64: block(8,2)=asc("G")-64
|
|
block(9,1)=asc("Q")-64: block(9,2)=asc("D")-64
|
|
block(10,1)=asc("F")-64: block(10,2)=asc("S")-64
|
|
block(11,1)=asc("J")-64: block(11,2)=asc("W")-64
|
|
block(12,1)=asc("H")-64: block(12,2)=asc("U")-64
|
|
block(13,1)=asc("V")-64: block(13,2)=asc("I")-64
|
|
block(14,1)=asc("A")-64: block(14,2)=asc("N")-64
|
|
block(15,1)=asc("O")-64: block(15,2)=asc("B")-64
|
|
block(16,1)=asc("E")-64: block(16,2)=asc("R")-64
|
|
block(17,1)=asc("F")-64: block(17,2)=asc("S")-64
|
|
block(18,1)=asc("L")-64: block(18,2)=asc("Y")-64
|
|
block(19,1)=asc("P")-64: block(19,2)=asc("C")-64
|
|
block(20,1)=asc("Z")-64: block(20,2)=asc("M")-64
|
|
|
|
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
|
|
if w$="" then exit function
|
|
DoneWithWord=0: BlocksUsed=0
|
|
l=len(w$)
|
|
dim LetterOK(l)
|
|
dim alphabet(26,1) 'clear letter-usage array
|
|
for x=1 to 20 'load block letters into letter-usage array col 0
|
|
alphabet(block(x,1),0)+=1
|
|
alphabet(block(x,2),0)+=1
|
|
next x
|
|
for x=1 to l 'load current word into letter-usage aray col 1
|
|
wl$=mid$(w$,x,1): w=asc(wl$)-64
|
|
alphabet(w,1)+=1
|
|
next x
|
|
|
|
for x=1 to 26 ' test for more of any letter in the word than in the blocks
|
|
if alphabet(x,1)>alphabet(x,0) then exit function
|
|
next x
|
|
|
|
[NextLetter]
|
|
if wl<l then wl=wl+1 else goto [DoneWithWord]
|
|
wl$=mid$(w$,wl,1): w=asc(wl$)-64
|
|
LetterOK=0
|
|
' if there's only one of the letter in the blocks then you must use that block
|
|
if alphabet(w,0)=1 then
|
|
call OnlyBlock w
|
|
LetterOK(wl)=1
|
|
if DoneWithWord then goto [DoneWithWord] else goto [NextLetter]
|
|
end if
|
|
' if more than one of the letter in the blocks, then try to use one that has
|
|
' an unused letter on other side (a "Free Block")
|
|
call FindFreeBlock w
|
|
if LetterOK then LetterOK(wl)=1
|
|
goto [NextLetter]
|
|
|
|
[DoneWithWord]
|
|
if BlocksUsed=l then CanMakeWord=1: exit function
|
|
if DoneWithWord then exit function
|
|
for x=1 to l
|
|
if not(LetterOK(x)) then
|
|
NumericLetter=asc(mid$(w$,x,1))-64
|
|
LetterOK=0
|
|
call OnlyBlock NumericLetter
|
|
if LetterOK then LetterOK(x)=1 else exit for
|
|
end if
|
|
next x
|
|
goto [DoneWithWord]
|
|
end function
|
|
|
|
sub OnlyBlock NumericLetter
|
|
for x=1 to 20
|
|
if (block(x, 1)=NumericLetter or block(x, 2)=NumericLetter) _
|
|
and block(x, 0)=0 then
|
|
call UseBlock x, NumericLetter
|
|
exit sub
|
|
end if
|
|
next x
|
|
DoneWithWord=1
|
|
end sub
|
|
|
|
sub FindFreeBlock NumericLetter
|
|
Possibility=0
|
|
for x=1 to 20
|
|
if block(x, 0)=0 then 'block not used
|
|
if block(x,1)=NumericLetter then
|
|
if alphabet(block(x,2),1)=0 then
|
|
call UseBlock x, NumericLetter
|
|
exit sub
|
|
end if
|
|
Possibility=Possibility+1
|
|
end if
|
|
if block(x,2)=NumericLetter then
|
|
if alphabet(block(x,1),1)=0 then
|
|
call UseBlock x, NumericLetter
|
|
exit sub
|
|
end if
|
|
Possibility=Possibility+1
|
|
end if
|
|
end if
|
|
next x
|
|
end sub
|
|
|
|
sub UseBlock BlockNumber, NumericLetter
|
|
block(BlockNumber, 0)=1 'Mark block as used
|
|
BlocksUsed=BlocksUsed+1
|
|
LetterOK=1
|
|
end sub
|