# Query Users OpenVerse Plugin 
#
# Copyright (C) 1999 David Gale <cruise@openverse.org>
# 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.
# -----------------------------------------------------------------------
# This plugin will allow users to click on the names of other users
# and have them in "Query" mode. It makes use of several available traps
# within Metaverse.
#
# Written by Cruise <cruise@drunkenbastards.org>
#
# This was to be included as a feature but I decided to make it a seperate
# plugin to being working on plugins in general. This can be used as an 
# example of how to make a plugin, there will be others as I make more
# plugin support available.
#
# SEE THE Plugins.tcl FILE FOR MORE INFORMATION ON CREATING PLUGINS!
#
# It is a good idea to put all of your variables into one container.
# This will ensure that "your" variables do not conflict with variables
# from another plugin. You should have one global variable which is an 
# array of all the variables which your plugin will need. You should name
# this variable the same as your directory name.

global Query

set Query(users) {}
set Query(OnOff) 0

#
# You must register your plugin with all the traps you intend to use.
# The arguments for the register command are....
#
# The name of your plugin's Directory (Case Counts)
# Trap Name (see lib/Global.tcl for a list)
# Your function to call when this trap is executed.
#
# NOTE!! Your function must return 1 or 0 indicating to the parent
# function that it should continue(1) processing normally or that it
# should stop(0) normal processing.
#
RegisterPlugin Query MoveTo.Pre Query_CheckClick
RegisterPlugin Query NewPerson Query_NewPerson
RegisterPlugin Query PersonLeft Query_PersonLeft
RegisterPlugin Query ChangeAvatar Query_ChangeAvatar
RegisterPlugin Query ChangeUserAvatar Query_ChangeUserAvatar
RegisterPlugin Query SendText Query_SendText
RegisterPlugin Query Disconnect Query_Disconnect
RegisterPlugin Query DoNames Query_DoNames
RegisterPlugin Query ShowName Query_ShowName
RegisterPlugin Qyery Debug_memory Query_Debug_memory

proc Query_NewPerson {who x y image xx yy size bx by} {
	global Query
	set Query($who) 0
	return 1
}

proc Query_PersonLeft {who} {
	global Query MV

	set Query($who) 0
	set idx [lsearch -exact $Query(users) $who]
	set Query(users) [lreplace $Query(users) $idx $idx]
	if ![llength $Query(users)] {
		if $MV(names) {.top.c itemconfigure $MV($MV(nick).nameplate) -fill "black"}
		set Query(OnOff) 0
	}
	#
	# Clean up the memory this user was using.
	#
	catch {unset Query($who)}

	return 1
}

proc Query_CheckClick {x y} {
	global Query MV

	#
	# If we are not displaying names, Don't bother checking.
	# This plugin requires names be displayed.
	# They can be shut off after you select a user for query.
	#
	if !$MV(names) {return 1}

	#
	# Check and see if the user is within the space of a name
	# tag on the screen. If they are, don't move.. query the
	# user and color their nametag blue (and your's!)
	# No, You cannot query yourself.
	# Clicking yourself will cancel all queries. (KaosBeetl 11/27/2000)
	#
	if {$x >= $MV($MV(nick).name_tl_x) &&
	        $x <= $MV($MV(nick).name_br_x) &&
	        $y >= $MV($MV(nick).name_tl_y) &&
  	        $y <= $MV($MV(nick).name_br_y)} {
		    if {$Query(OnOff) == 0} {
			return 0
		    }

		    while {[llength $Query(users)]} {
			set who [lindex $Query(users) 0]
			if $MV(names) {.top.c itemconfigure $MV($who.nameplate) -fill "black"}
			set Query($who) 0
			set Query(users) [lreplace $Query(users) 0 0]
		    }

		    if $MV(names) {.top.c itemconfigure $MV($MV(nick).nameplate) -fill "black"}
		    set Query(OnOff) 0
		    
		    DoNames
		    return 0
	}

	foreach who $MV(people) {
		if {$x >= $MV($who.name_tl_x) &&
			$x <= $MV($who.name_br_x) &&
			$y >= $MV($who.name_tl_y) &&
			$y <= $MV($who.name_br_y)} {
			if $Query($who) {
				if $MV(names) {.top.c itemconfigure $MV($who.nameplate) -fill "black"}
				set Query($who) 0
				set idx [lsearch -exact $Query(users) $who]
				set Query(users) [lreplace $Query(users) $idx $idx]
				if ![llength $Query(users)] {
					if $MV(names) {.top.c itemconfigure $MV($MV(nick).nameplate) -fill "black"}
					set Query(OnOff) 0
				}
			} else {
				if $MV(names) {.top.c itemconfigure $MV($who.nameplate) -fill "blue"}
				if $MV(names) {.top.c itemconfigure $MV($MV(nick).nameplate) -fill "blue"}
				lappend Query(users) "$who"
				set Query($who) 1
				if !$Query(OnOff) {
					set Query(OnOff) 1
				}
			}
			DoNames
			return 0
		}
	}
	return 1
}

proc Query_ChangeAvatar {notused} {
	global Query MV

	if $Query(OnOff) {
		if $MV(names) {.top.c itemconfigure $MV($MV(nick).nameplate) -fill "blue"}
	}
	return 1
}

proc Query_ChangeUserAvatar {who what x y size bx by} {
	global Query MV

	if $Query($who) {
		if $MV(names) {.top.c itemconfigure $MV($who.nameplate) -fill "blue"}
	}
	return 1
}

proc Query_ColorLocal {x y} {
	global Query MV

	if $Query(OnOff) {
		if $MV(names) {.top.c itemconfigure $MV($MV(nick).nameplate) -fill "blue"}
	}
	return 1
}

proc Query_ColorRemote {who x y speed} {
	global Query MV

	if $Query($who) {
		if $MV(names) {.top.c itemconfigure $MV($who.nameplate) -fill "blue"}
	}
	return 1
}

proc Query_ShowName {who} {
	global Query MV
	
	if {![string compare $MV(nick) $who]} {
		Query_ColorLocal -1 -1
	} else {
		Query_ColorRemote $who -1 -1 -1
	}

	return 1
}

#
# Bug FIX - CRUISE - 11/02/2001 - Will now put <!> around YOUR name when sending private messages.
#
proc Query_SendText {stuff} {
	global Query MV

	if !$Query(OnOff) {return 1}
	if {[string range $stuff 0 0] == "/"} {return 1}

	ProcChat $MV(nick) "$stuff" 0 2 $MV(colors.privmsg.baloon)
	foreach who $Query(users) {
		if $MV(rot13) {set stuff [Rot13 $stuff]}
		SendToServer "PRIVMSG $who $stuff"
	}
	return 0
}

proc Query_Disconnect {} {
	global Query MV

	set Query(users) {}
	set Query(OnOff) 0
	if $MV(names) {.top.c itemconfigure $MV($MV(nick).nameplate) -fill "black"}
	return 1
}

proc Query_DoNames {win who idx} {
	global Query

	if $Query($who) {
		$win add command -label "UnQuery" -command "Query_ByNumber $idx"
	} else {
		$win add command -label "Query" -command "Query_ByNumber $idx"
	}
	return 1
}

proc Query_ByNumber {idx} {
	global Query MV

	if !$Query($MV(whois.$idx)) {
		if $MV(names) {
			.top.c itemconfigure $MV($MV(whois.$idx).nameplate) -fill "blue"
			if !$Query(OnOff) {
				.top.c itemconfigure $MV($MV(nick).nameplate) -fill "blue"
			}	
		}
		lappend Query(users) "$MV(whois.$idx)"
		set Query($MV(whois.$idx)) 1
		set Query(OnOff) 1
	} else {
		if $MV(names) {.top.c itemconfigure $MV($MV(whois.$idx).nameplate) -fill "black"}
		set Query($MV(whois.$idx)) 0
		set id [lsearch -exact $Query(users) $MV(whois.$idx)]
		set Query(users) [lreplace $Query(users) $id $id]
		if ![llength $Query(users)] {
			if $MV(names) {.top.c itemconfigure $MV($MV(nick).nameplate) -fill "black"}
			set Query(OnOff) 0
		}
	}
	DoNames
	return 1
}

proc Query_Debug_memory {outfile} {
	global Query


	set arrays [list Query]
	#
	# debug all the arrays.
	#
	foreach ar $arrays {
		puts $outfile "------------------------------------------------------------------------------"
		puts $outfile " Query - THIS IS THE $ar\() ARRAY"
		puts $outfile "------------------------------------------------------------------------------"
		set toggle 0
		set values {}
		set keys {}
		foreach var [array get $ar] {
			if {!$toggle} {
				lappend keys $var
				set toggle 1
			} else {
				set toggle 0
			}
		}
		set keys [lsort $keys]
		foreach key $keys {
			puts $outfile [format "%-39.39s %-39.39s" $key [set $ar\($key)]]
		}
	}
	return 1
}

if $MV(debug) {puts "Query Plugin Initalized!"}

