"SfR Fresh" - the SfR Freeware/Shareware Archive 
Member "OpenVerse/lib/Avatars.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 Avatar Functions Module
2 #
3 # This module includes all the functions related
4 # to avatars and avatar movement.
5 #
6 # Module Name - Avatar Functions
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 # 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 # Additional Notes
29 #
30 # Performance enhancements with string comparisons.
31 # Performance using curleybraces around functions
32
33 # CRUISE - 11/08/2001 - Will only call itself if the avatar has multiple
34 # frames and the animate option is set.
35 #
36 proc AnimateAvatar {} {
37 global MV
38
39 if {$MV(anim.current) == -1} {
40 ChangeAvatar $MV(anim.0)
41 set MV(anim.stop) 1
42 set MV(anim.running) 0
43 return
44 }
45 set delay 0
46 if {$MV(anim.current) == 1 && !$MV(anim.new)} {
47 set delay $MV(anim.final_delay)
48 }
49 if {$MV(anim.running) && $MV(anim.new)} {
50 ChangeAvatar "$MV(anim.0)"
51 set MV(anim.new) 0
52 incr MV(anim.current)
53 if {$MV(anim.current) > $MV(anim.frames)} {set MV(anim.current) 1}
54 return
55 }
56 set MV(anim.new) 0
57 if $MV(anim.stop) {
58 ChangeAvatar "$MV(anim.0)"
59 set MV(anim.running) 0
60 return
61 }
62 ChangeAvatar "$MV(anim.[expr $MV(anim.current) -1])"
63 set MV(anim.running) 1
64 incr MV(anim.current)
65 if {$MV(anim.current) > $MV(anim.frames)} {
66 set MV(anim.current) 1
67 }
68 set do_delay [expr $MV(anim.delay) + $delay]
69 if {$MV(anim.frames) > 1 && $MV(anim.animated)} {
70 after $do_delay AnimateAvatar
71 }
72 }
73
74 proc RaiseAvatar {who} {
75 global MV errorInfo
76
77 # Performance Enchancement DRG
78 if {![string compare $who $MV(nick)]} {
79 set image $MV(img)
80 } else {
81 if {[catch {set image $MV($who.icon)}]} {
82 DebugIt "ERROR, Unable to raise $who (RaiseAvatar) Please report this error to cruise@openverse.org" other
83 DebugIt "$errorInfo" other
84 DebugIt "ERROR, Unable to raise $who (RaiseAvatar) Please report this error to cruise@openverse.org" other
85 return
86 }
87 }
88 .top.c raise $image
89 if $MV(names) {
90 KillName $who
91 ShowName $who
92 }
93 }
94
95 proc AnimateMe {what which} {
96 global MV
97
98
99 switch $which {
100 1 {
101 set file "$MV(avatar_files.$what)"
102 }
103 2 {
104 set file "$MV(avatar_setup.$what)"
105 }
106 3 {
107 if {![file exists "$MV(anims)/$what"]} {return}
108 set file "$what"
109 }
110 default {
111 set file "default.av"
112 }
113 }
114
115 if {[winfo exists .setup.na.l.b.avatars.entry]} {
116 .setup.na.l.b.avatars.entry delete 0 end
117 .setup.na.l.b.avatars.entry insert end "$file"
118 }
119 catch {source "$MV(anims)/$file"}
120 AnimateAvatar
121 }
122
123 proc ShowNames {} {
124 global MV
125
126 if $MV(names) {
127 ShowName $MV(nick)
128 #
129 # Process Plugins!
130 #
131 foreach plugin $MV(plugin.traps.ShowNames) {
132 if {![$MV(plugin.traps.ShowNames.$plugin) $MV(nick)]} {return}
133 }
134 foreach who $MV(people) {
135 ShowName $who
136 #
137 # Process Plugins!
138 #
139 foreach plugin $MV(plugin.traps.ShowNames) {
140 if {![$MV(plugin.traps.ShowNames.$plugin) $who]} {return}
141 }
142 }
143 } else {
144 KillName $MV(nick)
145 #
146 # Process Plugins!
147 #
148 foreach plugin $MV(plugin.traps.KillNames) {
149 if {![$MV(plugin.traps.KillNames.$plugin) $MV(nick)]} {return}
150 }
151 foreach who $MV(people) {
152 KillName $who
153 #
154 # Process Plugins!
155 #
156 foreach plugin $MV(plugin.traps.KillNames) {
157 if {![$MV(plugin.traps.KillNames.$plugin) $who]} {return}
158 }
159 }
160 }
161 }
162
163 proc KillName {who} {
164 global MV
165
166 catch {
167 .top.c delete $MV($who.nametext)
168 .top.c delete $MV($who.nameplate)
169 }
170 }
171
172 #
173 # This is the function which displays the name on the screen.
174 # For the name plate.
175 #
176 # CRUISE - 10/24/2001 - took color codes out of name tags.
177 #
178 proc ShowName {who} {
179 global MV
180
181 # Performance Enhancement DRG
182 if {![string compare $who $MV(nick)]} {
183 set MV($MV(nick).x) $MV(x)
184 set MV($MV(nick).y) $MV(y)
185 set MV($MV(nick).name_x_offset) $MV(anim.x_off)
186 set MV($MV(nick).name_y_offset) $MV(anim.y_off)
187 }
188
189
190 #
191 # Replace underscores with spaces
192 #
193 set who_words [split $who "_"]
194 set who_text [join $who_words " "]
195 #
196 # Strip the color codes
197 #
198 set who_text [StripColorCodes $who_text]
199 set width [expr [string length $who_text] * 8]
200
201 if $MV($who.moving) {
202 set x $MV($who.current_x)
203 set y $MV($who.current_y)
204 } else {
205 set x $MV($who.x)
206 set y $MV($who.y)
207 }
208
209 #
210 # Set so that a plugin can access this information.
211 #
212 set MV($who.name_tl_x) [expr ($x + $MV($who.name_x_offset)) - ($width / 2)]
213 set MV($who.name_tl_y) [expr ($y + $MV($who.name_y_offset)) - 8]
214 set MV($who.name_br_x) [expr ($x + $MV($who.name_x_offset)) + ($width / 2)]
215 set MV($who.name_br_y) [expr ($y + $MV($who.name_y_offset)) + 8]
216 set MV($who.nameplate) [.top.c create rectangle \
217 [expr ($x + $MV($who.name_x_offset)) - ($width / 2)] \
218 [expr ($y + $MV($who.name_y_offset)) - 8] \
219 [expr ($x + $MV($who.name_x_offset)) + ($width / 2)] \
220 [expr ($y + $MV($who.name_y_offset)) + 8] -fill black]
221 set MV($who.nametext) [.top.c create text \
222 [expr ($x + $MV($who.name_x_offset))] \
223 [expr ($y + $MV($who.name_y_offset))] \
224 -text $who_text -fill white]
225
226 update idletasks
227 #
228 # Process Plugins!
229 #
230 foreach plugin $MV(plugin.traps.ShowName) {
231 if {![$MV(plugin.traps.ShowName.$plugin) $who]} {return}
232 }
233 }
234
235 proc ChangeAvatar {what} {
236 global MV
237
238 if {![file exists "$MV(images)/$what"]} {
239 image create photo OpenVerse_Image_pic -file "$MV(images)/default.gif"
240 return
241 }
242 #
243 # Do not allow image files with spaces in their names.
244 # Cruise - 10/18/2001
245 #
246 if {[string first " " "$what"] != -1} {
247 ThrowError "[Trns space_in_filename] (IMAGE NAME IS $what)"
248 image create photo OpenVerse_Image_pic -file "$MV(images)/default.gif"
249 return
250 }
251 image create photo OpenVerse_Image_pic -file "$MV(images)/$what"
252 set MV(avatar) $what
253 SendToServer "AVATAR $what $MV(anim.x_off) $MV(anim.y_off) [file size "$MV(images)/$what"] $MV(anim.baloon_x) $MV(anim.baloon_y)"
254 if $MV(names) {
255 KillName $MV(nick)
256 ShowName $MV(nick)
257 }
258
259 #
260 # Process Plugins!
261 #
262 foreach plugin $MV(plugin.traps.ChangeAvatar) {
263 if {![$MV(plugin.traps.ChangeAvatar.$plugin) $what]} {return}
264 }
265 }
266
267 proc DoAvatars {} {
268 global MV
269
270 set anims 0
271 set depth 0
272 set count 1
273
274 destroy $MV(avatar_menu).m
275
276 if $MV(use_windowmanager_colors) {
277 menu $MV(avatar_menu).m
278 } else {
279 menu $MV(avatar_menu).m -bg $MV(colors.av.bg) \
280 -fg $MV(colors.av.fg) -activeforeground $MV(colors.av.afg) \
281 -activebackground $MV(colors.av.abg)
282 }
283
284 set MV(avatar_files.0) "default.av"
285 foreach file [List_Avatars] {
286 if !$depth {
287 incr depth
288 $MV(avatar_menu).m add cascade -menu \
289 $MV(avatar_menu).m.m$depth -label "[Trns avatars] $depth"
290 if $MV(use_windowmanager_colors) {
291 menu $MV(avatar_menu).m.m$depth
292 } else {
293 menu $MV(avatar_menu).m.m$depth -bg $MV(colors.av.bg) \
294 -fg $MV(colors.av.fg) -activeforeground $MV(colors.av.afg) \
295 -activebackground $MV(colors.av.abg)
296 }
297
298 }
299 set MV(avatar_files.$count) "[file tail $file]"
300 if {[file tail $file] == "default.av"} {
301 set MV(default_avatar_number) $count
302 }
303 $MV(avatar_menu).m.m$depth add command -label [file tail $file] \
304 -command "AnimateMe $count 1"
305 incr anims
306 incr count
307 if {$anims > 19} {
308 incr depth
309 $MV(avatar_menu).m add cascade -menu \
310 $MV(avatar_menu).m.m$depth -label "[Trns avatars] $depth"
311 if $MV(use_windowmanager_colors) {
312 menu $MV(avatar_menu).m.m$depth
313 } else {
314 menu $MV(avatar_menu).m.m$depth -bg $MV(colors.av.bg) \
315 -fg $MV(colors.av.fg) -activeforeground $MV(colors.av.afg) \
316 -activebackground $MV(colors.av.abg)
317 }
318 set anims 0
319 }
320 }
321 }
322
323 proc MoveTo {x y pushed} {
324 global MV
325
326 set ret 0
327 if !$pushed {
328 #
329 # Process Plugins!
330 #
331 foreach plugin $MV(plugin.traps.MoveTo.Pre) {
332 if {![$MV(plugin.traps.MoveTo.Pre.$plugin) $x $y]} {return}
333 }
334 foreach link $MV(server_links) {
335 if {$x >= $MV(server_links.$link.x1) &&
336 $x <= $MV(server_links.$link.x2) &&
337 $y >= $MV(server_links.$link.y1) &&
338 $y <= $MV(server_links.$link.y2)} {
339 DebugIt "Openening URL $MV(server_links.$link.url)" other
340 set MV(url.-1.-99.what) $MV(server_links.$link.url)
341 URL_OpenWeb -1 -99
342 set ret 1
343 }
344 }
345 if !$ret {
346 foreach tell $MV(server_tells) {
347 if {$x >= $MV(server_tells.$tell.x1) &&
348 $x <= $MV(server_tells.$tell.x2) &&
349 $y >= $MV(server_tells.$tell.y1) &&
350 $y <= $MV(server_tells.$tell.y2)} {
351 DebugIt "Telling Server $tell" other
352 SendToServer "TELL $tell"
353 set ret 1
354 }
355 }
356 }
357 if !$ret {
358 foreach link $MV(server_exits) {
359 if {$x >= $MV(server_exits.$link.x1) &&
360 $x <= $MV(server_exits.$link.x2) &&
361 $y >= $MV(server_exits.$link.y1) &&
362 $y <= $MV(server_exits.$link.y2)} {
363 DebugIt "Clicked Exit $MV(server_exits.$link.host)" other
364 ConnectToRoom $MV(server_exits.$link.host) $MV(server_exits.$link.port)
365 set ret 1
366 break
367 }
368 }
369 }
370 }
371
372 if !$ret {
373 SendToServer "MOVE $MV(nick) $x $y $MV(movespeed)"
374 set string "$x $y $MV(x) $MV(y) $MV(movespeed) 1 0"
375 set MV(x) $x
376 set MV(y) $y
377 update idletasks
378 lappend MV($MV(nick).moves) $string
379 MoveAvatars 0
380 }
381 }
382
383 proc DoTheMove {person} {
384 global MV
385
386 set length [llength $MV($person.moves)]
387 if !$length {return}
388 set info [split [lindex $MV($person.moves) 0] " "]
389 set delete_flag [lindex $info 6]
390 if $delete_flag {return}
391 set x [lindex $info 0]
392 set y [lindex $info 1]
393 set xx [lindex $info 2]
394 set yy [lindex $info 3]
395 set speed [lindex $info 4]
396 set nametag [lindex $info 5]
397 if {![string compare $person $MV(nick)]} {
398 set image $MV(img)
399 } else {
400 set image $MV($person.icon)
401 }
402 set MV($person.moving) 1
403 set sspeed [expr $speed * 3]
404
405 #puts "DoTheMove $x $y $xx $yy $speed $nametag $delete_flag"
406
407 if {[expr $x - $xx] > 0} {set xdir 1} else {set xdir -1}
408 if {[expr $y - $yy] > 0} {set ydir 1} else {set ydir -1}
409 if {[expr $y - $yy] == 0} {set ydir 0}
410 if {[expr $x - $xx] == 0} {set xdir 0}
411
412 set xinc $xdir
413 set yinc $ydir
414
415 if {$xdir && $sspeed != 2} {
416 set xinc [expr $xdir * 1]
417 set xxx $xx
418 while { $xxx != $x && $xinc != [expr $sspeed * $xdir]} {
419 set xxx $xx
420 incr xinc [expr $xdir * 1]
421 incr xxx $xinc
422 }
423 }
424 if {$ydir && $sspeed != 2} {
425 set yinc [expr $ydir * 1]
426 set yyy $yy
427 while { $yyy != $y && $yinc != [expr $sspeed * $ydir]} {
428 set yyy $yy
429 incr yinc [expr $ydir * 1]
430 incr yyy $yinc
431 }
432 }
433 .top.c move $image $xinc $yinc
434 set xx [expr $xx + $xinc]
435 set yy [expr $yy + $yinc]
436
437 set MV($person.current_x) $xx
438 set MV($person.current_y) $yy
439
440 if {$nametag && $MV(names)} {
441 KillName $person
442 ShowName $person
443 }
444
445 if {$x != $xx || $y != $yy} {
446 set newlist "$x $y $xx $yy $speed $nametag 0"
447 } else {
448 set newlist "$x $y $xx $yy $speed $nametag 1"
449 }
450 set MV($person.moves) [lreplace $MV($person.moves) 0 0 $newlist]
451 # Process Plugins!
452 #
453 foreach plugin $MV(plugin.traps.MoveTo.Post) {
454 $MV(plugin.traps.MoveTo.Post.$plugin) $x $y
455 }
456 }
457
458 proc MoveAvatars {loop_var} {
459 global MV
460
461 if {$MV(moving) && !$loop_var} {return}
462 set MV(moving) 1
463
464 # Info needed for movement.
465 #
466 # X position to move to.
467 # Y position to move to.
468 # XX Original X position
469 # YY Original Y position
470 # Speed at which we move.
471 # Nametag replacement (should we move the nametag)
472 # The image name to move.
473
474 set anymove 0
475 set moveusers {}
476 if {[llength $MV($MV(nick).moves)]} {
477 lappend moveusers $MV(nick)
478 } else {
479 set MV($MV(nick).moving) 0
480 }
481 foreach person $MV(people) {
482 if {[llength $MV($person.moves)]} {
483 lappend moveusers $person
484 } else {
485 set MV($person.moving) 0
486 }
487 }
488 foreach user $moveusers {
489 DoTheMove $user
490 set info [split [lindex $MV($user.moves) 0] " "]
491 set delete_flag [lindex $info 6]
492 if $delete_flag {
493 set MV($user.moves) [lreplace $MV($user.moves) 0 0]
494 }
495 if {[llength $MV($user.moves)]} {
496 set anymove 1
497 } else {
498 set MV($user.moving) 0
499 }
500 }
501 update idletasks
502 if $anymove {
503 #
504 # NOTE: PERFORMANCE!
505 #
506 # What you see below is a great performance enhancer. It
507 # causes this function to return now instead of later and
508 # prevents unnescary nesting.
509 #
510 after 1 "MoveAvatars 1"
511 } else {
512 set MV(moving) 0
513 }
514 return
515 }
516
517 proc ChangeUserAvatar {who what x y size bx by} {
518 global MV
519
520 if {[lsearch -exact $MV(people) $who] == -1} {return}
521 if {[TestNum $x] || [TestNum $y] || [TestPosNum $size] || \
522 [TestNum $bx] || [TestNum $by]} {
523 DebugIt "ChangeUserAvatar: Invalid Parameters" other
524 return
525 }
526
527 set MV($who.avatar) $what
528 set MV($who.name_x_offset) $x
529 set MV($who.name_y_offset) $y
530 set MV($who.baloon_x) $bx
531 set MV($who.baloon_y) $by
532 if $MV(names) {
533 KillName $who
534 ShowName $who
535 }
536 if {![string compare $what "default.gif"]} {
537 image create photo OpenVerse_User_Image_$who -file "$MV(images)/default.gif"
538 return
539 }
540 if {![file exists "$MV(rem_images)/$what"]} {
541 if {[lsearch -exact $MV(downloads) $what] == -1} {
542 DebugIt "I do not have $what ([file exists \"$MV(rem_images)/$what\"])" other
543 if $MV(download_avatars) {
544 SendToServer "DCCSENDAV $what"
545 set MV($who.downloading) 1
546 }
547 }
548 } else {
549 if {[file size "$MV(rem_images)/$what"] != $size} {
550 if {[lsearch -exact $MV(downloads) $what] == -1} {
551 DebugIt "size mismatch for $what" other
552 catch {file delete "$MV(rem_images)/$what"}
553 if $MV(download_avatars) {
554 SendToServer "DCCSENDAV $what"
555 set MV($who.downloading) 1
556 }
557 }
558 } else {
559 catch {image create photo OpenVerse_User_Image_$who -file "$MV(rem_images)/$what"} err
560 if {[string compare $err OpenVerse_User_Image_$who]} {
561 image create photo OpenVerse_User_Image_$who -file "$MV(images)/default.gif"
562 }
563 }
564 }
565
566 #
567 # Process Plugins!
568 #
569 foreach plugin $MV(plugin.traps.ChangeUserAvatar) {
570 if {![$MV(plugin.traps.ChangeUserAvatar.$plugin) $who $what $x $y $size $bx $by]} {return}
571 }
572 }
573
574 proc MoveUser {who x y speed} {
575 global MV
576
577 if {![string compare $who $MV(nick)]} {return}
578 if {[lsearch -exact $MV(people) $who] == -1} {return}
579 if $MV($who.nomoremove) {return}
580 if {[TestNum $x] || [TestNum $y] || [TestNum $speed]} {
581 DebugIt "MoveUser: Invalid Parameters" other
582 return
583 }
584 #
585 # Process Plugins!
586 #
587 foreach plugin $MV(plugin.traps.MoveUser.Pre) {
588 if {![$MV(plugin.traps.MoveUser.Pre.$plugin) $who $x $y $speed]} {return}
589 }
590 if {![string compare $speed ""]} {set speed 1}
591
592 set string "$x $y $MV($who.x) $MV($who.y) $speed 1 0"
593 set MV($who.x) $x
594 set MV($who.y) $y
595 update idletasks
596 lappend MV($who.moves) $string
597 MoveAvatars 0
598
599 #
600 # Process Plugins!
601 #
602 foreach plugin $MV(plugin.traps.MoveUser.Post) {
603 if {![$MV(plugin.traps.MoveUser.Post.$plugin) $who $x $y $speed]} {return}
604 }
605 }
606
607 proc AvatarEffect {who what} {
608 global MV
609
610 if {![string compare $who $MV(nick)]} {
611 set image $MV(img)
612 } else {
613 set image $MV($who.icon)
614 }
615 set x $MV($who.x)
616 set y $MV($who.y)
617 DebugIt "(Effect) - $who $what $x $y" other
618 switch -- [string tolower $what] {
619 "shiver" {
620 set dir 0
621 for {set c 0} {$c < 50} {incr c} {
622 if $dir {
623 set dir 0
624 set xx [expr $x - 15]
625 } else {
626 set dir 1
627 set xx [expr $x + 15]
628 }
629 lappend MV($who.moves) "$xx $y $x $y 12 0 0"
630 lappend MV($who.moves) "$x $y $xx $y 12 0 0"
631 }
632 MoveAvatars 0
633 }
634 "jump" {
635 set dir 0
636 for {set c 0} {$c < 50} {incr c} {
637 switch -- $dir {
638 "0" {
639 set dir 1
640 set yy [expr $y - 15]
641 }
642 "1" {
643 set dir 2
644 set yy [expr $y - 30]
645 }
646 "2" {
647 set dir 3
648 set yy [expr $y - 45]
649 }
650 "3" {
651 set dir 4
652 set yy [expr $y - 30]
653 }
654 "4" {
655 set dir 5
656 set yy [expr $y - 15]
657 }
658 "5" {
659 set dir 0
660 set yy $y
661 }
662 }
663 lappend MV($who.moves) "$x $yy $x $y 3 0 0"
664 lappend MV($who.moves) "$x $y $x $yy 3 0 0"
665 }
666 MoveAvatars 0
667 }
668 }
669 }