interfaces/xmaxima/Tkmaxima/scene.tcl

   1 #  $Id: scene.tcl,v 1.2 2011-03-19 23:13:04 villate Exp $
   2 #
   3 ###### scene.tcl ######
   4 # Copyright (c) 2011, Jaime E. Villate <villate@fe.up.pt>
   5 #
   6 # Interface to the Visualization Toolkit (VTK) for Xmaxima
   7 # (the license information can be found in COPYING.tcl)
   8
   9 global sceneOptions
  10 set sceneOptions {
  11     {background {0 0 0} {red green and blue values for the background}}
  12     {width 500 {Rendering screen width in pixels}}
  13     {height 500 {Rendering screen height in pixels}}
  14     {windowname {.scene} {Window name}}
  15     {windowtitle {Xmaxima: scene} {Window title}}
  16     {azimuth 135 {Azimuth angle}}
  17     {elevation 30 {Elevation angle}}
  18     {tstep 10 {Time interval between iterations, in milliseconds}}
  19     {restart 0 {If different from zero, the animation will loop forever.}}
  20     {objects  {} {A list of Objects of the form {{Class {options}} ...}}}
  21 }
  22
  23
  24 proc PlayStep {frame} {
  25     linkLocal $frame playing iteration prev_iteration maxiter trackers \
  26         restart animate tstep renwin
  27     if { $iteration<0 } {
  28         foreach obj $trackers {
  29             set name [lindex $obj 0]
  30             "$name:points" Initialize
  31             "$name:points" Modified
  32             "$name:lines" Initialize
  33             "$name:lines" Modified
  34         }
  35       }
  36     if {$iteration < $maxiter } {
  37         incr iteration
  38         uplevel $frame.menubar.play configure -image ::img::pause
  39         foreach anim_obj $animate {
  40             set name [lindex $anim_obj 0]
  41             set prop [lindex $anim_obj 1]
  42             set values [lindex $anim_obj 3]
  43             if { $iteration < [llength $values] } {
  44                 eval "$name:actor" "Set$prop" [lindex $values $iteration]
  45             } elseif { $prev_iteration < [llength $values] } {
  46                 eval "$name:actor" "Set$prop" [lindex $values end]
  47             }
  48         }
  49         foreach obj $trackers {
  50             set name [lindex $obj 0]
  51             if { $iteration <= [lindex $obj 1] } {
  52                 eval "$name:points" InsertPoint $iteration ["$name:actor" GetPosition]
  53                 "$name:points" Modified
  54                 if { $iteration<1 } {
  55                     "$name:lines" InsertNextCell 1
  56                     "$name:lines" InsertCellPoint $iteration
  57                 } else {
  58                     "$name:lines" InsertNextCell 2
  59                     "$name:lines" InsertCellPoint $prev_iteration
  60                     "$name:lines" InsertCellPoint $iteration
  61                     "$name:lines" Modified
  62                 }
  63             } elseif { $prev_iteration < [lindex $obj 1] } {
  64                 eval "$name:points" InsertPoint [lindex $obj 1] ["$name:actor" GetPosition]
  65                 "$name:points" Modified
  66                 "$name:lines" InsertNextCell 2
  67                 "$name:lines" InsertCellPoint $prev_iteration
  68                 "$name:lines" InsertCellPoint [lindex $obj 1]
  69                 "$name:lines" Modified
  70             }
  71         }
  72         if { $iteration<1 } {
  73             set prev_iteration 0
  74         } else {
  75             set prev_iteration [expr $iteration-1]
  76         }
  77         $renwin Render
  78     }
  79     if {$iteration < $maxiter } {
  80         if {$playing == 1} {
  81             after $tstep PlayStep $frame
  82         }
  83     } else {
  84         if {$restart} {
  85             set iteration -1
  86             set trackers {}
  87             after $tstep PlayStep $frame
  88         } else {
  89             uplevel stopAnimation $frame
  90         }
  91     }
  92 }
  93
  94 proc playAnimation {frame} {
  95     linkLocal $frame playing
  96     if {$playing == 0} {
  97         set playing 1
  98         uplevel PlayStep $frame
  99     } else {
 100         uplevel stopAnimation $frame
 101     }
 102 }
 103 proc stopAnimation {frame} {
 104     linkLocal $frame iteration playing
 105     after cancel PlayStep $frame
 106     set playing 0
 107     uplevel $frame.menubar.play configure -image ::img::play
 108 }
 109 proc startAnimation {frame} {
 110     linkLocal $frame iteration prev_iteration playing
 111     after cancel PlayStep $frame
 112     set playing 0
 113     set iteration -1
 114     set prev_iteration 0
 115     uplevel PlayStep $frame
 116     uplevel $frame.menubar.play configure -image ::img::play
 117 }
 118 proc endAnimation {frame} {
 119     linkLocal $frame maxiter iteration prev_iteration
 120     after cancel PlayStep $frame
 121     set prev_iteration $iteration
 122     set iteration [expr $maxiter-1]
 123     uplevel PlayStep $frame
 124 }
 125
 126 proc makeVTKFrame { w type } {
 127     global doExit fontSize buttonfont maxima_priv
 128     linkLocal $w width height restart renwin windowtitle
 129     set win $w
 130     if { "$w" == "." } {
 131         set w ""
 132     } else {
 133         catch { destroy $w}
 134         frame $w
 135     }
 136     set dismiss "destroy [winfo toplevel $win]"
 137     if { "$doExit" != "" } {set dismiss $doExit }
 138     oset $w type $type
 139
 140     set top $w
 141     catch { set top [winfo parent $w]}
 142     catch {
 143         wm title $top $windowtitle
 144         wm iconname $top "scene"
 145     }
 146
 147     set buttonFont $buttonfont
 148     oset $win buttonFont $buttonfont
 149     set mb [frame $w.menubar]
 150     pack $mb -fill x
 151
 152     set dismiss [concat "vtkCommand DeleteAllObjects;" \
 153                      "after cancel PlayStep $mb.play;" $dismiss \
 154                      "; clearLocal $win"]
 155     # define exit command fot the scene window
 156     wm protocol $top WM_DELETE_WINDOW \
 157         "after cancel PlayStep $mb.play; vtkCommand DeleteAllObjects; destroy $top; clearLocal $win"
 158
 159     button $mb.play -image ::img::play -text [mc "Play"] \
 160         -command "playAnimation $w"
 161     button $mb.start -image ::img::start -text [mc "Start"] \
 162         -command "startAnimation $w"
 163     button $mb.end -image ::img::end -text [mc "End"] \
 164         -command "endAnimation $w"
 165     button $mb.config -image ::img::config -text [mc "Config"]
 166     button $mb.close -image ::img::close -text [mc "Close"] -command $dismiss
 167     if {$restart} {
 168         $mb.end configure -state disabled
 169     }
 170     set c $w.c
 171     oset $win c $c
 172     canvas $c  -borderwidth 2 -scrollregion {-1200 -1200 1200 1200}
 173
 174     # Create a Tk widget that we can render into.
 175     set vtkw [vtkTkRenderWidget $c.ren -width $width -height $height -rw $renwin]
 176     # Setup Tk bindings and VTK observers for that widget.
 177     ::vtk::bind_tk_render_widget $vtkw
 178
 179     pack $vtkw -side left -fill both -expand 1
 180     pack $mb.play $mb.start $mb.end -side left
 181     pack $mb.close $mb.config -side right
 182 # FIX ME: these bindings do not work inside the VTK frame, because it
 183 # has its own bindings.
 184     bind $c <Control-w> $dismiss
 185     bind $c <p> "playAnimation $w"
 186     pack $c -side right -expand 1 -fill both
 187     pack $w
 188     focus $w
 189     return $w
 190 }
 191
 192 proc scene { args } {
 193     if {[catch {package require vtk; package require vtkinteraction}]} {
 194          bgerror [mc "VTK is not installed, which is required for Scene"]
 195          return
 196     }
 197     global sceneOptions
 198     set win [assoc -windowname $args]
 199     if { "$win" == "" } {set win [getOptionDefault windowname $sceneOptions] }
 200     global [oarray $win]
 201     getOptions $sceneOptions $args -usearray [oarray $win]
 202     set renderer [set win]:renderer
 203     set renwin [set win]:renwin
 204     set iren [set win]:iren
 205     oset $win maxiter 0
 206     oset $win trackers ""
 207     oset $win playing 0
 208     oset $win iteration 0
 209     oset $win prev_iteration 0
 210     oset $win animate ""
 211     oset $win renderer $renderer
 212     oset $win renwin $renwin
 213
 214     vtkRenderer $renderer
 215
 216     # Create the render window and put the renderer in it
 217     vtkRenderWindow $renwin
 218     $renwin AddRenderer $renderer
 219     # Change from the default interaction style to Trackball
 220     vtkRenderWindowInteractor $iren
 221     $iren SetRenderWindow $renwin
 222     vtkInteractorStyleTrackballCamera style
 223     $iren SetInteractorStyle style
 224     # create the frame with the buttons and the rendering widget
 225     makeVTKFrame $win scene
 226     # put the objects into the widget
 227     updateScene $win
 228 }
 229
 230 proc updateScene { win } {
 231     linkLocal $win background azimuth elevation objects maxiter trackers \
 232         animate renwin renderer
 233     set objcount 0
 234     foreach obj $objects {
 235         incr objcount
 236         set name "object$objcount"
 237         set class [lindex $obj 0]
 238         set anim_obj [lindex $obj 4]
 239         "vtk$class\Source" $name
 240         foreach prop [lindex $obj 1] {
 241             eval $name "Set$prop"
 242         }
 243         vtkPolyDataMapper "$name:mapper"
 244         "$name:mapper" SetInputConnection [$name GetOutputPort]
 245         vtkLODActor "$name:actor"
 246         "$name:actor" SetMapper "$name:mapper"
 247         foreach prop [lindex $obj 2] {
 248             eval ["$name:actor" GetProperty] "Set$prop"
 249         }
 250         foreach prop [lindex $obj 3] {
 251             eval "$name:actor" "Set$prop"
 252         }
 253         $renderer AddActor "$name:actor"
 254         if { [llength $anim_obj] > 2 } {
 255             lappend animate [linsert $anim_obj 0 $name]
 256             set n [expr [llength [lindex $anim_obj 2]] - 1]
 257             if { $n > $maxiter } {
 258                 set maxiter $n
 259             }
 260             if { [lindex $anim_obj 1] } {
 261                 lappend trackers "$name [llength [lindex $anim_obj 2]]"
 262                 vtkPoints "$name:points"
 263                 eval "$name:points" InsertPoint 0 [lindex [lindex $anim_obj 2] 0]
 264                 vtkCellArray "$name:lines"
 265                 "$name:lines" InsertNextCell 1
 266                 "$name:lines" InsertCellPoint 0
 267                 vtkPolyData "$name:track"
 268                 "$name:track" SetPoints "$name:points"
 269                 "$name:track" SetLines "$name:lines"
 270                 vtkPolyDataMapper "$name:track:mapper"
 271                 "$name:track:mapper" SetInput "$name:track"
 272                 vtkActor "$name:track:actor"
 273                 "$name:track:actor" SetMapper "$name:track:mapper"
 274                 eval ["$name:track:actor" GetProperty] SetColor [["$name:actor" GetProperty] GetColor]
 275                 $renderer AddActor "$name:track:actor"
 276             }
 277         }
 278     }
 279     eval "$renderer SetBackground $background"
 280
 281     # Rotate the camera so the axis are in the position familiar to Physicists
 282     [$renderer GetActiveCamera] Elevation -90
 283     [$renderer GetActiveCamera] SetViewUp 0.0 0.0 1.0
 284
 285     # Set azimuth and elevation
 286     [$renderer GetActiveCamera] Azimuth $azimuth
 287     [$renderer GetActiveCamera] Elevation $elevation
 288     $renderer ResetCamera
 289     $renwin Render
 290
 291 }
 292
 293 ## endsource scene.tcl