P99

(load "@lib/simul.l")

(de crossword (File)
   (use (Words Data Grid Slots Org)
      (in File
         (setq
            Words (flip (by length sort (make (while (line) (link (trim @))))))
            Data (flip (make (while (line) (link (trim @)))))   # Read data
            Len (apply max (mapcar length Data))
            Grid (grid Len (length Data)) ) )            # Create grid
      (for Col Grid  # Set initial data
         (use Data
            (for This Col
               (let C (pop Data)
                  (=: char (unless (sp? C) C)) )
               (pop 'Data) ) ) )
      (setq Slots
         (mapcar
            '((L) (cons (length (car L)) L))
            (by length group
               (make
                  (for Col Grid  # Init slots
                     (for This Col
                        (when (: char)
                           (and  # Check horizontal slot
                              (not (; (west This) char))
                              (; (east This) char)
                              (; (east (east This)) char)
                              (link
                                 (make
                                    (for (This This (: char) (east This))
                                       (link This) ) ) ) )
                           (and  # Check vertical slot
                              (not (; (north This) char))
                              (; (south This) char)
                              (; (south (south This)) char)
                              (link
                                 (make
                                    (for (This This (: char) (south This))
                                       (link This) ) ) ) ) ) ) ) ) ) ) )
      (recur (Words)
         (if Words
            (for Slot (cdr (assoc (length (car Words)) Slots))
               (unless
                  (find
                     '((This C) (nor (= C (: char)) (= "." (: char))))
                     Slot
                     (car Words) )
                  (let Org (mapcar get Slot '(char .))
                     (mapc put Slot '(char .) (car Words))
                     (recurse (cdr Words))
                     (mapc put Slot '(char .) Org) ) ) )
            (disp Grid T  # Found a solution: Display it
               '((This)
                  (if (: char)
                     (pack " " @ " ")
                     "###" ) ) ) ) ) ) )


: (crossword "p99a.dat")

   +---+---+---+---+---+---+---+---+---+
 6 | P | R | O | L | O | G |###|###| E |
   +---+---+---+---+---+---+---+---+---+
 5 | E |###| N |###|###| N |###|###| M |
   +---+---+---+---+---+---+---+---+---+
 4 | R |###| L | I | N | U | X |###| A |
   +---+---+---+---+---+---+---+---+---+
 3 | L |###| I |###| F |###| M | A | C |
   +---+---+---+---+---+---+---+---+---+
 2 |###|###| N |###| S | Q | L |###| S |
   +---+---+---+---+---+---+---+---+---+
 1 |###| W | E | B |###|###|###|###|###|
   +---+---+---+---+---+---+---+---+---+
     a   b   c   d   e   f   g   h   i

http://picolisp.com/wiki/?99p99

12jul10

abu