1use Test::More tests => 6; 2 3use strict; 4use warnings; 5 6sub vars_ipv { 7 PDL::Dbg::vars() if $PDL::debug; 8} 9 10sub p { 11 print @_ if $PDL::debug; 12} 13 14use PDL::LiteF; 15use PDL::ImageRGB; 16use PDL::Dbg; 17 18$PDL::debug = 0; 19 20 21vars_ipv; 22 23{ 24 my $im = float [1,2,3,4,5]; 25 my $out = bytescl($im,100); 26 ok(all approx($im,$out)); 27 cmp_ok($out->get_datatype, '==', $PDL::Types::PDL_B); 28} 29 30{ 31 my $im = float [1,2,3,4,5]; 32 my $out = bytescl($im,-100); 33 ok(all approx(pdl([0,25,50,75,100]),$out)); 34 35 p "$out\n"; 36} 37 38{ 39 my $rgb = double [[1,1,1],[1,0.5,0.7],[0.1,0.2,0.1]]; 40 my $out = rgbtogr($rgb); 41 ok(all approx($out,pdl([1,0.67,0.16]), 0.01)); 42 cmp_ok($out->get_datatype, '==', $PDL::Types::PDL_D); 43 44 vars_ipv; 45 p $out; 46} 47 48{ 49 my $im = byte [[1,2,3],[0,3,0]]; 50 my $lut = byte [[0,0,0], 51 [10,1,10], 52 [2,20,20], 53 [30,30,3] 54 ]; 55 # do the interlacing the lengthy way 56 my $interl = zeroes(byte,3,$im->dims); 57 for my $i (0..($im->dims)[0]-1) { 58 for my $j (0..($im->dims)[1]-1) { 59 my $pos = $im->at($i,$j); 60 (my $tmp = $interl->slice(":,($i),($j)")) .= $lut->slice(":,($pos)"); 61 } 62 } 63 64 my $out = interlrgb($im,$lut); 65 vars_ipv; 66 p $out; 67 ok(all approx($out,$interl)); 68} 69