git.oblomov.eu Git - mplib/blob - src/texk/web2c/mpdir/lib/psout.w

   1 % $Id: mp.web,v 1.8 2005/08/24 10:54:02 taco Exp $
   2 % MetaPost, by John Hobby.  Public domain.
   3
   4 % Much of this program was copied with permission from MF.web Version 1.9
   5 % It interprets a language very similar to D.E. Knuth's METAFONT, but with
   6 % changes designed to make it more suitable for PostScript output.
   7
   8 % TeX is a trademark of the American Mathematical Society.
   9 % METAFONT is a trademark of Addison-Wesley Publishing Company.
  10 % PostScript is a trademark of Adobe Systems Incorporated.
  11
  12 % Here is TeX material that gets inserted after \input webmac
  13 \def\hang{\hangindent 3em\noindent\ignorespaces}
  14 \def\textindent#1{\hangindent2.5em\noindent\hbox to2.5em{\hss#1 }\ignorespaces}
  15 \def\PASCAL{Pascal}
  16 \def\ps{PostScript}
  17 \def\ph{\hbox{Pascal-H}}
  18 \def\psqrt#1{\sqrt{\mathstrut#1}}
  19 \def\k{_{k+1}}
  20 \def\pct!{{\char`\%}} % percent sign in ordinary text
  21 \font\tenlogo=logo10 % font used for the METAFONT logo
  22 \font\logos=logosl10
  23 \def\MF{{\tenlogo META}\-{\tenlogo FONT}}
  24 \def\MP{{\tenlogo META}\-{\tenlogo POST}}
  25 \def\<#1>{$\langle#1\rangle$}
  26 \def\section{\mathhexbox278}
  27 \let\swap=\leftrightarrow
  28 \def\round{\mathop{\rm round}\nolimits}
  29 \mathchardef\vb="026A % synonym for `\|'
  30 \def\[#1]{} % from pascal web
  31 \def\(#1){} % this is used to make section names sort themselves better
  32 \def\9#1{} % this is used for sort keys in the index via @@:sort key}{entry@@>
  33
  34 \let\?=\relax % we want to be able to \write a \?
  35
  36 \def\title{MetaPost \ps\ output}
  37 \def\topofcontents{\hsize 5.5in
  38   \vglue -30pt plus 1fil minus 1.5in
  39   \def\?##1]{\hbox to 1in{\hfil##1.\ }}
  40   }
  41 \def\botofcontents{\vskip 0pt plus 1fil minus 1.5in}
  42 \pdfoutput=1
  43 \pageno=3
  44
  45 @
  46 @d true 1
  47 @d false 0
  48 @d null_font 0
  49 @d null 0
  50 @d unity   0200000 /* $2^{16}$, represents 1.00000 */
  51 @d two     0400000 /* $2^{17}$, represents 2.00000 */
  52 @d three   0600000 /* represents 3.00000 */
  53 @d el_gordo   017777777777 /* $2^{31}-1$, the largest value that \MP\ likes */
  54 @d incr(A)   (A)=(A)+1 /* increase a variable by unity */
  55 @d decr(A)   (A)=(A)-1 /* decrease a variable by unity */
  56 @d negate(A)   (A)=-(A) /* change the sign of a variable */
  57 @d odd(A)   ((A)%2==1)
  58 @d half(A) ((A)/2)
  59 @d print_err(A) mp_print_err(mp,(A))
  60 @d max_quarterword 0x3FFF /* largest allowable value in a |quarterword| */
  61
  62 @c
  63 #include <stdio.h>
  64 #include <stdlib.h>
  65 #include <string.h>
  66 #include <stdarg.h>
  67 #include <assert.h>
  68 #include "avl.h"
  69 #include "mplib.h"
  70 #include "mpmp.h" /* internal header */
  71 #include "mppsout.h" /* internal header */
  72 @h
  73 @<Declarations@>;
  74 @<Static variables in the outer block@>;
  75
  76 @ There is a small bit of code from the backend that bleads through
  77 to the frontend because I do not know how to set up the includes
  78 properly. Those are the definitions of |struct libavl_allocator|
  79 and |typedef struct psout_data_struct * psout_data|.
  80
  81 The |libavl_allocator| is a trick that makes sure that frontends
  82 do not need |avl.h|, and the |psout_data| is needed for the backend
  83 data structure.
  84
  85 @ @(mppsout.h@>=
  86 @<Types...@>;
  87 typedef struct psout_data_struct {
  88   @<Globals@>;
  89 } psout_data_struct ;
  90 @<Exported function headers@>
  91
  92 @ @<Exported function headers@>=
  93 void mp_backend_initialize (MP mp) ;
  94 void mp_backend_free (MP mp) ;
  95
  96 @
  97 @c void mp_backend_initialize (MP mp) {
  98   mp->ps = mp_xmalloc(mp,1,sizeof(psout_data_struct));
  99   @<Set initial values@>;
 100 }
 101 void mp_backend_free (MP mp) {
 102   @<Dealloc variables@>;
 103   enc_free(mp);
 104   t1_free(mp);
 105   fm_free(mp);
 106   mp_xfree(mp->ps);
 107   mp->ps = NULL;
 108 }
 109
 110 @ Writing to ps files
 111
 112 @<Globals@>=
 113 integer ps_offset;
 114   /* the number of characters on the current \ps\ file line */
 115
 116 @ @<Set initial values@>=
 117 mp->ps->ps_offset = 0;
 118
 119 @
 120
 121 @d wps(A)     (mp->write_ascii_file)(mp->ps_file,(A))
 122 @d wps_chr(A) do {
 123   char ss[2];
 124   ss[0]=(A); ss[1]=0;
 125   (mp->write_ascii_file)(mp->ps_file,(char *)ss);
 126 } while (0)
 127 @d wps_cr     (mp->write_ascii_file)(mp->ps_file,"\n")
 128 @d wps_ln(A)  { wterm_cr; (mp->write_ascii_file)(mp->ps_file,(A)); }
 129
 130 @c
 131 void mp_ps_print_ln (MP mp) { /* prints an end-of-line */
 132   wps_cr;
 133   mp->ps->ps_offset=0;
 134 }
 135
 136 @ @c
 137 void mp_ps_print_char (MP mp, ASCII_code s) { /* prints a single character */
 138   if ( s==13 ) {
 139     wps_cr; mp->ps->ps_offset=0;
 140   } else {
 141     wps_chr(s); incr(mp->ps->ps_offset);
 142   }
 143 }
 144
 145 @ @c
 146 void mp_ps_do_print (MP mp, char *ss, unsigned int len) { /* prints string |s| */
 147   unsigned int j = 0;
 148   while ( j<len ){
 149     mp_ps_print_char(mp, ss[j]); incr(j);
 150   }
 151 }
 152
 153 @ Deciding where to break the ps output line.
 154
 155 @d ps_room(A) if ( (mp->ps->ps_offset+(int)(A))>mp->max_print_line ) {
 156   mp_ps_print_ln(mp); /* optional line break */
 157 }
 158
 159 @c
 160 void mp_ps_print (MP mp, char *ss) {
 161   ps_room(strlen(ss));
 162   mp_ps_do_print(mp, ss, strlen(ss));
 163 }
 164
 165 @ The procedure |print_nl| is like |print|, but it makes sure that the
 166 string appears at the beginning of a new line.
 167
 168 @c
 169 void mp_ps_print_nl (MP mp, char *s) { /* prints string |s| at beginning of line */
 170   if ( mp->ps->ps_offset>0 ) mp_ps_print_ln(mp);
 171   mp_ps_print(mp, s);
 172 }
 173
 174 @ An array of digits in the range |0..9| is printed by |print_the_digs|.
 175
 176 @c
 177 void mp_ps_print_the_digs (MP mp, eight_bits k) {
 178   /* prints |dig[k-1]|$\,\ldots\,$|dig[0]| */
 179   while ( k-->0 ){
 180     mp_ps_print_char(mp, '0'+mp->dig[k]);
 181   }
 182 }
 183
 184 @ The following procedure, which prints out the decimal representation of a
 185 given integer |n|, has been written carefully so that it works properly
 186 if |n=0| or if |(-n)| would cause overflow. It does not apply |mod| or |div|
 187 to negative arguments, since such operations are not implemented consistently
 188 by all \PASCAL\ compilers.
 189
 190 @c
 191 void mp_ps_print_int (MP mp,integer n) { /* prints an integer in decimal form */
 192   integer m; /* used to negate |n| in possibly dangerous cases */
 193   int k = 0; /* index to current digit; we assume that $|n|<10^{23}$ */
 194   if ( n<0 ) {
 195     mp_ps_print_char(mp, '-');
 196     if ( n>-100000000 ) {
 197           negate(n);
 198     } else  {
 199           m=-1-n; n=m / 10; m=(m % 10)+1; k=1;
 200       if ( m<10 ) {
 201         mp->dig[0]=m;
 202       } else {
 203         mp->dig[0]=0; incr(n);
 204       }
 205     }
 206   }
 207   do {
 208     mp->dig[k]=n % 10; n=n / 10; incr(k);
 209   } while (n!=0);
 210   mp_ps_print_the_digs(mp, k);
 211 };
 212
 213 @ @<Internal ...@>=
 214 void mp_ps_print_int (MP mp,integer n);
 215
 216 @ \MP\ also makes use of a trivial procedure to print two digits. The
 217 following subroutine is usually called with a parameter in the range |0<=n<=99|.
 218
 219 @c
 220 void mp_ps_print_dd (MP mp,integer n) { /* prints two least significant digits */
 221   n=abs(n) % 100;
 222   mp_ps_print_char(mp, '0'+(n / 10));
 223   mp_ps_print_char(mp, '0'+(n % 10));
 224 }
 225
 226 @ Conversely, here is a procedure analogous to |print_int|. If the output
 227 of this procedure is subsequently read by \MP\ and converted by the
 228 |round_decimals| routine above, it turns out that the original value will
 229 be reproduced exactly. A decimal point is printed only if the value is
 230 not an integer. If there is more than one way to print the result with
 231 the optimum number of digits following the decimal point, the closest
 232 possible value is given.
 233
 234 The invariant relation in the \&{repeat} loop is that a sequence of
 235 decimal digits yet to be printed will yield the original number if and only if
 236 they form a fraction~$f$ in the range $s-\delta\L10\cdot2^{16}f<s$.
 237 We can stop if and only if $f=0$ satisfies this condition; the loop will
 238 terminate before $s$ can possibly become zero.
 239
 240 @c
 241 void mp_ps_print_scaled (MP mp,scaled s) {
 242   scaled delta; /* amount of allowable inaccuracy */
 243   if ( s<0 ) {
 244         mp_ps_print_char(mp, '-');
 245     negate(s); /* print the sign, if negative */
 246   }
 247   mp_ps_print_int(mp, s / unity); /* print the integer part */
 248   s=10*(s % unity)+5;
 249   if ( s!=5 ) {
 250     delta=10;
 251     mp_ps_print_char(mp, '.');
 252     do {
 253       if ( delta>unity )
 254         s=s+0100000-(delta / 2); /* round the final digit */
 255       mp_ps_print_char(mp, '0'+(s / unity));
 256       s=10*(s % unity);
 257       delta=delta*10;
 258     } while (s>delta);
 259   }
 260 }
 261
 262
 263 @* \[44a] Dealing with font encodings.
 264
 265 First, here are a few helpers for parsing files
 266
 267 @d check_buf(size, buf_size)
 268     if ((unsigned)(size) > (unsigned)(buf_size)) {
 269       char s[128];
 270       snprintf(s,128,"buffer overflow: (%d,%d) at file %s, line %d",
 271                size,buf_size, __FILE__,  __LINE__ );
 272       mp_fatal_error(mp,s);
 273     }
 274
 275 @d append_char_to_buf(c, p, buf, buf_size) do {
 276     if (c == 9)
 277         c = 32;
 278     if (c == 13 || c == EOF)
 279         c = 10;
 280     if (c != ' ' || (p > buf && p[-1] != 32)) {
 281         check_buf(p - buf + 1, (buf_size));
 282         *p++ = c;
 283     }
 284 } while (0)
 285
 286 @d append_eol(p, buf, buf_size) do {
 287     check_buf(p - buf + 2, (buf_size));
 288     if (p - buf > 1 && p[-1] != 10)
 289         *p++ = 10;
 290     if (p - buf > 2 && p[-2] == 32) {
 291         p[-2] = 10;
 292         p--;
 293     }
 294     *p = 0;
 295 } while (0)
 296
 297 @d remove_eol(p, buf) do {
 298     p = strend(buf) - 1;
 299     if (*p == 10)
 300         *p = 0;
 301 } while (0)
 302
 303 @d skip(p, c)   if (*p == c)  p++
 304 @d strend(s)    strchr(s, 0)
 305 @d str_prefix(s1, s2)  (strncmp((s1), (s2), strlen(s2)) == 0)
 306
 307
 308 @ @<Types...@>=
 309 typedef struct {
 310     boolean loaded;             /* the encoding has been loaded? */
 311     char *file_name;                 /* encoding file name */
 312     char *enc_name;              /* encoding true name */
 313     integer objnum;             /* object number */
 314     char **glyph_names;
 315     integer tounicode;          /* object number of associated ToUnicode entry */
 316 } enc_entry;
 317
 318
 319 @
 320
 321 @d ENC_STANDARD  0
 322 @d ENC_BUILTIN   1
 323
 324 @<Glob...@>=
 325 #define ENC_BUF_SIZE  0x1000
 326 char enc_line[ENC_BUF_SIZE];
 327 void * enc_file;
 328
 329 @
 330 @d enc_eof()       (mp->eof_file)(mp->ps->enc_file)
 331 @d enc_close()     (mp->close_file)(mp->ps->enc_file)
 332
 333 @c
 334 int enc_getchar(MP mp) {
 335   size_t len = 1;
 336   unsigned char byte=0;
 337   void *byte_ptr = &byte;
 338   (mp->read_binary_file)(mp->ps->enc_file,&byte_ptr,&len);
 339   return byte;
 340 }
 341
 342 @ @c
 343 static boolean mp_enc_open (MP mp, char *n) {
 344   mp->ps->enc_file=(mp->open_file)(n, "rb", mp_filetype_encoding);
 345   if (mp->ps->enc_file!=NULL)
 346     return true;
 347   else
 348    return false;
 349 }
 350 static void mp_enc_getline (MP mp) {
 351   char *p;
 352   int c;
 353 RESTART:
 354   if (enc_eof ()) {
 355     print_err("unexpected end of file");
 356     mp_error(mp);
 357   }
 358   p = mp->ps->enc_line;
 359   do {
 360     c = enc_getchar (mp);
 361     append_char_to_buf (c, p, mp->ps->enc_line, ENC_BUF_SIZE);
 362   } while (c != 10);
 363   append_eol (p, mp->ps->enc_line, ENC_BUF_SIZE);
 364   if (p - mp->ps->enc_line < 2 || *mp->ps->enc_line == '%')
 365     goto RESTART;
 366 }
 367 static void mp_load_enc (MP mp, char *enc_name,
 368                   char **enc_encname, char **glyph_names){
 369   char buf[ENC_BUF_SIZE], *p, *r;
 370   int names_count;
 371   char *myname;
 372   int save_selector = mp->selector;
 373   if (!mp_enc_open (mp,enc_name)) {
 374       mp_print (mp,"cannot open encoding file for reading");
 375       return;
 376   }
 377   mp_normalize_selector(mp);
 378   mp_print (mp,"{");
 379   mp_print (mp, enc_name);
 380   mp_enc_getline (mp);
 381   if (*mp->ps->enc_line != '/' || (r = strchr (mp->ps->enc_line, '[')) == NULL) {
 382     remove_eol (r, mp->ps->enc_line);
 383     print_err ("invalid encoding vector (a name or `[' missing): `");
 384     mp_print(mp,mp->ps->enc_line);
 385     mp_print(mp,"'");
 386     mp_error(mp);
 387   }
 388   while (*(r-1)==' ') r--; /* strip trailing spaces from encoding name */
 389   myname = mp_xmalloc(mp,r-mp->ps->enc_line,1);
 390   memcpy(myname,mp->ps->enc_line+1,(r-mp->ps->enc_line)-1);
 391   *(myname+(r-mp->ps->enc_line-1))=0;
 392   *enc_encname = myname;
 393   while (*r!='[') r++;
 394   r++;                        /* skip '[' */
 395   names_count = 0;
 396   skip (r, ' ');
 397   for (;;) {
 398     while (*r == '/') {
 399       for (p = buf, r++;
 400            *r != ' ' && *r != 10 && *r != ']' && *r != '/'; *p++ = *r++);
 401         *p = 0;
 402       skip (r, ' ');
 403       if (names_count > 256) {
 404         print_err ("encoding vector contains more than 256 names");
 405         mp_error(mp);
 406       }
 407       if (mp_xstrcmp (buf, notdef) != 0)
 408         glyph_names[names_count] = mp_xstrdup (mp,buf);
 409       names_count++;
 410     }
 411     if (*r != 10 && *r != '%') {
 412       if (str_prefix (r, "] def"))
 413         goto DONE;
 414       else {
 415         remove_eol (r, mp->ps->enc_line);
 416         print_err
 417           ("invalid encoding vector: a name or `] def' expected: `");
 418         mp_print(mp,mp->ps->enc_line);
 419         mp_print(mp,"'");
 420         mp_error(mp);
 421       }
 422     }
 423     mp_enc_getline (mp);
 424     r = mp->ps->enc_line;
 425   }
 426 DONE:
 427   enc_close ();
 428   mp_print (mp,"}");
 429   mp->selector = save_selector;
 430 }
 431 static void mp_read_enc (MP mp, enc_entry * e) {
 432     if (e->loaded)
 433         return;
 434     e->enc_name = NULL;
 435     mp_load_enc (mp,e->file_name, &e->enc_name, e->glyph_names);
 436     e->loaded = true;
 437 }
 438
 439 @ |write_enc| is used to write either external encoding (given in map file) or
 440  internal encoding (read from the font file); when |glyph_names| is NULL
 441  the 2nd argument is a pointer to the encoding entry; otherwise the 3rd is
 442  the object number of the Encoding object
 443
 444 @c
 445 static void mp_write_enc (MP mp, char **glyph_names, enc_entry * e) {
 446     int i;
 447     int s;
 448     int foffset;
 449     char **g;
 450     if (glyph_names == NULL) {
 451         if (e->objnum != 0)     /* the encoding has been written already */
 452             return;
 453         e->objnum = 1;
 454         g = e->glyph_names;
 455     } else {
 456         g = glyph_names;
 457     }
 458
 459     mp_ps_print(mp,"\n%%%%BeginResource: encoding ");
 460     mp_ps_print(mp, e->enc_name);
 461     mp_ps_print_nl(mp, "/");
 462     mp_ps_print(mp, e->enc_name);
 463     mp_ps_print(mp, " [ ");
 464     foffset = strlen(e->file_name)+3;
 465     for (i = 0; i < 256; i++) {
 466       s = strlen(g[i]);
 467       if (s+1+foffset>=80) {
 468             mp_ps_print_ln (mp);
 469         foffset = 0;
 470       }
 471       foffset += s+2;
 472       mp_ps_print_char(mp,'/');
 473       mp_ps_print(mp, g[i]);
 474       mp_ps_print_char(mp,' ');
 475     }
 476     if (foffset>75)
 477            mp_ps_print_ln (mp);
 478     mp_ps_print_nl (mp,"] def\n");
 479     mp_ps_print(mp,"%%%%EndResource");
 480 }
 481
 482
 483 @ All encoding entries go into AVL tree for fast search by name.
 484
 485 @<Glob...@>=
 486 struct avl_table *enc_tree;
 487
 488 @ Memory management functions for avl
 489
 490 @<Static variables in the outer block@>=
 491 static const char notdef[] = ".notdef";
 492
 493 @ @<Declarations@>=
 494 static void *avl_xmalloc (struct libavl_allocator *allocator, size_t size);
 495 static void avl_xfree (struct libavl_allocator *allocator, void *block);
 496
 497 @ @c
 498 static void *avl_xmalloc (struct libavl_allocator *allocator, size_t size) {
 499     assert(allocator);
 500     return malloc (size);
 501 }
 502 static void avl_xfree (struct libavl_allocator *allocator, void *block) {
 503     assert(allocator);
 504     free (block);
 505 }
 506
 507 @ @<Glob...@>=
 508 struct libavl_allocator avl_xallocator;
 509
 510 @ @<Set initial...@>=
 511 mp->ps->avl_xallocator.libavl_malloc=avl_xmalloc;
 512 mp->ps->avl_xallocator.libavl_free= avl_xfree;
 513 mp->ps->enc_tree = NULL;
 514
 515 @ @c
 516 static int comp_enc_entry (const void *pa, const void *pb, void *p) {
 517     assert(p==NULL);
 518     return strcmp (((const enc_entry *) pa)->file_name,
 519                    ((const enc_entry *) pb)->file_name);
 520 }
 521 static enc_entry * mp_add_enc (MP mp, char *s) {
 522     int i;
 523     enc_entry tmp, *p;
 524     void **aa;
 525     if (mp->ps->enc_tree == NULL) {
 526       mp->ps->enc_tree = avl_create (comp_enc_entry, NULL, &mp->ps->avl_xallocator);
 527     }
 528     tmp.file_name = s;
 529     p = (enc_entry *) avl_find (mp->ps->enc_tree, &tmp);
 530     if (p != NULL)              /* encoding already registered */
 531         return p;
 532     p = mp_xmalloc (mp,1,sizeof (enc_entry));
 533     p->loaded = false;
 534     p->file_name = mp_xstrdup (mp,s);
 535     p->objnum = 0;
 536     p->tounicode = 0;
 537     p->glyph_names = mp_xmalloc (mp,256,sizeof (char *));
 538     for (i = 0; i < 256; i++)
 539         p->glyph_names[i] = (char *) notdef;
 540     aa = avl_probe (mp->ps->enc_tree, p);
 541     return p;
 542 }
 543
 544 @ cleaning up...
 545
 546 @c
 547 static void mp_destroy_enc_entry (void *pa, void *pb) {
 548     enc_entry *p;
 549     int i;
 550
 551     p = (enc_entry *) pa;
 552     assert(pb==NULL);
 553     mp_xfree (p->file_name);
 554     if (p->glyph_names != NULL)
 555         for (i = 0; i < 256; i++)
 556             if (p->glyph_names[i] != notdef)
 557                 mp_xfree (p->glyph_names[i]);
 558     mp_xfree (p->glyph_names);
 559     mp_xfree (p);
 560 }
 561
 562 @ @<Declarations@>=
 563 static void enc_free (MP mp);
 564
 565 @ @c static void enc_free (MP mp) {
 566     if (mp->ps->enc_tree != NULL)
 567       avl_destroy (mp->ps->enc_tree, mp_destroy_enc_entry);
 568 }
 569
 570 @ @<Exported function headers@>=
 571 void mp_reload_encodings (MP mp) ;
 572
 573 @ @<Declarations@>=
 574 static void mp_font_encodings (MP mp, int lastfnum, int encodings_only) ;
 575
 576 @ @c void mp_reload_encodings (MP mp) {
 577   int f;
 578   enc_entry *e;
 579   fm_entry *fm_cur;
 580   int lastfnum = mp->last_fnum;
 581   for (f=null_font+1;f<=lastfnum;f++) {
 582     if (mp->font_enc_name[f]!=NULL ) {
 583        mp_xfree(mp->font_enc_name[f]);
 584        mp->font_enc_name[f]=NULL;
 585     }
 586     if (mp_has_fm_entry (mp,f,&fm_cur)) {
 587       if (fm_cur != NULL && fm_cur->ps_name != NULL &&is_reencoded (fm_cur)) {
 588         e = fm_cur->encoding;
 589         mp_read_enc (mp,e);
 590       }
 591     }
 592   }
 593 }
 594 static void mp_font_encodings (MP mp, int lastfnum, int encodings_only) {
 595   int f;
 596   enc_entry *e;
 597   fm_entry *fm;
 598   for (f=null_font+1;f<=lastfnum;f++) {
 599     if (mp_has_font_size(mp,f) && mp_has_fm_entry (mp,f, &fm)) {
 600       if (fm != NULL && (fm->ps_name != NULL)) {
 601         if (is_reencoded (fm)) {
 602           if (encodings_only || (!is_subsetted (fm))) {
 603             e = fm->encoding;
 604             mp_write_enc (mp,NULL, e);
 605             /* clear for next run */
 606             e->objnum = 0;
 607           }
 608         }
 609       }
 610     }
 611   }
 612 }
 613
 614 @* \[44b] Parsing font map files.
 615
 616 @d FM_BUF_SIZE     1024
 617
 618 @<Glob...@>=
 619 void * fm_file;
 620
 621 @
 622 @d fm_close()      (mp->close_file)(mp->ps->fm_file)
 623 @d fm_eof()        (mp->eof_file)(mp->ps->fm_file)
 624
 625 @c
 626 int fm_getchar(MP mp) {
 627   size_t len = 1;
 628   unsigned char byte=0;
 629   void *byte_ptr = &byte;
 630   (mp->read_binary_file)(mp->ps->fm_file,&byte_ptr,&len);
 631   if (len==0)
 632     return EOF;
 633   return byte;
 634 }
 635
 636
 637 @ @<Types...@>=
 638 enum _mode { FM_DUPIGNORE, FM_REPLACE, FM_DELETE };
 639 enum _ltype { MAPFILE, MAPLINE };
 640 enum _tfmavail { TFM_UNCHECKED, TFM_FOUND, TFM_NOTFOUND };
 641 typedef struct mitem {
 642     int mode;                   /* |FM_DUPIGNORE| or |FM_REPLACE| or |FM_DELETE| */
 643     int type;                   /* map file or map line */
 644     char *map_line;              /* pointer to map file name or map line */
 645     int lineno;                 /* line number in map file */
 646 } mapitem;
 647
 648 @ @<Glob...@>=
 649 mapitem *mitem;
 650 fm_entry *fm_cur;
 651 fm_entry *loaded_tfm_found;
 652 fm_entry *avail_tfm_found;
 653 fm_entry *non_tfm_found;
 654 fm_entry *not_avail_tfm_found;
 655
 656 @ @<Set initial...@>=
 657 mp->ps->mitem = NULL;
 658
 659 @ @<Declarations@>=
 660 static const char nontfm[] = "<nontfm>";
 661
 662 @
 663 @d read_field(r, q, buf) do {
 664     q = buf;
 665     while (*r != ' ' && *r != '\0')
 666         *q++ = *r++;
 667     *q = '\0';
 668     skip (r, ' ');
 669 } while (0)
 670
 671 @d set_field(F) do {
 672     if (q > buf)
 673         fm->F = mp_xstrdup(mp,buf);
 674     if (*r == '\0')
 675         goto DONE;
 676 } while (0)
 677
 678 @d cmp_return(a, b)
 679     if (a > b)
 680         return 1;
 681     if (a < b)
 682         return -1
 683
 684 @c
 685 static fm_entry *new_fm_entry (MP mp) {
 686     fm_entry *fm;
 687     fm = mp_xmalloc (mp,1,sizeof(fm_entry));
 688     fm->tfm_name = NULL;
 689     fm->ps_name = NULL;
 690     fm->flags = 4;
 691     fm->ff_name = NULL;
 692     fm->subset_tag = NULL;
 693     fm->encoding = NULL;
 694     fm->tfm_num = null_font;
 695     fm->tfm_avail = TFM_UNCHECKED;
 696     fm->type = 0;
 697     fm->slant = 0;
 698     fm->extend = 0;
 699     fm->ff_objnum = 0;
 700     fm->fn_objnum = 0;
 701     fm->fd_objnum = 0;
 702     fm->charset = NULL;
 703     fm->all_glyphs = false;
 704     fm->links = 0;
 705     fm->pid = -1;
 706     fm->eid = -1;
 707     return fm;
 708 }
 709
 710 static void delete_fm_entry (fm_entry * fm) {
 711     mp_xfree (fm->tfm_name);
 712     mp_xfree (fm->ps_name);
 713     mp_xfree (fm->ff_name);
 714     mp_xfree (fm->subset_tag);
 715     mp_xfree (fm->charset);
 716     mp_xfree (fm);
 717 }
 718
 719 static ff_entry *new_ff_entry (MP mp) {
 720     ff_entry *ff;
 721     ff = mp_xmalloc (mp,1,sizeof(ff_entry));
 722     ff->ff_name = NULL;
 723     ff->ff_path = NULL;
 724     return ff;
 725 }
 726
 727 static void delete_ff_entry (ff_entry * ff) {
 728     mp_xfree (ff->ff_name);
 729     mp_xfree (ff->ff_path);
 730     mp_xfree (ff);
 731 }
 732
 733 static char *mk_base_tfm (MP mp, char *tfmname, int *i) {
 734     static char buf[SMALL_BUF_SIZE];
 735     char *p = tfmname, *r = strend (p) - 1, *q = r;
 736     while (q > p && isdigit (*q))
 737         --q;
 738     if (!(q > p) || q == r || (*q != '+' && *q != '-'))
 739         return NULL;
 740     check_buf (q - p + 1, SMALL_BUF_SIZE);
 741     strncpy (buf, p, (size_t) (q - p));
 742     buf[q - p] = '\0';
 743     *i = atoi (q);
 744     return buf;
 745 }
 746
 747 @ @<Exported function headers@>=
 748 boolean mp_has_fm_entry (MP mp,font_number f, fm_entry **fm);
 749
 750 @ @c
 751 boolean mp_has_fm_entry (MP mp,font_number f, fm_entry **fm) {
 752     fm_entry *res = NULL;
 753     res = mp_fm_lookup (mp, f);
 754     if (fm != NULL) {
 755        *fm =res;
 756     }
 757     return (res != NULL);
 758 }
 759
 760 @ @<Glob...@>=
 761 struct avl_table *tfm_tree;
 762 struct avl_table *ps_tree;
 763 struct avl_table *ff_tree;
 764
 765 @ @<Set initial...@>=
 766 mp->ps->tfm_tree = NULL;
 767 mp->ps->ps_tree = NULL;
 768 mp->ps->ff_tree = NULL;
 769
 770 @ AVL sort |fm_entry| into |tfm_tree| by |tfm_name |
 771
 772 @c
 773 static int comp_fm_entry_tfm (const void *pa, const void *pb, void *p) {
 774     assert(p==NULL);
 775     return strcmp (((const fm_entry *) pa)->tfm_name,
 776                    ((const fm_entry *) pb)->tfm_name);
 777 }
 778
 779 @ AVL sort |fm_entry| into |ps_tree| by |ps_name|, |slant|, and |extend|
 780
 781 @c static int comp_fm_entry_ps (const void *pa, const void *pb, void *p) {
 782     assert(p==NULL);
 783     const fm_entry *p1 = (const fm_entry *) pa, *p2 = (const fm_entry *) pb;
 784     int i;
 785     assert (p1->ps_name != NULL && p2->ps_name != NULL);
 786     if ((i = strcmp (p1->ps_name, p2->ps_name)))
 787         return i;
 788     cmp_return (p1->slant, p2->slant);
 789     cmp_return (p1->extend, p2->extend);
 790     if (p1->tfm_name != NULL && p2->tfm_name != NULL &&
 791         (i = strcmp (p1->tfm_name, p2->tfm_name)))
 792         return i;
 793     return 0;
 794 }
 795
 796 @ AVL sort |ff_entry| into |ff_tree| by |ff_name|
 797
 798 @c static int comp_ff_entry (const void *pa, const void *pb, void *p) {
 799     assert(p==NULL);
 800     return strcmp (((const ff_entry *) pa)->ff_name,
 801                    ((const ff_entry *) pb)->ff_name);
 802 }
 803
 804 @ @c static void create_avl_trees (MP mp) {
 805     if (mp->ps->tfm_tree == NULL) {
 806         mp->ps->tfm_tree = avl_create (comp_fm_entry_tfm, NULL, &mp->ps->avl_xallocator);
 807         assert (mp->ps->tfm_tree != NULL);
 808     }
 809     if (mp->ps->ps_tree == NULL) {
 810         mp->ps->ps_tree = avl_create (comp_fm_entry_ps, NULL, &mp->ps->avl_xallocator);
 811         assert (mp->ps->ps_tree != NULL);
 812     }
 813     if (mp->ps->ff_tree == NULL) {
 814         mp->ps->ff_tree = avl_create (comp_ff_entry, NULL, &mp->ps->avl_xallocator);
 815         assert (mp->ps->ff_tree != NULL);
 816     }
 817 }
 818
 819 @ The function |avl_do_entry| is not completely symmetrical with regards
 820 to |tfm_name| and |ps_name handling|, e. g. a duplicate |tfm_name| gives a
 821 |goto exit|, and no |ps_name| link is tried. This is to keep it compatible
 822 with the original version.
 823
 824 @d LINK_TFM            0x01
 825 @d LINK_PS             0x02
 826 @d set_tfmlink(fm)     ((fm)->links |= LINK_TFM)
 827 @d set_pslink(fm)      ((fm)->links |= LINK_PS)
 828 @d unset_tfmlink(fm)   ((fm)->links &= ~LINK_TFM)
 829 @d unset_pslink(fm)    ((fm)->links &= ~LINK_PS)
 830 @d has_tfmlink(fm)     ((fm)->links & LINK_TFM)
 831 @d has_pslink(fm)      ((fm)->links & LINK_PS)
 832
 833 @c
 834 static int avl_do_entry (MP mp, fm_entry * fp, int mode) {
 835     fm_entry *p;
 836     void *a;
 837     void **aa;
 838     char s[128];
 839
 840     /* handle |tfm_name| link */
 841
 842     if (strcmp (fp->tfm_name, nontfm)) {
 843         p = (fm_entry *) avl_find (mp->ps->tfm_tree, fp);
 844         if (p != NULL) {
 845             if (mode == FM_DUPIGNORE) {
 846                snprintf(s,128,"fontmap entry for `%s' already exists, duplicates ignored",
 847                      fp->tfm_name);
 848                 mp_warn(mp,s);
 849                 goto exit;
 850             } else {            /* mode == |FM_REPLACE| / |FM_DELETE| */
 851                 if (mp_has_font_size(mp,p->tfm_num)) {
 852                     snprintf(s,128,
 853                         "fontmap entry for `%s' has been used, replace/delete not allowed",
 854                          fp->tfm_name);
 855                     mp_warn(mp,s);
 856                     goto exit;
 857                 }
 858                 a = avl_delete (mp->ps->tfm_tree, p);
 859                 assert (a != NULL);
 860                 unset_tfmlink (p);
 861                 if (!has_pslink (p))
 862                     delete_fm_entry (p);
 863             }
 864         }
 865         if (mode != FM_DELETE) {
 866             aa = avl_probe (mp->ps->tfm_tree, fp);
 867             assert (aa != NULL);
 868             set_tfmlink (fp);
 869         }
 870     }
 871
 872     /* handle |ps_name| link */
 873
 874     if (fp->ps_name != NULL) {
 875         assert (fp->tfm_name != NULL);
 876         p = (fm_entry *) avl_find (mp->ps->ps_tree, fp);
 877         if (p != NULL) {
 878             if (mode == FM_DUPIGNORE) {
 879                 snprintf(s,128,
 880                     "ps_name entry for `%s' already exists, duplicates ignored",
 881                      fp->ps_name);
 882                 mp_warn(mp,s);
 883                 goto exit;
 884             } else {            /* mode == |FM_REPLACE| / |FM_DELETE| */
 885                 if (mp_has_font_size(mp,p->tfm_num)) {
 886                     /* REPLACE/DELETE not allowed */
 887                     snprintf(s,128,
 888                         "fontmap entry for `%s' has been used, replace/delete not allowed",
 889                          p->tfm_name);
 890                     mp_warn(mp,s);
 891                     goto exit;
 892                 }
 893                 a = avl_delete (mp->ps->ps_tree, p);
 894                 assert (a != NULL);
 895                 unset_pslink (p);
 896                 if (!has_tfmlink (p))
 897                     delete_fm_entry (p);
 898             }
 899         }
 900         if (mode != FM_DELETE) {
 901             aa = avl_probe (mp->ps->ps_tree, fp);
 902             assert (aa != NULL);
 903             set_pslink (fp);
 904         }
 905     }
 906   exit:
 907     if (!has_tfmlink (fp) && !has_pslink (fp))  /* e. g. after |FM_DELETE| */
 908         return 1;               /* deallocation of |fm_entry| structure required */
 909     else
 910         return 0;
 911 }
 912
 913 @ consistency check for map entry, with warn flag
 914
 915 @c
 916 static int check_fm_entry (MP mp, fm_entry * fm, boolean warn) {
 917     int a = 0;
 918     char s[128];
 919     assert (fm != NULL);
 920     if (fm->ps_name != NULL) {
 921         if (is_basefont (fm)) {
 922             if (is_fontfile (fm) && !is_included (fm)) {
 923                 if (warn) {
 924                     snprintf(s,128, "invalid entry for `%s': "
 925                          "font file must be included or omitted for base fonts",
 926                          fm->tfm_name);
 927                     mp_warn(mp,s);
 928                 }
 929                 a += 1;
 930             }
 931         } else {                /* not a base font */
 932             /* if no font file given, drop this entry */
 933             /* |if (!is_fontfile (fm)) {
 934                  if (warn) {
 935                    snprintf(s,128,
 936                         "invalid entry for `%s': font file missing",
 937                                                 fm->tfm_name);
 938                     mp_warn(mp,s);
 939                  }
 940                 a += 2;
 941             }|
 942             */
 943         }
 944     }
 945     if (is_truetype (fm) && is_reencoded (fm) && !is_subsetted (fm)) {
 946         if (warn) {
 947             snprintf(s,128,
 948                 "invalid entry for `%s': only subsetted TrueType font can be reencoded",
 949                  fm->tfm_name);
 950                     mp_warn(mp,s);
 951         }
 952         a += 4;
 953     }
 954     if ((fm->slant != 0 || fm->extend != 0) &&
 955         (is_truetype (fm))) {
 956         if (warn) {
 957            snprintf(s,128,
 958                  "invalid entry for `%s': "
 959                  "SlantFont/ExtendFont can be used only with embedded T1 fonts",
 960                  fm->tfm_name);
 961                     mp_warn(mp,s);
 962         }
 963         a += 8;
 964     }
 965     if (abs (fm->slant) > 1000) {
 966         if (warn) {
 967             snprintf(s,128,
 968                 "invalid entry for `%s': too big value of SlantFont (%g)",
 969                  fm->tfm_name, fm->slant / 1000.0);
 970                     mp_warn(mp,s);
 971         }
 972         a += 16;
 973     }
 974     if (abs (fm->extend) > 2000) {
 975         if (warn) {
 976             snprintf(s,128,
 977                 "invalid entry for `%s': too big value of ExtendFont (%g)",
 978                  fm->tfm_name, fm->extend / 1000.0);
 979                     mp_warn(mp,s);
 980         }
 981         a += 32;
 982     }
 983     if (fm->pid != -1 &&
 984         !(is_truetype (fm) && is_included (fm) &&
 985           is_subsetted (fm) && !is_reencoded (fm))) {
 986         if (warn) {
 987             snprintf(s,128,
 988                 "invalid entry for `%s': "
 989                  "PidEid can be used only with subsetted non-reencoded TrueType fonts",
 990                  fm->tfm_name);
 991                     mp_warn(mp,s);
 992         }
 993         a += 64;
 994     }
 995     return a;
 996 }
 997
 998 @ returns true if s is one of the 14 std. font names; speed-trimmed.
 999
1000 @c static boolean check_basefont (char *s) {
1001     static const char *basefont_names[] = {
1002         "Courier",              /* 0:7 */
1003         "Courier-Bold",         /* 1:12 */
1004         "Courier-Oblique",      /* 2:15 */
1005         "Courier-BoldOblique",  /* 3:19 */
1006         "Helvetica",            /* 4:9 */
1007         "Helvetica-Bold",       /* 5:14 */
1008         "Helvetica-Oblique",    /* 6:17 */
1009         "Helvetica-BoldOblique",        /* 7:21 */
1010         "Symbol",               /* 8:6 */
1011         "Times-Roman",          /* 9:11 */
1012         "Times-Bold",           /* 10:10 */
1013         "Times-Italic",         /* 11:12 */
1014         "Times-BoldItalic",     /* 12:16 */
1015         "ZapfDingbats"          /* 13:12 */
1016     };
1017     static const int Index[] =
1018         { -1, -1, -1, -1, -1, -1, 8, 0, -1, 4, 10, 9, -1, -1, 5, 2, 12, 6,
1019         -1, 3, -1, 7
1020     };
1021     const size_t n = strlen (s);
1022     int k = -1;
1023     if (n > 21)
1024         return false;
1025     if (n == 12) {              /* three names have length 12 */
1026         switch (*s) {
1027         case 'C':
1028             k = 1;              /* Courier-Bold */
1029             break;
1030         case 'T':
1031             k = 11;             /* Times-Italic */
1032             break;
1033         case 'Z':
1034             k = 13;             /* ZapfDingbats */
1035             break;
1036         default:
1037             return false;
1038         }
1039     } else
1040         k = Index[n];
1041     if (k > -1 && !strcmp (basefont_names[k], s))
1042         return true;
1043     return false;
1044 };
1045
1046 @
1047 @d is_cfg_comment(c) (c == 10 || c == '*' || c == '#' || c == ';' || c == '%')
1048
1049 @c static void fm_scan_line (MP mp) {
1050     int a, b, c, j, u = 0, v = 0;
1051     float d;
1052     fm_entry *fm;
1053     char fm_line[FM_BUF_SIZE], buf[FM_BUF_SIZE];
1054     char *p, *q, *r, *s;
1055     char warn_s[128];
1056     switch (mp->ps->mitem->type) {
1057     case MAPFILE:
1058         p = fm_line;
1059         do {
1060             c = fm_getchar (mp);
1061             append_char_to_buf (c, p, fm_line, FM_BUF_SIZE);
1062         } while (c != 10);
1063         *(--p) = '\0';
1064         r = fm_line;
1065         break;
1066     case MAPLINE:
1067         r = mp->ps->mitem->map_line;
1068         break;
1069     default:
1070         assert (0);
1071     }
1072     if (*r == '\0' || is_cfg_comment (*r))
1073         return;
1074     fm = new_fm_entry (mp);
1075     read_field (r, q, buf);
1076     set_field (tfm_name);
1077     p = r;
1078     read_field (r, q, buf);
1079     if (*buf != '<' && *buf != '"')
1080         set_field (ps_name);
1081     else
1082         r = p;                  /* unget the field */
1083     if (isdigit (*r)) {         /* font flags given */
1084         fm->flags = atoi (r);
1085         while (isdigit (*r))
1086             r++;
1087     }
1088     while (1) {                 /* loop through "specials", encoding, font file */
1089         skip (r, ' ');
1090         switch (*r) {
1091         case '\0':
1092             goto DONE;
1093         case '"':              /* opening quote */
1094             r++;
1095             u = v = 0;
1096             do {
1097                 skip (r, ' ');
1098                 if (sscanf (r, "%f %n", &d, &j) > 0) {
1099                     s = r + j;  /* jump behind number, eat also blanks, if any */
1100                     if (*(s - 1) == 'E' || *(s - 1) == 'e')
1101                         s--;    /* e. g. 0.5ExtendFont: \%f = 0.5E */
1102                     if (str_prefix (s, "SlantFont")) {
1103                         d *= 1000.0;    /* correct rounding also for neg. numbers */
1104                         fm->slant = (integer) (d > 0 ? d + 0.5 : d - 0.5);
1105                         r = s + strlen ("SlantFont");
1106                     } else if (str_prefix (s, "ExtendFont")) {
1107                         d *= 1000.0;
1108                         fm->extend = (integer) (d > 0 ? d + 0.5 : d - 0.5);
1109                         if (fm->extend == 1000)
1110                             fm->extend = 0;
1111                         r = s + strlen ("ExtendFont");
1112                     } else {    /* unknown name */
1113                         for (r = s;
1114                              *r != ' ' && *r != '"' && *r != '\0';
1115                              r++); /* jump over name */
1116                         c = *r; /* remember char for temporary end of string */
1117                         *r = '\0';
1118                         snprintf(warn_s,128,
1119                             "invalid entry for `%s': unknown name `%s' ignored",
1120                              fm->tfm_name, s);
1121                         mp_warn(mp,warn_s);
1122                         *r = c;
1123                     }
1124                 } else
1125                     for (; *r != ' ' && *r != '"' && *r != '\0'; r++);
1126             }
1127             while (*r == ' ');
1128             if (*r == '"')      /* closing quote */
1129                 r++;
1130             else {
1131                 snprintf(warn_s,128,
1132                     "invalid entry for `%s': closing quote missing",
1133                      fm->tfm_name);
1134                 mp_warn(mp,warn_s);
1135                 goto bad_line;
1136             }
1137             break;
1138         case 'P':              /* handle cases for subfonts like 'PidEid=3,1' */
1139             if (sscanf (r, "PidEid=%i, %i %n", &a, &b, &c) >= 2) {
1140                 fm->pid = a;
1141                 fm->eid = b;
1142                 r += c;
1143                 break;
1144             }
1145         default:               /* encoding or font file specification */
1146             a = b = 0;
1147             if (*r == '<') {
1148                 a = *r++;
1149                 if (*r == '<' || *r == '[')
1150                     b = *r++;
1151             }
1152             read_field (r, q, buf);
1153             /* encoding, formats: '8r.enc' or '<8r.enc' or '<[8r.enc' */
1154             if (strlen (buf) > 4 && strcasecmp (strend (buf) - 4, ".enc") == 0) {
1155                 fm->encoding = mp_add_enc (mp, buf);
1156                 u = v = 0;      /* u, v used if intervening blank: "<< foo" */
1157             } else if (strlen (buf) > 0) {      /* file name given */
1158                 /* font file, formats:
1159                  * subsetting:    '<cmr10.pfa'
1160                  * no subsetting: '<<cmr10.pfa'
1161                  * no embedding:  'cmr10.pfa'
1162                  */
1163                 if (a == '<' || u == '<') {
1164                   set_included (fm);
1165                   if ((a == '<' && b == 0) || (a == 0 && v == 0))
1166                     set_subsetted (fm);
1167                   /* otherwise b == '<' (or '[') => no subsetting */
1168                 }
1169                 set_field (ff_name);
1170                 u = v = 0;
1171             } else {
1172                 u = a;
1173                 v = b;
1174             }
1175         }
1176     }
1177   DONE:
1178     if (fm->ps_name != NULL && check_basefont (fm->ps_name))
1179         set_basefont (fm);
1180     if (is_fontfile (fm)
1181         && strcasecmp (strend (fm_fontfile (fm)) - 4, ".ttf") == 0)
1182         set_truetype (fm);
1183     if (check_fm_entry (mp,fm, true) != 0)
1184         goto bad_line;
1185     /*
1186        Until here the map line has been completely scanned without errors;
1187        fm points to a valid, freshly filled-out |fm_entry| structure.
1188        Now follows the actual work of registering/deleting.
1189      */
1190     if (avl_do_entry (mp, fm, mp->ps->mitem->mode) == 0)    /* if success */
1191         return;
1192   bad_line:
1193     delete_fm_entry (fm);
1194 }
1195
1196 @
1197 @c static void fm_read_info (MP mp) {
1198     char *n;
1199     char s[256];
1200     if (mp->ps->tfm_tree == NULL)
1201         create_avl_trees (mp);
1202     if (mp->ps->mitem->map_line == NULL)    /* nothing to do */
1203         return;
1204     mp->ps->mitem->lineno = 1;
1205     switch (mp->ps->mitem->type) {
1206     case MAPFILE:
1207         n = mp->ps->mitem->map_line;
1208         mp->ps->fm_file = (mp->open_file)( n, "r", mp_filetype_fontmap);
1209         if (!mp->ps->fm_file) {
1210             snprintf(s,256,"cannot open font map file %s",n);
1211             mp_warn(mp,s);
1212         } else {
1213             int save_selector = mp->selector;
1214             mp_normalize_selector(mp);
1215             mp_print (mp, "{");
1216             mp_print (mp, n);
1217             while (!fm_eof ()) {
1218                 fm_scan_line (mp);
1219                 mp->ps->mitem->lineno++;
1220             }
1221             fm_close ();
1222             mp_print (mp,"}");
1223             mp->selector = save_selector;
1224             mp->ps->fm_file = NULL;
1225         }
1226         mp_xfree(n);
1227         break;
1228     case MAPLINE:
1229         fm_scan_line (mp);
1230         break;
1231     default:
1232         assert (0);
1233     }
1234     mp->ps->mitem->map_line = NULL;         /* done with this line */
1235     return;
1236 }
1237
1238 @ @c
1239 static scaled mp_round_xn_over_d (MP mp, scaled x, integer  n, integer d) {
1240   boolean positive; /* was |x>=0|? */
1241   unsigned int t,u; /* intermediate quantities */
1242   integer v; /* intermediate quantities */
1243   if ( x>=0 ) {
1244     positive=true;
1245   } else {
1246     negate(x); positive=false;
1247   };
1248   t=(x % 0100000)*n;
1249   u=(x / 0100000)*n+(t / 0100000);
1250   v=(u % d)*0100000 + (t % 0100000);
1251   if ( u / d>=0100000 ) mp->arith_error=true;
1252   else u=0100000*(u / d) + (v / d);
1253   v = v % d;
1254   if ( 2*v >= d )
1255     u++;
1256   return ( positive ? u : -u );
1257 }
1258 static fm_entry *mk_ex_fm (MP mp, font_number f, fm_entry * basefm, int ex) {
1259     fm_entry *fm;
1260     integer e = basefm->extend;
1261     if (e == 0)
1262         e = 1000;
1263     fm = new_fm_entry (mp);
1264     fm->flags = basefm->flags;
1265     fm->encoding = basefm->encoding;
1266     fm->type = basefm->type;
1267     fm->slant = basefm->slant;
1268     fm->extend = mp_round_xn_over_d (mp, e, 1000 + ex, 1000);
1269         /* modify ExtentFont to simulate expansion */
1270     if (fm->extend == 1000)
1271         fm->extend = 0;
1272     fm->tfm_name = mp_xstrdup (mp,mp->font_name[f]);
1273     if (basefm->ps_name != NULL)
1274         fm->ps_name = mp_xstrdup (mp,basefm->ps_name);
1275     fm->ff_name = mp_xstrdup (mp,basefm->ff_name);
1276     fm->ff_objnum = 0;
1277     fm->tfm_num = f;
1278     fm->tfm_avail = TFM_FOUND;
1279     assert (strcmp (fm->tfm_name, nontfm));
1280     return fm;
1281 }
1282
1283 @ @c static void init_fm (fm_entry * fm, font_number f) {
1284     if (fm->tfm_num == null_font ) {
1285         fm->tfm_num = f;
1286         fm->tfm_avail = TFM_FOUND;
1287     }
1288 }
1289
1290 @ @<Declarations@>=
1291 static fm_entry * mp_fm_lookup (MP mp, font_number f);
1292
1293 @ @c
1294 static fm_entry * mp_fm_lookup (MP mp, font_number f) {
1295     char *tfm;
1296     fm_entry *fm, *exfm;
1297     fm_entry tmp;
1298     int ai, e;
1299     if (mp->ps->tfm_tree == NULL)
1300         fm_read_info (mp);        /* only to read default map file */
1301     tfm = mp->font_name[f];
1302     assert (strcmp (tfm, nontfm));
1303     /* Look up for full <tfmname>[+-]<expand> */
1304     tmp.tfm_name = tfm;
1305     fm = (fm_entry *) avl_find (mp->ps->tfm_tree, &tmp);
1306     if (fm != NULL) {
1307         init_fm (fm, f);
1308         return (fm_entry *) fm;
1309     }
1310     tfm = mk_base_tfm (mp, mp->font_name[f], &e);
1311     if (tfm == NULL)            /* not an expanded font, nothing to do */
1312         return NULL;
1313
1314     tmp.tfm_name = tfm;
1315     fm = (fm_entry *) avl_find (mp->ps->tfm_tree, &tmp);
1316     if (fm != NULL) {           /* found an entry with the base tfm name, e.g. cmr10 */
1317         return (fm_entry *) fm; /* font expansion uses the base font */
1318         /* the following code would be obsolete, as would be |mk_ex_fm| */
1319         if (!is_t1fontfile (fm) || !is_included (fm)) {
1320             char s[128];
1321             snprintf(s,128,
1322                 "font %s cannot be expanded (not an included Type1 font)", tfm);
1323             mp_warn(mp,s);
1324             return NULL;
1325         }
1326         exfm = mk_ex_fm (mp, f, fm, e);     /* copies all fields from fm except tfm name */
1327         init_fm (exfm, f);
1328         ai = avl_do_entry (mp, exfm, FM_DUPIGNORE);
1329         assert (ai == 0);
1330         return (fm_entry *) exfm;
1331     }
1332     return NULL;
1333 }
1334
1335 @  Early check whether a font file exists. Used e. g. for replacing fonts
1336    of embedded PDF files: Without font file, the font within the embedded
1337    PDF-file is used. Search tree |ff_tree| is used in 1st instance, as it
1338    may be faster than the |kpse_find_file()|, and |kpse_find_file()| is called
1339    only once per font file name + expansion parameter. This might help
1340    keeping speed, if many PDF pages with same fonts are to be embedded.
1341
1342    The |ff_tree| contains only font files, which are actually needed,
1343    so this tree typically is much smaller than the |tfm_tree| or |ps_tree|.
1344
1345 @c
1346 static ff_entry *check_ff_exist (MP mp, fm_entry * fm) {
1347     ff_entry *ff;
1348     ff_entry tmp;
1349     void **aa;
1350
1351     assert (fm->ff_name != NULL);
1352     tmp.ff_name = fm->ff_name;
1353     ff = (ff_entry *) avl_find (mp->ps->ff_tree, &tmp);
1354     if (ff == NULL) {           /* not yet in database */
1355         ff = new_ff_entry (mp);
1356         ff->ff_name = mp_xstrdup (mp,fm->ff_name);
1357         ff->ff_path = mp_xstrdup (mp,fm->ff_name);
1358         aa = avl_probe (mp->ps->ff_tree, ff);
1359         assert (aa != NULL);
1360     }
1361     return ff;
1362 }
1363
1364 @ Process map file given by its name or map line contents. Items not
1365 beginning with [+-=] flush default map file, if it has not yet been
1366 read. Leading blanks and blanks immediately following [+-=] are ignored.
1367
1368
1369 @c static void mp_process_map_item (MP mp, char *s, int type) {
1370     char *p;
1371     int mode;
1372     if (*s == ' ')
1373         s++;                    /* ignore leading blank */
1374     switch (*s) {
1375     case '+':                  /* +mapfile.map, +mapline */
1376         mode = FM_DUPIGNORE;    /* insert entry, if it is not duplicate */
1377         s++;
1378         break;
1379     case '=':                  /* =mapfile.map, =mapline */
1380         mode = FM_REPLACE;      /* try to replace earlier entry */
1381         s++;
1382         break;
1383     case '-':                  /* -mapfile.map, -mapline */
1384         mode = FM_DELETE;       /* try to delete entry */
1385         s++;
1386         break;
1387     default:
1388         mode = FM_DUPIGNORE;    /* like +, but also: */
1389         mp_xfree(mp->ps->mitem->map_line);
1390         mp->ps->mitem->map_line = NULL;     /* flush default map file name */
1391     }
1392     if (*s == ' ')
1393         s++;                    /* ignore blank after [+-=] */
1394     p = s;                      /* map item starts here */
1395     switch (type) {
1396     case MAPFILE:              /* remove blank at end */
1397         while (*p != '\0' && *p != ' ')
1398             p++;
1399         *p = '\0';
1400         break;
1401     case MAPLINE:              /* blank at end allowed */
1402         break;
1403     default:
1404         assert (0);
1405     }
1406     if (mp->ps->mitem->map_line != NULL)    /* read default map file first */
1407         fm_read_info (mp);
1408     if (*s != '\0') {           /* only if real item to process */
1409         mp->ps->mitem->mode = mode;
1410         mp->ps->mitem->type = type;
1411         mp->ps->mitem->map_line = s;
1412         fm_read_info (mp);
1413     }
1414 }
1415
1416 @ @<Exported function headers@>=
1417 void mp_map_file (MP mp, str_number t);
1418 void mp_map_line (MP mp, str_number t);
1419 void mp_init_map_file (MP mp, int is_troff);
1420
1421 @ @c
1422 void mp_map_file (MP mp, str_number t) {
1423   char *s = mp_xstrdup(mp,mp_str (mp,t));
1424   mp_process_map_item (mp, s, MAPFILE);
1425   mp_xfree (s);
1426 }
1427 void mp_map_line (MP mp, str_number t) {
1428   char *s = mp_xstrdup(mp,mp_str (mp,t));
1429   mp_process_map_item (mp, s, MAPLINE);
1430   mp_xfree (s);
1431 }
1432
1433 @
1434 @c void mp_init_map_file (MP mp, int is_troff) {
1435     char *r;
1436     mp->ps->mitem = mp_xmalloc (mp,1,sizeof(mapitem));
1437     mp->ps->mitem->mode = FM_DUPIGNORE;
1438     mp->ps->mitem->type = MAPFILE;
1439     mp->ps->mitem->map_line = NULL;
1440     r = (mp->find_file)("mpost.map", "rb", mp_filetype_fontmap);
1441     if (r != NULL) {
1442       mp_xfree(r);
1443       mp->ps->mitem->map_line = mp_xstrdup (mp,"mpost.map");
1444     } else {
1445       if (is_troff) {
1446              mp->ps->mitem->map_line = mp_xstrdup (mp,"troff.map");
1447       } else {
1448              mp->ps->mitem->map_line = mp_xstrdup (mp,"pdftex.map");
1449       }
1450     }
1451 }
1452
1453 @ @<Dealloc variables@>=
1454 if (mp->ps->mitem!=NULL) {
1455   mp_xfree(mp->ps->mitem->map_line);
1456   mp_xfree(mp->ps->mitem);
1457 }
1458
1459 @ cleaning up...
1460
1461 @c
1462 static void destroy_fm_entry_tfm (void *pa, void *pb) {
1463     fm_entry *fm;
1464     assert(pb==NULL);
1465     fm = (fm_entry *) pa;
1466     if (!has_pslink (fm))
1467         delete_fm_entry (fm);
1468     else
1469         unset_tfmlink (fm);
1470 }
1471 static void destroy_fm_entry_ps (void *pa, void *pb) {
1472     fm_entry *fm;
1473     assert(pb==NULL);
1474     fm = (fm_entry *) pa;
1475     if (!has_tfmlink (fm))
1476         delete_fm_entry (fm);
1477     else
1478         unset_pslink (fm);
1479 }
1480 static void destroy_ff_entry (void *pa, void *pb) {
1481     ff_entry *ff;
1482     assert(pb==NULL);
1483     ff = (ff_entry *) pa;
1484     delete_ff_entry (ff);
1485 }
1486
1487 @ @<Declarations@>=
1488 static void fm_free (MP mp);
1489
1490 @ @c
1491 static void fm_free (MP mp) {
1492     if (mp->ps->tfm_tree != NULL)
1493         avl_destroy (mp->ps->tfm_tree, destroy_fm_entry_tfm);
1494     if (mp->ps->ps_tree != NULL)
1495         avl_destroy (mp->ps->ps_tree, destroy_fm_entry_ps);
1496     if (mp->ps->ff_tree != NULL)
1497         avl_destroy (mp->ps->ff_tree, destroy_ff_entry);
1498 }
1499
1500 @ The file |ps_tab_file| gives a table of \TeX\ font names and corresponding
1501 PostScript names for fonts that do not have to be downloaded, i.e., fonts that
1502 can be used when |internal[prologues]>0|.  Each line consists of a \TeX\ name,
1503 one or more spaces, a PostScript name, and possibly a space and some other junk.
1504 This routine reads the table, updates |font_ps_name| entries starting after
1505 |last_ps_fnum|, and sets |last_ps_fnum:=last_fnum|.
1506
1507 @d ps_tab_name "psfonts.map"  /* locates font name translation table */
1508
1509 @<Declarations@>=
1510 static void mp_read_psname_table (MP mp) ;
1511
1512 @ @c
1513 static void mp_read_psname_table (MP mp) {
1514   font_number k;
1515   if (mp->ps->mitem == NULL) {
1516     mp->ps->mitem = mp_xmalloc (mp,1,sizeof(mapitem));
1517     mp->ps->mitem->mode = FM_DUPIGNORE;
1518     mp->ps->mitem->type = MAPFILE;
1519     mp->ps->mitem->map_line = NULL;
1520   }
1521   mp->ps->mitem->map_line = mp_xstrdup (mp,ps_tab_name);
1522   fm_read_info (mp);
1523   for (k=mp->last_ps_fnum+1;k<=mp->last_fnum;k++) {
1524     if (mp_has_fm_entry(mp, k, NULL)) {
1525       mp->font_ps_name[k] = mp_fm_font_name(mp,k);
1526     }
1527   }
1528   mp->last_ps_fnum=mp->last_fnum;
1529 }
1530
1531
1532 @ The traditional function is a lot shorter now.
1533
1534
1535
1536 @* \[44c] Helper functions for Type1 fonts.
1537
1538 @<Types...@>=
1539 typedef char char_entry;
1540 typedef unsigned char  Byte;
1541 typedef Byte  Bytef;
1542
1543 @ @<Glob...@>=
1544 char_entry *char_ptr, *char_array;
1545 size_t char_limit;
1546 char *job_id_string;
1547
1548 @ @<Set initial...@>=
1549 mp->ps->char_array = NULL;
1550 mp->ps->job_id_string = NULL;
1551
1552 @
1553 @d SMALL_ARRAY_SIZE    256
1554 @d Z_NULL  0
1555
1556 @c
1557 void mp_set_job_id (MP mp) {
1558     char *name_string, *format_string, *s;
1559     size_t slen;
1560     int i;
1561     if (mp->ps->job_id_string != NULL)
1562        return;
1563     if ( mp->job_name==NULL )
1564        mp->job_name = mp_xstrdup(mp,"mpout");
1565     name_string = mp_xstrdup (mp,mp->job_name);
1566     format_string = mp_xstrdup (mp,mp->mem_ident);
1567     slen = SMALL_BUF_SIZE +
1568         strlen (name_string) +
1569         strlen (format_string);
1570     s = mp_xmalloc (mp,slen, sizeof (char));
1571     i = snprintf (s, slen,
1572                   "%.4d/%.2d/%.2d %.2d:%.2d %s %s",
1573                   (mp->internal[mp_year]>>16),
1574                   (mp->internal[mp_month]>>16),
1575                   (mp->internal[mp_day]>>16),
1576                   (mp->internal[mp_time]>>16) / 60,
1577                   (mp->internal[mp_time]>>16) % 60,
1578                   name_string, format_string);
1579     mp->ps->job_id_string = mp_xstrdup (mp,s);
1580     mp_xfree (s);
1581     mp_xfree (name_string);
1582     mp_xfree (format_string);
1583 }
1584 static void fnstr_append (MP mp, const char *s) {
1585     size_t l = strlen (s) + 1;
1586     alloc_array (char, l, SMALL_ARRAY_SIZE);
1587     strcat (mp->ps->char_ptr, s);
1588     mp->ps->char_ptr = strend (mp->ps->char_ptr);
1589 }
1590
1591 @ @<Exported function headers@>=
1592 void mp_set_job_id (MP mp) ;
1593
1594 @ @<Dealloc variables@>=
1595 mp_xfree(mp->ps->job_id_string);
1596
1597 @ this is not really a true crc32, but it should be just enough to keep
1598   subsets prefixes somewhat disjunct
1599
1600 @c
1601 static unsigned long crc32 (int oldcrc, const Byte *buf, int len) {
1602   unsigned long ret = 0;
1603   int i;
1604   if (oldcrc==0)
1605         ret = (23<<24)+(45<<16)+(67<<8)+89;
1606   else
1607       for (i=0;i<len;i++)
1608           ret = (ret<<2)+buf[i];
1609   return ret;
1610 }
1611 static boolean mp_char_marked (MP mp,font_number f, eight_bits c) {
1612   integer b; /* |char_base[f]| */
1613   b=mp->char_base[f];
1614   if ( (c>=mp->font_bc[f])&&(c<=mp->font_ec[f])&&(mp->font_info[b+c].qqqq.b3!=0) )
1615     return true;
1616   else
1617     return false;
1618 }
1619
1620 static void make_subset_tag (MP mp, fm_entry * fm_cur, char **glyph_names, int tex_font)
1621 {
1622     char tag[7];
1623     unsigned long crc;
1624     int i;
1625     size_t l ;
1626     if (mp->ps->job_id_string ==NULL)
1627       mp_fatal_error(mp, "no job id!");
1628     l = strlen (mp->ps->job_id_string) + 1;
1629
1630     alloc_array (char, l, SMALL_ARRAY_SIZE);
1631     strcpy (mp->ps->char_array, mp->ps->job_id_string);
1632     mp->ps->char_ptr = strend (mp->ps->char_array);
1633     if (fm_cur->tfm_name != NULL) {
1634         fnstr_append (mp," TFM name: ");
1635         fnstr_append (mp,fm_cur->tfm_name);
1636     }
1637     fnstr_append (mp," PS name: ");
1638     if (fm_cur->ps_name != NULL)
1639         fnstr_append (mp,fm_cur->ps_name);
1640     fnstr_append (mp," Encoding: ");
1641     if (fm_cur->encoding != NULL && (fm_cur->encoding)->file_name != NULL)
1642         fnstr_append (mp,(fm_cur->encoding)->file_name);
1643     else
1644         fnstr_append (mp,"built-in");
1645     fnstr_append (mp," CharSet: ");
1646     for (i = 0; i < 256; i++)
1647         if (mp_char_marked (mp,tex_font, i) && glyph_names[i] != notdef) {
1648                         if (glyph_names[i]!=NULL) {
1649                           fnstr_append (mp,"/");
1650                           fnstr_append (mp,glyph_names[i]);
1651                         }
1652         }
1653     if (fm_cur->charset != NULL) {
1654         fnstr_append (mp," Extra CharSet: ");
1655         fnstr_append (mp, fm_cur->charset);
1656     }
1657     crc = crc32 (0L, Z_NULL, 0);
1658     crc = crc32 (crc, (Bytef *) mp->ps->char_array, strlen (mp->ps->char_array));
1659     /* we need to fit a 32-bit number into a string of 6 uppercase chars long;
1660      * there are 26 uppercase chars ==> each char represents a number in range
1661      * |0..25|. The maximal number that can be represented by the tag is
1662      * $26^6 - 1$, which is a number between $2^28$ and $2^29$. Thus the bits |29..31|
1663      * of the CRC must be dropped out.
1664      */
1665     for (i = 0; i < 6; i++) {
1666         tag[i] = 'A' + crc % 26;
1667         crc /= 26;
1668     }
1669     tag[6] = 0;
1670     fm_cur->subset_tag = mp_xstrdup (mp,tag);
1671 }
1672
1673
1674
1675 @
1676 @d external_enc()      (fm_cur->encoding)->glyph_names
1677 @d is_used_char(c)     mp_char_marked (mp, tex_font, c)
1678 @d end_last_eexec_line()
1679     mp->ps->hexline_length = HEXLINE_WIDTH;
1680     end_hexline(mp);
1681     mp->ps->t1_eexec_encrypt = false
1682 @d t1_log(s)           mp_print(mp,(char *)s)
1683 @d t1_putchar(c)       wps_chr(c)
1684 @d embed_all_glyphs(tex_font)  false
1685 @d t1_char(c)          c
1686 @d extra_charset()     mp->ps->dvips_extra_charset
1687 @d update_subset_tag()
1688 @d fixedcontent        true
1689
1690 @<Glob...@>=
1691 #define PRINTF_BUF_SIZE     1024
1692 char *dvips_extra_charset;
1693 char *cur_enc_name;
1694 unsigned char *grid;
1695 char *ext_glyph_names[256];
1696 char print_buf[PRINTF_BUF_SIZE];
1697 int t1_byte_waiting;
1698
1699 @ @<Set initial ...@>=
1700 mp->ps->dvips_extra_charset=NULL;
1701 mp->ps->t1_byte_waiting=0;
1702
1703 @
1704 @d t1_ungetchar(A) mp->ps->t1_byte_waiting=A
1705 @d t1_eof()        (mp->eof_file)(mp->ps->t1_file)
1706 @d t1_close()      (mp->close_file)(mp->ps->t1_file)
1707 @d valid_code(c)   (c >= 0 && c < 256)
1708
1709 @c
1710 int t1_getchar (MP mp) {
1711   size_t len = 1;
1712   unsigned char byte=0;
1713   void *byte_ptr = &byte;
1714   if (mp->ps->t1_byte_waiting) {
1715     byte = mp->ps->t1_byte_waiting;
1716     mp->ps->t1_byte_waiting = 0;
1717   } else {
1718     (mp->read_binary_file)(mp->ps->t1_file,&byte_ptr,&len);
1719   }
1720   return byte;
1721 }
1722
1723 @ @<Static variables in the outer block@>=
1724 static const char *standard_glyph_names[256] =
1725     { notdef, notdef, notdef, notdef, notdef, notdef, notdef, notdef,
1726     notdef, notdef, notdef, notdef, notdef, notdef, notdef, notdef, notdef,
1727     notdef, notdef, notdef, notdef, notdef, notdef,
1728     notdef, notdef, notdef, notdef, notdef, notdef, notdef, notdef, notdef,
1729     "space", "exclam", "quotedbl", "numbersign",
1730     "dollar", "percent", "ampersand", "quoteright", "parenleft",
1731     "parenright", "asterisk", "plus", "comma", "hyphen", "period",
1732     "slash", "zero", "one", "two", "three", "four", "five", "six", "seven",
1733     "eight", "nine", "colon", "semicolon", "less",
1734     "equal", "greater", "question", "at", "A", "B", "C", "D", "E", "F",
1735     "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q",
1736     "R", "S", "T", "U", "V", "W", "X", "Y", "Z", "bracketleft",
1737     "backslash", "bracketright", "asciicircum", "underscore",
1738     "quoteleft", "a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k",
1739     "l", "m", "n", "o", "p", "q", "r", "s", "t", "u", "v",
1740     "w", "x", "y", "z", "braceleft", "bar", "braceright", "asciitilde",
1741     notdef, notdef, notdef, notdef, notdef, notdef, notdef,
1742     notdef, notdef, notdef, notdef, notdef, notdef, notdef, notdef, notdef,
1743     notdef, notdef, notdef, notdef, notdef, notdef,
1744     notdef, notdef, notdef, notdef, notdef, notdef, notdef, notdef, notdef,
1745     notdef, notdef, notdef, "exclamdown", "cent",
1746     "sterling", "fraction", "yen", "florin", "section", "currency",
1747     "quotesingle", "quotedblleft", "guillemotleft",
1748     "guilsinglleft", "guilsinglright", "fi", "fl", notdef, "endash",
1749     "dagger", "daggerdbl", "periodcentered", notdef,
1750     "paragraph", "bullet", "quotesinglbase", "quotedblbase",
1751     "quotedblright", "guillemotright", "ellipsis", "perthousand",
1752     notdef, "questiondown", notdef, "grave", "acute", "circumflex",
1753     "tilde", "macron", "breve", "dotaccent", "dieresis", notdef,
1754     "ring", "cedilla", notdef, "hungarumlaut", "ogonek", "caron", "emdash",
1755     notdef, notdef, notdef, notdef, notdef, notdef,
1756     notdef, notdef, notdef, notdef, notdef, notdef, notdef, notdef, notdef,
1757     notdef, "AE", notdef, "ordfeminine", notdef, notdef,
1758     notdef, notdef, "Lslash", "Oslash", "OE", "ordmasculine", notdef,
1759     notdef, notdef, notdef, notdef, "ae", notdef, notdef,
1760     notdef, "dotlessi", notdef, notdef, "lslash", "oslash", "oe",
1761     "germandbls", notdef, notdef, notdef, notdef };
1762 static const char charstringname[] = "/CharStrings";
1763
1764 @ @<Glob...@>=
1765 char **t1_glyph_names;
1766 char *t1_builtin_glyph_names[256];
1767 char charsetstr[0x4000];
1768 boolean read_encoding_only;
1769 int t1_encoding;
1770
1771 @ @c
1772 #define T1_BUF_SIZE   0x10
1773
1774 #define CS_HSTEM            1
1775 #define CS_VSTEM            3
1776 #define CS_VMOVETO          4
1777 #define CS_RLINETO          5
1778 #define CS_HLINETO          6
1779 #define CS_VLINETO          7
1780 #define CS_RRCURVETO        8
1781 #define CS_CLOSEPATH        9
1782 #define CS_CALLSUBR         10
1783 #define CS_RETURN           11
1784 #define CS_ESCAPE           12
1785 #define CS_HSBW             13
1786 #define CS_ENDCHAR          14
1787 #define CS_RMOVETO          21
1788 #define CS_HMOVETO          22
1789 #define CS_VHCURVETO        30
1790 #define CS_HVCURVETO        31
1791 #define CS_1BYTE_MAX        (CS_HVCURVETO + 1)
1792
1793 #define CS_DOTSECTION       CS_1BYTE_MAX + 0
1794 #define CS_VSTEM3           CS_1BYTE_MAX + 1
1795 #define CS_HSTEM3           CS_1BYTE_MAX + 2
1796 #define CS_SEAC             CS_1BYTE_MAX + 6
1797 #define CS_SBW              CS_1BYTE_MAX + 7
1798 #define CS_DIV              CS_1BYTE_MAX + 12
1799 #define CS_CALLOTHERSUBR    CS_1BYTE_MAX + 16
1800 #define CS_POP              CS_1BYTE_MAX + 17
1801 #define CS_SETCURRENTPOINT  CS_1BYTE_MAX + 33
1802 #define CS_2BYTE_MAX        (CS_SETCURRENTPOINT + 1)
1803 #define CS_MAX              CS_2BYTE_MAX
1804
1805 @ @<Types...@>=
1806 typedef unsigned char byte;
1807 typedef struct {
1808     byte nargs;                 /* number of arguments */
1809     boolean bottom;             /* take arguments from bottom of stack? */
1810     boolean clear;              /* clear stack? */
1811     boolean valid;
1812 } cc_entry;                     /* CharString Command */
1813 typedef struct {
1814     char *glyph_name;                 /* glyph name (or notdef for Subrs entry) */
1815     byte *data;
1816     unsigned short len;         /* length of the whole string */
1817     unsigned short cslen;       /* length of the encoded part of the string */
1818     boolean is_used;
1819     boolean valid;
1820 } cs_entry;
1821
1822 @ @<Glob...@>=
1823 unsigned short t1_dr, t1_er;
1824 unsigned short t1_c1, t1_c2;
1825 unsigned short t1_cslen;
1826 short t1_lenIV;
1827
1828 @ @<Set initial...@>=
1829 mp->ps->t1_c1 = 52845;
1830 mp->ps->t1_c2 = 22719;
1831
1832 @ @<Types...@>=
1833 typedef char t1_line_entry;
1834 typedef char t1_buf_entry;
1835
1836 @ @<Glob...@>=
1837 t1_line_entry *t1_line_ptr, *t1_line_array;
1838 size_t t1_line_limit;
1839 t1_buf_entry *t1_buf_ptr, *t1_buf_array;
1840 size_t t1_buf_limit;
1841 int cs_start;
1842 cs_entry *cs_tab, *cs_ptr, *cs_notdef;
1843 char *cs_dict_start, *cs_dict_end;
1844 int cs_count, cs_size, cs_size_pos;
1845 cs_entry *subr_tab;
1846 char *subr_array_start, *subr_array_end;
1847 int subr_max, subr_size, subr_size_pos;
1848
1849 @ @<Set initial...@>=
1850 mp->ps->t1_line_array = NULL;
1851 mp->ps->t1_buf_array = NULL;
1852
1853 @
1854  This list contains the begin/end tokens commonly used in the
1855  /Subrs array of a Type 1 font.
1856
1857 @<Static variables in the outer block@>=
1858 static const char *cs_token_pairs_list[][2] = {
1859     {" RD", "NP"},
1860     {" -|", "|"},
1861     {" RD", "noaccess put"},
1862     {" -|", "noaccess put"},
1863     {NULL, NULL}
1864 };
1865
1866 @ @<Glob...@>=
1867 const char **cs_token_pair;
1868 boolean t1_pfa, t1_cs, t1_scan, t1_eexec_encrypt, t1_synthetic;
1869 int t1_in_eexec;  /* 0 before eexec-encrypted, 1 during, 2 after */
1870 long t1_block_length;
1871 int last_hexbyte;
1872 void *t1_file;
1873 int hexline_length;
1874
1875 @
1876 @d HEXLINE_WIDTH 64
1877
1878 @<Set initial ...@>=
1879 mp->ps->hexline_length = HEXLINE_WIDTH;
1880
1881 @
1882 @d t1_prefix(s)        str_prefix(mp->ps->t1_line_array, s)
1883 @d t1_buf_prefix(s)    str_prefix(mp->ps->t1_buf_array, s)
1884 @d t1_suffix(s)        str_suffix(mp->ps->t1_line_array, mp->ps->t1_line_ptr, s)
1885 @d t1_buf_suffix(s)    str_suffix(mp->ps->t1_buf_array, mp->ps->t1_buf_ptr, s)
1886 @d t1_charstrings()    strstr(mp->ps->t1_line_array, charstringname)
1887 @d t1_subrs()          t1_prefix("/Subrs")
1888 @d t1_end_eexec()      t1_suffix("mark currentfile closefile")
1889 @d t1_cleartomark()    t1_prefix("cleartomark")
1890
1891 @d isdigit(A) ((A)>='0'&&(A)<='9')
1892
1893 @c
1894 static void end_hexline (MP mp) {
1895   if (mp->ps->hexline_length == HEXLINE_WIDTH) {
1896     wps_cr;
1897     mp->ps->hexline_length = 0;
1898   }
1899 }
1900 static void t1_check_pfa (MP mp) {
1901     const int c = t1_getchar (mp);
1902     mp->ps->t1_pfa = (c != 128) ? true : false;
1903     t1_ungetchar (c);
1904 }
1905 static int t1_getbyte (MP mp)
1906 {
1907     int c = t1_getchar (mp);
1908     if (mp->ps->t1_pfa)
1909         return c;
1910     if (mp->ps->t1_block_length == 0) {
1911         if (c != 128)
1912          mp_fatal_error (mp, "invalid marker");
1913         c = t1_getchar (mp);
1914         if (c == 3) {
1915             while (!t1_eof ())
1916                 t1_getchar (mp);
1917             return EOF;
1918         }
1919         mp->ps->t1_block_length = t1_getchar (mp) & 0xff;
1920         mp->ps->t1_block_length |= (t1_getchar (mp) & 0xff) << 8;
1921         mp->ps->t1_block_length |= (t1_getchar (mp) & 0xff) << 16;
1922         mp->ps->t1_block_length |= (t1_getchar (mp) & 0xff) << 24;
1923         c = t1_getchar (mp);
1924     }
1925     mp->ps->t1_block_length--;
1926     return c;
1927 }
1928 static int hexval (int c) {
1929     if (c >= 'A' && c <= 'F')
1930         return c - 'A' + 10;
1931     else if (c >= 'a' && c <= 'f')
1932         return c - 'a' + 10;
1933     else if (c >= '0' && c <= '9')
1934         return c - '0';
1935     else
1936         return -1;
1937 }
1938 static byte edecrypt (MP mp, byte cipher) {
1939     byte plain;
1940     if (mp->ps->t1_pfa) {
1941         while (cipher == 10 || cipher == 13)
1942             cipher = t1_getbyte (mp);
1943         mp->ps->last_hexbyte = cipher = (hexval (cipher) << 4) + hexval (t1_getbyte (mp));
1944     }
1945     plain = (cipher ^ (mp->ps->t1_dr >> 8));
1946     mp->ps->t1_dr = (cipher + mp->ps->t1_dr) * mp->ps->t1_c1 + mp->ps->t1_c2;
1947     return plain;
1948 }
1949 static byte cdecrypt (MP mp, byte cipher, unsigned short *cr)
1950 {
1951     const byte plain = (cipher ^ (*cr >> 8));
1952     *cr = (cipher + *cr) * mp->ps->t1_c1 + mp->ps->t1_c2;
1953     return plain;
1954 }
1955 static byte eencrypt (MP mp, byte plain)
1956 {
1957     const byte cipher = (plain ^ (mp->ps->t1_er >> 8));
1958     mp->ps->t1_er = (cipher + mp->ps->t1_er) * mp->ps->t1_c1 + mp->ps->t1_c2;
1959     return cipher;
1960 }
1961
1962 static byte cencrypt (MP mp, byte plain, unsigned short *cr)
1963 {
1964     const byte cipher = (plain ^ (*cr >> 8));
1965     *cr = (cipher + *cr) * mp->ps->t1_c1 + mp->ps->t1_c2;
1966     return cipher;
1967 }
1968
1969 static char *eol (char *s) {
1970     char *p = strend (s);
1971     if (p - s > 1 && p[-1] != 10) {
1972         *p++ = 10;
1973         *p = 0;
1974     }
1975     return p;
1976 }
1977 static float t1_scan_num (MP mp, char *p, char **r)
1978 {
1979     float f;
1980     char s[128];
1981     skip (p, ' ');
1982     if (sscanf (p, "%g", &f) != 1) {
1983         remove_eol (p, mp->ps->t1_line_array);
1984             snprintf(s,128, "a number expected: `%s'", mp->ps->t1_line_array);
1985         mp_fatal_error(mp,s);
1986     }
1987     if (r != NULL) {
1988         for (; isdigit (*p) || *p == '.' ||
1989              *p == 'e' || *p == 'E' || *p == '+' || *p == '-'; p++);
1990         *r = p;
1991     }
1992     return f;
1993 }
1994
1995 static boolean str_suffix (const char *begin_buf, const char *end_buf,
1996                            const char *s)
1997 {
1998     const char *s1 = end_buf - 1, *s2 = strend (s) - 1;
1999     if (*s1 == 10)
2000         s1--;
2001     while (s1 >= begin_buf && s2 >= s) {
2002         if (*s1-- != *s2--)
2003             return false;
2004     }
2005     return s2 < s;
2006 }
2007
2008 @
2009
2010 @d alloc_array(T, n, s) do {
2011     if (mp->ps->T##_array == NULL) {
2012         mp->ps->T##_limit = (s);
2013         if ((unsigned)(n) > mp->ps->T##_limit)
2014             mp->ps->T##_limit = (n);
2015         mp->ps->T##_array = mp_xmalloc (mp,mp->ps->T##_limit,sizeof(T##_entry));
2016         mp->ps->T##_ptr = mp->ps->T##_array;
2017     }
2018     else if ((unsigned)(mp->ps->T##_ptr - mp->ps->T##_array + (n)) > mp->ps->T##_limit) {
2019         size_t last_ptr_index;
2020         last_ptr_index = mp->ps->T##_ptr - mp->ps->T##_array;
2021         mp->ps->T##_limit *= 2;
2022         if ((unsigned)(mp->ps->T##_ptr - mp->ps->T##_array + (n)) > mp->ps->T##_limit)
2023             mp->ps->T##_limit = mp->ps->T##_ptr - mp->ps->T##_array + (n);
2024         mp->ps->T##_array = mp_xrealloc(mp,mp->ps->T##_array,mp->ps->T##_limit, sizeof(T##_entry));
2025         mp->ps->T##_ptr = mp->ps->T##_array + last_ptr_index;
2026     }
2027 } while (0)
2028
2029 @d out_eexec_char(A)      t1_outhex(mp,(A))
2030
2031 @c
2032 static void t1_outhex (MP mp, byte b)
2033 {
2034     static char *hexdigits = "0123456789ABCDEF";
2035     t1_putchar (hexdigits[b / 16]);
2036     t1_putchar (hexdigits[b % 16]);
2037     mp->ps->hexline_length += 2;
2038     end_hexline (mp);
2039 }
2040 static void t1_getline (MP mp) {
2041     int c, l, eexec_scan;
2042     char *p;
2043     static const char eexec_str[] = "currentfile eexec";
2044     static int eexec_len = 17;  /* |strlen(eexec_str)| */
2045   RESTART:
2046     if (t1_eof ())
2047         mp_fatal_error (mp,"unexpected end of file");
2048     mp->ps->t1_line_ptr = mp->ps->t1_line_array;
2049     alloc_array (t1_line, 1, T1_BUF_SIZE);
2050     mp->ps->t1_cslen = 0;
2051     eexec_scan = 0;
2052     c = t1_getbyte (mp);
2053     if (c == EOF)
2054         goto EXIT;
2055     while (!t1_eof ()) {
2056         if (mp->ps->t1_in_eexec == 1)
2057             c = edecrypt (mp,c);
2058         alloc_array (t1_line, 1, T1_BUF_SIZE);
2059         append_char_to_buf (c, mp->ps->t1_line_ptr, mp->ps->t1_line_array, mp->ps->t1_line_limit);
2060         if (mp->ps->t1_in_eexec == 0 && eexec_scan >= 0 && eexec_scan < eexec_len) {
2061             if (mp->ps->t1_line_array[eexec_scan] == eexec_str[eexec_scan])
2062                 eexec_scan++;
2063             else
2064                 eexec_scan = -1;
2065         }
2066         if (c == 10 || (mp->ps->t1_pfa && eexec_scan == eexec_len && c == 32))
2067             break;
2068         if (mp->ps->t1_cs && mp->ps->t1_cslen == 0 &&
2069             (mp->ps->t1_line_ptr - mp->ps->t1_line_array > 4) &&
2070             (t1_suffix (" RD ") || t1_suffix (" -| "))) {
2071             p = mp->ps->t1_line_ptr - 5;
2072             while (*p != ' ')
2073                 p--;
2074             mp->ps->t1_cslen = l = t1_scan_num (mp, p + 1, 0);
2075             mp->ps->cs_start = mp->ps->t1_line_ptr - mp->ps->t1_line_array;
2076                   /* |mp->ps->cs_start| is an index now */
2077             alloc_array (t1_line, l, T1_BUF_SIZE);
2078             while (l-- > 0)
2079                 *mp->ps->t1_line_ptr++ = edecrypt (mp,t1_getbyte (mp));
2080         }
2081         c = t1_getbyte (mp);
2082     }
2083     alloc_array (t1_line, 2, T1_BUF_SIZE);      /* |append_eol| can append 2 chars */
2084     append_eol (mp->ps->t1_line_ptr, mp->ps->t1_line_array, mp->ps->t1_line_limit);
2085     if (mp->ps->t1_line_ptr - mp->ps->t1_line_array < 2)
2086         goto RESTART;
2087     if (eexec_scan == eexec_len)
2088         mp->ps->t1_in_eexec = 1;
2089   EXIT:
2090     /* ensure that |mp->ps->t1_buf_array| has as much room as |t1_line_array| */
2091     mp->ps->t1_buf_ptr = mp->ps->t1_buf_array;
2092     alloc_array (t1_buf, mp->ps->t1_line_limit, mp->ps->t1_line_limit);
2093 }
2094
2095 static void t1_putline (MP mp)
2096 {
2097     char *p = mp->ps->t1_line_array;
2098     if (mp->ps->t1_line_ptr - mp->ps->t1_line_array <= 1)
2099         return;
2100     if (mp->ps->t1_eexec_encrypt) {
2101         while (p < mp->ps->t1_line_ptr)
2102             out_eexec_char (eencrypt (mp,*p++));
2103     } else {
2104         while (p < mp->ps->t1_line_ptr)
2105             t1_putchar (*p++);
2106         }
2107 }
2108
2109 static void t1_puts (MP mp, const char *s)
2110 {
2111     if (s != mp->ps->t1_line_array)
2112         strcpy (mp->ps->t1_line_array, s);
2113     mp->ps->t1_line_ptr = strend (mp->ps->t1_line_array);
2114     t1_putline (mp);
2115 }
2116
2117 static void t1_printf (MP mp, const char *fmt, ...)
2118 {
2119     va_list args;
2120     va_start (args, fmt);
2121     vsprintf (mp->ps->t1_line_array, fmt, args);
2122     t1_puts (mp,mp->ps->t1_line_array);
2123     va_end (args);
2124 }
2125
2126 static void t1_init_params (MP mp, char *open_name_prefix,
2127                            char *cur_file_name) {
2128   if ((open_name_prefix != NULL) && strlen(open_name_prefix)) {
2129     t1_log (open_name_prefix);
2130     t1_log (cur_file_name);
2131   }
2132     mp->ps->t1_lenIV = 4;
2133     mp->ps->t1_dr = 55665;
2134     mp->ps->t1_er = 55665;
2135     mp->ps->t1_in_eexec = 0;
2136     mp->ps->t1_cs = false;
2137     mp->ps->t1_scan = true;
2138     mp->ps->t1_synthetic = false;
2139     mp->ps->t1_eexec_encrypt = false;
2140     mp->ps->t1_block_length = 0;
2141     t1_check_pfa (mp);
2142 }
2143 static void  t1_close_font_file (MP mp, const char *close_name_suffix) {
2144   if ((close_name_suffix != NULL) && strlen(close_name_suffix)) {
2145     t1_log (close_name_suffix);
2146   }
2147   t1_close ();
2148 }
2149
2150 static void  t1_check_block_len (MP mp, boolean decrypt) {
2151     int l, c;
2152     char s[128];
2153     if (mp->ps->t1_block_length == 0)
2154         return;
2155     c = t1_getbyte (mp);
2156     if (decrypt)
2157         c = edecrypt (mp,c);
2158     l = mp->ps->t1_block_length;
2159     if (!(l == 0 && (c == 10 || c == 13))) {
2160         snprintf(s,128,"%i bytes more than expected were ignored", l+ 1);
2161         mp_warn(mp,s);
2162         while (l-- > 0)
2163           t1_getbyte (mp);
2164     }
2165 }
2166 static void  t1_start_eexec (MP mp, fm_entry *fm_cur) {
2167     int i;
2168     if (!mp->ps->t1_pfa)
2169      t1_check_block_len (mp, false);
2170     for (mp->ps->t1_line_ptr = mp->ps->t1_line_array, i = 0; i < 4; i++) {
2171       edecrypt (mp, t1_getbyte (mp));
2172       *mp->ps->t1_line_ptr++ = 0;
2173     }
2174     mp->ps->t1_eexec_encrypt = true;
2175         if (!mp->ps->read_encoding_only)
2176           if (is_included (fm_cur))
2177         t1_putline (mp);          /* to put the first four bytes */
2178 }
2179 static void  t1_stop_eexec (MP mp) {
2180     int c;
2181     end_last_eexec_line ();
2182     if (!mp->ps->t1_pfa)
2183       t1_check_block_len (mp,true);
2184     else {
2185         c = edecrypt (mp, t1_getbyte (mp));
2186         if (!(c == 10 || c == 13)) {
2187            if (mp->ps->last_hexbyte == 0)
2188               t1_puts (mp,"00");
2189            else
2190               mp_warn (mp,"unexpected data after eexec");
2191         }
2192     }
2193     mp->ps->t1_cs = false;
2194     mp->ps->t1_in_eexec = 2;
2195 }
2196 static void  t1_modify_fm (MP mp) {
2197   mp->ps->t1_line_ptr = eol (mp->ps->t1_line_array);
2198 }
2199
2200 static void  t1_modify_italic (MP mp) {
2201   mp->ps->t1_line_ptr = eol (mp->ps->t1_line_array);
2202 }
2203
2204 @ @<Types...@>=
2205 typedef struct {
2206     const char *pdfname;
2207     const char *t1name;
2208     float value;
2209     boolean valid;
2210 } key_entry;
2211
2212 @
2213 @d FONT_KEYS_NUM  11
2214
2215 @<Declarations@>=
2216 static key_entry font_keys[FONT_KEYS_NUM] = {
2217     {"Ascent", "Ascender", 0, false},
2218     {"CapHeight", "CapHeight", 0, false},
2219     {"Descent", "Descender", 0, false},
2220     {"FontName", "FontName", 0, false},
2221     {"ItalicAngle", "ItalicAngle", 0, false},
2222     {"StemV", "StdVW", 0, false},
2223     {"XHeight", "XHeight", 0, false},
2224     {"FontBBox", "FontBBox", 0, false},
2225     {"", "", 0, false},
2226     {"", "", 0, false},
2227     {"", "", 0, false}
2228 };
2229
2230
2231 @
2232 @d ASCENT_CODE         0
2233 @d CAPHEIGHT_CODE      1
2234 @d DESCENT_CODE        2
2235 @d FONTNAME_CODE       3
2236 @d ITALIC_ANGLE_CODE   4
2237 @d STEMV_CODE          5
2238 @d XHEIGHT_CODE        6
2239 @d FONTBBOX1_CODE      7
2240 @d FONTBBOX2_CODE      8
2241 @d FONTBBOX3_CODE      9
2242 @d FONTBBOX4_CODE      10
2243 @d MAX_KEY_CODE (FONTBBOX1_CODE + 1)
2244
2245 @c
2246 static void  t1_scan_keys (MP mp, int tex_font,fm_entry *fm_cur) {
2247     int i, k;
2248     char *p, *r;
2249     key_entry *key;
2250     if (fm_extend (fm_cur) != 0 || fm_slant (fm_cur) != 0) {
2251         if (t1_prefix ("/FontMatrix")) {
2252             t1_modify_fm (mp);
2253             return;
2254         }
2255         if (t1_prefix ("/ItalicAngle")) {
2256             t1_modify_italic (mp);
2257             return;
2258         }
2259     }
2260     if (t1_prefix ("/FontType")) {
2261         p = mp->ps->t1_line_array + strlen ("FontType") + 1;
2262         if ((i = t1_scan_num (mp,p, 0)) != 1) {
2263             char s[128];
2264             snprintf(s,125,"Type%d fonts unsupported by metapost", i);
2265             mp_fatal_error(mp,s);
2266         }
2267         return;
2268     }
2269     for (key = font_keys; key - font_keys < MAX_KEY_CODE; key++)
2270         if (str_prefix (mp->ps->t1_line_array + 1, key->t1name))
2271             break;
2272     if (key - font_keys == MAX_KEY_CODE)
2273         return;
2274     key->valid = true;
2275     p = mp->ps->t1_line_array + strlen (key->t1name) + 1;
2276     skip (p, ' ');
2277     if ((k = key - font_keys) == FONTNAME_CODE) {
2278         if (*p != '/') {
2279           char s[128];
2280           remove_eol (p, mp->ps->t1_line_array);
2281           snprintf(s,128,"a name expected: `%s'", mp->ps->t1_line_array);
2282           mp_fatal_error(mp,s);
2283         }
2284         r = ++p;                /* skip the slash */
2285         if (is_included (fm_cur)) {
2286           /* save the fontname */
2287           strncpy (mp->ps->fontname_buf, p, FONTNAME_BUF_SIZE);
2288           for (i=0; mp->ps->fontname_buf[i] != 10; i++);
2289           mp->ps->fontname_buf[i]=0;
2290
2291           if(is_subsetted (fm_cur)) {
2292             if (fm_cur->encoding!=NULL && fm_cur->encoding->glyph_names!=NULL)
2293               make_subset_tag (mp,fm_cur, fm_cur->encoding->glyph_names, tex_font);
2294             else
2295               make_subset_tag (mp,fm_cur, mp->ps->t1_builtin_glyph_names, tex_font);
2296
2297             alloc_array (t1_line, (r-mp->ps->t1_line_array+6+1+strlen(mp->ps->fontname_buf)+1),
2298                          T1_BUF_SIZE);
2299             strncpy (r, fm_cur->subset_tag , 6);
2300             *(r+6) = '-';
2301             strncpy (r+7, mp->ps->fontname_buf, strlen(mp->ps->fontname_buf)+1);
2302             mp->ps->t1_line_ptr = eol (r);
2303           } else {
2304             /* |for (q = p; *q != ' ' && *q != 10; *q++);|*/
2305             /*|*q = 0;|*/
2306             mp->ps->t1_line_ptr = eol (r);
2307           }
2308         }
2309         return;
2310     }
2311     if ((k == STEMV_CODE || k == FONTBBOX1_CODE)
2312         && (*p == '[' || *p == '{'))
2313         p++;
2314     if (k == FONTBBOX1_CODE) {
2315         for (i = 0; i < 4; i++) {
2316             key[i].value = t1_scan_num (mp, p, &r);
2317             p = r;
2318         }
2319         return;
2320     }
2321     key->value = t1_scan_num (mp, p, 0);
2322 }
2323 static void  t1_scan_param (MP mp, int tex_font,fm_entry *fm_cur)
2324 {
2325     static const char *lenIV = "/lenIV";
2326     if (!mp->ps->t1_scan || *mp->ps->t1_line_array != '/')
2327         return;
2328     if (t1_prefix (lenIV)) {
2329         mp->ps->t1_lenIV = t1_scan_num (mp,mp->ps->t1_line_array + strlen (lenIV), 0);
2330         return;
2331     }
2332     t1_scan_keys (mp, tex_font,fm_cur);
2333 }
2334 static void  copy_glyph_names (MP mp, char **glyph_names, int a, int b) {
2335     if (glyph_names[b] != notdef) {
2336         mp_xfree (glyph_names[b]);
2337         glyph_names[b] = (char *) notdef;
2338     }
2339     if (glyph_names[a] != notdef) {
2340         glyph_names[b] = mp_xstrdup (mp,glyph_names[a]);
2341     }
2342 }
2343 static void  t1_builtin_enc (MP mp) {
2344     int i, a, b, c, counter = 0;
2345     char *r, *p;
2346     /*
2347      * At this moment "/Encoding" is the prefix of |mp->ps->t1_line_array|
2348      */
2349     if (t1_suffix ("def")) {    /* predefined encoding */
2350         sscanf (mp->ps->t1_line_array + strlen ("/Encoding"), "%256s", mp->ps->t1_buf_array);
2351         if (strcmp (mp->ps->t1_buf_array, "StandardEncoding") == 0) {
2352             for (i = 0; i < 256; i++)
2353                 if (standard_glyph_names[i] == notdef)
2354                     mp->ps->t1_builtin_glyph_names[i] = (char *) notdef;
2355                 else
2356                     mp->ps->t1_builtin_glyph_names[i] =
2357                         mp_xstrdup (mp,standard_glyph_names[i]);
2358             mp->ps->t1_encoding = ENC_STANDARD;
2359         } else {
2360             char s[128];
2361             snprintf(s,128, "cannot subset font (unknown predefined encoding `%s')",
2362                         mp->ps->t1_buf_array);
2363             mp_fatal_error(mp,s);
2364         }
2365         return;
2366     } else
2367         mp->ps->t1_encoding = ENC_BUILTIN;
2368     /*
2369      * At this moment "/Encoding" is the prefix of |mp->ps->t1_line_array|, and the encoding is
2370      * not a predefined encoding
2371      *
2372      * We have two possible forms of Encoding vector. The first case is
2373      *
2374      *     /Encoding [/a /b /c...] readonly def
2375      *
2376      * and the second case can look like
2377      *
2378      *     /Encoding 256 array 0 1 255 {1 index exch /.notdef put} for
2379      *     dup 0 /x put
2380      *     dup 1 /y put
2381      *     ...
2382      *     readonly def
2383      */
2384     for (i = 0; i < 256; i++)
2385         mp->ps->t1_builtin_glyph_names[i] = (char *) notdef;
2386     if (t1_prefix ("/Encoding [") || t1_prefix ("/Encoding[")) {        /* the first case */
2387         r = strchr (mp->ps->t1_line_array, '[') + 1;
2388         skip (r, ' ');
2389         for (;;) {
2390             while (*r == '/') {
2391                 for (p = mp->ps->t1_buf_array, r++;
2392                      *r != 32 && *r != 10 && *r != ']' && *r != '/';
2393                      *p++ = *r++);
2394                 *p = 0;
2395                 skip (r, ' ');
2396                 if (counter > 255) {
2397                    mp_fatal_error
2398                         (mp, "encoding vector contains more than 256 names");
2399                 }
2400                 if (strcmp (mp->ps->t1_buf_array, notdef) != 0)
2401                   mp->ps->t1_builtin_glyph_names[counter] = mp_xstrdup (mp,mp->ps->t1_buf_array);
2402                 counter++;
2403             }
2404             if (*r != 10 && *r != '%') {
2405                 if (str_prefix (r, "] def")
2406                     || str_prefix (r, "] readonly def"))
2407                     break;
2408                 else {
2409                     char s[128];
2410                     remove_eol (r, mp->ps->t1_line_array);
2411                     snprintf(s,128,"a name or `] def' or `] readonly def' expected: `%s'",
2412                                     mp->ps->t1_line_array);
2413                     mp_fatal_error(mp,s);
2414                 }
2415             }
2416             t1_getline (mp);
2417             r = mp->ps->t1_line_array;
2418         }
2419     } else {                    /* the second case */
2420         p = strchr (mp->ps->t1_line_array, 10);
2421         for (;;) {
2422             if (*p == 10) {
2423                 t1_getline (mp);
2424                 p = mp->ps->t1_line_array;
2425             }
2426             /*
2427                check for `dup <index> <glyph> put'
2428              */
2429             if (sscanf (p, "dup %i%256s put", &i, mp->ps->t1_buf_array) == 2 &&
2430                 *mp->ps->t1_buf_array == '/' && valid_code (i)) {
2431                 if (strcmp (mp->ps->t1_buf_array + 1, notdef) != 0)
2432                     mp->ps->t1_builtin_glyph_names[i] =
2433                       mp_xstrdup (mp,mp->ps->t1_buf_array + 1);
2434                 p = strstr (p, " put") + strlen (" put");
2435                 skip (p, ' ');
2436             }
2437             /*
2438                check for `dup dup <to> exch <from> get put'
2439              */
2440             else if (sscanf (p, "dup dup %i exch %i get put", &b, &a) == 2
2441                      && valid_code (a) && valid_code (b)) {
2442                 copy_glyph_names (mp,mp->ps->t1_builtin_glyph_names, a, b);
2443                 p = strstr (p, " get put") + strlen (" get put");
2444                 skip (p, ' ');
2445             }
2446             /*
2447                check for `dup dup <from> <size> getinterval <to> exch putinterval'
2448              */
2449             else if (sscanf
2450                      (p, "dup dup %i %i getinterval %i exch putinterval",
2451                       &a, &c, &b) == 3 && valid_code (a) && valid_code (b)
2452                      && valid_code (c)) {
2453                 for (i = 0; i < c; i++)
2454                     copy_glyph_names (mp,mp->ps->t1_builtin_glyph_names, a + i, b + i);
2455                 p = strstr (p, " putinterval") + strlen (" putinterval");
2456                 skip (p, ' ');
2457             }
2458             /*
2459                check for `def' or `readonly def'
2460              */
2461             else if ((p == mp->ps->t1_line_array || (p > mp->ps->t1_line_array && p[-1] == ' '))
2462                      && strcmp (p, "def\n") == 0)
2463                 return;
2464             /*
2465                skip an unrecognizable word
2466              */
2467             else {
2468                 while (*p != ' ' && *p != 10)
2469                     p++;
2470                 skip (p, ' ');
2471             }
2472         }
2473     }
2474 }
2475
2476 static void  t1_check_end (MP mp) {
2477     if (t1_eof ())
2478         return;
2479     t1_getline (mp);
2480     if (t1_prefix ("{restore}"))
2481         t1_putline (mp);
2482 }
2483
2484 @ @<Types...@>=
2485 typedef struct {
2486     char *ff_name;              /* base name of font file */
2487     char *ff_path;              /* full path to font file */
2488 } ff_entry;
2489
2490 @ @c
2491 static boolean t1_open_fontfile (MP mp, fm_entry *fm_cur,const char *open_name_prefix) {
2492     ff_entry *ff;
2493     ff = check_ff_exist (mp, fm_cur);
2494     if (ff->ff_path != NULL) {
2495         mp->ps->t1_file = (mp->open_file)(ff->ff_path, "rb", mp_filetype_font);
2496     } else {
2497         mp_warn (mp, "cannot open Type 1 font file for reading");
2498         return false;
2499     }
2500     t1_init_params (mp,(char *)open_name_prefix,fm_cur->ff_name);
2501     mp->ps->fontfile_found = true;
2502     return true;
2503 }
2504
2505 static void  t1_scan_only (MP mp, int tex_font, fm_entry *fm_cur) {
2506     do {
2507         t1_getline (mp);
2508         t1_scan_param (mp,tex_font, fm_cur);
2509     }
2510     while (mp->ps->t1_in_eexec == 0);
2511     t1_start_eexec (mp,fm_cur);
2512     do {
2513         t1_getline (mp);
2514         t1_scan_param (mp,tex_font, fm_cur);
2515     }
2516     while (!(t1_charstrings () || t1_subrs ()));
2517 }
2518
2519 static void  t1_include (MP mp, int tex_font, fm_entry *fm_cur) {
2520     do {
2521         t1_getline (mp);
2522         t1_scan_param (mp,tex_font, fm_cur);
2523         t1_putline (mp);
2524     }
2525     while (mp->ps->t1_in_eexec == 0);
2526     t1_start_eexec (mp,fm_cur);
2527     do {
2528         t1_getline (mp);
2529         t1_scan_param (mp,tex_font, fm_cur);
2530         t1_putline (mp);
2531     }
2532     while (!(t1_charstrings () || t1_subrs ()));
2533     mp->ps->t1_cs = true;
2534     do {
2535         t1_getline (mp);
2536         t1_putline (mp);
2537     }
2538     while (!t1_end_eexec ());
2539     t1_stop_eexec (mp);
2540     if (fixedcontent) {         /* copy 512 zeros (not needed for PDF) */
2541         do {
2542             t1_getline (mp);
2543             t1_putline (mp);
2544         }
2545         while (!t1_cleartomark ());
2546         t1_check_end (mp);        /* write "{restore}if" if found */
2547     }
2548 }
2549
2550 @
2551 @d check_subr(SUBR) if (SUBR >= mp->ps->subr_size || SUBR < 0) {
2552         char s[128];
2553         snprintf(s,128,"Subrs array: entry index out of range (%i)",SUBR);
2554         mp_fatal_error(mp,s);
2555   }
2556
2557 @c
2558 static const char **check_cs_token_pair (MP mp) {
2559     const char **p = (const char **) cs_token_pairs_list;
2560     for (; p[0] != NULL; ++p)
2561         if (t1_buf_prefix (p[0]) && t1_buf_suffix (p[1]))
2562             return p;
2563     return NULL;
2564 }
2565
2566 static void cs_store (MP mp, boolean is_subr) {
2567     char *p;
2568     cs_entry *ptr;
2569     int subr;
2570     for (p = mp->ps->t1_line_array, mp->ps->t1_buf_ptr = mp->ps->t1_buf_array; *p != ' ';
2571          *mp->ps->t1_buf_ptr++ = *p++);
2572     *mp->ps->t1_buf_ptr = 0;
2573     if (is_subr) {
2574         subr = t1_scan_num (mp, p + 1, 0);
2575         check_subr (subr);
2576         ptr = mp->ps->subr_tab + subr;
2577     } else {
2578         ptr = mp->ps->cs_ptr++;
2579         if (mp->ps->cs_ptr - mp->ps->cs_tab > mp->ps->cs_size) {
2580           char s[128];
2581           snprintf(s,128,"CharStrings dict: more entries than dict size (%i)",mp->ps->cs_size);
2582           mp_fatal_error(mp,s);
2583         }
2584         if (strcmp (mp->ps->t1_buf_array + 1, notdef) == 0)     /* skip the slash */
2585             ptr->glyph_name = (char *) notdef;
2586         else
2587             ptr->glyph_name = mp_xstrdup (mp,mp->ps->t1_buf_array + 1);
2588     }
2589     /* copy " RD " + cs data to |mp->ps->t1_buf_array| */
2590     memcpy (mp->ps->t1_buf_array, mp->ps->t1_line_array + mp->ps->cs_start - 4,
2591             (unsigned) (mp->ps->t1_cslen + 4));
2592     /* copy the end of cs data to |mp->ps->t1_buf_array| */
2593     for (p = mp->ps->t1_line_array + mp->ps->cs_start + mp->ps->t1_cslen, mp->ps->t1_buf_ptr =
2594          mp->ps->t1_buf_array + mp->ps->t1_cslen + 4; *p != 10; *mp->ps->t1_buf_ptr++ = *p++);
2595     *mp->ps->t1_buf_ptr++ = 10;
2596     if (is_subr && mp->ps->cs_token_pair == NULL)
2597         mp->ps->cs_token_pair = check_cs_token_pair (mp);
2598     ptr->len = mp->ps->t1_buf_ptr - mp->ps->t1_buf_array;
2599     ptr->cslen = mp->ps->t1_cslen;
2600     ptr->data = mp_xmalloc (mp,ptr->len , sizeof (byte));
2601     memcpy (ptr->data, mp->ps->t1_buf_array, ptr->len);
2602     ptr->valid = true;
2603 }
2604
2605 #define store_subr(mp)    cs_store(mp,true)
2606 #define store_cs(mp)      cs_store(mp,false)
2607
2608 #define CC_STACK_SIZE       24
2609
2610 static integer cc_stack[CC_STACK_SIZE], *stack_ptr = cc_stack;
2611 static cc_entry cc_tab[CS_MAX];
2612 static boolean is_cc_init = false;
2613
2614
2615 #define cc_pop(N)                       \
2616     if (stack_ptr - cc_stack < (N))     \
2617         stack_error(N);                 \
2618     stack_ptr -= N
2619
2620 #define stack_error(N) {                \
2621     char s[256];                        \
2622     snprintf(s,255,"CharString: invalid access (%i) to stack (%i entries)", \
2623                  (int) N, (int)(stack_ptr - cc_stack));                  \
2624     mp_warn(mp,s);                    \
2625     goto cs_error;                    \
2626 }
2627
2628
2629 #define cc_get(N)   ((N) < 0 ? *(stack_ptr + (N)) : *(cc_stack + (N)))
2630
2631 #define cc_push(V)  *stack_ptr++ = V
2632 #define cc_clear()  stack_ptr = cc_stack
2633
2634 #define set_cc(N, B, A, C) \
2635     cc_tab[N].nargs = A;   \
2636     cc_tab[N].bottom = B;  \
2637     cc_tab[N].clear = C;   \
2638     cc_tab[N].valid = true
2639
2640 static void cc_init (void) {
2641     int i;
2642     if (is_cc_init)
2643         return;
2644     for (i = 0; i < CS_MAX; i++)
2645         cc_tab[i].valid = false;
2646     set_cc (CS_HSTEM, true, 2, true);
2647     set_cc (CS_VSTEM, true, 2, true);
2648     set_cc (CS_VMOVETO, true, 1, true);
2649     set_cc (CS_RLINETO, true, 2, true);
2650     set_cc (CS_HLINETO, true, 1, true);
2651     set_cc (CS_VLINETO, true, 1, true);
2652     set_cc (CS_RRCURVETO, true, 6, true);
2653     set_cc (CS_CLOSEPATH, false, 0, true);
2654     set_cc (CS_CALLSUBR, false, 1, false);
2655     set_cc (CS_RETURN, false, 0, false);
2656     /*
2657        |set_cc(CS_ESCAPE,          false,  0, false);|
2658      */
2659     set_cc (CS_HSBW, true, 2, true);
2660     set_cc (CS_ENDCHAR, false, 0, true);
2661     set_cc (CS_RMOVETO, true, 2, true);
2662     set_cc (CS_HMOVETO, true, 1, true);
2663     set_cc (CS_VHCURVETO, true, 4, true);
2664     set_cc (CS_HVCURVETO, true, 4, true);
2665     set_cc (CS_DOTSECTION, false, 0, true);
2666     set_cc (CS_VSTEM3, true, 6, true);
2667     set_cc (CS_HSTEM3, true, 6, true);
2668     set_cc (CS_SEAC, true, 5, true);
2669     set_cc (CS_SBW, true, 4, true);
2670     set_cc (CS_DIV, false, 2, false);
2671     set_cc (CS_CALLOTHERSUBR, false, 0, false);
2672     set_cc (CS_POP, false, 0, false);
2673     set_cc (CS_SETCURRENTPOINT, true, 2, true);
2674     is_cc_init = true;
2675 }
2676
2677 @
2678
2679 @d cs_getchar(mp)    cdecrypt(mp,*data++, &cr)
2680
2681 @d mark_subr(mp,n)    cs_mark(mp,0, n)
2682 @d mark_cs(mp,s)      cs_mark(mp,s, 0)
2683 @d SMALL_BUF_SIZE      256
2684
2685 @c
2686 static void cs_warn (MP mp, const char *cs_name, int subr, const char *fmt, ...) {
2687     char buf[SMALL_BUF_SIZE];
2688     char s[300];
2689     va_list args;
2690     va_start (args, fmt);
2691     vsprintf (buf, fmt, args);
2692     va_end (args);
2693     if (cs_name == NULL) {
2694         snprintf(s,299,"Subr (%i): %s", (int) subr, buf);
2695     } else {
2696        snprintf(s,299,"CharString (/%s): %s", cs_name, buf);
2697     }
2698     mp_warn(mp,s);
2699 }
2700
2701 static void cs_mark (MP mp, const char *cs_name, int subr)
2702 {
2703     byte *data;
2704     int i, b, cs_len;
2705     integer a, a1, a2;
2706     unsigned short cr;
2707     static integer lastargOtherSubr3 = 3;       /* the argument of last call to
2708                                                    OtherSubrs[3] */
2709     cs_entry *ptr;
2710     cc_entry *cc;
2711     if (cs_name == NULL) {
2712         check_subr (subr);
2713         ptr = mp->ps->subr_tab + subr;
2714         if (!ptr->valid)
2715           return;
2716     } else {
2717         if (mp->ps->cs_notdef != NULL &&
2718             (cs_name == notdef || strcmp (cs_name, notdef) == 0))
2719             ptr = mp->ps->cs_notdef;
2720         else {
2721             for (ptr = mp->ps->cs_tab; ptr < mp->ps->cs_ptr; ptr++)
2722                 if (strcmp (ptr->glyph_name, cs_name) == 0)
2723                     break;
2724             if (ptr == mp->ps->cs_ptr) {
2725                 char s[128];
2726                 snprintf (s,128,"glyph `%s' undefined", cs_name);
2727                 mp_warn(mp,s);
2728                 return;
2729             }
2730             if (ptr->glyph_name == notdef)
2731                 mp->ps->cs_notdef = ptr;
2732         }
2733     }
2734     /* only marked CharString entries and invalid entries can be skipped;
2735        valid marked subrs must be parsed to keep the stack in sync */
2736     if (!ptr->valid || (ptr->is_used && cs_name != NULL))
2737         return;
2738     ptr->is_used = true;
2739     cr = 4330;
2740     cs_len = ptr->cslen;
2741     data = ptr->data + 4;
2742     for (i = 0; i < mp->ps->t1_lenIV; i++, cs_len--)
2743         cs_getchar (mp);
2744     while (cs_len > 0) {
2745         --cs_len;
2746         b = cs_getchar (mp);
2747         if (b >= 32) {
2748             if (b <= 246)
2749                 a = b - 139;
2750             else if (b <= 250) {
2751                 --cs_len;
2752                 a = ((b - 247) << 8) + 108 + cs_getchar (mp);
2753             } else if (b <= 254) {
2754                 --cs_len;
2755                 a = -((b - 251) << 8) - 108 - cs_getchar (mp);
2756             } else {
2757                 cs_len -= 4;
2758                 a = (cs_getchar (mp) & 0xff) << 24;
2759                 a |= (cs_getchar (mp) & 0xff) << 16;
2760                 a |= (cs_getchar (mp) & 0xff) << 8;
2761                 a |= (cs_getchar (mp) & 0xff) << 0;
2762                 if (sizeof (integer) > 4 && (a & 0x80000000))
2763                     a |= ~0x7FFFFFFF;
2764             }
2765             cc_push (a);
2766         } else {
2767             if (b == CS_ESCAPE) {
2768                 b = cs_getchar (mp) + CS_1BYTE_MAX;
2769                 cs_len--;
2770             }
2771             if (b >= CS_MAX) {
2772                 cs_warn (mp,cs_name, subr, "command value out of range: %i",
2773                          (int) b);
2774                 goto cs_error;
2775             }
2776             cc = cc_tab + b;
2777             if (!cc->valid) {
2778                 cs_warn (mp,cs_name, subr, "command not valid: %i", (int) b);
2779                 goto cs_error;
2780             }
2781             if (cc->bottom) {
2782                 if (stack_ptr - cc_stack < cc->nargs)
2783                     cs_warn (mp,cs_name, subr,
2784                              "less arguments on stack (%i) than required (%i)",
2785                              (int) (stack_ptr - cc_stack), (int) cc->nargs);
2786                 else if (stack_ptr - cc_stack > cc->nargs)
2787                     cs_warn (mp,cs_name, subr,
2788                              "more arguments on stack (%i) than required (%i)",
2789                              (int) (stack_ptr - cc_stack), (int) cc->nargs);
2790             }
2791             switch (cc - cc_tab) {
2792             case CS_CALLSUBR:
2793                 a1 = cc_get (-1);
2794                 cc_pop (1);
2795                 mark_subr (mp,a1);
2796                 if (!mp->ps->subr_tab[a1].valid) {
2797                     cs_warn (mp,cs_name, subr, "cannot call subr (%i)", (int) a1);
2798                     goto cs_error;
2799                 }
2800                 break;
2801             case CS_DIV:
2802                 cc_pop (2);
2803                 cc_push (0);
2804                 break;
2805             case CS_CALLOTHERSUBR:
2806                 if (cc_get (-1) == 3)
2807                     lastargOtherSubr3 = cc_get (-3);
2808                 a1 = cc_get (-2) + 2;
2809                 cc_pop (a1);
2810                 break;
2811             case CS_POP:
2812                 cc_push (lastargOtherSubr3);
2813                 /* the only case when we care about the value being pushed onto
2814                    stack is when POP follows CALLOTHERSUBR (changing hints by
2815                    OtherSubrs[3])
2816                  */
2817                 break;
2818             case CS_SEAC:
2819                 a1 = cc_get (3);
2820                 a2 = cc_get (4);
2821                 cc_clear ();
2822                 mark_cs (mp,standard_glyph_names[a1]);
2823                 mark_cs (mp,standard_glyph_names[a2]);
2824                 break;
2825             default:
2826                 if (cc->clear)
2827                     cc_clear ();
2828             }
2829         }
2830     }
2831     return;
2832   cs_error:                    /* an error occured during parsing */
2833     cc_clear ();
2834     ptr->valid = false;
2835     ptr->is_used = false;
2836 }
2837
2838 static void t1_subset_ascii_part (MP mp, int tex_font, fm_entry *fm_cur)
2839 {
2840     int i, j;
2841     t1_getline (mp);
2842     while (!t1_prefix ("/Encoding")) {
2843           t1_scan_param (mp,tex_font, fm_cur);
2844         t1_putline (mp);
2845         t1_getline (mp);
2846     }
2847     t1_builtin_enc (mp);
2848     if (is_reencoded (fm_cur))
2849         mp->ps->t1_glyph_names = external_enc ();
2850     else
2851         mp->ps->t1_glyph_names = mp->ps->t1_builtin_glyph_names;
2852         /*
2853     |if (is_included (fm_cur) && is_subsetted (fm_cur)) {
2854             make_subset_tag (fm_cur, t1_glyph_names, tex_font);
2855         update_subset_tag ();
2856     }|
2857     */
2858     if ((!is_subsetted (fm_cur)) && mp->ps->t1_encoding == ENC_STANDARD)
2859         t1_puts (mp,"/Encoding StandardEncoding def\n");
2860     else {
2861         t1_puts
2862             (mp,"/Encoding 256 array\n0 1 255 {1 index exch /.notdef put} for\n");
2863         for (i = 0, j = 0; i < 256; i++) {
2864             if (is_used_char (i) && mp->ps->t1_glyph_names[i] != notdef) {
2865                 j++;
2866                 t1_printf (mp,"dup %i /%s put\n", (int) t1_char (i),
2867                            mp->ps->t1_glyph_names[i]);
2868             }
2869         }
2870         /* We didn't mark anything for the Encoding array. */
2871         /* We add "dup 0 /.notdef put" for compatibility   */
2872         /* with Acrobat 5.0.                               */
2873         if (j == 0)
2874             t1_puts (mp,"dup 0 /.notdef put\n");
2875         t1_puts (mp,"readonly def\n");
2876     }
2877     do {
2878         t1_getline (mp);
2879         t1_scan_param (mp,tex_font, fm_cur);
2880         if (!t1_prefix ("/UniqueID"))   /* ignore UniqueID for subsetted fonts */
2881             t1_putline (mp);
2882     }
2883     while (mp->ps->t1_in_eexec == 0);
2884 }
2885
2886 #define t1_subr_flush(mp)  t1_flush_cs(mp,true)
2887 #define t1_cs_flush(mp)    t1_flush_cs(mp,false)
2888
2889 static void cs_init (MP mp) {
2890     mp->ps->cs_ptr = mp->ps->cs_tab = NULL;
2891     mp->ps->cs_dict_start = mp->ps->cs_dict_end = NULL;
2892     mp->ps->cs_count = mp->ps->cs_size = mp->ps->cs_size_pos = 0;
2893     mp->ps->cs_token_pair = NULL;
2894     mp->ps->subr_tab = NULL;
2895     mp->ps->subr_array_start = mp->ps->subr_array_end = NULL;
2896     mp->ps->subr_max = mp->ps->subr_size = mp->ps->subr_size_pos = 0;
2897 }
2898
2899 static void init_cs_entry ( cs_entry * cs) {
2900     cs->data = NULL;
2901     cs->glyph_name = NULL;
2902     cs->len = 0;
2903     cs->cslen = 0;
2904     cs->is_used = false;
2905     cs->valid = false;
2906 }
2907
2908 static void t1_mark_glyphs (MP mp, int tex_font);
2909
2910 static void t1_read_subrs (MP mp, int tex_font, fm_entry *fm_cur)
2911 {
2912     int i, s;
2913     cs_entry *ptr;
2914     t1_getline (mp);
2915     while (!(t1_charstrings () || t1_subrs ())) {
2916         t1_scan_param (mp,tex_font, fm_cur);
2917         t1_putline (mp);
2918         t1_getline (mp);
2919     }
2920   FOUND:
2921     mp->ps->t1_cs = true;
2922     mp->ps->t1_scan = false;
2923     if (!t1_subrs ())
2924         return;
2925     mp->ps->subr_size_pos = strlen ("/Subrs") + 1;
2926     /* |subr_size_pos| points to the number indicating dict size after "/Subrs" */
2927     mp->ps->subr_size = t1_scan_num (mp,mp->ps->t1_line_array + mp->ps->subr_size_pos, 0);
2928     if (mp->ps->subr_size == 0) {
2929         while (!t1_charstrings ())
2930             t1_getline (mp);
2931         return;
2932     }
2933         /*    |subr_tab = xtalloc (subr_size, cs_entry);| */
2934         mp->ps->subr_tab = (cs_entry *)mp_xmalloc (mp,mp->ps->subr_size, sizeof (cs_entry));
2935     for (ptr = mp->ps->subr_tab; ptr - mp->ps->subr_tab < mp->ps->subr_size; ptr++)
2936         init_cs_entry (ptr);
2937     mp->ps->subr_array_start = mp_xstrdup (mp,mp->ps->t1_line_array);
2938     t1_getline (mp);
2939     while (mp->ps->t1_cslen) {
2940         store_subr (mp);
2941         t1_getline (mp);
2942     }
2943     /* mark the first four entries without parsing */
2944     for (i = 0; i < mp->ps->subr_size && i < 4; i++)
2945         mp->ps->subr_tab[i].is_used = true;
2946     /* the end of the Subrs array might have more than one line so we need to
2947        concatnate them to |subr_array_end|. Unfortunately some fonts don't have
2948        the Subrs array followed by the CharStrings dict immediately (synthetic
2949        fonts). If we cannot find CharStrings in next |POST_SUBRS_SCAN| lines then
2950        we will treat the font as synthetic and ignore everything until next
2951        Subrs is found
2952      */
2953 #define POST_SUBRS_SCAN     5
2954     s = 0;
2955     *mp->ps->t1_buf_array = 0;
2956     for (i = 0; i < POST_SUBRS_SCAN; i++) {
2957         if (t1_charstrings ())
2958             break;
2959         s += mp->ps->t1_line_ptr - mp->ps->t1_line_array;
2960         alloc_array (t1_buf, s, T1_BUF_SIZE);
2961         strcat (mp->ps->t1_buf_array, mp->ps->t1_line_array);
2962         t1_getline (mp);
2963     }
2964     mp->ps->subr_array_end = mp_xstrdup (mp,mp->ps->t1_buf_array);
2965     if (i == POST_SUBRS_SCAN) { /* CharStrings not found;
2966                                    suppose synthetic font */
2967         for (ptr = mp->ps->subr_tab; ptr - mp->ps->subr_tab < mp->ps->subr_size; ptr++)
2968             if (ptr->valid)
2969                 mp_xfree (ptr->data);
2970         mp_xfree (mp->ps->subr_tab);
2971         mp_xfree (mp->ps->subr_array_start);
2972         mp_xfree (mp->ps->subr_array_end);
2973         cs_init (mp);
2974         mp->ps->t1_cs = false;
2975         mp->ps->t1_synthetic = true;
2976         while (!(t1_charstrings () || t1_subrs ()))
2977             t1_getline (mp);
2978         goto FOUND;
2979     }
2980 }
2981
2982 @ @c
2983 static void t1_flush_cs (MP mp, boolean is_subr)
2984 {
2985     char *p;
2986     byte *r, *return_cs = NULL;
2987     cs_entry *tab, *end_tab, *ptr;
2988     char *start_line, *line_end;
2989     int count, size_pos;
2990     unsigned short cr, cs_len = 0; /* to avoid warning about uninitialized use of |cs_len| */
2991     if (is_subr) {
2992         start_line = mp->ps->subr_array_start;
2993         line_end =  mp->ps->subr_array_end;
2994         size_pos =  mp->ps->subr_size_pos;
2995         tab =  mp->ps->subr_tab;
2996         count =  mp->ps->subr_max + 1;
2997         end_tab =  mp->ps->subr_tab + count;
2998     } else {
2999         start_line =  mp->ps->cs_dict_start;
3000         line_end =  mp->ps->cs_dict_end;
3001         size_pos =  mp->ps->cs_size_pos;
3002         tab =  mp->ps->cs_tab;
3003         end_tab =  mp->ps->cs_ptr;
3004         count =  mp->ps->cs_count;
3005     }
3006     mp->ps->t1_line_ptr = mp->ps->t1_line_array;
3007     for (p = start_line; p - start_line < size_pos;)
3008         *mp->ps->t1_line_ptr++ = *p++;
3009     while (isdigit (*p))
3010         p++;
3011     sprintf (mp->ps->t1_line_ptr, "%u", count);
3012     strcat (mp->ps->t1_line_ptr, p);
3013     mp->ps->t1_line_ptr = eol (mp->ps->t1_line_array);
3014     t1_putline (mp);
3015
3016     /* create |return_cs| to replace unsused subr's */
3017     if (is_subr) {
3018         cr = 4330;
3019         cs_len = 0;
3020         return_cs = mp_xmalloc (mp, (mp->ps->t1_lenIV + 1) , sizeof(byte));
3021         if ( mp->ps->t1_lenIV > 0) {
3022             for (cs_len = 0, r = return_cs; cs_len <  mp->ps->t1_lenIV; cs_len++, r++)
3023                 *r = cencrypt (mp,0x00, &cr);
3024             *r = cencrypt (mp,CS_RETURN, &cr);
3025         } else {
3026             *return_cs = CS_RETURN;
3027         }
3028         cs_len++;
3029     }
3030
3031     for (ptr = tab; ptr < end_tab; ptr++) {
3032         if (ptr->is_used) {
3033             if (is_subr)
3034                 sprintf (mp->ps->t1_line_array, "dup %i %u", (int) (ptr - tab),
3035                          ptr->cslen);
3036             else
3037                 sprintf (mp->ps->t1_line_array, "/%s %u", ptr->glyph_name, ptr->cslen);
3038             p = strend (mp->ps->t1_line_array);
3039             memcpy (p, ptr->data, ptr->len);
3040             mp->ps->t1_line_ptr = p + ptr->len;
3041             t1_putline (mp);
3042         } else {
3043             /* replace unsused subr's by |return_cs| */
3044             if (is_subr) {
3045                 sprintf (mp->ps->t1_line_array, "dup %i %u%s ", (int) (ptr - tab),
3046                          cs_len,  mp->ps->cs_token_pair[0]);
3047                 p = strend (mp->ps->t1_line_array);
3048                 memcpy (p, return_cs, cs_len);
3049                 mp->ps->t1_line_ptr = p + cs_len;
3050                 t1_putline (mp);
3051                 sprintf (mp->ps->t1_line_array, " %s",  mp->ps->cs_token_pair[1]);
3052                 mp->ps->t1_line_ptr = eol (mp->ps->t1_line_array);
3053                 t1_putline (mp);
3054             }
3055         }
3056         mp_xfree (ptr->data);
3057         if (ptr->glyph_name != notdef)
3058             mp_xfree (ptr->glyph_name);
3059     }
3060     sprintf (mp->ps->t1_line_array, "%s", line_end);
3061     mp->ps->t1_line_ptr = eol (mp->ps->t1_line_array);
3062     t1_putline (mp);
3063     if (is_subr)
3064         mp_xfree (return_cs);
3065     mp_xfree (tab);
3066     mp_xfree (start_line);
3067     mp_xfree (line_end);
3068 }
3069
3070 static void t1_mark_glyphs (MP mp, int tex_font)
3071 {
3072     int i;
3073     char *charset = extra_charset ();
3074     char *g, *s, *r;
3075     cs_entry *ptr;
3076     if (mp->ps->t1_synthetic || embed_all_glyphs (tex_font)) {  /* mark everything */
3077         if (mp->ps->cs_tab != NULL)
3078             for (ptr = mp->ps->cs_tab; ptr < mp->ps->cs_ptr; ptr++)
3079                 if (ptr->valid)
3080                     ptr->is_used = true;
3081         if (mp->ps->subr_tab != NULL) {
3082             for (ptr = mp->ps->subr_tab; ptr - mp->ps->subr_tab < mp->ps->subr_size; ptr++)
3083                 if (ptr->valid)
3084                     ptr->is_used = true;
3085             mp->ps->subr_max = mp->ps->subr_size - 1;
3086         }
3087         return;
3088     }
3089     mark_cs (mp,notdef);
3090     for (i = 0; i < 256; i++)
3091         if (is_used_char (i)) {
3092             if (mp->ps->t1_glyph_names[i] == notdef) {
3093                 char s[128];
3094                 snprintf(s,128, "character %i is mapped to %s", i, notdef);
3095                 mp_warn(mp,s);
3096             } else
3097                 mark_cs (mp,mp->ps->t1_glyph_names[i]);
3098         }
3099     if (charset == NULL)
3100         goto SET_SUBR_MAX;
3101     g = s = charset + 1;        /* skip the first '/' */
3102     r = strend (g);
3103     while (g < r) {
3104         while (*s != '/' && s < r)
3105             s++;
3106         *s = 0;                 /* terminate g by rewriting '/' to 0 */
3107         mark_cs (mp,g);
3108         g = s + 1;
3109     }
3110   SET_SUBR_MAX:
3111     if (mp->ps->subr_tab != NULL)
3112         for (mp->ps->subr_max = -1, ptr = mp->ps->subr_tab;
3113                  ptr - mp->ps->subr_tab < mp->ps->subr_size;
3114              ptr++)
3115             if (ptr->is_used && ptr - mp->ps->subr_tab > mp->ps->subr_max)
3116                 mp->ps->subr_max = ptr - mp->ps->subr_tab;
3117 }
3118
3119 static void t1_subset_charstrings (MP mp, int tex_font)
3120 {
3121     cs_entry *ptr;
3122     mp->ps->cs_size_pos =
3123         strstr (mp->ps->t1_line_array, charstringname) + strlen (charstringname)
3124         - mp->ps->t1_line_array + 1;
3125     /* |cs_size_pos| points to the number indicating
3126        dict size after "/CharStrings" */
3127     mp->ps->cs_size = t1_scan_num (mp,mp->ps->t1_line_array + mp->ps->cs_size_pos, 0);
3128     mp->ps->cs_ptr = mp->ps->cs_tab = mp_xmalloc (mp,mp->ps->cs_size, sizeof(cs_entry));
3129     for (ptr = mp->ps->cs_tab; ptr - mp->ps->cs_tab < mp->ps->cs_size; ptr++)
3130         init_cs_entry (ptr);
3131     mp->ps->cs_notdef = NULL;
3132     mp->ps->cs_dict_start = mp_xstrdup (mp,mp->ps->t1_line_array);
3133     t1_getline (mp);
3134     while (mp->ps->t1_cslen) {
3135         store_cs (mp);
3136         t1_getline (mp);
3137     }
3138     mp->ps->cs_dict_end = mp_xstrdup (mp,mp->ps->t1_line_array);
3139     t1_mark_glyphs (mp,tex_font);
3140     if (mp->ps->subr_tab != NULL) {
3141         if (mp->ps->cs_token_pair == NULL)
3142             mp_fatal_error
3143                 (mp, "This Type 1 font uses mismatched subroutine begin/end token pairs.");
3144         t1_subr_flush (mp);
3145     }
3146     for (mp->ps->cs_count = 0, ptr = mp->ps->cs_tab; ptr < mp->ps->cs_ptr; ptr++)
3147         if (ptr->is_used)
3148             mp->ps->cs_count++;
3149     t1_cs_flush (mp);
3150 }
3151
3152 static void t1_subset_end (MP mp)
3153 {
3154     if (mp->ps->t1_synthetic) {         /* copy to "dup /FontName get exch definefont pop" */
3155         while (!strstr (mp->ps->t1_line_array, "definefont")) {
3156             t1_getline (mp);
3157             t1_putline (mp);
3158         }
3159         while (!t1_end_eexec ())
3160             t1_getline (mp);      /* ignore the rest */
3161         t1_putline (mp);          /* write "mark currentfile closefile" */
3162     } else
3163         while (!t1_end_eexec ()) {      /* copy to "mark currentfile closefile" */
3164             t1_getline (mp);
3165             t1_putline (mp);
3166         }
3167     t1_stop_eexec (mp);
3168     if (fixedcontent) {         /* copy 512 zeros (not needed for PDF) */
3169         while (!t1_cleartomark ()) {
3170             t1_getline (mp);
3171             t1_putline (mp);
3172         }
3173         if (!mp->ps->t1_synthetic)      /* don't check "{restore}if" for synthetic fonts */
3174             t1_check_end (mp);    /* write "{restore}if" if found */
3175     }
3176 }
3177
3178 static int t1_updatefm (MP mp, int f, fm_entry *fm)
3179 {
3180   char *s, *p;
3181   mp->ps->read_encoding_only = true;
3182   if (!t1_open_fontfile (mp,fm,NULL)) {
3183         return 0;
3184   }
3185   t1_scan_only (mp,f, fm);
3186   s = mp_xstrdup(mp,mp->ps->fontname_buf);
3187   p = s;
3188   while (*p != ' ' && *p != 0)
3189      p++;
3190   *p=0;
3191   fm->ps_name = s;
3192   t1_close_font_file (mp,"");
3193   return 1;
3194 }
3195
3196
3197 static void  writet1 (MP mp, int tex_font, fm_entry *fm_cur) {
3198         int save_selector = mp->selector;
3199     mp_normalize_selector(mp);
3200     mp->ps->read_encoding_only = false;
3201     if (!is_included (fm_cur)) {        /* scan parameters from font file */
3202       if (!t1_open_fontfile (mp,fm_cur,"{"))
3203             return;
3204             t1_scan_only (mp,tex_font, fm_cur);
3205         t1_close_font_file (mp,"}");
3206         return;
3207     }
3208     if (!is_subsetted (fm_cur)) {       /* include entire font */
3209       if (!t1_open_fontfile (mp,fm_cur,"<<"))
3210             return;
3211           t1_include (mp,tex_font,fm_cur);
3212         t1_close_font_file (mp,">>");
3213         return;
3214     }
3215     /* partial downloading */
3216     if (!t1_open_fontfile (mp,fm_cur,"<"))
3217         return;
3218     t1_subset_ascii_part (mp,tex_font,fm_cur);
3219     t1_start_eexec (mp,fm_cur);
3220     cc_init ();
3221     cs_init (mp);
3222     t1_read_subrs (mp,tex_font, fm_cur);
3223     t1_subset_charstrings (mp,tex_font);
3224     t1_subset_end (mp);
3225     t1_close_font_file (mp,">");
3226     mp->selector = save_selector;
3227 }
3228
3229 @ @<Declarations@>=
3230 static void t1_free (MP mp);
3231
3232 @ @c
3233 static void  t1_free (MP mp) {
3234   mp_xfree (mp->ps->t1_line_array);
3235   mp_xfree (mp->ps->t1_buf_array);
3236 }
3237
3238
3239 @* \[44d] Embedding fonts.
3240
3241 @ The |tfm_num| is officially of type |font_number|, but that
3242 type does not exist yet at this point in the output order.
3243
3244 @<Types...@>=
3245 typedef struct {
3246     char *tfm_name;             /* TFM file name */
3247     char *ps_name;              /* PostScript name */
3248     integer flags;              /* font flags */
3249     char *ff_name;              /* font file name */
3250     char *subset_tag;           /* pseudoUniqueTag for subsetted font */
3251     enc_entry *encoding;        /* pointer to corresponding encoding */
3252     unsigned int tfm_num;       /* number of the TFM refering this entry */
3253     unsigned short type;        /* font type (T1/TTF/...) */
3254     short slant;                /* SlantFont */
3255     short extend;               /* ExtendFont */
3256     integer ff_objnum;          /* FontFile object number */
3257     integer fn_objnum;          /* FontName/BaseName object number */
3258     integer fd_objnum;          /* FontDescriptor object number */
3259     char *charset;              /* string containing used glyphs */
3260     boolean all_glyphs;         /* embed all glyphs? */
3261     unsigned short links;       /* link flags from |tfm_tree| and |ps_tree| */
3262     short tfm_avail;            /* flags whether a tfm is available */
3263     short pid;                  /* Pid for truetype fonts */
3264     short eid;                  /* Eid for truetype fonts */
3265 } fm_entry;
3266
3267
3268 @
3269 @<Glob...@>=
3270 #define FONTNAME_BUF_SIZE 128
3271 boolean fontfile_found;
3272 boolean is_otf_font;
3273 char fontname_buf[FONTNAME_BUF_SIZE];
3274
3275 @
3276 @d F_INCLUDED          0x01
3277 @d F_SUBSETTED         0x02
3278 @d F_TRUETYPE          0x04
3279 @d F_BASEFONT          0x08
3280
3281 @d set_included(fm)    ((fm)->type |= F_INCLUDED)
3282 @d set_subsetted(fm)   ((fm)->type |= F_SUBSETTED)
3283 @d set_truetype(fm)    ((fm)->type |= F_TRUETYPE)
3284 @d set_basefont(fm)    ((fm)->type |= F_BASEFONT)
3285
3286 @d is_included(fm)     ((fm)->type & F_INCLUDED)
3287 @d is_subsetted(fm)    ((fm)->type & F_SUBSETTED)
3288 @d is_truetype(fm)     ((fm)->type & F_TRUETYPE)
3289 @d is_basefont(fm)     ((fm)->type & F_BASEFONT)
3290 @d is_reencoded(fm)    ((fm)->encoding != NULL)
3291 @d is_fontfile(fm)     (fm_fontfile(fm) != NULL)
3292 @d is_t1fontfile(fm)   (is_fontfile(fm) && !is_truetype(fm))
3293
3294 @d fm_slant(fm)        (fm)->slant
3295 @d fm_extend(fm)       (fm)->extend
3296 @d fm_fontfile(fm)     (fm)->ff_name
3297
3298 @<Declarations@>=
3299 static boolean mp_font_is_reencoded (MP mp, int f);
3300 static boolean mp_font_is_included (MP mp, int f);
3301 static boolean mp_font_is_subsetted (MP mp, int f);
3302
3303 @ @c
3304 static boolean mp_font_is_reencoded (MP mp, int f) {
3305   fm_entry *fm;
3306   if (mp_has_font_size(mp,f) && mp_has_fm_entry (mp, f, &fm)) {
3307     if (fm != NULL
3308         && (fm->ps_name != NULL)
3309         && is_reencoded (fm))
3310       return 1;
3311   }
3312   return 0;
3313 }
3314 static boolean mp_font_is_included (MP mp, int f) {
3315   fm_entry *fm;
3316   if (mp_has_font_size(mp,f) && mp_has_fm_entry (mp, f, &fm)) {
3317     if (fm != NULL
3318         && (fm->ps_name != NULL && fm->ff_name != NULL)
3319         && is_included (fm))
3320       return 1;
3321   }
3322   return 0;
3323 }
3324 static boolean mp_font_is_subsetted (MP mp, int f) {
3325   fm_entry *fm;
3326   if (mp_has_font_size(mp,f) && mp_has_fm_entry (mp, f,&fm)) {
3327     if (fm != NULL
3328           && (fm->ps_name != NULL && fm->ff_name != NULL)
3329           && is_included (fm) && is_subsetted (fm))
3330       return 1;
3331   }
3332   return 0;
3333 }
3334
3335 @ @<Exported function headers@>=
3336 char * mp_fm_encoding_name (MP mp, int f);
3337 char * mp_fm_font_name (MP mp, int f);
3338
3339 @ @<Declarations@>=
3340 static char * mp_fm_font_subset_name (MP mp, int f);
3341
3342 @
3343 @c char * mp_fm_encoding_name (MP mp, int f) {
3344   enc_entry *e;
3345   fm_entry *fm;
3346   if (mp_has_fm_entry (mp, f, &fm)) {
3347     if (fm != NULL && (fm->ps_name != NULL)) {
3348       if (is_reencoded (fm)) {
3349             e = fm->encoding;
3350         if (e->enc_name!=NULL)
3351           return mp_xstrdup(mp,e->enc_name);
3352       } else {
3353             return NULL;
3354       }
3355     }
3356   }
3357   print_err ("fontmap encoding problems for font ");
3358   mp_print(mp,mp->font_name[f]);
3359   mp_error(mp);
3360   return NULL;
3361 }
3362 char * mp_fm_font_name (MP mp, int f) {
3363   fm_entry *fm;
3364   if (mp_has_fm_entry (mp, f,&fm)) {
3365     if (fm != NULL && (fm->ps_name != NULL)) {
3366       if (mp_font_is_included(mp, f) && !mp->font_ps_name_fixed[f]) {
3367         /* find the real fontname, and update |ps_name| and |subset_tag| if needed */
3368         if (t1_updatefm(mp,f,fm)) {
3369           mp->font_ps_name_fixed[f] = true;
3370         } else {
3371           print_err ("font loading problems for font ");
3372           mp_print(mp,mp->font_name[f]);
3373           mp_error(mp);
3374         }
3375       }
3376       return mp_xstrdup(mp,fm->ps_name);
3377     }
3378   }
3379   print_err ("fontmap name problems for font ");
3380   mp_print(mp,mp->font_name[f]);
3381   mp_error(mp);
3382   return NULL;
3383 }
3384
3385 static char * mp_fm_font_subset_name (MP mp, int f) {
3386   fm_entry *fm;
3387   if (mp_has_fm_entry (mp, f, &fm)) {
3388     if (fm != NULL && (fm->ps_name != NULL)) {
3389       if (is_subsetted(fm)) {
3390             char *s = mp_xmalloc(mp,strlen(fm->ps_name)+8,1);
3391         snprintf(s,strlen(fm->ps_name)+8,"%s-%s",fm->subset_tag,fm->ps_name);
3392             return s;
3393       } else {
3394         return mp_xstrdup(mp,fm->ps_name);
3395       }
3396     }
3397   }
3398   print_err ("fontmap name problems for font ");
3399   mp_print(mp,mp->font_name[f]);
3400   mp_error(mp);
3401   return NULL;
3402 }
3403
3404 @ @<Declarations@>=
3405 static integer mp_fm_font_slant (MP mp, int f);
3406 static integer mp_fm_font_extend (MP mp, int f);
3407
3408 @
3409 @c static integer mp_fm_font_slant (MP mp, int f) {
3410   fm_entry *fm;
3411   if (mp_has_fm_entry (mp, f, &fm)) {
3412     if (fm != NULL && (fm->ps_name != NULL)) {
3413       return fm->slant;
3414     }
3415   }
3416   return 0;
3417 }
3418 static integer mp_fm_font_extend (MP mp, int f) {
3419   fm_entry *fm;
3420   if (mp_has_fm_entry (mp, f, &fm)) {
3421     if (fm != NULL && (fm->ps_name != NULL)) {
3422       return fm->extend;
3423     }
3424   }
3425   return 0;
3426 }
3427
3428 @ @<Declarations@>=
3429 static boolean mp_do_ps_font (MP mp, font_number f);
3430
3431 @ @c static boolean mp_do_ps_font (MP mp, font_number f) {
3432   fm_entry *fm_cur;
3433   (void)mp_has_fm_entry (mp, f, &fm_cur); /* for side effects */
3434   if (fm_cur == NULL)
3435     return 1;
3436   if (is_truetype(fm_cur) ||
3437          (fm_cur->ps_name == NULL && fm_cur->ff_name == NULL)) {
3438     return 0;
3439   }
3440   if (is_included(fm_cur)) {
3441     mp_ps_print_nl(mp,"%%BeginResource: font ");
3442     if (is_subsetted(fm_cur)) {
3443       mp_ps_print(mp, fm_cur->subset_tag);
3444       mp_ps_print_char(mp,'-');
3445     }
3446     mp_ps_print(mp, fm_cur->ps_name);
3447     mp_ps_print_ln(mp);
3448     writet1 (mp,f,fm_cur);
3449     mp_ps_print_nl(mp,"%%EndResource");
3450     mp_ps_print_ln(mp);
3451   }
3452   return 1;
3453 }
3454
3455 @ Included subset fonts do not need and encoding vector, make
3456 sure we skip that case.
3457
3458 @<Declarations@>=
3459 static void mp_list_used_resources (MP mp);
3460
3461 @ @c static void mp_list_used_resources (MP mp) {
3462   font_number f; /* fonts used in a text node or as loop counters */
3463   int ff;  /* a loop counter */
3464   font_number ldf; /* the last \.{DocumentFont} listed (otherwise |null_font|) */
3465   boolean firstitem;
3466   int prologues = (mp->internal[mp_prologues]>>16);
3467   int procset = (mp->internal[mp_procset]>>16);
3468
3469   if ( procset>0 )
3470     mp_ps_print_nl(mp, "%%DocumentResources: procset mpost");
3471   else
3472     mp_ps_print_nl(mp, "%%DocumentResources: procset mpost-minimal");
3473   ldf=null_font;
3474   firstitem=true;
3475   for (f=null_font+1;f<=mp->last_fnum;f++) {
3476     if ( (mp_has_font_size(mp,f))&&(mp_font_is_reencoded(mp,f)) ) {
3477           for (ff=ldf;ff>=null_font;ff--) {
3478         if ( mp_has_font_size(mp,ff) )
3479           if ( mp_xstrcmp(mp->font_enc_name[f],mp->font_enc_name[ff])==0 )
3480             goto FOUND;
3481       }
3482       if ( mp_font_is_subsetted(mp,f) )
3483         goto FOUND;
3484       if ( mp->ps->ps_offset+1+strlen(mp->font_enc_name[f])>
3485            (unsigned)mp->max_print_line )
3486         mp_ps_print_nl(mp, "%%+ encoding");
3487       if ( firstitem ) {
3488         firstitem=false;
3489         mp_ps_print_nl(mp, "%%+ encoding");
3490       }
3491       mp_ps_print_char(mp, ' ');
3492       mp_ps_print(mp, mp->font_enc_name[f]);
3493       ldf=f;
3494     }
3495   FOUND:
3496     ;
3497   }
3498   ldf=null_font;
3499   firstitem=true;
3500   for (f=null_font+1;f<=mp->last_fnum;f++) {
3501     if ( mp_has_font_size(mp,f) ) {
3502       for (ff=ldf;ff>=null_font;ff--) {
3503         if ( mp_has_font_size(mp,ff) )
3504           if ( mp_xstrcmp(mp->font_name[f],mp->font_name[ff])==0 )
3505             goto FOUND2;
3506       }
3507       if ( mp->ps->ps_offset+1+strlen(mp->font_ps_name[f])>
3508                (unsigned)mp->max_print_line )
3509         mp_ps_print_nl(mp, "%%+ font");
3510       if ( firstitem ) {
3511         firstitem=false;
3512         mp_ps_print_nl(mp, "%%+ font");
3513       }
3514       mp_ps_print_char(mp, ' ');
3515           if ( (prologues==3)&&
3516            (mp_font_is_subsetted(mp,f)) )
3517         mp_ps_print(mp, mp_fm_font_subset_name(mp,f));
3518       else
3519         mp_ps_print(mp, mp->font_ps_name[f]);
3520       ldf=f;
3521     }
3522   FOUND2:
3523     ;
3524   }
3525   mp_ps_print_ln(mp);
3526 }
3527
3528 @ @<Declarations@>=
3529 static void mp_list_supplied_resources (MP mp);
3530
3531 @ @c static void mp_list_supplied_resources (MP mp) {
3532   font_number f; /* fonts used in a text node or as loop counters */
3533   int ff; /* a loop counter */
3534   font_number ldf; /* the last \.{DocumentFont} listed (otherwise |null_font|) */
3535   boolean firstitem;
3536   int prologues = (mp->internal[mp_prologues]>>16);
3537   int procset = (mp->internal[mp_procset]>>16);
3538   if ( procset>0 )
3539     mp_ps_print_nl(mp, "%%DocumentSuppliedResources: procset mpost");
3540   else
3541     mp_ps_print_nl(mp, "%%DocumentSuppliedResources: procset mpost-minimal");
3542   ldf=null_font;
3543   firstitem=true;
3544   for (f=null_font+1;f<=mp->last_fnum;f++) {
3545     if ( (mp_has_font_size(mp,f))&&(mp_font_is_reencoded(mp,f)) )  {
3546        for (ff=ldf;ff>= null_font;ff++) {
3547          if ( mp_has_font_size(mp,ff) )
3548            if ( mp_xstrcmp(mp->font_enc_name[f],mp->font_enc_name[ff])==0 )
3549              goto FOUND;
3550         }
3551       if ( (prologues==3)&&(mp_font_is_subsetted(mp,f)))
3552         goto FOUND;
3553       if ( mp->ps->ps_offset+1+strlen(mp->font_enc_name[f])>(unsigned)mp->max_print_line )
3554         mp_ps_print_nl(mp, "%%+ encoding");
3555       if ( firstitem ) {
3556         firstitem=false;
3557         mp_ps_print_nl(mp, "%%+ encoding");
3558       }
3559       mp_ps_print_char(mp, ' ');
3560       mp_ps_print(mp, mp->font_enc_name[f]);
3561       ldf=f;
3562     }
3563   FOUND:
3564     ;
3565   }
3566   ldf=null_font;
3567   firstitem=true;
3568   if (prologues==3) {
3569     for (f=null_font+1;f<=mp->last_fnum;f++) {
3570       if ( mp_has_font_size(mp,f) ) {
3571         for (ff=ldf;ff>= null_font;ff--) {
3572           if ( mp_has_font_size(mp,ff) )
3573             if ( mp_xstrcmp(mp->font_name[f],mp->font_name[ff])==0 )
3574                goto FOUND2;
3575         }
3576         if ( ! mp_font_is_included(mp,f) )
3577           goto FOUND2;
3578         if ( mp->ps->ps_offset+1+strlen(mp->font_ps_name[f])>(unsigned)mp->max_print_line )
3579           mp_ps_print_nl(mp, "%%+ font");
3580         if ( firstitem ) {
3581           firstitem=false;
3582           mp_ps_print_nl(mp, "%%+ font");
3583         }
3584         mp_ps_print_char(mp, ' ');
3585             if ( mp_font_is_subsetted(mp,f) )
3586           mp_ps_print(mp, mp_fm_font_subset_name(mp,f));
3587         else
3588           mp_ps_print(mp, mp->font_ps_name[f]);
3589         ldf=f;
3590       }
3591     FOUND2:
3592       ;
3593     }
3594     mp_ps_print_ln(mp);
3595   }
3596 }
3597
3598 @ @<Declarations...@>=
3599 static void mp_list_needed_resources (MP mp);
3600
3601 @ @c static void mp_list_needed_resources (MP mp) {
3602   font_number f; /* fonts used in a text node or as loop counters */
3603   int ff; /* a loop counter */
3604   font_number ldf; /* the last \.{DocumentFont} listed (otherwise |null_font|) */
3605   boolean firstitem;
3606   int prologues = (mp->internal[mp_prologues]>>16);
3607   ldf=null_font;
3608   firstitem=true;
3609   for (f=null_font+1;f<=mp->last_fnum;f++ ) {
3610     if ( mp_has_font_size(mp,f)) {
3611       for (ff=ldf;ff>=null_font;ff--) {
3612         if ( mp_has_font_size(mp,ff) )
3613           if ( mp_xstrcmp(mp->font_name[f],mp->font_name[ff])==0 )
3614              goto FOUND;
3615       };
3616       if ((prologues==3)&&(mp_font_is_included(mp,f)) )
3617         goto FOUND;
3618       if ( mp->ps->ps_offset+1+strlen(mp->font_ps_name[f])>(unsigned)mp->max_print_line )
3619         mp_ps_print_nl(mp, "%%+ font");
3620       if ( firstitem ) {
3621         firstitem=false;
3622         mp_ps_print_nl(mp, "%%DocumentNeededResources: font");
3623       }
3624       mp_ps_print_char(mp, ' ');
3625       mp_ps_print(mp, mp->font_ps_name[f]);
3626       ldf=f;
3627     }
3628   FOUND:
3629     ;
3630   }
3631   if ( ! firstitem ) {
3632     mp_ps_print_ln(mp);
3633     ldf=null_font;
3634     firstitem=true;
3635     for (f=null_font+1;f<= mp->last_fnum;f++) {
3636       if ( mp_has_font_size(mp,f) ) {
3637         for (ff=ldf;ff>=null_font;ff-- ) {
3638           if ( mp_has_font_size(mp,ff) )
3639             if ( mp_xstrcmp(mp->font_name[f],mp->font_name[ff])==0 )
3640               goto FOUND2;
3641         }
3642         if ((prologues==3)&&(mp_font_is_included(mp,f)) )
3643           goto FOUND2;
3644         mp_ps_print(mp, "%%IncludeResource: font ");
3645         mp_ps_print(mp, mp->font_ps_name[f]);
3646         mp_ps_print_ln(mp);
3647         ldf=f;
3648       }
3649     FOUND2:
3650       ;
3651     }
3652   }
3653 }
3654
3655 @ @<Declarations@>=
3656 static void mp_write_font_definition (MP mp, font_number f);
3657
3658 @
3659
3660 @d applied_reencoding(A) ((mp_font_is_reencoded(mp,(A)))&&
3661     ((! mp_font_is_subsetted(mp,(A)))||(prologues==2)))
3662
3663 @c static void mp_write_font_definition(MP mp, font_number f) {
3664   int prologues = (mp->internal[mp_prologues]>>16);
3665   if ( (applied_reencoding(f))||(mp_fm_font_slant(mp,f)!=0)||
3666        (mp_fm_font_extend(mp,f)!=0)||
3667        (mp_xstrcmp(mp->font_name[f],"psyrgo")==0)||
3668        (mp_xstrcmp(mp->font_name[f],"zpzdr-reversed")==0) ) {
3669     if ( (mp_font_is_subsetted(mp,f))&&
3670          (mp_font_is_included(mp,f))&&(prologues==3))
3671       mp_ps_name_out(mp, mp_fm_font_subset_name(mp,f),true);
3672     else
3673       mp_ps_name_out(mp, mp->font_ps_name[f],true);
3674     mp_ps_print(mp, " fcp");
3675     mp_ps_print_ln(mp);
3676     if ( applied_reencoding(f) ) {
3677       mp_ps_print(mp, "/Encoding ");
3678       mp_ps_print(mp, mp->font_enc_name[f]);
3679       mp_ps_print(mp, " def ");
3680     };
3681     if ( mp_fm_font_slant(mp,f)!=0 ) {
3682       mp_ps_print_int(mp, mp_fm_font_slant(mp,f));
3683       mp_ps_print(mp, " SlantFont ");
3684     };
3685     if ( mp_fm_font_extend(mp,f)!=0 ) {
3686       mp_ps_print_int(mp, mp_fm_font_extend(mp,f));
3687       mp_ps_print(mp, " ExtendFont ");
3688     };
3689     if ( mp_xstrcmp(mp->font_name[f],"psyrgo")==0 ) {
3690       mp_ps_print(mp, " 890 ScaleFont ");
3691       mp_ps_print(mp, " 277 SlantFont ");
3692     };
3693     if ( mp_xstrcmp(mp->font_name[f],"zpzdr-reversed")==0 ) {
3694       mp_ps_print(mp, " FontMatrix [-1 0 0 1 0 0] matrix concatmatrix /FontMatrix exch def ");
3695       mp_ps_print(mp, "/Metrics 2 dict dup begin ");
3696       mp_ps_print(mp, "/space[0 -278]def ");
3697       mp_ps_print(mp, "/a12[-904 -939]def ");
3698       mp_ps_print(mp, "end def ");
3699     };
3700     mp_ps_print(mp, "currentdict end");
3701     mp_ps_print_ln(mp);
3702     mp_ps_print_defined_name(mp,f);
3703     mp_ps_print(mp, " exch definefont pop");
3704     mp_ps_print_ln(mp);
3705   }
3706 }
3707
3708 @ @<Declarations@>=
3709 static void mp_ps_print_defined_name (MP mp, font_number f);
3710
3711 @
3712 @c static void mp_ps_print_defined_name(MP mp, font_number A) {
3713   int prologues = (mp->internal[mp_prologues]>>16);
3714   mp_ps_print(mp, " /");
3715   if ((mp_font_is_subsetted(mp,(A)))&&
3716       (mp_font_is_included(mp,(A)))&&(prologues==3))
3717     mp_ps_print(mp, mp_fm_font_subset_name(mp,(A)));
3718   else
3719     mp_ps_print(mp, mp->font_ps_name[(A)]);
3720   if ( mp_xstrcmp(mp->font_name[(A)],"psyrgo")==0 )
3721     mp_ps_print(mp, "-Slanted");
3722   if ( mp_xstrcmp(mp->font_name[(A)],"zpzdr-reversed")==0 )
3723     mp_ps_print(mp, "-Reverse");
3724   if ( applied_reencoding((A)) ) {
3725     mp_ps_print(mp, "-");
3726     mp_ps_print(mp, mp->font_enc_name[(A)]);
3727   }
3728   if ( mp_fm_font_slant(mp,(A))!=0 ) {
3729     mp_ps_print(mp, "-Slant_"); mp_ps_print_int(mp, mp_fm_font_slant(mp,(A))) ;
3730   }
3731   if ( mp_fm_font_extend(mp,(A))!=0 ) {
3732     mp_ps_print(mp, "-Extend_"); mp_ps_print_int(mp, mp_fm_font_extend(mp,(A)));
3733   }
3734 }
3735
3736 @ @<Include encodings and fonts for edge structure~|h|@>=
3737 mp_font_encodings(mp,mp->last_fnum,prologues==2);
3738 @<Embed fonts that are available@>
3739
3740 @ @<Embed fonts that are available@>=
3741 {
3742 next_size=0;
3743 @<Make |cur_fsize| a copy of the |font_sizes| array@>;
3744 do {
3745   done_fonts=true;
3746   for (f=null_font+1;f<=mp->last_fnum;f++) {
3747     if ( cur_fsize[f]!=null ) {
3748       if (prologues==3 ) {
3749         if ( ! mp_do_ps_font(mp,f) ) {
3750               if ( mp_has_fm_entry(mp,f, NULL) ) {
3751             print_err("Font embedding failed");
3752             mp_error(mp);
3753           }
3754         }
3755       }
3756       cur_fsize[f]=link(cur_fsize[f]);
3757       if ( cur_fsize[f]!=null ) { mp_unmark_font(mp, f); done_fonts=false; }
3758     }
3759   }
3760   if ( ! done_fonts )
3761     @<Increment |next_size| and apply |mark_string_chars| to all text nodes with
3762       that size index@>;
3763 } while (! done_fonts);
3764 }
3765
3766 @ @<Increment |next_size| and apply |mark_string_chars| to all text nodes...@>=
3767 {
3768   next_size++;
3769   mp_apply_mark_string_chars(mp, h, next_size);
3770 }
3771
3772 @ We also need to keep track of which characters are used in text nodes
3773 in the edge structure that is being shipped out.  This is done by procedures
3774 that use the left-over |b3| field in the |char_info| words; i.e.,
3775 |char_info(f)(c).b3| gives the status of character |c| in font |f|.
3776
3777 @<Types...@>=
3778 enum mp_char_mark_state {mp_unused=0, mp_used};
3779
3780 @ @<Exported...@>=
3781 void mp_mark_string_chars (MP mp,font_number f, char *s) ;
3782
3783 @ @c
3784 void mp_mark_string_chars (MP mp,font_number f, char *s) {
3785   integer b; /* |char_base[f]| */
3786   ASCII_code bc,ec; /* only characters between these bounds are marked */
3787   char *k; /* an index into string |s| */
3788   b=mp->char_base[f];
3789   bc=mp->font_bc[f];
3790   ec=mp->font_ec[f];
3791   k=s; /* str_stop */
3792   while (*k){
3793     if ( (*k>=bc)&&(*k<=ec) )
3794       mp->font_info[b+*k].qqqq.b3=mp_used;
3795     k++;
3796   }
3797 }
3798
3799
3800 @ @<Exported ...@>=
3801 void mp_unmark_font (MP mp,font_number f) ;
3802
3803 @ @c
3804 void mp_unmark_font (MP mp,font_number f) {
3805   int k; /* an index into |font_info| */
3806   for (k= mp->char_base[f]+mp->font_bc[f];
3807        k<=mp->char_base[f]+mp->font_ec[f];
3808        k++)
3809     mp->font_info[k].qqqq.b3=mp_unused;
3810 }
3811
3812
3813 @ @<Exported...@>=
3814 void mp_print_improved_prologue (MP mp, struct mp_edge_object *h) ;
3815
3816
3817 @
3818 @c
3819 void mp_print_improved_prologue (MP mp, struct mp_edge_object *h) {
3820   quarterword next_size; /* the size index for fonts being listed */
3821   pointer *cur_fsize; /* current positions in |font_sizes| */
3822   boolean done_fonts; /* have we finished listing the fonts in the header? */
3823   font_number f; /* a font number for loops */
3824
3825   int prologues = (mp->internal[mp_prologues]>>16);
3826   int procset = (mp->internal[mp_procset]>>16);
3827   int groffmode = (mp->internal[mp_gtroffmode]>>16);
3828
3829   cur_fsize = mp_xmalloc(mp,(mp->font_max+1),sizeof(pointer));
3830
3831   mp_list_used_resources(mp);
3832   mp_list_supplied_resources(mp);
3833   mp_list_needed_resources(mp);
3834   mp_ps_print_nl(mp, "%%EndComments");
3835   mp_ps_print_nl(mp, "%%BeginProlog");
3836   if ( procset>0 )
3837     mp_ps_print_nl(mp, "%%BeginResource: procset mpost");
3838   else
3839     mp_ps_print_nl(mp, "%%BeginResource: procset mpost-minimal");
3840   mp_ps_print_nl(mp, "/bd{bind def}bind def"
3841                   "/fshow {exch findfont exch scalefont setfont show}bd");
3842   if ( procset>0 ) @<Print the procset@>;
3843   mp_ps_print_nl(mp, "/fcp{findfont dup length dict begin"
3844                   "{1 index/FID ne{def}{pop pop}ifelse}forall}bd");
3845   mp_ps_print_nl(mp, "/fmc{FontMatrix dup length array copy dup dup}bd"
3846                    "/fmd{/FontMatrix exch def}bd");
3847   mp_ps_print_nl(mp, "/Amul{4 -1 roll exch mul 1000 div}bd"
3848                   "/ExtendFont{fmc 0 get Amul 0 exch put fmd}bd");
3849   if ( groffmode>0 ) {
3850     mp_ps_print_nl(mp, "/ScaleFont{dup fmc 0 get"
3851                         " Amul 0 exch put dup dup 3 get Amul 3 exch put fmd}bd");
3852     };
3853   mp_ps_print_nl(mp, "/SlantFont{fmc 2 get dup 0 eq{pop 1}if"
3854                       " Amul FontMatrix 0 get mul 2 exch put fmd}bd");
3855   mp_ps_print_nl(mp, "%%EndResource");
3856   @<Include encodings and fonts  for edge structure~|h|@>;
3857   mp_ps_print_nl(mp, "%%EndProlog");
3858   mp_ps_print_nl(mp, "%%BeginSetup");
3859   mp_ps_print_ln(mp);
3860   for (f=null_font+1;f<=mp->last_fnum;f++) {
3861     if ( mp_has_font_size(mp,f) ) {
3862       if ( mp_has_fm_entry(mp,f,NULL) ) {
3863         mp_write_font_definition(mp,f);
3864         mp_ps_name_out(mp, mp->font_name[f],true);
3865         mp_ps_print_defined_name(mp,f);
3866         mp_ps_print(mp, " def");
3867       } else {
3868         char s[256];
3869         snprintf(s,256,"font %s cannot be found in any fontmapfile!", mp->font_name[f]);
3870         mp_warn(mp,s);
3871         mp_ps_name_out(mp, mp->font_name[f],true);
3872         mp_ps_name_out(mp, mp->font_name[f],true);
3873         mp_ps_print(mp, " def");
3874       }
3875       mp_ps_print_ln(mp);
3876     }
3877   }
3878   mp_ps_print_nl(mp, "%%EndSetup");
3879   mp_ps_print_nl(mp, "%%Page: 1 1");
3880   mp_ps_print_ln(mp);
3881   mp_xfree(cur_fsize);
3882 }
3883
3884 @ @<Declarations@>=
3885 static font_number mp_print_font_comments (MP mp , struct mp_edge_object *h);
3886
3887
3888 @
3889 @c
3890 static font_number mp_print_font_comments (MP mp , struct mp_edge_object *h) {
3891   quarterword next_size; /* the size index for fonts being listed */
3892   pointer *cur_fsize; /* current positions in |font_sizes| */
3893   int ff; /* a loop counter */
3894   boolean done_fonts; /* have we finished listing the fonts in the header? */
3895   font_number f; /* a font number for loops */
3896   scaled ds; /* design size and scale factor for a text node */
3897   font_number ldf=0; /* the last \.{DocumentFont} listed (otherwise |null_font|) */
3898   int prologues = (mp->internal[mp_prologues]>>16);
3899   cur_fsize = mp_xmalloc(mp,(mp->font_max+1),sizeof(pointer));
3900   if ( prologues>0 ) {
3901     @<Give a \.{DocumentFonts} comment listing all fonts with non-null
3902       |font_sizes| and eliminate duplicates@>;
3903   } else {
3904     next_size=0;
3905     @<Make |cur_fsize| a copy of the |font_sizes| array@>;
3906     do {  done_fonts=true;
3907       for (f=null_font+1;f<=mp->last_fnum;f++) {
3908         if ( cur_fsize[f]!=null ) {
3909           @<Print the \.{\%*Font} comment for font |f| and advance |cur_fsize[f]|@>;
3910         }
3911         if ( cur_fsize[f]!=null ) { mp_unmark_font(mp, f); done_fonts=false;  };
3912       }
3913       if ( ! done_fonts ) {
3914         @<Increment |next_size| and apply |mark_string_chars| to all text nodes with
3915           that size index@>;
3916       }
3917     } while (! done_fonts);
3918   }
3919   mp_xfree(cur_fsize);
3920   return ldf;
3921 }
3922
3923 @ @<Make |cur_fsize| a copy of the |font_sizes| array@>=
3924 for (f=null_font+1;f<= mp->last_fnum;f++)
3925   cur_fsize[f]=mp->font_sizes[f]
3926
3927 @ It's not a good idea to make any assumptions about the |font_ps_name| entries,
3928 so we carefully remove duplicates.  There is no harm in using a slow, brute-force
3929 search.
3930
3931 @<Give a \.{DocumentFonts} comment listing all fonts with non-null...@>=
3932 {
3933   ldf=null_font;
3934   for (f=null_font+1;f<= mp->last_fnum;f++) {
3935     if ( mp->font_sizes[f]!=null ) {
3936       if ( ldf==null_font )
3937         mp_ps_print_nl(mp, "%%DocumentFonts:");
3938       for (ff=ldf;ff>=null_font;ff--) {
3939         if ( mp->font_sizes[ff]!=null )
3940           if ( mp_xstrcmp(mp->font_ps_name[f],mp->font_ps_name[ff])==0 )
3941             goto FOUND;
3942       }
3943       if ( mp->ps->ps_offset+1+strlen(mp->font_ps_name[f])>(unsigned)mp->max_print_line )
3944         mp_ps_print_nl(mp, "%%+");
3945       mp_ps_print_char(mp, ' ');
3946       mp_ps_print(mp, mp->font_ps_name[f]);
3947       ldf=f;
3948     FOUND:
3949       ;
3950     }
3951   }
3952 }
3953
3954 @ @c
3955 static void mp_hex_digit_out (MP mp,small_number d) {
3956   if ( d<10 ) mp_ps_print_char(mp, d+'0');
3957   else mp_ps_print_char(mp, d+'a'-10);
3958 }
3959
3960 @ We output the marks as a hexadecimal bit string starting at |c| or
3961 |font_bc[f]|, whichever is greater.  If the output has to be truncated
3962 to avoid exceeding |emergency_line_length| the return value says where to
3963 start scanning next time.
3964
3965 @<Declarations@>=
3966 static halfword mp_ps_marks_out (MP mp,font_number f, eight_bits c);
3967
3968 @
3969 @d emergency_line_length 255
3970   /* \ps\ output lines can be this long in unusual circumstances */
3971
3972 @c
3973 static halfword mp_ps_marks_out (MP mp,font_number f, eight_bits c) {
3974   eight_bits bc,ec; /* only encode characters between these bounds */
3975   integer lim; /* the maximum number of marks to encode before truncating */
3976   int p; /* |font_info| index for the current character */
3977   int d,b; /* used to construct a hexadecimal digit */
3978   lim=4*(emergency_line_length-mp->ps->ps_offset-4);
3979   bc=mp->font_bc[f];
3980   ec=mp->font_ec[f];
3981   if ( c>bc ) bc=c;
3982   @<Restrict the range |bc..ec| so that it contains no unused characters
3983     at either end and has length at most |lim|@>;
3984   @<Print the initial label indicating that the bitmap starts at |bc|@>;
3985   @<Print a hexadecimal encoding of the marks for characters |bc..ec|@>;
3986   while ( (ec<mp->font_ec[f])&&(mp->font_info[p].qqqq.b3==mp_unused) ) {
3987     p++; ec++;
3988   }
3989   return (ec+1);
3990 }
3991
3992 @ We could save time by setting the return value before the loop that
3993 decrements |ec|, but there is no point in being so tricky.
3994
3995 @<Restrict the range |bc..ec| so that it contains no unused characters...@>=
3996 p=mp->char_base[f]+bc;
3997 while ( (mp->font_info[p].qqqq.b3==mp_unused)&&(bc<ec) ) {
3998   p++; bc++;
3999 }
4000 if ( ec>=bc+lim ) ec=bc+lim-1;
4001 p=mp->char_base[f]+ec;
4002 while ( (mp->font_info[p].qqqq.b3==mp_unused)&&(bc<ec) ) {
4003   p--; ec--;
4004 }
4005
4006 @ @<Print the initial label indicating that the bitmap starts at |bc|@>=
4007 mp_ps_print_char(mp, ' ');
4008 mp_hex_digit_out(mp, bc / 16);
4009 mp_hex_digit_out(mp, bc % 16);
4010 mp_ps_print_char(mp, ':')
4011
4012 @
4013
4014 @<Print a hexadecimal encoding of the marks for characters |bc..ec|@>=
4015 b=8; d=0;
4016 for (p=mp->char_base[f]+bc;p<=mp->char_base[f]+ec;p++) {
4017   if ( b==0 ) {
4018     mp_hex_digit_out(mp, d);
4019     d=0; b=8;
4020   }
4021   if ( mp->font_info[p].qqqq.b3!=mp_unused ) d=d+b;
4022   b=b>>1;
4023 }
4024 mp_hex_digit_out(mp, d)
4025
4026
4027 @ Here is a simple function that determines whether there are any marked
4028 characters in font~|f| with character code at least~|c|.
4029
4030 @<Declarations@>=
4031 static boolean mp_check_ps_marks (MP mp,font_number f, integer  c) ;
4032
4033 @ @c
4034 static boolean mp_check_ps_marks (MP mp,font_number f, integer  c) {
4035   int p; /* |font_info| index for the current character */
4036   for (p=mp->char_base[f]+c;p<=mp->char_base[f]+mp->font_ec[f];p++) {
4037     if ( mp->font_info[p].qqqq.b3==mp_used )
4038        return true;
4039   }
4040   return false;
4041 }
4042
4043
4044 @ If the file name is so long that it can't be printed without exceeding
4045 |emergency_line_length| then there will be missing items in the \.{\%*Font:}
4046 line.  We might have to repeat line in order to get the character usage
4047 information to fit within |emergency_line_length|.
4048
4049 TODO: these two defines are also defined in mp.w!
4050
4051 @d link(A)   mp->mem[(A)].hh.rh /* the |link| field of a memory word */
4052 @d sc_factor(A) mp->mem[(A)+1].cint /* the scale factor stored in a font size node */
4053
4054 @<Print the \.{\%*Font} comment for font |f| and advance |cur_fsize[f]|@>=
4055 { integer t=0;
4056   while ( mp_check_ps_marks(mp, f,t) ) {
4057     mp_ps_print_nl(mp, "%*Font: ");
4058     if ( mp->ps->ps_offset+strlen(mp->font_name[f])+12>emergency_line_length )
4059       break;
4060     mp_ps_print(mp, mp->font_name[f]);
4061     mp_ps_print_char(mp, ' ');
4062     ds=(mp->font_dsize[f] + 8) / 16;
4063     mp_ps_print_scaled(mp, mp_take_scaled(mp, ds,sc_factor(cur_fsize[f])));
4064     if ( mp->ps->ps_offset+12>emergency_line_length ) break;
4065     mp_ps_print_char(mp, ' ');
4066     mp_ps_print_scaled(mp, ds);
4067     if ( mp->ps->ps_offset+5>emergency_line_length ) break;
4068     t=mp_ps_marks_out(mp, f,t);
4069   }
4070   cur_fsize[f]=link(cur_fsize[f]);
4071 }
4072
4073 @ @<Print the procset@>=
4074 {
4075   mp_ps_print_nl(mp, "/hlw{0 dtransform exch truncate exch idtransform pop setlinewidth}bd");
4076   mp_ps_print_nl(mp, "/vlw{0 exch dtransform truncate idtransform setlinewidth pop}bd");
4077   mp_ps_print_nl(mp, "/l{lineto}bd/r{rlineto}bd/c{curveto}bd/m{moveto}bd"
4078                   "/p{closepath}bd/n{newpath}bd");
4079   mp_ps_print_nl(mp, "/C{setcmykcolor}bd/G{setgray}bd/R{setrgbcolor}bd"
4080                   "/lj{setlinejoin}bd/ml{setmiterlimit}bd");
4081   mp_ps_print_nl(mp, "/lc{setlinecap}bd/S{stroke}bd/F{fill}bd/q{gsave}bd"
4082                   "/Q{grestore}bd/s{scale}bd/t{concat}bd");
4083   mp_ps_print_nl(mp, "/sd{setdash}bd/rd{[] 0 setdash}bd/P{showpage}bd/B{q F Q}bd/W{clip}bd");
4084 }
4085
4086
4087 @ The prologue defines \.{fshow} and corrects for the fact that \.{fshow}
4088 arguments use |font_name| instead of |font_ps_name|.  Downloaded bitmap fonts
4089 might not have reasonable |font_ps_name| entries, but we just charge ahead
4090 anyway.  The user should not make \&{prologues} positive if this will cause
4091 trouble.
4092 @:prologues_}{\&{prologues} primitive@>
4093
4094 @<Exported...@>=
4095 void mp_print_prologue (MP mp, struct mp_edge_object *h);
4096
4097 @ @c
4098 void mp_print_prologue (MP mp, struct mp_edge_object *h) {
4099   font_number f;
4100   font_number ldf ;
4101   int prologues = (mp->internal[mp_prologues]>>16);
4102   int procset = (mp->internal[mp_procset]>>16);
4103   ldf = mp_print_font_comments (mp, h);
4104   mp_ps_print_ln(mp);
4105   if ( (mp->internal[mp_prologues]==unity) && (mp->last_ps_fnum<mp->last_fnum) )
4106     mp_read_psname_table(mp);
4107   mp_ps_print(mp, "%%BeginProlog"); mp_ps_print_ln(mp);
4108   if ( (prologues>0)||(procset>0) ) {
4109     if ( ldf!=null_font ) {
4110       if ( prologues>0 ) {
4111         for (f=null_font+1;f<=mp->last_fnum;f++) {
4112           if ( mp_has_font_size(mp,f) ) {
4113             mp_ps_name_out(mp, mp->font_name[f],true);
4114             mp_ps_name_out(mp, mp->font_ps_name[f],true);
4115             mp_ps_print(mp, " def");
4116             mp_ps_print_ln(mp);
4117           }
4118         }
4119         if ( procset==0 ) {
4120           mp_ps_print(mp, "/fshow {exch findfont exch scalefont setfont show}bind def");
4121           mp_ps_print_ln(mp);
4122         }
4123       }
4124     }
4125     if (procset>0 ) {
4126       mp_ps_print_nl(mp, "%%BeginResource: procset mpost");
4127       if ( (prologues>0)&&(ldf!=null_font) )
4128         mp_ps_print(mp,
4129         "/bd{bind def}bind def/fshow {exch findfont exch scalefont setfont show}bd");
4130       else
4131         mp_ps_print_nl(mp, "/bd{bind def}bind def");
4132       @<Print the procset@>;
4133       mp_ps_print_nl(mp, "%%EndResource");
4134       mp_ps_print_ln(mp);
4135     }
4136   }
4137   mp_ps_print(mp, "%%EndProlog");
4138   mp_ps_print_nl(mp, "%%Page: 1 1"); mp_ps_print_ln(mp);
4139 }
4140
4141 @ \MP\ used to have one single routine to print to both `write' files
4142 and the PostScript output. Web2c redefines ``Character |k| cannot be
4143 printed'', and that resulted in some bugs where 8-bit characters were
4144 written to the PostScript file (reported by Wlodek Bzyl).
4145
4146 Also, Hans Hagen requested spaces to be output as "\\040" instead of
4147 a plain space, since that makes it easier to parse the result file
4148 for postprocessing.
4149
4150 @<Character |k| is not allowed in PostScript output@>=
4151   (k<=' ')||(k>'~')
4152
4153 @ We often need to print a pair of coordinates.
4154
4155 @c
4156 void mp_ps_pair_out (MP mp,scaled x, scaled y) {
4157   ps_room(26);
4158   mp_ps_print_scaled(mp, x); mp_ps_print_char(mp, ' ');
4159   mp_ps_print_scaled(mp, y); mp_ps_print_char(mp, ' ');
4160 }
4161
4162 @ @<Exported...@>=
4163 void mp_ps_pair_out (MP mp,scaled x, scaled y) ;
4164
4165 @ @c
4166 void mp_ps_print_cmd (MP mp, char *l, char *s) {
4167   if ( mp->internal[mp_procset]>0 ) { ps_room(strlen(s)); mp_ps_print(mp,s); }
4168   else { ps_room(strlen(l)); mp_ps_print(mp, l); };
4169 }
4170
4171 @ @<Exported...@>=
4172 void mp_ps_print_cmd (MP mp, char *l, char *s) ;
4173
4174 @ @c
4175 void mp_ps_string_out (MP mp, char *s) {
4176   ASCII_code k; /* bits to be converted to octal */
4177   mp_ps_print(mp, "(");
4178   while ((k=*s++)) {
4179     if ( mp->ps->ps_offset+5>mp->max_print_line ) {
4180       mp_ps_print_char(mp, '\\');
4181       mp_ps_print_ln(mp);
4182     }
4183     if ( (@<Character |k| is not allowed in PostScript output@>) ) {
4184       mp_ps_print_char(mp, '\\');
4185       mp_ps_print_char(mp, '0'+(k / 64));
4186       mp_ps_print_char(mp, '0'+((k / 8) % 8));
4187       mp_ps_print_char(mp, '0'+(k % 8));
4188     } else {
4189       if ( (k=='(')||(k==')')||(k=='\\') )
4190         mp_ps_print_char(mp, '\\');
4191       mp_ps_print_char(mp, k);
4192     }
4193   }
4194   mp_ps_print_char(mp, ')');
4195 }
4196
4197 @ @<Exported...@>=
4198 void mp_ps_string_out (MP mp, char *s) ;
4199
4200 @ This is a define because the function does not use its |mp| argument.
4201
4202 @d mp_is_ps_name(M,A) mp_do_is_ps_name(A)
4203
4204 @c
4205 static boolean mp_do_is_ps_name (char *s) {
4206   ASCII_code k; /* the character being checked */
4207   while ((k=*s++)) {
4208     if ( (k<=' ')||(k>'~') ) return false;
4209     if ( (k=='(')||(k==')')||(k=='<')||(k=='>')||
4210        (k=='{')||(k=='}')||(k=='/')||(k=='%') ) return false;
4211   }
4212   return true;
4213 }
4214
4215 @ @<Exported...@>=
4216 void mp_ps_name_out (MP mp, char *s, boolean lit) ;
4217
4218 @ @c
4219 void mp_ps_name_out (MP mp, char *s, boolean lit) {
4220   ps_room(strlen(s)+2);
4221   mp_ps_print_char(mp, ' ');
4222   if ( mp_is_ps_name(mp, s) ) {
4223     if ( lit ) mp_ps_print_char(mp, '/');
4224       mp_ps_print(mp, s);
4225   } else {
4226     mp_ps_string_out(mp, s);
4227     if ( ! lit ) mp_ps_print(mp, "cvx ");
4228       mp_ps_print(mp, "cvn");
4229   }
4230 }
4231
4232
4233 @ These special comments described in the {\sl PostScript Language Reference
4234 Manual}, 2nd.~edition are understood by some \ps-reading programs.
4235 We can't normally output ``conforming'' \ps\ because
4236 the structuring conventions don't allow us to say ``Please make sure the
4237 following characters are downloaded and define the \.{fshow} macro to access
4238 them.''
4239
4240 The exact bounding box is written out if |mp_prologues<0|, although this
4241 is not standard \ps, since it allows \TeX\ to calculate the box dimensions
4242 accurately. (Overfull boxes are avoided if an illustration is made to
4243 match a given \.{\char`\\hsize}.)
4244
4245 @<Exported...@>=
4246 void mp_print_initial_comment(MP mp,struct mp_edge_object *hh);
4247
4248 @ @c
4249 void mp_print_initial_comment(MP mp,struct mp_edge_object *hh) {
4250   scaled t;
4251   int prologues = (mp->internal[mp_prologues]>>16);
4252   mp_ps_print(mp, "%!PS");
4253   if ( prologues>0 )
4254     mp_ps_print(mp, "-Adobe-3.0 EPSF-3.0");
4255   mp_ps_print_nl(mp, "%%BoundingBox: ");
4256   if ( hh->_minx>hh->_maxx) {
4257      mp_ps_print(mp, "0 0 0 0");
4258   } else if ( prologues<0 ) {
4259     mp_ps_pair_out(mp, hh->_minx,hh->_miny);
4260     mp_ps_pair_out(mp, hh->_maxx,hh->_maxy);
4261   } else {
4262     mp_ps_pair_out(mp, mp_floor_scaled(mp, hh->_minx),mp_floor_scaled(mp, hh->_miny));
4263     mp_ps_pair_out(mp, -mp_floor_scaled(mp, -hh->_maxx),-mp_floor_scaled(mp, -hh->_maxy));
4264   }
4265   mp_ps_print_nl(mp, "%%HiResBoundingBox: ");
4266   if ( hh->_minx>hh->_maxx ) {
4267     mp_ps_print(mp, "0 0 0 0");
4268   } else {
4269     mp_ps_pair_out(mp, hh->_minx,hh->_miny);
4270     mp_ps_pair_out(mp, hh->_maxx,hh->_maxy);
4271   }
4272   mp_ps_print_nl(mp, "%%Creator: MetaPost ");
4273   mp_ps_print(mp, mp_metapost_version(mp));
4274   mp_ps_print_nl(mp, "%%CreationDate: ");
4275   mp_ps_print_int(mp, mp_round_unscaled(mp, mp->internal[mp_year]));
4276   mp_ps_print_char(mp, '.');
4277   mp_ps_print_dd(mp, mp_round_unscaled(mp, mp->internal[mp_month]));
4278   mp_ps_print_char(mp, '.');
4279   mp_ps_print_dd(mp, mp_round_unscaled(mp, mp->internal[mp_day]));
4280   mp_ps_print_char(mp, ':');
4281   t=mp_round_unscaled(mp, mp->internal[mp_time]);
4282   mp_ps_print_dd(mp, t / 60);
4283   mp_ps_print_dd(mp, t % 60);
4284   mp_ps_print_nl(mp, "%%Pages: 1");
4285 }
4286
4287 @ The most important output procedure is the one that gives the \ps\ version of
4288 a \MP\ path.
4289
4290 @<Types...@>=
4291 #define gr_left_type(A)  (A)->left_type_field
4292 #define gr_right_type(A) (A)->right_type_field
4293 #define gr_x_coord(A)    (A)->x_coord_field
4294 #define gr_y_coord(A)    (A)->y_coord_field
4295 #define gr_left_x(A)     (A)->left_x_field
4296 #define gr_left_y(A)     (A)->left_y_field
4297 #define gr_right_x(A)    (A)->right_x_field
4298 #define gr_right_y(A)    (A)->right_y_field
4299 #define gr_next_knot(A)  (A)->next_field
4300 #define gr_originator(A) (A)->originator_field
4301 typedef struct mp_knot {
4302   unsigned short left_type_field;
4303   unsigned short right_type_field;
4304   scaled x_coord_field;
4305   scaled y_coord_field;
4306   scaled left_x_field;
4307   scaled left_y_field;
4308   scaled right_x_field;
4309   scaled right_y_field;
4310   struct mp_knot * next_field;
4311   quarterword originator_field;
4312 } mp_knot;
4313
4314 @ @c
4315 struct mp_knot * mp_gr_insert_knot (MP mp, struct mp_knot *q, scaled x, scaled y) {
4316   /* returns the inserted knot */
4317   struct mp_knot *r; /* the new knot */
4318   r= mp_xmalloc(mp, 1, sizeof (struct mp_knot));
4319   gr_next_knot(r)=gr_next_knot(q); gr_next_knot(q)=r;
4320   gr_right_x(r)=gr_right_x(q);
4321   gr_right_y(r)=gr_right_y(q);
4322   gr_x_coord(r)=x;
4323   gr_y_coord(r)=y;
4324   gr_right_x(q)=gr_x_coord(q);
4325   gr_right_y(q)=gr_y_coord(q);
4326   gr_left_x(r)=gr_x_coord(r);
4327   gr_left_y(r)=gr_y_coord(r);
4328   gr_left_type(r)=mp_explicit;
4329   gr_right_type(r)=mp_explicit;
4330   gr_originator(r)=mp_program_code;
4331   return r;
4332 }
4333
4334
4335 @ If we want to duplicate a knot node, we can say |copy_knot|:
4336
4337 @c
4338 struct mp_knot *mp_gr_copy_knot (MP mp,  struct mp_knot *p) {
4339   struct mp_knot *q; /* the copy */
4340   q = mp_xmalloc(mp, 1, sizeof (struct mp_knot));
4341   memcpy(q,p,sizeof (struct mp_knot));
4342   gr_next_knot(q)=NULL;
4343   return q;
4344 }
4345
4346 @ The |copy_path| routine makes a clone of a given path.
4347
4348 @c
4349 struct mp_knot *mp_gr_copy_path (MP mp,  struct mp_knot *p) {
4350   struct mp_knot *q, *pp, *qq; /* for list manipulation */
4351   q=mp_gr_copy_knot(mp, p);
4352   qq=q;
4353   pp=gr_next_knot(p);
4354   while ( pp!=p ) {
4355     gr_next_knot(qq)=mp_gr_copy_knot(mp, pp);
4356     qq=gr_next_knot(qq);
4357     pp=gr_next_knot(pp);
4358   }
4359   gr_next_knot(qq)=q;
4360   return q;
4361 }
4362
4363 @ Similarly, there's a way to copy the {\sl reverse\/} of a path. This procedure
4364 returns a pointer to the first node of the copy, if the path is a cycle,
4365 but to the final node of a non-cyclic copy. The global
4366 variable |path_tail| will point to the final node of the original path;
4367 this trick makes it easier to implement `\&{doublepath}'.
4368
4369 All node types are assumed to be |endpoint| or |explicit| only.
4370
4371 @c
4372 struct mp_knot * mp_gr_htap_ypoc (MP mp,  struct mp_knot *p) {
4373   struct mp_knot *q, *pp, *qq, *rr; /* for list manipulation */
4374   q=mp_xmalloc(mp, 1, sizeof (struct mp_knot)); /* this will correspond to |p| */
4375   qq=q; pp=p;
4376   while (1) {
4377     gr_right_type(qq)=gr_left_type(pp);
4378     gr_left_type(qq)=gr_right_type(pp);
4379     gr_x_coord(qq)=gr_x_coord(pp);
4380     gr_y_coord(qq)=gr_y_coord(pp);
4381     gr_right_x(qq)=gr_left_x(pp);
4382     gr_right_y(qq)=gr_left_y(pp);
4383     gr_left_x(qq)=gr_right_x(pp);
4384     gr_left_y(qq)=gr_right_y(pp);
4385     gr_originator(qq)=gr_originator(pp);
4386     if ( gr_next_knot(pp)==p ) {
4387       gr_next_knot(q)=qq;
4388       /* mp->path_tail=pp; */ /* ? */
4389       return q;
4390     }
4391     rr=mp_xmalloc(mp, 1, sizeof (struct mp_knot));
4392     gr_next_knot(rr)=qq;
4393     qq=rr;
4394     pp=gr_next_knot(pp);
4395   }
4396 }
4397
4398 @ When a cyclic list of knot nodes is no longer needed, it can be recycled by
4399 calling the following subroutine.
4400
4401 @<Declarations@>=
4402 void mp_do_gr_toss_knot_list (struct mp_knot *p) ;
4403
4404 @
4405 @d mp_gr_toss_knot_list(B,A) mp_do_gr_toss_knot_list(A)
4406
4407 @c
4408 void mp_do_gr_toss_knot_list (struct mp_knot * p) {
4409   struct mp_knot *q; /* the node being freed */
4410   struct mp_knot *r; /* the next node */
4411   if (p==NULL)
4412     return;
4413   q=p;
4414   do {
4415     r=gr_next_knot(q);
4416     mp_xfree(q); q=r;
4417   } while (q!=p);
4418 }
4419
4420
4421
4422 @ @c
4423 void mp_gr_ps_path_out (MP mp, struct mp_knot *h) {
4424   struct mp_knot *p, *q; /* for scanning the path */
4425   scaled d; /* a temporary value */
4426   boolean curved; /* |true| unless the cubic is almost straight */
4427   ps_room(40);
4428   mp_ps_print_cmd(mp, "newpath ","n ");
4429   mp_ps_pair_out(mp, gr_x_coord(h),gr_y_coord(h));
4430   mp_ps_print_cmd(mp, "moveto","m");
4431   p=h;
4432   do {
4433     if ( gr_right_type(p)==mp_endpoint ) {
4434       if ( p==h ) mp_ps_print_cmd(mp, " 0 0 rlineto"," 0 0 r");
4435       return;
4436     }
4437     q=gr_next_knot(p);
4438     @<Start a new line and print the \ps\ commands for the curve from
4439       |p| to~|q|@>;
4440     p=q;
4441   } while (p!=h);
4442   mp_ps_print_cmd(mp, " closepath"," p");
4443 }
4444
4445 @ @<Start a new line and print the \ps\ commands for the curve from...@>=
4446 curved=true;
4447 @<Set |curved:=false| if the cubic from |p| to |q| is almost straight@>;
4448 mp_ps_print_ln(mp);
4449 if ( curved ){
4450   mp_ps_pair_out(mp, gr_right_x(p),gr_right_y(p));
4451   mp_ps_pair_out(mp, gr_left_x(q),gr_left_y(q));
4452   mp_ps_pair_out(mp, gr_x_coord(q),gr_y_coord(q));
4453   mp_ps_print_cmd(mp, "curveto","c");
4454 } else if ( q!=h ){
4455   mp_ps_pair_out(mp, gr_x_coord(q),gr_y_coord(q));
4456   mp_ps_print_cmd(mp, "lineto","l");
4457 }
4458
4459 @ Two types of straight lines come up often in \MP\ paths:
4460 cubics with zero initial and final velocity as created by |make_path| or
4461 |make_envelope|, and cubics with control points uniformly spaced on a line
4462 as created by |make_choices|.
4463
4464 @d bend_tolerance 131 /* allow rounding error of $2\cdot10^{-3}$ */
4465
4466 @<Set |curved:=false| if the cubic from |p| to |q| is almost straight@>=
4467 if ( gr_right_x(p)==gr_x_coord(p) )
4468   if ( gr_right_y(p)==gr_y_coord(p) )
4469     if ( gr_left_x(q)==gr_x_coord(q) )
4470       if ( gr_left_y(q)==gr_y_coord(q) ) curved=false;
4471 d=gr_left_x(q)-gr_right_x(p);
4472 if ( abs(gr_right_x(p)-gr_x_coord(p)-d)<=bend_tolerance )
4473   if ( abs(gr_x_coord(q)-gr_left_x(q)-d)<=bend_tolerance )
4474     { d=gr_left_y(q)-gr_right_y(p);
4475     if ( abs(gr_right_y(p)-gr_y_coord(p)-d)<=bend_tolerance )
4476       if ( abs(gr_y_coord(q)-gr_left_y(q)-d)<=bend_tolerance ) curved=false;
4477     }
4478
4479 @ The colored objects use a union to express the color parts:
4480
4481 @<Types...@>=
4482 typedef union {
4483   struct {
4484     scaled _red_val, _green_val, _blue_val;
4485   } rgb;
4486   struct {
4487     scaled _cyan_val, _magenta_val, _yellow_val, _black_val;
4488   } cmyk;
4489   struct {
4490     scaled _grey_val;
4491   } grey ;
4492 } mp_color;
4493
4494 @
4495
4496 @d gr_start_x(A)    (A)->start_x_field
4497 @d gr_stop_x(A)     (A)->stop_x_field
4498 @d gr_dash_link(A)  (A)->next_field
4499
4500 @d gr_dash_list(A)  (A)->list_field
4501 @d gr_dash_y(A)     (A)->y_field
4502
4503 @<Types...@>=
4504 typedef struct mp_dash_item {
4505   scaled start_x_field;
4506   scaled stop_x_field;
4507   struct mp_dash_item *next_field;
4508 } mp_dash_item ;
4509 typedef struct mp_dash_list {
4510   struct mp_dash_item *list_field;
4511   scaled y_field;
4512 } mp_dash_list ;
4513
4514
4515 @
4516 @d mp_gr_toss_dashes(A,B) mp_do_gr_toss_dashes(B)
4517
4518 @<Declarations@>=
4519 void mp_do_gr_toss_dashes(struct mp_dash_list *dl);
4520
4521 @ @c
4522 void mp_do_gr_toss_dashes(struct mp_dash_list *dl) {
4523   struct mp_dash_item *di, *dn;
4524   di = gr_dash_list(dl);
4525   while (di!= NULL) {
4526      dn = gr_dash_link(di);
4527      mp_xfree(di);
4528      di = dn;
4529   }
4530   mp_xfree(dl);
4531 }
4532
4533
4534 @ Now for outputting the actual graphic objects. First, set up some
4535 structures and access macros.
4536
4537 @d gr_has_color(A) (gr_type((A))<mp_start_clip_code)
4538
4539 @<Types...@>=
4540 #define gr_type(A)         (A)->_type_field
4541 #define gr_link(A)         (A)->_link_field
4542 #define gr_name_type(A)    (A)->name_type_field
4543 #define gr_color_model(A)  (A)->color_model_field
4544 #define gr_red_val(A)      (A)->color_field.rgb._red_val
4545 #define gr_green_val(A)    (A)->color_field.rgb._green_val
4546 #define gr_blue_val(A)     (A)->color_field.rgb._blue_val
4547 #define gr_cyan_val(A)     (A)->color_field.cmyk._cyan_val
4548 #define gr_magenta_val(A)  (A)->color_field.cmyk._magenta_val
4549 #define gr_yellow_val(A)   (A)->color_field.cmyk._yellow_val
4550 #define gr_black_val(A)    (A)->color_field.cmyk._black_val
4551 #define gr_grey_val(A)     (A)->color_field.grey._grey_val
4552 #define gr_path_p(A)       (A)->path_p_field
4553 #define gr_htap_p(A)       (A)->htap_p_field
4554 #define gr_pen_p(A)        (A)->pen_p_field
4555 #define gr_ljoin_val(A)    (A)->ljoin_field
4556 #define gr_lcap_val(A)     (A)->lcap_field
4557 #define gr_dash_scale(A)   (A)->dash_scale_field
4558 #define gr_miterlim_val(A) (A)->miterlim_field
4559 #define gr_pre_script(A)   (A)->pre_script_field
4560 #define gr_post_script(A)  (A)->post_script_field
4561 #define gr_dash_p(A)       (A)->dash_p_field
4562 #define gr_text_p(A)       (A)->text_p_field
4563 #define gr_font_n(A)       (A)->font_n_field
4564 #define gr_width_val(A)    (A)->width_field
4565 #define gr_height_val(A)   (A)->height_field
4566 #define gr_depth_val(A)    (A)->depth_field
4567 #define gr_tx_val(A)       (A)->tx_field
4568 #define gr_ty_val(A)       (A)->ty_field
4569 #define gr_txx_val(A)      (A)->txx_field
4570 #define gr_txy_val(A)      (A)->txy_field
4571 #define gr_tyx_val(A)      (A)->tyx_field
4572 #define gr_tyy_val(A)      (A)->tyy_field
4573 typedef struct mp_graphic_object {
4574   halfword _type_field;
4575   quarterword name_type_field;
4576   struct mp_graphic_object * _link_field;
4577   struct mp_knot * path_p_field;
4578   struct mp_knot * htap_p_field;
4579   struct mp_knot * pen_p_field;
4580   quarterword color_model_field;
4581   mp_color color_field;
4582   quarterword ljoin_field ;
4583   quarterword lcap_field ;
4584   scaled miterlim_field ;
4585   scaled dash_scale_field ;
4586   char *pre_script_field;
4587   char *post_script_field;
4588   struct mp_dash_list *dash_p_field;
4589   char *text_p_field;
4590   font_number font_n_field ;
4591   scaled width_field ;
4592   scaled height_field ;
4593   scaled depth_field ;
4594   scaled tx_field ;
4595   scaled ty_field ;
4596   scaled txx_field ;
4597   scaled txy_field ;
4598   scaled tyx_field ;
4599   scaled tyy_field ;
4600 } mp_graphic_object;
4601 typedef struct mp_edge_object {
4602   struct mp_graphic_object * body;
4603   scaled _minx, _miny, _maxx, _maxy;
4604 } mp_edge_object;
4605
4606 @ @<Exported function headers@>=
4607 struct mp_graphic_object *mp_new_graphic_object(MP mp, int type);
4608
4609 @ @c
4610 struct mp_graphic_object *mp_new_graphic_object (MP mp, int type) {
4611   mp_graphic_object *p;
4612   p = mp_xmalloc(mp,1,sizeof(struct mp_graphic_object));
4613   memset(p,0,sizeof(struct mp_graphic_object));
4614   gr_type(p) = type;
4615   return p;
4616 }
4617
4618 @ We need to keep track of several parameters from the \ps\ graphics state.
4619 @^graphics state@>
4620 This allows us to be sure that \ps\ has the correct values when they are
4621 needed without wasting time and space setting them unnecessarily.
4622
4623 @d gs_red        mp->ps->gs_state->red_field
4624 @d gs_green      mp->ps->gs_state->green_field
4625 @d gs_blue       mp->ps->gs_state->blue_field
4626 @d gs_black      mp->ps->gs_state->black_field
4627 @d gs_colormodel mp->ps->gs_state->colormodel_field
4628 @d gs_ljoin      mp->ps->gs_state->ljoin_field
4629 @d gs_lcap       mp->ps->gs_state->lcap_field
4630 @d gs_adj_wx     mp->ps->gs_state->adj_wx_field
4631 @d gs_miterlim   mp->ps->gs_state->miterlim_field
4632 @d gs_dash_p     mp->ps->gs_state->dash_p_field
4633 @d gs_previous   mp->ps->gs_state->previous_field
4634 @d gs_dash_sc    mp->ps->gs_state->dash_sc_field
4635 @d gs_width      mp->ps->gs_state->width_field
4636
4637 @<Types...@>=
4638 typedef struct _gs_state {
4639   scaled red_field ;
4640   scaled green_field ;
4641   scaled blue_field ;
4642   scaled black_field ;
4643   /* color from the last \&{setcmykcolor} or \&{setrgbcolor} or \&{setgray} command */
4644   quarterword colormodel_field ;
4645    /* the current colormodel */
4646   quarterword ljoin_field ;
4647   quarterword lcap_field ;
4648    /* values from the last \&{setlinejoin} and \&{setlinecap} commands */
4649   quarterword adj_wx_field ;
4650    /* what resolution-dependent adjustment applies to the width */
4651   scaled miterlim_field ;
4652    /* the value from the last \&{setmiterlimit} command */
4653   struct mp_dash_list * dash_p_field ;
4654    /* edge structure for last \&{setdash} command */
4655   struct _gs_state * previous_field ;
4656    /* backlink to the previous |_gs_state| structure */
4657   scaled dash_sc_field ;
4658    /* scale factor used with |gs_dash_p| */
4659   scaled width_field ;
4660    /* width setting or $-1$ if no \&{setlinewidth} command so far */
4661 } _gs_state;
4662
4663
4664 @ @<Glob...@>=
4665 struct _gs_state * gs_state;
4666
4667 @ @<Set init...@>=
4668 mp->ps->gs_state=NULL;
4669
4670 @ @<Dealloc variables@>=
4671 mp_xfree(mp->ps->gs_state);
4672
4673 @ To avoid making undue assumptions about the initial graphics state, these
4674 parameters are given special values that are guaranteed not to match anything
4675 in the edge structure being shipped out.  On the other hand, the initial color
4676 should be black so that the translation of an all-black picture will have no
4677 \&{setcolor} commands.  (These would be undesirable in a font application.)
4678 Hence we use |c=0| when initializing the graphics state and we use |c<0|
4679 to recover from a situation where we have lost track of the graphics state.
4680
4681 @c
4682 void mp_gs_unknown_graphics_state (MP mp,scaled c) ;
4683
4684 @
4685 @d mp_void (null+1) /* a null pointer different from |null| */
4686
4687 @c void mp_gs_unknown_graphics_state (MP mp,scaled c) {
4688   struct _gs_state *p; /* to shift graphic states around */
4689   if ( (c==0)||(c==-1) ) {
4690     if ( mp->ps->gs_state==NULL ) {
4691       mp->ps->gs_state = mp_xmalloc(mp,1,sizeof(struct _gs_state));
4692       gs_previous=NULL;
4693     } else {
4694       while ( gs_previous!=NULL ) {
4695         p = gs_previous;
4696         mp_xfree(mp->ps->gs_state);
4697         mp->ps->gs_state=p;
4698       }
4699     }
4700     gs_red=c; gs_green=c; gs_blue=c; gs_black=c;
4701     gs_colormodel=mp_uninitialized_model;
4702     gs_ljoin=3;
4703     gs_lcap=3;
4704     gs_miterlim=0;
4705     gs_dash_p=NULL;
4706     gs_dash_sc=0;
4707     gs_width=-1;
4708   } else if ( c==1 ) {
4709     p= mp->ps->gs_state;
4710     mp->ps->gs_state =  mp_xmalloc(mp,1,sizeof(struct _gs_state));
4711     memcpy(mp->ps->gs_state,p,sizeof(struct _gs_state));
4712     gs_previous = p;
4713   } else if ( c==2 ) {
4714     p = gs_previous;
4715     mp_xfree(mp->ps->gs_state);
4716     mp->ps->gs_state=p;
4717   }
4718 }
4719
4720
4721 @ When it is time to output a graphical object, |fix_graphics_state| ensures
4722 that \ps's idea of the graphics state agrees with what is stored in the object.
4723
4724 @<Declarations@>=
4725 void mp_gr_fix_graphics_state (MP mp, struct mp_graphic_object *p) ;
4726
4727 @ @c
4728 void mp_gr_fix_graphics_state (MP mp, struct mp_graphic_object *p) {
4729   /* get ready to output graphical object |p| */
4730   struct mp_knot *pp; /* for list manipulation */
4731   struct mp_dash_list *hh;
4732   scaled wx,wy,ww; /* dimensions of pen bounding box */
4733   boolean adj_wx; /* whether pixel rounding should be based on |wx| or |wy| */
4734   integer tx,ty; /* temporaries for computing |adj_wx| */
4735   scaled scf; /* a scale factor for the dash pattern */
4736   if ( gr_has_color(p) )
4737     @<Make sure \ps\ will use the right color for object~|p|@>;
4738   if ( (gr_type(p)==mp_fill_code)||(gr_type(p)==mp_stroked_code) )
4739     if ( gr_pen_p(p)!=NULL )
4740       if ( pen_is_elliptical(gr_pen_p(p)) ) {
4741         @<Generate \ps\ code that sets the stroke width to the
4742           appropriate rounded value@>;
4743         @<Make sure \ps\ will use the right dash pattern for |dash_p(p)|@>;
4744         @<Decide whether the line cap parameter matters and set it if necessary@>;
4745         @<Set the other numeric parameters as needed for object~|p|@>;
4746       }
4747   if ( mp->ps->ps_offset>0 ) mp_ps_print_ln(mp);
4748 }
4749
4750 @ @<Decide whether the line cap parameter matters and set it if necessary@>=
4751 if ( gr_type(p)==mp_stroked_code )
4752   if ( (gr_left_type(gr_path_p(p))==mp_endpoint)||(gr_dash_p(p)!=NULL) )
4753     if ( gs_lcap!=gr_lcap_val(p) ) {
4754       ps_room(13);
4755       mp_ps_print_char(mp, ' ');
4756       mp_ps_print_char(mp, '0'+gr_lcap_val(p));
4757       mp_ps_print_cmd(mp, " setlinecap"," lc");
4758       gs_lcap=gr_lcap_val(p);
4759     }
4760
4761 @ @<Set the other numeric parameters as needed for object~|p|@>=
4762 if ( gs_ljoin!=gr_ljoin_val(p) ) {
4763   ps_room(14);
4764   mp_ps_print_char(mp, ' ');
4765   mp_ps_print_char(mp, '0'+gr_ljoin_val(p));
4766   mp_ps_print_cmd(mp, " setlinejoin"," lj");
4767   gs_ljoin=gr_ljoin_val(p);
4768 }
4769 if ( gs_miterlim!=gr_miterlim_val(p) ) {
4770   ps_room(27);
4771   mp_ps_print_char(mp, ' ');
4772   mp_ps_print_scaled(mp, gr_miterlim_val(p));
4773   mp_ps_print_cmd(mp, " setmiterlimit"," ml");
4774   gs_miterlim=gr_miterlim_val(p);
4775 }
4776
4777 @ @<Make sure \ps\ will use the right color for object~|p|@>=
4778 {
4779   if ( (gr_color_model(p)==mp_rgb_model)||
4780      ((gr_color_model(p)==mp_uninitialized_model)&&
4781      ((mp->internal[mp_default_color_model]>>16)==mp_rgb_model)) ) {
4782   if ( (gs_colormodel!=mp_rgb_model)||(gs_red!=gr_red_val(p))||
4783       (gs_green!=gr_green_val(p))||(gs_blue!=gr_blue_val(p)) ) {
4784       gs_red=gr_red_val(p);
4785       gs_green=gr_green_val(p);
4786       gs_blue=gr_blue_val(p);
4787       gs_black= -1;
4788       gs_colormodel=mp_rgb_model;
4789       { ps_room(36);
4790         mp_ps_print_char(mp, ' ');
4791         mp_ps_print_scaled(mp, gs_red); mp_ps_print_char(mp, ' ');
4792         mp_ps_print_scaled(mp, gs_green); mp_ps_print_char(mp, ' ');
4793         mp_ps_print_scaled(mp, gs_blue);
4794         mp_ps_print_cmd(mp, " setrgbcolor", " R");
4795       }
4796     }
4797   } else if ( (gr_color_model(p)==mp_cmyk_model)||
4798      ((gr_color_model(p)==mp_uninitialized_model)&&
4799      ((mp->internal[mp_default_color_model]>>16)==mp_cmyk_model)) ) {
4800    if ( (gs_red!=gr_cyan_val(p))||(gs_green!=gr_magenta_val(p))||
4801       (gs_blue!=gr_yellow_val(p))||(gs_black!=gr_black_val(p))||
4802       (gs_colormodel!=mp_cmyk_model) ) {
4803       if ( gr_color_model(p)==mp_uninitialized_model ) {
4804         gs_red=0;
4805         gs_green=0;
4806         gs_blue=0;
4807         gs_black=unity;
4808       } else {
4809         gs_red=gr_cyan_val(p);
4810         gs_green=gr_magenta_val(p);
4811         gs_blue=gr_yellow_val(p);
4812         gs_black=gr_black_val(p);
4813       }
4814       gs_colormodel=mp_cmyk_model;
4815       { ps_room(45);
4816         mp_ps_print_char(mp, ' ');
4817         mp_ps_print_scaled(mp, gs_red);
4818         mp_ps_print_char(mp, ' ');
4819         mp_ps_print_scaled(mp, gs_green);
4820         mp_ps_print_char(mp, ' ');
4821         mp_ps_print_scaled(mp, gs_blue);
4822             mp_ps_print_char(mp, ' ');
4823         mp_ps_print_scaled(mp, gs_black);
4824         mp_ps_print_cmd(mp, " setcmykcolor"," C");
4825       }
4826     }
4827   } else if ( (gr_color_model(p)==mp_grey_model)||
4828     ((gr_color_model(p)==mp_uninitialized_model)&&
4829      ((mp->internal[mp_default_color_model]>>16)==mp_grey_model)) ) {
4830    if ( (gs_red!=gr_grey_val(p))||(gs_colormodel!=mp_grey_model) ) {
4831       gs_red = gr_grey_val(p);
4832       gs_green= -1;
4833       gs_blue= -1;
4834       gs_black= -1;
4835       gs_colormodel=mp_grey_model;
4836       { ps_room(16);
4837         mp_ps_print_char(mp, ' ');
4838         mp_ps_print_scaled(mp, gs_red);
4839         mp_ps_print_cmd(mp, " setgray"," G");
4840       }
4841     }
4842   }
4843   if ( gr_color_model(p)==mp_no_model )
4844     gs_colormodel=mp_no_model;
4845 }
4846
4847 @ In order to get consistent widths for horizontal and vertical pen strokes, we
4848 want \ps\ to use an integer number of pixels for the \&{setwidth} parameter.
4849 @:setwidth}{\&{setwidth}command@>
4850 We set |gs_width| to the ideal horizontal or vertical stroke width and then
4851 generate \ps\ code that computes the rounded value.  For non-circular pens, the
4852 pen shape will be rescaled so that horizontal or vertical parts of the stroke
4853 have the computed width.
4854
4855 Rounding the width to whole pixels is not likely to improve the appearance of
4856 diagonal or curved strokes, but we do it anyway for consistency.  The
4857 \&{truncate} command generated here tends to make all the strokes a little
4858 @:truncate}{\&{truncate} command@>
4859 thinner, but this is appropriate for \ps's scan-conversion rules.  Even with
4860 truncation, an ideal with of $w$~pixels gets mapped into $\lfloor w\rfloor+1$.
4861 It would be better to have $\lceil w\rceil$ but that is ridiculously expensive
4862 to compute in \ps.
4863
4864 @<Generate \ps\ code that sets the stroke width...@>=
4865 @<Set |wx| and |wy| to the width and height of the bounding box for
4866   |pen_p(p)|@>;
4867 @<Use |pen_p(p)| and |path_p(p)| to decide whether |wx| or |wy| is more
4868   important and set |adj_wx| and |ww| accordingly@>;
4869 if ( (ww!=gs_width) || (adj_wx!=gs_adj_wx) ) {
4870   if ( adj_wx ) {
4871     ps_room(13);
4872     mp_ps_print_char(mp, ' '); mp_ps_print_scaled(mp, ww);
4873     mp_ps_print_cmd(mp,
4874       " 0 dtransform exch truncate exch idtransform pop setlinewidth"," hlw");
4875   } else {
4876     if ( mp->internal[mp_procset]>0 ) {
4877       ps_room(13);
4878       mp_ps_print_char(mp, ' ');
4879       mp_ps_print_scaled(mp, ww);
4880       mp_ps_print(mp, " vlw");
4881     } else {
4882       ps_room(15);
4883       mp_ps_print(mp, " 0 "); mp_ps_print_scaled(mp, ww);
4884       mp_ps_print(mp, " dtransform truncate idtransform setlinewidth pop");
4885     }
4886   }
4887   gs_width = ww;
4888   gs_adj_wx = adj_wx;
4889 }
4890
4891 @ @<Set |wx| and |wy| to the width and height of the bounding box for...@>=
4892 pp=gr_pen_p(p);
4893 if ( (gr_right_x(pp)==gr_x_coord(pp)) && (gr_left_y(pp)==gr_y_coord(pp)) ) {
4894   wx = abs(gr_left_x(pp) - gr_x_coord(pp));
4895   wy = abs(gr_right_y(pp) - gr_y_coord(pp));
4896 } else {
4897   wx = mp_pyth_add(mp, gr_left_x(pp)-gr_x_coord(pp), gr_right_x(pp)-gr_x_coord(pp));
4898   wy = mp_pyth_add(mp, gr_left_y(pp)-gr_y_coord(pp), gr_right_y(pp)-gr_y_coord(pp));
4899 }
4900
4901 @ The path is considered ``essentially horizontal'' if its range of
4902 $y$~coordinates is less than the $y$~range |wy| for the pen.  ``Essentially
4903 vertical'' paths are detected similarly.  This code ensures that no component
4904 of the pen transformation is more that |aspect_bound*(ww+1)|.
4905
4906 @d aspect_bound 10 /* ``less important'' of |wx|, |wy| cannot exceed the other by
4907     more than this factor */
4908
4909 @d do_x_loc 1
4910 @d do_y_loc 2
4911
4912 @<Use |pen_p(p)| and |path_p(p)| to decide whether |wx| or |wy| is more...@>=
4913 tx=1; ty=1;
4914 if ( mp_gr_coord_rangeOK(gr_path_p(p), do_y_loc, wy) ) tx=aspect_bound;
4915 else if ( mp_gr_coord_rangeOK(gr_path_p(p), do_x_loc, wx) ) ty=aspect_bound;
4916 if ( wy / ty>=wx / tx ) { ww=wy; adj_wx=false; }
4917 else { ww=wx; adj_wx=true;  }
4918
4919 @ This routine quickly tests if path |h| is ``essentially horizontal'' or
4920 ``essentially vertical,'' where |zoff| is |x_loc(0)| or |y_loc(0)| and |dz| is
4921 allowable range for $x$ or~$y$.  We do not need and cannot afford a full
4922 bounding-box computation.
4923
4924 @<Declarations@>=
4925 boolean mp_gr_coord_rangeOK (struct mp_knot *h,
4926                           small_number  zoff, scaled dz);
4927
4928 @ @c
4929 boolean mp_gr_coord_rangeOK (struct mp_knot *h,
4930                           small_number  zoff, scaled dz) {
4931   struct mp_knot *p; /* for scanning the path form |h| */
4932   scaled zlo,zhi; /* coordinate range so far */
4933   scaled z; /* coordinate currently being tested */
4934   if (zoff==do_x_loc) {
4935     zlo=gr_x_coord(h);
4936     zhi=zlo;
4937     p=h;
4938     while ( gr_right_type(p)!=mp_endpoint ) {
4939       z=gr_right_x(p);
4940       @<Make |zlo..zhi| include |z| and |return false| if |zhi-zlo>dz|@>;
4941       p=gr_next_knot(p);  z=gr_left_x(p);
4942       @<Make |zlo..zhi| include |z| and |return false| if |zhi-zlo>dz|@>;
4943       z=gr_x_coord(p);
4944       @<Make |zlo..zhi| include |z| and |return false| if |zhi-zlo>dz|@>;
4945       if ( p==h ) break;
4946     }
4947   } else {
4948     zlo=gr_y_coord(h);
4949     zhi=zlo;
4950     p=h;
4951     while ( gr_right_type(p)!=mp_endpoint ) {
4952       z=gr_right_y(p);
4953       @<Make |zlo..zhi| include |z| and |return false| if |zhi-zlo>dz|@>;
4954       p=gr_next_knot(p); z=gr_left_y(p);
4955       @<Make |zlo..zhi| include |z| and |return false| if |zhi-zlo>dz|@>;
4956       z=gr_y_coord(p);
4957       @<Make |zlo..zhi| include |z| and |return false| if |zhi-zlo>dz|@>;
4958       if ( p==h ) break;
4959     }
4960   }
4961   return true;
4962 }
4963
4964 @ @<Make |zlo..zhi| include |z| and |return false| if |zhi-zlo>dz|@>=
4965 if ( z<zlo ) zlo=z;
4966 else if ( z>zhi ) zhi=z;
4967 if ( zhi-zlo>dz ) return false
4968
4969 @ Filling with an elliptical pen is implemented via a combination of \&{stroke}
4970 and \&{fill} commands and a nontrivial dash pattern would interfere with this.
4971 @:stroke}{\&{stroke} command@>
4972 @:fill}{\&{fill} command@>
4973 Note that we don't use |delete_edge_ref| because |gs_dash_p| is not counted as
4974 a reference.
4975
4976 @<Make sure \ps\ will use the right dash pattern for |dash_p(p)|@>=
4977 if ( gr_type(p)==mp_fill_code ) {
4978   hh=NULL;
4979 } else {
4980   hh=gr_dash_p(p);
4981   scf=mp_gr_get_pen_scale(mp, gr_pen_p(p));
4982   if ( scf==0 ) {
4983     if ( gs_width==0 ) scf=gr_dash_scale(p);  else hh=NULL;
4984   } else {
4985     scf=mp_make_scaled(mp, gs_width,scf);
4986     scf=mp_take_scaled(mp, scf,gr_dash_scale(p));
4987   }
4988 }
4989 if ( hh==NULL ) {
4990   if ( gs_dash_p!=NULL ) {
4991     mp_ps_print_cmd(mp, " [] 0 setdash"," rd");
4992     gs_dash_p=NULL;
4993   }
4994 } else if ( (gs_dash_sc!=scf) || ! mp_gr_same_dashes(gs_dash_p,hh) ) {
4995   @<Set the dash pattern from |dash_list(hh)| scaled by |scf|@>;
4996 }
4997
4998 @ @<Declarations@>=
4999 scaled mp_gr_get_pen_scale (MP mp, struct mp_knot *p) ;
5000
5001
5002 @ @c
5003 scaled mp_gr_get_pen_scale (MP mp, struct mp_knot *p) {
5004   return mp_sqrt_det(mp,
5005     gr_left_x(p)-gr_x_coord(p), gr_right_x(p)-gr_x_coord(p),
5006     gr_left_y(p)-gr_y_coord(p), gr_right_y(p)-gr_y_coord(p));
5007 }
5008
5009
5010 @ Translating a dash list into \ps\ is very similar to printing it symbolically
5011 in |print_edges|.  A dash pattern with |dash_y(hh)=0| has length zero and is
5012 ignored.  The same fate applies in the bizarre case of a dash pattern that
5013 cannot be printed without overflow.
5014
5015 @<Set the dash pattern from |dash_list(hh)| scaled by |scf|@>=
5016 { gs_dash_p=hh;
5017   gs_dash_sc=scf;
5018   if ( (gr_dash_p(p)==NULL) ||
5019        (gr_dash_y(hh)==0) ||
5020        ((abs(gr_dash_y(hh)) / unity) >= (el_gordo / scf))) {
5021     mp_ps_print_cmd(mp, " [] 0 setdash"," rd");
5022   } else {
5023     struct mp_dash_item *dpp=gr_dash_list(hh);
5024     struct mp_dash_item *pp= dpp;
5025     ps_room(28);
5026     mp_ps_print(mp, " [");
5027     while ( dpp!=NULL ) {
5028           scaled dx,dy;
5029       dx = mp_take_scaled(mp, gr_stop_x(dpp)-gr_start_x(dpp),scf);
5030       dy = 0;
5031       if (gr_dash_link(dpp)!=NULL) {
5032         dy = mp_take_scaled(mp, gr_start_x(gr_dash_link(dpp))-gr_stop_x(dpp),scf);
5033       } else {
5034         dy = mp_take_scaled(mp, (gr_start_x(pp)+gr_dash_y(hh))-gr_stop_x(dpp),scf);
5035       }
5036       mp_ps_pair_out(mp, dx, dy);
5037       dpp=gr_dash_link(dpp);
5038     }
5039     ps_room(22);
5040     mp_ps_print(mp, "] ");
5041     mp_ps_print_scaled(mp, mp_take_scaled(mp, mp_gr_dash_offset(mp, hh),scf));
5042     mp_ps_print_cmd(mp, " setdash"," sd");
5043   }
5044 }
5045
5046 @ @<Declarations@>=
5047 boolean mp_gr_same_dashes (struct mp_dash_list *h, struct mp_dash_list *hh) ;
5048
5049 @ @c
5050 boolean mp_gr_same_dashes (struct mp_dash_list * h, struct mp_dash_list *hh) {
5051   /* do |h| and |hh| represent the same dash pattern? */
5052   struct mp_dash_item * p, *pp; /* dash nodes being compared */
5053   if ( h==hh ) return true;
5054   else if ( (h==NULL)||(hh==NULL) ) return false;
5055   else if ( gr_dash_y(h)!=gr_dash_y(hh) ) return false;
5056   else { @<Compare |dash_list(h)| and |dash_list(hh)|@>; }
5057   return false; /* can't happen */
5058 }
5059
5060 @ @<Compare |dash_list(h)| and |dash_list(hh)|@>=
5061 { p=gr_dash_list(h);
5062   pp=gr_dash_list(hh);
5063   while ( (p!=NULL)&&(pp!=NULL) ) {
5064     if ( (gr_start_x(p)!=gr_start_x(pp))||
5065          (gr_stop_x(p)!=gr_stop_x(pp)) ) {
5066       break;
5067     } else {
5068       p=gr_dash_link(p);
5069       pp=gr_dash_link(pp);
5070     }
5071   }
5072   return (p==pp);
5073 }
5074
5075 @ @<Declarations@>=
5076 scaled mp_gr_dash_offset (MP mp, struct mp_dash_list *h) ;
5077
5078 @ @c
5079 scaled mp_gr_dash_offset (MP mp, struct mp_dash_list *h) {
5080   scaled x;  /* the answer */
5081   if ( h==NULL || (gr_dash_list(h)==NULL) || (gr_dash_y(h)<0) )
5082      mp_confusion(mp, "dash0");
5083 @:this can't happen dash0}{\quad dash0@>
5084   if ( gr_dash_y(h)==0 ) {
5085     x=0;
5086   } else {
5087     x=-(gr_start_x(gr_dash_list(h)) % gr_dash_y(h));
5088     if ( x<0 ) x=x+gr_dash_y(h);
5089   }
5090   return x;
5091 }
5092
5093 @ When stroking a path with an elliptical pen, it is necessary to transform
5094 the coordinate system so that a unit circular pen will have the desired shape.
5095 To keep this transformation local, we enclose it in a
5096 $$\&{gsave}\ldots\&{grestore}$$
5097 block. Any translation component must be applied to the path being stroked
5098 while the rest of the transformation must apply only to the pen.
5099 If |fill_also=true|, the path is to be filled as well as stroked so we must
5100 insert commands to do this after giving the path.
5101
5102 @<Declarations@>=
5103 void mp_gr_stroke_ellipse (MP mp, struct mp_graphic_object *h, boolean fill_also) ;
5104
5105 @
5106 @c void mp_gr_stroke_ellipse (MP mp, struct mp_graphic_object *h, boolean fill_also) {
5107   /* generate an elliptical pen stroke from object |h| */
5108   scaled txx,txy,tyx,tyy; /* transformation parameters */
5109   struct mp_knot *p; /* the pen to stroke with */
5110   scaled d1,det; /* for tweaking transformation parameters */
5111   integer s; /* also for tweaking transformation paramters */
5112   boolean transformed; /* keeps track of whether gsave/grestore are needed */
5113   transformed=false;
5114   @<Use |pen_p(h)| to set the transformation parameters and give the initial
5115     translation@>;
5116   @<Tweak the transformation parameters so the transformation is nonsingular@>;
5117   mp_gr_ps_path_out(mp, gr_path_p(h));
5118   if ( mp->internal[mp_procset]==0 ) {
5119     if ( fill_also ) mp_ps_print_nl(mp, "gsave fill grestore");
5120     @<Issue \ps\ commands to transform the coordinate system@>;
5121     mp_ps_print(mp, " stroke");
5122     if ( transformed ) mp_ps_print(mp, " grestore");
5123   } else {
5124     if ( fill_also ) mp_ps_print_nl(mp, "B"); else mp_ps_print_ln(mp);
5125     if ( (txy!=0)||(tyx!=0) ) {
5126       mp_ps_print(mp, " [");
5127       mp_ps_pair_out(mp, txx,tyx);
5128       mp_ps_pair_out(mp, txy,tyy);
5129       mp_ps_print(mp, "0 0] t");
5130     } else if ((txx!=unity)||(tyy!=unity) )  {
5131       mp_ps_pair_out(mp,txx,tyy);
5132       mp_ps_print(mp, " s");
5133     };
5134     mp_ps_print(mp, " S");
5135     if ( transformed ) mp_ps_print(mp, " Q");
5136   }
5137   mp_ps_print_ln(mp);
5138 }
5139
5140 @ @<Use |pen_p(h)| to set the transformation parameters and give the...@>=
5141 p=gr_pen_p(h);
5142 txx=gr_left_x(p);
5143 tyx=gr_left_y(p);
5144 txy=gr_right_x(p);
5145 tyy=gr_right_y(p);
5146 if ( (gr_x_coord(p)!=0)||(gr_y_coord(p)!=0) ) {
5147   mp_ps_print_nl(mp, "");
5148   mp_ps_print_cmd(mp, "gsave ","q ");
5149   mp_ps_pair_out(mp, gr_x_coord(p), gr_y_coord(p));
5150   mp_ps_print(mp, "translate ");
5151   txx-=gr_x_coord(p);
5152   tyx-=gr_y_coord(p);
5153   txy-=gr_x_coord(p);
5154   tyy-=gr_y_coord(p);
5155   transformed=true;
5156 } else {
5157   mp_ps_print_nl(mp, "");
5158 }
5159 @<Adjust the transformation to account for |gs_width| and output the
5160   initial \&{gsave} if |transformed| should be |true|@>
5161
5162 @ @<Adjust the transformation to account for |gs_width| and output the...@>=
5163 if ( gs_width!=unity ) {
5164   if ( gs_width==0 ) {
5165     txx=unity; tyy=unity;
5166   } else {
5167     txx=mp_make_scaled(mp, txx,gs_width);
5168     txy=mp_make_scaled(mp, txy,gs_width);
5169     tyx=mp_make_scaled(mp, tyx,gs_width);
5170     tyy=mp_make_scaled(mp, tyy,gs_width);
5171   };
5172 }
5173 if ( (txy!=0)||(tyx!=0)||(txx!=unity)||(tyy!=unity) ) {
5174   if ( (! transformed) ){
5175     mp_ps_print_cmd(mp, "gsave ","q ");
5176     transformed=true;
5177   }
5178 }
5179
5180 @ @<Issue \ps\ commands to transform the coordinate system@>=
5181 if ( (txy!=0)||(tyx!=0) ){
5182   mp_ps_print_ln(mp);
5183   mp_ps_print_char(mp, '[');
5184   mp_ps_pair_out(mp, txx,tyx);
5185   mp_ps_pair_out(mp, txy,tyy);
5186   mp_ps_print(mp, "0 0] concat");
5187 } else if ( (txx!=unity)||(tyy!=unity) ){
5188   mp_ps_print_ln(mp);
5189   mp_ps_pair_out(mp, txx,tyy);
5190   mp_ps_print(mp, "scale");
5191 }
5192
5193 @ The \ps\ interpreter will probably abort if it encounters a singular
5194 transformation matrix.  The determinant must be large enough to ensure that
5195 the printed representation will be nonsingular.  Since the printed
5196 representation is always within $2^{-17}$ of the internal |scaled| value, the
5197 total error is at most $4T_{\rm max}2^{-17}$, where $T_{\rm max}$ is a bound on
5198 the magnitudes of |txx/65536|, |txy/65536|, etc.
5199
5200 The |aspect_bound*(gs_width+1)| bound on the components of the pen
5201 transformation allows $T_{\rm max}$ to be at most |2*aspect_bound|.
5202
5203 @<Tweak the transformation parameters so the transformation is nonsingular@>=
5204 det=mp_take_scaled(mp, txx,tyy) - mp_take_scaled(mp, txy,tyx);
5205 d1=4*aspect_bound+1;
5206 if ( abs(det)<d1 ) {
5207   if ( det>=0 ) { d1=d1-det; s=1;  }
5208   else { d1=-d1-det; s=-1;  };
5209   d1=d1*unity;
5210   if ( abs(txx)+abs(tyy)>=abs(txy)+abs(tyy) ) {
5211     if ( abs(txx)>abs(tyy) ) tyy=tyy+(d1+s*abs(txx)) / txx;
5212     else txx=txx+(d1+s*abs(tyy)) / tyy;
5213   } else {
5214     if ( abs(txy)>abs(tyx) ) tyx=tyx+(d1+s*abs(txy)) / txy;
5215     else txy=txy+(d1+s*abs(tyx)) / tyx;
5216   }
5217 }
5218
5219 @ Here is a simple routine that just fills a cycle.
5220
5221 @<Declarations@>=
5222 void mp_gr_ps_fill_out (MP mp, struct mp_knot *p);
5223
5224 @ @c
5225 void mp_gr_ps_fill_out (MP mp, struct mp_knot *p) { /* fill cyclic path~|p| */
5226   mp_gr_ps_path_out(mp, p);
5227   mp_ps_print_cmd(mp, " fill"," F");
5228   mp_ps_print_ln(mp);
5229 }
5230
5231 @ A text node may specify an arbitrary transformation but the usual case
5232 involves only shifting, scaling, and occasionally rotation.  The purpose
5233 of |choose_scale| is to select a scale factor so that the remaining
5234 transformation is as ``nice'' as possible.  The definition of ``nice''
5235 is somewhat arbitrary but shifting and $90^\circ$ rotation are especially
5236 nice because they work out well for bitmap fonts.  The code here selects
5237 a scale factor equal to $1/\sqrt2$ times the Frobenius norm of the
5238 non-shifting part of the transformation matrix.  It is careful to avoid
5239 additions that might cause undetected overflow.
5240
5241 @<Declarations@>=
5242 scaled mp_gr_choose_scale (MP mp, struct mp_graphic_object *p) ;
5243
5244 @ @c scaled mp_gr_choose_scale (MP mp, struct mp_graphic_object *p) {
5245   /* |p| should point to a text node */
5246   scaled a,b,c,d,ad,bc; /* temporary values */
5247   a=gr_txx_val(p);
5248   b=gr_txy_val(p);
5249   c=gr_tyx_val(p);
5250   d=gr_tyy_val(p);
5251   if ( (a<0) ) negate(a);
5252   if ( (b<0) ) negate(b);
5253   if ( (c<0) ) negate(c);
5254   if ( (d<0) ) negate(d);
5255   ad=half(a-d);
5256   bc=half(b-c);
5257   return mp_pyth_add(mp, mp_pyth_add(mp, d+ad,ad), mp_pyth_add(mp, c+bc,bc));
5258 }
5259
5260 @ The potential overflow here is caused by the fact the returned value
5261 has to fit in a |name_type|, which is a quarterword.
5262
5263 @d fscale_tolerance 65 /* that's $.001\times2^{16}$ */
5264
5265 @<Declarations@>=
5266 quarterword mp_size_index (MP mp, font_number f, scaled s) ;
5267
5268 @ @c
5269 quarterword mp_size_index (MP mp, font_number f, scaled s) {
5270   pointer p,q; /* the previous and current font size nodes */
5271   quarterword i; /* the size index for |q| */
5272   q=mp->font_sizes[f];
5273   i=0;
5274   while ( q!=null ) {
5275     if ( abs(s-sc_factor(q))<=fscale_tolerance )
5276       return i;
5277     else
5278       { p=q; q=link(q); incr(i); };
5279     if ( i==max_quarterword )
5280       mp_overflow(mp, "sizes per font",max_quarterword);
5281 @:MetaPost capacity exceeded sizes per font}{\quad sizes per font@>
5282   }
5283   q=mp_get_node(mp, font_size_size);
5284   sc_factor(q)=s;
5285   if ( i==0 ) mp->font_sizes[f]=q;  else link(p)=q;
5286   return i;
5287 }
5288
5289 @ @<Declarations@>=
5290 scaled mp_indexed_size (MP mp,font_number f, quarterword j);
5291
5292 @ @c
5293 scaled mp_indexed_size (MP mp,font_number f, quarterword j) {
5294   pointer p; /* a font size node */
5295   quarterword i; /* the size index for |p| */
5296   p=mp->font_sizes[f];
5297   i=0;
5298   if ( p==null ) mp_confusion(mp, "size");
5299   while ( (i!=j) ) {
5300     incr(i); p=link(p);
5301     if ( p==null ) mp_confusion(mp, "size");
5302   }
5303   return sc_factor(p);
5304 }
5305
5306 @ @<Declarations@>=
5307 void mp_clear_sizes (MP mp) ;
5308
5309 @ @c void mp_clear_sizes (MP mp) {
5310   font_number f;  /* the font whose size list is being cleared */
5311   pointer p;  /* current font size nodes */
5312   for (f=null_font+1;f<=mp->last_fnum;f++) {
5313     while ( mp->font_sizes[f]!=null ) {
5314       p=mp->font_sizes[f];
5315       mp->font_sizes[f]=link(p);
5316       mp_free_node(mp, p,font_size_size);
5317     }
5318   }
5319 }
5320
5321 @ A text node may specify an arbitrary transformation but the usual case
5322 involves only shifting, scaling, and occasionally rotation.  The purpose
5323 of |choose_scale| is to select a scale factor so that the remaining
5324 transformation is as ``nice'' as possible.  The definition of ``nice''
5325 is somewhat arbitrary but shifting and $90^\circ$ rotation are especially
5326 nice because they work out well for bitmap fonts.  The code here selects
5327 a scale factor equal to $1/\sqrt2$ times the Frobenius norm of the
5328 non-shifting part of the transformation matrix.  It is careful to avoid
5329 additions that might cause undetected overflow.
5330
5331 @<Declare the \ps\ output procedures@>=
5332 scaled mp_choose_scale (MP mp, mp_graphic_object *p) ;
5333
5334 @ @c scaled mp_choose_scale (MP mp, mp_graphic_object *p) {
5335   /* |p| should point to a text node */
5336   scaled a,b,c,d,ad,bc; /* temporary values */
5337   a=gr_txx_val(p);
5338   b=gr_txy_val(p);
5339   c=gr_tyx_val(p);
5340   d=gr_tyy_val(p);
5341   if ( (a<0) ) negate(a);
5342   if ( (b<0) ) negate(b);
5343   if ( (c<0) ) negate(c);
5344   if ( (d<0) ) negate(d);
5345   ad=half(a-d);
5346   bc=half(b-c);
5347   return mp_pyth_add(mp, mp_pyth_add(mp, d+ad,ad), mp_pyth_add(mp, c+bc,bc));
5348 }
5349
5350 @ There may be many sizes of one font and we need to keep track of the
5351 characters used for each size.  This is done by keeping a linked list of
5352 sizes for each font with a counter in each text node giving the appropriate
5353 position in the size list for its font.
5354
5355 @d font_size_size 2 /* size of a font size node */
5356
5357
5358 @ @<Declarations@>=
5359 void mp_apply_mark_string_chars(MP mp, struct mp_edge_object *h, int next_size);
5360
5361 @ @c
5362 void mp_apply_mark_string_chars(MP mp, struct mp_edge_object *h, int next_size) {
5363   struct mp_graphic_object * p;
5364   p=h->body;
5365   while ( p!= NULL ) {
5366     if ( gr_type(p)==mp_text_code ) {
5367       if ( gr_font_n(p)!=null_font ) {
5368         if ( gr_name_type(p)==next_size )
5369           mp_mark_string_chars(mp, gr_font_n(p),gr_text_p(p));
5370       }
5371     }
5372     p=gr_link(p);
5373   }
5374 }
5375
5376 @ @<Unmark all marked characters@>=
5377 for (f=null_font+1;f<=mp->last_fnum;f++) {
5378   if ( mp->font_sizes[f]!=null ) {
5379     mp_unmark_font(mp, f);
5380     mp->font_sizes[f]=null;
5381   }
5382 }
5383
5384 @ @<Scan all the text nodes and mark the used ...@>=
5385 p=hh->body;
5386 while ( p!=null ) {
5387   if ( gr_type(p)==mp_text_code ) {
5388     f = gr_font_n(p);
5389     if (f!=null_font ) {
5390       switch (prologues) {
5391       case two:
5392       case three:
5393         mp->font_sizes[f] = mp_void;
5394         mp_mark_string_chars(mp, f, gr_text_p(p));
5395             if (mp_has_fm_entry(mp,f,NULL) ) {
5396           if (mp->font_enc_name[f]==NULL )
5397             mp->font_enc_name[f] = mp_fm_encoding_name(mp,f);
5398           mp->font_ps_name[f] = mp_fm_font_name(mp,f);
5399         }
5400         break;
5401       case unity:
5402         mp->font_sizes[f]=mp_void;
5403         break;
5404       default:
5405         gr_name_type(p)=mp_size_index(mp, f,mp_choose_scale(mp, p));
5406         if ( gr_name_type(p)==0 )
5407           mp_mark_string_chars(mp, f, gr_text_p(p));
5408       }
5409     }
5410   }
5411   p=gr_link(p);
5412 }
5413
5414
5415 @
5416 @d pen_is_elliptical(A) ((A)==gr_next_knot((A)))
5417
5418 @<Exported function headers@>=
5419 void mp_gr_ship_out (MP mp, struct mp_edge_object *hh) ;
5420
5421 @ @c
5422 void mp_gr_ship_out (MP mp, struct mp_edge_object *hh) {
5423   struct mp_graphic_object *p;
5424   scaled ds,scf; /* design size and scale factor for a text node */
5425   font_number f; /* for loops over fonts while (un)marking characters */
5426   boolean transformed; /* is the coordinate system being transformed? */
5427   scaled prologues = mp->internal[mp_prologues];
5428   mp_open_output_file(mp);
5429   mp_print_initial_comment(mp, hh);
5430   p = hh->body;
5431   @<Unmark all marked characters@>;
5432   if ( prologues==two || prologues==three ) {
5433     mp_reload_encodings(mp);
5434   }
5435   @<Scan all the text nodes and mark the used characters@>;
5436   if ( prologues==two || prologues==three ) {
5437     mp_print_improved_prologue(mp, hh);
5438   } else {
5439     mp_print_prologue(mp, hh);
5440   }
5441   mp_gs_unknown_graphics_state(mp, 0);
5442   p = hh->body;
5443   while ( p!=NULL ) {
5444     if ( gr_has_color(p) ) {
5445       if ( (gr_pre_script(p))!=NULL ) {
5446         mp_ps_print_nl (mp, gr_pre_script(p));
5447             mp_ps_print_ln(mp);
5448       }
5449     }
5450     mp_gr_fix_graphics_state(mp, p);
5451     switch (gr_type(p)) {
5452     case mp_fill_code:
5453       if ( gr_pen_p(p)==NULL ) {
5454         mp_gr_ps_fill_out(mp, gr_path_p(p));
5455       } else if ( pen_is_elliptical(gr_pen_p(p)) )  {
5456         mp_gr_stroke_ellipse(mp, p,true);
5457       } else {
5458         mp_gr_ps_fill_out(mp, gr_path_p(p));
5459         mp_gr_ps_fill_out(mp, gr_htap_p(p));
5460       }
5461       if ( gr_post_script(p)!=NULL ) {
5462          mp_ps_print_nl (mp, gr_post_script(p));
5463              mp_ps_print_ln(mp);
5464       }
5465       break;
5466     case mp_stroked_code:
5467       if ( pen_is_elliptical(gr_pen_p(p)) ) mp_gr_stroke_ellipse(mp, p,false);
5468       else {
5469         mp_gr_ps_fill_out(mp, gr_path_p(p));
5470       }
5471       if ( gr_post_script(p)!=NULL ) {
5472         mp_ps_print_nl (mp, gr_post_script(p)); mp_ps_print_ln(mp);
5473       }
5474       break;
5475     case mp_text_code:
5476       if ( (gr_font_n(p)!=null_font) && (strlen(gr_text_p(p))>0) ) {
5477         if ( mp->internal[mp_prologues]>0 )
5478           scf=mp_gr_choose_scale(mp, p);
5479         else
5480           scf=mp_indexed_size(mp, gr_font_n(p), gr_name_type(p));
5481         @<Shift or transform as necessary before outputting text node~|p| at scale
5482           factor~|scf|; set |transformed:=true| if the original transformation must
5483           be restored@>;
5484         mp_ps_string_out(mp, gr_text_p(p));
5485         mp_ps_name_out(mp, mp->font_name[gr_font_n(p)],false);
5486         @<Print the size information and \ps\ commands for text node~|p|@>;
5487         mp_ps_print_ln(mp);
5488       }
5489       if ( gr_post_script(p)!=NULL ) {
5490         mp_ps_print_nl (mp, gr_post_script(p)); mp_ps_print_ln(mp);
5491       }
5492       break;
5493     case mp_start_clip_code:
5494       mp_ps_print_nl(mp, ""); mp_ps_print_cmd(mp, "gsave ","q ");
5495       mp_gr_ps_path_out(mp, gr_path_p(p));
5496       mp_ps_print_cmd(mp, " clip"," W");
5497       mp_ps_print_ln(mp);
5498       if ( mp->internal[mp_restore_clip_color]>0 )
5499         mp_gs_unknown_graphics_state(mp, 1);
5500       break;
5501     case mp_stop_clip_code:
5502       mp_ps_print_nl(mp, ""); mp_ps_print_cmd(mp, "grestore","Q");
5503       mp_ps_print_ln(mp);
5504       if ( mp->internal[mp_restore_clip_color]>0 )
5505         mp_gs_unknown_graphics_state(mp, 2);
5506       else
5507         mp_gs_unknown_graphics_state(mp, -1);
5508       break;
5509     case mp_start_bounds_code:
5510     case mp_stop_bounds_code:
5511           break;
5512     case mp_special_code:
5513       mp_ps_print_nl (mp, gr_pre_script(p));
5514           mp_ps_print_ln (mp);
5515       break;
5516     } /* all cases are enumerated */
5517     p=gr_link(p);
5518   }
5519   mp_ps_print_cmd(mp, "showpage","P"); mp_ps_print_ln(mp);
5520   mp_ps_print(mp, "%%EOF"); mp_ps_print_ln(mp);
5521   mp_gr_toss_objects(mp, hh->body);
5522   (mp->close_file)(mp->ps_file);
5523   if ( mp->internal[mp_prologues]<=0 )
5524     mp_clear_sizes(mp);
5525 }
5526
5527 @ The envelope of a cyclic path~|q| could be computed by calling
5528 |make_envelope| once for |q| and once for its reversal.  We don't do this
5529 because it would fail color regions that are covered by the pen regardless
5530 of where it is placed on~|q|.
5531
5532 @<Break the cycle and set |t:=1| if path |q| is cyclic@>=
5533 if ( gr_left_type(q)!=mp_endpoint ) {
5534   gr_left_type(mp_gr_insert_knot(mp, q,gr_x_coord(q),gr_y_coord(q)))=mp_endpoint;
5535   gr_right_type(q)=mp_endpoint;
5536   q=gr_next_knot(q);
5537   t=1;
5538 }
5539
5540 @ @<Print the size information and \ps\ commands for text node~|p|@>=
5541 ps_room(18);
5542 mp_ps_print_char(mp, ' ');
5543 ds=(mp->font_dsize[gr_font_n(p)]+8) / 16;
5544 mp_ps_print_scaled(mp, mp_take_scaled(mp, ds,scf));
5545 mp_ps_print(mp, " fshow");
5546 if ( transformed )
5547    mp_ps_print_cmd(mp, " grestore"," Q")
5548
5549
5550
5551 @ @<Shift or transform as necessary before outputting text node~|p| at...@>=
5552 transformed=(gr_txx_val(p)!=scf)||(gr_tyy_val(p)!=scf)||
5553             (gr_txy_val(p)!=0)||(gr_tyx_val(p)!=0);
5554 if ( transformed ) {
5555   mp_ps_print_cmd(mp, "gsave [", "q [");
5556   mp_ps_pair_out(mp, mp_make_scaled(mp, gr_txx_val(p),scf),
5557                      mp_make_scaled(mp, gr_tyx_val(p),scf));
5558   mp_ps_pair_out(mp, mp_make_scaled(mp, gr_txy_val(p),scf),
5559                      mp_make_scaled(mp, gr_tyy_val(p),scf));
5560   mp_ps_pair_out(mp, gr_tx_val(p),gr_ty_val(p));
5561   mp_ps_print_cmd(mp, "] concat 0 0 moveto","] t 0 0 m");
5562 } else {
5563   mp_ps_pair_out(mp, gr_tx_val(p),gr_ty_val(p));
5564   mp_ps_print_cmd(mp, "moveto","m");
5565 }
5566 mp_ps_print_ln(mp)
5567
5568
5569 @
5570 @d mp_gr_toss_objects(A,B)  mp_do_gr_toss_objects(B)
5571
5572 @<Declarations@>=
5573 void mp_do_gr_toss_objects (struct mp_graphic_object *p) ;
5574
5575 @ @c
5576 void mp_do_gr_toss_objects (struct mp_graphic_object *p) {
5577   struct mp_graphic_object *q;
5578   while ( p!=NULL ) {
5579     switch (gr_type(p)) {
5580     case mp_fill_code:
5581       mp_xfree(gr_pre_script(p));
5582       mp_xfree(gr_post_script(p));
5583       mp_gr_toss_knot_list(mp,gr_pen_p(p));
5584       mp_gr_toss_knot_list(mp,gr_path_p(p));
5585       mp_gr_toss_knot_list(mp,gr_htap_p(p));
5586           break;
5587     case mp_stroked_code:
5588       mp_xfree(gr_pre_script(p));
5589       mp_xfree(gr_post_script(p));
5590       mp_gr_toss_knot_list(mp,gr_pen_p(p));
5591       mp_gr_toss_knot_list(mp,gr_path_p(p));
5592       if (gr_dash_p(p)!=NULL)
5593         mp_gr_toss_dashes   (mp,gr_dash_p(p));
5594       break;
5595     case mp_text_code:
5596       mp_xfree(gr_pre_script(p));
5597       mp_xfree(gr_post_script(p));
5598       mp_xfree(gr_text_p(p));
5599       break;
5600     case mp_start_clip_code:
5601     case mp_start_bounds_code:
5602       mp_gr_toss_knot_list(mp,gr_path_p(p));
5603       break;
5604     case mp_stop_clip_code:
5605     case mp_stop_bounds_code:
5606           break;
5607     case mp_special_code:
5608       mp_xfree(gr_pre_script(p));
5609           break;
5610     } /* all cases are enumerated */
5611         q = gr_link(p);
5612     mp_xfree(p);
5613     p=q;
5614   }
5615 }