Newer
Older
(in-package :sudoku-gui)
;;; Using presentations and presentation types to draw sudoku board.
;;; This class represents cells that display values.
;;; These cells can not be modified.
(defclass fixed-cell ()
((%label :initarg :label :reader label)
(%duplication :initarg :duplication :initform nil :accessor duplication)))
;;; This class represents cells those right values are hidden.
;;; They can be modified by users.
(defclass hole ()
((%label :initarg :label :accessor label)
(%duplication :initarg :duplication :initform nil :accessor duplication)))
;;; This class represents cells that display the inputting-values.
;;; They can not be modified by users.
(defclass sudoku-symbol ()
(make-instance 'sudoku-symbol :label label))
(defparameter *board-size* 9)
(defparameter *cell-width* 35)
(defparameter *thin-line-width* 2)
(defparameter *thick-line-width* 4)
(defparameter *initial-x* 30)
(defparameter *initial-y* 50)
(defparameter *hole-to-be-changed* NIL)
(defparameter *temp-array-to-display*
: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)
(nil 3 nil nil 1 8 nil nil nil)
(nil 1 nil nil nil 9 nil nil 7)
(nil nil nil nil nil nil nil 9 8)
(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))))
(defun make-gui-array (board-size)
(let ((array (make-array (list board-size board-size))))
(dotimes (r board-size)
(dotimes (c board-size)
(setf (aref array r c)
(if (= r c)
(make-hole (format nil "~a~a" r c))
(make-fixed-cell (format nil "~a~a" r c))))))
array))
(defun make-gui-array-2 (array-to-display)
(loop for r from 0 below 9
do (loop for c from 0 below 9
do (setf (aref array r c)
(make-hole (format nil ""))
(make-fixed-cell
(format nil "~a"
(aref array-to-display r c)))))))
array))
(defun make-sudoku-symbol-array (board-size)
(let ((array (make-array (list board-size))))
(loop for i from 0 below board-size
do (setf (aref array i)
(make-sudoku-symbol (format nil "~a" (+ i 1)))))
array))
;;(defparameter *gui-array* (make-gui-array *board-size*))
(defparameter *gui-array* (make-gui-array-2 *temp-array-to-display*))
(defparameter *sudoku-symbol* (make-sudoku-symbol-array *board-size*))
(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 (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)
(loop for r from 0 below board-size
do (loop for c from 0 below board-size
do (when (equal label (label (aref gui-array r c)))
(setf labels (append labels
(list label r c))))))
labels))
(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-start-point from 0
below board-size by (ceiling (sqrt board-size))
do (let ((count 0))
(loop for r from r-start-point
below (+ r-start-point
(ceiling (sqrt board-size)))
do (loop for c from c-start-point
below (+ c-start-point
(ceiling (sqrt board-size)))
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)))))
(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 (> lengths 3)
(progn (loop for i from 1 below lengths by 3
do (assign-dup-value (nth i labels)
(nth (1+ i) labels)
(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))))))
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
(define-application-frame sudoku-gui ()
((%cells :initform *gui-array*
:accessor cells)
(%symbols :initform *sudoku-symbol*
:accessor symbols))
(:menu-bar menubar-command-table)
(:panes (app :application-pane
:height 760 :width 760
:display-function 'display-app)
(int :interactor
:height 20 :width 760))
(:layouts (default (vertically () app int))))
(defun draw-lines (pane
board-size cell-width
thin-line-width thick-line-width
initial-x initial-y)
(flet ((plus-plus-minus (initial line-width time)
(+ (+ (- initial line-width)
(* (+ cell-width thin-line-width) time))
(* (floor (/ time (sqrt board-size)))
(- thick-line-width thin-line-width))))
(plus-plus-board-size (initial)
(+ (+ initial (* (+ cell-width thin-line-width) board-size))
(* (/ board-size (sqrt board-size))
(- thick-line-width thin-line-width))))
(plus-plus-time (initial time)
(+ (+ initial (* (+ cell-width thin-line-width) time))
(* (floor (/ time (sqrt board-size)))
(- thick-line-width thin-line-width)))))
(flet ((draw-horizontal-line (type-of-line time)
(clim:draw-rectangle* pane
(- initial-x thick-line-width)
(plus-plus-minus initial-y type-of-line time)
(plus-plus-board-size initial-x)
(plus-plus-time initial-y time)))
(draw-vertical-line (type-of-line time)
(clim:draw-rectangle* pane
(plus-plus-minus initial-x type-of-line time)
initial-y
(plus-plus-time initial-x time)
(plus-plus-board-size initial-y))))
(loop for time from 0 to board-size
do (if (zerop (mod time (sqrt board-size)))
(progn (draw-horizontal-line thick-line-width time)
(draw-vertical-line thick-line-width time))
(progn (draw-horizontal-line thin-line-width time)
(draw-vertical-line thin-line-width time)))))))
(defun display-app (frame pane)
(declare (ignore frame))
(let ((x *initial-x*) (y *initial-y*) (count-x 0) (count-y 0))
(loop for row from 0 below *board-size*
do (loop for column from 0 below *board-size*
do (let ((obj (aref *gui-array* row column)))
(with-output-as-presentation (pane obj (class-of obj))
(draw-rectangle* pane x y
(+ x *cell-width*) (+ y *cell-width*)
:ink (if (typep obj 'fixed-cell)
+green+
+orange+))))
do (let ((obj (aref *gui-array* row column)))
(draw-text* pane (label (aref *gui-array* row column))
(+ x (/ *cell-width* 2)) (+ y (/ *cell-width* 2))
:align-x :center :align-y :center
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
+red+
+black+)))
do (incf count-x)
do (if (= count-x (sqrt *board-size*))
(progn (incf x (+ *cell-width* *thick-line-width*))
(setf count-x 0))
(incf x (+ *cell-width* *thin-line-width*))))
do (incf count-y)
do (setf x *initial-x*)
do (if (= count-y (sqrt *board-size*))
(progn (incf y (+ *cell-width* *thick-line-width*))
(setf count-y 0))
(incf y (+ *cell-width* *thin-line-width*)))))
(draw-lines pane
*board-size* *cell-width*
*thin-line-width* *thick-line-width*
*initial-x* *initial-y*)
(let ((symbol-x (+ *initial-x* (/ *cell-width* 2))))
(loop for i from 0 below *board-size*
do (let ((obj (aref *sudoku-symbol* i)))
(with-output-as-presentation (pane obj (class-of obj))
(draw-text* pane (label (aref *sudoku-symbol* i))
symbol-x 30)))
do (incf symbol-x *cell-width*))))
(defun sudoku-gui ()
(run-frame-top-level (make-application-frame 'sudoku-gui)))
(make-command-table 'file-command-table
:errorp nil
:menu '(("New game" :command new-game)
("Save game" :command save-game)
("Load game" :command load-game)))
(make-command-table 'difficulties-command-table
:errorp nil
:menu '(("Easy" :command easy-mode)
("Medium" :command medium-mode)
("Hard" :command hard-mode)))
(make-command-table 'board-size-command-table
:errorp nil
:menu '(("4x4" :command size-four)
("9x9 (Default)" :command size-nine)
("16x16" :command size-sixteen)))
(make-command-table 'cell-size-command-table
:errorp nil
:menu '(("Standard (Default)" :command cell-standard)
("Large" :command cell-large)))
(make-command-table 'lines-size-command-table
:errorp nil
:menu '(("Standard (Default)" :command lines-standard)
("Bolder" :command lines-bolder)))
(make-command-table 'menubar-command-table
:errorp nil
:menu '(("File" :menu file-command-table)
("Difficulties" :menu difficulties-command-table)
("Board-sizes" :menu board-size-command-table)
("Cell-sizes" :menu cell-size-command-table)
("Line-sizes" :menu lines-size-command-table)
("Quit" :command quit)))
(defun combo-command-for-size (size)
(setf *board-size* size)
(setf *gui-array* (make-gui-array *board-size*))
(setf *sudoku-symbol* (make-sudoku-symbol-array *board-size*))
(setf *hole-to-be-changed* NIL))
(define-sudoku-gui-command new-game ())
(define-sudoku-gui-command save-game ())
(define-sudoku-gui-command load-game ())
(define-sudoku-gui-command easy-mode ())
(define-sudoku-gui-command medium-mode ())
(define-sudoku-gui-command hard-mode ())
(define-sudoku-gui-command size-four ()
(combo-command-for-size 4))
(define-sudoku-gui-command size-nine ()
(combo-command-for-size 9))
(define-sudoku-gui-command size-sixteen ()
(combo-command-for-size 16))
(define-sudoku-gui-command cell-standard ()
(setf *cell-width* 35))
(define-sudoku-gui-command cell-large ()
(setf *cell-width* 42))
(define-sudoku-gui-command lines-standard ()
(setf *thin-line-width* 2)
(setf *thick-line-width* 4))
(define-sudoku-gui-command lines-bolder ()
(setf *thin-line-width* 3)
(setf *thick-line-width* 5))
(define-sudoku-gui-command quit ()
(clim:frame-exit clim:*application-frame*))
(define-sudoku-gui-command (com-sudoku-symbol :name t)
((sudoku-symbol 'sudoku-symbol))
(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*)
(second *hole-to-be-changed*)))
(label sudoku-symbol))
(setf *hole-to-be-changed* NIL)))
(loop for k from 1 to *board-size*
do (setf *labels* (search-items-duplication
(define-presentation-to-command-translator com-sudoku-symbol-translator
(sudoku-symbol com-sudoku-symbol sudoku-gui)
(object)
(list object))
(define-sudoku-gui-command (com-sudoku-hole :name t)
((hole '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
(hole com-sudoku-hole sudoku-gui)
(object)
(list object))
(define-sudoku-gui-command (com-sudoku-hole-error :name t)
((hole-error 'hole-error))
(let ((hole-position (search-position *board-size* *gui-array* hole-error)))