From 744f4cad89d78c166b9fb4226d7b2f8f9b041b28 Mon Sep 17 00:00:00 2001 From: Ian Jackson Date: Fri, 1 Mar 2019 23:23:30 +0000 Subject: [PATCH] wip hs and facepscolour --- generate-board | 30 +++++++++++++++++++++++------- 1 file changed, 23 insertions(+), 7 deletions(-) diff --git a/generate-board b/generate-board index f6b002f..6554c2b 100755 --- a/generate-board +++ b/generate-board @@ -284,10 +284,10 @@ sub pscolour ($;$) { 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; @@ -298,12 +298,18 @@ sub preamble() { 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"); } } @@ -322,7 +328,7 @@ sub afsluitdijk() { 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 @@ -347,18 +353,28 @@ sub edge_faces() { 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 <{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"); -- 2.30.2