data/effects-overview.pl

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