From e0c6872cf40896c7be36b11dcc744620f10adf1d Mon Sep 17 00:00:00 2001 From: Norbert Preining Date: Mon, 2 Sep 2019 13:46:59 +0900 Subject: Initial commit --- macros/musixtex/dvips/psslurs.pro | 282 ++++++++++++++++++++++++++++++++++++++ 1 file changed, 282 insertions(+) create mode 100644 macros/musixtex/dvips/psslurs.pro (limited to 'macros/musixtex/dvips') diff --git a/macros/musixtex/dvips/psslurs.pro b/macros/musixtex/dvips/psslurs.pro new file mode 100644 index 0000000000..b1ba95253d --- /dev/null +++ b/macros/musixtex/dvips/psslurs.pro @@ -0,0 +1,282 @@ +% 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 + 1 psxAR ceiling setlinewidth % line thickness: this results + 1 setlinecap % to exactly 2 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 + 1 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 + -- cgit v1.2.3