Word search puzzle maker

[Richard Frost]

Code: QB64: [Select]

1. _TITLE "Word Search Puzzle Maker by rfrost@mail.com"
2.  
3. ' schemes:
4. ' 0 fixed bonus for direction, each pass
5. ' 1 random bonus each pass
6. ' 2 random bonus each word
7.  
8. $EXEICON:'\icons\ws2.ico'
9. $CHECKING:OFF
10. DEFINT A-Z
11. _SCREENMOVE _MIDDLE
12. start! = TIMER: bestblanks = 9999: crlf$ = CHR$(13) + CHR$(10): totalwords = 103
13. RANDOMIZE TIMER
14. SCREEN 12
15. DIM word$(totalwords), board(25, 25), pdir(8), hdir(8), vdir(8), worth(8), worda(totalwords, 20), hc&(3, totalwords), pf(13, 4), ord(totalwords)
16. RESTORE tiny
17. FOR n = 0 TO 9 '                                 tiny font
18.     READ g$
19.     FOR i = 0 TO 4
20.         READ z
21.         pf(n, i) = z * 4096
22.     NEXT i
23. NEXT n
24. FOR i = 1 TO totalwords
25.     READ discard, word$(i)
26. NEXT i
27.  
28. IF _FILEEXISTS("ws.bst") THEN
29.     OPEN "ws.bst" FOR INPUT AS #1
30.     INPUT #1, bestwordsused, bestblanks
31.     CLOSE
32. END IF
33. FOR word = 1 TO totalwords
34.     ord(word) = word
35.     word$(word) = UCASE$(word$(word))
36.     worda(word, 0) = LEN(word$(word))
37.     FOR j = 1 TO worda(word, 0)
38.         worda(word, j) = ASC(MID$(word$(word), j, 1))
39.     NEXT j
40. NEXT word
41.  
42. begin:
43. try& = try& + 1
44. scheme = VAL(RIGHT$(TIME$, 2)) \ 20 '                 change every 20 seconds
45. CLS
46. GOSUB stats
47. ERASE board
48.  
49. FOR i = 0 TO 9 '                                      scramble word pointers a bit each time
50.     z1 = RND * (totalwords - 1) + 1
51.     z2 = RND * (totalwords - 1) + 1
52.     IF z1 <> z2 THEN SWAP ord(z1), ord(z2)
53. NEXT i
54.  
55. RESTORE
56. FOR i = 1 TO 8 '                                      scheme 0
57.     READ pdir(i), hdir(i), vdir(i), worth(i)
58. NEXT i
59. IF scheme = 1 THEN
60.     FOR i = 1 TO 8
61.         worth(i) = RND * 2
62.     NEXT i
63. END IF
64.  
65. wordsused = 0
66. FOR word = 1 TO totalwords
67.     GOSUB scankey
68.     highscore = 0
69.     pt = ord(word)
70.     worda(pt, 0) = ABS(worda(pt, 0))
71.     FOR row = 1 TO 25
72.         FOR col = 1 TO 25
73.             FOR dir = 1 TO 8
74.                 tscore = 0
75.                 FOR i = 1 TO worda(pt, 0)
76.                     tr = row + vdir(dir) * (i - 1)
77.                     tc = col + hdir(dir) * (i - 1)
78.                     IF (tr < 1) OR (tc < 1) OR (tr > 25) OR (tc > 25) THEN GOTO nextdir
79.                     wv = worda(pt, i)
80.                     bv = board(tr, tc)
81.                     IF (bv = 0) OR (bv = wv) THEN
82.                         tscore = tscore - (tscore = 0) - (bv = wv) * 10
83.                     ELSE
84.                         IF (i = 1) AND (bv <> 0) THEN GOTO nextcol
85.                         GOTO nextdir
86.                     END IF
87.                 NEXT i
88.                 IF tscore = 0 THEN GOTO nextdir
89.                 IF scheme < 2 THEN
90.                     tscore = tscore + worth(dir)
91.                 ELSE
92.                     tscore = tscore + RND * 2
93.                 END IF
94.                 flag = (tscore > highscore)
95.                 IF tscore = highscore THEN flag = -((RND * 100) > 96)
96.                 IF flag THEN highscore = tscore: sdir = dir: srow = row: scol = col
97.                 nextdir:
98.             NEXT dir
99.             nextcol:
100.         NEXT col
101.     NEXT row
102.     IF highscore = 0 THEN
103.         worda(pt, 0) = -worda(pt, 0) '                flag as not used
104.     ELSE
105.         COLOR pdir(sdir), 0 '                         show word
106.         FOR i = 1 TO worda(pt, 0)
107.             tr = srow + (i - 1) * vdir(sdir)
108.             tc = scol + (i - 1) * hdir(sdir)
109.             board(tr, tc) = worda(pt, i)
110.             IF blank = 0 THEN
111.                 LOCATE tr + 2, tc * 2 + 27
112.                 PRINT CHR$(board(tr, tc));
113.             END IF
114.         NEXT i
115.         COLOR 7, 0
116.         wordsused = wordsused + 1
117.     END IF
118. NEXT word
119.  
120. hc&(scheme, wordsused) = hc&(scheme, wordsused) + 1
121. IF wordsused < bestwordsused THEN GOTO begin
122.  
123. numblanks = 0
124. FOR row = 1 TO 25
125.     FOR col = 1 TO 25
126.         numblanks = numblanks - (board(row, col) = 0)
127.     NEXT col
128. NEXT row
129.  
130. IF (wordsused = bestwordsused) AND (numblanks >= bestblanks) THEN GOTO begin
131. bestblanks = numblanks: bestwordsused = wordsused
132.  
133. SOUND 400, 1
134. OPEN "ws.bst" FOR OUTPUT AS #1
135. PRINT #1, bestwordsused, bestblanks
136. CLOSE
137.  
138. OPEN "ws.top" FOR OUTPUT AS #1
139. PRINT #1, crlf$; crlf$; crlf$; crlf$;
140. FOR row = 1 TO 25
141.     OutLine$ = SPACE$(50)
142.     FOR col = 1 TO 25
143.         IF board(row, col) = 0 THEN board(row, col) = RND(1) * 25 + 65 ' random character (you might want chr$(219) or similar)
144.         MID$(OutLine$, (col - 1) * 2 + 1, 1) = CHR$(board(row, col))
145.     NEXT col
146.     PRINT #1, OutLine$; crlf$;
147. NEXT row
148.    
149. PRINT #1, crlf$; "Blanks ="; numblanks;
150. t$ = "Words used:" + STR$(wordsused)
151. PRINT #1, crlf$; crlf$; t$; crlf$; crlf$;
152. CharsPrinted = 0
153. FOR word = 1 TO totalwords
154.     IF worda(word, 0) > 0 THEN
155.         t$ = word$(word)
156.         IF (CharsPrinted + LEN(t$)) > 79 THEN
157.             PRINT #1, crlf$;
158.             CharsPrinted = 0
159.         END IF
160.         PRINT #1, t$; " ";
161.         CharsPrinted = CharsPrinted + LEN(t$) + 1
162.     END IF
163. NEXT word
164.  
165. t$ = "Not used:" + STR$(totalwords - wordsused)
166. PRINT #1, crlf$; crlf$; t$; crlf$; crlf$;
167. CharsPrinted = 0
168. FOR word = 1 TO totalwords
169.     IF worda(word, 0) < 0 THEN
170.         t$ = word$(word)
171.         IF (CharsPrinted + LEN(t$)) > 79 THEN
172.             PRINT #1, crlf$;
173.             CharsPrinted = 0
174.         END IF
175.         PRINT #1, t$; " ";
176.         CharsPrinted = CharsPrinted + LEN(t$) + 1
177.     END IF
178. NEXT word
179.  
180. PRINT #1, CHR$(12); '                                                     printer eject
181. CLOSE #1
182. GOTO begin
183.  
184. scankey:
185. k = _KEYHIT
186. IF (k > 0) AND (k < 256) THEN
187.     IF k = 32 THEN
188.         SLEEP
189.         DO: LOOP UNTIL INKEY$ = ""
190.     END IF
191.     IF k = ASC("b") THEN blank = blank XOR 1
192.     IF k = ASC("p") THEN SHELL "copy ws.top prn >nul"
193.     IF k = ASC("t") THEN SHELL "copy ws.top temp.top /y"
194.     IF k = 27 THEN SYSTEM
195. END IF
196. RETURN
197.  
198. stats:
199. el! = TIMER - start!
200. IF el! < 0 THEN el! = (86400 - start!) + TIMER
201. start! = TIMER
202. et! = et! + el!
203. tet! = et!
204. u$ = "s"
205. IF tet! > 60 THEN tet! = tet! / 60: u$ = "m"
206. IF tet! > 60 THEN tet! = tet! / 60: u$ = "h"
207.  
208. s$ = SPACE$(3)
209. LOCATE 3, 1
210. PRINT s$; "Timer:   ";: PRINT USING "#######.##"; tet!;: PRINT u$
211. PRINT s$; "Passes:  ";: PRINT USING "##########"; try&
212. PRINT s$; "Avg pass:";: PRINT USING "#######.##"; et! / try&;: PRINT "s"
213. PRINT s$; "Last:    ";: PRINT USING "##########"; wordsused
214. PRINT s$; "Grid:    ";: PRINT USING "##########"; 25
215. PRINT s$; "Words:   ";: PRINT USING "##########"; totalwords
216. z$ = STR$(bestwordsused) + "/" + LTRIM$(STR$(bestblanks))
217. PRINT s$; "Best:";: LOCATE CSRLIN, 23 - LEN(z$): PRINT z$
218. PRINT s$; "Output:      ws.top"
219. IF blank THEN RETURN
220.  
221. y = 420: tc = 0 '                                     show count (with tiny font) for schemes
222. FOR i = 103 TO 0 STEP -1
223.     IF (hc&(0, i) + hc&(1, i) + hc&(2, i)) > 0 THEN
224.         z$ = RIGHT$("   " + STR$(i), 4) + SPACE$(50)
225.         FOR j = 0 TO 2
226.             n$ = RIGHT$("    " + STR$(hc&(j, i)), 6)
227.             cc = j * 12 + 10
228.             MID$(z$, cc, LEN(n$)) = n$
229.         NEXT j
230.         z$ = RTRIM$(z$)
231.         IF tc = 7 THEN tc = 4 ELSE tc = 7
232.         FOR j = 1 TO LEN(z$)
233.             d$ = MID$(z$, j, 1)
234.             IF d$ <> " " THEN
235.                 d = VAL(d$)
236.                 x = 20 + j * 4
237.                 FOR k = 0 TO 4
238.                     LINE (x, y + k)-(x + 4, y + k), tc, , pf(d, k)
239.                 NEXT k
240.             END IF
241.         NEXT j
242.         y = y - 8
243.     END IF
244. NEXT i
245. RETURN
246.  
247. DATA 4,1,0,0
248. DATA 9,1,1,0
249. DATA 10,0,1,0
250. DATA 11,-1,1,2
251. DATA 12,-1,0,1
252. DATA 13,-1,-1,2
253. DATA 14,0,-1,1
254. DATA 15,1,-1,1
255.  
256. tiny:
257. DATA 0,7,5,5,5,7
258. DATA 1,2,6,2,2,7
259. DATA 2,7,1,7,4,7
260. DATA 3,7,1,7,1,7
261. DATA 4,5,5,7,1,1
262. DATA 5,7,4,7,1,7
263. DATA 6,7,4,7,5,7
264. DATA 7,7,1,1,1,1
265. DATA 8,7,5,7,5,7
266. DATA 9,7,5,7,1,7
267.  
268. words:
269. DATA 89,actinium
270. DATA 13,aluminum
271. DATA 95,americium
272. DATA 51,antimony
273. DATA 18,argon
274. DATA 33,arsenic
275. DATA 85,astatine
276. DATA 56,barium
277. DATA 97,berkelium
278. DATA 4,beryllium
279. DATA 83,bismuth
280. DATA 5,boron
281. DATA 35,bromine
282. DATA 48,cadmium
283. DATA 20,calcium
284. DATA 98,californium
285. DATA 6,carbon
286. DATA 58,cerium
287. DATA 55,cesium
288. DATA 17,chlorine
289. DATA 24,chromium
290. DATA 27,cobalt
291. DATA 29,copper
292. DATA 96,curium
293. DATA 66,dysprosium
294. DATA 99,einsteinium
295. DATA 68,erbium
296. DATA 63,europium
297. DATA 100,fermium
298. DATA 9,florine
299. DATA 87,francium
300. DATA 64,gadolinium
301. DATA 31,gallium
302. DATA 32,germanium
303. DATA 79,gold
304. DATA 72,hafnium
305. DATA 2,helium
306. DATA 67,holmium
307. DATA 1,hydrogen
308. DATA 53,iodine
309. DATA 49,indium
310. DATA 77,iridium
311. DATA 26,iron
312. DATA 36,krypton
313. DATA 57,lanthanum
314. DATA 103,lawrencium
315. DATA 82,lead
316. DATA 3,lithium
317. DATA 71,lutetium
318. DATA 12,magnesium
319. DATA 25,manganese
320. DATA 101,mendelevium
321. DATA 80,mercury
322. DATA 42,molybdenum
323. DATA 60,neodymium
324. DATA 10,neon
325. DATA 93,neptunium
326. DATA 28,nickel
327. DATA 41,niobium
328. DATA 7,nitrogen
329. DATA 102,nobelium
330. DATA 76,osmium
331. DATA 8,oxygen
332. DATA 46,palladium
333. DATA 15,phosphorus
334. DATA 78,platinum
335. DATA 94,plutonium
336. DATA 84,pollonium
337. DATA 19,potassium
338. DATA 59,praseodymium
339. DATA 61,promethium
340. DATA 91,protactinium
341. DATA 86,radium
342. DATA 88,radon
343. DATA 75,rhenium
344. DATA 45,rhodium
345. DATA 37,rubidium
346. DATA 44,ruthenium
347. DATA 62,samarium
348. DATA 21,scandium
349. DATA 34,selenium
350. DATA 14,silicon
351. DATA 47,silver
352. DATA 11,sodium
353. DATA 38,strontium
354. DATA 16,sulfur
355. DATA 73,tantalum
356. DATA 43,technetium
357. DATA 52,tellurium
358. DATA 65,terbium
359. DATA 81,thallium
360. DATA 90,thorium
361. DATA 69,thulium
362. DATA 50,tin
363. DATA 22,titanium
364. DATA 74,tungsten
365. DATA 92,uranium
366. DATA 23,vanadium
367. DATA 54,xenon
368. DATA 39,yttrium
369. DATA 70,ytterbium
370. DATA 30,zinc
371. DATA 40,zirconium

[bplus]

Hi Richard Frost,

I had odd problem loading .ico? I saved code in same folder as .ico and removed path of .ico. Is there something special about .ico files or just another bone head blunder by yours truly?

Also any changes since I saw this last, a month or 2 ago from IRC, is the print even smaller or had my eyes gotten that much worse?

Update nothing special from Help:
 

It is a nice Icon, did you make that Richard?

[Richard Frost]

Sorry, no clue why that icon file doesn't work for you.  Of course the path should be modified to where the file is.
The icon is quite optional anyway.

I adore that 3*5 font and use it whenever possible, and in this case had a valid reason - the ordinary font doesn't fit.

My best run for fitting all the words is 99 words with 66 spaces, which took about a week.  Also, my average pass time
is 0.12 seconds.  Working with the ASCII values is considerably faster than with text. 

Any ideas to make it even faster, or smarter?

[bplus]

Any ideas to make it even faster, or smarter?

Easy, shorter words with lots of vowels to share. ;-))

Well I guess if you made that icon you would have been proud enough to admit it :D

I've had QB64 tell me many a time a file didn't exist and then change it's mind, but this one seems pretty set.

Is anyone else having problems loading the .ico file?