quacks-ingredients-counts

   1 #!/usr/bin/perl -w
   2
   3 use strict;
   4
   5 use Data::Dumper;
   6 use POSIX;
   7
   8 sub xdata ($) {
   9     my ($cb) = @_;
  10     foreach my $count (qw(1 2 3)) {
  11         foreach my $nspots (qw(1 2 3 4)) {
  12             $_ = $cb->($count,$nspots)."\t".$_;
  13         }
  14     }
  15 }
  16
  17 $_=<DATA>; chomp or die;
  18 xdata sub {
  19     my ($xcount,$xnspots) = @_;
  20     "${xcount}x". (qw(X One Two Three Four)[$xnspots]);
  21 };
  22 our @names = split /\t/, $_;
  23
  24 our %count;
  25
  26 foreach my $nspots (qw(1 2 3 4)) {
  27     $_=<DATA>; chomp or die;
  28     xdata sub {
  29         my ($xcount,$xnspots) = @_;
  30         $xnspots == $nspots and $xcount;
  31     };
  32     my @l = split /\t/, $_;
  33     foreach my $i (0..$#names) { $count{$names[$i]}{$nspots} = $l[$i] || 0; }
  34 }
  35
  36 $_ = Dumper(\%count);
  37 s{^}{// }mg;
  38
  39 our $name;
  40 our $total_count;
  41 our $total_real_count;
  42 our $max_nrows=0;
  43 our $max_rowsz=0;
  44
  45 sub wrtoplevel () {
  46     print "module $name(){ ////toplevel\n";
  47     my $cs = $count{$name};
  48     my $total = 0; $total += $_ foreach values %$cs;
  49     my $rowsz = ceil(sqrt($total));
  50     my $nrows = ceil($total / $rowsz);
  51     $total_count += $total;
  52     $total_real_count += $total if $name =~ m/^[A-Z][a-z]+$/;
  53     $max_nrows = $nrows if $nrows > $max_nrows;
  54     $max_rowsz = $rowsz if $rowsz > $max_rowsz;
  55     my $ix = 0;
  56     printf "// %-10s  total=%2d  rowsz=$rowsz  nrows=$nrows\n",
  57         "$name", $total;
  58     foreach my $nspots (sort keys %$cs) {
  59         my $c = $cs->{$nspots};
  60         print <<END;
  61   union(){
  62     Frame(\$phase, token_pitch * [ $rowsz + 1.00, $nrows + 0.50 ]);
  63     \$nspots = $nspots;
  64 END
  65         while ($c--) {
  66             my $xy = sprintf "[ %5.1f, %5.1f ]",
  67                 int($ix / $nrows) - 0.5 * ($rowsz-1),
  68                 $ix % $nrows - 0.5 * ($nrows-1);
  69             print "    translate(token_pitch * $xy) Token_L();\n";
  70             $ix++;
  71         }
  72         print <<END;
  73   };
  74 END
  75     }
  76     print "}\n";
  77 }
  78
  79 foreach $name (sort keys %count) {
  80     wrtoplevel();
  81 }
  82
  83 print <<END;
  84 // total_count=$total_count   total_real_count=$total_real_count
  85 // max_rowsz=$max_rowsz       max_nrows=$max_nrows
  86 END
  87
  88 STDOUT->error and die $!;
  89
  90 __DATA__
  91 White   Green   Blue    Red     Yellow  Purple  Black   Orange
  92 20      15      14      12      13      15      18      20
  93 8       10      10      8       6
  94 4
  95         13      10      10      10