3 # We make one set of xpms for every (segment,[movfeat])
4 # For each (segment,[movfeat]) there is one `off' bitmap, a mask.
5 # For (segment,nil) there are also `on' and `detect' pixmaps.
6 # For (segment,movfeat) there are `on' and `detect' XPMs for each posn.
7 # (The `on' and `detect' XPMs share the actual pixel data.)
13 #---------- general ----------
18 $$r eq $v or die "$v $$r $w ?";
24 #---------- word-reading (for pbm) ----------
30 if ($txtrdbuf =~ s/^\s*(\S+)\s?//) {
31 #print STDERR "w>$1<\n";
35 die $! unless length $txtrdbuf;
36 $txtrdbuf='' if $txtrdbuf =~ m/^\s*\#/;
43 die "$wn ?" unless $wn =~ m/^(?:[1-9]\d*|0)$/;
44 die "$wn $_[0]..$_[1] ?" if $wn < $_[0] || $wn > $_[1];
49 while (@wns < $_[2]) { push @wns, wn($_[0],$_[1]); }
53 #---------- xpm data structure ----------
56 # $xpmdata{$style}{$namerhs}{X}{Min}
57 # $xpmdata{$style}{$namerhs}{X}{Max}
58 # $xpmdata{$style}{$namerhs}{Y}{Min}
59 # $xpmdata{$style}{$namerhs}{Y}{Max}
60 # $xpmdata{$style}{$namerhs}{Pixels}{$y}{$x}
61 # $xpmdata{$style}{$namerhs}{Holey}
62 # $xpminstance{$instancename}{Data}= $xpmname
64 sub xpmdata_setup ($$$) {
65 my ($style, $namerhs, $holey)=@_;
67 die if $xpmdata{$style}{$namerhs};
68 $xp= $xpmdata{$style}{$namerhs}= {
73 #---------- parse args ----------
75 our $gvarname= 'ui_plan_data';
78 die if $ARGV[0] =~ m/^\-/;
79 if ($ARGV[$#ARGV] =~ s/^\-g//) {
81 $gvarname =~ s/\W/_/g;
84 #---------- read segcmap ----------
86 our (%datum_numbits,%datum_basebit);
87 # $datum_numbits{Segname} etc.
89 our (@segnum_name,%movfeats,%movfeat_prefix,%movfeat_configbits);
90 # $segnum_name[$segnum]= $segname;
91 # $movfeats{$segname}[$i]= $xpmname
92 # $movfeat_prefix{$xpmname}
93 # $movfeat_configbits{$xpmname}
95 xpmdata_setup('background','',1);
98 $!=0; defined($_=<>) or die $!;
99 #print STDERR "p>$_<\n";
101 if (m/^B (\w+) (\d+) (\d+)$/) {
102 $datum_numbits{$1}= $2;
103 $datum_basebit{$1}= $3;
104 } elsif (m/^S ([0-9A-Z]+) (0x[0-9a-f]+)$/) {
105 seteq(\$segnum_name[hex $2], $1, "segnum $2");
106 xpmdata_setup("bitmap","m_$1",1);
107 xpmdata_setup("on","_$1",1);
108 xpmdata_setup("bitmap","e_$1",1);
109 } elsif (m/^F ([0-9A-Z]+) (0x[0-9a-f]+) ([A-Z]+) (0x[0-9a-f]+) (\d+)$/) {
110 my ($xpmname,$bitno,$namerhs);
111 seteq(\$segnum_name[hex $2], $1, "segnum $2 F $3");
112 push @{ $movfeats{$1} }, $3;
114 $movfeat_prefix{$xpmname}= hex $4;
115 $movfeat_configbits{$xpmname}= $5;
116 xpmdata_setup("on","u_$xpmname",1);
117 xpmdata_setup("bitmap","m_$xpmname",1);
118 for ($bitno=0; $bitno<$movfeat_configbits{$xpmname}; $bitno++) {
119 $namerhs= "${xpmname}_${bitno}";
120 xpmdata_setup("on","_$namerhs",1);
121 xpmdata_setup("bitmap","e_$namerhs",1);
126 sub ang2pixchars ($) {
127 die if $datum_numbits{Angle} > 6;
129 return substr('0123456789'.
130 'abcdefghijklmnopqrstuvwxyz'.
131 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'.
136 #---------- read input image ----------
141 # $overall{X|Y}{Min|Max}
145 print STDERR "xpm_sizes\n";
146 foreach $rr (values %xpmdata) {
147 foreach $xp (values %$rr) {
148 foreach $xy (qw(X Y)) {
149 $xp->{$xy}{Min}= $sz{$xy}-1;
154 foreach $xy (qw(X Y)) {
155 $overall{$xy}{Min}= $sz{$xy}-1;
156 $overall{$xy}{Max}= 0;
160 #---------- read input pixels ----------
167 sub xpmdata_pixel ($$$) {
168 my ($style,$namerhs,$pcharstr)=@_;
169 my ($xp,$pk,$xy,$was,$mima);
170 #printf STDERR "%s %s %s \`%s'", $pp, $style, $namerhs, $pcharstr;
171 $xp= $xpmdata{$style}{$namerhs};
172 defined $xp or die "$pp: $style $namerhs ?";
173 foreach $xy (qw(X Y)) {
174 foreach $mima ($xp->{$xy}, $overall{$xy}) {
175 $mima->{Min}= $p{$xy} if $p{$xy} < $mima->{Min};
176 $mima->{Max}= $p{$xy} if $p{$xy} > $mima->{Max};
179 $was= $xp->{Pixels}{$p{Y}}{$p{X}};
180 if (defined($was) && $was gt $pcharstr) {
181 #print STDERR " already \`$was'\n";
184 # die "$pp $style $namerhs \`$pcharstr',\`$xp->{Pixels}{$p{Y}}{$p{X}}' ?"
186 $xp->{Pixels}{$p{Y}}{$p{X}}= $pcharstr;
187 #print STDERR " set\n";
192 my ($namerhs,$movfeat,%t,$xpmname,$segname,$datum,$k,$angstr,$bitno,$me);
193 $pp= "$ARGV $p{X} $p{Y}";
194 $datum= unpack 'V', $pbytes."\0";
195 foreach $k (keys %datum_numbits) {
196 $t{$k}= ($datum >> $datum_basebit{$k}) &
197 ((1 << $datum_numbits{$k}) - 1);
199 #printf(STDERR "%s 0x%08lx 0x%x 0x%x %d\n",$pp,$datum,
200 # $t{Segnum},$t{Movfeatpos},$t{Edge});
202 xpmdata_pixel('background','','=')
206 xpmdata_pixel('background','','!')
209 $segname= $segnum_name[$t{Segnum}];
210 defined $segname or die "$pp $t{Segnum} $datum";
213 $angstr= ang2pixchars($t{Angle});
215 if (!$t{Movfeatpos}) {
217 xpmdata_pixel("on","_$xpmname", $angstr)
219 xpmdata_pixel("bitmap", "e_${xpmname}", '*')
221 xpmdata_pixel("bitmap", "m_${segname}", '*');
225 foreach $movfeat (@{ $movfeats{$segname} }) {
226 $xpmname= $segname.'_'.$movfeat;
227 if (($t{Movfeatpos} & ~((1<< $movfeat_configbits{$xpmname})-1))
228 == $movfeat_prefix{$xpmname}) {
229 die "$pp $t{Movfeatpos} $found $movfeat"
234 die "$pp $t{Movfeatpos}"
235 unless defined $found;
236 $xpmname= $segname.'_'.$found;
237 xpmdata_pixel("on", "u_${xpmname}",
238 (($p{X} + $p{Y}) % 2) ? $angstr : '!')
240 xpmdata_pixel("bitmap", "m_${xpmname}", '*');
241 for ($bitno=0; $bitno < $movfeat_configbits{$xpmname}; $bitno++) {
242 $namerhs= "${xpmname}_${bitno}";
243 $yes= $p{Movpos} == $bitno;
244 xpmdata_pixel("on","_$namerhs", $yes ? $angstr : '!')
246 xpmdata_pixel("bitmap","e_$namerhs", $yes ? '*' : ' ')
252 #---------- read input pixmaps
254 sub read_pixmap_header () {
256 @szn= wns(1,32767,2);
258 $osz= "$sz{X} $sz{Y}";
259 "@szn" eq "$osz" or die "$osz @szn ?";
261 ($sz{X},$sz{Y})= @szn;
264 wn(1,65535)==255 or die;
268 die "$txtrdbuf ?" if length $txtrdbuf;
270 if (!defined $txtrdbuf) {
271 die $! unless ARGV->eof;
275 read_pixmap_header();
276 $ARGV =~ m/.*\.p([0-9a-f]+)\b/ or die "$ARGV ?";
277 $p{Movpos}= $1 eq 'f' ? '' : hex($1);
278 my ($pbytes,$x,$xsz);
280 for ($p{Y}=0; $p{Y}<$sz{Y}; $p{Y}++) {
281 printf STDERR "%s %d\r",$ARGV,$p{Y}
283 for ($x=0; $x<$xsz; $x++) {
284 $!=0; read(ARGV, $pbytes, 3) == 3 or die $!;
285 next if $pbytes eq "\xff\xff\xff";
292 #---------- colourmaps ----------
294 our (%cmap,%stylecmaps);
295 # $stylecmaps{$style}= [ $cmapname,... ]
296 # $cmap{$cmapname}{$pixchars}= $xpm_data_string_rhs
297 # $cmap{$cmapname}{''}= [ string names for including in xpm ]
298 # (after cmapdata_output_all)
299 $cmap{''}= {}; # fixed colours
302 my ($style,$cmapname) = @_;
303 die "$cmapname ?" if exists $cmap{$cmapname};
304 push @{ $stylecmaps{$style} }, $cmapname;
305 $cmap{$cmapname}= { };
308 sub xpm_cmap_entry ($$$) {
309 my ($cmapname,$pixchars,$rhs) = @_;
310 die "$cmapname ?" unless exists $cmap{$cmapname};
311 die "$cmapname $pixchars ?" if exists $cmap{$cmapname}{$pixchars};
312 $cmap{$cmapname}{$pixchars}= $rhs;
315 sub xpm_cmap_rgbpermil($@) {
316 my ($cmapname, @l) = @_;
317 my ($pixchars, @rgb);
318 die "$cmapname @l ?" if @l % 4;
320 ($pixchars, @rgb)= @l[0..3]; @l = @l[4..$#l];
321 xpm_cmap_entry($cmapname, $pixchars,
322 sprintf("c #%04x%04x%04x",
323 map { floor($_ * 65.535 + 0.5) } @rgb));
327 sub xpm_cmap_fixedbitmap($$) {
328 my ($cmapname,$on) = @_;
329 xpm_cmap_entry($cmapname,' ','s space');
330 xpm_cmap_entry($cmapname,$on,'s mark');
333 sub angle_to_colour ($) {
335 my ($s,$f,$u,$U,$d,$D,$R);
345 #print STDERR "a>$u|$U|$d|$D|$s<\n";
358 sub xpm_cmap_angular($$$@) {
359 my ($cmapname, $invert, $alpha, @basergb) = @_;
360 my ($angnum,$angval,@permil,@angrgb,$i);
361 for ($angnum=0; $angnum<(1<<$datum_numbits{Angle}); $angnum++) {
362 $angval= 6.0 * ($angnum+0.0) / (1<<$datum_numbits{Angle});
363 $angval += 3.0 if $invert;
364 $angval -= 6.0 if $angval >= 6.0;
365 @angrgb= angle_to_colour($angval);
366 for ($i=0; $i<3; $i++) {
367 #print STDERR ">$cmapname|$i|$alpha|$angrgb[$i]|$basergb[$i]<\n";
368 $permil[$i]= $alpha * $angrgb[$i] +
369 (1.0 - $alpha/1000.0) * $basergb[$i];
371 xpm_cmap_rgbpermil($cmapname, ang2pixchars($angnum), @permil);
375 sub cmaps_define () {
376 my ($style,$inv,$ondet);
377 my (@background, @projected, @off, @otherposn);
379 @background= qw(100 100 100);
381 @otherposn= qw(50 50 50);
382 @projected= qw(75 75 75);
384 xpm_cmap("background","background");
385 xpm_cmap_rgbpermil("background",
390 xpm_cmap("bitmap","bitmap");
391 xpm_cmap_fixedbitmap("bitmap",'*');
393 foreach $inv (('','i')) {
394 foreach $ondet (qw(on det)) {
395 xpm_cmap("on","${inv}${ondet}");
396 xpm_cmap_rgbpermil("${inv}${ondet}",
400 xpm_cmap_angular("${inv}on", !!$inv, 650, qw(0 0 0));
401 xpm_cmap_angular("${inv}det",!!$inv, 650, qw(1000 1000 1000));
407 #---------- output ----------
409 sub cmapdata_output_all () {
410 my ($cmapname, $stuff, $cmap, $sname, $pixchars);
412 foreach $cmapname (sort keys %cmap) {
413 next unless length $cmapname;
415 $cmap= $cmap{$cmapname};
416 foreach $pixchars (sort keys %$cmap) {
417 $sname= "m_${cmapname}_". unpack "H*", $pixchars;
418 printf("static const char %s[]= \"%s %s\";\n",
419 $sname, $pixchars, $cmap->{$pixchars})
421 push @$stuff, $sname;
428 foreach $colour (sort keys %$cmap) {
429 $rhs= $cmap->{$colour};
430 $rhs =~ s/^c // or die "$colour $rhs ?";
431 printf("const char ui_plan_colour_%s[]= \"%s\";\n",
437 sub xpmdata_output_all () {
438 my ($style, $namerhs, $xp, $row, $pp, $xy, $pixel);
439 my ($y, $cmap_data, $header_data, $cmapname);
440 foreach $style (sort keys %xpmdata) {
441 foreach $namerhs (sort keys %{ $xpmdata{$style} }) {
442 $xp= $xpmdata{$style}{$namerhs};
444 foreach $xy (qw(X Y)) {
445 $xp->{$xy}{Max}= $xp->{$xy}{Min} if
446 $xp->{$xy}{Max} < $xp->{$xy}{Min};
447 $header_data .= $xp->{$xy}{Max} - $xp->{$xy}{Min} + 1;
450 for ($p{Y}=$xp->{Y}{Min}; $p{Y}<=$xp->{Y}{Max}; $p{Y}++) {
451 printf "static const char d%04d_%s_%s[]= \"",
452 $p{Y}, $style, $namerhs or die $!;
453 $row= $xp->{Pixels}{$p{Y}};
454 $pp= "$style $namerhs $p{X} $p{Y}";
455 for ($p{X}=$xp->{X}{Min}; $p{X}<=$xp->{X}{Max}; $p{X}++) {
456 $pixel= $row->{$p{X}};
457 if (!defined $pixel) {
458 die "$pp ?" if !$xp->{Holey};
461 print $pixel or die $!;
463 print "\";\n" or die $!;
465 #printf STDERR "style >$style<\n";
466 foreach $cmapname (sort @{ $stylecmaps{$style} }) {
467 $cmap_data= $cmap{$cmapname}{''};
468 printf("static const char *p_%s_%s[]= {\n".
471 $header_data, scalar(@$cmap_data))
473 map { printf " %s,\n", $_ or die $!; } @$cmap_data;
474 for ($y=$xp->{Y}{Min}; $y<=$xp->{Y}{Max}; $y++) {
475 printf " d%04d_%s_%s,\n", $y, $style, $namerhs
487 my ($style,$cmap,$namerhs) = @_;
489 $xpmd= $xpmdata{$style}{$namerhs};
490 defined $xpmd or die "$style $cmap $namerhs ?";
491 return sprintf("{ %d-%d,%d-%d, p_%s_%s }",
492 (map { $xpmd->{$_}{Min}, $overall{$_}{Min} } qw(X Y)),
498 return ("{ { ".ppdr('on',"on",$dname).", ".ppdr('on',"det",$dname)." },".
499 " { ".ppdr('on',"ion",$dname).", ".ppdr('on',"idet",$dname).
503 our (@oodnames, %ood);
504 # $ood{$oodname}{Data}= $data_so_far
505 # $ood{$oodname}{ArrayDelim}= "\n" or ",\n" but for oodas only
508 my ($oodname, $data) = @_;
509 die "$oodname {{$data}} ?" if exists $ood{$oodname};
510 $ood{$oodname}{Data}= $data;
511 push @oodnames, $oodname;
515 my ($oodname, $begin) = @_;
516 die "$oodname {{$begin}} ?" if exists $ood{$oodname};
517 $ood{$oodname}{Data}= $begin;
518 $ood{$oodname}{Data} .= "[]= {";
519 $ood{$oodname}{ArrayDelim}= "\n";
520 push @oodnames, $oodname;
524 my ($oodname, $entry) = @_;
525 die "$oodname {{$entry}} ?" unless defined $ood{$oodname}{ArrayDelim};
526 $ood{$oodname}{Data} .= $ood{$oodname}{ArrayDelim};
527 $ood{$oodname}{Data} .= " ".$entry;
528 $ood{$oodname}{ArrayDelim}= ",\n";
531 sub ood_output_all () {
533 foreach $oodname (reverse @oodnames) {
534 $ood= $ood{$oodname};
535 print $ood->{Data} or die $!;
536 if (defined $ood->{ArrayDelim}) {
537 print "\n};\n" or die $!;
542 sub plandata_output_all () {
543 my ($i, @segnames, $segname);
544 my (@movfeats, $movfeat, $dname, $xpmname, $n_posns, $code, $posn);
545 my ($n_movfeats, $style, $xpmd, $pedge, $me, $noppdr);
547 for ($i=1; $i<@segnum_name; $i++) {
548 $segname= $segnum_name[$i];
549 next unless defined $segname;
550 push @segnames, $segname;
554 "const PlanData $gvarname= {\n".
555 " $overall{X}{Max}-$overall{X}{Min},".
556 " $overall{Y}{Max}-$overall{Y}{Min},".
558 " ".scalar(@segnames).", segments\n".
562 "static const PlanSegmentData segments");
564 foreach $segname (sort @segnames) {
566 exists $movfeats{$segname} ? @{ $movfeats{$segname} } : ();
567 unshift @movfeats, '';
570 "static const PlanSegmovfeatData mf_$segname");
573 "{ \"$segname\", ".scalar(@movfeats).", mf_$segname }");
575 foreach $movfeat (sort @movfeats) {
576 if (!length $movfeat) {
581 $xpmname= "${segname}_${movfeat}";
582 $n_posns= $movfeat_configbits{$xpmname};
583 $code= "\"$movfeat\"";
585 #print STDERR ">$segname|$movfeat<\n";
586 $noppdr= "{-1,-1,0}";
588 "{ $code, ".ppdr('bitmap',"bitmap","m_$xpmname").", ".
589 ($n_posns > 1 ? ppdiondet("u_$xpmname") :
590 "{ { $noppdr, $noppdr }, { $noppdr, $noppdr } }").
591 ", $n_posns, posns_$xpmname }");
593 ooda0("posns_$xpmname",
594 "static const PlanPixmapOnData posns_$xpmname");
596 for ($posn=0; $posn < $n_posns; $posn++) {
597 if ($movfeat eq '') {
601 $dname= sprintf "%s_%s_%d", $segname, $movfeat, $posn;
604 ooda1("posns_$xpmname",
605 "{ ".ppdr('bitmap',"bitmap","e_$dname").",".
606 " ".ppdiondet("_$dname")." }");
612 print "#include \"plan-data-format.h\"\n" or die $!;
613 cmapdata_output_all();
614 xpmdata_output_all();
615 plandata_output_all();