=head1 VERSION
-Version 0.01
+Version 0.02
=cut
-our $VERSION = '0.01';
+our $VERSION = '0.02';
=head1 DESCRIPTION
-A functor takes a L<LaTeX::TikZ::Set> tree and clones it according to certain rules.
+A functor takes a L<LaTeX::TikZ::Set> tree and returns a new, transmuted version of it according to certain rules.
+It recursively visits all the nodes of the tree, building a new set out of the result of the functor on the child sets.
-=cut
+Rules are stored as L<LaTeX::TikZ::Functor::Rule> objects.
+They can apply not only to L<LaTeX::TikZ::Set> consumer objects, but also to the L<LaTeX::TikZ::Mod> consumer objects they contain.
+When the functor is called against a set object and that the returned set is different from the original (as told by C<==>, which defaults to object identity), then the functor is also applied to all the mods of the set, and their transformed counterparts are added to the new set.
-use Carp ();
+When the functor is called onto a set or mod object, all its associated rules are tried successively, and the handler of the first matching rule is executed with :
-use Sub::Name ();
+=over 4
-use LaTeX::TikZ::Interface;
+=item *
-use LaTeX::TikZ::Tools;
+the functor object as its first argument ;
-use Any::Moose 'Util' => [ 'does_role' ];
+=item *
-my $lts_tc = LaTeX::TikZ::Tools::type_constraint('LaTeX::TikZ::Set');
+the current set or mod object as its second argument ;
-my @default_set_rules;
-my @default_mod_rules;
+=item *
-my ($validate_rule, $insert_rule);
-BEGIN {
- $validate_rule = Sub::Name::subname('validate_rule' => sub {
- my ($target, $handler) = @_;
+the arguments passed to the functor itself starting at the third argument.
- unless (defined $target and ref $target eq ''
- and $target =~ /[A-Za-z][A-Za-z0-9_]*(?:::[A-Za-z][A-Za-z0-9_]*)*/) {
- Carp::confess("Invalid target $target");
- }
+=back
- (my $pm = $target) =~ s{::}{/}g;
- $pm .= '.pm';
- require $pm;
+The handler is expected to return the new set or mod that will replace the old one in the resulting set tree.
- my $is_set;
- if (does_role($target, 'LaTeX::TikZ::Set')) {
- $is_set = 1;
- } elsif (does_role($target, 'LaTeX::TikZ::Mod')) {
- $is_set = 0;
- } else {
- Carp::confess("Target $target is neither a set nor a mod");
- }
+If no matching rule is found, the object is returned as-is.
- Carp::confess("Invalid handler for target $target")
- unless ref $handler eq 'CODE';
+=cut
- return [ $target, $handler, $is_set ];
- });
+use Carp ();
- $insert_rule = Sub::Name::subname('insert_rule' => sub {
- my ($rule, $list) = @_;
+use Sub::Name ();
- my $spec = $rule->[0];
- for my $i (0 .. $#$list) {
- my $old_spec = $list->[$i]->[0];
- if ($old_spec->isa($spec) or does_role($old_spec, $spec)) {
- splice @$list, $i, 1, $rule;
- return 1;
- }
+use LaTeX::TikZ::Functor::Rule;
+
+use LaTeX::TikZ::Interface;
+
+use LaTeX::TikZ::Tools;
+
+my $lts_tc = LaTeX::TikZ::Tools::type_constraint('LaTeX::TikZ::Set');
+
+my $validate_spec;
+BEGIN {
+ $validate_spec = Sub::Name::subname('validate_spec' => sub {
+ my ($spec) = @_;
+
+ my ($replace, $target);
+ if (defined $spec and ref $spec eq ''
+ and $spec =~ /^(\+?)([A-Za-z][A-Za-z0-9_]*(?:::[A-Za-z][A-Za-z0-9_]*)*)$/) {
+ $replace = defined($1) && $1 eq '+';
+ $target = $2;
+ } else {
+ Carp::confess("Invalid rule spec $spec");
}
- push @$list, $rule;
- return $#$list;
+ return $target, $replace;
});
}
=head1 METHODS
-=head2 C<default_rule>
+=head2 C<new>
-=cut
+ my $functor = LaTeX::TikZ::Functor->new(
+ rules => [ $spec1 => $handler1, $spec2 => $handler2, ... ],
+ );
-sub default_rule {
- shift;
+Creates a new functor object that will use both the default and the user-specified rules.
+The functor is also a code reference that expects to be called against L<LaTeX::TikZ::Set> objects.
- my $rule = $validate_rule->(@_);
+The default set and mod rules clone their relevant objects, so you get a clone functor (for the default set types) if you don't specify any user rule.
- $insert_rule->($rule, $rule->[2] ? \@default_set_rules : \@default_mod_rules);
-}
+ # The default is a clone method
+ my $clone = Tikz->functor;
+ my $dup = $set->$clone;
-=head2 C<< new rules => [ $class_name => sub { ... }, ... ] >>
+If there is already a default rule for one of the C<$spec>s, it is replaced by the new one ; otherwise, the user rule is inserted into the list of default rules after all its descendants' rules and before all its ancestors' rules.
+
+ # A translator
+ my $translate = Tikz->functor(
+ # Only replace the way point sets are cloned
+ 'LaTeX::TikZ::Set::Point' => sub {
+ my ($functor, $set, $x, $y) = @_;
+
+ $set->new(
+ point => [
+ $set->x + $x,
+ $set->y + $y,
+ ],
+ label => $set->label,
+ pos => $set->pos,
+ );
+ },
+ );
+ my $shifted = $set->$translate(1, 1);
+
+But if one of the C<$spec>s begins with C<'+'>, the rule will replace I<all> default rules that apply to subclasses or subroles of C<$spec> (including C<$spec> itself).
+
+ # A mod stripper
+ my $strip = Tikz->functor(
+ # Replace all existent mod rules by this simple one
+ '+LaTeX::TikZ::Mod' => sub { return },
+ );
+ my $naked = $set->$strip;
+
+The functor will map unhandled sets and mods to themselves without cloning them, since it has no way to know how to do it.
+Thus, if you define your own L<LaTeX::TikZ::Set> or L<LaTeX::TikZ::Mod> object, be sure to register a default rule for it with the L</default_rule> method.
=cut
+my @default_set_rules;
+my @default_mod_rules;
+
sub new {
my ($class, %args) = @_;
my @user_rules = @{$args{rules} || []};
while (@user_rules) {
- my ($target, $handler) = splice @user_rules, 0, 2;
+ my ($spec, $handler) = splice @user_rules, 0, 2;
- my $rule = $validate_rule->($target, $handler);
+ my ($target, $replace) = $validate_spec->($spec);
- $insert_rule->($rule, $rule->[2] ? \@set_rules : \@mod_rules);
+ my $rule = LaTeX::TikZ::Functor::Rule->new(
+ target => $target,
+ handler => $handler,
+ );
+
+ $rule->insert(
+ into => $rule->is_set ? \@set_rules : \@mod_rules,
+ overwrite => 1,
+ replace => $replace,
+ );
}
- my %dispatch = map { $_->[0] => $_ } @set_rules, @mod_rules;
+ my %dispatch = map { $_->target => $_ } @set_rules, @mod_rules;
my $self;
my $rule = $dispatch{ref($set)};
unless ($rule) {
- ($set->isa($_->[0]) or $set->does($_->[0])) and $rule = $_ for @set_rules;
- $rule = [ undef, sub { $_[1] } ] unless $rule;
+ for (@set_rules) {
+ if ($_->handles($set)) {
+ $rule = $_;
+ last;
+ }
+ }
}
- my $new_set = $rule->[1]->($self, $set, @_);
- my $is_new = $new_set ne $set;
+ return $set unless $rule;
+
+ my $new_set = $rule->handler->($self, $set, @_);
+ return $set if $new_set == $set;
my @new_mods;
MOD:
for my $mod ($set->mods) {
my $rule = $dispatch{ref($mod)};
unless ($rule) {
- ($mod->isa($_->[0]) or $mod->does($_->[0])) and $rule = $_ for @mod_rules;
- unless ($rule) {
- push @new_mods, $mod;
- next MOD;
+ for (@mod_rules) {
+ if ($_->handles($mod)) {
+ $rule = $_;
+ last;
+ }
}
}
- push @new_mods, $rule->[1]->($self, $mod, @_);
+ push @new_mods, $rule ? $rule->handler->($self, $mod, @_)
+ : $mod;
}
-
- $new_set->mod(@new_mods) if $is_new;
+ $new_set->mod(@new_mods);
return $new_set;
}, $class;
},
);
+=head2 C<default_rule>
+
+ LaTeX::TikZ::Functor->default_rule($spec => $handler)
+
+Adds to all subsequently created functors a default rule for the class or role C<$spec>.
+
+An exception is thrown if there is already a default rule for C<$spec> ; otherwise, the new rule is inserted into the current list of default rules after all its descendants' rules and before all its ancestors' rules.
+But if C<$spec> begins with C<'+'>, the rule will replace I<all> default rules that apply to subclasses or subroles of C<$spec> (including C<$spec> itself).
+
+Returns true if and only if an existent rule was replaced.
+
+=cut
+
+sub default_rule {
+ shift;
+ my ($spec, $handler) = @_;
+
+ my ($target, $replace) = $validate_spec->($spec);
+
+ my $rule = LaTeX::TikZ::Functor::Rule->new(
+ target => $target,
+ handler => $handler,
+ );
+
+ $rule->insert(
+ into => $rule->is_set ? \@default_set_rules : \@default_mod_rules,
+ overwrite => 0,
+ replace => $replace,
+ );
+}
+
+=head1 SEE ALSO
+
+L<LaTeX::TikZ>, L<LaTeX::TikZ::Functor::Rule>.
+
=head1 AUTHOR
Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
=head1 COPYRIGHT & LICENSE
-Copyright 2010 Vincent Pit, all rights reserved.
+Copyright 2010,2011,2012,2013,2014,2015 Vincent Pit, all rights reserved.
This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
projects / perl / modules / LaTeX-TikZ.git / blobdiff