Commit | Line | Data |
---|---|---|
86530b38 AT |
1 | # twind.pl |
2 | ||
3 | use Plot; | |
4 | use subs qw/twind_create_plot twind_delete_plot twind_restore_bg/; | |
5 | use vars qw/$TOP/; | |
6 | ||
7 | sub twind { | |
8 | ||
9 | # Create a top-level window with a text widget that demonstrates the | |
10 | # use of embedded windows in Text widgets. | |
11 | ||
12 | my($demo) = @_; | |
13 | $TOP = $MW->WidgetDemo( | |
14 | -name => $demo, | |
15 | -text => '', | |
16 | -title => 'Text Demonstration - Embedded Windows', | |
17 | -iconname => 'twind', | |
18 | ); | |
19 | ||
20 | # By default, when you create a Scrolled instance of a Perl/Tk widget | |
21 | # the scrollbars are always displayed; that is, they are required. But | |
22 | # you can have optional scrollbars as well, specified via the -scrollbars | |
23 | # specifier. So, assume scrollbars can be postioned 'nsew' (north, south | |
24 | # east or west), or 'se' for southeast, etcetera. You specify 'required' | |
25 | # or 'optional' using an 'r' or 'o' character, respectively, preceeding | |
26 | # the scrollbar position. So the following Scrolled widget has an | |
27 | # optional scrollbar at the bottom of the text widget and a required | |
28 | # scrollbar positioned to the right. | |
29 | # | |
30 | # Optional scrollbars are only displayed if they are required, so, the | |
31 | # the southern scrollbar is displayed IFF -wrap => none. | |
32 | ||
33 | my $t = $TOP->Scrolled(qw/Text -setgrid true -width 70 -height 35 | |
34 | -wrap word -highlightthickness 0 -borderwidth 0 -scrollbars osre | |
35 | -font/ => $FONT)->pack; | |
36 | ||
37 | $t->tag(qw/configure center -justify center -spacing1 5m -spacing3 5m/); | |
38 | $t->tag(qw/configure buttons -lmargin1 1c -lmargin2 1c -rmargin 1c | |
39 | -spacing1 3m -spacing2 0 -spacing3 0/); | |
40 | ||
41 | my $t_on = $t->Button( | |
42 | -text => 'Turn On', | |
43 | -command => [$t => qw/configure -wrap none/], | |
44 | -cursor => 'top_left_arrow', | |
45 | ); | |
46 | my $t_off = $t->Button( | |
47 | -text => 'Turn Off', | |
48 | -command => [$t => qw/configure -wrap word/], | |
49 | -cursor => 'top_left_arrow', | |
50 | ); | |
51 | ||
52 | my $t_click = $t->Button( | |
53 | -text => 'Click Here', | |
54 | -command => [\&twind_create_plot, $t], | |
55 | -cursor => 'top_left_arrow', | |
56 | ); | |
57 | my $t_delete = $t->Button( | |
58 | -text => 'Delete', | |
59 | -command => [\&twind_delete_plot, $t], | |
60 | -cursor => 'top_left_arrow', | |
61 | ); | |
62 | ||
63 | $t->insert('end', "A text widget can contain other widgets embedded "); | |
64 | $t->insert('end', "in it. These are called "); | |
65 | $t->insert('end', "\"embedded windows\""); | |
66 | $t->insert('end', ", and they can consist of arbitrary widgets. "); | |
67 | $t->insert('end', "For example, here are two embedded button "); | |
68 | $t->insert('end', "widgets. You can click on the first button to "); | |
69 | $t->window('create', 'end', -window => $t_on); | |
70 | $t->insert('end', " horizontal scrolling, which also turns off "); | |
71 | $t->insert('end', "word wrapping. Or, you can click on the second "); | |
72 | $t->insert('end', "button to\n"); | |
73 | $t->window('create', 'end', -window => $t_off); | |
74 | $t->insert('end', " horizontal scrolling and turn back on word "); | |
75 | $t->insert('end', "wrapping.\n\n"); | |
76 | ||
77 | $t->insert('end', "Or, here is another example. If you "); | |
78 | $t->window('create', 'end', -window => $t_click); | |
79 | $t->insert('end', " a canvas displaying an x-y plot will appear "); | |
80 | $t->insert('end', "right here."); | |
81 | $t->mark('set', 'plot', 'insert'); | |
82 | $t->mark('gravity', 'plot', 'left'); | |
83 | $t->insert('end', " You can drag the data points around with the "); | |
84 | $t->insert('end', "mouse, or you can click here to "); | |
85 | $t->window('create', 'end', -window => $t_delete); | |
86 | $t->insert('end', " the plot again.\n\n"); | |
87 | ||
88 | $t->insert('end', "You may also find it useful to put embedded windows"); | |
89 | $t->insert('end', " in a text without any actual text. In this case "); | |
90 | $t->insert('end', "the text widget acts like a geometry manager. For "); | |
91 | $t->insert('end', "example, here is a collection of buttons laid out "); | |
92 | $t->insert('end', "neatly into rows by the text widget. These buttons"); | |
93 | $t->insert('end', " can be used to change the background color of the "); | |
94 | $t->insert('end', "text widget (\"Default\" restores the color to "); | |
95 | $t->insert('end', "its default). If you click on the button labeled "); | |
96 | $t->insert('end', "\"Short\", it changes to a longer string so that "); | |
97 | $t->insert('end', "you can see how the text widget automatically "); | |
98 | $t->insert('end', "changes the layout. Click on the button again "); | |
99 | $t->insert('end', "to restore the short string.\n"); | |
100 | ||
101 | my $t_default = $t->Button( | |
102 | -text => 'Default', | |
103 | -command => [\&twind_restore_bg, $t], | |
104 | -cursor => 'top_left_arrow', | |
105 | ); | |
106 | $t->window('create', 'end', -window => $t_default, -padx => 3); | |
107 | my $embToggle = 'Short'; | |
108 | my $t_toggle = $t->Checkbutton( | |
109 | -textvariable => \$embToggle, | |
110 | -indicatoron => 0, | |
111 | -variable => \$embToggle, | |
112 | -onvalue => 'A much longer string', | |
113 | -offvalue => 'Short', | |
114 | -cursor => 'top_left_arrow', | |
115 | ); | |
116 | $t->window('create', 'end', -window => $t_toggle, | |
117 | -padx => 3, -pady => 2); | |
118 | my($i, $color) = (1, ''); | |
119 | foreach $color (qw(AntiqueWhite3 Bisque1 Bisque2 Bisque3 Bisque4 | |
120 | SlateBlue3 RoyalBlue1 SteelBlue2 DeepSkyBlue3 | |
121 | LightBlue1 DarkSlateGray1 Aquamarine2 DarkSeaGreen2 | |
122 | SeaGreen1 Yellow1 IndianRed1 IndianRed2 Tan1 Tan4)) { | |
123 | my $col = $t->Button( | |
124 | -text => "$color", | |
125 | -cursor => 'top_left_arrow', | |
126 | ); | |
127 | $col->configure(-command => sub { | |
128 | $t->configure(-background => $color); | |
129 | }); | |
130 | $t->window('create', 'end', -window => $col, | |
131 | -padx => 3, -pady => 2); | |
132 | $i++; | |
133 | } | |
134 | $t->tag('add', 'buttons', $t_default, 'end'); | |
135 | ||
136 | } # end twind | |
137 | ||
138 | sub twind_create_plot { | |
139 | ||
140 | # We are required to create a new Plot object everytime since embedded | |
141 | # widgets are destroyed when their tag is deleted. (Too bad.) | |
142 | ||
143 | my($text) = @_; | |
144 | ||
145 | if (not Exists($twind::plot)) { | |
146 | $twind::plot = $text->Plot( | |
147 | -title_color => 'Brown', | |
148 | -inactive_highlight => 'Skyblue2', | |
149 | -active_highlight => 'red', | |
150 | ); | |
151 | ||
152 | while ($text->get('plot') =~ / |\t|\n/) { | |
153 | $text->delete('plot'); | |
154 | } | |
155 | $text->insert('plot', "\n"); | |
156 | $text->window('create', 'plot', -window => $twind::plot); | |
157 | $text->tag('add', 'center', 'plot'); | |
158 | $text->insert('plot', "\n"); | |
159 | } # ifend | |
160 | ||
161 | } # end twind_create_plot | |
162 | ||
163 | sub twind_delete_plot { | |
164 | ||
165 | my($text) = @_; | |
166 | ||
167 | if (Exists($twind::plot)) { | |
168 | $text->delete($twind::plot); | |
169 | while ($text->get('plot') =~ / |\t|\n/) { | |
170 | $text->delete('plot'); | |
171 | } | |
172 | $text->insert('plot', ' '); | |
173 | } | |
174 | ||
175 | } # end twind_delete_plot | |
176 | ||
177 | sub twind_restore_bg { | |
178 | ||
179 | my($text) = @_; | |
180 | ||
181 | $text->configure(-background => | |
182 | ($text->Subwidget('text')->configure(-background))[3]); | |
183 | ||
184 | } # end twind_restore_bg | |
185 | ||
186 | 1; |