lib/maracasVisuLib/src/interface/tcl/to_change/vtkInt.tcl

   1 # a generic interactor for tcl and vtk
   2 #
   3 catch {unset vtkInteract.bold}
   4 catch {unset vtkInteract.normal}
   5 catch {unset vtkInteract.tagcount}
   6 set vtkInteractBold "-background #43ce80 -foreground #221133 -relief raised -borderwidth 1"
   7 set vtkInteractNormal "-background #dddddd -foreground #221133 -relief flat"
   8 set vtkInteractTagcount 1
   9 set vtkInteractCommandList ""
  10 set vtkInteractCommandIndex 0
  11
  12 proc vtkInteract {} {
  13     global vtkInteractCommandList vtkInteractCommandIndex
  14     global vtkInteractTagcount
  15
  16     proc dovtk {s w} {
  17         global vtkInteractBold vtkInteractNormal vtkInteractTagcount
  18         global vtkInteractCommandList vtkInteractCommandIndex
  19
  20         set tag [append tagnum $vtkInteractTagcount]
  21         set vtkInteractCommandIndex $vtkInteractTagcount
  22         incr vtkInteractTagcount 1
  23         .vtkInteract.display.text configure -state normal
  24         .vtkInteract.display.text insert end $s $tag
  25         set vtkInteractCommandList [linsert $vtkInteractCommandList end $s]
  26         eval .vtkInteract.display.text tag configure $tag $vtkInteractNormal
  27         .vtkInteract.display.text tag bind $tag <Any-Enter> \
  28             ".vtkInteract.display.text tag configure $tag $vtkInteractBold"
  29         .vtkInteract.display.text tag bind $tag <Any-Leave> \
  30             ".vtkInteract.display.text tag configure $tag $vtkInteractNormal"
  31         .vtkInteract.display.text tag bind $tag <1> "dovtk [list $s] .vtkInteract"
  32         .vtkInteract.display.text insert end \n;
  33         .vtkInteract.display.text insert end [uplevel 1 $s]
  34         .vtkInteract.display.text insert end \n\n
  35         .vtkInteract.display.text configure -state disabled
  36         .vtkInteract.display.text yview end
  37     }
  38
  39     catch {destroy .vtkInteract}
  40     toplevel .vtkInteract -bg #bbbbbb
  41     wm title .vtkInteract "vtk Interactor"
  42     wm iconname .vtkInteract "vtk"
  43
  44     frame .vtkInteract.buttons -bg #bbbbbb
  45     pack  .vtkInteract.buttons -side bottom -fill both -expand 0 -pady 2m
  46     button .vtkInteract.buttons.dismiss -text Dismiss \
  47         -command "wm withdraw .vtkInteract" \
  48         -bg #bbbbbb -fg #221133 -activebackground #cccccc -activeforeground #221133
  49     pack .vtkInteract.buttons.dismiss -side left -expand 1 -fill x
  50
  51     frame .vtkInteract.file -bg #bbbbbb
  52     label .vtkInteract.file.label -text "Command:" -width 10 -anchor w \
  53         -bg #bbbbbb -fg #221133
  54     entry .vtkInteract.file.entry -width 40 \
  55         -bg #dddddd -fg #221133 -highlightthickness 1 -highlightcolor #221133
  56     bind .vtkInteract.file.entry <Return> {
  57         dovtk [%W get] .vtkInteract; %W delete 0 end}
  58     pack .vtkInteract.file.label -side left
  59     pack .vtkInteract.file.entry -side left -expand 1 -fill x
  60
  61     frame .vtkInteract.display -bg #bbbbbb
  62     text .vtkInteract.display.text -yscrollcommand ".vtkInteract.display.scroll set" \
  63         -setgrid true -width 60 -height 8 -wrap word -bg #dddddd -fg #331144 \
  64         -state disabled
  65     scrollbar .vtkInteract.display.scroll \
  66         -command ".vtkInteract.display.text yview" -bg #bbbbbb \
  67         -troughcolor #bbbbbb -activebackground #cccccc -highlightthickness 0
  68     pack .vtkInteract.display.text -side left -expand 1 -fill both
  69     pack .vtkInteract.display.scroll -side left -expand 0 -fill y
  70
  71     pack .vtkInteract.display -side bottom -expand 1 -fill both
  72     pack .vtkInteract.file -pady 3m -padx 2m -side bottom -fill x
  73
  74     set vtkInteractCommandIndex 0
  75
  76     bind .vtkInteract <Down> {
  77       if { $vtkInteractCommandIndex < [expr $vtkInteractTagcount - 1] } {
  78         incr vtkInteractCommandIndex
  79         set command_string [lindex $vtkInteractCommandList $vtkInteractCommandIndex]
  80         .vtkInteract.file.entry delete 0 end
  81         .vtkInteract.file.entry insert end $command_string
  82       } elseif { $vtkInteractCommandIndex == [expr $vtkInteractTagcount - 1] } {
  83         .vtkInteract.file.entry delete 0 end
  84       }
  85     }
  86
  87     bind .vtkInteract <Up> {
  88       if { $vtkInteractCommandIndex > 0 } {
  89         set vtkInteractCommandIndex [expr $vtkInteractCommandIndex - 1]
  90         set command_string [lindex $vtkInteractCommandList $vtkInteractCommandIndex]
  91         .vtkInteract.file.entry delete 0 end
  92         .vtkInteract.file.entry insert end $command_string
  93       }
  94     }
  95
  96     wm withdraw .vtkInteract
  97 }
  98
  99 vtkInteract