#!/usr/bin/perl ############################################################################ ### May be used or extended under the LGPL license ### ############################################################################ ### Copyright(c) Fred P. 1998-2003 - All rights reserved. ### ############################################################################ ### Version 2.0 - Fred - Build 14 may 2003 ### ############################################################################ ### ### ### PNG2SVG : Transformation using vertically linear pixelization ### ### ### ############################################################################ ### Single file: ### ############################################################################ ### zero compression ### ### C:\> bmp2png -0 file.bmp ### ### C:\> perl png2svg.pl file.png HEADER ### ### ### ############################################################################ ### Batch file: ### ############################################################################ ### zero compression ### ### C:\> bmp2png -0 file1.bmp ### ### C:\> perl png2svg.pl file1.png HEADER ### ### C:\> bmp2png -0 file2.bmp ### ### C:\> perl png2svg.pl file2.png ### ### C:\> bmp2png -0 file3.bmp ### ### C:\> perl png2svg.pl file3.png ### ### C:\> copy /b file1.svg+file2.svg+file3.svg fileall.svg ### ### ### ############################################################################ ### ### ### Require bmp2png tool: ### ### http://pmt.sourceforge.net/bmp2png/ ### ### ### ############################################################################ ### ### ### Require ActiveState ActivePerl 5.6.0 ### ### with GD package ### ### ### ### C:\> ppm ### ### install GD ### ### y ### ### exit ### ### ### ############################################################################ use strict; ############################################################################ ### Package usage definition: ### ############################################################################ use GD; #use GD::Image; use Data::Dumper; ############################################################################ # http://search.cpan.org/author/JHI/perl-5.8.0/ext/Data/Dumper/Dumper.pm # ############################################################################ $Data::Dumper::Terse = 1; $Data::Dumper::Deepcopy = 1; #$Data::Dumper::Sortkeys = 1; ############################################################################ ### Global variables definitions ### ############################################################################ use vars qw/ $name $file $file_png $file_svg $bg $image @pixel $width $height @data @rect $x $y $x1 $x2 $y1 $y2 $WANT_HEADER /; ############################################################################ ### Skipping header for batch icons ### ############################################################################ $WANT_HEADER = 0; ############################################################################ ### Add space for formatting purposes ### ############################################################################ sub add_space( $$ ) { my $string = $_[0]; my $wanted = $_[1]; my $len = length( $string ); my $sp = ""; for( my $i = $len; $i < $wanted; $i++ ) { $sp .= " "; } return $sp . $string; } ############################################################################ ### Open and create a new SVG file for output ### ############################################################################ sub openSVG() { open (SVG, "> $file_svg" ) || die; if ( $WANT_HEADER ) { print SVG < EOF } } ############################################################################ ### Close SVG output file ### ############################################################################ sub closeSVG() { if ( $WANT_HEADER ) { print SVG < EOF my $x = 0; my $y = 0; for my $k ( 0 .. $#data ) { print SVG " \n"; $y += 30; } print SVG < EOF } close SVG; } ############################################################################ ### Read PNG image file ### ############################################################################ sub readPNG() { $file_png =~ /(\.png)\s*$/i; $file = $`; $file_svg = $file . '.svg'; $file =~ /([^\/\\]+)$/i; $file = $1; $name = $file; $name =~ s/btn_//gi; print "Object: $file\n"; print "PNG file: $file_png\n"; print "SVG file: $file_svg\n"; open (PNG, $file_png ) || die; binmode PNG; $image = newFromPng GD::Image(\*PNG) || die; close PNG; ($width,$height) = $image->getBounds(); } ############################################################################ ### Retrieve a specific (X,Y) pixel RGB color in HEX web format ### ############################################################################ sub getPixel( $$ ) { my ( $x, $y ) = @_; my ($red,$green,$blue) = $image->rgb( $image->getPixel($x,$y) ); my $hr = sprintf("%.2X", $red ); my $hg = sprintf("%.2X", $green); my $hb = sprintf("%.2X", $blue ); my $h = '#'.$hr.$hg.$hb; return $h; } ############################################################################ ### Retrieve (X,Y) matrix of RGB color in HEX web format ### ############################################################################ sub getMatrix() { my $g; my $prev = undef; my $start_y = 0; my $end_y = 0; $x1 = $width; $y1 = $height; $x2 = 0; $y2 = 0; push @data, $name; print SVG " \n"; for $x ( 0 .. $width-1 ) { for $y ( 0 .. $height-1 ) { my $rgb = getPixel( $x, $y ); $pixel[$x][$y][0] = $rgb; $pixel[$x][$y][1] = 0; ############################# # Find DY rectangle ############################# if ( $prev eq $rgb ) { $end_y = $y; } else { if ( $prev ) { $prev =~ s/ //g; ############################# # Store ############################# my $h2 = $end_y - $start_y + 1; if ( $prev ne $bg ) #&& $h2 > 1 ) { push @rect, [ $prev, 1, $h2, $x, $start_y ]; } if ( $h2 > 1 ) { for my $dy ( $start_y .. $end_y ) { $pixel[$x][$dy][1] = 1; } } } ############################# # Start a new DY ############################# $prev = $rgb; $start_y = $y; $end_y = $y; } if ( $rgb ne $bg ) { if ( $x < $x1 ) { $x1 = $x; } if ( $y < $y1 ) { $y1 = $y; } if ( $x > $x1 ) { $x2 = $x; } if ( $y > $y1 ) { $y2 = $y; } } } $prev = " $prev"; } print SVG " \n"; print SVG " \n"; printRect( '' ); } ############################################################################ ### Process (X,Y) matrix ### ############################################################################ sub processMatrix() { my $start_x = 0; my $end_x = 0; my $prev = ""; my $g; push @rect, "\n"; for $y ( $y1 .. $y2 ) { for $x ( $x1 .. $x2 ) { my $rgb = getPixel( $x, $y ); if ( $rgb ne $bg ) { $pixel[$x][$y][0] = $rgb; ############################### # Find DX rectangle ############################### if ( $prev eq $rgb ) { $end_x = $x; } else { if ( $prev ne "" ) { $prev =~ s/ //g; ############################### # Store ############################### my $w2 = $end_x - $start_x + 1; # $g = " "; push @rect, [ $prev, $w2, 1, $start_x, $y ]; if ( $w2 > 1 ) { for my $dx ( $start_x .. $end_x ) { $pixel[$dx][$y][1] = 1; } } } ############################### # Start a new DY ############################### $prev = $rgb; $start_x = $x; $end_x = $x; } } } $prev = " $prev"; } } ############################################################################ ### Print an SVG rectangle ### ############################################################################ sub printRect($) { my $name3 = $name . $_[0]; my $g; push @data, $name3; for my $i ( 0 .. $#rect ) { my ( $prev, $w, $h, $x, $y ) = @{ $rect[ $i ] }; $x -= $x1; $y -= $y1; $g = " \n"; print SVG $g; } print SVG " \n"; } ############################################################################ ### Main function ### ############################################################################ sub main($$) { $file_png = "new.png"; if ( $_[0] ) { $file_png = $_[0]; } if ( $_[1] ) { $WANT_HEADER = $_[1] + 0; } @data = (); @rect = (); readPNG(); $bg = getPixel( 0,0 ); openSVG(); getMatrix(); closeSVG(); } ############################################################################ ### Script entry point ### ############################################################################ main( $ARGV[0], $ARGV[1] ); exit; 1; __END__