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

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