1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136
|
package require vtk
package require vtkinteraction
set root [toplevel .top -visual {truecolor 24}]
wm title .top "superquadric viewer"
wm protocol .top WM_DELETE_WINDOW ::vtk::cb_exit
# create render window
vtkRenderWindow renWin
set ren [vtkTkRenderWidget $root.ren -width 550 -height 450 -rw renWin]
::vtk::bind_tk_render_widget $ren
# create parameter sliders
set prs [scale $root.prs -from 0 -to 3.5 -res 0.1 -orient horizontal \
-label "phi roundness"]
set trs [scale $root.trs -from 0 -to 3.5 -res 0.1 -orient horizontal \
-label "theta roundness"]
set thicks [scale $root.thicks -from 0.01 -to 1 -res 0.01 -orient horizontal \
-label "thickness"]
set rframe [frame $root.rframe]
set torbut [checkbutton $rframe.torbut -text "Toroid" -variable toroid]
set texbut [checkbutton $rframe.texbut -text "Texture" -variable doTexture]
grid $ren - -sticky news
grid $rframe $thicks -sticky news -padx 10 -ipady 5
grid $rframe -sticky news
grid $prs $trs -sticky news -padx 10 -ipady 5
pack $torbut $texbut -padx 10 -pady 5 -ipadx 20 -ipady 5 -side right -anchor s
pack propagate $rframe no
set renWin1 [$ren GetRenderWindow]
# create pipeline
vtkSuperquadricSource squad
squad SetPhiResolution 20
squad SetThetaResolution 25
vtkPNMReader pnmReader
pnmReader SetFileName "$VTK_DATA_ROOT/Data/earth.ppm"
vtkTexture atext
atext SetInputConnection [pnmReader GetOutputPort]
atext InterpolateOn
vtkAppendPolyData appendSquads
appendSquads AddInputConnection [squad GetOutputPort]
vtkPolyDataMapper mapper
mapper SetInputConnection [squad GetOutputPort]
mapper ScalarVisibilityOff
vtkActor actor
actor SetMapper mapper
actor SetTexture atext
eval [actor GetProperty] SetDiffuseColor 0.5 0.8 0.8
eval [actor GetProperty] SetAmbient 0.2
eval [actor GetProperty] SetAmbientColor 0.2 0.2 0.2
proc setTexture {actor texture win} {
global doTexture
if $doTexture {
$actor SetTexture $texture
} else {
$actor SetTexture {}
}
$win Render
}
proc setPhi {squad win phi} {
$squad SetPhiRoundness $phi
$win Render
}
proc setTheta {squad win theta} {
$squad SetThetaRoundness $theta
$win Render
}
proc setThickness {squad win thickness} {
$squad SetThickness $thickness
$win Render
}
proc setToroid {squad scale win} {
global toroid
$squad SetToroidal $toroid
if {$toroid} {
$scale config -state normal -fg black
} else {
$scale config -state disabled -fg gray
}
$win Render
}
$prs set 1.0
$trs set 0.7
$thicks set 0.3
set toroid 1
set doTexture 0
squad SetPhiRoundness [$prs get]
squad SetThetaRoundness [$trs get]
squad SetToroidal $toroid
squad SetThickness [$thicks get]
squad SetScale 1 1 1
setTexture actor atext $renWin1
# Create renderer stuff
#
vtkRenderer ren1
ren1 SetAmbient 1 1 1
$renWin1 AddRenderer ren1
# Add the actors to the renderer, set the background and size
#
ren1 AddActor actor
ren1 SetBackground 0.25 0.2 0.2
ren1 ResetCamera
[ren1 GetActiveCamera] Zoom 1.2
[ren1 GetActiveCamera] Elevation 40
[ren1 GetActiveCamera] Azimuth -20
# prevent the tk window from showing up then start the event loop
wm withdraw .
update
$prs config -command "setPhi squad $renWin1"
$trs config -command "setTheta squad $renWin1"
$thicks config -command "setThickness squad $renWin1"
$torbut config -command "setToroid squad $thicks $renWin1"
$texbut config -command "setTexture actor atext $renWin1"
|