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
|
/* Copyright (c) 1996--1999 Geoff Pike. */
/* All rights reserved. */
/* Floater is distributed in the hope that it will be useful, */
/* but WITHOUT ANY WARRANTY; without even the implied warranty of */
/* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. */
/* This software is provided "as is" and comes with absolutely no */
/* warranties. Geoff Pike is not liable for damages under any */
/* circumstances. Support is not provided. Use at your own risk. */
/* Personal, non-commercial use is allowed. Attempting to make money */
/* from Floater or products or code derived from Floater is not allowed */
/* without prior written consent from Geoff Pike. Anything that remotely */
/* involves commercialism, including (but not limited to) systems that */
/* show advertisements while being used and systems that collect */
/* information on users that is later sold or traded require prior */
/* written consent from Geoff Pike. */
// Record (not on disk---just for now) that we've seen this hand.
// Also, if they exist, update Nseen, Sseen, Wseen, and Eseen.
proc lseenhand {root number scoring} {
global seenhands maxseenhand \
Nseen$scoring Sseen$scoring Eseen$scoring Wseen$scoring
// if ![info exists seenhands($root,$number)] \
// {puts stderr "seen $root $number"}
set seen seen
foreach d {N S E W} {
if [info exists $d$seen$scoring] {
eval "set old $$d$seen$scoring"
set $d$seen$scoring $old$number-
// puts "set $d$seen$scoring to $old$number-"
}
}
set seenhands($root,$number) 1
if [info exists maxseenhand($root)] \
{if {$maxseenhand($root) > $number} return}
set maxseenhand($root) $number
}
// What hands have we seen?
proc seen {root {silent 0}} {
global seenhands maxseenhand youveseen
if ![info exists maxseenhand($root)] {
if {$youveseen && !$silent} \
{talkmsg "You haven't seen any hands from $root"}
return ""
}
set m $maxseenhand($root)
set s ""
set t ""
for {set i 1} {$i <= $m} {incr i} {
if [info exists seenhands($root,$i)] {
append s "$i-"
append t "$i "
}
}
if {$youveseen && !$silent} {talkmsg "From set $root, you've seen: $t"}
if {$silent} {return $t} {return $s}
}
#ifdef NO_FLOATER_FILES
proc setprioruse {name} {}
proc seenfile {root} {}
proc seenhand {root number scoring} { lseenhand $root $number $scoring }
proc loadseen {} {}
#else
proc floater_mkdir {s} {
if {[info tclversion] < 7.6} {exec mkdir $s} {file mkdir $s}
}
proc floater_delete {s} {
if {[info tclversion] < 7.6} {exec /bin/rm $s} {file delete $s}
}
if [info exists env(DOT_FLOATER)] {
tryset floaterdir $env(DOT_FLOATER)
}
tryset floaterdir [set env(HOME)]/.floater
tryset startupfile $floaterdir/startup.tcl
tryset seenfileroot $floaterdir/seenhands
if {[file exists $floaterdir] == 0} {catch {floater_mkdir $floaterdir}}
if {[file exists $seenfileroot] == 0} {catch {floater_mkdir $seenfileroot}}
// returns a list of all .tcl files in dir or its subdirectories
proc tclfiles {dir {recurse 1}} {
set slashstar "\/\*"
set pattern $dir$slashstar
set files ""
while 1 {
if ![catch {glob $pattern.tcl} newfiles] {append files " $newfiles"}
if {!$recurse || [catch {glob $pattern}]} {return $files}
set pattern $pattern$slashstar
}
}
proc source_all_tclfiles {dir {recurse 1}} {
global startupfile
foreach file [tclfiles $dir $recurse] {
if {$file != $startupfile} {
#ifndef TEXT
#ifdef DEBUG
puts stdout "Reading $file ..."
#endif
#endif
if [catch {source $file} err] {
puts stderr $err
}
}
}
}
/////////////////////////////////////////////////////////////////////////////
proc setprioruse {name} {
global usedname startupfile
if [info exists usedname($name)] return
set "usedname($name)" 1
set u "\"usedname("
catch {exec cat << "set $u$name)\" 1\n" >> $startupfile}
}
////////////////////////////////////////////////////////////////////////////
// stuff to keep track of what hands we've seen
////////////////////////////////////////////////////////////////////////////
set seenname _everyone_
proc seenfile {root} {
global seenfileroot seenname
return $seenfileroot/$seenname/$root.tcl
}
// Record once and forever that we've seen this hand.
proc seenhand {root number scoring} {
global seenhands
if [info exists seenhands($root,$number)] return
lseenhand $root $number $scoring
if [catch {exec cat << "lseenhand $root $number $scoring\n" >> \
[seenfile $root]}] {
floatererror "Floater error: unable to make permanent note of what hands you've seen!"
set e1 "Floater error: unable to write to file "
set e2 [seenfile $root]
floatererror "$e1$e2"
}
}
proc loadseen {} {
global seenhands maxseenhand seenname seenfileroot \
globaldate previousglobaldate
debugmsg "loadseen with seenname=$seenname"
// remove seenfiles other than from this week and last week
if {[info exists globaldate] && [info exists previousglobaldate]} {
cleanseen $seenfileroot/$seenname $globaldate $previousglobaldate
if {$seenname != "_everyone_"} {
cleanseen $seenfileroot/_everyone_ $globaldate $previousglobaldate
}
}
catch {unset seenhands; unset maxseenhand}
if {[file exists $seenfileroot/_everyone_] == 0} \
{catch {floater_mkdir $seenfileroot/_everyone_}}
if {[file exists $seenfileroot/$seenname] == 0} \
{catch {floater_mkdir $seenfileroot/$seenname}}
source_all_tclfiles $seenfileroot/_everyone_
// for backward compatibility with a1
source_all_tclfiles $seenfileroot 0
if {$seenname != "_everyone_"} \
{source_all_tclfiles $seenfileroot/$seenname}
}
proc cleanseen {dir except1 except2} {
debugmsg "cleanseen $dir $except1 $except2"
foreach file [tclfiles $dir 0] {
if {![string match "$dir/$except1*" $file]
&& ![string match "$dir/$except2*" $file]} {
debugmsg "Removing $file"
floater_delete $file
}
}
}
#endif /* NO_FLOATER_FILES */
/////////////////////////////////////////////////////////////////////////////
// Check if a path is in our part of the file system
/////////////////////////////////////////////////////////////////////////////
// The path must lie in floaterdir or a subdirectory
proc validfile {filename} {
global floaterdir
regexp $floaterdir/.* [file dirname $filename]/
}
|
