#!/usr/bin/perl


sub UsageShort() {
	print "Usage: grffmt [ -h | --help ] | [ base_image format.grf result_image [variables1.var ... variablesN.var] ]\n" ;
}

sub UsageLong() {
	print "   The variables files contains one variable definition by line:\n" ;
	print "     _ VAR = no_whitespace_string\n" ;
	print "     _ VAR = \"any words without double quotes\"\n" ;
	print "     A dash ('-') stands for the standard input\n" ;
	print "   The format file two first lines are:\n" ;
	print "     _ FNT: \"the de\fault text font\"\n" ;
	print "     _ COL: \"the default text color\"\n" ;
	print "     Subsequent lines are composed of a position definition, and an\n" ;
	print "     expression:\n" ;
	print "     _ X,Y no_whitespace_expression\n" ;
	print "     _ X,Y \"composite expression\"" ;
	print "     where the expression is either \$(var_name), printed as is, or\n" ;
	print "     \${expression}, evaluated\n" ;
}

if(scalar(@ARGV)==0) {
	UsageShort() ;
	exit 1 ;
}

if((scalar(@ARGV)>=1)&&(($ARGV[0] eq '-h')||($ARGV[0] eq '--help'))) {
	UsageShort() ;
	UsageLong() ;
	exit 0 ;
}

my $verb = 0 ;
if($ARGV[0] eq '-v') { $verb = 1 ; shift @ARGV ; }

if(scalar(@ARGV)<3) {
	UsageShort() ;
	exit 1 ;
}


# FormatString
#   Formats a 
#   Args:
#         _str             : string to format
#         _fil             : character filler
#         _len             : total final length
#         _aln             : c|r|l , horizontal alignment
#   Returns:
#         _the formatted string
sub FormatString($$$$) {
	my $str = shift ;
	my $fil = shift ;
	my $len = shift ;
	my $aln = shift ;
	if(length($fil)==0) { $fil = ' ' ; }
	$fil = substr($fil,0,1) ;	
	if(!defined $str) { return $fil x $len ; }
	if(length($str)>=$len) { return $str ; }
	if($aln eq 'l') { return $str . ($fil x ($len-length($str))) ; }
	elsif($aln eq 'r') { return ($fil x ($len-length($str))) . $str ; }
	elsif($aln eq 'c') {
		return ($fil x (($len-length($str))/2)) . $str . ($fil x (($len+1-length($str))/2)) ;
	}
	else { return $str ; }
}


# InterpretString
#   Parses and rewrite a variable or expression definition
#   Args:
#         _var             : reference to a variables hash
#         _str             : string to parse
#         _len             : length of result string [optional]
#   Returns:
#         _an interpreted string, if the hash ref was valid and '$(..)' or '${..}'
#            patterns were found
#         _a '*' (star) only string if the hash ref was invalid
#         _the original string otherwise
sub InterpretString($$;$) {
	my $var = shift ;
	my $str = shift ;
	my $len = length($str) ;
	my $alg = 'c' ;
	if(scalar(@_)) {
		my $tmp = shift ;
		if($tmp=~m/^([rcl])(\d+)/) {
			$alg = $1 ;
			$len = $2 ;
		}
		else { $len = $tmp ; }
	}
	if(ref($var) ne 'HASH') { return '*' x $len ; }
	if($str=~m/^\s*\$\(([^\)]+)\)\s*$/) {
#print stderr "Format \"$str\" (\"$var->{$1}\")\n" ;
		return FormatString($var->{$1},' ',$len,$alg) ;
	}
	elsif($str=~m/^\s*\$\{([^\}]+)\}\s*$/) {
#print stderr "Interp \"$str\"\n" ;
		$str = $1 ;
		if($str =~ /\$/) {
			$str =~ s/\$\(([^\)]+)\)/$var->{$1}/g ;
			local $SIG{__WARN__} = sub { } ;
			$str = eval($str) ;
		}
		if(length($str)>$len) { $str = substr($str,0,$len) ; }
		return FormatString($str,' ',$len,$alg) ;
	}
#print stderr "Reject \"$str\"\n" ;
	return $str ;
}


# LoadVarFile
#   Loads a variables definition file into a hash
#   Args:
#         _var             : reference to a variables hash
#         _file            : the file to read
#   Returns:
#         _the original hash ref if it was defined and valid
#         _a ref to a new hash if the first argument was undef
#         _'undef' if the hash ref was invalid
sub LoadVarFile($$) {
	my $var = shift ;
	my $file = shift ;
	my $fd ;
	my $base = undef ;
	if(defined $var) {
		if(ref($var) ne 'HASH') { return undef ; }
	}
	else {
		$var = { } ;
	}
	if($file ne '-') {
		open($fd,'<',$file) ;
		my @base = split('/', $file) ;
		pop @base ;
		if(@base) { $base = join('/',@base) . '/' ; }
		else { $base = '' ; }
	}
	else {
		$fd = *stdin ;
	}
	while(<$fd>) {
		if(/^#/) { next ; }
		if(/^\s*$/) { next ; }
		if(
			   (/^\s*([^\s]+)\s*=\s*([^'"\s][^\s]*)/)
			|| (/^\s*([^\s]+)\s*=\s*"([^"]+)"/)
			|| (/^\s*([^\s]+)\s*=\s*'([^']+)'/)
		   ) {
			my ($nam,$cnt) = ($1,$2) ;
			if($cnt=~/^@(?!\/)/) { $cnt = '@' . $base . substr($cnt,1) ; }
			$var->{$nam} = $cnt ;
		}
	}
	if($file ne '-') { close($fd) ; }
	return $var ;
}


my %allvars = ( '_processed_with_' => "$0" ) ;

sub LoadGrfFile($) {
	my $file = shift ;
	my @items = () ;
	my $fd ;
	if($file ne '-') {
		open($fd,'<',$file) ;
	}
	else {
		$fd = *stdin ;
	}
	while(<$fd>) {
		if(/^#/) { next ; } ;
		if(/^\s*$/) { next ; } ;
		my $def = undef ;
		my $exp = undef ;
		my $len ;
#print '$_: ', $_ ;
		if( (/^\s*FNT\s+([^\s"'][^\s]*)/)
		 || (/^\s*FNT\s+"([^\"]+)"/)
		 || (/^\s*FNT\s+'([^\']+)'/) ) {
#print "MF" ;
			push @items, '-font' ;
			push @items, $1 ;
			next ;
		}
		elsif( (/^\s*COL\s+([^\s"'][^\s]*)/)
		 || (/^\s*COL\s+"([^\"]+)"/)
		 || (/^\s*COL\s+'([^\']+)'/) ) {
#print "MC" ;
			push @items, '-fill' ;
			push @items, $1 ;
			next ;
		}
		elsif(/^(\s*\d+,\s*\d+(?:,\w+)?(?:,\w)?(?:,\+)?)\s+(\$(?:(?:\([^\)]+\))|(?:\{[^\}]+\}))):([rcl]?\d+)/) {
#print "M3" ;
			$def = $1 ;
			$exp = $2 ;
			$len = $3 ;
		}
		elsif(/^(\s*\d+,\s*\d+(?:,\w+)?(?:,\w)?(?:,\+)?)\s+(\$(?:(?:\([^\)]+\))|(?:\{[^\}]+\})))/) {
#print "M2" ;
			$def = $1 ;
			$exp = $2 ;
			$len = length($exp) ;
		}
		elsif( (/^(\s*\d+,\s*\d+(?:,\w+)?(?:,\w)?(?:,\+)?)\s+([^\s]+)/)
		 || (/^(\s*\d+,\s*\d+(?:,\w+)?(?:,\w)?(?:,\+)?)\s+"([^\"]*)"/)
		 || (/^(\s*\d+,\s*\d+(?:,\w+)?(?:,\w)?(?:,\+)?)\s+'([^\']*)'/) ) {
#print "M1" ;
			$def = $1 ;
			$exp = $2 ;
			$len = length($exp) ;
		}
		else {
#print "M0" ;
		}
#print " $def $exp $len\n" ;
		if(defined($def) && defined($exp)) {
			my @def = split(',',$def) ;
			my $cmd = 'text ' ;
			if(defined $def[2]) {
				my $fnt = "-*-" . $def[2] . "-*-" ;
				if(defined($def[3])&&($def[3]=~m/^[ior]$/)) {
					$fnt .= $def[3] ;
					$fnt .= "-*-*-" ;
					if(defined $def[4]) { $fnt .= $def[4] ; }
					else { $fnt .= 20 ; }
				}
				else {
					$fnt .= 'r' ;
					$fnt .= "-*-*-" ;
					if(defined $def[3]) { $fnt .= $def[3] ; }
					else { $fnt .= 20 ; }
				}
				$fnt .= "-*-*-*-*-*-*-*" ;
				push @items, '-font' ;
				push @items, $fnt ;
			}
			if(defined $def[0]) { $cmd .= $def[0] ; }
			else { $cmd .= '0' ; }
			$cmd .= ',' ;
			if(defined $def[1]) { $cmd .= $def[1] ; }
			else { $cmd .= '0' ; }
			$cmd .= ' ' ;
			$exp = InterpretString(\%allvars,$exp,$len) ;
			if($exp =~ m/^@/) {
				local *F ;
				if(open(F,'<',substr($exp,1))) {
					$exp = '' ;
					while(<F>) { $exp .= $_ ; }
					close(F) ;
					$exp =~ s/\\\n//g ;
					$exp =~ s/\n/\\n\\n/g ;
				}
			}
			$exp =~ s/"/''/g ;
			$exp =~ s/\t+/    /g ;
			$exp =~ tr/\n//d ;
			$cmd .= '"' . $exp .'"' ;
			push @items, '-draw' ;
			push @items, $cmd ;
		}	
	}
	if($file ne '-') { close($fd) ; }
	return @items ;
}

$img = shift @ARGV ;
$fmt = shift @ARGV ;
$out = shift @ARGV ;
for $var (@ARGV) {
	LoadVarFile(\%allvars,$var) ;
}

@list = LoadGrfFile($fmt) ;

if($verb) {
	for my $key (keys %allvars) {
		print $key, ' => "', $allvars{$key}, '"' , "\n" ;
	}
	print "CMD convert '", join("' '",($img, @list, $out)) , "'\n";
}

exec 'convert', $img, @list, $out ;