#!/bin/bash
#\
exec wish -f "$0" ${1+"$@"}
#
# calibrate -- Utility to test the xinputs and to calibrate
#	       touch-screens.
#
# Author	: Patrick Lecoanet.
# Creation date	: 5/10/1998
#
#
#
# Copyright (c) 1998-99 Patrick Lecoanet --
#
# This code is free software; you can redistribute it and/or
# modify it under the terms of the GNU Library General Public
# License as published by the Free Software Foundation; either
# version 2 of the License, or (at your option) any later version.
#
# This code is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# Library General Public License for more details.
#
# You should have received a copy of the GNU Library General Public
# License along with this code; if not, write to the Free
# Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
#
# $Id$
#

#
# BUGS
#
# Problems with <ButtonPress> which probably fires for motions
# without buttons.
#
# Problem when destroying a window in a callback triggered by
# an extended event on that window.
#
#
# TODO:
#
#  Simulate a focus on unfocusable touchscreen devices. Needed
#  for calibration. This can be done with a warp-pointer + binding
#  on pointer motion that maintain the pointer in the specified
#  window.
#
#  Try to locate which XF86Config is used by the server and use it
#  to associate a device instance e.g Elo with a driver type e.g
#  Elographics. This may obsolete the driver selection list. Well
#  this seems a bit harder than it looks as some drivers implements
#  several devices. The mapping is not one to one but many to one.
# 
#  Take into account the two XF86Config formats 3.3.x & 3.9.x to
#  produce a valid syntax for calibration data. This needs some
#  code to detect the server version.
#
#  Currently it is not possible to change the core pointer or the
#  core keyboard.
#
#  Nothing as been done to test keyboards (keys, etc).
#
#  It would be nice to have a help button that pops up a text window
#  displaying some help info.
#

package require XI 1.0

set scratchWidth 450
set scratchHeight 450
set screenWidth [ winfo screenwidth . ]
set screenHeight [ winfo screenheight . ]
set swapThresh 100
set size 50
set circle_size 10
set line_size 30
#set XF86ConfigDirs "/etc/XF86Config /etc/X11/XF86Config /usr/X11R6/lib/X11/config/XF86Config"
#set autoFoundXF86Config 0
#
#proc usage {} {
#    puts "\nusage: calibrate [xf86ConfigFile]\n"
#    exit(1)
#}
#
#proc parseXF86Config {name} {
#    global drivers
#    
#    set chan [open $name]
#    set config [read $chan]
#    close $chan
#    
#    set chunk [string range "$config" [string first "Section \"Xinput\"" "$config"] \
#	     [string length $config]]
#    set chunk [string range "$chunk" 0 [expr [string first "EndSection" $chunk]-2]]
#    set Xinput [split "$chunk" "\n"]
#    set driver ""
#    foreach l "$Xinput" {
#	 if {[regexp -nocase "^\[ \t\]*SubSection.*\"(.*)\".*$" "$l" match token]} {
#	     set driver $token
#	 } elseif {[regexp -nocase "^\[ \t\]*DeviceName.*\"(.*)\".*$" "$l" match token]} {
#	     if { $driver != "" } {
#		 set drivers($token) $driver
#	     }
#	 } elseif {[regexp -nocase "^\[ \t\]*EndSubSection.*$" "$l"]} {
#	     set driver ""
#	 }
#    }
#    foreach d [array names drivers] {
#	 puts "$d --> $drivers($d)"
#    }
#    exit
#}
#
#set XF86Config ""
#if { [llength $argv] > 1 } {
#    usage
#} elseif { [llength $argv] == 1 } {
#    if { [file readable [lindex $argv 0]] } {
#	 set XF86Config [lindex $argv 0]
#    }
#} else {
#    foreach fname $XF86ConfigDirs {
#	 if { [file readable $fname] } {
#	     set XF86Config $fname
#	     break
#	 }
#    }
#    if { $XF86Config != "" } {
#	 set autoFoundXF86Config 1
#    }
#}
#if { $XF86Config == "" } {
#    puts "Couldn't find a XF86Config file\n"
#}
#parseXF86Config $XF86Config
#

set origin_x [ expr ($screenWidth/2) - ($scratchWidth/2) ]
set origin_y [ expr ($screenHeight/2) - ($scratchHeight/2) ]

set device ""
set driver ""
set deviceIndex 0
set focused 0
set focusable 0
set alwaysCore 0
#set alwaysCoreDict ()
set coreFeedbackIndex 0
set mapOnPad 0
set transformOnPad 0
set absRel 0
set absRelCapable 0
set features ""
set showButtons 0
set showValuators 0
set showProximity 0
#set deviceCalib ()
set devXRange 0
set devXMin 0
set devYRange 0
set devYMin 0

#
# Format is: Y axis dir 0 = down, 1 = up; Support reverse axes 0 = no, 1 = yes;
#            Support swap axes 0 = no, 1 = yes
set drivers(Elographics) "1 1 1"
set drivers(Microtouch) "1 1 1"
set drivers(Dynapro) "1 1 1"
#
# Need some more work to decide what to do
# for the tablets in general. It is not exactly
# a calibration but rather a zone mapping.
set drivers(Wacom) "0 0 0"



#
# The error handler is used to catch failed attempt to open
# a declared device or to change from absolute to relative
# motion.
# 
proc catchError {type resourceId serial errorCode requestCode minorCode} {
    global xErrorCode
#    puts "xError: $type $resourceId $serial $errorCode $requestCode $minorCode"
    set xErrorCode $errorCode 
}

proc pad {name geometry} {
    global size circle_size line_size

    set circleox [ expr $size/2-$circle_size/2 ]
    set circleoy $circleox
    set circlecx [ expr $circleox+$circle_size ]
    set circlecy $circlecx
    set vertx [ expr $size/2 ]
    set vertoy [ expr ($size-$line_size)/2 ]
    set vertcy [ expr $vertoy+$line_size ]
    set horizox [ expr ($size-$line_size)/2 ]
    set horizcx [ expr $horizox+$line_size ]
    set horizy [ expr $size/2 ]

    toplevel $name
    wm geometry $name $geometry
    wm overrideredirect $name true
    canvas $name.m -height $size -width $size -bg "#505075"
    $name.m create oval $circleox $circleoy $circlecx $circlecy -outline white
    $name.m create line $vertx $vertoy $vertx $vertcy -fill white
    $name.m create line $horizox $horizy $horizcx $horizy -fill white
    pack $name.m
}

#
# Should warp the pointer instead of focusing the device
# if focus is not supported
#
proc calibrationSequence {which xDev yDev} {
    global focused device calibResults absRelCapable
    global size focusable driver drivers deviceCalib
    global workingTags calibTags scratchWidth scratchHeight
    global swapThresh
    
#    puts "$xDev $yDev"
    set calibResults(xDev,$which) $xDev
    set calibResults(yDev,$which) $yDev
    if { $which == 0 } {
	.topleft.m configure -background "#505075"
	xi::bindevent .topleft.m $device <ButtonRelease> ""
	.topright.m configure -background "#df94df"
	if { $focusable == 1 } {
	    xi::device focus $device .topright.m pointer
	}
	xi::bindevent .topright.m $device <ButtonRelease> \
		{calibrationSequence 1 %0 %1}
    } elseif { $which == 1 } {
	.topright.m configure -background "#505075"
	xi::bindevent .topright.m $device <ButtonRelease> ""
	.bottomright.m configure -background "#df94df"
	if { $focusable == 1 } {
	    xi::device focus $device .bottomright.m pointer
	}
	xi::bindevent .bottomright.m $device <ButtonRelease> \
		{calibrationSequence 2 %0 %1}
    } elseif { $which == 2 } {
	.bottomright.m configure -background "#505075"
	xi::bindevent .bottomright.m $device <ButtonRelease> ""
	.bottomleft.m configure -background "#df94df"
	if { $focusable == 1 } {
	    xi::device focus $device .bottomleft.m pointer
	}
	xi::bindevent .bottomleft.m $device <ButtonRelease> \
		{calibrationSequence 3 %0 %1}
    } elseif { $which == 3 } {
	.bottomleft.m configure -background "#505075"
	xi::bindevent .bottomleft.m $device <ButtonRelease> ""	
 	if { $focused } {
 	    xi::device focus $device .scratchArea pointer
 	}
 	if { [info commands .caldata] == "" } {
 	    toplevel .caldata
	    wm title .caldata "XF86Config options"
	    wm transient .caldata .
	    text .caldata.text -background gray -width 60 -height 20
	    button .caldata.dismiss -text "Dismiss" \
		    -command "wm withdraw .caldata"
	    pack .caldata.text .caldata.dismiss
 	} else {
	    .caldata.text configure -state normal
	    .caldata.text delete 0.0 end
	    wm deiconify .caldata	    
	}
	set geomx [expr [winfo rootx .scratchArea]+ ($scratchWidth/4)]
	set geomy [expr [winfo rooty .scratchArea]+ ($scratchHeight/4)]
	wm geometry .caldata "+$geomx+$geomy"
	set borderOffset [expr ($size / 2)+1]
 	set screenWidth [ winfo screenwidth . ]
	set screenHeight [ winfo screenheight . ]
	set widthDev [expr $calibResults(xDev,1) - $calibResults(xDev,0)]
 	set heightDev [expr abs($calibResults(yDev,3) - $calibResults(yDev,0))]
 	set widthX [expr $screenWidth - (2 * $borderOffset)]
 	set heightX [expr $screenHeight - (2 * $borderOffset)]

# 	puts "$widthDev $heightDev $widthX $heightX"

	#
	# Calibrate X axis taking into account a possible axis reversal.
	set xReversal 0
	if { $calibResults(xDev,1) < $calibResults(xDev,0) } {
	    set xReversal 1
	}
	set xDevMin [expr $calibResults(xDev,0) - \
		($borderOffset * $widthDev / $widthX)]
	set xDevMax [expr $calibResults(xDev,1) + \
		($borderOffset * $widthDev / $widthX)]
	#
	# Calibrate Y axis taking into account a possible axis reversal and
	# the device Y direction
	set yReversal 0
	if { $calibResults(yDev,3) < $calibResults(yDev,0) } {
	    set yReversal 1
	}
	if { [lindex $drivers($driver) 0] == 1 } {
	    set yDevMin [expr $calibResults(yDev,3) - \
		    ($borderOffset * $heightDev / $heightX)]
	    set yDevMax [expr $calibResults(yDev,0) + \
		    ($borderOffset * $heightDev / $heightX)]
	} else {
	    set yDevMin [expr $calibResults(yDev,0) - \
		    ($borderOffset * $heightDev / $heightX)]
	    set yDevMax [expr $calibResults(yDev,3) + \
		    ($borderOffset * $heightDev / $heightX)]
	}

	set swapXY 0
	if { $calibResults(xDev,0) < [expr $calibResults(xDev,3)-$swapThresh] || \
		$calibResults(xDev,0) > [expr $calibResults(xDev,3)+$swapThresh] || \
		$calibResults(xDev,1) < [expr $calibResults(xDev,2)-$swapThresh] || \
		$calibResults(xDev,1) > [expr $calibResults(xDev,2)+$swapThresh] } {
	    set swapXY 1
	}
	
	.caldata.text insert end "To tell the $driver driver to consider the\n"
	.caldata.text insert end "new calibration data, you need to add or replace\n"
	.caldata.text insert end "the following lines in the $driver\n"
	.caldata.text insert end "subsection of the XF86CONFIG file:\n\n"
 	.caldata.text insert end "MinimumXPosition	$xDevMin\n"
 	.caldata.text insert end "MaximumXPosition	$xDevMax\n"
 	.caldata.text insert end "MinimumYPosition	$yDevMin\n"
 	.caldata.text insert end "MaximumYPosition	$yDevMax\n"
	if {$swapXY==1 && ([lindex $drivers($driver) 2]==1)} {
	    .caldata.text insert end "SwapXY\n"
	}
	if {($xReversal==1 || $yReversal==1) && [lindex $drivers($driver) 1]==0} {
	    .caldata.text insert end "\nIMPORTANT NOTE: The "
	    if {$xReversal==1 && $yReversal==1} {
		.caldata.text insert end "X and Y axes are"
	    } elseif {$xReversal==1} {
		.caldata.text insert end "X axis is"
	    } else {
		.caldata.text insert end "Y axis is"
	    }
	    .caldata.text insert end " reversed and the \n"
	    .caldata.text insert end "current driver can't fix this.\n"
	}
	if {$swapXY==1 && ([lindex $drivers($driver) 2]==0)} {
	    .caldata.text insert end "\nIMPORTANT NOTE: The X and Y are reversed and the\n"
	    .caldata.text insert end "current driver can't fix this.\n"
	}
	
	.caldata.text configure -state disabled

	set deviceCalib(xDevMin$device) $xDevMin
	set deviceCalib(xDevMax$device) $xDevMax
	set deviceCalib(yDevMin$device) $yDevMin
	set deviceCalib(yDevMax$device) $yDevMax
	set deviceCalib(xReversal$device) $xReversal
	set deviceCalib(yReversal$device) $yReversal
	
 	bindtags .workingDev.list $workingTags
 	bindtags .calib.list $calibTags
	.calib.doit configure -state normal
	.calib.info configure -state normal
	.devControl.setCore configure -state normal
	.devControl.transformOnPad configure -state normal
	if { $focusable == 1 } {
	    .devControl.setFocus configure -state normal
	}
	.devControl.mapOnPad configure -state normal
	if { $absRelCapable == 1 } {
	    .absRel.setAbsolute configure -state normal
	    .absRel.setRelative configure -state normal
	}
	destroy .topleft .bottomleft .topright .bottomright
    }
}

proc startCalibration {} {
    global device workingTags calibTags calibResults
    global focusable scratchWidth scratchHeight

    if {! $focusable } {
	set ok 0
	toplevel .notFocusable
	wm title .notFocusable "Warning !?!"
	wm transient .notFocusable .
	text .notFocusable.text -background gray -width 60 -height 20
	button .notFocusable.dismiss -text "Dismiss" \
		-command "destroy .notFocusable; set ok 1"
	.notFocusable.text insert end "The device you are trying to calibrate can not\n"
	.notFocusable.text insert end "be focused on a window. You NEED to put the X\n"
	.notFocusable.text insert end "pointer (aka mouse) in each calibration pad BEFORE\n"
        .notFocusable.text insert end "touching it.\n"
	.notFocusable.text insert end "If you don't do it nothing will happen and the\n"
	.notFocusable.text insert end "calibration sequence will not proceed.\n"
	pack .notFocusable.text .notFocusable.dismiss
	set geomx [expr [winfo rootx .scratchArea]+ ($scratchWidth/4)]
	set geomy [expr [winfo rooty .scratchArea]+ ($scratchHeight/4)]
	wm geometry .notFocusable "+$geomx+$geomy"
	#
	# Do some spiffy animation to draw attention !
	for { set i 0 } { $i < 10 } { incr i } {
	    after 100
	    .notFocusable.text configure -background white
	    update
	    after 100
	    .notFocusable.text configure -background gray
	    update
	}
	tkwait variable ok 
    }
    
    #
    # Suppress tags on listboxes to prevent changing the
    # device and driver and disable other controls
    set workingTags [ bindtags .workingDev.list]
    bindtags .workingDev.list .
    set calibTags [ bindtags .calib.list]
    bindtags .calib.list .
    .calib.doit configure -state disabled
    .calib.info configure -state disabled
    .devControl.setCore configure -state disabled
    .devControl.setFocus configure -state disabled
    .devControl.mapOnPad configure -state disabled
    .devControl.transformOnPad configure -state disabled
    .absRel.setAbsolute configure -state disabled
    .absRel.setRelative configure -state disabled
    
    pad .topleft +0+0
    pad .bottomleft +0-0
    pad .topright -0+0
    pad .bottomright -0-0
    update
    #
    # Start calib sequence
    catch {unset calibResults}
    .topleft.m configure -background "#df94df"
    if { $focusable } {
	xi::device focus $device .topleft.m pointer
    }
    xi::bindevent .topleft.m $device <ButtonRelease> {calibrationSequence 0 %0 %1}
}

proc buttonsDisplay {bNum state} {
    global showButtons
    if { ! $showButtons } {
	return
    }
    set button [incr bNum -1]
    
    .buttons.b$button configure -state normal
    if { $state == "down" } {
	.buttons.b$button select
    } else {
	.buttons.b$button deselect
    }
    .buttons.b$button configure -state disabled
}

proc numButtons {features} {
  return [lindex $features 0]
}

proc updateButtons {} {
    global showButtons features device
    
    set numButs [numButtons "$features"]
    if { $showButtons == 0 } {
	destroy .buttons
	for { set i 0 } { $i < $numButs } { incr i 1 } {
	    global b$i
	    catch { unset b$i }
	}
    } else {
	frame .buttons
	for { set i 0 } { $i < $numButs } { incr i 1 } {
	    checkbutton .buttons.b$i -state disabled
	    grid .buttons.b$i -row [expr "$i/16"] -column [expr "$i%16"]
	}
	grid .buttons -row 9 -column 1 -sticky news
    }
}

proc valuatorsDisplay {vList} {
    global showValuators
    if { ! $showValuators } {
	return
    }
    set i 0
    foreach val $vList {
	.valuators.v$i configure -state normal
	.valuators.v$i delete 0 end
	.valuators.v$i insert 0 $val
	.valuators.v$i configure -state disabled
	incr i 1
    }
}

#
# Draw on the scratch pad after mapping coordinates from
# device space to scratch pad space.
#
proc transform {x y} {
    global scratchWidth scratchHeight
    global mapOnPad screenWidth screenHeight
    global devXMin devXRange devYMin devYRange
    global device deviceCalib transformOnPad
    global drivers driver
    
    #
    # If asked to use calibration infos to transform the
    # coords on Pad use those available or use the device
    # raw coords.
    if { $transformOnPad && ([array names deviceCalib xDevMin$device] != "") } {
	set xMin $deviceCalib(xDevMin$device)
	set yMin $deviceCalib(yDevMin$device)
	set xRange [expr $deviceCalib(xDevMax$device) - $deviceCalib(xDevMin$device)]
	set yRange [expr $deviceCalib(yDevMax$device) - $deviceCalib(yDevMin$device)]
    } else {
	set xMin $devXMin
	set yMin $devYMin
	set xRange $devXRange
	set yRange $devYRange
    }

    set deviceYDir 1
    if { [array names drivers $driver] != "" } {
	set deviceYDir [lindex $drivers($driver) 0]
    }
    
    #
    # transform x and y from device coordinates
    # to scratch pad or screen. Return a point as a list.
    if { ! $mapOnPad } {
	set xt [expr $screenWidth * ($x - $xMin) / $xRange]
	set yt [expr $screenHeight * ($y - $yMin) / $yRange]
	if { $deviceYDir } {
	    set yt [expr $screenHeight - $yt]
	}
	#
	# The following translation is useful to get the
	# drawing on the scratch pad synchronized with the
	# pointer in Always Core mode. It does not work
	# well if the current server calib is different from
	# the new locally done (and active) calib.
	incr xt -[ winfo rootx .scratchArea ]
	incr yt -[ winfo rooty .scratchArea ]
    } {
	set xt [expr $scratchWidth * ($x - $xMin) / $xRange]
	set yt [expr $scratchHeight*($y - $yMin) / $yRange]
	if { $deviceYDir } {
	    set yt [expr $scratchHeight - $yt]
	}	
    }
    list $xt $yt
}

proc beginStroke {x y} {
    global stroke

    catch { unset stroke }
    set stroke(N) 0
    set stroke(0) [ transform $x $y ]
}

proc drawStroke {x y T} {
    global stroke

    #
    # We can receive a motion *before* the down event!!
    if { [array names stroke N] == "" } {
	return
    }
    set last $stroke($stroke(N))
    incr stroke(N)
    set stroke($stroke(N)) [ transform $x $y ]
    
    eval {.scratchArea create line} $last $stroke($stroke(N)) {-tag segments -fill green}
}

proc endStroke {x y} {
    global stroke

    incr stroke(N)
    set stroke($stroke(N)) [ transform $x $y ]
    set points { }
    for { set i 0 } { $i <= $stroke(N) } { incr i } {
	append points $stroke($i) " "
    }
    unset stroke
    .scratchArea delete segments
    eval { .scratchArea create line } $points { -tag line -fill yellow1 }
}


proc numValuators {features} {
  return [lindex $features 2]
}

proc updateValuators {} {
    global showValuators features device

    if { $showValuators == 0 } {
	destroy .valuators
    } else {
	frame .valuators

	set numVals [numValuators "$features"]
	for { set i 0 } { $i < $numVals } { incr i 1 } {
	    entry .valuators.v$i -state disabled -width 7
	    grid .valuators.v$i -row [expr "$i/8"] -column [expr "$i%8"]
	}
	grid .valuators -row 10 -column 1 -sticky news	
    }
}

proc proximityDisplay {state} {
    global showProximity
    if { ! $showProximity } {
	return
    }
    .proximity.prox configure -state normal
    if { $state == "in" } {
	.proximity.prox select
    } else {
	.proximity.prox deselect
    }
    .proximity.prox configure -state disabled
}

proc proxCapable {features} {
    return [expr [lindex $features 5] == 1]
}

proc focusCapable {features} {
    return [expr [lindex $features 4] == 1]
}

proc isAbsRelCapable {} {
    global device xErrorCode
    
    set localAbsRel [xi::device mode $device]
    if { $localAbsRel == "absolute" } {
	set changeTo "relative"
    } else {
	set changeTo "absolute"
    }
    set xErrorCode 0
    xi::device mode $device $changeTo
    if { $xErrorCode > 0 } {
	return 0
    } else {
	xi::device mode $device $localAbsRel
	return 1
    }
}

proc updateProximity {} {
    global showProximity features device

    if { $showProximity == 0 } {
	destroy .proximity
	global prox
	catch { unset prox }
    } else {
	frame .proximity
	checkbutton .proximity.prox -state disabled
	grid .proximity.prox -row 0 -column 0
	grid .proximity -row 8 -column 1 -sticky news
    }
}

proc removeAllIndicators {} {
    global showProximity showButtons showValuators device

    if { $showProximity != 0 } {
	set showProximity 0
	updateProximity
	set showProximity 1
    }
    if { $showButtons != 0 } {
	set showButtons 0
	updateButtons
	set showButtons 1
    }
    if { $showValuators != 0 } {
	set showValuators 0
	updateValuators
	set showValuators 1
    }
    
}

proc updateAllIndicators {} {
    global showProximity showButtons showValuators device

    if { $showProximity != 0 } {
	updateProximity
    }
    if { $showButtons != 0 } {
	updateButtons
    }
    if { $showValuators != 0 } {
	updateValuators
    }
}

proc updateDriver {} {
    global driver device
    
    set driver [ .calib.list get anchor ]
    .calib.label configure -text $driver
    if { $device != "" } {
	.calib.doit configure -state normal
    }
}

proc updateDevice {} {
    global features device deviceIndex coreFeedbackIndex
    global focused focusable absRel alwaysCore alwaysCoreDict
    global driver devXRange devYRange devXMin devYMin
    global deviceCalib
    
    set newDevice [ .workingDev.list get anchor ]
    
    #
    # Update the entry indicator
    #
    .workingDev.label configure -text $newDevice

    if { $device != "" } {
	#
	# Clear old state related to preceding device
	#
	xi::bindevent .scratchArea $device <ButtonPress> ""
	xi::bindevent .scratchArea $device <ButtonRelease> ""
	xi::bindevent .scratchArea $device <ProximityIn> ""
	xi::bindevent .scratchArea $device <ProximityOut> ""
	xi::bindevent .scratchArea $device <ButtonMotion> ""
	removeAllIndicators
	set driver ""
	.calib.label configure -text $driver
	.calib.doit configure -state disabled
	.calib.info configure -state disabled
    }
    
    set deviceIndex [ .workingDev.list index anchor ]
    set device $newDevice
    set features [ xi::device features $device ]

    set numVals [numValuators "$features"]
    if { $numVals != 0 } {
	set script ""
	for { set i 0 } { $i < $numVals } { incr i 1 } {
	    #
	    # Special case for Switch device
	    #
	    if { $device == "SWITCH" } {
		set script "%*"
	    } else {
		lappend script "%$i"
	    }
	}
	set script "valuatorsDisplay {$script}"
	.showValuators configure -state normal    
	if { $numVals > 1 } {
	    if { [numButtons "$features"] != 0 } {
		set script "$script; drawStroke %0 %1 %T"
	    }
	    set xAxisInfo [xi::device axisinfo $device 0]
	    set yAxisInfo [xi::device axisinfo $device 1]
	    set devXRange [expr [lindex $xAxisInfo 1] - [lindex $xAxisInfo 0]]
	    set devYRange [expr [lindex $yAxisInfo 1] - [lindex $yAxisInfo 0]]
	    set devXMin [lindex $xAxisInfo 0]
	    set devYMin [lindex $yAxisInfo 0]	
	}
	
	xi::bindevent .scratchArea $device <ButtonMotion> $script
    } else {
	.showValuators configure -state disabled
    }

    if { $device != "SWITCH" } {
	.devControl.mapOnPad configure -state normal
	if { [array names deviceCalib xDevMin$device] != "" } {
	    .devControl.transformOnPad configure -state normal
	} else {
	    .devControl.transformOnPad configure -state disabled
	}
    } else {
	.devControl.mapOnPad configure -state disabled
	.devControl.transformOnPad configure -state disabled
    }
    set coreFeedbackIndex [getAlwaysCoreIndex $device]
    #
    # The last feedback controls the AlwaysCore feature.
    # If there is no feedbacks then the feature is not supported.
    #
    if { ($coreFeedbackIndex >= 0) && $device != "SWITCH" } {
	.devControl.setCore configure -state normal
	set alwaysCore $alwaysCoreDict($device)
	changeAlwaysCore
    } else {
	.devControl.setCore configure -state normal
	set alwaysCore 0
	.devControl.setCore configure -state disabled
    }
    .absRel.setAbsolute configure -state normal
    .absRel.setRelative configure -state normal
    set absRel [xi::device mode $device]
    set absRelCapable [isAbsRelCapable]
    if { ! $absRelCapable } {
	.absRel.setAbsolute configure -state disabled
	.absRel.setRelative configure -state disabled
    }
    .devControl.setFocus configure -state normal
    set focused 0
     
    set focusable [focusCapable "$features"]
    if {  ($focusable == 1) && $device != "SWITCH" } {
	if { [xi::device focus $device] == ".scratchArea" } {
	    set focused 1
	}
    } else {
	.devControl.setFocus configure -state disabled
    }
    updateAllIndicators
    if { [numButtons "$features"] != 0 } {
	.showButtons configure -state normal
	if { [numValuators "$features"] > 1 } {
	    if { $driver != "" } {
		.calib.doit configure -state normal
	    }
	    set scriptBegin { buttonsDisplay %b down; beginStroke %0 %1 }
	    set scriptEnd { buttonsDisplay %b up; endStroke %0 %1 }
	} else {
	    set scriptBegin { buttonsDisplay %b down }
	    set scriptEnd { buttonsDisplay %b up }
	}
	xi::bindevent .scratchArea $device <ButtonPress> $scriptBegin
	xi::bindevent .scratchArea $device <ButtonRelease> $scriptEnd
    } else {
	.showButtons configure -state disabled
    }
    if { [proxCapable "$features"] } {
	.showProximity configure -state normal
	xi::bindevent .scratchArea $device <ProximityIn> "proximityDisplay in"
	xi::bindevent .scratchArea $device <ProximityOut> "proximityDisplay out"
    } else {
	.showProximity configure -state disabled
    }
}

proc changeFocus {} {
    global device focused

    if { $focused } {
	xi::device focus $device .scratchArea pointer
    } else {
	xi::device focus $device pointer pointer
    }
}

proc getAlwaysCoreIndex {device} {

    set feedbacks [ xi::device intfeedback $device ]
    return [expr ([llength $feedbacks]/4)-1]
}
    
proc changeAlwaysCore {} {
    global device coreFeedbackIndex alwaysCore alwaysCoreDict

    set alwaysCoreDict($device) $alwaysCore
    xi::device intfeedback $device $coreFeedbackIndex $alwaysCore
}

proc changeMode {} {
    global device absRel

    xi::device mode $device $absRel
}

proc createControls {} {
    global xErrorCode alwaysCoreDict
    global scratchWidth scratchHeight drivers

    label .title -text "XFree86 Xinput tool" -relief sunken
    
    canvas .scratchArea  -width $scratchWidth -borderwidth 2 \
	    -relief sunken -height $scratchHeight -bg LightSteelBlue4

    set devices [ xi::device list ]
    frame .configuredDev
    label .configuredDev.title -text "All devices:"
    listbox .configuredDev.list -width 12 -height 8 \
	    -font "Helvetica 12" -yscrollcommand ".configuredDev.sb set"
    scrollbar .configuredDev.sb -width 10 \
	    -command ".configuredDev.list yview"
    grid .configuredDev.title -row 0 -column 0 -columnspan 2 -sticky we
    grid .configuredDev.list -row 1 -column 0
    grid .configuredDev.sb -row 1 -column 1 -sticky ns
    bindtags .configuredDev.list "."
    foreach dev $devices {
	.configuredDev.list insert end $dev
    }

    frame .workingDev
    label .workingDev.title -text "Working on device:"
    label .workingDev.label -background gray
    listbox .workingDev.list -width 12 -height 8 \
	    -yscrollcommand ".workingDev.sb set"
    scrollbar .workingDev.sb -width 10 \
	    -command ".workingDev.list yview"
    grid .workingDev.title -row 0 -column 0 -columnspan 2 -sticky we
    grid .workingDev.label -row 1 -column 0 -columnspan 2 -sticky we
    grid .workingDev.list -row 2 -column 0
    grid .workingDev.sb -row 2 -column 1 -sticky ns
    foreach dev $devices {
	if { ([xi::device corepointer] != $dev) && \
		([xi::device corekeyboard] != $dev) } {
	    set xErrorCode 0
	    catch {set feat [xi::device features $dev]}
	    if { $xErrorCode == 0 } {
		.workingDev.list insert end $dev
		set alwaysCoreDict($dev) 0
	    }
	}
    }
    bind .workingDev.list <ButtonRelease-1> updateDevice
    
    frame .calib
    label .calib.title -text "Calib. for driver:"
    label .calib.label -background gray
    listbox .calib.list -width 12 -height 5 -yscrollcommand ".calib.sb set"
    scrollbar .calib.sb -width 10 \
	    -command ".calib.list yview"
    button .calib.doit -text "Calibrate" \
	    -command startCalibration -state disabled
    button .calib.info -text "Calib. info" -state disabled \
	    -command {if {[info commands .caldata] != ""} {wm deiconify .caldata}}
    grid .calib.title -row 0 -column 0 -columnspan 2 -sticky we
    grid .calib.label -row 1 -column 0 -columnspan 2 -sticky we
    grid .calib.list -row 2 -column 0
    grid .calib.sb -row 2 -column 1 -sticky ns
    grid .calib.doit -row 3 -column 0 -columnspan 2 -sticky we
    grid .calib.info -row 4 -column 0 -columnspan 2 -sticky we
    foreach drv [array names drivers] {
	.calib.list insert end $drv
    }
    bind .calib.list <ButtonRelease-1> updateDriver
    
    button .clearPad -text "Clear\nScratch Pad" \
	    -command {.scratchArea delete line}

    checkbutton .showButtons -text "Buttons" -anchor w \
	    -variable showButtons \
	    -command updateButtons -state disabled
    checkbutton .showValuators -text "Valuators" -anchor w \
	    -variable showValuators \
	    -command updateValuators -state disabled
    checkbutton .showProximity -text "Proximity" -anchor w \
	    -variable showProximity \
	    -command updateProximity -state disabled

    frame .devControl
    checkbutton .devControl.setCore -text "Always Core" -anchor w \
	    -variable alwaysCore -state disabled -command changeAlwaysCore
    checkbutton .devControl.setFocus -text "Focus on\nScratch Pad" -anchor w \
	    -variable focused -state disabled -command changeFocus
    checkbutton .devControl.mapOnPad -text "Map on \nScratch Pad" -anchor w \
	    -state disabled
    checkbutton .devControl.transformOnPad -text "Transform on \nScratch Pad" \
	    -anchor w -state disabled
    pack .devControl.setCore .devControl.setFocus .devControl.mapOnPad \
	    .devControl.transformOnPad -fill x

    frame .absRel
    radiobutton .absRel.setAbsolute -text Absolute -anchor w \
	    -variable absRel -value absolute -state disabled -command changeMode
    radiobutton .absRel.setRelative -text Relative -anchor w \
	    -variable absRel -value relative -state disabled -command changeMode
    pack .absRel.setAbsolute .absRel.setRelative -fill x

    button .exit -text "Exit" -command "exit 0" -padx 2
    
    grid .title -row 0 -column 1 -sticky ns -ipadx 4 -ipady 4 -pady 2
    grid .scratchArea -row 1 -rowspan 7 -column 1 -sticky news

    grid .configuredDev -row 1 -column 2 -sticky nw -padx 2
    grid .calib -row 3 -rowspan 3 -column 2 -sticky nw -padx 2
    grid .exit -row 10 -column 2 -sticky news -padx 2
    
    grid .workingDev -row 1 -column 0 -padx 2
    grid .devControl -row 3 -column 0 -sticky ews -padx 2
    grid .absRel -row 4 -column 0 -sticky ews -padx 2 -pady 2
    grid .clearPad -row 5 -column 0 -sticky ews -padx 2 -pady 2
    grid .showProximity -row 8 -column 0 -sticky news -padx 2
    grid .showButtons -row 9 -column 0 -sticky news -padx 2
    grid .showValuators -row 10 -column 0 -sticky news -padx 2

    grid columnconfigure . 1 -weight 1
    grid rowconfigure . 2 -weight 1
    grid rowconfigure . 7 -weight 5
}

xi::errorhandler "catchError"

createControls

wm title . "Xinput tool"
wm geometry . +$origin_x+$origin_y

#
# Local Variables:
# mode: tcl
# End:
#
