#! /client/bin/perl

# convert ascii pixel image to xpm file

$P2{'-'} = 'none';          # farblos
$P2{' '} = '#FFFFFFFFFFFF'; # weiß
$P2{'o'} = '#D7D7D7D7D7D7'; # hellgrau
$P2{'O'} = '#808080808080'; # grau
$P2{'@'} = '#404040404040'; # dunkelgrau
$P2{'#'} = '#000000000000'; # schwarz
$P2{"'"} = '#FFFF88888888'; # altrosa
$P2{'|'} = '#FFFF00000000'; # rot
$P2{'.'} = '#FFFFCCCCCCCC'; # elfenbein
$P2{':'} = '#FFFF00000000'; # gelb
$P2{'x'} = '#FFFF80004000'; # orange
$P2{'*'} = '#FFFFD7D70000'; # gold
$P2{'X'} = '#B0B060604040'; # braun
$P2{'`'} = '#4444FFFF0000'; # hellgrün
$P2{'\\'} = '#0000FFFF0000'; # grün
$P2{'V'} = '#444488880000'; # dunkelgrün
$P2{'='} = '#00008000FFFF'; # himmelblau
$P2{'F'} = '#00000000FFFF'; # blau
$P2{'E'} = '#6A6A5A5ACCCC'; # preußischblau
$P2{','} = '#FFFFCCCCFFFF'; # blasslila
$P2{'/'} = '#FFFF0000FFFF'; # lila
$P2{'A'} = '#88880000CCCC'; # violett

# read command line parameters

foreach $o (@ARGV) {
  $x = "$oo$o";
  $oo = '';
  if ($x =~/^-[mc]$/) {
    $oo = $x;
  } elsif ($x =~ /^(.)=(.*)$/) {
    $x = $1;
    $y = &colour ($2);
    $P1{$x} = $y;
  } elsif ($x =~/^-m(.*)$/) {
    @margins = split (/,/, $1);
    if ($#margins == 0) {
      $margins[1] = $margins[0];
    };
    if ($#margins == 1) {
      $margins[2] = $margins[1];
    };
    if ($#margins == 2) {
      $margins[3] = $margins[0];
    };
  } elsif ($x =~/^-c(.)$/) {
    $margin = $1;
  } else {
    die "unrecognisable option \"$x\"";
  };
};

# read input file

while (<STDIN>) {
  chop;
  if (/"[^"]*$/) {
    $_ = $`;
  };
  if (/"/) {
    $_ = $';
  };
  if (/"/) {
    die "line contains quotes";
  }
  if (/^\s*(.)\tc (none|\#[0-9A-Fa-f]{12})\s*$/) {
    $x = $1;
    $y = $2;
    $y =~ tr/a-f/A-F/;
    $P2{$x} = $y;
    undef @T;
  } else {
    push (@T, $_);
  };
};

# make sure all symbols are defined, determine width

$mn = -1;
for ($i=0; $i<=$#T; $i++) {
  if (($l = length ($T[$i])) > $mx) {
    $mx = $l;
  };
  if ($mn < 0 || $l < $mn) {
    $mn = $l;
  };
  foreach $x (split (//, $T[$i])) {
    &set_colour ($x);
  };
};

# decide whether additional symbol for margin is needed; if so, define it

$exmarg = $margins[0] ne '' || $margins[1] ne '' || $margins[0] ne '' || $margins[0] ne '';

if ($exmarg || $mn != $mx) {
  if ($margin) {
    &set_colour ($margin);
  } else {
    foreach $x (keys %P) {
      if ($P{$x} eq 'none') {
        $margin = $x;
        last;
      };
    };
    if (!$margin) {
      foreach $x (keys %P1) {
        if ($P1{$x} eq 'none') {
          $margin = $x;
          &set_colour ($margin);
          last;
        };
      };
    };
    if (!$margin) {
      for ($i=32; $i<=255; $i++) {
        next if ($i == 34 || ($i >= 127 && $i <= 160));
        $x = chr($i);
        if (!$P{$x}) {
          $P{$x} = 'none';
          $margin = $x;
          $p++;
          last;
        };
      };
    };
  };
};

# trim picture

if ($exmarg) {
  if ($margins[0] ne '') {
    while ($T[0] =~ /^[$margin]*$/) {
      shift @T;
    };
  };
  if ($margins[3] ne '') {
    while ($T[$#T] =~ /^[$margin]*$/) {
      pop @T;
    };
  };
  $lm = $mx;
  $rm = $mx;
  for ($i=0; $i<$#T; $i++) {
# print (STDERR "«$T[$i]» «/^([^$margin]*)([$margin]|[$margin].*[$margin])([^$margin]*)\$/»\n");
    if ($T[$i] =~ /^([^$margin]*)([$margin]|[$margin].*[$margin])([^$margin]*)$/) {
      $x = length $1;
      $y = length $3;
# print (STDERR "«$T[$i]», $x, $y\n");
      if ($x < $lm) {
        $lm = $x;
      };
      if ($y < $rm) {
        $rm = $y;
      };
      last if !($lm || $rm);
    } else {
      $rm = $lm = 0;
      last;
    };
  };
};

if ($margins[1] ne '') {
  $w = $mx - $lm + $margins[1];
} else {
  $w = $mx;
};

if ($margins[2] ne '') {
  $w = $w - $rm + $margins[2];
};

$h = $#T + 1 + $margins[0] + $margins[3];

# print header info

print "/* XPM */\nstatic char * image_name[] = {\n\"$w $h $p 1\"";

foreach $x (keys %P) {
  print ",\n\"$x\tc $P{$x}\"";
};

# print picture

$prefix = ",\n\"" . ($margin x $margins[1]);
$lrest = $w - $margins[1];
$empty = $margin x $w;
$emptyl = ",\n\"" . $empty . '"';

for ($i=0; $i<$margins[0]; $i++) {
  print $emptyl;
};

for ($i=0; $i<$#T; $i++) {
  print $prefix . substr ($T[$i].$empty, $lm, $lrest) . '"';
};

for ($i=0; $i<$margins[3]; $i++) {
  print $emptyl;
};

print "};\n";


#   s u b r o u t i n e s 

sub colour {
  local ($x) = $_[0];

  if ($x =~ /^none$/i) {
    return 'none';
  } elsif  ($x =~ /^[#]?([0-9A-Fa-f]{12})\s*$/i) {
    $x = $1;
    $x =~ tr/a-f/A-F/;
    return "\#$x";
  } else {
    die "unrecognisable colour \"$x\"";
  };
}

sub set_colour {
  local ($x) = $_[0];
  local ($y);

  if (!$P{$x}) {
    if (($y = $P1{$x}) || ($y = $P2{$x})) {
      $P{$x} = $y;
    } else {
      $unknown++;
      print (STDERR "undefined character \"$x\"\n");
      $P{$x} = sprintf ("\#%12.12d", $unknown);
    };
    $p++;
  };
}