File Coverage

blib/lib/LaTeX/TikZ/Mod/Pattern.pm

Criterion	Covered	Total	%
statement	42	43	97.6
branch	7	10	70.0
condition			n/a
subroutine	9	10	90.0
pod	5	6	83.3
total	63	69	91.3

line	stmt	bran	sub	pod	time	code
1						package LaTeX::TikZ::Mod::Pattern;
2
3	10		10		36	use strict;
	10				13
	10				261
4	10		10		36	use warnings;
	10				13
	10				318
5
6						=head1 NAME
7
8						LaTeX::TikZ::Mod::Pattern - A modifier that fills a closed path with a pattern.
9
10						=head1 VERSION
11
12						Version 0.03
13
14						=cut
15
16						our $VERSION = '0.03';
17
18	10		10		40	use LaTeX::TikZ::Interface;
	10				14
	10				193
19
20	10		10		34	use Mouse;
	10				13
	10				43
21
22						=head1 RELATIONSHIPS
23
24						This class consumes the L role, and as such implements the L, L, L and L methods.
25
26						=cut
27
28						with 'LaTeX::TikZ::Mod';
29
30						=head1 ATTRIBUTES
31
32						=head2 C
33
34						=cut
35
36						has 'template' => (
37						is => 'ro',
38						isa => 'ArrayRef[Str]',
39						required => 1,
40						);
41
42						has '_cache' => (
43						is => 'ro',
44						isa => 'HashRef',
45						init_arg => undef,
46						default => sub { +{ } },
47						);
48
49						=head1 METHODS
50
51						=head2 C
52
53						=cut
54
55						sub name {
56	10		10	1	10	my ($pat, $tikz) = @_;
57
58	10				26	my $cache = $pat->_cache->{$tikz->id};
59	10	50			23	confess('Template not yet declared') unless defined $cache;
60
61	10				61	$cache->[0];
62						}
63
64						my $id = 'a';
65
66						my %handlers = (
67						name => sub { $_[0]->name($_[1]) },
68						width => sub { sprintf '%0.1fpt', $_[1]->thickness($_[2]) },
69						);
70
71						=head2 C
72
73						=cut
74
75	4		4	1	10	sub tag { ref $_[0] }
76
77						=head2 C
78
79						=cut
80
81	0		0	1	0	sub covers { 0 }
82
83						=head2 C
84
85						=cut
86
87						sub declare {
88	7		7	1	7	my ($pat, $tikz) = @_;
89
90	7				16	my $tikz_id = $tikz->id;
91	7				29	my $cache = $pat->_cache->{$tikz_id};
92	7	100			14	return @{$cache->[1]} if defined $cache;
	4				19
93
94	3				10	$cache = $pat->_cache->{$tikz_id} = [ ];
95	3				9	$cache->[0] = 'pat' . $id++;
96
97	3				5	my $template = [ map $_, @{$pat->template} ];
	3				15
98						s!#([^#]+)#!
99	34				73	my ($command, @opts) = split /=/, $1, 2;
100	34	100			82	@opts = split /,/, $opts[0] if @opts;
101	34				57	$handlers{lc $command}->($pat, $tikz, @opts);
102	3				23	!ge for @$template;
103	3				4	$cache->[1] = $template;
104
105	3				14	return @$template;
106						}
107
108						=head2 C
109
110						=cut
111
112	7		7	1	19	sub apply { 'fill', 'pattern=' . $_[0]->name($_[1]) }
113
114						LaTeX::TikZ::Interface->register(
115						pattern => sub {
116	3		3	0	101	my $class = shift;
117
118	3				8	my %args = @_;
119	3	50			9	if (exists $args{class}) {
120	3				9	$class = delete $args{class};
121	3	50			13	$class = __PACKAGE__ . '::' . $class unless $class =~ /::/;
122	3				15	(my $pm = $class) =~ s{::}{/}g;
123	3				4	$pm .= '.pm';
124	3				924	require $pm;
125						}
126
127	3				19	$class->new(%args);
128						},
129						);
130
131						__PACKAGE__->meta->make_immutable;
132
133						=head1 SEE ALSO
134
135						L, L.
136
137						=head1 AUTHOR
138
139						Vincent Pit, C<< >>, L.
140
141						You can contact me by mail or on C (vincent).
142
143						=head1 BUGS
144
145						Please report any bugs or feature requests to C, or through the web interface at L.
146						I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
147
148						=head1 SUPPORT
149
150						You can find documentation for this module with the perldoc command.
151
152						perldoc LaTeX::TikZ
153
154						=head1 COPYRIGHT & LICENSE
155
156						Copyright 2010,2011,2012,2013,2014,2015 Vincent Pit, all rights reserved.
157
158						This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
159
160						=cut
161
162						1; # End of LaTeX::TikZ::Mod::Pattern