Author Topic: Word Search  (Read 1156 times)

0 Members and 1 Guest are viewing this topic.

Offline bplus

  • Forum Resident
  • Posts: 5947
  • B+ Knot again!
Word Search
« on: October 18, 2018, 09:23:43 AM »
RE: https://www.qb64.org/forum/index.php?topic=694.0
Halloween Theme Word Search puzzles in replies #9 and #10

Judging from responses at other forums to this challenge, some instructions might be helpful.

First, I did NOT know Rosetta actually had a Word Search challenge, This part of their description was followed in my puzzle:
http://rosettacode.org/wiki/Word_search
Quote
Quote
A word search puzzle typically consists of a grid of letters in which words are hidden.

There are many varieties of word search puzzles. For the task at hand we will use a rectangular grid in which the words may be placed horizontally, vertically, or diagonally. The words may also be spelled backwards.

The words may overlap but are not allowed to zigzag, or wrap around.

zigzag probably means start going one direction and then changing course mid-word.

Here is my BASIC strategy for finding words:

For each word in search list
1. Take the first letter and run through the grid of letters for a match.
2. For a matching first letter, check each of 8 directions and see if the length of the word will fit the grid in that direction.
3. If so, build the word from the grid in that direction and length (or check letter by letter and bug out if mismatch).
4. See if it matches the word being searched, if so, count it, display it and/or record the find.
5. Repeat until all words have been searched over the entire grid ie continue with remaining directions then continue with remaining grid, unless you know there is only one word positioned in the puzzle (but my challenge is a twist on the this standard newspaper puzzle).

A BASIC strategy for the 8 directions:
I set up two arrays (or use one of vectors). I called them DX() and DY() because they are the changes (D is for Delta which is Geek for change) of position when added to (x, y) coordinate of a location.

A normal word direction (say direction 1) is from left to right due East change X by +1 and Y by 0 DX(1) = 1, DY(1) = 0
SouthEast call direction 2, DX(2) = 1, DY(2) = 1 AKA diagonal down to the right
South call direction 3, DX(3) = 0, DY(3) = 1 AKA down vertically
SouthWest call direction 4, DX(4) = -1, DY(4) = 1 AKA diagonal down to left
...
DX(1) = 1 : DY(1) = 0
DX(2) = 1 : DY(2) = 1
DX(3) = 0 : DY(3) = 1
DX(4) = -1 : DY(4) = 1
DX(5) = -1 : DY(5) = 0
DX(6) = -1 : DY(6) = -1
DX(7) = 0 : DY(7) = -1
DX(8) = 1 : DY(8) = -1

There's a good chunk of the code done for you now!

Now there is another challenge, find the words by rotating and/or reflecting the grid of letters. Sound like fun?
Eh, probably not for Beginner's ASIC.

Ha! maybe only B+ thinks that might be fun?
« Last Edit: October 18, 2018, 09:32:24 AM by bplus »

Offline bplus

  • Forum Resident
  • Posts: 5947
  • B+ Knot again!
Re: Word Search
« Reply #1 on: October 19, 2018, 09:54:58 AM »
Update:

Yesterday, I got started on the array rotations idea and was making good progress until the phone started ringing like... every minute. Hey wait a minute, didn't I just last week sign up for no more Robo and some level of call blocking...? Dang! Another talk with the tech guy at cable company after getting through the maze of god awful multiple choices with bot.

It turns out that rotating arrays was the easy part. Not so easy is locating the position found by INSTR() back to the original Letters$() array. 

2B continued... (unless it completely bombs like WordCrack idea :(  )

Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 3234
    • Steve’s QB64 Archive Forum
Re: Word Search
« Reply #2 on: October 19, 2018, 05:23:46 PM »
My little take on the BAT search:

Code: QB64: [Select]
  1. '*****************************
  2. '  TEXT FRAMES LIBRARY CODE
  3. '*****************************
  4.  
  5. TYPE TextArea
  6.     InUse AS INTEGER
  7.     x1 AS LONG 'left
  8.     y1 AS LONG 'top
  9.     w AS LONG 'width
  10.     h AS LONG 'height
  11.     FrameColor AS _UNSIGNED LONG
  12.     BackColor AS _UNSIGNED LONG
  13.     Xpos AS INTEGER
  14.     Ypos AS INTEGER
  15.     VerticalAlignment AS INTEGER
  16.     Justification AS INTEGER
  17.     UpdateMethod AS INTEGER
  18.     TextColor AS _UNSIGNED LONG
  19.     TextBackgroundColor AS _UNSIGNED LONG
  20.     SavedBackground AS INTEGER
  21.     HideFrame AS INTEGER
  22.     ScreenX AS INTEGER
  23.     ScreenY AS INTEGER
  24.  
  25. REDIM SHARED TextHandles(0) AS TextArea
  26.  
  27. CONST True = -1, False = 0
  28. CONST LeftJustify = -1, CenterJustify = -2, RightJustify = -3, NoJustify = 0
  29. CONST OnLine = 0, CenterLine = -1, TopLine = 1, BottomLine = -2
  30. CONST NoUpdate = 0, DoUpdate = 1, NewLine = 2
  31.  
  32. '**********************************
  33. '*   PROGRAM CODE
  34. '**********************************
  35.  
  36.  
  37.  
  38.  
  39.  
  40.  
  41. CONST FileName$ = "bat.txt"
  42.  
  43.  
  44. REDIM SHARED WordGrid(0, 0) AS STRING * 1
  45. REDIM SHARED YLines(0, 0) AS STRING
  46. REDIM SHARED XLines(0, 0) AS STRING
  47.  
  48. DIM SHARED SearchTerms(0) AS STRING
  49. SearchTerms(0) = "BAT"
  50.  
  51.  
  52. DIM SHARED LeftFrame AS INTEGER, RightFrame AS INTEGER
  53.  
  54.  
  55. SCREEN _NEWIMAGE(1280, 720, 32) '720p HD just cause I like it as a standard
  56.  
  57.  
  58. LeftFrame = NewTextArea(0, 0, 400, _HEIGHT - 1, False)
  59. ColorTextArea LeftFrame, _RGB32(255, 255, 255), _RGB32(0, 0, 128)
  60. DrawTextArea LeftFrame
  61.  
  62. RightFrame = NewTextArea(401, 0, _WIDTH - 1, _HEIGHT - 1, False)
  63. ColorTextArea RightFrame, _RGB32(255, 255, 255), _RGB32(0, 0, 0)
  64. DrawTextArea RightFrame
  65.  
  66.  
  67.  
  68. LoadWordGrid
  69. MakeDirectional
  70. ShowGrid
  71. FindWords
  72.  
  73.  
  74.  
  75. SUB FindWords
  76.     FOR j = 0 TO UBOUND(SearchTerms)
  77.         PrintOut RightFrame, "SEARCHING FOR " + SearchTerms(j)
  78.         PrintOut RightFrame, ""
  79.         PrintOut RightFrame, "Finding Left to Right Matches"
  80.         FOR i = 1 TO Y
  81.             foundone = 0
  82.             DO
  83.                 foundone = INSTR(foundone + 1, YLines(1, i), SearchTerms(j))
  84.                 IF foundone THEN
  85.                     OUT$ = OUT$ + "(Line" + STR$(i) + ", Position" + STR$(foundone) + "), "
  86.                     tc = tc + 1
  87.                 END IF
  88.             LOOP UNTIL NOT foundone
  89.         NEXT
  90.         PrintOut RightFrame, OUT$
  91.  
  92.         OUT$ = ""
  93.         PrintOut RightFrame, ""
  94.         PrintOut RightFrame, "Finding Right to Left Matches"
  95.         FOR i = 1 TO Y
  96.             foundone = 0
  97.             DO
  98.                 foundone = INSTR(foundone + 1, YLines(2, i), SearchTerms(j))
  99.                 IF foundone THEN
  100.                     OUT$ = OUT$ + "(Line" + STR$(i) + ", Position" + STR$(X - foundone + 1) + "), "
  101.                     tc = tc + 1
  102.                 END IF
  103.             LOOP UNTIL NOT foundone
  104.         NEXT
  105.         PrintOut RightFrame, OUT$
  106.  
  107.         OUT$ = ""
  108.         PrintOut RightFrame, ""
  109.         PrintOut RightFrame, "Finding Up to Down Matches"
  110.         FOR i = 1 TO X
  111.             foundone = 0
  112.             DO
  113.                 foundone = INSTR(foundone + 1, XLines(1, i), SearchTerms(j))
  114.                 IF foundone THEN
  115.                     OUT$ = OUT$ + "(Line" + STR$(foundone) + ", Position" + STR$(i) + "), "
  116.                     tc = tc + 1
  117.                 END IF
  118.             LOOP UNTIL NOT foundone
  119.         NEXT
  120.         PrintOut RightFrame, OUT$
  121.  
  122.         OUT$ = ""
  123.         PrintOut RightFrame, ""
  124.         PrintOut RightFrame, "Finding Down to Up Matches"
  125.         FOR i = 1 TO X
  126.             foundone = 0
  127.             DO
  128.                 foundone = INSTR(foundone + 1, XLines(2, i), SearchTerms(j))
  129.                 IF foundone THEN
  130.                     OUT$ = OUT$ + "(Line" + STR$(foundone) + ", Position" + STR$(i) + "), "
  131.                     tc = tc + 1
  132.                 END IF
  133.             LOOP UNTIL NOT foundone
  134.         NEXT
  135.         PrintOut RightFrame, OUT$
  136.  
  137.         PrintOut RightFrame, ""
  138.         PrintOut RightFrame, ""
  139.         PrintOut RightFrame, STR$(tc) + " total matches found."
  140.     NEXT
  141.  
  142.  
  143.  
  144. SUB ShowGrid
  145.     'Print the words in the grid
  146.     SetTextColor LeftFrame, _RGB32(255, 255, 0), 0
  147.     PrintOut LeftFrame, ""
  148.     PrintOut LeftFrame, "                     WORD GRID"
  149.     PrintOut LeftFrame, ""
  150.     SetTextColor LeftFrame, _RGB32(255, 255, 255), 0
  151.     FOR i = 1 TO Y
  152.         PrintOut LeftFrame, "  " + YLines(1, i)
  153.     NEXT
  154.  
  155.  
  156.  
  157.  
  158. SUB LoadWordGrid
  159.     OPEN FileName$ FOR BINARY AS #1
  160.     DO UNTIL EOF(1)
  161.         LINE INPUT #1, junk$
  162.         Y = Y + 1
  163.     LOOP
  164.     X = LEN(junk$): Y = Y
  165.     SEEK #1, 1
  166.  
  167.     REDIM WordGrid(1 TO X, 1 TO Y) AS STRING * 1 'Properly size our grid, with borders
  168.     REDIM YLines(2, Y) AS STRING
  169.     REDIM XLines(2, X) AS STRING
  170.  
  171.     FOR i = 1 TO Y
  172.         LINE INPUT #1, junk$
  173.         FOR j = 1 TO X
  174.             WordGrid(j, i) = MID$(junk$, j) 'Fill in the grid with the letters
  175.         NEXT
  176.     NEXT
  177.     CLOSE #1
  178.  
  179. SUB MakeDirectional
  180.     FOR i = 1 TO Y: FOR j = 1 TO X
  181.             YLines(1, i) = YLines(1, i) + WordGrid(i, j) 'Left to Right Lines
  182.     NEXT j, i
  183.     FOR i = 1 TO Y: FOR j = X TO 1 STEP -1
  184.             YLines(2, i) = YLines(2, i) + WordGrid(i, j) 'Right to Left Lines
  185.     NEXT j, i
  186.     FOR i = 1 TO Y: FOR j = 1 TO X
  187.             XLines(1, i) = XLines(1, i) + WordGrid(j, i) 'Up to Down Lines
  188.     NEXT j, i
  189.     FOR i = 1 TO Y: FOR j = X TO 1 STEP -1
  190.             XLines(2, i) = XLines(1, i) + WordGrid(j, i) 'Right to Left Lines
  191.     NEXT j, i
  192.  
  193. '*****************************
  194. '  TEXT FRAMES LIBRARY CODE
  195. '*****************************
  196.  
  197. SUB PrintOut (WhichHandle AS INTEGER, What AS STRING)
  198.     u = UBOUND(TextHandles)
  199.     Handle = WhichHandle
  200.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  201.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  202.     Where = TextHandles(Handle).VerticalAlignment
  203.     How = TextHandles(Handle).Justification
  204.     UpdatePrintPosition = TextHandles(Handle).UpdateMethod
  205.     PlaceText Handle, Where, How, What, UpdatePrintPosition
  206.  
  207.  
  208. SUB PlaceText (WhichHandle AS INTEGER, Where AS INTEGER, How AS INTEGER, What AS STRING, UpdatePrintPosition AS INTEGER)
  209.     'WhichHandle is the handle which designates which text area we want to use
  210.     'Where is where we want it to go in that text area
  211.     '  -- Online prints the text to the current print position line in that text area.
  212.     '  -- CenterLine centers the text to the center of that text area.
  213.     '  -- any other value will print to that line positon in that particular box.
  214.     'How tells us how we want to place that text (LeftJustified, RightJustified,CenterJustified, or NoJustify)
  215.     'What is the text that we want to print in our text area
  216.     'UpdatePrintPosition lets us know if we need to move to a newline or stay on the same line.  (Think PRINT with a semicolon vs PRINT without a semicolon).
  217.  
  218.     D = _DEST: S = _SOURCE
  219.  
  220.  
  221.     u = UBOUND(TextHandles)
  222.     fh = _FONTHEIGHT
  223.     pw = _PRINTWIDTH(What)
  224.     Handle = WhichHandle
  225.  
  226.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  227.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  228.     IF TextHandles(Handle).HideFrame THEN
  229.         _DEST TextHandles(Handle).SavedBackground
  230.         _SOURCE TextHandles(Handle).SavedBackground
  231.     END IF
  232.     h = TextHandles(Handle).h - 4
  233.     w = TextHandles(Handle).w - 4
  234.  
  235.     SELECT CASE Where
  236.         CASE BottomLine
  237.             TextFrameY = h \ fh
  238.         CASE OnLine
  239.             TextFrameY = TextHandles(Handle).Ypos
  240.             IF TextFrameY = 0 THEN TextFrameY = 1
  241.         CASE CenterLine
  242.             linesused = 0
  243.             tpw = pw: tw = w: tWhat$ = What
  244.             DO UNTIL tpw <= tw
  245.                 textallowed = WordBreak(LEFT$(tWhat$, w \ _FONTWIDTH))
  246.                 text$ = RTRIM$(LEFT$(tWhat$, textallowed))
  247.                 linesused = linesused + 1
  248.                 tWhat$ = MID$(tWhat$, textallowed + 1)
  249.                 tpw = _PRINTWIDTH(tWhat$)
  250.             LOOP
  251.             linesused = linesused + 1
  252.             py = (h - linesused * fh) \ 2
  253.             TextFrameY = py \ fh + 1
  254.             IF TextFrameY < 1 THEN TextFrameY = 1
  255.         CASE ELSE
  256.             TextFrameY = Where
  257.     END SELECT
  258.  
  259.     IF TextFrameY < 1 THEN ERROR 5: EXIT FUNCTION 'We don't print above the allocated text area.
  260.     blend = _BLEND
  261.     DO UNTIL TextFrameY * fh < h 'We need to scroll the text area up, if someone is trying to print below it.
  262.         'first let's get a temp image handle for the existing area of the screen.
  263.         x1 = TextHandles(Handle).x1 + 2
  264.         y1 = TextHandles(Handle).y1 + 2
  265.         x2 = TextHandles(Handle).x1 + w
  266.         y2 = TextHandles(Handle).y1 + h
  267.         nh = y2 - y1 + 1 - fh
  268.         nw = x2 - x1 + 1
  269.         tempimage = _NEWIMAGE(nw, nh, 32) 'Really, I should swap this to a routine to pick which screen mode the user is in, but I'll come back to that later.
  270.         _PUTIMAGE , , tempimage, (x1, y1 + fh)-(x2, y2)
  271.         DrawTextArea Handle
  272.         _PUTIMAGE (x1, y1)-(x2, y2 - fh), tempimage
  273.         TextFrameY = TextFrameY - 1
  274.     LOOP
  275.     IF blend THEN _BLEND
  276.  
  277.     COLOR TextHandles(Handle).TextColor, TextHandles(Handle).TextBackgroundColor
  278.  
  279.     SELECT CASE How
  280.         CASE LeftJustify
  281.             TextFrameX = 0
  282.             IF pw > w THEN
  283.                 textallowed = WordBreak(LEFT$(What, w \ _FONTWIDTH))
  284.                 text$ = RTRIM$(LEFT$(What, textallowed))
  285.                 _PRINTSTRING (TextFrameX + 2 + TextHandles(Handle).x1, (TextFrameY - 1) * fh + TextHandles(Handle).y1 + 2), text$
  286.                 PlaceText Handle, TextFrameY + 1, LeftJustify, MID$(What, textallowed + 1), 0
  287.             ELSE
  288.                 _PRINTSTRING (TextFrameX + 2 + TextHandles(Handle).x1, (TextFrameY - 1) * fh + TextHandles(Handle).y1 + 2), What
  289.                 finished = -1
  290.             END IF
  291.         CASE CenterJustify
  292.             IF pw > w THEN
  293.                 textallowed = WordBreak(LEFT$(What, w \ _FONTWIDTH))
  294.                 text$ = RTRIM$(LEFT$(What, textallowed))
  295.                 TextFrameX = (w - _PRINTWIDTH(text$)) \ 2
  296.                 _PRINTSTRING (TextFrameX + 2 + TextHandles(Handle).x1, (TextFrameY - 1) * fh + TextHandles(Handle).y1 + 2), text$
  297.                 PlaceText Handle, TextFrameY + 1, CenterJustify, MID$(What, textallowed + 1), NoUpdate
  298.             ELSE
  299.                 TextFrameX = (w - pw) \ 2
  300.                 _PRINTSTRING (TextFrameX + 2 + TextHandles(Handle).x1, (TextFrameY - 1) * fh + TextHandles(Handle).y1 + 2), What
  301.                 finished = -1
  302.             END IF
  303.         CASE RightJustify
  304.             IF pw > w THEN
  305.                 textallowed = WordBreak(LEFT$(What, w \ _FONTWIDTH))
  306.                 text$ = RTRIM$(LEFT$(What, textallowed))
  307.                 TextFrameX = w - _PRINTWIDTH(text$)
  308.                 _PRINTSTRING (TextFrameX + 2 + TextHandles(Handle).x1, (TextFrameY - 1) * fh + TextHandles(Handle).y1 + 2), text$
  309.                 PlaceText Handle, TextFrameY + 1, RightJustify, MID$(What, textallowed + 1), 0
  310.             ELSE
  311.                 TextFrameX = w - pw
  312.                 _PRINTSTRING (TextFrameX + 2 + TextHandles(Handle).x1, (TextFrameY - 1) * fh + TextHandles(Handle).y1 + 2), What
  313.                 finished = -1
  314.             END IF
  315.         CASE NoJustify
  316.             TextFrameX = TextHandles(Handle).Xpos
  317.             firstlinelimit = (w - TextFrameX) \ _FONTWIDTH 'the limit of characters on the first line
  318.             IF LEN(What) > firstlinelimit THEN
  319.                 textallowed = WordBreak(LEFT$(What, firstlinelimit))
  320.                 text$ = RTRIM$(LEFT$(What, textallowed))
  321.                 _PRINTSTRING (TextFrameX + 2 + TextHandles(Handle).x1, (TextFrameY - 1) * fh + TextHandles(Handle).y1 + 2), text$
  322.                 PlaceText Handle, TextFrameY + 1, LeftJustify, MID$(What, textallowed + 1), 0 'After the first line we start printing over on the left, after a line break
  323.             ELSE
  324.                 _PRINTSTRING (TextFrameX + 2 + TextHandles(Handle).x1, (TextFrameY - 1) * fh + TextHandles(Handle).y1 + 2), What
  325.                 finished = -1
  326.             END IF
  327.     END SELECT
  328.  
  329.     IF finished THEN
  330.         SELECT CASE TextHandles(Handle).UpdateMethod
  331.             CASE NoUpdate 'We don't update the position at all.
  332.             CASE DoUpdate
  333.                 TextHandles(Handle).Xpos = TextFrameX + pw
  334.                 TextHandles(Handle).Ypos = TextFrameY
  335.             CASE NewLine
  336.                 TextHandles(Handle).Ypos = TextFrameY + 1
  337.                 TextHandles(Handle).Xpos = 1
  338.         END SELECT
  339.         _DEST D: _SOURCE S
  340.         COLOR FG, BG
  341.     END IF
  342.  
  343. SUB SetTextForeground (Handle AS INTEGER, Foreground AS _UNSIGNED LONG)
  344.     u = UBOUND(TextHandles)
  345.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  346.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  347.     TextHandles(Handle).TextColor = Foreground
  348.  
  349.  
  350. SUB SetTextBackground (Handle AS INTEGER, Background AS _UNSIGNED LONG)
  351.     u = UBOUND(TextHandles)
  352.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  353.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  354.     TextHandles(Handle).TextBackgroundColor = Background
  355.  
  356.  
  357.  
  358. SUB SetTextColor (Handle AS INTEGER, Foreground AS _UNSIGNED LONG, Background AS _UNSIGNED LONG)
  359.     u = UBOUND(TextHandles)
  360.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  361.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  362.     TextHandles(Handle).TextColor = Foreground
  363.     TextHandles(Handle).TextBackgroundColor = Background
  364.  
  365.  
  366. SUB SetPrintUpdate (Handle AS INTEGER, Method AS INTEGER)
  367.     u = UBOUND(TextHandles)
  368.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  369.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  370.     IF Method < 0 OR Method > 2 THEN ERROR 5: EXIT FUNCTION
  371.     TextHandles(Handle).UpdateMethod = Method
  372.  
  373.  
  374. SUB SetPrintPosition (Handle AS INTEGER, TextFrameX AS INTEGER, TextFrameY AS INTEGER)
  375.     u = UBOUND(TextHandles)
  376.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  377.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  378.     SELECT CASE TextFrameY
  379.         CASE BottomLine
  380.             TextHandles(Handle).VerticalAlignment = -2
  381.         CASE CenterLine
  382.             TextHandles(Handle).VerticalAlignment = -1
  383.         CASE ELSE
  384.             TextHandles(Handle).VerticalAlignment = 0
  385.     END SELECT
  386.     IF TextFrameX < 1 AND TextFrameX > -4 THEN
  387.         TextHandles(Handle).Justification = TextFrameX
  388.     ELSE
  389.         TextHandles(Handle).Xpos = TextFrameX
  390.     END IF
  391.     IF TextFrameY < 1 THEN EXIT SUB
  392.     TextHandles(Handle).Ypos = TextFrameY
  393.  
  394. SUB SetPrintPositionX (Handle AS INTEGER, TextFrameX AS INTEGER)
  395.     u = UBOUND(TextHandles)
  396.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  397.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  398.     IF TextFrameX < 1 AND TextFrameX > -4 THEN
  399.         TextHandles(Handle).Justification = TextFrameX
  400.     ELSE
  401.         TextHandles(Handle).Xpos = TextFrameX
  402.     END IF
  403.  
  404. SUB SetPrintPositionY (Handle AS INTEGER, TextFrameY AS INTEGER)
  405.     u = UBOUND(TextHandles)
  406.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  407.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  408.     SELECT CASE TextFrameY
  409.         CASE BottomLine
  410.             TextHandles(Handle).VerticalAlignment = -2
  411.         CASE CenterLine
  412.             TextHandles(Handle).VerticalAlignment = -1
  413.         CASE ELSE
  414.             TextHandles(Handle).VerticalAlignment = 0
  415.     END SELECT
  416.     IF TextFrameY < 1 THEN EXIT SUB
  417.     TextHandles(Handle).Ypos = TextFrameY
  418.  
  419.  
  420. FUNCTION GetPrintPositionY (Handle AS INTEGER)
  421.     u = UBOUND(TextHandles)
  422.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  423.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  424.     GetPrintPositionY = TextHandles(Handle).Ypos
  425.  
  426. FUNCTION GetPrintPositionX (Handle AS INTEGER)
  427.     u = UBOUND(TextHandles)
  428.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  429.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  430.     GetPrintPositionX = TextHandles(Handle).Xpos
  431.  
  432.  
  433.  
  434. FUNCTION WordBreak (text$)
  435.     CONST Breaks = " ;,.?!-"
  436.     FOR i = LEN(text$) TO 0 STEP -1
  437.         IF INSTR(Breaks, MID$(text$, i, 1)) THEN EXIT FOR
  438.         loopcount = loopcount + 1
  439.     NEXT
  440.     IF i = 0 THEN i = LEN(text$)
  441.     WordBreak = i
  442.  
  443.  
  444.  
  445. SUB ClearTextArea (Handle AS INTEGER)
  446.     u = UBOUND(TextHandles)
  447.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  448.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  449.     IF TextHandles(Handle).SavedBackground THEN
  450.         w = TextHandles(Handle).w
  451.         h = TextHandles(Handle).h
  452.         x1 = TextHandles(Handle).ScreenX
  453.         y1 = TextHandles(Handle).ScreenY
  454.         x2 = x1 + w - 1
  455.         y2 = y1 + h - 1
  456.         blend = _BLEND
  457.         _DONTBLEND
  458.         _PUTIMAGE (x1, y1)-(x2, y2), TextHandles(Handle).SavedBackground
  459.         IF blend THEN _BLEND
  460.     END IF
  461.     DrawTextArea Handle
  462.  
  463.  
  464.  
  465. SUB DrawTextArea (Handle AS INTEGER)
  466.     u = UBOUND(TextHandles)
  467.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  468.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  469.     w = TextHandles(Handle).w
  470.     h = TextHandles(Handle).h
  471.     x1 = TextHandles(Handle).ScreenX
  472.     y1 = TextHandles(Handle).ScreenY
  473.     x2 = x1 + w - 1
  474.     y2 = y1 + h - 1
  475.  
  476.     LINE (x1, y1)-(x2, y2), TextHandles(Handle).BackColor, BF
  477.     LINE (x1, y1)-(x2, y2), TextHandles(Handle).FrameColor, B
  478.  
  479.  
  480.  
  481. SUB ColorTextArea (Handle AS INTEGER, FrameColor AS _UNSIGNED LONG, BackColor AS _UNSIGNED LONG)
  482.     u = UBOUND(TextHandles)
  483.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  484.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  485.     TextHandles(Handle).FrameColor = FrameColor
  486.     TextHandles(Handle).BackColor = BackColor
  487.  
  488.  
  489.  
  490. FUNCTION NewTextArea% (tx1 AS INTEGER, ty1 AS INTEGER, tx2 AS INTEGER, ty2 AS INTEGER, SaveBackground AS INTEGER)
  491.     x1 = tx1: y1 = ty1 'We pass temp variables to the function so we can swap values if needed without altering user variables
  492.     x2 = tx2: y2 = ty2
  493.     IF x1 > x2 THEN SWAP x1, x2
  494.     IF y1 > y2 THEN SWAP y1, y2
  495.     w = x2 - x1 + 1
  496.     h = y2 - y1 + 1
  497.     IF w = 0 AND h = 0 THEN ERROR 5: EXIT FUNCTION 'Illegal Function Call if the user tries to define an area with no size
  498.     'Error checking for if the user sends coordinates which are off the screen
  499.     IF x1 < 0 OR x2 > _WIDTH - 1 THEN ERROR 5: EXIT FUNCTION
  500.     IF y1 < 0 OR y2 > _HEIGHT - 1 THEN ERROR 5: EXIT FUNCTION
  501.  
  502.     u = UBOUND(TextHandles)
  503.     FOR i = 1 TO u 'First let's check to see if we have an open handle from where one was freed earlier
  504.         IF TextHandles(i).InUse = False THEN Handle = i: EXIT FOR
  505.     NEXT
  506.     IF Handle = 0 THEN 'We didn't have an open spot, so we need to add one to our list
  507.         Handle = u + 1
  508.         REDIM _PRESERVE TextHandles(Handle) AS TextArea
  509.     END IF
  510.     TextHandles(Handle).x1 = x1
  511.     TextHandles(Handle).y1 = y1
  512.     TextHandles(Handle).w = w: TextHandles(Handle).h = h
  513.     TextHandles(Handle).InUse = True
  514.     TextHandles(Handle).Xpos = 0
  515.     TextHandles(Handle).Ypos = 1
  516.     TextHandles(Handle).UpdateMethod = NewLine
  517.     TextHandles(Handle).TextColor = _RGB32(255, 255, 255) 'White text
  518.     TextHandles(Handle).TextBackgroundColor = _RGB32(0, 0, 0) 'Black background
  519.  
  520.     IF SaveBackground THEN
  521.         imagehandle = _NEWIMAGE(w, h, 32)
  522.         _PUTIMAGE , 0, imagehandle, (x1, y1)-(x2, y2)
  523.         TextHandles(Handle).SavedBackground = imagehandle
  524.     END IF
  525.     TextHandles(Handle).ScreenX = x1
  526.     TextHandles(Handle).ScreenY = y1
  527.  
  528.     NewTextArea% = Handle
  529.  
  530. SUB FreeTextArea (Handle AS INTEGER)
  531.     IF Handle > 0 AND Handle <= UBOUND(TextHandles) THEN
  532.         IF TextHandles(Handle).InUse THEN
  533.             TextHandles(Handle).InUse = False
  534.             IF TextHandles(Handle).SavedBackground THEN
  535.                 IF TextHandles(Handle).HideFrame = 0 THEN 'If the frame isn't hidden, then restore what's supposed to be beneath it
  536.                     w = TextHandles(Handle).w
  537.                     h = TextHandles(Handle).h
  538.                     x1 = TextHandles(Handle).ScreenX
  539.                     y1 = TextHandles(Handle).ScreenY
  540.                     x2 = x1 + w - 1
  541.                     y2 = y1 + h - 1
  542.                     blend = _BLEND
  543.                     _DONTBLEND
  544.                     _PUTIMAGE (x1, y1)-(x2, y2), TextHandles(Handle).SavedBackground
  545.                     IF blend THEN _BLEND
  546.                 END IF
  547.                 'Even if it is hidden though, if we're going to free that frame, we need to free the stored image held with it to reduce memory usage.
  548.                 _FREEIMAGE TextHandles(Handle).SavedBackground
  549.             END IF
  550.         ELSE
  551.             ERROR 258 'Invalid handle if the user tries to free a handle which has already been freed.
  552.         END IF
  553.     ELSE
  554.         ERROR 5 'Illegal function call if the user tries to free a handle that doesn't exist at all.
  555.     END IF
  556.  
  557. SUB HideFrame (Handle AS INTEGER)
  558.     IF TextHandles(Handle).HideFrame = 0 THEN 'only if the frame isn't hidden, can we hide it.
  559.         TextHandles(Handle).HideFrame = -1
  560.         w = TextHandles(Handle).w
  561.         h = TextHandles(Handle).h
  562.         x1 = TextHandles(Handle).ScreenX
  563.         y1 = TextHandles(Handle).ScreenY
  564.         x2 = x1 + w - 1
  565.         y2 = y1 + h - 1
  566.         imagehandle = _NEWIMAGE(TextHandles(Handle).w, TextHandles(Handle).h, 32)
  567.         _PUTIMAGE , 0, imagehandle, (x1, y1)-(x2, y2)
  568.         IF TextHandles(Handle).SavedBackground THEN
  569.             blend = _BLEND
  570.             _DONTBLEND
  571.             _PUTIMAGE (x1, y1)-(x2, y2), TextHandles(Handle).SavedBackground
  572.             _FREEIMAGE TextHandles(Handle).SavedBackground
  573.             IF blend THEN _BLEND
  574.         END IF
  575.         TextHandles(Handle).SavedBackground = imagehandle
  576.         TextHandles(Handle).x1 = 0 'When the frames are hidden, we calculate our print position based off the hidden image
  577.         TextHandles(Handle).y1 = 0 'So we'd start at point (0,0) as being top left
  578.     END IF
  579.  
  580. SUB RestoreFrame (Handle AS INTEGER)
  581.     IF TextHandles(Handle).HideFrame THEN 'only if we have a hidden frame do we have to worry about restoring it
  582.         TextHandles(Handle).HideFrame = 0
  583.         w = TextHandles(Handle).w
  584.         h = TextHandles(Handle).h
  585.         x1 = TextHandles(Handle).ScreenX
  586.         y1 = TextHandles(Handle).ScreenY
  587.         x2 = x1 + w - 1
  588.         y2 = y1 + h - 1
  589.         imagehandle = _NEWIMAGE(TextHandles(Handle).w, TextHandles(Handle).h, 32)
  590.         blend = _BLEND
  591.         _DONTBLEND
  592.         _PUTIMAGE , 0, imagehandle, (x1, y1)-(x2, y2)
  593.         _PUTIMAGE (x1, y1)-(x2, y2), TextHandles(Handle).SavedBackground ', 0, (0, 0)-(w, h)
  594.         _FREEIMAGE TextHandles(Handle).SavedBackground
  595.         IF blend THEN _BLEND
  596.         TextHandles(Handle).SavedBackground = imagehandle
  597.         TextHandles(Handle).x1 = x1 'When the frames are frames are restored, we need to recalculate our print position
  598.         TextHandles(Handle).y1 = y1 'as we're no longer going over the image cooridinates, but the screen location of the top left corner instead.
  599.     END IF
  600.  
  601. SUB MoveFrame (Handle AS INTEGER, x1 AS INTEGER, y1 AS INTEGER)
  602.     'Only two coordinates here, so we'll be positioning our frames new movement by the top left corner.
  603.     u = UBOUND(TextHandles)
  604.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  605.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  606.     HideFrame Handle
  607.     TextHandles(Handle).ScreenX = x1
  608.     TextHandles(Handle).ScreenY = y1
  609.     RestoreFrame Handle
  610.  

Works with CONST FileName$ = "bat.txt", cause I'm too lazy to type the full file name."  :P

This should also work with trick and treat, with minor alterations, which I'll post soon(tm).
https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!

Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 3234
    • Steve’s QB64 Archive Forum
Re: Word Search
« Reply #3 on: October 19, 2018, 05:42:35 PM »
Code: QB64: [Select]
  1. '*****************************
  2. '  TEXT FRAMES LIBRARY CODE
  3. '*****************************
  4.  
  5. TYPE TextArea
  6.     InUse AS INTEGER
  7.     x1 AS LONG 'left
  8.     y1 AS LONG 'top
  9.     w AS LONG 'width
  10.     h AS LONG 'height
  11.     FrameColor AS _UNSIGNED LONG
  12.     BackColor AS _UNSIGNED LONG
  13.     Xpos AS INTEGER
  14.     Ypos AS INTEGER
  15.     VerticalAlignment AS INTEGER
  16.     Justification AS INTEGER
  17.     UpdateMethod AS INTEGER
  18.     TextColor AS _UNSIGNED LONG
  19.     TextBackgroundColor AS _UNSIGNED LONG
  20.     SavedBackground AS INTEGER
  21.     HideFrame AS INTEGER
  22.     ScreenX AS INTEGER
  23.     ScreenY AS INTEGER
  24.  
  25. REDIM SHARED TextHandles(0) AS TextArea
  26.  
  27. CONST True = -1, False = 0
  28. CONST LeftJustify = -1, CenterJustify = -2, RightJustify = -3, NoJustify = 0
  29. CONST OnLine = 0, CenterLine = -1, TopLine = 1, BottomLine = -2
  30. CONST NoUpdate = 0, DoUpdate = 1, NewLine = 2
  31.  
  32. '**********************************
  33. '*   PROGRAM CODE
  34. '**********************************
  35.  
  36.  
  37.  
  38.  
  39.  
  40.  
  41. CONST FileName$ = "tt.txt"
  42.  
  43.  
  44. REDIM SHARED WordGrid(0, 0) AS STRING * 1
  45. REDIM SHARED YLines(0, 0) AS STRING
  46. REDIM SHARED XLines(0, 0) AS STRING
  47.  
  48. DIM SHARED SearchTerms(1) AS STRING
  49. SearchTerms(0) = "TRICK": SearchTerms(1) = "TREAT"
  50.  
  51.  
  52. DIM SHARED LeftFrame AS INTEGER, RightFrame AS INTEGER
  53.  
  54.  
  55. SCREEN _NEWIMAGE(1280, 720, 32) '720p HD just cause I like it as a standard
  56.  
  57.  
  58. LeftFrame = NewTextArea(0, 0, 400, _HEIGHT - 1, False)
  59. ColorTextArea LeftFrame, _RGB32(255, 255, 255), _RGB32(0, 0, 128)
  60. DrawTextArea LeftFrame
  61.  
  62. RightFrame = NewTextArea(401, 0, _WIDTH - 1, _HEIGHT - 1, False)
  63. ColorTextArea RightFrame, _RGB32(255, 255, 255), _RGB32(0, 0, 0)
  64. DrawTextArea RightFrame
  65.  
  66.  
  67.  
  68. LoadWordGrid
  69. MakeDirectional
  70. ShowGrid
  71. FindWords
  72.  
  73.  
  74.  
  75. SUB FindWords
  76.     FOR j = 0 TO UBOUND(SearchTerms)
  77.         PrintOut RightFrame, "SEARCHING FOR " + SearchTerms(j)
  78.         PrintOut RightFrame, ""
  79.         PrintOut RightFrame, "Finding Left to Right Matches"
  80.         FOR i = 1 TO Y
  81.             foundone = 0
  82.             DO
  83.                 foundone = INSTR(foundone + 1, YLines(1, i), SearchTerms(j))
  84.                 IF foundone THEN
  85.                     OUT$ = OUT$ + "(Line" + STR$(i) + ", Position" + STR$(foundone) + "), "
  86.                     tc = tc + 1
  87.                 END IF
  88.             LOOP UNTIL NOT foundone
  89.         NEXT
  90.         PrintOut RightFrame, OUT$
  91.  
  92.         OUT$ = ""
  93.         PrintOut RightFrame, ""
  94.         PrintOut RightFrame, "Finding Right to Left Matches"
  95.         FOR i = 1 TO Y
  96.             foundone = 0
  97.             DO
  98.                 foundone = INSTR(foundone + 1, YLines(2, i), SearchTerms(j))
  99.                 IF foundone THEN
  100.                     OUT$ = OUT$ + "(Line" + STR$(i) + ", Position" + STR$(X - foundone + 1) + "), "
  101.                     tc = tc + 1
  102.                 END IF
  103.             LOOP UNTIL NOT foundone
  104.         NEXT
  105.         PrintOut RightFrame, OUT$
  106.  
  107.         OUT$ = ""
  108.         PrintOut RightFrame, ""
  109.         PrintOut RightFrame, "Finding Up to Down Matches"
  110.         FOR i = 1 TO X
  111.             foundone = 0
  112.             DO
  113.                 foundone = INSTR(foundone + 1, XLines(1, i), SearchTerms(j))
  114.                 IF foundone THEN
  115.                     OUT$ = OUT$ + "(Line" + STR$(foundone) + ", Position" + STR$(i) + "), "
  116.                     tc = tc + 1
  117.                 END IF
  118.             LOOP UNTIL NOT foundone
  119.         NEXT
  120.         PrintOut RightFrame, OUT$
  121.  
  122.         OUT$ = ""
  123.         PrintOut RightFrame, ""
  124.         PrintOut RightFrame, "Finding Down to Up Matches"
  125.         FOR i = 1 TO X
  126.             foundone = 0
  127.             DO
  128.                 foundone = INSTR(foundone + 1, XLines(2, i), SearchTerms(j))
  129.                 IF foundone THEN
  130.                     OUT$ = OUT$ + "(Line" + STR$(foundone) + ", Position" + STR$(i) + "), "
  131.                     tc = tc + 1
  132.                 END IF
  133.             LOOP UNTIL NOT foundone
  134.         NEXT
  135.         PrintOut RightFrame, OUT$
  136.         PrintOut RightFrame, ""
  137.         PrintOut RightFrame, ""
  138.         PrintOut RightFrame, STR$(tc) + " total matches found."
  139.         PrintOut RightFrame, ""
  140.         PrintOut RightFrame, ""
  141.         tc = 0
  142.     NEXT
  143.  
  144.  
  145.  
  146. SUB ShowGrid
  147.     'Print the words in the grid
  148.     SetTextColor LeftFrame, _RGB32(255, 255, 0), 0
  149.     PrintOut LeftFrame, ""
  150.     PrintOut LeftFrame, "                     WORD GRID"
  151.     PrintOut LeftFrame, ""
  152.     SetTextColor LeftFrame, _RGB32(255, 255, 255), 0
  153.     FOR i = 1 TO Y
  154.         PrintOut LeftFrame, "  " + YLines(1, i)
  155.     NEXT
  156.  
  157.  
  158.  
  159.  
  160. SUB LoadWordGrid
  161.     OPEN FileName$ FOR BINARY AS #1
  162.     DO UNTIL EOF(1)
  163.         LINE INPUT #1, junk$
  164.         Y = Y + 1
  165.     LOOP
  166.     X = LEN(junk$): Y = Y
  167.     SEEK #1, 1
  168.  
  169.     REDIM WordGrid(1 TO X, 1 TO Y) AS STRING * 1 'Properly size our grid, with borders
  170.     REDIM YLines(2, Y) AS STRING
  171.     REDIM XLines(2, X) AS STRING
  172.  
  173.     FOR i = 1 TO Y
  174.         LINE INPUT #1, junk$
  175.         FOR j = 1 TO X
  176.             WordGrid(j, i) = MID$(junk$, j) 'Fill in the grid with the letters
  177.         NEXT
  178.     NEXT
  179.     CLOSE #1
  180.  
  181. SUB MakeDirectional
  182.     FOR i = 1 TO Y
  183.         FOR j = 1 TO X
  184.             YLines(1, i) = YLines(1, i) + WordGrid(j, i) 'Left to Right Lines
  185.     NEXT j, i
  186.     FOR i = 1 TO Y: FOR j = X TO 1 STEP -1
  187.             YLines(2, i) = YLines(2, i) + WordGrid(j, i) 'Right to Left Lines
  188.     NEXT j, i
  189.     FOR i = 1 TO Y: FOR j = 1 TO X
  190.             XLines(1, i) = XLines(1, i) + WordGrid(j, i) 'Up to Down Lines
  191.     NEXT j, i
  192.     FOR i = 1 TO Y: FOR j = X TO 1 STEP -1
  193.             XLines(2, i) = XLines(1, i) + WordGrid(j, i) 'Right to Left Lines
  194.     NEXT j, i
  195.  
  196. '*****************************
  197. '  TEXT FRAMES LIBRARY CODE
  198. '*****************************
  199.  
  200. SUB PrintOut (WhichHandle AS INTEGER, What AS STRING)
  201.     u = UBOUND(TextHandles)
  202.     Handle = WhichHandle
  203.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  204.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  205.     Where = TextHandles(Handle).VerticalAlignment
  206.     How = TextHandles(Handle).Justification
  207.     UpdatePrintPosition = TextHandles(Handle).UpdateMethod
  208.     PlaceText Handle, Where, How, What, UpdatePrintPosition
  209.  
  210.  
  211. SUB PlaceText (WhichHandle AS INTEGER, Where AS INTEGER, How AS INTEGER, What AS STRING, UpdatePrintPosition AS INTEGER)
  212.     'WhichHandle is the handle which designates which text area we want to use
  213.     'Where is where we want it to go in that text area
  214.     '  -- Online prints the text to the current print position line in that text area.
  215.     '  -- CenterLine centers the text to the center of that text area.
  216.     '  -- any other value will print to that line positon in that particular box.
  217.     'How tells us how we want to place that text (LeftJustified, RightJustified,CenterJustified, or NoJustify)
  218.     'What is the text that we want to print in our text area
  219.     'UpdatePrintPosition lets us know if we need to move to a newline or stay on the same line.  (Think PRINT with a semicolon vs PRINT without a semicolon).
  220.  
  221.     D = _DEST: S = _SOURCE
  222.  
  223.  
  224.     u = UBOUND(TextHandles)
  225.     fh = _FONTHEIGHT
  226.     pw = _PRINTWIDTH(What)
  227.     Handle = WhichHandle
  228.  
  229.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  230.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  231.     IF TextHandles(Handle).HideFrame THEN
  232.         _DEST TextHandles(Handle).SavedBackground
  233.         _SOURCE TextHandles(Handle).SavedBackground
  234.     END IF
  235.     h = TextHandles(Handle).h - 4
  236.     w = TextHandles(Handle).w - 4
  237.  
  238.     SELECT CASE Where
  239.         CASE BottomLine
  240.             TextFrameY = h \ fh
  241.         CASE OnLine
  242.             TextFrameY = TextHandles(Handle).Ypos
  243.             IF TextFrameY = 0 THEN TextFrameY = 1
  244.         CASE CenterLine
  245.             linesused = 0
  246.             tpw = pw: tw = w: tWhat$ = What
  247.             DO UNTIL tpw <= tw
  248.                 textallowed = WordBreak(LEFT$(tWhat$, w \ _FONTWIDTH))
  249.                 text$ = RTRIM$(LEFT$(tWhat$, textallowed))
  250.                 linesused = linesused + 1
  251.                 tWhat$ = MID$(tWhat$, textallowed + 1)
  252.                 tpw = _PRINTWIDTH(tWhat$)
  253.             LOOP
  254.             linesused = linesused + 1
  255.             py = (h - linesused * fh) \ 2
  256.             TextFrameY = py \ fh + 1
  257.             IF TextFrameY < 1 THEN TextFrameY = 1
  258.         CASE ELSE
  259.             TextFrameY = Where
  260.     END SELECT
  261.  
  262.     IF TextFrameY < 1 THEN ERROR 5: EXIT FUNCTION 'We don't print above the allocated text area.
  263.     blend = _BLEND
  264.     DO UNTIL TextFrameY * fh < h 'We need to scroll the text area up, if someone is trying to print below it.
  265.         'first let's get a temp image handle for the existing area of the screen.
  266.         x1 = TextHandles(Handle).x1 + 2
  267.         y1 = TextHandles(Handle).y1 + 2
  268.         x2 = TextHandles(Handle).x1 + w
  269.         y2 = TextHandles(Handle).y1 + h
  270.         nh = y2 - y1 + 1 - fh
  271.         nw = x2 - x1 + 1
  272.         tempimage = _NEWIMAGE(nw, nh, 32) 'Really, I should swap this to a routine to pick which screen mode the user is in, but I'll come back to that later.
  273.         _PUTIMAGE , , tempimage, (x1, y1 + fh)-(x2, y2)
  274.         DrawTextArea Handle
  275.         _PUTIMAGE (x1, y1)-(x2, y2 - fh), tempimage
  276.         TextFrameY = TextFrameY - 1
  277.     LOOP
  278.     IF blend THEN _BLEND
  279.  
  280.     COLOR TextHandles(Handle).TextColor, TextHandles(Handle).TextBackgroundColor
  281.  
  282.     SELECT CASE How
  283.         CASE LeftJustify
  284.             TextFrameX = 0
  285.             IF pw > w THEN
  286.                 textallowed = WordBreak(LEFT$(What, w \ _FONTWIDTH))
  287.                 text$ = RTRIM$(LEFT$(What, textallowed))
  288.                 _PRINTSTRING (TextFrameX + 2 + TextHandles(Handle).x1, (TextFrameY - 1) * fh + TextHandles(Handle).y1 + 2), text$
  289.                 PlaceText Handle, TextFrameY + 1, LeftJustify, MID$(What, textallowed + 1), 0
  290.             ELSE
  291.                 _PRINTSTRING (TextFrameX + 2 + TextHandles(Handle).x1, (TextFrameY - 1) * fh + TextHandles(Handle).y1 + 2), What
  292.                 finished = -1
  293.             END IF
  294.         CASE CenterJustify
  295.             IF pw > w THEN
  296.                 textallowed = WordBreak(LEFT$(What, w \ _FONTWIDTH))
  297.                 text$ = RTRIM$(LEFT$(What, textallowed))
  298.                 TextFrameX = (w - _PRINTWIDTH(text$)) \ 2
  299.                 _PRINTSTRING (TextFrameX + 2 + TextHandles(Handle).x1, (TextFrameY - 1) * fh + TextHandles(Handle).y1 + 2), text$
  300.                 PlaceText Handle, TextFrameY + 1, CenterJustify, MID$(What, textallowed + 1), NoUpdate
  301.             ELSE
  302.                 TextFrameX = (w - pw) \ 2
  303.                 _PRINTSTRING (TextFrameX + 2 + TextHandles(Handle).x1, (TextFrameY - 1) * fh + TextHandles(Handle).y1 + 2), What
  304.                 finished = -1
  305.             END IF
  306.         CASE RightJustify
  307.             IF pw > w THEN
  308.                 textallowed = WordBreak(LEFT$(What, w \ _FONTWIDTH))
  309.                 text$ = RTRIM$(LEFT$(What, textallowed))
  310.                 TextFrameX = w - _PRINTWIDTH(text$)
  311.                 _PRINTSTRING (TextFrameX + 2 + TextHandles(Handle).x1, (TextFrameY - 1) * fh + TextHandles(Handle).y1 + 2), text$
  312.                 PlaceText Handle, TextFrameY + 1, RightJustify, MID$(What, textallowed + 1), 0
  313.             ELSE
  314.                 TextFrameX = w - pw
  315.                 _PRINTSTRING (TextFrameX + 2 + TextHandles(Handle).x1, (TextFrameY - 1) * fh + TextHandles(Handle).y1 + 2), What
  316.                 finished = -1
  317.             END IF
  318.         CASE NoJustify
  319.             TextFrameX = TextHandles(Handle).Xpos
  320.             firstlinelimit = (w - TextFrameX) \ _FONTWIDTH 'the limit of characters on the first line
  321.             IF LEN(What) > firstlinelimit THEN
  322.                 textallowed = WordBreak(LEFT$(What, firstlinelimit))
  323.                 text$ = RTRIM$(LEFT$(What, textallowed))
  324.                 _PRINTSTRING (TextFrameX + 2 + TextHandles(Handle).x1, (TextFrameY - 1) * fh + TextHandles(Handle).y1 + 2), text$
  325.                 PlaceText Handle, TextFrameY + 1, LeftJustify, MID$(What, textallowed + 1), 0 'After the first line we start printing over on the left, after a line break
  326.             ELSE
  327.                 _PRINTSTRING (TextFrameX + 2 + TextHandles(Handle).x1, (TextFrameY - 1) * fh + TextHandles(Handle).y1 + 2), What
  328.                 finished = -1
  329.             END IF
  330.     END SELECT
  331.  
  332.     IF finished THEN
  333.         SELECT CASE TextHandles(Handle).UpdateMethod
  334.             CASE NoUpdate 'We don't update the position at all.
  335.             CASE DoUpdate
  336.                 TextHandles(Handle).Xpos = TextFrameX + pw
  337.                 TextHandles(Handle).Ypos = TextFrameY
  338.             CASE NewLine
  339.                 TextHandles(Handle).Ypos = TextFrameY + 1
  340.                 TextHandles(Handle).Xpos = 1
  341.         END SELECT
  342.         _DEST D: _SOURCE S
  343.         COLOR FG, BG
  344.     END IF
  345.  
  346. SUB SetTextForeground (Handle AS INTEGER, Foreground AS _UNSIGNED LONG)
  347.     u = UBOUND(TextHandles)
  348.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  349.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  350.     TextHandles(Handle).TextColor = Foreground
  351.  
  352.  
  353. SUB SetTextBackground (Handle AS INTEGER, Background AS _UNSIGNED LONG)
  354.     u = UBOUND(TextHandles)
  355.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  356.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  357.     TextHandles(Handle).TextBackgroundColor = Background
  358.  
  359.  
  360.  
  361. SUB SetTextColor (Handle AS INTEGER, Foreground AS _UNSIGNED LONG, Background AS _UNSIGNED LONG)
  362.     u = UBOUND(TextHandles)
  363.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  364.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  365.     TextHandles(Handle).TextColor = Foreground
  366.     TextHandles(Handle).TextBackgroundColor = Background
  367.  
  368.  
  369. SUB SetPrintUpdate (Handle AS INTEGER, Method AS INTEGER)
  370.     u = UBOUND(TextHandles)
  371.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  372.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  373.     IF Method < 0 OR Method > 2 THEN ERROR 5: EXIT FUNCTION
  374.     TextHandles(Handle).UpdateMethod = Method
  375.  
  376.  
  377. SUB SetPrintPosition (Handle AS INTEGER, TextFrameX AS INTEGER, TextFrameY AS INTEGER)
  378.     u = UBOUND(TextHandles)
  379.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  380.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  381.     SELECT CASE TextFrameY
  382.         CASE BottomLine
  383.             TextHandles(Handle).VerticalAlignment = -2
  384.         CASE CenterLine
  385.             TextHandles(Handle).VerticalAlignment = -1
  386.         CASE ELSE
  387.             TextHandles(Handle).VerticalAlignment = 0
  388.     END SELECT
  389.     IF TextFrameX < 1 AND TextFrameX > -4 THEN
  390.         TextHandles(Handle).Justification = TextFrameX
  391.     ELSE
  392.         TextHandles(Handle).Xpos = TextFrameX
  393.     END IF
  394.     IF TextFrameY < 1 THEN EXIT SUB
  395.     TextHandles(Handle).Ypos = TextFrameY
  396.  
  397. SUB SetPrintPositionX (Handle AS INTEGER, TextFrameX AS INTEGER)
  398.     u = UBOUND(TextHandles)
  399.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  400.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  401.     IF TextFrameX < 1 AND TextFrameX > -4 THEN
  402.         TextHandles(Handle).Justification = TextFrameX
  403.     ELSE
  404.         TextHandles(Handle).Xpos = TextFrameX
  405.     END IF
  406.  
  407. SUB SetPrintPositionY (Handle AS INTEGER, TextFrameY AS INTEGER)
  408.     u = UBOUND(TextHandles)
  409.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  410.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  411.     SELECT CASE TextFrameY
  412.         CASE BottomLine
  413.             TextHandles(Handle).VerticalAlignment = -2
  414.         CASE CenterLine
  415.             TextHandles(Handle).VerticalAlignment = -1
  416.         CASE ELSE
  417.             TextHandles(Handle).VerticalAlignment = 0
  418.     END SELECT
  419.     IF TextFrameY < 1 THEN EXIT SUB
  420.     TextHandles(Handle).Ypos = TextFrameY
  421.  
  422.  
  423. FUNCTION GetPrintPositionY (Handle AS INTEGER)
  424.     u = UBOUND(TextHandles)
  425.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  426.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  427.     GetPrintPositionY = TextHandles(Handle).Ypos
  428.  
  429. FUNCTION GetPrintPositionX (Handle AS INTEGER)
  430.     u = UBOUND(TextHandles)
  431.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  432.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  433.     GetPrintPositionX = TextHandles(Handle).Xpos
  434.  
  435.  
  436.  
  437. FUNCTION WordBreak (text$)
  438.     CONST Breaks = " ;,.?!-"
  439.     FOR i = LEN(text$) TO 0 STEP -1
  440.         IF INSTR(Breaks, MID$(text$, i, 1)) THEN EXIT FOR
  441.         loopcount = loopcount + 1
  442.     NEXT
  443.     IF i = 0 THEN i = LEN(text$)
  444.     WordBreak = i
  445.  
  446.  
  447.  
  448. SUB ClearTextArea (Handle AS INTEGER)
  449.     u = UBOUND(TextHandles)
  450.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  451.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  452.     IF TextHandles(Handle).SavedBackground THEN
  453.         w = TextHandles(Handle).w
  454.         h = TextHandles(Handle).h
  455.         x1 = TextHandles(Handle).ScreenX
  456.         y1 = TextHandles(Handle).ScreenY
  457.         x2 = x1 + w - 1
  458.         y2 = y1 + h - 1
  459.         blend = _BLEND
  460.         _DONTBLEND
  461.         _PUTIMAGE (x1, y1)-(x2, y2), TextHandles(Handle).SavedBackground
  462.         IF blend THEN _BLEND
  463.     END IF
  464.     DrawTextArea Handle
  465.  
  466.  
  467.  
  468. SUB DrawTextArea (Handle AS INTEGER)
  469.     u = UBOUND(TextHandles)
  470.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  471.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  472.     w = TextHandles(Handle).w
  473.     h = TextHandles(Handle).h
  474.     x1 = TextHandles(Handle).ScreenX
  475.     y1 = TextHandles(Handle).ScreenY
  476.     x2 = x1 + w - 1
  477.     y2 = y1 + h - 1
  478.  
  479.     LINE (x1, y1)-(x2, y2), TextHandles(Handle).BackColor, BF
  480.     LINE (x1, y1)-(x2, y2), TextHandles(Handle).FrameColor, B
  481.  
  482.  
  483.  
  484. SUB ColorTextArea (Handle AS INTEGER, FrameColor AS _UNSIGNED LONG, BackColor AS _UNSIGNED LONG)
  485.     u = UBOUND(TextHandles)
  486.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  487.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  488.     TextHandles(Handle).FrameColor = FrameColor
  489.     TextHandles(Handle).BackColor = BackColor
  490.  
  491.  
  492.  
  493. FUNCTION NewTextArea% (tx1 AS INTEGER, ty1 AS INTEGER, tx2 AS INTEGER, ty2 AS INTEGER, SaveBackground AS INTEGER)
  494.     x1 = tx1: y1 = ty1 'We pass temp variables to the function so we can swap values if needed without altering user variables
  495.     x2 = tx2: y2 = ty2
  496.     IF x1 > x2 THEN SWAP x1, x2
  497.     IF y1 > y2 THEN SWAP y1, y2
  498.     w = x2 - x1 + 1
  499.     h = y2 - y1 + 1
  500.     IF w = 0 AND h = 0 THEN ERROR 5: EXIT FUNCTION 'Illegal Function Call if the user tries to define an area with no size
  501.     'Error checking for if the user sends coordinates which are off the screen
  502.     IF x1 < 0 OR x2 > _WIDTH - 1 THEN ERROR 5: EXIT FUNCTION
  503.     IF y1 < 0 OR y2 > _HEIGHT - 1 THEN ERROR 5: EXIT FUNCTION
  504.  
  505.     u = UBOUND(TextHandles)
  506.     FOR i = 1 TO u 'First let's check to see if we have an open handle from where one was freed earlier
  507.         IF TextHandles(i).InUse = False THEN Handle = i: EXIT FOR
  508.     NEXT
  509.     IF Handle = 0 THEN 'We didn't have an open spot, so we need to add one to our list
  510.         Handle = u + 1
  511.         REDIM _PRESERVE TextHandles(Handle) AS TextArea
  512.     END IF
  513.     TextHandles(Handle).x1 = x1
  514.     TextHandles(Handle).y1 = y1
  515.     TextHandles(Handle).w = w: TextHandles(Handle).h = h
  516.     TextHandles(Handle).InUse = True
  517.     TextHandles(Handle).Xpos = 0
  518.     TextHandles(Handle).Ypos = 1
  519.     TextHandles(Handle).UpdateMethod = NewLine
  520.     TextHandles(Handle).TextColor = _RGB32(255, 255, 255) 'White text
  521.     TextHandles(Handle).TextBackgroundColor = _RGB32(0, 0, 0) 'Black background
  522.  
  523.     IF SaveBackground THEN
  524.         imagehandle = _NEWIMAGE(w, h, 32)
  525.         _PUTIMAGE , 0, imagehandle, (x1, y1)-(x2, y2)
  526.         TextHandles(Handle).SavedBackground = imagehandle
  527.     END IF
  528.     TextHandles(Handle).ScreenX = x1
  529.     TextHandles(Handle).ScreenY = y1
  530.  
  531.     NewTextArea% = Handle
  532.  
  533. SUB FreeTextArea (Handle AS INTEGER)
  534.     IF Handle > 0 AND Handle <= UBOUND(TextHandles) THEN
  535.         IF TextHandles(Handle).InUse THEN
  536.             TextHandles(Handle).InUse = False
  537.             IF TextHandles(Handle).SavedBackground THEN
  538.                 IF TextHandles(Handle).HideFrame = 0 THEN 'If the frame isn't hidden, then restore what's supposed to be beneath it
  539.                     w = TextHandles(Handle).w
  540.                     h = TextHandles(Handle).h
  541.                     x1 = TextHandles(Handle).ScreenX
  542.                     y1 = TextHandles(Handle).ScreenY
  543.                     x2 = x1 + w - 1
  544.                     y2 = y1 + h - 1
  545.                     blend = _BLEND
  546.                     _DONTBLEND
  547.                     _PUTIMAGE (x1, y1)-(x2, y2), TextHandles(Handle).SavedBackground
  548.                     IF blend THEN _BLEND
  549.                 END IF
  550.                 'Even if it is hidden though, if we're going to free that frame, we need to free the stored image held with it to reduce memory usage.
  551.                 _FREEIMAGE TextHandles(Handle).SavedBackground
  552.             END IF
  553.         ELSE
  554.             ERROR 258 'Invalid handle if the user tries to free a handle which has already been freed.
  555.         END IF
  556.     ELSE
  557.         ERROR 5 'Illegal function call if the user tries to free a handle that doesn't exist at all.
  558.     END IF
  559.  
  560. SUB HideFrame (Handle AS INTEGER)
  561.     IF TextHandles(Handle).HideFrame = 0 THEN 'only if the frame isn't hidden, can we hide it.
  562.         TextHandles(Handle).HideFrame = -1
  563.         w = TextHandles(Handle).w
  564.         h = TextHandles(Handle).h
  565.         x1 = TextHandles(Handle).ScreenX
  566.         y1 = TextHandles(Handle).ScreenY
  567.         x2 = x1 + w - 1
  568.         y2 = y1 + h - 1
  569.         imagehandle = _NEWIMAGE(TextHandles(Handle).w, TextHandles(Handle).h, 32)
  570.         _PUTIMAGE , 0, imagehandle, (x1, y1)-(x2, y2)
  571.         IF TextHandles(Handle).SavedBackground THEN
  572.             blend = _BLEND
  573.             _DONTBLEND
  574.             _PUTIMAGE (x1, y1)-(x2, y2), TextHandles(Handle).SavedBackground
  575.             _FREEIMAGE TextHandles(Handle).SavedBackground
  576.             IF blend THEN _BLEND
  577.         END IF
  578.         TextHandles(Handle).SavedBackground = imagehandle
  579.         TextHandles(Handle).x1 = 0 'When the frames are hidden, we calculate our print position based off the hidden image
  580.         TextHandles(Handle).y1 = 0 'So we'd start at point (0,0) as being top left
  581.     END IF
  582.  
  583. SUB RestoreFrame (Handle AS INTEGER)
  584.     IF TextHandles(Handle).HideFrame THEN 'only if we have a hidden frame do we have to worry about restoring it
  585.         TextHandles(Handle).HideFrame = 0
  586.         w = TextHandles(Handle).w
  587.         h = TextHandles(Handle).h
  588.         x1 = TextHandles(Handle).ScreenX
  589.         y1 = TextHandles(Handle).ScreenY
  590.         x2 = x1 + w - 1
  591.         y2 = y1 + h - 1
  592.         imagehandle = _NEWIMAGE(TextHandles(Handle).w, TextHandles(Handle).h, 32)
  593.         blend = _BLEND
  594.         _DONTBLEND
  595.         _PUTIMAGE , 0, imagehandle, (x1, y1)-(x2, y2)
  596.         _PUTIMAGE (x1, y1)-(x2, y2), TextHandles(Handle).SavedBackground ', 0, (0, 0)-(w, h)
  597.         _FREEIMAGE TextHandles(Handle).SavedBackground
  598.         IF blend THEN _BLEND
  599.         TextHandles(Handle).SavedBackground = imagehandle
  600.         TextHandles(Handle).x1 = x1 'When the frames are frames are restored, we need to recalculate our print position
  601.         TextHandles(Handle).y1 = y1 'as we're no longer going over the image cooridinates, but the screen location of the top left corner instead.
  602.     END IF
  603.  
  604. SUB MoveFrame (Handle AS INTEGER, x1 AS INTEGER, y1 AS INTEGER)
  605.     'Only two coordinates here, so we'll be positioning our frames new movement by the top left corner.
  606.     u = UBOUND(TextHandles)
  607.     IF Handle < 1 OR Handle > u THEN ERROR 5: EXIT FUNCTION
  608.     IF TextHandles(Handle).InUse = False THEN ERROR 5: EXIT FUNCTION
  609.     HideFrame Handle
  610.     TextHandles(Handle).ScreenX = x1
  611.     TextHandles(Handle).ScreenY = y1
  612.     RestoreFrame Handle
  613.  

For the second puzzle, where I was lazy and renamed the tirck and treat file to "tt.txt".

Feel free to change the internals as needed for different word search puzzles, with these lines:

Code: QB64: [Select]
  1. CONST FileName$ = "tt.txt"
  2.  
  3.  
  4. REDIM SHARED WordGrid(0, 0) AS STRING * 1
  5. REDIM SHARED YLines(0, 0) AS STRING
  6. REDIM SHARED XLines(0, 0) AS STRING
  7.  
  8. DIM SHARED SearchTerms(1) AS STRING
  9. SearchTerms(0) = "TRICK": SearchTerms(1) = "TREAT"
https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!

Offline bplus

  • Forum Resident
  • Posts: 5947
  • B+ Knot again!
Re: Word Search
« Reply #4 on: October 19, 2018, 05:50:55 PM »
Hi Steve,

RE: the first post (you posted again as I was composing this reply)

Your count is low, (I get 44 bats counted (< 50%) when I run your program after I fix the file name :P ) I suspect you are NOT checking the 4 diagonal directions for words.

Code: QB64: [Select]
  1. 6   7   8
  2.  D  D  D
  3.   R R R
  4.    OOO
  5. 5DROWORD1
  6.    OOO
  7.   R R R
  8.  D  D  D
  9. 4   3   2
  10.  

Let me know if you want to see my 71 line BAT counter, that is not generalized enough to do TRICK TREAT but with a few quick mods can easily. When you run mine, the BAT's flutter around the screen if you lean on the enter key.

Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 3234
    • Steve’s QB64 Archive Forum
Re: Word Search
« Reply #5 on: October 19, 2018, 05:54:29 PM »
I wasn't checking diagonally.  :P

I'm used to up/down/left/right checking.   It's easy enough to add the other ways though, but that'll have to wait till later.   The wife says, "We're going shopping!"

/cry
https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!

Offline bplus

  • Forum Resident
  • Posts: 5947
  • B+ Knot again!
Re: Word Search
« Reply #6 on: October 19, 2018, 05:59:07 PM »
I give you a B+ for being the first responder here and the first to do verticals.

BTW, 630+ lines??? man aren't you the guy that got the pig code from 32 to 17 lines. ;D

I suspect you are re-purposing other code procedures, allot of them! ;D

Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 3234
    • Steve’s QB64 Archive Forum
Re: Word Search
« Reply #7 on: October 19, 2018, 06:11:02 PM »
I give you a B+ for being the first responder here and the first to do verticals.

BTW, 630+ lines??? man aren't you the guy that got the pig code from 32 to 17 lines. ;D

I suspect you are re-purposing other code procedures, allot of them! ;D

Most of it is just an insertion of my TextFrame library, which lets us designate specific frames to print in, and 90% of that library isn't even used. 

I just like the ease of being able to print in various sections of the screen, with automatic word-wrap, line scrolling, and hideable/moveable all set up and ready to go.

NewTextArea(0, 0, 400, _HEIGHT - 1, False)
ColorTextArea LeftFrame, _RGB32(255, 255, 255), _RGB32(0, 0, 128)
DrawTextArea LeftFrame

RightFrame = NewTextArea(401, 0, _WIDTH - 1, _HEIGHT - 1, False)
ColorTextArea RightFrame, _RGB32(255, 255, 255), _RGB32(0, 0, 0)
DrawTextArea RightFrame

Once the library is loaded, it's basically that easy to designate different text areas to print to.
« Last Edit: October 19, 2018, 06:13:10 PM by SMcNeill »
https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!

Offline codeguy

  • Forum Regular
  • Posts: 180
Re: Word Search
« Reply #8 on: October 20, 2018, 12:31:41 AM »
did you know 8 items taken at a time from 26 items gives you 1562275 distinct combinations? How to find these distinct combinations, you ask? (Not the same as permutations)
Code: QB64: [Select]
  1. n = 25
  2. DIM array2combine(0 TO n) AS _UNSIGNED _BYTE '* could be the ascii values of letters - even strings if modified
  3. FOR i = 0 TO n
  4.     array2combine(i) = i + 1
  5. r = 7
  6. DIM result(0 TO r) AS _UNSIGNED _BYTE
  7.  
  8. CombinationsNR array2combine(), r, LBOUND(array2combine), result(), combinations&
  9. ' *_CLIPBOARD$ = LTRIM$(STR$(combinations&))
  10. PRINT "Combination("; n + 1; "taken "; r + 1; ") at a time."; combinations&
  11.  
The sub producing non-repeating combinations.
Code: QB64: [Select]
  1. SUB CombinationsNR (array2combine() AS _UNSIGNED _BYTE, chosen AS LONG, startPosition AS LONG, result() AS _UNSIGNED _BYTE, combinations&)
  2.     IF (chosen < 0) THEN
  3.         combinations& = combinations& + 1
  4.         FOR i = 0 TO UBOUND(result)
  5.             PRINT result(i);
  6.         NEXT
  7.         PRINT
  8.         EXIT SUB
  9.     END IF
  10.     FOR i = startPosition TO UBOUND(array2combine) - chosen
  11.         result(UBOUND(result) - chosen) = array2combine(i)
  12.         CombinationsNR array2combine(), chosen - 1, i + 1, result(), combinations&
  13.     NEXT
  14.  

This may also help in your wordsearch.
« Last Edit: October 20, 2018, 12:44:23 AM by codeguy »

Offline bplus

  • Forum Resident
  • Posts: 5947
  • B+ Knot again!
Re: Word Search
« Reply #9 on: October 20, 2018, 09:38:31 AM »
Hi codeguy,

Like with WordCrack, I am not seeing how what you offer fits in with Word Search.

I am becoming very surprised how little the BASIC programmers I hang out with know of Word Search. But I guess people don't get daily newspapers as regularly as the old days. But it also makes sense, if you have BASIC to play with, why waste time with newspaper games like Sudoku, Crosswords, and WordSearch? ;-))

So anyway, codeguy, have you been following the Pig thread? I could use code to calculate frequency tables of dice combinations to calculate odds of dice coming up with 1's give n amount of dice thrown in a turn, eg throw 5 dice what are the chances of 1 di having a 1, 2 di having a 1, 3 di having a 1, 4 di having a 1 and all 5 di having a 1.

Offline bplus

  • Forum Resident
  • Posts: 5947
  • B+ Knot again!
Re: Word Search
« Reply #10 on: October 20, 2018, 10:00:30 AM »
Update: While you guys are working out your first version of Word Search code, or not ;-))  I have finally got the long and tedious method of "rotating" the array of letters to search using INSTR for the find word. I am sure that INSTR will work faster when all the strings are setup but it is complex / tricky to translate back to the Letters$() array the position found with INSTR.

But, thanks to pulling the plug on the phone, I have it working for word list searching, at least the couple of examples I've tested.

Next up make the whole thing generic for any letters$ array and Word List of find words up to say 20 x 20 grid and any amount of words you can jam into that array. Do this for BOTH methods, my first straight forward finder as described above and for the rotated arrays finder method. Also while doing this, add the capacity to find the word several times throughout the Letters$() array and list the counts next to the Word Find List, so my Halloween BAT and TRICK TREAT puzzles would also work along with normal newspaper style Word Search puzzles.

So as TempodiBasic likes to say, "Thanks for reading!"

Offline bplus

  • Forum Resident
  • Posts: 5947
  • B+ Knot again!
Re: Word Search
« Reply #11 on: October 21, 2018, 11:50:15 PM »
OK done!

Included in the attached are 4 .bas files: 2 designed just for the Halloween Challenge of counting BAT in one Word Search Letter block and TRICK TREAT in the other.

A generic Word Search code v1 for any Word Search letter block up to 40 letters wide and 20 rows and a 48 max Word list (fitting it all in Screen 0 default).

v2 has v1 code to compare to the "Rotating Array Strings Search Method" I was curious about. The code there has number labels for the rows and columns of the letters array.

3 more Puzzle sets and a Read Me Notes txt file for more details.

« Last Edit: October 22, 2018, 12:08:59 AM by bplus »

Offline bplus

  • Forum Resident
  • Posts: 5947
  • B+ Knot again!
Re: Word Search
« Reply #12 on: October 27, 2018, 02:56:25 AM »
WS Editor coming along nicely. I have improved my message box and now created an inputBox$() function.

Here is a snap of a new Treats and Tricks puzzle with a few more tricks and treats to count in direction rich puzzle plus a snap of new inputBox$() in action for adding a word.


Offline bplus

  • Forum Resident
  • Posts: 5947
  • B+ Knot again!
Re: Word Search
« Reply #13 on: November 01, 2018, 10:33:21 PM »
First success with Rosetta Code Word Search Challenge, added a couple specs of my own:
Code: QB64: [Select]
  1.    0 1 2 3 4 5 6 7 8 9
  2.  
  3. 0   b p l u s m R y t t
  4. 1   a u p u s o y O i h
  5. 2   s s n o b n e S s u
  6. 3   i h i i E s l p i h
  7. 4   c T o h t a t a h T
  8. 5   z o o a o n a i c A
  9. 6   t C p n r t h c r n
  10. 7   r n u h O o w y u r
  11. 8   c t e d w o t D l a
  12. 9   E r e g a e y b a c
  13.  
  14.       1)      basic (0, 0) >>>---> 2      2)       plus (1, 0) >>>---> 0
  15.      3)   monsanto (5, 0) >>>---> 2      4)     yeager (6, 9) >>>---> 4
  16.      5)    whatley (6, 7) >>>---> 6      6)      lurch (8, 8) >>>---> 6
  17.      7)       hoar (1, 3) >>>---> 1      8)        sup (4, 1) >>>---> 4
  18.      9)        his (3, 4) >>>---> 5     10)        tin (4, 4) >>>---> 5
  19.     11)        huh (9, 1) >>>---> 2     12)        sit (8, 2) >>>---> 6
  20.     13)        car (9, 9) >>>---> 6     14)        hun (3, 7) >>>---> 4
  21.     15)        cia (7, 6) >>>---> 6     16)        pat (2, 6) >>>---> 7
  22.     17)        zoo (0, 5) >>>---> 0     18)        crt (0, 8) >>>---> 6
  23.     19)        icy (7, 5) >>>---> 2     20)        ted (1, 8) >>>---> 0
  24.     21)        nob (2, 2) >>>---> 0     22)        tow (6, 8) >>>---> 4
  25.     23)        hip (9, 3) >>>---> 4     24)        cab (9, 9) >>>---> 4
  26.     25)        lao (6, 3) >>>---> 3     26)        nrc (9, 6) >>>---> 4
  27.     27)        bun (0, 0) >>>---> 1     28)        tty (9, 0) >>>---> 4
  28.     29)        tun (1, 8) >>>---> 7
  29.  
  30.  

A tweak of word length limits and almost every run now:
Code: QB64: [Select]
  1.    0 1 2 3 4 5 6 7 8 9
  2.  
  3. 0   b p l u s g t b n R
  4. 1   a a e c u O a i a k
  5. 2   s l e n o n S f k i
  6. 3   i d s a o o l E e n
  7. 4   c T o b t a t g d T
  8. 5   o l b e t s A r e e
  9. 6   x i i t C i e s a l
  10. 7   r m e s s v O l e m
  11. 8   D r b l e a g u e x
  12. 9   y a s i s a t s E c
  13.  
  14.       1)      basic (0, 0) >>>---> 2      2)       plus (1, 0) >>>---> 0
  15.      3)    celesta (9, 9) >>>---> 5      4)     stasis (7, 9) >>>---> 4
  16.      5)   flattery (7, 2) >>>---> 3      6)     ribbon (0, 7) >>>---> 7
  17.      7)      naked (8, 0) >>>---> 2      8)        doe (1, 3) >>>---> 1
  18.      9)       mart (9, 7) >>>---> 5     10)       siva (5, 5) >>>---> 2
  19.     11)       lise (1, 5) >>>---> 1     12)        lee (2, 0) >>>---> 2
  20.     13)       ague (5, 8) >>>---> 0     14)       snug (2, 3) >>>---> 7
  21.     15)        sex (7, 6) >>>---> 1     16)        kin (9, 1) >>>---> 2
  22.     17)        ibm (3, 9) >>>---> 5     18)        coo (3, 1) >>>---> 1
  23.     19)        gel (7, 4) >>>---> 1     20)        ban (7, 0) >>>---> 3
  24.     21)        pal (1, 0) >>>---> 2     22)        lsi (3, 8) >>>---> 7
  25.     23)        cox (0, 4) >>>---> 2     24)        kit (8, 2) >>>---> 5
  26.     25)        elm (9, 5) >>>---> 2
  27.  
  28.  
« Last Edit: November 01, 2018, 10:54:43 PM by bplus »

Offline bplus

  • Forum Resident
  • Posts: 5947
  • B+ Knot again!
Re: Word Search
« Reply #14 on: November 03, 2018, 12:14:45 PM »
Oh hey Steve, your word generator gave me an idea! But it turns out I got a quicker file made by copy / paste off Wiki alpha listing of keywords (and some edits) st,

This works! (after I allowed words of length 2 to Puzzle Builder.)
Code: QB64: [Select]
  1.    0 1 2 3 4 5 6 7 8 9
  2.  
  3. 0   b p l u s C G O D q
  4. 1   a A N D L W b N G S
  5. 2   s V Q E F A E 6 O I
  6. 3   i O A $ D I M 4 O L
  7. 4   c R $ T _ T q C O S
  8. 5   T U P Y N A T b V O
  9. 6   I K E Y E L T I N 6
  10. 7   X P O K E K E A 4 P
  11. 8   E S P C A W N T N q
  12. 9   _ R E S I Z E I b 2
  13.  
  14. Directions >>>---> 0 = East, 1 = SE, 2 = South, 3 = SW, 4 = West, 5 = NW, 6 = North, 7 = NE
  15.  
  16.      These are the items from Just QB64 words.txt used TO build the puzzle:
  17.  
  18.       1)      basic (0, 0) >>>---> 2      2)       plus (1, 0) >>>---> 0
  19.      3)        KEY (1, 6) >>>---> 0      4)     INKEY$ (7, 9) >>>---> 5
  20.      5)     _ATAN2 (4, 4) >>>---> 1      6)      CLEAR (5, 0) >>>---> 3
  21.      7)       WAIT (5, 1) >>>---> 2      8)      IOCTL (9, 2) >>>---> 3
  22.      9)       LONG (9, 3) >>>---> 5     10)    _RESIZE (0, 9) >>>---> 0
  23.     11)        LET (5, 6) >>>---> 1     12)      _EXIT (0, 9) >>>---> 6
  24.     13)       MID$ (6, 3) >>>---> 4     14)        AND (1, 1) >>>---> 0
  25.     15)        EQV (3, 2) >>>---> 4     16)       VIEW (8, 5) >>>---> 3
  26.     17)       POKE (1, 7) >>>---> 0     18)        SPC (1, 8) >>>---> 0
  27.     19)        COS (7, 4) >>>---> 0     20)        ATN (2, 3) >>>---> 1
  28.     21)        SGN (9, 1) >>>---> 4     22)        END (6, 2) >>>---> 7
  29.     23)        PUT (2, 5) >>>---> 4     24)        ON (9, 5) >>>---> 3
  30.     25)        IF (5, 3) >>>---> 5     26)        AS (4, 8) >>>---> 3
  31.     27)        DO (8, 0) >>>---> 4     28)        OR (1, 3) >>>---> 2
  32.     29)        INP (7, 9) >>>---> 7
  33.  
  34.      These are the items from Just QB64 words.txt found embedded in the puzzle:
  35.  
  36.       1)     _ATAN2 (4, 4) >>>---> 1      2)      _EXIT (0, 9) >>>---> 6
  37.      3)    _RESIZE (0, 9) >>>---> 0      4)        AND (1, 1) >>>---> 0
  38.      5)        AS (4, 8) >>>---> 3      6)        ATN (2, 3) >>>---> 1
  39.      7)      CLEAR (5, 0) >>>---> 3      8)        COS (7, 4) >>>---> 0
  40.      9)        DIM (4, 3) >>>---> 0     10)        DO (8, 0) >>>---> 4
  41.     11)        END (6, 2) >>>---> 7     12)        EQV (3, 2) >>>---> 4
  42.     13)       EXIT (0, 8) >>>---> 6     14)        IF (5, 3) >>>---> 5
  43.     15)     INKEY$ (7, 9) >>>---> 5     16)        INP (7, 9) >>>---> 7
  44.     17)      IOCTL (9, 2) >>>---> 3     18)        KEY (1, 6) >>>---> 0
  45.     19)        KEY (5, 7) >>>---> 5     20)        KEY (1, 6) >>>---> 0
  46.     21)        KEY (5, 7) >>>---> 5     22)        LET (5, 6) >>>---> 1
  47.     23)       LONG (9, 3) >>>---> 5     24)       MID$ (6, 3) >>>---> 4
  48.     25)        ON (7, 0) >>>---> 2     26)        ON (8, 2) >>>---> 5
  49.     27)        ON (9, 5) >>>---> 3     28)        OR (1, 3) >>>---> 2
  50.     29)       POKE (1, 7) >>>---> 0     30)        PUT (2, 5) >>>---> 4
  51.     31)        SGN (9, 1) >>>---> 4     32)        SPC (1, 8) >>>---> 0
  52.     33)        TAN (6, 5) >>>---> 4     34)        TAN (6, 6) >>>---> 1
  53.     35)       VIEW (8, 5) >>>---> 3     36)       WAIT (5, 1) >>>---> 2
  54.  
  55.