mf/mf2pt1.mp

   1 %%%%
   2 %%%% MF2PT1.MP, by Scott Pakin, scott+mf@pakin.org
   3 %%%%
   4 %%%% This file is used to dump a special version of MetaPost with:
   5 %%%%     mpost -progname=mpost -ini mf2pt1 \\dump
   6 %%%%
   7 %%%% To pretty-print this file, you'll need LaTeX and the mftinc package
   8 %%%% (available from CTAN).
   9 %%%%
  10
  11 %%%% ==================================================================== %%%%
  12 %%%% mf2pt1                                                               %%%%
  13 %%%% Copyright (C) 2008 Scott Pakin                                       %%%%
  14 %%%%                                                                      %%%%
  15 %%%% This program may be distributed and/or modified under the conditions %%%%
  16 %%%% of the LaTeX Project Public License, either version 1.3c of this     %%%%
  17 %%%% license or (at your option) any later version.                       %%%%
  18 %%%%                                                                      %%%%
  19 %%%% The latest version of this license is in:                            %%%%
  20 %%%%                                                                      %%%%
  21 %%%%    http://www.latex-project.org/lppl.txt                             %%%%
  22 %%%%                                                                      %%%%
  23 %%%% and version 1.3c or later is part of all distributions of LaTeX      %%%%
  24 %%%% version 2006/05/20 or later.                                         %%%%
  25 %%%% ==================================================================== %%%%
  26
  27 input mfplain;
  28
  29 %%% addto makepath makepen
  30 %%% length clockwise counterclockwise
  31 %%% scaled dashed withcolor
  32
  33 %% \begin{explaincode}
  34 %%   Enable a \MF\ file to determine if it's being built with
  35 %%   \texttt{mf2pt1}.
  36 %% \end{explaincode}
  37
  38 newinternal ps_output;
  39 ps_output := 1;
  40
  41
  42 %% \begin{explaincode}
  43 %%   The following was taken right out of \texttt{mfplain.mp}.  The \mfcomment
  44 %    |def| and the |special|s at the end
  45 %%   are the sole additions.  Normally, MetaPost outputs a tight bounding
  46 %%   box around the character in its PostScript output.  The purpose of the
  47 %%   first \mfcomment
  48 %    |special|
  49 %%   is to pass \texttt{mf2pt1} a bounding box that includes the proper
  50 %%   surrounding whitespace.  The purpose of the second special is to
  51 %%   provide \texttt{mf2pt1} with a default PostScript font name.
  52 %% \end{explaincode}
  53
  54 def beginchar(expr c,w_sharp,h_sharp,d_sharp) =
  55   begingroup
  56     charcode:=if known c: byte c else: 0 fi;
  57     charwd:=w_sharp;      charht:=h_sharp;       chardp:=d_sharp;
  58     w:=charwd*pt; h:=charht*pt; d:=chardp*pt;
  59     charic:=0; clearxy; clearit; clearpen; scantokens extra_beginchar;
  60
  61     def to_bp (expr num) = decimal (ceiling (num*bp_per_pixel)) enddef;
  62     special "% MF2PT1: glyph_dimensions 0 " & to_bp (-d) & " " & to_bp(w) & " " & to_bp(h);
  63     special "% MF2PT1: font_size " & decimal designsize;
  64     special "% MF2PT1: font_slant " & decimal font_slant_;
  65     special "% MF2PT1: charwd " & decimal charwd;   % Must come after the |font_size| |special|
  66     for fvar = "font_identifier", "font_coding_scheme", "font_version",
  67       "font_comment", "font_family", "font_weight", "font_unique_id",
  68       "font_name":
  69       if known scantokens (fvar & "_"):
  70         special "% MF2PT1: " & fvar & " " & scantokens (fvar & "_");
  71       fi;
  72     endfor;
  73     for fvar = "font_underline_position", "font_underline_thickness":
  74       if known scantokens (fvar & "_"):
  75         special "% MF2PT1: " & fvar & " " &
  76           scantokens ("decimal " & fvar & "_");
  77       fi;
  78     endfor;
  79     special "% MF2PT1: font_fixed_pitch " &
  80             (if font_fixed_pitch_: "1" else: "0" fi);
  81 enddef;
  82
  83
  84 %% \begin{explaincode}
  85 %%   Enable a character to specify explicitly the PostScript glyph
  86 %%   name associated with it.
  87 %% \end{explaincode}
  88 def glyph_name expr name =
  89   special "% MF2PT1: glyph_name " & name;
  90 enddef;
  91
  92
  93 %% \begin{explaincode}
  94 %%   Store the value of \mfcomment
  95 %    |font_slant_|, so we can recall it at each |beginchar|.
  96 %% \end{explaincode}
  97
  98 font_slant_ := 0;
  99
 100 def font_slant expr x =
 101   font_slant_ := x;
 102   fontdimen 1: x
 103 enddef;
 104
 105
 106 %% \begin{explaincode}
 107 %%   Redefine \mfcomment
 108 %    |bpppix_|, the number of ``big'' points per pixel. \mfcomment
 109 %    This in turn redefines |mm|, |in|, |pt|, and other derived units.
 110 %% \end{explaincode}
 111
 112 def bpppix expr x =
 113   bpppix_ := x;
 114   mm := 2.83464 / bpppix_;
 115   pt := 0.99626 / bpppix_;
 116   dd := 1.06601 / bpppix_;
 117   bp := 1 / bpppix_;
 118   cm := 28.34645 / bpppix_;
 119   pc := 11.95517 / bpppix_;
 120   cc := 12.79213 / bpppix_;
 121   in := 72 / bpppix_;
 122   hppp := pt;
 123   vppp := pt;
 124 enddef;
 125
 126
 127 %% \begin{explaincode}
 128 %%   Define a bunch of PostScript font parameters to be used by
 129 %%   \texttt{mf2pt1.pl}.  Default values are specified in
 130 %%   \texttt{mf2pt1.pl}, not here.
 131 %% \end{explaincode}
 132
 133 forsuffixes fvar = font_version, font_comment, font_family, font_weight,
 134                    font_name, font_unique_id:
 135   scantokens ("string " & str fvar & "_;");
 136   scantokens ("def " & str fvar & " expr x = " & str fvar & "_ := x enddef;");
 137 endfor;
 138
 139 forsuffixes fvar = font_underline_position, font_underline_thickness:
 140   scantokens ("numeric " & str fvar & "_;");
 141   scantokens ("def " & str fvar & " expr x = " & str fvar & "_ := x enddef;");
 142 endfor;
 143
 144 boolean font_fixed_pitch_;
 145 font_fixed_pitch_ := false;
 146 def font_fixed_pitch expr x = font_fixed_pitch_ := x enddef;
 147
 148
 149 %% \begin{explaincode}
 150 %%   We'd like to be able to use calligraphic pens.  Normally, MetaPost's
 151 %%   output routine does all the work for us of converting these to filled
 152 %%   PostScript paths.  The only exception occurs for paths drawn using a
 153 %%   pen that was transformed from  \mfcomment
 154 %    |pencircle|.  MetaPost outputs these paths as stroked PostScript
 155 %%   paths.  The following code tricks MetaPost into using a filled path
 156 %%   for  \mfcomment
 157 %    |pencircle| by replacing the primitive |pencircle| pen with a
 158 %%   non-primitive approximation.  Note that we use a 20-gon for our circle
 159 %%   instead of a diamond, so we get better results from  \mfcomment
 160 %    |draw|.
 161 %% \end{explaincode}
 162
 163 pen fakepencircle, mfplain_pencircle;
 164 mfplain_pencircle := pencircle;
 165 fakepencircle := makepen (for deg=0 step 360/20 until 359:
 166     (0.5 cosd deg, 0.5 sind deg)--
 167   endfor cycle);
 168 save pencircle;
 169 pen pencircle;
 170 pencircle := fakepencircle;
 171
 172
 173 %% \begin{explaincode}
 174 %%   Return  \mfcomment
 175 %    |true| if a path is cyclic, |false| otherwise.
 176 %% \end{explaincode}
 177
 178 def is_cyclic expr cpath =
 179   (point 0 of cpath = point (length cpath) of cpath)
 180 enddef;
 181
 182
 183 %% \begin{explaincode}
 184 %%   Determine the direction of a path which doesn't intersect
 185 %%   itself. \mfcomment
 186 %    Returns |true| if the curve is clockwise, |false| if
 187 %%   counterclockwise.  For non-cyclic paths the result is not
 188 %%   predictable.
 189 %%   \bigskip
 190 %%
 191 %%   The \mfcomment
 192 %    |crossproduct|, |makeline|, and |is_clockwise| functions were
 193 %%   provided by Werner Lemberg.
 194 %%   \bigskip
 195 %%
 196 %%   The algorithm used is quite simple:
 197 %%
 198 %%   \begin{itemize}
 199 %%     \item Find a point~$P$ on the path which has a non-zero direction,
 200 %%     and which is on a not-too-short path element.
 201 %%
 202 %%     \item Construct a ray of ``infinite'' length, starting in the
 203 %%     vicinity of~$P$ which intersects the path at this point.
 204 %%
 205 %%     \item Use \mfcomment
 206 %      |intersectiontimes| to find the intersection.  If the direction of
 207 %%     the path at this point is (near) zero, or if we have a grazing
 208 %%     intersection or even a tangent, get a new ray.
 209 %%
 210 %%     \item Shorten the ray so that it starts right after the
 211 %%     intersection.  Repeat the previous step until no intersection is
 212 %%     found.  Then go back to the last intersection and compare the path's
 213 %%     direction with the direction of the ray.  According to the
 214 %%     \emph{nonzero winding number} rule we have found a clockwise
 215 %%     oriented path if it crosses the ray from left to right.
 216 %%   \end{itemize}
 217 %%
 218 %%   This method completely avoids any problems with the geometry of
 219 %%   B\'{e}zier curves.  If problems arise, a different ray is tried.
 220 %%   Since it isn't necessary to analyze the whole path it runs quite fast
 221 %%   in spite of using \mfcomment
 222 %    |intersectiontimes| which is a slow MetaPost command.
 223 %% \end{explaincode}
 224
 225 vardef crossproduct (expr u, v) =
 226   save u_, v_;
 227   pair u_, v_;
 228
 229   u_ := unitvector u;
 230   v_ := unitvector v;
 231
 232   abs (xpart u_ * ypart v_ - ypart u_ * xpart v_)
 233 enddef;
 234
 235 vardef makeline primary p =
 236   save start, bad_n, loop, distance, d, i, n;
 237   pair start, d;
 238
 239   loop := 0;
 240   bad_n := -1;
 241   for i := 0 step 1 until length p - 1:
 242     distance := length (point i of p - point (i + 1) of p);
 243     if distance <> 0:
 244       if distance < 1:
 245         % In case we don't find something better.
 246         bad_n := i;
 247       else:
 248         n := i;
 249         loop := 1;
 250       fi;
 251     fi;
 252     exitif loop = 1;
 253   endfor;
 254
 255   if loop = 0:
 256     if bad_n <> -1:
 257       n := bad_n;
 258       loop = 1;
 259     fi;
 260   fi;
 261
 262   % Add some randomness to get different lines for each function call.
 263   n := n + uniformdeviate 0.8 + 0.1;
 264   start := point n of p;
 265
 266   if loop = 0:
 267     % Construct a line which misses the degenerated path.
 268     start + (1, 0)
 269     -- start + (1, 1)
 270   else:
 271     d := direction n of p;
 272
 273     % Again, some added randomness.
 274     n := uniformdeviate 150 + 15;
 275     d := unitvector (d rotated n);
 276
 277     % Construct a line which intersects the path at least once.
 278     start - eps * d
 279     -- infinity * d
 280   fi
 281 enddef;
 282
 283 vardef is_clockwise primary p =
 284   save line, cut, cut_new, res, line_dir, tangent_dir;
 285   path line;
 286   pair cut, cut_new, line_dir, tangent_dir;
 287
 288   line := makeline p;
 289   line_dir := direction 0 of line;
 290
 291   % Find the outermost intersection.
 292   cut := (0, 0);
 293   forever:
 294     cut_new := line intersectiontimes p;
 295     exitif cut_new = (-1, -1);
 296
 297     % Compute a new line if we have a strange intersection.
 298     tangent_dir := direction (ypart cut_new) of p;
 299     if abs tangent_dir < eps:
 300       % The vector is zero or too small.
 301       line := makeline p;
 302       line_dir := direction 0 of line;
 303
 304     elseif abs (ypart cut_new - floor (ypart cut_new + 0.5)) < eps:
 305       % Avoid possible tangent touching in a corner or cusp.
 306       line := makeline p;
 307       line_dir := direction 0 of line;
 308
 309     elseif crossproduct (tangent_dir, line_dir) < 0.2:
 310       % Grazing intersection (arcsin 0.2 ~= 11.5 degrees).
 311       line := makeline p;
 312       line_dir := direction 0 of line;
 313
 314     else:
 315       % Go ahead.
 316       cut := cut_new;
 317       line := subpath (xpart cut + eps, infinity) of line;
 318     fi;
 319   endfor;
 320
 321   tangent_dir := direction (ypart cut) of p;
 322   if tangent_dir <> (0, 0):
 323     res := (angle tangent_dir - angle line_dir + 180) mod 360 - 180;
 324     res < 0
 325   else:
 326     false
 327   fi
 328 enddef;
 329
 330
 331 %% \begin{explaincode}
 332 %%   Make a given path run clockwise or counterclockwise.  \mfcomment
 333 %    (|counterclockwise| is defined by \texttt{mfplain} but we override
 334 %%   it here.)
 335 %% \end{explaincode}
 336
 337 vardef counterclockwise primary c =
 338   (if is_clockwise c: (reverse c) else: c fi)
 339 enddef;
 340
 341 vardef clockwise primary c =
 342   (if is_clockwise c: c else: (reverse c) fi)
 343 enddef;
 344
 345
 346 %% \begin{explaincode}
 347 %%   Redefine  \mfcomment
 348 %    |fill| and |unfill| to ensure that filled paths run
 349 %%   counterclockwise and unfilled paths run clockwise, as is required
 350 %%   by PostScript Type~1 fonts.
 351 %% \end{explaincode}
 352
 353 def fill expr c =
 354   addto currentpicture contour counterclockwise c t_ pc_
 355 enddef;
 356
 357 def unfill expr c =
 358   addto currentpicture contour clockwise c t_ pc_ withcolor background
 359 enddef;
 360
 361
 362 %% \begin{explaincode}
 363 %%   Convert  \mfcomment
 364 %    |filldraw| and |unfilldraw| to |fill| and |unfill|.
 365 %% \end{explaincode}
 366
 367 let mfplain_filldraw := filldraw;
 368 def filldraw expr c =
 369   begingroup
 370     message "! Warning: Replacing filldraw with fill.";
 371     fill c
 372   endgroup
 373 enddef;
 374
 375 let mfplain_unfilldraw := unfilldraw;
 376 def unfilldraw expr c =
 377   begingroup
 378     message "! Warning: Replacing unfilldraw with unfill.";
 379     unfill c
 380   endgroup
 381 enddef;
 382
 383
 384 %% \begin{explaincode}
 385 %%   Return  \mfcomment
 386 %    |true| if |currentpen| looks like a |pencircle|.
 387 %% \end{explaincode}
 388
 389 def using_pencircle =
 390   begingroup
 391     path qpath, circlepath;
 392     qpath = makepath currentpen;
 393     numeric circlediv;
 394     circlepath = makepath pencircle;
 395     circlediv = xpart (lrcorner circlepath);
 396
 397     (length qpath = length circlepath) and (pen_rt <> 0) and (pen_top <> 0)
 398     for pp = 0 upto (length qpath)-1:
 399       and ((xpart (point pp of qpath) / pen_rt,
 400             ypart (point pp of qpath) / pen_top) =
 401            point pp of circlepath / circlediv)
 402     endfor
 403   endgroup
 404 enddef;
 405
 406
 407 %% \begin{explaincode}
 408 %%   If the pen looks like a circular pen, draw a nice circle.  Otherwise,
 409 %%   draw the pen as is.
 410 %% \end{explaincode}
 411
 412 def drawdot expr z =
 413   if using_pencircle:
 414     begingroup
 415       path cpath;
 416       numeric clength;
 417       cpath = makepath currentpen;
 418       clength = length cpath;
 419       fill ((point 0 of cpath)
 420         ..(point clength/4 of cpath)
 421         ..(point clength/2 of cpath)
 422         ..(point 3*clength/4 of cpath)
 423         ..cycle) shifted z t_
 424     endgroup
 425   else:
 426     addto currentpicture contour makepath currentpen shifted z
 427     t_ pc_
 428   fi
 429 enddef;
 430
 431
 432 %% \begin{explaincode}
 433 %%   Do the same as the above, but unfill the current pen.
 434 %% \end{explaincode}
 435
 436 def undrawdot expr z =
 437   if using_pencircle:
 438     begingroup
 439       path cpath;
 440       numeric clength;
 441       cpath = makepath currentpen;
 442       clength = length cpath;
 443       unfill ((point 0 of cpath)
 444         ..(point clength/4 of cpath)
 445         ..(point clength/2 of cpath)
 446         ..(point 3*clength/4 of cpath)
 447         ..cycle) shifted z t_
 448     endgroup
 449   else:
 450     unfill makepath currentpen shifted z t_
 451   fi
 452 enddef;
 453
 454
 455 %% \begin{explaincode}
 456 %%   MetaPost renders \mfcomment
 457 %    |draw| with a filled curve.
 458 %%   Hence, we need to ensure the orientation is correct (i.e.,
 459 %%   counterclockwise).  Unfortunately, we have no way to check for
 460 %%   overlap, and it's fairly common for MetaPost to output
 461 %%   self-overlapping curve outlines, even if the curve itself has no
 462 %%   overlap.
 463 %% \end{explaincode}
 464
 465 def draw expr p =
 466   addto currentpicture
 467   if picture p:
 468     also p
 469   elseif is_cyclic p:
 470     doublepath counterclockwise p t_ withpen currentpen
 471   else:
 472     if is_clockwise (p--cycle):
 473       doublepath (reverse p) t_ withpen currentpen
 474     else:
 475       doublepath p t_ withpen currentpen
 476     fi
 477   fi
 478   pc_
 479 enddef;
 480
 481 def undraw expr p =
 482   addto currentpicture
 483   if picture p:
 484     also p
 485   elseif is_cyclic p:
 486     doublepath clockwise p t_ withpen currentpen
 487   else:
 488     if is_clockwise (p--cycle):
 489       doublepath p t_ withpen currentpen
 490     else:
 491       doublepath (reverse p) t_ withpen currentpen
 492     fi
 493   fi
 494   pc_ withcolor background
 495 enddef;