vtkCubeSource, vtkSphereSource, vtkConeSource, vtkCylinderSource, vtkPlaneSource, vtkDiskSource, vtkRegularPolygonSource, vtkArrowSource, vtkEarthSource

# primitive-vtk.tcl
# Author:      Gerard Sookahet
# Date:        02 June 2018
# Version:     0.1
# Description: Primitive objects visualization with VTK and Tcl-Tk user interface

# load the VTK Tcl package and load the vtkinteraction package that contains 
# default bindings for handling mouse and keyboard events for a render widget
# Default keyboard events are :
#  e / q / ESC : exit
#  s : surface rendering
#  w : wireframe rendering
#  r : reset camera

package require vtk
package require vtkinteraction

# Flat UI
option add *Button.relief flat
option add *Button.foreground white
option add *Button.background blue
option add *Button.width 14
option add *Label.foreground blue
option add *Label.background orange
option add *Label.width 14
option add *Entry.relief flat
option add *Entry.background lightblue
option add *Entry.width 2
option add *Text.foreground lightgreen
option add *Text.background black

global color
global renWin
set color 1

set w .prim
catch {destroy $w} 
toplevel $w
wm title $w "Primitive Objects Visualization"
wm protocol $w WM_DELETE_WINDOW ::vtk::cb_exit

# Create render window inside a Tk widget and bind the mouse events
::vtk::bind_tk_render_widget [vtkTkRenderWidget $w.rw -width 600 -height 600]
#
# Get the render window associated with the widget
set renWin [$w.rw GetRenderWindow] 
vtkRenderer ren
$renWin AddRenderer ren

# Start VTK pipeline
# Source -> Mapper -> Actor ->  Renderer

# Create an instance of a primitive object (vtkCubeSource) 
vtkCubeSource obj

# Create an instance of vtkPolyDataMapper to map the polygonal data 
# into graphics primitives and connect the output of the obj source
# to the input of this mapper 
vtkPolyDataMapper objMapper
objMapper SetInputConnection [obj GetOutputPort]

# Create an actor to represent the obj. The actor coordinates rendering of
# the graphics primitives for a mapper. We set this actor's mapper to be
# the mapper which we created above.
vtkLODActor actor
actor SetMapper objMapper

# Assign a blue color to our actor
[actor GetProperty] SetColor 0 0 1

# Create the Renderer and add actors to it (ren AddViewProp actor also works) 
# A renderer is like a viewport. It is part or all of a window on the screen 
# and it is responsible for drawing the actors it has. 
ren AddActor actor

# Set the background color and render
ren SetBackground 0 0 0
ren Render

# prevent the tk window from showing up then start the event loop
wm withdraw .

set f0 [frame $w.f0 -bg black] 
set f1 [frame $f0.f1 -relief flat -borderwidth 0 -bg black]
set f2 [frame $f0.f2 -relief flat -borderwidth 0 -bg black]
pack $f1 $f2 -pady 4

label $f1.l1 -text "       Rendering       " 
button $f1.clr -text "Change Color" -width 14 -command {ChangeColor}

pack {*}[winfo children $f1] -pady 2

label $f2.l2 -text "          Object          "
set l {vtkCubeSource vtkSphereSource vtkConeSource vtkCylinderSource vtkPlaneSource \
        vtkDiskSource vtkRegularPolygonSource vtkArrowSource vtkEarthSource}
foreach i $l {
 button $f2.$i -text [string map {vtk "" Source ""} $i] -command "ChangeObject $i"
}

pack {*}[winfo children $f2] -pady 2

button $f0.exit  -text Quit  -width 14 -command {exit}
button $f0.about -text About -width 14 -command {About}
pack $f0.exit -side bottom -pady 2
pack $f0.about -side bottom

pack $w.rw $f0 -side left -anchor nw -fill both -expand 1 

# Change obj color between red green blue
proc ChangeColor {} {
    global color
    global renWin

 switch $color {
       0 {
          set rgb "0 0 1"
          set color 1
       }
       1 {
          set rgb "0 1 0"
          set color 2
       }
       2 {
          set rgb "1 0 0"
          set color 0
       }
 }

 for {set i 1} {$i <= 100} {incr i 5} { 
    after 30
    set r [lindex $rgb 0]
    set g [lindex $rgb 1]
    set b [lindex $rgb 2]
    set i100 [expr {$i/100.0}]
    [actor GetProperty] SetColor [expr {$i100*$r}] [expr {$i100*$g}] [expr {$i100*$b}]
    $renWin Render
 }
}

# Change obj primitive and set some of its properties
proc ChangeObject {actor} {
    global renWin
    
 obj Delete
 $actor obj
 switch $actor {
   vtkConeSource -
   vtkCylinderSource {obj SetResolution 20}
   vtkSphereSource {
      obj SetThetaResolution 16
      obj SetPhiResolution 16
   }
   vtkDiskSource {
      obj SetInnerRadius 0.3
      obj SetOuterRadius 0.8
      obj SetRadialResolution 1
      obj SetCircumferentialResolution 20
   }
   vtkEarthSource {
      obj SetRadius 0.6
      obj OutlineOff
      obj SetOnRatio 1
   }
 }
 objMapper SetInputConnection [obj GetOutputPort]
 $renWin Render
}

proc About {} {
 set w .about
 catch {destroy $w}
 toplevel $w
 .about configure -bg black
 wm title $w "About VTK primitive"
 set txt "VTK Primitive Object Visualization \n June 2018 \n Gerard Sookahet"
 message $w.msg -justify left -aspect 250 -relief flat -bg black -fg lightblue -text $txt
 button $w.bquit -text " OK " -command {destroy .about}
 pack $w.msg $w.bquit
}

• Home
• Recent changes
• Help
• WhoAmI/Logout
• Create new page
• Random page
• Previous page
• Next page
• 
  
• Add comments
• Edit
• History
• Edit summary
• References