"SfR Fresh" - the SfR Freeware/Shareware Archive 
Member "OpenVerse/lib/BaseFunc.tcl" of archive OpenVerse-0.8-7.tar.gz:
As a special service "SfR Fresh" has tried to format the requested source page into HTML format using (guessed) Tcl/Tk source code syntax highlighting with prefixed line numbers.
Alternatively you can here view or download the uninterpreted source code file.
That can be also achieved for any archive member file by clicking within an archive contents listing on the first character of the file(path) respectively on the according byte size field.
1 # OpenVerse Base Functions
2 #
3 # This file contains some basic functions for
4 # OpenVerse
5 #
6 # Module Name - Main Module
7 # Current Maintainter - Cruise <cruise@openverse.org>
8 # Sourced By - Main Module
9 #
10 # Copyright (C) 1999 David Gale <cruise@openverse.org>
11 # For more information visit http://OpenVerse.org/
12 #
13 # This program is free software; you can redistribute it and/or
14 # modify it under the terms of the GNU General Public License
15 # as published by the Free Software Foundation; either version 2
16 # of the License, or (at your option) any later version.
17 #
18 # This program is distributed in the hope that it will be useful,
19 # but WITHOUT ANY WARRANTY; without even the implied warranty of
20 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21 # GNU General Public License for more details.
22 #
23 # You should have received a copy of the GNU General Public License
24 # along with this program; if not, write to the Free Software
25 # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
26 # USA.
27
28 # NOTES:
29 # Now using string compare for increased performance
30 # Now using curleybraces around functions for speed
31
32 #
33 # Images which we use with our chat balloons.
34 #
35 image create photo OpenVerse_Image_CHAT_notes -file "$MV(icondir)/notes.gif"
36 image create photo OpenVerse_Image_CHAT_love -file "$MV(icondir)/hearts.gif"
37 image create photo OpenVerse_Image_CHAT_steam -file "$MV(icondir)/steam.gif"
38 image create photo OpenVerse_Image_CHAT_idea -file "$MV(icondir)/bulb.gif"
39 image create photo OpenVerse_Image_CHAT_smile -file "$MV(icondir)/smile.gif"
40 image create photo OpenVerse_Image_CHAT_frown -file "$MV(icondir)/frown.gif"
41 image create photo OpenVerse_Image_CHAT_wink -file "$MV(icondir)/wink.gif"
42 image create photo OpenVerse_Image_CHAT_jump -file "$MV(icondir)/jump.gif"
43 image create photo OpenVerse_Image_CHAT_shiver -file "$MV(icondir)/shiver.gif"
44 image create photo OpenVerse_Image_CHAT_quit -file "$MV(icondir)/shutdown.gif"
45
46 #
47 # Translator - This is an attempt to make a portable translator.
48 # It used text files to load it's phrases from. If there is no translation
49 # for the word or phrase, it will just display the english form. If there
50 # is no english form, it will imporvise.
51 #
52
53 proc Trns {what} {
54 global MV
55
56 if {[catch {set MV(words.$what)}]} {
57 set str [join [split $what "_"] " "]
58 set str "[string toupper [string range $str 0 0]][string range $str 1 end]"
59 DebugIt "(Translator) No Translation exists for $what" other
60 } else {
61 set str $MV(words.$what)
62 }
63 return $str
64 }
65
66 #
67 # Will fill the names button with people who are in the channel.
68 #
69 proc DoNames {} {
70 global MV
71
72 destroy $MV(names_menu).m
73 menu $MV(names_menu).m
74
75 $MV(names_menu).m add command -label [Trns whois_everyone] \
76 -command "SendToServer \"WHOIS *\""
77 #
78 # Process Plugins!
79 #
80 foreach plugin $MV(plugin.traps.Names) {
81 if ![$MV(plugin.traps.Names.$plugin)] {return}
82 }
83 $MV(names_menu).m add separator
84
85 set people 0
86 foreach person $MV(people) {
87 set MV(whois.$people) $person
88 $MV(names_menu).m add cascade -menu \
89 $MV(names_menu).m.$people -label "$person"
90 if !$MV(use_windowmanager_colors) {
91 menu $MV(names_menu).m.$people -bg $MV(colors.name.bg) \
92 -fg $MV(colors.name.fg) -activebackground $MV(colors.name.abg) \
93 -activeforeground $MV(colors.name.afg)
94 } else {
95 menu $MV(names_menu).m.$people
96 }
97 NameMenu "$MV(names_menu).m.$people" $people $person
98 incr people
99 }
100 ColorNames
101 }
102
103
104 #
105 # CRUISE - 11/06/2001 - Changed the way IgnoreALL works, it will ig/unignore all types
106 #
107 proc NameMenu {win people person} {
108 global MV MVS
109
110 $win add command -label [Trns whois] \
111 -command "WhoisCMD $people"
112 $win add command -label [Trns send_message] \
113 -command "MessageCMD $people"
114 $win add command -label [Trns send_url] \
115 -command "URLCMD $people"
116 $win add command -label [Trns send_file] \
117 -command "SendFileFromMenu $people"
118 $win add command -label [Trns call] \
119 -command "CallUser $people"
120 $win add command -label [Trns request_personal_info] \
121 -command "RequestPersonal $people"
122 if $MVS(serving) {
123 $win add command -label [Trns announce_server] \
124 -command "AnnounceServerToUser $people"
125 }
126 $win add cascade -label [Trns ignore] \
127 -menu $win.m
128 if !$MV(use_windowmanager_colors) {
129 menu $win.m -bg $MV(colors.name.bg) \
130 -fg $MV(colors.name.fg) -activebackground $MV(colors.name.abg) \
131 -activeforeground $MV(colors.name.afg)
132 } else {
133 menu $win.m
134 }
135 if {[lsearch -exact $MV(ignore.avatar) $person] == -1} {
136 $win.m add command -label [Trns ignore_avatar] \
137 -command "IgnoreUser $people AVATAR"
138 } else {
139 $win.m add command -label [Trns unignore_avatar] \
140 -command "UnIgnoreUser $people AVATAR"
141 }
142 if {[lsearch -exact $MV(ignore.effect) $person] == -1} {
143 $win.m add command -label [Trns ignore_effects] \
144 -command "IgnoreUser $people EFFECT"
145 } else {
146 $win.m add command -label [Trns unignore_effects] \
147 -command "UnIgnoreUser $people EFFECT"
148 }
149 if {[lsearch -exact $MV(ignore.move) $person] == -1} {
150 $win.m add command -label [Trns ignore_moves] \
151 -command "IgnoreUser $people MOVE"
152 } else {
153 $win.m add command -label [Trns unignore_moves] \
154 -command "UnIgnoreUser $people MOVE"
155 }
156 if {[lsearch -exact $MV(ignore.speech) $person] == -1} {
157 $win.m add command -label [Trns ignore_speech] \
158 -command "IgnoreUser $people SPEECH"
159 } else {
160 $win.m add command -label [Trns unignore_speech] \
161 -command "UnIgnoreUser $people SPEECH"
162 }
163 if {[lsearch -exact $MV(ignore.sub) $person] == -1} {
164 $win.m add command -label [Trns ignore_sub] \
165 -command "IgnoreUser $people SUB"
166 } else {
167 $win.m add command -label [Trns unignore_sub] \
168 -command "UnIgnoreUser $people SUB"
169 }
170 if {[lsearch -exact $MV(ignore.url) $person] == -1} {
171 $win.m add command -label [Trns ignore_url] \
172 -command "IgnoreUser $people URL"
173 } else {
174 $win.m add command -label [Trns unignore_url] \
175 -command "UnIgnoreUser $people URL"
176 }
177 # All handled differently.
178 if {[lsearch -exact $MV(ignore.all) $person] == -1 || \
179 [lsearch -exact $MV(ignore.url) $person] == -1 || \
180 [lsearch -exact $MV(ignore.sub) $person] == -1 || \
181 [lsearch -exact $MV(ignore.move) $person] == -1 || \
182 [lsearch -exact $MV(ignore.speech) $person] == -1 || \
183 [lsearch -exact $MV(ignore.effect) $person] == -1 || \
184 [lsearch -exact $MV(ignore.avatar) $person] == -1} {
185 $win.m add command -label [Trns ignore_all] \
186 -command "IgnoreUser $people ALL"
187 }
188 if {[lsearch -exact $MV(ignore.all) $person] != -1 || \
189 [lsearch -exact $MV(ignore.url) $person] != -1 || \
190 [lsearch -exact $MV(ignore.sub) $person] != -1 || \
191 [lsearch -exact $MV(ignore.move) $person] != -1 || \
192 [lsearch -exact $MV(ignore.speech) $person] != -1 || \
193 [lsearch -exact $MV(ignore.effect) $person] != -1 || \
194 [lsearch -exact $MV(ignore.avatar) $person] != -1} {
195 $win.m add command -label [Trns unignore_all] \
196 -command "UnIgnoreUser $people ALL"
197 }
198 #
199 # Process Plugins!
200 #
201 foreach plugin $MV(plugin.traps.DoNames) {
202 if ![$MV(plugin.traps.DoNames.$plugin) $win $person $people] {return}
203 }
204 }
205
206
207 proc StartLog {} {
208 global MV
209
210 set MV(log) 1
211 set MV(logfile) [open "$MV(homedir)/LogFile.txt" "a+"]
212 puts $MV(logfile) "- Log Started - [clock format [clock seconds]]"
213 InsertIntoChat 0 "\0030,4- Log Started - [clock format [clock seconds]] ($MV(homedir)/LogFile.txt)\n"
214 }
215
216 proc LogThis {what} {
217 global MV
218 puts -nonewline $MV(logfile) "$what"
219 }
220
221 proc StopLog {} {
222 global MV
223
224 set MV(log) 0
225 puts $MV(logfile) "- Log Stopped - [clock format [clock seconds]]"
226 InsertIntoChat 0 "\0030,4- Log Stopped - [clock format [clock seconds]] ($MV(homedir)/LogFile.txt)\n"
227 close $MV(logfile)
228 set MV(logfile) "-1"
229 }
230
231 proc NickComplete {} {
232 global MV
233
234 DebugIt "-- In NickComplete" other
235 set stuff [$MV(chat_entry) get]
236 if {![string compare $stuff ""]} {return}
237 set wrds [split $stuff " "]
238 set lastwrd [string tolower [lindex $wrds [expr [llength $wrds] -1]]]
239 set len [expr [string length $lastwrd] -1]
240 foreach person $MV(people) {
241 if {[string range $person 0 $len] == $lastwrd} {
242 $MV(chat_entry) insert end [string range $person [expr $len +1] end]
243 return
244 }
245 }
246 }
247
248 proc SetRoom {what size} {
249 global MV
250
251 if {[file exists "$MV(roomdir)/$what"]} {
252 if {[file size "$MV(roomdir)/$what"] != $size} {
253 DebugIt "size mismatch for $what" other
254 catch {file delete "$MV(roomdir)/$what"}
255 if {[lsearch -exact $MV(roomloads) $what] == -1} {
256 image create photo OpenVerse_Image_room -file "$MV(homedir)/icons/loading.gif"
257 SendToServer "DCCSENDROOM $what"
258 }
259 } else {
260 image create photo OpenVerse_Image_room -file "$MV(roomdir)/$what"
261 }
262 } else {
263 if {[lsearch -exact $MV(roomloads) $what] == -1} {
264 image create photo OpenVerse_Image_room -file "$MV(homedir)/icons/loading.gif"
265 SendToServer "DCCSENDROOM $what"
266 }
267 }
268 }
269
270
271 proc WhoisCMD {person} {
272 global MV
273
274 SendToServer "WHOIS $MV(whois.$person)"
275 }
276
277 proc WHOISUser {who hostmask} {
278 global MV
279 if {[lsearch -exact $MV(people) $who] == -1} {return}
280 ProcChat $who "[Trns host_info] $hostmask" 0 3 $MV(colors.whois.baloon)
281 }
282
283 proc GetChatRows {text} {
284 global MV
285 set words [split $text]
286 set word_ptr 0
287 set last_word [llength $words]
288 if {$last_word == 1} {return 1}
289 set rows 1
290 set line ""
291 set last_word_ptr -1
292 while {$word_ptr <= $last_word} {
293 update idletasks
294 append line [lindex $words $word_ptr]
295 set width [font measure "$MV(font.balloon.$MV(font.balloon).$MV(font.balloon.style)) -size $MV(font.balloon.size)" $line]
296 if {$width >= 240} {
297 incr rows
298 set incremented 1
299 set line ""
300 if {$word_ptr == $last_word_ptr} {
301 incr word_ptr
302 } else {
303 set last_word_ptr $word_ptr
304 }
305 } else {
306 set incremented 0
307 incr word_ptr
308 }
309 }
310 if $incremented {
311 return $rows
312 } else {
313 return [expr $rows + 1]
314 }
315 }
316
317 #
318 # StripColorCodes "Text To Be Stripped"
319 #
320 # Takes out all the color codes from some text
321 # and returns a cleaner string.
322 #
323 proc StripColorCodes {text} {
324 while {[set tb [string first \x03 $text]] != -1} {
325 set string [string range $text 0 [expr $tb -1]]
326 set text [string range $text [expr $tb +1] end]
327 if {[regexp {^([0-9][0-9]?)(,([0-9][0-9]?))?(.*)} $text m fg bl bg text]} {
328 # hehe stripped!
329 set color 1
330 }
331 set text "$string$text"
332 }
333 return $text
334 }
335
336 #
337 # CRUISE - 11-06-2001 - Fixed the balloon bug when someone says something jsut as you're leaving?
338 #
339 proc ProcChat {who what que system baloon} {
340 global MV
341
342 # If this user isn't here, bail.
343 if {[lsearch -exact $MV(people) $who] == -1 && $who != $MV(nick)} {return}
344
345 if {![string compare $who $MV(nick)]} {
346 set MV($MV(nick).x) $MV(x)
347 set MV($MV(nick).y) $MV(y)
348 set MV($MV(nick).baloon_x) $MV(anim.baloon_x)
349 set MV($MV(nick).baloon_y) $MV(anim.baloon_y)
350 }
351 set MV($who.chattime) [clock seconds]
352 if {$MV($who.haschat) && !$que} {
353 lappend MV($who.chatque) "$system$baloon:$what"
354 return
355 } else {
356 set MV($who.lastsaid) "$what"
357 }
358
359 #
360 # Proces Plugins!
361 foreach plugin $MV(plugin.traps.ProcChat.pre) {
362 if ![$MV(plugin.traps.ProcChat.pre.$plugin) $who $what $system $baloon] {return}
363 }
364
365 set MV($who.haschat) 1
366 #
367 # Types of balloons.
368 #
369 # 0 Normal Chat
370 # 1 System Messages.
371 # 2 Private Messages.
372 # 3 Whois Messages.
373 # 4 Singing Chat
374 # 5 Love Chat
375 # 6 Angry Chat
376 # 7 Idea Chat
377 # 8 Smiling Chat
378 # 9 Frowning Chat
379 # A Winking Chat
380 #
381 switch $system {
382 0 {set textcolor $MV(colors.chat.text)}
383 1 {set textcolor $MV(colors.system.text)}
384 2 {set textcolor $MV(colors.privmsg.text)}
385 3 {set textcolor $MV(colors.whois.text)}
386 4 {set textcolor $MV(colors.chat.text)}
387 5 {set textcolor $MV(colors.chat.text)}
388 6 {set textcolor $MV(colors.chat.text)}
389 7 {set textcolor $MV(colors.chat.text)}
390 8 {set textcolor $MV(colors.chat.text)}
391 9 {set textcolor $MV(colors.chat.text)}
392 A {set textcolor $MV(colors.chat.text)}
393 default {set textcolor "black"}
394 }
395 set oldwhat $what
396 set what [StripColorCodes $what]
397 set text $what
398 while {[string first "-d" $text] != -1} {
399 set str1 [string range $text 0 [expr [string first "-d" $text] -1]]
400 set str2 [string range $text [expr [string first "-d" $text] +2] end]
401 set text "$str1$str2"
402 }
403 set rows [GetChatRows $text]
404 set font_height [lindex [font metrics "$MV(font.balloon.$MV(font.balloon).$MV(font.balloon.style)) -size $MV(font.balloon.size)"] 5]
405 if {![string compare [string range $text 0 0] "-"]} {
406 set text [string range $text 1 end]
407 }
408 set fwidth [font measure "$MV(font.balloon.$MV(font.balloon).$MV(font.balloon.style)) -size $MV(font.balloon.size)" $text]
409 if {$fwidth > 260} {
410 set width 260
411 if {$rows == 1} {set rows [expr int($fwidth / 260) + 1]}
412 if {$rows < 3} {set rows 2}
413 set height [expr $rows * $font_height]
414 set hoff [expr int($rows * 1.5)]
415 } else {
416 set width [expr $fwidth + 15]
417 set height 30
418 set rows 2
419 set hoff 2
420 }
421 if {$system >= 4} {incr width 30}
422 if {$width > 300} {set width 300}
423 if {$height < 30} {set height 30}
424 if {[expr $MV($who.x) + $width + $MV($who.baloon_x)] > 620} {
425 set xoff [expr $MV($who.baloon_x) - 35]
426 set yoff -1
427 } else {
428 set xoff $MV($who.baloon_x)
429 set yoff 1
430 }
431 set MV($who.baloon) [.top.c create polygon \
432 [expr $MV($who.x) + ($xoff - (20 * $yoff))] [expr $MV($who.y) + $MV($who.baloon_y)] \
433 [expr $MV($who.x) + $xoff] [expr $MV($who.y) + $MV($who.baloon_y) - 5] \
434 [expr $MV($who.x) + $xoff] [expr $MV($who.y) + $MV($who.baloon_y) - ($height / 2)] \
435 [expr $MV($who.x) + $xoff + ($yoff * 10)] [expr $MV($who.y) + $MV($who.baloon_y) - ($height / 2) - $hoff] \
436 [expr $MV($who.x) + $xoff + (($width - 10) * $yoff)] [expr $MV($who.y) + $MV($who.baloon_y) - ($height / 2) - $hoff] \
437 [expr $MV($who.x) + $xoff + ($width * $yoff)] [expr $MV($who.y) + $MV($who.baloon_y) - ($height / 2)] \
438 [expr $MV($who.x) + $xoff + ($width * $yoff)] [expr $MV($who.y) + $MV($who.baloon_y) + ($height / 2)] \
439 [expr $MV($who.x) + $xoff + (($width - 10) * $yoff)] [expr $MV($who.y) + $MV($who.baloon_y) + ($height / 2) + $hoff] \
440 [expr $MV($who.x) + $xoff + ($yoff * 10)] [expr $MV($who.y) + $MV($who.baloon_y) + ($height / 2) + $hoff] \
441 [expr $MV($who.x) + $xoff] [expr $MV($who.y) + $MV($who.baloon_y) + ($height / 2)] \
442 [expr $MV($who.x) + $xoff] [expr $MV($who.y) + $MV($who.baloon_y) + 5] \
443 [expr $MV($who.x) + ($xoff - (20 * $yoff))] [expr $MV($who.y) + $MV($who.baloon_y)] \
444 -fill $baloon -outline black -smooth 1]
445 set MV($who.text) [.top.c create text \
446 [expr $MV($who.x) + ($xoff - (20 * $yoff)) + ($yoff * ($width / 2)) + ($yoff * 20)] \
447 [expr $MV($who.y) + $MV($who.baloon_y) - ($height / 2) + ($height / 2)] \
448 -width 240 -text $what -fill $textcolor \
449 -font "$MV(font.balloon.$MV(font.balloon).$MV(font.balloon.style)) -size $MV(font.balloon.size)"]
450 set what $oldwhat
451 switch $system {
452 0 {set log 1;set SendToChat "<$who> $what\n"}
453 1 {set log 0;set SendToChat "\0030,4[Trns system]\00399,99 $what\n"}
454 2 {set log 1;set SendToChat "<!>$who<!> $what\n"}
455 3 {set log 1;set SendToChat "<!>$who<!> $what\n"}
456 4 {
457 set log 1
458 set SendToChat "<§>$who<§> $what\n"
459 incr MV(killnotes)
460 set MV(NotesKill.$MV(killnotes)) "$who"
461 set MV($who.notes) [.top.c create image \
462 [expr $MV($who.x) + $xoff + ($yoff * 10)] \
463 [expr $MV($who.y) + $MV($who.baloon_y)] \
464 -image OpenVerse_Image_CHAT_notes]
465 after [expr $MV(staytime) * 1000] "KillNotes $MV(killnotes)"
466 }
467 5 {
468 set log 1
469 set SendToChat "<¤>$who<¤> $what\n"
470 incr MV(killlove)
471 set MV(LoveKill.$MV(killlove)) "$who"
472 set MV($who.love) [.top.c create image \
473 [expr $MV($who.x) + $xoff + ($yoff * 10)] \
474 [expr $MV($who.y) + $MV($who.baloon_y)] \
475 -image OpenVerse_Image_CHAT_love]
476 after [expr $MV(staytime) * 1000] "KillLove $MV(killlove)"
477 }
478 6 {
479 set log 1
480 set SendToChat "<¥>$who<¥> $what\n"
481 incr MV(killsteam)
482 set MV(SteamKill.$MV(killsteam)) "$who"
483 set MV($who.steam) [.top.c create image \
484 [expr $MV($who.x) + $xoff + ($yoff * 10)] \
485 [expr $MV($who.y) + $MV($who.baloon_y)] \
486 -image OpenVerse_Image_CHAT_steam]
487 after [expr $MV(staytime) * 1000] "KillSteam $MV(killsteam)"
488 }
489 7 {
490 set log 1
491 set SendToChat "<¿>$who<¿> $what\n"
492 incr MV(killidea)
493 set MV(IdeaKill.$MV(killidea)) "$who"
494 set MV($who.idea) [.top.c create image \
495 [expr $MV($who.x) + $xoff + ($yoff * 10)] \
496 [expr $MV($who.y) + $MV($who.baloon_y)] \
497 -image OpenVerse_Image_CHAT_idea]
498 after [expr $MV(staytime) * 1000] "KillIdea $MV(killidea)"
499 }
500 8 {
501 set log 1
502 set SendToChat "<:)>$who<(:> $what\n"
503 incr MV(killsmile)
504 set MV(SmileKill.$MV(killsmile)) "$who"
505 set MV($who.smile) [.top.c create image \
506 [expr $MV($who.x) + $xoff + ($yoff * 10)] \
507 [expr $MV($who.y) + $MV($who.baloon_y)] \
508 -image OpenVerse_Image_CHAT_smile]
509 after [expr $MV(staytime) * 1000] "KillSmile $MV(killsmile)"
510 }
511 9 {
512 set log 1
513 set SendToChat "<:(>$who<):> $what\n"
514 incr MV(killfrown)
515 set MV(FrownKill.$MV(killfrown)) "$who"
516 set MV($who.frown) [.top.c create image \
517 [expr $MV($who.x) + $xoff + ($yoff * 10)] \
518 [expr $MV($who.y) + $MV($who.baloon_y)] \
519 -image OpenVerse_Image_CHAT_frown]
520 after [expr $MV(staytime) * 1000] "KillFrown $MV(killfrown)"
521 }
522 A {
523 set log 1
524 set SendToChat "<;)>$who<(;> $what\n"
525 incr MV(killwink)
526 set MV(WinkKill.$MV(killwink)) "$who"
527 set MV($who.wink) [.top.c create image \
528 [expr $MV($who.x) + $xoff + ($yoff * 10)] \
529 [expr $MV($who.y) + $MV($who.baloon_y)] \
530 -image OpenVerse_Image_CHAT_wink]
531 after [expr $MV(staytime) * 1000] "KillWink $MV(killwink)"
532 }
533 default {set log 1;set SendToChat "<$who> $what\n"}
534 }
535 InsertIntoChat $log "$SendToChat"
536 if $MV(bell) {bell}
537 incr MV(killhigh)
538 set MV(BaloonKill.$MV(killhigh)) "$who"
539 after [expr $MV(staytime) * 1000] "KillBaloon $MV(killhigh)"
540 #
541 # Proces Plugins!
542 foreach plugin $MV(plugin.traps.ProcChat.post) {
543 if ![$MV(plugin.traps.ProcChat.post.$plugin) $who $what $system $baloon] {return}
544 }
545 update idletasks
546 }
547
548 proc KillNotes {which} {
549 global MV
550
551 set who "$MV(NotesKill.$which)"
552 .top.c delete $MV($who.notes)
553 #
554 # Clean up the memory which this user was using.
555 #
556 catch {unset MV(NotesKill.$which)}
557 catch {unset MV($who.notes)}
558 }
559
560 proc KillLove {which} {
561 global MV
562
563 DebugIt "Killing Little Hearts (poor things)!" other
564 set who "$MV(LoveKill.$which)"
565 .top.c delete $MV($who.love)
566 #
567 # Clean up the memory which this user was using.
568 #
569 catch {unset MV(LoveKill.$which)}
570 catch {unset MV($who.love)}
571 }
572
573 proc KillSteam {which} {
574 global MV
575
576 DebugIt "Killing Steam!" other
577 set who "$MV(SteamKill.$which)"
578 .top.c delete $MV($who.steam)
579 #
580 # Clean up the memory which this user was using.
581 #
582 catch {unset MV(SteamKill.$which)}
583 catch {unset MV($who.steam)}
584 }
585
586 proc KillIdea {which} {
587 global MV
588
589 DebugIt "Killing Idea (they are a threat to free speach and must be silenced!!" other
590 set who "$MV(IdeaKill.$which)"
591 .top.c delete $MV($who.idea)
592 #
593 # Clean up the memory which this user was using.
594 #
595 catch {unset MV(IdeaKill.$which)}
596 catch {unset MV($who.idea)}
597 }
598
599 proc KillSmile {which} {
600 global MV
601
602 DebugIt "Killing Smile" other
603 set who "$MV(SmileKill.$which)"
604 .top.c delete $MV($who.smile)
605 #
606 # Clean up the memory which this user was using.
607 #
608 catch {unset MV(SmileKill.$which)}
609 catch {unset MV($who.smile)}
610 }
611 proc KillFrown {which} {
612 global MV
613
614 DebugIt "Killing Frown" other
615 set who "$MV(FrownKill.$which)"
616 .top.c delete $MV($who.frown)
617 #
618 # Clean up the memory which this user was using.
619 #
620 catch {unset MV(FrownKill.$which)}
621 catch {unset MV($who.frowm)}
622 }
623 proc KillWink {which} {
624 global MV
625
626 DebugIt "Killing Wink" other
627 set who "$MV(WinkKill.$which)"
628 .top.c delete $MV($who.wink)
629 #
630 # Clean up the memory which this user was using.
631 #
632 catch {unset MV(WinkKill.$which)}
633 catch {unset MV($who.wink)}
634 }
635
636 proc KillBaloon {which} {
637 global MV
638
639 set who "$MV(BaloonKill.$which)"
640 if {[lsearch -exact $MV(people) $who] == -1 && $who != $MV(nick)} {
641 DebugIt "KillBaloon: Called KillBaloon for user which is no longer logged on." other
642 set MV($who.chatque) {}
643 set MV($who.haschat) 0
644 }
645 .top.c delete $MV($who.text)
646 .top.c delete $MV($who.baloon)
647 #
648 # Clean up the memory this was using.
649 #
650 catch {unset MV($who.text)}
651 catch {unset MV($who.baloon)}
652 catch {unset MV(BaloonKill.$which)}
653
654 if {[llength $MV($who.chatque)]} {
655 set stuff [lindex $MV($who.chatque) 0]
656 set system [string range $stuff 0 0]
657 set what [string range $stuff 1 end]
658 set color [string range $stuff 1 [expr [string first ":" $stuff] -1]]
659 set what [string range $stuff [expr [string first ":" $stuff] +1] end]
660 set MV($who.chatque) [lreplace $MV($who.chatque) 0 0]
661 ProcChat $who $what 1 $system $color
662 } else {
663 if {[lsearch -exact $MV(people) $who] != -1 || $who == $MV(nick)} {
664 set MV($who.haschat) 0
665 } else {
666 catch {unset MV($who.haschat)}
667 catch {unset MV($who.chatque)}
668 }
669 }
670 }
671
672 proc NewPerson {who x y image xx yy size bx by} {
673 global MV
674
675 if {![string compare $who $MV(nick)]} {return}
676 if {[lsearch -exact $MV(people) $who] != -1} {
677 DebugIt "New User $who is already logged on" other
678 return
679 }
680 if {[TestPosNum $x] || [TestPosNum $y] || [TestNum $xx] || \
681 [TestNum $yy] || [TestPosNum $size] || [TestNum $bx] || \
682 [TestNum $by]} {
683 DebugIt "New User $who has invalid numerics (ignoring)" other
684 return
685 }
686 lappend MV(people) $who
687 set MV($who.name) $who
688 set MV($who.downloading) 0
689 set MV($who.moving) 0
690 set MV($who.avatar) $image
691 set MV($who.x) $x
692 set MV($who.y) $y
693 set MV($who.lastsaid) ""
694 set MV($who.name_x_offset) $xx
695 set MV($who.name_y_offset) $yy
696 set MV($who.baloon_x) $bx
697 set MV($who.baloon_y) $by
698 set MV($who.haschat) 0
699 set MV($who.nomoremove) 0
700 set MV($who.chatque) {}
701 set MV($who.moves) {}
702
703 #
704 # Proces Plugins!
705 foreach plugin $MV(plugin.traps.NewPerson) {
706 if ![$MV(plugin.traps.NewPerson.$plugin) $who $x $y $image $xx $yy $size $bx $by] {return}
707 }
708
709 InsertIntoChat 1 "<*>$who<*> [Trns entered_the_room]\n"
710 if {![string compare $image "default.gif"]} {
711 image create photo OpenVerse_User_Image_$who -file "$MV(images)/default.gif"
712 set