=head1 DESCRIPTION
A functor takes a L<LaTeX::TikZ::Set> tree and clones it according to certain rules.
+Rules can apply not only to L<LaTeX::TikZ::Set> objects, but also to the L<LaTeX::TikZ::Mod> objects they contain.
=cut
use Sub::Name ();
+use LaTeX::TikZ::Functor::Rule;
+
use LaTeX::TikZ::Interface;
use LaTeX::TikZ::Tools;
-use Any::Moose 'Util' => [ 'does_role' ];
-
my $lts_tc = LaTeX::TikZ::Tools::type_constraint('LaTeX::TikZ::Set');
-my @default_set_rules;
-my @default_mod_rules;
-
-my ($validate_rule, $insert_rule);
+my $validate_spec;
BEGIN {
- $validate_rule = Sub::Name::subname('validate_rule' => sub {
- my ($target, $handler) = @_;
-
- 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");
- }
-
- (my $pm = $target) =~ s{::}{/}g;
- $pm .= '.pm';
- require $pm;
-
- my $is_set;
- if (does_role($target, 'LaTeX::TikZ::Set')) {
- $is_set = 1;
- } elsif (does_role($target, 'LaTeX::TikZ::Mod')) {
- $is_set = 0;
+ $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("Target $target is neither a set nor a mod");
+ Carp::confess("Invalid rule spec $spec");
}
- Carp::confess("Invalid handler for target $target")
- unless defined $handler and ref $handler eq 'CODE';
-
- return [ $target, $handler, $is_set ];
+ return $target, $replace;
});
+}
- $insert_rule = Sub::Name::subname('insert_rule' => sub {
- my ($rule, $list) = @_;
+=head1 METHODS
- 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;
- }
- }
+=head2 C<< new rules => [ $spec1 => $handler1, $spec2 => $handler2, ... ] >>
- push @$list, $rule;
- return $#$list;
- });
-}
+Creates a new functor object that will use both the default and these user-specified rules.
+The functor is also a code reference that expects to be called against L<LaTeX::TikZ::Set> objects.
-=head1 METHODS
+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.
-=head2 C<default_rule>
+ # The default is a clone method
+ my $clone = Tikz->functor;
+ my $dup = $set->$clone;
-=cut
+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 appended to the list of default rules.
-sub default_rule {
- shift;
+ # A translator
+ my $translate = Tikz->functor(
+ # Only replace the way point sets are cloned
+ 'LaTeX::TikZ::Set::Point' => sub {
+ my ($functor, $set, $x, $y) = @_;
- my $rule = $validate_rule->(@_);
+ $set->new(
+ point => [
+ $set->x + $x,
+ $set->y + $y,
+ ],
+ label => $set->label,
+ pos => $set->pos,
+ );
+ },
+ );
+ my $shifted = $set->$translate(1, 1);
- $insert_rule->($rule, $rule->[2] ? \@default_set_rules : \@default_mod_rules);
-}
+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).
-=head2 C<< new rules => [ $class_name => sub { ... }, ... ] >>
+ # 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 ($target, $replace) = $validate_spec->($spec);
- my $rule = $validate_rule->($target, $handler);
+ my $rule = LaTeX::TikZ::Functor::Rule->new(
+ target => $target,
+ handler => $handler,
+ );
- $insert_rule->($rule, $rule->[2] ? \@set_rules : \@mod_rules);
+ $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 $new_set = $rule ? $rule->handler->($self, $set, @_)
+ : $set;
my $is_new = $new_set ne $set;
my @new_mods;
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;
},
);
+=head2 C<< 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 appended to the current list of 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>.
projects / perl / modules / LaTeX-TikZ.git / blobdiff