Post by B+ on Oct 15, 2018 18:07:28 GMT
Original from 2016 Thanksgiving Puzzle, text version:
The dx, dy arrays might remind you of Knights Tour.
'Word Search 2.txt for JB [B+=MGA] 2016-11-24
' try another approach to Word Search
'found this in newspaper 2016-11-23 "Thanksgiving Word Search"
data "OOCEPOTATOESCGDSMPEB"
data "MMMTKWDMNIKPMUPCPLPI"
data "WDOWIAGADWHYESOWRLII"
data "NTAVYLBYDDMWNRPGDTCB"
data "VESMIRGLIPCMNLMNCCEK"
data "KITAGRAVYAUUKEDIOVRT"
data "CASSEROLETCWRFGVNLFS"
data "LRTDANEMUOBTQTAIVUEQ"
data "TTYRVBKAPMMASOTGEFAF"
data "EHHEACDIHRWSTVHSRKSO"
data "VDUTLDAIKKUTUEEKSNTO"
data "ISARATIINBFYFRRNAAST"
data "TUNESSATFNKWFSIATHNB"
data "AOYRRDCEIMEBIRNHITEA"
data "NISGOBAAKOHRNLGTOYVL"
data "RCDNFCNYLSNYGFFWNTOL"
data "RIOIGHARARHSNNIKPAND"
data "HLWNBOOUOVEGETABLESQ"
data "FEGIUDQPMCDESSERTNYD"
data "PDADDSENOBHSIWPELEAF"
'words to find
data "ACORN AUTUMN BAKE BASTE CASSEROLE CONVERSATION"
data "CORNBREAD CORNUCOPIA DELICIOUS DESSERT DINING DINNER"
data "EAT FEAST FOOTBALL GATHERING GRAVY LEAF"
data "LEFTOVERS NAPKIN NATIVE OVEN PILGRIMS POTATOES"
data "PUMPKIN RECIPE SQUASH STUFFING TASTY THANKFUL"
data "THANKSGIVING THURSDAY TRADITIONS VEGETABLES WISHBONE YAM"
global xy 'for square block of letters xy is one side of square
xy = 20 : nWords = 36 : wpl = 6 'words per line
dim L$(xy, xy), W$(nWords)
DX(1) = 1 : DY(1) = 0
DX(2) = 1 : DY(2) = 1
DX(3) = 0 : DY(3) = 1
DX(4) = -1 : DY(4) = 1
DX(5) = -1 : DY(5) = 0
DX(6) = -1 : DY(6) = -1
DX(7) = 0 : DY(7) = -1
DX(8) = 1 : DY(8) = -1
for y = 1 to xy 'read in block of letters
read r$
for x = 1 to xy
L$(x,y) = mid$(r$, x, 1)
next
next
call showPuzzle
for i = 1 to nWords/wpl 'read in list of words to find
read r$
for j = 1 to wpl
W$( (i - 1) * wpl + j ) = word$(r$, j)
next
next
for i = 1 to 36 'words not more than 12 letters?
locate 2 * xy + 6 + (i-1) mod 2 * 17, int(i/2) + i mod 2
print i;" ";W$(i)
next
for i = 1 to 36 'this time through find word, show word, star word
locate 1, xy + 5 : print space$(40)
locate 1, xy + 5 : print W$(i); :input " press enter to show ";wayt
call clearPuzzle
if showWord(W$(i)) then
locate 46 + (i-1) mod 2 * 17, int(i/2) + i mod 2
print i;" ";W$(i);"*";
end if
locate 1, xy + 5 : print space$(40)
locate 1, xy + 5 : print W$(i); :input " OK, press enter ";wayt
call showPuzzle
next
locate 10, xy + 7 : print "Happy Thanksgiving!"
sub showPuzzle
locate 1, 1
for y = 1 to xy
for x = 1 to xy
print L$(x, y);" ";
next
print ">";chr$(96 + y)
next
locate 1, xy + 1
for x = 1 to xy : print "V "; : next
locate 1, xy + 2
for x = 1 to xy : print chr$(96 + x);" "; : next
print
end sub
sub clearPuzzle
for y = 1 to xy
locate 0, y
print space$(2 * xy)
next
end sub
function showWord(find$)
'first find a letter that matches the first
'then at that x,y try each of 8 directions to see if find a match
'be smart see if enough room to fit the find word before heading out
'if find it print in upper left board section 0, 0
first$ = mid$(find$, 1, 1) : lf1 = len(find$) - 1
for y = 1 to xy
for x = 1 to xy
if L$(x,y) = first$ then
for d = 1 to 8
b1 = lf1 * DX(d) + x > 0 and lf1 * DX(d) + x <= xy
b2 = lf1 * DY(d) + y > 0 and lf1 * DY(d) + y <= xy
if b1 and b2 then
b$ = first$ : xx = x + DX(d) : yy = y + DY(d)
for i = 2 to len(find$)
b$ = b$ + L$(xx, yy)
xx = xx + DX(d) : yy = yy + DY(d)
next
if b$ = find$ then 'show our result
for i = 1 to len(find$)
locate 2*x-1, y : print L$(x,y);
x = x + DX(d) : y = y + DY(d)
next
showWord = 1 : exit function
end if
end if
next
end if
next
next
'if still here, couldn't find find$
showWord = 0
end function
The dx, dy arrays might remind you of Knights Tour.