X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=ps%2Fmusic-drawing-routines.ps;h=d7450e452bee0c239f10fca06e70f4f40a5c40b4;hb=c74e3c672472e22f28abc82d1705188add41a229;hp=b665aff49a98416b292921c35f73a48ee74aec36;hpb=f2d6ea6c952ab8f8651f95cdc1bc45716e4d3cc8;p=lilypond.git

diff --git a/ps/music-drawing-routines.ps b/ps/music-drawing-routines.ps
index b665aff49a..d7450e452b 100644
--- a/ps/music-drawing-routines.ps
+++ b/ps/music-drawing-routines.ps
@@ -2,382 +2,239 @@
 %
 % Functions for direct and embedded PostScript
 
+% Careful with double % as comment prefix.
+% Any %%X comment is interpreted as DSC comments.
 
-/blot-diameter { lilypondpaperblotdiameter } bind def
-
-/set_tex_dimen {
-	cvr def     
-} bind def
-
+% TODO: use dicts or prefixes to prevent namespace pollution.
 
+/pdfmark where
+{pop} {userdict /pdfmark /cleartomark load put} ifelse
 
-/euclidean_length  
-{ 
-	1 copy mul exch 1 copy mul add sqrt 
-} bind def 
 
-% FIXME.  translate to middle of box.
-% Nice rectangle with rounded corners
-/draw_box % breapth width depth height
+% llx lly urx ury URI
+/mark_URI
 {
-	currentdict /testing known {
-		%% real thin lines for testing
-		/blot 0.005 def
-	}{
-		/blot blot-diameter def
-	} ifelse
-
-	0 setlinecap
-	blot setlinewidth
-	1 setlinejoin
-
-	blot 2 div sub /h exch def
-	blot 2 div sub /d exch def
-	blot 2 div sub /w exch def
-	blot 2 div sub /b exch def
+    /uri exch def
+    /ury exch def
+    /urx exch def
+    /lly exch def
+    /llx exch def
+    [
+	/Rect [ llx lly urx ury ]
+	
+	/Border [ 0 0 0 ]
+
+        /Action
+	    <<
+		/Subtype /URI
+		/URI uri
+	    >>
+        /Subtype /Link
+    /ANN
+    pdfmark
+}
+bind def
+
+% llx lly urx ury page
+/mark_page_link
+{
+    /page exch def
+    /ury exch def
+    /urx exch def
+    /lly exch def
+    /llx exch def
+    [
+        /Rect [ llx lly urx ury ]
+        /Border [ 0 0 0 ]
+        /Page page
+        /Subtype /Link
+    /ANN
+    pdfmark
+}
+bind def
+
+% from adobe tech note 5002.
+/BeginEPSF { %def
+    /b4_Inc_state save def % Save state for cleanup
+    /dict_count countdictstack def % Count objects on dict stack
+    /op_count count 1 sub def % Count objects on operand stack
+    userdict begin % Push userdict on dict stack
+    /showpage { } def % Redefine showpage, { } = null proc
+    0 setgray 0 setlinecap % Prepare graphics state
+    1 setlinewidth 0 setlinejoin
+    10 setmiterlimit [ ] 0 setdash newpath
+    /languagelevel where % If level not equal to 1 then
+    {pop languagelevel % set strokeadjust and
+    1 ne % overprint to their defaults.
+      {false setstrokeadjust false setoverprint
+      } if
+    } if
+} bind def
 
-	b neg d neg moveto
-	b w add 0 rlineto
-	0 d h add rlineto
-	b w add neg 0 rlineto
-	0 d h add neg rlineto
+/EndEPSF { %def
+  count op_count sub {pop} repeat % Clean up stacks
+  countdictstack dict_count sub {end} repeat
+  b4_Inc_state restore
+} bind def
 
-	currentdict /testing known {
-		%% outline only, for testing:
+/stroke_and_fill {
+	gsave
 		stroke
-	}{
-		closepath gsave stroke grestore fill
-	} ifelse
+	grestore
+	fill
 } bind def
 
-
-/draw_symmetric_x_triangle % h w th
-{
-    setlinewidth
-    0 0 moveto
-    dup 0 lineto
-    2 div 
-    exch lineto
-    0 0 lineto
-    stroke
+/vector_add { % x1 y1 x2 y2 vector_add x1+x2 y1+y2
+	exch
+	4 1 roll
+	add
+	3 1 roll
+	add
+	exch
 } bind def
 
-/draw_round_box % breapth width depth height blot
+/draw_round_box % width height x y blot
 {
-	/blot exch def
-
-	0 setlinecap
-	blot setlinewidth
-	1 setlinejoin
-
-	blot 2 div sub /h exch def
-	blot 2 div sub /d exch def
-	blot 2 div sub /w exch def
-	blot 2 div sub /b exch def
-
-	b neg d neg moveto
-	b w add 0 rlineto
-	0 d h add rlineto
-	b w add neg 0 rlineto
-	0 d h add neg rlineto
-
-	currentdict /testing known {
-		%% outline only, for testing:
-		stroke
-	}{
-		closepath gsave stroke grestore fill
+        dup
+	0.0 gt {
+		setlinewidth % w h x y
+		0 setlinecap
+		1 setlinejoin
+
+		rmoveto % w h
+		currentpoint % w h x1 y1
+		4 2 roll % x1 y1 w h
+		4 copy
+		rectfill
+		rectstroke
+	} {
+		pop % w h x y
+		rmoveto % w h
+		currentpoint % w h x1 y1
+		4 2 roll % x1 y1 w h
+		rectfill
 	} ifelse
 } bind def
 
-% Nice beam with rounded corners
-/draw_beam % slope width thick 
-{
-	currentdict /testing known {
-		%% real thin lines for testing
-		/blot 0.005 def
-	}{
-		/blot blot-diameter def
-	} ifelse
-	blot setlinewidth
-
- 	0 setlinecap
-	1 setlinejoin
-
-	blot sub /t exch def
-	blot sub /w exch def
-	w mul /h exch def
-
-	blot 2 div t 2 div neg moveto
-	w h rlineto
-	0 t rlineto
-	w neg h neg rlineto
-	0 t neg rlineto
-
-	currentdict /testing known {
-		%% outline only, for testing:
-		stroke
-	}{
-		closepath gsave stroke grestore fill
-	} ifelse
-} bind def 
-
-/draw_polygon % x(n) y(n) x(n-1) y(n-1) ... x(1) y(1) n blot
+/draw_polygon % fill? x(n) y(n) x(n-1) y(n-1) ... x(0) y(0) n blot
 {
-	/blot exch def
+	setlinewidth %set to blot
 
 	0 setlinecap
-	blot setlinewidth
 	1 setlinejoin
 
-	/points exch def
-	2 copy
-	moveto
-	1 1 points {pop lineto} for
-	currentdict /testing known {
-		%% outline only, for testing:
-		stroke
+	3 1 roll
+	/polygon_x
+	currentpoint
+	/polygon_y exch def
+	def
+	rmoveto % x(0) y(0)
+	{ polygon_x polygon_y vector_add lineto } repeat % n times
+	closepath
+	{ %fill?
+		stroke_and_fill
 	}{
-		closepath gsave stroke grestore fill
+		stroke
 	} ifelse
 } bind def
 
-/draw_repeat_slash % width slope thick
+/draw_circle % filled? radius thickness draw_circle
 {
-	1 setlinecap
-	1 setlinejoin
-
-	/beamthick exch def
-	/slope exch def
-	/width exch def
-	beamthick beamthick slope div euclidean_length
-	  /xwid exch def 
-	0 0 moveto
-	xwid 0  rlineto
-	width slope width mul rlineto
-	xwid neg 0 rlineto
-      %  width neg width angle sin mul neg rlineto
-	closepath fill
+	setlinewidth	% f? r
+	currentpoint	% f? r x0 y0
+	3 2 roll	% f? x0 y0 r
+	dup 0 rmoveto
+	0 360 arc closepath
+		{ stroke_and_fill }
+		{ stroke }
+	ifelse
 } bind def
 
-
-/draw_ez_ball % ch letter_col ball_col font
+/draw_ellipse % filled? x-radius y-radius thickness draw_ellipse
 {
-	% font
-	findfont 0.7 scalefont setfont 
-	0.1 setlinewidth
-	0 0 moveto
-	0 setgray
-	0.5 0 0.5 0 360 arc closepath fill stroke
-	% ball_col
-	1 eq {
-		0.01 setlinewidth
-		1 setgray
-		0.5 0 0.4 0 360 arc closepath
-		fill stroke
-	} if 
-	% letter_col
-	setgray
-	% 0.25 is empiric centering. Change to taste
-	0.25 -0.25 moveto
-	% ch
-	show
+  setlinewidth % f? x-r y-r
+  /savematrix matrix currentmatrix def
+  scale % f?
+  currentpoint
+  1 0 rmoveto
+  1 0 360  arc closepath
+  savematrix setmatrix
+             { stroke_and_fill}
+             { stroke }
+  ifelse
 } bind def
 
-% Simple, but does it work everywhere?
-% Han-Wen reports that one printer (brand?) at cs.uu.nl chokes on this,
-% reverted for now -- jcn
-%
-% The filled circles are drawn by setting the linewidth
-% to 2*radius and drawing a point.
-/simple_draw_ez_ball % ch letter_col ball_col font
+/draw_partial_ellipse % filled connect x-radius y-radius startangle endangle thickness draw_partial_ellipse
+% Note that filled is not boolean to permit for different graylevels (ie for trill keys)
 {
-	% font
-	findfont 0.85 scalefont setfont
-	/origin { 0.45 0 } def
-	0 setgray
-	1.1 setlinewidth
-	origin moveto
-	origin lineto stroke
-	% ball_col
- 	setgray
-	0.9 setlinewidth
-	origin moveto
-	origin lineto stroke
-	% letter_col
-	setgray
-	% 0.25 is empiric centering. Change to taste
-	origin moveto
-	-0.28 -0.30 rmoveto
-	% ch
-	show
+  gsave
+  currentpoint translate
+  /thickness exch def
+  /endangle exch def
+  /startangle exch def
+  /y_radius exch def
+  /x_radius exch def
+  /endrad x_radius y_radius mul
+    x_radius x_radius mul
+    endangle cos endangle cos mul mul
+    y_radius y_radius mul
+    endangle sin endangle sin mul mul add sqrt div def
+  /endangle endangle sin endrad mul y_radius div
+    endangle cos endrad mul x_radius div atan def
+  /startrad x_radius y_radius mul
+    x_radius x_radius mul
+      startangle cos startangle cos mul mul
+    y_radius y_radius mul
+      startangle sin startangle sin mul mul add sqrt div def
+  /startangle startangle sin startrad mul y_radius div
+    startangle cos startrad mul x_radius div atan def
+  /connect exch def
+  /filled exch def
+  /savematrix matrix currentmatrix def
+  thickness setlinewidth
+  x_radius y_radius scale
+  startangle cos startangle sin moveto
+  0 0 1 startangle
+    startangle endangle eq { endangle 360 add } { endangle } ifelse
+    arc
+  connect {
+    startangle cos startangle sin moveto endangle cos endangle sin lineto }
+    if
+  savematrix setmatrix filled { stroke_and_fill } { stroke } ifelse
+  grestore
 } bind def
 
-% this is for drawing slurs. 
-/draw_bezier_sandwich  % thickness controls 
+/draw_line % dx dy x1 y1 thickness draw_line
 {
-    % round ending and round beginning
-    1 setlinejoin 1 setlinecap
-	setlinewidth 
-	moveto 
-	curveto 
-	lineto 
-	curveto
-	closepath
-	gsave 
-	fill 
-	grestore 
-	stroke 
-} bind def 
-
-/draw_dot % x1 y2 R
-{
-%	0 360 arc fill stroke
-	0 360 arc closepath fill stroke
-} bind def
-
-/draw_dashed_line % dash thickness dx dy
-{ 
-	1 setlinecap 
-	1 setlinejoin 
-	setdash 
-	setlinewidth 
-	0 0 moveto
-	lineto
-	stroke 
-} bind def 
-
-/draw_dashed_slur % dash thickness controls
-{ 
-	1 setlinecap 
-	1 setlinejoin 
-	setdash 
-	setlinewidth 
-	8 -2 roll 
-	moveto 
-	curveto 
-	stroke 
-} bind def 
-
-
-% a b c d subvec  ==  a-c b-d
-/subvec {
-  3 2 roll exch sub
-  3 1 roll
-  sub exch
+	setlinewidth % dx dy x1 y1
+	1 setlinecap
+	1 setlinejoin
+	rmoveto % dx dy
+	rlineto
+	stroke
 } bind def
 
-
-% centre? zzwidth zzheight thickness x0 y0 x1 y1
-/draw_zigzag_line {
-  newpath
-  6 dict begin
- 
-  4 2 roll % zzuw zzh th x1 y1 x0 y0
-  2 copy
-  moveto
-  subvec % zzuw zzh th dx dy
-
-  2 copy euclidean_length /l exch def
-  l div /uy exch def
-  l div /ux exch def
-  setlinewidth
-  /zzh exch def
-  l exch div round /n exch def
-  n 0 gt { %if
-      /zzw l n 2 mul div def
-      {
-	  uy zzh mul 2 div ux zzh mul -2 div rmoveto
-      } if
-      1 1 n {
-	  ux zzw mul uy zzh mul sub
-	  uy zzw mul ux zzh mul add
-	  rlineto
-	  ux zzw mul uy zzh mul add
-	  uy zzw mul ux zzh mul sub
-	  rlineto
-      } bind for
-  }{ %else
-      pop
-      ux l mul uy l mul rlineto
-  } ifelse
-  stroke
- end
+/draw_dashed_line % dx dy thickness dashpattern offset draw_dashed_line
+{
+	1 setlinecap
+	1 setlinejoin
+	setdash % dx dy thickness
+	setlinewidth %dx dy
+	rlineto
+	stroke
+	[] 0 setdash % reset dash pattern
 } bind def
 
-/bracket_traject 
-{ 
-	/traject_ds exch def 
-	/traject_alpha exch def 
-	traject_ds traject_alpha sin mul add 
-	exch 
-	traject_ds traject_alpha cos mul add 
-	exch 
-} bind def 
-
-
-
-/half_bracket
-{ 
-%6 
-	0 0 
-%5a 
-	bracket_thick arch_height add half_height arch_thick sub arch_width add 
-	arch_angle arch_height -0.15 mul bracket_traject 
-%5b 
-	bracket_thick 0.5 mul half_height 
-	0 arch_height 0.5 mul bracket_traject 
-%5c 
-	0 half_height 
-%4a 
-	bracket_thick half_height arch_thick sub 
-	0 arch_height 0.4 mul bracket_traject 
-%4b 
-	bracket_thick arch_height add half_height arch_thick sub arch_width add 
-	arch_angle arch_height -0.25 mul bracket_traject 
-%4c 
-	bracket_thick arch_height add half_height arch_thick sub arch_width add 
-%3 
-	bracket_thick half_height arch_thick sub 
-%2 
-	bracket_thick 0 
-%1 
-	0 0 
-} bind def 
-
-/draw_half_bracket { 
-	moveto 
-	lineto 
-	lineto 
-	curveto 
-	curveto 
-	lineto 
-	gsave 
-	fill 
-	grestore 
-} bind def 
-
-/draw_bracket % arch_angle arch_width arch_height bracket_height arch_thick bracket_thick
-{ 
-	% urg
-
-	/bracket_thick exch def
-	/arch_thick exch def
-	/bracket_height exch def
-	/arch_height exch def
-	/arch_width exch def
-	/arch_angle exch def
-
-	bracket_height 2 div bracket_thick add /half_height exch def 
-	bracket_thick 0.5 mul setlinewidth
-	1 setlinecap 
-	1 setlinejoin 
-	half_bracket 
-	20 copy 
-	1 -1 scale 
-	draw_half_bracket 
-	stroke 
-	1 -1 scale 
-	draw_half_bracket 
-	stroke 
-} bind def 
-
+/print_glyphs % w dx dy glyph print_glyphs
+{
+	{
+		currentpoint %w dx dy glyph x0 y0
+		5 2 roll %w x0 y0 dx dy glyph
+		3 1 roll %w x0 y0 glyph dx dy
+		rmoveto %w x0 y0 glyph
+		glyphshow %w x0 y0
+		moveto %w
+		0 rmoveto
+	}repeat
+}bind def
+%end music-drawing-routines.ps