chiark / gitweb /
wip hs and facepscolour
authorIan Jackson <ijackson@chiark.greenend.org.uk>
Fri, 1 Mar 2019 23:23:30 +0000 (23:23 +0000)
committerIan Jackson <ijackson@chiark.greenend.org.uk>
Fri, 1 Mar 2019 23:23:30 +0000 (23:23 +0000)
generate-board

index f6b002f4f789022ab4730163b98644e45a57755b..6554c2b83a4af97dbfb36c1398d361d67178a5c2 100755 (executable)
@@ -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 <<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");