lib/make-pixel-font

   1 #!/usr/bin/perl
   2 use warnings;
   3 use strict;
   4
   5 my %bitno = (0 => 0);
   6 for (0 .. 31) {
   7     $bitno{1 << $_} = $_;
   8 }
   9
  10 my $last_ch = -1;
  11 open U, '<', 'unifont.hex' or
  12     open U, '<', '/usr/share/unifont/unifont.hex' or die $!;
  13 open O, '>', 'unifont.pixelfont' or die $!;
  14 while (<U>) {
  15     my ($ch, $hex) = /^([[:xdigit:]]+):([[:xdigit:]]+)$/;
  16     if (!defined $ch) {
  17         print "Bad line: $_";
  18         next;
  19     }
  20     $ch = hex($ch);
  21     if ($ch == 256) {
  22         close O;
  23         open O, '<', 'unifont.pixelfont' or die $!;
  24         open P, '>', 'preload_font.h' or die $!;
  25         print P "static const unsigned char fontdata_preloaded[] = {";
  26         my $c = 0;
  27         while (<O>) {
  28             for (split //, $_) {
  29                 if ($c++ % 8 == 0) {
  30                     print P "\n   ";
  31                 }
  32                 printf P "% 4d,", ord $_;
  33             }
  34         }
  35         print P "\n};\n";
  36         close P;
  37         close O;
  38         open O, '>', 'unifont.pixelfont' or die $!;
  39     }
  40
  41     while (++$last_ch < $ch) {
  42         # print "Missing entry for ".($last_ch - 1 )."\n";
  43         print O pack 'C', 0x00;
  44     }
  45
  46     # $len is 0, 2 or 4
  47     my $len = length($hex) / 16;
  48     my $packcode;
  49     if ($len == 4) {
  50         $packcode = 'n';
  51     } elsif ($len == 2) {
  52         $packcode = 'C';
  53     } elsif ($len == 0) {
  54         $packcode = '';
  55     } else {
  56         die "No handling for len = $len\n";
  57     }
  58     my $data = '';
  59     my $start;
  60     my $n = 0;
  61     my $pixels_set = 0;
  62     my $width = $len * 4;
  63     if ($len) {
  64         my @data = ();
  65         for (0 .. 15) {
  66             my $c = substr($hex, (15 - $_) * $len, $len);
  67             my $row = hex($c);
  68             $pixels_set |= $row;
  69             if (!defined $start) {
  70                 # Skip blank rows at the bottom.
  71                 next unless $row;
  72                 $start = $_;
  73             }
  74             $n = $_ if $row;
  75             push @data, $row;
  76
  77 #       my $b = sprintf $fmt, $row;
  78 #       $b =~ y/01/ @/;
  79 #       print "\t$b\n";
  80         }
  81
  82         my $left_gap = 0;
  83         my $lsb_used = $pixels_set & -$pixels_set;
  84         my $msb_used = 1 << ($len * 4 - 1);
  85         while ($msb_used > $pixels_set) {
  86             $msb_used >>= 1;
  87             ++$left_gap;
  88         }
  89         $data = join '', map {pack($packcode, $_ << $left_gap)} @data;
  90         my $right_gap = $bitno{$lsb_used} + $left_gap;
  91         $right_gap = 0 if ($left_gap == 16);
  92         $width -= $right_gap;
  93     } else {
  94         $width -= 2;
  95     }
  96
  97     if (!defined $start) {
  98         # No set pixels.
  99         print O pack 'C', ($len * 4 - 4);
 100         die "not really empty!" unless $hex =~ /^0*$/;
 101     } else {
 102         die "really empty!" if $hex =~ /^0*$/;
 103         $n = $n + 1 - $start;
 104         print O pack 'C', (($len / 2) << 6) | $width;
 105         print O pack 'C', ($start << 4) | ($n - 1);
 106         die "too little data (".length($data)." < ".$n."*".($len/2).")" if length($data) < $n * $len/2;
 107         print O substr($data, 0, $n * $len / 2);
 108     }
 109 }
 110 close O or die $!;