home *** CD-ROM | disk | FTP | other *** search
/ Netrunner 2004 October / NETRUNNER0410.ISO / regular / ActivePerl-5.8.4.810-MSWin32-x86.msi / _c54a62652414f56dd9cb195355372597 < prev    next >
Encoding:
Text File  |  2004-06-01  |  6.8 KB  |  187 lines
  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;
  187.