home *** CD-ROM | disk | FTP | other *** search
/ Netrunner 2004 October / NETRUNNER0410.ISO / regular / ActivePerl-5.8.4.810-MSWin32-x86.msi / _66934b951f44e6412d191d727d4bc8c0 < prev    next >
Encoding:
Text File  |  2004-06-01  |  11.6 KB  |  382 lines
  1. # Plot a series of continuous functions on a Perl/Tk Canvas.
  2. #
  3. # This program is described in the Perl/Tk column from Volume 1, Issue 1 of
  4. # The Perl Journal (http://tpj.com/tpj), and is included in the Perl/Tk
  5. # distribution with permission.  It has been modified slightly to conform
  6. # to the widget demo standard.
  7.  
  8. #!/usr/local/bin/perl -w
  9. #
  10. # plot_program - plot a series of continuous functions on a Perl/Tk Canvas.
  11. #
  12. # Stephen O. Lidie, Lehigh University Computing Center, lusol@Lehigh.EDU
  13. # 96/01/27.
  14. #
  15. # Copyright (C) 1996 - 1998 Stephen O. Lidie. All rights reserved.
  16. #
  17. # This program is free software; you can redistribute it and/or modify it under
  18. # the same terms as Perl itself.
  19.  
  20. require 5.002;
  21. use strict;
  22. use Tk;
  23. use Tk::Dialog;
  24. use Tk::LabEntry;
  25. eval {require "plop.fnc";};    # user supplied math functions
  26.  
  27. # Predeclare global subroutines and variables.
  28.  
  29. sub collect_errors;
  30. sub display_coordinates;
  31. sub initialize_canvas;
  32. sub initialize_dialogs;
  33. sub initialize_functions;
  34. sub initialize_menus;
  35. sub make_menubutton;
  36. sub plot_functions;
  37. sub update_functions;
  38.  
  39. my $VERSION = '1.0';
  40.  
  41. # The default sample functions and limits, each in a different color.
  42.  
  43. my (@FUNCTIONS) = ('sin($x)', 'cos($x)', 'exp($x)', '$x', 'int($x)');
  44. my (@COLORS) = qw(red green blue orange olivedrab magenta black salmon purple);
  45. my $NUM_COLORS = scalar @COLORS;
  46. my ($X_MIN, $X_MAX, $Y_MIN, $Y_MAX) = (-5, 5, -5, 5);
  47. my ($DX, $DY) = ($X_MAX - $X_MIN, $Y_MAX - $Y_MIN);
  48.  
  49. # Declare constants that configure the plotting area: a square approximately
  50. # 500 pixels on a side, with left/right and top/bottom margins of 80 pixles
  51. # where we can paint axes labels.  With this layout there is a 340x340 area
  52. # available for graphs.
  53.  
  54. my $MIN_PXL = 0;        # minimum Canvas pixel coordinate
  55. my $MAX_PXL = 300;        # maximum Canvas pixel coordinate
  56. my $MARGIN = 80;        # margin size, in pixels
  57. my $ALEN = $MAX_PXL - 2 * $MARGIN; # X/Y axes length, in pixels
  58.  
  59. # Declare Perl/Tk widgets and other data.
  60.  
  61. my $CANV;            # Canvas widget used for plotting functions
  62. my $DIALOG_ABOUT;        # Dialog widget showing "About" information
  63. my $DIALOG_USAGE;        # Dialog widget describing plot usage
  64. my $MBF;            # Menubutton frame
  65. my $MW = MainWindow->new;    # program's main window
  66. my $ORIGINAL_CURSOR = ($MW->configure(-cursor))[3]; # restore this cursor
  67. my $TEXT;            # Text widget showing function definitions
  68.  
  69. # %ERRORS is a hash to collect eval() and -w errors.  The keys are the error
  70. # messages themselves and the values are the number of times a particular
  71. # error was detected.
  72.  
  73. my %ERRORS;
  74.  
  75. # Begin main.
  76.  
  77. initialize_dialogs;
  78. initialize_menus;
  79. initialize_canvas;
  80. initialize_functions;
  81.  
  82. # End main.
  83.  
  84. sub collect_errors {
  85.  
  86.     # Update the hash %ERRORS with the latest eval() error message.  Remove
  87.     # the eval() line number (it's useless to us) to maintain a compact hash.
  88.  
  89.     my($error) = @_;
  90.  
  91.     $error =~ s/eval\s+(\d+)/eval/;
  92.     $ERRORS{$error}++;
  93.  
  94. } # end collect_errors
  95.  
  96. sub display_coordinates {
  97.  
  98.     # Print Canvas and Plot coordinates.
  99.  
  100.     my($canvas) = @_;
  101.  
  102.     my $e = $canvas->XEvent;
  103.     my($canv_x, $canv_y) = ($e->x, $e->y);
  104.     my($x, $y);
  105.     $x = $X_MIN + $DX * (($canv_x - $MARGIN) / $ALEN);
  106.     $y = $Y_MAX - $DY * (($canv_y - $MARGIN) / $ALEN);
  107.     print STDOUT "\nCanvas x = $canv_x, Canvas y = $canv_y.\n";
  108.     print STDOUT  "Plot x = $x, Plot y = $y.\n";
  109.  
  110. } # end display_coordinates
  111.  
  112. sub initialize_canvas {
  113.  
  114.     # Create the Canvas widget and draw axes and labels.
  115.  
  116.     my($label_offset, $tick_length) = (20, 5);
  117.  
  118.     $CANV = $MW->Canvas(
  119.             -width  => $MAX_PXL + $MARGIN * 2,
  120.             -height => $MAX_PXL,
  121.             -relief => 'sunken',
  122.             );
  123.     $CANV->pack;
  124.     $CANV->Tk::bind('<Button-1>' => \&display_coordinates);
  125.  
  126.     $CANV->create('text',
  127.           225, 25,
  128.           -text => 'Plot Continuous Functions Of The Form y=f($x)',
  129.           -fill => 'blue',
  130.           );
  131.  
  132.     # Create the line to represent the X axis and label it.  Then label the
  133.     # minimum and maximum X values and draw tick marks to indicate where they
  134.     # fall.  The axis limits are LabEntry widgets embedded in Canvas windows.
  135.  
  136.     $CANV->create('line',
  137.           $MIN_PXL + $MARGIN, $MAX_PXL - $MARGIN,
  138.           $MAX_PXL - $MARGIN, $MAX_PXL - $MARGIN,
  139.           );
  140.  
  141.     $CANV->create('window',
  142.           $MIN_PXL + $MARGIN, $MAX_PXL - $label_offset,
  143.           -window => $MW->LabEntry(
  144.                        -textvariable => \$X_MIN,
  145.                        -label => 'X Minimum',
  146.                        -width => 5,
  147.                        ),
  148.           );
  149.     $CANV->create('line',
  150.           $MIN_PXL + $MARGIN, $MAX_PXL - $MARGIN - $tick_length,
  151.           $MIN_PXL + $MARGIN, $MAX_PXL - $MARGIN + $tick_length,
  152.           );
  153.  
  154.     $CANV->create('window',
  155.           $MAX_PXL - $MARGIN, $MAX_PXL - $label_offset,
  156.           -window => $MW->LabEntry(
  157.                        -textvariable => \$X_MAX,
  158.                        -label => 'X Maximum',
  159.                        -width => 5,
  160.                        ),
  161.           );
  162.     $CANV->create('line',
  163.           $MAX_PXL - $MARGIN, $MAX_PXL - $MARGIN - $tick_length,
  164.           $MAX_PXL - $MARGIN, $MAX_PXL - $MARGIN + $tick_length,
  165.           );
  166.  
  167.     # Create the line to represent the Y axis and label it.  Then label the
  168.     # minimum and maximum Y values and draw tick marks to indicate where they
  169.     # fall.  The axis limits are LabEntry widgets embedded in Canvas windows.
  170.  
  171.     $CANV->create('line',
  172.           $MAX_PXL - $MARGIN, $MIN_PXL + $MARGIN,
  173.           $MAX_PXL - $MARGIN, $MAX_PXL - $MARGIN,
  174.           );
  175.  
  176.     $CANV->create('window',
  177.           $MAX_PXL + $label_offset, $MIN_PXL + $MARGIN,
  178.           -window => $MW->LabEntry(
  179.                        -textvariable => \$Y_MAX,
  180.                        -label => 'Y Maximum',
  181.                        -width => 5,
  182.                        ),
  183.           );
  184.     $CANV->create('line',
  185.           $MAX_PXL - $MARGIN - $tick_length, $MIN_PXL + $MARGIN,
  186.           $MAX_PXL - $MARGIN + $tick_length, $MIN_PXL + $MARGIN,
  187.           );
  188.  
  189.     $CANV->create('window',
  190.           $MAX_PXL + $label_offset, $MAX_PXL - $MARGIN,
  191.           -window => $MW->LabEntry(
  192.                        -textvariable => \$Y_MIN,
  193.                        -label => 'Y Minimum',
  194.                        -width => 5,
  195.                        ),
  196.           );
  197.     $CANV->create('line',
  198.           $MAX_PXL - $MARGIN - $tick_length, $MAX_PXL - $MARGIN,
  199.           $MAX_PXL - $MARGIN + $tick_length, $MAX_PXL - $MARGIN,
  200.           );
  201.  
  202. } # end initialize_canvas
  203.  
  204. sub initialize_dialogs {
  205.  
  206.     # Create all application Dialog objects.
  207.  
  208.     $DIALOG_ABOUT = $MW->Dialog(
  209.                 -title   => 'About',
  210.                 -text    =>
  211. "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.",
  212.                 -bitmap  => 'info',
  213.                 -buttons => ['Dismiss'],
  214.                 );
  215.     $DIALOG_ABOUT->configure(-wraplength => '6i');
  216.     $DIALOG_USAGE = $MW->Dialog(
  217.                 -title   => 'Usage',
  218.                 -buttons => ['Dismiss'],
  219.                 );
  220.     $DIALOG_USAGE->Subwidget('message')->configure(
  221.                            -wraplength => '4i',
  222.                            -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.",
  223.                            );
  224.  
  225. } # end initialize_dialogs
  226.  
  227. sub initialize_functions {
  228.  
  229.     # Pack a spacer Frame and then display instructions in a Label widget.
  230.  
  231. #    $MW->Frame(-height => 10)->pack;
  232.     $MW->Label(
  233.            -text       => 'Enter your functions here',
  234.            -foreground => 'blue',
  235.            )->pack;
  236.  
  237.     # Create a Frame with a scrollable Text widget that displays the function
  238.     # list, and a Button to initiate plot activities.
  239.  
  240.     my $functions_frame = $MW->Frame;
  241.     $functions_frame->pack;
  242.     $TEXT = $functions_frame->Text(-height => 3);
  243.     $TEXT->pack;
  244.     $functions_frame->AddScrollbars($TEXT);
  245.     $functions_frame->configure(-scrollbars => 'e');
  246.     update_functions;
  247.  
  248.     my $buttons_frame = $MW->Frame;
  249.     $buttons_frame->pack(-padx => 10, -pady => 5, -expand => 1, -fill => 'x');
  250.     my @pack_attributes = qw(-side left -fill x -expand 1);
  251.     $buttons_frame->Button(
  252.                -text    => 'Plot',
  253.                -command => \&plot_functions,
  254.                )->pack(@pack_attributes);
  255.  
  256. } # end initialize_functions
  257.  
  258. sub initialize_menus {
  259.  
  260.     # Create the Menubuttons and their associated Menu items.
  261.  
  262.     $MBF = $MW->Frame(-relief => 'raised', -borderwidth => 1);
  263.     $MBF->pack(-fill => 'x');
  264.  
  265.     make_menubutton($MBF, 'File', 0, 'left',
  266.             [
  267.              ['Quit',  [$MW => 'bell'],          0],
  268.             ],
  269.            );
  270.     make_menubutton($MBF, 'Help', 0, 'right',
  271.             [
  272.              ['About', [$DIALOG_ABOUT => 'Show'], 0],
  273.              ['',      undef,                     0],
  274.              ['Usage', [$DIALOG_USAGE => 'Show'], 0],
  275.             ],
  276.            );
  277.  
  278. } # end initialize_menus
  279.  
  280. sub make_menubutton {
  281.  
  282.     # Make a Menubutton widget; note that the Menu is automatically created.
  283.     # If the label is '', make a separator.
  284.  
  285.     my($mbf, $mb_label, $mb_label_underline, $pack, $mb_list_ref) = @_;
  286.  
  287.     my $mb = $mbf->Menubutton(
  288.                    -text      => $mb_label,
  289.                    -underline => $mb_label_underline,
  290.                   );
  291.     my $mb_list;
  292.     foreach $mb_list (@{$mb_list_ref}) {
  293.     $mb_list->[0] eq '' ? $mb->separator :
  294.         $mb->command(
  295.              -label     => $mb_list->[0],
  296.              -command   => $mb_list->[1],
  297.              -underline => $mb_list->[2],
  298.              );
  299.     }
  300.     $mb->pack(-side => $pack);
  301.  
  302. } # end make_menubutton
  303.  
  304. sub plot_functions {
  305.  
  306.     # Plot all the functions.
  307.  
  308.     my($x, $y, $canv_x, $canv_y) = (0, 0, 0, 0);
  309.     $canv_x = $MIN_PXL + $MARGIN; # X minimum
  310.     $MW->configure(-cursor => 'watch');
  311.     $DX = $X_MAX - $X_MIN;    # update delta X
  312.     $DY = $Y_MAX - $Y_MIN;    # update delta Y
  313.     $CANV->delete('plot');    # erase all previous plots
  314.  
  315.     # Fetch the newline-separated Text widget contents and update the function
  316.     # list @FUNCTIONS.  Also update the Text widget with the new colors.
  317.  
  318.     @FUNCTIONS = ();
  319.     foreach (split /\n/, $TEXT->get('0.0', 'end')) {
  320.     next if $_ eq '';
  321.     push @FUNCTIONS, $_;
  322.     }
  323.     update_functions;
  324.     $MW->idletasks;
  325.  
  326.     %ERRORS = ();
  327.     local $SIG{'__WARN__'} = sub {collect_errors($_[0])};
  328.  
  329. ALL_X_VALUES:
  330.     for ($x = $X_MIN; $x <= $X_MAX; $x += ($X_MAX - $X_MIN) / $ALEN) {
  331.  
  332.       ALL_FUNCTIONS:
  333.     foreach (0 .. $#FUNCTIONS) {
  334.         next if $FUNCTIONS[$_] =~ /^ERROR:/;
  335.         $y = eval $FUNCTIONS[$_];
  336.         if ($::EVAL_ERROR) {
  337.         collect_errors($::EVAL_ERROR);
  338.         next;
  339.         }
  340.         $canv_y = (($Y_MAX - $y) / $DY) * $ALEN + $MARGIN;
  341.         $CANV->create('text', $canv_x, $canv_y,
  342.               -fill => $COLORS[$_ % $NUM_COLORS],
  343.               -tags => ['plot'],
  344.               -text => '.',
  345.               ) if $canv_y > $MIN_PXL + $MARGIN and
  346.                    $canv_y < $MAX_PXL - $MARGIN;
  347.     } # forend ALL_FUNCTIONS
  348.  
  349.     $canv_x++;        # next X pixel
  350.  
  351.     } # forend ALL_X_VALUES
  352.  
  353.     $MW->configure(-cursor => $ORIGINAL_CURSOR);
  354.     $MW->idletasks;
  355.  
  356.     # Print all the eval() errors to alert the user of malformed functions.
  357.  
  358.     print STDOUT "\n" if %ERRORS;
  359.     foreach (keys %ERRORS) {
  360.     print STDOUT "$ERRORS{$_} occurrences of $_";
  361.     }
  362.  
  363. } # end plot_functions
  364.  
  365. sub update_functions {
  366.  
  367.     # Insert the function list into the Text widget.
  368.  
  369.     $TEXT->delete('0.0', 'end');
  370.     my $i = 0;
  371.     foreach (@FUNCTIONS) {
  372.     $TEXT->insert('end', "$_\n", [$i]);
  373.     $TEXT->tagConfigure($i,
  374.            -foreground => $COLORS[$i % $NUM_COLORS],
  375.            -font       => 'fixed',
  376.            );
  377.     $i++;
  378.     }
  379.     $TEXT->yview('end');
  380.  
  381. } # end update_function_list
  382.