#!/usr/bin/perl -w
#
# We make one set of xpms for every (segment,[movfeat])
# For each (segment,[movfeat]) there is one `off' bitmap, a mask.
# For (segment,nil) there are also `on' and `detect' pixmaps.
# For (segment,movfeat) there are `on' and `detect' XPMs for each posn.
# (The `on' and `detect' XPMs share the actual pixel data.)

use strict qw(vars);
use POSIX;
use IO::Handle;

#---------- general ----------

sub seteq ($$$) {
    my ($r,$v,$w)= @_;
    if (defined $$r) {
	$$r eq $v or die "$v $$r $w ?";
    } else {
	$$r= $v;
    }
}

#---------- word-reading (for pbm) ----------

our $txtrdbuf= '';

sub w () {
    for (;;) {
	if ($txtrdbuf =~ s/^\s*(\S+)\s?//) {
#print STDERR "w>$1<\n";
	    return $1;
	}
	$!=0; $txtrdbuf=<>;
	die $! unless length $txtrdbuf;
	$txtrdbuf='' if $txtrdbuf =~ m/^\s*\#/;
    }
}

sub wn ($$) {
    my ($wn);
    $wn= w();
    die "$wn ?" unless $wn =~ m/^(?:[1-9]\d*|0)$/;
    die "$wn $_[0]..$_[1] ?" if $wn < $_[0] || $wn > $_[1];
    return $wn;
}
sub wns ($$$) {
    my (@wns);
    while (@wns < $_[2]) { push @wns, wn($_[0],$_[1]); }
    return @wns;
}

#---------- xpm data structure ----------

our(%xpmdata);
# $xpmdata{$style}{$namerhs}{X}{Min}
# $xpmdata{$style}{$namerhs}{X}{Max}
# $xpmdata{$style}{$namerhs}{Y}{Min}
# $xpmdata{$style}{$namerhs}{Y}{Max}
# $xpmdata{$style}{$namerhs}{Pixels}{$y}{$x}
# $xpmdata{$style}{$namerhs}{Holey}
# $xpminstance{$instancename}{Data}= $xpmname

sub xpmdata_setup ($$$) {
    my ($style, $namerhs, $holey)=@_;
    my ($xp,$xy);
    die if $xpmdata{$style}{$namerhs};
    $xp= $xpmdata{$style}{$namerhs}= {
	Holey => $holey,
	};
}

#---------- parse args ----------

our $gvarname= 'ui_plan_data';

die unless @ARGV;
die if $ARGV[0] =~ m/^\-/;
if ($ARGV[$#ARGV] =~ s/^\-g//) {
    $gvarname= pop @ARGV;
    $gvarname =~ s/\W/_/g;
}

#---------- read segcmap ----------

our (%datum_numbits,%datum_basebit);
# $datum_numbits{Segname} etc.

our (@segnum_name,%movfeats,%movfeat_prefix,%movfeat_configbits);
# $segnum_name[$segnum]= $segname;
# $movfeats{$segname}[$i]= $xpmname
# $movfeat_prefix{$xpmname}
# $movfeat_configbits{$xpmname}

xpmdata_setup('background','',1);

for (;;) {
    $!=0; defined($_=<>) or die $!;
#print STDERR "p>$_<\n";
    last if m/^E$/;
    if (m/^B (\w+) (\d+) (\d+)$/) {
	$datum_numbits{$1}= $2;
	$datum_basebit{$1}= $3;
    } elsif (m/^S ([0-9A-Z]+) (0x[0-9a-f]+)$/) {
	seteq(\$segnum_name[hex $2], $1, "segnum $2");
	xpmdata_setup("bitmap","m_$1",1);
	xpmdata_setup("on","_$1",1);
	xpmdata_setup("bitmap","e_$1",1);
    } elsif (m/^F ([0-9A-Z]+) (0x[0-9a-f]+) ([A-Z]+) (0x[0-9a-f]+) (\d+)$/) {
	my ($xpmname,$bitno,$namerhs);
	seteq(\$segnum_name[hex $2], $1, "segnum $2 F $3");
	push @{ $movfeats{$1} }, $3;
	$xpmname= $1.'_'.$3;
	$movfeat_prefix{$xpmname}= hex $4;
	$movfeat_configbits{$xpmname}= $5;
	xpmdata_setup("on","u_$xpmname",1);
	xpmdata_setup("bitmap","m_$xpmname",1);
	for ($bitno=0; $bitno<$movfeat_configbits{$xpmname}; $bitno++) {
	    $namerhs= "${xpmname}_${bitno}";
	    xpmdata_setup("on","_$namerhs",1);
	    xpmdata_setup("bitmap","e_$namerhs",1);
	}
    }
}

sub ang2pixchars ($) {
    die if $datum_numbits{Angle} > 6;
    die if $_[0] > 64;
    return substr('0123456789'.
		  'abcdefghijklmnopqrstuvwxyz'.
		  'ABCDEFGHIJKLMNOPQRSTUVWXYZ'.
		  '@#',
		  $_[0], 1);
}		  

#---------- read input image ----------

our(%sz,%overall);
# $sz{X}
# $sz{Y}
# $overall{X|Y}{Min|Max}

sub xpm_sizes () {
    my ($rr,$xp,$xy);
print STDERR "xpm_sizes\n";
    foreach $rr (values %xpmdata) {
	foreach $xp (values %$rr) {
	    foreach $xy (qw(X Y)) {
		$xp->{$xy}{Min}= $sz{$xy}-1;
		$xp->{$xy}{Max}= 0;
	    }
	}
    }
    foreach $xy (qw(X Y)) {
	$overall{$xy}{Min}= $sz{$xy}-1;
	$overall{$xy}{Max}= 0;
    }
}

#---------- read input pixels ----------

our(%p,$pp);
# $p{X}
# $p{Y}
# $p{Movpos}

sub xpmdata_pixel ($$$) {
    my ($style,$namerhs,$pcharstr)=@_;
    my ($xp,$pk,$xy,$was,$mima);
#printf STDERR "%s  %s %s \`%s'", $pp, $style, $namerhs, $pcharstr;
    $xp= $xpmdata{$style}{$namerhs};
    defined $xp or die "$pp: $style $namerhs ?";
    foreach $xy (qw(X Y)) {
	foreach $mima ($xp->{$xy}, $overall{$xy}) {
	    $mima->{Min}= $p{$xy} if $p{$xy} < $mima->{Min};
	    $mima->{Max}= $p{$xy} if $p{$xy} > $mima->{Max};
	}
    }
    $was= $xp->{Pixels}{$p{Y}}{$p{X}};
    if (defined($was) && $was gt $pcharstr) {
#print STDERR " already \`$was'\n";
	return;
    }
#    die "$pp $style $namerhs \`$pcharstr',\`$xp->{Pixels}{$p{Y}}{$p{X}}' ?"
#	
    $xp->{Pixels}{$p{Y}}{$p{X}}= $pcharstr;
#print STDERR " set\n";
}

sub in_pixel ($) {
    my ($pbytes) = @_;
    my ($namerhs,$movfeat,%t,$xpmname,$segname,$datum,$k,$angstr,$bitno,$me);
    $pp= "$ARGV $p{X} $p{Y}";
    $datum= unpack 'V', $pbytes."\0";
    foreach $k (keys %datum_numbits) {
	$t{$k}= ($datum >> $datum_basebit{$k}) &
	    ((1 << $datum_numbits{$k}) - 1);
    }
#printf(STDERR "%s 0x%08lx 0x%x 0x%x %d\n",$pp,$datum,
#       $t{Segnum},$t{Movfeatpos},$t{Edge});
    if (!$t{Segnum}) {
	xpmdata_pixel('background','','=')
	    unless $t{Edge};
	return;
    } else {
	xpmdata_pixel('background','','!')
	    unless $t{Edge};
    }
    $segname= $segnum_name[$t{Segnum}];
    defined $segname or die "$pp $t{Segnum} $datum";
    $pp.= " $segname";

    $angstr= ang2pixchars($t{Angle});

    if (!$t{Movfeatpos}) {
	$xpmname= $segname;
	xpmdata_pixel("on","_$xpmname", $angstr)
	    unless $t{Edge};
	xpmdata_pixel("bitmap", "e_${xpmname}", '*')
	    if $t{Edge};
	xpmdata_pixel("bitmap", "m_${segname}", '*');
    } else {
	my ($found, $yes);
	$found= undef;
	foreach $movfeat (@{ $movfeats{$segname} }) {
	    $xpmname= $segname.'_'.$movfeat;
	    if (($t{Movfeatpos} & ~((1<< $movfeat_configbits{$xpmname})-1))
		== $movfeat_prefix{$xpmname}) {
		die "$pp $t{Movfeatpos} $found $movfeat"
		    if defined $found;
		$found= $movfeat;
	    }
	}
	die "$pp $t{Movfeatpos}"
	    unless defined $found;
	$xpmname= $segname.'_'.$found;
	xpmdata_pixel("on", "u_${xpmname}",
		      (($p{X} + $p{Y}) % 2) ? $angstr : '!')
	    unless $t{Edge};
	xpmdata_pixel("bitmap", "m_${xpmname}", '*');
	for ($bitno=0; $bitno < $movfeat_configbits{$xpmname}; $bitno++) {
	    $namerhs= "${xpmname}_${bitno}";
	    $yes= $p{Movpos} == $bitno;
	    xpmdata_pixel("on","_$namerhs", $yes ? $angstr : '!')
		unless $t{Edge};
	    xpmdata_pixel("bitmap","e_$namerhs", $yes ? '*' : ' ')
		if $t{Edge};
	}
    }
}

#---------- read input pixmaps

sub read_pixmap_header () {
    my (@szn,$osz);
    @szn= wns(1,32767,2);
    if (exists $sz{X}) {
	$osz= "$sz{X} $sz{Y}";
	"@szn" eq "$osz" or die "$osz @szn ?";
    } else {
	($sz{X},$sz{Y})= @szn;
	xpm_sizes();
    }
    wn(1,65535)==255 or die;
}

for (;;) {
    die "$txtrdbuf ?" if length $txtrdbuf;
    $txtrdbuf= <>;
    if (!defined $txtrdbuf) {
	die $! unless ARGV->eof;
	last;
    }
    w() eq 'P6' or die;
    read_pixmap_header();
    $ARGV =~ m/.*\.p([0-9a-f]+)\b/ or die "$ARGV ?";
    $p{Movpos}= $1 eq 'f' ? '' : hex($1);
    my ($pbytes,$x,$xsz);
    $xsz= $sz{X};
    for ($p{Y}=0; $p{Y}<$sz{Y}; $p{Y}++) {
	printf STDERR "%s %d\r",$ARGV,$p{Y}
	    unless $p{Y} % 100;
	for ($x=0; $x<$xsz; $x++) {
	    $!=0; read(ARGV, $pbytes, 3) == 3 or die $!;
	    next if $pbytes eq "\xff\xff\xff";
	    $p{X}= $x;
	    in_pixel($pbytes);
	}
    }
}

#---------- colourmaps ----------

our (%cmap,%stylecmaps);
# $stylecmaps{$style}= [ $cmapname,... ]
# $cmap{$cmapname}{$pixchars}= $xpm_data_string_rhs
# $cmap{$cmapname}{''}= [ string names for including in xpm ]
#                          (after cmapdata_output_all)
$cmap{''}= {}; # fixed colours

sub xpm_cmap ($$) {
    my ($style,$cmapname) = @_;
    die "$cmapname ?" if exists $cmap{$cmapname};
    push @{ $stylecmaps{$style} }, $cmapname;
    $cmap{$cmapname}= { };
}

sub xpm_cmap_entry ($$$) {
    my ($cmapname,$pixchars,$rhs) = @_;
    die "$cmapname ?" unless exists $cmap{$cmapname};
    die "$cmapname $pixchars ?" if exists $cmap{$cmapname}{$pixchars};
    $cmap{$cmapname}{$pixchars}= $rhs;
}

sub xpm_cmap_rgbpermil($@) {
    my ($cmapname, @l) = @_;
    my ($pixchars, @rgb);
    die "$cmapname @l ?" if @l % 4;
    while (@l) {
	($pixchars, @rgb)= @l[0..3];  @l = @l[4..$#l];
	xpm_cmap_entry($cmapname, $pixchars,
		       sprintf("c #%04x%04x%04x",
			       map { floor($_ * 65.535 + 0.5) } @rgb));
    }
}

sub xpm_cmap_fixedbitmap($$) {
    my ($cmapname,$on) = @_;
    xpm_cmap_entry($cmapname,' ','s space');
    xpm_cmap_entry($cmapname,$on,'s mark');
}

sub angle_to_colour ($) {
    my ($angle) = @_;
    my ($s,$f,$u,$U,$d,$D,$R);
    
    $s= floor($angle);
    $f= $angle - $s;
  
    $u= $f * 0.5;
    $U= $u + 0.5;
    $d= 0.5 - $u;
    $D= $d + 0.5; 

#print STDERR "a>$u|$U|$d|$D|$s<\n";

    $R= ([ $D, $U,  0 ],
	 [ $d,  1, $u ],
	 [  0, $D, $U ],
	 [ $u, $d,  1 ],
	 [ $U,  0, $D ],
	 [  1, $u, $d ])[$s];
    $R->[1] *= 0.9;
    $R->[2] *= 0.9;
    return @$R;
}

sub xpm_cmap_angular($$$@) {
    my ($cmapname, $invert, $alpha, @basergb) = @_;
    my ($angnum,$angval,@permil,@angrgb,$i);
    for ($angnum=0; $angnum<(1<<$datum_numbits{Angle}); $angnum++) {
	$angval= 6.0 * ($angnum+0.0) / (1<<$datum_numbits{Angle});
	$angval += 3.0 if $invert;
	$angval -= 6.0 if $angval >= 6.0;
	@angrgb= angle_to_colour($angval);
	for ($i=0; $i<3; $i++) {
#print STDERR ">$cmapname|$i|$alpha|$angrgb[$i]|$basergb[$i]<\n";
	    $permil[$i]= $alpha * $angrgb[$i] +
		         (1.0 - $alpha/1000.0) * $basergb[$i];
	}
	xpm_cmap_rgbpermil($cmapname, ang2pixchars($angnum), @permil);
    }
}

sub cmaps_define () {
    my ($style,$inv,$ondet);
    my (@background, @projected, @off, @otherposn);

    @background= qw(100 100 100);
    @off= qw(0 0 0);
    @otherposn= qw(50 50 50);
    @projected= qw(75 75 75);
    
    xpm_cmap("background","background");
    xpm_cmap_rgbpermil("background",
		       ' ', @background,
		       '=', @projected,
		       '!', @off);

    xpm_cmap("bitmap","bitmap");
    xpm_cmap_fixedbitmap("bitmap",'*');
    
    foreach $inv (('','i')) {
	foreach $ondet (qw(on det)) {
	    xpm_cmap("on","${inv}${ondet}");
	    xpm_cmap_rgbpermil("${inv}${ondet}",
			       ' ', @background,
			       '!', @otherposn);
	}
	xpm_cmap_angular("${inv}on", !!$inv, 650, qw(0 0 0));
	xpm_cmap_angular("${inv}det",!!$inv, 650, qw(1000 1000 1000));
    }
}

cmaps_define();

#---------- output ----------

sub cmapdata_output_all () {
    my ($cmapname, $stuff, $cmap, $sname, $pixchars);

    foreach $cmapname (sort keys %cmap) {
	next unless length $cmapname;
	$stuff= [ ];
	$cmap= $cmap{$cmapname};
	foreach $pixchars (sort keys %$cmap) {
	    $sname= "m_${cmapname}_". unpack "H*", $pixchars;
	    printf("static const char %s[]= \"%s %s\";\n",
		   $sname, $pixchars, $cmap->{$pixchars})
		or die $!;
	    push @$stuff, $sname;
	}
	$cmap->{''}= $stuff;
    }

    my ($colour, $rhs);
    $cmap= $cmap{''};
    foreach $colour (sort keys %$cmap) {
	$rhs= $cmap->{$colour};
	$rhs =~ s/^c // or die "$colour $rhs ?";
	printf("const char ui_plan_colour_%s[]= \"%s\";\n",
	       $colour, $rhs)
	    or die $!;
    }
}

sub xpmdata_output_all () {
    my ($style, $namerhs, $xp, $row, $pp, $xy, $pixel);
    my ($y, $cmap_data, $header_data, $cmapname);
    foreach $style (sort keys %xpmdata) {
	foreach $namerhs (sort keys %{ $xpmdata{$style} }) {
	    $xp= $xpmdata{$style}{$namerhs};
	    $header_data= "";
	    foreach $xy (qw(X Y)) {
		$xp->{$xy}{Max}= $xp->{$xy}{Min} if
		    $xp->{$xy}{Max} < $xp->{$xy}{Min};
		$header_data .= $xp->{$xy}{Max} - $xp->{$xy}{Min} + 1;
		$header_data .= " ";
	    }
	    for ($p{Y}=$xp->{Y}{Min}; $p{Y}<=$xp->{Y}{Max}; $p{Y}++) {
		printf "static const char d%04d_%s_%s[]= \"",
		    $p{Y}, $style, $namerhs or die $!;
		$row= $xp->{Pixels}{$p{Y}};
		$pp= "$style $namerhs $p{X} $p{Y}";
		for ($p{X}=$xp->{X}{Min}; $p{X}<=$xp->{X}{Max}; $p{X}++) {
		    $pixel= $row->{$p{X}};
		    if (!defined $pixel) {
			die "$pp ?" if !$xp->{Holey};
			$pixel= ' ';
		    }
		    print $pixel or die $!;
		}
		print "\";\n" or die $!;
	    }
#printf STDERR "style >$style<\n";
	    foreach $cmapname (sort @{ $stylecmaps{$style} }) {
		$cmap_data= $cmap{$cmapname}{''};
		printf("static const char *p_%s_%s[]= {\n".
		       "  \"%s%d 1\",\n",
		       $cmapname, $namerhs,
		       $header_data, scalar(@$cmap_data))
		    or die $!;
		map { printf "  %s,\n", $_ or die $!; } @$cmap_data;
		for ($y=$xp->{Y}{Min}; $y<=$xp->{Y}{Max}; $y++) {
		    printf "  d%04d_%s_%s,\n", $y, $style, $namerhs
			or die $!;
		}
		print("  0\n".
		      "};\n")
		    or die $!;
	    }
	}
    }
}

sub ppdr ($$$) {
    my ($style,$cmap,$namerhs) = @_;
    my ($xpmd);
    $xpmd= $xpmdata{$style}{$namerhs};
defined $xpmd or die "$style $cmap $namerhs ?";
    return sprintf("{ %d-%d,%d-%d, p_%s_%s }",
		   (map { $xpmd->{$_}{Min}, $overall{$_}{Min} } qw(X Y)),
		   $cmap, $namerhs);
}

sub ppdiondet ($) {
    my ($dname) = @_;
    return ("{ { ".ppdr('on',"on",$dname).", ".ppdr('on',"det",$dname)." },".
	    " { ".ppdr('on',"ion",$dname).", ".ppdr('on',"idet",$dname).
	    " } }");
}

our (@oodnames, %ood);
# $ood{$oodname}{Data}= $data_so_far
# $ood{$oodname}{ArrayDelim}= "\n" or ",\n" but for oodas only

sub oods ($$) {
    my ($oodname, $data) = @_;
    die "$oodname {{$data}} ?" if exists $ood{$oodname};
    $ood{$oodname}{Data}= $data;
    push @oodnames, $oodname;
}

sub ooda0 ($$) {
    my ($oodname, $begin) = @_;
    die "$oodname {{$begin}} ?" if exists $ood{$oodname};
    $ood{$oodname}{Data}= $begin;
    $ood{$oodname}{Data} .= "[]= {";
    $ood{$oodname}{ArrayDelim}= "\n";
    push @oodnames, $oodname;
}

sub ooda1 ($$) {
    my ($oodname, $entry) = @_;
    die "$oodname {{$entry}} ?" unless defined $ood{$oodname}{ArrayDelim};
    $ood{$oodname}{Data} .= $ood{$oodname}{ArrayDelim};
    $ood{$oodname}{Data} .= "  ".$entry;
    $ood{$oodname}{ArrayDelim}= ",\n";
}

sub ood_output_all () {
    my ($oodname, $ood);
    foreach $oodname (reverse @oodnames) {
	$ood= $ood{$oodname};
	print $ood->{Data} or die $!;
	if (defined $ood->{ArrayDelim}) {
	    print "\n};\n" or die $!;
	}
    }
}

sub plandata_output_all () {
    my ($i, @segnames, $segname);
    my (@movfeats, $movfeat, $dname, $xpmname, $n_posns, $code, $posn);
    my ($n_movfeats, $style, $xpmd, $pedge, $me, $noppdr);

    for ($i=1; $i<@segnum_name; $i++) {
	$segname= $segnum_name[$i];
	next unless defined $segname;
	push @segnames, $segname;
    }

    oods('ui_plan_data',
	 "const PlanData $gvarname= {\n".
	 "  $overall{X}{Max}-$overall{X}{Min},".
	 "  $overall{Y}{Max}-$overall{Y}{Min},".
	 "  p_background_,\n".
	 "  ".scalar(@segnames).", segments\n".
	 "};\n");

    ooda0('segments',
	  "static const PlanSegmentData segments");

    foreach $segname (sort @segnames) {
	@movfeats=
	    exists $movfeats{$segname} ? @{ $movfeats{$segname} } : ();
	unshift @movfeats, '';

	ooda0("mf_$segname",
	      "static const PlanSegmovfeatData mf_$segname");

	ooda1("segments",
	      "{ \"$segname\", ".scalar(@movfeats).", mf_$segname }");

	foreach $movfeat (sort @movfeats) {
	    if (!length $movfeat) {
		$xpmname= $segname;
		$n_posns= 1;
		$code= '0';
	    } else {
		$xpmname= "${segname}_${movfeat}";
		$n_posns= $movfeat_configbits{$xpmname};
		$code= "\"$movfeat\"";
	    }
#print STDERR ">$segname|$movfeat<\n";
	    $noppdr= "{-1,-1,0}";
	    ooda1("mf_$segname",
		  "{ $code, ".ppdr('bitmap',"bitmap","m_$xpmname").", ".
		  ($n_posns > 1 ? ppdiondet("u_$xpmname") :
		   "{ { $noppdr, $noppdr }, { $noppdr, $noppdr } }").
		  ", $n_posns, posns_$xpmname }");

	    ooda0("posns_$xpmname",
		  "static const PlanPixmapOnData posns_$xpmname");
	    
	    for ($posn=0; $posn < $n_posns; $posn++) {
		if ($movfeat eq '') {
		    $dname= $segname;
		    $pedge= 'edge';
		} else {
		    $dname= sprintf "%s_%s_%d", $segname, $movfeat, $posn;
		    $pedge= 'pedge';
		}
		ooda1("posns_$xpmname",
		      "{ ".ppdr('bitmap',"bitmap","e_$dname").",".
		      " ".ppdiondet("_$dname")." }");
	    }
	}
    }
}

print "#include \"plan-data-format.h\"\n" or die $!;
cmapdata_output_all();
xpmdata_output_all();
plandata_output_all();
ood_output_all();