% This file can be used instead of psslurs.pro, it is only commented % and indented. % % VERSION: 1.01 % % WARNING! This is a heavy magic! If you want something more understandable, % you will have to write it yourself (if it is possible in a stack-oriented % language that PostScript is). There are some constants you can % change and see what happens, but I think the slurs should be almost % always satisfiable. When not, let me know at: % stanislav@kneifl.net % Also any bug reports and comments are welcomed. % % Stanislav Kneifl. /slur@Dict 200 dict def % this dictionary is for \setslurtext, overriding some dvips's definitions /temp@xx@dict 4 dict def temp@xx@dict begin /a { moveto ax1 ay1 rmoveto } def /V {gsave newpath transform round exch round exch itransform exch ax1 add exch ay1 add moveto rulex 0 rlineto 0 ruley neg rlineto rulex neg 0 rlineto fill grestore} def end TeXDict begin % get dimen from TeX's string ("125pt" -> 125 PS points) /psxGD { dup length 2 sub 0 exch getinterval cvr 1.045 mul} def % get dimen adjusted to Resolution /psxGDAR { dup length 2 sub 0 exch getinterval cvr 4 psxAR mul 1.045 mul} def % Adjust to Resolution /psxAR { Resolution mul 300 div } def % the distances in dvips's PostScript are resolution dependant! end slur@Dict begin /CP /currentpoint load def /ED { exch def } bind def /psxAR { Resolution mul 300 div } def % stands for Adjust to Resolution, /VS { dup /ay1 exch ay1 exch linew mul 4 mul add def /ay2 exch ay2 exch linew mul 4 mul add def } def /y { 3 2 roll ax1 ay1 rmoveto show moveto } def /M { mul } def /A { add } def /SB { sub } def /P { pop } def /DP { dup } def /R { roll } def /drawseg { 0 0 moveto ax1 ay1 ax1 0.6 mul ax2 0.4 mul add ay1 0.6 mul ay2 0.4 mul add ax1 ax2 add 2 div ay1 ay2 add 2 div curveto ax1 0.4 mul ax2 0.6 mul add ay1 0.4 mul ay2 0.6 mul add ax2 ay2 x2 0 curveto } def /DS { psxAR /maxe ED /ifadjust ED /ifdash ED psxAR /m ED % max height of the slur /e ED % "angularity" of the slur; 0.1 = very angular, % 0.3 = very round /aa exch neg def % what to multiply the height with % AFTER the max height checking /y2 ED % y coordinate of the end of the slur /x2 ED % x coordinate of the end of the slur /y1 ED % y coordinate of the beginning of the slur /x1 ED % x coordinate of the beginning of the slur /yr2 ED /yr1 ED /internote ED /x2 x2 x1 sub def % x2=x2-x1 /y2 y2 y1 sub def % y2=y2-y1 /sx y2 x2 div def /b x2 300 mul Resolution div abs sqrt psxAR 2 mul def % b=2*sqrt(x2) b 3 psxAR lt {/b 3 psxAR def} if % b=max(b,3) b m gt {/b m def} if % b=min(b,m) /aa b aa mul def % aa=aa*b /s 90 x2 y2 atan sub def % s=90-arctan(x2,y2) slope of the slur /aa aa s cos div def % aa=aa/cos(s) height of the slur /x2 s neg cos x2 mul s neg sin y2 mul sub def % x2 = x2*cos(-s) - y2*sin(-s) % is the length of the slur e x2 mul maxe gt { /e maxe x2 div def } if /beta e x2 mul aa neg atan def beta 90 gt {/beta 180 beta sub def} if /ax1 e x2 mul def % control points /ay1 aa def /ax2 1 e sub x2 mul def /ay2 aa def % check if the starting and endin vector stay in desired quadrants % => beta < abs(s) beta s abs lt { /b aa abs s abs 2 add sin mul s abs 2 add cos div def s aa mul 0 lt { s cos 0.75 lt { /ax1 ax1 b 1 s cos sub mul 0.5 mul sub def /ay1 ay1 s cos mul 0.8 mul def } if % ^^^^ ^^^ ^^^ % (values to play with) /ax2 x2 b sub def } { /ax1 b def s cos 0.75 lt { /ax2 b 1 s cos sub mul 0.5 mul ax2 add def /ay2 ay2 s cos mul 0.8 mul def } if % ^^^^ ^^^ ^^^ } ifelse } if % align the slur to the staff lines gsave x1 y1 translate s rotate % [1 0 sx 1 0 0] concat drawseg gsave initmatrix flattenpath pathbbox exch pop sub /slh ED % in slh we have the height of the whole slur pop grestore /yr s aa mul 0 ge { yr1 } { yr2 } ifelse internote div def /slh yr slh internote div aa 0 gt { add } { sub } ifelse 2 div def % check if the slur gets too close to staff line /shift 0 def slh 4.45 lt slh -0.5 gt and { /slh slh dup truncate sub def slh 0 lt { /slh 1 slh add def } if aa 0 gt { /slh 1 slh sub def } if % slh now contains the position ot the slur top/bottom in the space % between the nearest staff lines (from <0,1>), regardless direction % slur is too low: slh 0.45 lt { /shift 0.45 slh sub def } if % slur is too high, but we can be shift it down: slh 0.7 gt slh 0.85 lt and { /shift 0.7 slh sub def } if % slur is too high, must be shifted up: slh 0.85 ge { /shift 1.45 slh sub def } if } if aa 0 gt { /shift shift neg def } if ifadjust 0 eq { /shift 0 def } if % and finally draw it... grestore gsave /linew internote 0.06 mul psxAR def linew 4 mul setlinewidth 1 setlinecap 0 setlinejoin ifdash 1 eq { [internote 8 mul psxAR internote 5 mul psxAR] 0 setdash } if x1 y1 shift neg 2 mul internote mul 4 psxAR mul add translate s rotate % [1 sx 0 1 0 0] concat % uncomment this to see the control points % 5 psxAR setlinewidth ax1 ay1 moveto 0.1 0 rlineto stroke % ax2 ay2 moveto 0.1 0 rlineto stroke linew setlinewidth drawseg 1 VS drawseg -2 VS drawseg x2 20 psxAR gt { 3 VS drawseg } if x2 50 psxAR gt { -4 VS drawseg } if x2 80 psxAR gt { 5 VS drawseg } if stroke grestore % now some \slurtext code... /x1 ax1 ax2 add 2 div def % middle of the slur /y1 ay1 ay2 add 2 div def x1 s cos mul y1 s sin mul add neg y1 s cos mul x1 s sin mul sub aa 0 lt {1} {0} ifelse end % this is a hack to place the slurtext in the middle of the slur. % From unknown reasons simple 'ax1 ay1 translate' did not work, % so we have to overlay some definitions with our own, namely % 'a', which is originally 'moveto' and 'V' for drawing rules. % maybe there are some other operations that should be redefined, % but for almost all cases this will be sufficient. If you find % anything that won't be typeset at the correct position, let me know... temp@xx@dict begin /dir exch def /ay1 exch def /ax1 exch def } def % crescendos /DC { /y2 ED /x2 ED /y1 ED /x1 ED gsave 2.5 psxAR ceiling setlinewidth % line thickness: this results 1 setlinecap % to exactly 2.5 pixels in 300 dpi 1 setlinejoin x2 y2 10 psxAR add moveto % the 10's specify wideness of the x1 y1 lineto % open end of the crescendo, x2 y2 10 psxAR sub lineto % similarly the 11's below stroke grestore } def % half crescendos /DHC { /y2 ED /x2 ED /y1 ED /x1 ED gsave 2.5 psxAR ceiling setlinewidth 1 setlinecap 1 setlinejoin x2 y2 11 psxAR add moveto x1 y1 4 psxAR add lineto stroke x1 y1 4 psxAR sub moveto x2 y2 11 psxAR sub lineto stroke grestore } def % differenced line /DLN { gsave psxGDAR ceiling setlinewidth psxGDAR exch psxGDAR neg rlineto stroke grestore } def % sloped line /DSLN { gsave psxGDAR ceiling setlinewidth psxGDAR exch 1.125 mul neg rotate 0 rlineto stroke grestore } def % free line (init & terminate) /DFLN { gsave psxGDAR ceiling setlinewidth CP moveto lineto stroke grestore } def end