Parent Directory
| 
Revision Log
Parent Directory
| Revision Log
Initial import
| 1 | harbaum | 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 |