diff options
author | Taco Hoekwater <taco@elvenkind.com> | 2007-11-28 22:38:47 +0000 |
---|---|---|
committer | Taco Hoekwater <taco@elvenkind.com> | 2007-11-28 22:38:47 +0000 |
commit | 068f23e738bb4d158c6e5986cb24ea6bddcee0eb (patch) | |
tree | bde51f1a1de612c002e6d9eaac407fd789ea9a1f /Build/source/texk/web2c/mp.web | |
parent | efd2ea1905cc57421e4d5b3123797164601993a4 (diff) |
MetaPost version 1.002
git-svn-id: svn://tug.org/texlive/trunk@5639 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Build/source/texk/web2c/mp.web')
-rw-r--r-- | Build/source/texk/web2c/mp.web | 204 |
1 files changed, 150 insertions, 54 deletions
diff --git a/Build/source/texk/web2c/mp.web b/Build/source/texk/web2c/mp.web index 8f8ef7eb6c8..26dc205e7fa 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.993' {printed when \MP\ starts} -@d metapost_version=="0.993" +@d banner=='This is MetaPost, Version 1.002' {printed when \MP\ starts} +@d metapost_version=="1.002" @ Different \PASCAL s have slightly different conventions, and the present @!@:PASCAL H}{\ph@> @@ -17088,10 +17088,7 @@ if p<>null then found:pict_length:=n; end; -@ 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. +@ Implement |turningnumber| @<Additional cases of unary...@>= turning_op:if cur_type=pair_type then flush_cur_exp(0) @@ -17099,9 +17096,100 @@ turning_op:if cur_type=pair_type then flush_cur_exp(0) else if left_type(cur_exp)=endpoint then flush_cur_exp(0) {not a cyclic path} else begin - flush_cur_exp(turn_cycles(cur_exp)); + flush_cur_exp(turn_cycles_wrapper(cur_exp)); end; +@ The function |an_angle| returns the value of the |angle| primitive, or $0$ if the +argument is |origin|. + +@<Declare unary action...@>= +function an_angle (@!xpar,@!ypar:scaled):angle; +begin + if (not ((xpar=0) and (ypar=0))) then + an_angle := n_arg(xpar,ypar) + else + an_angle := 0; +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. + +@d p_nextnext==link(link(p)) +@d p_next==link(p) + +@d seven_twenty_deg==@'5500000000 {$720\cdot2^{20}$, represents $720^\circ$} + +@<Declare unary action...@>= +function new_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} +@!old_setting:0..max_selector; {saved |selector| setting} +begin +res:=0; +turns:= 0; +p:=c; +old_setting := selector; selector:=term_only; +if internal[tracing_commands]>unity then begin + begin_diagnostic; + print_nl(""); + end_diagnostic(false); +end; +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, internal[tracing_commands]); + if ang>seven_twenty_deg then begin + print_err("Strange path"); + error; + new_turn_cycles := 0; + return; + end; + res := res + ang; + if res > one_eighty_deg then begin + res := res - three_sixty_deg; + turns := turns + unity; + end; + if res <= -one_eighty_deg then begin + res := res + three_sixty_deg; + turns := turns - unity; + end; + { 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); + reduce_angle(ang); + if ang<>0 then begin + res := res + ang; + if res >= one_eighty_deg then begin + res := res - three_sixty_deg; + turns := turns + unity; + end; + if res <= -one_eighty_deg then begin + res := res + three_sixty_deg; + turns := turns - unity; + end; + end; + p := link(p); +until p=c; +new_turn_cycles := turns; +exit: +selector:=old_setting; +end; + @ This code is based on Bogus\l{}av Jackowski's |emergency_turningnumber| macro, with some minor changes by Taco @@ -17130,19 +17218,6 @@ the old code was not always correct either, and worse, it sometimes failed for w 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; -begin - if (not ((xpar=0) and (ypar=0))) then - an_angle := n_arg(xpar,ypar) - else - an_angle := 0; -end; - - @ 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 @@ -17163,29 +17238,50 @@ var @!res,ang:angle; { the angles of intermediate results } @!turns:scaled; { the turn counter } @!p:pointer; { for running around the path } 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 - 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; - if res >= three_sixty_deg then begin - res := res - three_sixty_deg; - turns := turns + unity; - end; - if res <= -three_sixty_deg then begin - res := res + three_sixty_deg; - turns := turns - unity; - end; - p := link(p); - until p=c; - turn_cycles := turns; +repeat + 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; + if res >= three_sixty_deg then begin + res := res - three_sixty_deg; + turns := turns + unity; + end; + if res <= -three_sixty_deg then begin + res := res + three_sixty_deg; + turns := turns - unity; + end; + p := link(p); +until p=c; +turn_cycles := turns; end; + +@ @<Declare unary action...@>= +function turn_cycles_wrapper (@!c:pointer):scaled; + var nval,oval:scaled; + saved_t_o:scaled; {tracing\_online saved } +begin + if (link(c)=c)or(link(link(c))=c) then + if an_angle (x_coord(c) - right_x(c), y_coord(c) - right_y(c)) > 0 then + turn_cycles_wrapper := unity + else + turn_cycles_wrapper := -unity + else begin + nval := new_turn_cycles(c); + oval := turn_cycles(c); + if nval<>oval then begin + saved_t_o:=internal[tracing_online]; + internal[tracing_online]:=unity; + begin_diagnostic; + print_nl ("Warning: the turningnumber algorithms do not agree. The current computed value is "); + print_scaled(nval); + print(", but the 'connect-the-dots' algorithm returned "); + print_scaled(oval); + end_diagnostic(false); + internal[tracing_online]:=saved_t_o; + end; + turn_cycles_wrapper := nval; + end; end; @ @<Declare unary action...@>= @@ -21649,6 +21745,7 @@ This routine issues a warning message if the user has asked for it. procedure lost_warning(@!f:font_number;@!k:pool_pointer); begin if internal[tracing_lost_chars]>0 then begin begin_diagnostic; + if selector=log_only then incr(selector); print_nl("Missing character: There is no "); @.Missing character@> print(so(str_pool[k])); print(" in font "); @@ -21786,8 +21883,7 @@ function new_dummy_font: font_number; begin new_dummy_font := read_font_info("dummy"); end; - -@x +@# function round_xn_over_d(@!x:scaled; @!n,@!d:integer):scaled; var positive:boolean; {was |x>=0|?} @!t,@!u,@!v:nonnegative_integer; {intermediate quantities} @@ -22395,9 +22491,9 @@ begin (gs_colormodel<>cmyk_model) then begin if color_model(p)=uninitialized_model then begin - gs_red:=unity; - gs_green:=unity; - gs_blue:=unity; + gs_red:=0; + gs_green:=0; + gs_blue:=0; gs_black:=unity;@/ end else begin @@ -22649,14 +22745,14 @@ if internal[mpprocset]=0 then begin else begin if fill_also then print_nl("B") else print_ln; if (txy<>0)or(tyx<>0) then - begin {print_ln;} + begin print(" ["); ps_pair_out(txx,tyx); ps_pair_out(txy,tyy);@/ ps_print("0 0] t"); end else if (txx<>unity)or(tyy<>unity) then - begin {print_ln;} + begin ps_pair_out(txx,tyy); print(" s"); end; @@ -22673,7 +22769,7 @@ tyx:=left_y(p);@/ txy:=right_x(p); tyy:=right_y(p); if (x_coord(p)<>0)or(y_coord(p)<>0) then - begin print_ln; print_cmd("gsave ","q "); + begin print_nl(""); print_cmd("gsave ","q "); ps_pair_out(x_coord(p),y_coord(p)); ps_print("translate ");@/ txx:=txx-x_coord(p); @@ -23046,9 +23142,7 @@ end @ @<Print any pending specials@>= t:=link(spec_head); while t<>null do - begin if length(value(t))<=emergency_line_length then print(value(t)) - else overflow("output line length",emergency_line_length); -@:MetaPost capacity exceeded output line length}{\quad output line length@> + begin print(value(t)); print_ln; t:=link(t); end; @@ -23202,7 +23296,7 @@ begin end else begin begin_diagnostic; - {selector:=term_and_log;} + if selector=log_only then incr(selector); print_err("Warning: font "); print(font_name[f]); print(" cannot be found in any fontmapfile!"); @@ -23696,11 +23790,13 @@ if ldf<>null_font then begin end; end; if internal[mpprocset]>0 then begin + print_nl("%%BeginResource: procset mpost"); if (internal[prologues]>0)and(ldf<>null_font) then print("/bd{bind def}bind def/fshow {exch findfont exch scalefont setfont show}bd") else print_nl("/bd{bind def}bind def"); @<Print the procset@>; + print_nl("%%EndResource"); print_ln; end; end |