Commit | Line | Data |
---|---|---|
86530b38 AT |
1 | # twind.tcl -- |
2 | # | |
3 | # This demonstration script creates a text widget with a bunch of | |
4 | # embedded windows. | |
5 | # | |
6 | # RCS: @(#) $Id: twind.tcl,v 1.3 2001/06/14 10:56:58 dkf Exp $ | |
7 | ||
8 | if {![info exists widgetDemo]} { | |
9 | error "This script should be run from the \"widget\" demo." | |
10 | } | |
11 | ||
12 | set w .twind | |
13 | catch {destroy $w} | |
14 | toplevel $w | |
15 | wm title $w "Text Demonstration - Embedded Windows" | |
16 | wm iconname $w "Embedded Windows" | |
17 | positionWindow $w | |
18 | ||
19 | frame $w.buttons | |
20 | pack $w.buttons -side bottom -fill x -pady 2m | |
21 | button $w.buttons.dismiss -text Dismiss -command "destroy $w" | |
22 | button $w.buttons.code -text "See Code" -command "showCode $w" | |
23 | pack $w.buttons.dismiss $w.buttons.code -side left -expand 1 | |
24 | ||
25 | frame $w.f -highlightthickness 2 -borderwidth 2 -relief sunken | |
26 | set t $w.f.text | |
27 | text $t -yscrollcommand "$w.scroll set" -setgrid true -font $font -width 70 \ | |
28 | -height 35 -wrap word -highlightthickness 0 -borderwidth 0 | |
29 | pack $t -expand yes -fill both | |
30 | scrollbar $w.scroll -command "$t yview" | |
31 | pack $w.scroll -side right -fill y | |
32 | pack $w.f -expand yes -fill both | |
33 | $t tag configure center -justify center -spacing1 5m -spacing3 5m | |
34 | $t tag configure buttons -lmargin1 1c -lmargin2 1c -rmargin 1c \ | |
35 | -spacing1 3m -spacing2 0 -spacing3 0 | |
36 | ||
37 | button $t.on -text "Turn On" -command "textWindOn $w" \ | |
38 | -cursor top_left_arrow | |
39 | button $t.off -text "Turn Off" -command "textWindOff $w" \ | |
40 | -cursor top_left_arrow | |
41 | button $t.click -text "Click Here" -command "textWindPlot $t" \ | |
42 | -cursor top_left_arrow | |
43 | button $t.delete -text "Delete" -command "textWindDel $w" \ | |
44 | -cursor top_left_arrow | |
45 | ||
46 | $t insert end "A text widget can contain other widgets embedded " | |
47 | $t insert end "it. These are called \"embedded windows\", " | |
48 | $t insert end "and they can consist of arbitrary widgets. " | |
49 | $t insert end "For example, here are two embedded button " | |
50 | $t insert end "widgets. You can click on the first button to " | |
51 | $t window create end -window $t.on | |
52 | $t insert end " horizontal scrolling, which also turns off " | |
53 | $t insert end "word wrapping. Or, you can click on the second " | |
54 | $t insert end "button to\n" | |
55 | $t window create end -window $t.off | |
56 | $t insert end " horizontal scrolling and turn back on word wrapping.\n\n" | |
57 | ||
58 | $t insert end "Or, here is another example. If you " | |
59 | $t window create end -window $t.click | |
60 | $t insert end " a canvas displaying an x-y plot will appear right here." | |
61 | $t mark set plot insert | |
62 | $t mark gravity plot left | |
63 | $t insert end " You can drag the data points around with the mouse, " | |
64 | $t insert end "or you can click here to " | |
65 | $t window create end -window $t.delete | |
66 | $t insert end " the plot again.\n\n" | |
67 | ||
68 | $t insert end "You may also find it useful to put embedded windows in " | |
69 | $t insert end "a text without any actual text. In this case the " | |
70 | $t insert end "text widget acts like a geometry manager. For " | |
71 | $t insert end "example, here is a collection of buttons laid out " | |
72 | $t insert end "neatly into rows by the text widget. These buttons " | |
73 | $t insert end "can be used to change the background color of the " | |
74 | $t insert end "text widget (\"Default\" restores the color to " | |
75 | $t insert end "its default). If you click on the button labeled " | |
76 | $t insert end "\"Short\", it changes to a longer string so that " | |
77 | $t insert end "you can see how the text widget automatically " | |
78 | $t insert end "changes the layout. Click on the button again " | |
79 | $t insert end "to restore the short string.\n" | |
80 | ||
81 | button $t.default -text Default -command "embDefBg $t" \ | |
82 | -cursor top_left_arrow | |
83 | $t window create end -window $t.default -padx 3 | |
84 | global embToggle | |
85 | set embToggle Short | |
86 | checkbutton $t.toggle -textvariable embToggle -indicatoron 0 \ | |
87 | -variable embToggle -onvalue "A much longer string" \ | |
88 | -offvalue "Short" -cursor top_left_arrow -pady 5 -padx 2 | |
89 | $t window create end -window $t.toggle -padx 3 -pady 2 | |
90 | set i 1 | |
91 | foreach color {AntiqueWhite3 Bisque1 Bisque2 Bisque3 Bisque4 | |
92 | SlateBlue3 RoyalBlue1 SteelBlue2 DeepSkyBlue3 LightBlue1 | |
93 | DarkSlateGray1 Aquamarine2 DarkSeaGreen2 SeaGreen1 | |
94 | Yellow1 IndianRed1 IndianRed2 Tan1 Tan4} { | |
95 | button $t.color$i -text $color -cursor top_left_arrow -command \ | |
96 | "$t configure -bg $color" | |
97 | $t window create end -window $t.color$i -padx 3 -pady 2 | |
98 | incr i | |
99 | } | |
100 | $t tag add buttons $t.default end | |
101 | ||
102 | proc textWindOn w { | |
103 | catch {destroy $w.scroll2} | |
104 | set t $w.f.text | |
105 | scrollbar $w.scroll2 -orient horizontal -command "$t xview" | |
106 | pack $w.scroll2 -after $w.buttons -side bottom -fill x | |
107 | $t configure -xscrollcommand "$w.scroll2 set" -wrap none | |
108 | } | |
109 | ||
110 | proc textWindOff w { | |
111 | catch {destroy $w.scroll2} | |
112 | set t $w.f.text | |
113 | $t configure -xscrollcommand {} -wrap word | |
114 | } | |
115 | ||
116 | proc textWindPlot t { | |
117 | set c $t.c | |
118 | if {[winfo exists $c]} { | |
119 | return | |
120 | } | |
121 | canvas $c -relief sunken -width 450 -height 300 -cursor top_left_arrow | |
122 | ||
123 | set font {Helvetica 18} | |
124 | ||
125 | $c create line 100 250 400 250 -width 2 | |
126 | $c create line 100 250 100 50 -width 2 | |
127 | $c create text 225 20 -text "A Simple Plot" -font $font -fill brown | |
128 | ||
129 | for {set i 0} {$i <= 10} {incr i} { | |
130 | set x [expr {100 + ($i*30)}] | |
131 | $c create line $x 250 $x 245 -width 2 | |
132 | $c create text $x 254 -text [expr {10*$i}] -anchor n -font $font | |
133 | } | |
134 | for {set i 0} {$i <= 5} {incr i} { | |
135 | set y [expr {250 - ($i*40)}] | |
136 | $c create line 100 $y 105 $y -width 2 | |
137 | $c create text 96 $y -text [expr {$i*50}].0 -anchor e -font $font | |
138 | } | |
139 | ||
140 | foreach point { | |
141 | {12 56} {20 94} {33 98} {32 120} {61 180} {75 160} {98 223} | |
142 | } { | |
143 | set x [expr {100 + (3*[lindex $point 0])}] | |
144 | set y [expr {250 - (4*[lindex $point 1])/5}] | |
145 | set item [$c create oval [expr {$x-6}] [expr {$y-6}] \ | |
146 | [expr {$x+6}] [expr {$y+6}] -width 1 -outline black \ | |
147 | -fill SkyBlue2] | |
148 | $c addtag point withtag $item | |
149 | } | |
150 | ||
151 | $c bind point <Any-Enter> "$c itemconfig current -fill red" | |
152 | $c bind point <Any-Leave> "$c itemconfig current -fill SkyBlue2" | |
153 | $c bind point <1> "embPlotDown $c %x %y" | |
154 | $c bind point <ButtonRelease-1> "$c dtag selected" | |
155 | bind $c <B1-Motion> "embPlotMove $c %x %y" | |
156 | while {[string first [$t get plot] " \t\n"] >= 0} { | |
157 | $t delete plot | |
158 | } | |
159 | $t insert plot "\n" | |
160 | $t window create plot -window $c | |
161 | $t tag add center plot | |
162 | $t insert plot "\n" | |
163 | } | |
164 | ||
165 | set embPlot(lastX) 0 | |
166 | set embPlot(lastY) 0 | |
167 | ||
168 | proc embPlotDown {w x y} { | |
169 | global embPlot | |
170 | $w dtag selected | |
171 | $w addtag selected withtag current | |
172 | $w raise current | |
173 | set embPlot(lastX) $x | |
174 | set embPlot(lastY) $y | |
175 | } | |
176 | ||
177 | proc embPlotMove {w x y} { | |
178 | global embPlot | |
179 | $w move selected [expr {$x-$embPlot(lastX)}] [expr {$y-$embPlot(lastY)}] | |
180 | set embPlot(lastX) $x | |
181 | set embPlot(lastY) $y | |
182 | } | |
183 | ||
184 | proc textWindDel w { | |
185 | set t $w.f.text | |
186 | if {[winfo exists $t.c]} { | |
187 | $t delete $t.c | |
188 | while {[string first [$t get plot] " \t\n"] >= 0} { | |
189 | $t delete plot | |
190 | } | |
191 | $t insert plot " " | |
192 | } | |
193 | } | |
194 | ||
195 | proc embDefBg t { | |
196 | $t configure -background [lindex [$t configure -background] 3] | |
197 | } |