From 967416b80210725e3243071ff3fb6b867ed255f2 Mon Sep 17 00:00:00 2001
From: David Kastrup <dak@gnu.org>
Date: Tue, 23 Apr 2013 16:49:19 +0200
Subject: [PATCH] Implement option -dstrokeadjust in order to get stroked stems
 and strokeadjustment

This makes the stroke drawing primitives for long rounded rectangles
dependent on the setting of currentstrokeadjust.  As a result,
low-resolution bitmap devices (up to 150 dpi or so) will get stroke
adjustment applied automatically.  The option needs to get invoked
explicitly to get stroke adjustment for PDF, giving a large file size
increase and markedly better previews on a number of PDF previewers.
---
 ps/music-drawing-routines.ps | 75 ++++++++++++++++++++----------------
 scm/framework-ps.scm         |  4 +-
 scm/lily.scm                 |  6 +++
 3 files changed, 50 insertions(+), 35 deletions(-)

diff --git a/ps/music-drawing-routines.ps b/ps/music-drawing-routines.ps
index 121897a021..03df7c03cb 100644
--- a/ps/music-drawing-routines.ps
+++ b/ps/music-drawing-routines.ps
@@ -138,51 +138,58 @@ bind def
 	    0 setlinecap
 	}
 	{ % full shape
-	    currentlinewidth 2 div
-	    0 0 2 index 180 270 arc
-	    2 index 0 2 index 270 360 arc
-	    3 copy 0 90 arc
-	    0 2 index 3 -1 roll 90 180 arc
-	    closepath
-	    2 copy 2 mul gt
-	    { % horizontal
-		2 copy add currentlinewidth add 10 add % large enough
-		0 1 index neg moveto
-		2 index 1 index neg lineto
-		2 index 1 index lineto
-		0 exch lineto closepath
-		gsave clip newpath
-		0 1 index 2 div moveto
-		currentlinewidth add setlinewidth
-		0 rlineto
-		2 setlinecap
-		stroke
-		grestore
-	    }
-	    {
-		2 copy exch 2 mul gt
-		{ % vertical
+	    currentstrokeadjust {
+		currentlinewidth 2 div
+		0 0 2 index 180 270 arc
+		2 index 0 2 index 270 360 arc
+		3 copy 0 90 arc
+		0 2 index 3 -1 roll 90 180 arc
+		closepath
+		2 copy 2 mul gt
+		{ % horizontal
 		    2 copy add currentlinewidth add 10 add % large enough
-		    dup neg 0 moveto
-		    dup 0 lineto
-		    dup 2 index lineto
-		    neg 1 index lineto closepath
+		    0 1 index neg moveto
+		    2 index 1 index neg lineto
+		    2 index 1 index lineto
+		    0 exch lineto closepath
 		    gsave clip newpath
-		    1 index 2 div 0 moveto
-		    exch currentlinewidth add setlinewidth
-		    0 exch rlineto
+		    0 1 index 2 div moveto
+		    currentlinewidth add setlinewidth
+		    0 rlineto
 		    2 setlinecap
 		    stroke
 		    grestore
 		}
 		{
-		    pop pop
-		    fill
+		    2 copy exch 2 mul gt
+		    { % vertical
+			2 copy add currentlinewidth add 10 add % large enough
+			dup neg 0 moveto
+			dup 0 lineto
+			dup 2 index lineto
+			neg 1 index lineto closepath
+			gsave clip newpath
+			1 index 2 div 0 moveto
+			exch currentlinewidth add setlinewidth
+			0 exch rlineto
+			2 setlinecap
+			stroke
+			grestore
+		    }
+		    {
+			pop pop
+			fill
+		    }
+		    ifelse
 		}
 		ifelse
+		newpath
+	    }
+	    {
+		1 setlinejoin
+		0 0 4 2 roll 4 copy rectstroke rectfill
 	    }
 	    ifelse
-	    newpath
 	}
 	ifelse
     }
diff --git a/scm/framework-ps.scm b/scm/framework-ps.scm
index 2e9db9f852..bb7dc55504 100644
--- a/scm/framework-ps.scm
+++ b/scm/framework-ps.scm
@@ -84,7 +84,9 @@
    "/output-scale "
    (number->string (ly:output-def-lookup layout 'output-scale)) " def\n"
    (output-entry "page-height" 'paper-height)
-   (output-entry "page-width" 'paper-width)))
+   (output-entry "page-width" 'paper-width)
+   (if (ly:get-option 'strokeadjust) "true setstrokeadjust\n" "")
+   ))
 
 (define (dump-page outputter page page-number page-count landscape?)
   (ly:outputter-dump-string
diff --git a/scm/lily.scm b/scm/lily.scm
index 1d69355e72..86054217b8 100644
--- a/scm/lily.scm
+++ b/scm/lily.scm
@@ -330,6 +330,12 @@ floating point exceptions.")
      #t
      "Don't use directories from input files while
 constructing output file names.")
+    (strokeadjust
+     #f
+     "Set the PostScript strokeadjust operator explicitly.
+This employs different drawing primitives, resulting in
+large PDF file size increases but often markedly better
+PDF previews.")
     (svg-woff
      #f
      "Use woff font files in SVG backend.")
-- 
2.39.2