diff options
Diffstat (limited to 'Build/source/texk/web2c/mp.web')
-rw-r--r-- | Build/source/texk/web2c/mp.web | 122 |
1 files changed, 73 insertions, 49 deletions
diff --git a/Build/source/texk/web2c/mp.web b/Build/source/texk/web2c/mp.web index 1b159920d05..0773f08620a 100644 --- a/Build/source/texk/web2c/mp.web +++ b/Build/source/texk/web2c/mp.web @@ -97,8 +97,8 @@ undergoes any modifications, so that it will be clear which version of @^extensions to \MP@> @^system dependencies@> -@d banner=='This is MetaPost, Version 0.980' {printed when \MP\ starts} -@d metapost_version=="0.980" +@d banner=='This is MetaPost, Version 0.99' {printed when \MP\ starts} +@d metapost_version=="0.99" @ Different \PASCAL s have slightly different conventions, and the present @!@:PASCAL H}{\ph@> @@ -4381,7 +4381,8 @@ fuss with. Every such parameter has an identifying code number, defined here. @d default_color_model=34 {the default color model for unspecified items} @d restore_clip_color=35 @d mpprocset=36 {wether or not create PostScript command shortcuts} -@d max_given_internal=36 +@d gtroffmode=37 {whether the user specified |-troff| on the command line} +@d max_given_internal=37 @<Glob...@>= @!internal:array[1..max_internal] of scaled; @@ -4469,6 +4470,8 @@ primitive("truecorners",internal_quantity,true_corners);@/ @!@:true_corners_}{\&{truecorners} primitive@> primitive("mpprocset",internal_quantity,mpprocset);@/ @!@:mpprocset_}{\&{mpprocset} primitive@> +primitive("troffmode",internal_quantity,gtroffmode);@/ +@!@:troffmode_}{\&{troffmode} primitive@> primitive("defaultcolormodel",internal_quantity,default_color_model);@/ @!@:default_color_model_}{\&{defaultcolormodel} primitive@> primitive("restoreclipcolor",internal_quantity,restore_clip_color);@/ @@ -4535,6 +4538,7 @@ int_name[prologues]:="prologues"; int_name[true_corners]:="truecorners"; int_name[default_color_model]:="defaultcolormodel"; int_name[mpprocset]:="mpprocset"; +int_name[gtroffmode]:="troffmode"; int_name[restore_clip_color]:="restoreclipcolor"; @ The following procedure, which is called just before \MP\ initializes its @@ -17084,7 +17088,10 @@ if p<>null then found:pict_length:=n; end; -@ Implement |turningnumber| +@ The turning number is computed only with respect to a triangular pen whose +@:turning_number_}{\&{turningnumber} primitive@> +vertices are $(0,1)$ and $(\pm{1\over2},0)$. The choice of pen isn't supposed +to matter but rounding error could make a difference if the path has a cusp. @<Additional cases of unary...@>= turning_op:if cur_type=pair_type then flush_cur_exp(0) @@ -17095,8 +17102,36 @@ turning_op:if cur_type=pair_type then flush_cur_exp(0) flush_cur_exp(turn_cycles(cur_exp)); end; -@ The function |an_angle| returns the value of the |angle| primitive, or $0$ if the -argument is |origin|. + +@ This code is based on Bogus\l{}av Jackowski's +|emergency_turningnumber| macro, with some minor changes by Taco +Hoekwater. The macro code looked more like this: +{\obeylines +vardef turning\_number primary p = +~~save res, ang, turns; +~~res := 0; +~~if length p <= 2: +~~~~if Angle ((point 0 of p) - (postcontrol 0 of p)) >= 0: 1 else: -1 fi +~~else: +~~~~for t = 0 upto length p-1 : +~~~~~~angc := Angle ((point t+1 of p) - (point t of p)) +~~~~~~~~- Angle ((point t of p) - (point t-1 of p)); +~~~~~~if angc > 180: angc := angc - 360; fi; +~~~~~~if angc < -180: angc := angc + 360; fi; +~~~~~~res := res + angc; +~~~~endfor; +~~res/360 +~~fi +enddef;} +The general idea is to calculate only the sum of the angles of straight lines between +the points, of a path, not worrying about cusps or self-intersections in the segments +at all. If the segment is not well-behaved, the result is not necesarily correct. But +the old code was not always correct either, and worse, it sometimes failed for well-behaved +paths as well. All known bugs that were triggered by the original code no longer occur +with this code, and it runs roughly 3 times as fast because the algorithm is much simpler. + +@ The macro |Angle()| returns the value of the |angle| primitive, or $0$ if the argument is +|origin|. Converting that calling convention to web code gives the |an_angle| function. @<Declare unary action...@>= function an_angle (@!xpar,@!ypar:scaled):angle; @@ -17108,63 +17143,42 @@ begin end; -@ The actual turning number is (for the moment) computed in a C function -that receives eight integers corresponding to the four controlling points, -and returns a single angle. Besides those, we have to account for discrete -moves at the actual points. +@ It is possible to overflow the return value of the |turn_cycles| +function when the path is sufficiently long and winding, but I am not +going to bother testing for that. In any case, it would only return +the looped result value, which is not a big problem. -@d p_nextnext==link(link(p)) -@d p_next==link(p) +The macro code for the repeat loop was a bit nicer to look +at than the pascal code, because it could use |point -1 of p|. In +pascal, the fastest way to loop around the path is not to look +backward once, but forward twice. These defines help hide the trick. -@d seven_twenty_deg==@'5500000000 {$720\cdot2^{20}$, represents $720^\circ$} +@d p_to==link(link(p)) +@d p_here==link(p) +@d p_from==p @<Declare unary action...@>= function turn_cycles (@!c:pointer):scaled; -label exit; var @!res,ang:angle; { the angles of intermediate results } @!turns:scaled; { the turn counter } @!p:pointer; { for running around the path } -@!xp,yp:integer; { coordinates of next point } -@!x,y:integer; { helper coordinates } -@!in_angle,out_angle:angle; { helper angles} -begin -res:=0; -turns:= 0; -p:=c; -if (p_next=p)or(p_nextnext=p) then +begin res:=0; turns:= 0; p:=c; +if ((link(p) = p) or (link(link(p)) = p)) then if an_angle (x_coord(p) - right_x(p), y_coord(p) - right_y(p)) >= 0 then turn_cycles := unity else turn_cycles := -unity else begin repeat - xp := x_coord(p_next); yp := y_coord(p_next); - ang := bezier_slope(x_coord(p), y_coord(p), right_x(p), right_y(p), - left_x(p_next), left_y(p_next), xp, yp); - if ang>seven_twenty_deg then begin - print_err("Strange path"); - error; - turn_cycles := 0; - return; - end; - res := res + ang; - { incoming angle at next point } - x := left_x(p_next); y := left_y(p_next); - if (xp=x)and(yp=y) then begin x := right_x(p); y := right_y(p); end; - if (xp=x)and(yp=y) then begin x := x_coord(p); y := y_coord(p); end; - in_angle := an_angle(xp - x, yp - y); - { outgoing angle at next point } - x := right_x(p_next); y := right_y(p_next); - if (xp=x)and(yp=y) then begin x := left_x(p_nextnext); y := left_y(p_nextnext); end; - if (xp=x)and(yp=y) then begin x := x_coord(p_nextnext); y := y_coord(p_nextnext); end; - out_angle := an_angle(x - xp, y- yp); - ang := (out_angle - in_angle); + ang := an_angle (x_coord(p_to) - x_coord(p_here), y_coord(p_to) - y_coord(p_here)) + - an_angle (x_coord(p_here) - x_coord(p_from), y_coord(p_here) - y_coord(p_from)); + reduce_angle(ang); res := res + ang; - while res >= three_sixty_deg do begin + if res >= three_sixty_deg then begin res := res - three_sixty_deg; turns := turns + unity; end; - while res <= -three_sixty_deg do begin + if res <= -three_sixty_deg then begin res := res + three_sixty_deg; turns := turns - unity; end; @@ -17172,7 +17186,17 @@ else begin until p=c; turn_cycles := turns; end; -exit: +end; + +@ @<Declare unary action...@>= +function count_turns(@!c:pointer):scaled; +var @!p:pointer; {a knot in envelope spec |c|} +@!t:integer; {total pen offset changes counted} +begin t:=0; p:=c; +repeat t:=t+info(p)-zero_off; +p:=link(p); +until p=c; +count_turns:=(t div 3)*unity; end; @ @d type_test_end== flush_cur_exp(true_code) @@ -23742,7 +23766,7 @@ print_char(" "); ds:=(font_dsize[font_n(p)]+8) div 16; print_scaled(take_scaled(ds,scf)); print(" fshow"); -if transformed then ps_print(" grestore") +if transformed then ps_print_cmd(" grestore"," Q") @ @<Shift or transform as necessary before outputting text node~|p| at...@>= transformed:=(txx_val(p)<>scf)or(tyy_val(p)<>scf)or@| @@ -23752,11 +23776,11 @@ if transformed then ps_pair_out(make_scaled(txx_val(p),scf),@|make_scaled(tyx_val(p),scf)); ps_pair_out(make_scaled(txy_val(p),scf),@|make_scaled(tyy_val(p),scf)); ps_pair_out(tx_val(p),ty_val(p));@/ - ps_print_cmd("] concat 0 0 ","] t 0 0"); + ps_print_cmd("] concat 0 0 moveto","] t 0 0 m"); end else begin ps_pair_out(tx_val(p),ty_val(p)); + ps_print_cmd("moveto","m"); end; -ps_print_cmd("moveto","m"); print_ln @ Now that we've finished |ship_out|, let's look at the other commands |