word search (#999)

Inspired by [this Reddit post](https://www.reddit.com/r/mildlyinfuriating/comments/108ba5i/dog).
![image](https://user-images.githubusercontent.com/261693/212199310-3b368b84-5202-4f4a-8bd8-356c60204265.png)

The mechanics are:
* You are "caged" while a system robot arranges the board.  It lets you out when finished.
* You have a finite amount of `"ink"` to mark (`drill`) the three solution letters.
* The letters on the board are not placed completely randomly.  One can peek at the header of `create-puzzle.sw` for a spoiler.

I include a general solution in `solution.sw`, but for the purpose of speeding up the integration tests, a solution hard-coded to the given seed is used.

data/scenarios/Challenges/00-ORDER.txt

@@ -1,6 +1,7 @@
 chess_horse.yaml
 teleport.yaml
 2048.yaml
+word-search.yaml
 hanoi.yaml
 bucket-brigade.yaml
 friend.yaml

data/scenarios/Challenges/_word-search/create-puzzle.sw

@@ -0,0 +1,133 @@
+/**
+Note: we are being a bit devious here;
+There actually will never be a horizontal solution.
+
+We know epirically that our chosen seed does
+contain at least one vertical solution.
+*/
+def intersperse = \n. \f2. \f1. if (n > 0) {
+        f1;
+        if (n > 1) {
+            f2;
+        } {};
+        intersperse (n - 1) f2 f1;
+    } {};
+    end;
+
+/**
+Call a function repeatedly with the numeric argument,
+in descending order.
+*/
+def iterN = \n. \f.
+    if (n > 0) {
+        let newNum = n - 1 in
+        f newNum;
+        iterN newNum f;
+    } {};
+    end;
+
+def chooseLetter = \i.
+    if (i == 0) {
+        return "capital C";
+    } {
+        if (i == 1) {
+            return "capital O";
+        } {
+            return "capital W";
+        }
+    };
+    end;
+
+/**
+We may have selected the last letter to complete
+the word COW.
+
+To ensure there are limited numbers of solutions
+(TODO: preferably exactly one),
+make sure we're not completing a word
+horizontally (foward or backward)
+(TODO: except if we
+are in the pre-designated location).
+
+If we would be completing
+a word, select a different random letter.
+*/
+def reRoll = \expectedFwdOrdinal. \expectedBkwdOrdinal.
+
+    letterIndex <- random 3;
+    let completingFwd = letterIndex == expectedFwdOrdinal && expectedFwdOrdinal == 2 in
+    let completingBkwd = letterIndex == expectedBkwdOrdinal && expectedBkwdOrdinal == 0 in
+    if (completingFwd || completingBkwd) {
+        if (completingFwd && completingBkwd) {
+            return 1;
+        } {
+            reRoll expectedFwdOrdinal expectedBkwdOrdinal;
+        };
+    } {
+        return letterIndex;
+    };
+    end;
+
+def singleTile = \expectedFwdOrdinal. \expectedBkwdOrdinal.
+    letterIndex <- reRoll expectedFwdOrdinal expectedBkwdOrdinal;
+    chosenLetter <- chooseLetter letterIndex;
+    place chosenLetter;
+    return letterIndex;
+    end;
+
+def crossBack = \n.
+    currentLoc <- whereami;
+    teleport self (0, snd currentLoc - 1);
+    end;
+
+/**
+Recursive. Tracks the completion of the word in both the forward
+and backward directions.
+*/
+def layTilesRow = \expectedFwdOrdinal. \expectedBkwdOrdinal. \n.
+    placedIndex <- singleTile expectedFwdOrdinal expectedBkwdOrdinal;
+
+    if (n > 1) {
+        move;
+
+        newFwdOrdinal <- if (placedIndex == expectedFwdOrdinal || placedIndex == 0) {
+            return $ placedIndex + 1;
+        } {
+            return 0;
+        };
+
+        newBkwdOrdinal <- if (placedIndex == expectedBkwdOrdinal || placedIndex == 2) {
+            return $ placedIndex - 1;
+        } {
+            return 2;
+        };
+
+        layTilesRow newFwdOrdinal newBkwdOrdinal $ n - 1;
+    } {};
+    end;
+
+def giveLetterNumbered = \n.
+    letter <- chooseLetter n;
+    give base letter;
+    end;
+
+def removeBoulder =
+    baseLoc <- as base {whereami};
+    teleport self (fst baseLoc - 1, snd baseLoc);
+
+    // Remove the boulder blocking the player's path
+    grab;
+
+    // Make sure the base "knows" about the letters
+    // to get rid of the question marks ("?").
+    iterN 3 giveLetterNumbered;
+
+    selfdestruct;
+    end;
+
+def createPuzzle = \width. \height.
+    intersperse height (crossBack width) (layTilesRow 0 2 width);
+    removeBoulder;
+    end;
+
+createPuzzle 25 15;

data/scenarios/Challenges/_word-search/solution.sw

@@ -0,0 +1,127 @@
+def doN = \n. \f. if (n > 0) {f; doN (n - 1) f} {}; end;
+
+def intersperse = \n. \f2. \f1. if (n > 0) {
+        f1;
+        if (n > 1) {
+            f2;
+        } {};
+        intersperse (n - 1) f2 f1;
+    } {};
+    end;
+
+def waitUntilUnblocked =
+    x <- blocked;
+    if x {
+        wait 1;
+        waitUntilUnblocked;
+    } {};
+    end;
+
+def whichOrdinal =
+    isC <- ishere "capital C";
+    if (isC) {
+        return 0;
+    } {
+        isO <- ishere "capital O";
+        if (isO) {
+            return 1;
+        } {
+            isW <- ishere "capital W";
+            if (isW) {
+                return 2;
+            } {
+                return (-1);
+            }
+        }
+    }
+    end;
+
+// Go to upper-left corner
+def goToCorner =
+    myLoc <- whereami;
+    doN (fst myLoc) move;
+    turn right;
+    doN (-(snd myLoc)) move;
+    turn right;
+    end;
+
+def highlightLetter =
+    drill down;
+    end;
+
+def traverseRow = \expectedOrdinal. \colCount.
+
+    theFoundOrdinal <- whichOrdinal;
+
+    // Logic: the first letter of the target word is *always*
+    // considered a "match".
+    let shouldAdvance = theFoundOrdinal == expectedOrdinal || theFoundOrdinal == 0 in
+    newExpectedOrdinal <- if shouldAdvance {
+        return $ theFoundOrdinal + 1;
+    } {
+        // Reset the progress
+        return 0;
+    };
+
+    if (newExpectedOrdinal == 3) {
+        turn back;
+
+        intersperse 3 move highlightLetter;
+        return true;
+    } {
+        if (colCount > 1) {
+            move;
+            traverseRow newExpectedOrdinal (colCount - 1);
+        } {
+          return false;
+        };
+    };
+    end;
+
+def advanceRow =
+    turn left;
+    move;
+    turn left;
+    end;
+
+/**
+Travels forward and then backward
+across a row, to check for solutions
+in either direction.
+*/
+def traverseCols = \width. \height. 
+    didWin <- traverseRow 0 width;
+    if didWin {
+        return true;
+    } {
+        turn back;
+        didWinBackward <- traverseRow 0 width;
+        if didWinBackward {
+            return true;
+        } {
+            if (height > 1) {
+                advanceRow;
+                traverseCols width $ height - 1;
+            } {
+                return false;
+            };
+        }
+    } 
+    end;
+
+def solve = \boardWidth. \boardHeight.
+    waitUntilUnblocked;
+    goToCorner;
+
+    wonHorizontally <- traverseCols boardWidth boardHeight;
+    if wonHorizontally {
+        return true;
+    } {
+        // If we did not find a horizontal solution,
+        // look for vertical solutions.
+        turn right;
+        traverseCols boardHeight boardWidth;
+    }
+    end;
+
+solve 25 15;

data/scenarios/Challenges/_word-search/verify-solution.sw

@@ -0,0 +1,84 @@
+/**
+Algorithm:
+We only need to check the base's
+current position: if we find three contiguous highlights,
+then we know that the player has just completed their
+third highlight.
+*/
+
+def whichOrdinal =
+    isC <- ishere "lowercase c";
+    if (isC) {
+        return 0;
+    } {
+        isO <- ishere "lowercase o";
+        if (isO) {
+            return 1;
+        } {
+            isW <- ishere "lowercase w";
+            if (isW) {
+                return 2;
+            } {
+                return (-1);
+            }
+        }
+    }
+    end;
+
+
+def countConsecutive = \expectedOrdinal. \n.
+
+    thisOrdinal <- whichOrdinal;
+
+    nextOrdinal <- if (thisOrdinal == expectedOrdinal) {
+        return $ expectedOrdinal + 1;
+    } {
+        return 0;
+    };
+
+    if (nextOrdinal == 3) {
+        return true;
+    } {
+
+        if (n > 0) {
+            move;
+            countConsecutive nextOrdinal (n - 1);
+        } {
+            return false;
+        };
+    };
+
+    end;
+
+
+def checkBackAndForth =
+
+    foundBackward <- countConsecutive 0 3;
+    if (foundBackward) {
+        return true;
+    } {
+        turn back;
+        countConsecutive 0 3;
+    }
+    end;
+
+
+def checkDirections = \n.
+    if (n > 0) {
+        wasFound <- checkBackAndForth;
+        if (wasFound) {
+            return true;
+        } {
+            turn left;
+            checkDirections $ n - 1;
+        }
+    } {
+        return false;
+    }
+    end;
+
+def checkSoln =
+    checkDirections 4;
+    end;
+
+as base {checkSoln};