Sun May 31 23:06:50 CEST 2009 Tobias Rautenkranz * 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 07:37:56.000000000 +0100 +++ new-qt.examples/src/hello-world_de.po 2014-10-30 07:37:56.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 \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 "" "

Hello world

\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 07:37:56.000000000 +0100 +++ new-qt.examples/src/repl.lisp 2014-10-30 07:37:56.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 07:37:56.000000000 +0100 +++ new-qt.examples/src/tick-tack-toe.lisp 2014-10-30 07:37:56.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))))