]> git.vpit.fr Git - perl/modules/LaTeX-TikZ.git/blob - LaTeX/TikZ/Formatter.pm
Update VPIT::TestHelpers to 15e8aee3
[perl/modules/LaTeX-TikZ.git] / LaTeX / TikZ / Formatter.pm
1 package LaTeX::TikZ::Formatter;
2
3 use strict;
4 use warnings;
5
6 =head1 NAME
7
8 LaTeX::TikZ::Formatter - LaTeX::TikZ formatter object.
9
10 =head1 VERSION
11
12 Version 0.01
13
14 =cut
15
16 our $VERSION = '0.01';
17
18 use Sub::Name ();
19
20 use LaTeX::TikZ::Point;
21
22 use LaTeX::TikZ::Interface;
23
24 use LaTeX::TikZ::Tools;
25
26 use Any::Moose;
27 use Any::Moose 'Util::TypeConstraints';
28
29 has 'unit' => (
30  is      => 'ro',
31  isa     => enum([ qw/cm pt/ ]),
32  default => 'cm',
33 );
34
35 has 'format' => (
36  is      => 'ro',
37  isa     => 'Str',
38  default => '%s',
39 );
40
41 has 'scale' => (
42  is      => 'rw',
43  isa     => 'Num',
44  default => 1,
45 );
46
47 has 'width' => (
48  is  => 'rw',
49  isa => 'Maybe[Num]',
50 );
51
52 has 'height' => (
53  is  => 'rw',
54  isa => 'Maybe[Num]',
55 );
56
57 has 'origin' => (
58  is     => 'rw',
59  isa    => 'LaTeX::TikZ::Point::Autocoerce',
60  coerce => 1,
61 );
62
63 sub id {
64  my $tikz = shift;
65
66  my $origin = $tikz->origin;
67  if (defined $origin) {
68   my ($x, $y) = map $origin->$_, qw/x y/;
69   $origin = "($x;$y)";
70  } else {
71   $origin = "(0;0)";
72  }
73
74  join $;, map {
75   defined() ? "$_" : '(undef)';
76  } map($tikz->$_, qw/unit format scale width height/), $origin;
77 }
78
79 my $find_mods = do {
80  our %seen;
81
82  my $find_mods_rec;
83  $find_mods_rec = do {
84   no warnings 'recursion';
85
86   Sub::Name::subname('find_mods_rec' => sub {
87    my ($set, $layers, $others) = @_;
88
89    for ($set->mods) {
90     my $tag = $_->tag;
91     next if $seen{$tag}++;
92
93     if ($_->isa('LaTeX::TikZ::Mod::Layer')) {
94      push @$layers, $_;
95     } else {
96      push @$others, $_;
97     }
98    }
99
100    my @subsets = $set->isa('LaTeX::TikZ::Set::Sequence')
101                  ? $set->kids
102                  : $set->isa('LaTeX::TikZ::Set::Path')
103                    ? $set->ops
104                    : ();
105
106    $find_mods_rec->($_, $layers, $others) for @subsets;
107   });
108  };
109
110  Sub::Name::subname('find_mods' => sub {
111   local %seen = ();
112
113   $find_mods_rec->(@_);
114  });
115 };
116
117 my $translate;
118
119 sub render {
120  my ($tikz, @sets) = @_;
121
122  unless ($translate) {
123   require LaTeX::TikZ::Functor;
124   $translate = LaTeX::TikZ::Functor->new(
125    rules => [
126     'LaTeX::TikZ::Set::Point' => sub {
127      my ($functor, $set, $v) = @_;
128
129      $set->new(
130       point => [
131        $set->x + $v->x,
132        $set->y + $v->y,
133       ],
134       label => $set->label,
135       pos   => $set->pos,
136      );
137     },
138    ],
139   );
140  }
141
142  my $origin = $tikz->origin;
143  if (defined $origin) {
144   @sets = map $_->$translate($origin), @sets;
145  }
146
147  my (@layers, @other_mods);
148  my $seq = LaTeX::TikZ::Set::Sequence->new(kids => \@sets);
149  $find_mods->($seq, \@layers, \@other_mods);
150
151  my $w = $tikz->width;
152  my $h = $tikz->height;
153  my $canvas = '';
154  if (defined $w and defined $h) {
155   require LaTeX::TikZ::Set::Rectangle;
156   for (@sets) {
157    $_->clip(LaTeX::TikZ::Set::Rectangle->new(
158     from   => 0,
159     width  => $w,
160     height => $h,
161    ));
162   }
163   $_ = $tikz->len($_) for $w, $h;
164   $canvas = ",papersize={$w,$h},body={$w,$h}";
165  }
166
167  my @header = (
168   "\\usepackage[pdftex,hcentering,vcentering$canvas]{geometry}",
169   "\\usepackage{tikz}",
170   "\\usetikzlibrary{patterns}",
171  );
172
173  my @decls;
174  push @decls, LaTeX::TikZ::Mod::Layer->declare(@layers) if  @layers;
175  push @decls, $_->declare($tikz)                        for @other_mods;
176
177  my @bodies = map [
178   "\\begin{tikzpicture}",
179   @{ $_->draw($tikz) },
180   "\\end{tikzpicture}",
181  ], @sets;
182
183  return \@header, \@decls, @bodies;
184 }
185
186 sub len {
187  my ($tikz, $len) = @_;
188
189  $len = 0 if LaTeX::TikZ::Tools::numeq($len, 0);
190
191  sprintf $tikz->format . $tikz->unit, $len * $tikz->scale;
192 }
193
194 sub angle {
195  my ($tikz, $a) = @_;
196
197  $a = ($a * 180) / CORE::atan2(0, -1);
198  $a += 360 if LaTeX::TikZ::Tools::numcmp($a, 0) < 0;
199
200  require POSIX;
201  sprintf $tikz->format, POSIX::ceil($a);
202 }
203
204 sub label {
205  my ($tikz, $name, $pos) = @_;
206
207  my $scale = sprintf '%0.2f', $tikz->scale / 5;
208
209  "node[scale=$scale,$pos] {$name}";
210 }
211
212 sub thickness {
213  my ($tikz, $width) = @_;
214
215  # width=1 is 0.4 points for a scale of 2.5
216  0.8 * $width * ($tikz->scale / 5);
217 }
218
219 LaTeX::TikZ::Interface->register(
220  formatter => sub {
221   shift;
222
223   __PACKAGE__->new(@_);
224  },
225 );
226
227 __PACKAGE__->meta->make_immutable;
228
229 =head1 AUTHOR
230
231 Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
232
233 You can contact me by mail or on C<irc.perl.org> (vincent).
234
235 =head1 BUGS
236
237 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>.
238 I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
239
240 =head1 SUPPORT
241
242 You can find documentation for this module with the perldoc command.
243
244     perldoc LaTeX::TikZ
245
246 =head1 COPYRIGHT & LICENSE
247
248 Copyright 2010 Vincent Pit, all rights reserved.
249
250 This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
251
252 =cut
253
254 1; # End of LaTeX::TikZ::Formatter