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