Parent Directory
| 
Revision Log
Parent Directory
| Revision Log
Initial import
| 1 | #!/usr/bin/perl |
| 2 | # Calculate mapnik-looking colours for a given bg and opacity. |
| 3 | # |
| 4 | # The resultant set should visually resemble the target Mapnik colours on-screen |
| 5 | # even though the colours in the generated stylesheet are darker. |
| 6 | |
| 7 | use strict; |
| 8 | use warnings FATAL => qw{all}; |
| 9 | |
| 10 | our $OPACITY = 0.40; |
| 11 | our $BG_COL = '#f2eee8'; |
| 12 | |
| 13 | sub parse_col { |
| 14 | my $rgbstr = shift; |
| 15 | my $xx = '[a-fA-F0-9]{2}'; |
| 16 | if ($rgbstr =~ m/\A\#($xx)($xx)($xx)\z/) { |
| 17 | return (hex($1), hex($2), hex($3)); |
| 18 | } |
| 19 | elsif ($rgbstr =~ m/^__.*__$/) { |
| 20 | return (); |
| 21 | } |
| 22 | die "$ARGV:$.: RGB string \"$rgbstr\" is misformatted"; |
| 23 | } |
| 24 | |
| 25 | sub fmt_col { |
| 26 | return sprintf("#%02x%02x%02x", @_); |
| 27 | } |
| 28 | |
| 29 | sub component_fix { |
| 30 | my ($bg_c, $want_c) = (@_); |
| 31 | my $targ_c = ($want_c - ($OPACITY * $bg_c)) / (1 - $OPACITY); |
| 32 | if ($targ_c > 0xff) { |
| 33 | warn "Want $want_c, but target $targ_c > 0xff. Clamping.\n"; |
| 34 | $targ_c = 0xff; |
| 35 | } |
| 36 | if ($targ_c < 0) { |
| 37 | warn "Want $want_c, but target $targ_c < 0. Clamping.\n"; |
| 38 | $targ_c = 0; |
| 39 | } |
| 40 | return $targ_c; |
| 41 | } |
| 42 | |
| 43 | my ($br, $bg, $bb) = parse_col($BG_COL); |
| 44 | my $now = localtime(time); |
| 45 | while (my $line = <>) { |
| 46 | $line =~ s{__TEMPLATE__}{ |
| 47 | *** |
| 48 | *** This file was automatically generated from $ARGV |
| 49 | *** at $now by $0. |
| 50 | *** |
| 51 | *** Do not edit this file if you want your ganges to persist! Edit the |
| 52 | *** template and run $0 again to generate it instead. |
| 53 | *** |
| 54 | }g; |
| 55 | $line =~ s{<(\s*area\b[^<>]*)/\s*>}{ |
| 56 | my $area = $1; |
| 57 | $area =~ s!\bcolour\s*=\s*"([^"]*)"! |
| 58 | my $r_col = $1; |
| 59 | my ($rr, $rg, $rb) = parse_col($r_col); |
| 60 | if (defined $rr) { |
| 61 | my $tr = component_fix($br, $rr); |
| 62 | my $tg = component_fix($bg, $rg); |
| 63 | my $tb = component_fix($bb, $rb); |
| 64 | my $t_col = fmt_col($tr, $tg, $tb); |
| 65 | "colour=\"$t_col\""; |
| 66 | } |
| 67 | else { |
| 68 | "colour=\"$r_col\""; # unchanged |
| 69 | } |
| 70 | !ge; |
| 71 | "<$area/>"; |
| 72 | }ge; |
| 73 | $line =~ s{__BG_COL__}{$BG_COL}g; |
| 74 | print $line; |
| 75 | } |
| 76 | continue { |
| 77 | close ARGV if eof; # reset $. |
| 78 | } |
| 79 |