]> git.donarmstrong.com Git - lilypond.git/blobdiff - ps/music-drawing-routines.ps
Merge master into nested-bookparts
[lilypond.git] / ps / music-drawing-routines.ps
index 0c5c3ce9b7aebe650b1f03c17aab230cabff9995..c6f4423615f8f4ea1715b3400e9f1695c3594f28 100644 (file)
 %
 % Functions for direct and embedded PostScript
 
+% Careful with double % as comment prefix.
+% Any %%X comment is interpreted as DSC comments.
+
+% TODO: use dicts or prefixes to prevent namespace pollution.
 
 /pdfmark where
 {pop} {userdict /pdfmark /cleartomark load put} ifelse
 
 
-% llx lly urx ury command
-/mark_file_line
+% llx lly urx ury URI
+/mark_URI
 {
-    /command 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 0 ]
+       
+       /Border [ 0 0 0 ]
 
-       pdf-viewer (acroread) eq
-       {
-           /Action
+        /Action
            <<
                /Subtype /URI
-               /URI command
-           >>
-       }
-       {
-           % xpdf.  FIXME: gpdf, kpdf etc?
-           /Action
-           <<
-               /Launch
-               /File command
+               /URI uri
            >>
-       } ifelse
         /Subtype /Link
     /ANN
     pdfmark
 }
 bind def
 
-/set_tex_dimen
-{
-       cvr 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
 
+/EndEPSF { %def
+  count op_count sub {pop} repeat % Clean up stacks
+  countdictstack dict_count sub {end} repeat
+  b4_Inc_state restore
+} bind def 
 
-
-/euclidean_length
+/set_tex_dimen
 {
-       1 copy mul exch 1 copy mul add sqrt
+       cvr def
 } bind def
 
-% FIXME.  translate to middle of box.
-% Nice rectangle with rounded corners
-/draw_box % breapth width depth height
-{
-%      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
-
-       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_and_fill {
+       gsave
                stroke
-       }{
-               closepath gsave stroke grestore fill
-       } ifelse
+       grestore
+       fill
 } bind def
 
-
-/draw_round_box % breapth width depth height 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
-       } ifelse
+/vector_add { % x1 y1 x2 y2 vector_add x1+x2 y1+y2
+       exch
+       4 1 roll
+       add
+       3 1 roll
+       add
+       exch
 } bind def
 
-% Nice beam with rounded corners
-/draw_beam % slope width thick  blot
+/draw_round_box % width height x y blot
 {
-       /blot exch def
-       blot setlinewidth
-
-       0 setlinecap
+       setlinewidth % w h x y
+       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
+       rmoveto % w h
+       currentpoint % w h x1 y1
+       4 2 roll % x1 y1 w h
+       4 copy
+       rectfill
+       rectstroke
 } 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_repeat_slash % x-width width height draw_repeat_slash
 {
+       2 index % duplicate x-width
        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
+       
+         0  rlineto % x-width 0
+            rlineto % width height
+       neg 0 rlineto % -x-width 0
        closepath fill
 } bind def
 
-
-/draw_white_text  % text scale font
-{
-  %font
-  findfont
-  %scale
-  exch scalefont setfont
-  1 setgray
-  0 0 moveto
-  %-0.05 -0.05 moveto
-  % text
-  show
-} bind def
-
-/draw_ez_ball % ch letter_col ball_col font
-{
-       % 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
-} 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
-{
-       % 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
-} bind def
-
-% this is for drawing slurs.
+% this is for drawing slurs and barre-indicators.
 /draw_bezier_sandwich  % thickness controls
 {
+       gsave
+       currentpoint translate
     % round ending and round beginning
     1 setlinejoin 1 setlinecap
        setlinewidth
@@ -257,173 +141,102 @@ bind def
        lineto
        curveto
        closepath
-       gsave
-       fill
+       stroke_and_fill
        grestore
-       stroke
 } bind def
 
-/draw_dot % x1 y2 R
+/draw_dot % radius x y draw_dot
 {
-%      0 360 arc fill stroke
-       0 360 arc closepath fill stroke
+       rmoveto
+       currentpoint
+       3 2 roll
+       0 360 arc closepath stroke_and_fill
 } bind def
 
-/draw_white_dot % x1 y2 R
+/draw_circle % filled? radius thickness draw_circle
 {
-%      0 360 arc fill stroke
-       0 360 arc closepath % fill stroke
-gsave
- 1 setgray fill
-grestore
-%      0 360 arc closepath % fill stroke
-  0.05 setlinewidth 0 setgray stroke
+       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_dashed_line % dash thickness dx dy
+/draw_oval % filled? x-radius y-radius thickness draw_ellipse
 {
-       1 setlinecap
-       1 setlinejoin
-       setdash
-       setlinewidth
-       0 0 moveto
-       lineto
-       stroke
+  setlinewidth % f? x-r y-r
+  /yrad exch def
+  /xrad exch def
+  xrad 0 rmoveto
+  0 yrad -2 xrad mul dup yrad exch 0 rcurveto
+  0 yrad neg dup 2 xrad mul dup 3 1 roll 0 rcurveto
+  closepath
+      { stroke_and_fill}
+      { stroke }
+  ifelse
 } bind def
 
-/draw_dashed_slur % dash thickness controls
+/draw_ellipse % filled? x-radius y-radius thickness draw_ellipse
 {
-       1 setlinecap
-       1 setlinejoin
-       setdash
-       setlinewidth
-       8 -2 roll
-       moveto
-       curveto
-       stroke
+  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
 
-
-% a b c d subvec  ==  a-c b-d
-/subvec {
-  3 2 roll exch sub
-  3 1 roll
-  sub exch
-} 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
-} bind def
-
-/bracket_traject
+/draw_line % dx dy x1 y1 thickness draw_line
 {
-       /traject_ds exch def
-       /traject_alpha exch def
-       traject_ds traject_alpha sin mul add
-       exch
-       traject_ds traject_alpha cos mul add
-       exch
+       setlinewidth % dx dy x1 y1
+       1 setlinecap
+       1 setlinejoin
+       rmoveto % dx dy
+       rlineto
+       stroke
 } bind def
 
-
-
-/half_bracket
+/draw_dashed_line % dx dy thickness dashpattern offset draw_dashed_line
 {
-%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
+       1 setlinecap
+       1 setlinejoin
+       setdash % dx dy thickness
+       setlinewidth %dx dy
+       rlineto
+       stroke
+       [] 0 setdash % reset dash pattern
 } bind def
 
-/draw_bracket % arch_angle arch_width arch_height bracket_height arch_thick bracket_thick
+/draw_dashed_slur % controls thickness dash
 {
-       % 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
+gsave
+       currentpoint translate
        1 setlinecap
        1 setlinejoin
-       half_bracket
-       20 copy
-       1 -1 scale
-       draw_half_bracket
-       stroke
-       1 -1 scale
-       draw_half_bracket
+       setdash
+       setlinewidth
+       8 2 roll
+       moveto
+       curveto
        stroke
+grestore
 } bind def
 
+/print_glyphs % dx dy glyph print_glyphs
+{
+       {
+               currentpoint %dx dy glyph x0 y0
+               3 2 roll %dx dy x0 y0 glyph
+               glyphshow % dx dy x0 y0
+               moveto % dx dy
+               rmoveto
+       }repeat
+}bind def
 %end music-drawing-routines.ps