]> git.vpit.fr Git - perl/modules/LaTeX-TikZ.git/blob - lib/LaTeX/TikZ/Mod/Pattern.pm
e31325d698a9ff45e8670dad212b14dc1cc527e2
[perl/modules/LaTeX-TikZ.git] / lib / LaTeX / TikZ / Mod / Pattern.pm
1 package LaTeX::TikZ::Mod::Pattern;
2
3 use strict;
4 use warnings;
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 use LaTeX::TikZ::Interface;
19
20 use Mouse;
21
22 =head1 RELATIONSHIPS
23
24 This class consumes the L<LaTeX::TikZ::Mod> role, and as such implements the L</tag>, L</covers>, L</declare> and L</apply> methods.
25
26 =cut
27
28 with 'LaTeX::TikZ::Mod';
29
30 =head1 ATTRIBUTES
31
32 =head2 C<template>
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<name>
52
53 =cut
54
55 sub name {
56  my ($pat, $tikz) = @_;
57
58  my $cache = $pat->_cache->{$tikz->id};
59  confess('Template not yet declared') unless defined $cache;
60
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<tag>
72
73 =cut
74
75 sub tag { ref $_[0] }
76
77 =head2 C<covers>
78
79 =cut
80
81 sub covers { 0 }
82
83 =head2 C<declare>
84
85 =cut
86
87 sub declare {
88  my ($pat, $tikz) = @_;
89
90  my $tikz_id = $tikz->id;
91  my $cache   = $pat->_cache->{$tikz_id};
92  return @{$cache->[1]} if defined $cache;
93
94  $cache = $pat->_cache->{$tikz_id} = [ ];
95  $cache->[0] = 'pat' . $id++;
96
97  my $template = [ map $_, @{$pat->template} ];
98  s!#([^#]+)#!
99   my ($command, @opts) = split /=/, $1, 2;
100   @opts = split /,/, $opts[0] if @opts;
101   $handlers{lc $command}->($pat, $tikz, @opts);
102  !ge for @$template;
103  $cache->[1] = $template;
104
105  return @$template;
106 }
107
108 =head2 C<apply>
109
110 =cut
111
112 sub apply { 'fill', 'pattern=' . $_[0]->name($_[1]) }
113
114 LaTeX::TikZ::Interface->register(
115  pattern => sub {
116   my $class = shift;
117
118   my %args = @_;
119   if (exists $args{class}) {
120    $class = delete $args{class};
121    $class = __PACKAGE__ . '::' . $class unless $class =~ /::/;
122    (my $pm = $class) =~ s{::}{/}g;
123    $pm .= '.pm';
124    require $pm;
125   }
126
127   $class->new(%args);
128  },
129 );
130
131 __PACKAGE__->meta->make_immutable;
132
133 =head1 SEE ALSO
134
135 L<LaTeX::TikZ>, L<LaTeX::TikZ::Mod>.
136
137 =head1 AUTHOR
138
139 Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
140
141 You can contact me by mail or on C<irc.perl.org> (vincent).
142
143 =head1 BUGS
144
145 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>.
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