summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/Tk/demos/widtrib
diff options
context:
space:
mode:
authorKarl Berry <karl@freefriends.org>2016-04-05 22:27:26 +0000
committerKarl Berry <karl@freefriends.org>2016-04-05 22:27:26 +0000
commitb56b320b5e2515160073fa1b469514002688fe11 (patch)
tree965a7100c5e45fca8ec803d22b8b6ce14fca4633 /Master/tlpkg/tlperl/lib/Tk/demos/widtrib
parentd26c206452d2e285c3bbf949f34011e4a55fd8f9 (diff)
tlperl 5.22.1 from siep
git-svn-id: svn://tug.org/texlive/trunk@40252 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Tk/demos/widtrib')
-rw-r--r--Master/tlpkg/tlperl/lib/Tk/demos/widtrib/Gedi.pl429
-rw-r--r--Master/tlpkg/tlperl/lib/Tk/demos/widtrib/TEMPLATE.pl92
-rw-r--r--Master/tlpkg/tlperl/lib/Tk/demos/widtrib/Tiler.pl15
-rw-r--r--Master/tlpkg/tlperl/lib/Tk/demos/widtrib/all.pl331
-rw-r--r--Master/tlpkg/tlperl/lib/Tk/demos/widtrib/cursor.pl65
-rw-r--r--Master/tlpkg/tlperl/lib/Tk/demos/widtrib/lib/npuz/Xcamel.npuzbin26699 -> 0 bytes
-rw-r--r--Master/tlpkg/tlperl/lib/Tk/demos/widtrib/npuz.pl226
-rw-r--r--Master/tlpkg/tlperl/lib/Tk/demos/widtrib/plop.pl381
8 files changed, 0 insertions, 1539 deletions
diff --git a/Master/tlpkg/tlperl/lib/Tk/demos/widtrib/Gedi.pl b/Master/tlpkg/tlperl/lib/Tk/demos/widtrib/Gedi.pl
deleted file mode 100644
index ff847000e05..00000000000
--- a/Master/tlpkg/tlperl/lib/Tk/demos/widtrib/Gedi.pl
+++ /dev/null
@@ -1,429 +0,0 @@
-# Gedi master advanced text editor.
-
-use Tk::TextEdit;
-
-use vars qw/$TOP/;
-
-my $TOP;
-my $text_frame;
-my $counter_frame;
-my $textwindow;
-my $current_line_label;
-my $total_line_label;
-my $current_column_label;
-my $insert_overstrike_mode_label;
-my $about_pop_up_reference;
-my $menu;
-my $help_menu;
-
-sub about_pop_up
-{
- my $name = ref($about_pop_up_reference);
- if (defined($about_pop_up_reference))
- {
- $about_pop_up_reference->raise;
- $about_pop_up_reference->focus;
- }
- else
- {
- my $pop = $TOP->Toplevel();
- $pop->title("About");
-
- $pop->Label(-text=>"Gedi (Gregs EDItor)")->pack();
- $pop->Label(-text=>"Ver. 1.0")->pack();
- $pop->Label(-text=>"Copyright 1999")->pack();
- $pop->Label(-text=>"Greg London")->pack();
- $pop->Label(-text=>"All Rights Reserved.")->pack();
- $pop->Label(-text=>"This program is free software.")->pack();
- $pop->Label(-text=>"You can redistribute it and/or")->pack();
- $pop->Label(-text=>"modify it under the same terms")->pack();
- $pop->Label(-text=>"as Perl itself.")->pack();
- $pop->Label(-text=>"Special Thanks to")->pack();
- $pop->Label(-text=>"Nick Ing-Simmons.")->pack();
-
- my $button_ok = $pop->Button(-text=>'OK',
- -command => sub {$pop->destroy();
- $about_pop_up_reference = undef;
- } )
- ->pack();
- $pop->resizable('no','no');
- $about_pop_up_reference = $pop;
- }
-}
-
-
-sub update_indicators
-{
- my ($line,$column)= split(/\./,$textwindow->index('insert'));
- $current_line_label->configure (-text=> "line: $line");
- $current_column_label->configure (-text=> "column: $column");
-
- my ($last_line,$last_col) = split(/\./,$textwindow->index('end'));
- $total_line_label->configure (-text=> "total lines: $last_line");
-
- my $mode = $textwindow->OverstrikeMode;
- my $overstrke_insert='Insert Mode';
- if ($mode)
- {$overstrke_insert='Overstrike Mode';}
- $insert_overstrike_mode_label->configure
- (-text=> "$overstrke_insert");
-
- my $filename = $textwindow->FileName;
- $filename = 'NoName' unless(defined($filename));
- my $edit_flag='';
- if($textwindow->numberChanges)
- {$edit_flag='edited';}
- $TOP->configure(-title => "Gedi $edit_flag $filename");
- $textwindow->idletasks;
-
-}
-
-
-
-
-
-
-sub Gedi {
- my($demo) = @_;
- $TOP = $MW->WidgetDemo(
- -name => $demo,
- -text => 'Gedi master advanced text editor ',
- -geometry_manager => 'grid',
- -title => 'GEDI Text Editor',
- -iconname => 'GEDI',
- );
-
-$TOP->withdraw;
-
-$text_frame = $TOP->Frame->pack
- (-anchor=>'nw', -expand=>'yes', -fill => 'both'); # autosizing
-$counter_frame = $TOP->Frame->pack(-anchor=>'nw');
-
-$textwindow = $text_frame->Scrolled(
- 'TextEdit',
- exportselection => 'true', # 'sel' tag is associated with selections
- # initial height, if it isnt 1, then autosizing fails
- # once window shrinks below height
- # and the line counters go off the screen.
- # seems to be a problem with the Tk::pack command;
-# height => 40,
- -background => 'white',
- -wrap=> 'none',
- -setgrid => 'true', # use this for autosizing
- -scrollbars =>'se')
- -> pack(-expand => 'yes' , -fill => 'both'); # autosizing
-
-$TOP->protocol('WM_DELETE_WINDOW'=>
- sub{$textwindow->ConfirmExit;}
- );
-
-$SIG{INT} = sub {$textwindow->ConfirmExit;};
-
-$current_line_label = $counter_frame
- -> Label(-text=>'line: 1')
- -> grid(-row=>1,-column=>1, -sticky=>'nw' );
-
-$total_line_label = $counter_frame
- -> Label(-text=>'total lines: 1')
- -> grid(-row=>2,-column=>1, -sticky=>'nw' );
-
-$current_column_label = $counter_frame
- -> Label(-text=>'column: 0')
- -> grid(-row=>3,-column=>1, -sticky=>'nw' );
-
-$insert_overstrike_mode_label = $counter_frame
- -> Label(-text=>' ')
- -> grid(-row=>5,-column=>1, -sticky=>'nw' );
-
-$textwindow->SetGUICallbacks (
- [
- \&update_indicators,
- sub{$textwindow->HighlightAllPairsBracketingCursor}
- ]
-);
-
-$menu = $textwindow->menu;
-
-$TOP->configure(-menu => $menu);
-
-$help_menu = $menu->cascade(-label=>'~Help', -tearoff => 0, -menuitems => [
- [Command => 'A~bout', -command => \&about_pop_up]
- ]);
-
-
-#$TOP->minsize(30,1);
-#$TOP->geometry("80x24");
-
-while(<DATA>)
- {$textwindow->insert('insert',$_);}
-$textwindow->ResetUndo;
-
-$textwindow->CallNextGUICallback;
-
-# adjust height
-$TOP->update;
-my $menuheight = ($TOP->wrapper)[1];
-my $TOPheight = 30 + $TOP->reqheight + $menuheight;
-if ($TOP->screenheight < $TOPheight) {
- $textwindow->GeometryRequest($textwindow->reqwidth, $textwindow->reqheight - ($TOPheight - $TOP->screenheight));
-}
-$TOP->deiconify;
-
-}
-
-
-__DATA__
-
-Tk800.015 contains many modifications to the
-text based modules, as well as new text modules
-and an application that uses them all.
-Text.pm, TextUndo.pm, TextEdit.pm, and gedi
-have all been updated since the release prior
-to Tk800.015.
-
-This demo contains a rundown of all the features
-of the text modules, and
-
-What is available in the text modules?
-================================================
-
-Text.pm
-========
-
-Text.pm is the base text editing module.
-Beyond the core functionality of typing text,
-Text.pm has built in menu support for basic
-editing features such as Find/Replace text,
-Copy/Cut/Paste, Goto Line Number, and What
-Line Number queries.
-
-These functions are available simply by right
-clicking the mouse over the text area. Doing
-so will cause a pop-up menu to appear which will
-contain cascading menus to give access to all of
-these new functions.
-
-Many of these functions will create their own
-pop-up windows. Find/Replace will create a pop-up
-window which contains an entry for text to
-find, an entry for replace text, a number of
-radio buttons to control options such as
-case sensitivity, and several command buttons to
-perform functions such as Find, Find All,
-Replace, Replace All.
-
-All of these features have corresponding methods
-built into the Text widget. This allows the basic
-functions to be built into the widget, and also
-allows added features to be built on the lower
-level methods as needed. No one should have to
-reinvent the wheel when it comes to text editing
-features.
-
-Insert and Overstrike modes are also supported
-in the Text.pm module. Pressing the <Insert>
-key will toggle modes back and forth.
-
-Column based copy/cut/paste features are also
-available in the Text.pm module. They are bound
-to the following keys:
-
-<F1> clipboardColumnCopy
-<F2> clipboardColumnCut
-<F3> clipboardColumnPaste
-
-Currently, column based operations are beta versions.
-They compensate for tabs, but they will not behave
-properly unless the text is all the same font, and
-is the same width per character.
-
-Hopefully some future version of Text.pm will correct
-for this deficiency.
-
-Column paste should work with overstrike mode.
-
-
-TextUndo.pm
-=============
-
-TextUndo.pm is the second level module, being
-derived from the Text.pm module. As it's name
-implies, TextUndo supports "UNDO" capability.
-It now also supports "REDO" capability.
-
-Undo/redo works on user typed commands and
-also programmatically, so that any application
-that causes text to be inserted or deleted
-can be undone/redone, whether it was directly
-typed by the user or indirectly through another
-method.
-
-The undo/redo functions support tags, so that
-if you delete text with tags, undo will re-insert
-the text and re-tag it as well. This will eventually
-allow the text modules to support more sophisticated
-word processing type features. Such functionality
-should be available in a future release of the
-text modules.
-
-The TextUndo.pm module also has several added
-features to support file based operations.
-File based methods include ->Save, ->Load, and
-->Include. All methods take a filename as a
-parameter. These methods will create a progress
-widget to indicate the progress of the operation.
-
-The other feature of the TextUndo.pm module
-is the ConfirmDiscard method. This method checks to
-see if the text has been modified since it was
-last saved. If it has been modified, and the
-it will create a pop-up menu asking the user
-if they want to save the text to a file before
-exiting. This method can easily be tied into
-the exit routines, and signal handlers, to provide
-a consistent "save before exit?" feel.
-
-TextEdit.pm
-=============
-
-The TextEdit.pm is a new module in prototype version
-which adds further features to the text modules.
-TextEdit is based off of the TextUndo module,
-and so has all of the features of TextUndo and
-Text.
-
-Features of the TextEdit.pm module include
-parenthesis matching. The module looks at the
-current cursor position and then tries to find
-the parenthesis that bracket the cursor.
-Character pairs that are searched for are:
-() {} [] "" ''
-
-It also checks the position of the pairs to
-try to highlight bad positions. The module
-assumes that if the pairs are not on the same
-line or not on the same column, then there
-might be a missing parenthesis somewhere.
-Characters that appear to not align are
-highlighted in red.
-
-(quotations must start and end on the same line)
-
-
-PARENTHISIS MATCHING DEMO:
-move the cursor to the x between the quotes
-on the line below:
-
-
-{
- ( )
- ( { }
- [
- ' ">> x <<" '
- [] ]
- )
-
-}
-
-PARENTHESIS MISMATCHING DEMO:
-move the cursor to the x between the quotes
-on the line below:
-
-
-{
- ( )
- ( <<RED possible error { }
- [
- ' ">> x <<" '
- [] ]
- ) <<RED possible error
-
-}
-
-
-
-Another feature of the TextEdit module is support
-for application level indicators which reflect
-the status of certain internals. The line and
-column position of the cursor, the total length
-of the file, whether the widget is in insert or
-overstrike mode. Anytime anything occurs that could
-affect these values, a user supplied callback
-is invoked. This callback is supplied by the
-application so that the application can update
-whatever indicators it uses, however it implements
-them.
-
-One other feature of the TextEdit.pm module is
-block level text indention and block level text
-commenting. If a block of text is selected,
-that text can be indented or unindented wiht
-a single keystroke. It can also be commented
-out or uncommented as well. The keystroke bindings
-that support this are:
-
-<F5> IndentSelectedLines
-<F6> UnindentSelectedLines
-
-<F7> CommentSelectedLines
-<F8> UncommentSelectedLines
-
-These bindings only operate on the currently
-selected text. The indent string and the comment
-string can be programmed to be anything, but
-defaults to "\t" (tab) for indent and "#" for
-comments.
-
-(currently the widget hash is used to store these values.
-$w->{'INDENT_STRING'} and $w->{'LINE_COMMENT_STRING'}
-At some point in the future, this will be changed to
-use configure options to set these values.
-any application that changes these values should do
-so in such a way that when the TextEdit module changes,
-the application can be easily changed to handle this)
-
-
-
-gedi application
-=====================
-gedi is short for Greg's EDItor.
-The "g" is soft, pronounced like a "j".
-
-The gedi application uses all of the features of
-the text modules, Text, TextUndo, and TextEdit.
-It supplies TextEdit with a callback to update
-the indicator displays. This information includes
-the current cursor position, insert/overstrike
-mode, length of the file, filename, and whether
-the file has been edited or not.
-
-The bottom of this display contains
-line number
-column number
-total lines
-insert/overstrike mode.
-
-The title bar contains
-filename
-and if the file has been edited, the word "edited".
-
-Where gedi is installed depends on your system,
-but it is part of the tarkit for Tk800.015 and above.
-
-gedi was created to be put a perl editor in with the
-perl tar kit.
-
-NOTE: THIS IS NOT THE ACTUAL GEDI APPLICATION, BUT
-A DEMO SET UP TO BE SIMILAR IN NATURE TO THE GEDI
-APPLICATION. THE ACTUAL GEDI APPLICATION IS PART OF
-THE TK800.015 TARKIT. WHERE IT IS LOCATED ON YOUR
-SYSTEM WILL VARY DEPENDING ON YOUR SYSTEM. ONCE
-YOU LOCATE THE GEDI APPLICATION, PUT IT IN YOUR
-EXECUTABLE PATH, AND YOU WILL BE ABLE TO USE IT AS
-A TEXT EDITOR.
-
-
-
-
-
-
diff --git a/Master/tlpkg/tlperl/lib/Tk/demos/widtrib/TEMPLATE.pl b/Master/tlpkg/tlperl/lib/Tk/demos/widtrib/TEMPLATE.pl
deleted file mode 100644
index f0415ea9cae..00000000000
--- a/Master/tlpkg/tlperl/lib/Tk/demos/widtrib/TEMPLATE.pl
+++ /dev/null
@@ -1,92 +0,0 @@
-# Learn how to write your own widget demonstration.
-
-use vars qw/$TOP/;
-
-sub TEMPLATE {
- my($demo) = @_;
- $TOP = $MW->WidgetDemo(
- -name => $demo,
- -text => 'Learn how to write a widget demonstration!',
- -geometry_manager => 'grid',
- -title => 'WidgetDemo Example',
- -iconname => 'WidgetDemo',
- );
- $TOP->Label(-text => 'Click "See Code".')->grid;
-}
-__END__
-
-The template code above specifies how user contributed widget demonstrations
-can be written.
-
-widget looks in the directory specified on the command line to load user
-contributed demonstrations. If no directory name is specified when widget is
-invoked and the environment variable WIDTRIB is defined then demonstrations
-are loaded from the WIDTRIB directory. If WIDTRIB is undefined then widget
-defaults to the released user contributed directory.
-
-The first line of the file is the DDD (Demonstration Description Data), which
-briefly describes the purpose of the demonstration. The widget program reads
-this line and uses it when building its interface.
-
-Demonstrations must have a unique subroutine which is the same as the filename
-with .pl stripped off. When widget calls your subroutine it's passed one
-argument, the demonstration name. So file TEMPLATE.pl contains subroutine
-TEMPLATE(). But a demo can actually be an entire program - read on!
-
-For consistency your demonstration should use the WidgetDemo widget. This is
-a toplevel widget with three frames. The top frame contains descriptive
-demonstration text. The bottom frame contains the "Dismiss" and "See Code"
-buttons. The middle frame is the demonstration container, which can be
-managed by either the pack or grid geometry manager.
-
-Since your subroutine can "see" all of widget's global variables, you
-use $MW (the main window reference) to create the WidgetDemo toplevel; be sure
-to pass at least the -name and -text parameters. -geometry_manager defaults
-to "pack". The call to WidgetDemo() returns a reference to the containing
-frame for your demonstration, so treat it as if it were the MainWindow, the
-top-most window of your widget hierarchy.
-
-Alternatively the .pl file may contain typical Perl/Tk code of the form:
-
- # Demonstration Description Data
-
- use Tk;
- my $top = MainWindow->new;
- $top->Label(-text => 'Whatever');
- MainLoop;
- __END__
-
-widget has re-defined normal MainWindow to actually create a WidgetDemo
-on your code's behalf. MainLoop is optional in a demo (it will immediately
-return as MainLoop is already active).
-
-Other consideration:
-
- . widget global variables are all uppercase, like $MW - be careful not
- to stomp on them!
-
- . Demo files should really be run in private packages to avoid those
- problems.
-
- . Don't subvert the inheritance mechanism by calling Tk::MainWindow
- in your demo code.
-
- . The description should really be extracted from POD documentation
- in the .pl file rather than a magic comment.
-
- . If your demonstration has a Quit button change it to ring the bell
- and use the builtin Dismiss instead. In particular destroying a
- MainWindow is acceptable, but exit will shut down widget itself!
-
- . Be sure $TOP is declared in a "use vars" statement and not as a
- lexical my() in the subroutine (see below).
-
- . If you're wrapping an existing main program in a subroutine be very
- alert for closure bugs. Lexicals inside a subroutine become closed
- so you may run into initialization problems on the second and
- subsequent invokations of the demonstration. The npuz and plop
- demonstrations show how to work around this. Essentially, remove
- all "global" my() variables and place them within a "use vars".
- This practice is prone to subtle bugs and is not recommended!
-
-
diff --git a/Master/tlpkg/tlperl/lib/Tk/demos/widtrib/Tiler.pl b/Master/tlpkg/tlperl/lib/Tk/demos/widtrib/Tiler.pl
deleted file mode 100644
index c9a44b8c0b1..00000000000
--- a/Master/tlpkg/tlperl/lib/Tk/demos/widtrib/Tiler.pl
+++ /dev/null
@@ -1,15 +0,0 @@
-# Tiler, arrange widgets in rows.
-
-use strict;
-use Tk;
-use Tk::Tiler;
-
-my $mw = MainWindow->new();
-my $tiler = $mw->Scrolled('Tiler');
-my $num = $tiler->cget('-rows') * $tiler->cget('-columns');
-$mw->Label(-text => "Tiler with $num widgets")->pack;
-foreach (1 .. $num) {
- $tiler->Manage( $tiler->Label(-text => "**$_**") );
-}
-$tiler->pack(qw/-expand yes -fill both/);
-MainLoop;
diff --git a/Master/tlpkg/tlperl/lib/Tk/demos/widtrib/all.pl b/Master/tlpkg/tlperl/lib/Tk/demos/widtrib/all.pl
deleted file mode 100644
index 482bb46ea5b..00000000000
--- a/Master/tlpkg/tlperl/lib/Tk/demos/widtrib/all.pl
+++ /dev/null
@@ -1,331 +0,0 @@
-# All widgets at a glance.
-# -*- perl -*-
-
-#
-# $Id: $
-# Author: Slaven Rezic
-#
-# Copyright (C) 2007 Slaven Rezic. All rights reserved.
-# This program is free software; you can redistribute it and/or
-# modify it under the same terms as Perl itself.
-#
-# Mail: slaven@rezic.de
-# WWW: http://www.rezic.de/eserte/
-#
-
-use strict;
-use Tk::Pane;
-
-use vars qw/$TOP $MW $DEMO_FILE/;
-
-sub all {
- my($demo) = @_;
- $TOP = $MW->WidgetDemo(
- -name => $demo,
- -text => <<"EOF",
-All Tk widgets at a glance in one Toplevel.
-
-The left column contains the class name, the middle column a sample representation of this widget, and the right column a button to the widget's Pod (requires Tk::Pod from CPAN).
-
-There are three sections: core Tk modules and Tix modules which come with stock Tk $Tk::VERSION and a sample of non-standard Tk modules from CPAN. The non-standard modules are only displayed if installed, otherwise they are skipped.
-EOF
- -geometry_manager => 'pack',
- -title => 'All widgets',
- -iconname => 'All widgets',
- );
-
- my($px_w, $px_h) = (400, 200);
- my($txt_w, $txt_h) = (40, 6);
- my @px_geom = (-width => $px_w, -height => $px_h);
- my @txt_geom = (-height => $txt_h, -width => $txt_w);
- my $insert_txt = sub {
- my $w = shift;
- if ($w->can("Subwidget") && $w->Subwidget("scrolled")) {
- $w = $w->Subwidget("scrolled");
- }
- $w->insert("end", "This is some sample text for the widget class " . $w->Class);
- };
- my $insert_lb = sub {
- shift->insert("end", sort grep { !m{^/} } keys %INC);
- };
-
- my $f = $TOP->Scrolled('Pane',
- qw(-width 900 -height 500), # XXX check for screensize!
- -gridded => 'xy',
- -scrollbars => 'osoe',
- -sticky => 'news',
- )->pack(qw(-expand 1 -fill both));
- $f = $f->Subwidget("scrolled");
- my @w_def = (
- {separator => 'Core Tk modules'},
-
- 'Adjuster',
- # XXX 'Balloon',
- {class => 'BrowseEntry', action => $insert_lb},
- {class => 'Button', w_args => [-text => 'This is a button']},
- {class => 'Canvas', w_args => [@px_geom],
- action => sub {
- my($w) = @_;
- my @colors = qw(red green blue orange black white);
- for (1..50) {
- $w->createLine(rand($px_w),rand($px_h),
- rand($px_w),rand($px_h),
- -fill => $colors[rand @colors],
- -width => rand(4)+1,
- );
- }
- $w->configure(-scrollregion => [$w->bbox("all")]);
- },
- },
- {class => 'Checkbutton', w_args => [-text => 'This is a checkbutton']},
- {class => 'ColorEditor', dialog => 1},
- {class => 'Dialog', dialog => 1},
- {class => 'DialogBox', dialog => 1},
- {class => 'DirTree', scrolled => 'oe'},
- {class => 'Dirlist', scrolled => 'oe'},
- {class => 'Entry', w_args => [-width => 20], action => $insert_txt},
- {class => 'FBox', dialog => 1},
- {class => 'FileDialog', dialog => 1},
- {class => 'FileSelect', dialog => 1},
- {class => 'Frame', w_args => [@px_geom, -bg => 'red']},
- {class => 'Label', w_args => [-text => 'This is a label']},
- {class => 'Labelframe', w_args => [@px_geom, -bg => 'red', -text => 'Title of frame']},
- {class => 'Listbox', action => $insert_lb, scrolled => 'oe'},
- # XXX Menubar?
- {class => 'Menubutton', w_args => [-text => 'Menu button']},#XXX menuitems
- {class => 'Message', w_args => [-text => 'This is a message widget']},
- {class => 'MsgBox', dialog => 1},
- {class => 'NoteBook', action => sub {
- my $w = shift;
- for (1..5) {
- my $p = $w->add("page$_", -label => "Page $_");
- $p->Label(-text => "A label in the page $_")->pack;
- }
- },
- },
- # XXX Pane
- {class => 'Radiobutton', w_args => [-text => 'This is a radiobutton']},
- {class => 'ROText', w_args => [@txt_geom], action => $insert_txt, scrolled => 'oe'},
- {class => 'Scale', w_args => [-orient => 'horiz', -from => 0, -showvalue => 1, -to => 100]},
- {class => 'Scrollbar', w_args => [-orient => 'horiz']},
- {class => 'Spinbox', w_args => [-from => 0, -to => 100]},
- {class => 'Text', w_args => [@txt_geom], action => $insert_txt, scrolled => 'oe'},
- # disabled because of warning loop, line 189 ... {class => 'TextEdit', w_args => [@txt_geom], action => $insert_txt, scrolled => 'oe'},
- {class => 'TextList', w_args => [@txt_geom], action => $insert_lb, scrolled => 'oe'},
- {class => 'TextUndo', w_args => [@txt_geom], action => $insert_txt, scrolled => 'oe'},
- # XXX Toplevel
-
- {separator => 'Tix modules'},
-
- 'FloatEntry',
- {class => 'HList', action => sub {
- my $w = shift;
- my $b = $w->Balloon;
- my %binfo;
- for my $path ('1', '1.1', '1.2', '2', '2.1') {
- $w->add($path, -text => $path);
- $binfo{$path} = "BalloonInfo: $path";
- }
- $b->attach($w, -balloonposition => "mouse", -msg => \%binfo);
- },
- },
- qw(IconList InputO
- LabEntry LabFrame LabRadio NBFrame Optionmenu
- Panedwindow ProgressBar TList Table
- Tiler TixGrid Tree
- ),
-
- {separator => 'Installed non-core Tk modules'},
-
- qw(Date DateEntry NumEntry NumEntryPlain
- PathEntry
- ),
- {class => 'FireButton', action => sub {
- my $w = shift;
- my $text = 'This is a firebutton 0';
- $w->configure(-textvariable => \$text,
- -command => sub {
- $text =~ s{(\d+)}{$1+1}e;
- },
- );
- },
- },
- {class => 'TFrame', w_args => [@px_geom, -bg => 'red',
- -label => [ -text => 'Title' ],
- -borderwidth => 2,
- -relief => 'groove',
- ],
- },
- {class => 'ToolBar', w_args => [qw/-movable 1 -side top
- -indicatorcolor blue/],
- action => sub {
- my $tb = shift;
- $tb->ToolButton (-text => 'Button',
- -tip => 'tool tip',
- -command => sub { print "hi\n" });
- $tb->ToolLabel (-text => 'A Label');
- $tb->Label (-text => 'Another Label');
- $tb->ToolLabEntry(-label => 'A LabEntry',
- -labelPack => [-side => "left",
- -anchor => "w"]);
- },
- },
- {class => 'HistEntry', action => sub {
- my $w = shift;
- $w->bind("<Return>" => sub {
- # do something with value, and then:
- $w->historyAdd;
- $w->delete('0', 'end');
- });
- },
- },
- {class => 'MListbox', w_args => [-columns=>[[-text=>'Heading1',
- -sortable=>0],
- [-text=>'Heading2']]],
- action => sub {
- my $w = shift;
- $w->insert("end", [qw(Cell11 Cell12)], [qw(Cell21 Cell22)]);
- },
- },
- {class => 'Cloth', w_args => [@px_geom],
- action => sub {
- my($w) = @_;
- my @colors = qw(red green blue orange black white);
- for (1..50) {
- $w->Line(-coords => [rand($px_w),rand($px_h),
- rand($px_w),rand($px_h)],
- -fill => $colors[rand @colors],
- -width => rand(4)+1,
- );
- }
- },
- },
- {class => 'DirSelect', dialog => 1},
- {class => 'ExecuteCommand', w_args => [@txt_geom]},
- {class => 'FontDialog', dialog => 1},
- {class => 'JBrowseEntry', action => $insert_lb},
- {class => 'JFileDialog', dialog => 1},
- {class => 'More', w_args => [@txt_geom], action => sub {
- shift->Load($DEMO_FILE),
- }, scrolled => 'oe'},
- {class => 'ObjEditor', w_args => [@txt_geom, -caller => { dummy => 'object'}]},
- {class => 'ObjScanner', w_args => [@txt_geom, -caller => $TOP]},
- {class => 'PodText', require => 'Tk::Pod::Text',
- w_args => [@txt_geom, -file => 'Tk']},
- {class => 'XMLViewer', w_args => [@txt_geom], action => sub {
- shift->insertXML(-text => "<?xml version='1.0' ?><a><bla /><foo>bar</foo></a>");
- }, scrolled => 'oe'},
- {class => 'Zinc', w_args => [@px_geom],
- action => sub {
- my($w) = @_;
- my @colors = qw(red green blue orange black white);
- for (1..20) {
- $w->add('curve', 1, [map { (rand($px_w),rand($px_h)) } (1..5)],
- -relief => 'roundgroove',
- -filled => 1,
- -fillcolor => $colors[rand @colors],
- );
- }
- },
- },
- );
- $f->grid('columnconfigure', $_, -pad => 3, -weight => 1) for (0 .. 1);
- $f->grid('rowconfigure', $_, -pad => 3, -weight => 1) for (0 .. $#w_def);
- my $row = -1;
- for my $w_def (@w_def) {
- my($separator, $text, $class, @w_args, $action, $scrolled, $dialog, $dialog_action);
- if (UNIVERSAL::isa($w_def, "HASH")) {
- $separator = $w_def->{separator};
- if (!$separator) {
- $class = $w_def->{class};
- $text = $w_def->{text} || $class;
- @w_args = @{ $w_def->{w_args} || [] };
- $action = $w_def->{action};
- $scrolled = $w_def->{scrolled};
- $dialog = $w_def->{dialog};
- $dialog_action = $w_def->{dialog_action};
- if ($dialog && !$dialog_action) {
- $dialog_action = sub { shift->Show };
- }
- if ($w_def->{require}) {
- eval 'require ' . $w_def->{require};
- if ($@) {
- warn $@;
- next;
- }
- }
- }
- } else {
- ($text, $class) = ($w_def, $w_def);
- }
-
- $row++;
-
- if ($separator) {
- $f->Label(-text => $separator,
- -font => 'Helvetica 18',
- -pady => 5,
- )->grid(-row => $row,
- -column => 0,
- -columnspan => 3,
- );
- next;
- }
-
- my $bgcolor = $row%2==0 ? '#c0c0c0' : '#a0a0a0';
- my $ff = $f->Frame(-background => $bgcolor,
- )->grid(-row => $row,
- -column => 1,
- -sticky => 'news',
- );
- my $cw = eval {
- if ($dialog) {
- $ff->$class(@w_args)->destroy; # just load it...
- $ff->Button(-text => 'Open ' . $class,
- -command => sub {
- # There are some buggy dialogs which display
- # already without calling a Show method (e.g. Tk::FBox),
- # so create here
- my $d = $ff->$class(@w_args);
- $dialog_action->($d) if $dialog_action;
- })->pack;
- } else {
- if ($scrolled) {
- $ff->Scrolled($class, @w_args, -scrollbars => $scrolled)->pack;
- } else {
- $ff->$class(@w_args)->pack;
- }
- }
- };
- if ($@ || !$cw) {
- warn $@;
- $row--;
- $ff->destroy;
- next;
- }
-
- $action->($cw) if $action && !$dialog;
-
- $f->Label(-text => $text,
- -background => $bgcolor,
- -anchor => 'w',
- )->grid(-row => $row,
- -column => 0,
- -sticky => "news",
- );
-
- $f->Button(-text => 'Pod',
- -background => $bgcolor,
- -command => sub {
- require Tk::Pod;
- $TOP->Pod(-file => 'Tk::' . $class);
- },
- )->grid(-row => $row,
- -column => 2,
- -sticky => 'news',
- );
- }
- # $TOP->WidgetDump;
-}
-
-__END__
diff --git a/Master/tlpkg/tlperl/lib/Tk/demos/widtrib/cursor.pl b/Master/tlpkg/tlperl/lib/Tk/demos/widtrib/cursor.pl
deleted file mode 100644
index 645f1433d54..00000000000
--- a/Master/tlpkg/tlperl/lib/Tk/demos/widtrib/cursor.pl
+++ /dev/null
@@ -1,65 +0,0 @@
-# Predefined cursors.
-# -*- perl -*-
-
-#
-# $Id: $
-# Author: Slaven Rezic
-#
-# Copyright (C) 2006,2008 Slaven Rezic. All rights reserved.
-# This program is free software; you can redistribute it and/or
-# modify it under the same terms as Perl itself.
-#
-# Mail: slaven@rezic.de
-# WWW: http://www.rezic.de/eserte/
-#
-
-use vars qw/$TOP/;
-
-sub cursor {
- my($demo) = @_;
- $TOP = $MW->WidgetDemo(
- -name => $demo,
- -text => <<'EOF',
-This window displays the names of Tk's built-in
-resp. predefined X11 cursors. Click or move on
-the names to see the cursor shape.
-EOF
- -geometry_manager => 'grid',
- -title => 'Predefined cursors',
- -iconname => 'Predefined cursors',
- );
-
- my $fh;
- TRY_CURSORFONTH: {
- for my $cursorfonth (Tk->findINC("X11/cursorfont.h"),
- "/usr/X11R6/include/X11/cursorfont.h",
- "/usr/include/X11/cursorfont.h",
- ) {
- last TRY_CURSORFONTH if (open $fh, $cursorfonth);
- }
- $TOP->Label(-text => "Sorry. I can't find X11/cursorfont.h on this system.")->grid;
- return;
- }
-
- while(<$fh>) {
- chomp;
- if (/XC_(\S+)/) {
- my $cursorname = $1;
- next if $cursorname eq 'num_glyphs';
- push @cursors, $cursorname;
- }
- }
-
- $lb = $TOP->Scrolled("Listbox", -scrollbars => "ose", -selectmode => "browse")->grid(-sticky => "ns");
- $lb->insert("end", @cursors);
- $lb->bind("<Motion>", sub {
- my($inx) = $lb->nearest($lb->Subwidget("scrolled")->XEvent->y);
- $lb->configure(-cursor => $cursors[$inx]);
- });
- $lb->bind("<<ListboxSelect>>", sub {
- my($inx) = $lb->curselection;
- $lb->configure(-cursor => $cursors[$inx]);
- });
-}
-
-__END__
diff --git a/Master/tlpkg/tlperl/lib/Tk/demos/widtrib/lib/npuz/Xcamel.npuz b/Master/tlpkg/tlperl/lib/Tk/demos/widtrib/lib/npuz/Xcamel.npuz
deleted file mode 100644
index c5c8318d145..00000000000
--- a/Master/tlpkg/tlperl/lib/Tk/demos/widtrib/lib/npuz/Xcamel.npuz
+++ /dev/null
Binary files differ
diff --git a/Master/tlpkg/tlperl/lib/Tk/demos/widtrib/npuz.pl b/Master/tlpkg/tlperl/lib/Tk/demos/widtrib/npuz.pl
deleted file mode 100644
index 3a6ba17f937..00000000000
--- a/Master/tlpkg/tlperl/lib/Tk/demos/widtrib/npuz.pl
+++ /dev/null
@@ -1,226 +0,0 @@
-# A N-puzzle implemented via the Grid geometry manager.
-#
-# This program is described in the Perl/Tk column from Volume 1, Issue 4 of
-# The Perl Journal (http://tpj.com/tpj), and is included in the Perl/Tk
-# distribution with permission. It has been modified slightly to conform
-# to the widget demo standard.
-
-#!/usr/local/bin/perl -w
-#
-# puz - demonstrate the Grid geometry manager by implementing an n-puzzle.
-#
-# Stephen O. Lidie, Lehigh University Computing Center, lusol@Lehigh.EDU
-# 96/08/11.
-#
-# Copyright (C) 1996 - 1998 Stephen O. Lidie. All rights reserved.
-#
-# This program is free software; you can redistribute it and/or modify it under
-# the same terms as Perl itself.
-
-require 5.002;
-use Tk;
-use Tk::Dialog;
-use strict;
-use subs qw(beep create_puz create_ui puz_fini move_piece new_puz randomly xy);
-
-my $CAMEL; # Perl/Tk Xcamel.gif Photo image
-my $CAMEL_HEIGHT; # Xcamel height
-my $CAMEL_WIDTH; # Xcamel width
-my (@LEVELS) = (9, 16, 36, 64); # possible puzzle piece counts
-my $MW = MainWindow->new; # program's main window
-my @ORDER; # random puzzle piece ordinals
-my $PIECES = $LEVELS[1]; # total puzzle piece count
-my $OLD_PIECES = -1; # previous puzzle piece count
-my $PF; # puzzle Frame
-my @PUZ; # puzzle piece information
-my $SIDE; # pieces per side of puzzle
-my $SPACE; # shortcut to puzzle space piece
-my $SPACE_IMAGE; # space piece image
-
-create_ui;
-create_puz;
-
-sub beep {$MW->bell}
-
-sub create_puz {
-
- return if $PIECES == $OLD_PIECES;
-
- # Create all the puzzle pieces - buttons with images - and arrange them
- # in a rectangular grid. @PUZ is a list of button widget references which
- # represent the puzzle pieces.
- #
- # The actual ordering is controlled by @ORDER, a list of list of two:
- #
- # $ORDER[$i]->[0] = puzzle piece ordinal
- # $ORDER[$i]->[1] = random number used to shuffle the puzzle ordinals
- #
- # If the puzzle frame $PF exists, we've been here before, which means that
- # all images and widgets associated with the previous puzzle need
- # destroying, plugging a potential memory leak. It's important to note
- # that an image must be explicity deleted - it doesn't magically go away
- # if a widget, which just happens to use it, is destroyed. So, loop
- # through all the puzzle pieces and delete their images, then destroy the
- # puzzle's master frame $PF, destroying all child widgets. Now, this
- # scheme isn't particulary efficient, but it is simple; ideally, we'd like
- # to create these images only once and reuse them as required.
-
- if (Exists $PF) {
- my $image;
- foreach (@PUZ) {
- $image = $_->cget(-image);
- $image = $SPACE_IMAGE if not defined $image;
- $image->delete;
- }
- $PF->destroy;
- }
-
- $PF = $MW->Frame->grid; # create the puzzle frame grid master
- $OLD_PIECES = $PIECES;
- $#PUZ = $#ORDER = $PIECES - 1;
- $SIDE = sqrt $PIECES;
-
- my($i, $o, $c, $r, $w, $h, $x, $y, $but, $gif);
-
- foreach (0..$#ORDER) {$ORDER[$_] = [$_, undef]}
-
- for($i = 0; $i <= $#PUZ; $i++) {
- $o = $ORDER[$i]->[0];
- ($c, $r) = xy $o; # puzzle ordinal to column/row
- $w = $CAMEL_WIDTH / $SIDE;
- $h = $CAMEL_HEIGHT / $SIDE;
- $x = $c * $w; # x/column pixel offset
- $y = $r * $h; # y/row pixel offset
- $gif = $PF->Photo; # new, empty, GIF image
- $gif->copy($CAMEL, -from => $x, $y, $x+$w, $y+$h);
- $but = $PF->Button(-image => $gif,
- -relief => 'flat',
- -borderwidth => 0,
- -command => \&beep,
- -highlightthickness => 0,
- );
- $PUZ[$o] = $but;
- ($c, $r) = xy $i;
- $but->grid(-column => $c, -row => $r, -sticky => 'nsew');
- if ($o == 0) {
- $SPACE_IMAGE = $gif;
- $SPACE = $but;
- }
- } # forend all puzzle pieces
-
-} # end create_puz
-
-sub create_ui {
-
- # Create a color Photo image of the Xcamel puzzle.
-
- $CAMEL = $MW->Photo(-file => "$WIDTRIB/lib/npuz/Xcamel.npuz");
- $CAMEL_WIDTH = $CAMEL->image('width');
- $CAMEL_HEIGHT = $CAMEL->image('height');
-
- # Create the menubar.
-
- my $mf = $MW->Frame(-bg => 'blue')->grid(-sticky => 'ew');
- $mf->gridColumnconfigure(1, -weight => 1);
-
- my $mbf = $mf->Menubutton(-text => 'File', -relief => 'raised');
- $mbf->command(-label => 'New Puzzle', -command => \&new_puz);
- $mbf->separator;
- $mbf->command(-label => 'Quit', -command => [$MW => 'bell']);
-
- my $mbp = $mf->Menubutton(-text => 'Prefs', -relief => 'raised');
- my $pieces = 'Pieces';
- $mbp->cascade(-label => $pieces);
- my $mbpm = $mbp->cget(-menu);
- my $mbpmp = $mbpm->Menu;
- $mbp->entryconfigure($pieces, -menu => $mbpmp);
- foreach (@LEVELS) {
- $mbpmp->radiobutton(-label => $_,
- -variable => \$PIECES,
- -value => $_,
- -command => \&create_puz,
- );
- }
-
- my $mbq = $mf->Menubutton(-text => 'Help', -relief => 'raised');
- my $about = $MW->Dialog(-text => <<"END"
-npuz Version 1.0\n
-Select \"File/New Puzzle\", then click around the red \"space\" to rearrange the pieces and solve the puzzle!\n\nThis program is described in the Perl/Tk column from Volume 1, Issue 4 of The Perl Journal (http://tpj.com/tpj), and is included in the Perl/Tk distribution with permission.
-END
- );
- $about->configure(-wraplength => '6i');
- $mbq->command(-label => 'About', -command => [$about => 'Show']);
-
- $mbf->grid(-row => 0, -column => 0, -sticky => 'w');
- $mbp->grid(-row => 0, -column => 1, -sticky => 'w');
- $mbq->grid(-row => 0, -column => 2, -sticky => 'e');
-
-} # end create_ui
-
-sub puz_fini {
-
- # Return true iff all puzzle pieces are in order.
-
- my($i, $c, $r, %info);
- for($i = 0; $i <= $#PUZ; $i++) {
- ($c, $r) = xy $i;
- %info = $PUZ[$i]->gridInfo;
- return 0 if $c != $info{-column} or $r != $info{-row};
- }
- return 1;
-
-} # end puz_fini
-
-sub move_piece {
-
- my($piece) = @_;
-
- my(%info, $c, $r, $sc, $sr);
- %info = $piece->gridInfo; ($c, $r) = @info{-column,-row};
- %info = $SPACE->gridInfo; ($sc, $sr) = @info{-column,-row};
- if ( ($sr == $r and ($sc == $c-1 or $sc == $c+1)) or
- ($sc == $c and ($sr == $r-1 or $sr == $r+1)) ) {
- $SPACE->grid(-column => $c, -row => $r);
- $piece->grid(-column => $sc, -row => $sr);
- }
- if (puz_fini) {
- my $color = ($SPACE->configure(-activebackground))[3];
- $SPACE->configure(-image => $SPACE_IMAGE,
- -activebackground => $color,
- -background => $color,
- -relief => 'flat',
- );
- foreach (@PUZ) {$_->configure(-command => \&beep)}
- }
-
-} # end move_piece
-
-sub new_puz {
-
- srand time;
- foreach (0..$#ORDER) {$ORDER[$_]->[1] = rand $#ORDER}
- my @order = sort randomly @ORDER;
- #@order = @ORDER; # here's how I solve the puzzle (;
- my($i, $o, $c, $r, $but);
-
- for($i = 0; $i <= $#PUZ; $i++) {
- $o = $order[$i]->[0];
- $but = $PUZ[$o];
- if ($o == 0) {
- $but->configure(-background => 'red',
- -relief => 'sunken',
- -image => undef,
- -activebackground => 'red',
- );
- } else {
- $but->configure(-command => [\&move_piece, $but]);
- }
- ($c, $r) = xy $i;
- $but->grid(-column => $c, -row => $r, -sticky => 'nsew');
- }
-
-} # end new_puz
-
-sub randomly {$a->[1] <=> $b->[1]} # randomize order of puzzle pieces
-
-sub xy {my($n) = @_; ($n % $SIDE, int $n / $SIDE)} # ordinal to X/Y
diff --git a/Master/tlpkg/tlperl/lib/Tk/demos/widtrib/plop.pl b/Master/tlpkg/tlperl/lib/Tk/demos/widtrib/plop.pl
deleted file mode 100644
index bd6f801b03f..00000000000
--- a/Master/tlpkg/tlperl/lib/Tk/demos/widtrib/plop.pl
+++ /dev/null
@@ -1,381 +0,0 @@
-# Plot a series of continuous functions on a Perl/Tk Canvas.
-#
-# This program is described in the Perl/Tk column from Volume 1, Issue 1 of
-# The Perl Journal (http://tpj.com/tpj), and is included in the Perl/Tk
-# distribution with permission. It has been modified slightly to conform
-# to the widget demo standard.
-
-#!/usr/local/bin/perl -w
-#
-# plot_program - plot a series of continuous functions on a Perl/Tk Canvas.
-#
-# Stephen O. Lidie, Lehigh University Computing Center, lusol@Lehigh.EDU
-# 96/01/27.
-#
-# Copyright (C) 1996 - 1998 Stephen O. Lidie. All rights reserved.
-#
-# This program is free software; you can redistribute it and/or modify it under
-# the same terms as Perl itself.
-
-require 5.002;
-use strict;
-use Tk;
-use Tk::Dialog;
-use Tk::LabEntry;
-eval {require "plop.fnc";}; # user supplied math functions
-
-# Predeclare global subroutines and variables.
-
-sub collect_errors;
-sub display_coordinates;
-sub initialize_canvas;
-sub initialize_dialogs;
-sub initialize_functions;
-sub initialize_menus;
-sub make_menubutton;
-sub plot_functions;
-sub update_functions;
-
-my $VERSION = '1.0';
-
-# The default sample functions and limits, each in a different color.
-
-my (@FUNCTIONS) = ('sin($x)', 'cos($x)', 'exp($x)', '$x', 'int($x)');
-my (@COLORS) = qw(red green blue orange olivedrab magenta black salmon purple);
-my $NUM_COLORS = scalar @COLORS;
-my ($X_MIN, $X_MAX, $Y_MIN, $Y_MAX) = (-5, 5, -5, 5);
-my ($DX, $DY) = ($X_MAX - $X_MIN, $Y_MAX - $Y_MIN);
-
-# Declare constants that configure the plotting area: a square approximately
-# 500 pixels on a side, with left/right and top/bottom margins of 80 pixles
-# where we can paint axes labels. With this layout there is a 340x340 area
-# available for graphs.
-
-my $MIN_PXL = 0; # minimum Canvas pixel coordinate
-my $MAX_PXL = 300; # maximum Canvas pixel coordinate
-my $MARGIN = 80; # margin size, in pixels
-my $ALEN = $MAX_PXL - 2 * $MARGIN; # X/Y axes length, in pixels
-
-# Declare Perl/Tk widgets and other data.
-
-my $CANV; # Canvas widget used for plotting functions
-my $DIALOG_ABOUT; # Dialog widget showing "About" information
-my $DIALOG_USAGE; # Dialog widget describing plot usage
-my $MBF; # Menubutton frame
-my $MW = MainWindow->new; # program's main window
-my $ORIGINAL_CURSOR = ($MW->configure(-cursor))[3]; # restore this cursor
-my $TEXT; # Text widget showing function definitions
-
-# %ERRORS is a hash to collect eval() and -w errors. The keys are the error
-# messages themselves and the values are the number of times a particular
-# error was detected.
-
-my %ERRORS;
-
-# Begin main.
-
-initialize_dialogs;
-initialize_menus;
-initialize_canvas;
-initialize_functions;
-
-# End main.
-
-sub collect_errors {
-
- # Update the hash %ERRORS with the latest eval() error message. Remove
- # the eval() line number (it's useless to us) to maintain a compact hash.
-
- my($error) = @_;
-
- $error =~ s/eval\s+(\d+)/eval/;
- $ERRORS{$error}++;
-
-} # end collect_errors
-
-sub display_coordinates {
-
- # Print Canvas and Plot coordinates.
-
- my($canvas) = @_;
-
- my $e = $canvas->XEvent;
- my($canv_x, $canv_y) = ($e->x, $e->y);
- my($x, $y);
- $x = $X_MIN + $DX * (($canv_x - $MARGIN) / $ALEN);
- $y = $Y_MAX - $DY * (($canv_y - $MARGIN) / $ALEN);
- print STDOUT "\nCanvas x = $canv_x, Canvas y = $canv_y.\n";
- print STDOUT "Plot x = $x, Plot y = $y.\n";
-
-} # end display_coordinates
-
-sub initialize_canvas {
-
- # Create the Canvas widget and draw axes and labels.
-
- my($label_offset, $tick_length) = (20, 5);
-
- $CANV = $MW->Canvas(
- -width => $MAX_PXL + $MARGIN * 2,
- -height => $MAX_PXL,
- -relief => 'sunken',
- );
- $CANV->pack;
- $CANV->Tk::bind('<Button-1>' => \&display_coordinates);
-
- $CANV->create('text',
- 225, 25,
- -text => 'Plot Continuous Functions Of The Form y=f($x)',
- -fill => 'blue',
- );
-
- # Create the line to represent the X axis and label it. Then label the
- # minimum and maximum X values and draw tick marks to indicate where they
- # fall. The axis limits are LabEntry widgets embedded in Canvas windows.
-
- $CANV->create('line',
- $MIN_PXL + $MARGIN, $MAX_PXL - $MARGIN,
- $MAX_PXL - $MARGIN, $MAX_PXL - $MARGIN,
- );
-
- $CANV->create('window',
- $MIN_PXL + $MARGIN, $MAX_PXL - $label_offset,
- -window => $MW->LabEntry(
- -textvariable => \$X_MIN,
- -label => 'X Minimum',
- -width => 5,
- ),
- );
- $CANV->create('line',
- $MIN_PXL + $MARGIN, $MAX_PXL - $MARGIN - $tick_length,
- $MIN_PXL + $MARGIN, $MAX_PXL - $MARGIN + $tick_length,
- );
-
- $CANV->create('window',
- $MAX_PXL - $MARGIN, $MAX_PXL - $label_offset,
- -window => $MW->LabEntry(
- -textvariable => \$X_MAX,
- -label => 'X Maximum',
- -width => 5,
- ),
- );
- $CANV->create('line',
- $MAX_PXL - $MARGIN, $MAX_PXL - $MARGIN - $tick_length,
- $MAX_PXL - $MARGIN, $MAX_PXL - $MARGIN + $tick_length,
- );
-
- # Create the line to represent the Y axis and label it. Then label the
- # minimum and maximum Y values and draw tick marks to indicate where they
- # fall. The axis limits are LabEntry widgets embedded in Canvas windows.
-
- $CANV->create('line',
- $MAX_PXL - $MARGIN, $MIN_PXL + $MARGIN,
- $MAX_PXL - $MARGIN, $MAX_PXL - $MARGIN,
- );
-
- $CANV->create('window',
- $MAX_PXL + $label_offset, $MIN_PXL + $MARGIN,
- -window => $MW->LabEntry(
- -textvariable => \$Y_MAX,
- -label => 'Y Maximum',
- -width => 5,
- ),
- );
- $CANV->create('line',
- $MAX_PXL - $MARGIN - $tick_length, $MIN_PXL + $MARGIN,
- $MAX_PXL - $MARGIN + $tick_length, $MIN_PXL + $MARGIN,
- );
-
- $CANV->create('window',
- $MAX_PXL + $label_offset, $MAX_PXL - $MARGIN,
- -window => $MW->LabEntry(
- -textvariable => \$Y_MIN,
- -label => 'Y Minimum',
- -width => 5,
- ),
- );
- $CANV->create('line',
- $MAX_PXL - $MARGIN - $tick_length, $MAX_PXL - $MARGIN,
- $MAX_PXL - $MARGIN + $tick_length, $MAX_PXL - $MARGIN,
- );
-
-} # end initialize_canvas
-
-sub initialize_dialogs {
-
- # Create all application Dialog objects.
-
- $DIALOG_ABOUT = $MW->Dialog(
- -title => 'About',
- -text =>
-"plot_program $VERSION\n\n95/12/04\n\nThis program is described in the Perl/Tk column from Volume 1, Issue 1 of The Perl Journal (http://tpj.com/tpj), and is included in the Perl/Tk distribution with permission.",
- -bitmap => 'info',
- -buttons => ['Dismiss'],
- );
- $DIALOG_ABOUT->configure(-wraplength => '6i');
- $DIALOG_USAGE = $MW->Dialog(
- -title => 'Usage',
- -buttons => ['Dismiss'],
- );
- $DIALOG_USAGE->Subwidget('message')->configure(
- -wraplength => '4i',
- -text => "plot_program iterates over the range of values X Minimum to X Maximum, setting the variable \$x to each value in turn, then evaluates each f(\$x) and paints a point on the Y axis. The X axis increment is (Xmax - Xmin) / $ALEN.\n\nJust enter your functions in the Text widget and click the Plot button.\n\nYou can define a file named \"plop.fnc\" that contains additional private math functions, which is automatically \"require\"d by plot_program. In this file are your private functions that you can plot.\n\nPressing button one on the pointing device displays on standard output the current canvas and plot X and Y coordinates.",
- );
-
-} # end initialize_dialogs
-
-sub initialize_functions {
-
- # Pack a spacer Frame and then display instructions in a Label widget.
-
-# $MW->Frame(-height => 10)->pack;
- $MW->Label(
- -text => 'Enter your functions here',
- -foreground => 'blue',
- )->pack;
-
- # Create a Frame with a scrollable Text widget that displays the function
- # list, and a Button to initiate plot activities.
-
- my $functions_frame = $MW->Frame;
- $functions_frame->pack;
- $TEXT = $functions_frame->Text(-height => 3);
- $TEXT->pack;
- $functions_frame->AddScrollbars($TEXT);
- $functions_frame->configure(-scrollbars => 'e');
- update_functions;
-
- my $buttons_frame = $MW->Frame;
- $buttons_frame->pack(-padx => 10, -pady => 5, -expand => 1, -fill => 'x');
- my @pack_attributes = qw(-side left -fill x -expand 1);
- $buttons_frame->Button(
- -text => 'Plot',
- -command => \&plot_functions,
- )->pack(@pack_attributes);
-
-} # end initialize_functions
-
-sub initialize_menus {
-
- # Create the Menubuttons and their associated Menu items.
-
- $MBF = $MW->Frame(-relief => 'raised', -borderwidth => 1);
- $MBF->pack(-fill => 'x');
-
- make_menubutton($MBF, 'File', 0, 'left',
- [
- ['Quit', [$MW => 'bell'], 0],
- ],
- );
- make_menubutton($MBF, 'Help', 0, 'right',
- [
- ['About', [$DIALOG_ABOUT => 'Show'], 0],
- ['', undef, 0],
- ['Usage', [$DIALOG_USAGE => 'Show'], 0],
- ],
- );
-
-} # end initialize_menus
-
-sub make_menubutton {
-
- # Make a Menubutton widget; note that the Menu is automatically created.
- # If the label is '', make a separator.
-
- my($mbf, $mb_label, $mb_label_underline, $pack, $mb_list_ref) = @_;
-
- my $mb = $mbf->Menubutton(
- -text => $mb_label,
- -underline => $mb_label_underline,
- );
- my $mb_list;
- foreach $mb_list (@{$mb_list_ref}) {
- $mb_list->[0] eq '' ? $mb->separator :
- $mb->command(
- -label => $mb_list->[0],
- -command => $mb_list->[1],
- -underline => $mb_list->[2],
- );
- }
- $mb->pack(-side => $pack);
-
-} # end make_menubutton
-
-sub plot_functions {
-
- # Plot all the functions.
-
- my($x, $y, $canv_x, $canv_y) = (0, 0, 0, 0);
- $canv_x = $MIN_PXL + $MARGIN; # X minimum
- $MW->configure(-cursor => 'watch');
- $DX = $X_MAX - $X_MIN; # update delta X
- $DY = $Y_MAX - $Y_MIN; # update delta Y
- $CANV->delete('plot'); # erase all previous plots
-
- # Fetch the newline-separated Text widget contents and update the function
- # list @FUNCTIONS. Also update the Text widget with the new colors.
-
- @FUNCTIONS = ();
- foreach (split /\n/, $TEXT->get('0.0', 'end')) {
- next if $_ eq '';
- push @FUNCTIONS, $_;
- }
- update_functions;
- $MW->idletasks;
-
- %ERRORS = ();
- local $SIG{'__WARN__'} = sub {collect_errors($_[0])};
-
-ALL_X_VALUES:
- for ($x = $X_MIN; $x <= $X_MAX; $x += ($X_MAX - $X_MIN) / $ALEN) {
-
- ALL_FUNCTIONS:
- foreach (0 .. $#FUNCTIONS) {
- next if $FUNCTIONS[$_] =~ /^ERROR:/;
- $y = eval $FUNCTIONS[$_];
- if ($::EVAL_ERROR) {
- collect_errors($::EVAL_ERROR);
- next;
- }
- $canv_y = (($Y_MAX - $y) / $DY) * $ALEN + $MARGIN;
- $CANV->create('text', $canv_x, $canv_y,
- -fill => $COLORS[$_ % $NUM_COLORS],
- -tags => ['plot'],
- -text => '.',
- ) if $canv_y > $MIN_PXL + $MARGIN and
- $canv_y < $MAX_PXL - $MARGIN;
- } # forend ALL_FUNCTIONS
-
- $canv_x++; # next X pixel
-
- } # forend ALL_X_VALUES
-
- $MW->configure(-cursor => $ORIGINAL_CURSOR);
- $MW->idletasks;
-
- # Print all the eval() errors to alert the user of malformed functions.
-
- print STDOUT "\n" if %ERRORS;
- foreach (keys %ERRORS) {
- print STDOUT "$ERRORS{$_} occurrences of $_";
- }
-
-} # end plot_functions
-
-sub update_functions {
-
- # Insert the function list into the Text widget.
-
- $TEXT->delete('0.0', 'end');
- my $i = 0;
- foreach (@FUNCTIONS) {
- $TEXT->insert('end', "$_\n", [$i]);
- $TEXT->tagConfigure($i,
- -foreground => $COLORS[$i % $NUM_COLORS],
- -font => 'fixed',
- );
- $i++;
- }
- $TEXT->yview('end');
-
-} # end update_function_list