/usr/local/CPAN/PDL/PDL/Demos/TriD1.pm

• package PDL::Demos::TriD1
  • run
• EOF

# Copyright (C) 1998 Tuomas J. Lukka.
# All rights reserved, except redistribution
# with PDL under the PDL License permitted.

package PDL::Demos::TriD1;

use PDL;
use PDL::Graphics::TriD;
use PDL::Graphics::TriD::Image;

PDL::Demos::Routines->import();
sub comment($);
sub act($);
sub actnw($);
sub output;

sub run {


comment q|
		Welcome to a short tour of the capabilities of
		PDL::Graphics::TriD.

		Press 'q' in the graphics window for the next screen.
		Rotate the image by pressing mouse button one and
		dragging in the graphics window.
		Zoom in/out by pressing MB3 and drag up/down.
		Note that a standalone TriD script must start with

				use PDL;
				use PDL::Graphics::TriD;
				use PDL::Graphics::TriD::Image;

		to work properly.
|;

actnw q|
		# Number of subdivisions for lines / surfaces.
		$size = 25;

		$cz = (xvals zeroes $size+1) / $size;  # interval 0..1
		$cx = sin($cz*12.6);	# Corkscrew
		$cy = cos($cz*12.6);
		line3d [$cx,$cy,$cz];	# Draw a line
		# [press 'q' in the graphics window when done]
|;

actnw q|
		$r = sin($cz*6.3)/2 + 0.5;
		$g = cos($cz*6.3)/2 + 0.5;
		$b = $cz;
		line3d [$cx,$cy,$cz], [$r,$g,$b];    # Draw a colored line
		# [press 'q' in the graphics window when done]
|;

actnw q|
		$x = (xvals zeroes $size+1,$size+1) / $size;
		$y = (yvals zeroes $size+1,$size+1) / $size;
		$z = 0.5 + 0.5 * (sin($x*6.3) * sin($y*6.3)) ** 3;   # Bumps
		line3d [$x,$y,$z];	# Draw several lines
		# [press 'q' in the graphics window when done]
|;

actnw q|
		$r = $x;
		$g = $y;
		$b = $z;
		line3d [$x,$y,$z], [$r,$g,$b];	# Draw several colored lines
		# [press 'q' in the graphics window when done]
|;

actnw q|
		lattice3d [$x,$y,$z], [$r,$g,$b];  # Draw a colored lattice
		# [press 'q' in the graphics window when done]
|;

actnw q|
		points3d [$x,$y,$z], [$r,$g,$b], {PointSize=>4};  # Draw colored points
		# [press 'q' in the graphics window when done]
|;

actnw q|
		imag3d_ns [$x,$y,$z], [$r,$g,$b];  # Draw a colored surface
		# [press 'q' in the graphics window when done]
|;

actnw q|
		imag3d [$x,$y,$z]; # Draw a shaded surface
		# [press 'q' in the graphics window when done]
|;

actnw q|
		hold3d();	# Leave the previous object in..
		imag3d_ns [$x,$y,$z+1], [$r,$g,$b];
						# ...and draw a colored surface on top of it...
		# [press 'q' in the graphics window when done]
|;

actnw q|
		lattice3d [$x,$y,$z-1], [$r,$g,$b];
						# ...and draw a colored lattice under it...
		# [press 'q' in the graphics window when done]
|;

actnw q|
		nokeeptwiddling3d(); # Don't wait for user while drawing
		for(-2,-1,0,1,2) {
				line3d [$cx,$cy,$cz+$_]; # ... and corkscrews...
		}
		keeptwiddling3d();   # Do wait for user while drawing...
		twiddle3d();	     # and actually, wait right now.
		release3d();
		# [press 'q' in the graphics window when done]
|;

actnw q|
		# The reason for the [] around $x,$y,$z:
		# 1. You can give all the coordinates and colors in one piddle.
		$c = (zeroes 3,$size+1) / $size;
		$coords =
				sin((3+3*xvals $c)*yvals $c);
		$colors = $coords;
		line3d $coords, $colors;        # Draw a curved line, colored
										# (this works also for lattices, etc.)
		# [press 'q' in the graphics window when done]
|;

actnw q|
		# 2. You can use defaults inside the brackets:
		lattice3d [$z], [$r];  # Note: no $x, $y, and $r is greyscale
		# [press 'q' in the graphics window when done]
|;

actnw q|
		# 3. You can plot in certain other systems as defaults
		imag3d_ns [POLAR2D, $z], [$r, $g, $b];  # Draw the familiar
												# bumpy surface in polar
												# coordinates
		# [press 'q' in the graphics window when done]
|;

actnw q|
		# One last thing: you can plot a color image like this
		imagrgb([$r,$g,$b]);
		# [press 'q' in the graphics window when done]
|;

comment q|
		'3d2' contains some of the more special constructions available
		in the PDL::Graphics::TriD modules.
|;

}

1;