Angle Tcl Script
|
|
|
Angle Tcl Script.# This procedure is called in init entry point. It defines joint's IDs of the chain.
proc angleInit {} {
global chainElementsID
global env
# Source file with procedure which calculates value of the angle given by three points.
source [file join $env(SI_LOCATION) 3D custom SoftWish SoftWishDemos \
behaviorDemo SW_angle.tcl]
# Retrieve leave of the chain. Since it is element with attached script use procedure
# SWB_getCurrentElement.
set leaveID [ SWB_getCurrentElement ]
# Allocate and retrieve middle joint of the chain.
set joint2ID [ SAA_AllocElem ]
if [ catch { SAA_chainGetPrevLimb [ SWB_getScene ] $leaveID $joint2ID } err ] {
SAA_Free $joint2ID
return -code error $err
}
# Allocate and retrieve root joint of the chain.
set joint1ID [ SAA_AllocElem ]
if [ catch { SAA_chainGetPrevLimb [ SWB_getScene ] $joint2ID $joint1ID } err ] {
SAA_Free $joint2ID
SAA_Free $joint1ID
return -code error $err
}
# Store all joints in the list.
set chainElementsID [ list $leaveID $joint2ID $joint1ID ]
}
# This procedure creates widget for angle value output.
proc angleWidget {} {
global tcl_platform
global currentAngle
# If TK package is not loaded then load it.
if { [info comm toplevel] == "" } {
package require Tk
wm withdraw .
}
# Create toplevel widget and set its title.
set t [ toplevel .angleWidget]
wm title $t "Behavior Demo"
# Create a message.
message $t.msg -text "Angle between joints" -aspect 1000
# Pack the message.
pack $t.msg -side top
# Create the entry for angle value output.
entry $t.etrn -textvariable currentAngle
# Pack the entry.
pack $t.etrn -side top -pady 4
# Place the widget in to left upper corner of the screen.
wm geometry $t 190x64+10+10
# Pop the widget to the top.
Pop2Top $t
return $t
}
# Init entry point.
proc initBehavior {} {
global angleTopLev
package require Pop2Top
# Call procedure that allows to select whether you want to print out angle values
# to a file as well as to the screen.
fileOtputWidget
# Call procedure that defines joint's IDs of the chain.
angleInit
# Create output widget.
set angleTopLev [ angleWidget ]
}
# Update entry point.
proc updateBehavior {} {
global chainElementsID
global angleTopLev
global currentAngle
global outputFile
global tcl_platform
# Calculate the angle.
set angle [ SW_angle [lindex $chainElementsID 0] \
[lindex $chainElementsID 1] [lindex $chainElementsID 2] \
[SWB_getScene] ]
set currentAngle [ expr 180 * $angle / 3.14 ]
# If user choose to save output in a file then append angle value to the file.
if { $outputFile != 0 } {
if [catch {open $outputFile {WRONLY APPEND CREAT} } fileID] {
tk_messageBox -icon error -message "$fileID" -title "File open error!" -type ok
set outputFile 0
return
}
puts $fileID $currentAngle
close $fileID
}
Pop2Top $angleTopLev
}
# Clean up entry point. Free memory, unset global variables and destroy output widget.
proc cleanupBehavior {} {
global chainElementsID
global angleTopLev
global currentAngle
global outputFile
SAA_Free [ lindex $chainElementsID 1 ]
SAA_Free [ lindex $chainElementsID 2 ]
destroy $angleTopLev
update
unset chainElementsID
unset angleTopLev
unset currentAngle
unset outputFile
}
# This procedure gives user the possibility to select the output file.
proc fileOtputWidget {} {
global tcl_platform
global outputFile
# Load Tk package if it is not loaded yet.
if { [info comm toplevel] == "" } {
package require Tk
wm withdraw .
}
# Create a toplevel widget and set its title.
set t [ toplevel .fileOtputWidget ]
wm title $t "Behavior Demo"
# Create a message.
message $t.msg -text "Save results to file" -aspect 1000
# Pack the message.
pack $t.msg -side top
# Create an entry for the output file name.
set fileSel [ frame $t.fileSel ]
entry $fileSel.etrn -textvariable outputFile -width 25 -highlightcolor gray50
# Pack the entry.
pack $fileSel.etrn -side left -pady 6 -padx 6
# Create a browse button for selecting the output file.
button $fileSel.browse -text "Browse" -underline 0 \
-highlightcolor gray50 -command { set outputFile [tk_getOpenFile] }
# Pack the button.
pack $fileSel.browse -side right -pady 6 -padx 6
pack $fileSel -side top
# Create Ok and Cancel buttons.
set control [ frame $t.control ]
button $control.ok -text "Ok" -underline 0 -highlightcolor \
gray50 -command "okCommand $t"
button $control.can -text "Cancel" -underline 0 -highlightcolor \
gray50 -command "set outputFile 0 ; destroy $t"
# Pack Ok and Cancel buttons.
pack $control.ok $control.can -side left -pady 6
pack $control -side top
Pop2Top $t
tkwait window $t
}
# Procedure is executed when user pushes Ok button.
proc okCommand { topLev } {
global outputFile
if ![ file isdirectory [file dirname $outputFile]] {
tk_messageBox -icon error -message "$outputFile is not a directory"\
-title "File error!" -type ok
return
}
destroy $topLev
}
|
|
copyright Video-Collage Inc. |