# OpenVerse I/O Functions Module # # This module handles all communctions with the server. # It also handles connections. # # # Module Name - I/O Functions Module # Current Maintainter - Cruise # Sourced By - Main Module # # Modifications by KaosBeetl: # Room History, 01/16/2000, revised 02/07/2000 # # Copyright (C) 1999 David Gale # For more information visit http://OpenVerse.org/ # # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License # as published by the Free Software Foundation; either version 2 # of the License, or (at your option) any later version. # # This program 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. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, # USA. #NOTE: # Now using string compare for increased performance # Now using curley braces around functiosn for more speed # # Sends pre-formatted commands to the server. # proc SendToServer {what} { global MV if {$MV(sock) == -1} {return} set new_what [split $what "\n"] set what [string trim [join $new_what " "]] DebugIt "-> $what" prot catch { puts $MV(sock) "$what" flush $MV(sock) } error } # # Reads text from the OpenVerse server. # proc ReadFrom {} { global MV set input "" catch {gets $MV(sock) input} error if {![string compare $input "NAMEINUSE"]} { ProcChat $MV(nick) [Trns nick_in_use] 0 1 $MV(colors.system.baloon) DebugIt "<- Disconnected!" prot Disconnect return } if {![string compare $input "ROOMFULL"]} { ProcChat $MV(nick) [Trns room_is_full] 0 1 $MV(colors.system.baloon) DebugIt "<- Disconnected!" prot Disconnect return } if {[eof $MV(sock)] == 1} { DebugIt "<- Disconnected!" prot Disconnect return; } ProcessInput $input } # # Process Command input # proc ProcessCommand {what} { global MV set cmd [string range $what 0 [expr [string first " " $what] -1]] set rest [string range $what [expr [string first " " $what] +1] end] set parms [split $rest " "] if {![string compare $cmd ""]} { set cmd $what set rest "" } # # Proces Plugins! # foreach plugin $MV(plugin.traps.ProcessCommand) { if ![$MV(plugin.traps.ProcessCommand.$plugin) $what $cmd $parms $rest] {return} } switch -exact -- [string tolower $cmd] { "/connect" { if {[lindex $parms 0] == "" || [lindex $parms 1] == ""} { ProcChat $MV(nick) [Trns connect_help] 0 1 $MV(colors.system.baloon) bell return } Disconnect set MV(roomhost) [lindex $parms 0] set MV(roomport) [lindex $parms 1] Connect } "/reconnect" { Disconnect Connect } "/aved" { AvEd } "/clear" { EraseChat } "/cls" { EraseChat } "/avatar" { if {[lindex $parms 0] == ""} { ProcChat $MV(nick) [Trns avatar_help] 0 1 $MV(colors.system.baloon) bell return } AnimateMe [lindex $parms 0] 3 } "/nick" { if {[lindex $parms 0] == "" || [string first " " $what] == -1} { ProcChat $MV(nick) [Trns nick_help] 0 1 $MV(colors.system.baloon) bell return } set newnick [CheckThatNick [lindex $parms 0]] if {![string compare $newnick ""]} {return} if $MV(names) {KillName $MV(nick)} ChangeNick "$newnick" set MV($MV(nick).haschat) 0 set MV($MV(nick).chatque) {} set MV($MV(nick).name_x_offset) $MV(anim.x_off) set MV($MV(nick).name_y_offset) $MV(anim.y_off) if $MV(names) {ShowName $MV(nick)} SendToServer "NICK $MV(nick)" InsertIntoChat 0 "\0030,4[Trns system]\00399,99 [Trns name_changed_to] $MV(nick).\n" } "/whois" { # CRUISE - 11-06-2001 - WHOIS now sends whatever you type. so /whois * works. if {[lindex $parms 0] == "" || [string first " " $what] == -1} { ProcChat $MV(nick) [Trns whois_help] 0 1 $MV(colors.system.baloon) bell return } SendToServer "WHOIS [lindex $parms 0]" } "/msg" { set rest [string range $rest [expr [string first " " $rest] +1] end] ProcChat $MV(nick) "$rest" 0 2 $MV(colors.privmsg.baloon) if $MV(rot13) {set rest [Rot13 $rest]} if {[lindex $parms 0] == "" || $rest == "" || [string first " " $what] == -1} { ProcChat $MV(nick) [Trns msg_help] 0 1 $MV(colors.system.baloon) bell return } foreach person $MV(people) { if {[string tolower $person] == [string tolower [lindex $parms 0]] || [lindex $parms 0] == "*"} { SendToServer "PRIVMSG $person $rest" } } } "/call" { set rest [string range $rest [expr [string first " " $rest] +1] end] if {[lindex $parms 0] == ""} { ProcChat $MV(nick) [Trns call_help] 0 1 $MV(colors.system.baloon) bell return } foreach person $MV(people) { if {[string tolower $person] == [string tolower [lindex $parms 0]] || [lindex $parms 0] == "*"} { SendToServer "SUB $person CALL [Trns call_msg]" } } } "/sing" { if {![string compare $rest ""]} { ProcChat $MV(nick) [Trns sing_help] 0 1 $MV(colors.system.baloon) bell return } if $MV(rot13) {set rest [Rot13 $rest]} SendToServer "SCHAT SING $rest" } "/steam" { if {![string compare $rest ""]} { ProcChat $MV(nick) [Trns steam_help] 0 1 $MV(colors.system.baloon) bell return } if $MV(rot13) {set rest [Rot13 $rest]} SendToServer "SCHAT STEAM $rest" } "/love" { if {![string compare $rest ""]} { ProcChat $MV(nick) [Trns love_help] 0 1 $MV(colors.system.baloon) bell return } if $MV(rot13) {set rest [Rot13 $rest]} SendToServer "SCHAT LOVE $rest" } "/idea" { if {![string compare $rest ""]} { ProcChat $MV(nick) [Trns idea_help] 0 1 $MV(colors.system.baloon) bell return } if $MV(rot13) {set rest [Rot13 $rest]} SendToServer "SCHAT IDEA $rest" } "/smile" { if {![string compare $rest ""]} { ProcChat $MV(nick) [Trns smile_help] 0 1 $MV(colors.system.baloon) bell return } if $MV(rot13) {set rest [Rot13 $rest]} SendToServer "SCHAT SMILE $rest" } "/wink" { if {![string compare $rest ""]} { ProcChat $MV(nick) [Trns wink_help] 0 1 $MV(colors.system.baloon) bell return } if $MV(rot13) {set rest [Rot13 $rest]} SendToServer "SCHAT WINK $rest" } "/frown" { if {![string compare $rest ""]} { ProcChat $MV(nick) [Trns frown_help] 0 1 $MV(colors.system.baloon) bell return } if $MV(rot13) {set rest [Rot13 $rest]} SendToServer "SCHAT FROWN $rest" } "/hfs" { ThrowError "HOLY FUCKING SHIT!" } "/sub" { set rest [string range $rest [expr [string first " " $rest] +1] end] if {[lindex $parms 0] == "" || $rest == "" || [string first " " $what] == -1} { ProcChat $MV(nick) [Trns sub_help] 0 1 $MV(colors.system.baloon) bell return } foreach person $MV(people) { if {[string tolower $person] == [string tolower [lindex $parms 0]] || [lindex $parms 0] == "*"} { SendToServer "SUB $person $rest" } } } "/quit" { if ![tk_dialog .quitQuestion [Trns really_quit] \ [Trns quit_question] \ "" 1 [Trns quit] [Trns cancel]] { exit } } "/rerot" { RotTextChat } "/rot13" { DebugIt "Rot13 --- $MV(rot13)" other if $MV(rot13) { set MV(rot13) 0 InsertIntoChat 0 "\0030,4[Trns system]\00399,99 [Trns rot13_disabled]\n" } else { set MV(rot13) 1 InsertIntoChat 0 "\0030,4[Trns system]\00399,99 [Trns rot13_enabled]\n" } DebugIt "Rot13 --- $MV(rot13)" other } "/push" { SendToServer "PUSH 100" } "/effect" { if {[lindex $parms 0] == ""} { ProcChat $MV(nick) [Trns effect_help] 0 1 $MV(colors.system.baloon) bell return } SendToServer "EFFECT [lindex $parms 0]" } "/dccsend" { set rest [string range $rest [expr [string first " " $rest] +1] end] if {[lindex $parms 0] == "" || $rest == "" || [string first " " $what] == -1} { ProcChat $MV(nick) [Trns dccsend_help] 0 1 $MV(colors.system.baloon) bell return } foreach person $MV(people) { if {[string tolower $person] == [string tolower [lindex $parms 0]] || [lindex $parms 0] == "*"} { DCCSend $person [lindex $parms 1] } } } "/url" { set rest [string range $rest [expr [string first " " $rest] +1] end] SendURL [lindex $parms 0] $rest } } } # # Connect to the current default server. # proc Connect {} { global MV ConnectToRoom $MV(roomhost) $MV(roomport) } # # Connect directly to a room. # proc ConnectToRoom {host port} { global MV if $MV(downloadingroom) { ThrowError [Trns cannot_change_rooms] return } # # Proces Plugins! # foreach plugin $MV(plugin.traps.Exit.pre) { if ![$MV(plugin.traps.Exit.pre.$plugin)] {return} } ProcChat $MV(nick) "[Trns changing_rooms_to] $host $port" 0 1 $MV(colors.system.baloon) Disconnect set MV(roomhost) $host set MV(roomport) $port if {[catch {set MV(sock) [socket $MV(roomhost) $MV(roomport)]} err]} { ThrowError "[Trns problem_connecting] \n\n $err" } else { fconfigure $MV(sock) -blocking 0 set args [fconfigure $MV(sock) -sockname] InsertIntoChat 0 "\0030,4[Trns system]\00399,99 [Trns connecting_to] $MV(roomhost) $MV(roomport)\n" set MV(MyIpAddress) [lindex $args 0] fileevent $MV(sock) readable ReadFrom SendToServer "AUTH $MV(nick) $MV(x) $MV(y) $MV(avatar) $MV(anim.x_off) $MV(anim.y_off) [file size "$MV(images)/$MV(avatar)"] $MV(anim.baloon_x) $MV(anim.baloon_y)" $MV(connect_button) configure -text [Trns disconnect] -command Disconnect } # # Proces Plugins! # foreach plugin $MV(plugin.traps.Exit.post) { if ![$MV(plugin.traps.Exit.post.$plugin)] {return} } } # # Disconnect from the server. # # CRUISE - 10/24/2001 - Made it disconnect DCC connections to the server # CRUISE - 11/06/2001 - Clears out the ignore list on disconnect. # proc Disconnect {} { global MV if {$MV(sock) == -1} {return} InsertIntoChat 0 "\0030,4[Trns system]\00399,99 [Trns disconnected_from] $MV(roomhost) $MV(roomport)\n" catch {close $MV(sock)} set MV(sock) -1 set MV(MyIpAddress) "0.0.0.0" wm title . [Trns not_connected_title] $MV(connect_button) configure -text [Trns connect] -command Connect foreach object $MV(server_objects) { KillServerObject $MV(server_objects.$object.id) } foreach link $MV(server_links) { KillServerLink $MV(server_links.$link.id) } foreach exit $MV(server_exits) { KillServerExit $MV(server_exits.$exit.id) } foreach tell $MV(server_tells) { KillServerTell $MV(server_tells.$tell.id) } foreach who $MV(people) { PersonLeft $who } # # Disconnect all connections to the server (*) # leave active other connections (to users?). # foreach idx $MV(dcc_list) { if {![string compare $MV(DCC.$idx.sender) "*"]} { endDCC LogOut $idx 0 "Logged Off Server - $MV(DCC.$idx.file)" } } # # Clear our ignore list. # TODO - READ IN A list in connect and send our stock ignores to the server on connect. set MV(ignore.avatar) {} set MV(ignore.effect) {} set MV(ignore.move) {} set MV(ignore.speech) {} set MV(ignore.sub) {} set MV(ignore.url) {} set MV(ignore.alll) {} # # Proces Plugins! # foreach plugin $MV(plugin.traps.Disconnect) { if ![$MV(plugin.traps.Disconnect.$plugin)] {return} } } # # Process Server input # proc ProcessInput {what} { global MV DebugIt "<- $what" prot set cmd [string range $what 0 [expr [string first " " $what] -1]] set rest [string range $what [expr [string first " " $what] +1] end] set parms [split $rest " "] if {![string compare $cmd ""]} {set cmd $what} # # Proces Plugins! # foreach plugin $MV(plugin.traps.ProcessInput.pre) { if ![$MV(plugin.traps.ProcessInput.pre.$plugin) "$what" $cmd $parms $rest] {return} } switch -exact -- $cmd { "AVATAR" { if {[lsearch -exact $MV(ignore.all) [lindex $parms 0]] != -1 || [lsearch -exact $MV(ignore.avatar) [lindex $parms 0]] != -1} {return} ChangeUserAvatar [lindex $parms 0] [lindex $parms 1] [lindex $parms 2] [lindex $parms 3] [lindex $parms 4] [lindex $parms 5] [lindex $parms 6] } "BADNAME" { ThrowError [Trns invalid_username] } "CHAT" { if {[lsearch -exact $MV(ignore.all) [lindex $parms 0]] != -1 || [lsearch -exact $MV(ignore.speech) [lindex $parms 0]] != -1} {return} set parms [split $rest " "] set rest [string range $rest [expr [string first " " $rest] +1] end] if $MV(rot13) {set rest [Rot13 $rest]} ProcChat [lindex $parms 0] $rest 0 0 $MV(colors.chat.baloon) } "SCHAT" { if {[lsearch -exact $MV(ignore.all) [lindex $parms 0]] != -1 || [lsearch -exact $MV(ignore.speech) [lindex $parms 0]] != -1} {return} set parms [split $rest " "] set rest [string range $rest [expr [string first " " $rest] +1] end] set rest [string range $rest [expr [string first " " $rest] +1] end] if $MV(rot13) {set rest [Rot13 $rest]} switch -exact -- [lindex $parms 0] { "SING" { ProcChat [lindex $parms 1] $rest 0 4 $MV(colors.chat.baloon) } "LOVE" { ProcChat [lindex $parms 1] $rest 0 5 $MV(colors.chat.baloon) } "STEAM" { ProcChat [lindex $parms 1] $rest 0 6 $MV(colors.chat.baloon) } "IDEA" { ProcChat [lindex $parms 1] $rest 0 7 $MV(colors.chat.baloon) } "SMILE" { ProcChat [lindex $parms 1] $rest 0 8 $MV(colors.chat.baloon) } "FROWN" { ProcChat [lindex $parms 1] $rest 0 9 $MV(colors.chat.baloon) } "WINK" { ProcChat [lindex $parms 1] $rest 0 A $MV(colors.chat.baloon) } default { ProcChat [lindex $parms 1] $rest 0 0 $MV(colors.chat.baloon) } } } "DCCGETAV" { if ![SanityCheck [lindex $parms 1]] {return} DCCGet $MV(roomhost) [lindex $parms 0] [lindex $parms 1] [lindex $parms 2] AVATAR * } "DCCGETOB" { if ![SanityCheck [lindex $parms 1]] {return} DCCGet $MV(roomhost) [lindex $parms 0] [lindex $parms 1] [lindex $parms 2] OBJECT * } "DCCGETROOM" { if ![SanityCheck [lindex $parms 1]] {return} DCCGet $MV(roomhost) [lindex $parms 0] [lindex $parms 1] [lindex $parms 2] ROOM * } "DCCSENDAV" { if ![SanityCheck [lindex $parms 1]] {return} DCCSendAv $MV(roomhost) [lindex $parms 0] [lindex $parms 1] } "EFFECT" { if {[lsearch -exact $MV(ignore.all) [lindex $parms 0]] != -1 || [lsearch -exact $MV(ignore.effect) [lindex $parms 0]] != -1} {return} if $MV(honor_effects) {AvatarEffect [lindex $parms 0] [lindex $parms 1]} } "EXIT" { if $MV(honor_exits) { ConnectToRoom [lindex $parms 0] [lindex $parms 1] } } "MOVE" { if {[lsearch -exact $MV(ignore.all) [lindex $parms 0]] != -1 || [lsearch -exact $MV(ignore.move) [lindex $parms 0]] != -1} {return} MoveUser [lindex $parms 0] [lindex $parms 1] [lindex $parms 2] [lindex $parms 3] } "NEW" { NewPerson [lindex $parms 0] [lindex $parms 1] [lindex $parms 2] [lindex $parms 3] [lindex $parms 4] [lindex $parms 5] [lindex $parms 6] [lindex $parms 7] [lindex $parms 8] } "NOMORE" { PersonLeft [lindex $parms 0] } "PING" { SendToServer "PONG" } "PUSH" { # # Validate here because of the plugin support here. # if {[TestNum [lindex $parms 0]] || [TestNum [lindex $parms 1]]} { DebugIt "PUSH Parameters invalid." other return } # Plugin support added, KaosBeetl 02/09/2000 # # Proces Plugins! # foreach plugin $MV(plugin.traps.Pushed.Pre) { if ![$MV(plugin.traps.Pushed.Pre.$plugin) [lindex $parms 0] [lindex $parms 1]] {return} } MoveTo [lindex $parms 0] [lindex $parms 1] 1 # # Proces Plugins! # foreach plugin $MV(plugin.traps.Pushed.Post) { if ![$MV(plugin.traps.Pushed.Post.$plugin) [lindex $parms 0] [lindex $parms 1]] {return} } } "PRIVMSG" { if {[lsearch -exact $MV(ignore.all) [lindex $parms 0]] != -1 || [lsearch -exact $MV(ignore.speech) [lindex $parms 0]] != -1} {return} set parms [split $rest " "] set rest [string range $rest [expr [string first " " $rest] +1] end] if $MV(rot13) {set rest [Rot13 $rest]} ProcChat [lindex $parms 0] "$rest" 0 2 $MV(colors.privmsg.baloon) } "ROOM" { SetRoom [lindex $parms 0] [lindex $parms 1] } "ROOMNAME" { wm title . $rest set MV(roomname) $rest # Now that we have the room's name, add to history # and update passageways time if applicable UpdatePassageways } "SUB" { if {[lsearch -exact $MV(ignore.all) [lindex $parms 0]] != -1 || [lsearch -exact $MV(ignore.sub) [lindex $parms 0]] != -1} {return} set parms [split $rest " "] set rest [string range $rest [expr [string first " " $rest] +1] end] if {[lindex $parms 1] == ""} {return} switch -exact -- [lindex $parms 1] { "DCCGET" { if ![SanityCheck [lindex $parms 4]] {return} ProcURL [lindex $parms 0] "FILE://[lindex $parms 2]:[lindex $parms 3]/[lindex $parms 4]:[lindex $parms 5]" } "CALL" { ProcCall [lindex $parms 0] } "GIVEPERSONAL" { GivePersonal [lindex $parms 0] } "PERSONAL" { ProcPersonal [lindex $parms 0] "$rest" } } } "TOOBIG" { AnimateMe $MV(default_avatar_number) 1 update idletasks ProcChat $MV(nick) [Trns toobig_msg] 0 1 $MV(colors.system.baloon) } "URL" { if {[lsearch -exact $MV(ignore.all) [lindex $parms 0]] != -1 || [lsearch -exact $MV(ignore.url) [lindex $parms 0]] != -1} {return} set parms [split $rest " "] set rest [string range $rest [expr [string first " " $rest] +1] end] ProcURL [lindex $parms 0] $rest } "USERS" { set MV(server_users) [lindex $parms 0] } "WHOIS" { WHOISUser [lindex $parms 0] [lindex $parms 1] } "BOX" { DrawBox [lindex $parms 0] [lindex $parms 1] \ [lindex $parms 2] [lindex $parms 3] \ [lindex $parms 4] [lindex $parms 5] \ [lindex $parms 6] [lindex $parms 7] } "LINK" { DrawLink [lindex $parms 0] [lindex $parms 1] \ [lindex $parms 2] [lindex $parms 3] \ [lindex $parms 4] [lindex $parms 5] \ [lindex $parms 6] } "MOUSEOVER" { DrawMouseOver [lindex $parms 0] [lindex $parms 1] \ [lindex $parms 2] [lindex $parms 3] \ [lindex $parms 4] [lindex $parms 5] \ [lindex $parms 6] [lindex $parms 7] } "ABOVE" { RaiseAvatar [lindex $parms 0] } "EXIT_OBJ" { DrawExit [lindex $parms 0] [lindex $parms 1] \ [lindex $parms 2] [lindex $parms 3] \ [lindex $parms 4] [lindex $parms 5] \ [lindex $parms 6] [lindex $parms 7] } "TELL" { # TELL NAME x1 y1 x2 y2 duration DrawTell [lindex $parms 0] [lindex $parms 1] \ [lindex $parms 2] [lindex $parms 3] \ [lindex $parms 4] [lindex $parms 5] } "IMAGE" { DrawImage [lindex $parms 0] [lindex $parms 1] \ [lindex $parms 2] [lindex $parms 3] \ [lindex $parms 4] [lindex $parms 5] } "TEXT" { set text [string range $rest [expr [string first "|" $rest] +1] end] DrawText [lindex $parms 0] [lindex $parms 1] \ [lindex $parms 2] [lindex $parms 3] \ [lindex $parms 4] [lindex $parms 5] $text } "ENTRY" { # ENTRY NAME x1 y1 length bg_color text_color duration |default text value set text [string range $rest [expr [string first "|" $rest] +1] end] DrawEntry [lindex $parms 0] [lindex $parms 1] \ [lindex $parms 2] [lindex $parms 3] \ [lindex $parms 4] [lindex $parms 5] \ [lindex $parms 6] $text } "SUBMIT" { # SUBMIT NAME x1 y1 color text_color duration |text set text [string range $rest [expr [string first "|" $rest] +1] end] DrawSubmit [lindex $parms 0] [lindex $parms 1] \ [lindex $parms 2] [lindex $parms 3] \ [lindex $parms 4] [lindex $parms 5] $text } "WTEXT" { # Wrapping Text # WTEXT NAME x1 y1 color size duration width |text set text [string range $rest [expr [string first "|" $rest] +1] end] DrawWText [lindex $parms 0] [lindex $parms 1] \ [lindex $parms 2] [lindex $parms 3] \ [lindex $parms 4] [lindex $parms 5] \ [lindex $parms 6] $text } "MOVE_OBJ" { # Move an object. # MOVE_OBJ NAME x_offset y_offset type speed MoveObject [lindex $parms 0] [lindex $parms 1] \ [lindex $parms 2] [lindex $parms 3] \ [lindex $parms 4] } } # -------------------------------------------------- # Server "Objects" # -------------------------------------------------- # BOX NAME x1 y1 x2 y2 fill outline duration # IMAGE NAME x1 y1 image duration # LINK NAME x1 y1 x2 y2 duration link # EXIT NAME x1 y1 x2 y2 duration host port # TEXT NAME x1 y1 color size duration |text # WTEXT NAME x1 y1 color size duration width |text # TELL NAME x1 y1 x2 y2 duration # ENTRY NAME x1 y1 length bg_color text_color duration |default text value # SUBMIT NAME x1 y1 duration |text # MOVE_OBJ NAME x_offset y_offset type speed # -------------------------------------------------- # # Proces Plugins! # foreach plugin $MV(plugin.traps.ProcessInput.post) { if ![$MV(plugin.traps.ProcessInput.post.$plugin) "$what" $cmd $parms $rest] {return} } } proc SanityCheck {what} { if {[string first "../" $what] != -1} { return 0} else { return 1} } proc DownloadWindow {file} { global MV if {[string length $file] > 16} { set file [string range $file 0 15] } # find an empty one. set row -1 set col -1 for {set c 0} {$c < 26 && $row < 0} {incr c} { for {set s 1} {$s < 4 && $col < 0} {incr s} { if !$MV(dls.$c.$s) { set row $c set col $s } } } # Make it not empty :) set y [expr $row * 18 + 2] set xx [expr $col * 213] set MV(dls.$row.$col) 1 set MV(dlbox.$row.$col) [.top.c create rectangle [expr $xx - 213] [expr $y +1] $xx [expr $y + 18 + 2] -fill black -outline white] set MV(dltxt.$row.$col) [.top.c create text [expr $xx - 140] [expr $y + 10] -text "$file" -fill white] set MV(dlstsbx.$row.$col) [.top.c create rectangle [expr $xx -68] [expr $y + 4] [expr $xx - 2] [expr $y + 16] -outline blue] set MV(dlsts.$row.$col) [.top.c create rectangle [expr $xx -66] [expr $y + 5] [expr $xx -66] [expr $y + 14] -fill red] set MV(dlperc.$row.$col) 0 set MV(dlcps.$row.$col) 0.00 # # Set the bounding box so a plugin can use this later. # set MV(dlbounds.$row.$col) [list [expr $xx - 213] [expr $y +1] $xx [expr $y + 18 + 2]] return "$row $col" } proc ShowDownloadStatus {row col} { global MV tl set y [expr $row * 18 + 2] set xx [expr $col * 213] set rightx [expr ($MV(dlperc.$row.$col) * 62) / 100] set leftx [expr $xx -66] .top.c delete $MV(dlsts.$row.$col) set idx $MV(dlidx.$row.$col) set type $MV(DCC.$idx.io) if {![string compare $type "Get"]} { set MV(dlsts.$row.$col) [.top.c create rectangle $leftx [expr $y + 5] [expr $leftx + $rightx] [expr $y + 14] -fill green] } else { set MV(dlsts.$row.$col) [.top.c create rectangle $leftx [expr $y + 5] [expr $leftx + $rightx] [expr $y + 14] -fill red] } if {[winfo exists .top.c.dlcanc]} { if $MV(dlactive.$row.$col) { set idx $MV(dlidx.$row.$col) .top.c.dlcanc.info2.inf configure -text "$tl($MV(DCC.$idx.sock))" .top.c.dlcanc.info3.inf configure -text "$MV(dlcps.$row.$col) Kcps" } } } proc KillDlwin {row col} { global MV .top.c delete $MV(dlbox.$row.$col) .top.c delete $MV(dltxt.$row.$col) .top.c delete $MV(dlstsbx.$row.$col) .top.c delete $MV(dlsts.$row.$col) set MV(dls.$row.$col) 0 } ### -- New download code. # DCC GET CODE # # This has been styled using DCC code from Zircon an ircII client # by Lindsay Marshall # # This is our central location for DOWNLOADING files. # proc DCCGet {host port file size type sender} { global MV tl if ![SanityCheck "$file"] { DebugIt "(!) $file fails SanityCheck" other return } # # make sure we are not already getting it. # Send a reject if we are! # TODO # lappend MV(downloads) "$file" switch -exact -- $type { "AVATAR" {set dldir "$MV(rem_images)"} "OBJECT" {set dldir "$MV(objects)"} "ROOM" { set dldir "$MV(roomdir)" set MV(downloadingroom) 1 } "OBJECT" {set dldir "$MV(objects)"} default {set dldir "$MV(download_dir)"} } set sock [socket -async $host $port] fconfigure $sock -blocking 1 set idx [incr MV(dcc_num)] set MV(DCC.$idx.sender) $sender set MV(DCC.$idx.io) "Get" set MV(DCC.$idx.file) "$dldir/$file" set MV(DCC.$idx.size) $size set MV(DCC.$idx.type) $type set MV(DCC.$idx.posn) 0 set MV(DCC.$idx.server) -1 set MV(DCC.$idx.sock) $sock set MV(DCC.$idx.time) [clock seconds] set rc [DownloadWindow [file tail $MV(DCC.$idx.file)]] set row [string range $rc 0 [expr [string first " " $rc] -1]] set col [string range $rc [expr [string first " " $rc] +1] end] set MV(DCC.$idx.row) $row set MV(DCC.$idx.col) $col set MV(dlidx.$row.$col) $idx set tl($sock) 0 lappend MV(dcc_list) $idx fileevent $sock writable "startGet $idx" } proc startGet {index} { global MV set file $MV(DCC.$index.file) set posn $MV(DCC.$index.posn) fileevent $MV(DCC.$index.sock) writable {} fconfigure $MV(DCC.$index.sock) -buffering none -blocking 0 -translation binary -buffersize 4096 set flags [list WRONLY CREAT] if {$posn == 0} { lappend flags TRUNC } if {![catch {open $file $flags 0600} outfile]} { if {$posn != 0} { if {[catch {seek $outfile $posn start} msg]} { close $outfile endDCC Get $index 0 "Cannot seek on $file : $msg" return 0 } incr MV(DCC.$index.size) -$posn } uplevel #0 set tl($MV(DCC.$index.sock)) 0 fconfigure $outfile -translation binary fileevent $MV(DCC.$index.sock) readable "dccgevent $index [clock seconds] $outfile" } { endDCC Get $index 0 "Cannot write $file : $outfile" return 0 } return 1 } proc dccgevent {index st out} { global tl MV set xc 0 set in $MV(DCC.$index.sock) set leng $MV(DCC.$index.size) uplevel #0 set MV(DCC.$index.time) [clock seconds] set fail_type 0 if {[eof $in]} { DebugIt "(!) Dcc Ended, EOF detected." prot if {$tl($in) < $leng} { set msg "Transfer Interrupted" set fail_type 0 } elseif {$tl($in) > $leng} { set msg "Too much data transferred!!" set fail_type 0 } else { set sx s if {[set st [expr {[clock seconds] - $st}]] == 0} { set st 1 set sx {} } set xc 1 set msg "Transfer completed. [expr {$leng / ($st * 1024.0)}] Kbytes/sec" set fail_type 1 } } { if {![catch {set buffer [read $in]} msg]} { incr tl($in) [set l [string length $buffer]] DebugIt "downloaded $l bytes ($tl($in) total) wrote to $out $MV(DCC.$index.file)" prot if {[set dt [expr {[clock seconds] - $st}]] == 0 || $tl($in) == 0} { set elt 0 } { set elt [expr {($leng - $tl($in)) / ($tl($in) /([clock seconds] - $st))}] } if {$leng == 0} { set xt 0 } { set xt [expr {($tl($in) * 100.0) / $leng}] } set row $MV(DCC.$index.row) set col $MV(DCC.$index.col) if {$tl($in) != 0 && $MV(DCC.$index.size) != 0} { uplevel #0 set MV(dlperc.$row.$col) [expr ($tl($in) * 100) / $MV(DCC.$index.size)] if {[expr [clock seconds] - $st]} { uplevel #0 set MV(dlcps.$row.$col) [format "%0.2f" [expr ($tl($in) / ([clock seconds] - $st)) / 1024.00]] } ShowDownloadStatus $row $col } if {![catch {puts -nonewline $out $buffer} msg]} { catch {flush $out} if $l { if {![catch {puts -nonewline $in [binary format I1 $tl($in)]} msg]} { flush $in return } } return } else { set msg "Unable to report received size" set fail_type 0 DebugIt "(!) Dcc Ended, Error Condition." prot } } else { # 0000 bytes triggered a read event? # return #set msg "Unable to read from remote connection" #set fail_type 0 # "(!) Dcc Ended, Error Condition." } } DebugIt "closing $out $MV(DCC.$index.file)" prot catch {close $out} endDCC Get $index $fail_type $msg } # DCC Send CODE # # This has been styled using DCC code from Zircon an ircII client # by Lindsay Marshall # # This is our central location for sending AVATAR files. # It is a passive send. proc DCCSendAv {host port what} { global MV tl set file "$MV(images)/$what" if {[file exists $file]} { if {![file readable $file]} { DebugIt "($who) (DCCSend) Cannot read file $file." prot return } set size [file size $file] set idx [incr MV(dcc_num)] set sock [socket -async $host $port] fconfigure $sock -blocking 1 set MV(DCC.$idx.sender) "*" set MV(DCC.$idx.io) "Send" # set MV(DCC.$idx.notify) "NONE" set MV(DCC.$idx.cps) 0 set MV(DCC.$idx.status) 0 # set MV(DCC.$idx.file) "$file" set MV(DCC.$idx.size) $size set MV(DCC.$idx.posn) 0 set MV(DCC.$idx.type) "AVATAR SEND" set MV(DCC.$idx.time) [clock seconds] set MV(DCC.$idx.server) -1 set MV(DCC.$idx.sock) $sock set MV(DCC.$idx.port) $port set MV(DCC.$idx.time) [clock seconds] set rc [DownloadWindow $MV(DCC.$idx.file)] set row [string range $rc 0 [expr [string first " " $rc] -1]] set col [string range $rc [expr [string first " " $rc] +1] end] set MV(dlidx.$row.$col) $idx set MV(DCC.$idx.row) $row set MV(DCC.$idx.col) $col set tl($sock) 0 lappend MV(dcc_list) $idx fileevent $sock writable "acceptAVSend $idx" } else { DebugIt "($who) (DCCSendAv) File $file does not exist." prot } update idletasks } proc acceptAVSend {index} { global MV fileevent $MV(DCC.$index.sock) writable {} set chan $MV(DCC.$index.sock) if {[ catch {open $MV(DCC.$index.file) RDONLY} infile]} { endDCC Send $index 0 "Cannot read $MV(DCC.$index.file) : $infile" return 0 } if {[set posn $MV(DCC.$index.posn)] != {} && $posn > 0} { if {[catch {seek $infile $posn start} msg]} { endDCC Send $index 0 "Cannot seek $MV(DCC.$index.file) : $msg" close $infile return 0 } incr MV(DCC.$index.size) -$posn } if {$MV(DCC.$index.size) == 0} { close $infile endDCC Send $index 1 "Transfer completed." return 1 } set st [clock seconds] fconfigure $infile -translation binary if {[catch {set buffer [read $infile $MV(sendbuffer)]} msg]} { endDCC Send $index 0 "Error reading $file : $msg" close $infile return 0 } global tl set tl($chan) [string length $buffer] fconfigure $chan -blocking 0 -buffering none -translation binary if {[catch {puts -nonewline $chan $buffer} msg]} { endDCC Send $index 0 "Write error : $msg" close $infile return 0 } flush $chan DebugIt "($MV(DCC.$index.sender)) -- Accepted DCCSend" prot fileevent $chan readable "dccSendEvent $index $st $infile" } # DCC Send CODE # # This has been styled using DCC code from Zircon an ircII client # by Lindsay Marshall # # This is our central location for SENDING ALL files. # # This function will return the index of the file which is being sent if # all went well, otherwise it will return -1. This index can be used to # set the MV(DCC.$idx.notify) variable to a function name which will be # called to let a plugin or remote application know that the download has # finished and with what status. # proc DCCSend {who what} { global MV tl set file "$what" set what "[file tail $file]" if {[file exists $file]} { if {![file readable $file]} { DebugIt "($who) (DCCSend) Cannot read file $file." prot return -1 } set size [file size $file] set idx [incr MV(dcc_num)] set sock [socket -server "acceptSend $idx" 0] if {[catch {fconfigure $sock -sockname} port]} { DebugIt "($who) (DCCSend) Cannot get port for server - $port" prot } set MV(DCC.$idx.sender) $who set MV(DCC.$idx.type) "OUTBOUND SEND" set MV(DCC.$idx.io) "Send" # set MV(DCC.$idx.notify) "NONE" set MV(DCC.$idx.cps) 0 set MV(DCC.$idx.status) 0 # set MV(DCC.$idx.file) "$file" set MV(DCC.$idx.size) $size set MV(DCC.$idx.posn) 0 set MV(DCC.$idx.time) [clock seconds] set MV(DCC.$idx.server) $sock set MV(DCC.$idx.sock) -1 set MV(DCC.$idx.port) [lindex $port 2] set MV(DCC.$idx.time) [clock seconds] set rc [DownloadWindow $MV(DCC.$idx.file)] set row [string range $rc 0 [expr [string first " " $rc] -1]] set col [string range $rc [expr [string first " " $rc] +1] end] set MV(dlidx.$row.$col) $idx set MV(DCC.$idx.row) $row set MV(DCC.$idx.col) $col set tl($sock) 0 lappend MV(dcc_list) $idx SendToServer "SUB $who DCCGET $MV(MyIpAddress) [lindex $port 2] $what $size" return $idx } else { DebugIt "($who) (DCCSend) File $file does not exist." prot return -1 } } proc acceptSend {index chan hst port} { global MV catch {close $MV(DCC.$index.server)} set MV(DCC.$index.server) -1 uplevel #0 set MV(DCC.$index.sock) $chan if {[ catch {open $MV(DCC.$index.file) RDONLY} infile]} { endDCC Send $index 0 "Cannot read $MV(DCC.$index.file) : $infile" return 0 } if {[set posn $MV(DCC.$index.posn)] != {} && $posn > 0} { if {[catch {seek $infile $posn start} msg]} { endDCC Send $index 0 "Cannot seek $MV(DCC.$index.file) : $msg" close $infile return 0 } incr MV(DCC.$index.size) -$posn } if {$MV(DCC.$index.size) == 0} { close $infile endDCC Send $index 1 "Transfer completed." return 1 } set st [clock seconds] fconfigure $infile -translation binary if {[catch {set buffer [read $infile $MV(sendbuffer)]} msg]} { endDCC Send $index 0 "Error reading $file : $msg" close $infile return 0 } global tl set tl($chan) [string length $buffer] fconfigure $chan -blocking 0 -buffering none -translation binary if {[catch {puts -nonewline $chan $buffer} msg]} { endDCC Send $index 0 "Write error : $msg" close $infile return 0 } flush $chan fileevent $chan readable "dccSendEvent $index $st $infile" } proc dccSendEvent {index st fd} { global MV set sk $MV(DCC.$index.sock) uplevel #0 set MV(DCC.$index.time) [clock seconds] if {[eof $sk]} { set MV(DCC.$index.status) -1 endDCC Send $index 0 "Transfer interrupted" close $fd return } if {[catch {set l [read $sk 4]} msg]} { set MV(DCC.$index.status) -1 endDCC Send $index 0 "Read error : $msg" close $fd return } if {[string length $l] == 0} { set MV(DCC.$index.status) -1 endDCC Send $index 0 "Sync read error" close $fd return } global tl set cl 0 binary scan $l I1 cl if {$cl != $tl($sk)} {return } if {[eof $fd]} { if {[set st [expr {[clock seconds] - $st}]] == 0} { set st 1 } close $fd set MV(DCC.$index.status) 1 endDCC Send $index 1 "Transfer completed" return } if {[catch {set buffer [read $fd $MV(sendbuffer)]} msg]} { set MV(DCC.$index.status) -1 endDCC Send $index 0 "Error reading $MV(DCC.$index.file) : $msg" close $fd return } if {[set lng [string length $buffer]] == 0} { if {[set st [expr {[clock seconds] - $st}]] == 0} { set st 1 } close $fd set MV(DCC.$index.status) 1 endDCC Send $index 1 "Transfer completed." return } incr tl($sk) $lng if {[catch {puts -nonewline $sk $buffer} msg]} { set MV(DCC.$index.status) -1 endDCC Send $index 0 "Write error : $msg" close $fd return } flush $sk set row $MV(DCC.$index.row) set col $MV(DCC.$index.col) if {$tl($sk) != 0 && $MV(DCC.$index.size) != 0} { uplevel #0 set MV(dlperc.$row.$col) [expr ($tl($sk) * 100) / $MV(DCC.$index.size)] if {[expr [clock seconds] - $st]} { uplevel #0 set MV(dlcps.$row.$col) [format "%0.2f" [expr ($tl($sk) / ([clock seconds] - $st)) / 1024.00]] } ShowDownloadStatus $row $col } if {[set dt [expr {[clock seconds] - $st}]] == 0} { set elt 0 } { set elt [expr {($MV(DCC.$index.size) - $tl($sk)) / ($tl($sk) /([clock seconds] - $st))}] } update idletasks } # # CRUISE 10/24/2001 - made it say we're not downloading a room on an end-dcc if we are # not connected to a server (any server) # proc endDCC {type index fail_type debug} { global MV tl set idx [lsearch -exact $MV(downloads) [file tail $MV(DCC.$index.file)]] if {$index >= 0} {set MV(downloads) [lreplace $MV(downloads) $idx $idx]} DebugIt "(!) (DCC$type) - $debug $MV(DCC.$index.file)" prot catch {close $MV(DCC.$index.sock)} if {$MV(DCC.$index.server) > 0} { catch {close $MV(DCC.$index.server)} } # # Kaos's FIX # ISSUE 01 # # # Proces Plugins! # #foreach plugin $MV(plugin.traps.endDCC.pre) { #if ![$MV(plugin.traps.endDCC.pre.$plugin) "$type" $index "$fail_type" "$debug"] {return} #} if {![string compare $type "Cancel"] && ![string compare $MV(DCC.$index.type) "ROOM"]} { set MV(downloadingroom) 0 } if {![string compare $type "Send"] && [string compare $MV(DCC.$index.notify) "NONE"]} { $MV(DCC.$index.notify) $type $index $fail_type $debug } if {![string compare $type "Get"] || ![string compare $type "LogOut"]} { switch -exact -- $MV(DCC.$index.type) { "AVATAR" { if $fail_type { foreach who $MV(people) { if {![string compare $MV($who.avatar) [file tail $MV(DCC.$index.file)]] && $MV($who.downloading) == 1} { catch {image create photo OpenVerse_User_Image_$who -file "$MV(rem_images)/$MV($who.avatar)"} err if {[string compare $err OpenVerse_User_Image_$who]} { catch {image create photo OpenVerse_User_Image_$who -file "$MV(images)/default.gif"} err } set MV($who.downloading) 0 } } } else { SendToServer "DCCSENDAV [file tail $MV(DCC.$index.file)]" } } "OBJECT" { if $fail_type { foreach object $MV(server_objects) { if {![string compare $MV(server_objects.$object.image) [file tail $MV(DCC.$index.file)]]} { catch {image create photo server_object_$object -file "$MV(objects)/$MV(server_objects.$object.image)"} err if {[string compare $err "server_object_$object"]} { DebugIt "$err" prot catch {image create photo server_object_$object -file "$MV(icons)/unknown.gif"} err } } } } else { SendToServer "DCCSENDOB [file tail $MV(DCC.$index.file)]" } } "ROOM" { set MV(downloadingroom) 0 if $fail_type { catch {image create photo OpenVerse_Image_room -file "$MV(roomdir)/[file tail $MV(DCC.$index.file)]"} } else { SendToServer "DCCSENDROOM [file tail $MV(DCC.$index.file)]" } } } } KillDlwin $MV(DCC.$index.row) $MV(DCC.$index.col) if {[winfo exists .top.c.dlcanc]} {KillDlInfoWin $MV(DCC.$index.row) $MV(DCC.$index.col)} set idx [lsearch -exact $MV(dcc_list) $index] set MV(dcc_list) [lreplace $MV(dcc_list) $idx $idx] # # Proces Plugins! # foreach plugin $MV(plugin.traps.endDCC.post) { $MV(plugin.traps.endDCC.post.$plugin) "$type" $index "$fail_type" "$debug" } # Cleanup memory used by this transfer. catch {unset MV(dlbounds.$MV(DCC.$index.row).$MV(DCC.$index.col))} catch {unset MV(dlbox.$MV(DCC.$index.row).$MV(DCC.$index.col))} catch {unset MV(dlidx.$MV(DCC.$index.row).$MV(DCC.$index.col))} catch {unset MV(dlperc.$MV(DCC.$index.row).$MV(DCC.$index.col))} catch {unset MV(dlsts.$MV(DCC.$index.row).$MV(DCC.$index.col))} catch {unset MV(dlstsbx.$MV(DCC.$index.row).$MV(DCC.$index.col))} catch {unset MV(dltxt.$MV(DCC.$index.row).$MV(DCC.$index.col))} catch {unset MV(DCC.$MV(DCC.$index.row).$MV(DCC.$index.col).window)} catch {set MV(dlcps.$MV(DCC.$index.row).$MV(DCC.$index.col)) 0} catch {unset tl($MV(DCC.$index.sock))} catch {unset MV(DCC.$index.col)} catch {unset MV(DCC.$index.file)} catch {unset MV(DCC.$index.io)} catch {unset MV(DCC.$index.posn)} catch {unset MV(DCC.$index.row)} catch {unset MV(DCC.$index.sender)} catch {unset MV(DCC.$index.server)} catch {unset MV(DCC.$index.size)} catch {unset MV(DCC.$index.cps)} catch {unset MV(DCC.$index.notify)} catch {unset MV(DCC.$index.port)} catch {unset MV(DCC.$index.status)} catch {unset MV(DCC.$index.sock)} catch {unset MV(DCC.$index.time)} catch {unset MV(DCC.$index.type)} } proc CheckTimeouts {} { global MV set tme [clock seconds] foreach idx $MV(dcc_list) { if {[expr $tme - $MV(DCC.$idx.time)] > $MV(dcctimeout)} { if {$MV(DCC.$idx.server) > 0} { catch {close $MV(DCC.$idx.server)} } endDCC Timer $idx 0 "Connection Timed Out $MV(DCC.$idx.file)" } } after 5000 CheckTimeouts } proc KillDlInfoWin {row col} { global MV set MV(dlactive.$row.$col) 0 destroy .top.c.dlcanc # Bug reported by topie if {[info exists MV(DCC.$row.$col.window)]} { .top.c delete $MV(DCC.$row.$col.window) } } proc DownloadClick {row col x y} { global MV tl if {[winfo exists .top.c.dlcanc]} {KillDlInfoWin $row $col} set where n if {$row < 13} {set where n} if {$row > 13} {set where s} if {$row == 13} {set where s} if {$col == 1} {append where "w"} if {$col == 3} {append where "e"} frame .top.c.dlcanc -relief raised -borderwidth 2 \ -bg $MV(colors.dl.frames.bg) set idx $MV(dlidx.$row.$col) set MV(DCC.$row.$col.window) [.top.c create window $x $y -anchor $where -window .top.c.dlcanc] set MV(dlactive.$row.$col) 1 frame .top.c.dlcanc.info0 -relief sunken -borderwidth 2 \ -bg $MV(colors.dl.frames.bg) frame .top.c.dlcanc.info1 -relief sunken -borderwidth 2 \ -bg $MV(colors.dl.frames.bg) frame .top.c.dlcanc.info2 -relief sunken -borderwidth 2 \ -bg $MV(colors.dl.frames.bg) frame .top.c.dlcanc.info3 -relief sunken -borderwidth 2 \ -bg $MV(colors.dl.frames.bg) label .top.c.dlcanc.info0.txt -relief raised -borderwidth 2 -width 15 \ -text [Trns dlwin_from] \ -fg $MV(colors.dl.labels.fg) \ -bg $MV(colors.dl.labels.bg) label .top.c.dlcanc.info1.txt -relief raised -borderwidth 2 -width 15 \ -text [Trns file] \ -fg $MV(colors.dl.labels.fg) \ -bg $MV(colors.dl.labels.bg) label .top.c.dlcanc.info2.txt -relief raised -borderwidth 2 -width 15 \ -text [Trns bytes_trans] \ -fg $MV(colors.dl.labels.fg) \ -bg $MV(colors.dl.labels.bg) label .top.c.dlcanc.info3.txt -relief raised -borderwidth 2 -width 15 \ -text [Trns cps] \ -fg $MV(colors.dl.labels.fg) \ -bg $MV(colors.dl.labels.bg) label .top.c.dlcanc.info0.inf -relief sunken -borderwidth 2 \ -text "$MV(DCC.$idx.sender)" \ -fg $MV(colors.dl.entries.fg) \ -bg $MV(colors.dl.entries.bg) label .top.c.dlcanc.info1.inf -relief sunken -borderwidth 2 \ -text "$MV(DCC.$idx.file)" \ -fg $MV(colors.dl.entries.fg) \ -bg $MV(colors.dl.entries.bg) # a fix for the problematic download problem? if {![info exists tl($MV(DCC.$idx.sock))]} { set tl($MV(DCC.$idx.sock)) 0 } label .top.c.dlcanc.info2.inf -relief sunken -borderwidth 2 \ -text "$tl($MV(DCC.$idx.sock))" \ -fg $MV(colors.dl.entries.fg) \ -bg $MV(colors.dl.entries.bg) label .top.c.dlcanc.info3.inf -relief sunken -borderwidth 2 \ -text "$MV(dlcps.$row.$col) Kbps" \ -fg $MV(colors.dl.entries.fg) \ -bg $MV(colors.dl.entries.bg) button .top.c.dlcanc.can -text [Trns end_download] \ -command "endDCC Cancel $idx 0 \"Canceled at user's Request\"" \ -fg $MV(colors.dl.buttons.fg) \ -bg $MV(colors.dl.buttons.bg) \ -activeforeground $MV(colors.dl.buttons.afg) \ -activebackground $MV(colors.dl.buttons.abg) button .top.c.dlcanc.nev -text [Trns close] \ -command "KillDlInfoWin $row $col" \ -fg $MV(colors.dl.buttons.fg) \ -bg $MV(colors.dl.buttons.bg) \ -activeforeground $MV(colors.dl.buttons.afg) \ -activebackground $MV(colors.dl.buttons.abg) pack .top.c.dlcanc.info0 -fill both -expand y pack .top.c.dlcanc.info1 -fill both -expand y pack .top.c.dlcanc.info2 -fill both -expand y pack .top.c.dlcanc.info3 -fill both -expand y pack .top.c.dlcanc.info0.txt -side left pack .top.c.dlcanc.info1.txt -side left pack .top.c.dlcanc.info2.txt -side left pack .top.c.dlcanc.info3.txt -side left pack .top.c.dlcanc.info0.inf -side left -fill both -expand y pack .top.c.dlcanc.info1.inf -side left -fill both -expand y pack .top.c.dlcanc.info2.inf -side left -fill both -expand y pack .top.c.dlcanc.info3.inf -side left -fill both -expand y pack .top.c.dlcanc.nev -side left -fill both -expand y if {[string compare $MV(DCC.$idx.type) "ROOM"]} { pack .top.c.dlcanc.can -side left -fill both -expand y } } # # We need to register as a plugin because # there seems to be a limit on the number of bound items # on the canvas or it's buggy or something. This works. # proc MV_DlWindows {x y} { global MV foreach dcc $MV(dcc_list) { set r $MV(DCC.$dcc.row) set c $MV(DCC.$dcc.col) if {$x >= [lindex $MV(dlbounds.$r.$c) 0] && \ $x <= [lindex $MV(dlbounds.$r.$c) 2] && \ $y >= [lindex $MV(dlbounds.$r.$c) 1] && \ $y <= [lindex $MV(dlbounds.$r.$c) 3]} { DownloadClick $r $c $x $y return 0 } } return 1 } # # CRUISE - 11/03/2001 - Will only collect information from people # we requested it from. # proc ProcPersonal {who data} { global MV if {[lsearch -exact $MV(personals.wanted) $MV($who.name)] == -1} { DebugIt "$MV($who.name) - uunrequested personals information." other return } set data [string range $data [expr [string first " " $data] +1] end] # data = "ID Data" set id [lindex [split $data] 0] set value [string range $data [expr [string length $id] + 1] end] DebugIt "(PERSONAL) ID=$id DATA=$value" other switch -- $id { 1 { set MV($who.personal.name) $value set MV($who.personal.text) "" } 2 {set MV($who.personal.email) $value} 3 {set MV($who.personal.webpage) $value} 4 {set MV($who.personal.sex) $value} 5 {set MV($who.personal.image) $value} 6 {set MV($who.personal.time) [join [split $value "\""]]} 7 {set MV($who.personal.date) [join [split $value "\""]]} default { if {$id >= 999} { BuildPersonalInfo $who } else { append MV($who.personal.text) "\n$value" } } } }