Beefy Boxes and Bandwidth Generously Provided by pair Networks
Clear questions and runnable code
get the best and fastest answer
 
PerlMonks  

Re: working with png data

by vr (Deacon)
on Sep 09, 2019 at 16:19 UTC ( #11105889=note: print w/replies, xml ) Need Help??


in reply to working with png data

Are you sure you need to extract all possible colors into that @col? There can be up to 2**24 of them in a PNG... A couple alternatives to mask areas with both R and B not more than 128 (if I'm reading your code and guessing your intent correctly):

use strict; use warnings; use feature 'say'; use Data::Dump 'dd'; use PDL; use PDL::NiceSlice; use PDL::IO::Image; #system 'convert rose: -resize 50% rose.png'; my $image = PDL::IO::Image-> new_from_file('rose.png') -> pixels_to_pdl; my $mask = ($image(,,(0)) <= 128) & ($image(,,(2)) <= 128); print $mask; __END__ [ [1 1 1 1 1 1 1 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 0 0 1 1 +1] [1 1 1 1 1 1 1 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 0 1 1 +1] [1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 0 0 0 0 0 1 0 0 0 0 1 1 1 1 1 1 0 0 0 +1] [1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 0 0 1 1 0 1 1 0 0 1 1 1 1 1 1 1 1 1 +1] [1 1 1 1 1 1 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 1 1 0 0 0 +1] [1 1 1 1 1 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 +0] [1 1 1 1 0 0 0 1 1 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 +0] [1 1 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 +0] [1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 +0] [1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 1 0 +0] [1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 1 0 +0] [1 1 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 +1] [1 1 1 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 +1] [1 1 1 0 0 0 0 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 0 1 1 1 +1] [1 1 1 0 0 0 0 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 0 1 1 1 1 +1] [1 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 +1] [1 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 1 1 1 1 1 1 1 +1] [1 1 1 1 1 1 1 1 1 0 0 0 0 0 0 0 1 0 1 1 0 0 1 1 1 0 0 1 1 1 1 1 1 1 +1] [1 1 1 1 1 1 0 0 1 1 1 0 0 0 0 0 0 0 1 1 1 1 1 1 1 0 1 1 1 1 1 1 1 1 +1] [1 1 1 1 1 0 0 0 0 1 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 +1] [1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 +1] [1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 +1] [1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 +1] ]

Or using Imager:

use strict; use warnings; use feature 'say'; use Data::Dump 'dd'; use Imager; my $i = Imager-> new( file => 'rose.png' ); my $w = $i-> getwidth; my $m = Imager::transform2( { rpnexpr => << 'END' x y getp1 !pix @pix red 128 le @pix blue 128 le and 255 0 if 0 0 rgb END }, $i )-> convert( preset => 'red' ); $m-> write( data => \my $data, type => 'raw' ); $data =~ tr/\0\377/01/; say for unpack "(a$w)*", $data; __END__ 11111111111111000000000011111100111 11111111111111000000000011111110111 11111111111111100000100001111110001 11111111111111110011011001111111111 11111111111110000000010000000110001 11111111111100000000000000000000000 11110001111000000000000000000000000 11110000000000000000000000000000000 11111000000000000000000000000000000 11111100000000000000000000000011100 11111100000000000000000000000010100 11110000000000000000000000000111111 11100000100000000000000000000111111 11100001100000000000000000001101111 11100001100000000000000000011011111 11111111000000000000000000011111111 11111111000000000000000010011111111 11111111100000001011001110011111111 11111100111000000011111110111111111 11111000010000000111111111111111111 11111000000000000111111111111111111 11111000000000000111111111111111111 11111000000000000011111111111111111

Here RPN DSL (described to compile to very fast code) is used to compute result and put it into red channel, which then is extracted to a one channel image. Last 3 lines are there to produce demo output only.

Both results match of course, but dump of your @sw is different. Either I misread your code, or it has problems (it emits warnings, by the way), I didn't investigate.

Replies are listed 'Best First'.
Re^2: working with png data
by Anonymous Monk on Sep 10, 2019 at 19:49 UTC

    Thanks for your answer ! Imager and PDL are nice modules. I did not know them up to now. Really worth to invest some time.

    It took me a while to install Imager. The problem was that the libpng was missing ..... But now its running.

    $data =~ tr/\0\377/01/;

    can be removed, if the ascii code is already used in the "if" of transform2:

    49 48 if

    I could not manage to install PDL yet. Prerequisite 'Module::Compile' is not passing for WIN 10 (report). Only one test is failing.(data1_t). Any idea what I could do here ? Force install ?

    I saw also minor differences in the output of my code and yours. I guess that the decoding of the PNG is done minor differently in the different modules. I have to read more about png coding if this idea can be true or compare the color at some dedicated pixels.

      The decoding is more different than I thought:

      use warnings; use strict; use GD::Simple; use Imager; $\="\n"; my @txt; $txt[0]=" GD::Simple <=> Imager"; my ($x1,$x2,$y)=(1375,1395,29); print "Line $y: Pixel $x1->$x2 "; my $png = GD::Image->newFromPng('test.png'); my ($width, $height) = $png->getBounds; print "GD::Simple Image dimensions: height = $height, width = $width"; for my $x ( $x1 .. $x2 ) { my @c=$png->rgb($png->getPixel($x,$y)); push (@txt,sprintf("%4d: [%3d,%3d,%3d]",$x,@c)); } my $i = Imager-> new; $i->read(file => 'test.png') or die "Cannot read: ", $i->errstr; $width = $i->getwidth(); $height = $i->getheight(); print "Imager Image dimensions: height = $height, width = $width\n +"; for my $x ( $x1 .. $x2 ) { my $color = $i->getpixel( x => $x, y => $y ); my ( $r, $g, $b,$a ) = $color->rgba(); $txt[$x-$x1+1].=sprintf(" <=> %4d: [%3d,%3d,%3d]",$x,$r,$g,$b); } print $_ foreach @txt;
      The output for my example is:
      Line 29: Pixel 1375->1395 GD::Simple Image dimensions: height = 2560, width = 1600 Imager Image dimensions: height = 2560, width = 1600 GD::Simple <=> Imager 1375: [ 4, 2, 4] <=> 1375: [ 1, 1, 1] 1376: [ 4, 2, 4] <=> 1376: [ 1, 1, 1] 1377: [ 4, 2, 4] <=> 1377: [ 1, 1, 1] 1378: [ 4, 2, 4] <=> 1378: [ 1, 1, 1] 1379: [ 12, 13, 12] <=> 1379: [ 11, 11, 11] 1380: [ 28, 28, 28] <=> 1380: [ 31, 31, 31] 1381: [ 68, 68, 68] <=> 1381: [ 61, 61, 61] 1382: [100,100,100] <=> 1382: [100,100,100] 1383: [100,100,100] <=> 1383: [102,102,102] 1384: [ 68, 68, 68] <=> 1384: [ 68, 68, 68] 1385: [ 52, 52, 52] <=> 1385: [ 48, 48, 48] 1386: [ 36, 34, 36] <=> 1386: [ 40, 40, 40] 1387: [ 36, 34, 36] <=> 1387: [ 33, 33, 33] 1388: [ 20, 26, 28] <=> 1388: [ 26, 26, 26] 1389: [ 20, 20, 20] <=> 1389: [ 20, 20, 20] 1390: [ 12, 13, 12] <=> 1390: [ 14, 14, 14] 1391: [ 4, 10, 12] <=> 1391: [ 9, 9, 9] 1392: [ 4, 6, 4] <=> 1392: [ 6, 6, 6] 1393: [ 4, 2, 4] <=> 1393: [ 4, 4, 4] 1394: [ 4, 2, 4] <=> 1394: [ 2, 2, 2] 1395: [ 4, 2, 4] <=> 1395: [ 1, 1, 1]

        I could not manage to install PDL yet. Prerequisite 'Module::Compile' is not passing for WIN 10 (report). Only one test is failing.(data1_t). Any idea what I could do here ? Force install ?

        I've never tried to compile PDL from source on Windows. Try Strawberry Perl PDL edition. PDL::IO::Image still needs to be installed from CPAN though.

        The decoding is more different than I thought

        GD documentation is misleading -- without forcing an image to remain true color, it's appears to be palettized on open:

        use strict; use warnings; use GD; use Imager; system 'convert rose: -resize 50% rose.png'; for my $force_true_color ( 0, 1 ) { my $png = GD::Image-> newFromPng( 'rose.png', $force_true_color ); print "GD, \$force_true_color is $force_true_color:\n"; for my $y ( 0 .. 4 ) { for my $x ( 0 .. 4 ) { my @c = $png-> rgb( $png-> getPixel( $x, $y )); print join '/', @c; print "\t"; } print "\n"; } print "\n"; } my $i = Imager-> new( file => 'rose.png' ); print "Imager:\n"; for my $y ( 0 .. 4 ) { for my $x ( 0 .. 4 ) { my @c = $i-> getpixel( x => $x, y => $y )-> rgba; pop @c; print join '/', @c; print "\t"; } print "\n"; } print "\n"; system 'convert rose.png -crop 5x5+0+0 txt:-'; __END__ GD, $force_true_color is 0: 52/48/45 52/48/45 60/50/46 52/48/45 60/50/ +46 44/48/44 44/48/44 52/40/40 44/41/44 52/48/ +45 44/48/44 44/48/44 52/48/45 44/41/44 44/41/ +44 52/55/45 60/56/50 60/56/50 60/50/46 52/48/ +45 60/56/50 60/62/68 68/68/52 76/66/53 68/60/ +51 GD, $force_true_color is 1: 48/47/45 54/50/46 57/49/44 56/48/45 56/49/ +45 44/45/46 47/45/43 48/43/40 46/43/43 49/44/ +43 45/47/47 47/47/46 48/45/42 44/41/41 42/41/ +43 53/54/47 57/56/50 62/56/52 59/52/48 54/51/ +51 56/57/51 64/63/57 70/66/62 72/67/60 70/59/ +47 Imager: 48/47/45 54/50/46 57/49/44 56/48/45 56/49/ +45 44/45/46 47/45/43 48/43/40 46/43/43 49/44/ +43 45/47/47 47/47/46 48/45/42 44/41/41 42/41/ +43 53/54/47 57/56/50 62/56/52 59/52/48 54/51/ +51 56/57/51 64/63/57 70/66/62 72/67/60 70/59/ +47 # ImageMagick pixel enumeration: 5,5,255,srgb 0,0: (48,47,45) #302F2D srgb(48,47,45) 1,0: (54,50,46) #36322E srgb(54,50,46) 2,0: (57,49,44) #39312C srgb(57,49,44) 3,0: (56,48,45) #38302D srgb(56,48,45) 4,0: (56,49,45) #38312D srgb(56,49,45) 0,1: (44,45,46) #2C2D2E srgb(44,45,46) 1,1: (47,45,43) #2F2D2B srgb(47,45,43) 2,1: (48,43,40) #302B28 srgb(48,43,40) 3,1: (46,43,43) #2E2B2B srgb(46,43,43) 4,1: (49,44,43) #312C2B srgb(49,44,43) 0,2: (45,47,47) #2D2F2F srgb(45,47,47) 1,2: (47,47,46) #2F2F2E srgb(47,47,46) 2,2: (48,45,42) #302D2A srgb(48,45,42) 3,2: (44,41,41) #2C2929 srgb(44,41,41) 4,2: (42,41,43) #2A292B srgb(42,41,43) 0,3: (53,54,47) #35362F srgb(53,54,47) 1,3: (57,56,50) #393832 srgb(57,56,50) 2,3: (62,56,52) #3E3834 srgb(62,56,52) 3,3: (59,52,48) #3B3430 srgb(59,52,48) 4,3: (54,51,51) #363333 srgb(54,51,51) 0,4: (56,57,51) #383933 srgb(56,57,51) 1,4: (64,63,57) #403F39 srgb(64,63,57) 2,4: (70,66,62) #46423E srgb(70,66,62) 3,4: (72,67,60) #48433C srgb(72,67,60) 4,4: (70,59,47) #463B2F srgb(70,59,47)

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://11105889]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others surveying the Monastery: (6)
As of 2019-11-13 04:39 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    Strict and warnings: which comes first?



    Results (68 votes). Check out past polls.

    Notices?