I wrote a Word Search generating program in C++ (308 lines) years ago: my brother used it to generate a puzzle including all the girls in his 8th grade class, which was 22 years ago: about 1984 (sounds Orwellian<g>). I wrote one in C# (456 lines) about 3 years ago. I wrote a VFP version (180 lines) which has more features than the prior 2:
it presents UI for user input (the C++ program used a text file as input)
it records the answers into a table
it parses the input into separate words, filtering out punctuation (the C# program does that)
it ignores duplicates (the C# program does that)
it prefills the data with the first few lines of War and Peace (see I cant understand why men cant live without wars)
Run the code below, paste some text into the editbox, then hit the button
You can make a list of your 8th grade classmates or your customers or favorite football teams or….
You can paste the elements into the text too. I copied this from an old C++ program:
"Hydrogen", "Helium", "Lithium", "Beryllium", "Boron", "Carbon", "Nitrogen",
"Oxygen", "Fluorine", "Neon", "Sodium", "Magnesium", "Aluminum", "Silicon",
"Phosphorus", "Sulfur", "Chlorine", "Argon", "Potassium", "Calcium", "Scandium",
"Titanium", "Vanadium", "Chromium", "Manganese", "Iron", "Cobalt", "Nickel", "Copper",
"Zinc", "Gallium", "Germanium", "Arsenic", "Selenium", "Bromine", "Krypton",
"Rubidium", "Strontium", "Yttrium", "Zirconium", "Niobium", "Molybdenum",
"Technetium", "Ruthenium", "Rhodium", "Palladium", "Silver", "Cadmium", "Indium",
"Tin", "Antimony", "Tellurium", "Iodine", "Xenon", "Cesium", "Barium", "Lanthanum",
"Cerium", "Praseodymium", "Neodymium", "Promethium", "Samarium", "Europium",
"Gadolinium", "Terbium", "Dysprosium", "Holmium", "Erbium", "Thulium", "Ytterbium",
"Lutetium", "Hafnium", "Tantalum", "Tungsten", "Rhenium", "Osmium", "Iridium",
"Platinum", "Gold", "Mercury", "Thallium", "Lead", "Bismuth", "Polonium", "Astatine",
"Radon", "Francium", "Radium", "Actinium", "Thorium", "Protactinium", "Uranium",
"Neptunium", "Plutonium", "Americium", "Curium", "Berkelium", "Californium",
"Einsteinium", "Fermium", "Mendelevium", "Nobelium", "Lawrencium"
CLEAR ALL
CLEAR
PUBLIC oForm
oForm=CREATEOBJECT("WordSearch")
oForm.show
DEFINE CLASS WordSearch as Form
left=310
height=600
width=500
allowoutput=.f.
ADD OBJECT edtText as editbox WITH height = thisform.Height-100,width=thisform.Width,maxlength=3000
ADD OBJECT cmdDoit as CommandButton WITH left=100,;
top=thisform.Height-50,caption="\<Generate"
PROCEDURE init
* RAND(1) && remove this for diff seed value each run
WITH this.edtText
.Visible=1
.Height=thisform.Height-100
.Width=thisform.Width
TEXT TO cvar NOSHOW
"Well, Prince, so Genoa and Lucca are now just family estates of the Buonapartes. But I warn you,
if you don't tell me that this means war, if you still try to defend the infamies and horrors
perpetrated by that Antichrist- I really believe he is Antichrist- I will have nothing more to do
with you and you are no longer my friend, no longer my 'faithful slave,' as you call yourself!
But how do you do? I see I have frightened you- sit down and tell me all the news."
It was in July, 1805, and the speaker was the well-known Anna Pavlovna Scherer, maid of honor
and favorite of the Empress Marya Fedorovna. With these words she greeted Prince Vasili Kuragin, a man
of high rank and importance, who was the first to arrive at her reception. Anna Pavlovna had had
a cough for some days. She was, as
ENDTEXT
.Value=cVar
ENDWITH
PROCEDURE click
IF !thisform.edtText.visible
thisform.Cls
thisform.edtText.visible=1
thisform.cmdDoit.visible=1
ENDIF
PROCEDURE cmdDoit.Click
thisform.edtText.visible=.f.
this.Visible=.f.
ALINES(aa,UPPER(thisform.edtText.value)) && create an array elem for each line of text
CREATE CURSOR words (word c(20)) && a table to store the words
FOR i = 1 TO ALEN(aa) && each line of text
FOR j = 1 TO GETWORDCOUNT(aa[i]) && each word on the line
cWord=GETWORDNUM(aa[i],j)
cTemp=""
FOR k = 1 TO LEN(cWord)
IF ISALPHA(SUBSTR(cWord,k,1)) && make sure only alpha chars are used
cTemp=cTemp+SUBSTR(cWord,k,1)
ENDFOR
IF LEN(cTemp) > 3 && only words > min length
INSERT INTO words VALUES (cTemp)
SELECT distinct word,LEN(ALLTRIM(word)) as len, 100 as x, 100 as y,9 as dir;
FROM words ORDER BY 2 descending INTO CURSOR WordList READWRITE
nMax=MAX(WordList.len,15) && size of sq must be >= longest word
FOR nTries = nMax TO 40
?"Trying to fit "+TRANSFORM(RECCOUNT())+" in square",TRANSFORM(nTries)+" x "+TRANSFORM(nTries)
IF thisform.fitit(nTries, nTries) && if success
EXIT
PROCEDURE FitIt(numX as Integer, numY as Integer)
LOCAL nTried,nLen,x0,y0,fGotit,nDir,ch,fFits
DIMENSION aGrid[numX,numY] && Each element is a character
DIMENSION aTried[numX,numY] && track direction tried for each cell in bitfield
aGrid=" " && int all cells to space
thisform.Cls && erase the form
UPDATE wordlist SET x=0,y=0,dir=0 && init recorded word positions
SCAN
aTried=0 && set all elements to 0
nTried=0 && number of tries to fit this particular word
DO WHILE .t.
nLen = LEN(ALLTRIM(word))
IF nTried < 4 * numX * numY && for the first few attempts, try random placement
DO WHILE .t. && get random direction: dx,dy = 0 or +=1: but both can't be 0
nDir = INT(RAND()*9) && get a random direction
IF nDir != 4 && 4 is dx=0 and dy=0
ENDDO
x0=INT(RAND()*numX)+1 && Random starting point in the grid
y0=INT(RAND()*numY)+1
IF BITTEST(aTried[x0,y0],nDir) && if this dir was tried, lets try another
nTried=nTried+1
LOOP
ELSE && if failed to fit the first few attempts randomly: try systematically
fGotit=.f.
FOR x0 = 1 TO numX && each row,col
FOR y0 = 1 TO numY
FOR nDir = 0 TO 8 && each direction
IF nDir !=4 && 4 is dx=0 and dy=0
IF !BITTEST(aTried[x0,y0],nDir) && if this dir is untried, lets try it
fGotit=.t.
IF fGotit
IF !fGotit
RETURN .f. && couldn't fit anywhere
dx=nDir%3-1 && -1, 0, 1
dy=INT(nDir/3)-1 && -1, 0, 1
aTried[x0,y0]=BITSET(aTried[x0,y0],nDir) && set bit indicating direction tried
IF BETWEEN(x0 + dx*nLen,1,numX) AND BETWEEN(y0 + dy * nLen,1, numY) && if enough room for word in grid
fFits = .t.
fHadBlank = .f.
FOR i = 0 TO nLen-1 && now see if existing letters in grid match word
ch = aGrid[x0+dx*i,y0+dy * i]
IF ch = " " && track empty squares (so "ear" not placed in "hear"
fHadBlank = .t.
ELSE
IF ch != SUBSTR(word,i+1,1) && the existing letter doesn't match the word
fFits = .f.
IF fHadBlank AND fFits && had a blank: we have a fit
FOR i = 0 TO nLen-1 && now place word in grid
aGrid[x0+dx*i,y0+dy * i] = SUBSTR(word,i+1,1)
thisform.Print(SUBSTR(word,i+1,1),15*(x0+dx*i),20*(y0+dy * i))
REPLACE x WITH x0,y WITH y0,Dir WITH nDir && record position
EXIT && go on to next word
ENDSCAN && finish looping on all words
IF WEXIST("t.txt") && if open from prior run
RELEASE WINDOWS t.txt && close it
SET PRINTER off
SET PRINTER TO t.txt
SET PRINTER on
FOR j = 1 TO numX
?SPACE(6)
FOR i = 1 TO numY
IF aGrid[i,j]=' '
??CHR(65+RAND()*26)+" " && random letter
??aGrid[i,j]+" "
SELECT word FROM wordlist ORDER BY 1 INTO CURSOR WordListAlpha
nCols=IIF(_tally > 50,4,3)
nRows = INT(_tally/nCols)
IF nRows*nCols != _tally
nRows=nRows+1
?
FOR j = 1 TO nRows
FOR i = 1 TO nCols
ndx = (i-1) * nRows + (j-1)
IF ndx < _tally
GO ndx+1
??word
?"Word Search by Calvin Hsia & Visual FoxPro", DATETIME()
_screen.FontName="Courier New"
SET PRINTER TO
SELECT wordlist
LOCATE
BROWSE LAST NOWAIT
MODIFY FILE t.txt NOWAIT
RETURN .t.
ENDDEFINE