repos
/
qt.examples
/ annotate_shade
summary
|
shortlog
|
log
|
tree
|
commit
|
commitdiff
|
headdiff
|
annotate
|
headblob
|
headfilediff
|
filehistory
normal
|
plain
|
shade
|
zebra
initial import
Annotate for file src/tick-tack-toe.lisp
2009-04-05 tobias
1
(in-package :qt.examples)
15:36:46 '
2
(declaim (optimize (debug 3)))
'
3
'
4
(defclass tick-tack-toe (qt:widget)
'
5
((board :accessor board
'
6
:initform (make-array '(3 3)))
'
7
(check :accessor check-slot))
'
8
(:metaclass smoke::smoke-wrapper-class))
'
9
'
10
(defclass chell-button (qt:push-button)
'
11
((x :reader x
'
12
:initarg :x)
'
13
(y :reader y
'
14
:initarg :y))
'
15
(:metaclass smoke::smoke-wrapper-class))
'
16
'
17
(defun update-cell (widget cell)
'
18
(when (= 0 (state cell))
'
19
(cxx:set-text cell "X")
'
20
(check-end widget)
'
21
(computer-move (board widget))
'
22
(check-end widget)))
'
23
'
24
(defun computer-move (board)
'
25
(block top
'
26
(let ((cell (random (free-cells board))))
'
27
(dotimes (x 3)
'
28
(dotimes (y 3)
'
29
(when (= 0 (state (aref board x y)))
'
30
(when (= 0 cell)
'
31
(cxx:set-text (aref board x y) "O")
'
32
(return-from top))
'
33
(decf cell)))))))
'
34
'
35
(defun check-end (widget)
'
36
(let ((winner (winner (board widget))))
'
37
(if winner
'
38
(progn
'
39
(qt:message-box.information widget "End"
'
40
(if (= 1 winner)
'
41
"You win."
'
42
"You lose."))
'
43
(reset-board (board widget)))
'
44
(when (= 0 (free-cells (board widget)))
'
45
(qt:message-box.information widget "End"
'
46
"Drawn.")
'
47
(reset-board (board widget))))))
'
48
'
49
(defun reset-board (board)
'
50
(dotimes (x 3)
'
51
(dotimes (y 3)
'
52
(cxx:set-text (aref board x y) ""))))
'
53
'
54
'
55
(defun state (cell)
'
56
(if (= (length (cxx:text cell)) 0)
'
57
0
'
58
(ecase (aref (cxx:text cell) 0)
'
59
(#\X 1)
'
60
(#\O -1))))
'
61
'
62
(defun winner-line (board dx dy &optional (offset 0))
'
63
(let ((sum 0))
'
64
(loop for i from -1 to 1 do
'
65
(incf sum (state (aref board
'
66
(+ 1 (* (1- dx) offset) (* dx i))
'
67
(+ 1 (* (1- dy) offset) (* dy i))))))
'
68
(if (= (abs sum) 3)
'
69
(floor sum 3)
'
70
nil)))
'
71
'
72
(defun free-cells (board)
'
73
(let ((sum 0))
'
74
(dotimes (x 3 sum)
'
75
(dotimes (y 3)
'
76
(when (= 0 (state (aref board x y)))
'
77
(incf sum))))))
'
78
'
79
(defun winner (board)
'
80
(or (winner-line board 1 1)
'
81
(winner-line board -1 1)
'
82
'
83
(winner-line board 1 0 -1)
'
84
(winner-line board 1 0)
'
85
(winner-line board 1 0 1)
'
86
'
87
(winner-line board 0 1 -1)
'
88
(winner-line board 0 1)
'
89
(winner-line board 0 1 1)))
'
90
'
91
'
92
(defmethod initialize-instance :after ((widget tick-tack-toe) &rest args)
'
93
(declare (ignore args))
'
94
(setf (check-slot widget) (qt::make-slot #'(lambda ()
'
95
(update-cell widget
'
96
(qt:sender)))))
'
97
'
98
(let ((layout (make-instance 'qt:grid-layout)))
'
99
(dotimes (x (array-dimension (board widget) 0))
'
100
(dotimes (y (array-dimension (board widget) 1))
'
101
(setf (aref (board widget) x y)
'
102
(make-instance 'chell-button :x x :y y))
'
103
(qt::connect (make-instance 'qt::qt-signal
'
104
:sender (aref (board widget) x y)
'
105
:name "clicked()")
'
106
(check-slot widget))
'
107
(cxx:add-widget layout (aref (board widget) x y)
'
108
x y)))
'
109
(cxx:set-layout widget layout)))
'
110
'
111
(defun tick-tack-toe ()
'
112
"Tick Tack Toe"
'
113
(qt:with-app
'
114
(let ((widget (make-instance 'tick-tack-toe)))
'
115
(cxx:show widget)
'
116
(qt:exec))))