Demo 2 of 2 in category tcl3dSDL
 |
# Copyright: 2005-2024 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
if { ! [tcl3dHaveSDL] } {
tk_messageBox -icon error -type ok -title "Missing Tcl3D module" \
-message "Demo needs the tcl3dSDL module."
proc Cleanup {} {}
exit 1
return
}
# The range of values returned by SDL_JoystickGetAxis.
set MIN_VAL $::SDL_JOYSTICK_AXIS_MIN
set MAX_VAL $::SDL_JOYSTICK_AXIS_MAX
set MED_VAL 0
set gAxisSize 200
set gRectHalf 5
set gDeadZone 0
set gDeadZoneRaw 0
proc bgerror { msg } {
tk_messageBox -icon error -type ok -message "Error: $msg\n\n$::errorInfo"
exit
}
proc TestJoystick { joyListbox } {
set selList [$joyListbox curselection]
if { [llength $selList] == 0 } {
return
}
set joyNum [lindex $selList 0]
WatchJoystick $joyNum
}
proc Cleanup {} {
SDL_QuitSubSystem [expr { $::SDL_INIT_VIDEO | $::SDL_INIT_JOYSTICK }]
}
proc StartAnimation {} {
if { [SDL_NumJoysticks] > 0 } {
WatchJoystick 0
}
}
proc ExitProg {} {
for { set i 0 } { $i < [SDL_NumJoysticks] } { incr i } {
StopPolling $i
}
exit
}
proc StopPolling { joyNum } {
global gDone
set gDone($joyNum) 1
}
proc GetDefaultPos {} {
global gAxisSize
return [expr { $gAxisSize / 2 }]
}
proc ConvertPos { joystickPos axisSize rectHalf } {
set pos [expr { int (($joystickPos + $::MAX_VAL) / double($::MAX_VAL - $::MIN_VAL) * $axisSize) }]
if { $pos < $rectHalf } {
set pos $rectHalf
} elseif { $pos > [expr { $axisSize - $rectHalf }] } {
set pos [expr { $axisSize - $rectHalf }]
}
return $pos
}
proc ConvertDeadZone {} {
global gDeadZone
global gDeadZoneRaw
set gDeadZoneRaw [expr { int($gDeadZone / 100.0 * $::MAX_VAL) }]
return $gDeadZoneRaw
}
proc WatchJoystick { joyNum } {
global gAxisSize
global gRectHalf
global gUseAxis
global gAxisLabel
global gDeadZone
global gDeadZoneRaw
global gDone
set xpos [GetDefaultPos]
set ypos [GetDefaultPos]
set joystick [SDL_JoystickOpen $joyNum]
set topWid .fr.demofr
catch { destroy $topWid }
set joyName [SDL_JoystickName $joystick]
labelframe $topWid -text "Joystick $joyNum ($joyName)"
grid .fr.demofr -row 3 -column 0 -sticky new
frame $topWid.menufr
labelframe $topWid.usefr
frame $topWid.btnfr -relief groove
frame $topWid.axisfr -relief sunken
grid $topWid.menufr -row 0 -column 0 -sticky news -columnspan 2
grid $topWid.usefr -row 1 -column 0 -sticky news -rowspan 2
grid $topWid.axisfr -row 1 -column 1 -sticky news
grid $topWid.btnfr -row 2 -column 1 -sticky ns
set numAxes [SDL_JoystickNumAxes $joystick]
set numHats [SDL_JoystickNumHats $joystick]
set numBalls [SDL_JoystickNumBalls $joystick]
set numButtons [SDL_JoystickNumButtons $joystick]
label $topWid.menufr.l -text "DeadZone (%):"
spinbox $topWid.menufr.s -from 0 -to 100 -width 3 -justify right -textvariable gDeadZone -command ConvertDeadZone
label $topWid.menufr.v -textvariable gDeadZoneRaw
pack {*}[winfo children $topWid.menufr] -side left
for { set i 0 } { $i < $numAxes } { incr i } {
set fr $topWid.usefr.fr_$i
frame $fr
pack $fr -side top
set gUseAxis($i) 1
checkbutton $fr.b -text "Axis $i" -variable gUseAxis($i)
label $fr.l -text [format "%6d" 0] -width 6
set gAxisLabel($i) $fr.l
pack $fr.b $fr.l -side left
}
set canvNum 0
for { set i 0 } { $i < [expr { $numAxes / 2 }] } { incr i } {
set axisWid($i) $topWid.axisfr.axisCanv_$canvNum
canvas $axisWid($i) -width $gAxisSize -height $gAxisSize -bg yellow
pack $axisWid($i) -side left
set axisRectId($i) [$axisWid($i) create rectangle \
[expr { $xpos - $gRectHalf }] [expr { $ypos - $gRectHalf }] \
[expr { $xpos + $gRectHalf }] [expr { $ypos + $gRectHalf }]]
$axisWid($i) create line 0 [expr { $gAxisSize / 2 }] $gAxisSize [expr { $gAxisSize / 2 }] -fill red
$axisWid($i) create line [expr { $gAxisSize / 2 }] 0 [expr { $gAxisSize / 2 }] $gAxisSize -fill red
$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 $gAxisSize -height $gAxisSize -bg green
pack $hatWid($i) -side left
set hatRectId($i) [$hatWid($i) create rectangle \
[expr { $xpos - $gRectHalf }] [expr { $ypos - $gRectHalf }] \
[expr { $xpos + $gRectHalf }] [expr { $ypos + $gRectHalf }]]
$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 gDone($joyNum) 0
set event [SDL_Event]
while { $gDone($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 $gAxisSize $gRectHalf]
set ypos [ConvertPos $yhat $gAxisSize $gRectHalf]
$hatWid(0) coords $hatRectId(0) \
[expr { $xpos - $gRectHalf }] [expr { $ypos - $gRectHalf }] \
[expr { $xpos + $gRectHalf }] [expr { $ypos + $gRectHalf }]
} elseif { $evType == $::SDL_JOYBALLMOTION } {
puts "Joystick BALL motion"
} elseif { $evType == $::SDL_JOYAXISMOTION } {
for { set i 0 } { $i < [expr { $numAxes / 2 }] } { incr i } {
set xaxis [expr { $i * 2 + 0 }]
set yaxis [expr { $i * 2 + 1 }]
set xjoy [SDL_JoystickGetAxis $joystick $xaxis]
if { [Abs $xjoy] < [ConvertDeadZone] } {
set xjoy 0
}
set yjoy [SDL_JoystickGetAxis $joystick $yaxis]
if { [Abs $yjoy] < [ConvertDeadZone] } {
set yjoy 0
}
$gAxisLabel($xaxis) configure -text [format "%6d" $xjoy]
$gAxisLabel($yaxis) configure -text [format "%6d" $yjoy]
set xpos [GetDefaultPos]
set ypos [GetDefaultPos]
if { $gUseAxis($xaxis) } {
set xpos [ConvertPos $xjoy $gAxisSize $gRectHalf]
}
if { $gUseAxis($yaxis) } {
set ypos [ConvertPos $yjoy $gAxisSize $gRectHalf]
}
$axisWid($i) coords $axisRectId($i) \
[expr { $xpos - $gRectHalf }] [expr { $ypos - $gRectHalf }] \
[expr { $xpos + $gRectHalf }] [expr { $ypos + $gRectHalf }]
}
}
}
$event -delete
SDL_JoystickClose $joystick
}
proc ShowJoystickInfo { joyListbox wid } {
set selList [$joyListbox 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 configure -state normal
$wid delete 0 end
$wid insert end "$numAxes axes"
$wid insert end "$numHats hats"
$wid insert end "$numBalls balls"
$wid insert end "$numButtons buttons"
$wid configure -state disabled
SDL_JoystickClose $joystick
}
proc Abs { a } {
if { $a < 0 } {
return [expr { -$a }]
} else {
return $a
}
}
proc Max { a b } {
if { $a >$b } {
return $a
} else {
return $b
}
}
if { [SDL_Init [expr { $::SDL_INIT_JOYSTICK }]] < 0 } {
error [format "Couldn't initialize SDL: %s\n" [SDL_GetError]]
exit 1
}
set numJoysticks [SDL_NumJoysticks]
# Master frame. Needed to integrate demo into Tcl3D Starpack presentation.
frame .fr
pack .fr -expand 1 -fill both
frame .fr.btnfr
frame .fr.joyfr
frame .fr.infofr
frame .fr.demofr
frame .fr.statfr
grid .fr.btnfr -row 0 -column 0 -sticky news
grid .fr.joyfr -row 1 -column 0 -sticky new
grid .fr.infofr -row 2 -column 0 -sticky new
grid .fr.demofr -row 3 -column 0 -sticky new
grid .fr.statfr -row 4 -column 0 -sticky news
grid rowconfigure .fr 3 -weight 1
grid columnconfigure .fr 0 -weight 1
set joyListbox .fr.joyfr.joys
set maxLen 0
for { set i 0 } { $i < $numJoysticks } { incr i } {
set maxLen [Max $maxLen [string length [SDL_JoystickNameForIndex $i]]]
}
listbox $joyListbox -height [Max $numJoysticks 1] -width [Max 40 $maxLen]
pack $joyListbox -expand 1 -fill x
listbox .fr.infofr.info -height 4 -exportselection false
pack .fr.infofr.info -expand 1 -fill x
bind $joyListbox <ButtonRelease-1> "ShowJoystickInfo $joyListbox .fr.infofr.info"
bind . <Key-Escape> ExitProg
wm protocol . WM_DELETE_WINDOW ExitProg
wm title . "Tcl3D demo: Jockstick test"
button .fr.btnfr.test -text "Test selected joystick" -command "TestJoystick $joyListbox"
pack .fr.btnfr.test -side left -fill x -expand 1
label .fr.statfr.stat
pack .fr.statfr.stat -fill x -expand 1
.fr.statfr.stat configure -text [tcl3dSDLGetInfoString]
if { $numJoysticks == 0 } {
$joyListbox insert end "No joysticks found"
.fr.btnfr.test configure -state disabled
} else {
for { set i 0 } { $i < $numJoysticks } { incr i } {
set name [SDL_JoystickNameForIndex $i]
$joyListbox insert end $name
set gJoys($i) $name
}
$joyListbox selection set 0
ShowJoystickInfo $joyListbox .fr.infofr.info
if { [file tail [info script]] eq [file tail $::argv0] } {
# If started directly from tclsh or wish, then start animation.
TestJoystick $joyListbox
}
}
|
