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.
21 Rules can apply not only to L<LaTeX::TikZ::Set> objects, but also to the L<LaTeX::TikZ::Mod> objects they contain.
29 use LaTeX::TikZ::Functor::Rule;
31 use LaTeX::TikZ::Interface;
33 use LaTeX::TikZ::Tools;
35 my $lts_tc = LaTeX::TikZ::Tools::type_constraint('LaTeX::TikZ::Set');
39 $validate_spec = Sub::Name::subname('validate_spec' => sub {
42 my ($replace, $target);
43 if (defined $spec and ref $spec eq ''
44 and $spec =~ /^(\+?)([A-Za-z][A-Za-z0-9_]*(?:::[A-Za-z][A-Za-z0-9_]*)*)$/) {
45 $replace = defined($1) && $1 eq '+';
48 Carp::confess("Invalid rule spec $spec");
51 return $target, $replace;
57 =head2 C<< new rules => [ $spec1 => $handler1, $spec2 => $handler2, ... ] >>
59 Creates a new functor object that will use both the default and these user-specified rules.
60 The functor is also a code reference that expects to be called against L<LaTeX::TikZ::Set> objects.
62 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.
64 # The default is a clone method
65 my $clone = Tikz->functor;
66 my $dup = $set->$clone;
68 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.
71 my $translate = Tikz->functor(
72 # Only replace the way point sets are cloned
73 'LaTeX::TikZ::Set::Point' => sub {
74 my ($functor, $set, $x, $y) = @_;
86 my $shifted = $set->$translate(1, 1);
88 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).
91 my $strip = Tikz->functor(
92 # Replace all existent mod rules by this simple one
93 '+LaTeX::TikZ::Mod' => sub { return },
95 my $naked = $set->$strip;
97 The functor will map unhandled sets and mods to themselves without cloning them, since it has no way to know how to do it.
98 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.
102 my @default_set_rules;
103 my @default_mod_rules;
106 my ($class, %args) = @_;
108 my @set_rules = @default_set_rules;
109 my @mod_rules = @default_mod_rules;
111 my @user_rules = @{$args{rules} || []};
112 while (@user_rules) {
113 my ($spec, $handler) = splice @user_rules, 0, 2;
115 my ($target, $replace) = $validate_spec->($spec);
117 my $rule = LaTeX::TikZ::Functor::Rule->new(
123 into => $rule->is_set ? \@set_rules : \@mod_rules,
129 my %dispatch = map { $_->target => $_ } @set_rules, @mod_rules;
136 $lts_tc->assert_valid($set);
138 my $rule = $dispatch{ref($set)};
141 if ($_->handles($set)) {
147 return $set unless $rule;
149 my $new_set = $rule->handler->($self, $set, @_);
150 return $set if $new_set == $set;
154 for my $mod ($set->mods) {
155 my $rule = $dispatch{ref($mod)};
158 if ($_->handles($mod)) {
164 push @new_mods, $rule ? $rule->handler->($self, $mod, @_)
167 $new_set->mod(@new_mods);
173 LaTeX::TikZ::Interface->register(
177 __PACKAGE__->new(rules => \@_);
181 =head2 C<< default_rule $spec => $handler >>
183 Adds to all subsequently created functors a default rule for the class or role C<$spec>.
185 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.
186 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).
188 Returns true if and only if an existent rule was replaced.
194 my ($spec, $handler) = @_;
196 my ($target, $replace) = $validate_spec->($spec);
198 my $rule = LaTeX::TikZ::Functor::Rule->new(
204 into => $rule->is_set ? \@default_set_rules : \@default_mod_rules,
216 Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
218 You can contact me by mail or on C<irc.perl.org> (vincent).
222 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>.
223 I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
227 You can find documentation for this module with the perldoc command.
231 =head1 COPYRIGHT & LICENSE
233 Copyright 2010 Vincent Pit, all rights reserved.
235 This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
239 1; # End of LaTeX::TikZ::Functor