# 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::Function;
use strict;
use warnings;
use vars qw/$VERSION/;
$VERSION = 1.02;
use Carp;
# Uncreatively named public class method "new"
#
# One of three syntaxes may be used:
# new(coderefs)
# new(param_names, expressions)
# new(param_names, expressions_and_coderefs_mixed)
# Returns a compiled anonymous subroutine
sub new {
my @components = @_;
# 'tis a class method after all, so remove the
# class name if necessary.
shift @components if $components[0] eq __PACKAGE__;
# Check for the existance of plaintext components
my $has_uncompiled_components = 0;
foreach my $component (@components) {
$has_uncompiled_components++, last
if ref $component ne 'CODE';
}
my $function;
# Call another subroutine to do the dirty work of
# compiling plaintext expressions if necessary.
if ($has_uncompiled_components) {
my $param_names = shift @components;
$function = _from_uncompiled_components($param_names, \@components);
} else {
# Have the function return whatever the applied components
# return. @components is accessible because
# the function in $function is a closure.
$function = sub {
return map { $_->(@_) } @components;
};
}
return $function;
}
# internal subroutine _from_uncompiled_components
#
# Does the dirty work of compiling plaintext expressions.
# Ugly. Very Ugly.
# Takes a string of parameter names (without dollar)
# separated by commas and an array reference to an
# array of components as arguments.
# Returns compiled function (anon sub).
sub _from_uncompiled_components {
# parameter names separated by commas
my @param_names = split /,/, shift;
my $components = shift;
# This var will hold the plaintext of the function we will compile
# later.
my $function_string = "sub {\n";
# For all declared parameter names, alias the n-th function
# argument to a lexical of the n-th name.
for (my $param_no = 0; $param_no < @param_names; $param_no++ ) {
$function_string .= " my \$$param_names[$param_no] = \$_[$param_no];\n";
}
# Return results of the applied component functions or expressions.
$function_string .= " return ";
my $component_count = 0;
foreach my $component (@$components) {
if (ref $component eq 'CODE') {
# We're a coderef. Run the anon sub associated with this
# component number and supply it with all function args.
$function_string .= "\$components[$component_count]->(\@_), ";
} else {
# We're a plaintext expression. Insert it, but wrap a
# "scalar()" around it to prevent expressions like "x,y"
# from screwing up the order of return values.
$function_string .= "scalar($component), ";
}
$component_count++;
}
$function_string .= "\n};";
# Call yet another subroutine to make sure the number
# of lexicals in scope is minimal.
return _compile_function($components, $function_string);
}
# Evil evaluator subroutine _compile_function
#
# Takes an array ref of components and a function_string
# as arguments.
# Returns compiled function or croaks about evaluation errors.
sub _compile_function {
# We want an array for speed. Dereferencing every time is
# quite a bit slow IIRC.
# This array will be accessed by the function (closure) in
# order to call the precompiled component functions.
my @components = @{+shift(@_)};
# Do it. Mwaha.
my $function = eval shift;
croak $@ if $@;
# All went well.
return $function;
}
1;
__END__
=pod
=head1 NAME
Math::Project3D::Function -
Generate anonymous subroutines for use as functions with Math::Project3D
=head1 SYNOPSIS
use Math::Project3D;
# Looks like a screw
my $function = Math::Project3D->new_function(
'u,v', # list of parameter names
'$u', # first component
'sin($v)', # more components
'cos($v)',
);
# or as an anonymous sub / closure!
{
# This is a sphere
my $radius = 5;
my $x_component = sub {
my $theta = shift;
my $phi = shift;
return $radius * sin($theta) * cos($phi);
};
my $y_component = sub {
my $theta = shift;
my $phi = shift;
return $radius * sin($theta) * sin($phi);
};
my $z_component = sub {
my $theta = shift;
return $radius * cos($theta);
};
$function = Math::Project3D->new_function(
$x_component, $y_component, $z_component
);
}
=head1 DESCRIPTION
This package contains the code for generating anonymous subroutines
for use as functions with the Math::Project3D module. The package
has no public subroutines and you should use it indirectly through
the C<new_function> method of Math::Project3D.
Oh, yes, I almost forgot. I<Do not read the source>. :-)
=head1 METHODS
Public methods
=head2 new
The C<new> method takes exactly the same arguments as the C<new_function>
method of L<Math::Project3D>.
It returns a new Math::Project3D::Function object.
=head1 AUTHOR
Steffen Mueller, mail at steffen-mueller dot net
=head1 COPYRIGHT
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<Math::Project3D>
=cut