# gn.tcl --
#
# A collection of procs that carry out the elementary actions of a user
# operating mouse when navigating a GUI.
#
# "gn" stands for "gui navigation"
#
# Copyright 2020 Erik Leunissen
#
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
# 
# 	http://www.apache.org/licenses/LICENSE-2.0
# 
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
#
namespace eval ::gn {}

proc ::gn::init {} {
	package present Tk
	namespace export mouse_button mouse_is_over mouse_move
	
	package provide gn 0.81
}


# mouse_button --
#
# Performs a mouse button action
#
# Arguments
#
#	button : the mouse button nr. or the corresponding string left, middle, right
#	action : press, release, click or double-click
#	w      : the window to deliver the event to. If not supplied, then
#            the window currently containing the mouse pointer is used.
#
# Return value : a boolean 0 or 1
#
# Note: this has been targeted at my own mouse [EL]. It is most probably not
#       valid for all mice; not generic.
#
proc ::gn::mouse_button {button action {w ""}} {
	if {$w eq ""} {
		set w [winfo containing [winfo pointerx .] [winfo pointery .]]
		if {$w eq ""} {
			return -code error "the mouse pointer is outside the active area of the GUI"
		}
	} else {
		if {! [winfo exists $w]} {
			return -code error "window $w doesn't exist"
		}
		if {! [winfo ismapped $w]} {
			return -code error "window $w is not mapped onto the screen"
		}
		if {! [mouse_is_over $w]} {
			return -code error "the mouse pointer is outside window $w"
		}
	}
	switch -- $button {
		1 -
		"left" {
			set button_nr 1
		}
		2 -
		"middle" {
			set button_nr 2
		}
		3 -
		"right" {
			set button_nr 3
		}
		default {
			return -code error "invalid mouse button \"$button\""
		}
	}
	switch -- $action {
		"press" {
			event generate $w <ButtonPress> -button $button_nr
		}
		"release" {
			event generate $w <ButtonRelease> -button $button_nr
		}
		"click" {
			event generate $w <ButtonPress> -button $button_nr
			twait 10
			event generate $w <ButtonRelease> -button $button_nr
		}
		"doubleclick" {
			#
			# Note: the Double modifier as in <Double-1> is not
			#       allowed with [event generate]
			#
			event generate $w <ButtonPress> -button $button_nr
			twait 10
			event generate $w <ButtonRelease> -button $button_nr
			twait 20
			event generate $w <ButtonPress> -button $button_nr
			twait 10
			event generate $w <ButtonRelease> -button $button_nr
		}
		default {
			return -code error "invalid mouse action \"$action\""
		}
	}
}


# mouse_is_over --
#
# Determines whether the mouse pointer is over a specific window
#
# Arguments
#
#	w : the window
#
# Return value : a boolean 0 or 1
#
proc ::gn::mouse_is_over {w} {
	expr {[winfo containing [winfo pointerx .] [winfo pointery .]] eq $w}
}


# mouse_move --
#
#	Move the mouse pointerrelative to a window.
#
# Arguments:
#
#	w        : window that serves as a geometric reference
#	position : the side or corner that serves as the geometric reference
#	side     : in or out
#
# Returns: nothing
#
proc ::gn::mouse_move {w position {side "in"}} {
	if {($side ne "in") && ($side ne "out")} {
		return -code error "invalid side \"$side\""
	}
	switch -- $position {
		"c" {
			set x [expr {[winfo width $w]/2}]
			set y [expr {[winfo height $w]/2}]
		}
		"nw" {
			set x [expr {$side eq "in"?0:-1}]
			set y [expr {$side eq "in"?0:-1}]
		}
		"n" {
			set x [expr {[winfo width $w]/2}]
			set y [expr {$side eq "in"?0:-1}]
		}
		"ne" {
			set x [expr {[winfo width $w]-1}]
			set y 0
			if {$side eq "out"} {
				incr x
				set y -1
			}
		}
		"e" {
			set x [expr {[winfo width $w]-1}]
			set y [expr {[winfo height $w]/2}]
			if {$side eq "out"} {
				incr x
			}
		}
		"se" {
			set x [expr {[winfo width $w]-1}]
			set y [expr {[winfo height $w]-1}]
			if {$side eq "out"} {
				incr x
				incr y
			}
		}
		"s" {
			set x [expr {[winfo width $w]/2}]
			set y [expr {[winfo height $w]-1}]
			if {$side eq "out"} {
				incr y
			}
		}
		"sw" {
			set x 0
			set y [expr {[winfo height $w]-1}]
			if {$side eq "out"} {
				set x -1
				incr y
			}
		}
		"w" {
			set x [expr {$side eq "in"?0:-1}]
			set y [expr {[winfo height $w]/2}]
		}
		default {
			return -code error "invalid position \"position\""
		}
	}
	event generate $w <Motion> -warp 1 -x $x -y $y -when now
	update idletasks
}


# twait --
#
#	Wait for a specified duration while allowing events to be processed.
#	It is used by gn to let events be delivered to a window before
#	generating an other event.
#
# Arguments:
#
#	duration: the amount of time to wait for.
#
# Returns: nothing
#
proc ::gn::twait {duration} {
	set ::gn::_twait 1; after $duration {unset ::gn::_twait}
	vwait ::gn::_twait
}


::gn::init
