1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
|
# CardStack.itcl
#
# Supposed to handle cardstacks. It doesn't handle any display things,
# and not any user interaction or interface stuff.
#
# $Id: CardStack.itcl,v 1.6 2006-04-13 10:45:05 matben Exp $
class CardStack {
# ------------------
# Class constructor.
# ------------------
protected {
constructor {args} {}
destructor {}
}
# --------------
# Class methods.
# --------------
public {
method MixCards {}
method DrawCard {card}
method Pop {}
method PopAndMix {}
method Image {card}
method HalfImage {card}
method CardSideFromImage {im}
method NumberOfCards {}
method TopCard {}
method MakeTopmost {card}
}
# ----------------------
# Private class methods.
# ----------------------
protected {
method CreateCardImages {}
method CreateEmptyPileImage {}
method CreateHalfCardImages {}
}
# --------------
# Static methods.
# --------------
private {
proc CreateAllCards {}
proc InitRand {}
proc UnifRand {x}
}
# ----------------------
# Configuration options.
# ----------------------
public {
variable rule
}
# ---------------------------
# Private class data members.
# ---------------------------
private {
# BUG
variable height 100
variable width 100
variable cardSet
variable imgbase ::img::card
variable currHand {}
}
# ----------------------------
# Private static data members.
# ----------------------------
private {
common inited 0
common cardsSorted
common libDir [file join [file dirname [info script]] cards]
}
}
body CardStack::constructor {args} {
if {!$inited} {
InitRand
CreateAllCards
CreateCardImages
CreateEmptyPileImage
CreateHalfCardImages
set inited 1
}
set currHand $cardsSorted
}
body CardStack::destructor {} {
# We should delete images when no objects left.
if {0} {
if {[llength [itcl::find objects CardStack]] == 1} {
eval {image delete} [lsearch -inline -glob -all [image names] ${imgbase}::*]
set inited 0
}
}
}
body CardStack::CreateAllCards {} {
set cardsSorted {}
foreach value {k q j 0 9 8 7 6 5 4 3 2 a} {
foreach suit {d h s c} {
lappend cardsSorted ${value}${suit}
}
}
}
body CardStack::CreateCardImages {} {
set readCards 1
source [file join $libDir tewi.tcl]
set width [image width ${imgbase}::back]
set height [image height ${imgbase}::back]
}
body CardStack::CreateEmptyPileImage {} {
set im [image create photo ${imgbase}::emptypile \
-width $width -height $height]
$im put black -to 0 0 $width $height
return $im
}
body CardStack::CreateHalfCardImages {} {
set h2 [expr {$height/2}]
foreach card $cardsSorted {
set im [image create photo ${imgbase}::${card}2 \
-width $width -height $height]
$im copy ${imgbase}::${card}
$im copy ${imgbase}::back -from 0 $h2 -to 0 $h2
}
}
body CardStack::MixCards {} {
set currHand {}
set cards $cardsSorted
set remaining [llength $cards]
while {$remaining > 0} {
set ind [UnifRand $remaining]
lappend currHand [lindex $cards $ind]
set cards [lreplace $cards $ind $ind]
incr remaining -1
}
}
body CardStack::DrawCard {card} {
set ind [lsearch $currHand $card]
if {$ind >= 0} {
set currHand [lreplace $currHand $ind $ind]
}
}
body CardStack::Pop {} {
set card [lindex $currHand end]
set currHand [lreplace $currHand end end]
return $card
}
# CardStack::PopAndMix --
#
# Draws a random card from a possible ordered card stack.
body CardStack::PopAndMix {} {
set remaining [llength $currHand]
set ind [UnifRand $remaining]
set card [lindex $currHand $ind]
set currHand [lreplace $currHand $ind $ind]
return $card
}
body CardStack::Image {card} {
return ${imgbase}::${card}
}
body CardStack::HalfImage {card} {
return ${imgbase}::${card}2
}
body CardStack::CardSideFromImage {im} {
set side ""
switch -regexp $im {
.+::back$ {
set side back
}
.+::[a-z0-9]{2}$ {
set side up
}
.+::[a-z0-9]{2}2$ {
set side half
}
}
return $side
}
body CardStack::NumberOfCards {} {
return [llength $currHand]
}
body CardStack::TopCard {} {
return [lindex $currHand end]
}
body CardStack::MakeTopmost {card} {
set ind [lsearch $currHand $card]
if {$ind > 0} {
set currHand [lrange $currHand 0 $ind]
}
}
body CardStack::InitRand {} {
# empty
}
body CardStack::UnifRand {x} {
return [expr {int($x*rand())}]
}
|
