X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=ps%2Fmusic-drawing-routines.ps;h=cb2249d4b4176c2313c0440cb778b65f9408dd70;hb=fd66a02317cc036a1dee15c4a52a2c9970a2a85d;hp=b665aff49a98416b292921c35f73a48ee74aec36;hpb=f2d6ea6c952ab8f8651f95cdc1bc45716e4d3cc8;p=lilypond.git diff --git a/ps/music-drawing-routines.ps b/ps/music-drawing-routines.ps index b665aff49a..cb2249d4b4 100644 --- a/ps/music-drawing-routines.ps +++ b/ps/music-drawing-routines.ps @@ -2,30 +2,103 @@ % % 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 + +% 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 + + +% reencode-font +/reencode-font +{ + /name exch def + /encoding exch def + dup length + dict begin { + 1 index /FID ne {def} {pop + pop} ifelse + } + forall + /Encoding encoding + def currentdict + end + name exch definefont +} bind def -/blot-diameter { lilypondpaperblotdiameter } bind def -/set_tex_dimen { - cvr def +% llx lly urx ury URI +/mark_URI +{ + /command 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 command + >> + /Subtype /Link + /ANN + pdfmark +} +bind def + +/set_tex_dimen +{ + cvr def } bind def -/euclidean_length -{ - 1 copy mul exch 1 copy mul add sqrt -} bind def +/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 { - currentdict /testing known { +% currentdict /testing known { %% real thin lines for testing /blot 0.005 def - }{ - /blot blot-diameter def - } ifelse +% }{ +% /blot blot-diameter def +% } ifelse 0 setlinecap blot setlinewidth @@ -51,17 +124,6 @@ } bind def -/draw_symmetric_x_triangle % h w th -{ - setlinewidth - 0 0 moveto - dup 0 lineto - 2 div - exch lineto - 0 0 lineto - stroke -} bind def - /draw_round_box % breapth width depth height blot { /blot exch def @@ -89,40 +151,9 @@ } 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 % x(n) y(n) x(n-1) y(n-1) ... x(1) y(1) n blot fill { + /fillp exch def /blot exch def 0 setlinecap @@ -132,12 +163,12 @@ /points exch def 2 copy moveto - 1 1 points {pop lineto} for - currentdict /testing known { - %% outline only, for testing: - stroke + 1 1 points { pop lineto } for + closepath + fillp { + gsave stroke grestore fill }{ - closepath gsave stroke grestore fill + stroke } ifelse } bind def @@ -150,7 +181,7 @@ /slope exch def /width exch def beamthick beamthick slope div euclidean_length - /xwid exch def + /xwid exch def 0 0 moveto xwid 0 rlineto width slope width mul rlineto @@ -159,75 +190,22 @@ closepath fill } 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. -/draw_bezier_sandwich % thickness controls +% this is for drawing slurs. +/draw_bezier_sandwich % thickness controls { % round ending and round beginning 1 setlinejoin 1 setlinecap - setlinewidth - moveto - curveto - lineto + setlinewidth + moveto + curveto + lineto curveto closepath - gsave - fill - grestore - stroke -} bind def + gsave + fill + grestore + stroke +} bind def /draw_dot % x1 y2 R { @@ -235,149 +213,79 @@ 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 +/draw_circle % R T F +{ + /filled exch def + setlinewidth + dup 0 moveto + 0 exch 0 exch + 0 360 arc closepath + gsave stroke grestore + filled { fill } if } 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 +% JUNKME. use color & circle. +/draw_white_dot % x1 y2 R +{ +% 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 } 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 +% JUNKME: Use color. +/draw_white_text % text scale font +{ + exch selectfont + 1 setgray + 0 0 moveto + %-0.05 -0.05 moveto + % text + show +} 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_dashed_line % dash thickness dx dy +{ + 1 setlinecap + 1 setlinejoin + setdash + setlinewidth + 0 0 moveto + lineto + stroke +} bind def -/draw_half_bracket { - moveto - lineto - lineto - curveto - curveto - lineto - gsave - fill - grestore -} bind def +/draw_dashed_slur % dash thickness controls +{ + 1 setlinecap + 1 setlinejoin + setdash + setlinewidth + 8 -2 roll + moveto + curveto + stroke +} 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_letter { + currentpoint + 3 2 roll + glyphshow + moveto +} bind def +/print_glyphs { + -1 1 + { + 3 mul -3 roll + print_letter + rmoveto + }for +}bind def +%end music-drawing-routines.ps