"Fossies" - the Fresh Open Source Software Archive

Member "PDL-2.080/Graphics/TriD/TriD.pm" (3 May 2022, 29524 Bytes) of package /linux/misc/PDL-2.080.tar.gz:


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;