LTK GUI for the Sudoku solver

2008-08-08

My original plan, when I created this blog, was to evaluate several GUI toolkits for Common Lisp and write about that, but I didn’t find the time for it. Now LTK is a really simple, small library and so I was able to learn it quickly and now I made a GUI for my Sudoku solver from the previous post with it.

[I’ve posted a screenshot.]

So here’s the code:

(in-package #:sudoku-gui)

(defun main ()
  (let ((*wish-args* '("-name" "CL-Sudoku")))
    (with-ltk ()
      (let* ((f (make-instance 'frame))
	     (puzzle-frame (make-instance 'frame
					  :master f))
	     (button-frame (make-instance 'frame
					  :master f))
	     (fields (make-array '(9 9)))
	     (clear-button (make-instance 'button
					  :master button-frame
					  :text "Clear"
					  :command (lambda ()
						     (update-fields
						      (make-array
						       '(9 9)
						       :initial-element "")
						      fields))))
	     (solve-button (make-instance 'button
					  :master button-frame
					  :text "Solve"
					  :command (lambda ()
						     (update-fields
						      (solve-puzzle fields)
						      fields)))))
	(pack f)
	(pack puzzle-frame)
	(pack button-frame)
	(dotimes (row 3)
	  (dotimes (col 3)
	    (let ((box (make-box row col puzzle-frame fields)))
	      (grid box row col))))
	(pack clear-button :side :left)
	(pack solve-button :side :left)))))

(defun update-fields (array fields)
  (dotimes (row 9)
    (dotimes (col 9)
      (setf (text (aref fields row col))
	    (aref array row col)))))

(defun make-box (row col frame fields)
  (let ((box (make-instance 'labelframe
			    :master frame
			    :text "")))
    (dotimes (inner-row 3)
      (dotimes (inner-col 3)
	(let ((field (make-instance 'spinbox
				    :master box
				    :width 1
				    :relief "solid"
				    :values "[list {} 1 2 3 4 5 6 7 8 9]"
				    :wrap t)))
	  (grid field inner-row inner-col)
	  (setf (aref fields
		      (+ inner-row (* row 3))
		      (+ inner-col (* col 3)))
		field))))
    box))

(defun field-val (field)
  (let ((str (text field)))
    (and (plusp (length str))
	 (digit-char-p (char str 0)))))

(defun solve-puzzle (fields)
  (let ((array (make-array '(9 9) :initial-element nil)))
    (dotimes (row 9)
      (dotimes (col 9)
	(setf (aref array row col)
	      (field-val (aref fields row col)))))
    (solve-array array t)))
Advertisements

Kommentar verfassen

Trage deine Daten unten ein oder klicke ein Icon um dich einzuloggen:

WordPress.com-Logo

Du kommentierst mit Deinem WordPress.com-Konto. Abmelden / Ändern )

Twitter-Bild

Du kommentierst mit Deinem Twitter-Konto. Abmelden / Ändern )

Facebook-Foto

Du kommentierst mit Deinem Facebook-Konto. Abmelden / Ändern )

Google+ Foto

Du kommentierst mit Deinem Google+-Konto. Abmelden / Ändern )

Verbinde mit %s

%d Bloggern gefällt das: