Sun May 31 23:06:50 CEST 2009 Tobias Rautenkranz <tobias@rautenkranz.ch>
* Undo support for tick tack toe
hunk ./src/hello-world_de.po 9
-"POT-Creation-Date: 2009-05-28 15:39+0200\n"
+"POT-Creation-Date: 2009-05-30 16:10+0200\n"
hunk ./src/hello-world_de.po 19
-#: i18n-hello-world.lisp:20
+#: i18n-hello-world.lisp:21
hunk ./src/hello-world_de.po 24
-#: i18n-hello-world.lisp:21
+#: i18n-hello-world.lisp:22
hunk ./src/repl.lisp 15
-
hunk ./src/tick-tack-toe.lisp 5
-(declaim (optimize (debug 3)))
hunk ./src/tick-tack-toe.lisp 6
-(defclass tick-tack-toe (qt:widget)
+(defclass tick-tack-toe-board (qt:widget)
hunk ./src/tick-tack-toe.lisp 9
- (check :accessor check-slot))
+ (check :accessor check-slot)
+ (undo-stack :reader undo-stack
+ :initform (make-instance 'qt:undo-stack)))
hunk ./src/tick-tack-toe.lisp 14
+(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)))
+
+
hunk ./src/tick-tack-toe.lisp 39
-(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)) "")))
hunk ./src/tick-tack-toe.lisp 69
-(defun computer-move (board)
+(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))))))
+
+(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)
hunk ./src/tick-tack-toe.lisp 141
- (let ((cell (random (free-cells board))))
+ (let ((cell (random (free-cells (board board-widget)))))
hunk ./src/tick-tack-toe.lisp 144
- (when (= 0 (state (aref board x y)))
+ (when (= 0 (cell-state (aref (board board-widget) x y)))
hunk ./src/tick-tack-toe.lisp 146
- (setf (cxx:text (aref board x y)) "O")
- (return-from top))
+ (return-from top (aref (board board-widget) x y)))
hunk ./src/tick-tack-toe.lisp 157
- (reset-board (board widget)))
+ (new-game widget))
hunk ./src/tick-tack-toe.lisp 161
- (reset-board (board widget))))))
+ (new-game widget)))))
hunk ./src/tick-tack-toe.lisp 163
-(defun reset-board (board)
- (dotimes (x 3)
- (dotimes (y 3)
- (setf (cxx:text (aref board x y)) ""))))
- [_$_]
- [_$_]
-(defun state (cell)
+
+(defun cell-state (cell)
hunk ./src/tick-tack-toe.lisp 174
- (incf sum (state (aref board
+ (incf sum (cell-state (aref board
hunk ./src/tick-tack-toe.lisp 185
- (when (= 0 (state (aref board x y)))
+ (when (= 0 (cell-state (aref board x y)))
hunk ./src/tick-tack-toe.lisp 199
- [_$_]
+
+(defclass tick-tack-toe (qt:main-window)
+ ()
+ (:metaclass cxx:class))
hunk ./src/tick-tack-toe.lisp 206
- (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)))))
+ [_$_]
hunk ./src/tick-tack-toe.lisp 221
- (qt:exec))))
+ (qt:exec widget))))