my ($spec, $adj1) = @_;
confess unless defined $spec;
my @rgb = map { hex($_) / 15.0 } split //, $spec;
- $adj1 //= sub { $_[0] };
+ $adj1 //= sub { };
+ $adj1->(@rgb);
my $r = join ' ',
- (map { sprintf "%.6f ", $_ }
- map { $adj1->($_) } @rgb
+ (map { sprintf "%.6f ", $_ } @rgb
),
'setrgbcolor';
return $r;
o(" 0.52 dup scale\n"); # xxx bodge, want boundingbox or something
}
+sub facepscolour ($) {
+ my ($colourname) = @_;
+ pscolour($c{Colours}{$colourname},
+ sub { $_ = 1.0 - 0.75 * (1.0 - $_) foreach @_ });
+}
+
sub fill_faces() {
- o("clippath ", pscolour($c{Colours}{land}), " fill\n");
+ o("clippath ", facepscolour('land'), " fill\n");
foreach my $rr (values %region) {
next if $rr->{Name} eq 'L';
face_path($rr);
- o(" ", pscolour($c{Colours}{$rr->{Colour}}), " eofill\n");
+ o(" ", facepscolour($rr->{Colour}), " eofill\n");
}
}
my (@pos) = map { $_->{Pos} } @{ $adj->{Ends} };
my $mid = 0.5 * ($pos[0] + $pos[1]);
my $r = 0.5 * ($pos[1] - $pos[0])->norm();
- o(sprintf <<'END', pscolour($c{Colours}{sea}), psvec($mid), $r);
+ o(sprintf <<'END', facepscolour('sea'), psvec($mid), $r);
%% Afsluitdijk
%s %s %s 0 360 arc closepath fill
END
sub label_faces() {
my $sz = 18;
my $hs_sz = 17 * MM2PT;
+ my $hs_lw = 3;
my $shadow = $sz * 0.1;
o(" /Helvetica-Bold findfont $sz scalefont setfont\n");
my %hs = map { $_ => 1 } @{ $c{HS} };
foreach my $rr (values %region) {
next if $rr->{Special};
- o(" /words {\n");
my $words = $rr->{DisplayName};
my $pos = $rr->{Centre} + mkvec( 0, 0.5 * $sz * @$words );
if ($hs{$rr->{Name}}) {
print STDERR "adjust hs $rr->{Name}\n";
$pos -= mkvec(0, -$hs_sz/2);
+ my $hspos = $pos - mkvec(0, $sz * @$words + $hs_sz/2 + $hs_lw);
+ o(sprintf <<END
+ %% HS
+ newpath %s %s %f 0 360 arc closepath gsave fill grestore
+ 0 setgray $hs_lw setlinewidth stroke
+END
+ , pscolour($c{Colours}{$rr->{Colour}},
+ sub { $_ = 0.75 * $_ foreach @_ }),
+ psvec($hspos), $hs_sz/2);
}
+ o(" /words {\n");
foreach my $word (@$words) {
$pos += mkvec(0,-$sz);
o(" ", psvec($pos), " moveto");