# package Mark
#	(c) 1997 Michel Beaudouin-Lafon, mbl@lri.fr
#
# This package defines a state machine to recognize mark-based interaction on a canvas.
# The following actions are recognized:
#	taps (button-down)
#	single and double-clicks
#	presses (button-down for more than 1/2 a second)
#	marks
#
# When the state machine Mark is bound to a canvas, the following command is called
# when an action is recognized :
#	AppProcessPosEvent type x y
#		type is one of tap, click, dblcklick, press, endpress
#		x and y are the coordinate of the action
#	AppProcessMarkEvent type trace
#		type is always mark
#		trace is a list {x0 y0 x1 y1 ... xn yn} describing the mark
# These functions must be defined by the calling module.
# (we might decide to use virtual events instead in the future...)
#
# Primitive mark analysis functions are provided:
#	Mark::IsStraight trace
#		test if trace is a straight line
#	Mark::IsFlick trace
#		returns N, S, E, W, NE, NW, SE, SW if the trace is a flick
#		returns line if it's a straight line
#		returns mark otherwise

package provide Mark 1.0

package require StateMachine 1.1

StateMachine::define Mark {
	# state
	local P1 P2
	local mark
	
	# preferences
	local prefs
	
	# wait for a button down to initiate a gesture
	state Start {
		when Down at P1 do {
			eval AppProcessPosEvent %W tap $P1
		} -> Hysteresis
	}
	
	# wait until something significant happens:
	#	- move enough to start a mark
	#	- button up for a click
	#	- timeout for a press
	state Hysteresis {
		enter {
			arm $prefs(pressTime)
		}
		when Move at P2 and {[eval Distance $P1 $P2] > $prefs(minMove)} do {
			eval %W create line $P1 $P2 -tags ink $prefs(inkAttr)
			update idletasks
			set mark {}
			eval lappend mark $P1 $P2
			set P1 $P2
		} -> Ink
		when Up at P1 -> MultiClick
		when TimeOut do {
			eval AppProcessPosEvent %W press $P1
		} -> Press
	}
	
	# wait until the end of the press
	state Press {
		# ### should probably have a when Move to start gesture after press
		
		when Up at P2 do {
			eval AppProcessPosEvent %W endpress $P2
		} -> Start
	}
	
	# wait after a single click to detect a double click 
	state MultiClick {
		enter {
			arm $prefs(dbleTime)
		}
		when Motion at P2 and {[eval Distance $P1 $P2] > $prefs(minMove)}  do {
			eval AppProcessPosEvent %W click $P1
			set P1 $P2
		} -> Start
		when TimeOut do {
			eval AppProcessPosEvent %W click $P1
		} -> Start
		when Down do {
			eval AppProcessPosEvent %W dblclick $P1
		} -> Start
	}
	
	# track the mouse and leave an ink trail
	state Ink {
		when Move at P2 do {
			eval %W create line $P1 $P2 -tags ink $prefs(inkAttr)
			update idletasks
			eval lappend mark $P2
			set P1 $P2
		}
		when Up do {
			%W delete ink
			AppProcessMarkEvent %W mark $mark
		} -> Start
	}
	
	# compute the Manhattan distance (for speed) between two points
	lproc Distance {x1 y1 x2 y2} {
		return [expr abs($x2 - $x1) + abs($y2 - $y1)]
	}

}

# --- Marks::prefs
#	default values for the preferences (can be changed at any time)
# 		minMove	minimal mouse motion to trigger a drag
#		inkAttr	line attributes for the ink trail
#		pressTime	minimum time from button Down to detect a press
#		dblTime	maximum time between up and down to detect a dble click
#
array set Mark::prefs {
	minMove 5
	inkAttr "-fill red"
	pressTime 500
	dbleTime 250
}
	
# --- Mark::IsStraight line
#	Returns 1 if the series of points can be considered a straight segment
#	line is of the form {x1 y1 x2 y2 ... xn yn}
#
#	We test whether all the intermediate points are close enough to the line
#	define by (x0, y0)-(xn, yn). Short lines are rejected.
#
#	the tolerance is set to 3 pixels
#	the minimum length of a line is set to 15 pixels
#
proc Mark::IsStraight {line} {
	set l [llength $line]
	if {$l % 2 != 0} {
		# we need an even number of coordinates
		return -1
	}
	
	# get endpoints
	set x0 [lindex $line 0]
	set y0 [lindex $line 1]
	set xn [lindex $line [expr $l -2]]
	set yn [lindex $line [expr $l -1]]
	
	# compute unit normal vector nx ny
	set dx [expr $xn - $x0]
	set dy [expr $yn - $y0]
	set norm [expr sqrt ($dx*$dx + $dy*$dy)]
	set nx [expr $dy / $norm]
	set ny [expr - $dx / $norm]
	
	# reject if too short
	if {$norm < 15} {
		return 0
	}
	
	# for each point, make sure it's close enough to the line
	foreach {x y} $line {
		set d [expr ($x - $x0)*$nx + ($y - $y0)*$ny]
		if {abs($d) > 3} {
			return 0
		}
	}
	return 1
}

# --- Mark::IsFlick line
#	If the direction is recognized as a flick, return it's direction
#	(N, S, E, W, NE, NW, SE, SW) otherwise return "line"
#	if it's a line or mark otherwise
#
#	the tolerance on the direction is set to 0.98,
#	i.e. the cosine of the angle between the ideal and actual directions
#	must be greater than 0.98
#	(this corresponds to a tolerance of approximately +/-10 degrees)
#
proc Mark::IsFlick {line} {
	# make sure it's a straight line
	if {! [IsStraight $line]} {
		return "mark"
	}
	
	# get endpoints and compute length
	### it's too bad MarkIsStraight has already done that...
	set l [llength $line]
	set x0 [lindex $line 0]
	set y0 [lindex $line 1]
	set xn [lindex $line [expr $l -2]]
	set yn [lindex $line [expr $l -1]]
	set dx [expr $xn - $x0]
	set dy [expr $yn - $y0]
	set norm [expr sqrt ($dx*$dx + $dy*$dy)]
	set vx [expr $dx / $norm]
	set vy [expr $dy / $norm]
	
	# find out which direction is closer
	set s2 [expr sqrt(2.0)/2.0]
	set s2n [expr -$s2]
	foreach {ux uy} {
		1.0 0.0
		$s2 $s2n
		0.0 -1.0
		$s2n $s2n
		-1.0 0.0
		$s2n $s2
		0.0 1.0
		$s2 $s2
	} dir {E NE N NW W SW S SE} {
		# ux uy is the direction and dir its name
		# We compute the dot product of u=(ux, uy) with v=(vx, vy)
		# Since u.v = ||u||.||v|| cos(a) where a is the angle uv and u and v
		# are unit vectors we can compute cos(a) and select the direction
		# if it is close enough to 1.
		set cosa [expr $ux*$vx + $uy*$vy]
		if {$cosa > 0.98} {
			return $dir
		}
	}
	
	return "line"
}