no display name and no $DISPLAY environment variable
while executing
"load /enadisk/commun/linux/local/ActiveTcl-8.6.11/lib/libtk8.6.so Tk"
("package ifneeded Tk 8.6.11" script)
invoked from within
"package require Tk"
(in namespace eval "::request" script line 15)
invoked from within
"namespace eval ::request $script"
("::try" body line 12)
OUTPUT BUFFER:
# Copyright: 2005-2010 Paul Obermeier (obermeier@tcl3d.org)
#
# See the file "Tcl3D_License.txt" for information on
# usage and redistribution of this file, and for a
# DISCLAIMER OF ALL WARRANTIES.
#
# Module: Tcl3D -> tcl3dSDL
# Filename: joysticktest.tcl
#
# Author: Paul Obermeier
#
# Description: Tcl script to test the joystick related functions of
# the Tcl3D SDL wrapping.
package require Tk
package require tcl3d 0.2
if { [info procs tcl3dHaveSDL] ne "" } {
if { ![tcl3dHaveSDL] } {
tk_messageBox -icon error -type ok -title "Error" \
-message "You do not have SDL installed."
exit
}
}
set MAX_VAL 32767
set MIN_VAL -32768
set MED_VAL 0
proc bgerror { msg } {
tk_messageBox -icon error -type ok -message "Error: $msg\n\n$::errorInfo"
exit
}
proc TestJoystick {} {
set selList [$::joyList curselection]
if { [llength $selList] == 0 } {
return
}
set joyNum [lindex $selList 0]
WatchJoystick $joyNum
}
proc Cleanup {} {
foreach w [winfo children .] {
if { [string match ".test_*" $w] } {
destroy $w
}
}
SDL_QuitSubSystem [expr $::SDL_INIT_VIDEO | $::SDL_INIT_JOYSTICK]
}
proc ExitProg {} {
Cleanup
exit
}
proc StopPolling { joyNum } {
set ::done($joyNum) 1
}
proc ConvertPos { joystickPos axisSize rectHalf } {
set pos [expr int (($joystickPos + $::MAX_VAL) / 65535.0 * $axisSize)]
if { $pos < $rectHalf } {
set pos $rectHalf
} elseif { $pos > [expr $axisSize - $rectHalf] } {
set pos [expr $axisSize - $rectHalf]
}
return $pos
}
proc WatchJoystick { joyNum } {
set axisSize 200
set rectHalf 5
set xpos [expr $axisSize/2]
set ypos [expr $axisSize/2]
set joystick [SDL_JoystickOpen $joyNum]
set topWid .test_$joyNum
if { [winfo exists $topWid] } {
return
}
toplevel $topWid
frame $topWid.btnfr -relief groove
frame $topWid.axisfr -relief sunken
pack $topWid.axisfr $topWid.btnfr -side top
bind $topWid "StopPolling $joyNum"
wm protocol $topWid WM_DELETE_WINDOW "StopPolling $joyNum"
set joyName [SDL_JoystickName $joyNum]
set numAxes [SDL_JoystickNumAxes $joystick]
set numHats [SDL_JoystickNumHats $joystick]
set numBalls [SDL_JoystickNumBalls $joystick]
set numButtons [SDL_JoystickNumButtons $joystick]
wm title $topWid "Joystick [SDL_JoystickIndex $joystick] ($joyName)"
set canvNum 0
for { set i 0 } { $i < [expr $numAxes/2] } { incr i } {
set axisWid($i) $topWid.axisfr.axisCanv_$canvNum
canvas $axisWid($i) -width $axisSize -height $axisSize -bg yellow
pack $axisWid($i) -side left
set rectId [$axisWid($i) create rectangle \
[expr $xpos -$rectHalf] [expr $ypos -$rectHalf] \
[expr $xpos +$rectHalf] [expr $ypos +$rectHalf]]
$axisWid($i) create text $xpos 10 \
-text "Axes [expr $i*2] and [expr $i*2+1]"
incr canvNum
}
for { set i 0 } { $i < $numHats } { incr i } {
set hatWid($i) $topWid.axisfr.axisCanv_$canvNum
canvas $hatWid($i) -width $axisSize -height $axisSize -bg green
pack $hatWid($i) -side left
set rectId [$hatWid($i) create rectangle \
[expr $xpos -$rectHalf] [expr $ypos -$rectHalf] \
[expr $xpos +$rectHalf] [expr $ypos +$rectHalf]]
$hatWid($i) create text $xpos 10 -text "Hat $i"
incr canvNum
}
for { set i 0 } { $i < $numButtons } { incr i } {
set btnNum [expr $i +1]
checkbutton $topWid.btnfr.b_$i -text "B$btnNum" \
-indicatoron 0 -variable ::gBtn($i)
pack $topWid.btnfr.b_$i -side left
}
set ::done($joyNum) 0
set event [SDL_Event]
while { $::done($joyNum) == 0 } {
set evAvailable [SDL_PollEvent $event]
if { $evAvailable != 1 } {
update
continue
}
set evType [$event cget -type]
if { $evType == $::SDL_JOYBUTTONDOWN || \
$evType == $::SDL_JOYBUTTONUP } {
set joybuttonevent [$event cget -jbutton]
set btnNum [$joybuttonevent cget -button]
if { $evType == $::SDL_JOYBUTTONDOWN } {
set ::gBtn($btnNum) 1
} elseif { $evType == $::SDL_JOYBUTTONUP } {
set ::gBtn($btnNum) 0
}
} elseif { $evType == $::SDL_JOYHATMOTION } {
set joyhatevent [$event cget -jhat]
set hatVal [$joyhatevent cget -value]
set xhat 0
set yhat 0
if { $hatVal == $::SDL_HAT_LEFTUP } {
set xhat $::MIN_VAL ; set yhat $::MIN_VAL
} elseif { $hatVal == $::SDL_HAT_UP } {
set xhat $::MED_VAL ; set yhat $::MIN_VAL
} elseif { $hatVal == $::SDL_HAT_RIGHTUP } {
set xhat $::MAX_VAL ; set yhat $::MIN_VAL
} elseif { $hatVal == $::SDL_HAT_LEFT } {
set xhat $::MIN_VAL ; set yhat $::MED_VAL
} elseif { $hatVal == $::SDL_HAT_RIGHT } {
set xhat $::MAX_VAL ; set yhat $::MED_VAL
} elseif { $hatVal == $::SDL_HAT_LEFTDOWN } {
set xhat $::MIN_VAL ; set yhat $::MAX_VAL
} elseif { $hatVal == $::SDL_HAT_DOWN } {
set xhat $::MED_VAL ; set yhat $::MAX_VAL
} elseif { $hatVal == $::SDL_HAT_RIGHTDOWN } {
set xhat $::MAX_VAL ; set yhat $::MAX_VAL
}
set xpos [ConvertPos $xhat $axisSize $rectHalf]
set ypos [ConvertPos $yhat $axisSize $rectHalf]
$hatWid(0) coords $rectId \
[expr $xpos -$rectHalf] [expr $ypos -$rectHalf] \
[expr $xpos +$rectHalf] [expr $ypos +$rectHalf]
} elseif { $evType == $::SDL_JOYBALLMOTION } {
puts "Joystick BALL motion"
} elseif { $evType == $::SDL_JOYAXISMOTION } {
set joyaxisevent [$event cget -jaxis]
set axisNum [$joyaxisevent cget -axis]
set axisVal [$joyaxisevent cget -value]
if { $numAxes >= 2 } {
set xjoy [SDL_JoystickGetAxis $joystick 0]
set xpos [ConvertPos $xjoy $axisSize $rectHalf]
set yjoy [SDL_JoystickGetAxis $joystick 1]
set ypos [ConvertPos $yjoy $axisSize $rectHalf]
$axisWid(0) coords $rectId \
[expr $xpos -$rectHalf] [expr $ypos -$rectHalf] \
[expr $xpos +$rectHalf] [expr $ypos +$rectHalf]
#puts "Motion: Axis $axisNum (Val: $axisVal) ($xjoy, $yjoy)"
}
if { $numAxes >= 4 } {
set xjoy [SDL_JoystickGetAxis $joystick 3]
set xpos [ConvertPos $xjoy $axisSize $rectHalf]
set yjoy [SDL_JoystickGetAxis $joystick 2]
set ypos [ConvertPos $yjoy $axisSize $rectHalf]
$axisWid(1) coords $rectId \
[expr $xpos -$rectHalf] [expr $ypos -$rectHalf] \
[expr $xpos +$rectHalf] [expr $ypos +$rectHalf]
#puts "Motion: Axis $axisNum (Val: $axisVal) ($xjoy, $yjoy)"
}
}
}
SDL_JoystickClose $joystick
destroy $topWid
}
proc ShowJoystickInfo { wid } {
set selList [$::joyList curselection]
if { [llength $selList] == 0 || [SDL_NumJoysticks] == 0 } {
return
}
set joyNum [lindex $selList 0]
set joystick [SDL_JoystickOpen $joyNum]
set numAxes [SDL_JoystickNumAxes $joystick]
set numHats [SDL_JoystickNumHats $joystick]
set numBalls [SDL_JoystickNumBalls $joystick]
set numButtons [SDL_JoystickNumButtons $joystick]
$wid delete 0 end
$wid insert end "$numAxes axes"
$wid insert end "$numHats hats"
$wid insert end "$numBalls balls"
$wid insert end "$numButtons buttons"
SDL_JoystickClose $joystick
}
if { [SDL_Init [expr $::SDL_INIT_VIDEO | $::SDL_INIT_JOYSTICK]] < 0 } {
error [format "Couldn't initialize SDL: %s\n" [SDL_GetError]]
exit 1
}
proc max { a b } {
if { $a >$b } {
return $a
} else {
return $b
}
}
set numJoysticks [SDL_NumJoysticks]
# Master frame. Needed to integrate demo into Tcl3D Starpack presentation.
frame .fr
pack .fr -expand 1 -fill both
frame .fr.joyfr
frame .fr.inffr
frame .fr.btnfr
grid .fr.joyfr -row 0 -column 0 -sticky ews
grid .fr.inffr -row 1 -column 0 -sticky news
grid .fr.btnfr -row 2 -column 0 -sticky news
grid rowconfigure .fr 0 -weight 1
grid columnconfigure .fr 0 -weight 1
set joyList .fr.joyfr.joys
set maxLen 0
for { set i 0 } { $i < $numJoysticks } { incr i } {
set maxLen [max $maxLen [string length [SDL_JoystickName $i]]]
}
listbox $joyList -height [max $numJoysticks 1] -width [max 40 $maxLen]
pack $joyList -expand 1 -fill x
listbox .fr.inffr.info -height 4 -exportselection false
pack .fr.inffr.info -expand 1 -fill x
bind $joyList <1> "ShowJoystickInfo .fr.inffr.info"
wm title . "Tcl3D demo: Jockstick test"
button .fr.btnfr.test -text "Test" -command "TestJoystick"
button .fr.btnfr.quit -text "Quit" -command "ExitProg"
pack .fr.btnfr.test .fr.btnfr.quit -side left -fill x -expand 1
if { $numJoysticks == 0 } {
$joyList insert end "No joysticks found"
.fr.btnfr.test configure -state disabled
} else {
for { set i 0 } { $i < $numJoysticks } { incr i } {
set name [SDL_JoystickName $i]
$joyList insert end $name
set gJoys($i) $name
}
$joyList selection set 0
ShowJoystickInfo .fr.inffr.info
}