From ef50bdb98dd22b788477f063a48bc5ccac89e6ac Mon Sep 17 00:00:00 2001
From: Stefan `Sec` Zehl <sec@42.org>
Date: Sat, 14 May 2011 22:51:14 +0200
Subject: [PATCH] Now creates compressed fonts. Yay!

---
 tools/makefont.pl | 290 +++++++++++++++++++++++++++++++++++++++++++---
 1 file changed, 274 insertions(+), 16 deletions(-)
 mode change 100644 => 100755 tools/makefont.pl

diff --git a/tools/makefont.pl b/tools/makefont.pl
old mode 100644
new mode 100755
index cf89519..e3e4d5e
--- a/tools/makefont.pl
+++ b/tools/makefont.pl
@@ -3,6 +3,18 @@ use GD;
 use strict;
 use warnings;
 
+$|=1;
+
+#for(1..500){
+#	printf "%3d | %-10s | %-10s\n",
+#		   $_,
+#		   join(" ",map {sprintf "%x",$_} (0,pk_encode_long($_))),
+#		   join(" ",map {sprintf "%x",$_} pk_encode_long($_+16));
+#}
+#exit(1);
+
+use constant VERBOSE=>0;
+
 ###
 ### Configure me
 ### 
@@ -13,8 +25,13 @@ for(32..126){
 };
 
 my $size=shift||17;
-my $font="/usr/local/lib/X11/fonts/bitstream-vera/Vera.ttf";
-my $title="Bitstream Vera Sans ".$size."pt";
+my ($font,$title);
+
+$font="/usr/local/lib/X11/fonts/bitstream-vera/Vera.ttf";
+$title="Bitstream Vera Sans ".$size."pt";
+
+#$font="./Comic_Sans_MS_KOI8.ttf";
+#$title="Comic Sans ".$size."pt";
 
 ###
 ### Code starts here.
@@ -24,6 +41,10 @@ my $width=2000;
 my $height=100;
 my $xoff=30;
 
+my $origsize;
+my $c1size;
+my $c2size;
+
 my $fonts=$title;
 $fonts=~s/ //g;
 $fonts=~s/Bitstream//;
@@ -98,6 +119,7 @@ EOF
 ;
 
 my $offset=0;
+my $maxsz=0;
 my @offsets;
 for (1..length$charlist){
 	my $char=substr($charlist,$_-1,1);
@@ -118,19 +140,96 @@ for (1..length$charlist){
 		};
 #		print "<\n";
 	};
-	print C "/* '",$char,"' at $offset */\n";
+	print "### Start $char\n" if(VERBOSE);
+
+	print C " /* Char ",ord $char," is ",scalar@char,"px wide \@ $offset */\n";
+
+	$maxsz=scalar@char if scalar@char > $maxsz;
+
+	$origsize+=$byte * scalar @char;
+
+	# Whoops. Characters are upside down.
 	for (@char){
 		$_=reverse $_;
+	};
+
+	### PK compression
+	my @enc=do_pk(\@char);
+	$c2size+=scalar(@enc);
+
+	### Lame compression
+	# "compress" blank spaces
+	my $preblank=0;
+	while(defined $char[1] && $char[0]=~/^0+$/){
+		shift@char;
+		$preblank++;
+	};
+	my $postblank=0;
+	while($#char>0 && $char[$#char]=~/^0+$/){
+		$#char--;
+		$postblank++;
+	};
+	$c1size+=$byte*scalar@char;
+
+	my @raw;
+	### Raw character data
+	for (@char){
 		my $h= pack("B*",$_).(chr(0).chr(0));
 		for my $b (1..$byte){
-			printf C "0x%02x,",ord(substr($h,$b-1,1));
+			push @raw,ord(substr($h,$b-1,1));
 		};
-		$_=~y/01/ */;
-		print C " /* $_ */ \n";
 	};
-	push @offsets,sprintf " {%2d,%4d}, /* %s */\n",scalar(@char),$offset,$char;
-	$offset+=scalar(@char)*$byte;
-#	print "-"x80,"\n";
+
+	# Maintenance overhead
+	$origsize+=1;
+	$c1size+=3;
+	$c2size+=1;
+
+	# If encoding is bigger, fall back to original char
+	my $rawpretty=0;
+	if($#enc>$#raw+3){
+		warn "Compression failure: Encoding char $char raw.\n";
+		@enc=(255,$preblank,$postblank,@raw);
+		$rawpretty=1;
+	};
+
+	# Generate C source
+	if($rawpretty){
+		my @out=@enc;
+		printf C "  0x%02x, %2d, %2d, /* rawmode, preblank, postblank */\n",
+			   (shift@out), (shift@out), (shift@out);
+		for (@char){
+			print C "  ";
+			printf C "0x%02x, ",shift@out for(1..$byte);
+			$_=~y/01/ */;
+			print C " /* $_ */ \n";
+		};
+	}else{
+		for (@char){
+			$_=~y/01/ */;
+			print C " /* $_ */ \n";
+		};
+		my $pretty=0;
+		for(@enc){
+			print C "  " if($pretty==0);
+			printf C "0x%02x, ",$_;
+			if(++$pretty==8){
+				print C "\n" ;
+				$pretty=0;
+			};
+		};
+	};
+
+	print C "\n";
+
+	push @offsets,sprintf " {%2d}, /* %s */\n",scalar(@enc),$char;
+	print C "\n";
+
+	$offset+=scalar(@enc);
+
+	if(VERBOSE){
+		print "-"x80,"\n";
+	};
 };
 
 
@@ -138,22 +237,24 @@ print C <<EOF;
 };
 
 /* Character descriptors */
-const FONT_CHAR_INFO ${fonts}Descriptors[] = {
+const FONT_CHAR_INFO ${fonts}Lengths[] = {
 EOF
 
 print C @offsets;
 
 my($first)=ord substr($charlist,0,1);
 my($last)=$first+length($charlist)-1;
-print C <<EOF;
-};
+printf C "};
 
 /* Font info */
-const struct FONT_DEF Font_$fonts = {0,$pxsize,$first,$last,
-    ${fonts}Bitmaps,
-    ${fonts}Descriptors,
+const struct FONT_DEF Font_$fonts = {
+	%3d,   /* width (1 == comressed) */
+	%3d,   /* character height */
+	%3d,   /* first char */
+	%3d,   /* last char */
+    %s, %s
 };
-EOF
+",1,$pxsize,$first,$last,"${fonts}Bitmaps","${fonts}Lengths";
 
 print H <<EOF;
 #include "fonts.h"
@@ -164,3 +265,160 @@ EOF
 close(C);
 close(H);
 
+print "\ndone.\n\n";
+print "Original size: $origsize\n";
+print "Simple compression: $c1size\n";
+print "PK compression: $c2size\n";
+print "Maximum character size: $byte*$maxsz bytes\n";
+
+exit(0);
+
+# subs
+
+sub pk_dedup {
+	my $char=shift;
+	my @echar=@{$char};
+
+#   for (@echar){ print "dedup_in: $_\n"; };
+
+	my $idx=0;
+	while(++$idx<$#echar){
+		# dupline code can't deal with all-0 or all-1 dupe lines
+		next if ($echar[$idx]=~/^(.)(\1)+$/);
+
+		if($echar[$idx-1] eq $echar[$idx]){
+			my $dl=1;
+			$dl++ while ($dl<$#echar && $echar[$idx] eq $echar[$idx+$dl]);
+
+#			print "dupline found\n";
+			if( $echar[$idx-1]=~ s/01/0[$dl]1/ ){
+				$echar[$idx]="";
+				@echar[$idx..($idx+$dl-1)]=();
+			}elsif ($echar[$idx-1]=~ s/10/1[$dl]0/){
+				$echar[$idx]="";
+				@echar[$idx..($idx+$dl-1)]=();
+			}else{
+				die "Shouldn't happen: Can't encode dupline?";
+			};
+			$idx+=$dl; # Skip deduped lines.
+		}
+	}
+	@echar=grep {defined $_} @echar;
+	return \@echar;
+};
+
+sub pk_rle {
+	my $char=shift;
+
+	my $line=join("",@$char);;
+
+	my $fpx=substr($line,0,1);
+	warn "first pixel ==1 - Encoder will do stupid things..." if $fpx ==1 ;
+
+	my @out;
+	while($line=~/./){
+		$line=~s/^(0*)(\[\d+\])?(1*)(\[\d+\])?//;
+		push @out,length($1);
+		push @out,$2 if defined $2;
+		push @out,length($3);
+		push @out,$4 if defined $4;
+	};
+	pop @out if ($out[$#out]==0); # Remove trailling zero
+
+#	print "rle: ",join(",",@out),"\n";
+	return @out;
+};
+
+###
+### Encode a "long run", i.e. big number
+###
+sub pk_encode_long {
+	my $n=shift;
+	my @packed;
+
+	while($n){
+		unshift @packed,$n%16;
+		$n=$n>>4;
+	};
+
+	for my $undef (1..$#packed){
+		unshift @packed,0;
+	};
+
+	return @packed;
+};
+
+###
+### Encode RLE data (with included repeat counts) into a nybble stream
+###
+### PK has "dyn" per-character, but for our font size encoding a dyn per
+### character needs more space than it saves, so it's fixed for now.
+###
+sub pk_encode {
+	my @out=@_;
+	my $dyn=12;
+	my @enc;
+
+	for (@out){
+		if($_ =~ /\[(\d+)\]/ ){
+			if($1 == 1){
+				push @enc,15;
+			}else{
+				my $n=$1-1; # this deviates from PK spec, i think.
+				push @enc,14,pk_encode_long($1-1);
+			};
+		}elsif($_ == 0){
+			warn "Encoder asked to encode a zero?"; # Shouldn't happen.
+		}elsif($_ <= $dyn){ # Short length
+			push @enc,$_;
+		}elsif($_ <= 16*(13-$dyn)+$dyn){ # Medium length
+			my $b=($_-$dyn-1)&0x0f;
+			my $a=(($_-$dyn-1)>>4)+$dyn+1;
+			push @enc,$a,$b; # (16*($a-$dyn-1)+$b+$dyn+1
+		}else{ # long length
+			my $n=$_- (16*(13-$dyn)+$dyn) + 16;
+			push @enc,pk_encode_long($n);
+		};
+	};
+#	print "enc: ",join(",",@enc),"\n";
+	return @enc;
+};
+
+sub make_bytes{
+	my @enc=@_;
+	my @out;
+
+	while(@enc){
+		push @enc,0 if($#enc==2);
+		push @out,16*(shift@enc)+(shift@enc);
+	};
+	return @out;
+};
+
+sub do_pk {
+	my $char=shift;
+	my $size=scalar @$char * $byte;
+	print "Input char is $size bytes\n" if VERBOSE;
+
+	$char=pk_dedup($char);
+	
+	if(VERBOSE){
+		for (@$char){
+			print "dedup: $_\n";
+		};
+	};
+
+	my @rle=pk_rle ($char);
+
+	if(VERBOSE){
+		print "RLE: ",join(",",@rle),"\n";
+	};
+
+	my @enc=pk_encode (@rle);
+
+	if(VERBOSE){
+		print "encoded stream: ",join(",",@enc),"\n";
+	};
+
+	return make_bytes(@enc);
+};