File: Interactor.tcl

package info (click to toggle)
vtk7 7.1.1%2Bdfsg2-8
  • links: PTS, VCS
  • area: main
  • in suites: bullseye
  • size: 127,396 kB
  • sloc: cpp: 1,539,584; ansic: 124,382; python: 78,038; tcl: 47,013; xml: 8,142; yacc: 5,040; java: 4,439; perl: 3,132; lex: 1,926; sh: 1,500; makefile: 126; objc: 83
file content (100 lines) | stat: -rw-r--r-- 4,240 bytes parent folder | download | duplicates (12)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
# 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

proc vtkInteract {} {
    global vtkInteractCommandList vtkInteractCommandIndex
    global vtkInteractTagcount

    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

    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
}
vtkInteract