quacks-ingredients-counts

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