"SfR Fresh" - the SfR Freeware/Shareware Archive 
Member "OpenVerse/lib/ChtFuncs.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 Text Chat Module
2 #
3 # This module contains all the functions needed for the
4 # text chat window.
5 #
6 # Module Name - Text Chat Module
7 # Current Maintainter - Cruise <cruise@openverse.org>
8 # Sourced By - InitMainWindow
9 #
10 # Copyright (C) 1999 David Gale <cruise@openverse.org>
11 # For more information visit http://OpenVerse.org/
12 #
13 # Updated: 2/24/2000 Jack <jack@openverse.org>
14 # Command (no push) and Quit buttons were added.
15 # Thanks in part to John Doe.
16 #
17 # Updated: 2/25/2000 Jack <jack@openverse.org>
18 # Added Bubbles to the buttons.
19 #
20 # This program is free software; you can redistribute it and/or
21 # modify it under the terms of the GNU General Public License
22 # as published by the Free Software Foundation; either version 2
23 # of the License, or (at your option) any later version.
24 #
25 # This program is distributed in the hope that it will be useful,
26 # but WITHOUT ANY WARRANTY; without even the implied warranty of
27 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
28 # GNU General Public License for more details.
29 #
30 # You should have received a copy of the GNU General Public License
31 # along with this program; if not, write to the Free Software
32 # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
33 # USA.
34
35 # NOTE:
36 # Now using string compare for increased performance
37 # Now using curley braces around functions for greater speed
38
39 #
40 # Images we will use in this module.
41 #
42 image create photo OpenVerse_Image_SCRLK -file "$MV(icondir)/locked.gif"
43 image create photo OpenVerse_Image_SCRULK -file "$MV(icondir)/unlocked.gif"
44 image create photo OpenVerse_Image_LOG -file "$MV(icondir)/log.gif"
45 image create photo OpenVerse_Image_RUBBER -file "$MV(icondir)/rubber.gif"
46 #
47 # Images for the hide-away toolbar in the Chat Window.
48 #
49 image create bitmap OpenVerse_Image_vhandle -file "$MV(icondir)/vhandle.xbm" -maskfile "$MV(icondir)/vhandle.mask" -background gray90
50 image create bitmap OpenVerse_Image_hhandle -file "$MV(icondir)/hhandle.xbm" -maskfile "$MV(icondir)/hhandle.mask" -background gray90
51
52 #
53 # Turns the text chat window on or off.
54 # When turning on, it fills it with the last bunch of lines.
55 #
56 proc ToggleText {} {
57 global MV
58
59 set MV(TCCommand) 0
60 if $MV(textwindow) {
61 destroy .chat
62 set MV(textwindow) 0
63 } else {
64 set MV(textwindow) 1
65 toplevel .chat
66 wm title .chat [Trns openverse_text_chat]
67 wm geometry .chat 646x149
68
69 frame .chat.chat
70 frame .chat.bottom -relief sunken -borderwidth 2
71 text .chat.chat.text -height 1 -width 0 -relief raised \
72 -borderwidth 2 -yscrollcommand ".chat.chat.scrolly set" \
73 -spacing1 1 -wrap word -state disabled
74 scrollbar .chat.chat.scrolly -command ".chat.chat.text yview"
75
76 # Added activeforeground red -JACK-
77 button .chat.bottom.send -text [Trns send] -activeforeground red \
78 -command {SendFromWindow}
79
80 frame .chat.bottom.buttons
81 label .chat.bottom.buttons.handle -image OpenVerse_Image_vhandle -relief \
82 raised -bd 1
83 update idletasks
84 frame .chat.bottom.buttons.frame -relief raised -bd 1
85 pack propagate .chat.bottom.buttons.frame 0
86 pack .chat.bottom.buttons.handle -side left -fill y
87 pack .chat.bottom.buttons.frame .chat.bottom.buttons -fill both -expand 1
88 bind .chat.bottom.buttons.handle <ButtonRelease-1> "ChtButShowHide"
89 set MV(ChtButState) show
90 set bframe ".chat.bottom.buttons.frame"
91 # "$bframe" is all over the place do a search to see where.
92 #################################################################
93
94 entry .chat.bottom.chat
95 button .chat.bottom.rubber -image OpenVerse_Image_RUBBER -command EraseChat
96 if $MV(log) {
97 button .chat.bottom.log -image OpenVerse_Image_LOG -command LogTog \
98 -bg red -activebackground pink
99 } else {
100 button .chat.bottom.log -image OpenVerse_Image_LOG -command LogTog \
101 -bg $MV(defbg) -activebackground $MV(defhl)
102 }
103 if $MV(textwindow.lock) {
104 button .chat.bottom.scrlk -image OpenVerse_Image_SCRLK -command ToggleChatLock
105 } else {
106 button .chat.bottom.scrlk -image OpenVerse_Image_SCRULK -command ToggleChatLock
107 }
108
109 ###############################################################
110 # Added command buttons; moved bottom ones to $bframe. -JACK-
111 # ? Maybe could toggle, but too much code?
112 label $bframe.label -text [Trns commands]
113
114 # Depends upon text entered...
115 # Order: wink, smile, frown, idea, love, sing, steam
116 button $bframe.1 -image OpenVerse_Image_CHAT_wink \
117 -command {SetSCHATcmd 1} -width 20 -height 20
118 button $bframe.2 -image OpenVerse_Image_CHAT_smile \
119 -command {SetSCHATcmd 2} -width 20 -height 20
120 button $bframe.3 -image OpenVerse_Image_CHAT_frown \
121 -command {SetSCHATcmd 3} -width 20 -height 20
122 button $bframe.4 -image OpenVerse_Image_CHAT_idea \
123 -command {SetSCHATcmd 4} -width 20 -height 20
124 button $bframe.5 -image OpenVerse_Image_CHAT_love \
125 -command {SetSCHATcmd 5} -width 20 -height 20
126 button $bframe.6 -image OpenVerse_Image_CHAT_notes \
127 -command {SetSCHATcmd 6} -width 20 -height 20
128 button $bframe.7 -image OpenVerse_Image_CHAT_steam \
129 -command {SetSCHATcmd 7} -width 20 -height 20
130
131 button $bframe.jump -image OpenVerse_Image_CHAT_jump \
132 -command { SendToServer "EFFECT jump"} -width 20 -height 20
133 button $bframe.shiver -image OpenVerse_Image_CHAT_shiver \
134 -command { SendToServer "EFFECT shiver"} -width 20 -height 20
135 button $bframe.quit -text [Trns close] -width 20 -height 20 \
136 -command {destroy .chat}
137 button $bframe.quit_ov -image OpenVerse_Image_CHAT_quit \
138 -command {
139 if ![tk_dialog .chat.quitQuestion [Trns really_quit] \
140 [Trns quit_question] \
141 "" 1 [Trns quit] [Trns cancel]] {
142 exit
143 }
144 }
145 # 11/05/2001 -Unununium- Moved the quit button away from the others
146 pack $bframe.label \
147 $bframe.1 $bframe.2 $bframe.3 $bframe.4 $bframe.5 \
148 $bframe.6 $bframe.7 $bframe.jump $bframe.shiver \
149 $bframe.quit -side left -fill both -padx 1
150 pack $bframe.quit_ov -fill both -side right
151 ###############################################################
152 # 2/25/2000 -JACK-
153 # Added Bubbles to the command buttons
154 if $MV(tooltips) {
155 Bubble::initBubble $bframe.jump [Trns cht_jump_bubble]
156 Bubble::initBubble $bframe.shiver [Trns cht_shiver_bubble]
157 Bubble::initBubble $bframe.quit [Trns cht_close_bubble]
158 Bubble::initBubble $bframe.quit_ov [Trns cht_quit_bubble]
159 Bubble::initBubble $bframe.1 [Trns cht_wink_bubble]
160 Bubble::initBubble $bframe.2 [Trns cht_smile_bubble]
161 Bubble::initBubble $bframe.3 [Trns cht_frown_bubble]
162 Bubble::initBubble $bframe.4 [Trns cht_idea_bubble]
163 Bubble::initBubble $bframe.5 [Trns cht_love_bubble]
164 Bubble::initBubble $bframe.6 [Trns cht_sing_bubble]
165 Bubble::initBubble $bframe.7 [Trns cht_steam_bubble]
166 }
167 pack .chat.chat -fill both -expand y
168 pack .chat.chat.text -side left -fill both -expand y
169 pack .chat.chat.scrolly -side left -fill y
170 pack .chat.bottom -fill x -expand n
171 pack .chat.bottom.buttons -side top
172 pack .chat.bottom.send -side left -expand n
173 pack .chat.bottom.chat -side left -fill x -expand y
174 pack .chat.bottom.log .chat.bottom.rubber \
175 .chat.bottom.scrlk -side left
176
177 focus .chat.bottom.chat
178 QuickKeys ".chat"
179 bind .chat <Return> SendFromWindow
180 bind .chat <Destroy> "set MV(textwindow) 0"
181 bind .chat <Pause> "ToggleChatLock"
182 bind .chat <Up> "ShowPrev .chat.bottom.chat"
183 bind .chat <Down> "ShowNext .chat.bottom.chat"
184 bind .chat <Control-k> ".chat.bottom.chat insert end \x03"
185 # These next binds enable cut and
186 # paste for Windows users. (BUG FIX, DG)
187 bind .chat <Control-c> {}
188 bind .chat <Control-v> {}
189 bind .chat <KeyRelease> {focus .chat.bottom.chat}
190 bind .chat.chat.text <ButtonPress> {.chat.chat.text configure -state normal}
191 bind .chat.chat.text <ButtonRelease> {.chat.chat.text configure -state disabled}
192 set hp [llength $MV(chats)]
193 for {set c 0} {$c < $hp} {incr c} {
194 InsertIntoChat 0 [lindex $MV(chats) $c]
195 }
196 # Colors (damn, why did I do this)
197 # 1=Black
198 # 2=Navy Blue
199 # 3=Dark Green
200 # 4=Bright Red
201 # 5=Brown
202 # 6=Magenta
203 # 7=Orange
204 # 8=Yellow
205 # 9=Bright Green
206 # 10=Bluish-Green
207 # 11=Cyan
208 # 12=Blue
209 # 13=Hot Pink
210 # 14=Dark Grey
211 # 15=Light Gray
212 # 0,16=White
213 # 99=normal
214 #
215 set w .chat.chat.text
216 $w tag configure B
217 $w tag configure F
218 $w tag configure B99
219 $w tag configure F99
220 $w tag configure F0 -foreground white
221 $w tag configure F1 -foreground black
222 $w tag configure F2 -foreground "navy blue"
223 $w tag configure F3 -foreground "dark green"
224 $w tag configure F4 -foreground "red"
225 $w tag configure F5 -foreground "brown"
226 $w tag configure F6 -foreground "magenta"
227 $w tag configure F7 -foreground "orange"
228 $w tag configure F8 -foreground "yellow"
229 $w tag configure F9 -foreground "green"
230 $w tag configure F00 -foreground white
231 $w tag configure F01 -foreground black
232 $w tag configure F02 -foreground "navy blue"
233 $w tag configure F03 -foreground "dark green"
234 $w tag configure F04 -foreground "red"
235 $w tag configure F05 -foreground "brown"
236 $w tag configure F06 -foreground "magenta"
237 $w tag configure F07 -foreground "orange"
238 $w tag configure F08 -foreground "yellow"
239 $w tag configure F09 -foreground "green"
240 $w tag configure F10 -foreground "#008080"
241 $w tag configure F11 -foreground "cyan"
242 $w tag configure F12 -foreground "blue"
243 $w tag configure F13 -foreground "hot pink"
244 $w tag configure F14 -foreground "dark grey"
245 $w tag configure F15 -foreground "light grey"
246 $w tag configure F16 -foreground "white"
247 $w tag configure B0 -background white
248 $w tag configure B1 -background black
249 $w tag configure B2 -background "navy blue"
250 $w tag configure B3 -background "dark green"
251 $w tag configure B4 -background "red"
252 $w tag configure B5 -background "brown"
253 $w tag configure B6 -background "magenta"
254 $w tag configure B7 -background "orange"
255 $w tag configure B8 -background "yellow"
256 $w tag configure B9 -background "green"
257 $w tag configure B00 -background white
258 $w tag configure B01 -background black
259 $w tag configure B02 -background "navy blue"
260 $w tag configure B03 -background "dark green"
261 $w tag configure B04 -background "red"
262 $w tag configure B05 -background "brown"
263 $w tag configure B06 -background "magenta"
264 $w tag configure B07 -background "orange"
265 $w tag configure B08 -background "yellow"
266 $w tag configure B09 -background "green"
267 $w tag configure B10 -background "#008080"
268 $w tag configure B11 -background "cyan"
269 $w tag configure B12 -background "blue"
270 $w tag configure B13 -background "hot pink"
271 $w tag configure B14 -background "dark grey"
272 $w tag configure B15 -background "light grey"
273 $w tag configure B16 -background "white"
274 }
275 }
276
277 proc LogTog {} {
278 global MV
279
280 if $MV(log) {
281 .chat.bottom.log configure -bg $MV(defbg) -activebackground $MV(defhl)
282 StopLog
283 } else {
284 .chat.bottom.log configure -bg red -activebackground pink
285 StartLog
286 }
287 }
288
289 proc ChtButShowHide {} {
290 global MV
291 switch $MV(ChtButState) {
292 show {
293 pack forget .chat.bottom.buttons.frame
294 .chat.bottom.buttons.handle configure -image OpenVerse_Image_hhandle
295 set MV(ChtButState) hide
296 return
297 }
298 hide {
299 .chat.bottom.buttons.handle configure -image OpenVerse_Image_vhandle
300 pack .chat.bottom.buttons.frame -fill both -expand 1
301 set MV(ChtButState) show
302 return
303 }
304 }
305 }
306
307 #
308 # Toggles the background color on emotion buttons.
309 #
310 # 11/05/2001 -Unununium- Fixed button background colors
311 #
312 proc SetSCHATcmd {idx} {
313 global MV
314
315 set MV(TCCommand) 0
316 for {set c 1} {$c < 8} {incr c} {
317 if {$idx == $c && [string compare [.chat.bottom.buttons.frame.$idx cget -bg] "red"]} {
318 .chat.bottom.buttons.frame.$idx configure -bg red -activebackground pink
319 set MV(TCCommand) $idx
320 } else {
321 .chat.bottom.buttons.frame.$c configure -bg $MV(defbg) -activebackground $MV(defhl)
322 }
323 }
324 }
325 #
326 # Sends text from the chat window.
327 # TODO: Use a more generic base function for this.
328 # make this a wrapper to it.
329 #
330 proc SendFromWindow {} {
331 global MV
332
333 set getChat "[.chat.bottom.chat get]" ;# JACK
334
335 ###################################################
336 # Do a little switch-a-roo, from command buttons
337 # Order: wink, smile, frown, idea, love, sing, steam.
338 switch $MV(TCCommand) {
339 1 { set MV(TCCommand) ""
340 set stuff "/wink $getChat"}
341 2 { set MV(TCCommand) ""
342 set stuff "/smile $getChat"}
343 3 { set MV(TCCommand) ""
344 set stuff "/frown $getChat"}
345 4 { set MV(TCCommand) ""
346 set stuff "/idea $getChat"}
347 5 { set MV(TCCommand) ""
348 set stuff "/love $getChat"}
349 6 { set MV(TCCommand) ""
350 set stuff "/sing $getChat"}
351 7 { set MV(TCCommand) ""
352 set stuff "/steam $getChat"}
353 default { set stuff $getChat}
354 }
355 .chat.bottom.chat delete 0 end
356 SetSCHATcmd 0
357 lappend MV(prev) $stuff
358 if {[llength $MV(prev)] > $MV(prevsave)} {
359 set MV(prev) [lreplace $MV(prev) 0 0]
360 }
361 set MV(curprev) -1
362
363 #
364 # Process Plugins!
365 #
366 foreach plugin $MV(plugin.traps.SendText) {
367 if ![$MV(plugin.traps.SendText.$plugin) $stuff] {return}
368 }
369
370
371 if {[string range $stuff 0 0] == "/"} {
372 ProcessCommand $stuff
373 } else {
374 if $MV(rot13) {set stuff [Rot13 $stuff]}
375 SendToServer "CHAT $stuff"
376 }
377
378
379 }
380
381 #
382 # Toggles the scroll lock on the text chat window
383 #
384 proc ToggleChatLock {} {
385 global MV
386
387 if $MV(textwindow.lock) {
388 set MV(textwindow.lock) 0
389 .chat.bottom.scrlk configure -image OpenVerse_Image_SCRULK
390 } else {
391 set MV(textwindow.lock) 1
392 .chat.bottom.scrlk configure -image OpenVerse_Image_SCRLK
393 }
394 }
395
396
397 #
398 # CRUISE - 11/04/2001 - Fixed a problem which would display multiple lines when
399 # users had color codes with no numbers. EW
400 #
401 proc InsertIntoChat {log what} {
402 global MV
403
404 set text $what
405 set color 0
406 set newtext ""
407 set FG ""
408 set BG ""
409 if {$MV(timestamp) && [winfo exists .chat]} {
410 .chat.chat.text conf -state normal
411 .chat.chat.text insert end "\[[clock format [clock seconds] -format "%T"]\] "
412 }
413 while {[set tb [string first \x03 $text]] != -1} {
414 #
415 # Fixes problem with color code without a numeric.
416 #
417 if {[TestPosNum [string range $text [expr $tb +1] [expr $tb +1]]]} {
418 # We need to ignore this color code because it has not number to go with it
419 set string [string range $text 0 [expr $tb -1]]
420 set text [string range $text [expr $tb +1] end]
421 if {[winfo exists .chat.chat]} {
422 .chat.chat.text conf -state normal
423 .chat.chat.text insert end $string
424 if !$MV(textwindow.lock) {.chat.chat.text see end}
425 }
426 continue
427 }
428 set string [string range $text 0 [expr $tb -1]]
429 set text [string range $text [expr $tb +1] end]
430 if {[regexp {^([0-9][0-9]?)(,([0-9][0-9]?))?(.*)} $text m fg bl bg text]} {
431 if {[winfo exists .chat.chat]} {
432 .chat.chat.text conf -state normal
433 .chat.chat.text insert end $string "$FG $BG"
434 set FG "F$fg"
435 set BG "B$bg"
436 if !$MV(textwindow.lock) {.chat.chat.text see end}
437 }
438 set color 1
439 } else {
440 if {[winfo exists .chat.chat]} {
441 .chat.chat.text conf -state normal
442 .chat.chat.text insert end $string "$FG $BG"
443 if !$MV(textwindow.lock) {.chat.chat.text see end}
444 }
445 }
446 append newtext $text
447 }
448 if { $color && [winfo exists .chat.chat] } {
449 set parms [split $text \n]
450 .chat.chat.text conf -state normal
451 .chat.chat.text insert end [lindex $parms 0] "$FG $BG"
452 .chat.chat.text insert end "\n"
453 if !$MV(textwindow.lock) {.chat.chat.text see end}
454 }
455 if {![string compare $newtext ""]} {set newtext $text}
456 if {[winfo exists .chat.chat.text] && !$color} {
457 .chat.chat.text conf -state normal
458 .chat.chat.text insert end $newtext
459 if !$MV(textwindow.lock) {.chat.chat.text see end}
460 }
461 if {[winfo exists .chat.chat.text]} {
462 .chat.chat.text conf -state disabled
463 }
464 if $log {
465 lappend MV(chats) "$what"
466 if {[llength $MV(chats)] > $MV(chatsave)} {
467 set MV(chats) [lreplace $MV(chats) 0 0]
468 }
469 }
470 if {$MV(log)} {
471 LogThis "$newtext"
472 }
473 }
474
475 proc RotTextChat {} {
476 global MV
477 EraseChat
478 set hp [llength $MV(chats)]
479 for {set c 0} {$c < $hp} {incr c} {
480 set stuff [lindex $MV(chats) $c]
481 set chat [string range $stuff 0 [expr [string first " " $stuff] -1]]
482 append chat [Rot13 [string range $stuff [string first " " $stuff] end]]
483 InsertIntoChat 0 $chat
484 }
485 }
486
487 #
488 # Modified by PJ7 to work correctly not that the state of the window is
489 # disabled to prevent it from taking focus during cut-n-paste.
490 #
491 proc EraseChat {} {
492 if {![winfo exists .chat.chat.text]} {return}
493 .chat.chat.text conf -state normal
494 .chat.chat.text delete 0.0 end
495 .chat.chat.text see end
496 .chat.chat.text conf -state disabled
497 }
498