1#!/usr/local/bin/perl
2
3use strict;
4use warnings;
5use PDL;
6use Test::More;
7
8use PDL::Config;
9plan skip_all => "PDL::Transform::Proj4 module not compiled."
10    unless $PDL::Config{WITH_PROJ};
11eval { require PDL::Transform::Proj4; PDL::Transform::Proj4->import; };
12plan skip_all => "PDL::Transform::Proj4 module compiled, but not available."
13    if $@;
14plan skip_all => "PDL::Transform::Proj4 module requires the PDL::Bad module!"
15    unless $PDL::Bad::Status;
16plan tests => 20;
17
18# Test integration with PDL::Transform
19
20my $im = sequence(2048,1024)/2048/1024*255.99;
21$im = $im->byte;
22my $h = $im->fhdr;
23
24$h->{SIMPLE} = 'T';
25$h->{NAXIS} = 3;
26$h->{NAXIS1}=2048;          $h->{CRPIX1}=1024.5;    $h->{CRVAL1}=0;
27$h->{NAXIS2}=1024;          $h->{CRPIX2}=512.5;     $h->{CRVAL2}=0;
28$h->{NAXIS3}=3,             $h->{CRPIX3}=1;         $h->{CRVAL3}=0;
29$h->{CTYPE1}='Longitude';   $h->{CUNIT1}='degrees'; $h->{CDELT1}=180/1024.0;
30$h->{CTYPE2}='Latitude';    $h->{CUNIT2}='degrees'; $h->{CDELT2}=180/1024.0;
31$h->{CTYPE3}='RGB';         $h->{CUNIT3}='index';   $h->{CDELT3}=1.0;
32$h->{COMMENT}='Plate Caree Projection';
33$h->{HISTORY}='PDL Distribution Image, derived from NASA/MODIS data',
34
35$im->hdrcpy(1);
36$im->badflag(1);
37
38SKIP: {
39
40   my $map = $im->copy;
41
42   my $map_size = [500,500];
43
44   my @slices = (
45      "245:254,68:77,(0)",
46      "128:137,272:281,(0)",
47      "245:254,262:271,(0)",
48      "390:399,245:254,(0)",
49      "271:280,464:473,(0)"
50   );
51
52
53   ##############
54   # TESTS 1-5: #
55   ##############
56   # Get EQC reference data:
57   my @ref_eqc_slices = get_ref_eqc_slices();
58
59   # Check EQC map against reference:
60   my $eqc_opts = "+proj=eqc +lon_0=0 +datum=WGS84";
61   my $eqc = eval { $map->map( t_proj( proj_params => $eqc_opts ), $map_size ) };
62   if (! defined($eqc)) {
63      diag("PROJ4 error: $@\n");
64      skip "Possible bad PROJ4 install",20 if $@ =~ m/Projection initialization failed/;
65   }
66   foreach my $i ( 0 .. $#slices )
67   {
68      my $str = $slices[$i];
69      my $slice = $eqc->slice($str);
70      is( "$slice", $ref_eqc_slices[$i], "check ref_eqc for slices[$i]" );
71   }
72
73   ###############
74   # TESTS 6-10: #
75   ###############
76   # Get Ortho reference data:
77   my @ref_ortho_slices = get_ref_ortho_slices();
78
79   # Check Ortho map against reference:
80   my $ortho_opts = "+proj=ortho +ellps=WGS84 +lon_0=-90 +lat_0=40";
81   my $ortho = $map->map( t_proj( proj_params => $ortho_opts ), $map_size );
82   foreach my $i ( 0 .. $#slices )
83   {
84      my $str = $slices[$i];
85      my $slice = $ortho->slice($str);
86      is( "$slice", $ref_ortho_slices[$i], "check ref_ortho for slices[$i]" );
87   }
88
89   #
90   # Test the auto-generated methods:
91   #
92   ################
93   # TESTS 11-15: #
94   ################
95   my $ortho2 = $map->map( t_proj_ortho( ellps => 'WGS84', lon_0 => -90, lat_0 => 40 ), $map_size );
96   foreach my $i ( 0 .. $#slices )
97   {
98      my $str = $slices[$i];
99      my $slice = $ortho2->slice($str);
100      is( "$slice", $ref_ortho_slices[$i], "check ref_ortho2 for slices[$i]" );
101   }
102
103   ################
104   # TESTS 16-20: #
105   ################
106   # Get Robinson reference data:
107   my @ref_robin_slices = get_ref_robin_slices();
108
109   # Check Robinson map against reference:
110   my $robin = $map->map( t_proj_robin( ellps => 'WGS84', over => 1 ), $map_size );
111   foreach my $i ( 0 .. $#slices )
112   {
113      my $str = $slices[$i];
114      my $slice = $robin->slice($str);
115      is( "$slice", $ref_robin_slices[$i], "check ref_robin for slices[$i]" );
116   }
117
118}
119
120sub get_ref_robin_slices {
121    my @slices = ();
122    push(@slices, <<"END");
123
124[
125 [43 43 43 43 43 43 43 43 43 43]
126 [44 44 44 44 44 44 44 44 44 44]
127 [44 44 44 44 44 44 44 44 44 44]
128 [45 45 45 45 45 45 45 45 45 45]
129 [45 45 45 45 45 45 45 45 45 45]
130 [46 46 46 46 46 46 46 46 46 46]
131 [46 46 46 46 46 46 46 46 46 46]
132 [47 47 47 47 47 47 47 47 47 47]
133 [47 47 47 47 47 47 47 47 47 47]
134 [48 48 48 48 48 48 48 48 48 48]
135]
136END
137    push(@slices, <<"END");
138
139[
140 [138 138 138 138 138 138 138 138 138 138]
141 [138 138 138 138 138 138 138 138 138 138]
142 [139 139 139 139 139 139 139 139 139 139]
143 [139 139 139 139 139 139 139 139 139 139]
144 [140 140 140 140 140 140 140 140 140 140]
145 [140 140 140 140 140 140 140 140 140 140]
146 [141 141 141 141 141 141 141 141 141 141]
147 [141 141 141 141 141 141 141 141 141 141]
148 [141 141 141 141 141 141 141 141 141 141]
149 [142 142 142 142 142 142 142 142 142 142]
150]
151END
152    push(@slices, <<"END");
153
154[
155 [133 133 133 133 133 133 133 133 133 133]
156 [134 134 134 134 134 134 134 134 134 134]
157 [134 134 134 134 134 134 134 134 134 134]
158 [135 135 135 135 135 135 135 135 135 135]
159 [135 135 135 135 135 135 135 135 135 135]
160 [136 136 136 136 136 136 136 136 136 136]
161 [136 136 136 136 136 136 136 136 136 136]
162 [136 136 136 136 136 136 136 136 136 136]
163 [137 137 137 137 137 137 137 137 137 137]
164 [137 137 137 137 137 137 137 137 137 137]
165]
166END
167    push(@slices, <<"END");
168
169[
170 [125 125 125 125 125 125 125 125 125 125]
171 [126 126 126 126 126 126 126 126 126 126]
172 [126 126 126 126 126 126 126 126 126 126]
173 [127 127 127 127 127 127 127 127 127 127]
174 [127 127 127 127 127 127 127 127 127 127]
175 [128 128 128 128 128 128 128 128 128 128]
176 [128 128 128 128 128 128 128 128 128 128]
177 [129 129 129 129 129 129 129 129 129 129]
178 [129 129 129 129 129 129 129 129 129 129]
179 [130 130 130 130 130 130 130 130 130 130]
180]
181END
182    push(@slices, <<"END");
183
184[
185 [229 229 229 229 229 229 229 229 229 229]
186 [230 230 230 230 230 230 230 230 230 230]
187 [230 230 230 230 230 230 230 230 230 230]
188 [231 231 231 231 231 231 231 231 231 231]
189 [231 231 231 231 231 231 231 231 231 231]
190 [232 232 232 232 232 232 232 232 232 232]
191 [232 232 232 232 232 232 232 232 232 232]
192 [233 233 233 233 233 233 233 233 233 233]
193 [234 234 234 234 234 234 234 234 234 234]
194 [234 234 234 234 234 234 234 234 234 234]
195]
196END
197    return @slices;
198}
199
200sub get_ref_ortho_slices {
201    my @slices = ();
202    push(@slices, <<"END");
203
204[
205 [118 118 118 118 118 118 118 118 118 118]
206 [119 119 119 119 119 119 119 119 119 119]
207 [119 119 119 119 119 119 119 119 119 119]
208 [120 120 120 120 120 120 120 120 120 120]
209 [120 120 120 120 120 120 120 120 120 120]
210 [121 121 121 121 121 121 121 121 121 121]
211 [121 121 121 121 121 121 121 121 121 121]
212 [121 121 121 121 121 121 121 121 121 121]
213 [122 122 122 122 122 122 122 122 122 122]
214 [122 122 122 122 122 122 122 122 122 122]
215]
216END
217    push(@slices, <<"END");
218
219[
220 [183 183 183 183 183 184 184 184 184 184]
221 [183 183 183 184 184 184 184 184 184 184]
222 [183 184 184 184 184 184 184 184 185 185]
223 [184 184 184 184 184 184 185 185 185 185]
224 [184 184 184 184 185 185 185 185 185 185]
225 [184 184 185 185 185 185 185 185 185 186]
226 [185 185 185 185 185 185 185 186 186 186]
227 [185 185 185 185 185 186 186 186 186 186]
228 [185 185 185 186 186 186 186 186 186 186]
229 [185 186 186 186 186 186 186 186 187 187]
230]
231END
232    push(@slices, <<"END");
233
234[
235 [188 188 188 188 188 188 188 188 188 188]
236 [189 189 189 189 189 189 189 189 189 189]
237 [189 189 189 189 189 189 189 189 189 189]
238 [189 189 189 189 189 189 189 189 189 189]
239 [190 190 190 190 190 190 190 190 190 190]
240 [190 190 190 190 190 190 190 190 190 190]
241 [190 190 190 190 190 190 190 190 190 190]
242 [191 191 191 191 191 191 191 191 191 191]
243 [191 191 191 191 191 191 191 191 191 191]
244 [191 191 191 191 191 191 191 191 191 191]
245]
246END
247    push(@slices, <<"END");
248
249[
250 [172 172 172 171 171 171 171 171 170 170]
251 [172 172 172 172 171 171 171 171 171 171]
252 [172 172 172 172 172 172 171 171 171 171]
253 [173 173 172 172 172 172 172 172 171 171]
254 [173 173 173 173 172 172 172 172 172 171]
255 [173 173 173 173 173 172 172 172 172 172]
256 [174 173 173 173 173 173 173 172 172 172]
257 [174 174 174 173 173 173 173 173 173 172]
258 [174 174 174 174 174 173 173 173 173 173]
259 [175 174 174 174 174 174 173 173 173 173]
260]
261END
262    push(@slices, <<"END");
263
264[
265 [240 240 240 240 240 239 239 239 239 238]
266 [240 240 239 239 239 239 239 238 238 238]
267 [239 239 239 239 238 238 238 238 238 237]
268 [239 238 238 238 238 238 237 237 237 237]
269 [238 238 238 237 237 237 237 237 236 236]
270 [237 237 237 237 237 236 236 236 236 236]
271 [237 237 236 236 236 236 236 235 235 235]
272 [236 236 236 236 235 235 235 235 234 234]
273 [235 235 235 235 235 234 234 234 234 234]
274 [235 235 234 234 234 234 234 233 233 233]
275]
276END
277    return @slices;
278}
279
280sub get_ref_eqc_slices {
281    my @slices = ();
282    push(@slices, <<"END");
283
284[
285 [35 35 35 35 35 35 35 35 35 35]
286 [35 35 35 35 35 35 35 35 35 35]
287 [36 36 36 36 36 36 36 36 36 36]
288 [36 36 36 36 36 36 36 36 36 36]
289 [37 37 37 37 37 37 37 37 37 37]
290 [37 37 37 37 37 37 37 37 37 37]
291 [38 38 38 38 38 38 38 38 38 38]
292 [38 38 38 38 38 38 38 38 38 38]
293 [39 39 39 39 39 39 39 39 39 39]
294 [39 39 39 39 39 39 39 39 39 39]
295]
296END
297    push(@slices, <<"END");
298
299[
300 [139 139 139 139 139 139 139 139 139 139]
301 [140 140 140 140 140 140 140 140 140 140]
302 [140 140 140 140 140 140 140 140 140 140]
303 [141 141 141 141 141 141 141 141 141 141]
304 [141 141 141 141 141 141 141 141 141 141]
305 [142 142 142 142 142 142 142 142 142 142]
306 [142 142 142 142 142 142 142 142 142 142]
307 [143 143 143 143 143 143 143 143 143 143]
308 [143 143 143 143 143 143 143 143 143 143]
309 [144 144 144 144 144 144 144 144 144 144]
310]
311END
312    push(@slices, <<"END");
313
314[
315 [134 134 134 134 134 134 134 134 134 134]
316 [134 134 134 134 134 134 134 134 134 134]
317 [135 135 135 135 135 135 135 135 135 135]
318 [135 135 135 135 135 135 135 135 135 135]
319 [136 136 136 136 136 136 136 136 136 136]
320 [136 136 136 136 136 136 136 136 136 136]
321 [137 137 137 137 137 137 137 137 137 137]
322 [137 137 137 137 137 137 137 137 137 137]
323 [138 138 138 138 138 138 138 138 138 138]
324 [139 139 139 139 139 139 139 139 139 139]
325]
326END
327    push(@slices, <<"END");
328
329[
330 [125 125 125 125 125 125 125 125 125 125]
331 [126 126 126 126 126 126 126 126 126 126]
332 [126 126 126 126 126 126 126 126 126 126]
333 [127 127 127 127 127 127 127 127 127 127]
334 [127 127 127 127 127 127 127 127 127 127]
335 [128 128 128 128 128 128 128 128 128 128]
336 [128 128 128 128 128 128 128 128 128 128]
337 [129 129 129 129 129 129 129 129 129 129]
338 [129 129 129 129 129 129 129 129 129 129]
339 [130 130 130 130 130 130 130 130 130 130]
340]
341END
342    push(@slices, <<"END");
343
344[
345 [237 237 237 237 237 237 237 237 237 237]
346 [238 238 238 238 238 238 238 238 238 238]
347 [238 238 238 238 238 238 238 238 238 238]
348 [239 239 239 239 239 239 239 239 239 239]
349 [239 239 239 239 239 239 239 239 239 239]
350 [240 240 240 240 240 240 240 240 240 240]
351 [240 240 240 240 240 240 240 240 240 240]
352 [241 241 241 241 241 241 241 241 241 241]
353 [241 241 241 241 241 241 241 241 241 241]
354 [242 242 242 242 242 242 242 242 242 242]
355]
356END
357    return @slices;
358}
359