effects-overview.pl

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 my @cols = qw/omg low med normal high ultra ultimate/;
   7 my %table = ();
   8
   9 for my $col(@cols)
  10 {
  11         my $fn = "effects-$col.cfg";
  12         open my $fh, "<", "$fn"
  13                 or die "<$fn: $!";
  14         while(<$fh>)
  15         {
  16                 chomp;
  17                 next unless /^(\S+) (.*)$/;
  18                 $table{$1}{$col} = $2;
  19         }
  20 }
  21
  22 my %sortkeys = ();
  23 for my $row(keys %table)
  24 {
  25         my @toggles = ();
  26         my $last = undef;
  27         my $i = 0;
  28         for my $col(reverse @cols)
  29         {
  30                 if(defined $last && $table{$row}{$col} == $last)
  31                 {
  32                 }
  33                 else
  34                 {
  35                         push @toggles, $i;
  36                         $last = $table{$row}{$col};
  37                 }
  38                 ++$i;
  39         }
  40         $sortkeys{$row} = \@toggles;
  41 }
  42 sub toggles_compare($$);
  43 sub toggles_compare($$)
  44 {
  45         my ($a, $b) = @_;
  46         return 0 if !@$a and !@$b;
  47         return -1 if !@$a and @$b;
  48         return +1 if @$a and !@$b;
  49         return -1 if $a->[0] < $b->[0];
  50         return +1 if $a->[0] > $b->[0];
  51         my @a = @$a;
  52         my @b = @$b;
  53         shift @a;
  54         shift @b;
  55         return toggles_compare \@a, \@b;
  56 }
  57 my @rows_sorted = sort { toggles_compare $sortkeys{$a}, $sortkeys{$b} or $a cmp $b } keys %table;
  58
  59 print <<EOF;
  60 <html>
  61 <title>Effects configs</title>
  62 <h1>Effects configs</h1>
  63 <table cellspacing=0>
  64 <tr><th width="40%">cvar</th>
  65 EOF
  66
  67 for my $col(@cols)
  68 {
  69         print <<EOF;
  70 <th width="@{[60 / @cols]}%">$col</th>
  71 EOF
  72 }
  73
  74 print <<EOF;
  75 </tr>
  76 EOF
  77
  78 for my $row(@rows_sorted)
  79 {
  80         print <<EOF;
  81 <tr><th>$row</th>
  82 EOF
  83         my $last = undef;
  84         my $last_colspan = undef;
  85         my $total_colspan = 0;
  86         my $print_last = sub {
  87                 if(defined $last)
  88                 {
  89                         my $colorspan = ($last_colspan * 0.5 + $total_colspan) / @cols;
  90                         my $color = sprintf "#%02x%02x%02x",
  91                                 # red-yellow-green transition
  92                                 # FF0000 -> FFFF00 -> 00FF00
  93                                 ($colorspan > 0.5) ? 255 * (2 - 2 * $colorspan) : 255,
  94                                 ($colorspan < 0.5) ? 255 * (2 * $colorspan) : 255,
  95                                 0;
  96                         $total_colspan += $last_colspan;
  97                         print <<EOF;
  98 <td colspan="$last_colspan" align="center" bgcolor="$color">$last</td>
  99 EOF
 100                 }
 101         };
 102         for my $col(@cols)
 103         {
 104                 my $v = $table{$row}{$col};
 105                 if(defined $last && $v == $last)
 106                 {
 107                         ++$last_colspan;
 108                 }
 109                 else
 110                 {
 111                         $print_last->();
 112                         $last = $v;
 113                         $last_colspan = 1;
 114                 }
 115         }
 116         $print_last->();
 117         print <<EOF;
 118 </tr>
 119 EOF
 120 }
 121
 122 print <<EOF;
 123 </html>
 124 EOF