X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=ps%2Fmusic-drawing-routines.ps;h=82b06c7c704bd2b85bffd61974ed77e4aecf6e66;hb=5d5b64463c27ba733797660a32a3de6100d57ef5;hp=8a64dcf6eb0936c05bb69a951e4c4f4aecbc64ea;hpb=f8dbe8f1d2e372fa099b4eb7e8baf59d849abb3a;p=lilypond.git diff --git a/ps/music-drawing-routines.ps b/ps/music-drawing-routines.ps index 8a64dcf6eb..82b06c7c70 100644 --- a/ps/music-drawing-routines.ps +++ b/ps/music-drawing-routines.ps @@ -2,29 +2,102 @@ % % Functions for direct and embedded PostScript -/blot-diameter { lilypondpaperblotdiameter } bind def - -/set_tex_dimen { - cvr def +% Don't use double % as comment prefix. These are 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 -/euclidean_length -{ - 1 copy mul exch 1 copy mul add sqrt + +/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 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 + % FIXME. translate to middle of box. % Nice rectangle with rounded corners -% FIXME: linewidth hardcoded. check: too round? /draw_box % breapth width depth height { - %% FIXME: hardcoded - 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 @@ -32,13 +105,6 @@ blot 2 div sub /h exch def blot 2 div sub /d exch def - - %% UGH huh? - %% Where does this correction come from? - %% Why don't we need this in x direction? - h blot 2 div sub /h exch def - d blot 2 div sub /d exch def - blot 2 div sub /w exch def blot 2 div sub /b exch def @@ -56,31 +122,25 @@ } ifelse } bind def -% Nice beam with rounded corners -% FIXME: linewidth hardcoded. check: too round? -/draw_beam % slope width thick + +/draw_round_box % breapth width depth height blot { - %% FIXME: hardcoded - currentdict /testing known { - %% real thin lines for testing - /blot 0.005 def - }{ - /blot blot-diameter def - } ifelse - blot setlinewidth + /blot exch def - 0 setlinecap + 0 setlinecap + blot setlinewidth 1 setlinejoin - blot 2 mul sub /t exch def - blot 2 mul sub /w exch def - w mul /h exch def + 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 - blot t 2 div neg moveto - w h rlineto - 0 t rlineto - w neg h neg rlineto - 0 t neg rlineto + 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: @@ -88,7 +148,28 @@ }{ closepath gsave stroke grestore fill } ifelse -} bind def +} bind def + +/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 + blot setlinewidth + 1 setlinejoin + + /points exch def + 2 copy + moveto + 1 1 points { pop lineto } for + closepath + fillp { + gsave stroke grestore fill + }{ + stroke + } ifelse +} bind def /draw_repeat_slash % width slope thick { @@ -99,7 +180,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 @@ -108,235 +189,91 @@ closepath fill } bind def -/draw_hairpin % width start_h end_h thick +% this is for drawing slurs. +/draw_bezier_sandwich % thickness controls { - 1 setlinecap - 1 setlinejoin - + % round ending and round beginning + 1 setlinejoin 1 setlinecap setlinewidth - /end_h exch def - /start_h exch def - /wid exch def - 0 start_h moveto - wid end_h lineto - stroke - 0 start_h neg moveto - wid end_h neg lineto + moveto + curveto + lineto + curveto + closepath + gsave + fill + grestore stroke } bind def -/draw_tuplet % height gap dx dy thick dir -{ - 1 setlinecap - 1 setlinejoin - - /dir exch def - setlinewidth - /tuplet_dy exch def - /tuplet_dx exch def - /tuplet_gapx exch def - /tuplet_h exch def - tuplet_dy tuplet_dx div tuplet_gapx mul /tuplet_gapy exch def - - - 0 tuplet_h neg dir mul moveto - 0 0 lineto - tuplet_dx tuplet_gapx sub 2 div - tuplet_dy tuplet_gapy sub 2 div lineto - tuplet_dx tuplet_gapx add 2 div - tuplet_dy tuplet_gapy add 2 div moveto - tuplet_dx tuplet_dy lineto - tuplet_dx tuplet_dy tuplet_h dir neg mul add lineto - stroke -} bind def +/draw_dot % x1 y2 R +{ +% 0 360 arc fill stroke + 0 360 arc closepath fill stroke +} bind def -/draw_ez_ball % ch letter_col ball_col font +/draw_circle % R T F { - % 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 + /filled exch def + setlinewidth + dup 0 moveto + 0 exch 0 exch + 0 360 arc closepath + gsave stroke grestore + filled { fill } if } 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 + +% JUNKME. use color & circle. +/draw_white_dot % x1 y2 R { - % 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 +% 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 -/draw_volta % h w thick vert_start vert_end -{ - 1 setlinecap - 1 setlinejoin - - /vert_end exch def - /vert_start exch def - setlinewidth - /volta_w exch def - /volta_h exch def - vert_start 0 eq { - 0 0 moveto - 0 volta_h lineto - } if - 0 volta_h moveto - volta_w volta_h lineto - vert_end 0 eq { - volta_w 0 lineto - } if - stroke -} bind def -% this is for drawing slurs. -/draw_bezier_sandwich % thickness controls -{ - setlinewidth - moveto - curveto - lineto - curveto - gsave - fill - grestore - 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 - 1 setlinejoin - setdash - setlinewidth +{ + 1 setlinecap + 1 setlinejoin + setdash + setlinewidth 0 0 moveto lineto - stroke -} bind def + stroke +} bind def /draw_dashed_slur % dash thickness controls -{ - 1 setlinecap - 1 setlinejoin - setdash - setlinewidth - 8 -2 roll - moveto - curveto - 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 - - - -/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 +{ + 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 +%end music-drawing-routines.ps