#
# QCad
# (c) Q Solutions 1998
#
#
#
# event Processing routines
#

proc eventBind { name } {
	upvar #0 $name data
	global GBL	
	set wtype [winType $data(Type)]	
	
	foreach event [array names data event,*] {
		unset data($event)
	}
	foreach {app mode item event func} $GBL(Bindings) {
		if { ($app != "*") && ([string first $wtype $app] == -1) } { continue }
		#if { $mode == "-" } { set mode "" }
		#if { $item == "-" } {set item "" }
		set data(event,$mode,$item,$event) $func
		#Log "bindline: $app, $mode,$item,$event,$func"
		#Log "bind: event,$mode,$item,$event --> $func"
	}
#
#
# Global Key Bindings
#
# While Tk supprts bindings to canvas items, I do not want to get into
# managing bindings for all objects on the canvas.
# If the bindings remain static for the life of the object and are the same
# regardless of window type it may be a better alternative.
# At the present during development, it is better to be able to work with
# bindings in an object independant way until the processing has been
# structured appropriately.
# Once the development is stable , this issue will be revisited.
###
### STILL HAVE DOUBTS ABOUT THE VIRTUALIZATION OF THE EVENT
### MECHANISM
### ONLY TIME WILL TELL IF IT CAN PROVIDE A TRUE VIRTUAL CONTEXT
### SENSITIVE BINDING ENVIRONMENT
### ONLY VIRTUAL EVENTS BOUND TO KEYS/BUTTONS NEED TO BE BOUND TO THE CANVAS
### OTHER EVENTS GENERATED INTERNALLY VIA RECUSIVE CALL TO doEvent
### (BOUND HERE FOR CLARITY, WILL NEVER BE GENERATED BY TK UNTIL KEY BOUND TO EVENT)
### SEE BINDINGS FOR CLARITY
### Note, Binding to Key/KeyRelease and Holding Shift/Alt state etc does not
### work when Modifier+Key causes new window to appear as the window loses focus
### and misses the key-release event as it occurs in the other window.
### This makes it necessary to bind to all modifiers as well as Key Event.
### Alternative is to store Modifiers until next 'key' is returned and remove
### stored modifiers after processing key.
###
	set c $data(Canvas)
	bind $c <Key> 		 "genEvent $name Key %K %A %x %y %W; break"
	bind $c <Shift-Key> 	 "genEvent $name Key %K %A %x %y %W; break"
	bind $c <Alt-Key> 		 "genEvent $name Alt-Key %K %A %x %y %W; break"
	bind $c <Control-Key> 		 "genEvent $name Control-Key %K %A %x %y %W; break"
	bind $c <Alt-Control-Key> 		 "genEvent $name Alt-Control-Key %K %A %x %y %W; break"
#	bind $c <KeyRelease> 		"genEvent $name KeyRelease %K %A %x %y %W; break"
	foreach se {Up Down Left Right Home End Prior Next Ins Del} {
		bind $c Shift-Key-$se "genEvent $name Shift-Key %K %A %x %y %W; break"
	}
	foreach ve {SELECT END SHIFT-MOTION MOTION CANCEL EXTEND ADJUST HELP} {
		bind $c <<$ve>> "genEvent $name <$ve> %K %A %x %y %W;break"
	}

	foreach se {Up Down Left Right Home End Prior Next} {
		bind $c <Shift-Key-$se> "genEvent $name Shift-Key %K %A %x %y %W; break"
	}
}

proc genEvent { name event K A x y w } {
	upvar #0 $name data

	if { [regexp {_[LR]$} $K] } { return }
	if { $K == "??" } { set K "" }
	if { $A == "??" } { set A "" }
	set c $data(Canvas)
	if { 1 } {
		set x [expr [winfo pointerx $c] - [winfo rootx $c]]
		set y [expr [winfo pointery $c] - [winfo rooty $c]]
	}
	set	g  $data(Grid,Step)
	set rx [$c canvasx $x $g]
	set ry [$c canvasy $y $g]
	set cx [$c canvasx $x]
	set cy [$c canvasy $y]
	set data(rx) $rx
	set data(ry) $ry
	set data(cx) $cx
	set data(cy) $cy
	set data(wx) $x
	set data(wy) $y
	set data(ux) [expr $rx / $data(RelScale)]
	set data(uy) [expr $ry / $data(RelScale)]
	set step $data(Grid,Step)
	set data(event) $event
	set data(eventkey) $K
	set data(eventascii) $A
	set data(dx) [expr $data(rx) - $data(x)] 
	set data(dy) [expr $data(ry) - $data(y)]
	set data(x) $rx
	set data(y) $ry

	if { $data(show,Cursor) } {
		canvasMoveCursor $c $x $y
	}
	doEvent $name $event
}


proc doEvent { name event} {

	upvar #0 $name data
	
	set mode [lindex $data(Mode) end]
	set K $data(eventkey)
	set A $data(eventascii)

	if { $K != "" } { set A $K }	
	
#	set data(dxT) [expr $data(dxT) + $dx]  ## ditto
#	set data(dyT) [expr $data(dyT) + $dy]  ## Total == Marked x,y - current

	if { $event == "<MOTION>" && $data(dx) == 0 && $data(dy) == 0 } { return }
	set compevent "<[join [join "$event $A"] -]>"
	set keyevent "<$event>"
	set item $data(edit,objItem)
	set type $data(edit,objType)

	if { $mode == "" } {set mode "-" }
	if { $item == "" } {set item "-" }
	if { $type == "" } {set type "-xx-" }
	set anymode "*"
	set anyitem "*"
	if { $mode == "-" } {set anymode "?"}
	if { $item == "-" } {set anyitem "?" }
	set func ""
	#Log "Event $compevent , $keyevent"
	foreach {tmode titem} [list $mode $item  $mode $type  $mode $anyitem  $anymode $type  $anymode $item  $anymode $anyitem # #]	{
		#Log "Try event,$tmode,$titem,$compevent"
		if { [info exists data(event,$tmode,$titem,$compevent) ] } {
			set func $data(event,$tmode,$titem,$compevent)
			break
		}
		if { [info exists data(event,$tmode,$titem,$keyevent) ] } {
			set func $data(event,$tmode,$titem,$keyevent)
			break
		}
	}
	if { $func != "" } {
		if { $compevent != "<<MOTION>>" } {
			#Log "Exec $compevent $func: $mode, $item, $type"
		}
		set args [lrange $func 1 end]
		set func  [lindex $func 0]
		if { [regexp "<<.*>>" $func] } {
			regsub "(<<)(.*)(>>)" $func {\2} func
			doEvent $name <$func>
		} else {
			#Log "dispatch: $compevent -> $func $name $args"
			set func [eval $func $name $args]
			if { $func != "" } {
				if { [regexp "<<.*>>" $func] } {
					regsub "(<<)(.*)(>>)" $func {\2} func
					doEvent $name <$func>
				} else {
					modePush $name $func
					#Log "New Mode $func"
				}
			}
		}
		return
	}
	if { $compevent == "<<MOTION>>" } { return }
	bell
	set data(Message) "$compevent , does not perform any function in this mode ($mode:$item,$type) "
}


proc modeSet { name {mode ""}} {
	upvar #0 $name data

	if { $data(Mode,Create) == {}  && $mode == "Create" } {return}
	set data(Stack) ""
	set data(Mode) $mode
	procDropAll $name
	return ""
}

proc modePush { name {mode ""}} {
	upvar #0 $name data

	lappend data(Stack) [array get data edit,*]
	Log "Stack\n[join $data(Stack) \n]"
	lappend data(Mode) $mode
	Log "$data(Mode): Saved\n[lindex $data(Stack) end]"
	#procDropAll $name
	return ""
}


proc modePop { name {def ""}} {
	upvar #0 $name data

	Log "Mode pop"
	set data(Mode) [lreplace $data(Mode) end end]
	if { $def != "" && $data(Mode) == "" } {
		set data(Mode) $def
	}
	if { [llength $data(Mode)] == 0  } {
		set data(Mode,Create) {}
	}
	#array set data [lindex $data(Stack) end]
	Log "$data(Mode): Restored\n[array get data edit,*]"
	set data(Stack) [lreplace $data(Stack) end end]
	return ""
}











