#! /client/bin/perl

# translate Hebrew text from Michigan-Claremont encoding to a
# pixel file in xbm format

# read command line parameters

while ($param = shift) {
  if ($option) {
    $option{$option} = $param;
    $option = '';
  } elsif ($param =~ /^-(.)(.*)$/) {
    if ($2) {
      $option{$1} = $2;
    } else {
      $option = $1;
    };
  } else {
    die "expected option, found \"$param\"";
  };
};

if ($option) {
  die "missing value for option \"$option\"";
};

# open files and read input

if ($option{'e'}) {
  $text = $option{'e'};
  $text =~ tr/\n/ /;
} else {
  if ($option{'i'}) {
    open (INP, "<$option{'i'}") || die "unable to open input file \"$option{'i'}\"";
  } else {
    open (INP, "<-");
  };
  while (read (INP, $tx, 1000)) {
    $text .= $tx;
  };
  close (INP);
  undef $tx;
};

if ($option{'d'}) {
  $ctxt = $text;
  $ctxt =~ s/\$/sh/g;
  $ctxt =~ tr/+F\"A-Z/taea-z/;
  $ctxt =~ tr/a-z//cd;
  if ($ctxt) {
    $ctxt = substr ($ctxt, 0, 6);
  } else {
    $ctxt = 'j';
  };
  opendir (DIR, "$option{'d'}") || die "unable to open directory \"$option{'d'}\"";
  @gifs = grep (/^$ctxt\d+\.gif$/, readdir (DIR));
  closedir (DIR);
  foreach $gif (@gifs) {
    open (GIF, "$option{'d'}/$gif");
    while (read (GIF, $tx, 1000)) {
      $giftext .= $tx;
    };
    close (GIF);
    undef $tx;
    if ($giftext =~ /\041\376(.)MC:([^\000]+)\000/) {
      $clen = ord($1);
      $cotxt = $2;
      if (length ($cotxt) == $clen-3 && $cotxt eq $text) {
        $width = ord (substr ($giftext, 7, 1)) * 256 + ord (substr ($giftext, 6, 1));
        $height = ord (substr ($giftext, 9, 1)) * 256 + ord (substr ($giftext, 8, 1));
        print (STDOUT "<IMG WIDTH=$width HEIGHT=$height SRC=\"$gif\" ALT=\"[$text]\" ALIGN=TOP>\n");
        exit 0;
      };
    };
    undef $giftext;
  };
  for ($i=0; 1; $i++) {
    $fnam = "$ctxt$i";
    last if ! -f "$option{'d'}/$fnam.xbm" && ! -f "$option{'d'}/$fnam.xpm" && ! -f "$option{'d'}/$fnam.ypm" && ! -f "$option{'d'}/$fnam.gif";
  };
  open (OUTO, ">$option{'d'}/$fnam.xbm") || die "unable to open output file \"$option{'d'}/$fnam.xbm\"";
  $output_o = 1;

} elsif ($option{'o'}) {
  open (OUTO, ">$option{'o'}") || die "unable to open output file \"$option{'o'}\"";
  if ($option{'o'} eq '-') {
    $output_o = 2;
  } else {
    $output_o = 1;
  };
};
  
if ($option{'l'}) {
  open (OUTL, ">$option{'l'}") || die "unable to open output file \"$option{'l'}\"";
  $output_l = 1;
};
 
if ($option{'t'}) {
  open (OUTT, ">$option{'t'}") || die "unable to open output file \"$option{'t'}\"";
  $output_t = 1;
};

# translate text into strict mode

$mode = 0;
while ($text =~ /[[}{~]/) {
  $pre = $`;
  $esc = $&;
  $post = $';
  if ($mode) {
    $txdm .= $pre;
  } else {
    $txdm .= &typo ($pre);
  };
  undef $pre;
  if ($esc eq '[') {
    if ($post =~ /\]+/) {
      $text = $';
      $post = $` . $&;
      chop $post;
    } else {
      $text = '';
    };
    foreach $x (reverse split ('', $post)) {
      $txdm .= "\[$x\]";
    };
  } elsif ($esc eq '}') {
    $text = $post;
    $mode = 0;
  } elsif ($esc eq '{') {
    $text = $post;
    $mode = 1;
  } elsif ($esc eq '~') {
    $post =~ /\n|$/;
    $text = $';
  };
};
if ($mode) {
  $txdm .= $text;
} else {
  $txdm .= &typo ($text);
};
if (! $option{'d'}) {
  undef $text;
};

&initial;
&hebstring ($txdm);
undef $txdm;

if ($option{'e'}) {
  @T2 = @T1;
};

&arr2xbm (@T2);

if ($output_o) {
  close (OUTO);
};

if ($output_o == 1) {
  if ($option{'d'}) { 
    system ('convert', "$option{'d'}/$fnam.xbm", "$option{'d'}/$fnam.xpm");
    system ("sed -e 's/#FFFFFFFFFFFF/none/' $option{'d'}/$fnam.xpm >$option{'d'}/$fnam.ypm");
    rename ("$option{'d'}/$fnam.ypm", "$option{'d'}/$fnam.xpm");
    system ('convert', '-comment', "MC:$text", "$option{'d'}/$fnam.xpm", "$option{'d'}/$fnam.gif");
    print (STDOUT "<IMG WIDTH=$T2[0] HEIGHT=$T2[1] SRC=\"$fnam.gif\" ALT=\"[$text]\" ALIGN=TOP>\n");
    if (-f "$option{'d'}/$fnam.gif") {
      unlink ("$option{'d'}/$fnam.xbm", "$option{'d'}/$fnam.xpm");
    };
  } else {
    print "width: $T2[0] height: $T2[1]\n";
  };
};

sub initial {
@T1 = (0, 0);
@T2 = (0, 0);
@pixels = (0);

$letter{')'} = $#pixels+1;
    push (@pixels, &str2arr ("\0\13\0\23\0\0\0\0B\0\303\1\207\3\16\7\34\5\270\0|\0\342\0\302\1\207\3\16\7\17\4\0\0\0\0\0\0\0\0\0\0"));
$letter{'B'} = $#pixels+1;
    push (@pixels, &str2arr ("\0\12\0\23\0\0\0\0\0\0\1\0\377\0\376\1\0\1\0\1\0\1\0\1\0\1\0\1\377\3\377\3\0\0\0\0\0\0\0\0\0\0"));
$letter{'G'} = $#pixels+1;
    push (@pixels, &str2arr ("\0\6\0\23\0\0\0\1\17\36\20\20\20\30\30\03673\0\0\0\0\0"));
$letter{'D'} = $#pixels+1;
    push (@pixels, &str2arr ("\0\12\0\23\0\0\0\0\0\0\1\0\377\3\376\3\0\1\0\1\0\1\0\1\0\1\0\1\0\1\0\1\0\0\0\0\0\0\0\0\0\0"));
$letter{'H'} = $#pixels+1;
    push (@pixels, &str2arr ("\0\12\0\23\0\0\0\0\0\0\1\0\377\3\376\3\0\2\0\2\0\2\0\2\2\2\2\2\2\2\2\2\0\0\0\0\0\0\0\0\0\0"));
$letter{'W'} = $#pixels+1;
    push (@pixels, &str2arr ("\0\5\0\23\0\0\0\1\17\36\20\20\20\20\20\20\20\20\0\0\0\0\0"));
$letter{'o'} = $#pixels+1;
    push (@pixels, &str2arr ("\0\5\0\23\4\4\0\1\17\36\20\20\20\20\20\20\20\20\0\0\0\0\0"));
$letter{'Z'} = $#pixels+1;
    push (@pixels, &str2arr ("\0\5\0\23\0\0\0\1\17\36\24\4\4\4\10\10\10\4\0\0\0\0\0"));
$letter{'X'} = $#pixels+1;
    push (@pixels, &str2arr ("\0\12\0\23\0\0\0\0\0\0\1\0\377\3\376\3\2\2\2\2\2\2\2\2\2\2\2\2\2\2\2\2\0\0\0\0\0\0\0\0\0\0"));
$letter{'+'} = $#pixels+1;
    push (@pixels, &str2arr ("\0\12\0\23\0\0\0\0\0\0\1\0\317\0\316\1J\3c\2!\2\3\3\2\1\206\1\376\1\374\0\0\0\0\0\0\0\0\0\0\0"));
$letter{'Y'} = $#pixels+1;
    push (@pixels, &str2arr ("\0\5\0\23\0\0\0\1\17\36\20\20\20\10\0\0\0\0\0\0\0\0\0"));
$letter{'k'} = $#pixels+1;
    push (@pixels, &str2arr ("\0\12\0\23\0\0\0\0\0\0\1\0\377\3\376\3\0\2\0\2\0\2\0\2\0\2\0\2\0\2\0\2\0\2\0\2\0\2\0\2\0\2"));
$letter{'K'} = $#pixels+1;
    push (@pixels, &str2arr ("\0\12\0\23\0\0\0\0\0\0\1\0\377\1\376\3\0\2\0\2\0\2\0\2\0\2\0\2\377\3\377\1\0\0\0\0\0\0\0\0\0\0"));
$letter{'L'} = $#pixels+1;
    push (@pixels, &str2arr ("\0\12\0\23\3\0\1\0\1\0\1\0\377\1\376\3\0\2\0\2\0\3\0\1\300\0 \0000\0000\0\0\0\0\0\0\0\0\0\0\0"));
$letter{'m'} = $#pixels+1;
    push (@pixels, &str2arr ("\0\12\0\23\0\0\0\0\0\0\1\0\377\1\376\3\2\2\2\2\2\2\2\2\2\2\2\2\376\3\376\3\0\0\0\0\0\0\0\0\0\0"));
$letter{'M'} = $#pixels+1;
    push (@pixels, &str2arr ("\0\13\0\23\0\0\0\0\0\0\1\0\317\3\356\0078\6\30\4\14\4\4\4\6\4\2\6\343\7\361\3\0\0\0\0\0\0\0\0\0\0"));
$letter{'n'} = $#pixels+1;
    push (@pixels, &str2arr ("\0\5\0\23\0\0\0\1\17\36\20\20\20\20\20\20\20\20\20\20\20\20\20"));
$letter{'N'} = $#pixels+1;
    push (@pixels, &str2arr ("\0\5\0\23\0\0\0\1\17\36\20\20\20\20\20\20\37\37\0\0\0\0\0"));
$letter{'S'} = $#pixels+1;
    push (@pixels, &str2arr ("\0\12\0\23\0\0\0\0\0\0\1\0\377\0\376\1\6\3\3\2\1\2\1\2\1\2\3\3\376\1\374\0\0\0\0\0\0\0\0\0\0\0"));
$letter{'('} = $#pixels+1;
    push (@pixels, &str2arr ("\0\13\0\23\0\0\0\0\0\0A\0\317\3\236\7\24\4\4\4\4\6\4\2\10\1\310\1\360\0|\0\17\0\3\0\0\0\0\0\0\0"));
$letter{'p'} = $#pixels+1;
    push (@pixels, &str2arr ("\0\12\0\23\0\0\0\0\0\0\1\0\377\1\376\3\2\2\2\2\36\2\37\2\0\2\0\2\0\2\0\2\0\2\0\2\0\2\0\2\0\2"));
$letter{'P'} = $#pixels+1;
    push (@pixels, &str2arr ("\0\12\0\23\0\0\0\0\0\0\1\0\377\1\376\3\2\2\2\2\36\2\37\2\0\2\0\2\377\3\377\1\0\0\0\0\0\0\0\0\0\0"));
$letter{'c'} = $#pixels+1;
    push (@pixels, &str2arr ("\0\13\0\23\0\0\0\0\0\0A\0\317\1\236\3\20\7\220\4P\0000\0\20\0\20\0\20\0\20\0\20\0\20\0\20\0\20\0\20\0"));
$letter{'C'} = $#pixels+1;
    push (@pixels, &str2arr ("\0\13\0\23\0\0\0\0\0\0A\0\317\1\236\3\4\7\210\4P\0`\0\200\0\0\3\376\7\377\3\0\0\0\0\0\0\0\0\0\0"));
$letter{'Q'} = $#pixels+1;
    push (@pixels, &str2arr ("\0\13\0\23\0\0\0\0\0\0\1\0\377\3\376\7\0\4\0\4\20\2\20\2\20\1\220\0P\0\20\0\20\0\20\0\20\0\20\0\20\0"));
$letter{'R'} = $#pixels+1;
    push (@pixels, &str2arr ("\0\12\0\23\0\0\0\0\0\0\1\0\377\1\376\3\0\2\0\2\0\2\0\2\0\2\0\2\0\2\0\2\0\0\0\0\0\0\0\0\0\0"));
$letter{'#'} = $#pixels+1;
    push (@pixels, &str2arr ("\0\17\0\23\0\0\0\0\0\0!\4\357=\336{\24C\4A\210 \210 P\20P\20\340\17\340\17\0\0\0\0\0\0\0\0\0\0"));
$letter{'T'} = $#pixels+1;
    push (@pixels, &str2arr ("\0\12\0\23\0\0\0\0\0\0\1\0\377\1\376\3\4\2\2\2\2\2\2\2\2\2\6\2\17\2\17\2\0\0\0\0\0\0\0\0\0\0"));
$letter{'-'} = $#pixels+1;
    push (@pixels, &str2arr ("\0\12\0\23\0\0\0\0\0\0\0\0\377\1\377\1\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0"));
$letter{')'} = $#pixels+1;
    push (@pixels, &str2arr ("\0\13\0\23\0\0\0\0\0\0A\0\307\1\216\3\34\7\270\4|\0\342\0\302\1\207\3\16\7\17\4\0\0\0\0\0\0\0\0\0\0"));
$letter{'+'} = $#pixels+1;
    push (@pixels, &str2arr ("\0\12\0\23\0\0\0\0\0\0\1\0\317\0\316\1J\3\43\2\1\2\3\3\3\3\206\1\376\1\376\1\0\0\0\0\0\0\0\0\0\0"));
$letter{'+'} = $#pixels+1;
    push (@pixels, &str2arr ("\0\12\0\23\0\0\0\0\0\0\1\0\317\0\316\1J\3\43\2\1\2\3\3\3\3\206\1\376\1\374\0\0\0\0\0\0\0\0\0\0\0"));
$letter{'Q'} = $#pixels+1;
    push (@pixels, &str2arr ("\0\13\0\23\0\0\0\0\0\0\1\0\377\3\376\7\0\4\0\4\10\2\10\2\10\1\210\0H\0H\0\10\0\10\0\10\0\10\0\10\0"));
$letter{'00'} = $#pixels+1;
    push (@pixels, &str2arr ("\0\3\0\23\0\0\0\0\2\7\2\0\0\0\2\7\2\0\0\0\0\0\0"));
$letter{':'} = $#pixels+1;
    push (@pixels, &str2arr ("\0\2\0\3\3\0\3"));
$letter{':A'} = $#pixels+1;
    push (@pixels, &str2arr ("\0\7\0\3\157\0\140"));
$letter{':E'} = $#pixels+1;
    push (@pixels, &str2arr ("\0\10\0\4\333\0\304\4"));
$letter{':F'} = $#pixels+1;
    push (@pixels, &str2arr ("\0\10\0\4\337\4\304\4"));
$letter{'A'} = $#pixels+1;
    push (@pixels, &str2arr ("\0\4\0\1\17"));
$letter{'F'} = $#pixels+1;
    push (@pixels, &str2arr ("\0\5\0\4\37\4\4\4"));
$letter{'E'} = $#pixels+1;
    push (@pixels, &str2arr ("\0\5\0\4\33\0\4\4"));
$letter{'"'} = $#pixels+1;
    push (@pixels, &str2arr ("\0\4\0\2\11\11"));
$letter{'I'} = $#pixels+1;
    push (@pixels, &str2arr ("\0\1\0\2\1\1"));
$letter{'U'} = $#pixels+1;
    push (@pixels, &str2arr ("\0\5\0\4\1\5\24\20"));
$dagesh{'B'} = 1032;
$dagesh{'C'} = 521;
$dagesh{'c'} = 1288;
$dagesh{'#'} = 2568;
$dagesh{'D'} = 1032;
$dagesh{'G'} = 264;
$dagesh{'('} = 1288;
$dagesh{'H'} = 1288;
$dagesh{')'} = 1288;
$dagesh{'K'} = 1032;
$dagesh{'k'} = 1288;
$dagesh{'+'} = 1289;
$dagesh{'L'} = 776;
$dagesh{'M'} = 1800;
$dagesh{'m'} = 1288;
$dagesh{'N'} = 520;
$dagesh{'n'} = 520;
$dagesh{'P'} = 1800;
$dagesh{'p'} = 1288;
$dagesh{'Q'} = 1544;
$dagesh{'R'} = 1288;
$dagesh{'S'} = 1288;
$dagesh{'T'} = 1544;
$dagesh{'W'} = 520;
$dagesh{'X'} = 1288;
$dagesh{'Y'} = 264;
$dagesh{'Z'} = 8;
}

sub size {
  local (@r, $left, $right, $upper, $lower, $lbyte, $w, $app, $i, $j, $x, $carry, $wbyte, $pad);
  @r = @_;
  $lower = pop (@r);
  $upper = pop (@r);
  $right = pop (@r);
  $left = pop (@r);
  if ($left) {
    $w = $r[0] + $left;
    while ($left > 7) {
      $left -= 8;
      $lbyte++;
    };
    while ($left < 0) {
      $left += 8;
      $lbyte--;
    };
    $app = $r[0] & 7;
    $app = ! $app || ($app + $left > 8);
    foreach $i (2..$#r) {
      if ($left) {
        if ($app) {
          $r[$i] .= chr (0);
        };
        $carry = 0;
        foreach $j (0 .. length ($r[$i])-1) {
          $x = (ord (substr ($r[$i], $j)) << $left) | $carry;
          $carry = $x >> 8;
          substr ($r[$i], $j, 1) = chr ($x & 0xff);
        };
      };
      for ($j=1; $j<=$lbyte; $j++) {
        $r[$i] = chr (0) . $r[$i];
      };
      if ($lbyte < 0) {
        $r[$i] = substr ($r[$i], -$lbyte);
      };
    };
    $r[0] = $w;
  };
  $w = $r[0] + $right;
  $wbyte = ($w+7) >> 3;
  if ($right) {
    $mask = (($wbyte+1) << 3) - $w - 8;
    $mask = ! ((17 << $mask) - 1) & 255;
    foreach $i (2..$#r) {
      while (length ($r[$i]) < $wbyte) {
        $r[$i] .= chr(0);
      };
      $r[$i] = substr ($r[$i], 0, $wbyte);
      substr ($r[$i], length ($r[$i])-1, 1) &= $mask;
    };
    $r[0] = $w;
  };
  if ($upper > 0 || $lower > 0) {
    $pad = '';
    for ($i=0; $i<$wbyte; $i++) {
      $pad .= chr(0);
    };
  };
  if ($upper) {
    for ($i=0; $i<$upper; $i++) {
      splice (@r, 2, 0, $pad);
    };
    if ($upper < 0) {
      splice (@r, 2, -$upper);
    };
    $r[1] += $upper;
  };
  if ($lower) {
    for ($i=0; $i<$lower; $i++) {
      push (@r, $pad);
    };
    if ($lower < 0) {
      splice (@r, $lower);
    };
    $r[1] += $lower;
  };
  return @r;
}

sub combine {
  local ($winc, $hinc, $i, $j);
  if ($_[0] > $T1[0]) {
    $winc = $_[0] - $T1[0];
  };
  if ($_[1] > $T1[1]) {
    $hinc = $_[1] - $T1[1];
  };
  if ($winc || $hinc) {
    @T1 = &size (@T1, 0, $winc, 0, $hinc);
  };
  foreach $i (2..$#_) {
    foreach $j (0 .. length ($_[$i])-1) {
      substr ($T1[$i], $j, 1) = chr (ord (substr ($T1[$i], $j, 1)) | ord (substr ($_[$i], $j, 1)));
    };
  };
}

sub append {
  local ($dist, $align) = @_;
  local ($l, $r, $lt);
  $l = $T1[0] - $T2[0];
  if ($lt = ($l < 0)) {
    $l = -$l;
  };
  if ($align =~ /^[Rr]/) {
  } elsif ($align =~ /^[Ll]/) {
    $r = $l;
    $l = 0;
  } else {
    $r = $l >> 1;
    $l -= $r;
  };
  if ($lt) {
    @T1 = &size (@T1, $l, $r, 0, 0);
    @T2 = &size (@T2, 0, 0, 0, $dist);
  } else {
    @T2 = &size (@T2, $l, $r, 0, $dist);
  };
  $T2[1] += $T1[1];
  @T2 = (@T2, @T1[2..$#T1]);
}

sub hebstring {
  local ($y, $il, $jl, @y);
  ($y = $_[0]) =~ s/(:[AEF]|\d\d|.|\n)/$1,/g;
  chop $y;
  foreach $y (split (',', $y)) {
    if ($output_t) {
      print (OUTT "<$y> ");
    };
    if ($y eq ' ') {
      @T1 = &size (@T1, 9-$Dist, 0, 0, 0);
      next;
    } elsif ($y eq '.') {
      &combine (&size (1, 2, chr(1), chr(1), $DageshW, 0, $DageshH, 0));
      next;
    } elsif ($y eq 'h') {
      &combine (13, 2, "\0\20", "\0\20");
      next;
    } elsif ($y eq 'O') {
      if ($Lamed) {
        @T1 = &size (@T1, 2, 0, 0, 0);
        &combine (1, 2, chr(1), chr(1));
        $Dist = 2;
      } else {
        &combine (2, 2, chr(2), chr(2));
      };
      next;
    } elsif ($y eq "\n") {
      &append (1, 'right');         
      @T1 = (0, 0);
      next;
    };
    next unless $letter{$y};

    $il = $letter{$y};
    $jl = $il + $pixels[$il+1] + 1;
    if ($pixels[$il+1] == 19) {
      $Lamed = ($y eq 'L');
      $DageshW = $DageshH = $dagesh{$y};
      $DageshW >>= 8;
      $DageshH &= 255;
      if ($y =~ /[DWR]/) {
        $ChireqW = $pixels[$il] - ($y eq 'D' ? 2 : 1);
      } else {
        $ChireqW = ($pixels[$il] >> 1) + ($y =~ /[Q\#(]/ ? 1 : 0);
      };
      if ($y =~ /[kn]/) {
        $ChireqH = 9;
      } else {
        $ChireqH = 15;
      };
      @T1 = &size (@T1, $pixels[$il]+2-$Dist, 0, 0, 0);
      &combine (@pixels[$il..$jl]);
      $Dist = 0;
    } else {
      $ChireqW -= $pixels[$il] >> 1;
      &combine (&size (@pixels[$il..$jl], $ChireqW, 0, $ChireqH, 0));
    };
  };
}

sub typo {
  local ($r) = $_[0];
  $r =~ s/\?//g;
  $r =~ s/O(\d*)W([^.:AFE"IOU]|\n)/$1o$2/g;
  $r =~ s/O(\d*)\$/$1\$/g;
  $r =~ s/\$/\#h/g;
  $r =~ s/\&O?/\#O/g;
  $r =~ s/([^ ])([KMNPC])([0-9.:AFE"IOU]*)(\n|-| |$)/$1.chr(ord($2)+32)."$3$4"/ge;
  return $r;
}

sub str2oct {
  local ($r, $c, $cc, $rr);
  foreach $c (split ('', $_[0]), 'X') {
    $cc = ord ($c);
    if ($rr) {
      if ($cc >= 48 && $cc <= 57) {
        $r .= "\\$rr";
      } else {
        $rr =~ /^0?0?/;
        $r .= "\\$'";
      };
      $rr = '';
    };
    if ($c =~ /[ !'-?A-Z^-~]/) {
      $r .= $c;
    } else {
      $rr = sprintf ("%3.3o", $cc);
    };
  };
  chop $r;
  return $r;
}

sub letter {
  local ($n, $l) = @_;
  local ($s, $c, $cc);
  open (LET, "<$n.xbm") || die "unable to open $n";
  read (LET, $s, 10000);
  close (LET);
  print (ALF "\$letter{'$l'} = \"", &str2oct (&xbm2str($s)), "\";\n");
}

sub xbm2str {
  local ($x) = $_[0];
  local ($w, $h, $r, @x);
  $x =~ s/\s//g;
  if ($x =~ /^\#define.+_width(\d+)\#define.+_height(\d+)staticunsignedchar.+_bits\[\]=\{(.+)\};$/) {
    $w = $1;
    $h = $2;
    $x = $3;
    $r = chr($w>>8) . chr($w&0xff) . chr($h>>8) . chr($h&0xff);
    @x = split (/,/, $x);
    foreach $x (@x) {
      $r .= chr(oct($x));
    };
  };
  return $r;
}

sub str2arr {
  local ($x) = $_[0];
  local (@r, $bw, $i, $j);
  if (!$n) {
    $n = 'x';
  };
  $r[0] = ord(substr($x,0)) << 8 | ord(substr($x,1));
  $r[1] = ord(substr($x,2)) << 8 | ord(substr($x,3));
  $bw = ($r[0]+7) >> 3;
  $j = 2;
  for ($i=4; $j<=$r[1]+1; $i+=$bw) {
    $r[$j++] = substr ($x, $i, $bw);
  };

  return @r;
}

sub arr2xbm { 
  # global variable: name
  local ($n, $r, $s, $i);
  if ($name) {
    $n = $name;
  } else {
    $n = 'x';
  };
  if ($output_o) {
    print (OUTO "\#define $n\_width $_[0]\n\#define $n\_height $_[1]\nstatic unsigned char $n\_bits[] = \{");
    $s = join ('', @_[2..$#_]);
    foreach $i (0 .. length($s)-1) {
      if (($i % 10) == 0) {
	print (OUTO "\n  ");
      };
      printf (OUTO " 0x%2.2x", ord(substr($s,$i)));
      if ($i < length($s)-1) {
	print (OUTO ',');
      };
    };
    print (OUTO "};\n");
  };
}