;;; This class represents cells that display values.
;;; These cells can not be modified.
(defclass fixed-cell ()
- ((%label :initarg :name :reader label)
- (%duplication :initarg :name :accessor duplication)))
+ ((%label :initarg :label :reader label)
+ (%duplication :initarg :duplication :initform nil :accessor duplication)))
(defun make-fixed-cell (label)
- (make-instance 'fixed-cell :name label))
+ (make-instance 'fixed-cell :label label))
;;; This class represents cells those right values are hidden.
;;; They can be modified by users.
(defclass hole ()
- ((%label :initarg :name :accessor label)
- (%duplication :initarg :name :accessor duplication)))
+ ((%label :initarg :label :accessor label)
+ (%duplication :initarg :duplication :initform nil :accessor duplication)))
(defun make-hole (label)
- (make-instance 'hole :name label))
+ (make-instance 'hole :label label))
;;; This class represents cells that display the inputting-values.
;;; They can not be modified by users.
(defclass sudoku-symbol ()
- ((%label :initarg :name :reader label)))
+ ((%label :initarg :label :reader label)))
(defun make-sudoku-symbol (label)
- (make-instance 'sudoku-symbol :name label))
+ (make-instance 'sudoku-symbol :label label))
(defparameter *board-size* 9)
(defparameter *cell-width* 35)
(defparameter *initial-y* 50)
(defparameter *hole-to-be-changed* NIL)
(defparameter *temp-array-to-display*
- (make-array (list 9 9)
+ (make-array '(9 9)
:initial-contents '((3 nil nil 1 nil nil 8 2 nil)
(nil nil nil nil nil nil 6 nil 9)
(nil 7 nil nil 6 nil nil nil nil)
(6 nil nil nil 5 nil nil nil nil)
(8 2 nil nil nil nil 7 nil 4)
(nil nil 1 nil nil nil nil nil nil))))
-(defparameter *labels-list* NIL)
+(defparameter *labels* NIL)
(defun make-gui-array (board-size)
(let ((array (make-array (list board-size board-size))))
array))
(defun make-gui-array-2 (array-to-display)
- (let ((array (make-array (list 9 9 ))))
+ (let ((array (make-array '(9 9))))
(loop for r from 0 below 9
do (loop for c from 0 below 9
do (setf (aref array r c)
- (if (equal (aref array-to-display r c)
- nil)
+ (if (null (aref array-to-display r c))
(make-hole (format nil ""))
(make-fixed-cell
(format nil "~a"
(defparameter *gui-array* (make-gui-array-2 *temp-array-to-display*))
(defparameter *sudoku-symbol* (make-sudoku-symbol-array *board-size*))
-(defun search-pos (board-size gui-array item)
+(defun search-position (board-size gui-array item)
(let ((array-pos))
(loop for r from 0 below board-size
do (loop for c from 0 below board-size
- do (if (equal item (aref gui-array r c))
- (setf array-pos (list r c)))))
+ do (when (equal item (aref gui-array r c))
+ (setf array-pos (list r c)))))
array-pos))
(defun search-items-duplication (board-size gui-array label)
- (let ((labels-list))
+ (let ((labels))
(loop for r from 0 below board-size
do (loop for c from 0 below board-size
- do (if (equal label (label (aref gui-array r c)))
- (setf labels-list (append labels-list
- (list label r c))))))
- labels-list))
+ do (when (equal label (label (aref gui-array r c)))
+ (setf labels (append labels
+ (list label r c))))))
+ labels))
-(defun check-in-same-block (r1 c1 r2 c2 board-size)
+(defun same-blockp (r1 c1 r2 c2 board-size)
(let ((checking nil))
(loop for r-start-point from 0
below board-size by (ceiling (sqrt board-size))
do (loop for c from c-start-point
below (+ c-start-point
(ceiling (sqrt board-size)))
- do (if (or (and (equal r r1)
- (equal c c1))
- (and (equal r r2)
- (equal c c2)))
- (incf count))))
- (if (equal 2 count)
- (setf checking t)))))
+ do (when (or (and (eq r r1)
+ (eq c c1))
+ (and (eq r r2)
+ (eq c c2)))
+ (incf count))))
+ (when (eq 2 count)
+ (setf checking t)))))
checking))
-(defun lets-search (labels-list gui-array)
- (let ((list-length (length labels-list)))
+(defun lets-search (labels gui-array)
+ (let ((lengths (length labels)))
(flet ((assign-dup-value (r-pos c-pos bool-value)
(setf (duplication (aref gui-array
r-pos
c-pos))
bool-value)))
- (if (> list-length 3)
- (progn (loop for i from 1 below list-length by 3
- do (assign-dup-value (nth i labels-list)
- (nth (1+ i) labels-list)
+ (if (> lengths 3)
+ (progn (loop for i from 1 below lengths by 3
+ do (assign-dup-value (nth i labels)
+ (nth (1+ i) labels)
nil))
- (loop for i from 1 below list-length by 3
- do (loop for j from (+ i 3) below list-length by 3
- do (if (or (equal (nth j labels-list)
- (nth i labels-list))
- (equal (nth (1+ j) labels-list)
- (nth (1+ i) labels-list))
- (equal (check-in-same-block
- (nth j labels-list)
- (nth (1+ j) labels-list)
- (nth i labels-list)
- (nth (1+ i) labels-list)
- *board-size*)
- t))
- (progn (assign-dup-value
- (nth j labels-list)
- (nth (1+ j) labels-list)
- t)
- (assign-dup-value
- (nth i labels-list)
- (nth (1+ i) labels-list)
- t))))))
- (if (> list-length 0)
- (assign-dup-value (nth 1 labels-list)
- (nth 2 labels-list)
- nil))))))
+ (loop for i from 1 below lengths by 3
+ do (loop for j from (+ i 3) below lengths by 3
+ do (when (or (eq (nth j labels)
+ (nth i labels))
+ (eq (nth (1+ j) labels)
+ (nth (1+ i) labels))
+ (eq (same-blockp
+ (nth j labels)
+ (nth (1+ j) labels)
+ (nth i labels)
+ (nth (1+ i) labels)
+ *board-size*)
+ t))
+ (progn (assign-dup-value
+ (nth j labels)
+ (nth (1+ j) labels)
+ t)
+ (assign-dup-value
+ (nth i labels)
+ (nth (1+ i) labels)
+ t))))))
+ (when (plusp lengths)
+ (assign-dup-value (nth 1 labels)
+ (nth 2 labels)
+ nil))))))
(define-application-frame sudoku-gui ()
((%cells :initform *gui-array*
(draw-text* pane (label (aref *gui-array* row column))
(+ x (/ *cell-width* 2)) (+ y (/ *cell-width* 2))
:align-x :center :align-y :center
- :ink (if (equal (duplication obj) t)
+ :ink (if (eq (duplication obj) t)
+red+
+black+)))
do (incf count-x)
(define-sudoku-gui-command (com-sudoku-symbol :name t)
((sudoku-symbol 'sudoku-symbol))
- (if (equal NIL *hole-to-be-changed*)
+ (if (null *hole-to-be-changed*)
(format (find-pane-named *application-frame* 'int)
"Please select a hole to input first")
(progn (setf (label (aref *gui-array* (first *hole-to-be-changed*)
(label sudoku-symbol))
(setf *hole-to-be-changed* NIL)))
(loop for k from 1 to *board-size*
- do (setf *labels-list* (search-items-duplication
+ do (setf *labels* (search-items-duplication
*board-size*
*gui-array*
(format nil "~a" k)))
- do (lets-search *labels-list* *gui-array*)))
+ do (lets-search *labels* *gui-array*)))
(define-presentation-to-command-translator com-sudoku-symbol-translator
(sudoku-symbol com-sudoku-symbol sudoku-gui)
(define-sudoku-gui-command (com-sudoku-hole :name t)
((hole 'hole))
- (let ((hole-position (search-pos *board-size* *gui-array* hole)))
+ (let ((hole-position (search-position *board-size* *gui-array* hole)))
(setf *hole-to-be-changed* hole-position)))
(define-presentation-to-command-translator com-sudoku-hole-translator
(define-sudoku-gui-command (com-sudoku-hole-error :name t)
((hole-error 'hole-error))
- (let ((hole-position (search-pos *board-size* *gui-array* hole-error)))
+ (let ((hole-position (search-position *board-size* *gui-array* hole-error)))
(setf *hole-to-be-changed* hole-position)))
(define-presentation-to-command-translator com-sudoku-hole-error-translator
common-lisp.net / projects/sudoku/sudoku.git / commitdiff
