| 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 |