1 package LaTeX::TikZ::Functor;
8 LaTeX::TikZ::Functor - Build functor methods that recursively visit nodes of a LaTeX::TikZ::Set tree.
16 our $VERSION = '0.01';
20 A functor takes a L<LaTeX::TikZ::Set> tree and clones it according to certain rules.
22 Rules can apply not only to L<LaTeX::TikZ::Set> consumer objects, but also to the L<LaTeX::TikZ::Mod> consumer objects they contain.
23 The are stored as L<LaTeX::TikZ::Functor::Rule> objects.
25 When the functor is called onto a set object, all its associated rules are tried successively, and the handler of the first matching rule is executed with :
31 the functor object as its first argument ;
35 the current set object as its second argument ;
39 the arguments passed to the functor itself starting at the third argument.
43 The handler is expected to return the new set/mod that will in the resulting set tree.
44 If the new set is different from the original, then the functor is applied to all the mods of the set, and their cloned version are added to the new set.
46 If no matching rule is found, the object is returned as-is.
54 use LaTeX::TikZ::Functor::Rule;
56 use LaTeX::TikZ::Interface;
58 use LaTeX::TikZ::Tools;
60 my $lts_tc = LaTeX::TikZ::Tools::type_constraint('LaTeX::TikZ::Set');
64 $validate_spec = Sub::Name::subname('validate_spec' => sub {
67 my ($replace, $target);
68 if (defined $spec and ref $spec eq ''
69 and $spec =~ /^(\+?)([A-Za-z][A-Za-z0-9_]*(?:::[A-Za-z][A-Za-z0-9_]*)*)$/) {
70 $replace = defined($1) && $1 eq '+';
73 Carp::confess("Invalid rule spec $spec");
76 return $target, $replace;
82 =head2 C<< new rules => [ $spec1 => $handler1, $spec2 => $handler2, ... ] >>
84 Creates a new functor object that will use both the default and these user-specified rules.
85 The functor is also a code reference that expects to be called against L<LaTeX::TikZ::Set> objects.
87 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.
89 # The default is a clone method
90 my $clone = Tikz->functor;
91 my $dup = $set->$clone;
93 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.
96 my $translate = Tikz->functor(
97 # Only replace the way point sets are cloned
98 'LaTeX::TikZ::Set::Point' => sub {
99 my ($functor, $set, $x, $y) = @_;
106 label => $set->label,
111 my $shifted = $set->$translate(1, 1);
113 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).
116 my $strip = Tikz->functor(
117 # Replace all existent mod rules by this simple one
118 '+LaTeX::TikZ::Mod' => sub { return },
120 my $naked = $set->$strip;
122 The functor will map unhandled sets and mods to themselves without cloning them, since it has no way to know how to do it.
123 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.
127 my @default_set_rules;
128 my @default_mod_rules;
131 my ($class, %args) = @_;
133 my @set_rules = @default_set_rules;
134 my @mod_rules = @default_mod_rules;
136 my @user_rules = @{$args{rules} || []};
137 while (@user_rules) {
138 my ($spec, $handler) = splice @user_rules, 0, 2;
140 my ($target, $replace) = $validate_spec->($spec);
142 my $rule = LaTeX::TikZ::Functor::Rule->new(
148 into => $rule->is_set ? \@set_rules : \@mod_rules,
154 my %dispatch = map { $_->target => $_ } @set_rules, @mod_rules;
161 $lts_tc->assert_valid($set);
163 my $rule = $dispatch{ref($set)};
166 if ($_->handles($set)) {
172 return $set unless $rule;
174 my $new_set = $rule->handler->($self, $set, @_);
175 return $set if $new_set == $set;
179 for my $mod ($set->mods) {
180 my $rule = $dispatch{ref($mod)};
183 if ($_->handles($mod)) {
189 push @new_mods, $rule ? $rule->handler->($self, $mod, @_)
192 $new_set->mod(@new_mods);
198 LaTeX::TikZ::Interface->register(
202 __PACKAGE__->new(rules => \@_);
206 =head2 C<< default_rule $spec => $handler >>
208 Adds to all subsequently created functors a default rule for the class or role C<$spec>.
210 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.
211 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).
213 Returns true if and only if an existent rule was replaced.
219 my ($spec, $handler) = @_;
221 my ($target, $replace) = $validate_spec->($spec);
223 my $rule = LaTeX::TikZ::Functor::Rule->new(
229 into => $rule->is_set ? \@default_set_rules : \@default_mod_rules,
237 L<LaTeX::TikZ>, L<LaTeX::TikZ::Functor::Rule>.
241 Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
243 You can contact me by mail or on C<irc.perl.org> (vincent).
247 Please report any bugs or feature requests to C<bug-latex-tikz at rt.cpan.org>, or through the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=LaTeX-TikZ>.
248 I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
252 You can find documentation for this module with the perldoc command.
256 =head1 COPYRIGHT & LICENSE
258 Copyright 2010 Vincent Pit, all rights reserved.
260 This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
264 1; # End of LaTeX::TikZ::Functor