X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=ps%2Fmusic-drawing-routines.ps;h=e0f28e82a6a21e9b9918409a81bd5c0c255858af;hb=c49a146628e5f8422c72deb40a42899c4c5cdd33;hp=b8f36aa208343c15912a4fba124bccc9f760d954;hpb=4e34058754b48872b6dc751d833c38da4e6706c6;p=lilypond.git diff --git a/ps/music-drawing-routines.ps b/ps/music-drawing-routines.ps index b8f36aa208..e0f28e82a6 100644 --- a/ps/music-drawing-routines.ps +++ b/ps/music-drawing-routines.ps @@ -2,12 +2,65 @@ % % 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. +% TODO: use dicts or prefixes to prevent namespace pollution. + +% Emulation code from Postscript Language Reference. + +/*SF +{ + exch findfont exch + dup type /arraytype eq + {makefont} + {scalefont} + ifelse + setfont +} bind def + +/languagelevel where + {pop languagelevel} + {1} +ifelse + +2 lt + { /selectfont /*SF load def } +if + +% end emulation code /pdfmark where {pop} {userdict /pdfmark /cleartomark load put} ifelse + +% llx lly urx ury URI +/mark_URI +% It's possible to eliminate the coordinate variables by doing [ /Rect [ 7 3 +% roll. That is, however, kind of ugly. It would be nice if this procedure +% were only included when PDF marks are enabled. +{ + /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 + % from adobe tech note 5002. /BeginEPSF { %def /b4_Inc_state save def % Save state for cleanup @@ -26,7 +79,6 @@ } if } bind def - /EndEPSF { %def count op_count sub {pop} repeat % Clean up stacks countdictstack dict_count sub {end} repeat @@ -52,28 +104,6 @@ } 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 0 ] - - /Action - << - /Subtype /URI - /URI command - >> - /Subtype /Link - /ANN - pdfmark -} -bind def /set_tex_dimen { @@ -81,116 +111,75 @@ bind 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 -/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 +/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 - + setlinewidth % w h x y 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 + 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 fill +/draw_polygon % fill? x(n) y(n) x(n-1) y(n-1) ... x(0) y(0) n blot { - /fillp exch def - /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 + 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 - fillp { - gsave stroke grestore fill + { %fill? + stroke_and_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 % this is for drawing slurs. /draw_bezier_sandwich % thickness controls { + gsave + currentpoint translate % round ending and round beginning 1 setlinejoin 1 setlinecap setlinewidth @@ -199,80 +188,75 @@ 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_circle % R T F +/draw_circle % filled? radius thickness draw_circle { - /filled exch def - setlinewidth - dup 0 moveto - 0 exch 0 exch + setlinewidth % f? r + currentpoint % f? r x0 y0 + 3 2 roll % f? x0 y0 r + dup 0 rmoveto 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 - 0 360 arc closepath % fill stroke -gsave - 1 setgray fill -grestore -% 0 360 arc closepath % fill stroke - 0.05 setlinewidth 0 setgray stroke + { stroke_and_fill } + { stroke } + ifelse } bind def -%% JUNKME: Use color. -/draw_white_text % text scale font +/draw_line % dx dy x1 y1 thickness draw_line { - %font - findfont - %scale - exch scalefont setfont - 1 setgray - 0 0 moveto - %-0.05 -0.05 moveto - % text - show + setlinewidth % dx dy x1 y1 + 1 setlinecap + 1 setlinejoin + rmoveto % dx dy + rlineto + stroke } bind def - -/draw_dashed_line % dash thickness dx dy +/draw_dashed_line % dx dy thickness dashpattern draw_dashed_line { 1 setlinecap 1 setlinejoin - setdash - setlinewidth - 0 0 moveto - lineto + setdash % dx dy thickness + setlinewidth %dx dy + rlineto stroke + [] 0 setdash % reset dash pattern } bind def -/draw_dashed_slur % dash thickness controls +/draw_dashed_slur % controls thickness dash { +gsave + currentpoint translate 1 setlinecap 1 setlinejoin setdash setlinewidth - 8 -2 roll + 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