LDVmouse

#
# Normally, you would source this file at the beginning of any of
# the other LDV mouse commands.
#
# We need root priviliges to execute some of these commands, so remember
# to run this with "sudo tclsh"
#
# Before you run this script, you should run "sudo ./evhz" to find out the
# device's polling rate.
# If the polling rate isn't high enough, 1 kHz seems to be max, then you can
# try:
#   sudo modprobe -r usbhid && sudo modprobe usbhid mousepoll=1
# AND THEN UNPLUG AND RE-PLUG IN THE MOUSE.
# See https://wiki.archlinux.org/index.php/Mouse_Polling_Rate for other settings.

# Set some global values:

# The polling rate and number of samples used to average:
set ::LDVrate   1000 ; # Polling rate. Only used in the output file header.
set ::LDVnavg   5000 ; # Number of samples for computing time-average in LDVtransect.tcl.
set ::LDVnsamp  5000 ; # Number of samples in time series by LDVts.tcl. 5 sec
#set ::LDVnsamp  300000 ; # Number of samples in time series by LDVts.tcl. 5 minutes


# Once you know the dev number and node, you may hardwire these values:
set ::LDVname "Catz"
set ::LDVdev  14
set ::LDVnode /dev/input/event16

# Note that "sudo ./evhz" will output the list of nodes and their associated
# devices.

###########################################################
# You should not need to modify anything below this line. #
###########################################################

# Find the mouse by name by parsing the output of xinput --list
proc finddev mousename {
    if { [ catch {exec xinput --list | grep "$mousename" } retstr ]
     } {
	puts "Could not find device named $mousename."
	puts "Returning dev=0."
#	puts "retstr = $retstr"
	return 0
    }
    regexp {id=(\d+?)\s} $retstr -> dev
    puts "Found \"$mousename\" mouse on dev=$dev"
    return $dev
}

# Determine the file name for accessing the mouse:
proc getnode dev {
    # On puppy linux, the mouse seems to show up at
    #	return /dev/sudo modprobe -r usbhid && sudo modprobe usbhid mousepoll=1
    # THEN UN-PLUG AND RE-PLUG MOUSE.
    # 	Mad CAT:
    #	return /dev/input/event8
    # Titanium:
    #	return /dev/input/event3
    #    return /dev/input/event2
    # red button is here:
    #	return /dev/input/event2
    #	return /dev/input/event12

    # Not all linux's seem to have the list-props option for xinput.
    # Execute xinput and grab the line containing "Device Node"
    if { [ catch {exec xinput list-props $dev | grep "Device Node"} retstr ]
     } {
	puts "Could not find device node for dev= $dev."
	puts "Returning devnode=0."
	#	puts "retstr = $retstr"
	return 0
    }
    # Parse the result to pull out the file name which is within quotes
    regexp {\"(.+?)\"} $retstr -> match
    puts "Found dev=$dev on node=$match"
    return $match
}

# Find the active device node just by grabbing output from everything
# /dev/input/event* until something shows up.
# Use this as a last resort in case xinput list-props fails.
set ::state 0
set ::ms 0
proc getnode_alt dev {
    puts "Searching for the device node corresponding to dev=$dev."
    puts "   Please move the mouse or sensor ...."
    after 3000
    set eventnodes [glob /dev/input/event*]
    foreach e $eventnodes {
	update
	puts "   Checking $e"
	after 250 set ::state timeout
	set ::ms [open $e rb]
	chan configure $::ms -encoding binary -translation binary -buffering none -blocking 0
	chan event $::ms readable {close $::ms; set ::state 1}
#	puts $::state
	vwait ::state
	after cancel set ::state timeout
#	puts $::state
	switch $::state {timeout {close $::ms ; puts "   ... no response"} default {return $e}}
	puts "Unable to find events associated with the mouse movement."
	return 0
    }
}


if {$::LDVnode == 0} {
    # Find the device number from the device name:
    set ::LDVdev  [finddev $::LDVname]
    
    # Try to find the node, e.g., /dev/input/event12:
    set ::LDVnode [getnode $::LDVdev]
    
    if {$::LDVnode == 0} {
	# If the above command fails because the linux does not have
	# full xinput command, then we search all active nodes.
	set ::LDVnode [getnode_alt $::LDVdev]
    }
}

#!/usr/local/bin/bltwish

##!/usr/bin/tclsh
#package require Tk
#package require BLT

#!/usr/local/bin/tclsh8.5

# xinput query-state 11
# xinput test 11
# xinput test-xi2
# xinput list-props 11
# sudo tclsh to run this script

# This will increase the mouse polling rate to 1kHz:
# sudo modprobe -r usbhid && sudo modprobe usbhid mousepoll=1
# THEN UN-PLUG AND RE-PLUG MOUSE.
# See https://wiki.archlinux.org/index.php/Mouse_Polling_Rate for other settings.

# Set up tcl/tk with tools we need to graph the data:


namespace import blt::*

# Initialize vectors
set nsamp 250 ;  # nominally, 1 second of data
#set nsamp 1000 ;  # nominally, 1 second of data
set nsamp 6000 ;  # nominally, 3 second of data at 500Hz
vector create utvec($nsamp) vtvec($nsamp) uvec($nsamp) vvec($nsamp)
vector create vzero($nsamp)

# "xinput list" provides a list of possible input devices.
# Device 11 is the mouse on my laptop.
# Default location (sometimes?)
set dev 9
# After setting polling rate with usbhid:
set dev 15
# Logitech wireless? It seems that after unplugging and replugging, the device comes back on 15:
#set dev 16
#set dev 10
#set dev 11

# Disable the mouse:
proc disablemouse dev {
    # other pointers should continue to work.
    exec xinput disable $dev
}

# Enable the mouse:
proc enablemouse dev {
    exec xinput enable $dev
}

# Determine the file name for accessing the mouse:
proc getnode dev {
	# On puppy linux, the mouse seems to show up at
#	return /dev/sudo modprobe -r usbhid && sudo modprobe usbhid mousepoll=1
# THEN UN-PLUG AND RE-PLUG MOUSE.
# 	Mad CAT:
#	return /dev/input/event8
# Titanium:
#	return /dev/input/event3
	return /dev/input/event2
	# red button is here:
#	return /dev/input/event2
#	return /dev/input/event12

    # Execute xinput and grab the line containing "Device Node"
    set retstr [exec xinput list-props $dev | grep "Device Node"]
    # Parse the result to pull out the file name which is within quotes
    regexp {\"(.+?)\"} $retstr -> match
    return $match
}

# Find out the polling rate on the device:
proc checkrate dev {
    set devnode [getnode $dev]

    # "xinput list-props 11" shows that the mouse is at /dev/input/event6
    # We must run tclsh as root, "sudo tclsh", in order to access the mouse in the following:

    # Open the channel and configure it for directly reading binary data.
    set ms [open $devnode rb]
    chan configure $ms -encoding binary -translation binary -buffering none
    
    puts "Start moving the device and keep it in continuous motion."
    set i 0
    set count 0
    set imax 1000
    set dtsum 0.
    while {$i < $imax} {
	set buf [read $ms 16]
	#    binary scan $buf iissi tvsec tvusec type code value
	binary scan $buf iissi tvsec tvusec type code value
	puts "$tvsec $tvusec $type $code $value"
	# See linux/linux.h for a desciption of the event structure:
	# tvsec
	# tvusec
	# type = 0 (sync) 2 (rel)
	# code = 0 (xaxis) 1 (yaxis)
	# value = amount of change.
	if {$type == 0} {
	    if {$count > 0} {
		set dt    [expr ($tvsec - $tsec)+($tvusec - $tusec)/1.e6]
		set dtsum [expr $dtsum + $dt]
	    }
	    set tsec  $tvsec
	    set tusec $tvusec
	    incr count
	}
	incr i
    }
    set rate [expr $dtsum/$count ] ; # Average dt over test period.
    set rate [expr 1./$rate ] ; # convert rate to Hz = 1/sec
    puts "Found polling rate = $rate Hz from $count samples."

    # Close the channel:
    close $ms

    return
}


# Read the device and compute instantaneous and average velocity in device units.
# Note that the vectors utvec, vtvec, uvec, and vvec are global variables.
proc rawvel {dev nsamp} {
    set devnode [getnode $dev]

    ::utvec set ::vzero
    ::vtvec set ::vzero
    ::uvec  set ::vzero
    ::vvec  set ::vzero

    set uttmp  [list]
    set utmp   [list]
    set vttmp  [list]
    set vtmp   [list]

    # Open the channel and configure it for directly reading binary data.
    # Need to put this in a "catch" statement with reminder to 
    # run tclsh as sudo.
    set ms [open $devnode rb]
    chan configure $ms -encoding binary -translation binary -buffering none

    set i 0
    set buf [read $ms 16]
    #    binary scan $buf iissi tvsec tvusec type code value
    binary scan $buf iissi tsec tusec type code value

#    puts "$tsec $tusec $type $code $value"
    set u_tsec_old  $tsec
    set u_tusec_old $tusec
    set v_tsec_old  $tsec
    set v_tusec_old $tusec
    set t0 [expr $tsec + $tusec/1.e6]

    set ucount 0
    set vcount 0
    while {$i < $nsamp} {
	set buf [read $ms 16]
	#    binary scan $buf iissi tvsec tvusec type code value
	binary scan $buf iissi tsec tusec type code value
#	puts "$tsec $tusec $type $code $value"
	# sec
	# usec
	# type = 0 (sync) 2 (rel)
	# code = 0 (xaxis) 1 (yaxis)
	# value = amount of change.
	# Only record increments when a relative change is reported:

	if {$type == 2} {
	    if {$code == 0} {
		set u_dt    [expr ($tsec - $u_tsec_old)+($tusec - $u_tusec_old)/1.e6]
		set u_tsec_old  $tsec
		set u_tusec_old $tusec
		lappend uttmp  [expr ($tsec+$tusec/1.e6)-$t0]
		#		lappend utmp   [expr $value/$u_dt]
		# It seems that each value returned is a speed, so it is not necessary to divide
		# by the time increment
		lappend utmp   $value
		incr ucount
	    }
	    if {$code == 1} {
		set v_dt    [expr ($tsec - $v_tsec_old)+($tusec - $v_tusec_old)/1.e6]
		set v_tsec_old  $tsec
		set v_tusec_old $tusec
		lappend vttmp  [expr ($tsec+$tusec/1.e6)-$t0]
#		lappend vtmp   [expr $value/$v_dt]
		# It seems that each value returned is a speed, so it is not necessary to divide
		# by the time increment
		lappend vtmp   $value
		incr vcount
	    }
	}
	incr i
#	puts "$ucount $vcount"
    }

    # Close the channel:
    close $ms

    ::utvec set $uttmp
    ::uvec  set $utmp
    ::vtvec set $vttmp
    ::vvec  set $vtmp

    if {[::uvec length] > 1} {
	if {[::vvec length] > 1} {
	    set ubar [vector expr {mean(::uvec)}]
	    set vbar [vector expr {mean(::vvec)}]
	    ::uvec set [vector expr {::uvec - $ubar}]
	    ::vvec set [vector expr {::vvec - $vbar}]
	    set uvar [vector expr {mean(::uvec * ::uvec)}]
	    set vvar [vector expr {mean(::vvec * ::vvec)}]
	    if {[::uvec length] <= [::vvec length]} {
		set lu [::uvec length]
		set lu [expr $lu - 1]
		::vvec set ::vvec(0:$lu)
		::vtvec set ::vtvec(0:$lu)
		set uvcov [vector expr {mean(::uvec * ::vvec)}]
	    } else {
		set lu [::vvec length]
		set lu [expr $lu - 1]
		::uvec set ::uvec(0:$lu)
		::utvec set ::utvec(0:$lu)
		set uvcov [vector expr {mean(::uvec * ::vvec)}]
	    }
	    puts "$ubar $vbar $uvar $vvar $uvcov"
    	    return "$ubar $vbar $uvar $vvar $uvcov"
	}
    }

    return "#ERROR"
}

proc value_dialog {string} {
    set w [toplevel .[clock seconds]]
    wm resizable $w 0 0
    wm title $w "Value request"
    wm attributes $w -topmost true
    label  $w.l -text $string
    entry  $w.e -textvar $w -bg white
    bind $w.e <Return> {set done 1}
    button $w.ok     -text OK     -command {set done 1}
    button $w.c      -text Clear  -command "set $w {}"
    button $w.cancel -text Cancel -command "set $w {}; set done 1"
    grid $w.l  -    -        -sticky news
    grid $w.e  -    -        -sticky news
    grid $w.ok $w.c $w.cancel
    focus $w.e
    vwait done
    destroy $w
    set ::$w
}


stripchart .s1 -height 2i -width 8i -bufferelements no
stripchart .s2 -height 2i -width 8i -bufferelements no

pack .s1 .s2

.s1 element create line1 -xdata utvec -ydata uvec -symbol none
.s2 element create line2 -xdata vtvec -ydata vvec -symbol none -color red
#.s1 axis configure y -min -16000 -max 16000
#.s2 axis configure y -min -16000 -max 16000

# Disable the selected device so you can keep using the computer while
# the mouse is collecting data:
# Does not work on puppy linux:
#disablemouse $dev

# Bind keypress event to write the next available out string to file.
global outnow
set outnow 0
bind . <Key> {global outnow ; set outnow 1}

set tstamp [clock format [clock seconds] -format %y%m%dT%H%M%S]
set fid [open ./Data/d${tstamp}.dat w]
set hdr [value_dialog "Enter header for output file:"]
puts $fid "###"
puts $fid "### Output of testdev.tcl on [exec hostname]."
puts $fid "### Edward D. Zaron"
puts $fid "### Dept of Civil and Environmental Engineering"
puts $fid "### Portland State University"
puts $fid "### Portland, OR USA"
puts $fid "### ezaron@pdx.edu"
puts $fid "### 503-725-2435"
puts $fid "###" 
puts $fid "### $hdr"
puts $fid "### Columns are in instrument units:"
puts $fid "### ubar vbar uvar vvar uvcov"
puts $fid "###"
flush $fid

# Enter the event loop and collect data:
while {1 == 1} {
	update idletasks
	set out [rawvel $dev $nsamp]
#	For some reason update idletasks is not enough to force
#	evaluation of the bind script.
#	update idletasks
	update
	puts $outnow
	if {$outnow == 1} {
	    set xval [value_dialog "X Value:"]
	    puts "Writing data to file."
	    puts $fid "$xval $out"
	    set outnow 0
	    flush $fid
	}
}

# How shall we despike or average?

## unused stuff below:
proc getselection {} {
    set ret [.devlist curselection]
    puts "You chose number $ret"
    return $ret
}

proc selectdevice {} {
    # Choose device:
    set devname [split [exec xinput list --name-only] \n]
    set devid   [split [exec xinput list --id-only] \n]

    listbox .devlist
    set count 0
    foreach id $devid {
	set str "id = $id [lindex $devname $count]"
	.devlist insert end $str
	incr count
    }
    
    button .choose -text "Select" -command getselection
    pack .devlist .choose -expand true -fill both

}

#!/usr/local/bin/bltwish

##!/usr/bin/tclsh
#package require Tk
#package require BLT

#!/usr/local/bin/tclsh8.5

# xinput query-state 11
# xinput test 11
# xinput test-xi2
# xinput list-props 11
# sudo tclsh to run this script

# This will increase the mouse polling rate to 1kHz:
# sudo modprobe -r usbhid && sudo modprobe usbhid mousepoll=1
# THEN UN-PLUG AND RE-PLUG MOUSE.
# See https://wiki.archlinux.org/index.php/Mouse_Polling_Rate for other settings.

# Set up tcl/tk with tools we need to graph the data:


namespace import blt::*

# Initialize vectors
set nsamp 250 ;  # nominally, 1 second of data
#set nsamp 1000 ;  # nominally, 1 second of data
set nsamp 6000 ;  # nominally, 3 second of data at 500Hz
set nsamp 60000 ;  # Lng run

# COLLECT A TIME SERIES OF nsamp DURATION AND WRITE TO FILE.

vector create utvec($nsamp) vtvec($nsamp) uvec($nsamp) vvec($nsamp)
vector create vzero($nsamp)

# "xinput list" provides a list of possible input devices.
# Device 11 is the mouse on my laptop.
# Default location (sometimes?)
set dev 9
# After setting polling rate with usbhid:
set dev 15
# Logitech wireless? It seems that after unplugging and replugging, the device comes back on 15:
#set dev 16
#set dev 10
#set dev 11

# Disable the mouse:
proc disablemouse dev {
    # other pointers should continue to work.
    exec xinput disable $dev
}

# Enable the mouse:
proc enablemouse dev {
    exec xinput enable $dev
}

# Determine the file name for accessing the mouse:
proc getnode dev {
	# On puppy linux, the mouse seems to show up at
#	return /dev/sudo modprobe -r usbhid && sudo modprobe usbhid mousepoll=1
# THEN UN-PLUG AND RE-PLUG MOUSE.
# 	Mad CAT:
#	return /dev/input/event8
# Titanium:
#	return /dev/input/event3
	return /dev/input/event2
	# red button is here:
#	return /dev/input/event2
#	return /dev/input/event12

    # Execute xinput and grab the line containing "Device Node"
    set retstr [exec xinput list-props $dev | grep "Device Node"]
    # Parse the result to pull out the file name which is within quotes
    regexp {\"(.+?)\"} $retstr -> match
    return $match
}

# Find out the polling rate on the device:
proc checkrate dev {
    set devnode [getnode $dev]

    # "xinput list-props 11" shows that the mouse is at /dev/input/event6
    # We must run tclsh as root, "sudo tclsh", in order to access the mouse in the following:

    # Open the channel and configure it for directly reading binary data.
    set ms [open $devnode rb]
    chan configure $ms -encoding binary -translation binary -buffering none
    
    puts "Start moving the device and keep it in continuous motion."
    set i 0
    set count 0
    set imax 1000
    set dtsum 0.
    while {$i < $imax} {
	set buf [read $ms 16]
	#    binary scan $buf iissi tvsec tvusec type code value
	binary scan $buf iissi tvsec tvusec type code value
	puts "$tvsec $tvusec $type $code $value"
	# See linux/linux.h for a desciption of the event structure:
	# tvsec
	# tvusec
	# type = 0 (sync) 2 (rel)
	# code = 0 (xaxis) 1 (yaxis)
	# value = amount of change.
	if {$type == 0} {
	    if {$count > 0} {
		set dt    [expr ($tvsec - $tsec)+($tvusec - $tusec)/1.e6]
		set dtsum [expr $dtsum + $dt]
	    }
	    set tsec  $tvsec
	    set tusec $tvusec
	    incr count
	}
	incr i
    }
    set rate [expr $dtsum/$count ] ; # Average dt over test period.
    set rate [expr 1./$rate ] ; # convert rate to Hz = 1/sec
    puts "Found polling rate = $rate Hz from $count samples."

    # Close the channel:
    close $ms

    return
}


# Read the device and compute instantaneous and average velocity in device units.
# Note that the vectors utvec, vtvec, uvec, and vvec are global variables.
proc rawvel {dev nsamp} {
    set devnode [getnode $dev]

    ::utvec set ::vzero
    ::vtvec set ::vzero
    ::uvec  set ::vzero
    ::vvec  set ::vzero

    set uttmp  [list]
    set utmp   [list]
    set vttmp  [list]
    set vtmp   [list]

    # Open the channel and configure it for directly reading binary data.
    # Need to put this in a "catch" statement with reminder to 
    # run tclsh as sudo.
    set ms [open $devnode rb]
    chan configure $ms -encoding binary -translation binary -buffering none

    set i 0
    set buf [read $ms 16]
    #    binary scan $buf iissi tvsec tvusec type code value
    binary scan $buf iissi tsec tusec type code value

#    puts "$tsec $tusec $type $code $value"
    set u_tsec_old  $tsec
    set u_tusec_old $tusec
    set v_tsec_old  $tsec
    set v_tusec_old $tusec
    set t0 [expr $tsec + $tusec/1.e6]

    set ucount 0
    set vcount 0
    while {$i < $nsamp} {
	set buf [read $ms 16]
	#    binary scan $buf iissi tvsec tvusec type code value
	binary scan $buf iissi tsec tusec type code value
#	puts "$tsec $tusec $type $code $value"
	# sec
	# usec
	# type = 0 (sync) 2 (rel)
	# code = 0 (xaxis) 1 (yaxis)
	# value = amount of change.
	# Only record increments when a relative change is reported:

	if {$type == 2} {
	    if {$code == 0} {
		set u_dt    [expr ($tsec - $u_tsec_old)+($tusec - $u_tusec_old)/1.e6]
		set u_tsec_old  $tsec
		set u_tusec_old $tusec
		lappend uttmp  [expr ($tsec+$tusec/1.e6)-$t0]
		#		lappend utmp   [expr $value/$u_dt]
		# It seems that each value returned is a speed, so it is not necessary to divide
		# by the time increment
		lappend utmp   $value
		incr ucount
	    }
	    if {$code == 1} {
		set v_dt    [expr ($tsec - $v_tsec_old)+($tusec - $v_tusec_old)/1.e6]
		set v_tsec_old  $tsec
		set v_tusec_old $tusec
		lappend vttmp  [expr ($tsec+$tusec/1.e6)-$t0]
#		lappend vtmp   [expr $value/$v_dt]
		# It seems that each value returned is a speed, so it is not necessary to divide
		# by the time increment
		lappend vtmp   $value
		incr vcount
	    }
	}
	incr i
#	puts "$ucount $vcount"
    }

    # Close the channel:
    close $ms

    ::utvec set $uttmp
    ::uvec  set $utmp
    ::vtvec set $vttmp
    ::vvec  set $vtmp

    return 0
}

proc value_dialog {string} {
    set w [toplevel .[clock seconds]]
    wm resizable $w 0 0
    wm title $w "Value request"
    wm attributes $w -topmost true
    label  $w.l -text $string
    entry  $w.e -textvar $w -bg white
    bind $w.e <Return> {set done 1}
    button $w.ok     -text OK     -command {set done 1}
    button $w.c      -text Clear  -command "set $w {}"
    button $w.cancel -text Cancel -command "set $w {}; set done 1"
    grid $w.l  -    -        -sticky news
    grid $w.e  -    -        -sticky news
    grid $w.ok $w.c $w.cancel
    focus $w.e
    vwait done
    destroy $w
    set ::$w
}


stripchart .s1 -height 2i -width 8i -bufferelements no
stripchart .s2 -height 2i -width 8i -bufferelements no

pack .s1 .s2

.s1 element create line1 -xdata utvec -ydata uvec -symbol none
.s2 element create line2 -xdata vtvec -ydata vvec -symbol none -color red
#.s1 axis configure y -min -16000 -max 16000
#.s2 axis configure y -min -16000 -max 16000

# Disable the selected device so you can keep using the computer while
# the mouse is collecting data:
# Does not work on puppy linux:
#disablemouse $dev

# Bind keypress event to write the next available out string to file.
global outnow
set outnow 0
bind . <Key> {global outnow ; set outnow 1}

proc newfile {} {
set tstamp [clock format [clock seconds] -format %y%m%dT%H%M%S]
set fid [open ./Data/ts${tstamp}.dat w]
set hdr [value_dialog "Enter header for output file:"]
puts $fid "###"
puts $fid "### Output of testdev.tcl on [exec hostname]."
puts $fid "### Edward D. Zaron"
puts $fid "### Dept of Civil and Environmental Engineering"
puts $fid "### Portland State University"
puts $fid "### Portland, OR USA"
puts $fid "### ezaron@pdx.edu"
puts $fid "### 503-725-2435"
puts $fid "###" 
puts $fid "### $hdr"
puts $fid "### Columns are in instrument units"
puts $fid "### k utvec(k) uvec(k)"
puts $fid "### k vtvec(k) vvec(k)"
flush $fid
return $fid
}

# Enter the event loop and collect data:
while {1 == 1} {
	update idletasks
	set out [rawvel $dev $nsamp]
#	For some reason update idletasks is not enough to force
#	evaluation of the bind script.
#	update idletasks
	update
	puts $outnow
	if {$outnow == 1} {
	    puts "Writing data to file."
	    set fid [newfile]
		set k 0
		while {$k < [::utvec length]} {
		    puts $fid "$k $::utvec($k) $::uvec($k)"
		    incr k
		}
		set k 0
		while {$k < [::vtvec length]} {
		    puts $fid "$k $::vtvec($k) $::vvec($k)"
		    incr k
		}
	    set outnow 0
	    flush $fid
	    close $fid
	}
}

# How shall we despike or average?

## unused stuff below:
proc getselection {} {
    set ret [.devlist curselection]
    puts "You chose number $ret"
    return $ret
}

proc selectdevice {} {
    # Choose device:
    set devname [split [exec xinput list --name-only] \n]
    set devid   [split [exec xinput list --id-only] \n]

    listbox .devlist
    set count 0
    foreach id $devid {
	set str "id = $id [lindex $devname $count]"
	.devlist insert end $str
	incr count
    }
    
    button .choose -text "Select" -command getselection
    pack .devlist .choose -expand true -fill both

}