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