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