# widget.tcl --
#
#	Object wrapper for "widget"-command created Widget's.
#

namespace eval NSWidget {

# NSWidget::NSWidget --
#
#	Object constructor called by NSObject::New().
#
# Arguments:
#	arg1					about arg1
#
# Results:
#	What happened.

proc NSWidget {oop parent width height gwidth gheight} {

	set widget $parent.widget$oop

	widget $widget -width $width -height $height \
		-gwidth $gwidth -gheight $gheight

	bind $widget <Enter> "NSWidget::Motion $oop %x %y"
	bind $widget <Motion> "NSWidget::Motion $oop %x %y"
	bind $widget <Leave> "NSWidget::Info $oop examined {}"

	Info $oop widget $widget
	Info $oop width [expr $width * $gwidth]
	Info $oop height [expr $height * $gheight]
	Info $oop examined ""
	Info $oop examineCmd ""
	Info $oop scaleCmd ""

	#
	# Context Menu
	#
	
	if {$gwidth != [icon size]} {
		set menu $widget.context
		menu $menu -tearoff 0
		for {set n 4} {$n <= 8} {incr n} {
			$menu add radiobutton -label "${n}x$n" \
				-variable NSWidget($oop,scale) -value $n \
				-command "NSWidget::SetScale $oop $n"
		}
		bind $widget <ButtonPress-3> "tk_popup $menu %X %Y"

		Info $oop scale $gwidth
	}

}

# NSWidget::Info --
#
#	Query and modify info.
#
# Arguments:
#	arg1					about arg1
#
# Results:
#	What happened.

proc Info {oop info args} {

	global NSWidget

	# Set info
	if {[llength $args]} {
		switch -- $info {
			default {
				set NSWidget($oop,$info) [lindex $args 0]
			}
		}

	# Get info
	} else {
		switch -- $info {
			default {
				return $NSWidget($oop,$info)
			}
		}
	}
}

# NSWidget::Motion --
#
#	Call the client's command when the mouse moves over a grid.
#
# Arguments:
#	oop					OOP ID.
#	x					x location in widget.
#	y					y location in widget.
#
# Results:
#	What happened.

proc Motion {oop x y} {

	set pos [PointToCave $oop $x $y]
	if {[Info $oop examined] == $pos} return
	Info $oop examined $pos

	set command [Info $oop examineCmd]
	if {[string length $command]} {
		uplevel #0 eval $command $oop $pos
	}
}

# NSWidget::PointToCave --
#
#	Determine the cave y,x location based on the given
#	coordinates inside the given widget.
#
# Arguments:
#	oop					OOP ID.
#	x					x coordinate in Widget.
#	y					y coordinate in Widget.
#
# Results:
#	Return "y x".

proc PointToCave {oop x y} {

	set widget [Info $oop widget]

	set gwidth [$widget cget -gwidth]
	set gheight [$widget cget -gheight]

	scan [$widget center] "%d %d" centery centerx

	set col [expr $x / $gwidth]
	set row [expr $y / $gheight]

	set left [expr [$widget cget -width] / 2]
	set top [expr [$widget cget -height] / 2]

	set x1 [expr $col + ($centerx - $left)]
	set y1 [expr $row + ($centery - $top)]

	return "$y1 $x1"
}

# NSWidget::SetScale --
#
#	Sets the resolution of the Widget, but doesn't let the Widget
#	get any larger than its original dimensions.
#
# Arguments:
#	arg1					about arg1
#
# Results:
#	What happened.

proc SetScale {oop scale} {

	global PYPX

	set widget [Info $oop widget]

	if {[string first $scale "45678"] == -1} return
	if {$scale == [$widget cget -gwidth]} return

	set width [expr [Info $oop width] / $scale]
	set height [expr [Info $oop height] / $scale]

	$widget configure -width $width -height $height \
		-gwidth $scale -gheight $scale

	# Hack -- Fully update the widget
	$widget wipe
	eval $widget center [$widget center]

	set command [Info $oop scaleCmd]
	if {[string length $command]} {
		uplevel #0 eval $command
	}
}

# NSWidget::IncrScale --
#
#	Increments the scale of the Widget, wrapping if needed.
#
# Arguments:
#	arg1					about arg1
#
# Results:
#	What happened.

proc IncrScale {oop value} {

	set widget [Info $oop widget]

	set scale [$widget cget -gwidth]
	incr scale $value
	if {$scale > 8} {
		set scale 4
	} elseif {$scale < 4} {
		set scale 8
	}
	SetScale $oop $scale
}

# NSWidget::Resize --
#
#	Change the size of the widget.
#
# Arguments:
#	arg1					about arg1
#
# Results:
#	What happened.

proc Resize {oop width height} {

	set widget [Info $oop widget]

	if {$width == [$widget cget -width] && $height == [$widget cget -height]} {
		return 0
	}
	$widget configure -width $width -height $height
	Info $oop width [expr $width * [$widget cget -gwidth]]
	Info $oop height [expr $height * [$widget cget -gheight]]

	# Hack -- Fully update the widget
	$widget wipe
	eval $widget center [$widget center]

dbwin "$widget cols=$width rows=$height\n"

	return 1
}

# namespace eval NSWidget
}

# WidgetCenter --
#
#	When the character goes to a new level (or WOR back to a level) this
#	routine sets the center of the given widget. When scroll_follow is
#	FALSE and the dungeon is smaller horizontally than the widget is
#	wide, the dungeon is displayed centered within the widget.
#	Otherwise the widget is centered on the character position.
#
# Arguments:
#	_coord					Name of variable holding 
#	center					Current widget center.
#	units					Cave height or width.
#	units2					Widget height or width.
#
# Results:
#	What happened.

proc WidgetCenter widget {

	scan [angband player position] "%d %d" y x

	if {![Value scroll_follow]} {
		set units [angband cave height]
		set units2 [$widget cget -height]
		if {$units <= $units2} {
			set y [expr ($units - $units2) / 2 + $units2 / 2]
		}
	
		set units [angband cave width]
		set units2 [$widget cget -width]
		if {$units <= $units2} {
			set x [expr ($units - $units2) / 2 + $units2 / 2]
		}
	}

	$widget center $y $x
}

# ClipCenter --
#
#	Helper command used control scrolling of a widget when updating the
#	character's position.
#
# Arguments:
#	_coord					Name of variable holding 
#	center					Current widget center.
#	units					Cave height or width.
#	units2					Widget height or width.
#
# Results:
#	What happened.

proc ClipCenter {_coord center units units2} {

	upvar $_coord coord

	set min [expr $center - $units2 / 2]
	set max [expr $min + $units2 - 1]
	set bord [expr $units2 / 8]
	set pad [expr $units2 / 4]
	if {$coord < $min + $bord} {
		set coord [expr ($coord + $pad) - $units2 / 2]
		if {$units2 % 2 == 0} {incr coord}
		set scroll 1
	} elseif {$coord > $max - $bord} {
		set coord [expr ($coord - $pad) + $units2 / 2]
		set scroll 1
	} else {
		set coord $center
		set scroll 0
	}

	if $scroll {
		if {$units > $units2} {
			set centerMin [expr $units2 / 2 - 1]
			set centerMax [expr $units - $units2 / 2 + 1]
			if {$units2 & 1} {incr centerMax -1}
			if {$coord < $centerMin} {
				set coord $centerMin
			} elseif {$coord > $centerMax} {
				set coord $centerMax
			} elseif {$coord == $centerMin + 1} {
				set coord $centerMin
			} elseif {$coord == $centerMax - 1} {
				set coord $centerMax
			}
		} else {
			set coord [expr ($units - $units2) / 2 + $units2 / 2]
		}
	}

	return $scroll
}

# ConstrainCenter --
#
#	Call this when you want to set the x/y center of a widget but do
#	not want the widget to scroll "too far". This calculation adds a
#	1-pixel border around the edge of the cave.
#
# Arguments:
#	arg1					about arg1
#
# Results:
#	What happened.

proc ConstrainCenter {coord units units2} {

	if {$units > $units2} {
		set centerMin [expr $units2 / 2 - 1]
		set centerMax [expr $units - $units2 / 2 + 1]
		if {$units2 & 1} {incr centerMax -1}
		if {$coord < $centerMin} {
			set coord $centerMin
		} elseif {$coord > $centerMax} {
			set coord $centerMax
		}
	} else {
		set coord [expr ($units - $units2) / 2 + $units2 / 2]
	}

	return $coord
}
