]> git.vpit.fr Git - perl/modules/LaTeX-TikZ.git/blob - t/30-functor.t
Update VPIT::TestHelpers to 15e8aee3
[perl/modules/LaTeX-TikZ.git] / t / 30-functor.t
1 #!perl -T
2
3 use strict;
4 use warnings;
5
6 use Test::More tests => 11 + 2 * 8;
7
8 use LaTeX::TikZ;
9
10 use lib 't/lib';
11 use LaTeX::TikZ::TestHelper;
12
13 using Tikz->formatter(
14  format => '%d',
15 );
16
17 my $translate = eval {
18  Tikz->functor(
19   'LaTeX::TikZ::Set::Point' => sub {
20    my ($functor, $set, $v) = @_;
21
22    $set->new(
23     point => [
24      $set->x + $v->x,
25      $set->y + $v->y,
26     ],
27     label => $set->label,
28     pos   => $set->pos,
29    );
30   },
31  );
32 };
33 is $@, '', 'creating a translator doesn\'t croak';
34
35 my $seq = Tikz->seq(
36                  Tikz->point,
37                  Tikz->raw('foo'),
38                  Tikz->point(2),
39                  Tikz->line(-1 => 3)
40                      ->clip(Tikz->circle(1, 1)),
41                  Tikz->union(
42                   Tikz->chain(4 => '--' => [ -3, 2 ]),
43                   Tikz->join('-|' => [ -1, 0 ], [ 0, 1 ]),
44                  ),
45                 )
46               ->clip(Tikz->rectangle([0, -1] => [2, 3]));
47
48 my $seq2 = eval {
49  $seq->$translate(Tikz->point(-1, 1));
50 };
51 is $@, '', 'translating a sequence doesn\'t croak';
52
53 check $seq, 'the original sequence', <<'RES';
54 \begin{scope}
55 \clip (0cm,-1cm) rectangle (2cm,3cm) ;
56 \draw (0cm,0cm) ;
57 \draw foo ;
58 \draw (2cm,0cm) ;
59 \begin{scope}
60 \clip (1cm,0cm) circle (1cm) ;
61 \draw (-1cm,0cm) -- (3cm,0cm) ;
62 \end{scope}
63 \draw (4cm,0cm) -- (-3cm,2cm) (-1cm,0cm) -| (0cm,1cm) ;
64 \end{scope}
65 RES
66
67 check $seq2, 'the translated sequence', <<'RES';
68 \begin{scope}
69 \clip (-1cm,0cm) rectangle (1cm,4cm) ;
70 \draw (-1cm,1cm) ;
71 \draw foo ;
72 \draw (1cm,1cm) ;
73 \begin{scope}
74 \clip (0cm,1cm) circle (1cm) ;
75 \draw (-2cm,1cm) -- (2cm,1cm) ;
76 \end{scope}
77 \draw (3cm,1cm) -- (-4cm,3cm) (-2cm,1cm) -| (-1cm,2cm) ;
78 \end{scope}
79 RES
80
81 my $poly = Tikz->closed_polyline(
82  [ 0, 0 ], [ 1, 0 ], [ 1, 1 ], [ 0, 1 ]
83 );
84
85 my $poly2 = eval {
86  $poly->$translate(Tikz->point(-1, 1));
87 };
88 is $@, '', 'translating a polyline doesn\'t croak';
89
90 check $poly2, 'the translated polyline', <<'RES';
91 \draw (-1cm,1cm) -- (0cm,1cm) -- (0cm,2cm) -- (-1cm,2cm) -- cycle ;
92 RES
93
94 my $strip = eval {
95  Tikz->functor(
96   '+LaTeX::TikZ::Mod' => sub { return },
97  );
98 };
99 is $@, '', 'creating a stripper doesn\'t croak';
100
101 $_->mod(Tikz->color('red')) for $seq2->kids;
102
103 my $seq3 = eval {
104  $seq2->$strip;
105 };
106 is $@, '', 'stripping a sequence doesn\'t croak';
107
108 check $seq2, 'the original sequence', <<'RES';
109 \begin{scope} [color=red]
110 \clip (-1cm,0cm) rectangle (1cm,4cm) ;
111 \draw (-1cm,1cm) ;
112 \draw foo ;
113 \draw (1cm,1cm) ;
114 \begin{scope}
115 \clip (0cm,1cm) circle (1cm) ;
116 \draw (-2cm,1cm) -- (2cm,1cm) ;
117 \end{scope}
118 \draw (3cm,1cm) -- (-4cm,3cm) (-2cm,1cm) -| (-1cm,2cm) ;
119 \end{scope}
120 RES
121
122 check $seq3, 'the stripped sequence', <<'RES';
123 \draw (-1cm,1cm) ;
124 \draw foo ;
125 \draw (1cm,1cm) ;
126 \draw (-2cm,1cm) -- (2cm,1cm) ;
127 \draw (3cm,1cm) -- (-4cm,3cm) (-2cm,1cm) -| (-1cm,2cm) ;
128 RES
129
130 my $special = eval {
131  Tikz->functor(
132   '+LaTeX::TikZ::Mod' => sub { die "mod\n" },
133   '+LaTeX::TikZ::Set' => sub { die "set\n" },
134  );
135 };
136 is $@, '', 'creating a special functor with + rules doesn\'t croak';
137
138 eval { $seq->$special };
139 is $@, "set\n", 'special functor with + rules eats everything properly';
140
141 $special = eval {
142  Tikz->functor(
143   '+LaTeX::TikZ::Mod'       => sub { die "mod\n" },
144   '+LaTeX::TikZ::Set'       => sub { die "set\n" },
145   'LaTeX::TikZ::Set::Point' => sub { Tikz->point(7) },
146   'LaTeX::TikZ::Set::Path'  => sub { Tikz->raw('moo') },
147  );
148 };
149 is $@, '', 'creating a special functor with + and normal rules doesn\'t croak';
150
151 my $res = eval { Tikz->point(3, 4)->$special };
152 is $@, '', 'special functor with + and normal rules orders its rules properly';
153
154 check $res, 'the result of the special functor', <<'RES';
155 \draw (7cm,0cm) ;
156 RES
157
158 $res = eval { Tikz->raw('hlagh')->$special };
159 is $@, '',
160       'special functor with + and normal rules orders its rules properly again';
161
162 check $res, 'the result of the special functor', <<'RES';
163 \draw moo ;
164 RES
165
166 using eval {
167  Tikz->formatter(
168   origin => [ -1, 1 ],
169  );
170 };
171 is $@, '', 'creating a formatter object with an origin doesn\'t croak';
172
173 check $seq, 'a sequence translated by an origin', <<'RES';
174 \begin{scope}
175 \clip (-1cm,0cm) rectangle (1cm,4cm) ;
176 \draw (-1cm,1cm) ;
177 \draw foo ;
178 \draw (1cm,1cm) ;
179 \begin{scope}
180 \clip (0cm,1cm) circle (1cm) ;
181 \draw (-2cm,1cm) -- (2cm,1cm) ;
182 \end{scope}
183 \draw (3cm,1cm) -- (-4cm,3cm) (-2cm,1cm) -| (-1cm,2cm) ;
184 \end{scope}
185 RES