rheolef 5.93-2 / usr / share / rheolef / vtk_interactor.tcl

#
# This file is part of Rheolef.
#
# Copyright (C) 2000-2009 Pierre Saramito 
#
# Rheolef is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# Rheolef is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with Rheolef; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#
# -------------------------------------------------------------------------

# file vtk-3.1.2/exampleTcl/vtkInt.tcl:
# a generic interactor for tcl and vtk
#
catch {unset vtkInteract.bold}
catch {unset vtkInteract.normal}
catch {unset vtkInteract.tagcount}
set vtkInteractBold "-background #43ce80 -foreground #221133 -relief raised -borderwidth 1"
set vtkInteractNormal "-background #dddddd -foreground #221133 -relief flat"
set vtkInteractTagcount 1
set vtkInteractCommandList ""
set vtkInteractCommandIndex 0

# -----------------------------------------------------------------------------------------
# get vtk version
# -----------------------------------------------------------------------------------------
vtkVersion vtk_version

proc get_vtk_major_version {} {

    return [vtk_version GetVTKMajorVersion]
}
proc get_vtk_minor_version {} {

    return [vtk_version GetVTKMinorVersion]
}
# -------------------------------------------------------
# Save windows as a tiff or png file
# PNG is 30 times smaller, but only supported by vtk-4.0
# -------------------------------------------------------

# global defs
vtkWindowToImageFilter _inter_w2if
vtkTIFFWriter          _inter_tiff_wr

if {[get_vtk_major_version] >= 4} {
    vtkPNGWriter       _inter_png_wr
    set default_image_file_format "png"
} else {
    set default_image_file_format "tiff"
}

proc __save_as_xxx {render_window file_name writer} {
    _inter_w2if SetInput $render_window
    _inter_w2if Modified; # required for animations, as update
    _inter_w2if Update
    $writer SetInput [_inter_w2if GetOutput]
    $writer SetFileName $file_name
    $writer Write
    puts "! file $file_name created";
}
proc save_as_tiff {render_window file_name} {
    __save_as_xxx $render_window $file_name _inter_tiff_wr
}
proc save_as_png {render_window file_name} {
    __save_as_xxx $render_window $file_name _inter_png_wr
}
proc save_as {render_window basename} {
    if {[get_vtk_major_version] >= 4} {
       __save_as_xxx $render_window "$basename.png" _inter_png_wr
    } else {
       __save_as_xxx $render_window "$basename.tiff" _inter_tiff_wr
    }
}
# pre-requis: `render_window' is a global vtk object
proc save_render_window_as_tiff {file_name} {
    save_as_tiff render_window $file_name
}
proc save_render_window_as_png {file_name} {
    save_as_png render_window $file_name
}
proc save_render_window_as {basename} {
    if {[get_vtk_major_version] >= 4} {
       save_as_png  render_window "$basename.png"
    } else {
       save_as_tiff render_window "$basename.tiff"
    }
}
# ------------------------------------------------
# Save windows as a tiff file
# ------------------------------------------------
proc vtk_interact {} {
    global render_window
    global vtkInteractCommandList vtkInteractCommandIndex
    global vtkInteractTagcount
    global default_image_file_format

    proc dovtk {s w} {
	global vtkInteractBold vtkInteractNormal vtkInteractTagcount 
	global vtkInteractCommandList vtkInteractCommandIndex

	set tag [append tagnum $vtkInteractTagcount]
        set vtkInteractCommandIndex $vtkInteractTagcount
	incr vtkInteractTagcount 1
	.vtkInteract.display.text configure -state normal
	.vtkInteract.display.text insert end $s $tag
	set vtkInteractCommandList [linsert $vtkInteractCommandList end $s]
	eval .vtkInteract.display.text tag configure $tag $vtkInteractNormal
	.vtkInteract.display.text tag bind $tag <Any-Enter> \
	    ".vtkInteract.display.text tag configure $tag $vtkInteractBold"
	.vtkInteract.display.text tag bind $tag <Any-Leave> \
	    ".vtkInteract.display.text tag configure $tag $vtkInteractNormal"
	.vtkInteract.display.text tag bind $tag <1> "dovtk [list $s] .vtkInteract"
	.vtkInteract.display.text insert end \n;
	.vtkInteract.display.text insert end [uplevel 1 $s]
	.vtkInteract.display.text insert end \n\n
	.vtkInteract.display.text configure -state disabled
	.vtkInteract.display.text yview end
    }

    catch {destroy .vtkInteract}
    toplevel .vtkInteract -bg #bbbbbb
    wm title .vtkInteract "vtk Interactor"
    wm iconname .vtkInteract "vtk"
    
    frame .vtkInteract.buttons -bg #bbbbbb
    pack  .vtkInteract.buttons -side bottom -fill both -expand 0 -pady 2m
    button .vtkInteract.buttons.dismiss -text Dismiss \
	-command "wm withdraw .vtkInteract" \
	-bg #bbbbbb -fg #221133 -activebackground #cccccc -activeforeground #221133
    pack .vtkInteract.buttons.dismiss -side left -expand 1 -fill x
    button .vtkInteract.buttons.save_as_tiff -text "Save image as \"output.${default_image_file_format}\"" \
	-command {save_render_window_as "output"} \
	-bg #bbbbbb -fg #221133 -activebackground #cccccc -activeforeground #221133
    pack .vtkInteract.buttons.save_as_tiff -side left -expand 1 -fill x

    frame .vtkInteract.file -bg #bbbbbb
    label .vtkInteract.file.label -text "Command:" -width 10 -anchor w \
	-bg #bbbbbb -fg #221133
    entry .vtkInteract.file.entry -width 40 \
	-bg #dddddd -fg #221133 -highlightthickness 1 -highlightcolor #221133
    bind .vtkInteract.file.entry <Return> {
	dovtk [%W get] .vtkInteract; %W delete 0 end}
    pack .vtkInteract.file.label -side left
    pack .vtkInteract.file.entry -side left -expand 1 -fill x
    
    frame .vtkInteract.display -bg #bbbbbb
    text .vtkInteract.display.text -yscrollcommand ".vtkInteract.display.scroll set" \
	-setgrid true -width 60 -height 8 -wrap word -bg #dddddd -fg #331144 \
	-state disabled
    scrollbar .vtkInteract.display.scroll \
	-command ".vtkInteract.display.text yview" -bg #bbbbbb \
	-troughcolor #bbbbbb -activebackground #cccccc -highlightthickness 0 
    pack .vtkInteract.display.text -side left -expand 1 -fill both
    pack .vtkInteract.display.scroll -side left -expand 0 -fill y

    pack .vtkInteract.display -side bottom -expand 1 -fill both
    pack .vtkInteract.file -pady 3m -padx 2m -side bottom -fill x 

    set vtkInteractCommandIndex 0
    
    bind .vtkInteract <Down> {
      if { $vtkInteractCommandIndex < [expr $vtkInteractTagcount - 1] } {
        incr vtkInteractCommandIndex
        set command_string [lindex $vtkInteractCommandList $vtkInteractCommandIndex]
        .vtkInteract.file.entry delete 0 end
        .vtkInteract.file.entry insert end $command_string
      } elseif { $vtkInteractCommandIndex == [expr $vtkInteractTagcount - 1] } {
        .vtkInteract.file.entry delete 0 end
      }
    }

    bind .vtkInteract <Up> {
      if { $vtkInteractCommandIndex > 0 } { 
        set vtkInteractCommandIndex [expr $vtkInteractCommandIndex - 1]
        set command_string [lindex $vtkInteractCommandList $vtkInteractCommandIndex]
        .vtkInteract.file.entry delete 0 end
        .vtkInteract.file.entry insert end $command_string
      }
    }
    wm withdraw .vtkInteract
}
vtk_interact