Word search: Difference between revisions
Content deleted Content added
Word search en FreeBASIC |
m →{{header|FreeBASIC}}: made it work properly |
||
Line 915:
=={{header|FreeBASIC}}==
{{trans|QB64}}
Changes:
ShowPuzzle gets call only after a word is inserted in the grid.
Added a check if unixdict.txt was found.
Made FilePuzzle print to the file.
If enough words are found but there where still spaces, fill them with random letters.
FILLED was not set to FALSE every time Initialize was called.
Set all integer to (U)long.
<lang freebasic>Randomize Timer ' OK getting a good puzzle every time
#Macro TrmSS (n)
LTrim(Str(n))
#EndMacro
'overhauled
Dim Shared As
'LoadWords opens file of words and sets
Dim Shared As
' word file words (shuffled) to be fit into puzzle and index position
Dim Shared As String WORDSSS(1 To 24945), CWORDSSS(1 To 24945)
Dim Shared As
'words placed in Letters grid, word itself (WSS) x, y head (WX, WY) and direction (WD), WI is the index to all these
Dim Shared As String WSS(1 To 100)
Dim Shared As
' letters grid and direction arrays
Dim Shared As String LSS(0 To 9, 0 To 9)
Dim Shared As
DX(0) = 1: DY(0) = 0
DX(1) = 1: DY(1) = 1
Line 946 ⟶ 956:
'to store all the words found embedded in the grid LSS()
Dim Shared As String ALLSS(1 To 200)
Dim Shared As
Dim Shared As
' signal successful fill of puzzle
Dim Shared FILLED As Boolean
Dim Shared As ULong try = 1
Sub LoadWords
Dim As String wdSS
Dim As
Dim ok As Boolean
Open "unixdict.txt" For Input As #ff
If Err > 0 Then
Print !"\n unixdict.txt not found, program will end"
Sleep 5000
End
End If
While Eof(1) = 0
Input #
If Len(wdSS) > 2 And Len(wdSS) < 11 Then
ok =
For m = 1 To Len(wdSS)
If Asc(wdSS, m) < 97 Or Asc(wdSS, m) > 122 Then ok =
Next
If ok Then i += 1: WORDSSS(i) = wdSS: CWORDSSS(i) = wdSS
End If
Wend
Close #
NWORDS = i
End Sub
Sub Shuffle
Dim As
For i = NWORDS To 2 Step -1
r = Int(Rnd * i) + 1
Swap WORDSSS(i), WORDSSS(r)
Next
End Sub
Sub Initialize
Dim As
Dim As String wdSS
FILLED = FALSE
For r = 0 To 9
For c = 0 To 9
LSS(c, r) = " "
Next
Next
'reset word arrays by resetting the word index back to zero
WI = 0
'fun stuff for me but doubt others would like that much fun!
'pluggin "basic", 0, 0, 2
'pluggin "plus", 1, 0, 0
'to assure the spreading of ROSETTA CODE
LSS(Int(Rnd * 5) + 5, 0) = "R": LSS(Int(Rnd * 9) + 1, 1) = "O"
Line 1,005 ⟶ 1,020:
LSS(Int(10 * Rnd), 6) = "C": LSS(Int(10 * Rnd), 7) = "O"
LSS(Int(10 * Rnd), 8) = "D": LSS(Int(10 * Rnd), 9) = "E"
'reset limits
LengthLimit(3) = 200
Line 1,015 ⟶ 1,030:
LengthLimit(9) = 0
LengthLimit(10) = 0
'reset word order
Shuffle
Line 1,021 ⟶ 1,036:
'for fun plug-in of words
Sub pluggin (wdSS As String, x As
For i As ULong = 0 To Len(wdSS) - 1
LSS(x + i * DX(d), y + i * DY(d)) = Mid(wdSS, i + 1, 1)
Next
WI += WI
WSS(WI) = wdSS: WX(WI) = x: WY(WI) = y: WD(WI) = d
End Sub
' Function TrmSS (n As Integer) As String
' TrmSS =
' End Function
'used in PlaceWord
Function CountSpaces () As
Dim As
For y = 0 To 9
For x = 0 To 9
If LSS(x, y) = " " Then count += 1
Next
Next
CountSpaces = count
End Function
Sub ShowPuzzle
Dim As
'Dim As String wateSS
Cls
Print " 0 1 2 3 4 5 6 7 8 9"
Line 1,053 ⟶ 1,070:
For i = 0 To 9
Print TrmSS(i)
Next
For y = 0 To 9
For x = 0 To 9
Locate y + 3, 2 * x + 5: Print LSS(x, y)
Next
Next
For i = 1 To WI
If i <
Locate i + 1, 30: Print TrmSS(i); " "; WSS(i)
Locate i - 20 + 1, 45: Print TrmSS(i); " "; WSS(i)
Locate i - 40 + 1, 60: Print TrmSS(i); " "; WSS(i)
End If
Next
Locate 18, 1: Print "Spaces left:"; CountSpaces
Locate 19, 1: Print NWORDS
Line 1,076 ⟶ 1,093:
'used in PlaceWord
Function Match (word As String, template As String) As
Dim i As
Dim c As String
Match = 0
Line 1,095 ⟶ 1,112:
' exactly 11 spaces needs to be left, if/when this occurs FILLED will be set true to signal finished to main loop
' if place a word update LSS, WI, WSS(WI), WX(WI), WY(WI), WD(WI)
Dim As String wdSS, templateSS
Dim As
Dim As
Dim As ULong x, y, d, dNum, rdd, i, j
Dim As Boolean b1, b2
wdSS = WORDSSS(WORDSINDEX) ' the right side is all shared
' skip too many long words
If LengthLimit(Len(wdSS)) Then LengthLimit(Len(wdSS)) += 1 Else Exit Sub 'skip long ones
wLen = Len(wdSS) - 1 ' from the spot there are this many letters to check
spot = Int(Rnd * 100) ' a random spot on grid
testNum = 1
If Rnd < .5 Then rdir = -1 Else rdir = 1 ' go forward or back from spot for next test
While testNum < 101
y =
x = spot Mod 10
If LSS(x, y) = Mid(wdSS, 1, 1) Or LSS(x, y) = " " Then
Line 1,132 ⟶ 1,151:
WI += 1
WSS(WI) = wdSS: WX(WI) = x: WY(WI) = y: WD(WI) = d
If CountSpaces = 0 Then FILLED = TRUE
Exit Sub 'get out now that word is loaded
End If
Line 1,150 ⟶ 1,170:
Sub FindAllWords
Dim As String wdSS, templateSS, wateSS
Dim As
Dim As Boolean b1, b2
For i As
wdSS = CWORDSSS(i)
wLen = Len(wdSS) - 1
Line 1,166 ⟶ 1,186:
For j = 0 To wLen
templateSS += LSS(x + j * DX(d), y + j * DY(d))
Next
If templateSS = wdSS Then '
'store it
ALLindex += 1
Line 1,177 ⟶ 1,197:
End If
End If
Next
End If
Next
Next
Next
End Sub
Sub FilePuzzle
Dim As
Dim As String bSS
Open "WS Puzzle.txt" For Output As #ff
Print #ff, " 0 1 2 3 4 5 6 7 8 9"
Print #ff,
For r = 0 To 9
bSS = TrmSS(r) + " "
For c = 0 To 9
bSS += LSS(c, r) + " "
Next
Print #ff, bSS
Next
Print
Print #ff, "Directions >>>---> 0 = East, 1 = SE, 2 = South, 3 = SW, 4 = West, 5 = NW, 6 = North, 7 = NE"
Print
Print #ff, " These are the items from unixdict.txt used to build the puzzle:"
Print
For i = 1 To WI Step 2
Print #ff, Right(Space(7) + TrmSS(i), 7); ") "; Right(Space(7) + WSS(i), 10); " ("; TrmSS(WX(i)); ", "; TrmSS(WY(i)); ") >>>---> "; TrmSS(WD(i));
If i + 1 <= WI Then
Print #ff, Right(Space(7) + TrmSS(i + 1), 7); ") "; Right(Space(7) + WSS(i + 1), 10); " ("; TrmSS(WX(i + 1)); ", "; TrmSS(WY(i + 1)); ") >>>---> "; TrmSS(WD(i + 1))
Else
Print
End If
Next
Print
Print #ff, " These are the items from unixdict.txt found embedded in the puzzle:"
Print
For i = 1 To ALLindex Step 2
Print #ff, Right(Space(7) + TrmSS(i), 7); ") "; Right(Space(7) + ALLSS(i), 10); " ("; TrmSS(AllX(i)); ", "; TrmSS(AllY(i)); ") >>>---> "; TrmSS(AllD(i));
If i + 1 <= ALLindex Then
Print #ff, Right(Space(7) + TrmSS(i + 1), 7); ") "; Right(Space(7) + ALLSS(i + 1), 10); " ("; TrmSS(AllX(i + 1)); ", "; TrmSS(AllY(i + 1)); ") >>>---> "; TrmSS(AllD(i + 1))
Else
Print #ff, ""
End If
Next
Print #ff, "On try #" + TrmSS(try) + " a successful puzzle was built and filed."
Close #ff
End Sub
LoadWords 'this sets NWORDS count to work with
While try < 11
Initialize
Line 1,231 ⟶ 1,255:
For WORDSINDEX = 1 To NWORDS
PlaceWord
' ShowPuzzle
If FILLED Then Exit For
Next
If Not filled And WI > 24 Then ' we have 25 or more words
For y As ULong = 0 To 9 ' fill spaces with random letters
For x As ULong = 0 To 9
If LSS(x, y) = " " Then LSS(x, y) = Chr(Int(Rnd * 26) + 1 + 96)
Next
Next
filled = TRUE
ShowPuzzle
End If
If FILLED And WI > 24 Then
FindAllWords
Line 1,243 ⟶ 1,276:
End If
Wend
If Not FILLED Then Locate 23, 1: Print "Sorry, 10 tries and no success."
Sleep
End</lang>
{{out}}
<pre style="height:52ex;overflow:scroll"> 0 1 2 3 4 5 6 7 8 9
0 m g y m l a i r R u
1 s e u i o n n p s O
2 a p S l s s u n e n
3 h w o e l t j E a t
4 c T r l n a e i s T
5 c t e a c A r w i g
6 C w m m r b a i d a
7 O d s t u m b r e l
8 D o a i t h i g h h
9 l p E g d b o r h t
Directions >>>---> 0 = East, 1 = SE, 2 = South, 3 = SW, 4 = West, 5 = NW, 6 = North, 7 = NE
These are the items from unixdict.txt used to build the puzzle:
1) yea (2, 0) >>>---> 3 2) thigh (4, 8) >>>---> 0
3) wells (1, 6) >>>---> 7 4) jacm (6, 3) >>>---> 3
5) tumbrel (3, 7) >>>---> 0 6) mile (3, 0) >>>---> 2
7) seaside (8, 1) >>>---> 2 8) putnam (7, 1) >>>---> 3
9) throb (9, 9) >>>---> 4 10) insert (6, 0) >>>---> 3
11) brian (5, 6) >>>---> 7 12) chasm (0, 4) >>>---> 6
13) los (0, 9) >>>---> 7 14) aida (6, 6) >>>---> 0
15) anna (5, 0) >>>---> 1 16) dis (4, 9) >>>---> 5
17) heir (9, 8) >>>---> 5 18) lop (3, 4) >>>---> 5
19) gull (1, 0) >>>---> 1 20) sol (4, 2) >>>---> 6
21) gad (3, 9) >>>---> 5 22) stew (4, 2) >>>---> 1
23) ncr (4, 4) >>>---> 2 24) pat (1, 9) >>>---> 7
25) lair (4, 0) >>>---> 0 26) woe (1, 3) >>>---> 0
27) pet (7, 1) >>>---> 1 28) usn (9, 0) >>>---> 3
29) lag (9, 7) >>>---> 6 30) etc (2, 5) >>>---> 4
These are the items from unixdict.txt found embedded in the puzzle:
1) acm (5, 4) >>>---> 3 2) aid (6, 6) >>>---> 0
3) aida (6, 6) >>>---> 0 4) air (5, 0) >>>---> 0
5) air (8, 3) >>>---> 3 6) ale (3, 5) >>>---> 6
7) all (5, 4) >>>---> 5 8) ann (5, 0) >>>---> 1
9) ann (8, 3) >>>---> 5 10) anna (5, 0) >>>---> 1
11) anna (8, 3) >>>---> 5 12) ant (3, 5) >>>---> 7
13) are (6, 6) >>>---> 6 14) arm (3, 5) >>>---> 1
15) aside (8, 3) >>>---> 2 16) bar (6, 7) >>>---> 6
17) bare (6, 7) >>>---> 6 18) bird (5, 9) >>>---> 7
19) brian (5, 6) >>>---> 7 20) chasm (0, 4) >>>---> 6
21) dis (8, 6) >>>---> 6 22) dis (4, 9) >>>---> 5
23) drib (8, 6) >>>---> 3 24) ego (8, 7) >>>---> 3
25) eli (3, 3) >>>---> 6 26) ell (2, 5) >>>---> 7
27) era (6, 4) >>>---> 2 28) etc (2, 5) >>>---> 4
29) gad (3, 9) >>>---> 5 30) gal (9, 5) >>>---> 2
31) gull (1, 0) >>>---> 1 32) gym (1, 0) >>>---> 0
33) heir (9, 8) >>>---> 5 34) high (5, 8) >>>---> 0
35) hum (5, 8) >>>---> 5 36) ian (7, 4) >>>---> 7
37) ida (7, 6) >>>---> 0 38) insert (6, 0) >>>---> 3
39) ion (3, 1) >>>---> 0 40) ira (7, 6) >>>---> 5
41) jacm (6, 3) >>>---> 3 42) lag (9, 7) >>>---> 6
43) lair (4, 0) >>>---> 0 44) lam (3, 4) >>>---> 2
45) leo (4, 3) >>>---> 4 46) lew (3, 4) >>>---> 3
47) lim (3, 2) >>>---> 6 48) lop (3, 4) >>>---> 5
49) los (4, 0) >>>---> 2 50) los (0, 9) >>>---> 7
51) lug (3, 2) >>>---> 5 52) male (3, 6) >>>---> 6
53) man (2, 6) >>>---> 7 54) maw (5, 7) >>>---> 7
55) mile (3, 0) >>>---> 2 56) nair (9, 2) >>>---> 3
57) ncr (4, 4) >>>---> 2 58) ore (2, 3) >>>---> 2
59) pat (1, 9) >>>---> 7 60) peg (1, 2) >>>---> 6
61) pet (7, 1) >>>---> 1 62) pod (1, 9) >>>---> 6
63) pol (1, 2) >>>---> 1 64) put (7, 1) >>>---> 3
65) putnam (7, 1) >>>---> 3 66) rib (7, 7) >>>---> 3
67) rim (7, 9) >>>---> 5 68) rob (7, 9) >>>---> 4
69) rut (4, 6) >>>---> 2 70) sea (8, 1) >>>---> 2
71) seaside (8, 1) >>>---> 2 72) side (8, 4) >>>---> 2
73) sol (4, 2) >>>---> 6 74) sol (2, 7) >>>---> 3
75) stew (4, 2) >>>---> 1 76) stu (2, 7) >>>---> 0
77) sun (5, 2) >>>---> 0 78) swam (8, 4) >>>---> 3
79) tap (3, 7) >>>---> 3 80) tea (1, 5) >>>---> 0
81) thigh (4, 8) >>>---> 0 82) throb (9, 9) >>>---> 4
83) tum (3, 7) >>>---> 0 84) tumbrel (3, 7) >>>---> 0
85) usn (9, 0) >>>---> 3 86) well (1, 6) >>>---> 7
87) wells (1, 6) >>>---> 7 88) wet (7, 5) >>>---> 5
89) wig (7, 5) >>>---> 0 90) woe (1, 3) >>>---> 0
91) yea (2, 0) >>>---> 3
On try #1 a successful puzzle was built and filed.</pre>
=={{header|Go}}==
|