]> git.vpit.fr Git - perl/modules/LaTeX-TikZ.git/blob - t/30-functor.t
e455a9d6e1a59bdd73168c6e15257afa0d52097f
[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 => 10 + 2 * 7;
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 $strip = eval {
82  Tikz->functor(
83   '+LaTeX::TikZ::Mod' => sub { return },
84  );
85 };
86 is $@, '', 'creating a stripper doesn\'t croak';
87
88 $_->mod(Tikz->color('red')) for $seq2->kids;
89
90 my $seq3 = eval {
91  $seq2->$strip;
92 };
93 is $@, '', 'stripping a sequence doesn\'t croak';
94
95 check $seq2, 'the original sequence', <<'RES';
96 \begin{scope} [color=red]
97 \clip (-1cm,0cm) rectangle (1cm,4cm) ;
98 \draw (-1cm,1cm) ;
99 \draw foo ;
100 \draw (1cm,1cm) ;
101 \begin{scope}
102 \clip (0cm,1cm) circle (1cm) ;
103 \draw (-2cm,1cm) -- (2cm,1cm) ;
104 \end{scope}
105 \draw (3cm,1cm) -- (-4cm,3cm) (-2cm,1cm) -| (-1cm,2cm) ;
106 \end{scope}
107 RES
108
109 check $seq3, 'the stripped sequence', <<'RES';
110 \draw (-1cm,1cm) ;
111 \draw foo ;
112 \draw (1cm,1cm) ;
113 \draw (-2cm,1cm) -- (2cm,1cm) ;
114 \draw (3cm,1cm) -- (-4cm,3cm) (-2cm,1cm) -| (-1cm,2cm) ;
115 RES
116
117 my $special = eval {
118  Tikz->functor(
119   '+LaTeX::TikZ::Mod' => sub { die "mod\n" },
120   '+LaTeX::TikZ::Set' => sub { die "set\n" },
121  );
122 };
123 is $@, '', 'creating a special functor with + rules doesn\'t croak';
124
125 eval { $seq->$special };
126 is $@, "set\n", 'special functor with + rules eats everything properly';
127
128 $special = eval {
129  Tikz->functor(
130   '+LaTeX::TikZ::Mod'       => sub { die "mod\n" },
131   '+LaTeX::TikZ::Set'       => sub { die "set\n" },
132   'LaTeX::TikZ::Set::Point' => sub { Tikz->point(7) },
133   'LaTeX::TikZ::Set::Path'  => sub { Tikz->raw('moo') },
134  );
135 };
136 is $@, '', 'creating a special functor with + and normal rules doesn\'t croak';
137
138 my $res = eval { Tikz->point(3, 4)->$special };
139 is $@, '', 'special functor with + and normal rules orders its rules properly';
140
141 check $res, 'the result of the special functor', <<'RES';
142 \draw (7cm,0cm) ;
143 RES
144
145 $res = eval { Tikz->raw('hlagh')->$special };
146 is $@, '',
147       'special functor with + and normal rules orders its rules properly again';
148
149 check $res, 'the result of the special functor', <<'RES';
150 \draw moo ;
151 RES
152
153 using eval {
154  Tikz->formatter(
155   origin => [ -1, 1 ],
156  );
157 };
158 is $@, '', 'creating a formatter object with an origin doesn\'t croak';
159
160 check $seq, 'a sequence translated by an origin', <<'RES';
161 \begin{scope}
162 \clip (-1cm,0cm) rectangle (1cm,4cm) ;
163 \draw (-1cm,1cm) ;
164 \draw foo ;
165 \draw (1cm,1cm) ;
166 \begin{scope}
167 \clip (0cm,1cm) circle (1cm) ;
168 \draw (-2cm,1cm) -- (2cm,1cm) ;
169 \end{scope}
170 \draw (3cm,1cm) -- (-4cm,3cm) (-2cm,1cm) -| (-1cm,2cm) ;
171 \end{scope}
172 RES