Less blurry crosshair ring
[voretournament/voretournament.git] / 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