#include the necessary packages
package require vtk
package require vtkinteraction

#Create a sphere
vtkSphereSource sphere
    sphere SetThetaResolution 8
    sphere SetPhiResolution 8
   
#Create a new polydata mapper and
#set the input to the sphere

vtkPolyDataMapper sphereMapper
    sphereMapper SetInput [sphere GetOutput]

#Create a new actor to reference the sphere
vtkActor sphereActor
    sphereActor SetMapper sphereMapper
      
#Create a new cube
vtkCubeSource cube

#Set the cube position and size
   cube SetCenter 1 1 1
   cube SetXLength 1
   cube SetYLength 1
   cube SetZLength 2
   
#Create a new poly data mapper and set
#it to the cube
vtkPolyDataMapper cubeMapper
   cubeMapper SetInput [cube GetOutput]

#Create a new actor to reference the cube
vtkActor cubeActor
   cubeActor SetMapper cubeMapper
   
# Create a new renderer and render window
vtkRenderer ren1
vtkRenderWindow renWin
    renWin AddRenderer ren1

ren1 SetBackground .5 0 .5

#add the actors to the scene
ren1 AddActor sphereActor
ren1 AddActor cubeActor

#Create a vtk Render Widget. This is an
#object which provides a mechanism allowing
#tcl/tk to interact with the renderwindow

set vtkw [vtkTkRenderWidget .ren \
       -width 300 \
       -height 300 \
       -rw renWin]

#Because we are using the tcl/tk RenderWidget
#we can't use the standart vtkRenderWindowInteractor
#instead we use BindTkRenderWidget to provide the
#standard functionality that RenderWindowInteractor
#would otherwise do for us.
BindTkRenderWidget $vtkw

#bind the x key to the ToggleWireframe function
bind $vtkw <KeyPress-x> {ToggleWireframe}

#flag to set whether wireframe is on or off
set wf 0

proc ToggleWireframe {} {
   global wf
   
   #get a reference to all the actors in the
   #current render
   set actors [ren1 GetActors]
   
   #Loop through all the actors and set the new
   #visualization mode
   $actors InitTraversal
   set actor [$actors GetNextItem]
   while {$actor != ""} {
      if {$wf == 0} {
         [$actor GetProperty] SetRepresentationToWireframe
      } elseif {$wf == 1} {
         [$actor GetProperty] SetRepresentationToPoints
      } else {
         [$actor GetProperty] SetRepresentationToSurface
      }
      
      set actor [$actors GetNextItem]
   }
   
   #Set the visualization mode flag
   if {$wf == 0} {
      set wf 1
   } elseif {$wf == 1} {
      set wf 2
   } else {
      set wf 0
   }
   
   #redraw the scene
   renWin Render
}

#bind the c key to toggle the cube on or off
bind $vtkw <KeyPress-c> {ToggleCube}

set cb 0

proc ToggleCube {} {
   global cb
   
   #if the cube is currently in the scene
   #remove it otherwise add it
   if {$cb == 0} {
      ren1 RemoveActor cubeActor
      set cb 1
   } else {
      ren1 AddActor cubeActor
      set cb 0
   }
   
   renWin Render
}

#bind the v key to toggle the sphere on or off
bind $vtkw <KeyPress-v> {ToggleSphere}

set sp 0

proc ToggleSphere {} {
   global sp
   if {$sp == 0} {
      ren1 RemoveActor sphereActor
      set sp 1
   } else {
      ren1 AddActor sphereActor
      set sp 0
   }
   
   renWin Render
}

#bind the b key to set the SetActor function
bind $vtkw <KeyPress-b> {SetActor}

vtkActor CurrentActor
set CurrentActor cubeActor
set aId 0

#Toggle which actor the CurrentActor is pointing to
proc SetActor {} {
   global CurrentActor
   global aId
   if {$aId == 0} {
      set CurrentActor cubeActor
      set aId 1
      puts "Current Actor: Cube"
   } else {
      set CurrentActor sphereActor
      set aId 0
      puts "Current Actor: Sphere"
   }
}

#bind the y key to the CycleColor procedure
bind $vtkw <KeyPress-y> {CycleColor}

set c 0

#Cycle the color of the current actor
proc CycleColor {} {
   global c
   global CurrentActor
   
   if {$c == 0} {
      [$CurrentActor GetProperty] SetColor 255 0 0
      set c 1
   } elseif {$c == 1} {
      [$CurrentActor GetProperty] SetColor 0 255 0
      set c 2
   } else {
      [$CurrentActor GetProperty] SetColor 0 0 255
      set c 0
   }
   
   renWin Render
}

#The following set of bindings and procedures
#changes the size of the cube actor
bind $vtkw <KeyPress-h> {GrowY}

proc GrowY {} {
   set y [cube GetYLength]
   set y [expr $y + 1]
   cube SetYLength $y
   renWin Render
}

bind $vtkw <KeyPress-n> {ShrinkY}

proc ShrinkY {} {
   set y [cube GetYLength]
   set y [expr $y - 1]
   if {$y < 1} {set y 1}
   cube SetYLength $y
   renWin Render
}

bind $vtkw <KeyPress-j> {GrowZ}

proc GrowZ {} {
   set z [cube GetZLength]
   set z [expr $z + 1]
   cube SetZLength $z
   renWin Render
}

bind $vtkw <KeyPress-m> {ShrinkZ}

proc ShrinkZ {} {
   set z [cube GetZLength]
   set z [expr $z - 1]
   if {$z < 1} {set z 1}
   cube SetZLength $z
   renWin Render
}

bind $vtkw <KeyPress-k> {GrowX}

proc GrowX {} {
   set x [cube GetXLength]
   set x [expr $x + 1]
   cube SetXLength $x
   renWin Render
}

bind $vtkw <KeyPress-l> {ShrinkX}

proc ShrinkX {} {
   set x [cube GetXLength]
   set x [expr $x - 1]
   if {$x < 1} {set x 1}
   cube SetXLength $x
   renWin Render
}

#put the window in the frame and display it
frame .params
pack $vtkw .params -side top -fill both -expand yes

wm protocol . WM_DELETE_WINDOW bye
proc bye {} {
    vtkCommand DeleteAllObjects
    exit
}

# You only need this line if you run this script from a Tcl shell
# (tclsh) instead of a Tk shell (wish)
tkwait window .

TCL/TK Tutorial Part 1: Installation Part 2: Molecules Part 3: Terrain Part 4: Interactive Part 5: Shapes