# See the POD documentation at the end of this # document for detailed copyright information. # (c) 2002-2006 Steffen Mueller, all rights reserved. package Math::Project3D::Plot; use 5.006; use strict; use warnings; use Carp; use Math::Project3D; use Imager; use vars qw/$VERSION/; $VERSION = '1.02'; # Constructor class and object method new # # Creates a new Math::Project3D::Plot instance and returns it. # Takes a list of object attributes as arguments. sub new { my $proto = shift; my $class = ref $proto || $proto; my %args = @_; # check for require attributes my $missing = _require_attributes(\%args, 'image', 'projection'); croak "Required attribute $missing missing." if $missing; # We might croak a lot. my $croaker = sub { croak "Attribute '$_[0]' is bad." }; my $self = {}; # valid image and projection? ref $args{image} or $croaker->('image'); $self->{image} = $args{image}; ref $args{projection} eq 'Math::Project3D' or $croaker->('projection'); $self->{proj} = $args{projection}; # defaults $self = { %$self, scale => 10, origin_x => $self->{image}->getwidth() / 2, origin_y => $self->{image}->getheight() / 2, }; my @valid_args = qw( origin_x origin_y scale ); # Take all valid args from the user input and # put them into our object. foreach my $arg (@valid_args) { $self->{$arg} = $args{$arg} if exists $args{$arg}; } bless $self => $class; # get min/max logical x/y coordinates ( $self->{min_x}, $self->{min_y} ) = $self->_g_l(0, 0); ( $self->{max_x}, $self->{max_y} ) = $self->_g_l( $self->{image}->getwidth(), $self->{image}->getheight(), ); return $self; } # Method plot # Takes argument pairs: color => Imager color # and params => array ref of params # projects the point associated with the parameters. # Plots the point. # Returns the graphical coordinates of the point that # was plotted. sub plot { my $self = shift; my %args = @_; ref $args{params} eq 'ARRAY' or croak "Invalid parameters passed to plot()."; my ($coeff1, $coeff2, $distance) = $self->{proj}->project(@{$args{params}}); my ($g_x, $g_y) = $self->_l_g($coeff1, $coeff2); $self->{image}->setpixel(color=>$args{color}, x=>$g_x, y=>$g_y); return $g_x, $g_y; } # Method plot_list # Takes argument pairs: color => Imager color, # params => array ref of array ref of params # and type => 'line' or 'points' # Projects the points associated with the parameters. # Plots the either points or the line connecting them. # Returns 1. sub plot_list { my $self = shift; my %args = @_; ref $args{params} eq 'ARRAY' or croak "Invalid parameters passed to plot_list()."; # Get type, default to points my $type = $args{type}; $type ||= 'points'; # Do some calulation on the points. my $matrix = $self->{proj}->project_list( @{ $args{params} } ); # Cache my ($prev_g_x, $prev_g_y); # For every point... for ( my $row = 1; $row <= @{$args{params}}; $row++ ) { # Get its coordinates my ($g_x, $g_y) = $self->_l_g( $matrix->element($row,1), $matrix->element($row,2) ); # Plot line or points? if ( $type eq 'line' ) { $self->{image}->line( color => $args{color}, x1 => $prev_g_x, y1 => $prev_g_y, x2 => $g_x, y2 => $g_y, ) if defined $prev_g_x; ($prev_g_x, $prev_g_y) = ($g_x, $g_y); } else { $self->{image}->setpixel(color=>$args{color}, x=>$g_x, y=>$g_y); } } return 1; } # Method plot_range # Takes argument pairs: color => Imager color, # params => array ref of array ref of ranges # and type => 'line' or 'points' # Projects the points associated with the parameter ranges. # Plots the either points or the line connecting them. # Returns 1. sub plot_range { my $self = shift; my %args = @_; ref $args{params} eq 'ARRAY' or croak "Invalid parameters passed to plot_range()."; # Get type, default to points my $type = $args{type}; $type ||= 'points'; # Cache my ($prev_g_x, $prev_g_y); # This will hold the callback routine my $callback; # Use different callbacks for different drawing types if ($type eq 'line') { $callback = sub { # Get its coordinates my ($g_x, $g_y) = $self->_l_g( @_[0,1] ); # Draw the line $self->{image}->line( color => $args{color}, x1 => $prev_g_x, y1 => $prev_g_y, x2 => $g_x, y2 => $g_y, ) if defined $prev_g_x; # cache ($prev_g_x, $prev_g_y) = ($g_x, $g_y); }; } elsif ($type eq 'multiline') { $callback = sub { my $newline = $_[3]; # Did we start a new line? # Get its coordinates my ($g_x, $g_y) = $self->_l_g( @_[0,1] ); # Draw the line if not a new line: $self->{image}->line( color => $args{color}, x1 => $prev_g_x, y1 => $prev_g_y, x2 => $g_x, y2 => $g_y, ) if defined $prev_g_x; # cache ($prev_g_x, $prev_g_y) = ($g_x, $g_y); ($prev_g_x, $prev_g_y) = (undef, undef) if $newline; }; } else { $callback = sub { # Get its coordinates my ($g_x, $g_y) = $self->_l_g( @_[0,1] ); # draw the point $self->{image}->setpixel(color=>$args{color}, x=>$g_x, y=>$g_y); }; } # Start the projection $self->{proj}->project_range_callback( $callback, @{ $args{params} }, ); return 1; } # Private method _require_attributes # # Arguments must be a list of attribute names (strings). # Tests for the existance of those attributes. # Returns the missing attribute on failure, undef on success. sub _require_attributes { my $self = shift; exists $self->{$_} or return $_ foreach @_; return undef; } # Private method _l_g (logical to graphical) # Takes an x/y pair of logical coordinates as # argument and returns the corresponding graphical # coordinates. sub _l_g { my $self = shift; my $x = shift; my $y = shift; # A logical unit is a graphical one displaced by the origin # and multiplied with the appropriate scaling factor. $x = $self->{origin_x} + $x * $self->{scale}; $y = $self->{origin_y} - $y * $self->{scale}; return $x, $y; } # Private method _g_l (graphical to logical) # Takes an x/y pair of graphical coordinates as # argument and returns the corresponding # logical coordinates. sub _g_l { my $self = shift; my $x = shift; my $y = shift; # A graphical unit is a logical one displaced by the origin # and divided by the appropriate scaling factor. $x = ( $x - $self->{origin_x} ) / $self->{scale}; $y = ( $y - $self->{origin_y} ) / $self->{scale}; return $x, $y; } # Method plot_axis # # The plot_axis method draws an axis into the image. "Axis" used # as in "a line that goes through the origin". Required arguments: # color => Imager color to use (see Imager::Color manpage) # vector => Array ref containing three vector components. # (only the direction matters as the vector will # be normalized by plot_axis.) # length => Desired axis length. sub plot_axis { my $self = shift; my %args = @_; ref $args{vector} eq 'ARRAY' or croak "Invalid vector passed to plot_axis()."; # Save original function my $old_function = $self->{proj}->get_function(); # Directional vector of the axis my @vector = @{ $args{vector} }; # Create new function along the axis' directional vector # using only one parameter t that will be determined # below $self->{proj}->new_function( 't', "$vector[0]*\$t", "$vector[1]*\$t", "$vector[2]*\$t", ); # Calculate the length of the unit vector my $vector_length = sqrt( $vector[0]**2 + $vector[1]**2 + $vector[2]**2 ); # Calculate $t, the number of units needed to get # a line of the correct length. my $t = $args{length} / ( 2 * $vector_length ); # Use the plot_list method to display the axis. $self->plot_list( color => $args{color}, type => 'line', params => [ [-$t], # We calculated for $t for length/2, hence [$t], # we may now draw from -$t to +$t ], ); # Restore original function $self->{proj}->set_function($old_function); return 1; } 1; __END__ =pod =head1 NAME Math::Project3D::Plot - Perl extension for plotting projections of 3D functions =head1 SYNOPSIS use Math::Project3D::Plot; # Create new image or open an existing one my $img = Imager->new(...); # Create new projection my $projection = Math::Project3D->new( # see Math::Project3D manpage! ); my $plotter = Math::Project3D::Plot->new( image => $img, projection => $projection, # 1 logical unit => 10 pixels scale => 10, # x/y coordinates of the origin in pixels origin_x => $img->getwidth() / 2, origin_y => $img->getheight() / 2, ); $plotter->plot_axis( color => $color, # see Imager manpage about colors vector => [1, 0, 0], # That's the x-axis length => 100, ); $plotter->plot( params => [@parameters], color => $color, # see Imager manpage about colors ); $plotter->plot_list( params => [ [@parameter_set1], [@parameter_set2], # ... ], color => $color, # see Imager manpage about colors type => 'line', # connect points with lines # other option: 'points' ); $plotter->plot_range( params => [ [$lower_boundary1, $upper_boundary1, $increment1], [$lower_boundary2, $upper_boundary2, $increment2], # ... ], color => $color, # see Imager manpage about colors type => 'points', # draw the points only # other options: 'line' and 'multiline' ); # Use Imager methods on $img to save the image to a file =head1 DESCRIPTION This module may be used to plot the results of a projection from a three dimensional vectorial function onto a plane into an image. What a horrible sentence. =head2 Methods =over 4 =item new new is the constructor for Math::Project3D::Plot objects. Using the specified arguments, it creates a new instance of Math::Project3D::Plot. Parameters are passed as a list of key value pairs. Valid parameters are: required: image => Imager object to draw into projection => Math::Project3D object to get projected points from optional: scale => how many pixels per logical unit (defaults to 10) origin_x => graphical x coordinate of the origin origin_y => graphical y coordinate of the origin (default to half the width/height of the image) =item plot The plot method plots the projected point associated with the function parameters passed to the method. Takes its arguments as key/value pairs. The following parameters are valid (and required): =over 2 =item color Imager color to use (see Imager::Color manpage) =item params Array reference containing a list of function parameters =back In addition to plotting the point, the method returns the graphical coordinates of the point. =item plot_list The plot_list method plots all projected points associated with the sets of function parameters passed to the method. Takes its arguments as key/value pairs. The following parameters are valid: =over 2 =item color Imager color to use (see Imager::Color manpage) =item params Array reference containing any number of array references containing sets of function parameters =item type May be either 'line' or 'points' (connect points or not) (defaults to 'points'). =back =item plot_range The plot_range method plots all projected points associated with the function parameter ranges passed to the method. Takes its arguments as key/value pairs. The following parameters are valid: =over 2 =item color Imager color to use (see Imager::Color manpage) =item params Array reference containing an array reference for every function parameter. These inner array references are to contain one or three items: one: static parameter three: lower boundary, upper boundary, increment =item type May be either 'line' or 'points' (connect points or not) (defaults to 'points'). I type 'multiline' that works similar to 'line', but does not connect points whenever a parameter other than the innermost one is incremented. This is usually the desired method whenever you are plotting functions of multiple parameters and are experiencing odd lines connecting different parts of the function. 'multiline' is only a valid type for 'plot_range', not for the other plotting methods. =back =item plot_axis The plot_axis method draws an axis into the image. "Axis" used as in "a line that goes through the origin". Required arguments: color => Imager color to use (see Imager::Color manpage) vector => Array ref containing three vector components. (only the direction matters as the vector will be normalized by plot_axis.) length => Desired axis length. =back =head1 AUTHOR Steffen Mueller, Esmueller@cpan.orgE =head1 COPYRIGHT AND LICENSE Copyright (c) 2002-2006 Steffen Mueller. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 SEE ALSO L, L, L, L =cut