As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option.
Alternatively you can here view or download the uninterpreted source code file.
For more information about "TriD.pm" see the Fossies "Dox" file reference documentation and the latest Fossies "Diffs" side-by-side code changes report: 2.079_vs_2.080.

1 =head1 NAME 2 3 PDL::Graphics::TriD - PDL 3D interface 4 5 =head1 SYNOPSIS 6 7 use PDL::Graphics::TriD; 8 9 # Generate a somewhat interesting sequence of points: 10 $t = sequence(100)/10; 11 $x = sin($t); $y = cos($t), $z = $t; 12 $coords = cat($x, $y, $z)->transpose; 13 my $red = cos(2*$t); my $green = sin($t); my $blue = $t; 14 $colors = cat($red, $green, $blue)->transpose; 15 16 # After each graph, let the user rotate and 17 # wait for them to press 'q', then make new graph 18 line3d($coords); # $coords = (3,n,...) 19 line3d($coords,$colors); # $colors = (3,n,...) 20 line3d([$x,$y,$z]); 21 22 # Generate a somewhat interesting sequence of surfaces 23 $surf1 = (rvals(100, 100) / 50)**2 + sin(xvals(100, 100) / 10); 24 $surf2 = sqrt(rvals(zeroes(50,50))/2); 25 $x = sin($surface); $y = cos($surface), $z = $surface; 26 $coords = cat($x, $y, $z)->transpose; 27 $red = cos(2*$surface); $green = sin($surface); $blue = $surface; 28 $colors = cat($red, $green, $blue)->transpose; 29 imagrgb([$red,$green,$blue]); # 2-d ndarrays 30 lattice3d([$surf1]); 31 points3d([$x,$y,$z]); 32 spheres3d([$x,$y,$z]); # preliminary implementation 33 34 hold3d(); # the following graphs are on top of each other and the previous 35 line3d([$x,$y,$z]); 36 line3d([$x,$y,$z+1]); 37 $pic = grabpic3d(); # Returns the picture in a (3,$x,$y) float ndarray (0..1). 38 39 release3d(); # the next graph will again wipe out things. 40 41 =head1 WARNING 42 43 These modules are still in a somewhat unfocused state: don't use them yet 44 if you don't know how to make them work if they happen to do something 45 strange. 46 47 =head1 DESCRIPTION 48 49 This module implements a generic 3D plotting interface for PDL. 50 Points, lines and surfaces (among other objects) are supported. 51 52 With OpenGL, it is easy to manipulate the resulting 3D objects 53 with the mouse in real time - this helps data visualization a lot. 54 55 =for comment 56 With VRML, you can generate objects for everyone to see with e.g. 57 Silicon Graphics' Cosmo Player. You can find out more about VRML 58 at C<http://vrml.sgi.com/> or C<http://www.vrml.org/> 59 60 =head1 SELECTING A DEVICE 61 62 The default device for TriD is currently OpenGL. 63 You can specify a different device either in your program 64 or in the environment variable C<PDL_3D_DEVICE>. 65 The one specified in the program takes priority. 66 67 The currently available devices are 68 69 =over 8 70 71 =item GL 72 73 OpenGL 74 75 =item GLpic 76 77 OpenGL but off-line (pixmap) rendering and writing to 78 a graphics file. 79 80 =item VRML (I< Not available this release >) 81 82 VRML objects rendering. This writes a VRML file describing the 83 scene. This VRML file can then be read with a browser. 84 85 =back 86 87 =head1 ONLINE AND OFFLINE VISUALIZATION 88 89 TriD offers both on- and off-line visualization. 90 Currently the interface w.r.t. this division is still much 91 in motion. 92 93 For OpenGL you can select either on- or off-line rendering. 94 VRML is currently always offline (this may change later, 95 if someone bothers to write the java(script) code to contact 96 PDL and wait for the next PDL image over the network. 97 98 =head1 COORDINATE SPECIFICATIONS 99 100 Specifying a set of coordinates is generally a context-dependent operation. 101 For a traditional 3D surface plot, you'll want two of the coordinates 102 to have just the xvals and yvals of the ndarray, respectively. 103 For a line, you would generally want to have one coordinate held 104 at zero and the other advancing. 105 106 This module tries to make a reasonable way of specifying the context 107 while letting you do whatever you want by overriding the default 108 interpretation. 109 110 The alternative syntaxes for specifying a set of coordinates (or colors) are 111 112 $ndarray # MUST have 3 as first dim. 113 [$ndarray] 114 [$ndarray1,$ndarray2] 115 [$ndarray1,$ndarray2,$ndarray3] 116 [CONTEXT,$ndarray] 117 [CONTEXT,$ndarray1,$ndarray2] 118 [CONTEXT,$ndarray1,$ndarray2,$ndarray3] 119 120 where C<CONTEXT> is a string describing in which context you wish these 121 ndarrays to be interpreted. Each routine specifies a default context 122 which is explained in the routines documentation. 123 Context is usually used only to understand what the user wants 124 when they specify less than 3 ndarrays. 125 126 The following contexts are currently supported: 127 128 =over 8 129 130 =item SURF2D 131 132 A 2-D lattice. C< [$ndarray] > is interpreted as the Z coordinate over 133 a lattice over the first dimension. Equivalent to 134 C<< [$ndarray->xvals, $ndarray->yvals, $ndarray] >>. 135 136 =item POLAR2D 137 138 A 2-D polar coordinate system. C< [$ndarray] > is interpreted as the 139 z coordinate over theta and r (theta = the first dimension of the ndarray). 140 141 =item COLOR 142 143 A set of colors. C< [$ndarray] > is interpreted as grayscale color 144 (equivalent to C< [$ndarray,$ndarray,$ndarray] >). 145 146 =item LINE 147 148 A line made of 1 or 2 coordinates. C< [$ndarray] > is interpreted as 149 C<< [$ndarray->xvals,$ndarray,0] >>. C< [$ndarray1,$ndarray2] > is interpreted as 150 C<< [$ndarray1,$ndarray2,$ndarray1->xvals] >>. 151 152 =back 153 154 What makes contexts useful is that if you want to plot points 155 instead of the full surface you plotted with 156 157 imag3d([$zcoords]); 158 159 you don't need to start thinking about where to plot the points: 160 161 points3d([SURF2D,$zcoords]); 162 163 will do exactly the same. 164 165 =head2 Wrapping your head around 3d surface specifications 166 167 Let's begin by thinking about how you might make a 2d data plot. 168 If you sampled your data at regular intervals, you would have 169 a time serires y(t) = (y0, y1, y2, ...). You could plot y vs t 170 by computing t0 = 0, t1 = dt, t2 = 2 * dt, and then plotting 171 (t0, y0), (t1, y1), etc. 172 173 Next suppose that you measured x(t) and y(t). You can still 174 plot y vs t, but you can also plot y vs x by plotting (x0, y0), 175 (x1, y1), etc. The x-values don't have to increase monotonically: 176 they could back-track on each other, for example, like the 177 latitude and longitude of a boat on a lake. If you use plplot, 178 you would plot this data using 179 C<< $pl->xyplot($x, $y, PLOTTYPE => 'POINTS') >>. 180 181 Good. Now let's add a third coordinate, z(t). If you actually 182 sampled x and y at regular intervals, so that x and y lie on a 183 grid, then you can construct a grid for z(x, y), and you would 184 get a surface. This is the situation in which you would use 185 C<mesh3d([$surface])>. 186 187 Of course, your data is not required to be regularly gridded. 188 You could, for example, be measuring the flight path of a bat 189 flying after mosquitos, which could be wheeling and arching 190 all over the space. This is what you might plot using 191 C<line3d([$x, $y, $z])>. You could plot the trajectories of 192 multiple bats, in which case C<$x>, C<$y>, and C<$z> would have 193 multiple columns, but in general you wouldn't expect them to be 194 coordinated. 195 196 More generally, each coordinate is expected to be arranged in a 3D 197 fashion, similar to C<3,x,y>. The "3" is the actual 3D coordinates of 198 each point. The "x,y" help with gridding, because each point at C<x,y> 199 is expected to have as geographical neighbours C<x+1,y>, C<x-1,y>, 200 C<x,y+1>, C<x,y-1>, and the grid polygon-building relies on that. 201 This is how, and why, the 3D earth in C<demo 3d> arranges its data. 202 203 #!/usr/bin/perl 204 205 use PDL; 206 use PDL::Graphics::TriD; 207 208 # Draw out a trajectory in three-space 209 $t = sequence(100)/10; 210 $x = sin($t); $y = cos($t); $z = $t; 211 212 # Plot the trajectory as (x(t), y(t), z(t)) 213 print "using line3d to plot a trajectory (press q when you're done twiddling)\n"; 214 line3d [$x,$y,$z]; 215 216 # If you give it a single ndarray, it expects 217 # the data to look like 218 # ((x1, y1, z1), (x2, y2, z2), ...) 219 # which is why we have to do the exchange: 220 $coords = cat($x, $y, $z)->transpose; 221 print "again, with a different coordinate syntax (press q when you're done twiddling)\n"; 222 line3d $coords; 223 224 # Draw a regularly-gridded surface: 225 $surface = sqrt(rvals(zeroes(50,50))/2); 226 print "draw a mesh of a regularly-gridded surface using mesh3d\n"; 227 mesh3d [$surface]; 228 print "draw a regularly-gridded surface using imag3d\n"; 229 imag3d [$surface], {Lines=>0}; 230 231 # Draw a mobius strip: 232 $two_pi = 8 * atan2(1,1); 233 $t = sequence(51) / 50 * $two_pi; 234 # We want three paths: 235 $mobius1_x = cos($t) + 0.5 * sin($t/2); 236 $mobius2_x = cos($t); 237 $mobius3_x = cos($t) - 0.5 * sin($t/2); 238 $mobius1_y = sin($t) + 0.5 * sin($t/2); 239 $mobius2_y = sin($t); 240 $mobius3_y = sin($t) - 0.5 * sin($t/2); 241 $mobius1_z = $t - $two_pi/2; 242 $mobius2_z = zeroes($t); 243 $mobius3_z = $two_pi/2 - $t; 244 245 $mobius_x = cat($mobius1_x, $mobius2_x, $mobius3_x); 246 $mobius_y = cat($mobius1_y, $mobius2_y, $mobius3_y); 247 $mobius_z = cat($mobius1_z, $mobius2_z, $mobius3_z); 248 249 $mobius_surface = cat($mobius_x, $mobius_y, $mobius_z)->mv(2,0); 250 251 print "A mobius strip using line3d one way\n"; 252 line3d $mobius_surface; 253 print "A mobius strip using line3d the other way\n"; 254 line3d $mobius_surface->xchg(1,2); 255 print "A mobius strip using mesh3d\n"; 256 mesh3d $mobius_surface; 257 print "The same mobius strip using imag3d\n"; 258 imag3d $mobius_surface, {Lines => 0}; 259 260 =head1 SIMPLE ROUTINES 261 262 Because using the whole object-oriented interface for doing 263 all your work might be cumbersome, the following shortcut 264 routines are supported: 265 266 =head1 FUNCTIONS 267 268 =head2 line3d 269 270 =for ref 271 272 3D line plot, defined by a variety of contexts. 273 274 Implemented by C<PDL::Graphics::TriD::LineStrip>. 275 276 =for usage 277 278 line3d ndarray(3,x), {OPTIONS} 279 line3d [CONTEXT], {OPTIONS} 280 281 =for example 282 283 Example: 284 285 pdl> line3d [sqrt(rvals(zeroes(50,50))/2)] 286 - Lines on surface 287 pdl> line3d [$x,$y,$z] 288 - Lines over X, Y, Z 289 pdl> line3d $coords 290 - Lines over the 3D coordinates in $coords. 291 292 Note: line plots differ from mesh plots in that lines 293 only go in one direction. If this is unclear try both! 294 295 See module documentation for more information on 296 contexts and options 297 298 =head2 imag3d 299 300 =for ref 301 302 3D rendered image plot, defined by a variety of contexts 303 304 Implemented by C<PDL::Graphics::TriD::SLattice_S>. 305 306 The variant, C<imag3d_ns>, is implemented by C<PDL::Graphics::TriD::SLattice>. 307 308 =for usage 309 310 imag3d ndarray(3,x,y), {OPTIONS} 311 imag3d [ndarray,...], {OPTIONS} 312 313 =for example 314 315 Example: 316 317 pdl> imag3d [sqrt(rvals(zeroes(50,50))/2)], {Lines=>0}; 318 319 - Rendered image of surface 320 321 See module documentation for more information on 322 contexts and options 323 324 =head2 mesh3d 325 326 =for ref 327 328 3D mesh plot, defined by a variety of contexts 329 330 Implemented by C<PDL::Graphics::TriD::Lattice>. 331 332 =for usage 333 334 mesh3d ndarray(3,x,y), {OPTIONS} 335 mesh3d [ndarray,...], {OPTIONS} 336 337 =for example 338 339 Example: 340 341 pdl> mesh3d [sqrt(rvals(zeroes(50,50))/2)] 342 343 - mesh of surface 344 345 Note: a mesh is defined by two sets of lines at 346 right-angles (i.e. this is how is differs from 347 line3d). 348 349 See module documentation for more information on 350 contexts and options 351 352 =head2 lattice3d 353 354 =for ref 355 356 alias for mesh3d 357 358 =head2 trigrid3d 359 360 Show a triangular mesh, giving C<$vertices> and C<$faceidx> which is 361 a series of triplets of indices into the vertices, each describing 362 one triangle. The order of points matters for the shading - the normal 363 vector points towards the clockface if the points go clockwise. 364 365 Options: C<Smooth> (on by default), C<Lines> (off by default), 366 C<ShowNormals> (off by default, useful for debugging). 367 368 Implemented by C<PDL::Graphics::TriD::STrigrid_S>. 369 370 =head2 trigrid3d_ns 371 372 Like L</trigrid3d>, but without shading or normals. 373 374 Implemented by C<PDL::Graphics::TriD::STrigrid>. 375 376 =head2 points3d 377 378 =for ref 379 380 3D points plot, defined by a variety of contexts 381 382 Implemented by C<PDL::Graphics::TriD::Points>. 383 384 =for usage 385 386 points3d ndarray(3), {OPTIONS} 387 points3d [ndarray,...], {OPTIONS} 388 389 =for example 390 391 Example: 392 393 pdl> points3d [sqrt(rvals(zeroes(50,50))/2)]; 394 - points on surface 395 396 See module documentation for more information on 397 contexts and options 398 399 =head2 spheres3d 400 401 =for ref 402 403 3D spheres plot (preliminary implementation) 404 405 This is a preliminary implementation as a proof of 406 concept. It has fixed radii for the spheres being 407 drawn and no control of color or transparency. 408 409 Implemented by C<PDL::Graphics::TriD::Spheres>. 410 411 =for usage 412 413 spheres3d ndarray(3), {OPTIONS} 414 spheres3d [ndarray,...], {OPTIONS} 415 416 =for example 417 418 Example: 419 420 pdl> spheres3d ndcoords(10,10,10)->clump(1,2,3) 421 422 - lattice of spheres at coordinates on 10x10x10 grid 423 424 =head2 imagrgb 425 426 =for ref 427 428 2D RGB image plot (see also imag2d) 429 430 Implemented by C<PDL::Graphics::TriD::Image>. 431 432 =for usage 433 434 imagrgb ndarray(3,x,y), {OPTIONS} 435 imagrgb [ndarray,...], {OPTIONS} 436 437 This would be used to plot an image, specifying 438 red, green and blue values at each point. Note: 439 contexts are very useful here as there are many 440 ways one might want to do this. 441 442 =for example 443 444 e.g. 445 446 pdl> $x=sqrt(rvals(zeroes(50,50))/2) 447 pdl> imagrgb [0.5*sin(8*$x)+0.5,0.5*cos(8*$x)+0.5,0.5*cos(4*$x)+0.5] 448 449 =head2 imagrgb3d 450 451 =for ref 452 453 2D RGB image plot as an object inside a 3D space 454 455 Implemented by C<PDL::Graphics::TriD::Image>. 456 457 =for usage 458 459 imagrdb3d ndarray(3,x,y), {OPTIONS} 460 imagrdb3d [ndarray,...], {OPTIONS} 461 462 The ndarray gives the colors. The option allowed is Points, 463 which should give 4 3D coordinates for the corners of the polygon, 464 either as an ndarray or as array ref. 465 The default is [[0,0,0],[1,0,0],[1,1,0],[0,1,0]]. 466 467 =for example 468 469 e.g. 470 471 pdl> imagrgb3d $colors, {Points => [[0,0,0],[1,0,0],[1,0,1],[0,0,1]]}; 472 - plot on XZ plane instead of XY. 473 474 =head2 grabpic3d 475 476 =for ref 477 478 Grab a 3D image from the screen. 479 480 =for usage 481 482 $pic = grabpic3d(); 483 484 The returned ndarray has dimensions (3,$x,$y) and is of type float 485 (currently). XXX This should be altered later. 486 487 =head2 hold3d, release3d 488 489 =for ref 490 491 Keep / don't keep the previous objects when plotting new 3D objects 492 493 =for usage 494 495 hold3d(); 496 release3d(); 497 498 or 499 500 hold3d(1); 501 hold3d(0); 502 503 =head2 keeptwiddling3d, nokeeptwiddling3d 504 505 =for ref 506 507 Wait / don't wait for 'q' after displaying a 3D image. 508 509 Usually, when showing 3D images, the user is given a chance 510 to rotate it and then press 'q' for the next image. However, 511 sometimes (for e.g. animation) this is undesirable and it is 512 more desirable to just run one step of the event loop at 513 a time. 514 515 =for usage 516 517 keeptwiddling3d(); 518 nokeeptwiddling3d(); 519 520 or 521 522 keeptwiddling3d(1); 523 keeptwiddling3d(0); 524 525 When an image is added to the screen, keep twiddling it until 526 user explicitly presses 'q'. 527 528 =for example 529 530 keeptwiddling3d(); 531 imag3d(..); 532 nokeeptwiddling3d(); 533 $o = imag3d($c); 534 do { 535 $c .= nextfunc($c); 536 $o->data_changed; 537 } while(!twiddle3d()); # animate one step, then iterate 538 keeptwiddling3d(); 539 twiddle3d(); # wait one last time 540 541 =head2 twiddle3d 542 543 =for ref 544 545 Wait for the user to rotate the image in 3D space. 546 547 Let the user rotate the image in 3D space, either for one step 548 or until they press 'q', depending on the 'keeptwiddling3d' 549 setting. If 'keeptwiddling3d' is not set the routine returns 550 immediately and indicates that a 'q' event was received by 551 returning 1. If the only events received were mouse events, 552 returns 0. 553 554 =head2 close3d 555 556 =for ref 557 558 Close the currently-open 3D window. 559 560 =head1 NOT EXPORTED 561 562 These functions are not exported, partly because they are not fully 563 implemented. 564 565 =over 566 567 =item contour3d 568 569 Implemented by C<PDL::Graphics::TriD::Contours>. 570 571 =back 572 573 =head1 CONCEPTS 574 575 The key concepts (object types) of TriD are explained in the following: 576 577 =head2 Object 578 579 In this 3D abstraction, everything that you can "draw" 580 without using indices is an Object. That is, if you have a surface, 581 each vertex is not an object and neither is each segment of a long 582 curve. The whole curve (or a set of curves) is the lowest level Object. 583 584 Transformations and groups of Objects are also Objects. 585 586 A Window is simply an Object that has subobjects. 587 588 =head2 Twiddling 589 590 Because there is no eventloop in Perl yet and because it would 591 be hassleful to do otherwise, it is currently not possible to 592 e.g. rotate objects with your mouse when the console is expecting 593 input or the program is doing other things. Therefore, you need 594 to explicitly say "$window->twiddle()" in order to display anything. 595 596 =head1 OBJECTS 597 598 The following types of objects are currently supported. 599 Those that do not have a calling sequence described here should 600 have their own manual pages. 601 602 There are objects that are not mentioned here; they are either internal 603 to PDL3D or in rapidly changing states. If you use them, you do so at 604 your own risk. 605 606 The syntax C<PDL::Graphics::TriD::Scale(x,y,z)> here means that you create 607 an object like 608 609 $c = PDL::Graphics::TriD::Scale->new($x,$y,$z); 610 611 =head2 PDL::Graphics::TriD::LineStrip 612 613 This is just a line or a set of lines. The arguments are 3 1-or-more-D 614 ndarrays which describe the vertices of a continuous line and an 615 optional color ndarray (which is 1-D also and simply 616 defines the color between red and blue. This will probably change). 617 618 =head2 PDL::Graphics::TriD::Lines 619 620 This is just a line or a set of lines. The arguments are 3 1-or-more-D 621 ndarrays where each contiguous pair of vertices describe a line segment 622 and an optional color ndarray (which is 1-D also and simply 623 defines the color between red and blue. This will probably change). 624 625 =head2 PDL::Graphics::TriD::Image 626 627 This is a 2-dimensional RGB image consisting of colored 628 rectangles. With OpenGL, this is implemented by texturing so this should 629 be relatively memory and execution-time-friendly. 630 631 =head2 PDL::Graphics::TriD::Lattice 632 633 This is a 2-D set of points connected by lines in 3-space. 634 The constructor takes as arguments 3 2-dimensional ndarrays. 635 636 =head2 PDL::Graphics::TriD::Points 637 638 This is simply a set of points in 3-space. Takes as arguments 639 the x, y and z coordinates of the points as ndarrays. 640 641 =head2 PDL::Graphics::TriD::Scale(x,y,z) 642 643 Self-explanatory 644 645 =head2 PDL::Graphics::TriD::Translation(x,y,z) 646 647 Ditto 648 649 =head2 PDL::Graphics::TriD::Quaternion(c,x,y,z) 650 651 One way of representing rotations is with quaternions. See the appropriate 652 man page. 653 654 =head2 PDL::Graphics::TriD::ViewPort 655 656 This is a special class: in order to obtain a new viewport, you 657 need to have an earlier viewport on hand. The usage is: 658 659 $new_vp = $old_vp->new_viewport($x0,$y0,$x1,$y1); 660 661 where $x0 etc are the coordinates of the upper left and lower right 662 corners of the new viewport inside the previous (relative 663 to the previous viewport in the (0,1) range. 664 665 Every implementation-level window object should implement the new_viewport 666 method. 667 668 =cut 669 670 #KGB: NEEDS DOCS ON COMMON OPTIONS!!!!! 671 672 # List of global variables 673 # 674 # $PDL::Graphics::TriD::offline 675 # $PDL::Graphics::TriD::Settings 676 $PDL::Graphics::TriD::verbose //= 0; 677 # $PDL::Graphics::TriD::keeptwiddling 678 # $PDL::Graphics::TriD::only_one 679 # $PDL::Graphics::TriD::create_window_sub 680 # $PDL::Graphics::TriD::current_window 681 # 682 # ' 683 684 package PDL::Graphics::TriD; 685 686 use strict; 687 use warnings; 688 use PDL::Exporter; 689 use PDL::Core ''; # barf 690 our @ISA = qw/PDL::Exporter/; 691 our @EXPORT_OK = qw/imag3d_ns imag3d line3d mesh3d lattice3d points3d 692 trigrid3d trigrid3d_ns 693 spheres3d describe3d imagrgb imagrgb3d hold3d release3d 694 keeptwiddling3d nokeeptwiddling3d close3d 695 twiddle3d grabpic3d tridsettings/; 696 our %EXPORT_TAGS = (Func=>\@EXPORT_OK); 697 our $verbose; 698 699 use PDL::Graphics::TriD::Object; 700 use PDL::Graphics::TriD::Window; 701 use PDL::Graphics::TriD::ViewPort; 702 use PDL::Graphics::TriD::Graph; 703 use PDL::Graphics::TriD::Quaternion; 704 use PDL::Graphics::TriD::Objects; 705 use PDL::Graphics::TriD::Rout; 706 707 # Then, see which display method are we using: 708 709 $PDL::Graphics::TriD::device = $PDL::Graphics::TriD::device; 710 BEGIN { 711 my $dev = $PDL::Graphics::TriD::device; # First, take it from this variable. 712 $dev ||= $::ENV{PDL_3D_DEVICE}; 713 if(!defined $dev) { 714 # warn "Default PDL 3D device is GL (OpenGL): 715 # Set PDL_3D_DEVICE=GL in your environment in order not to see this warning. 716 # You must have OpenGL or Mesa installed and the PDL::Graphics::OpenGL extension 717 # compiled. Otherwise you will get strange warnings."; 718 719 $dev = "GL"; # default GL works on all platforms now 720 } 721 my $dv; 722 # The following is just a sanity check. 723 for($dev) { 724 # (/^OOGL$/ and $dv="PDL::Graphics::TriD::OOGL") or 725 (/^GL$/ and $dv="PDL::Graphics::TriD::GL") or 726 (/^GLpic$/ and $dv="PDL::Graphics::TriD::GL" and $PDL::Graphics::TriD::offline=1) or 727 (/^VRML$/ and $dv="PDL::Graphics::TriD::VRML" and $PDL::Graphics::TriD::offline=1) or 728 (barf "Invalid PDL 3D device '$_' specified!"); 729 } 730 my $mod = $dv; 731 $mod =~ s|::|/|g; 732 print "dev = $dev mod=$mod\n" if($verbose); 733 require "$mod.pm"; 734 $dv->import; 735 my $verbose; 736 } 737 738 # currently only used by VRML backend 739 $PDL::Graphics::TriD::Settings = $PDL::Graphics::TriD::Settings; 740 sub tridsettings {return $PDL::Graphics::TriD::Settings} 741 742 # Allowable forms: 743 # x(3,..) [x(..),y(..),z(..)] 744 sub realcoords { 745 my($type,$c) = @_; 746 if(ref $c ne "ARRAY") { 747 if($c->getdim(0) != 3) { 748 barf "If one ndarray given for coordinate, must be (3,...) or have default interpretation"; 749 } 750 return $c ; 751 } 752 my @c = @$c; 753 if(!ref $c[0]) {$type = shift @c} 754 if(!@c || @c>3) { 755 barf "Must have 1..3 array members for coordinates"; 756 } 757 if(@c == 1 and $type eq "SURF2D") { 758 # surf2d -> this is z axis 759 @c = ($c[0]->xvals,$c[0]->yvals,$c[0]); 760 } elsif(@c == 1 and $type eq "POLAR2D") { 761 my $t = 6.283 * $c[0]->xvals / ($c[0]->getdim(0)-1); 762 my $r = $c[0]->yvals / ($c[0]->getdim(1)-1); 763 @c = ($r * sin($t), $r * cos($t), $c[0]); 764 } elsif(@c == 1 and $type eq "COLOR") { 765 # color -> 1 ndarray = grayscale 766 @c = @c[0,0,0]; 767 } elsif(@c == 1 and $type eq "LINE") { 768 @c = ($c[0]->xvals, $c[0], 0); 769 } elsif(@c == 2 and $type eq "LINE") { 770 @c = (@c[0,1], $c[0]->xvals); 771 } 772 # XXX 773 if(@c != 3) { 774 barf("Must have 3 coordinates if no interpretation (here '$type')"); 775 } 776 # allow a constant (either pdl or not) to be introduced in one dimension 777 foreach(0..2) { 778 if(ref($c[$_]) ne "PDL" or $c[$_]->nelem==1){ 779 $c[$_] = $c[$_]*(PDL->ones($c[($_+1)%3]->dims)); 780 } 781 } 782 my $g = PDL::Graphics::TriD::Rout::combcoords(@c); 783 $g->dump if $PDL::Graphics::TriD::verbose; 784 return $g; 785 } 786 787 sub checkargs { 788 if(ref $_[$#_] eq "HASH" and $PDL::Graphics::TriD::verbose) { 789 790 print "enter checkargs \n"; 791 for(['KeepTwiddling',\&keeptwiddling3d]) { 792 print "checkargs >$_<\n"; 793 if(defined $_[$#_]{$_->[0]}) { 794 &{$_->[1]}(delete $_[$#_]{$_->[0]}); 795 } 796 } 797 } 798 } 799 800 *keeptwiddling3d=*keeptwiddling3d=\&PDL::keeptwiddling3d; 801 sub PDL::keeptwiddling3d { 802 $PDL::Graphics::TriD::keeptwiddling = $_[0] // 1; 803 } 804 *nokeeptwiddling3d=*nokeeptwiddling3d=\&PDL::nokeeptwiddling3d; 805 sub PDL::nokeeptwiddling3d { 806 $PDL::Graphics::TriD::keeptwiddling = 0 ; 807 } 808 keeptwiddling3d(); 809 *twiddle3d = *twiddle3d = *PDL::twiddle3d = \&twiddle_current; 810 811 *close3d = *close3d = \&PDL::close3d; 812 sub PDL::close3d { 813 return if !ref $PDL::Graphics::TriD::current_window; 814 return if !$PDL::Graphics::TriD::current_window->can('close'); 815 $PDL::Graphics::TriD::current_window->close; 816 } 817 818 sub graph_object { 819 my($obj) = @_; 820 if(!defined $obj or !ref $obj) { 821 barf("Invalid object to TriD::graph_object"); 822 } 823 print "graph_object: calling get_new_graph\n" if($PDL::Graphics::TriD::verbose); 824 my $g = get_new_graph(); 825 print "graph_object: back from get_new_graph\n" if($PDL::Graphics::TriD::verbose); 826 my $name = $g->add_dataseries($obj); 827 $g->bind_default($name); 828 $g->scalethings(); 829 print "ADDED TO GRAPH: '$name'\n" if $PDL::Graphics::TriD::verbose; 830 twiddle_current(); 831 return $obj; 832 } 833 834 # Plotting routines that use the whole viewport 835 836 *describe3d=*describe3d=\&PDL::describe3d; 837 sub PDL::describe3d { 838 require PDL::Graphics::TriD::TextObjects; 839 my ($text) = @_; 840 my $win = PDL::Graphics::TriD::get_current_window(); 841 my $imag = PDL::Graphics::TriD::Description->new($text); 842 $win->add_object($imag); 843 # $win->twiddle(); 844 } 845 846 *imagrgb=*imagrgb=\&PDL::imagrgb; 847 sub PDL::imagrgb { 848 require PDL::Graphics::TriD::Image; 849 my (@data) = @_; &checkargs; 850 my $win = PDL::Graphics::TriD::get_current_window(); 851 my $imag = PDL::Graphics::TriD::Image->new(@data); 852 $win->clear_viewports(); 853 $win->current_viewport()->add_object($imag); 854 $win->twiddle(); 855 } 856 857 # Plotting routines that use the 3D graph 858 859 # Call: line3d([$x,$y,$z],[$color]); 860 *line3d=*line3d=\&PDL::line3d; 861 sub PDL::line3d { 862 &checkargs; 863 my $obj = PDL::Graphics::TriD::LineStrip->new(@_); 864 print "line3d: object is $obj\n" if($PDL::Graphics::TriD::verbose); 865 graph_object($obj); 866 } 867 868 *contour3d=*contour3d=\&PDL::contour3d; 869 sub PDL::contour3d { 870 # &checkargs; 871 require PDL::Graphics::TriD::Contours; 872 graph_object(PDL::Graphics::TriD::Contours->new(@_)); 873 } 874 875 # XXX Should enable different positioning... 876 *imagrgb3d=*imagrgb3d=\&PDL::imagrgb3d; 877 sub PDL::imagrgb3d { &checkargs; 878 require PDL::Graphics::TriD::Image; 879 graph_object(PDL::Graphics::TriD::Image->new(@_)); 880 } 881 882 *imag3d_ns=*imag3d_ns=\&PDL::imag3d_ns; 883 sub PDL::imag3d_ns { &checkargs; 884 graph_object(PDL::Graphics::TriD::SLattice->new(@_)); 885 } 886 887 *imag3d=*imag3d=\&PDL::imag3d; 888 sub PDL::imag3d { &checkargs; 889 graph_object(PDL::Graphics::TriD::SLattice_S->new(@_)); 890 } 891 892 *trigrid3d=*trigrid3d=\&PDL::trigrid3d; 893 sub PDL::trigrid3d { &checkargs; 894 graph_object(PDL::Graphics::TriD::STrigrid_S->new(@_)); } 895 896 *trigrid3d_ns=*trigrid3d_ns=\&PDL::trigrid3d_ns; 897 sub PDL::trigrid3d_ns { &checkargs; 898 graph_object(PDL::Graphics::TriD::STrigrid->new(@_)); } 899 900 *mesh3d=*mesh3d=\&PDL::mesh3d; 901 *lattice3d=*lattice3d=\&PDL::mesh3d; 902 *PDL::lattice3d=*PDL::lattice3d=\&PDL::mesh3d; 903 sub PDL::mesh3d { &checkargs; 904 graph_object(PDL::Graphics::TriD::Lattice->new(@_)); 905 } 906 907 *points3d=*points3d=\&PDL::points3d; 908 sub PDL::points3d { &checkargs; 909 graph_object(PDL::Graphics::TriD::Points->new(@_)); 910 } 911 912 *spheres3d=*spheres3d=\&PDL::spheres3d; 913 sub PDL::spheres3d { &checkargs; 914 graph_object(PDL::Graphics::TriD::Spheres->new(@_)); 915 } 916 917 *grabpic3d=*grabpic3d=\&PDL::grabpic3d; 918 sub PDL::grabpic3d { 919 my $win = PDL::Graphics::TriD::get_current_window(); 920 barf "backend doesn't support grabbing the rendered scene" 921 unless $win->can('read_picture'); 922 my $pic = $win->read_picture(); 923 return ($pic->float) / 255; 924 } 925 926 $PDL::Graphics::TriD::only_one = 1; 927 sub PDL::hold3d {$PDL::Graphics::TriD::only_one = !($_[0] // 1);} 928 sub PDL::release3d {$PDL::Graphics::TriD::only_one = 1;} 929 930 *hold3d=*hold3d=\&PDL::hold3d; 931 *release3d=*release3d=\&PDL::release3d; 932 933 sub get_new_graph { 934 print "get_new_graph: calling PDL::Graphics::TriD::get_current_window...\n" if($PDL::Graphics::TriD::verbose); 935 my $win = PDL::Graphics::TriD::get_current_window(); 936 print "get_new_graph: calling get_current_graph...\n" if($PDL::Graphics::TriD::verbose); 937 my $g = get_current_graph($win); 938 print "get_new_graph: back get_current_graph returned $g...\n" if($PDL::Graphics::TriD::verbose); 939 if ($PDL::Graphics::TriD::only_one) { 940 $g->clear_data; 941 $win->clear_viewport; 942 } 943 $g->default_axes; 944 $win->add_object($g); 945 return $g; 946 } 947 948 sub get_current_graph { 949 my $win = shift; 950 my $g = $win->current_viewport()->graph(); 951 if(!defined $g) { 952 $g = PDL::Graphics::TriD::Graph->new; 953 $g->default_axes(); 954 $win->current_viewport()->graph($g); 955 } 956 return $g; 957 } 958 959 # $PDL::Graphics::TriD::create_window_sub = undef; 960 sub get_current_window { 961 my $opts = shift @_; 962 my $win = $PDL::Graphics::TriD::current_window; 963 964 if(!defined $win) { 965 if(!$PDL::Graphics::TriD::create_window_sub) { 966 barf("PDL::Graphics::TriD must be used with a display mechanism: for example PDL::Graphics::TriD::GL!\n"); 967 } 968 print "get_current_window - creating window...\n" if($PDL::Graphics::TriD::verbose); 969 $PDL::Graphics::TriD::current_window = $win = PDL::Graphics::TriD::Window->new($opts); 970 971 print "get_current_window - calling set_material...\n" if($PDL::Graphics::TriD::verbose); 972 $win->set_material(PDL::Graphics::TriD::Material->new); 973 } 974 return $PDL::Graphics::TriD::current_window; 975 } 976 977 sub twiddle_current { get_current_window()->twiddle() } 978 979 ################################### 980 # 981 # 982 package PDL::Graphics::TriD::Material; 983 984 sub new { 985 my ($type,%ops) = @_; 986 my $this = bless {}, $type; 987 for (['Shine',40], 988 ['Specular',[1,1,0.3,0]], 989 ['Ambient',[0.3,1,1,0]], 990 ['Diffuse',[1,0.3,1,0]], 991 ['Emissive',[0,0,0]]) { 992 if (!defined $ops{$_->[0]}) { 993 $this->{$_->[0]} = $_->[1]; 994 } else { 995 $this->{$_->[0]} = $ops{$_->[0]}; 996 } 997 } 998 return $this; 999 } 1000 1001 package PDL::Graphics::TriD::BoundingBox; 1002 use base qw/PDL::Graphics::TriD::Object/; 1003 use fields qw/Box/; 1004 1005 sub new { 1006 my($type,$x0,$y0,$z0,$x1,$y1,$z1) = @_; 1007 my $this = $type->SUPER::new(); 1008 $this->{Box} = [$x0,$y0,$z0,$x1,$y1,$z1]; 1009 } 1010 1011 sub normalize {my($this,$x0,$y0,$z0,$x1,$y1,$z1) = @_; 1012 $this = $this->{Box}; 1013 my $trans = PDL::Graphics::TriD::Transformation->new(); 1014 my $sx = ($x1-$x0)/($this->[3]-$this->[0]); 1015 my $sy = ($y1-$y0)/($this->[4]-$this->[1]); 1016 my $sz = ($z1-$z0)/($this->[5]-$this->[2]); 1017 $trans->add_transformation( 1018 PDL::Graphics::TriD::Translation->new( 1019 ($x0-$this->[0]*$sx), 1020 ($y0-$this->[1]*$sy), 1021 ($z0-$this->[2]*$sz) 1022 )); 1023 $trans->add_transformation(PDL::Graphics::TriD::Scale->new($sx,$sy,$sz)); 1024 return $trans; 1025 } 1026 1027 package PDL::Graphics::TriD::OneTransformation; 1028 use fields qw/Args/; 1029 1030 sub new { 1031 my($type,@args) = @_; 1032 my $this = fields::new($type); 1033 $this->{Args} = [@args]; 1034 $this; 1035 } 1036 1037 package PDL::Graphics::TriD::Scale; 1038 use base qw/PDL::Graphics::TriD::OneTransformation/; 1039 1040 package PDL::Graphics::TriD::Translation; 1041 use base qw/PDL::Graphics::TriD::OneTransformation/; 1042 1043 1044 package PDL::Graphics::TriD::Transformation; 1045 use base qw/PDL::Graphics::TriD::Object/; 1046 1047 sub add_transformation { 1048 my($this,$trans) = @_; 1049 push @{$this->{Transforms}},$trans; 1050 } 1051 1052 =head1 AUTHOR 1053 1054 Copyright (C) 1997 Tuomas J. Lukka (lukka@husc.harvard.edu). Documentation 1055 contributions from Karl Glazebrook (kgb@aaoepp.aao.gov.au). 1056 All rights reserved. There is no warranty. You are allowed 1057 to redistribute this software / documentation under certain 1058 conditions. For details, see the file COPYING in the PDL 1059 distribution. If this file is separated from the PDL distribution, 1060 the copyright notice should be included in the file. 1061 1062 =cut 1063 1064 1;