You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
99 lines
1.8 KiB
99 lines
1.8 KiB
package require vtk
|
|
package require vtkinteraction
|
|
|
|
# prevent the tk window from showing up then start the event loop
|
|
wm withdraw .
|
|
|
|
vtkRenderWindow renWin
|
|
|
|
# create a rendering window and renderer
|
|
vtkRenderer ren1
|
|
renWin AddRenderer ren1
|
|
renWin SetSize 400 400
|
|
|
|
|
|
vtkSpherePuzzle puzzle
|
|
vtkPolyDataMapper mapper
|
|
mapper SetInputConnection [puzzle GetOutputPort]
|
|
vtkActor actor
|
|
actor SetMapper mapper
|
|
|
|
vtkSpherePuzzleArrows arrows
|
|
vtkPolyDataMapper mapper2
|
|
mapper2 SetInputConnection [arrows GetOutputPort]
|
|
vtkActor actor2
|
|
actor2 SetMapper mapper2
|
|
|
|
|
|
|
|
|
|
# Add the actors to the renderer, set the background and size
|
|
#
|
|
ren1 AddActor actor
|
|
ren1 AddActor actor2
|
|
|
|
ren1 SetBackground 0.1 0.2 0.4
|
|
|
|
|
|
set LastVal -1
|
|
proc MotionCallback {x y} {
|
|
global LastVal
|
|
|
|
# Compute display point from Tk display point.
|
|
set WindowY 400
|
|
set y [expr $WindowY - $y]
|
|
set z [ren1 GetZ $x $y]
|
|
|
|
ren1 SetDisplayPoint $x $y $z
|
|
ren1 DisplayToWorld
|
|
set pt [ren1 GetWorldPoint]
|
|
|
|
#tk_messageBox -message "$pt"
|
|
set x [lindex $pt 0]
|
|
set y [lindex $pt 1]
|
|
set z [lindex $pt 2]
|
|
|
|
set val [puzzle SetPoint $x $y $z]
|
|
if {$val != $LastVal} {
|
|
renWin Render
|
|
set LastVal $val
|
|
}
|
|
}
|
|
|
|
|
|
proc ButtonCallback {x y} {
|
|
|
|
# Compute display point from Tk display point.
|
|
set WindowY 400
|
|
set y [expr $WindowY - $y]
|
|
set z [ren1 GetZ $x $y]
|
|
|
|
ren1 SetDisplayPoint $x $y $z
|
|
ren1 DisplayToWorld
|
|
set pt [ren1 GetWorldPoint]
|
|
|
|
#tk_messageBox -message "$pt"
|
|
set x [lindex $pt 0]
|
|
set y [lindex $pt 1]
|
|
set z [lindex $pt 2]
|
|
|
|
for { set i 0} {$i <= 100} {set i [expr $i + 5]} {
|
|
puzzle SetPoint $x $y $z
|
|
puzzle MovePoint $i
|
|
renWin Render
|
|
}
|
|
}
|
|
|
|
renWin Render
|
|
|
|
set cam [ren1 GetActiveCamera]
|
|
$cam Elevation -40
|
|
update
|
|
|
|
ButtonCallback 261 272
|
|
arrows SetPermutation puzzle
|
|
renWin Render
|
|
|
|
|
|
|
|
|
|
|