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