1# twind.tcl --
2#
3# This demonstration script creates a text widget with a bunch of
4# embedded windows.
5#
6# RCS: @(#) $Id$
7
8if {![info exists widgetDemo]} {
9    error "This script should be run from the \"widget\" demo."
10}
11
12package require Tk
13
14set w .twind
15catch {destroy $w}
16toplevel $w
17wm title $w "Text Demonstration - Embedded Windows and Other Features"
18wm iconname $w "Embedded Windows"
19positionWindow $w
20
21## See Code / Dismiss buttons
22set btns [addSeeDismiss $w.buttons $w]
23pack $btns -side bottom -fill x
24
25frame $w.f -highlightthickness 1 -borderwidth 1 -relief sunken
26set t $w.f.text
27text $t -yscrollcommand "$w.scroll set" -setgrid true -font $font -width 70 \
28	-height 35 -wrap word -highlightthickness 0 -borderwidth 0
29pack $t -expand  yes -fill both
30scrollbar $w.scroll -command "$t yview"
31pack $w.scroll -side right -fill y
32panedwindow $w.pane
33pack $w.pane -expand yes -fill both
34$w.pane add $w.f
35# Import to raise given creation order above
36raise $w.f
37
38$t tag configure center -justify center -spacing1 5m -spacing3 5m
39$t tag configure buttons -lmargin1 1c -lmargin2 1c -rmargin 1c \
40	-spacing1 3m -spacing2 0 -spacing3 0
41
42button $t.on -text "Turn On" -command "textWindOn $w" \
43	-cursor top_left_arrow
44button $t.off -text "Turn Off" -command "textWindOff $w" \
45	-cursor top_left_arrow
46
47$t insert end "A text widget can contain many different kinds of items, "
48$t insert end "both active and passive.  It can lay these out in various "
49$t insert end "ways, with wrapping, tabs, centering, etc.  In addition, "
50$t insert end "when the contents are too big for the window, smooth "
51$t insert end "scrolling in all directions is provided.\n\n"
52
53$t insert end "A text widget can contain other widgets embedded "
54$t insert end "it.  These are called \"embedded windows\", "
55$t insert end "and they can consist of arbitrary widgets.  "
56$t insert end "For example, here are two embedded button "
57$t insert end "widgets.  You can click on the first button to "
58$t window create end -window $t.on
59$t insert end " horizontal scrolling, which also turns off "
60$t insert end "word wrapping.  Or, you can click on the second "
61$t insert end "button to\n"
62$t window create end -window $t.off
63$t insert end " horizontal scrolling and turn back on word wrapping.\n\n"
64
65$t insert end "Or, here is another example.  If you "
66$t window create end -create {
67    button %W.click -text "Click Here" -command "textWindPlot %W" \
68	    -cursor top_left_arrow}
69
70$t insert end " a canvas displaying an x-y plot will appear right here."
71$t mark set plot insert
72$t mark gravity plot left
73$t insert end "  You can drag the data points around with the mouse, "
74$t insert end "or you can click here to "
75$t window create end -create {
76    button %W.delete -text "Delete" -command "textWindDel %W" \
77	    -cursor top_left_arrow
78}
79$t insert end " the plot again.\n\n"
80
81$t insert end "You can also create multiple text widgets each of which "
82$t insert end "display the same underlying text. Click this button to "
83$t window create end \
84  -create {button %W.peer -text "Make A Peer" -command "textMakePeer %W" \
85  -cursor top_left_arrow} -padx 3
86$t insert end " widget.  Notice how peer widgets can have different "
87$t insert end "font settings, and by default contain all the images "
88$t insert end "of the 'parent', but many of the embedded windows, "
89$t insert end "such as buttons will not be there.  The easiest way "
90$t insert end "to ensure they are in all peers is to use '-create' "
91$t insert end "embedded window creation scripts "
92$t insert end "(the plot above and the 'Make A Peer' button are "
93$t insert end "designed to show up in all peers).  A good use of "
94$t insert end "peers is for "
95$t window create end \
96  -create {button %W.split -text "Split Windows" -command "textSplitWindow %W" \
97  -cursor top_left_arrow} -padx 3
98$t insert end " \n\n"
99
100$t insert end "Users of previous versions of Tk will also be interested "
101$t insert end "to note that now cursor movement is now by visual line by "
102$t insert end "default, and that all scrolling of this widget is by pixel.\n\n"
103
104$t insert end "You may also find it useful to put embedded windows in "
105$t insert end "a text without any actual text.  In this case the "
106$t insert end "text widget acts like a geometry manager.  For "
107$t insert end "example, here is a collection of buttons laid out "
108$t insert end "neatly into rows by the text widget.  These buttons "
109$t insert end "can be used to change the background color of the "
110$t insert end "text widget (\"Default\" restores the color to "
111$t insert end "its default).  If you click on the button labeled "
112$t insert end "\"Short\", it changes to a longer string so that "
113$t insert end "you can see how the text widget automatically "
114$t insert end "changes the layout.  Click on the button again "
115$t insert end "to restore the short string.\n"
116
117button $t.default -text Default -command "embDefBg $t" \
118	-cursor top_left_arrow
119$t window create end -window $t.default -padx 3
120global embToggle
121set embToggle Short
122checkbutton $t.toggle -textvariable embToggle -indicatoron 0 \
123	-variable embToggle -onvalue "A much longer string" \
124	-offvalue "Short" -cursor top_left_arrow -pady 5 -padx 2
125$t window create end -window $t.toggle -padx 3 -pady 2
126set i 1
127foreach color {AntiqueWhite3 Bisque1 Bisque2 Bisque3 Bisque4
128	SlateBlue3 RoyalBlue1 SteelBlue2 DeepSkyBlue3 LightBlue1
129	DarkSlateGray1 Aquamarine2 DarkSeaGreen2 SeaGreen1
130	Yellow1 IndianRed1 IndianRed2 Tan1 Tan4} {
131    button $t.color$i -text $color -cursor top_left_arrow -command \
132	    "$t configure -bg $color"
133    $t window create end -window $t.color$i -padx 3 -pady 2
134    incr i
135}
136$t tag add buttons $t.default end
137
138button $t.bigB -text "Big borders" -command "textWindBigB $t" \
139  -cursor top_left_arrow
140button $t.smallB -text "Small borders" -command "textWindSmallB $t" \
141  -cursor top_left_arrow
142button $t.bigH -text "Big highlight" -command "textWindBigH $t" \
143  -cursor top_left_arrow
144button $t.smallH -text "Small highlight" -command "textWindSmallH $t" \
145  -cursor top_left_arrow
146button $t.bigP -text "Big pad" -command "textWindBigP $t" \
147  -cursor top_left_arrow
148button $t.smallP -text "Small pad" -command "textWindSmallP $t" \
149  -cursor top_left_arrow
150
151set text_normal(border) [$t cget -borderwidth]
152set text_normal(highlight) [$t cget -highlightthickness]
153set text_normal(pad) [$t cget -padx]
154
155$t insert end "\nYou can also change the usual border width and "
156$t insert end "highlightthickness and padding.\n"
157$t window create end -window $t.bigB
158$t window create end -window $t.smallB
159$t window create end -window $t.bigH
160$t window create end -window $t.smallH
161$t window create end -window $t.bigP
162$t window create end -window $t.smallP
163
164$t insert end "\n\nFinally, images fit comfortably in text widgets too:"
165
166$t image create end -image \
167  [image create bitmap -file [file join $tk_demoDirectory images face.xbm]]
168
169
170proc textWindBigB w {
171    $w configure -borderwidth 15
172}
173
174proc textWindBigH w {
175    $w configure -highlightthickness 15
176}
177
178proc textWindBigP w {
179    $w configure -padx 15 -pady 15
180}
181
182proc textWindSmallB w {
183    $w configure -borderwidth $::text_normal(border)
184}
185
186proc textWindSmallH w {
187    $w configure -highlightthickness $::text_normal(highlight)
188}
189
190proc textWindSmallP w {
191    $w configure -padx $::text_normal(pad) -pady $::text_normal(pad)
192}
193
194
195proc textWindOn w {
196    catch {destroy $w.scroll2}
197    set t $w.f.text
198    scrollbar $w.scroll2 -orient horizontal -command "$t xview"
199    pack $w.scroll2 -after $w.buttons -side bottom -fill x
200    $t configure -xscrollcommand "$w.scroll2 set" -wrap none
201}
202
203proc textWindOff w {
204    catch {destroy $w.scroll2}
205    set t $w.f.text
206    $t configure -xscrollcommand {} -wrap word
207}
208
209proc textWindPlot t {
210    set c $t.c
211    if {[winfo exists $c]} {
212	return
213    }
214
215    while {[string first [$t get plot] " \t\n"] >= 0} {
216	$t delete plot
217    }
218    $t insert plot "\n"
219
220    $t window create plot -create {createPlot %W}
221    $t tag add center plot
222    $t insert plot "\n"
223}
224
225proc createPlot {t} {
226    set c $t.c
227
228    canvas $c -relief sunken -width 450 -height 300 -cursor top_left_arrow
229
230    set font {Helvetica 18}
231
232    $c create line 100 250 400 250 -width 2
233    $c create line 100 250 100 50 -width 2
234    $c create text 225 20 -text "A Simple Plot" -font $font -fill brown
235
236    for {set i 0} {$i <= 10} {incr i} {
237	set x [expr {100 + ($i*30)}]
238	$c create line $x 250 $x 245 -width 2
239	$c create text $x 254 -text [expr {10*$i}] -anchor n -font $font
240    }
241    for {set i 0} {$i <= 5} {incr i} {
242	set y [expr {250 - ($i*40)}]
243	$c create line 100 $y 105 $y -width 2
244	$c create text 96 $y -text [expr {$i*50}].0 -anchor e -font $font
245    }
246
247    foreach point {
248	{12 56} {20 94} {33 98} {32 120} {61 180} {75 160} {98 223}
249    } {
250	set x [expr {100 + (3*[lindex $point 0])}]
251	set y [expr {250 - (4*[lindex $point 1])/5}]
252	set item [$c create oval [expr {$x-6}] [expr {$y-6}] \
253		[expr {$x+6}] [expr {$y+6}] -width 1 -outline black \
254		-fill SkyBlue2]
255	$c addtag point withtag $item
256    }
257
258    $c bind point <Any-Enter> "$c itemconfig current -fill red"
259    $c bind point <Any-Leave> "$c itemconfig current -fill SkyBlue2"
260    $c bind point <1> "embPlotDown $c %x %y"
261    $c bind point <ButtonRelease-1> "$c dtag selected"
262    bind $c <B1-Motion> "embPlotMove $c %x %y"
263    return $c
264}
265
266set embPlot(lastX) 0
267set embPlot(lastY) 0
268
269proc embPlotDown {w x y} {
270    global embPlot
271    $w dtag selected
272    $w addtag selected withtag current
273    $w raise current
274    set embPlot(lastX) $x
275    set embPlot(lastY) $y
276}
277
278proc embPlotMove {w x y} {
279    global embPlot
280    $w move selected [expr {$x-$embPlot(lastX)}] [expr {$y-$embPlot(lastY)}]
281    set embPlot(lastX) $x
282    set embPlot(lastY) $y
283}
284
285proc textWindDel t {
286    if {[winfo exists $t.c]} {
287	$t delete $t.c
288	while {[string first [$t get plot] " \t\n"] >= 0} {
289	    $t delete plot
290	}
291	$t insert plot "  "
292    }
293}
294
295proc embDefBg t {
296    $t configure -background [lindex [$t configure -background] 3]
297}
298
299proc textMakePeer {parent} {
300    set n 1
301    while {[winfo exists .peer$n]} { incr n }
302    set w [toplevel .peer$n]
303    wm title $w "Text Peer #$n"
304    frame $w.f -highlightthickness 1 -borderwidth 1 -relief sunken
305    set t [$parent peer create $w.f.text -yscrollcommand "$w.scroll set" \
306	       -borderwidth 0 -highlightthickness 0]
307    pack $t -expand  yes -fill both
308    scrollbar $w.scroll -command "$t yview"
309    pack $w.scroll -side right -fill y
310    pack $w.f -expand yes -fill both
311}
312
313proc textSplitWindow {textW} {
314    if {$textW eq ".twind.f.text"} {
315	if {[winfo exists .twind.peer]} {
316	    destroy .twind.peer
317	} else {
318	    set parent [winfo parent $textW]
319	    set w [winfo parent $parent]
320	    set t [$textW peer create $w.peer \
321	      -yscrollcommand "$w.scroll set"]
322	    $w.pane add $t
323	}
324    } else {
325        return
326    }
327}
328