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