#
# Copyright (c) 1993 Eric Schenk.
# All rights reserved.
#
# Permission is hereby granted, without written agreement and without
# license or royalty fees, to use, copy, modify, and distribute this
# software and its documentation for any purpose, provided that the
# above copyright notice and the following two paragraphs appear in
# all copies of this software.
# 
# IN NO EVENT SHALL ERIC SCHENK BE LIABLE TO ANY PARTY FOR
# DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT
# OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF ERIC
# SCHENK HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
#
# ERIC SCHENK SPECIFICALLY DISCLAIMS ANY WARRANTIES,
# INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
# AND FITNESS FOR A PARTICULAR PURPOSE.  THE SOFTWARE PROVIDED HEREUNDER IS
# ON AN "AS IS" BASIS, AND ERIC SCHENK HAS NO OBLIGATION TO
# PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.

# code to drag about a top level window

# variables used:
#	tkwm_priv(xoff): offset from the left side to the mouse pointer
#	tkwm_priv(yoff): offset from the top to the mouse pointer
#	tkwm_priv(width):
#	tkwm_priv(height):
#	tkwm_priv(position): final requested position for the window
#	tkwm_priv(opaque): true if this operation should be opaque
#	tkwm_priv(constrained): true if this window should be constrained
#	tkwm_priv(xmax): max allowable x value if constrained
#	tkwm_priv(ymax): max allowable y value if constrained

# Interactivly move a top level window.
# Arguments:
#	w	- the window to move
#	event	- the event that should terminate the move
#	x	- the initial x position of the pointer
#	y	- the initial y position of the pointer


proc move {w event} {
    exclusive-dispatch [list real-move $w $event]
}

proc real-move {w event} {
    global tkwm_priv

    scan [tkwm pointer] "%d %d" x y

    # this is a fixed width label to avoid interfering with the resize
    # border crossing the label. If the label changes size when the border
    # crosses it it leaves inverted bits behind on any window that overlaps
    # the label.
    label .notifier -text "" -width 12 -height 1 \
	-relief raised -border 2 -cursor top_left_corner
    place .notifier -x 0 -y -100

    unwindProtect {
	if {![guarded_raise $w $event]} {
	    bind .notifier $event [list tkwm_end_move $w $event %X %Y]
	    bind .notifier <Any-Motion> [list tkwm_drag_move $w %X %Y]

	    set tkwm_priv(opaque) [get_resource_value $w opaqueMove OpaqueMove]
	    
	    if !$tkwm_priv(opaque) {tkwm grabserver}
	    grab -global .notifier
	    install_root_colormap
	    unwindProtect {
		set tkwm_priv(xoff) [expr $x-[winfo x $w]]
		set tkwm_priv(yoff) [expr $y-[winfo y $w]]
		set tkwm_priv(width) [winfo width $w]
		set tkwm_priv(height) [winfo height $w]
		set tkwm_priv(constrained) [get_resource_value \
			$w constrained Constrained]
		set tkwm_priv(xmax) \
			[expr [winfo screenwidth $w]-[winfo width $w]]
		set tkwm_priv(ymax) \
			[expr [winfo screenheight $w]-[winfo height $w]]
		set x [winfo x $w]
		set y [winfo y $w]
		if !$tkwm_priv(opaque) {
		    tkwm outline $x $y [winfo width $w] [winfo height $w]
		}
		.notifier config -text "($x,$y)"
		place .notifier -x 0 -y 0
		tkwait variable tkwm_priv(position)
		catch {
		    # in case the window was destroyed
		    # VIRTUAL PSEUDOROOT: This command would have to deal with
		    # drags over the pseudo-root, in which case $w may not be
		    # toplevel.
		    wm geometry $w $tkwm_priv(position)
		    # in case the window is not a client frame
		    $w.plug sendconfig
		}
		update idletasks
	    } {
		catch {uninstall_root_colormap}
		catch {grab release .notifier}
		if !$tkwm_priv(opaque) {tkwm ungrabserver}
	    }
	}
    } {
    	destroy .notifier
    }
}

proc tkwm_drag_move {w x y} {
    global tkwm_priv

    set x [expr $x-$tkwm_priv(xoff)]
    set y [expr $y-$tkwm_priv(yoff)]
    if $tkwm_priv(constrained) {
        if {"$x"<"0"} {set x 0}
        if {"$y"<"0"} {set y 0}
        if {"$x">"$tkwm_priv(xmax)"} {set x $tkwm_priv(xmax)}
        if {"$y">"$tkwm_priv(ymax)"} {set y $tkwm_priv(ymax)}
    }
    if $tkwm_priv(opaque) {
	wm geometry $w +$x+$y
    } else {
        tkwm outline $x $y $tkwm_priv(width) $tkwm_priv(height)
    }
    .notifier config -text "($x,$y)"
    update idletasks
}

proc tkwm_end_move {w event x y} {
    global tkwm_priv

    unwindProtect {
	bind all $event {}
	bind all <Any-Motion> {}
	tkwm outline 0 0 0 0
	set x [expr $x-$tkwm_priv(xoff)]
	set y [expr $y-$tkwm_priv(yoff)]
	if $tkwm_priv(constrained) {
	    if {"$x"<"0"} {set x 0}
	    if {"$y"<"0"} {set y 0}
	    if {"$x">"$tkwm_priv(xmax)"} {set x $tkwm_priv(xmax)}
	    if {"$y">"$tkwm_priv(ymax)"} {set y $tkwm_priv(ymax)}
	}
    } {
	set tkwm_priv(position) "+$x+$y"
    }
}