# wordsearch.kbs
# 2010-05-06 j.m.reneau
# set height, width, number of words, and then your word list
h = 15
w = 15
nwords = 20
dim words$(nwords)
words$ = {"unicode", "token", "comment", "subroutine", "statement", "program", "input", "sound", "function", "while", "string", "integer", "boolean", "decimal", "condition", "loop", "end", "else", "floor", "float"}
font "Tahoma", 10, 100
fastgraphics
# make the longest first
gosub sortwords
if length(words$[0]) > h then h = length(words$[0])
if length(words$[0]) > w then w = length(words$[0])
dim puzzle$(w,h)
fill = false
for n = 0 to nwords-1
word$ = words$[n]
print "Placing " + word$
try = 0
do
try = try + 1
# figure out x,y,dx,dy for word position
do
dx = int(rand * 3) - 1
dy = int(rand * 3) - 1
until dx <> 0 or dy <> 0
#
# get starting x and y position in the direction
if dx = 0 then x = int(rand * w)
if dx = 1 then x = int(rand * (w + 1 - length(word$)))
if dx = -1 then x = length(word$) - 1 + int(rand * (w + 1 - length(word$)))
if dy = 0 then y = int(rand * h)
if dy = 1 then y = int(rand * (h + 1 - length(word$)))
if dy = -1 then y = length(word$) - 1 + int(rand * (h + 1 - length(word$)))
# print x + " " + y + " " + dx + " " + dy
#
# test to see if word fits with cross overs
good = true
tx = x
ty = y
for pos = 1 to length(word$)
# print tx + " " + ty + " " + mid(word$,pos,1)
if puzzle$[tx,ty] <> "" then
if puzzle$[tx,ty] <> mid(word$,pos,1) then
good = false
end if
end if
tx = tx + dx
ty = ty + dy
next pos
until good or try > 1000
if not good then
print "Unable to place " + word$ + " try increasing size."
else
#
# place word
tx = x
ty = y
for pos = 1 to length(word$)
puzzle$[tx,ty] = mid(word$,pos,1)
tx = tx + dx
ty = ty + dy
next pos
#
gosub drawpuzzle
end if
next n
input "Here is the key. Press enter to fill in the puzzle.", wait$
fill = true
gosub drawpuzzle
end
drawpuzzle:
color white
rect 0,0,graphwidth,graphheight
color black
for th = 0 to h-1
for tw = 0 to w - 1
c$ = puzzle$[tw,th]
if c$ = "" and fill then c$ = chr(asc("a") + rand * 26)
text tw * graphwidth/w, th * graphheight/h, c$
next tw
next th
refresh
return
sortwords:
# program works best if words are sorted with the longest word first
# this a simple bubble sort - really slow for big lists
do
swap = false
for n = 1 to nwords-1
if length(words$[n]) > length(words$[n-1]) then
swap = true
temp$ = words$[n-1]
words$[n-1] = words$[n]
words$[n] = temp$
end if
next n
until not swap
return