Author Topic: Word search puzzle maker  (Read 4062 times)

0 Members and 1 Guest are viewing this topic.

Offline Richard Frost

  • Seasoned Forum Regular
  • Posts: 316
  • Needle nardle noo. - Peter Sellers
    • View Profile
Word search puzzle maker
« on: November 24, 2019, 09:40:16 pm »






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

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Word search puzzle maker
« Reply #1 on: November 25, 2019, 09:33:25 am »
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 there- what is your problem.PNG


It is a nice Icon, did you make that Richard?
« Last Edit: November 25, 2019, 10:53:39 am by bplus »

Offline Richard Frost

  • Seasoned Forum Regular
  • Posts: 316
  • Needle nardle noo. - Peter Sellers
    • View Profile
Re: Word search puzzle maker
« Reply #2 on: November 25, 2019, 09:53:56 pm »
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?
It works better if you plug it in.

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Word search puzzle maker
« Reply #3 on: November 25, 2019, 11:01:49 pm »
Quote
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?