Create your own Word Search puzzles


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.Height100,width=thisform.Width,maxlength=3000


      ADD OBJECT cmdDoit as CommandButton WITH left=100,;


            top=thisform.Height50,caption=”\<Generate”


      PROCEDURE init


*           RAND(1)     && remove this for diff seed value each run


            WITH this.edtText


                  .Visible=1


                  .Height=thisform.Height100


                  .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)


                              ENDIF


                        ENDFOR


                        IF LEN(cTemp) > 3 && only words > min length


                              INSERT INTO words VALUES (cTemp)


                        ENDIF


                  ENDFOR


            ENDFOR


            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


                  ENDIF


            ENDFOR


      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


                                          EXIT


                                    ENDIF


                              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


                              ENDIF


                        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.


                                                            EXIT


                                                      ENDIF


                                                ENDIF


                                          ENDFOR


                                          IF fGotit


                                                EXIT


                                          ENDIF


                                    ENDFOR


                                    IF fGotit


                                          EXIT


                                    ENDIF


                              ENDFOR


                              IF !fGotit


                                    RETURN .f.  && couldn’t fit anywhere


                              ENDIF


                        ENDIF


                        dx=nDir%31 && -1, 0, 1


                        dy=INT(nDir/3)-1  && -1, 0, 1


                        aTried[x0,y0]=BITSET(aTried[x0,y0],nDir)  && set bit indicating direction tried


                        nTried=nTried+1


                        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.


                                                EXIT


                                          ENDIF


                                    ENDIF


                              ENDFOR


                              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


                                    ENDFOR


                                    EXIT && go on to next word


                              ENDIF


                        ENDIF


                  ENDDO


            ENDSCAN                 && finish looping on all words


            IF WEXIST(“t.txt”)      && if open from prior run


                  RELEASE WINDOWS t.txt   && close it


            ENDIF


            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


                        ELSE


                              ??aGrid[i,j]+” “


                        ENDIF


                  ENDFOR


            ENDFOR


            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


            ENDIF


            ?


            ?


            FOR j = 1 TO nRows


                  FOR i = 1 TO nCols


                        ndx = (i-1) * nRows + (j-1)


                        IF ndx < _tally


                              GO ndx+1


                              ??word


                        ENDIF


                  ENDFOR


                  ?


            ENDFOR


            ?”Word Search by Calvin Hsia & Visual FoxPro”, DATETIME()


            _screen.FontName=”Courier New”


            SET PRINTER off


            SET PRINTER TO


            SELECT wordlist


            LOCATE


            BROWSE LAST NOWAIT


            MODIFY FILE t.txt NOWAIT


            RETURN .t.


ENDDEFINE


 

Comments (27)

  1. Calvin_Hsia says:

    I erroneously posted the wrong version: I was playing with a minor code change. The code in this post has been fixed.

  2. Steven Black says:

    That’s tremendously cool, Calvin. Christina left for school this morning with a bunch of puzzles for her teacher to distribute during recess, which are indoors in rainy weather. Susie, who’s a teacher, has designs for themed puzzles for her li’ll kids as well. BTW, this’d make a cool web service. Cheers!

  3. Calvin_Hsia says:

    Thanks very much for the positive feedback Steve: great incentive for more posts!

    Say hi to Christina and Susie! It’s fairly CPU intensive, and I’d rather not tie up my CPU in a puzzle generating web service.

  4. Randy Jean says:

    This is great! My daughter is currently studying the table of elements so I gave her this for "extra credit". Also, they are getting ready for this years spelling be so I’m loading their study list. This will be a great way to help memorize words.

  5. Randy Jean says:

    Make sure your desktop font is set to Courier – mine was set to Arial and the resulting text from SET PRINTER had extra spaces in it.

  6. whitney pearson says:

    nees the word boron i it make the puzzle a couple pf words.

  7. whitney pearson says:

    needs the word boron in it make the puzzle a couple of words.

  8. Whitney says:

    "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

  9. Alicia Metcalf says:

    I want a Hydrogen word Search puzzle.

    Thank you so much for the help if you give me any.

  10. Alicia Metcalf says:

    I want a Hydrogen word Search puzzle.

    Thank you so much for the help if you give me any.

  11. Alicia Metcalf says:

    I want a Hydrogen word Search puzzle.

    Thank you so much for the help if you give me any.

  12. Erica says:

    Jalon

    Jimmy

    Chris

    Kenneth

    Nick

    Krista

    Asia

    Noela

    Tank

    Mom

    Dad

    Bre

    Jay

    James

    Corey

    TD

    Quan

    AuntJoe

    AuntLisa

    AuntSheirley

    AuntSherri

    AuntBeverly

    Andrea

    Bobby

    Johnathan

    Rashida

    Bo

    Jabar

    Kaila

    Onnie

    Nessa

    Keshia

    Shell

    Shena

    Jr

    Mookie

    Wonnie

    Crystal

    CJ

    MeMe

    JayJay

    RayRay

    Donte

    Jordan

    Lonnell

    TJ

    MrsBlackmon

    Akem

    Jermaine

    Marcus

    Mike

    Jamarcus

    Jammer

    Erica

    Mya

    Denise

    Marceles

    Jemere

    Devonte

    Denzel

    Kevin

    De

    Hans

    Isacc

    Man

    Antoine

    PJ

  13. Kimberly K. Dickerson says:

    How much does this cost?  SudokuMaster40@cinci.rr.com

  14. Warning: this simple program produces mesmerizing spirographic images that seem hallucinatory in nature!…

  15. My brother and future sister in law wanted special word search puzzles created as wedding favors. The

  16. duha says:

    i need to look for a word search

  17. piss in a cup says:

    ", "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

  18. 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 8 th grade class, which was 22 years ago: about 1984 (sounds Orwellian&amp;lt;g&amp;gt;). I wrote one in C# (456

  19. Randolph says:

    Can you post a link to your C# version. I’d love to review and learn. Thx.

    – rw

  20. My wife and I like to listen to PuzzleMaster Will Shortz.on NPR. This week’s challenge is from one of

  21. Several years ago, my wife and I were walking through a local shopping mall. At the time, there was some