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