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

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