#!/usr/bin/perl 

#
# Do not change formating here. VERSION is grep'ed by externals

my $VERSION;
$VERSION="2.1";

# </do not>

use strict;
use warnings;
use Image::Magick;
use Getopt::Long;
use DBI;
use fontlinge::Fontling;
use fontlinge::Filebasics;
use File::Temp;

no utf8;
use bytes;

#
# options
#
my $verbose=0;
my $display=0;
my $debug=0;
my $help=0;
my $mode='find_by_img';
my $fingerprint;
my $similar;
my $fingerprint_font;
my $compare_fonts;
my $dbh;
                        
GetOptions (	'verbose|v'		=> \$verbose,
		'display'		=> \$display,
		'debug'			=> \$debug,
		'fingerprint'		=> \$fingerprint,
		'similar'		=> \$similar,
		'fingerprint-font'	=> \$fingerprint_font,
		'compare-fonts'	=> \$compare_fonts,
 		'help'		 	=> \$help
) || exit -1 ;

if ( $fingerprint	) { $mode="fingerprint"; }
if ( $similar		) { $mode="similar"; }
if ( $fingerprint_font	) { $mode="fingerprint-font"; }
if ( $compare_fonts	) { $mode="compare-fonts"; }

if( ( $mode eq 'similar')		&& (scalar (@ARGV) != 4) ) { $help = -1; }
if( ( $mode eq 'find_by_img')		&& (scalar (@ARGV) != 3) ) { $help = -1; }
if( ( $mode eq 'compare-fonts')		&& (scalar (@ARGV) != 3) ) { $help = -1; }
if( ( $mode eq 'fingerprint') 		&& (scalar (@ARGV) != 1) ) { $help = -1; }
if( ( $mode eq 'fingerprint-font') 	&& (scalar (@ARGV) != 2) ) { $help = -1; }

if( $help ) {
	print << "end_of_help"
In find mode (default) fontlinge_compare take exactly THREE parameters
and (optional) options:
fontlinge_compare [--verbose] [--display] [--debug] img text sqlquery

img          black/white image with exactly one letter
text         the letter in img
sqlquery     a sql statement to speed up search (see example)
             or just '1' to search all fonts


In fingerprint modes fontlinge_compare takes exactly ONE parameter
for images or TWO parameter for fonts and (optional) options:
fontlinge_compare --fingerprint      [--verbose] [--debug] img
fontlinge_compare --fingerprint-font [--verbose] [--debug] text font

     
--verbose           print out every font fontlinge_compare is working on,
                    not only better matches
--display           display currently best match as image
--debug             for debugging
--fingerprint       Output image fingerprint
--fingerprint-font  Output fingerprint for given string
--similar           Temporarily(!) set fonts above similarity-minimum to
                    category 'WORK' in MySQL.

example:
./fontlinge_compare --display --verbose v.png 'V' 'font_kategorie=4'
The output contains a similarily factor in percent.

./fontlinge_compare --fingerprint-font "I" ~/font.ttf
The output contains a fingerprint for the letter I, using that font.

./fontlinge_compare --similar F.png 'F' 'font_kategorie=0' 96
Set all fonts 96 percent or more similar to F.png to 'WORK' in MySQL.


In compare-fonts mode fontlinge_compare takes exactly THREE parameters:
FILE1, FILE2 and a LETTER.

fontlinge_compare --compare-fonts pear.ttf apple.ttf 'X'

end_of_help
;
	exit -1;
}

my %config=&fontlinge_Get_Config();


my $best = new File::Temp( TEMPLATE => 'fontlingeXXXXX',
                        DIR => $config{'tmp_as_folder'},
                        SUFFIX => '.png') -> filename; 
                        
my $best2 = new File::Temp( TEMPLATE => 'fontlingeXXXXX',
                        DIR => $config{'tmp_as_folder'},
                        SUFFIX => '.png') -> filename; 


$dbh = fontlinge_Open_Database(
		$config{'username'},
		$config{'password'},
		$config{'mysqlserver'},
		$config{'database'}
	);

if	( ( $mode eq 'find_by_img') ) {
	find_similar_font( $ARGV[0],$ARGV[1],$ARGV[2],0 );
} elsif	( ( $mode eq 'similar') ) {
	find_similar_font( $ARGV[0],$ARGV[1],$ARGV[2],$ARGV[3] );
} elsif	( ( $mode eq 'fingerprint') ) {
	fingerprint_image( $ARGV[0] );
} elsif	( ( $mode eq 'compare-fonts') ) {
	compare_two_fonts( $ARGV[0] , $ARGV[1] , $ARGV[2] );
} elsif	( ( $mode eq 'fingerprint-font') ) {
	print join("-",@ARGV),"\n";
	fingerprint_font( $ARGV[0] , $ARGV[1] );
}

fontlinge_Close_Database($dbh);

#########################################################

sub fingerprint_image {
	my $image=shift(@_);
	my $original;
	my $finger;
	read_image_png( \$original , $image );
	$finger=fingerprint( \$original );
	undef $original;
	print "$finger\n";
}

sub fingerprint_font {
	my ( $fontfile , $text  ) = ( @_ );
	my $original;
	my $finger;
	fontlinge_Read_Image_Font(  $fontfile , $text , \$original);
	$finger=fingerprint( \$original );
	undef $original;
	print "$finger\n";
}


sub fingerprint {
	my $original=shift(@_);
	my $tmp;
	my $colordepth=&fontlinge_Quantum_Depth();
	my $anderes;
	my $finger="";

	if	( $colordepth== 8  )	{ $colordepth=255; }
	elsif	( $colordepth== 16 )	{ $colordepth=65535; }
	elsif	( $colordepth== 32 )	{ $colordepth=4294967295; }
	for ( my $y=0 ; $y < 256 ; $y+=32 ) {
		for ( my $x=0 ; $x < 256 ; $x+=32 ) {
			blank_image(\$anderes,256,256);
			$anderes->Composite(	image		=>	${$original},
						compose		=>	'Over',
			);

			$anderes->Crop(	x=>$x,
					y=>$y,
					width=>32,
					height=>32
			);

			$anderes->Quantize(	colors		=>	1,
						dither		=>	0
			);
			$tmp= $anderes->Get('pixel[0,0]'); 
			$tmp=~s/,(.*)//gis;
			$tmp= sprintf("%02d", 99*$tmp/$colordepth );
			$finger.= $tmp;
			undef $anderes;
		}
	}
	return $finger;
}


sub find_similar_font {
	my $image=shift(@_);
	my $text =shift(@_);
	my $where=shift(@_);
	my $similar_min=shift(@_);
	my $data;
	my $filename;
	
	my $original;
	my $anderes;
	my $samecolor=0;
	my $diffcolor=0;
	my $msg="";
	
	my $sth;
	my $sth2;
	my %data;

	my $bestmatch=-1;
	my $backspace="\x08 \x08" x 120;
	if ($debug) {$backspace="\n";}

	if ($display) {
		# Display does not return until exit'ed. So create a fork and use that.
		my $pid;
		if ($pid = fork) {
			`convert LOGO: $best`;
			`display -update 2 $best; rm $best`;
			waitpid($pid,0);
			exit;
		}
		die "cannot fork: $!" unless defined $pid;
	}

	if ($debug) {print "SELECT font_id,font_path,font_name,font_datatype FROM fonts WHERE $where\n";}
	$sth = $dbh->prepare("SELECT font_id,font_path,font_name,font_datatype FROM fonts WHERE $where");
	$sth->execute();
	while($data = $sth->fetchrow_hashref) {
		$filename=$data->{'font_path'};
		if( $verbose) {
			print "$backspace$filename";
		}
		if($data->{'font_datatype'} eq 'mmm') {	$filename='' };
		if($data->{'font_datatype'} eq 'ps') {
			$filename=$data->{'font_name'};
			$filename=~s/\W/_/gs;
			$filename=$data->{'font_path'}.$filename;
			if    (-e $filename.".pfb") {$filename.=".pfb";}
			elsif (-e $filename.".pfa") {$filename.=".pfa";}
		}
		read_image_png( \$original, $image);
		if ($debug) {print "Do\n";}
		if ($debug) {print "$filename\n";}
		fontlinge_Read_Image_Font($filename,$text,\$anderes);
		if ($debug) {print "Done\n";}
		if($anderes ne "") {
			($samecolor,$diffcolor,$msg)=compare_images($original,$anderes);



			if	( $mode eq 'find_by_img') {
				if ($samecolor >= $bestmatch ) {
					print $backspace;
					print 100*$samecolor/65536;
					if (! $debug) {print "\t$filename\n";}
					$bestmatch=$samecolor;
					$anderes->Draw(	primitive	=>	'rectangle',
							fill		=>	'white',
							stroke		=>	'white',
							points		=>	'0,245,255,255',
							method		=>	'Replace'
										);
					my $tmp=$filename;
					$tmp=~s/^.*\///gis;
					$anderes->Annotate(	text	=>	$tmp,
								x	=>	0,
								y	=>	255,
								fill	=>	'#123456'
							);
					$anderes->Write("png:$best2");
					`mv $best2 $best`;
				}
				undef $anderes;
			}

			if	( $mode eq 'similar') {
				if ( 100*$samecolor/65536 >= $similar_min ) {
					print 100*$samecolor/65536 ,"\t" , $data->{'font_id'}  ,"\t" , $data->{'font_path'} , "\n";
					$sth2 = $dbh->prepare("UPDATE fonts SET font_kategorie=19 WHERE font_id=$data->{'font_id'}");
#					print "UPDATE fonts SET font_kategorie=19 WHERE font_id=$data->{'font_id'}\n";
					$sth2->execute();
					$sth2->finish;
				 }
			}

		}
		undef $original;
	};
	$sth->finish;
	if ($verbose) {print "$backspace";}
	if ($display) {
		print "finished. Please close the displayed image, then fontlinge_compare will exit.\n";
	}
}


sub compare_two_fonts {
	my $font1 =shift(@_);
	my $font2 =shift(@_);
	my $letter =shift(@_);
	my ( $font1_img , $font2_img ,  $samecolor , $diffcolor , $msg );
	
	fontlinge_Read_Image_Font($font1,$letter,\$font1_img);
	fontlinge_Read_Image_Font($font2,$letter,\$font2_img);
	($samecolor,$diffcolor,$msg)=compare_images($font1_img , $font2_img );
	print 100*$samecolor/65536 , $msg ? "[ ".$msg." ]" : "" , "\n"
}

sub fontfilename {
	my $font_path=shift(@_);
	my $font_name=shift(@_);
	my $font_filetype=shift(@_);
	my $image_name;
	
	if ($font_filetype eq 'single') {
		$image_name=$font_path; $image_name=~s/...$/png/is;
	}else {
		$image_name=$font_name; $image_name=~s/\W/_/gis;
		$font_path=~/(.*)\//s;  # With PS-Fonts only path, not name must be given
		$font_path="$1/";
		$image_name="$font_path$image_name.png";
	}
	return $image_name;
}

sub compare_images {
	my $original=shift(@_);
	my $anderes=shift(@_);
	my $samecolor=0;
	my $diffcolor=0;
	my $count='';
	my @count;
	my $msg="";
	
	$original->Composite(	image		=>	$anderes,
				compose		=>	'Difference',
							);
	$original->Quantize(	colors		=>	2,
				dither		=>	0);
#	$original->Set(		depth		=>	1);
	$original->Set(		monochrome	=>	1);
	$original->Write("HISTOGRAM:tmp");

	$original=`cat tmp`;
#print "$original\n";
	if ($original=~/comment=\{(.*?)\}/is) {
#print "$1\n";
		foreach my $line(split("\n",$1)) {
			chomp $line;
			if ($line=~/^(\W*)(\d*)(.*)\((\W*)(\d*)/s) {
				$count.="$2,";
			}
		}
		@count=split(",",$count);
		if (scalar (@count) > 3) {
			print "More than 2 colors found!";
			return (0,65536,"Error");
		}
		if (scalar (@count) == 1) {
			$count[1] = 0 ;	# Exact match returns just one number. :-(
		}
#print $count[0] , "\t" , $count[1] , "\n";
		$samecolor+=$count[0];
		$diffcolor+=$count[1];
	} else {
		$msg="Error.";
		return (0,65536,"Error");
	}
	return ($samecolor,$diffcolor,$msg);
}

sub read_image_png {
	my ($img , $filename) = (@_);
	${$img}=Image::Magick->new(	depth	=>	8 );
	${$img}->Read($filename);
	${$img}->Quantize(		colors	=>	2,
					dither	=>	0
		);
	${$img}->Set(			matte	=>	0 );
	${$img}->Border(		geometry=>	"1x1",
					fill	=>	'white'
		); # This avoids black to be taken as bg-Color, which is the case i.e. for an exactly cropped sans-serif "F". Two black sides.
	${$img}->Trim();
	${$img}->Resize(		width	=>	256,
					height	=>	256,
					blur	=>	0
		);
}


sub blank_image {
	my ( $img , $width ,$height )= ( @_ );
	${$img}=Image::Magick->new(	size		=>	$width."x".$height, 
					background	=>	'white', 
					depth		=>	8 );
	${$img}->ReadImage(		"xc:white" );

	${$img}->Set(			matte	=>	0 );
}

 
# vim:ts=8
