#! perl -slw ## This script will not run without the -s and -l options +. use strict; use GD; use File::Temp qw[ tempfile ]; our $H; + ## Usage our $VERBOSE; + ## Produce informative messages our $TYPE; + ## Output filetype (defaults to same as input) our $NOPROMPT; + ## Prompt for confirmation unless overridden our $NODUMP; + ## Dump colors if no swaps supplied our $NOPREVIEW; + ## Display modifed image before commiting our $QUALITY; + ## Output image quality ## .png => 0..9 Best quality (lowest compression) .. Worst quality (h +ighest compression) ## .JPG => 0 .. 100 Worst quality (highest compression) .. Best quali +ty (lowest compression) ## .gif => No effect. $QUALITY = -1 unless defined $QUALITY; + ## Used glib compiled in defaults our $MORE ||= $ENV{MORE} || 'more'; + ## Program used to page dump output our $NEAR ||= 0; + ## Use closestColor if exact match not found sub rgb2n{ unpack 'N', pack 'CCCC', 0, @_ } + ## 3-byte RGB to 24-bit integer sub n2rgb{ unpack 'xCCC', pack 'N', $_[0] } + ## 24-bit int to 3-byte rgb my %methods = ( + ## Could be extended to the other GD supported types png => \&GD::Image::png, jpg => \&GD::Image::jpeg, jpeg => \&GD::Image::jpeg, gif => \&GD::Image::gif, ); print <<USAGE and exit if $H or not @ARGV; usage: $0 [-H] [-DUMP[=0]] [-NEAR] [-PRE] [-TYPE=<jpg|png|gif>] file [ +<color pair> ... ] where: -H gives this message and exits -VERBOSE produces some informational messages -NODUMP Inhibits the dumping of the colors (palette) if no color p +airs are supplied. -NEAR replaces the nearest color found to the first of each pair + with the second (default:off) -NOPROMPT inhibits prompting for confirmation of modifications -NOPREVIEW inhibits the modified file from being previewed by display +ing it in your associate image viewer -TYPE=<png|jpg|gif> specifies the output type for modified image. defaults to the same as the input type, or png if the inpu +t type is unrecognised. file the path/name of the mage to be modified <color pair> ... are pairs of color values. The first is looked for and if +found, replaced by the second. The colors can be specified in several ways: 0xhhhhhh 0xhhhhhh xhhhhhh xhhhhhh ddd:ddd:ddd d:d:d The different styles can be intermixed. USAGE ##Get filename and load image my $file = shift @ARGV; GD::Image->trueColor( 1 ); + ## Start off allowing trueColor images my $img = GD::Image->new( $file ) or die "Couldn't load image from $file: $!"; my( $typeIn ) = $file =~ m[\.(.+$)]; my( $typeOut ) = $TYPE || $typeIn; + ## Output same image type as input unless overridden $VERBOSE && print "Outputting type:$typeOut"; my $outputMethod = $methods{ lc $typeOut } + ## Select appropriate output method || die "Unrecognised filetype $typeOut"; ## If colorsTotal return true, it seems to indicate that the original ## file was palletised. So reload the file having turned it off to avo +id ## conversion of the modifed output ## Is this reliable? (Seems to be!) Is there a better way? if( $img->colorsTotal ) { GD::Image->trueColor( 0 ); + ## Reload without trueColor set my $img = GD::Image->new( $file ) or die "Couldn't load image from $file: $!"; } ## Successfully opened the file so look for color swaps my %swaps = map{ $_ = hex if m[^0?x]; + ## Allow hex xhhhhhh or 0xhhhhhh input $_ = rgb2n( m[^(\d+):(\d+):(\d+)$] ) if m[:]; + ## Or rgb ddd:ddd:ddd $_; } @ARGV; ## Different processing required for palletised and truecolor images unless( $img->trueColor ) { + ## palletised open MORE, "| $MORE" or die $!; #*MORE = *STDOUT; printf MORE "Image is %d x %d, and has %d colors in it's palette\n +", $img->getBounds, $img->colorsTotal; if( not %swaps ) { + ## Dump pallete if no swaps specified die "No swap colors specified" if $NODUMP; + ## and dump not overridden print MORE "No swap colours specified; dumping palette"; printf MORE "%d: rgb(%3d:%3d:%3d) 0x%06x\n", $_, $img->rgb( $_ ), rgb2n( $img->rgb( $_ ) ) for 0 .. $img->colorsTotal - 1; exit; } close MORE; my $transIndex = $img->transparent; + ## Save transparent index $img->transparent( -1 ) if 1+$transIndex; + ## And remove it as it inhibits matching for my $color ( keys %swaps ) { my $index = $img->colorExact( n2rgb( $color ) ); + ## Try for an exact match if( 1+$index + ## If we found one or $NEAR and 1+( $index = $img->colorClosest( n2rgb( $color ) + ) ) ## or asked for near and we got a close match ){ $img->colorDeallocate( $index ); + ## Do the swap 1+$img->colorAllocate( n2rgb( $swaps{ $color } ) ) or die sprintf "Failed to reallocate 0x%06x to 0x%06x\ +n", $color, $swaps{ $color }; } else { warn sprintf "Couldn't match color 0x%06x\n", $color; } } $img->transparent( $transIndex ); + ## Reset transparency (if required ) } else { + ## 24-bit open MORE, "| $MORE" or die $!; #*MORE = *STDOUT; printf MORE "Image is %d x %d, 24 bpp\n", $img->getBounds; my $gd = $img->gd; + ## gd format is easiest to manipulate my( $sig, $x, $y, $true, $transparent ) = unpack 'nnncN', $gd; + ## Extract some info my %colors; push @{ $colors{ unpack 'N', substr $gd, 11+( 4 * $_ ), 4 } }, $_ + ## Find, count and remember the colors for 0 .. ( $x * $y )-1; + ## Could blow memory for very large images! printf MORE "Contains %d unique colors\n", scalar keys %colors; if( not %swaps ) { + ## Dump the colors? die "No swaps specified" if $NODUMP; print MORE "No swap colours specified; dumping palette"; printf MORE "rgb(%3d:%3d:%3d) 0x%06x\n", $img->rgb( $_ ), rgb2n( $img->rgb( $_ ) ) for sort{ $a<=>$b } keys %colors; exit; } close MORE; for my $color ( keys %swaps ) { + ## Do the swaps if( exists $colors{ $color } ) { my $replacement = pack 'N', $swaps{ $color }; substr( $gd, 11 + ( $_ * 4 ), 4 ) = $replacement for @{ $colors{ $color } }; } else { warn sprintf "Couldn't match color 0x%06x\n", $color; } } $img = GD::Image->newFromGdData( $gd ); + ## Build a new image from the modified GD format data } my( $fh, $tempname ) = tempfile( 'TEMPXXXX', SUFFIX => ".$typeOut" ); + ## Create a temporary Image file binmode( $fh, ':raw' ); print $fh $img->$outputMethod( $QUALITY ); close $fh; system $tempname unless $NOPREVIEW; + ## Show them the changes printf "Enter Y<return> to make changes or anything else to abort:" unless $NOPROMPT; if( $NOPROMPT or <STDIN> =~ /^Y/i ) { + ## Backup and rename if( $typeIn eq $typeOut ) { if( rename $file, "$file.bak" ) { $VERBOSE && print "$file backed up to $file.bak"; } else { warn "Failed to create backup file '$file.bak': $!"; } } $file =~s[\..*$][.$typeOut] if $TYPE; if( rename $tempname, $file ) { $VERBOSE && print "Modified image written to $file"; } else { warn "Failed to rename $tempname to $file: $!" } } else { + ## or delete if( unlink $tempname ) { $VERBOSE and print "$tempname deleted; $file unchanged"; } else { warn "Couldn't delete tempfile $tempname: $!"; } }
In reply to Image color swapping with GD by BrowserUk
| For: | Use: | ||
| & | & | ||
| < | < | ||
| > | > | ||
| [ | [ | ||
| ] | ] |