Sun May 31 23:06:50 CEST 2009 Tobias Rautenkranz <tobias@rautenkranz.ch>
* Undo support for tick tack toe
diff -rN -u old-qt.examples/src/hello-world_de.po new-qt.examples/src/hello-world_de.po
--- old-qt.examples/src/hello-world_de.po 2014-10-30 06:59:54.000000000 +0100
+++ new-qt.examples/src/hello-world_de.po 2014-10-30 06:59:54.000000000 +0100
@@ -6,7 +6,7 @@
msgstr ""
"Project-Id-Version: hello-world\n"
"Report-Msgid-Bugs-To: \n"
-"POT-Creation-Date: 2009-05-28 15:39+0200\n"
+"POT-Creation-Date: 2009-05-30 16:10+0200\n"
"PO-Revision-Date: 2009-03-21 11:41+0100\n"
"Last-Translator: Tobias Rautenkranz <tobias@rautenkranz.ch>\n"
"Language-Team: German <>\n"
@@ -16,12 +16,12 @@
"X-Generator: Lokalize 0.3\n"
"Plural-Forms: nplurals=2; plural=n != 1;\n"
-#: i18n-hello-world.lisp:20
+#: i18n-hello-world.lisp:21
msgctxt "hello-world"
msgid "Lisp Qt Example"
msgstr "Lisp Qt Beispiel"
-#: i18n-hello-world.lisp:21
+#: i18n-hello-world.lisp:22
#, lisp-format
msgid ""
"<h1>Hello world</h1>\n"
diff -rN -u old-qt.examples/src/repl.lisp new-qt.examples/src/repl.lisp
--- old-qt.examples/src/repl.lisp 2014-10-30 06:59:54.000000000 +0100
+++ new-qt.examples/src/repl.lisp 2014-10-30 06:59:54.000000000 +0100
@@ -12,7 +12,6 @@
:initform (make-instance 'qt:line-edit)))
(:metaclass cxx:class))
-
(defun append-list-model (list-model string)
"Appends STRING to LIST-MODEL."
(let ((index (cxx:row-count list-model)))
diff -rN -u old-qt.examples/src/tick-tack-toe.lisp new-qt.examples/src/tick-tack-toe.lisp
--- old-qt.examples/src/tick-tack-toe.lisp 2014-10-30 06:59:54.000000000 +0100
+++ new-qt.examples/src/tick-tack-toe.lisp 2014-10-30 06:59:54.000000000 +0100
@@ -2,14 +2,33 @@
;;; License: X11 license
(in-package :qt.examples)
-(declaim (optimize (debug 3)))
-(defclass tick-tack-toe (qt:widget)
+(defclass tick-tack-toe-board (qt:widget)
((board :accessor board
:initform (make-array '(3 3)))
- (check :accessor check-slot))
+ (check :accessor check-slot)
+ (undo-stack :reader undo-stack
+ :initform (make-instance 'qt:undo-stack)))
(:metaclass cxx:class))
+(defmethod initialize-instance :after ((widget tick-tack-toe-board) &rest args)
+ (declare (ignore args))
+ (setf (check-slot widget) (qt:make-slot #'(lambda ()
+ (update-cell widget
+ (qt:sender)))))
+ (let ((layout (make-instance 'qt:grid-layout)))
+ (dotimes (x (array-dimension (board widget) 0))
+ (dotimes (y (array-dimension (board widget) 1))
+ (setf (aref (board widget) x y)
+ (make-instance 'chell-button :x x :y y))
+ (qt:connect (qt:get-signal (aref (board widget) x y)
+ "clicked()")
+ (check-slot widget))
+ (cxx:add-widget layout (aref (board widget) x y)
+ x y)))
+ (setf (cxx:layout widget) layout)))
+
+
(defclass chell-button (qt:push-button)
((x :reader x
:initarg :x)
@@ -17,22 +36,114 @@
:initarg :y))
(:metaclass cxx:class))
-(defun update-cell (widget cell)
- (when (= 0 (state cell))
- (setf (cxx:text cell) "X")
- (check-end widget)
- (computer-move (board widget))
- (check-end widget)))
+;;; Undo
+;;
+;; Move
+
+(defclass move (qt:undo-command)
+ ((cell :accessor cell :initarg :cell)
+ (board :reader board :initarg :board))
+ (:metaclass cxx:class))
+
+(defmethod cxx:undo ((move move))
+ (setf (cxx:text (cell move)) ""))
+
+(defmethod cxx:id ((move move))
+ 37)
+
+
+(defclass player-move (move)
+ ((computer-cell :accessor computer-cell))
+ (:metaclass cxx:class))
+
+(defmethod cxx:redo ((move player-move))
+ (setf (cxx:text (cell move)) "X")
+ (when (slot-boundp move 'computer-cell)
+ (setf (cxx:text (computer-cell move)) "O")))
+
+(defmethod cxx:undo ((move player-move))
+ (call-next-method)
+ (when (slot-boundp move 'computer-cell)
+ (setf (cxx:text (computer-cell move)) "")))
+
+(defmethod cxx:merge-with ((move player-move) command)
+ "Merge a player and a computer move, such that undo and redo
+operate on a player - computer move pair."
+ (when (typep command 'computer-move)
+ (setf (computer-cell move) (cell command))
+ t))
+
+
+(defclass computer-move (move)
+ ()
+ (:metaclass cxx:class))
+
+(defmethod initialize-instance :after ((move computer-move) &key)
+ (setf (cell move) (computer-move (board move))))
+
+(defmethod cxx:redo ((move computer-move))
+ (setf (cxx:text (cell move)) "O"))
+
+
+
+;; New Game
+;;
+(defclass new-game (qt:undo-command)
+ ((board :reader board :initarg :board)
+ (state :reader state :initform (make-array '(3 3)))
+ (initial-move :accessor initial-move))
+ (:metaclass cxx:class))
+
+(defmethod initialize-instance :after ((new-game new-game) &key)
+ (dotimes (x 3)
+ (dotimes (y 3)
+ (setf (aref (state new-game) x y)
+ (cxx:text (aref (board new-game) x y))))))
-(defun computer-move (board)
+(defmethod cxx:id ((new-game new-game))
+ 37)
+
+(defmethod cxx:redo ((new-game new-game))
+ (dotimes (x 3)
+ (dotimes (y 3)
+ (setf (cxx:text (aref (board new-game) x y)) "")))
+ (when (slot-boundp new-game 'initial-move)
+ (setf (cxx:text (initial-move new-game)) "O")))
+
+(defmethod cxx:undo ((new-game new-game))
+ (dotimes (x 3)
+ (dotimes (y 3)
+ (setf (cxx:text (aref (board new-game) x y))
+ (aref (state new-game) x y)))))
+
+(defmethod cxx:merge-with ((new-game new-game) command)
+ (when (typep command 'computer-move)
+ (setf (initial-move new-game) (cell command))
+ t))
+
+(defun new-game (board-widget)
+ (cxx:push (undo-stack board-widget)
+ (make-instance 'new-game :board (board board-widget))))
+
+
+
+(defun update-cell (board-widget cell)
+ (when (= 0 (cell-state cell))
+ (cxx:push (undo-stack board-widget)
+ (make-instance 'player-move :cell cell :board board-widget))
+ (check-end board-widget)
+ (cxx:push (undo-stack board-widget)
+ (make-instance 'computer-move :board board-widget))
+ (check-end board-widget)))
+
+(defun computer-move (board-widget)
(block top
- (let ((cell (random (free-cells board))))
+ (let ((cell (random (free-cells (board board-widget)))))
(dotimes (x 3)
(dotimes (y 3)
- (when (= 0 (state (aref board x y)))
+ (when (= 0 (cell-state (aref (board board-widget) x y)))
(when (= 0 cell)
- (setf (cxx:text (aref board x y)) "O")
- (return-from top))
+ (return-from top (aref (board board-widget) x y)))
(decf cell)))))))
(defun check-end (widget)
@@ -43,19 +154,14 @@
(if (= 1 winner)
"You win."
"You lose."))
- (reset-board (board widget)))
+ (new-game widget))
(when (= 0 (free-cells (board widget)))
(qt:message-box.information widget "End"
"Drawn.")
- (reset-board (board widget))))))
+ (new-game widget)))))
-(defun reset-board (board)
- (dotimes (x 3)
- (dotimes (y 3)
- (setf (cxx:text (aref board x y)) ""))))
-
-
-(defun state (cell)
+
+(defun cell-state (cell)
(if (= (length (cxx:text cell)) 0)
0
(ecase (aref (cxx:text cell) 0)
@@ -65,7 +171,7 @@
(defun winner-line (board dx dy &optional (offset 0))
(let ((sum 0))
(loop for i from -1 to 1 do
- (incf sum (state (aref board
+ (incf sum (cell-state (aref board
(+ 1 (* (1- dx) offset) (* dx i))
(+ 1 (* (1- dy) offset) (* dy i))))))
(if (= (abs sum) 3)
@@ -76,7 +182,7 @@
(let ((sum 0))
(dotimes (x 3 sum)
(dotimes (y 3)
- (when (= 0 (state (aref board x y)))
+ (when (= 0 (cell-state (aref board x y)))
(incf sum))))))
(defun winner (board)
@@ -90,28 +196,26 @@
(winner-line board 0 1 -1)
(winner-line board 0 1)
(winner-line board 0 1 1)))
-
+
+(defclass tick-tack-toe (qt:main-window)
+ ()
+ (:metaclass cxx:class))
(defmethod initialize-instance :after ((widget tick-tack-toe) &rest args)
(declare (ignore args))
- (setf (check-slot widget) (qt:make-slot #'(lambda ()
- (update-cell widget
- (qt:sender)))))
- (let ((layout (make-instance 'qt:grid-layout)))
- (dotimes (x (array-dimension (board widget) 0))
- (dotimes (y (array-dimension (board widget) 1))
- (setf (aref (board widget) x y)
- (make-instance 'chell-button :x x :y y))
- (qt:connect (qt:get-signal (aref (board widget) x y)
- "clicked()")
- (check-slot widget))
- (cxx:add-widget layout (aref (board widget) x y)
- x y)))
- (setf (cxx:layout widget) layout)))
-
+ (let ((board (make-instance 'tick-tack-toe-board)))
+ (cxx:set-central-widget widget board)
+ (let ((toolbar (cxx:add-tool-bar widget "Main")))
+ (cxx:add-action toolbar
+ (cxx:create-undo-action (undo-stack board)
+ widget))
+ (cxx:add-action toolbar
+ (cxx:create-redo-action (undo-stack board)
+ widget)))))
+
(defun tick-tack-toe ()
"Tick Tack Toe"
(qt:with-app
(let ((widget (make-instance 'tick-tack-toe)))
(cxx:show widget)
- (qt:exec))))
+ (qt:exec widget))))