X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=ps%2Fmusic-drawing-routines.ps;h=ad75562e77c67f0c38a58277cb003d8879fa377b;hb=cd586e589daa7a550fa39200a78cb2012e853d99;hp=36d16ce38301e7a939639fa90a6ffa4cf8e2fd02;hpb=3f383278764e642a98e15291eae5a6e946beca20;p=lilypond.git diff --git a/ps/music-drawing-routines.ps b/ps/music-drawing-routines.ps index 36d16ce383..ad75562e77 100644 --- a/ps/music-drawing-routines.ps +++ b/ps/music-drawing-routines.ps @@ -2,13 +2,60 @@ % % 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 -% llx lly urx ury command -/mark_file_line + +% llx lly urx ury URI +/mark_URI { /command exch def /ury exch def @@ -17,21 +64,21 @@ /llx exch def [ /Rect [ llx lly urx ury ] - /Border [ 0 0 0 0 ] -% /Action /Launch -% /File command - /Action << - /Subtype /URI - /URI command - >> - + /Border [ 0 0 0 ] + + /Action + << + /Subtype /URI + /URI command + >> /Subtype /Link /ANN pdfmark } bind def -/set_tex_dimen { +/set_tex_dimen +{ cvr def } bind def @@ -104,35 +151,9 @@ bind def } ifelse } bind def -% Nice beam with rounded corners -/draw_beam % slope width thick blot -{ - /blot exch def - 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 @@ -142,12 +163,12 @@ bind def /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 @@ -169,72 +190,6 @@ bind def 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. /draw_bezier_sandwich % thickness controls { @@ -258,6 +213,19 @@ bind def 0 360 arc closepath fill stroke } bind def +/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 + + +% JUNKME. use color & circle. /draw_white_dot % x1 y2 R { % 0 360 arc fill stroke @@ -269,6 +237,22 @@ grestore 0.05 setlinewidth 0 setgray stroke } bind def + +% JUNKME: Use color. +/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_dashed_line % dash thickness dx dy { 1 setlinecap @@ -293,126 +277,4 @@ grestore } 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 -{ - /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 - %end music-drawing-routines.ps