]> git.vpit.fr Git - perl/modules/LaTeX-TikZ.git/blob - lib/LaTeX/TikZ/Formatter.pm
Initial commit
[perl/modules/LaTeX-TikZ.git] / lib / 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::Tools;
21
22 use Any::Moose;
23 use Any::Moose 'Util::TypeConstraints';
24
25 has 'unit' => (
26  is      => 'ro',
27  isa     => enum([ qw/cm pt/ ]),
28  default => 'cm',
29 );
30
31 has 'format' => (
32  is      => 'ro',
33  isa     => 'Str',
34  default => '%s',
35 );
36
37 has 'scale' => (
38  is      => 'ro',
39  isa     => 'Num',
40  default => 1,
41 );
42
43 has 'width' => (
44  is  => 'ro',
45  isa => 'Maybe[Num]',
46 );
47
48 has 'height' => (
49  is  => 'ro',
50  isa => 'Maybe[Num]',
51 );
52
53 has 'origin' => (
54  is   => 'ro',
55  does => 'Maybe[LaTeX::TikZ::Point]',
56 );
57
58 my $lts_tc = LaTeX::TikZ::Tools::type_constraint('LaTeX::TikZ::Set');
59
60 my $find_mods;
61 $find_mods = do {
62  no warnings 'recursion';
63
64  Sub::Name::subname('find_mods' => sub {
65   my ($set, $layers, $others) = @_;
66
67   if ($set->isa('LaTeX::TikZ::Set::Mod')) {
68    for ($set->mods) {
69     if ($_->isa('LaTeX::TikZ::Mod::Layer')) {
70      push @$layers, $_;
71     } else {
72      push @$others, $_;
73     }
74    }
75   }
76
77   my @subsets = $set->isa('LaTeX::TikZ::Set::Sequence')
78                 ? $set->kids
79                 : $set->isa('LaTeX::TikZ::Set::Path')
80                   ? $set->ops
81                   : ();
82
83   $find_mods->($_, $layers, $others) for @subsets;
84  })
85 };
86
87 sub render {
88  my $tikz = shift;
89
90  $lts_tc->assert_valid($_) for @_;
91
92  my $seq = LaTeX::TikZ::Set::Sequence->new(
93   kids => \@_,
94  );
95
96  my (@layers, @other_mods);
97  $find_mods->($seq, \@layers, \@other_mods);
98
99  my $o = $tikz->origin;
100  $seq  = $seq->translate($o) if defined $o;
101
102  my $w = $tikz->width;
103  my $h = $tikz->height;
104  my $canvas = '';
105  if (defined $w and defined $h) {
106   $seq->clip(Tikz->rectangle(Tikz->point(0) => [ $w, $h ]));
107   $_ = $tikz->len($_) for $w, $h;
108   $canvas = ",papersize={$w,$h},body={$w,$h}";
109  }
110
111  my @header = (
112   "\\usepackage[pdftex,hcentering,vcentering$canvas]{geometry}",
113   "\\usepackage{tikz}",
114   "\\usetikzlibrary{patterns}",
115  );
116
117  my @decls;
118  if (@layers) {
119   my $layers_decl = LaTeX::TikZ::Mod::Layer->declare(@layers);
120   if (defined $layers_decl) {
121    chomp $layers_decl;
122    push @decls, $layers_decl;
123   }
124  }
125  for (@other_mods) {
126   my $decl = $_->declare($tikz);
127   if (defined $decl) {
128    chomp $decl;
129    push @decls, $decl;
130   }
131  }
132
133  my @content = (
134   "\\begin{tikzpicture}",
135   do { my $s = $seq->draw($tikz); chomp $s; $s },
136   "\\end{tikzpicture}",
137  );
138
139  return \@header, \@decls, \@content;
140 }
141
142 sub len {
143  my ($tikz, $len) = @_;
144
145  $len = 0 if LaTeX::TikZ::Tools::numeq($len, 0);
146
147  sprintf $tikz->format . $tikz->unit, $len * $tikz->scale;
148 }
149
150 sub angle {
151  my ($tikz, $a) = @_;
152
153  $a = ($a * 180) / CORE::atan2(0, -1);
154  $a += 360 if LaTeX::TikZ::Tools::numcmp($a, 0) < 0;
155
156  require POSIX;
157  sprintf $tikz->format, POSIX::ceil($a);
158 }
159
160 sub label {
161  my ($tikz, $name, $pos) = @_;
162
163  my $scale = sprintf '%0.2f', $tikz->scale / 5;
164
165  "node[scale=$scale,$pos] {\$$name\$}";
166 }
167
168 sub thickness {
169  my ($tikz, $width) = @_;
170
171  # width=1 is 0.4 points for a scale of 2.5
172  0.8 * $width * ($tikz->scale / 5);
173 }
174
175 __PACKAGE__->meta->make_immutable;
176
177 =head1 AUTHOR
178
179 Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
180
181 You can contact me by mail or on C<irc.perl.org> (vincent).
182
183 =head1 BUGS
184
185 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>.
186 I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
187
188 =head1 SUPPORT
189
190 You can find documentation for this module with the perldoc command.
191
192     perldoc LaTeX::TikZ
193
194 =head1 COPYRIGHT & LICENSE
195
196 Copyright 2010 Vincent Pit, all rights reserved.
197
198 This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
199
200 =cut
201
202 1; # End of LaTeX::TikZ::Formatter