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