File Coverage

blib/lib/LaTeX/TikZ/Mod/Pattern/Dots.pm
Criterion Covered Total %
statement 15 15 100.0
branch n/a
condition n/a
subroutine 5 5 100.0
pod n/a
total 20 20 100.0


line stmt bran cond sub pod time code
1             package LaTeX::TikZ::Mod::Pattern::Dots;
2              
3 2     2   29634 use strict;
  2         5  
  2         88  
4 2     2   13 use warnings;
  2         3  
  2         105  
5              
6             =head1 NAME
7              
8             LaTeX::TikZ::Mod::Pattern::Dots - A dotted pattern modifier.
9              
10             =head1 VERSION
11              
12             Version 0.02
13              
14             =cut
15              
16             our $VERSION = '0.02';
17              
18 2     2   12 use Sub::Name ();
  2         5  
  2         36  
19              
20 2     2   12 use Any::Moose;
  2         4  
  2         16  
21 2     2   1648 use Any::Moose 'Util::TypeConstraints';
  2         5  
  2         8  
22              
23             =head1 RELATIONSHIPS
24              
25             This class inherits the L<LaTeX::TikZ::Mod::Pattern> class and its L<LaTeX::TikZ::Mod::Pattern/tag>, L<LaTeX::TikZ::Mod::Pattern/covers>, L<LaTeX::TikZ::Mod::Pattern/declare> and L<LaTeX::TikZ::Mod::Pattern/apply> methods.
26              
27             =cut
28              
29             extends 'LaTeX::TikZ::Mod::Pattern';
30              
31             =head1 ATTRIBUTES
32              
33             =head2 C<dot_width>
34              
35             =cut
36              
37             has 'dot_width' => (
38             is => 'ro',
39             isa => subtype('Num' => where { LaTeX::TikZ::Tools::numcmp($_, 0) >= 0 }),
40             default => 1,
41             );
42              
43             =head2 C<space_width>
44              
45             =cut
46              
47             has 'space_width' => (
48             is => 'ro',
49             isa => subtype('Num' => where { LaTeX::TikZ::Tools::numcmp($_, 0) >= 0 }),
50             default => 10,
51             );
52              
53             my $W = Sub::Name::subname('WIDTH' => sub { sprintf '#WIDTH=%0.1f#', @_ });
54              
55             my $forge_template = Sub::Name::subname('forge_template' => sub {
56             my ($dot_width, $space_width) = @_;
57              
58             my ($low_left, $up_right, $tile_size, $center);
59             my ($width, $half_width, $shadow_min, $shadow_max);
60              
61             $width = $W->($space_width);
62             $half_width = $W->($space_width / 2);
63              
64             $shadow_min = $W->(- $dot_width);
65             $shadow_max = $W->($space_width + $dot_width);
66             $dot_width = $W->($dot_width);
67              
68             $low_left = "\\pgfqpoint{$shadow_min}{$shadow_min}";
69             $up_right = "\\pgfqpoint{$shadow_max}{$shadow_max}";
70             $center = "\\pgfqpoint{$half_width}{$half_width}";
71             $tile_size = "\\pgfqpoint{$width}{$width}";
72              
73             return [
74             "\\pgfdeclarepatternformonly{#NAME#}{$low_left}{$up_right}{$tile_size}{",
75             "\\pgfpathcircle{$center}{$dot_width}",
76             "\\pgfusepath{fill}",
77             '}',
78             ];
79             });
80              
81             around 'BUILDARGS' => sub {
82             my ($orig, $class, %args) = @_;
83              
84             confess('Can\'t specify an explicit template for a '. __PACKAGE__ .' pattern')
85             if exists $args{template};
86              
87             my @params = qw/dot_width space_width/;
88              
89             my $meta = $class->meta;
90             for (@params) {
91             my $attr = $meta->find_attribute_by_name($_);
92             $args{$_} = $attr->default if $attr->has_default and not exists $args{$_};
93             $attr->type_constraint->assert_valid($args{$_});
94             }
95              
96             $args{template} = $forge_template->(@args{@params});
97              
98             $class->$orig(%args);
99             };
100              
101             __PACKAGE__->meta->make_immutable;
102              
103             =head1 SEE ALSO
104              
105             L<LaTeX::TikZ>, L<LaTeX::TikZ::Mod::Pattern>.
106              
107             =head1 AUTHOR
108              
109             Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
110              
111             You can contact me by mail or on C<irc.perl.org> (vincent).
112              
113             =head1 BUGS
114              
115             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>.
116             I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
117              
118             =head1 SUPPORT
119              
120             You can find documentation for this module with the perldoc command.
121              
122             perldoc LaTeX::TikZ
123              
124             =head1 COPYRIGHT & LICENSE
125              
126             Copyright 2010 Vincent Pit, all rights reserved.
127              
128             This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
129              
130             =cut
131              
132             1; # End of LaTeX::TikZ::Mod::Pattern::Dots