src/tick-tack-toe.lisp
Sun Apr 5 17:36:46 CEST 2009 Tobias Rautenkranz <tobias@rautenkranz.ch>
* initial import
--- old-qt.examples/src/tick-tack-toe.lisp 1970-01-01 01:00:00.000000000 +0100
+++ new-qt.examples/src/tick-tack-toe.lisp 2014-10-30 07:39:54.000000000 +0100
@@ -0,0 +1,116 @@
+(in-package :qt.examples)
+(declaim (optimize (debug 3)))
+
+(defclass tick-tack-toe (qt:widget)
+ ((board :accessor board
+ :initform (make-array '(3 3)))
+ (check :accessor check-slot))
+ (:metaclass smoke::smoke-wrapper-class))
+
+(defclass chell-button (qt:push-button)
+ ((x :reader x
+ :initarg :x)
+ (y :reader y
+ :initarg :y))
+ (:metaclass smoke::smoke-wrapper-class))
+
+(defun update-cell (widget cell)
+ (when (= 0 (state cell))
+ (cxx:set-text cell "X")
+ (check-end widget)
+ (computer-move (board widget))
+ (check-end widget)))
+
+(defun computer-move (board)
+ (block top
+ (let ((cell (random (free-cells board))))
+ (dotimes (x 3)
+ (dotimes (y 3)
+ (when (= 0 (state (aref board x y)))
+ (when (= 0 cell)
+ (cxx:set-text (aref board x y) "O")
+ (return-from top))
+ (decf cell)))))))
+
+(defun check-end (widget)
+ (let ((winner (winner (board widget))))
+ (if winner
+ (progn
+ (qt:message-box.information widget "End"
+ (if (= 1 winner)
+ "You win."
+ "You lose."))
+ (reset-board (board widget)))
+ (when (= 0 (free-cells (board widget)))
+ (qt:message-box.information widget "End"
+ "Drawn.")
+ (reset-board (board widget))))))
+
+(defun reset-board (board)
+ (dotimes (x 3)
+ (dotimes (y 3)
+ (cxx:set-text (aref board x y) ""))))
+
+
+(defun state (cell)
+ (if (= (length (cxx:text cell)) 0)
+ 0
+ (ecase (aref (cxx:text cell) 0)
+ (#\X 1)
+ (#\O -1))))
+
+(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
+ (+ 1 (* (1- dx) offset) (* dx i))
+ (+ 1 (* (1- dy) offset) (* dy i))))))
+ (if (= (abs sum) 3)
+ (floor sum 3)
+ nil)))
+
+(defun free-cells (board)
+ (let ((sum 0))
+ (dotimes (x 3 sum)
+ (dotimes (y 3)
+ (when (= 0 (state (aref board x y)))
+ (incf sum))))))
+
+(defun winner (board)
+ (or (winner-line board 1 1)
+ (winner-line board -1 1)
+
+ (winner-line board 1 0 -1)
+ (winner-line board 1 0)
+ (winner-line board 1 0 1)
+
+ (winner-line board 0 1 -1)
+ (winner-line board 0 1)
+ (winner-line board 0 1 1)))
+
+
+(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 (make-instance 'qt::qt-signal
+ :sender (aref (board widget) x y)
+ :name "clicked()")
+ (check-slot widget))
+ (cxx:add-widget layout (aref (board widget) x y)
+ x y)))
+ (cxx:set-layout widget layout)))
+
+(defun tick-tack-toe ()
+ "Tick Tack Toe"
+ (qt:with-app
+ (let ((widget (make-instance 'tick-tack-toe)))
+ (cxx:show widget)
+ (qt:exec))))