1use strict; 2use warnings; 3 4############################################################################ 5 package PDL::Demos::Prima; 6############################################################################ 7 8use PDL; 9 10=head1 NAME 11 12PDL::Demos::Prima - PDL demo for PDL::Graphics::Prima 13 14=head1 SYNOPSIS 15 16You can enjoy this demo in any number of ways. First, you can invoke the 17demo from the command line by saying 18 19 perl -MPDL::Demos::Prima 20 21Second, you can invoke the demo from with the pdl shell by saying 22 23 pdl> demo prima 24 25Finally, all of the content is in the pod documentation, so you can simply 26read this, though it won't be quite so interactive. :-) 27 28 perldoc PDL::Demos::Prima 29 podview PDL::Demos::Prima 30 31=head1 DESCRIPTION 32 33The documentation in this module is meant to give a short, hands-on 34introduction to L<PDL::Graphics::Prima|PDL::Graphics::Prima/>, a plotting 35library written on top of the L<Prima|Prima/> GUI toolkit. 36 37=cut 38 39############################## 40# Check load status of Prima # 41############################## 42 43my $min_version = 0.13; 44my $loaded_prima = eval { 45 require PDL::Graphics::Prima; 46 return 0 if $PDL::Graphics::Prima::VERSION < $min_version; 47 require PDL::Graphics::Prima::Simple; 48 PDL::Graphics::Prima::Simple->import(); 49 require Prima::Application; 50 Prima::Application->import(); 51 1; 52}; 53 54########################################### 55# Pull the demo pod into a data structure # 56########################################### 57 58# Pull the pod apart into the following sort of array structure 59# @demo = ( 60# 'Introduction' => $first_paragraph => $first_code, 61# 'Introduction' => $second_paragraph => $second_code, 62# ... 63# 'First steps' => $first_paragraph => $first_code, 64# ... 65# ); 66 67my (@demo, $curr_section, $curr_par, $curr_code); 68my $curr_state = 'section_title'; 69while(my $line = <DATA>) { 70 # Only =head2s in this documentation 71 last if $line =~ /=head1/; 72 if ($line =~ /^=head2 (.*)/) { 73 # Add the current section's name and an empty arrayref 74 $curr_section = $1; 75 } 76 elsif ($line =~ /^\n/) { 77 if (defined $curr_par and defined $curr_code) { 78 push @demo, $curr_section, $curr_par, $curr_code; 79 $curr_par = $curr_code = undef; 80 } 81 } 82 elsif (not defined $curr_par) { 83 $curr_par = $line; 84 } 85 elsif (not defined $curr_code and $line !~ /^\s/) { 86 $curr_par .= $line; 87 } 88 elsif ($line =~ /^\s/) { 89 # Accumulate code lines, stripping off the leading space 90 $line =~ s/^\s//; 91 $curr_code .= $line; 92 } 93} 94 95# Add some extra content for Prima viewing only 96if ($loaded_prima) { 97 unshift @demo, 'Introduction', 98'This is the demo for L<PDL::Graphics::Prima|PDL::Graphics::Prima/>. Explanatory 99text will appear here; code samples will appear below. Tip: you can modify and 100re-run the code samples. When you are done, simply close the window.', 101'### HEY, EDIT ME! ### 102use Prima::MsgBox; 103Prima::MsgBox::message( "Hello, this is the PDL::Graphics::Prima demo.", mb::Ok);' 104} 105 106################################## 107# The command that runs the demo # 108################################## 109 110# These are widgts I will need across multiple functions, so they are globals. 111my ($section_title_label, $text_pod, $code_eval, $prev_button, $next_button, 112 $run_button, $help_window, $window, $is_evaling); 113sub run { 114 115 # Make sure they have it. Otherwise, bail out. 116 if (not $loaded_prima) { 117 my $reason = 118"I couldn't load the library, either because it's not installed on your 119machine or it's broken."; 120 $reason = 121"your version of PDL::Graphics::Prima (v$PDL::Graphics::Prima::VERSION) is out of date. This demo 122requires at least v$min_version." if defined $loaded_prima; 123 print <<SORRY; 124 125Thanks for trying to learn more about PDL::Graphics::Prima. Unfortunately, 126$reason 127 128If you really want to get this working, the fastest way to get help is to 129join the live chat on the PDL irc channel. If you have an IRC client, check 130out 131 132 irc.perl.org#pdl 133 134If you don't have an IRC client, you can join the discussion via mibbit: 135 136 http://www.mibbit.com/chat/?url=irc://irc.perl.org/pdl 137 138If you would rather, you can send an email to the mailing list: 139 140 http://pdl.perl.org/?page=mailing-lists 141 142For more information about PDL::Graphics::Prima, check out 143 144 http://p3rl.org/PDL::Graphics::Prima. 145 146 147Thanks, and keep trying! I promise it's worth it. 148 149SORRY 150 return; 151 } 152 153 # Note that by the time we reach here, $::application is defined. 154 require Prima::Label; 155 require Prima::PodView; 156 require Prima::Buttons; 157 require Prima::Utils; 158 require Prima::Edit; 159 160 my $current_slide = 0; 161 162 # ---( Build the Demo Window )--- # 163 164 # Window 165 $window = Prima::Window->create( 166 place => { 167 relx => 0.15, relwidth => 0.7, relheight => 0.7, rely => 0.15, 168 anchor => 'sw', 169 }, 170 sizeMax => [600, 800], 171 sizeMin => [600, 800], 172 text => 'PDL::Graphics::Prima Demo', 173 onDestroy => sub { 174 require Prima::Utils; 175 # Throw an exception after destruction is complete so that we 176 # break out of the $::application->go loop. 177 Prima::Utils::post(sub { die 'time to exit the event loop' }); 178 }, 179 onKeyUp => \&keypress_handler, 180 ); 181 $window->font->size(12); 182 # Title 183 # ---( Build list of windows that we don't want to close )--- 184 my @dont_touch = $::application->get_widgets; 185 186 my $title_height = 50; 187 $section_title_label = $window->insert(Label => 188 place => { 189 x => 0, relwidth => 1, anchor => 'sw', 190 y => -$title_height, rely => 1, height => $title_height, 191 }, 192 text => '', 193 height => $title_height, 194 alignment => ta::Center(), 195 valignment => ta::Center(), 196 backColor => cl::White(), 197 font => { 198 size => 24, 199 }, 200 onKeyUp => \&keypress_handler, 201 ); 202 # Buttons 203 my $button_height = 35; 204 $prev_button = $window->insert(Button => 205 place => { 206 x => 0, relwidth => 0.333, anchor => 'sw', 207 y => 0, height => $button_height, 208 }, 209 height => $button_height, 210 text => 'Previous', 211 enabled => 0, 212 onClick => sub { 213 $current_slide-- unless $current_slide == 0; 214 setup_slide($current_slide); 215 }, 216 ); 217 $run_button = $window->insert(Button => 218 place => { 219 relx => 0.333, relwidth => 0.333, anchor => 'sw', 220 y => 0, height => $button_height, 221 }, 222 height => $button_height, 223 text => 'Run', 224 onClick => sub { 225 # Clear out old windows 226 for my $curr_window ($::application->get_widgets) { 227 next if grep { $curr_window == $_ } @dont_touch 228 or defined $help_window and $curr_window == $help_window; 229 $curr_window->destroy; 230 } 231 232 # Disable the buttons 233 my $prev_state = $prev_button->enabled; 234 $prev_button->enabled(0); 235 $run_button->enabled(0); 236 my $next_state = $next_button->enabled; 237 $next_button->enabled(0); 238 239 # Run the eval 240 eval 'no strict; no warnings; ' . $code_eval->text; 241 if ($@ and $@ !~ /time to exit the event loop/ ) { 242 warn $@; 243 Prima::MsgBox::message($@); 244 } 245 246 $prev_button->enabled($prev_state); 247 $run_button->enabled(1); 248 $next_button->enabled($next_state); 249 }, 250 ); 251 $next_button = $window->insert(Button => 252 place => { 253 relx => 0.666, relwidth => 0.333, anchor => 'sw', 254 y => 0, height => $button_height, 255 }, 256 height => $button_height, 257 text => 'Next', 258 onClick => sub { 259 $current_slide++ unless $current_slide == @demo/3; 260 setup_slide($current_slide); 261 }, 262 ); 263 # Text 264 my $par_container = $window->insert(Widget => 265 place => { 266 x => 0, relwidth => 1, anchor => 'sw', 267 rely => 0.6, relheight => 0.4, height => -$title_height-1, 268 }, 269 backColor => cl::White(), 270 ); 271 my $padding = 10; 272 $text_pod = $par_container->insert(PodView => 273 place => { 274 x => $padding, relwidth => 1, width => -2*$padding, 275 y => $padding, relheight => 1, height => -2*$padding - 15, 276 anchor => 'sw', 277 }, 278 # This Event does not appear to be documented!!! Beware!!! 279 # Modify link clicking so that it opens the help window instead 280 # of following the link. 281 onLink => sub { 282 my ($self, $link) = @_; 283 # $link is a reference to the link that should be opened; deref 284 $::application->open_help($$link); 285 # Store the help window so we can close it on exit later 286 $help_window = $::application->get_active_window; 287 # Bring the help window to the fore 288 $::application->get_active_window->bring_to_front 289 if $::application->get_active_window; 290 # Clear the event so that it doesn't follow the link in this 291 # renderer 292 $self->clear_event; 293 }, 294 backColor => cl::White(), 295 borderWidth => 0, 296 autoVScroll => 1, 297 onKeyUp => \&keypress_handler, 298 ); 299 300 # Code 301 my $code_container = $window->insert(Widget => 302 place => { 303 x => 0, relwidth => 1, anchor => 'sw', 304 y => $button_height+1, relheight => 0.6, height => -$button_height-2, 305 }, 306 backColor => cl::White(), 307 ); 308 $code_eval = $code_container->insert(Edit => 309 place => { 310 x => $padding, relwidth => 1, width => -2*$padding, 311 y => $padding, relheight => 1, height => -2*$padding, 312 anchor => 'sw', 313 }, 314 borderWidth => 0, 315 backColor => cl::White(), 316 tabIndent => 4, 317 syntaxHilite => 1, 318 wantTabs => 1, 319 wantReturns => 1, 320 wordWrap => 0, 321 autoIndent => 1, 322 cursorWrap => 1, 323 font => { name => 'monospace', size => 12 }, 324 ); 325 326 $window->bring_to_front; 327 setup_slide(0); 328 329 # Run this sucker 330 local $@; 331 eval { $::application->go }; 332 $help_window->close if defined $help_window and $help_window->alive; 333} 334 335sub keypress_handler { 336 my ($self, $code, $key, $mod) = @_; 337 if ($key == kb::Down() or $key == kb::Right() or $key == kb::PgDn()) { 338 $next_button->notify('Click'); 339 } 340 elsif ($key == kb::Up() or $key == kb::Left() or $key == kg::PgUp()) { 341 $prev_button->notify('Click'); 342 } 343 else { 344 $code_eval->notify('KeyUp', $code, $key, $mod); 345 } 346} 347 348 349############################################################# 350# Function that transitions between paragraphs and sections # 351############################################################# 352 353sub setup_slide { 354 my $number = shift; 355 if ($number == 0) { 356 $prev_button->enabled(0); 357 } 358 else { 359 $prev_button->enabled(1); 360 } 361 if ($number == @demo/3 - 1) { 362 $next_button->enabled(1); 363 $next_button->text('Finish'); 364 } 365 elsif ($number == @demo/3) { 366 # Close the window 367 $window->notify('Destroy'); 368 return; 369 } 370 else { 371 $next_button->enabled(1); 372 $next_button->text('Next'); 373 } 374 375 $number *= 3; 376 # Set the section title and code 377 $section_title_label->text($demo[$number]); 378 $code_eval->text($demo[$number+2]); 379 380 # Load the pod 381 $text_pod->open_read; 382 $text_pod->read("=pod\n\n$demo[$number+1]\n\n=cut"); 383 $text_pod->close_read; 384 385 # Run the demo 386 $run_button->notify('Click'); 387} 388 389# This way, it can be invoked as "perl -MPDL::Demos::Prima" or as 390# "perl path/to/Prima.pm" 391if ($0 eq '-' or $0 eq __FILE__) { 392 run; 393 exit; 394} 395 3961; 397 398__DATA__ 399 400=head2 use PDL::Graphics::Prima::Simple 401 402To get started, you will want to use 403L<PDL::Graphics::Prima::Simple|PDL::Graphics::Prima::Simple/>. This 404module provides a set of friendly wrappers for simple, first-cut data 405visualization. L<PDL::Graphics::Prima|PDL::Graphics::Prima/>, the underlying 406library, is a general-purpose 2D plotting library built as a widget in the 407L<Prima GUI toolkit|Prima/>, but we don't need the full functionality for 408the purposes of this demo. 409 410 use PDL::Graphics::Prima::Simple; 411 my $x = sequence(100)/10; 412 line_plot($x, $x->sin); 413 414=head2 More than just lines! 415 416In addition to numerous ways to plot x/y data, you can also plot 417distributions and images. The best run-down of the simple plotting routines 418can be found in 419L<the Synopsis for PDL::Graphics::Prima::Simple|PDL::Graphics::Prima::Simple/SYNOPSIS>. 420 421 $distribution = grandom(100); 422 hist_plot($distribution); 423 424 $x = sequence(100)/10; 425 cross_plot($x, $x->sin); 426 427 $image = rvals(100, 100); 428 matrix_plot($image); 429 430=head2 Mouse Interaction 431 432Plots allow for 433L<mouse interaction|PDL::Graphics::Prima::Simple/"Interactive Features">, 434herein referred to as twiddling. You can resize the window, zoom with the 435scroll wheel, or click and drag the canvas around. There is also a 436right-click zoom-rectangle, and a right-click context menu. 437 438 hist_plot(grandom(100)); 439 440 # Run this, then try using your mouse 441 442In your Perl scripts, and in the PDL shell for some operating systems and 443some versions of L<Term::ReadLine>, twiddling will cause your script to pause 444when you create a new plot. To resume your script or return execution to the 445shell, either close the window or press 'q'. 446 447 # If your PDL shell supports simultaneous 448 # input and plot interaction, running this 449 # should display both plots simultaneously: 450 451 $x = sequence(100)/10; 452 cross_plot($x, $x->sin); 453 line_plot($x, $x->cos); 454 455=head2 Multiple plots without blocking 456 457The blocking behavior just discussed is due to what is called autotwiddling. 458To turn this off, simply send a boolean false value to auto_twiddle. Then, 459be sure to invoke twiddling when you're done creating your plots. 460 461 auto_twiddle(0); 462 hist_plot(grandom(100)); 463 matrix_plot(rvals(100, 100)); 464 twiddle(); 465 466Once turned off, autotwiddling will remain off until you turn it back on. 467 468 # autotwiddling still off 469 hist_plot(grandom(100)); 470 matrix_plot(rvals(100, 100)); 471 twiddle(); 472 473=head2 Adding a title and axis labels 474 475Functions like 476L<hist_plot|PDL::Graphics::Prima::Simple/hist_plot>, 477L<cross_plot|PDL::Graphics::Prima::Simple/cross_plot>, and 478L<matrix_plot|PDL::Graphics::Prima::Simple/matrix_plot> actually create and 479return plot objects which you can subsequently modify. For example, 480adding a title and axis labels are pretty easy. For titles, you call the 481L<title method on the plot object|PDL::Graphics::Prima/title>. For axis 482labels, you call the 483L<label method on the axis objects|PDL::Graphics::Prima::Axis/label>. 484 485 # Make sure autotwiddling is off in your script 486 auto_twiddle(0); 487 488 # Build the plot 489 my $x = sequence(100)/10; 490 my $plot = line_plot($x, $x->sin); 491 492 # Add the title and labels 493 $plot->title('Harmonic Oscillator'); 494 $plot->x->label('Time [s]'); 495 $plot->y->label('Displacement [cm]'); 496 497 # Manually twiddle once everything is finished 498 twiddle(); 499 500=head2 Saving to a file 501 502L<PDL::Graphics::Prima::Simple> excels at user interaction, but you can save 503your plots to a file using L<save_to_file|PDL::Graphics::Prima/save_to_file> 504or L<save_to_postscript|PDL::Graphics::Prima/save_to_postscript> methods, or 505by right-clicking and selecting the appropriate menu option. 506 507 auto_twiddle(0); 508 $x = sequence(100)/10; 509 line_plot($x, $x->sin)->save_to_postscript; 510 511 # You can supply a filename to the method if you like. 512 # Also available is save_to_file, which saves to raster 513 # file formats. Expect save_to_postscript to be merged 514 # into save_to_file in the future. 515 516=head2 Adding additional data to the plot 517 518Once you have created a plot, you can 519L<add additional data to it|PDL::Graphics::Prima/dataSets>. You 520achieve this by adding a new 521L<DataSet|PDL::Graphics::Prima::DataSet> with the data you want displayed. 522 523 auto_twiddle(0); 524 my $plot = hist_plot(grandom(100)); 525 526 # Add a Gaussian curve that "fits" the data 527 use PDL::Constants qw(PI); 528 my $fit_xs = zeroes(100)->xlinvals(-2, 2); 529 my $fit_ys = exp(-$fit_xs**2 / 2) / sqrt(2*PI); 530 $plot->dataSets->{fit_curve} = ds::Pair($fit_xs, $fit_ys); 531 532 twiddle(); 533 534The default L<plot type|PDL::Graphics::Prima::PlotType/> for 535L<pairwise data|PDL::Graphics::Prima::DataSet/Pair> is 536L<Diamonds|PDL::Graphics::Prima::PlotType/ppair::Diamonds>. You can choose a 537L<different pairwise plot type|PDL::Graphics::Prima::PlotType/Pairs>, or 538even mix and match L<multiple pairwise plot types|PDL::Graphics::Prima::PlotType/SYNOPSIS>. 539 540 auto_twiddle(0); 541 my $plot = hist_plot(grandom(100)); 542 543 # Add a Gaussian curve that "fits" the data 544 use PDL::Constants qw(PI); 545 my $fit_xs = zeroes(200)->xlinvals(-5, 5); 546 my $fit_ys = exp(-$fit_xs**2 / 2) / sqrt(2*PI); 547 $plot->dataSets->{fit_curve} = ds::Pair($fit_xs, $fit_ys, 548 # Use lines 549 plotTypes => [ 550 ppair::Lines( 551 # with a thickness of three pixels 552 lineWidth => 3, 553 # And the color red 554 color => cl::LightRed, 555 ), 556 ppair::Diamonds, 557 ], 558 ); 559 560 twiddle(); 561 562=head2 The plot command 563 564If you want to specify everything in one command, you can use the plot 565function. This lets you put everything together that we've already discussed, 566including multiple DataSets in a single command, title specification, and 567x and y axis options. 568 569 # Generate some data: 570 my $xs = sequence(100)/10 + 0.1; 571 my $ys = $xs->sin + $xs->grandom / 10; 572 my $y_err = $ys->grandom/10; 573 574 # Plot the data and the fit 575 plot( 576 -data => ds::Pair($xs, $ys, 577 plotTypes => [ 578 ppair::Triangles(filled => 1), 579 ppair::ErrorBars(y_err => $y_err), 580 ], 581 ), 582 -fit => ds::Func(\&PDL::sin, 583 lineWidth => 3, 584 color => cl::LightRed, 585 ), 586 -note => ds::Note( 587 pnote::Text('Incoming Signal', 588 x => 0.2, 589 y => sin(0.2) . '-3em', 590 ), 591 ), 592 title => 'Noisey Sine Wave', 593 x => { 594 label => 'Time [s]', 595 scaling => sc::Log, 596 }, 597 y => { label => 'Measurement [Amp]' }, 598 ); 599 600=head2 Enjoy PDL::Graphics::Prima! 601 602I hope you've enjoyed the tour, and I hope you find 603L<PDL::Graphics::Prima|PDL::Graphics::Prima/> to be a useful plotting tool! 604 605 # Thanks! 606 607=head1 AUTHOR 608 609David Mertens C<dcmertens.perl@gmail.com> 610 611=head1 LICENSE AND COPYRIGHT 612 613Copyright (c) 2013, David Mertens. All righs reserved. 614 615This module is free software; you can redistribute it and/or modify it under the 616same terms as Perl itself. See L<perlartistic>. 617 618=cut 619