Word Search Creator

Joke758 · January 2, 2007

Make your own Word search ^_^

;By Joke758
#include <String.au3>
#include <GUIConstants.au3>
HotKeySet ( "{ENTER}", "_hotkeyadd" )

Global $word
Global $words
Global $first = 0 
Global $secw
Global $title = InputBox ( "Word Search", "What is the title of your word search?", "", "", -1, 100, -1, -1 )
Global $x = Inputbox ( "Word Search", "Number of row?", "25", "", 10, 100, -1, -1)
Global $y = Inputbox ( "Word Search", "Number of column?", "25", "", 10, 100, -1, -1 )
Dim $letters[$x+1][$y+1]
Global $counts = $x*$y

$Form1 = GUICreate("Word Search", 176, 82, -1, -1)
$Input1 = GUICtrlCreateInput("", 8, 8, 161, 21)
$Button1 = GUICtrlCreateButton("Add word", 8, 32, 75, 25, 0)
$Button2 = GUICtrlCreateButton("Done", 96, 32, 75, 25, 0)
GUICtrlCreateLabel("Remaining letters:", 8, 64, 88, 17)
$Label1 = GUICtrlCreateLabel($counts, 96, 64, 75, 17)
GUISetState(@SW_SHOW)
While 1
    $msg = GuiGetMsg()
    Select
    Case $msg = $GUI_EVENT_CLOSE
        ExitLoop
    Case $msg = $button1 and $first = 0 and $word <> "" and StringLen ( $word ) <= $x and StringLen ( $word ) <= $y and StringIsAlpha ( $word ) = 1
        $first = 1
        GuiCtrlSetData ( $input1, "Adding.." )
        For $i = 1 to StringLen ( $word )
            $letters[$i][$i] = StringMid ( _StringReverse($word), $i, 1 )
        Next
        $words = $words & $word & " "
        GuiCtrlSetData ( $input1, "" )
    Case $msg = $button1 and $first = 1 and $word <> "" and StringIsAlpha ( $word ) = 1
        GuiCtrlSetData ( $input1, "Adding.." )
        $errtemp = _Addword ( $word )
        GuiCtrlSetData ( $input1, "" )
        If $errtemp <> 0  Then
            $words = $words & $word & " "
        EndIf
    Case $msg = $Button2
        GuiDelete ( $Form1 )
        $counz = _Countsquare()
        If Msgbox ( 4, "Word Search", "Do you want to have a secret word?" ) = 6 Then
            Do
                $secw = Inputbox ( "Word Search", "Choose a secret word of "&$counz&" letters.", "", "", -1, 100, -1, -1 )
            Until StringLen ( $secw ) = $counz
        Else
            $ttemp = "abcdefghijklmnopqrstuvwxyz"
            For $awk = 1 to $counz
                $secw &= StringMid ( $ttemp, Round ( Random ( 1, 26 ) ), 1 )
            Next
        EndIf
        $allwords = _class(StringTrimRight($words, 1))
        _secretword($secw)
        _displaygrid()
        _displaywords ( StringLower($allwords), $title )
        While 1
            Sleep ( 100 )
        WEnd
    Case Else
        $word = GuiCtrlRead ( $input1 )
        If $counts <> _Countsquare() Then
            $counts = _Countsquare()
            GuiCtrlSetData ( $label1, $counts )
        EndIf
    EndSelect
WEnd
Exit

Func _addword ($wordz)
    $occ = _Occurance ( $wordz )
    If $occ = 0 Then
        TrayTip ( "Error", $wordz&" cannot fit in the grid.", 5 )
        SetError ( 1 )
        Return 0
    Else
        For $woot = 1 to $occ[0]
            $tzd = StringSplit ( $occ[$woot], "," )
            $letters[$tzd[1]][$tzd[2]] = $tzd[3]
        Next
    EndIf
    Return 1
EndFunc

Func _Displaygrid()
$Form1 = GUICreate("Word Search - Grid", $x*20, $y*20, 192, 125)
For $i2 = 0 To $y-1
    For $i = 0 to $x-1
        GUICtrlCreateInput ( "", (20*$i), (20*$i2), 20, 20 )
        GuiCtrlSetData ( -1, StringUpper( $letters[$i+1][$i2+1] ) )
    Next
Next
GUISetState(@SW_SHOW)
EndFunc
    
Func _Freesquare($number)
    Local $tmp = 0
    Local $return
    ;Scanning each square
    For $v = 1 to $x
        For $v2 = 1 to $y
            ;Vertical up to down
            If $v2+($number-1) <= $y Then
                For $v3 = 0 to $number-1
                    If $letters[$v][$v2+$v3] = "" Then $tmp = $tmp + 1
                    $return = $return & $v&','&$v2+$v3&"|"
                Next
                
                If $tmp = $number Then Return StringSplit ( StringTrimRight ( $return, 1 ), "|" )
                $tmp = 0
                $return = ""
            EndIf
            
            ;Vertical down to up
            If $v2-($number-1) > 0 Then
                For $v3 = 0 to $number-1
                    If $letters[$v][$v2-$v3] = "" Then $tmp = $tmp + 1
                    $return = $return & $v&','&$v2-$v3&"|"
                Next
                
                If $tmp = $number Then Return StringSplit ( StringTrimRight ( $return, 1 ), "|" )
                $tmp = 0
                $return = ""
            EndIf
            
            ;Horizontal left ro right
            If $v+($number-1) <= $x Then
                For $v3 = 0 to $number-1
                    If $letters[$v+$v3][$v2] = "" Then $tmp = $tmp + 1
                    $return = $return & $v+$v3&','&$v2&"|"
                Next
                 
                If $tmp = $number Then Return StringSplit ( StringTrimRight ( $return, 1 ), "|" )
                $tmp = 0
                $return = ""
            EndIf
            
            ;Horizontal right to left
            If $v-($number-1) > 0 Then
                For $v3 = 0 to $number-1
                    If $letters[$v-$v3][$v2] = "" Then $tmp = $tmp + 1
                    $return = $return & $v-$v3&','&$v2&"|"
                Next
                 
                If $tmp = $number Then Return StringSplit ( StringTrimRight ( $return, 1 ), "|" )
                $tmp = 0
                $return = ""
            EndIf
            
            ;Diagonal Up-Right
            If $v+($number-1) <= $x and $v2-($number-1) > 0 Then
                For $v3 = 0 to $number-1
                    If $letters[$v+$v3][$v2-$v3] = "" Then $tmp = $tmp + 1
                    $return = $return & $v+$v3&','&$v2-$v3&"|"
                Next
             
                If $tmp = $number Then Return StringSplit ( StringTrimRight ( $return, 1 ), "|" )
                $tmp = 0
                $return = ""
            EndIf
            
            ;Diagonal Down-Right
            If $v+($number-1) <= $x and $v2+($number-1) <= $y Then
                For $v3 = 0 to $number-1
                    If $letters[$v+$v3][$v2+$v3] = "" Then $tmp = $tmp + 1
                    $return = $return & $v+$v3&','&$v2+$v3&"|"
                Next
             
                If $tmp = $number Then Return StringSplit ( StringTrimRight ( $return, 1 ), "|" )
                $tmp = 0
                $return = ""
            EndIf
            
            ;Diagonal Down-Left
            If $v-($number-1) > 0 and $v2+($number-1) <= $y Then
                For $v3 = 0 to $number-1
                    If $letters[$v-$v3][$v2+$v3] = "" Then $tmp = $tmp + 1
                    $return = $return & $v-$v3&','&$v2+$v3&"|"
                Next
             
                If $tmp = $number Then Return StringSplit ( StringTrimRight ( $return, 1 ), "|" )
                $tmp = 0
                $return = ""
            EndIf
            
            ;Diagonal Up-Left
            If $v-($number-1) > 0 and $v2-($number-1) > 0 Then
                For $v3 = 0 to $number-1
                    If $letters[$v-$v3][$v2-$v3] = "" Then $tmp = $tmp + 1
                    $return = $return & $v-$v3&','&$v2-$v3&"|"
                Next
             
                If $tmp = $number Then Return StringSplit ( StringTrimRight ( $return, 1 ), "|" )
                $tmp = 0
                $return = ""
            EndIf
        Next
    Next
    SetError ( 1 )
    Return 0
EndFunc

Func _Occurance($word)
    Local $tmpl = 1
    Local $geez = 0
    Local $leng = StringLen ( $word )
    Dim $returnval[$leng+1]
    $returnval[0] = $leng
    Dim $cord[2][2]
    
    For $i = 1 to $leng
        $tmplet = StringMid ( $word, $i, 1 )
        For $pp = 1 to $x
            For $pp2 = 1 to $y
                If $letters[$pp][$pp2] = $tmplet Then $geez = _Check($pp&","&$pp2, $word, $tmplet)
                If $geez<>0 Then
                    Redim $cord[$tmpl+1][$geez[0]+1]
                    For $popo = 1 to $geez[0]
                        $cord[$tmpl][$popo] = $geez[$popo]
                    Next
                    $tmpl = $tmpl + 1
                    $geez = 0
                EndIf
            Next
        Next
    Next
    $rand = Round ( Random ( 1, $tmpl-1 ) )
    If $tmpl = 2 Then $rand = 1
    If $tmpl <> 1 Then
        For $fir = 1 to $leng
            $returnval[$fir] = $cord[$rand][$fir]
        Next
    ElseIf $tmpl = 1 Then
        $returnval = _Freesquare($leng)
        If @error Then Return 0
        $dtemp = Round ( Random ( 1, 2 ) )
        If $dtemp = 1 Then
            $tword = $word
        Else
            $tword = _StringReverse ( $word )
        EndIf
        
        For $eee = 1 to $leng
            $returnval[$eee] &= ","&StringMid ( $tword, $eee, 1 )
        Next
    EndIf
    
    Return $returnval
EndFunc

Func _Check($var, $mot, $ltr)
    Local $1 = StringSplit ( $var, "," )
    Local $pos = StringInStr ( $mot, $ltr )
    Local $len = StringLen ( $mot )
    Local $aft = $len-$pos
    Local $bfr = $pos-1
    Local $gooz[9]
    Local $ret[9]
    Dim $coord[$len+1]
    $coord[0] = $len
    
    ;Horizontale
    If $1[1]+$aft <= $x and $1[1]-$bfr > 0 Then
        For $ii = 0 to $len-1
            $coord[$ii+1] = $1[1]+$ii-$bfr&","&$1[2]&","&StringMid ( $mot, $ii+1, 1 )
        Next
        $gooz[1] = _verify($mot, $coord)
        $check1 = $coord
        Dim $coord[$len+1]
        $coord[0] = $len
    EndIf
    
    ;Horizontal Inverse
    If $1[1]+$bfr <= $x and $1[1]-$aft > 0 Then
        For $ii = 0 to $len-1
            $coord[$ii+1] = $1[1]+$ii-$aft&","&$1[2]&","&StringMid ( _StringReverse($mot), $ii+1, 1 )
        Next
        $gooz[2] = _verify(_StringReverse($mot), $coord)
        $check2 = $coord
        Dim $coord[$len+1]
        $coord[0] = $len
    EndIf
    
    ;Verticale
    If $1[2]+$aft <= $y and $1[2]-$bfr > 0 Then
        For $ii = 0 to $len-1
            $coord[$ii+1] = $1[1]&","&$1[2]+$ii-$bfr&","&StringMid ( $mot, $ii+1, 1 )
        Next
        $gooz[3] = _verify($mot, $coord)
        $check3 = $coord
        Dim $coord[$len+1]
        $coord[0] = $len
    EndIf
    
    ;Vertical Inverse
    If $1[2]+$bfr <= $x and $1[2]-$aft > 0 Then
        For $ii = 0 to $len-1
            $coord[$ii+1] = $1[1]&","&$1[2]+$ii-$aft&","&StringMid ( _StringReverse($mot), $ii+1, 1 )
        Next
        $gooz[4] = _verify(_StringReverse($mot), $coord)
        $check4 = $coord
        Dim $coord[$len+1]
        $coord[0] = $len
    EndIf
    
    ;Diagonal /
    If $1[1]-$bfr > 0 and $1[1]+$aft <= $x and $1[2]+$bfr <= $y and $1[2]-$aft > 0 Then
        For $ii = 0 to $len-1
            $coord[$ii+1] = $1[1]+$ii-$bfr&","&$1[2]-$ii+$bfr&","&StringMid ( $mot, $ii+1, 1 )
        Next
        $gooz[5] = _verify($mot, $coord)
        $check5 = $coord
        Dim $coord[$len+1]
        $coord[0] = $len
    EndIf
    
    ;Diagonal / Inverse
    If $1[1]-$aft > 0 and $1[1]+$bfr <= $x and $1[2]+$aft <= $y and $1[2]-$bfr > 0 Then
        For $ii = 0 to $len-1
            $coord[$ii+1] = $1[1]+$ii-$aft&","&$1[2]-$ii+$aft&","&StringMid ( _StringReverse($mot), $ii+1, 1 )
        Next
        $gooz[6] = _verify(_StringReverse($mot), $coord)
        $check6 = $coord
        Dim $coord[$len+1]
        $coord[0] = $len
    EndIf
    
    ;Diagonal \
    If $1[1]-$bfr > 0 and $1[1]+$aft <= $x and $1[2]-$bfr > 0 and $1[2]+$aft <= $y Then
        For $ii = 0 to $len-1
            $coord[$ii+1] = $1[1]+$ii-$bfr&","&$1[2]+$ii-$bfr&","&StringMid ( $mot, $ii+1, 1 )
        Next
        $gooz[7] = _verify($mot, $coord)
        $check7 = $coord
        Dim $coord[$len+1]
        $coord[0] = $len
    EndIf
    
    ;Diagonal \ Inverse
    If $1[1]-$aft > 0 and $1[1]+$bfr <= $x and $1[2]-$aft > 0 and $1[2]+$bfr <= $y Then
        For $ii = 0 to $len-1
            $coord[$ii+1] = $1[1]+$ii-$aft&","&$1[2]+$ii-$aft&","&StringMid ( _StringReverse($mot), $ii+1, 1 )
        Next
        $gooz[8] = _verify(_StringReverse($mot), $coord)
        $check8 = $coord
        Dim $coord[$len+1]
        $coord[0] = $len
    EndIf
    
    If $gooz[1]+$gooz[2]+$gooz[3]+$gooz[4]+$gooz[5]+$gooz[6]+$gooz[7]+$gooz[8] = 0 Then Return 0
    
    While 1
        $rio = Round ( Random ( 1, 8 ) )
        If $gooz[$rio] = 1 Then ExitLoop
    WEnd
    
    If $rio = 1 Then
        Return $check1
    ElseIf $rio = 2 Then
        Return $check2
    ElseIf $rio = 3 Then
        Return $check3
    ElseIf $rio = 4 Then
        Return $check4
    ElseIf $rio = 5 Then
        Return $check5
    ElseIf $rio = 6 Then
        Return $check6
    ElseIf $rio = 7 Then
        Return $check7
    ElseIf $rio = 8 Then
        Return $check8
    EndIf
    
EndFunc

Func _verify($wz, $co)
    For $zi = 1 to $co[0]
        $templetter = StringMid ( $wz, $zi, 1 )
        $temp_coord = StringSplit ( $co[$zi], "," )
        $xt = $temp_coord[1]
        $yt = $temp_coord[2]
        If $letters[$xt][$yt] <> "" and $letters[$xt][$yt] <> $templetter Then Return 0
    Next
    Return 1
EndFunc

Func _countsquare()
    Local $count
    For $zzz = 1 to $x
        For $www = 1 to $y
            If $letters[$zzz][$www] = "" Then $count = $count + 1
        Next
    Next
    Return $count
EndFunc 

Func _secretword($w)
    Local $lettre = 1
    
    For $wii = 1 to $x
        For $tp = 1 to $y
            If $letters[$wii][$tp] = "" Then
                $letters[$wii][$tp] = StringMid ( $w, $lettre, 1 )
                $lettre = $lettre + 1
            EndIf
        Next
    Next
EndFunc

Func _hotkeyadd()
    Select
    Case $first = 0 and $word <> "" and StringLen ( $word ) <= $x and StringLen ( $word ) <= $y and StringIsAlpha ( $word ) = 1
        $first = 1
        GuiCtrlSetData ( $input1, "Adding.." )
        For $i = 1 to StringLen ( $word )
            $letters[$i][$i] = StringMid ( _StringReverse($word), $i, 1 )
        Next
        $words = $words & $word & " "
        GuiCtrlSetData ( $input1, "" )
    Case $first = 1 and $word <> "" and StringIsAlpha ( $word ) = 1
        GuiCtrlSetData ( $input1, "Adding.." )
        $errtemp = _Addword ( $word )
        GuiCtrlSetData ( $input1, "" )
        If $errtemp <> 0  Then
            $words = $words & $word & " "
        EndIf
    EndSelect
EndFunc

Func _displaywords($wwww, $tatle)
    $Form1 = GUICreate("Words", 671, 220, 144, 344)
    GUICtrlCreateLabel($wwww, 8, 40, 659, 177)
    GUICtrlCreateLabel($tatle, 8, 0, 661, 28)
    GUICtrlSetFont(-1, 10, 800, 0, "MS Sans Serif")
    GUISetState(@SW_SHOW)
EndFunc

Func _class($awords)
    Local $list = "abcdefghijklmnopqrstuvwxyz"
    Local $arrayw = StringSplit ( $awords, " " )
    Local $return1
    
    Dim $newarray[27]
    
    For $rtr = 1 to $arrayw[0]
        $1let = StringInStr ( $list, StringMid ( $arrayw[$rtr], 1, 1 ) )
        $newarray[$1let] &= $arrayw[$rtr]&" "
    Next
    
    For $wejiew = 1 to 26
        $return1 &= $newarray[$wejiew]
    Next
    Return $return1
        
EndFunc

:graduated:

Edited January 6, 2007 by Joke758

RazerM · January 2, 2007

I was going to make something like this but never got round to it. Well done.

llamnuds · January 3, 2007

Make your own Word search

Thanks for that.

Nice script, well done.

llamnuds

Red-Steel · January 3, 2007

Wow, it is very nice!

It will be usefull for my newspaper!

dandymcgee · January 3, 2007

Hey that's pretty cool.

Selmak · January 5, 2007

Ah, that takes me back to my DOS coding days...

Yours is a much better presentation, mind you.

Check your results with this

Rather clunky interface I admit (DOS GUI) but solves them and verifies that the puzzle has only one right answer.

Edited January 5, 2007 by Selmak

Joke758 · January 6, 2007

I tried and my results are ok

Everything works.

NELyon · January 6, 2007

Lol, i like this script, but can you edit your first post and put it into a [codebox']? (remove the single quote)

Sign In

Word Search Creator

Recommended Posts

Joke758

Link to comment

Share on other sites

RazerM

Link to comment

Share on other sites

llamnuds

Link to comment

Share on other sites

Red-Steel

Link to comment

Share on other sites

dandymcgee

Link to comment

Share on other sites

Selmak

Link to comment

Share on other sites

Joke758

Link to comment

Share on other sites

NELyon

Link to comment

Share on other sites

Create an account or sign in to comment

Create an account

Sign in

Recently Browsing 0 members

Browse

AutoIt Resources

Release

Beta