1 % $Id
: mp.w
2070M
2015-11-10 16:03:56Z
(local
) $
3 % This file is part of MetaPost
;
4 % the MetaPost program is in the public domain.
5 % See the
<Show version...
> code in mpost.w for more info.
7 % Here is TeX material that gets inserted after \input webmac
8 \def\hang
{\hangindent
3em\noindent\ignorespaces
}
9 \def\textindent#
1{\hangindent2.5em\noindent\hbox to2.5em
{\hss#
1 }\ignorespaces
}
11 \def\psqrt#
1{\sqrt
{\mathstrut#
1}}
13 \def\pct
!{{\char`\
%}} % percent sign in ordinary text
14 \font\tenlogo
=logo10
% font used for the METAFONT logo
16 \def\MF
{{\tenlogo META
}\
-{\tenlogo
FONT}}
17 \def\MP
{{\tenlogo META
}\
-{\tenlogo POST
}}
18 \def\
<#
1>{$\langle#
1\rangle$
}
19 \def\section
{\mathhexbox278
}
20 \let\swap
=\leftrightarrow
21 \def\round
{\mathop
{\rm round
}\nolimits
}
22 \mathchardef\vbv
="026A % synonym for `\|'
23 \def\vb{\relax\ifmmode\vbv\else$\vbv$\fi}
25 \def\(#1){} % this is used to make section names sort themselves better
26 \def\9#1{} % this is used for sort keys in the index via @@:sort key}{entry@@>
33 This is \MP\ by John Hobby, a graphics-language processor based on D. E. Knuth's \MF.
35 Much of the original Pascal version of this program was copied with
36 permission from MF.web Version 1.9. It interprets a language very
37 similar to D.E. Knuth's METAFONT, but with changes designed to make it
38 more suitable for PostScript output.
40 The main purpose of the following program is to explain the algorithms of \MP\
41 as clearly as possible. However, the program has been written so that it
42 can be tuned to run efficiently in a wide variety of operating environments
43 by making comparatively few changes. Such flexibility is possible because
44 the documentation that follows is written in the \.{WEB} language, which is
45 at a higher level than C.
47 A large piece of software like \MP\ has inherent complexity that cannot
48 be reduced below a certain level of difficulty, although each individual
49 part is fairly simple by itself. The \.{WEB} language is intended to make
50 the algorithms as readable as possible, by reflecting the way the
51 individual program pieces fit together and by providing the
52 cross-references that connect different parts. Detailed comments about
53 what is going on, and about why things were done in certain ways, have
54 been liberally sprinkled throughout the program. These comments explain
55 features of the implementation, but they rarely attempt to explain the
56 \MP\ language itself, since the reader is supposed to be familiar with
57 {\sl The {\logos METAFONT\/}book} as well as the manual
59 @:METAFONTbook}{\sl The {\logos METAFONT\/}book@>
60 {\sl A User's Manual for MetaPost}, Computing Science Technical Report 162,
61 AT\AM T Bell Laboratories.
63 @ The present implementation is a preliminary version, but the possibilities
64 for new features are limited by the desire to remain as nearly compatible
65 with \MF\ as possible.
67 On the other hand, the \.{WEB} description can be extended without changing
68 the core of the program, and it has been designed so that such
69 extensions are not extremely difficult to make.
70 The |banner| string defined here should be changed whenever \MP\
71 undergoes any modifications, so that it will be clear which version of
72 \MP\ might be the guilty party when a problem arises.
74 @^system dependencies@>
76 @d default_banner "This is MetaPost
, Version
1.999" /* printed when \MP\ starts */
80 @<Metapost version header@>=
81 #define metapost_version "1.999"
83 @ The external library header for \MP\ is |mplib.h|. It contains a
84 few typedefs and the header defintions for the externally used
87 The most important of the typedefs is the definition of the structure
88 |MP_options|, that acts as a small, configurable front-end to the fairly
89 large |MP_instance| structure.
98 @<Metapost version header@>
99 typedef struct MP_instance *MP;
101 typedef struct MP_options {
104 @<Exported function headers@>
105 @<MPlib header stuff@>
108 @ The internal header file is much longer: it not only lists the complete
109 |MP_instance|, but also a lot of functions that have to be available to
110 the \ps\ backend, that is defined in a separate \.{WEB} file.
112 The variables from |MP_options| are included inside the |MP_instance|
121 typedef struct psout_data_struct *psout_data;
122 typedef struct svgout_data_struct *svgout_data;
123 typedef struct pngout_data_struct *pngout_data;
131 @<Enumeration types@>;
132 @<Types in the outer block@>;
133 @<Constants in the outer block@>;
134 typedef struct MP_instance {
138 @<Internal library declarations@>
139 @<MPlib internal header stuff@>
143 #define KPATHSEA_DEBUG_H 1
144 #include <w2c/config.h>
152 # include <unistd.h> /* for access */
154 #include <time.h> /* for struct tm \& co */
155 #include <zlib.h> /* for |ZLIB_VERSION|, zlibVersion() */
156 #include <png.h> /* for |PNG_LIBPNG_VER_STRING|, |png_libpng_ver| */
157 #include <pixman.h> /* for |PIXMAN_VERSION_STRING|, |pixman_version_string()| */
158 #include <cairo.h> /* for |CAIRO_VERSION_STRING|, |cairo_version_string()| */
159 #include <gmp.h> /* for |gmp_version| */
160 #include <mpfr.h> /* for |MPFR_VERSION_STRING|, |mpfr_get_version()| */
162 #include "mplibps.h
" /* external header */
163 #include "mplibsvg.h
" /* external header */
164 #include "mplibpng.h
" /* external header */
165 #include "mpmp.h
" /* internal header */
166 #include "mppsout.h
" /* internal header */
167 #include "mpsvgout.h
" /* internal header */
168 #include "mppngout.h
" /* internal header */
169 #include "mpmath.h
" /* internal header */
170 #include "mpmathdouble.h
" /* internal header */
171 #include "mpmathdecimal.h
" /* internal header */
172 #include "mpmathbinary.h
" /* internal header */
173 #include "mpstrings.h
" /* internal header */
174 extern font_number mp_read_font_info (MP mp, char *fname); /* tfmin.w */
176 @<Basic printing procedures@>;
177 @<Error handling procedures@>
179 @ Some debugging support for development. The trick with the variadic macros
180 probably only works in gcc, as this preprocessor feature was not formalized
181 until the c99 standard (and that is too new for us). Lets' hope that at least
182 most compilers understand the non-debug version.
183 @^system dependencies@>
185 @<MPlib internal header stuff@>=
188 #define debug_number(A) printf("%d
: %s
=%.32f
(%d
)\n
", __LINE__, #A, number_to_double(A), number_to_scaled(A))
190 #define debug_number(A)
193 void do_debug_printf(MP mp, const char *prefix, const char *fmt, ...);
194 # define debug_printf(a1,a2,a3) do_debug_printf(mp, "", a1,a2,a3)
195 # define FUNCTION_TRACE1(a1) do_debug_printf(mp, "FTRACE
: ", a1)
196 # define FUNCTION_TRACE2(a1,a2) do_debug_printf(mp, "FTRACE
: ", a1,a2)
197 # define FUNCTION_TRACE3(a1,a2,a3) do_debug_printf(mp, "FTRACE
: ", a1,a2,a3)
198 # define FUNCTION_TRACE3X(a1,a2,a3) (void)mp
199 # define FUNCTION_TRACE4(a1,a2,a3,a4) do_debug_printf(mp, "FTRACE
: ", a1,a2,a3,a4)
201 # define debug_printf(a1,a2,a3)
202 # define FUNCTION_TRACE1(a1) (void)mp
203 # define FUNCTION_TRACE2(a1,a2) (void)mp
204 # define FUNCTION_TRACE3(a1,a2,a3) (void)mp
205 # define FUNCTION_TRACE3X(a1,a2,a3) (void)mp
206 # define FUNCTION_TRACE4(a1,a2,a3,a4) (void)mp
209 @ This function occasionally crashes (if something is written after the
210 log file is already closed), but that is not so important while debugging.
214 void do_debug_printf(MP mp, const char *prefix, const char *fmt, ...) ;
215 void do_debug_printf(MP mp, const char *prefix, const char *fmt, ...) {
219 if (mp->log_file && !ferror((FILE *)mp->log_file)) {
220 fputs(prefix, mp->log_file);
221 vfprintf(mp->log_file, fmt, ap);
227 if (mp->term_out && !ferror((FILE *)mp->term_out)) {
231 fputs(prefix, mp->term_out);
232 vfprintf(mp->term_out, fmt, ap);
234 fputs(prefix, stdout);
235 vfprintf(stdout, fmt, ap);
241 @ Here are the functions that set up the \MP\ instance.
244 MP_options *mp_options (void);
245 MP mp_initialize (MP_options * opt);
248 MP_options *mp_options (void) {
250 size_t l = sizeof (MP_options);
259 @ @<Internal library declarations@>=
260 @<Declare subroutines for parsing file names@>
263 @ The whole instance structure is initialized with zeroes,
264 this greatly reduces the number of statements needed in
265 the |Allocate or initialize variables| block.
267 @d set_callback_option(A) do { mp->A = mp_##A;
268 if (opt->A!=NULL) mp->A = opt->A;
272 static MP mp_do_new (jmp_buf * buf) {
273 MP mp = malloc (sizeof (MP_instance));
278 memset (mp, 0, sizeof (MP_instance));
285 static void mp_free (MP mp) {
286 int k; /* loop variable */
287 @<Dealloc variables@>;
288 if (mp->noninteractive) {
289 @<Finish non-interactive use@>;
291 xfree (mp->jump_buf);
292 @<Free table entries@>;
299 static void mp_do_initialize (MP mp) {
300 @<Local variables for initialization@>;
301 @<Set initial values of key variables@>;
304 @ For the retargetable math library, we need to have a pointer, at least.
306 @<Global variables@>=
309 @ @<Exported types@>=
324 typedef struct mp_number_data {
325 mp_number_store data;
328 typedef struct mp_number_data mp_number;
329 #define is_number(A) ((A).type != mp_nan_type)
331 typedef void (*convert_func) (mp_number *r);
332 typedef void (*m_log_func) (MP mp, mp_number *r, mp_number a);
333 typedef void (*m_exp_func) (MP mp, mp_number *r, mp_number a);
334 typedef void (*m_unif_rand_func) (MP mp, mp_number *ret, mp_number x_orig);
335 typedef void (*m_norm_rand_func) (MP mp, mp_number *ret);
336 typedef void (*pyth_add_func) (MP mp, mp_number *r, mp_number a, mp_number b);
337 typedef void (*pyth_sub_func) (MP mp, mp_number *r, mp_number a, mp_number b);
338 typedef void (*n_arg_func) (MP mp, mp_number *r, mp_number a, mp_number b);
339 typedef void (*velocity_func) (MP mp, mp_number *r, mp_number a, mp_number b, mp_number c, mp_number d, mp_number e);
340 typedef void (*ab_vs_cd_func) (MP mp, mp_number *r, mp_number a, mp_number b, mp_number c, mp_number d);
341 typedef void (*crossing_point_func) (MP mp, mp_number *r, mp_number a, mp_number b, mp_number c);
342 typedef void (*number_from_int_func) (mp_number *A, int B);
343 typedef void (*number_from_boolean_func) (mp_number *A, int B);
344 typedef void (*number_from_scaled_func) (mp_number *A, int B);
345 typedef void (*number_from_double_func) (mp_number *A, double B);
346 typedef void (*number_from_addition_func) (mp_number *A, mp_number B, mp_number C);
347 typedef void (*number_from_substraction_func) (mp_number *A, mp_number B, mp_number C);
348 typedef void (*number_from_div_func) (mp_number *A, mp_number B, mp_number C);
349 typedef void (*number_from_mul_func) (mp_number *A, mp_number B, mp_number C);
350 typedef void (*number_from_int_div_func) (mp_number *A, mp_number B, int C);
351 typedef void (*number_from_int_mul_func) (mp_number *A, mp_number B, int C);
352 typedef void (*number_from_oftheway_func) (MP mp, mp_number *A, mp_number t, mp_number B, mp_number C);
353 typedef void (*number_negate_func) (mp_number *A);
354 typedef void (*number_add_func) (mp_number *A, mp_number B);
355 typedef void (*number_substract_func) (mp_number *A, mp_number B);
356 typedef void (*number_modulo_func) (mp_number *A, mp_number B);
357 typedef void (*number_half_func) (mp_number *A);
358 typedef void (*number_halfp_func) (mp_number *A);
359 typedef void (*number_double_func) (mp_number *A);
360 typedef void (*number_abs_func) (mp_number *A);
361 typedef void (*number_clone_func) (mp_number *A, mp_number B);
362 typedef void (*number_swap_func) (mp_number *A, mp_number *B);
363 typedef void (*number_add_scaled_func) (mp_number *A, int b);
364 typedef void (*number_multiply_int_func) (mp_number *A, int b);
365 typedef void (*number_divide_int_func) (mp_number *A, int b);
366 typedef int (*number_to_int_func) (mp_number A);
367 typedef int (*number_to_boolean_func) (mp_number A);
368 typedef int (*number_to_scaled_func) (mp_number A);
369 typedef int (*number_round_func) (mp_number A);
370 typedef void (*number_floor_func) (mp_number *A);
371 typedef double (*number_to_double_func) (mp_number A);
372 typedef int (*number_odd_func) (mp_number A);
373 typedef int (*number_equal_func) (mp_number A, mp_number B);
374 typedef int (*number_less_func) (mp_number A, mp_number B);
375 typedef int (*number_greater_func) (mp_number A, mp_number B);
376 typedef int (*number_nonequalabs_func) (mp_number A, mp_number B);
377 typedef void (*make_scaled_func) (MP mp, mp_number *ret, mp_number A, mp_number B);
378 typedef void (*make_fraction_func) (MP mp, mp_number *ret, mp_number A, mp_number B);
379 typedef void (*take_fraction_func) (MP mp, mp_number *ret, mp_number A, mp_number B);
380 typedef void (*take_scaled_func) (MP mp, mp_number *ret, mp_number A, mp_number B);
381 typedef void (*sin_cos_func) (MP mp, mp_number A, mp_number *S, mp_number *C);
382 typedef void (*slow_add_func) (MP mp, mp_number *A, mp_number S, mp_number C);
383 typedef void (*sqrt_func) (MP mp, mp_number *ret, mp_number A);
384 typedef void (*init_randoms_func) (MP mp, int seed);
385 typedef void (*new_number_func) (MP mp, mp_number *A, mp_number_type t);
386 typedef void (*free_number_func) (MP mp, mp_number *n);
387 typedef void (*fraction_to_round_scaled_func) (mp_number *n);
388 typedef void (*print_func) (MP mp, mp_number A);
389 typedef char * (*tostring_func) (MP mp, mp_number A);
390 typedef void (*scan_func) (MP mp, int A);
391 typedef void (*mp_free_func) (MP mp);
392 typedef void (*set_precision_func) (MP mp);
394 typedef struct math_data {
395 mp_number precision_default;
396 mp_number precision_max;
397 mp_number precision_min;
400 mp_number one_third_inf_t;
405 mp_number half_unit_t;
406 mp_number three_quarter_unit_t;
407 mp_number fraction_one_t;
408 mp_number fraction_half_t;
409 mp_number fraction_three_t;
410 mp_number fraction_four_t;
411 mp_number one_eighty_deg_t;
412 mp_number three_sixty_deg_t;
414 mp_number sqrt_8_e_k;
415 mp_number twelve_ln_2_k;
416 mp_number coef_bound_k;
417 mp_number coef_bound_minus_1;
418 mp_number twelvebits_3;
420 mp_number twentysixbits_sqrt2_t;
421 mp_number twentyeightbits_d_t;
422 mp_number twentysevenbits_sqrt2_d_t;
423 mp_number fraction_threshold_t;
424 mp_number half_fraction_threshold_t;
425 mp_number scaled_threshold_t;
426 mp_number half_scaled_threshold_t;
427 mp_number near_zero_angle_t;
428 mp_number p_over_v_threshold_t;
429 mp_number equation_threshold_t;
430 mp_number tfm_warn_threshold_t;
431 mp_number warning_limit_t;
432 new_number_func allocate;
433 free_number_func free;
434 number_from_int_func from_int;
435 number_from_boolean_func from_boolean;
436 number_from_scaled_func from_scaled;
437 number_from_double_func from_double;
438 number_from_addition_func from_addition;
439 number_from_substraction_func from_substraction;
440 number_from_div_func from_div;
441 number_from_mul_func from_mul;
442 number_from_int_div_func from_int_div;
443 number_from_int_mul_func from_int_mul;
444 number_from_oftheway_func from_oftheway;
445 number_negate_func negate;
447 number_substract_func substract;
448 number_half_func half;
449 number_modulo_func modulo;
450 number_halfp_func halfp;
451 number_double_func do_double;
453 number_clone_func clone;
454 number_swap_func swap;
455 number_add_scaled_func add_scaled;
456 number_multiply_int_func multiply_int;
457 number_divide_int_func divide_int;
458 number_to_int_func to_int;
459 number_to_boolean_func to_boolean;
460 number_to_scaled_func to_scaled;
461 number_to_double_func to_double;
463 number_equal_func equal;
464 number_less_func less;
465 number_greater_func greater;
466 number_nonequalabs_func nonequalabs;
467 number_round_func round_unscaled;
468 number_floor_func floor_scaled;
469 make_scaled_func make_scaled;
470 make_fraction_func make_fraction;
471 take_fraction_func take_fraction;
472 take_scaled_func take_scaled;
473 velocity_func velocity;
474 ab_vs_cd_func ab_vs_cd;
475 crossing_point_func crossing_point;
479 m_unif_rand_func m_unif_rand;
480 m_norm_rand_func m_norm_rand;
481 pyth_add_func pyth_add;
482 pyth_sub_func pyth_sub;
483 fraction_to_round_scaled_func fraction_to_round_scaled;
484 convert_func fraction_to_scaled;
485 convert_func scaled_to_fraction;
486 convert_func scaled_to_angle;
487 convert_func angle_to_scaled;
488 init_randoms_func init_randoms;
489 sin_cos_func sin_cos;
491 slow_add_func slow_add;
493 tostring_func tostring;
494 scan_func scan_numeric;
495 scan_func scan_fractional;
496 mp_free_func free_math;
497 set_precision_func set_precision;
502 @ This procedure gets things started properly.
504 MP mp_initialize (MP_options * opt) {
506 jmp_buf *buf = malloc (sizeof (jmp_buf));
507 if (buf == NULL || setjmp (*buf) != 0)
509 mp = mp_do_new (buf);
512 mp->userdata = opt->userdata;
513 mp->noninteractive = opt->noninteractive;
514 mp->extensions = opt->extensions;
515 set_callback_option (find_file);
516 set_callback_option (open_file);
517 set_callback_option (read_ascii_file);
518 set_callback_option (read_binary_file);
519 set_callback_option (close_file);
520 set_callback_option (eof_file);
521 set_callback_option (flush_file);
522 set_callback_option (write_ascii_file);
523 set_callback_option (write_binary_file);
524 set_callback_option (shipout_backend);
525 set_callback_option (run_script);
526 set_callback_option (make_text);
527 if (opt->banner && *(opt->banner)) {
528 mp->banner = xstrdup (opt->banner);
530 mp->banner = xstrdup (default_banner);
532 if (opt->command_line && *(opt->command_line))
533 mp->command_line = xstrdup (opt->command_line);
534 if (mp->noninteractive) {
535 @<Prepare function pointers for non-interactive use@>;
537 /* open the terminal for output */
540 setvbuf(stdout, (char *) NULL, _IONBF, 0);
541 setvbuf(mp->term_out, (char *) NULL, _IONBF, 0);
543 if (opt->math_mode == mp_math_scaled_mode) {
544 mp->math = mp_initialize_scaled_math(mp);
545 } else if (opt->math_mode == mp_math_decimal_mode) {
546 mp->math = mp_initialize_decimal_math(mp);
547 } else if (opt->math_mode == mp_math_binary_mode) {
548 mp->math = mp_initialize_binary_math(mp);
550 mp->math = mp_initialize_double_math(mp);
552 @<Find and load preload file, if required@>;
553 @<Allocate or initialize variables@>;
554 mp_reallocate_paths (mp, 1000);
555 mp_reallocate_fonts (mp, 8);
556 mp->history = mp_fatal_error_stop; /* in case we quit during initialization */
557 @<Check the ``constant'' values...@>;
560 mp_snprintf (ss, 256, "Ouch---my internal constants have been clobbered
!\n
"
561 "---case
%i
", (int) mp->bad);
562 mp_fputs ((char *) ss, mp->err_out);
563 @.Ouch...clobbered@>;
566 mp_do_initialize (mp); /* erase preloaded mem */
567 mp_init_tab (mp); /* initialize the tables */
568 if (opt->math_mode == mp_math_scaled_mode) {
569 set_internal_string (mp_number_system, mp_intern (mp, "scaled
"));
570 } else if (opt->math_mode == mp_math_decimal_mode) {
571 set_internal_string (mp_number_system, mp_intern (mp, "decimal
"));
572 } else if (opt->math_mode == mp_math_binary_mode) {
573 set_internal_string (mp_number_system, mp_intern (mp, "binary
"));
575 set_internal_string (mp_number_system, mp_intern (mp, "double
"));
577 mp_init_prim (mp); /* call |primitive| for each primitive */
578 mp_fix_date_and_time (mp);
579 if (!mp->noninteractive) {
580 @<Initialize the output routines@>;
581 @<Get the first line of input and prepare to start@>;
582 @<Initializations after first line is read@>;
583 @<Fix up |mp->internal[mp_job_name]|@>;
585 mp->history = mp_spotless;
592 @ @<Initializations after first line is read@>=
593 mp_open_log_file (mp);
595 mp_init_map_file (mp, mp->troff_mode);
596 mp->history = mp_spotless; /* ready to go! */
597 if (mp->troff_mode) {
598 number_clone (internal_value (mp_gtroffmode), unity_t);
599 number_clone (internal_value (mp_prologues), unity_t);
601 if (mp->start_sym != NULL) { /* insert the `\&{everyjob}' symbol */
602 set_cur_sym (mp->start_sym);
606 @ @<Exported function headers@>=
607 extern MP_options *mp_options (void);
608 extern MP mp_initialize (MP_options * opt);
609 extern int mp_status (MP mp);
610 extern void *mp_userdata (MP mp);
613 int mp_status (MP mp) {
619 void *mp_userdata (MP mp) {
624 @ The overall \MP\ program begins with the heading just shown, after which
625 comes a bunch of procedure declarations and function declarations.
626 Finally we will get to the main program, which begins with the
627 comment `|start_here|'. If you want to skip down to the
628 main program now, you can look up `|start_here|' in the index.
629 But the author suggests that the best way to understand this program
630 is to follow pretty much the order of \MP's components as they appear in the
631 \.{WEB} description you are now reading, since the present ordering is
632 intended to combine the advantages of the ``bottom up'' and ``top down''
633 approaches to the problem of understanding a somewhat complicated system.
635 @ Some of the code below is intended to be used only when diagnosing the
636 strange behavior that sometimes occurs when \MP\ is being installed or
637 when system wizards are fooling around with \MP\ without quite knowing
638 what they are doing. Such code will not normally be compiled; it is
639 delimited by the preprocessor test `|#ifdef DEBUG .. #endif|'.
641 @ The following parameters can be changed at compile time to extend or
642 reduce \MP's capacity.
643 @^system dependencies@>
646 #define bistack_size 1500 /* size of stack for bisection algorithms;
647 should probably be left at this value */
649 @ Like the preceding parameters, the following quantities can be changed
650 to extend or reduce \MP's capacity.
653 int pool_size; /* maximum number of characters in strings, including all
654 error messages and help texts, and the names of all identifiers */
655 int max_in_open; /* maximum number of input files and error insertions that
656 can be going on simultaneously */
657 int param_size; /* maximum number of simultaneous macro parameters */
659 @ @<Option variables@>=
660 int error_line; /* width of context lines on terminal error messages */
661 int half_error_line; /* width of first lines of contexts in terminal
662 error messages; should be between 30 and |error_line-15| */
663 int halt_on_error; /* do we quit at the first error? */
664 int max_print_line; /* width of longest text lines output; should be at least 60 */
665 void *userdata; /* this allows the calling application to setup local */
666 char *banner; /* the banner that is printed to the screen and log */
669 @ @<Dealloc variables@>=
673 @d set_lower_limited_value(a,b,c) do { a=c; if (b>c) a=b; } while (0)
678 mp->pool_size = 10000;
679 set_lower_limited_value (mp->error_line, opt->error_line, 79);
680 set_lower_limited_value (mp->half_error_line, opt->half_error_line, 50);
681 if (mp->half_error_line > mp->error_line - 15)
682 mp->half_error_line = mp->error_line - 15;
683 mp->max_print_line = 100;
684 set_lower_limited_value (mp->max_print_line, opt->max_print_line, 79);
685 mp->halt_on_error = (opt->halt_on_error ? true : false);
686 mp->ini_version = (opt->ini_version ? true : false);
688 @ In case somebody has inadvertently made bad settings of the ``constants,''
689 \MP\ checks them using a global variable called |bad|.
691 This is the second of many sections of \MP\ where global variables are
695 integer bad; /* is some ``constant'' wrong? */
697 @ Later on we will say `|if ( int_packets+17*int_increment>bistack_size )mp->bad=19;|',
698 or something similar.
700 In case you are wondering about the non-consequtive values of |bad|: most
701 of the things that used to be WEB constants are now runtime variables
702 with checking at assignment time.
704 @<Check the ``constant'' values for consistency@>=
707 @ Here are some macros for common programming idioms.
709 @d incr(A) (A)=(A)+1 /* increase a variable by unity */
710 @d decr(A) (A)=(A)-1 /* decrease a variable by unity */
711 @d negate(A) (A)=-(A) /* change the sign of a variable */
712 @d double(A) (A)=(A)+(A)
713 @d odd(A) (abs(A)%2==1)
715 @* The character set.
716 In order to make \MP\ readily portable to a wide variety of
717 computers, all of its input text is converted to an internal eight-bit
718 code that includes standard ASCII, the ``American Standard Code for
719 Information Interchange.'' This conversion is done immediately when each
720 character is read in. Conversely, characters are converted from ASCII to
721 the user's external representation just before they are output to a
725 Such an internal code is relevant to users of \MP\ only with respect to
726 the \&{char} and \&{ASCII} operations, and the comparison of strings.
728 @ Characters of text that have been converted to \MP's internal form
729 are said to be of type |ASCII_code|, which is a subrange of the integers.
732 typedef unsigned char ASCII_code; /* eight-bit numbers */
734 @ The present specification of \MP\ has been written under the assumption
735 that the character set contains at least the letters and symbols associated
736 with ASCII codes 040 through 0176; all of these characters are now
737 available on most computer terminals.
740 typedef unsigned char text_char; /* the data type of characters in text files */
742 @ @<Local variables for init...@>=
745 @ The \MP\ processor converts between ASCII code and
746 the user's external character set by means of arrays |xord| and |xchr|
747 that are analogous to Pascal's |ord| and |chr| functions.
749 @<MPlib internal header stuff@>=
750 #define xchr(A) mp->xchr[(A)]
751 #define xord(A) mp->xord[(A)]
754 ASCII_code xord[256]; /* specifies conversion of input characters */
755 text_char xchr[256]; /* specifies conversion of output characters */
757 @ The core system assumes all 8-bit is acceptable. If it is not,
758 a change file has to alter the below section.
759 @^system dependencies@>
761 Additionally, people with extended character sets can
762 assign codes arbitrarily, giving an |xchr| equivalent to whatever
763 characters the users of \MP\ are allowed to have in their input files.
764 Appropriate changes to \MP's |char_class| table should then be made.
765 (Unlike \TeX, each installation of \MP\ has a fixed assignment of category
766 codes, called the |char_class|.) Such changes make portability of programs
767 more difficult, so they should be introduced cautiously if at all.
768 @^character set dependencies@>
769 @^system dependencies@>
772 for (i = 0; i <= 0377; i++) {
773 xchr (i) = (text_char) i;
777 @ The following system-independent code makes the |xord| array contain a
778 suitable inverse to the information in |xchr|. Note that if |xchr[i]=xchr[j]|
779 where |i<j<0177|, the value of |xord[xchr[i]]| will turn out to be
780 |j| or more; hence, standard ASCII code numbers will be used instead of
781 codes below 040 in case there is a coincidence.
784 for (i = 0; i <= 255; i++) {
785 xord (xchr (i)) = 0177;
787 for (i = 0200; i <= 0377; i++) {
788 xord (xchr (i)) = (ASCII_code) i;
790 for (i = 0; i <= 0176; i++) {
791 xord (xchr (i)) = (ASCII_code) i;
796 The bane of portability is the fact that different operating systems treat
797 input and output quite differently, perhaps because computer scientists
798 have not given sufficient attention to this problem. People have felt somehow
799 that input and output are not part of ``real'' programming. Well, it is true
800 that some kinds of programming are more fun than others. With existing
801 input/output conventions being so diverse and so messy, the only sources of
802 joy in such parts of the code are the rare occasions when one can find a
803 way to make the program a little less bad than it might have been. We have
804 two choices, either to attack I/O now and get it over with, or to postpone
805 I/O until near the end. Neither prospect is very attractive, so let's
808 The basic operations we need to do are (1)~inputting and outputting of
809 text, to or from a file or the user's terminal; (2)~inputting and
810 outputting of eight-bit bytes, to or from a file; (3)~instructing the
811 operating system to initiate (``open'') or to terminate (``close'') input or
812 output from a specified file; (4)~testing whether the end of an input
813 file has been reached; (5)~display of bits on the user's screen.
814 The bit-display operation will be discussed in a later section; we shall
815 deal here only with more traditional kinds of I/O.
817 @ Finding files happens in a slightly roundabout fashion: the \MP\
818 instance object contains a field that holds a function pointer that finds a
819 file, and returns its name, or NULL. For this, it receives three
820 parameters: the non-qualified name |fname|, the intended |fopen|
821 operation type |fmode|, and the type of the file |ftype|.
823 The file types that are passed on in |ftype| can be used to
824 differentiate file searches if a library like kpathsea is used,
825 the fopen mode is passed along for the same reason.
828 typedef unsigned char eight_bits; /* unsigned one-byte quantity */
830 @ @<Exported types@>=
832 mp_filetype_terminal = 0, /* the terminal */
833 mp_filetype_error, /* the terminal */
834 mp_filetype_program, /* \MP\ language input */
835 mp_filetype_log, /* the log file */
836 mp_filetype_postscript, /* the postscript output */
837 mp_filetype_bitmap, /* the bitmap output file */
838 mp_filetype_memfile, /* memory dumps, obsolete */
839 mp_filetype_metrics, /* TeX font metric files */
840 mp_filetype_fontmap, /* PostScript font mapping files */
841 mp_filetype_font, /* PostScript type1 font programs */
842 mp_filetype_encoding, /* PostScript font encoding files */
843 mp_filetype_text /* first text file for readfrom and writeto primitives */
845 typedef char *(*mp_file_finder) (MP, const char *, const char *, int);
846 typedef char *(*mp_script_runner) (MP, const char *);
847 typedef char *(*mp_text_maker) (MP, const char *, int mode);
848 typedef void *(*mp_file_opener) (MP, const char *, const char *, int);
849 typedef char *(*mp_file_reader) (MP, void *, size_t *);
850 typedef void (*mp_binfile_reader) (MP, void *, void **, size_t *);
851 typedef void (*mp_file_closer) (MP, void *);
852 typedef int (*mp_file_eoftest) (MP, void *);
853 typedef void (*mp_file_flush) (MP, void *);
854 typedef void (*mp_file_writer) (MP, void *, const char *);
855 typedef void (*mp_binfile_writer) (MP, void *, void *, size_t);
857 @ @<Option variables@>=
858 mp_file_finder find_file;
859 mp_file_opener open_file;
860 mp_script_runner run_script;
861 mp_text_maker make_text;
862 mp_file_reader read_ascii_file;
863 mp_binfile_reader read_binary_file;
864 mp_file_closer close_file;
865 mp_file_eoftest eof_file;
866 mp_file_flush flush_file;
867 mp_file_writer write_ascii_file;
868 mp_binfile_writer write_binary_file;
870 @ The default function for finding files is |mp_find_file|. It is
871 pretty stupid: it will only find files in the current directory.
874 static char *mp_find_file (MP mp, const char *fname, const char *fmode,
877 if (fmode[0] != 'r' || (!access (fname, R_OK)) || ftype) {
878 return mp_strdup (fname);
884 static char *mp_run_script (MP mp, const char *str) {
886 return mp_strdup (str);
890 static char *mp_make_text (MP mp, const char *str, int mode) {
892 return mp_strdup (str);
895 @ Because |mp_find_file| is used so early, it has to be in the helpers
899 static char *mp_find_file (MP mp, const char *fname, const char *fmode,
901 static void *mp_open_file (MP mp, const char *fname, const char *fmode,
903 static char *mp_read_ascii_file (MP mp, void *f, size_t * size);
904 static void mp_read_binary_file (MP mp, void *f, void **d, size_t * size);
905 static void mp_close_file (MP mp, void *f);
906 static int mp_eof_file (MP mp, void *f);
907 static void mp_flush_file (MP mp, void *f);
908 static void mp_write_ascii_file (MP mp, void *f, const char *s);
909 static void mp_write_binary_file (MP mp, void *f, void *s, size_t t);
910 static char *mp_run_script (MP mp, const char *str);
911 static char *mp_make_text (MP mp, const char *str, int mode);
913 @ The function to open files can now be very short.
916 void *mp_open_file (MP mp, const char *fname, const char *fmode, int ftype) {
919 realmode[0] = *fmode;
922 if (ftype == mp_filetype_terminal) {
923 return (fmode[0] == 'r' ? stdin : stdout);
924 } else if (ftype == mp_filetype_error) {
926 } else if (fname != NULL && (fmode[0] != 'r' || (!access (fname, R_OK)))) {
927 return (void *) fopen (fname, realmode);
933 @ (Almost) all file names pass through |name_of_file|.
936 char *name_of_file; /* the name of a system file */
938 @ If this parameter is true, the terminal and log will report the found
939 file names for input files instead of the requested ones.
940 It is off by default because it creates an extra filename lookup.
942 @<Option variables@>=
943 int print_found_names; /* configuration parameter */
945 @ @<Allocate or initialize ...@>=
946 mp->print_found_names = (opt->print_found_names > 0 ? true : false);
948 @ The |file_line_error_style| parameter makes \MP\ use a more
949 standard compiler error message format instead of the Knuthian
950 exclamation mark. It needs the actual version of the current input
951 file name, that will be saved by |open_in| in the |long_name|.
953 TODO: currently these long strings cause memory leaks, because they cannot
954 be safely freed as they may appear in the |input_stack| multiple times.
955 In fact, the current implementation is just a quick hack in response
956 to a bug report for metapost 1.205.
958 @d long_name mp->cur_input.long_name_field /* long name of the current file */
960 @<Option variables@>=
961 int file_line_error_style; /* configuration parameter */
963 @ @<Allocate or initialize ...@>=
964 mp->file_line_error_style = (opt->file_line_error_style > 0 ? true : false);
966 @ \MP's file-opening procedures return |false| if no file identified by
967 |name_of_file| could be opened.
969 The |do_open_file| function takes care of the |print_found_names| parameter.
972 static boolean mp_do_open_file (MP mp, void **f, int ftype, const char *mode) {
973 if (mp->print_found_names || mp->file_line_error_style) {
974 char *s = (mp->find_file)(mp,mp->name_of_file,mode,ftype);
976 *f = (mp->open_file)(mp,mp->name_of_file,mode, ftype);
977 if (mp->print_found_names) {
978 xfree(mp->name_of_file);
979 mp->name_of_file = xstrdup(s);
981 if ((*mode == 'r') && (ftype == mp_filetype_program)) {
982 long_name = xstrdup(s);
989 *f = (mp->open_file)(mp,mp->name_of_file,mode, ftype);
991 return (*f ? true : false);
994 static boolean mp_open_in (MP mp, void **f, int ftype) {
995 /* open a file for input */
996 return mp_do_open_file (mp, f, ftype, "r
");
999 static boolean mp_open_out (MP mp, void **f, int ftype) {
1000 /* open a file for output */
1001 return mp_do_open_file (mp, f, ftype, "w
");
1006 static char *mp_read_ascii_file (MP mp, void *ff, size_t * size) {
1008 size_t len = 0, lim = 128;
1010 FILE *f = (FILE *) ff;
1012 (void) mp; /* for -Wunused */
1021 while (c != EOF && c != '\n' && c != '\r') {
1022 if ((len + 1) == lim) {
1023 s = realloc (s, (lim + (lim >> 2)));
1028 s[len++] = (char) c;
1033 if (c != EOF && c != '\n')
1043 void mp_write_ascii_file (MP mp, void *f, const char *s) {
1046 fputs (s, (FILE *) f);
1052 void mp_read_binary_file (MP mp, void *f, void **data, size_t * size) {
1056 len = fread (*data, 1, *size, (FILE *) f);
1062 void mp_write_binary_file (MP mp, void *f, void *s, size_t size) {
1065 (void) fwrite (s, size, 1, (FILE *) f);
1070 void mp_close_file (MP mp, void *f) {
1073 fclose ((FILE *) f);
1078 int mp_eof_file (MP mp, void *f) {
1081 return feof ((FILE *) f);
1088 void mp_flush_file (MP mp, void *f) {
1091 fflush ((FILE *) f);
1095 @ Input from text files is read one line at a time, using a routine called
1096 |input_ln|. This function is defined in terms of global variables called
1097 |buffer|, |first|, and |last| that will be described in detail later; for
1098 now, it suffices for us to know that |buffer| is an array of |ASCII_code|
1099 values, and that |first| and |last| are indices into this array
1100 representing the beginning and ending of a line of text.
1103 size_t buf_size; /* maximum number of characters simultaneously present in
1104 current lines of open files */
1105 ASCII_code *buffer; /* lines of characters being read */
1106 size_t first; /* the first unused position in |buffer| */
1107 size_t last; /* end of the line just input to |buffer| */
1108 size_t max_buf_stack; /* largest index used in |buffer| */
1110 @ @<Allocate or initialize ...@>=
1112 mp->buffer = xmalloc ((mp->buf_size + 1), sizeof (ASCII_code));
1114 @ @<Dealloc variables@>=
1118 static void mp_reallocate_buffer (MP mp, size_t l) {
1120 if (l > max_halfword) {
1121 mp_confusion (mp, "buffer size
"); /* can't happen (I hope) */
1123 buffer = xmalloc ((l + 1), sizeof (ASCII_code));
1124 (void) memcpy (buffer, mp->buffer, (mp->buf_size + 1));
1126 mp->buffer = buffer;
1131 @ The |input_ln| function brings the next line of input from the specified
1132 field into available positions of the buffer array and returns the value
1133 |true|, unless the file has already been entirely read, in which case it
1134 returns |false| and sets |last:=first|. In general, the |ASCII_code|
1135 numbers that represent the next line of the file are input into
1136 |buffer[first]|, |buffer[first+1]|, \dots, |buffer[last-1]|; and the
1137 global variable |last| is set equal to |first| plus the length of the
1138 line. Trailing blanks are removed from the line; thus, either |last=first|
1139 (in which case the line was entirely blank) or |buffer[last-1]<>" "|.
1142 The variable |max_buf_stack|, which is used to keep track of how large
1143 the |buf_size| parameter must be to accommodate the present job, is
1144 also kept up to date by |input_ln|.
1147 static boolean mp_input_ln (MP mp, void *f) {
1148 /* inputs the next line or returns |false| */
1151 mp->last = mp->first; /* cf.\ Matthew 19\thinspace:\thinspace30 */
1152 s = (mp->read_ascii_file) (mp, f, &size);
1156 mp->last = mp->first + size;
1157 if (mp->last >= mp->max_buf_stack) {
1158 mp->max_buf_stack = mp->last + 1;
1159 while (mp->max_buf_stack > mp->buf_size) {
1160 mp_reallocate_buffer (mp, (mp->buf_size + (mp->buf_size >> 2)));
1163 (void) memcpy ((mp->buffer + mp->first), s, size);
1170 @ The user's terminal acts essentially like other files of text, except
1171 that it is used both for input and for output. When the terminal is
1172 considered an input file, the file variable is called |term_in|, and when it
1173 is considered an output file the file variable is |term_out|.
1174 @^system dependencies@>
1177 void *term_in; /* the terminal as an input file */
1178 void *term_out; /* the terminal as an output file */
1179 void *err_out; /* the terminal as an output file */
1181 @ Here is how to open the terminal files. In the default configuration,
1182 nothing happens except that the command line (if there is one) is copied
1183 to the input buffer. The variable |command_line| will be filled by the
1186 @d t_open_out() do {/* open the terminal for text output */
1187 mp->term_out = (mp->open_file)(mp,"terminal
", "w
", mp_filetype_terminal);
1188 mp->err_out = (mp->open_file)(mp,"error
", "w
", mp_filetype_error);
1190 @d t_open_in() do { /* open the terminal for text input */
1191 mp->term_in = (mp->open_file)(mp,"terminal
", "r
", mp_filetype_terminal);
1192 if (mp->command_line!=NULL) {
1193 mp->last = strlen(mp->command_line);
1194 (void)memcpy((void *)mp->buffer,(void *)mp->command_line,mp->last);
1195 xfree(mp->command_line);
1201 @<Option variables@>=
1204 @ Sometimes it is necessary to synchronize the input/output mixture that
1205 happens on the user's terminal, and three system-dependent
1206 procedures are used for this
1207 purpose. The first of these, |update_terminal|, is called when we want
1208 to make sure that everything we have output to the terminal so far has
1209 actually left the computer's internal buffers and been sent.
1210 The second, |clear_terminal|, is called when we wish to cancel any
1211 input that the user may have typed ahead (since we are about to
1212 issue an unexpected error message). The third, |wake_up_terminal|,
1213 is supposed to revive the terminal if the user has disabled it by
1214 some instruction to the operating system. The following macros show how
1215 these operations can be specified:
1216 @^system dependencies@>
1218 @<MPlib internal header stuff@>=
1219 #define update_terminal() (mp->flush_file)(mp,mp->term_out) /* empty the terminal output buffer */
1220 #define clear_terminal() /* clear the terminal input buffer */
1221 #define wake_up_terminal() (mp->flush_file)(mp,mp->term_out)
1222 /* cancel the user's cancellation of output */
1224 @ We need a special routine to read the first line of \MP\ input from
1225 the user's terminal. This line is different because it is read before we
1226 have opened the transcript file; there is sort of a ``chicken and
1227 egg'' problem here. If the user types `\.{input cmr10}' on the first
1228 line, or if some macro invoked by that line does such an \.{input},
1229 the transcript file will be named `\.{cmr10.log}'; but if no \.{input}
1230 commands are performed during the first line of terminal input, the transcript
1231 file will acquire its default name `\.{mpout.log}'. (The transcript file
1232 will not contain error messages generated by the first line before the
1233 first \.{input} command.)
1235 The first line is even more special. It's nice to let the user start
1236 running a \MP\ job by typing a command line like `\.{MP cmr10}'; in
1237 such a case, \MP\ will operate as if the first line of input were
1238 `\.{cmr10}', i.e., the first line will consist of the remainder of the
1239 command line, after the part that invoked \MP.
1241 @ Different systems have different ways to get started. But regardless of
1242 what conventions are adopted, the routine that initializes the terminal
1243 should satisfy the following specifications:
1245 \yskip\textindent{1)}It should open file |term_in| for input from the
1246 terminal. (The file |term_out| will already be open for output to the
1249 \textindent{2)}If the user has given a command line, this line should be
1250 considered the first line of terminal input. Otherwise the
1251 user should be prompted with `\.{**}', and the first line of input
1252 should be whatever is typed in response.
1254 \textindent{3)}The first line of input, which might or might not be a
1255 command line, should appear in locations |first| to |last-1| of the
1258 \textindent{4)}The global variable |loc| should be set so that the
1259 character to be read next by \MP\ is in |buffer[loc]|. This
1260 character should not be blank, and we should have |loc<last|.
1262 \yskip\noindent(It may be necessary to prompt the user several times
1263 before a non-blank line comes in. The prompt is `\.{**}' instead of the
1264 later `\.*' because the meaning is slightly different: `\.{input}' need
1265 not be typed immediately after~`\.{**}'.)
1267 @d loc mp->cur_input.loc_field /* location of first unread character in |buffer| */
1270 boolean mp_init_terminal (MP mp) { /* gets the terminal input started */
1272 if (mp->last != 0) {
1278 if (!mp->noninteractive) {
1280 mp_fputs ("**", mp->term_out);
1284 if (!mp_input_ln (mp, mp->term_in)) { /* this shouldn't happen */
1285 mp_fputs ("\n
! End of file on the terminal... why?
", mp->term_out);
1286 @.End of file on the terminal@>;
1289 loc = (halfword) mp->first;
1290 while ((loc < (int) mp->last) && (mp->buffer[loc] == ' '))
1292 if (loc < (int) mp->last) {
1293 return true; /* return unless the line was all blank */
1295 if (!mp->noninteractive) {
1296 mp_fputs ("Please type the name of your input file.\n
", mp->term_out);
1303 static boolean mp_init_terminal (MP mp);
1305 @* Globals for strings.
1307 @ Symbolic token names and diagnostic messages are variable-length strings
1308 of eight-bit characters. Many strings \MP\ uses are simply literals
1309 in the compiled source, like the error messages and the names of the
1310 internal parameters. Other strings are used or defined from the \MP\ input
1311 language, and these have to be interned.
1313 \MP\ uses strings more extensively than \MF\ does, but the necessary
1314 operations can still be handled with a fairly simple data structure.
1315 The avl tree |strings| contains all of the known string structures.
1317 Each structure contains an |unsigned char| pointer containing the eight-bit
1318 data, a |size_t| that holds the length of that data, and an |int| that
1319 indicates how often this string is referenced (this will be explained below).
1320 Such strings are referred to by structure pointers called |mp_string|.
1322 Besides the avl tree, there is a set of three variables called |cur_string|,
1323 |cur_length| and |cur_string_size| that are used for strings while they are
1326 @<Exported types...@>=
1328 unsigned char *str; /* the string value */
1329 size_t len; /* its length */
1330 int refs; /* number of references */
1332 typedef mp_lstring *mp_string; /* for pointers to string values */
1334 @ The string handling functions are in \.{mpstrings.w}, but strings
1335 need a bunch of globals and those are defined here in the main file.
1338 avl_tree strings; /* string avl tree */
1339 unsigned char *cur_string; /* current string buffer */
1340 size_t cur_length; /* current index in that buffer */
1341 size_t cur_string_size; /* malloced size of |cur_string| */
1343 @ @<Allocate or initialize ...@>=
1344 mp_initialize_strings(mp);
1346 @ @<Dealloc variables@>=
1347 mp_dealloc_strings(mp);
1349 @ The next four variables are for keeping track of string memory usage.
1352 integer pool_in_use; /* total number of string bytes actually in use */
1353 integer max_pl_used; /* maximum |pool_in_use| so far */
1354 integer strs_in_use; /* total number of strings actually in use */
1355 integer max_strs_used; /* maximum |strs_in_use| so far */
1358 @* On-line and off-line printing.
1359 Messages that are sent to a user's terminal and to the transcript-log file
1360 are produced by several `|print|' procedures. These procedures will
1361 direct their output to a variety of places, based on the setting of
1362 the global variable |selector|, which has the following possible
1366 \hang |term_and_log|, the normal setting, prints on the terminal and on the
1369 \hang |log_only|, prints only on the transcript file.
1371 \hang |term_only|, prints only on the terminal.
1373 \hang |no_print|, doesn't print at all. This is used only in rare cases
1374 before the transcript file is open.
1376 \hang |pseudo|, puts output into a cyclic buffer that is used
1377 by the |show_context| routine; when we get to that routine we shall discuss
1378 the reasoning behind this curious mode.
1380 \hang |new_string|, appends the output to the current string in the
1383 \hang |>=write_file| prints on one of the files used for the \&{write}
1384 @:write_}{\&{write} primitive@>
1388 \noindent The symbolic names `|term_and_log|', etc., have been assigned
1389 numeric codes that satisfy the convenient relations |no_print+1=term_only|,
1390 |no_print+2=log_only|, |term_only+2=log_only+1=term_and_log|. These
1391 relations are not used when |selector| could be |pseudo|, or |new_string|.
1392 We need not check for unprintable characters when |selector<pseudo|.
1394 Three additional global variables, |tally|, |term_offset| and |file_offset|
1395 record the number of characters that have been printed
1396 since they were most recently cleared to zero. We use |tally| to record
1397 the length of (possibly very long) stretches of printing; |term_offset|,
1398 and |file_offset|, on the other hand, keep track of how many
1399 characters have appeared so far on the current line that has been output
1400 to the terminal, the transcript file, or the \ps\ output file, respectively.
1402 @d new_string 0 /* printing is deflected to the string pool */
1403 @d pseudo 2 /* special |selector| setting for |show_context| */
1404 @d no_print 3 /* |selector| setting that makes data disappear */
1405 @d term_only 4 /* printing is destined for the terminal only */
1406 @d log_only 5 /* printing is destined for the transcript file only */
1407 @d term_and_log 6 /* normal |selector| setting */
1408 @d write_file 7 /* first write file selector */
1411 void *log_file; /* transcript of \MP\ session */
1412 void *output_file; /* the generic font output goes here */
1413 unsigned int selector; /* where to print a message */
1414 integer tally; /* the number of characters recently printed */
1415 unsigned int term_offset;
1416 /* the number of characters on the current terminal line */
1417 unsigned int file_offset;
1418 /* the number of characters on the current file line */
1419 ASCII_code *trick_buf; /* circular buffer for pseudoprinting */
1420 integer trick_count; /* threshold for pseudoprinting, explained later */
1421 integer first_count; /* another variable for pseudoprinting */
1423 @ The first 128 strings will contain 95 standard ASCII characters, and the
1424 other 33 characters will be printed in three-symbol form like `\.{\^\^A}'
1425 unless a system-dependent change is made here. Installations that have
1426 an extended character set, where for example |xchr[032]=@t\.{'^^Z'}@>|,
1427 would like string 032 to be printed as the single character 032 instead
1428 of the three characters 0136, 0136, 0132 (\.{\^\^Z}). On the other hand,
1429 even people with an extended character set will want to represent string
1430 015 by \.{\^\^M}, since 015 is ASCII's ``carriage return'' code; the idea is
1431 to produce visible strings instead of tabs or line-feeds or carriage-returns
1432 or bell-rings or characters that are treated anomalously in text files.
1434 The boolean expression defined here should be |true| unless \MP\ internal
1435 code number~|k| corresponds to a non-troublesome visible symbol in the
1436 local character set.
1437 If character |k| cannot be printed, and |k<0200|, then character |k+0100| or
1438 |k-0100| must be printable; moreover, ASCII codes |[060..071, 0141..0146]|
1440 @^character set dependencies@>
1441 @^system dependencies@>
1443 @<Character |k| cannot be printed@>=
1444 (k < ' ') || (k == 127)
1446 @ @<Allocate or initialize ...@>=
1447 mp->trick_buf = xmalloc ((mp->error_line + 1), sizeof (ASCII_code));
1449 @ @<Dealloc variables@>=
1450 xfree (mp->trick_buf);
1452 @ @<Initialize the output routines@>=
1453 mp->selector = term_only;
1455 mp->term_offset = 0;
1456 mp->file_offset = 0;
1458 @ Macro abbreviations for output to the terminal and to the log file are
1459 defined here for convenience. Some systems need special conventions
1460 for terminal output, and it is possible to adhere to those conventions
1461 by changing |wterm|, |wterm_ln|, and |wterm_cr| here.
1462 @^system dependencies@>
1464 @<MPlib internal header stuff@>=
1465 #define mp_fputs(b,f) (mp->write_ascii_file)(mp,f,b)
1466 #define wterm(A) mp_fputs((A), mp->term_out)
1467 #define wterm_chr(A) { unsigned char ss[2]; ss[0]=(A); ss[1]='\0'; wterm((char *)ss);}
1468 #define wterm_cr mp_fputs("\n
", mp->term_out)
1469 #define wterm_ln(A) { wterm_cr; mp_fputs((A), mp->term_out); }
1470 #define wlog(A) mp_fputs((A), mp->log_file)
1471 #define wlog_chr(A) { unsigned char ss[2]; ss[0]=(A); ss[1]='\0'; wlog((char *)ss);}
1472 #define wlog_cr mp_fputs("\n
", mp->log_file)
1473 #define wlog_ln(A) { wlog_cr; mp_fputs((A), mp->log_file); }
1476 @ To end a line of text output, we call |print_ln|. Cases |0..max_write_files|
1477 use an array |wr_file| that will be declared later.
1479 @d mp_print_text(A) mp_print_str(mp,text((A)))
1481 @<Internal library ...@>=
1482 void mp_print (MP mp, const char *s);
1483 void mp_printf (MP mp, const char *ss, ...);
1484 void mp_print_ln (MP mp);
1485 void mp_print_char (MP mp, ASCII_code k);
1486 void mp_print_str (MP mp, mp_string s);
1487 void mp_print_nl (MP mp, const char *s);
1488 void mp_print_two (MP mp, mp_number x, mp_number y);
1491 static void mp_print_visible_char (MP mp, ASCII_code s);
1493 @ @<Basic print...@>=
1494 void mp_print_ln (MP mp) { /* prints an end-of-line */
1495 switch (mp->selector) {
1499 mp->term_offset = 0;
1500 mp->file_offset = 0;
1504 mp->file_offset = 0;
1508 mp->term_offset = 0;
1515 mp_fputs ("\n
", mp->wr_file[(mp->selector - write_file)]);
1517 } /* note that |tally| is not affected */
1520 @ The |print_visible_char| procedure sends one character to the desired
1521 destination, using the |xchr| array to map it into an external character
1522 compatible with |input_ln|. (It assumes that it is always called with
1523 a visible ASCII character.) All printing comes through |print_ln| or
1524 |print_char|, which ultimately calls |print_visible_char|, hence these
1525 routines are the ones that limit lines to at most |max_print_line| characters.
1526 But we must make an exception for the \ps\ output file since it is not safe
1527 to cut up lines arbitrarily in \ps.
1529 @<Basic printing...@>=
1530 static void mp_print_visible_char (MP mp, ASCII_code s) { /* prints a single character */
1531 switch (mp->selector) {
1533 wterm_chr (xchr (s));
1534 wlog_chr (xchr (s));
1535 incr (mp->term_offset);
1536 incr (mp->file_offset);
1537 if (mp->term_offset == (unsigned) mp->max_print_line) {
1539 mp->term_offset = 0;
1541 if (mp->file_offset == (unsigned) mp->max_print_line) {
1543 mp->file_offset = 0;
1547 wlog_chr (xchr (s));
1548 incr (mp->file_offset);
1549 if (mp->file_offset == (unsigned) mp->max_print_line)
1553 wterm_chr (xchr (s));
1554 incr (mp->term_offset);
1555 if (mp->term_offset == (unsigned) mp->max_print_line)
1561 if (mp->tally < mp->trick_count)
1562 mp->trick_buf[mp->tally % mp->error_line] = s;
1569 text_char ss[2] = {0,0};
1571 mp_fputs ((char *) ss, mp->wr_file[(mp->selector - write_file)]);
1578 @ The |print_char| procedure sends one character to the desired destination.
1579 File names and string expressions might contain |ASCII_code| values that
1580 can't be printed using |print_visible_char|. These characters will be
1581 printed in three- or four-symbol form like `\.{\^\^A}' or `\.{\^\^e4}'.
1582 (This procedure assumes that it is safe to bypass all checks for unprintable
1583 characters when |selector| is in the range |0..max_write_files-1|.
1584 The user might want to write unprintable characters.
1586 @<Basic printing...@>=
1587 void mp_print_char (MP mp, ASCII_code k) { /* prints a single character */
1588 if (mp->selector < pseudo || mp->selector >= write_file) {
1589 mp_print_visible_char (mp, k);
1590 } else if (@<Character |k| cannot be printed@>) {
1591 mp_print (mp, "^^
");
1593 mp_print_visible_char (mp, (ASCII_code) (k + 0100));
1594 } else if (k < 0200) {
1595 mp_print_visible_char (mp, (ASCII_code) (k - 0100));
1597 int l; /* small index or counter */
1599 mp_print_visible_char (mp, xord (l < 10 ? l + '0' : l - 10 + 'a'));
1601 mp_print_visible_char (mp, xord (l < 10 ? l + '0' : l - 10 + 'a'));
1604 mp_print_visible_char (mp, k);
1609 @ An entire string is output by calling |print|. Note that if we are outputting
1610 the single standard ASCII character \.c, we could call |print("c
")|, since
1611 |"c
"=99| is the number of a single-character string, as explained above. But
1612 |print_char("c
")| is quicker, so \MP\ goes directly to the |print_char|
1613 routine when it knows that this is safe. (The present implementation
1614 assumes that it is always safe to print a visible ASCII character.)
1615 @^system dependencies@>
1618 static void mp_do_print (MP mp, const char *ss, size_t len) { /* prints string |s| */
1621 if (mp->selector == new_string) {
1623 memcpy((mp->cur_string+mp->cur_length), ss, len);
1624 mp->cur_length += len;
1628 /* this was |xord((int)ss[j])| but that doesnt work */
1629 mp_print_char (mp, (ASCII_code) ss[j]);
1638 void mp_print (MP mp, const char *ss) {
1639 assert (ss != NULL);
1640 mp_do_print (mp, ss, strlen (ss));
1642 void mp_printf (MP mp, const char *ss, ...) {
1645 assert (ss != NULL);
1647 vsnprintf (pval, 256, ss, ap);
1648 mp_do_print (mp, pval, strlen (pval));
1652 void mp_print_str (MP mp, mp_string s) {
1654 mp_do_print (mp, (const char *) s->str, s->len);
1658 @ Here is the very first thing that \MP\ prints: a headline that identifies
1659 the version number and base name. The |term_offset| variable is temporarily
1660 incorrect, but the discrepancy is not serious since we assume that the banner
1661 and mem identifier together will occupy at most |max_print_line|
1662 character positions.
1664 @<Initialize the output...@>=
1669 @ The procedure |print_nl| is like |print|, but it makes sure that the
1670 string appears at the beginning of a new line.
1673 void mp_print_nl (MP mp, const char *s) { /* prints string |s| at beginning of line */
1674 switch (mp->selector) {
1676 if ((mp->term_offset > 0) || (mp->file_offset > 0))
1680 if (mp->file_offset > 0)
1684 if (mp->term_offset > 0)
1691 } /* there are no other cases */
1696 @ The following procedure, which prints out the decimal representation of a
1697 given integer |n|, assumes that all integers fit nicely into a |int|.
1698 @^system dependencies@>
1701 void mp_print_int (MP mp, integer n) { /* prints an integer in decimal form */
1703 mp_snprintf (s, 12, "%d
", (int) n);
1706 void mp_print_pointer (MP mp, void *n) { /* prints an pointer in hexadecimal form */
1708 mp_snprintf (s, 12, "%p
", n);
1712 @ @<Internal library ...@>=
1713 void mp_print_int (MP mp, integer n);
1714 void mp_print_pointer (MP mp, void *n);
1716 @ \MP\ also makes use of a trivial procedure to print two digits. The
1717 following subroutine is usually called with a parameter in the range |0<=n<=99|.
1720 static void mp_print_dd (MP mp, integer n) { /* prints two least significant digits */
1722 mp_print_char (mp, xord ('0' + (n / 10)));
1723 mp_print_char (mp, xord ('0' + (n % 10)));
1728 static void mp_print_dd (MP mp, integer n);
1730 @ Here is a procedure that asks the user to type a line of input,
1731 assuming that the |selector| setting is either |term_only| or |term_and_log|.
1732 The input is placed into locations |first| through |last-1| of the
1733 |buffer| array, and echoed on the transcript file if appropriate.
1735 This procedure is never called when |interaction<mp_scroll_mode|.
1737 @d prompt_input(A) do {
1738 if (!mp->noninteractive) {
1743 } while (0) /* prints a string and gets a line of input */
1746 void mp_term_input (MP mp) { /* gets a line from the terminal */
1747 size_t k; /* index into |buffer| */
1748 if (mp->noninteractive) {
1749 if (!mp_input_ln (mp, mp->term_in))
1750 longjmp (*(mp->jump_buf), 1); /* chunk finished */
1751 mp->buffer[mp->last] = xord ('%');
1753 update_terminal(); /* Now the user sees the prompt for sure */
1754 if (!mp_input_ln (mp, mp->term_in)) {
1755 mp_fatal_error (mp, "End of file on the terminal
!");
1756 @.End of file on the terminal@>
1758 mp->term_offset = 0; /* the user's line ended with \<\rm return> */
1759 decr (mp->selector); /* prepare to echo the input */
1760 if (mp->last != mp->first) {
1761 for (k = mp->first; k < mp->last; k++) {
1762 mp_print_char (mp, mp->buffer[k]);
1766 mp->buffer[mp->last] = xord ('%');
1767 incr (mp->selector); /* restore previous status */
1772 @* Reporting errors.
1774 The |print_err| procedure supplies a `\.!' before the official message,
1775 and makes sure that the terminal is awake if a stop is going to occur.
1776 The |error| procedure supplies a `\..' after the official message, then it
1777 shows the location of the error; and if |interaction=error_stop_mode|,
1778 it also enters into a dialog with the user, during which time the help
1779 message may be printed.
1780 @^system dependencies@>
1782 @ The global variable |interaction| has four settings, representing increasing
1783 amounts of user interaction:
1786 enum mp_interaction_mode {
1787 mp_unspecified_mode = 0, /* extra value for command-line switch */
1788 mp_batch_mode, /* omits all stops and omits terminal output */
1789 mp_nonstop_mode, /* omits all stops */
1790 mp_scroll_mode, /* omits error stops */
1791 mp_error_stop_mode /* stops at every opportunity to interact */
1794 @ @<Option variables@>=
1795 int interaction; /* current level of interaction */
1796 int noninteractive; /* do we have a terminal? */
1799 @ Set it here so it can be overwritten by the commandline
1801 @<Allocate or initialize ...@>=
1802 mp->interaction = opt->interaction;
1803 if (mp->interaction == mp_unspecified_mode
1804 || mp->interaction > mp_error_stop_mode)
1805 mp->interaction = mp_error_stop_mode;
1806 if (mp->interaction < mp_unspecified_mode)
1807 mp->interaction = mp_batch_mode;
1809 @ |print_err| is not merged in |error| because it is also used in |prompt_file_name|,
1810 where |error| is not called at all.
1813 static void mp_print_err (MP mp, const char *A);
1816 static void mp_print_err (MP mp, const char *A) {
1817 if (mp->interaction == mp_error_stop_mode)
1819 if (mp->file_line_error_style && file_state && !terminal_input) {
1820 mp_print_nl (mp, "");
1821 if (long_name != NULL) {
1822 mp_print (mp, long_name);
1824 mp_print (mp, mp_str (mp, name));
1827 mp_print_int (mp, line);
1828 mp_print (mp, ": ");
1830 mp_print_nl (mp, "! ");
1837 @ \MP\ is careful not to call |error| when the print |selector| setting
1838 might be unusual. The only possible values of |selector| at the time of
1841 \yskip\hang|no_print| (when |interaction=mp_batch_mode|
1842 and |log_file| not yet open);
1844 \hang|term_only| (when |interaction>mp_batch_mode| and |log_file| not yet open);
1846 \hang|log_only| (when |interaction=mp_batch_mode| and |log_file| is open);
1848 \hang|term_and_log| (when |interaction>mp_batch_mode| and |log_file| is open).
1850 @d initialize_print_selector() mp->selector = (mp->interaction == mp_batch_mode ? no_print : term_only);
1852 @ The global variable |history| records the worst level of error that
1853 has been detected. It has four possible values: |spotless|, |warning_issued|,
1854 |error_message_issued|, and |fatal_error_stop|.
1856 Another global variable, |error_count|, is increased by one when an
1857 |error| occurs without an interactive dialog, and it is reset to zero at
1858 the end of every statement. If |error_count| reaches 100, \MP\ decides
1859 that there is no point in continuing further.
1862 enum mp_history_state {
1863 mp_spotless = 0, /* |history| value when nothing has been amiss yet */
1864 mp_warning_issued, /* |history| value when |begin_diagnostic| has been called */
1865 mp_error_message_issued, /* |history| value when |error| has been called */
1866 mp_fatal_error_stop, /* |history| value when termination was premature */
1867 mp_system_error_stop /* |history| value when termination was due to disaster */
1871 int history; /* has the source input been clean so far? */
1872 int error_count; /* the number of scrolled errors since the last statement ended */
1874 @ The value of |history| is initially |fatal_error_stop|, but it will
1875 be changed to |spotless| if \MP\ survives the initialization process.
1877 @ Since errors can be detected almost anywhere in \MP, we want to declare the
1878 error procedures near the beginning of the program. But the error procedures
1879 in turn use some other procedures, which need to be declared |forward|
1880 before we get to |error| itself.
1882 It is possible for |error| to be called recursively if some error arises
1883 when |get_next| is being used to delete a token, and/or if some fatal error
1884 occurs while \MP\ is trying to fix a non-fatal one. But such recursion
1886 is never more than two levels deep.
1889 static void mp_get_next (MP mp);
1890 static void mp_term_input (MP mp);
1891 static void mp_show_context (MP mp);
1892 static void mp_begin_file_reading (MP mp);
1893 static void mp_open_log_file (MP mp);
1894 static void mp_clear_for_error_prompt (MP mp);
1897 void mp_normalize_selector (MP mp);
1900 boolean use_err_help; /* should the |err_help| string be shown? */
1901 mp_string err_help; /* a string set up by \&{errhelp} */
1903 @ @<Allocate or ...@>=
1904 mp->use_err_help = false;
1906 @ The |jump_out| procedure just cuts across all active procedure levels and
1907 goes to |end_of_MP|. This is the only nonlocal |goto| statement in the
1908 whole program. It is used when there is no recovery from a particular error.
1910 The program uses a |jump_buf| to handle this, this is initialized at three
1911 spots: the start of |mp_new|, the start of |mp_initialize|, and the start
1912 of |mp_run|. Those are the only library enty points.
1913 @^system dependencies@>
1918 @ If the array of internals is still |NULL| when |jump_out| is called, a
1919 crash occured during initialization, and it is not safe to run the normal
1923 void mp_jump_out (MP mp) {
1924 if (mp->internal != NULL && mp->history < mp_system_error_stop)
1925 mp_close_files_and_terminate (mp);
1926 longjmp (*(mp->jump_buf), 1);
1930 void mp_jump_out (MP mp);
1935 void mp_warn (MP mp, const char *msg) {
1936 unsigned saved_selector = mp->selector;
1937 mp_normalize_selector (mp);
1938 mp_print_nl (mp, "Warning
: ");
1941 mp->selector = saved_selector;
1944 @ Here now is the general |error| routine.
1946 The argument |deletions_allowed| is set |false| if the |get_next|
1947 routine is active when |error| is called; this ensures that |get_next|
1948 will never be called recursively.
1951 Individual lines of help are recorded in the array |help_line|, which
1952 contains entries in positions |0..(help_ptr-1)|. They should be printed
1953 in reverse order, i.e., with |help_line[0]| appearing last.
1956 void mp_error (MP mp, const char *msg, const char **hlp, boolean deletions_allowed) {
1957 ASCII_code c; /* what the user types */
1958 integer s1, s2; /* used to save global variables when deleting tokens */
1959 mp_sym s3; /* likewise */
1961 const char *help_line[6]; /* helps for the next |error| */
1962 unsigned int help_ptr; /* the number of help lines present */
1963 const char **cnt = NULL;
1964 mp_print_err(mp, msg);
1974 help_line[--i]= *cnt++;
1976 if (mp->history < mp_error_message_issued)
1977 mp->history = mp_error_message_issued;
1978 mp_print_char (mp, xord ('.'));
1979 mp_show_context (mp);
1980 if (mp->halt_on_error) {
1981 mp->history = mp_fatal_error_stop;
1984 if ((!mp->noninteractive) && (mp->interaction == mp_error_stop_mode)) {
1985 @<Get user's advice and |return|@>;
1987 incr (mp->error_count);
1988 if (mp->error_count == 100) {
1989 mp_print_nl (mp, "(That makes
100 errors
; please try again.
)");
1990 @.That makes 100 errors...@>;
1991 mp->history = mp_fatal_error_stop;
1994 @<Put help message on the transcript file@>;
1998 @ @<Exported function ...@>=
1999 extern void mp_error (MP mp, const char *msg, const char **hlp, boolean deletions_allowed);
2000 extern void mp_warn (MP mp, const char *msg);
2003 @ @<Get user's advice...@>=
2006 mp_clear_for_error_prompt (mp);
2007 prompt_input ("?
");
2009 if (mp->last == mp->first)
2011 c = mp->buffer[mp->first];
2013 c = (ASCII_code) (c + 'A' - 'a'); /* convert to uppercase */
2014 @<Interpret code |c| and |return| if done@>;
2018 @ It is desirable to provide an `\.E' option here that gives the user
2019 an easy way to return from \MP\ to the system editor, with the offending
2020 line ready to be edited. But such an extension requires some system
2021 wizardry, so the present implementation simply types out the name of the
2023 edited and the relevant line number.
2024 @^system dependencies@>
2027 typedef void (*mp_editor_cmd) (MP, char *, int);
2029 @ @<Option variables@>=
2030 mp_editor_cmd run_editor;
2032 @ @<Allocate or initialize ...@>=
2033 set_callback_option (run_editor);
2036 static void mp_run_editor (MP mp, char *fname, int fline);
2039 void mp_run_editor (MP mp, char *fname, int fline) {
2040 char *s = xmalloc (256, 1);
2041 mp_snprintf (s, 256, "You want to edit file
%s at line
%d\n
", fname, fline);
2043 @.You want to edit file x@>
2049 @<Interpret code |c| and |return| if done@>=
2061 if (deletions_allowed) {
2062 @<Delete tokens and |continue|@>;
2066 if (mp->file_ptr > 0) {
2067 mp->interaction = mp_scroll_mode;
2068 mp_close_files_and_terminate (mp);
2069 (mp->run_editor) (mp,
2070 mp_str (mp, mp->input_stack[mp->file_ptr].name_field),
2076 @<Print the help information and |continue|@>;
2079 @<Introduce new material from the terminal and |return|@>;
2084 @<Change the interaction level and |return|@>;
2087 mp->interaction = mp_scroll_mode;
2093 @<Print the menu of available options@>
2096 @ @<Print the menu...@>=
2098 mp_print (mp, "Type
<return
> to proceed
, S to scroll future error messages
,");
2099 @.Type <return> to proceed...@>;
2100 mp_print_nl (mp, "R to run without stopping
, Q to run quietly
,");
2101 mp_print_nl (mp, "I to insert something
, ");
2102 if (mp->file_ptr > 0)
2103 mp_print (mp, "E to edit your file
,");
2104 if (deletions_allowed)
2106 "1 or ... or
9 to ignore the next
1 to
9 tokens of input
,");
2107 mp_print_nl (mp, "H for help
, X to quit.
");
2111 @ @<Change the interaction...@>=
2113 mp->error_count = 0;
2114 mp_print (mp, "OK, entering
");
2117 mp->interaction = mp_batch_mode;
2118 mp_print (mp, "batchmode
");
2119 decr (mp->selector);
2122 mp->interaction = mp_nonstop_mode;
2123 mp_print (mp, "nonstopmode
");
2126 mp->interaction = mp_scroll_mode;
2127 mp_print (mp, "scrollmode
");
2129 } /* there are no other cases */
2130 mp_print (mp, "...
");
2137 @ When the following code is executed, |buffer[(first+1)..(last-1)]| may
2138 contain the material inserted by the user; otherwise another prompt will
2139 be given. In order to understand this part of the program fully, you need
2140 to be familiar with \MP's input stacks.
2142 @<Introduce new material...@>=
2144 mp_begin_file_reading (mp); /* enter a new syntactic level for terminal input */
2145 if (mp->last > mp->first + 1) {
2146 loc = (halfword) (mp->first + 1);
2147 mp->buffer[mp->first] = xord (' ');
2149 prompt_input ("insert
>");
2150 loc = (halfword) mp->first;
2153 mp->first = mp->last + 1;
2154 mp->cur_input.limit_field = (halfword) mp->last;
2159 @ We allow deletion of up to 99 tokens at a time.
2161 @<Delete tokens...@>=
2166 mp->OK_to_interrupt = false;
2167 if ((mp->last > mp->first + 1) && (mp->buffer[mp->first + 1] >= '0')
2168 && (mp->buffer[mp->first + 1] <= '9'))
2169 c = xord (c * 10 + mp->buffer[mp->first + 1] - '0' * 11);
2171 c = (ASCII_code) (c - '0');
2173 mp_get_next (mp); /* one-level recursive call of |error| is possible */
2174 @<Decrease the string reference count, if the current token is a string@>;
2180 mp->OK_to_interrupt = true;
2182 help_line[1] = "I have just deleted some text
, as you asked.
";
2183 help_line[0] = "You can now delete more
, or insert
, or whatever.
";
2184 mp_show_context (mp);
2189 @ Some wriggling with |help_line| is done here to avoid giving no
2190 information whatsoever, or presenting the same information twice
2193 @<Print the help info...@>=
2195 if (mp->use_err_help) {
2196 @<Print the string |err_help|, possibly on several lines@>;
2197 mp->use_err_help = false;
2199 if (help_ptr == 0) {
2201 help_line[1] = "Sorry
, I don't know how to help in this situation.
";
2202 help_line[0] = "Maybe you should try asking a human?
";
2206 mp_print (mp, help_line[help_ptr]);
2208 } while (help_ptr != 0);
2211 help_line[3] = "Sorry
, I already gave what help I could...
";
2212 help_line[2] = "Maybe you should try asking a human?
";
2213 help_line[1] = "An error might have occurred before I noticed any problems.
";
2214 help_line[0] = "``If all else fails
, read the instructions.''
";
2219 @ @<Print the string |err_help|, possibly on several lines@>=
2222 while (j < mp->err_help->len) {
2223 if (*(mp->err_help->str + j) != '%')
2224 mp_print (mp, (const char *) (mp->err_help->str + j));
2225 else if (j + 1 == mp->err_help->len)
2227 else if (*(mp->err_help->str + j) != '%')
2231 mp_print_char (mp, xord ('%'));
2238 @ @<Put help message on the transcript file@>=
2239 if (mp->interaction > mp_batch_mode)
2240 decr (mp->selector); /* avoid terminal output */
2241 if (mp->use_err_help) {
2242 mp_print_nl (mp, "");
2243 @<Print the string |err_help|, possibly on several lines@>;
2245 while (help_ptr > 0) {
2247 mp_print_nl (mp, help_line[help_ptr]);
2250 if (mp->interaction > mp_batch_mode)
2251 incr (mp->selector); /* re-enable terminal output */
2256 @ In anomalous cases, the print selector might be in an unknown state;
2257 the following subroutine is called to fix things just enough to keep
2258 running a bit longer.
2261 void mp_normalize_selector (MP mp) {
2263 mp->selector = term_and_log;
2265 mp->selector = term_only;
2266 if (mp->job_name == NULL)
2267 mp_open_log_file (mp);
2268 if (mp->interaction == mp_batch_mode)
2269 decr (mp->selector);
2273 @ The following procedure prints \MP's last words before dying.
2276 void mp_fatal_error (MP mp, const char *s) { /* prints |s|, and that's it */
2277 const char *hlp[] = {s, NULL} ;
2278 mp_normalize_selector (mp);
2279 if ( mp->interaction==mp_error_stop_mode )
2280 mp->interaction=mp_scroll_mode; /* no more interaction */
2281 if ( mp->log_opened )
2282 mp_error(mp, "Emergency stop
", hlp, true);
2283 mp->history=mp_fatal_error_stop;
2284 mp_jump_out(mp); /* irrecoverable error */
2289 @ @<Exported function ...@>=
2290 extern void mp_fatal_error (MP mp, const char *s);
2293 @ @<Internal library declarations@>=
2294 void mp_overflow (MP mp, const char *s, integer n);
2297 @ @<Error hand...@>=
2298 void mp_overflow (MP mp, const char *s, integer n) { /* stop due to finiteness */
2300 const char *hlp[] = {
2301 "If you really absolutely need more capacity
,",
2302 "you can ask a wizard to enlarge me.
",
2304 mp_normalize_selector (mp);
2305 mp_snprintf (msg, 256, "MetaPost capacity exceeded
, sorry
[%s
=%d
]", s, (int) n);
2306 @.MetaPost capacity exceeded ...@>;
2307 if ( mp->interaction==mp_error_stop_mode )
2308 mp->interaction=mp_scroll_mode; /* no more interaction */
2309 if ( mp->log_opened )
2310 mp_error(mp, msg, hlp, true);
2311 mp->history=mp_fatal_error_stop;
2312 mp_jump_out(mp); /* irrecoverable error */
2316 @ The program might sometime run completely amok, at which point there is
2317 no choice but to stop. If no previous error has been detected, that's bad
2318 news; a message is printed that is really intended for the \MP\
2319 maintenance person instead of the user (unless the user has been
2320 particularly diabolical). The index entries for `this can't happen' may
2321 help to pinpoint the problem.
2324 @<Internal library ...@>=
2325 void mp_confusion (MP mp, const char *s);
2327 @ Consistency check violated; |s| tells where.
2329 void mp_confusion (MP mp, const char *s) {
2331 const char *hlp[] = {
2332 "One of your faux pas seems to have wounded me deeply...
",
2333 "in fact
, I'm barely conscious. Please fix it and try again.
",
2335 mp_normalize_selector (mp);
2336 if (mp->history < mp_error_message_issued) {
2337 mp_snprintf (msg, 256, "This can't happen
(%s
)", s);
2338 @.This can't happen@>;
2339 hlp[0] = "I'm broken. Please show this to someone who can fix can fix
";
2342 mp_snprintf (msg, 256, "I can\'t go on meeting you like this
");
2343 @.I can't go on...@>;
2345 if ( mp->interaction==mp_error_stop_mode )
2346 mp->interaction=mp_scroll_mode; /* no more interaction */
2347 if ( mp->log_opened )
2348 mp_error(mp, msg, hlp, true);
2349 mp->history=mp_fatal_error_stop;
2350 mp_jump_out(mp); /* irrecoverable error */
2354 @ Users occasionally want to interrupt \MP\ while it's running.
2355 If the runtime system allows this, one can implement
2356 a routine that sets the global variable |interrupt| to some nonzero value
2357 when such an interrupt is signaled. Otherwise there is probably at least
2358 a way to make |interrupt| nonzero using the C debugger.
2359 @^system dependencies@>
2362 @d check_interrupt { if ( mp->interrupt!=0 )
2363 mp_pause_for_instructions(mp); }
2366 integer interrupt; /* should \MP\ pause for instructions? */
2367 boolean OK_to_interrupt; /* should interrupts be observed? */
2368 integer run_state; /* are we processing input ? */
2369 boolean finished; /* set true by |close_files_and_terminate| */
2370 boolean reading_preload;
2372 @ @<Allocate or ...@>=
2373 mp->OK_to_interrupt = true;
2374 mp->finished = false;
2376 @ When an interrupt has been detected, the program goes into its
2377 highest interaction level and lets the user have the full flexibility of
2378 the |error| routine. \MP\ checks for interrupts only at times when it is
2382 static void mp_pause_for_instructions (MP mp) {
2383 const char *hlp[] = { "You rang?
",
2384 "Try to insert some instructions for me
(e.g.
,`I show x'
),",
2385 "unless you just want to quit by typing `
X'.
",
2387 if (mp->OK_to_interrupt) {
2388 mp->interaction = mp_error_stop_mode;
2389 if ((mp->selector == log_only) || (mp->selector == no_print))
2390 incr (mp->selector);
2392 mp_error (mp, "Interruption
", hlp, false);
2398 @* Arithmetic with scaled numbers.
2399 The principal computations performed by \MP\ are done entirely in terms of
2400 integers less than $2^{31}$ in magnitude; thus, the arithmetic specified in this
2401 program can be carried out in exactly the same way on a wide variety of
2402 computers, including some small ones.
2405 But C does not rigidly define the |/| operation in the case of negative
2406 dividends; for example, the result of |(-2*n-1) / 2| is |-(n+1)| on some
2407 computers and |-n| on others (is this true ?). There are two principal
2408 types of arithmetic: ``translation-preserving,'' in which the identity
2409 |(a+q*b)/b=(a/b)+q| is valid; and ``negation-preserving,'' in which
2410 |(-a)/b=-(a/b)|. This leads to two \MP s, which can produce
2411 different results, although the differences should be negligible when the
2412 language is being used properly. The \TeX\ processor has been defined
2413 carefully so that both varieties of arithmetic will produce identical
2414 output, but it would be too inefficient to constrain \MP\ in a similar way.
2416 @d inf_t ((math_data *)mp->math)->inf_t
2418 @ A single computation might use several subroutine calls, and it is
2419 desirable to avoid producing multiple error messages in case of arithmetic
2420 overflow. So the routines below set the global variable |arith_error| to |true|
2421 instead of reporting errors directly to the user.
2422 @^overflow in arithmetic@>
2425 boolean arith_error; /* has arithmetic overflow occurred recently? */
2427 @ @<Allocate or ...@>=
2428 mp->arith_error = false;
2430 @ At crucial points the program will say |check_arith|, to test if
2431 an arithmetic error has been detected.
2433 @d check_arith() do {
2434 if ( mp->arith_error )
2439 static void mp_clear_arith (MP mp) {
2440 const char *hlp[] = {
2441 "Uh
, oh. A little while ago one of the quantities that I was
",
2442 "computing got too large
, so I'm afraid your answers will be
",
2443 "somewhat askew. You'll probably have to adopt different
",
2444 "tactics next time. But I shall try to carry on anyway.
",
2446 mp_error (mp, "Arithmetic overflow
", hlp, true);
2447 @.Arithmetic overflow@>;
2448 mp->arith_error = false;
2452 @ The definitions of these are set up by the math initialization.
2454 @d arc_tol_k ((math_data *)mp->math)->arc_tol_k
2455 @d coef_bound_k ((math_data *)mp->math)->coef_bound_k
2456 @d coef_bound_minus_1 ((math_data *)mp->math)->coef_bound_minus_1
2457 @d sqrt_8_e_k ((math_data *)mp->math)->sqrt_8_e_k
2458 @d twelve_ln_2_k ((math_data *)mp->math)->twelve_ln_2_k
2459 @d twelvebits_3 ((math_data *)mp->math)->twelvebits_3
2460 @d one_k ((math_data *)mp->math)->one_k
2461 @d epsilon_t ((math_data *)mp->math)->epsilon_t
2462 @d unity_t ((math_data *)mp->math)->unity_t
2463 @d zero_t ((math_data *)mp->math)->zero_t
2464 @d two_t ((math_data *)mp->math)->two_t
2465 @d three_t ((math_data *)mp->math)->three_t
2466 @d half_unit_t ((math_data *)mp->math)->half_unit_t
2467 @d three_quarter_unit_t ((math_data *)mp->math)->three_quarter_unit_t
2468 @d twentysixbits_sqrt2_t ((math_data *)mp->math)->twentysixbits_sqrt2_t
2469 @d twentyeightbits_d_t ((math_data *)mp->math)->twentyeightbits_d_t
2470 @d twentysevenbits_sqrt2_d_t ((math_data *)mp->math)->twentysevenbits_sqrt2_d_t
2471 @d warning_limit_t ((math_data *)mp->math)->warning_limit_t
2472 @d precision_default ((math_data *)mp->math)->precision_default
2473 @d precision_max ((math_data *)mp->math)->precision_max
2474 @d precision_min ((math_data *)mp->math)->precision_min
2476 @ In fact, the two sorts of scaling discussed above aren't quite
2477 sufficient; \MP\ has yet another, used internally to keep track of angles.
2479 @ We often want to print two scaled quantities in parentheses,
2480 separated by a comma.
2482 @<Basic printing...@>=
2483 void mp_print_two (MP mp, mp_number x, mp_number y) { /* prints `|(x,y)|' */
2484 mp_print_char (mp, xord ('('));
2486 mp_print_char (mp, xord (','));
2488 mp_print_char (mp, xord (')'));
2493 @d fraction_one_t ((math_data *)mp->math)->fraction_one_t
2494 @d fraction_half_t ((math_data *)mp->math)->fraction_half_t
2495 @d fraction_three_t ((math_data *)mp->math)->fraction_three_t
2496 @d fraction_four_t ((math_data *)mp->math)->fraction_four_t
2498 @d one_eighty_deg_t ((math_data *)mp->math)->one_eighty_deg_t
2499 @d three_sixty_deg_t ((math_data *)mp->math)->three_sixty_deg_t
2501 @ @<Local variables for initialization@>=
2502 integer k; /* all-purpose loop index */
2504 @ And now let's complete our collection of numeric utility routines
2505 by considering random number generation.
2506 \MP\ generates pseudo-random numbers with the additive scheme recommended
2507 in Section 3.6 of {\sl The Art of Computer Programming}; however, the
2508 results are random fractions between 0 and |fraction_one-1|, inclusive.
2510 There's an auxiliary array |randoms| that contains 55 pseudo-random
2511 fractions. Using the recurrence $x_n=(x_{n-55}-x_{n-31})\bmod 2^{28}$,
2512 we generate batches of 55 new $x_n$'s at a time by calling |new_randoms|.
2513 The global variable |j_random| tells which element has most recently
2515 The global variable |random_seed| was introduced in version 0.9,
2516 for the sole reason of stressing the fact that the initial value of the
2517 random seed is system-dependant. The initialization code below will initialize
2518 this variable to |(internal[mp_time] div unity)+internal[mp_day]|, but this
2519 is not good enough on modern fast machines that are capable of running
2520 multiple MetaPost processes within the same second.
2521 @^system dependencies@>
2524 mp_number randoms[55]; /* the last 55 random values generated */
2525 int j_random; /* the number of unused |randoms| */
2527 @ @<Option variables@>=
2528 int random_seed; /* the default random seed */
2530 @ @<Allocate or initialize ...@>=
2531 mp->random_seed = opt->random_seed;
2534 for (i=0;i<55;i++) {
2535 new_fraction (mp->randoms[i]);
2542 for (i=0;i<55;i++) {
2543 free_number (mp->randoms[i]);
2547 @ @<Internal library ...@>=
2548 void mp_new_randoms (MP mp);
2551 void mp_new_randoms (MP mp) {
2552 int k; /* index into |randoms| */
2553 mp_number x; /* accumulator */
2555 for (k = 0; k <= 23; k++) {
2556 set_number_from_substraction(x, mp->randoms[k], mp->randoms[k + 31]);
2557 if (number_negative(x))
2558 number_add (x, fraction_one_t);
2559 number_clone (mp->randoms[k], x);
2561 for (k = 24; k <= 54; k++) {
2562 set_number_from_substraction(x, mp->randoms[k], mp->randoms[k - 24]);
2563 if (number_negative(x))
2564 number_add (x, fraction_one_t);
2565 number_clone (mp->randoms[k], x);
2571 @ To consume a random fraction, the program below will say `|next_random|'.
2572 Now each number system has its own implementation,
2573 true to the original as much as possibile.
2577 static void mp_next_random (MP mp, mp_number *ret) {
2578 if ( mp->j_random==0 )
2582 number_clone (*ret, mp->randoms[mp->j_random]);
2586 @ To produce a uniform random number in the range |0<=u<x| or |0>=u>x|
2587 or |0=u=x|, given a |scaled| value~|x|, we proceed as shown here.
2589 Note that the call of |take_fraction| will produce the values 0 and~|x|
2590 with about half the probability that it will produce any other particular
2591 values between 0 and~|x|, because it rounds its answers.
2592 This is the original one,
2593 that stays as reference:
2594 As said before, now each number system has its own implementation.
2599 static void mp_unif_rand (MP mp, mp_number *ret, mp_number x_orig) {
2600 mp_number y; // trial value
2607 number_clone (x, x_orig);
2608 number_clone (abs_x, x);
2610 mp_next_random(mp, &u);
2611 take_fraction (y, abs_x, u);
2613 if (number_equal(y, abs_x)) {
2614 set_number_to_zero(*ret);
2615 } else if (number_positive(x)) {
2616 number_clone (*ret, y);
2618 number_clone (*ret, y);
2619 number_negate (*ret);
2621 free_number (abs_x);
2627 @ Finally, a normal deviate with mean zero and unit standard deviation
2628 can readily be obtained with the ratio method (Algorithm 3.4.1R in
2629 {\sl The Art of Computer Programming\/}). This is the original one,
2630 that stays as reference:
2631 Now each number system has its own implementation,
2632 true to the original as much as possibile.
2637 static void mp_norm_rand (MP mp, mp_number *ret) {
2643 new_number (ab_vs_cd);
2653 mp_next_random(mp, &v);
2654 number_substract (v, fraction_half_t);
2655 take_fraction (xa, sqrt_8_e_k, v);
2657 mp_next_random(mp, &u);
2658 number_clone (abs_x, xa);
2660 } while (number_greaterequal (abs_x, u));
2661 make_fraction (r, xa, u);
2662 number_clone (xa, r);
2664 set_number_from_substraction(la, twelve_ln_2_k, la);
2665 ab_vs_cd (ab_vs_cd, one_k, la, xa, xa);
2666 } while (number_negative(ab_vs_cd));
2667 number_clone (*ret, xa);
2668 free_number (ab_vs_cd);
2670 free_number (abs_x);
2680 @d max_quarterword 0x3FFF /* largest allowable value in a |quarterword| */
2681 @d max_halfword 0xFFFFFFF /* largest allowable value in a |halfword| */
2683 @ The macros |qi| and |qo| are used for input to and output
2684 from quarterwords. These are legacy macros.
2685 @^system dependencies@>
2687 @d qo(A) (A) /* to read eight bits from a quarterword */
2688 @d qi(A) (quarterword)(A) /* to store eight bits in a quarterword */
2690 @ The reader should study the following definitions closely:
2691 @^system dependencies@>
2694 typedef struct mp_value_node_data *mp_value_node;
2695 typedef struct mp_node_data *mp_node;
2696 typedef struct mp_symbol_entry *mp_sym;
2697 typedef short quarterword; /* 1/4 of a word */
2698 typedef int halfword; /* 1/2 of a word */
2700 integer scale; /* only for |indep_scale|, used together with |serial| */
2701 integer serial; /* only for |indep_value|, used together with |scale| */
2702 } mp_independent_data;
2704 mp_independent_data indep;
2712 mp_variable_type type;
2716 quarterword b0, b1, b2, b3;
2724 @ The global variable |math_mode| has four settings, representing the
2725 math value type that will be used in this run.
2727 the typedef for |mp_number| is here because it has to come very early.
2731 mp_math_scaled_mode = 0,
2732 mp_math_double_mode = 1,
2733 mp_math_binary_mode = 2,
2734 mp_math_decimal_mode = 3
2737 @ @<Option variables@>=
2738 int math_mode; /* math mode */
2740 @ @<Allocate or initialize ...@>=
2741 mp->math_mode = opt->math_mode;
2744 @d xfree(A) do { mp_xfree(A); A=NULL; } while (0)
2745 @d xrealloc(P,A,B) mp_xrealloc(mp,P,(size_t)A,B)
2746 @d xmalloc(A,B) mp_xmalloc(mp,(size_t)A,B)
2747 @d xstrdup(A) mp_xstrdup(mp,A)
2748 @d XREALLOC(a,b,c) a = xrealloc(a,(b+1),sizeof(c));
2750 @<Declare helpers@>=
2751 extern void mp_xfree (void *x);
2752 extern void *mp_xrealloc (MP mp, void *p, size_t nmem, size_t size);
2753 extern void *mp_xmalloc (MP mp, size_t nmem, size_t size);
2754 extern void mp_do_snprintf (char *str, int size, const char *fmt, ...);
2755 extern void *do_alloc_node(MP mp, size_t size);
2757 @ This is an attempt to spend less time in |malloc()|:
2759 @d max_num_token_nodes 1000
2760 @d max_num_pair_nodes 1000
2761 @d max_num_knot_nodes 1000
2762 @d max_num_value_nodes 1000
2763 @d max_num_symbolic_nodes 1000
2766 mp_node token_nodes;
2767 int num_token_nodes;
2772 mp_node value_nodes;
2773 int num_value_nodes;
2774 mp_node symbolic_nodes;
2775 int num_symbolic_nodes;
2777 @ @<Allocate or initialize ...@>=
2778 mp->token_nodes = NULL;
2779 mp->num_token_nodes = 0;
2780 mp->pair_nodes = NULL;
2781 mp->num_pair_nodes = 0;
2782 mp->knot_nodes = NULL;
2783 mp->num_knot_nodes = 0;
2784 mp->value_nodes = NULL;
2785 mp->num_value_nodes = 0;
2786 mp->symbolic_nodes = NULL;
2787 mp->num_symbolic_nodes = 0;
2790 while (mp->value_nodes) {
2791 mp_node p = mp->value_nodes;
2792 mp->value_nodes = p->link;
2793 mp_free_node(mp,p,value_node_size);
2795 while (mp->symbolic_nodes) {
2796 mp_node p = mp->symbolic_nodes;
2797 mp->symbolic_nodes = p->link;
2798 mp_free_node(mp,p,symbolic_node_size);
2800 while (mp->pair_nodes) {
2801 mp_node p = mp->pair_nodes;
2802 mp->pair_nodes = p->link;
2803 mp_free_node(mp,p,pair_node_size);
2805 while (mp->token_nodes) {
2806 mp_node p = mp->token_nodes;
2807 mp->token_nodes = p->link;
2808 mp_free_node(mp,p,token_node_size);
2810 while (mp->knot_nodes) {
2811 mp_knot p = mp->knot_nodes;
2812 mp->knot_nodes = p->next;
2816 @ This is a nicer way of allocating nodes.
2818 @d malloc_node(A) do_alloc_node(mp,(A))
2822 void *do_alloc_node (MP mp, size_t size) {
2824 p = xmalloc(1,size);
2825 add_var_used (size);
2826 ((mp_node)p)->link = NULL;
2827 ((mp_node)p)->has_number = 0;
2832 @ The |max_size_test| guards against overflow, on the assumption that
2833 |size_t| is at least 31bits wide.
2835 @d max_size_test 0x7FFFFFFF
2838 void mp_xfree (void *x) {
2842 void *mp_xrealloc (MP mp, void *p, size_t nmem, size_t size) {
2844 if ((max_size_test / size) < nmem) {
2845 mp_fputs ("Memory size overflow
!\n
", mp->err_out);
2846 mp->history = mp_fatal_error_stop;
2849 w = realloc (p, (nmem * size));
2851 mp_fputs ("Out of memory
!\n
", mp->err_out);
2852 mp->history = mp_system_error_stop;
2857 void *mp_xmalloc (MP mp, size_t nmem, size_t size) {
2860 if ((max_size_test / size) < nmem) {
2861 mp_fputs ("Memory size overflow
!\n
", mp->err_out);
2862 mp->history = mp_fatal_error_stop;
2866 w = malloc (nmem * size);
2868 mp_fputs ("Out of memory
!\n
", mp->err_out);
2869 mp->history = mp_system_error_stop;
2875 @ @<Internal library declarations@>=
2876 # define mp_snprintf (void)snprintf
2878 @* Dynamic memory allocation.
2880 The \MP\ system does nearly all of its own memory allocation, so that it
2881 can readily be transported into environments that do not have automatic
2882 facilities for strings, garbage collection, etc., and so that it can be in
2883 control of what error messages the user receives.
2885 @d MP_VOID (mp_node)(1) /* |NULL+1|, a |NULL| pointer different from |NULL| */
2887 @d mp_link(A) (A)->link /* the |link| field of a node */
2888 @d set_mp_link(A,B) do {
2890 /* |printf("set link of
%p to
%p on line
%d\n
", (A), d, __LINE__);| */
2893 @d mp_type(A) (A)->type /* identifies what kind of value this is */
2894 @d mp_name_type(A) (A)->name_type /* a clue to the name of this value */
2896 @ @<MPlib internal header stuff@>=
2898 mp_variable_type type; \
2899 mp_name_type_type name_type; \
2900 unsigned short has_number; \
2901 struct mp_node_data *link
2902 typedef struct mp_node_data {
2906 typedef struct mp_node_data *mp_symbolic_node;
2908 @ Users who wish to study the memory requirements of particular applications can
2909 can use the special features that keep track of current and maximum memory usage.
2910 \MP\ will report these statistics when |mp_tracing_stats| is positive.
2912 @d add_var_used(a) do {
2914 if (mp->var_used>mp->var_used_max) mp->var_used_max=mp->var_used;
2918 size_t var_used; /* how much memory is in use */
2919 size_t var_used_max; /* how much memory was in use max */
2921 @ These redirect to function to aid in debugging.
2925 #define mp_sym_info(A) get_mp_sym_info(mp,(A))
2926 #define set_mp_sym_info(A,B) do_set_mp_sym_info(mp,(A),(B))
2927 #define mp_sym_sym(A) get_mp_sym_sym(mp,(A))
2928 #define set_mp_sym_sym(A,B) do_set_mp_sym_sym(mp,(A),(mp_sym)(B))
2929 static void do_set_mp_sym_info (MP mp, mp_node p, halfword v) {
2930 FUNCTION_TRACE3 ("do_set_mp_sym_info
(%p
,%d
)\n
", p, v);
2931 assert (p->type == mp_symbol_node);
2932 set_indep_value(p, v);
2934 static halfword get_mp_sym_info (MP mp, mp_node p) {
2935 FUNCTION_TRACE3 ("%d
= get_mp_sym_info
(%p
)\n
", indep_value (p), p);
2936 assert (p->type == mp_symbol_node);
2937 return indep_value(p);
2939 static void do_set_mp_sym_sym (MP mp, mp_node p, mp_sym v) {
2940 mp_symbolic_node pp = (mp_symbolic_node) p;
2941 FUNCTION_TRACE3 ("do_set_mp_sym_sym
(%p
,%p
)\n
", pp, v);
2942 assert (pp->type == mp_symbol_node);
2945 static mp_sym get_mp_sym_sym (MP mp, mp_node p) {
2946 mp_symbolic_node pp = (mp_symbolic_node) p;
2947 FUNCTION_TRACE3 ("%p
= get_mp_sym_sym
(%p
)\n
", pp->data.sym, pp);
2948 assert (pp->type == mp_symbol_node);
2949 return pp->data.sym;
2952 #define mp_sym_info(A) indep_value(A)
2953 #define set_mp_sym_info(A,B) set_indep_value(A, (B))
2954 #define mp_sym_sym(A) (A)->data.sym
2955 #define set_mp_sym_sym(A,B) (A)->data.sym = (mp_sym)(B)
2960 static void do_set_mp_sym_info (MP mp, mp_node A, halfword B);
2961 static halfword get_mp_sym_info (MP mp, mp_node p);
2962 static void do_set_mp_sym_sym (MP mp, mp_node A, mp_sym B);
2963 static mp_sym get_mp_sym_sym (MP mp, mp_node p);
2966 @ The function |get_symbolic_node| returns a pointer to a new symbolic node whose
2967 |link| field is null.
2970 @d symbolic_node_size sizeof(mp_node_data)
2972 static mp_node mp_get_symbolic_node (MP mp) {
2974 if (mp->symbolic_nodes) {
2975 p = (mp_symbolic_node)mp->symbolic_nodes;
2976 mp->symbolic_nodes = p->link;
2977 mp->num_symbolic_nodes--;
2980 p = malloc_node (symbolic_node_size);
2981 new_number(p->data.n);
2984 p->type = mp_symbol_node;
2985 p->name_type = mp_normal_sym;
2986 FUNCTION_TRACE2 ("%p
= mp_get_symbolic_node
()\n
", p);
2991 @ Conversely, when some node |p| of size |s| is no longer needed,
2992 the operation |free_node(p,s)| will make its words available, by inserting
2993 |p| as a new empty node just before where |rover| now points.
2995 A symbolic node is recycled by calling |free_symbolic_node|.
2998 void mp_free_node (MP mp, mp_node p, size_t siz) { /* node liberation */
2999 FUNCTION_TRACE3 ("mp_free_node
(%p
,%d
)\n
", p, (int)siz);
3001 mp->var_used -= siz;
3002 if (mp->math_mode > mp_math_double_mode) {
3003 if (p->has_number >= 1 && is_number(((mp_symbolic_node)p)->data.n)) {
3004 free_number(((mp_symbolic_node)p)->data.n);
3006 if (p->has_number == 2 && is_number(((mp_value_node)p)->subscript_)) {
3007 free_number(((mp_value_node)p)->subscript_);
3009 /* There was a quite large |switch| here first, but the |mp_dash_node|
3010 case was the only one that did anything ... */
3011 if (mp_type (p) == mp_dash_node_type) {
3012 free_number(((mp_dash_node)p)->start_x);
3013 free_number(((mp_dash_node)p)->stop_x);
3014 free_number(((mp_dash_node)p)->dash_y);
3019 void mp_free_symbolic_node (MP mp, mp_node p) { /* node liberation */
3020 FUNCTION_TRACE2 ("mp_free_symbolic_node
(%p
)\n
", p);
3022 if (mp->num_symbolic_nodes < max_num_symbolic_nodes) {
3023 p->link = mp->symbolic_nodes;
3024 mp->symbolic_nodes = p;
3025 mp->num_symbolic_nodes++;
3028 mp->var_used -= symbolic_node_size;
3031 void mp_free_value_node (MP mp, mp_node p) { /* node liberation */
3032 FUNCTION_TRACE2 ("mp_free_value_node
(%p
)\n
", p);
3034 if (mp->num_value_nodes < max_num_value_nodes) {
3035 p->link = mp->value_nodes;
3036 mp->value_nodes = p;
3037 mp->num_value_nodes++;
3040 mp->var_used -= value_node_size;
3041 assert(p->has_number == 2);
3042 if (mp->math_mode > mp_math_double_mode) {
3043 free_number(((mp_value_node)p)->data.n);
3044 free_number(((mp_value_node)p)->subscript_);
3050 @ @<Internal library declarations@>=
3051 void mp_free_node (MP mp, mp_node p, size_t siz);
3052 void mp_free_symbolic_node (MP mp, mp_node p);
3053 void mp_free_value_node (MP mp, mp_node p);
3056 Some nodes are created statically, since static allocation is
3057 more efficient than dynamic allocation when we can get away with it.
3060 mp_dash_node null_dash;
3061 mp_value_node dep_head;
3071 @ The following code gets the memory off to a good start.
3073 @<Initialize table entries@>=
3074 mp->spec_head = mp_get_symbolic_node (mp);
3075 mp->last_pending = mp->spec_head;
3076 mp->temp_head = mp_get_symbolic_node (mp);
3077 mp->hold_head = mp_get_symbolic_node (mp);
3079 @ @<Free table entries@>=
3080 mp_free_symbolic_node (mp, mp->spec_head);
3081 mp_free_symbolic_node (mp, mp->temp_head);
3082 mp_free_symbolic_node (mp, mp->hold_head);
3084 @ The procedure |flush_node_list(p)| frees an entire linked list of
3085 nodes that starts at a given position, until coming to a |NULL| pointer.
3089 static void mp_flush_node_list (MP mp, mp_node p) {
3090 mp_node q; /* the node being recycled */
3091 FUNCTION_TRACE2 ("mp_flush_node_list
(%p
)\n
", p);
3095 if (q->type != mp_symbol_node)
3096 mp_free_token_node (mp, q);
3098 mp_free_symbolic_node (mp, q);
3103 @* The command codes.
3104 Before we can go much further, we need to define symbolic names for the internal
3105 code numbers that represent the various commands obeyed by \MP. These codes
3106 are somewhat arbitrary, but not completely so. For example,
3107 some codes have been made adjacent so that |case| statements in the
3108 program need not consider cases that are widely spaced, or so that |case|
3109 statements can be replaced by |if| statements. A command can begin an
3110 expression if and only if its code lies between |min_primary_command| and
3111 |max_primary_command|, inclusive. The first token of a statement that doesn't
3112 begin with an expression has a command code between |min_command| and
3113 |max_statement_command|, inclusive. Anything less than |min_command| is
3114 eliminated during macro expansions, and anything no more than |max_pre_command|
3115 is eliminated when expanding \TeX\ material. Ranges such as
3116 |min_secondary_command..max_secondary_command| are used when parsing
3117 expressions, but the relative ordering within such a range is generally not
3120 The ordering of the highest-numbered commands
3121 (|comma<semicolon<end_group<stop|) is crucial for the parsing and
3122 error-recovery methods of this program as is the ordering |if_test<fi_or_else|
3123 for the smallest two commands. The ordering is also important in the ranges
3124 |numeric_token..plus_or_minus| and |left_brace..ampersand|.
3126 At any rate, here is the list, for future reference.
3128 @d mp_max_command_code mp_stop
3129 @d mp_max_pre_command mp_mpx_break
3130 @d mp_min_command (mp_defined_macro+1)
3131 @d mp_max_statement_command mp_type_name
3132 @d mp_min_primary_command mp_type_name
3133 @d mp_min_suffix_token mp_internal_quantity
3134 @d mp_max_suffix_token mp_numeric_token
3135 @d mp_max_primary_command mp_plus_or_minus /* should also be |numeric_token+1| */
3136 @d mp_min_tertiary_command mp_plus_or_minus
3137 @d mp_max_tertiary_command mp_tertiary_binary
3138 @d mp_min_expression_command mp_left_brace
3139 @d mp_max_expression_command mp_equals
3140 @d mp_min_secondary_command mp_and_command
3141 @d mp_max_secondary_command mp_secondary_binary
3142 @d mp_end_of_statement (cur_cmd()>mp_comma)
3145 @<Enumeration types@>=
3147 mp_start_tex=1, /* begin \TeX\ material (\&{btex}, \&{verbatimtex}) */
3148 mp_etex_marker, /* end \TeX\ material (\&{etex}) */
3149 mp_mpx_break, /* stop reading an \.{MPX} file (\&{mpxbreak}) */
3150 mp_if_test, /* conditional text (\&{if}) */
3151 mp_fi_or_else, /* delimiters for conditionals (\&{elseif}, \&{else}, \&{fi}) */
3152 mp_input, /* input a source file (\&{input}, \&{endinput}) */
3153 mp_iteration, /* iterate (\&{for}, \&{forsuffixes}, \&{forever}, \&{endfor}) */
3154 mp_repeat_loop, /* special command substituted for \&{endfor} */
3155 mp_exit_test, /* premature exit from a loop (\&{exitif}) */
3156 mp_relax, /* do nothing (\.{\char`\\}) */
3157 mp_scan_tokens, /* put a string into the input buffer */
3158 mp_runscript, /* put a script result string into the input buffer */
3159 mp_maketext, /* put a script result string into the input buffer */
3160 mp_expand_after, /* look ahead one token */
3161 mp_defined_macro, /* a macro defined by the user */
3162 mp_save_command, /* save a list of tokens (\&{save}) */
3163 mp_interim_command, /* save an internal quantity (\&{interim}) */
3164 mp_let_command, /* redefine a symbolic token (\&{let}) */
3165 mp_new_internal, /* define a new internal quantity (\&{newinternal}) */
3166 mp_macro_def, /* define a macro (\&{def}, \&{vardef}, etc.) */
3167 mp_ship_out_command, /* output a character (\&{shipout}) */
3168 mp_add_to_command, /* add to edges (\&{addto}) */
3169 mp_bounds_command, /* add bounding path to edges (\&{setbounds}, \&{clip}) */
3170 mp_tfm_command, /* command for font metric info (\&{ligtable}, etc.) */
3171 mp_protection_command, /* set protection flag (\&{outer}, \&{inner}) */
3172 mp_show_command, /* diagnostic output (\&{show}, \&{showvariable}, etc.) */
3173 mp_mode_command, /* set interaction level (\&{batchmode}, etc.) */
3174 mp_random_seed, /* initialize random number generator (\&{randomseed}) */
3175 mp_message_command, /* communicate to user (\&{message}, \&{errmessage}) */
3176 mp_every_job_command, /* designate a starting token (\&{everyjob}) */
3177 mp_delimiters, /* define a pair of delimiters (\&{delimiters}) */
3178 mp_special_command, /* output special info (\&{special})
3179 or font map info (\&{fontmapfile}, \&{fontmapline}) */
3180 mp_write_command, /* write text to a file (\&{write}) */
3181 mp_type_name, /* declare a type (\&{numeric}, \&{pair}, etc.) */
3182 mp_left_delimiter, /* the left delimiter of a matching pair */
3183 mp_begin_group, /* beginning of a group (\&{begingroup}) */
3184 mp_nullary, /* an operator without arguments (e.g., \&{normaldeviate}) */
3185 mp_unary, /* an operator with one argument (e.g., \&{sqrt}) */
3186 mp_str_op, /* convert a suffix to a string (\&{str}) */
3187 mp_cycle, /* close a cyclic path (\&{cycle}) */
3188 mp_primary_binary, /* binary operation taking `\&{of}' (e.g., \&{point}) */
3189 mp_capsule_token, /* a value that has been put into a token list */
3190 mp_string_token, /* a string constant (e.g., |"hello
"|) */
3191 mp_internal_quantity, /* internal numeric parameter (e.g., \&{pausing}) */
3192 mp_tag_token, /* a symbolic token without a primitive meaning */
3193 mp_numeric_token, /* a numeric constant (e.g., \.{3.14159}) */
3194 mp_plus_or_minus, /* either `\.+' or `\.-' */
3195 mp_tertiary_secondary_macro, /* a macro defined by \&{secondarydef} */
3196 mp_tertiary_binary, /* an operator at the tertiary level (e.g., `\.{++}') */
3197 mp_left_brace, /* the operator `\.{\char`\{}' */
3198 mp_path_join, /* the operator `\.{..}' */
3199 mp_ampersand, /* the operator `\.\&' */
3200 mp_expression_tertiary_macro, /* a macro defined by \&{tertiarydef} */
3201 mp_expression_binary, /* an operator at the expression level (e.g., `\.<') */
3202 mp_equals, /* the operator `\.=' */
3203 mp_and_command, /* the operator `\&{and}' */
3204 mp_secondary_primary_macro, /* a macro defined by \&{primarydef} */
3205 mp_slash, /* the operator `\./' */
3206 mp_secondary_binary, /* an operator at the binary level (e.g., \&{shifted}) */
3207 mp_param_type, /* type of parameter (\&{primary}, \&{expr}, \&{suffix}, etc.) */
3208 mp_controls, /* specify control points explicitly (\&{controls}) */
3209 mp_tension, /* specify tension between knots (\&{tension}) */
3210 mp_at_least, /* bounded tension value (\&{atleast}) */
3211 mp_curl_command, /* specify curl at an end knot (\&{curl}) */
3212 mp_macro_special, /* special macro operators (\&{quote}, \.{\#\AT!}, etc.) */
3213 mp_right_delimiter, /* the right delimiter of a matching pair */
3214 mp_left_bracket, /* the operator `\.[' */
3215 mp_right_bracket, /* the operator `\.]' */
3216 mp_right_brace, /* the operator `\.{\char`\}}' */
3217 mp_with_option, /* option for filling (\&{withpen}, \&{withweight}, etc.) */
3219 /* variant of \&{addto} (\&{contour}, \&{doublepath}, \&{also}) */
3220 mp_of_token, /* the operator `\&{of}' */
3221 mp_to_token, /* the operator `\&{to}' */
3222 mp_step_token, /* the operator `\&{step}' */
3223 mp_until_token, /* the operator `\&{until}' */
3224 mp_within_token, /* the operator `\&{within}' */
3226 /* the operators `\&{kern}' and `\.{=:}' and `\.{=:\char'174}', etc. */
3227 mp_assignment, /* the operator `\.{:=}' */
3228 mp_skip_to, /* the operation `\&{skipto}' */
3229 mp_bchar_label, /* the operator `\.{\char'174\char'174:}' */
3230 mp_double_colon, /* the operator `\.{::}' */
3231 mp_colon, /* the operator `\.:' */
3233 mp_comma, /* the operator `\.,', must be |colon+1| */
3234 mp_semicolon, /* the operator `\.;', must be |comma+1| */
3235 mp_end_group, /* end a group (\&{endgroup}), must be |semicolon+1| */
3236 mp_stop, /* end a job (\&{end}, \&{dump}), must be |end_group+1| */
3237 mp_outer_tag, /* protection code added to command code */
3238 mp_undefined_cs, /* protection code added to command code */
3241 @ Variables and capsules in \MP\ have a variety of ``types,''
3242 distinguished by the code numbers defined here. These numbers are also
3243 not completely arbitrary. Things that get expanded must have types
3244 |>mp_independent|; a type remaining after expansion is numeric if and only if
3245 its code number is at least |numeric_type|; objects containing numeric
3246 parts must have types between |transform_type| and |pair_type|;
3247 all other types must be smaller than |transform_type|; and among the types
3248 that are not unknown or vacuous, the smallest two must be |boolean_type|
3249 and |string_type| in that order.
3251 @d unknown_tag 1 /* this constant is added to certain type codes below */
3252 @d unknown_types mp_unknown_boolean: case mp_unknown_string:
3253 case mp_unknown_pen: case mp_unknown_picture: case mp_unknown_path
3255 @<Enumeration types@>=
3257 mp_undefined = 0, /* no type has been declared */
3258 mp_vacuous, /* no expression was present */
3259 mp_boolean_type, /* \&{boolean} with a known value */
3261 mp_string_type, /* \&{string} with a known value */
3263 mp_pen_type, /* \&{pen} with a known value */
3265 mp_path_type, /* \&{path} with a known value */
3267 mp_picture_type, /* \&{picture} with a known value */
3269 mp_transform_type, /* \&{transform} variable or capsule */
3270 mp_color_type, /* \&{color} variable or capsule */
3271 mp_cmykcolor_type, /* \&{cmykcolor} variable or capsule */
3272 mp_pair_type, /* \&{pair} variable or capsule */
3273 mp_numeric_type, /* variable that has been declared \&{numeric} but not used */
3274 mp_known, /* \&{numeric} with a known value */
3275 mp_dependent, /* a linear combination with |fraction| coefficients */
3276 mp_proto_dependent, /* a linear combination with |scaled| coefficients */
3277 mp_independent, /* \&{numeric} with unknown value */
3278 mp_token_list, /* variable name or suffix argument or text argument */
3279 mp_structured, /* variable with subscripts and attributes */
3280 mp_unsuffixed_macro, /* variable defined with \&{vardef} but no \.{\AT!\#} */
3281 mp_suffixed_macro, /* variable defined with \&{vardef} and \.{\AT!\#} */
3282 /* here are some generic node types */
3287 mp_subscr_node_type,
3289 mp_transform_node_type,
3291 mp_cmykcolor_node_type,
3292 /* it is important that the next 7 items remain in this order, for export */
3294 mp_stroked_node_type,
3296 mp_start_clip_node_type,
3297 mp_start_bounds_node_type,
3298 mp_stop_clip_node_type,
3299 mp_stop_bounds_node_type,
3303 mp_edge_header_node_type,
3307 static void mp_print_type (MP mp, quarterword t);
3309 @ @<Basic printing procedures@>=
3310 static const char *mp_type_string (quarterword t) {
3311 const char *s = NULL;
3319 case mp_boolean_type:
3322 case mp_unknown_boolean:
3323 s = "unknown boolean
";
3325 case mp_string_type:
3328 case mp_unknown_string:
3329 s = "unknown string
";
3334 case mp_unknown_pen:
3340 case mp_unknown_path:
3343 case mp_picture_type:
3346 case mp_unknown_picture:
3347 s = "unknown picture
";
3349 case mp_transform_type:
3355 case mp_cmykcolor_type:
3362 s = "known numeric
";
3367 case mp_proto_dependent:
3368 s = "proto-dependent
";
3370 case mp_numeric_type:
3373 case mp_independent:
3380 s = "mp_structured
";
3382 case mp_unsuffixed_macro:
3383 s = "unsuffixed macro
";
3385 case mp_suffixed_macro:
3386 s = "suffixed macro
";
3388 case mp_symbol_node:
3391 case mp_token_node_type:
3394 case mp_value_node_type:
3397 case mp_attr_node_type:
3398 s = "attribute node
";
3400 case mp_subscr_node_type:
3401 s = "subscript node
";
3403 case mp_pair_node_type:
3406 case mp_transform_node_type:
3407 s = "transform node
";
3409 case mp_color_node_type:
3412 case mp_cmykcolor_node_type:
3413 s = "cmykcolor node
";
3415 case mp_fill_node_type:
3418 case mp_stroked_node_type:
3421 case mp_text_node_type:
3424 case mp_start_clip_node_type:
3425 s = "start clip node
";
3427 case mp_start_bounds_node_type:
3428 s = "start bounds node
";
3430 case mp_stop_clip_node_type:
3431 s = "stop clip node
";
3433 case mp_stop_bounds_node_type:
3434 s = "stop bounds node
";
3436 case mp_dash_node_type:
3439 case mp_dep_node_type:
3440 s = "dependency node
";
3442 case mp_if_node_type:
3445 case mp_edge_header_node_type:
3446 s = "edge header node
";
3451 mp_snprintf (ss, 256, "<unknown type
%d
>", t);
3458 void mp_print_type (MP mp, quarterword t) {
3459 if (t >= 0 && t <= mp_edge_header_node_type)
3460 mp_print (mp, mp_type_string (t));
3462 mp_print (mp, "unknown
");
3466 @ Values inside \MP\ are stored in non-symbolic nodes that have a |name_type|
3467 as well as a |type|. The possibilities for |name_type| are defined
3468 here; they will be explained in more detail later.
3470 @<Enumeration types...@>=
3472 mp_root = 0, /* |name_type| at the top level of a variable */
3473 mp_saved_root, /* same, when the variable has been saved */
3474 mp_structured_root, /* |name_type| where a |mp_structured| branch occurs */
3475 mp_subscr, /* |name_type| in a subscript node */
3476 mp_attr, /* |name_type| in an attribute node */
3477 mp_x_part_sector, /* |name_type| in the \&{xpart} of a node */
3478 mp_y_part_sector, /* |name_type| in the \&{ypart} of a node */
3479 mp_xx_part_sector, /* |name_type| in the \&{xxpart} of a node */
3480 mp_xy_part_sector, /* |name_type| in the \&{xypart} of a node */
3481 mp_yx_part_sector, /* |name_type| in the \&{yxpart} of a node */
3482 mp_yy_part_sector, /* |name_type| in the \&{yypart} of a node */
3483 mp_red_part_sector, /* |name_type| in the \&{redpart} of a node */
3484 mp_green_part_sector, /* |name_type| in the \&{greenpart} of a node */
3485 mp_blue_part_sector, /* |name_type| in the \&{bluepart} of a node */
3486 mp_cyan_part_sector, /* |name_type| in the \&{redpart} of a node */
3487 mp_magenta_part_sector, /* |name_type| in the \&{greenpart} of a node */
3488 mp_yellow_part_sector, /* |name_type| in the \&{bluepart} of a node */
3489 mp_black_part_sector, /* |name_type| in the \&{greenpart} of a node */
3490 mp_grey_part_sector, /* |name_type| in the \&{bluepart} of a node */
3491 mp_capsule, /* |name_type| in stashed-away subexpressions */
3492 mp_token, /* |name_type| in a numeric token or string token */
3493 /* Symbolic nodes also have |name_type|, which is a different enumeration */
3495 mp_internal_sym, /* for values of internals */
3496 mp_macro_sym, /* for macro names */
3497 mp_expr_sym, /* for macro parameters if type |expr| */
3498 mp_suffix_sym, /* for macro parameters if type |suffix| */
3499 mp_text_sym, /* for macro parameters if type |text| */
3501 } mp_name_type_type;
3503 @ Primitive operations that produce values have a secondary identification
3504 code in addition to their command code; it's something like genera and species.
3505 For example, `\.*' has the command code |primary_binary|, and its
3506 secondary identification is |times|. The secondary codes start such that
3507 they don't overlap with the type codes; some type codes (e.g., |mp_string_type|)
3508 are used as operators as well as type identifications. The relative values
3509 are not critical, except for |true_code..false_code|, |or_op..and_op|,
3510 and |filled_op..bounded_op|. The restrictions are that
3511 |and_op-false_code=or_op-true_code|, that the ordering of
3512 |x_part...blue_part| must match that of |x_part_sector..mp_blue_part_sector|,
3513 and the ordering of |filled_op..bounded_op| must match that of the code
3514 values they test for.
3516 @d mp_min_of mp_substring_of
3518 @<Operation codes@>=
3519 mp_true_code, /* operation code for \.{true} */
3520 mp_false_code, /* operation code for \.{false} */
3521 mp_null_picture_code, /* operation code for \.{nullpicture} */
3522 mp_null_pen_code, /* operation code for \.{nullpen} */
3523 mp_read_string_op, /* operation code for \.{readstring} */
3524 mp_pen_circle, /* operation code for \.{pencircle} */
3525 mp_normal_deviate, /* operation code for \.{normaldeviate} */
3526 mp_read_from_op, /* operation code for \.{readfrom} */
3527 mp_close_from_op, /* operation code for \.{closefrom} */
3528 mp_odd_op, /* operation code for \.{odd} */
3529 mp_known_op, /* operation code for \.{known} */
3530 mp_unknown_op, /* operation code for \.{unknown} */
3531 mp_not_op, /* operation code for \.{not} */
3532 mp_decimal, /* operation code for \.{decimal} */
3533 mp_reverse, /* operation code for \.{reverse} */
3534 mp_make_path_op, /* operation code for \.{makepath} */
3535 mp_make_pen_op, /* operation code for \.{makepen} */
3536 mp_oct_op, /* operation code for \.{oct} */
3537 mp_hex_op, /* operation code for \.{hex} */
3538 mp_ASCII_op, /* operation code for \.{ASCII} */
3539 mp_char_op, /* operation code for \.{char} */
3540 mp_length_op, /* operation code for \.{length} */
3541 mp_turning_op, /* operation code for \.{turningnumber} */
3542 mp_color_model_part, /* operation code for \.{colormodel} */
3543 mp_x_part, /* operation code for \.{xpart} */
3544 mp_y_part, /* operation code for \.{ypart} */
3545 mp_xx_part, /* operation code for \.{xxpart} */
3546 mp_xy_part, /* operation code for \.{xypart} */
3547 mp_yx_part, /* operation code for \.{yxpart} */
3548 mp_yy_part, /* operation code for \.{yypart} */
3549 mp_red_part, /* operation code for \.{redpart} */
3550 mp_green_part, /* operation code for \.{greenpart} */
3551 mp_blue_part, /* operation code for \.{bluepart} */
3552 mp_cyan_part, /* operation code for \.{cyanpart} */
3553 mp_magenta_part, /* operation code for \.{magentapart} */
3554 mp_yellow_part, /* operation code for \.{yellowpart} */
3555 mp_black_part, /* operation code for \.{blackpart} */
3556 mp_grey_part, /* operation code for \.{greypart} */
3557 mp_font_part, /* operation code for \.{fontpart} */
3558 mp_text_part, /* operation code for \.{textpart} */
3559 mp_path_part, /* operation code for \.{pathpart} */
3560 mp_pen_part, /* operation code for \.{penpart} */
3561 mp_dash_part, /* operation code for \.{dashpart} */
3562 mp_prescript_part, /* operation code for \.{prescriptpart} */
3563 mp_postscript_part, /* operation code for \.{postscriptpart} */
3564 mp_sqrt_op, /* operation code for \.{sqrt} */
3565 mp_m_exp_op, /* operation code for \.{mexp} */
3566 mp_m_log_op, /* operation code for \.{mlog} */
3567 mp_sin_d_op, /* operation code for \.{sind} */
3568 mp_cos_d_op, /* operation code for \.{cosd} */
3569 mp_floor_op, /* operation code for \.{floor} */
3570 mp_uniform_deviate, /* operation code for \.{uniformdeviate} */
3571 mp_char_exists_op, /* operation code for \.{charexists} */
3572 mp_font_size, /* operation code for \.{fontsize} */
3573 mp_ll_corner_op, /* operation code for \.{llcorner} */
3574 mp_lr_corner_op, /* operation code for \.{lrcorner} */
3575 mp_ul_corner_op, /* operation code for \.{ulcorner} */
3576 mp_ur_corner_op, /* operation code for \.{urcorner} */
3577 mp_arc_length, /* operation code for \.{arclength} */
3578 mp_angle_op, /* operation code for \.{angle} */
3579 mp_cycle_op, /* operation code for \.{cycle} */
3580 mp_filled_op, /* operation code for \.{filled} */
3581 mp_stroked_op, /* operation code for \.{stroked} */
3582 mp_textual_op, /* operation code for \.{textual} */
3583 mp_clipped_op, /* operation code for \.{clipped} */
3584 mp_bounded_op, /* operation code for \.{bounded} */
3585 mp_plus, /* operation code for \.+ */
3586 mp_minus, /* operation code for \.- */
3587 mp_times, /* operation code for \.* */
3588 mp_over, /* operation code for \./ */
3589 mp_pythag_add, /* operation code for \.{++} */
3590 mp_pythag_sub, /* operation code for \.{+-+} */
3591 mp_or_op, /* operation code for \.{or} */
3592 mp_and_op, /* operation code for \.{and} */
3593 mp_less_than, /* operation code for \.< */
3594 mp_less_or_equal, /* operation code for \.{<=} */
3595 mp_greater_than, /* operation code for \.> */
3596 mp_greater_or_equal, /* operation code for \.{>=} */
3597 mp_equal_to, /* operation code for \.= */
3598 mp_unequal_to, /* operation code for \.{<>} */
3599 mp_concatenate, /* operation code for \.\& */
3600 mp_rotated_by, /* operation code for \.{rotated} */
3601 mp_slanted_by, /* operation code for \.{slanted} */
3602 mp_scaled_by, /* operation code for \.{scaled} */
3603 mp_shifted_by, /* operation code for \.{shifted} */
3604 mp_transformed_by, /* operation code for \.{transformed} */
3605 mp_x_scaled, /* operation code for \.{xscaled} */
3606 mp_y_scaled, /* operation code for \.{yscaled} */
3607 mp_z_scaled, /* operation code for \.{zscaled} */
3608 mp_in_font, /* operation code for \.{infont} */
3609 mp_intersect, /* operation code for \.{intersectiontimes} */
3610 mp_double_dot, /* operation code for improper \.{..} */
3611 mp_substring_of, /* operation code for \.{substring} */
3612 mp_subpath_of, /* operation code for \.{subpath} */
3613 mp_direction_time_of, /* operation code for \.{directiontime} */
3614 mp_point_of, /* operation code for \.{point} */
3615 mp_precontrol_of, /* operation code for \.{precontrol} */
3616 mp_postcontrol_of, /* operation code for \.{postcontrol} */
3617 mp_pen_offset_of, /* operation code for \.{penoffset} */
3618 mp_arc_time_of, /* operation code for \.{arctime} */
3619 mp_version, /* operation code for \.{mpversion} */
3620 mp_envelope_of, /* operation code for \.{envelope} */
3621 mp_glyph_infont, /* operation code for \.{glyph} */
3622 mp_kern_flag /* operation code for \.{kern} */
3625 static void mp_print_op (MP mp, quarterword c) {
3626 if (c <= mp_numeric_type) {
3627 mp_print_type (mp, c);
3631 mp_print (mp, "true
");
3634 mp_print (mp, "false
");
3636 case mp_null_picture_code:
3637 mp_print (mp, "nullpicture
");
3639 case mp_null_pen_code:
3640 mp_print (mp, "nullpen
");
3642 case mp_read_string_op:
3643 mp_print (mp, "readstring
");
3646 mp_print (mp, "pencircle
");
3648 case mp_normal_deviate:
3649 mp_print (mp, "normaldeviate
");
3651 case mp_read_from_op:
3652 mp_print (mp, "readfrom
");
3654 case mp_close_from_op:
3655 mp_print (mp, "closefrom
");
3658 mp_print (mp, "odd
");
3661 mp_print (mp, "known
");
3664 mp_print (mp, "unknown
");
3667 mp_print (mp, "not
");
3670 mp_print (mp, "decimal
");
3673 mp_print (mp, "reverse
");
3675 case mp_make_path_op:
3676 mp_print (mp, "makepath
");
3678 case mp_make_pen_op:
3679 mp_print (mp, "makepen
");
3682 mp_print (mp, "oct
");
3685 mp_print (mp, "hex
");
3688 mp_print (mp, "ASCII
");
3691 mp_print (mp, "char
");
3694 mp_print (mp, "length
");
3697 mp_print (mp, "turningnumber
");
3700 mp_print (mp, "xpart
");
3703 mp_print (mp, "ypart
");
3706 mp_print (mp, "xxpart
");
3709 mp_print (mp, "xypart
");
3712 mp_print (mp, "yxpart
");
3715 mp_print (mp, "yypart
");
3718 mp_print (mp, "redpart
");
3721 mp_print (mp, "greenpart
");
3724 mp_print (mp, "bluepart
");
3727 mp_print (mp, "cyanpart
");
3729 case mp_magenta_part:
3730 mp_print (mp, "magentapart
");
3732 case mp_yellow_part:
3733 mp_print (mp, "yellowpart
");
3736 mp_print (mp, "blackpart
");
3739 mp_print (mp, "greypart
");
3741 case mp_color_model_part:
3742 mp_print (mp, "colormodel
");
3745 mp_print (mp, "fontpart
");
3748 mp_print (mp, "textpart
");
3750 case mp_prescript_part:
3751 mp_print (mp, "prescriptpart
");
3753 case mp_postscript_part:
3754 mp_print (mp, "postscriptpart
");
3757 mp_print (mp, "pathpart
");
3760 mp_print (mp, "penpart
");
3763 mp_print (mp, "dashpart
");
3766 mp_print (mp, "sqrt
");
3769 mp_print (mp, "mexp
");
3772 mp_print (mp, "mlog
");
3775 mp_print (mp, "sind
");
3778 mp_print (mp, "cosd
");
3781 mp_print (mp, "floor
");
3783 case mp_uniform_deviate:
3784 mp_print (mp, "uniformdeviate
");
3786 case mp_char_exists_op:
3787 mp_print (mp, "charexists
");
3790 mp_print (mp, "fontsize
");
3792 case mp_ll_corner_op:
3793 mp_print (mp, "llcorner
");
3795 case mp_lr_corner_op:
3796 mp_print (mp, "lrcorner
");
3798 case mp_ul_corner_op:
3799 mp_print (mp, "ulcorner
");
3801 case mp_ur_corner_op:
3802 mp_print (mp, "urcorner
");
3805 mp_print (mp, "arclength
");
3808 mp_print (mp, "angle
");
3811 mp_print (mp, "cycle
");
3814 mp_print (mp, "filled
");
3817 mp_print (mp, "stroked
");
3820 mp_print (mp, "textual
");
3823 mp_print (mp, "clipped
");
3826 mp_print (mp, "bounded
");
3829 mp_print_char (mp, xord ('+'));
3832 mp_print_char (mp, xord ('-'));
3835 mp_print_char (mp, xord ('*'));
3838 mp_print_char (mp, xord ('/'));
3841 mp_print (mp, "++");
3844 mp_print (mp, "+-+");
3847 mp_print (mp, "or
");
3850 mp_print (mp, "and
");
3853 mp_print_char (mp, xord ('<'));
3855 case mp_less_or_equal:
3856 mp_print (mp, "<=");
3858 case mp_greater_than:
3859 mp_print_char (mp, xord ('>'));
3861 case mp_greater_or_equal:
3862 mp_print (mp, ">=");
3865 mp_print_char (mp, xord ('='));
3868 mp_print (mp, "<>");
3870 case mp_concatenate:
3874 mp_print (mp, "rotated");
3877 mp_print (mp, "slanted");
3880 mp_print (mp, "scaled");
3883 mp_print (mp, "shifted");
3885 case mp_transformed_by:
3886 mp_print (mp, "transformed");
3889 mp_print (mp, "xscaled");
3892 mp_print (mp, "yscaled");
3895 mp_print (mp, "zscaled");
3898 mp_print (mp, "infont");
3901 mp_print (mp, "intersectiontimes");
3903 case mp_substring_of:
3904 mp_print (mp, "substring");
3907 mp_print (mp, "subpath");
3909 case mp_direction_time_of:
3910 mp_print (mp, "directiontime");
3913 mp_print (mp, "point");
3915 case mp_precontrol_of:
3916 mp_print (mp, "precontrol");
3918 case mp_postcontrol_of:
3919 mp_print (mp, "postcontrol");
3921 case mp_pen_offset_of:
3922 mp_print (mp, "penoffset");
3924 case mp_arc_time_of:
3925 mp_print (mp, "arctime");
3928 mp_print (mp, "mpversion");
3930 case mp_envelope_of:
3931 mp_print (mp, "envelope");
3933 case mp_glyph_infont:
3934 mp_print (mp, "glyph");
3937 mp_print (mp, "..");
3944 @ \MP\ also has a bunch of internal parameters that a user might want to
3945 fuss with. Every such parameter has an identifying code number, defined here.
3948 enum mp_given_internal {
3949 mp_output_template = 1, /* a string set up by \&{outputtemplate} */
3950 mp_output_filename, /* the output file name, accessible as \&{outputfilename} */
3951 mp_output_format, /* the output format set up by \&{outputformat} */
3952 mp_output_format_options, /* the output format options set up by \&{outputformatoptions} */
3953 mp_number_system, /* the number system as set up by \&{numbersystem} */
3954 mp_number_precision, /* the number system precision as set up by \&{numberprecision} */
3955 mp_job_name, /* the perceived jobname, as set up from the options stucture,
3956 the name of the input file, or by \&{jobname} */
3957 mp_tracing_titles, /* show titles online when they appear */
3958 mp_tracing_equations, /* show each variable when it becomes known */
3959 mp_tracing_capsules, /* show capsules too */
3960 mp_tracing_choices, /* show the control points chosen for paths */
3961 mp_tracing_specs, /* show path subdivision prior to filling with polygonal a pen */
3962 mp_tracing_commands, /* show commands and operations before they are performed */
3963 mp_tracing_restores, /* show when a variable or internal is restored */
3964 mp_tracing_macros, /* show macros before they are expanded */
3965 mp_tracing_output, /* show digitized edges as they are output */
3966 mp_tracing_stats, /* show memory usage at end of job */
3967 mp_tracing_lost_chars, /* show characters that aren't \&{infont} */
3968 mp_tracing_online, /* show long diagnostics on terminal and in the log file */
3969 mp_year, /* the current year (e.g., 1984) */
3970 mp_month, /* the current month (e.g., 3 $\equiv$ March) */
3971 mp_day, /* the current day of the month */
3972 mp_time, /* the number of minutes past midnight when this job started */
3973 mp_hour, /* the number of hours past midnight when this job started */
3974 mp_minute, /* the number of minutes in that hour when this job started */
3975 mp_char_code, /* the number of the next character to be output */
3976 mp_char_ext, /* the extension code of the next character to be output */
3977 mp_char_wd, /* the width of the next character to be output */
3978 mp_char_ht, /* the height of the next character to be output */
3979 mp_char_dp, /* the depth of the next character to be output */
3980 mp_char_ic, /* the italic correction of the next character to be output */
3981 mp_design_size, /* the unit of measure used for |mp_char_wd..mp_char_ic|, in points */
3982 mp_pausing, /* positive to display lines on the terminal before they are read */
3983 mp_showstopping, /* positive to stop after each \&{show} command */
3984 mp_fontmaking, /* positive if font metric output is to be produced */
3985 mp_linejoin, /* as in \ps: 0 for mitered, 1 for round, 2 for beveled */
3986 mp_linecap, /* as in \ps: 0 for butt, 1 for round, 2 for square */
3987 mp_miterlimit, /* controls miter length as in \ps */
3988 mp_warning_check, /* controls error message when variable value is large */
3989 mp_boundary_char, /* the right boundary character for ligatures */
3990 mp_prologues, /* positive to output conforming PostScript using built-in fonts */
3991 mp_true_corners, /* positive to make \&{llcorner} etc. ignore \&{setbounds} */
3992 mp_default_color_model, /* the default color model for unspecified items */
3993 mp_restore_clip_color,
3994 mp_procset, /* wether or not create PostScript command shortcuts */
3995 mp_hppp, /* horizontal pixels per point (for png output) */
3996 mp_vppp, /* vertical pixels per point (for png output) */
3997 mp_gtroffmode, /* whether the user specified |-troff| on the command line */
4005 @ @<MPlib internal header stuff@>=
4006 #define internal_value(A) mp->internal[(A)].v.data.n
4007 #define set_internal_from_number(A,B) do { \
4008 number_clone (internal_value ((A)),(B));\
4010 #define internal_string(A) (mp_string)mp->internal[(A)].v.data.str
4011 #define set_internal_string(A,B) mp->internal[(A)].v.data.str=(B)
4012 #define internal_name(A) mp->internal[(A)].intname
4013 #define set_internal_name(A,B) mp->internal[(A)].intname=(B)
4014 #define internal_type(A) (mp_variable_type)mp->internal[(A)].v.type
4015 #define set_internal_type(A,B) mp->internal[(A)].v.type=(B)
4016 #define set_internal_from_cur_exp(A) do { \
4017 if (internal_type ((A)) == mp_string_type) { \
4018 add_str_ref (cur_exp_str ()); \
4019 set_internal_string ((A), cur_exp_str ()); \
4021 set_internal_from_number ((A), cur_exp_value_number ()); \
4029 @d max_given_internal mp_gtroffmode
4032 mp_internal *internal; /* the values of internal quantities */
4033 int int_ptr; /* the maximum internal quantity defined so far */
4034 int max_internal; /* current maximum number of internal quantities */
4036 @ @<Option variables@>=
4039 @ @<Allocate or initialize ...@>=
4040 mp->max_internal = 2 * max_given_internal;
4041 mp->internal = xmalloc ((mp->max_internal + 1), sizeof (mp_internal));
4042 memset (mp->internal, 0,
4043 (size_t) (mp->max_internal + 1) * sizeof (mp_internal));
4046 for (i = 1; i <= mp->max_internal; i++) {
4047 new_number(mp->internal[i].v.data.n);
4049 for (i = 1; i <= max_given_internal; i++) {
4050 set_internal_type (i, mp_known);
4053 set_internal_type (mp_output_format, mp_string_type);
4054 set_internal_type (mp_output_filename, mp_string_type);
4055 set_internal_type (mp_output_format_options, mp_string_type);
4056 set_internal_type (mp_output_template, mp_string_type);
4057 set_internal_type (mp_number_system, mp_string_type);
4058 set_internal_type (mp_job_name, mp_string_type);
4059 mp->troff_mode = (opt->troff_mode > 0 ? true : false);
4061 @ @<Exported function ...@>=
4062 int mp_troff_mode (MP mp);
4065 int mp_troff_mode (MP mp) {
4066 return mp->troff_mode;
4070 @ @<Set initial ...@>=
4071 mp->int_ptr = max_given_internal;
4073 @ The symbolic names for internal quantities are put into \MP's hash table
4074 by using a routine called |primitive|, which will be defined later. Let us
4075 enter them now, so that we don't have to list all those names again
4078 @<Put each of \MP's primitives into the hash table@>=
4079 mp_primitive (mp, "tracingtitles", mp_internal_quantity, mp_tracing_titles);
4080 @:tracingtitles_}{\&{tracingtitles} primitive@>;
4081 mp_primitive (mp, "tracingequations", mp_internal_quantity, mp_tracing_equations);
4082 @:mp_tracing_equations_}{\&{tracingequations} primitive@>;
4083 mp_primitive (mp, "tracingcapsules", mp_internal_quantity, mp_tracing_capsules);
4084 @:mp_tracing_capsules_}{\&{tracingcapsules} primitive@>;
4085 mp_primitive (mp, "tracingchoices", mp_internal_quantity, mp_tracing_choices);
4086 @:mp_tracing_choices_}{\&{tracingchoices} primitive@>;
4087 mp_primitive (mp, "tracingspecs", mp_internal_quantity, mp_tracing_specs);
4088 @:mp_tracing_specs_}{\&{tracingspecs} primitive@>;
4089 mp_primitive (mp, "tracingcommands", mp_internal_quantity, mp_tracing_commands);
4090 @:mp_tracing_commands_}{\&{tracingcommands} primitive@>;
4091 mp_primitive (mp, "tracingrestores", mp_internal_quantity, mp_tracing_restores);
4092 @:mp_tracing_restores_}{\&{tracingrestores} primitive@>;
4093 mp_primitive (mp, "tracingmacros", mp_internal_quantity, mp_tracing_macros);
4094 @:mp_tracing_macros_}{\&{tracingmacros} primitive@>;
4095 mp_primitive (mp, "tracingoutput", mp_internal_quantity, mp_tracing_output);
4096 @:mp_tracing_output_}{\&{tracingoutput} primitive@>;
4097 mp_primitive (mp, "tracingstats", mp_internal_quantity, mp_tracing_stats);
4098 @:mp_tracing_stats_}{\&{tracingstats} primitive@>;
4099 mp_primitive (mp, "tracinglostchars", mp_internal_quantity, mp_tracing_lost_chars);
4100 @:mp_tracing_lost_chars_}{\&{tracinglostchars} primitive@>;
4101 mp_primitive (mp, "tracingonline", mp_internal_quantity, mp_tracing_online);
4102 @:mp_tracing_online_}{\&{tracingonline} primitive@>;
4103 mp_primitive (mp, "year", mp_internal_quantity, mp_year);
4104 @:mp_year_}{\&{year} primitive@>;
4105 mp_primitive (mp, "month", mp_internal_quantity, mp_month);
4106 @:mp_month_}{\&{month} primitive@>;
4107 mp_primitive (mp, "day", mp_internal_quantity, mp_day);
4108 @:mp_day_}{\&{day} primitive@>;
4109 mp_primitive (mp, "time", mp_internal_quantity, mp_time);
4110 @:time_}{\&{time} primitive@>;
4111 mp_primitive (mp, "hour", mp_internal_quantity, mp_hour);
4112 @:hour_}{\&{hour} primitive@>;
4113 mp_primitive (mp, "minute", mp_internal_quantity, mp_minute);
4114 @:minute_}{\&{minute} primitive@>;
4115 mp_primitive (mp, "charcode", mp_internal_quantity, mp_char_code);
4116 @:mp_char_code_}{\&{charcode} primitive@>;
4117 mp_primitive (mp, "charext", mp_internal_quantity, mp_char_ext);
4118 @:mp_char_ext_}{\&{charext} primitive@>;
4119 mp_primitive (mp, "charwd", mp_internal_quantity, mp_char_wd);
4120 @:mp_char_wd_}{\&{charwd} primitive@>;
4121 mp_primitive (mp, "charht", mp_internal_quantity, mp_char_ht);
4122 @:mp_char_ht_}{\&{charht} primitive@>;
4123 mp_primitive (mp, "chardp", mp_internal_quantity, mp_char_dp);
4124 @:mp_char_dp_}{\&{chardp} primitive@>;
4125 mp_primitive (mp, "charic", mp_internal_quantity, mp_char_ic);
4126 @:mp_char_ic_}{\&{charic} primitive@>;
4127 mp_primitive (mp, "designsize", mp_internal_quantity, mp_design_size);
4128 @:mp_design_size_}{\&{designsize} primitive@>;
4129 mp_primitive (mp, "pausing", mp_internal_quantity, mp_pausing);
4130 @:mp_pausing_}{\&{pausing} primitive@>;
4131 mp_primitive (mp, "showstopping", mp_internal_quantity, mp_showstopping);
4132 @:mp_showstopping_}{\&{showstopping} primitive@>;
4133 mp_primitive (mp, "fontmaking", mp_internal_quantity, mp_fontmaking);
4134 @:mp_fontmaking_}{\&{fontmaking} primitive@>;
4135 mp_primitive (mp, "linejoin", mp_internal_quantity, mp_linejoin);
4136 @:mp_linejoin_}{\&{linejoin} primitive@>;
4137 mp_primitive (mp, "linecap", mp_internal_quantity, mp_linecap);
4138 @:mp_linecap_}{\&{linecap} primitive@>;
4139 mp_primitive (mp, "miterlimit", mp_internal_quantity, mp_miterlimit);
4140 @:mp_miterlimit_}{\&{miterlimit} primitive@>;
4141 mp_primitive (mp, "warningcheck", mp_internal_quantity, mp_warning_check);
4142 @:mp_warning_check_}{\&{warningcheck} primitive@>;
4143 mp_primitive (mp, "boundarychar", mp_internal_quantity, mp_boundary_char);
4144 @:mp_boundary_char_}{\&{boundarychar} primitive@>;
4145 mp_primitive (mp, "prologues", mp_internal_quantity, mp_prologues);
4146 @:mp_prologues_}{\&{prologues} primitive@>;
4147 mp_primitive (mp, "truecorners", mp_internal_quantity, mp_true_corners);
4148 @:mp_true_corners_}{\&{truecorners} primitive@>;
4149 mp_primitive (mp, "mpprocset", mp_internal_quantity, mp_procset);
4150 @:mp_procset_}{\&{mpprocset} primitive@>;
4151 mp_primitive (mp, "troffmode", mp_internal_quantity, mp_gtroffmode);
4152 @:troffmode_}{\&{troffmode} primitive@>;
4153 mp_primitive (mp, "defaultcolormodel", mp_internal_quantity,
4154 mp_default_color_model);
4155 @:mp_default_color_model_}{\&{defaultcolormodel} primitive@>;
4156 mp_primitive (mp, "restoreclipcolor", mp_internal_quantity, mp_restore_clip_color);
4157 @:mp_restore_clip_color_}{\&{restoreclipcolor} primitive@>;
4158 mp_primitive (mp, "outputtemplate", mp_internal_quantity, mp_output_template);
4159 @:mp_output_template_}{\&{outputtemplate} primitive@>;
4160 mp_primitive (mp, "outputfilename", mp_internal_quantity, mp_output_filename);
4161 @:mp_output_filename_}{\&{outputfilename} primitive@>;
4162 mp_primitive (mp, "numbersystem", mp_internal_quantity, mp_number_system);
4163 @:mp_number_system_}{\&{numbersystem} primitive@>;
4164 mp_primitive (mp, "numberprecision", mp_internal_quantity, mp_number_precision);
4165 @:mp_number_precision_}{\&{numberprecision} primitive@>;
4166 mp_primitive (mp, "outputformat", mp_internal_quantity, mp_output_format);
4167 @:mp_output_format_}{\&{outputformat} primitive@>;
4168 mp_primitive (mp, "outputformatoptions", mp_internal_quantity, mp_output_format_options);
4169 @:mp_output_format_options_}{\&{outputformatoptions} primitive@>;
4170 mp_primitive (mp, "jobname", mp_internal_quantity, mp_job_name);
4171 @:mp_job_name_}{\&{jobname} primitive@>
4172 mp_primitive (mp, "hppp", mp_internal_quantity, mp_hppp);
4173 @:mp_hppp_}{\&{hppp} primitive@>;
4174 mp_primitive (mp, "vppp", mp_internal_quantity, mp_vppp);
4175 @:mp_vppp_}{\&{vppp} primitive@>;
4178 @ Colors can be specified in four color models. In the special
4179 case of |no_model|, MetaPost does not output any color operator to
4180 the postscript output.
4182 Note: these values are passed directly on to |with_option|. This only
4183 works because the other possible values passed to |with_option| are
4184 8 and 10 respectively (from |with_pen| and |with_picture|).
4186 There is a first state, that is only used for |gs_colormodel|. It flags
4187 the fact that there has not been any kind of color specification by
4188 the user so far in the game.
4190 @<MPlib header stuff@>=
4191 enum mp_color_model {
4196 mp_uninitialized_model = 9
4200 @ @<Initialize table entries@>=
4201 set_internal_from_number (mp_default_color_model, unity_t);
4202 number_multiply_int (internal_value (mp_default_color_model), mp_rgb_model);
4203 number_clone (internal_value (mp_restore_clip_color), unity_t);
4204 number_clone (internal_value (mp_hppp), unity_t);
4205 number_clone (internal_value (mp_vppp), unity_t);
4206 set_internal_string (mp_output_template, mp_intern (mp, "%j.%c"));
4207 set_internal_string (mp_output_filename, mp_intern (mp, ""));
4208 set_internal_string (mp_output_format, mp_intern (mp, "eps"));
4209 set_internal_string (mp_output_format_options, mp_intern (mp, ""));
4210 set_internal_string (mp_number_system, mp_intern (mp, "scaled"));
4211 set_internal_from_number (mp_number_precision, precision_default);
4213 number_clone (internal_value (mp_tracing_titles), three_t);
4214 number_clone (internal_value (mp_tracing_equations), three_t);
4215 number_clone (internal_value (mp_tracing_capsules), three_t);
4216 number_clone (internal_value (mp_tracing_choices), three_t);
4217 number_clone (internal_value (mp_tracing_specs), three_t);
4218 number_clone (internal_value (mp_tracing_commands), three_t);
4219 number_clone (internal_value (mp_tracing_restores), three_t);
4220 number_clone (internal_value (mp_tracing_macros), three_t);
4221 number_clone (internal_value (mp_tracing_output), three_t);
4222 number_clone (internal_value (mp_tracing_stats), three_t);
4223 number_clone (internal_value (mp_tracing_lost_chars), three_t);
4224 number_clone (internal_value (mp_tracing_online), three_t);
4227 @ Well, we do have to list the names one more time, for use in symbolic
4230 @<Initialize table...@>=
4231 set_internal_name (mp_tracing_titles, xstrdup ("tracingtitles"));
4232 set_internal_name (mp_tracing_equations, xstrdup ("tracingequations"));
4233 set_internal_name (mp_tracing_capsules, xstrdup ("tracingcapsules"));
4234 set_internal_name (mp_tracing_choices, xstrdup ("tracingchoices"));
4235 set_internal_name (mp_tracing_specs, xstrdup ("tracingspecs"));
4236 set_internal_name (mp_tracing_commands, xstrdup ("tracingcommands"));
4237 set_internal_name (mp_tracing_restores, xstrdup ("tracingrestores"));
4238 set_internal_name (mp_tracing_macros, xstrdup ("tracingmacros"));
4239 set_internal_name (mp_tracing_output, xstrdup ("tracingoutput"));
4240 set_internal_name (mp_tracing_stats, xstrdup ("tracingstats"));
4241 set_internal_name (mp_tracing_lost_chars, xstrdup ("tracinglostchars"));
4242 set_internal_name (mp_tracing_online, xstrdup ("tracingonline"));
4243 set_internal_name (mp_year, xstrdup ("year"));
4244 set_internal_name (mp_month, xstrdup ("month"));
4245 set_internal_name (mp_day, xstrdup ("day"));
4246 set_internal_name (mp_time, xstrdup ("time"));
4247 set_internal_name (mp_hour, xstrdup ("hour"));
4248 set_internal_name (mp_minute, xstrdup ("minute"));
4249 set_internal_name (mp_char_code, xstrdup ("charcode"));
4250 set_internal_name (mp_char_ext, xstrdup ("charext"));
4251 set_internal_name (mp_char_wd, xstrdup ("charwd"));
4252 set_internal_name (mp_char_ht, xstrdup ("charht"));
4253 set_internal_name (mp_char_dp, xstrdup ("chardp"));
4254 set_internal_name (mp_char_ic, xstrdup ("charic"));
4255 set_internal_name (mp_design_size, xstrdup ("designsize"));
4256 set_internal_name (mp_pausing, xstrdup ("pausing"));
4257 set_internal_name (mp_showstopping, xstrdup ("showstopping"));
4258 set_internal_name (mp_fontmaking, xstrdup ("fontmaking"));
4259 set_internal_name (mp_linejoin, xstrdup ("linejoin"));
4260 set_internal_name (mp_linecap, xstrdup ("linecap"));
4261 set_internal_name (mp_miterlimit, xstrdup ("miterlimit"));
4262 set_internal_name (mp_warning_check, xstrdup ("warningcheck"));
4263 set_internal_name (mp_boundary_char, xstrdup ("boundarychar"));
4264 set_internal_name (mp_prologues, xstrdup ("prologues"));
4265 set_internal_name (mp_true_corners, xstrdup ("truecorners"));
4266 set_internal_name (mp_default_color_model, xstrdup ("defaultcolormodel"));
4267 set_internal_name (mp_procset, xstrdup ("mpprocset"));
4268 set_internal_name (mp_gtroffmode, xstrdup ("troffmode"));
4269 set_internal_name (mp_restore_clip_color, xstrdup ("restoreclipcolor"));
4270 set_internal_name (mp_output_template, xstrdup ("outputtemplate"));
4271 set_internal_name (mp_output_filename, xstrdup ("outputfilename"));
4272 set_internal_name (mp_output_format, xstrdup ("outputformat"));
4273 set_internal_name (mp_output_format_options, xstrdup ("outputformatoptions"));
4274 set_internal_name (mp_job_name, xstrdup ("jobname"));
4275 set_internal_name (mp_number_system, xstrdup ("numbersystem"));
4276 set_internal_name (mp_number_precision, xstrdup ("numberprecision"));
4277 set_internal_name (mp_hppp, xstrdup ("hppp"));
4278 set_internal_name (mp_vppp, xstrdup ("vppp"));
4280 @ The following procedure, which is called just before \MP\ initializes its
4281 input and output, establishes the initial values of the date and time.
4282 @^system dependencies@>
4284 Note that the values are |scaled| integers. Hence \MP\ can no longer
4285 be used after the year 32767.
4288 static void mp_fix_date_and_time (MP mp) {
4289 time_t aclock = time ((time_t *) 0);
4290 struct tm *tmptr = localtime (&aclock);
4291 set_internal_from_number (mp_time, unity_t);
4292 number_multiply_int (internal_value(mp_time), (tmptr->tm_hour * 60 + tmptr->tm_min));
4293 set_internal_from_number (mp_hour, unity_t);
4294 number_multiply_int (internal_value(mp_hour), (tmptr->tm_hour));
4295 set_internal_from_number (mp_minute, unity_t);
4296 number_multiply_int (internal_value(mp_minute), (tmptr->tm_min));
4297 set_internal_from_number (mp_day, unity_t);
4298 number_multiply_int (internal_value(mp_day), (tmptr->tm_mday));
4299 set_internal_from_number (mp_month, unity_t);
4300 number_multiply_int (internal_value(mp_month), (tmptr->tm_mon + 1));
4301 set_internal_from_number (mp_year, unity_t);
4302 number_multiply_int (internal_value(mp_year), (tmptr->tm_year + 1900));
4307 static void mp_fix_date_and_time (MP mp);
4309 @ \MP\ is occasionally supposed to print diagnostic information that
4310 goes only into the transcript file, unless |mp_tracing_online| is positive.
4311 Now that we have defined |mp_tracing_online| we can define
4312 two routines that adjust the destination of print commands:
4315 static void mp_begin_diagnostic (MP mp);
4316 static void mp_end_diagnostic (MP mp, boolean blank_line);
4317 static void mp_print_diagnostic (MP mp, const char *s, const char *t,
4320 @ @<Basic printing...@>=
4321 void mp_begin_diagnostic (MP mp) { /* prepare to do some tracing */
4322 mp->old_setting = mp->selector;
4323 if (number_nonpositive(internal_value (mp_tracing_online))
4324 && (mp->selector == term_and_log)) {
4325 decr (mp->selector);
4326 if (mp->history == mp_spotless)
4327 mp->history = mp_warning_issued;
4331 void mp_end_diagnostic (MP mp, boolean blank_line) {
4332 /* restore proper conditions after tracing */
4333 mp_print_nl (mp, "");
4336 mp->selector = mp->old_setting;
4343 unsigned int old_setting;
4345 @ We will occasionally use |begin_diagnostic| in connection with line-number
4346 printing, as follows. (The parameter |s| is typically |"Path"| or
4347 |"Cycle spec"|, etc.)
4349 @<Basic printing...@>=
4350 void mp_print_diagnostic (MP mp, const char *s, const char *t, boolean nuline) {
4351 mp_begin_diagnostic (mp);
4353 mp_print_nl (mp, s);
4356 mp_print (mp, " at line ");
4357 mp_print_int (mp, mp_true_line (mp));
4359 mp_print_char (mp, xord (':'));
4363 @ The 256 |ASCII_code| characters are grouped into classes by means of
4364 the |char_class| table. Individual class numbers have no semantic
4365 or syntactic significance, except in a few instances defined here.
4366 There's also |max_class|, which can be used as a basis for additional
4367 class numbers in nonstandard extensions of \MP.
4369 @d digit_class 0 /* the class number of \.{0123456789} */
4370 @d period_class 1 /* the class number of `\..' */
4371 @d space_class 2 /* the class number of spaces and nonstandard characters */
4372 @d percent_class 3 /* the class number of `\.\%' */
4373 @d string_class 4 /* the class number of `\."' */
4374 @d right_paren_class
8 /* the class number of `\.
)'
*/
4375 @d isolated_classes
5: case
6: case
7: case
8 /* characters that make length-one tokens only
*/
4376 @d letter_class
9 /* letters and the underline character
*/
4377 @d mp_left_bracket_class
17 /* `\.
['
*/
4378 @d mp_right_bracket_class
18 /* `\.
]'
*/
4379 @d invalid_class
20 /* bad character in the input
*/
4380 @d max_class
20 /* the largest class number
*/
4383 #define digit_class
0 /* the class number of \.
{0123456789} */
4384 int char_class
[256]; /* the class numbers
*/
4386 @ If changes are made to accommodate non-ASCII character sets
, they should
4387 follow the guidelines in Appendix~C of
{\sl The
{\logos METAFONT\
/}book
}.
4388 @
:METAFONTbook
}{\sl The
{\logos METAFONT\
/}book@
>
4389 @^system dependencies@
>
4391 @
<Set initial ...@
>=
4392 for
(k
= '
0'
; k
<= '
9'
; k
++)
4393 mp-
>char_class
[k
] = digit_class
;
4394 mp-
>char_class
['.'
] = period_class
;
4395 mp-
>char_class
[' '
] = space_class
;
4396 mp-
>char_class
['
%'
] = percent_class
;
4397 mp-
>char_class
['
"'] = string_class;
4398 mp->char_class[','] = 5;
4399 mp->char_class[';'] = 6;
4400 mp->char_class['('] = 7;
4401 mp->char_class[')'] = right_paren_class;
4402 for (k = 'A'; k <= 'Z'; k++)
4403 mp->char_class[k] = letter_class;
4404 for (k = 'a'; k <= 'z'; k++)
4405 mp->char_class[k] = letter_class;
4406 mp->char_class['_'] = letter_class;
4407 mp->char_class['<'] = 10;
4408 mp->char_class['='] = 10;
4409 mp->char_class['>'] = 10;
4410 mp->char_class[':'] = 10;
4411 mp->char_class['|'] = 10;
4412 mp->char_class['`'] = 11;
4413 mp->char_class['\''] = 11;
4414 mp->char_class['+'] = 12;
4415 mp->char_class['-'] = 12;
4416 mp->char_class['/'] = 13;
4417 mp->char_class['*'] = 13;
4418 mp->char_class['\\'] = 13;
4419 mp->char_class['!'] = 14;
4420 mp->char_class['?'] = 14;
4421 mp->char_class['#'] = 15;
4422 mp->char_class['&'] = 15;
4423 mp->char_class['@@'] = 15;
4424 mp->char_class['$'] = 15;
4425 mp->char_class['^'] = 16;
4426 mp->char_class['~'] = 16;
4427 mp->char_class['['] = mp_left_bracket_class;
4428 mp->char_class[']'] = mp_right_bracket_class;
4429 mp->char_class['{'] = 19;
4430 mp->char_class['}'] = 19;
4431 for (k = 0; k < ' '; k++)
4432 mp->char_class[k] = invalid_class;
4433 mp->char_class['\t'] = space_class;
4434 mp->char_class['\f'] = space_class;
4435 for (k = 127; k <= 255; k++)
4436 mp->char_class[k] = invalid_class;
4440 Symbolic tokens are stored in and retrieved from an AVL tree. This
4441 is not as fast as an actual hash table, but it is easily extensible.
4443 A symbolic token contains a pointer to the |mp_string| that
4444 contains the string representation of the symbol, a |halfword|
4445 that holds the current command value of the token, and an
4446 |mp_value| for the associated equivalent.
4449 FUNCTION_TRACE3 ("set_text
(%p
, %p
)\n
",(A),(B));
4453 @d set_eq_type(A,B) do {
4454 FUNCTION_TRACE3 ("set_eq_type
(%p
, %d
)\n
",(A),(B));
4458 @d set_equiv(A,B) do {
4459 FUNCTION_TRACE3 ("set_equiv
(%p
, %d
)\n
",(A),(B));
4460 (A)->v.data.node=NULL ;
4461 (A)->v.data.indep.serial=(B);
4464 @d set_equiv_node(A,B) do {
4465 FUNCTION_TRACE3 ("set_equiv_node
(%p
, %p
)\n
",(A),(B));
4466 (A)->v.data.node=(B) ;
4467 (A)->v.data.indep.serial=0;
4470 @d set_equiv_sym(A,B) do {
4471 FUNCTION_TRACE3 ("set_equiv_sym
(%p
, %p
)\n
",(A),(B));
4472 (A)->v.data.node=(mp_node)(B);
4473 (A)->v.data.indep.serial=0;
4478 #define text(A) do_get_text(mp, (A))
4479 #define eq_type(A) do_get_eq_type(mp, (A))
4480 #define equiv(A) do_get_equiv(mp, (A))
4481 #define equiv_node(A) do_get_equiv_node(mp, (A))
4482 #define equiv_sym(A) do_get_equiv_sym(mp, (A))
4483 static mp_string do_get_text (MP mp, mp_sym A) {
4484 FUNCTION_TRACE3 ("%d
= do_get_text
(%p
)\n
",A->text,A);
4487 static halfword do_get_eq_type (MP mp, mp_sym A) {
4488 FUNCTION_TRACE3 ("%d
= do_get_eq_type
(%p
)\n
",A->type,A);
4491 static halfword do_get_equiv (MP mp, mp_sym A) {
4492 FUNCTION_TRACE3 ("%d
= do_get_equiv
(%p
)\n
",A->v.data.indep.serial,A);
4493 return A->v.data.indep.serial;
4495 static mp_node do_get_equiv_node (MP mp, mp_sym A) {
4496 FUNCTION_TRACE3 ("%p
= do_get_equiv_node
(%p
)\n
",A->v.data.node,A);
4497 return A->v.data.node;
4499 static mp_sym do_get_equiv_sym (MP mp, mp_sym A) {
4500 FUNCTION_TRACE3 ("%p
= do_get_equiv_sym
(%p
)\n
",A->v.data.node,A);
4501 return (mp_sym)A->v.data.node;
4504 #define text(A) (A)->text
4505 #define eq_type(A) (A)->type
4506 #define equiv(A) (A)->v.data.indep.serial
4507 #define equiv_node(A) (A)->v.data.node
4508 #define equiv_sym(A) (mp_sym)(A)->v.data.node
4511 @ @<Declarations...@>=
4513 static mp_string do_get_text (MP mp, mp_sym A);
4514 static halfword do_get_eq_type (MP mp, mp_sym A);
4515 static halfword do_get_equiv (MP mp, mp_sym A);
4516 static mp_node do_get_equiv_node (MP mp, mp_sym A);
4517 static mp_sym do_get_equiv_sym (MP mp, mp_sym A);
4521 typedef struct mp_symbol_entry {
4529 integer st_count; /* total number of known identifiers */
4530 avl_tree symbols; /* avl tree of symbolic tokens */
4531 avl_tree frozen_symbols; /* avl tree of frozen symbolic tokens */
4532 mp_sym frozen_bad_vardef;
4533 mp_sym frozen_colon;
4534 mp_sym frozen_end_def;
4535 mp_sym frozen_end_for;
4536 mp_sym frozen_end_group;
4539 mp_sym frozen_inaccessible;
4540 mp_sym frozen_left_bracket;
4541 mp_sym frozen_mpx_break;
4542 mp_sym frozen_repeat_loop;
4543 mp_sym frozen_right_delimiter;
4544 mp_sym frozen_semicolon;
4545 mp_sym frozen_slash;
4546 mp_sym frozen_undefined;
4550 @ Here are the functions needed for the avl construction.
4553 static int comp_symbols_entry (void *p, const void *pa, const void *pb);
4554 static void *copy_symbols_entry (const void *p);
4555 static void *delete_symbols_entry (void *p);
4558 @ The avl comparison function is a straightword version of |strcmp|,
4559 except that checks for the string lengths first.
4562 static int comp_symbols_entry (void *p, const void *pa, const void *pb) {
4563 const mp_symbol_entry *a = (const mp_symbol_entry *) pa;
4564 const mp_symbol_entry *b = (const mp_symbol_entry *) pb;
4566 if (a->text->len != b->text->len) {
4567 return (a->text->len > b->text->len ? 1 : -1);
4569 return strncmp ((const char *) a->text->str, (const char *) b->text->str,
4574 @ Copying a symbol happens when an item is inserted into an AVL tree.
4575 The |text| and |mp_number| needs to be deep copied, every thing else
4579 static void *copy_symbols_entry (const void *p) {
4582 const mp_symbol_entry *fp;
4583 fp = (const mp_symbol_entry *) p;
4584 mp = (MP)fp->parent;
4585 ff = malloc (sizeof (mp_symbol_entry));
4588 ff->text = copy_strings_entry (fp->text);
4589 if (ff->text == NULL)
4592 ff->type = fp->type;
4594 new_number(ff->v.data.n);
4595 number_clone(ff->v.data.n, fp->v.data.n);
4600 @ In the current implementation, symbols are not freed until the
4604 static void *delete_symbols_entry (void *p) {
4606 mp_sym ff = (mp_sym) p;
4607 mp = (MP)ff->parent;
4608 free_number(ff->v.data.n);
4609 mp_xfree (ff->text->str);
4610 mp_xfree (ff->text);
4616 @ @<Allocate or initialize ...@>=
4617 mp->symbols = avl_create (comp_symbols_entry,
4619 delete_symbols_entry, malloc, free, NULL);
4620 mp->frozen_symbols = avl_create (comp_symbols_entry,
4622 delete_symbols_entry, malloc, free, NULL);
4624 @ @<Dealloc variables@>=
4625 if (mp->symbols != NULL)
4626 avl_destroy (mp->symbols);
4627 if (mp->frozen_symbols != NULL)
4628 avl_destroy (mp->frozen_symbols);
4630 @ Actually creating symbols is done by |id_lookup|, but in order to
4631 do so it needs a way to create a new, empty symbol structure.
4634 static mp_sym new_symbols_entry (MP mp, unsigned char *nam, size_t len);
4637 static mp_sym new_symbols_entry (MP mp, unsigned char *nam, size_t len) {
4639 ff = mp_xmalloc (mp, 1, sizeof (mp_symbol_entry));
4640 memset (ff, 0, sizeof (mp_symbol_entry));
4642 ff->text = mp_xmalloc (mp, 1, sizeof (mp_lstring));
4643 ff->text->str = nam;
4644 ff->text->len = len;
4645 ff->type = mp_tag_token;
4646 ff->v.type = mp_known;
4647 new_number(ff->v.data.n);
4648 FUNCTION_TRACE4 ("%p
= new_symbols_entry
(\
"%s\",%d
)\n
", ff, nam, (int)len);
4653 @ There is one global variable so that |id_lookup| does not always have to
4654 create a new entry just for testing. This is not freed because it creates
4655 a double-free thanks to the |NULL| init.
4658 mp_sym id_lookup_test;
4660 @ @<Initialize table entries@>=
4661 mp->id_lookup_test = new_symbols_entry (mp, NULL, 0);
4663 @ Certain symbols are ``frozen'' and not redefinable, since they are
4667 @<Initialize table entries@>=
4669 mp->frozen_bad_vardef = mp_frozen_primitive (mp, "a bad variable
", mp_tag_token, 0);
4670 mp->frozen_right_delimiter = mp_frozen_primitive (mp, ")", mp_right_delimiter, 0);
4671 mp->frozen_inaccessible = mp_frozen_primitive (mp, " INACCESSIBLE
", mp_tag_token, 0);
4672 mp->frozen_undefined = mp_frozen_primitive (mp, " UNDEFINED
", mp_tag_token, 0);
4674 @ Here is the subroutine that searches the avl tree for an identifier
4675 that matches a given string of length~|l| appearing in |buffer[j..
4676 (j+l-1)]|. If the identifier is not found, it is inserted if
4677 |insert_new| is |true|, and the corresponding symbol will be returned.
4679 There are two variations on the lookup function: one for the normal
4680 symbol table, and one for the table of error recovery symbols.
4682 @d mp_id_lookup(A,B,C,D) mp_do_id_lookup ((A), mp->symbols, (B), (C), (D))
4685 static mp_sym mp_do_id_lookup (MP mp, avl_tree symbols, char *j,
4686 size_t l, boolean insert_new) {
4687 /* search an avl tree */
4689 mp->id_lookup_test->text->str = (unsigned char *)j;
4690 mp->id_lookup_test->text->len = l;
4691 str = (mp_sym) avl_find (mp->id_lookup_test, symbols);
4692 if (str == NULL && insert_new) {
4693 unsigned char *nam = (unsigned char *) mp_xstrldup (mp, j, l);
4694 mp_sym s = new_symbols_entry (mp, nam, l);
4696 assert (avl_ins (s, symbols, avl_false) > 0);
4697 str = (mp_sym) avl_find (s, symbols);
4698 delete_symbols_entry (s);
4702 static mp_sym mp_frozen_id_lookup (MP mp, char *j, size_t l,
4703 boolean insert_new) {
4704 /* search the error recovery symbol table */
4705 return mp_do_id_lookup (mp, mp->frozen_symbols, j, l, insert_new);
4708 /* see mp_print_sym (mp_sym sym) */
4709 @ Get a numeric value from \MP\ is not easy. We have to consider
4710 the macro and the loops, as also the internal type (this is a
4711 first attempt, and more work is needed). If we are inside
4712 a \&{for} loop, then the global |loop_ptr| is not null and the other loops
4713 eventually nested are available by mean of |loop_ptr->link|.
4714 The current numeric value is stored in |old_value|.
4717 double mp_get_numeric_value (MP mp, const char *s, size_t l) {
4718 char *ss = mp_xstrdup(mp,s);
4720 mp_sym sym = mp_id_lookup(mp,ss,l,false);
4722 if (mp->loop_ptr != NULL) {
4725 while (s != NULL && sym != s->var)
4726 s = mp->loop_ptr->link;
4727 if (s != NULL && sym == s->var ){
4729 return number_to_double(s->old_value) ;
4732 if (mp_type(sym) == mp_internal_quantity) {
4733 halfword qq = equiv(sym);
4735 if (internal_type (qq) != mp_string_type)
4736 return number_to_double(internal_value(qq));
4740 if (sym->v.data.node != NULL && mp_type(sym->v.data.node) == mp_known) {
4742 return number_to_double(sym->v.data.node->data.n) ;
4750 int mp_get_boolean_value (MP mp, const char *s, size_t l) {
4751 char *ss = mp_xstrdup(mp,s);
4753 mp_sym sym = mp_id_lookup(mp,ss,l,false);
4755 if (mp_type(sym->v.data.node) == mp_boolean_type) {
4756 if (number_to_boolean (sym->v.data.node->data.n) == mp_true_code) {
4767 char *mp_get_string_value (MP mp, const char *s, size_t l) {
4768 char *ss = mp_xstrdup(mp,s);
4770 mp_sym sym = mp_id_lookup(mp,ss,l,false);
4772 if (mp_type(sym->v.data.node) == mp_string_type) {
4774 return (char *) sym->v.data.node->data.str->str;
4782 @ @<Exported function headers@>=
4783 double mp_get_numeric_value(MP mp,const char *s,size_t l);
4784 int mp_get_boolean_value(MP mp,const char *s,size_t l);
4785 char *mp_get_string_value(MP mp,const char *s,size_t l);
4787 @ We need to put \MP's ``primitive'' symbolic tokens into the hash
4788 table, together with their command code (which will be the |eq_type|)
4789 and an operand (which will be the |equiv|). The |primitive| procedure
4790 does this, in a way that no \MP\ user can. The global value |cur_sym|
4791 contains the new |eqtb| pointer after |primitive| has acted.
4794 static void mp_primitive (MP mp, const char *ss, halfword c, halfword o) {
4795 char *s = mp_xstrdup (mp, ss);
4796 set_cur_sym (mp_id_lookup (mp, s, strlen (s), true));
4798 set_eq_type (cur_sym(), c);
4799 set_equiv (cur_sym(), o);
4803 @ Some other symbolic tokens only exist for error recovery.
4806 static mp_sym mp_frozen_primitive (MP mp, const char *ss, halfword c,
4808 char *s = mp_xstrdup (mp, ss);
4809 mp_sym str = mp_frozen_id_lookup (mp, s, strlen (ss), true);
4812 str->v.data.indep.serial = o;
4817 @ This routine returns |true| if the argument is an un-redefinable symbol
4818 because it is one of the error recovery tokens (as explained elsewhere,
4819 |frozen_inaccessible| actuall is redefinable).
4822 static boolean mp_is_frozen (MP mp, mp_sym sym) {
4823 mp_sym temp = mp_frozen_id_lookup (mp, (char *) sym->text->str, sym->text->len, false);
4824 if (temp==mp->frozen_inaccessible)
4826 return (temp == sym);
4830 @ Many of \MP's primitives need no |equiv|, since they are identifiable
4831 by their |eq_type| alone. These primitives are loaded into the hash table
4834 @<Put each of \MP's primitives into the hash table@>=
4835 mp_primitive (mp, "..
", mp_path_join, 0);
4836 @:.._}{\.{..} primitive@>;
4837 mp_primitive (mp, "[", mp_left_bracket, 0);
4838 mp->frozen_left_bracket = mp_frozen_primitive (mp, "[", mp_left_bracket, 0);
4839 @:[ }{\.{[} primitive@>;
4840 mp_primitive (mp, "]", mp_right_bracket, 0);
4841 @:] }{\.{]} primitive@>;
4842 mp_primitive (mp, "}", mp_right_brace, 0);
4843 @:]]}{\.{\char`\}} primitive@>;
4844 mp_primitive (mp, "{", mp_left_brace, 0);
4845 @:][}{\.{\char`\{} primitive@>;
4846 mp_primitive (mp, ":", mp_colon, 0);
4847 mp->frozen_colon = mp_frozen_primitive (mp, ":", mp_colon, 0);
4848 @:: }{\.{:} primitive@>;
4849 mp_primitive (mp, "::", mp_double_colon, 0);
4850 @::: }{\.{::} primitive@>;
4851 mp_primitive (mp, "||
:", mp_bchar_label, 0);
4852 @:::: }{\.{\char'174\char'174:} primitive@>;
4853 mp_primitive (mp, ":=", mp_assignment, 0);
4854 @::=_}{\.{:=} primitive@>;
4855 mp_primitive (mp, ",", mp_comma, 0);
4856 @:, }{\., primitive@>;
4857 mp_primitive (mp, ";", mp_semicolon, 0);
4858 mp->frozen_semicolon = mp_frozen_primitive (mp, ";", mp_semicolon, 0);
4859 @:; }{\.; primitive@>;
4860 mp_primitive (mp, "\\
", mp_relax, 0);
4861 @:]]\\}{\.{\char`\\} primitive@>;
4862 mp_primitive (mp, "addto
", mp_add_to_command, 0);
4863 @:add_to_}{\&{addto} primitive@>;
4864 mp_primitive (mp, "atleast
", mp_at_least, 0);
4865 @:at_least_}{\&{atleast} primitive@>;
4866 mp_primitive (mp, "begingroup
", mp_begin_group, 0);
4867 mp->bg_loc = cur_sym();
4868 @:begin_group_}{\&{begingroup} primitive@>;
4869 mp_primitive (mp, "controls
", mp_controls, 0);
4870 @:controls_}{\&{controls} primitive@>;
4871 mp_primitive (mp, "curl
", mp_curl_command, 0);
4872 @:curl_}{\&{curl} primitive@>;
4873 mp_primitive (mp, "delimiters
", mp_delimiters, 0);
4874 @:delimiters_}{\&{delimiters} primitive@>;
4875 mp_primitive (mp, "endgroup
", mp_end_group, 0);
4876 mp->eg_loc = cur_sym();
4877 mp->frozen_end_group = mp_frozen_primitive (mp, "endgroup
", mp_end_group, 0);
4878 @:endgroup_}{\&{endgroup} primitive@>;
4879 mp_primitive (mp, "everyjob
", mp_every_job_command, 0);
4880 @:every_job_}{\&{everyjob} primitive@>;
4881 mp_primitive (mp, "exitif
", mp_exit_test, 0);
4882 @:exit_if_}{\&{exitif} primitive@>;
4883 mp_primitive (mp, "expandafter
", mp_expand_after, 0);
4884 @:expand_after_}{\&{expandafter} primitive@>;
4885 mp_primitive (mp, "interim
", mp_interim_command, 0);
4886 @:interim_}{\&{interim} primitive@>;
4887 mp_primitive (mp, "let
", mp_let_command, 0);
4888 @:let_}{\&{let} primitive@>;
4889 mp_primitive (mp, "newinternal
", mp_new_internal, 0);
4890 @:new_internal_}{\&{newinternal} primitive@>;
4891 mp_primitive (mp, "of
", mp_of_token, 0);
4892 @:of_}{\&{of} primitive@>;
4893 mp_primitive (mp, "randomseed
", mp_random_seed, 0);
4894 @:mp_random_seed_}{\&{randomseed} primitive@>;
4895 mp_primitive (mp, "save
", mp_save_command, 0);
4896 @:save_}{\&{save} primitive@>;
4897 mp_primitive (mp, "scantokens
", mp_scan_tokens, 0);
4898 @:scan_tokens_}{\&{scantokens} primitive@>;
4900 mp_primitive (mp, "runscript
", mp_runscript, 0);
4901 @:run_script_}{\&{runscript} primitive@>;
4902 mp_primitive (mp, "maketext
", mp_maketext, 0);
4903 @:make_text_}{\&{maketext} primitive@>;
4905 mp_primitive (mp, "shipout
", mp_ship_out_command, 0);
4906 @:ship_out_}{\&{shipout} primitive@>;
4907 mp_primitive (mp, "skipto
", mp_skip_to, 0);
4908 @:skip_to_}{\&{skipto} primitive@>;
4909 mp_primitive (mp, "special
", mp_special_command, 0);
4910 @:special}{\&{special} primitive@>;
4911 mp_primitive (mp, "fontmapfile
", mp_special_command, 1);
4912 @:fontmapfile}{\&{fontmapfile} primitive@>;
4913 mp_primitive (mp, "fontmapline
", mp_special_command, 2);
4914 @:fontmapline}{\&{fontmapline} primitive@>;
4915 mp_primitive (mp, "step
", mp_step_token, 0);
4916 @:step_}{\&{step} primitive@>;
4917 mp_primitive (mp, "str
", mp_str_op, 0);
4918 @:str_}{\&{str} primitive@>;
4919 mp_primitive (mp, "tension
", mp_tension, 0);
4920 @:tension_}{\&{tension} primitive@>;
4921 mp_primitive (mp, "to
", mp_to_token, 0);
4922 @:to_}{\&{to} primitive@>;
4923 mp_primitive (mp, "until
", mp_until_token, 0);
4924 @:until_}{\&{until} primitive@>;
4925 mp_primitive (mp, "within
", mp_within_token, 0);
4926 @:within_}{\&{within} primitive@>;
4927 mp_primitive (mp, "write
", mp_write_command, 0);
4928 @:write_}{\&{write} primitive@>
4931 @ Each primitive has a corresponding inverse, so that it is possible to
4932 display the cryptic numeric contents of |eqtb| in symbolic form.
4933 Every call of |primitive| in this program is therefore accompanied by some
4934 straightforward code that forms part of the |print_cmd_mod| routine
4937 @<Cases of |print_cmd_mod| for symbolic printing of primitives@>=
4938 case mp_add_to_command:
4939 mp_print (mp, "addto
");
4942 mp_print (mp, ":=");
4945 mp_print (mp, "atleast
");
4947 case mp_bchar_label:
4948 mp_print (mp, "||
:");
4950 case mp_begin_group:
4951 mp_print (mp, "begingroup
");
4960 mp_print (mp, "controls
");
4962 case mp_curl_command:
4963 mp_print (mp, "curl
");
4966 mp_print (mp, "delimiters
");
4968 case mp_double_colon:
4969 mp_print (mp, "::");
4972 mp_print (mp, "endgroup
");
4974 case mp_every_job_command:
4975 mp_print (mp, "everyjob
");
4978 mp_print (mp, "exitif
");
4980 case mp_expand_after:
4981 mp_print (mp, "expandafter
");
4983 case mp_interim_command:
4984 mp_print (mp, "interim
");
4989 case mp_left_bracket:
4992 case mp_let_command:
4993 mp_print (mp, "let
");
4995 case mp_new_internal:
4996 mp_print (mp, "newinternal
");
4999 mp_print (mp, "of
");
5002 mp_print (mp, "..
");
5004 case mp_random_seed:
5005 mp_print (mp, "randomseed
");
5008 mp_print_char (mp, xord ('\\'));
5010 case mp_right_brace:
5011 mp_print_char (mp, xord ('}'));
5013 case mp_right_bracket:
5014 mp_print_char (mp, xord (']'));
5016 case mp_save_command:
5017 mp_print (mp, "save
");
5019 case mp_scan_tokens:
5020 mp_print (mp, "scantokens
");
5023 mp_print (mp, "runscript
");
5026 mp_print (mp, "maketext
");
5029 mp_print_char (mp, xord (';'));
5031 case mp_ship_out_command:
5032 mp_print (mp, "shipout
");
5035 mp_print (mp, "skipto
");
5037 case mp_special_command:
5039 mp_print (mp, "fontmapline
");
5041 mp_print (mp, "fontmapfile
");
5043 mp_print (mp, "special
");
5046 mp_print (mp, "step
");
5049 mp_print (mp, "str
");
5052 mp_print (mp, "tension
");
5055 mp_print (mp, "to
");
5057 case mp_until_token:
5058 mp_print (mp, "until
");
5060 case mp_within_token:
5061 mp_print (mp, "within
");
5063 case mp_write_command:
5064 mp_print (mp, "write
");
5067 @ We will deal with the other primitives later, at some point in the program
5068 where their |eq_type| and |equiv| values are more meaningful. For example,
5069 the primitives for macro definitions will be loaded when we consider the
5070 routines that define macros. It is easy to find where each particular
5071 primitive was treated by looking in the index at the end; for example, the
5072 section where |"def
"| entered |eqtb| is listed under `\&{def} primitive'.
5076 A \MP\ token is either symbolic or numeric or a string, or it denotes a macro
5077 parameter or capsule or an internal; so there are six corresponding ways to
5078 encode it internally:
5081 (1)~A symbolic token for symbol |p| is represented by the pointer |p|,
5082 in the |sym_sym| field of a symbolic node in~|mem|. The |type| field is |symbol_node|;
5083 and it has a |name_type| to differentiate various subtypes of symbolic tokens,
5084 which is usually |normal_sym|, but |macro_sym| for macro names.
5086 (2)~A numeric token whose |scaled| value is~|v| is
5087 represented in a non-symbolic node of~|mem|; the |type| field is |known|,
5088 the |name_type| field is |token|, and the |value| field holds~|v|.
5090 (3)~A string token is also represented in a non-symbolic node; the |type|
5091 field is |mp_string_type|, the |name_type| field is |token|, and the
5092 |value| field holds the corresponding |mp_string|.
5094 (4)~Capsules have |name_type=capsule|, and their |type| and |value| fields
5095 represent arbitrary values, with |type| different from |symbol_node|
5096 (in ways to be explained later).
5098 (5)~Macro parameters appear in |sym_info| fields of symbolic nodes. The |type|
5099 field is |symbol_node|; the $k$th parameter is represented by |k| in |sym_info|;
5100 and |expr_sym| in |name_type|, if it is of type \&{expr}, or |suffix_sym| if it
5101 is of type \&{suffix}, or by |text_sym| if it is of type \&{text}.
5103 (6)~The $k$th internal is also represented by |k| in |sym_info|; the |type| field is
5104 |symbol_node| as for the other symbolic tokens; and |internal_sym| is its |name_type|;
5106 Actual values of the parameters and internals are kept in a separate
5107 stack, as we will see later.
5109 Note that the `\\{type}' field of a node has nothing to do with ``type'' in a
5110 printer's sense. It's curious that the same word is used in such different ways.
5112 @d token_node_size sizeof(mp_node_data) /* the number of words in a large token node */
5114 @d set_value_sym(A,B) do_set_value_sym(mp, (mp_token_node)(A), (B))
5115 @d set_value_number(A,B) do_set_value_number(mp, (mp_token_node)(A), (B))
5116 @d set_value_node(A,B) do_set_value_node(mp, (mp_token_node)(A), (B))
5117 @d set_value_str(A,B) do_set_value_str(mp, (mp_token_node)(A), (B))
5118 @d set_value_knot(A,B) do_set_value_knot(mp, (mp_token_node)A, (B))
5120 @d value_sym_NEW(A) (mp_sym)mp_link(A)
5121 @d set_value_sym_NEW(A,B) set_mp_link(A,(mp_node)B)
5123 @<MPlib internal header stuff@>=
5124 typedef struct mp_node_data *mp_token_node;
5128 #define value_sym(A) do_get_value_sym(mp,(mp_token_node)(A))
5129 /* |#define value_number(A) do_get_value_number(mp,(mp_token_node)(A))| */
5130 #define value_number(A) ((mp_token_node)(A))->data.n
5131 #define value_node(A) do_get_value_node(mp,(mp_token_node)(A))
5132 #define value_str(A) do_get_value_str(mp,(mp_token_node)(A))
5133 #define value_knot(A) do_get_value_knot(mp,(mp_token_node)(A))
5135 #define value_sym(A) ((mp_token_node)(A))->data.sym
5136 #define value_number(A) ((mp_token_node)(A))->data.n
5137 #define value_node(A) ((mp_token_node)(A))->data.node
5138 #define value_str(A) ((mp_token_node)(A))->data.str
5139 #define value_knot(A) ((mp_token_node)(A))->data.p
5141 static void do_set_value_sym(MP mp, mp_token_node A, mp_sym B) {
5142 FUNCTION_TRACE3 ("set_value_sym
(%p
,%p
)\n
", (A),(B));
5145 static void do_set_value_number(MP mp, mp_token_node A, mp_number B) {
5146 FUNCTION_TRACE3 ("set_value
(%p
,%s
)\n
", (A), number_tostring(B));
5149 A->data.node = NULL;
5150 number_clone (A->data.n, B);
5152 static void do_set_value_str(MP mp, mp_token_node A, mp_string B) {
5153 FUNCTION_TRACE3 ("set_value_str
(%p
,%p
)\n
", (A),(B));
5154 assert (A->type != mp_structured);
5158 A->data.node = NULL;
5159 number_clone (A->data.n, zero_t);
5161 static void do_set_value_node(MP mp, mp_token_node A, mp_node B) {
5162 /* store the value in a large token node */
5163 FUNCTION_TRACE3 ("set_value_node
(%p
,%p
)\n
", A,B);
5164 assert (A->type != mp_structured);
5168 number_clone (A->data.n, zero_t);
5170 static void do_set_value_knot(MP mp, mp_token_node A, mp_knot B) {
5171 FUNCTION_TRACE3 ("set_value_knot
(%p
,%p
)\n
", (A),(B));
5172 assert (A->type != mp_structured);
5175 A->data.node = NULL;
5176 number_clone (A->data.n, zero_t);
5182 static mp_sym do_get_value_sym (MP mp, mp_token_node A) {
5183 /* |A->type| can be structured in this case */
5184 FUNCTION_TRACE3 ("%p
= get_value_sym
(%p
)\n
", A->data.sym, A);
5185 return A->data.sym ;
5187 static mp_node do_get_value_node (MP mp, mp_token_node A) {
5188 assert (A->type != mp_structured);
5189 FUNCTION_TRACE3 ("%p
= get_value_node
(%p
)\n
", A->data.node, A);
5190 return A->data.node ;
5192 static mp_string do_get_value_str (MP mp, mp_token_node A) {
5193 assert (A->type != mp_structured);
5194 FUNCTION_TRACE3 ("%p
= get_value_str
(%p
)\n
", A->data.str, A);
5195 return A->data.str ;
5197 static mp_knot do_get_value_knot (MP mp, mp_token_node A) {
5198 assert (A->type != mp_structured);
5199 FUNCTION_TRACE3 ("%p
= get_value_knot
(%p
)\n
", A->data.p, A);
5202 static mp_number do_get_value_number (MP mp, mp_token_node A) {
5203 assert (A->type != mp_structured);
5204 FUNCTION_TRACE3 ("%d
= get_value_number
(%p
)\n
", A->data.n.type, A);
5211 static mp_number do_get_value_number (MP mp, mp_token_node A);
5212 static mp_sym do_get_value_sym (MP mp, mp_token_node A);
5213 static mp_node do_get_value_node (MP mp, mp_token_node A);
5214 static mp_string do_get_value_str (MP mp, mp_token_node A) ;
5215 static mp_knot do_get_value_knot (MP mp, mp_token_node A) ;
5217 static void do_set_value_sym (MP mp, mp_token_node A, mp_sym B);
5218 static void do_set_value_number (MP mp, mp_token_node A, mp_number B);
5219 static void do_set_value_node (MP mp, mp_token_node A, mp_node B);
5220 static void do_set_value_str (MP mp, mp_token_node A, mp_string B);
5221 static void do_set_value_knot (MP mp, mp_token_node A, mp_knot B);
5225 static mp_node mp_get_token_node (MP mp) {
5227 if (mp->token_nodes) {
5228 p = mp->token_nodes;
5229 mp->token_nodes = p->link;
5230 mp->num_token_nodes--;
5233 p = malloc_node (token_node_size);
5234 new_number(p->data.n);
5237 p->type = mp_token_node_type;
5238 FUNCTION_TRACE2 ("%p
= mp_get_token_node
()\n
", p);
5243 static void mp_free_token_node (MP mp, mp_node p) {
5244 FUNCTION_TRACE2 ("mp_free_token_node
(%p
)\n
", p);
5246 if (mp->num_token_nodes < max_num_token_nodes) {
5247 p->link = mp->token_nodes;
5248 mp->token_nodes = p;
5249 mp->num_token_nodes++;
5252 mp->var_used -= token_node_size;
5253 if (mp->math_mode > mp_math_double_mode) {
5254 free_number(((mp_value_node)p)->data.n);
5260 static void mp_free_token_node (MP mp, mp_node p);
5262 @ A numeric token is created by the following trivial routine.
5265 static mp_node mp_new_num_tok (MP mp, mp_number v) {
5266 mp_node p; /* the new node */
5267 p = mp_get_token_node (mp);
5268 set_value_number (p, v);
5270 p->name_type = mp_token;
5271 FUNCTION_TRACE3 ("%p
= mp_new_num_tok
(%p
)\n
", p, v);
5276 @ A token list is a singly linked list of nodes in |mem|, where
5277 each node contains a token and a link. Here's a subroutine that gets rid
5278 of a token list when it is no longer needed.
5281 static void mp_flush_token_list (MP mp, mp_node p) {
5282 mp_node q; /* the node being recycled */
5283 FUNCTION_TRACE2 ("mp_flush_token_list
(%p
)\n
", p);
5287 if (mp_type (q) == mp_symbol_node) {
5288 mp_free_symbolic_node (mp, q);
5290 switch (mp_type (q)) {
5292 case mp_boolean_type:
5295 case mp_string_type:
5296 delete_str_ref (value_str (q));
5301 case mp_picture_type:
5304 case mp_cmykcolor_type:
5305 case mp_transform_type:
5307 case mp_proto_dependent:
5308 case mp_independent:
5309 mp_recycle_value (mp, q);
5312 mp_confusion (mp, "token
");
5313 @:this can't happen token}{\quad token@>;
5315 mp_free_token_node (mp, q);
5321 @ The procedure |show_token_list|, which prints a symbolic form of
5322 the token list that starts at a given node |p|, illustrates these
5323 conventions. The token list being displayed should not begin with a reference
5326 An additional parameter |q| is also given; this parameter is either NULL
5327 or it points to a node in the token list where a certain magic computation
5328 takes place that will be explained later. (Basically, |q| is non-NULL when
5329 we are printing the two-line context information at the time of an error
5330 message; |q| marks the place corresponding to where the second line
5333 The generation will stop, and `\.{\char`\ ETC.}' will be printed, if the length
5334 of printing exceeds a given limit~|l|; the length of printing upon entry is
5335 assumed to be a given amount called |null_tally|. (Note that
5336 |show_token_list| sometimes uses itself recursively to print
5337 variable names within a capsule.)
5340 Unusual entries are printed in the form of all-caps tokens
5341 preceded by a space, e.g., `\.{\char`\ BAD}'.
5344 static void mp_show_token_list (MP mp, mp_node p, mp_node q, integer l,
5345 integer null_tally);
5348 void mp_show_token_list (MP mp, mp_node p, mp_node q, integer l,
5349 integer null_tally) {
5350 quarterword cclass, c; /* the |char_class| of previous and new tokens */
5351 cclass = percent_class;
5352 mp->tally = null_tally;
5353 while ((p != NULL) && (mp->tally < l)) {
5357 /* Display token |p| and set |c| to its class; but |return| if there are problems */
5358 c = letter_class; /* the default */
5359 if (mp_type (p) != mp_symbol_node) {
5360 /* Display non-symbolic token */
5361 if (mp_name_type (p) == mp_token) {
5362 if (mp_type (p) == mp_known) {
5363 /* Display a numeric token */
5364 if (cclass == digit_class)
5365 mp_print_char (mp, xord (' '));
5366 if (number_negative (value_number (p))) {
5367 if (cclass == mp_left_bracket_class)
5368 mp_print_char (mp, xord (' '));
5369 mp_print_char (mp, xord ('['));
5370 print_number (value_number (p));
5371 mp_print_char (mp, xord (']'));
5372 c = mp_right_bracket_class;
5374 print_number (value_number (p));
5378 } else if (mp_type (p) != mp_string_type) {
5379 mp_print (mp, " BAD
");
5381 mp_print_char (mp, xord ('"'
));
5382 mp_print_str
(mp
, value_str
(p
));
5383 mp_print_char
(mp
, xord
('
"'));
5386 } else if ((mp_name_type (p) != mp_capsule) || (mp_type (p) < mp_vacuous)
5387 || (mp_type (p) > mp_independent)) {
5388 mp_print (mp, " BAD
");
5390 mp_print_capsule (mp, p);
5391 c = right_paren_class;
5395 if (mp_name_type (p) == mp_expr_sym ||
5396 mp_name_type (p) == mp_suffix_sym || mp_name_type (p) == mp_text_sym) {
5397 integer r; /* temporary register */
5398 r = mp_sym_info (p);
5399 if (mp_name_type (p) == mp_expr_sym) {
5400 mp_print (mp, "(EXPR
");
5401 } else if (mp_name_type (p) == mp_suffix_sym) {
5402 mp_print (mp, "(SUFFIX
");
5404 mp_print (mp, "(TEXT");
5406 mp_print_int (mp, r);
5407 mp_print_char (mp, xord (')'));
5408 c = right_paren_class;
5410 mp_sym sr = mp_sym_sym (p);
5411 if (sr == collective_subscript) {
5412 /* Display a collective subscript */
5413 if (cclass == mp_left_bracket_class)
5414 mp_print_char (mp, xord (' '));
5415 mp_print (mp, "[]");
5416 c = mp_right_bracket_class;
5419 mp_string rr = text (sr);
5420 if (rr == NULL || rr->str == NULL) {
5421 mp_print (mp, " NONEXISTENT
");
5423 /* Print string |r| as a symbolic token and set |c| to its class */
5424 c = (quarterword) mp->char_class[(rr->str[0])];
5428 mp_print_char (mp, xord ('.'));
5430 case isolated_classes:
5433 mp_print_char (mp, xord (' '));
5437 mp_print_str (mp, rr);
5448 mp_print (mp, " ETC.
");
5454 static void mp_print_capsule (MP mp, mp_node p);
5456 @ @<Declare miscellaneous procedures that were declared |forward|@>=
5457 void mp_print_capsule (MP mp, mp_node p) {
5458 mp_print_char (mp, xord ('('));
5459 mp_print_exp (mp, p, 0);
5460 mp_print_char (mp, xord (')'));
5464 @ Macro definitions are kept in \MP's memory in the form of token lists
5465 that have a few extra symbolic nodes at the beginning.
5467 The first node contains a reference count that is used to tell when the
5468 list is no longer needed. To emphasize the fact that a reference count is
5469 present, we shall refer to the |sym_info| field of this special node as the
5471 @^reference counts@>
5473 The next node or nodes after the reference count serve to describe the
5474 formal parameters. They consist of zero or more parameter tokens followed
5475 by a code for the type of macro.
5477 /* reference count preceding a macro definition or picture header */
5478 @d ref_count(A) indep_value(A)
5479 @d set_ref_count(A,B) set_indep_value(A,B)
5480 @d add_mac_ref(A) set_ref_count((A),ref_count((A))+1) /* make a new reference to a macro list */
5481 @d decr_mac_ref(A) set_ref_count((A),ref_count((A))-1) /* remove a reference to a macro list */
5485 mp_general_macro, /* preface to a macro defined with a parameter list */
5486 mp_primary_macro, /* preface to a macro with a \&{primary} parameter */
5487 mp_secondary_macro, /* preface to a macro with a \&{secondary} parameter */
5488 mp_tertiary_macro, /* preface to a macro with a \&{tertiary} parameter */
5489 mp_expr_macro, /* preface to a macro with an undelimited \&{expr} parameter */
5490 mp_of_macro, /* preface to a macro with undelimited `\&{expr} |x| \&{of}~|y|' parameters */
5491 mp_suffix_macro, /* preface to a macro with an undelimited \&{suffix} parameter */
5492 mp_text_macro, /* preface to a macro with an undelimited \&{text} parameter */
5493 mp_expr_param, /* used by \.{expr} primitive */
5494 mp_suffix_param, /* used by \.{suffix} primitive */
5495 mp_text_param /* used by \.{text} primitive */
5499 static void mp_delete_mac_ref (MP mp, mp_node p) {
5500 /* |p| points to the reference count of a macro list that is
5501 losing one reference */
5502 if (ref_count (p) == 0)
5503 mp_flush_token_list (mp, p);
5509 @ The following subroutine displays a macro, given a pointer to its
5513 static void mp_show_macro (MP mp, mp_node p, mp_node q, integer l) {
5514 mp_node r; /* temporary storage */
5515 p = mp_link (p); /* bypass the reference count */
5516 while (mp_name_type (p) != mp_macro_sym) {
5519 mp_show_token_list (mp, p, NULL, l, 0);
5526 } /* control printing of `\.{ETC.}' */
5529 switch (mp_sym_info (p)) {
5530 case mp_general_macro:
5531 mp_print (mp, "->");
5534 case mp_primary_macro:
5535 case mp_secondary_macro:
5536 case mp_tertiary_macro:
5537 mp_print_char (mp, xord ('<'));
5538 mp_print_cmd_mod (mp, mp_param_type, mp_sym_info (p));
5539 mp_print (mp, ">->");
5542 mp_print (mp, "<expr
>->");
5545 mp_print (mp, "<expr
>of
<primary
>->");
5547 case mp_suffix_macro:
5548 mp_print (mp, "<suffix
>->");
5551 mp_print (mp, "<text
>->");
5553 } /* there are no other cases */
5554 mp_show_token_list (mp, mp_link (p), q, l - mp->tally, 0);
5558 @* Data structures for variables.
5559 The variables of \MP\ programs can be simple, like `\.x', or they can
5560 combine the structural properties of arrays and records, like `\.{x20a.b}'.
5561 A \MP\ user assigns a type to a variable like \.{x20a.b} by saying, for
5562 example, `\.{boolean} \.{x[]a.b}'. It's time for us to study how such
5563 things are represented inside of the computer.
5565 Each variable value occupies two consecutive words, either in a non-symbolic
5566 node called a value node, or as a non-symbolic subfield of a larger node. One
5567 of those two words is called the |value| field; it is an integer,
5568 containing either a |scaled| numeric value or the representation of some
5569 other type of quantity. (It might also be subdivided into halfwords, in
5570 which case it is referred to by other names instead of |value|.) The other
5571 word is broken into subfields called |type|, |name_type|, and |link|. The
5572 |type| field is a quarterword that specifies the variable's type, and
5573 |name_type| is a quarterword from which \MP\ can reconstruct the
5574 variable's name (sometimes by using the |link| field as well). Thus, only
5575 1.25 words are actually devoted to the value itself; the other
5576 three-quarters of a word are overhead, but they aren't wasted because they
5577 allow \MP\ to deal with sparse arrays and to provide meaningful diagnostics.
5579 In this section we shall be concerned only with the structural aspects of
5580 variables, not their values. Later parts of the program will change the
5581 |type| and |value| fields, but we shall treat those fields as black boxes
5582 whose contents should not be touched.
5584 However, if the |type| field is |mp_structured|, there is no |value| field,
5585 and the second word is broken into two pointer fields called |attr_head|
5586 and |subscr_head|. Those fields point to additional nodes that
5587 contain structural information, as we shall see.
5589 TH Note: DEK and JDH had a nice theoretical split between |value|,
5590 |attr| and |subscr| nodes, as documented above and further
5591 below. However, all three types had a bad habit of transmuting into
5592 each other in practice while pointers to them still lived on
5593 elsewhere, so using three different C structures is simply not
5594 workable. All three are now represented as a single C structure called
5597 There is a potential union in this structure in the interest of space
5598 saving: |subscript_| and |hashloc_| are mutually exclusive.
5600 Actually, so are |attr_head_| + |subscr_head_| on one side and and
5601 |value_| on the other, but because of all the access macros that are
5602 used in the code base to get at values, those cannot be folded into a
5603 union (yet); this would have required creating a similar union in
5604 |mp_token_node| where it would only serve to confuse things.
5606 Finally, |parent_| only applies in |attr| nodes (the ones that have
5607 |hashloc_|), but creating an extra substructure inside the union just
5608 for that does not save space and the extra complication in the
5609 structure is not worth the minimal extra code clarification.
5611 @d attr_head(A) do_get_attr_head(mp,(mp_value_node)(A))
5612 @d set_attr_head(A,B) do_set_attr_head(mp,(mp_value_node)(A),(mp_node)(B))
5614 @d subscr_head(A) do_get_subscr_head(mp,(mp_value_node)(A))
5615 @d set_subscr_head(A,B) do_set_subscr_head(mp,(mp_value_node)(A),(mp_node)(B))
5617 @<MPlib internal header stuff@>=
5618 typedef struct mp_value_node_data {
5621 mp_number subscript_;
5625 mp_node subscr_head_;
5626 } mp_value_node_data;
5629 static mp_node do_get_attr_head (MP mp, mp_value_node A) {
5630 assert (A->type == mp_structured);
5631 FUNCTION_TRACE3 ("%p
= get_attr_head
(%p
)\n
", A->attr_head_, A);
5632 return A->attr_head_;
5634 static mp_node do_get_subscr_head (MP mp, mp_value_node A) {
5635 assert (A->type == mp_structured);
5636 FUNCTION_TRACE3 ("%p
= get_subscr_head
(%p
)\n
", A->subscr_head_, A);
5637 return A->subscr_head_;
5639 static void do_set_attr_head (MP mp, mp_value_node A, mp_node d) {
5640 FUNCTION_TRACE4 ("set_attr_head
(%p
,%p
) on line
%d\n
", (A), d, __LINE__);
5641 assert (A->type == mp_structured);
5644 static void do_set_subscr_head (MP mp, mp_value_node A, mp_node d) {
5645 FUNCTION_TRACE4 ("set_subscr_head
(%p
,%p
) on line
%d\n
", (A), d, __LINE__);
5646 assert (A->type == mp_structured);
5647 A->subscr_head_ = d;
5651 static mp_node do_get_subscr_head (MP mp, mp_value_node A);
5652 static mp_node do_get_attr_head (MP mp, mp_value_node A);
5653 static void do_set_attr_head (MP mp, mp_value_node A, mp_node d);
5654 static void do_set_subscr_head (MP mp, mp_value_node A, mp_node d);
5656 @ It would have been nicer to make |mp_get_value_node| return
5657 |mp_value_node| variables, but with |eqtb| as it stands that
5658 became messy: lots of typecasts. So, it returns a simple
5661 @d value_node_size sizeof(struct mp_value_node_data)
5664 static mp_node mp_get_value_node (MP mp) {
5666 if (mp->value_nodes) {
5667 p = (mp_value_node)mp->value_nodes;
5668 mp->value_nodes = p->link;
5669 mp->num_value_nodes--;
5672 p = malloc_node (value_node_size);
5673 new_number(p->data.n);
5674 new_number(p->subscript_);
5677 mp_type (p) = mp_value_node_type;
5678 FUNCTION_TRACE2 ("%p
= mp_get_value_node
()\n
", p);
5682 static void debug_dump_value_node (mp_node x) {
5683 mp_value_node qq = (mp_value_node)x;
5684 fprintf (stdout, "\nnode
%p
:\n
", qq);
5685 fprintf (stdout, " type
=%s\n
", mp_type_string(qq->type));
5686 fprintf (stdout, " name_type
=%d\n
", qq->name_type);
5687 fprintf (stdout, " link
=%p\n
", qq->link);
5688 fprintf (stdout, " data.n
=%d\n
", qq->data.n.type);
5689 if (is_number(qq->data.n)) {
5690 fprintf (stdout, " data.n.data.val
=%d\n
", qq->data.n.data.val);
5691 fprintf (stdout, " data.n.data.dval
=%f\n
", qq->data.n.data.dval);
5693 fprintf (stdout, " data.str
=%p\n
", qq->data.str);
5694 if (qq->data.str != NULL) {
5695 fprintf (stdout, " data.str-
>len
=%d\n
", (int)qq->data.str->len);
5696 fprintf (stdout, " data.str-
>str
=%s\n
", qq->data.str->str);
5698 fprintf (stdout, " data.indep.serial
=%d\n data.indep.scale
=%d\n
", qq->data.indep.serial,
5699 qq->data.indep.scale);
5700 fprintf (stdout, " data.sym
=%p\n
", qq->data.sym);
5701 fprintf (stdout, " data.p
=%p\n
", qq->data.p);
5702 fprintf (stdout, " data.node
=%p\n
", qq->data.node);
5703 fprintf (stdout, " subscript
=%d\n
", qq->subscript_.type);
5704 if (is_number(qq->subscript_)) {
5705 fprintf (stdout, " subscript_.data.val
=%d\n
", qq->subscript_.data.val);
5706 fprintf (stdout, " subscript_.data.dval
=%f\n
", qq->subscript_.data.dval);
5708 fprintf (stdout, " hashloc
=%p\n
", qq->hashloc_);
5709 fprintf (stdout, " parent
=%p\n
", qq->parent_);
5710 fprintf (stdout, " attr_head
=%p\n
", qq->attr_head_);
5711 fprintf (stdout, " subscr_head
=%p\n\n
", qq->subscr_head_);
5716 static mp_node mp_get_value_node (MP mp);
5718 static void debug_dump_value_node (mp_node x);
5721 @ An attribute node is three words long. Two of these words contain |type|
5722 and |value| fields as described above, and the third word contains
5723 additional information: There is an |hashloc| field, which contains the
5724 hash address of the token that names this attribute; and there's also a
5725 |parent| field, which points to the value node of |mp_structured| type at the
5726 next higher level (i.e., at the level to which this attribute is
5727 subsidiary). The |name_type| in an attribute node is `|attr|'. The
5728 |link| field points to the next attribute with the same parent; these are
5729 arranged in increasing order, so that |hashloc(mp_link(p))>hashloc(p)|. The
5730 final attribute node links to the constant |end_attr|, whose |hashloc|
5731 field is greater than any legal hash address. The |attr_head| in the
5732 parent points to a node whose |name_type| is |mp_structured_root|; this
5733 node represents the NULL attribute, i.e., the variable that is relevant
5734 when no attributes are attached to the parent. The |attr_head| node
5735 has the fields of either
5736 a value node, a subscript node, or an attribute node, depending on what
5737 the parent would be if it were not structured; but the subscript and
5738 attribute fields are ignored, so it effectively contains only the data of
5739 a value node. The |link| field in this special node points to an attribute
5740 node whose |hashloc| field is zero; the latter node represents a collective
5741 subscript `\.{[]}' attached to the parent, and its |link| field points to
5742 the first non-special attribute node (or to |end_attr| if there are none).
5744 A subscript node likewise occupies three words, with |type| and |value| fields
5745 plus extra information; its |name_type| is |subscr|. In this case the
5746 third word is called the |subscript| field, which is a |scaled| integer.
5747 The |link| field points to the subscript node with the next larger
5748 subscript, if any; otherwise the |link| points to the attribute node
5749 for collective subscripts at this level. We have seen that the latter node
5750 contains an upward pointer, so that the parent can be deduced.
5752 The |name_type| in a parent-less value node is |root|, and the |link|
5753 is the hash address of the token that names this value.
5755 In other words, variables have a hierarchical structure that includes
5756 enough threads running around so that the program is able to move easily
5757 between siblings, parents, and children. An example should be helpful:
5758 (The reader is advised to draw a picture while reading the following
5759 description, since that will help to firm up the ideas.)
5760 Suppose that `\.x' and `\.{x.a}' and `\.{x[]b}' and `\.{x5}'
5761 and `\.{x20b}' have been mentioned in a user's program, where
5762 \.{x[]b} has been declared to be of \&{boolean} type. Let |h(x)|, |h(a)|,
5763 and |h(b)| be the hash addresses of \.x, \.a, and~\.b. Then
5764 |eq_type(h(x))=name| and |equiv(h(x))=p|, where |p|~is a non-symbolic value
5765 node with |mp_name_type(p)=root| and |mp_link(p)=h(x)|. We have |type(p)=mp_structured|,
5766 |attr_head(p)=q|, and |subscr_head(p)=r|, where |q| points to a value
5767 node and |r| to a subscript node. (Are you still following this? Use
5768 a pencil to draw a diagram.) The lone variable `\.x' is represented by
5769 |type(q)| and |value(q)|; furthermore
5770 |mp_name_type(q)=mp_structured_root| and |mp_link(q)=q1|, where |q1| points
5771 to an attribute node representing `\.{x[]}'. Thus |mp_name_type(q1)=attr|,
5772 |hashloc(q1)=collective_subscript=0|, |parent(q1)=p|,
5773 |type(q1)=mp_structured|, |attr_head(q1)=qq|, and |subscr_head(q1)=qq1|;
5774 |qq| is a three-word ``attribute-as-value'' node with |type(qq)=numeric_type|
5775 (assuming that \.{x5} is numeric, because |qq| represents `\.{x[]}'
5776 with no further attributes), |mp_name_type(qq)=structured_root|,
5777 |hashloc(qq)=0|, |parent(qq)=p|, and
5778 |mp_link(qq)=qq1|. (Now pay attention to the next part.) Node |qq1| is
5779 an attribute node representing `\.{x[][]}', which has never yet
5780 occurred; its |type| field is |undefined|, and its |value| field is
5781 undefined. We have |mp_name_type(qq1)=attr|, |hashloc(qq1)=collective_subscript|,
5782 |parent(qq1)=q1|, and |mp_link(qq1)=qq2|. Since |qq2| represents
5783 `\.{x[]b}', |type(qq2)=mp_unknown_boolean|; also |hashloc(qq2)=h(b)|,
5784 |parent(qq2)=q1|, |mp_name_type(qq2)=attr|, |mp_link(qq2)=end_attr|.
5785 (Maybe colored lines will help untangle your picture.)
5786 Node |r| is a subscript node with |type| and |value|
5787 representing `\.{x5}'; |mp_name_type(r)=subscr|, |subscript(r)=5.0|,
5788 and |mp_link(r)=r1| is another subscript node. To complete the picture,
5789 see if you can guess what |mp_link(r1)| is; give up? It's~|q1|.
5790 Furthermore |subscript(r1)=20.0|, |mp_name_type(r1)=subscr|,
5791 |type(r1)=mp_structured|, |attr_head(r1)=qqq|, |subscr_head(r1)=qqq1|,
5792 and we finish things off with three more nodes
5793 |qqq|, |qqq1|, and |qqq2| hung onto~|r1|. (Perhaps you should start again
5794 with a larger sheet of paper.) The value of variable \.{x20b}
5795 appears in node~|qqq2|, as you can well imagine.
5797 If the example in the previous paragraph doesn't make things crystal
5798 clear, a glance at some of the simpler subroutines below will reveal how
5799 things work out in practice.
5801 The only really unusual thing about these conventions is the use of
5802 collective subscript attributes. The idea is to avoid repeating a lot of
5803 type information when many elements of an array are identical macros
5804 (for which distinct values need not be stored) or when they don't have
5805 all of the possible attributes. Branches of the structure below collective
5806 subscript attributes do not carry actual values except for macro identifiers;
5807 branches of the structure below subscript nodes do not carry significant
5808 information in their collective subscript attributes.
5813 #define hashloc(A) do_get_hashloc(mp,(mp_value_node)(A))
5814 #define set_hashloc(A,B) do_set_hashloc (mp,(mp_value_node)A, B)
5815 #define parent(A) do_get_parent(mp, A)
5816 #define set_parent(A,B) do_set_parent (mp,(mp_value_node)A, B)
5817 static mp_sym do_get_hashloc (MP mp, mp_value_node A) {
5818 assert((A)->type == mp_attr_node_type || (A)->name_type == mp_attr);
5819 return (A)->hashloc_;
5821 static void do_set_hashloc (MP mp, mp_value_node A, mp_sym B) {
5822 FUNCTION_TRACE4 ("set_hashloc
(%p
,%p
) on line
%d\n
", (A), (B), __LINE__);
5823 assert((A)->type == mp_attr_node_type || (A)->name_type == mp_attr);
5826 static mp_node do_get_parent (MP mp, mp_value_node A) {
5827 assert((A)->type == mp_attr_node_type || (A)->name_type == mp_attr);
5828 return (A)->parent_; /* pointer to |mp_structured| variable */
5830 static void do_set_parent (MP mp, mp_value_node A, mp_node d) {
5831 assert((A)->type == mp_attr_node_type || (A)->name_type == mp_attr);
5832 FUNCTION_TRACE4 ("set_parent
(%p
,%p
) on line
%d\n
", (A), d, __LINE__);
5836 #define hashloc(A) ((mp_value_node)(A))->hashloc_
5837 #define set_hashloc(A,B) ((mp_value_node)(A))->hashloc_ = B
5838 #define parent(A) ((mp_value_node)(A))->parent_
5839 #define set_parent(A,B) ((mp_value_node)(A))->parent_ = B
5843 @d mp_free_attr_node(a,b) do {
5844 assert((b)->type == mp_attr_node_type || (b)->name_type == mp_attr);
5845 mp_free_value_node(a,b);
5849 static mp_value_node mp_get_attr_node (MP mp) {
5850 mp_value_node p = (mp_value_node) mp_get_value_node (mp);
5851 mp_type (p) = mp_attr_node_type;
5856 @ Setting the |hashloc| field of |end_attr| to a value greater than
5857 any legal hash address is done by assigning $-1$ typecasted to
5858 |mp_sym|, hopefully resulting in all bits being set. On systems that
5859 support negative pointer values or where typecasting $-1$ does not
5860 result in all bits in a pointer being set, something else needs to be done.
5861 @^system dependencies@>
5863 @<Initialize table...@>=
5864 mp->end_attr = (mp_node) mp_get_attr_node (mp);
5865 set_hashloc (mp->end_attr, (mp_sym)-1);
5866 set_parent ((mp_value_node) mp->end_attr, NULL);
5868 @ @<Free table...@>=
5869 mp_free_attr_node (mp, mp->end_attr);
5872 @d collective_subscript (void *)0 /* code for the attribute `\.{[]}' */
5873 @d subscript(A) ((mp_value_node)(A))->subscript_
5874 @d set_subscript(A,B) do_set_subscript (mp, (mp_value_node)(A), B)
5877 static void do_set_subscript (MP mp, mp_value_node A, mp_number B) {
5878 FUNCTION_TRACE3("set_subscript
(%p
,%p
)\n
", (A), (B));
5879 assert((A)->type == mp_subscr_node_type || (A)->name_type == mp_subscr);
5880 number_clone(A->subscript_,B); /* subscript of this variable */
5885 static mp_value_node mp_get_subscr_node (MP mp) {
5886 mp_value_node p = (mp_value_node) mp_get_value_node (mp);
5887 mp_type (p) = mp_subscr_node_type;
5892 @ Variables of type \&{pair} will have values that point to four-word
5893 nodes containing two numeric values. The first of these values has
5894 |name_type=mp_x_part_sector| and the second has |name_type=mp_y_part_sector|;
5895 the |link| in the first points back to the node whose |value| points
5896 to this four-word node.
5898 @d x_part(A) ((mp_pair_node)(A))->x_part_ /* where the \&{xpart} is found in a pair node */
5899 @d y_part(A) ((mp_pair_node)(A))->y_part_ /* where the \&{ypart} is found in a pair node */
5901 @<MPlib internal header stuff@>=
5902 typedef struct mp_pair_node_data {
5906 } mp_pair_node_data;
5907 typedef struct mp_pair_node_data *mp_pair_node;
5910 @d pair_node_size sizeof(struct mp_pair_node_data) /* the number of words in a subscript node */
5913 static mp_node mp_get_pair_node (MP mp) {
5915 if (mp->pair_nodes) {
5917 mp->pair_nodes = p->link;
5918 mp->num_pair_nodes--;
5921 p = malloc_node (pair_node_size);
5923 mp_type (p) = mp_pair_node_type;
5924 FUNCTION_TRACE2("get_pair_node
(): %p\n
", p);
5929 void mp_free_pair_node (MP mp, mp_node p);
5932 void mp_free_pair_node (MP mp, mp_node p) {
5933 FUNCTION_TRACE2 ("mp_free_pair_node
(%p
)\n
", p);
5935 if (mp->num_pair_nodes < max_num_pair_nodes) {
5936 p->link = mp->pair_nodes;
5938 mp->num_pair_nodes++;
5941 mp->var_used -= pair_node_size;
5946 @ If |type(p)=mp_pair_type| or if |value(p)=NULL|, the procedure call |init_pair_node(p)| will
5947 allocate a pair node for~|p|. The individual parts of such nodes are initially of type
5951 static void mp_init_pair_node (MP mp, mp_node p) {
5952 mp_node q; /* the new node */
5953 mp_type (p) = mp_pair_type;
5954 q = mp_get_pair_node (mp);
5955 y_part (q) = mp_get_value_node (mp);
5956 mp_new_indep (mp, y_part (q)); /* sets |type(q)| and |value(q)| */
5957 mp_name_type (y_part (q)) = (quarterword) (mp_y_part_sector);
5958 mp_link (y_part (q)) = p;
5959 x_part (q) = mp_get_value_node (mp);
5960 mp_new_indep (mp, x_part (q)); /* sets |type(q)| and |value(q)| */
5961 mp_name_type (x_part (q)) = (quarterword) (mp_x_part_sector);
5962 mp_link (x_part (q)) = p;
5963 set_value_node (p, q);
5968 Variables of type \&{transform} are similar, but in this case their
5969 |value| points to a 12-word node containing six values, identified by
5970 |x_part_sector|, |y_part_sector|, |mp_xx_part_sector|, |mp_xy_part_sector|,
5971 |mp_yx_part_sector|, and |mp_yy_part_sector|.
5973 @d tx_part(A) ((mp_transform_node)(A))->tx_part_ /* where the \&{xpart} is found in a transform node */
5974 @d ty_part(A) ((mp_transform_node)(A))->ty_part_ /* where the \&{ypart} is found in a transform node */
5975 @d xx_part(A) ((mp_transform_node)(A))->xx_part_ /* where the \&{xxpart} is found in a transform node */
5976 @d xy_part(A) ((mp_transform_node)(A))->xy_part_ /* where the \&{xypart} is found in a transform node */
5977 @d yx_part(A) ((mp_transform_node)(A))->yx_part_ /* where the \&{yxpart} is found in a transform node */
5978 @d yy_part(A) ((mp_transform_node)(A))->yy_part_ /* where the \&{yypart} is found in a transform node */
5980 @<MPlib internal header stuff@>=
5981 typedef struct mp_transform_node_data {
5989 } mp_transform_node_data;
5990 typedef struct mp_transform_node_data *mp_transform_node;
5993 @d transform_node_size sizeof(struct mp_transform_node_data) /* the number of words in a subscript node */
5996 static mp_node mp_get_transform_node (MP mp) {
5997 mp_transform_node p = (mp_transform_node) malloc_node (transform_node_size);
5998 mp_type (p) = mp_transform_node_type;
6004 static void mp_init_transform_node (MP mp, mp_node p) {
6005 mp_node q; /* the new node */
6006 mp_type (p) = mp_transform_type;
6007 q = mp_get_transform_node (mp); /* big node */
6008 yy_part (q) = mp_get_value_node (mp);
6009 mp_new_indep (mp, yy_part (q)); /* sets |type(q)| and |value(q)| */
6010 mp_name_type (yy_part (q)) = (quarterword) (mp_yy_part_sector);
6011 mp_link (yy_part (q)) = p;
6012 yx_part (q) = mp_get_value_node (mp);
6013 mp_new_indep (mp, yx_part (q)); /* sets |type(q)| and |value(q)| */
6014 mp_name_type (yx_part (q)) = (quarterword) (mp_yx_part_sector);
6015 mp_link (yx_part (q)) = p;
6016 xy_part (q) = mp_get_value_node (mp);
6017 mp_new_indep (mp, xy_part (q)); /* sets |type(q)| and |value(q)| */
6018 mp_name_type (xy_part (q)) = (quarterword) (mp_xy_part_sector);
6019 mp_link (xy_part (q)) = p;
6020 xx_part (q) = mp_get_value_node (mp);
6021 mp_new_indep (mp, xx_part (q)); /* sets |type(q)| and |value(q)| */
6022 mp_name_type (xx_part (q)) = (quarterword) (mp_xx_part_sector);
6023 mp_link (xx_part (q)) = p;
6024 ty_part (q) = mp_get_value_node (mp);
6025 mp_new_indep (mp, ty_part (q)); /* sets |type(q)| and |value(q)| */
6026 mp_name_type (ty_part (q)) = (quarterword) (mp_y_part_sector);
6027 mp_link (ty_part (q)) = p;
6028 tx_part (q) = mp_get_value_node (mp);
6029 mp_new_indep (mp, tx_part (q)); /* sets |type(q)| and |value(q)| */
6030 mp_name_type (tx_part (q)) = (quarterword) (mp_x_part_sector);
6031 mp_link (tx_part (q)) = p;
6032 set_value_node (p, q);
6037 Variables of type \&{color} have 3~values in 6~words identified by |mp_red_part_sector|,
6038 |mp_green_part_sector|, and |mp_blue_part_sector|.
6040 @d red_part(A) ((mp_color_node)(A))->red_part_ /* where the \&{redpart} is found in a color node */
6041 @d green_part(A) ((mp_color_node)(A))->green_part_ /* where the \&{greenpart} is found in a color node */
6042 @d blue_part(A) ((mp_color_node)(A))->blue_part_ /* where the \&{bluepart} is found in a color node */
6044 @d grey_part(A) red_part(A) /* where the \&{greypart} is found in a color node */
6046 @<MPlib internal header stuff@>=
6047 typedef struct mp_color_node_data {
6050 mp_node green_part_;
6052 } mp_color_node_data;
6053 typedef struct mp_color_node_data *mp_color_node;
6056 @d color_node_size sizeof(struct mp_color_node_data) /* the number of words in a subscript node */
6059 static mp_node mp_get_color_node (MP mp) {
6060 mp_color_node p = (mp_color_node) malloc_node (color_node_size);
6061 mp_type (p) = mp_color_node_type;
6069 static void mp_init_color_node (MP mp, mp_node p) {
6070 mp_node q; /* the new node */
6071 mp_type (p) = mp_color_type;
6072 q = mp_get_color_node (mp); /* big node */
6073 blue_part (q) = mp_get_value_node (mp);
6074 mp_new_indep (mp, blue_part (q)); /* sets |type(q)| and |value(q)| */
6075 mp_name_type (blue_part (q)) = (quarterword) (mp_blue_part_sector);
6076 mp_link (blue_part (q)) = p;
6077 green_part (q) = mp_get_value_node (mp);
6078 mp_new_indep (mp, green_part (q)); /* sets |type(q)| and |value(q)| */
6079 mp_name_type (y_part (q)) = (quarterword) (mp_green_part_sector);
6080 mp_link (green_part (q)) = p;
6081 red_part (q) = mp_get_value_node (mp);
6082 mp_new_indep (mp, red_part (q)); /* sets |type(q)| and |value(q)| */
6083 mp_name_type (red_part (q)) = (quarterword) (mp_red_part_sector);
6084 mp_link (red_part (q)) = p;
6085 set_value_node (p, q);
6089 @ Finally, variables of type |cmykcolor|.
6091 @d cyan_part(A) ((mp_cmykcolor_node)(A))->cyan_part_ /* where the \&{cyanpart} is found in a color node */
6092 @d magenta_part(A) ((mp_cmykcolor_node)(A))->magenta_part_ /* where the \&{magentapart} is found in a color node */
6093 @d yellow_part(A) ((mp_cmykcolor_node)(A))->yellow_part_ /* where the \&{yellowpart} is found in a color node */
6094 @d black_part(A) ((mp_cmykcolor_node)(A))->black_part_ /* where the \&{blackpart} is found in a color node */
6096 @<MPlib internal header stuff@>=
6097 typedef struct mp_cmykcolor_node_data {
6100 mp_node magenta_part_;
6101 mp_node yellow_part_;
6102 mp_node black_part_;
6103 } mp_cmykcolor_node_data;
6104 typedef struct mp_cmykcolor_node_data *mp_cmykcolor_node;
6107 @d cmykcolor_node_size sizeof(struct mp_cmykcolor_node_data) /* the number of words in a subscript node */
6110 static mp_node mp_get_cmykcolor_node (MP mp) {
6111 mp_cmykcolor_node p = (mp_cmykcolor_node) malloc_node (cmykcolor_node_size);
6112 mp_type (p) = mp_cmykcolor_node_type;
6120 static void mp_init_cmykcolor_node (MP mp, mp_node p) {
6121 mp_node q; /* the new node */
6122 mp_type (p) = mp_cmykcolor_type;
6123 q = mp_get_cmykcolor_node (mp); /* big node */
6124 black_part (q) = mp_get_value_node (mp);
6125 mp_new_indep (mp, black_part (q)); /* sets |type(q)| and |value(q)| */
6126 mp_name_type (black_part (q)) = (quarterword) (mp_black_part_sector);
6127 mp_link (black_part (q)) = p;
6128 yellow_part (q) = mp_get_value_node (mp);
6129 mp_new_indep (mp, yellow_part (q)); /* sets |type(q)| and |value(q)| */
6130 mp_name_type (yellow_part (q)) = (quarterword) (mp_yellow_part_sector);
6131 mp_link (yellow_part (q)) = p;
6132 magenta_part (q) = mp_get_value_node (mp);
6133 mp_new_indep (mp, magenta_part (q)); /* sets |type(q)| and |value(q)| */
6134 mp_name_type (magenta_part (q)) = (quarterword) (mp_magenta_part_sector);
6135 mp_link (magenta_part (q)) = p;
6136 cyan_part (q) = mp_get_value_node (mp);
6137 mp_new_indep (mp, cyan_part (q)); /* sets |type(q)| and |value(q)| */
6138 mp_name_type (cyan_part (q)) = (quarterword) (mp_cyan_part_sector);
6139 mp_link (cyan_part (q)) = p;
6140 set_value_node (p, q);
6144 @ When an entire structured variable is saved, the |root| indication
6145 is temporarily replaced by |saved_root|.
6147 Some variables have no name; they just are used for temporary storage
6148 while expressions are being evaluated. We call them {\sl capsules}.
6150 @ The |id_transform| function creates a capsule for the
6151 identity transformation.
6154 static mp_node mp_id_transform (MP mp) {
6155 mp_node p, q; /* list manipulation registers */
6156 p = mp_get_value_node (mp);
6157 mp_name_type (p) = mp_capsule;
6158 set_value_number (p, zero_t); /* todo: this was |null| */
6159 mp_init_transform_node (mp, p);
6161 mp_type (tx_part (q)) = mp_known;
6162 set_value_number (tx_part (q), zero_t);
6163 mp_type (ty_part (q)) = mp_known;
6164 set_value_number (ty_part (q), zero_t);
6165 mp_type (xy_part (q)) = mp_known;
6166 set_value_number (xy_part (q), zero_t);
6167 mp_type (yx_part (q)) = mp_known;
6168 set_value_number (yx_part (q), zero_t);
6169 mp_type (xx_part (q)) = mp_known;
6170 set_value_number (xx_part (q), unity_t);
6171 mp_type (yy_part (q)) = mp_known;
6172 set_value_number (yy_part (q), unity_t);
6177 @ Tokens are of type |tag_token| when they first appear, but they point
6178 to |NULL| until they are first used as the root of a variable.
6179 The following subroutine establishes the root node on such grand occasions.
6182 static void mp_new_root (MP mp, mp_sym x) {
6183 mp_node p; /* the new node */
6184 p = mp_get_value_node (mp);
6185 mp_type (p) = mp_undefined;
6186 mp_name_type (p) = mp_root;
6187 set_value_sym (p, x);
6188 set_equiv_node (x, p);
6192 @ These conventions for variable representation are illustrated by the
6193 |print_variable_name| routine, which displays the full name of a
6194 variable given only a pointer to its value.
6197 static void mp_print_variable_name (MP mp, mp_node p);
6200 void mp_print_variable_name (MP mp, mp_node p) {
6201 mp_node q; /* a token list that will name the variable's suffix */
6202 mp_node r; /* temporary for token list creation */
6203 while (mp_name_type (p) >= mp_x_part_sector) {
6204 switch (mp_name_type (p)) {
6205 case mp_x_part_sector: mp_print (mp, "xpart
"); break;
6206 case mp_y_part_sector: mp_print (mp, "ypart
"); break;
6207 case mp_xx_part_sector: mp_print (mp, "xxpart
"); break;
6208 case mp_xy_part_sector: mp_print (mp, "xypart
"); break;
6209 case mp_yx_part_sector: mp_print (mp, "yxpart
"); break;
6210 case mp_yy_part_sector: mp_print (mp, "yypart
"); break;
6211 case mp_red_part_sector: mp_print (mp, "redpart
"); break;
6212 case mp_green_part_sector: mp_print (mp, "greenpart
"); break;
6213 case mp_blue_part_sector: mp_print (mp, "bluepart
"); break;
6214 case mp_cyan_part_sector: mp_print (mp, "cyanpart
"); break;
6215 case mp_magenta_part_sector:mp_print (mp, "magentapart
");break;
6216 case mp_yellow_part_sector: mp_print (mp, "yellowpart
"); break;
6217 case mp_black_part_sector: mp_print (mp, "blackpart
"); break;
6218 case mp_grey_part_sector: mp_print (mp, "greypart
"); break;
6219 case mp_capsule: mp_printf (mp, "%%CAPSULE
%p
",p); return; break;
6220 /* this is to please the compiler: the remaining cases are operation codes */
6226 while (mp_name_type (p) > mp_saved_root) {
6227 /* Ascend one level, pushing a token onto list |q|
6228 and replacing |p| by its parent */
6229 if (mp_name_type (p) == mp_subscr) {
6230 r = mp_new_num_tok (mp, subscript (p));
6233 } while (mp_name_type (p) != mp_attr);
6234 } else if (mp_name_type (p) == mp_structured_root) {
6238 if (mp_name_type (p) != mp_attr)
6239 mp_confusion (mp, "var
");
6240 r = mp_get_symbolic_node (mp);
6241 set_mp_sym_sym (r, hashloc (p)); /* the hash address */
6246 p = parent ((mp_value_node) p);
6249 /* now |link(p)| is the hash address of |p|, and
6250 |name_type(p)| is either |root| or |saved_root|.
6251 Have to prepend a token to |q| for |show_token_list|. */
6252 r = mp_get_symbolic_node (mp);
6253 set_mp_sym_sym (r, value_sym (p));
6255 if (mp_name_type (p) == mp_saved_root)
6256 mp_print (mp, "(SAVED
)");
6257 mp_show_token_list (mp, r, NULL, max_integer, mp->tally);
6258 mp_flush_token_list (mp, r);
6261 @ The |interesting| function returns |true| if a given variable is not
6262 in a capsule, or if the user wants to trace capsules.
6265 static boolean mp_interesting (MP mp, mp_node p) {
6266 mp_name_type_type t; /* a |name_type| */
6267 if (number_positive(internal_value (mp_tracing_capsules))) {
6270 t = mp_name_type (p);
6271 if (t >= mp_x_part_sector && t != mp_capsule) {
6272 mp_node tt = value_node(mp_link(p));
6274 case mp_x_part_sector:
6275 t = mp_name_type (x_part (tt));
6277 case mp_y_part_sector:
6278 t = mp_name_type (y_part (tt));
6280 case mp_xx_part_sector:
6281 t = mp_name_type (xx_part (tt));
6283 case mp_xy_part_sector:
6284 t = mp_name_type (xy_part (tt));
6286 case mp_yx_part_sector:
6287 t = mp_name_type (yx_part (tt));
6289 case mp_yy_part_sector:
6290 t = mp_name_type (yy_part (tt));
6292 case mp_red_part_sector:
6293 t = mp_name_type (red_part (tt));
6295 case mp_green_part_sector:
6296 t = mp_name_type (green_part (tt));
6298 case mp_blue_part_sector:
6299 t = mp_name_type (blue_part (tt));
6301 case mp_cyan_part_sector:
6302 t = mp_name_type (cyan_part (tt));
6304 case mp_magenta_part_sector:
6305 t = mp_name_type (magenta_part (tt));
6307 case mp_yellow_part_sector:
6308 t = mp_name_type (yellow_part (tt));
6310 case mp_black_part_sector:
6311 t = mp_name_type (black_part (tt));
6313 case mp_grey_part_sector:
6314 t = mp_name_type (grey_part (tt));
6321 return (t != mp_capsule);
6325 @ Now here is a subroutine that converts an unstructured type into an
6326 equivalent structured type, by inserting a |mp_structured| node that is
6327 capable of growing. This operation is done only when |mp_name_type(p)=root|,
6328 |subscr|, or |attr|.
6330 The procedure returns a pointer to the new node that has taken node~|p|'s
6331 place in the structure. Node~|p| itself does not move, nor are its
6332 |value| or |type| fields changed in any way.
6335 static mp_node mp_new_structure (MP mp, mp_node p) {
6336 mp_node q, r = NULL; /* list manipulation registers */
6338 switch (mp_name_type (p)) {
6342 r = mp_get_value_node (mp);
6343 set_equiv_node (qq, r);
6347 /* Link a new subscript node |r| in place of node |p| */
6353 } while (mp_name_type (q) != mp_attr);
6354 q = parent ((mp_value_node) q);
6356 set_mp_link (r, subscr_head (q));
6361 r = (mp_node) mp_get_subscr_node (mp);
6362 if (q_new == mp->temp_head) {
6363 set_subscr_head (q, r);
6365 set_mp_link (q_new, r);
6367 set_subscript (r, subscript (p));
6372 /* Link a new attribute node |r| in place of node |p| */
6373 /* If the attribute is |collective_subscript|, there are two pointers to
6374 node~|p|, so we must change both of them. */
6377 q = parent ((mp_value_node) p);
6383 rr = mp_get_attr_node (mp);
6385 set_mp_link (q, (mp_node) rr);
6386 set_hashloc (rr, hashloc (p));
6387 set_parent (rr, parent ((mp_value_node) p));
6388 if (hashloc (p) == collective_subscript) {
6390 set_mp_link (q, subscr_head (parent ((mp_value_node) p)));
6391 while (mp_link (q) != p)
6393 if (q == mp->temp_head)
6394 set_subscr_head (parent ((mp_value_node) p), (mp_node) rr);
6396 set_mp_link (q, (mp_node) rr);
6402 mp_confusion (mp, "struct
");
6405 set_mp_link (r, mp_link (p));
6406 set_value_sym (r, value_sym (p));
6407 mp_type (r) = mp_structured;
6408 mp_name_type (r) = mp_name_type (p);
6409 set_attr_head (r, p);
6410 mp_name_type (p) = mp_structured_root;
6412 mp_value_node qqr = mp_get_attr_node (mp);
6413 set_mp_link (p, (mp_node) qqr);
6414 set_subscr_head (r, (mp_node) qqr);
6415 set_parent (qqr, r);
6416 mp_type (qqr) = mp_undefined;
6417 mp_name_type (qqr) = mp_attr;
6418 set_mp_link (qqr, mp->end_attr);
6419 set_hashloc (qqr, collective_subscript);
6424 @ The |find_variable| routine is given a pointer~|t| to a nonempty token
6425 list of suffixes; it returns a pointer to the corresponding non-symbolic
6426 value. For example, if |t| points to token \.x followed by a numeric
6427 token containing the value~7, |find_variable| finds where the value of
6428 \.{x7} is stored in memory. This may seem a simple task, and it
6429 usually is, except when \.{x7} has never been referenced before.
6430 Indeed, \.x may never have even been subscripted before; complexities
6431 arise with respect to updating the collective subscript information.
6433 If a macro type is detected anywhere along path~|t|, or if the first
6434 item on |t| isn't a |tag_token|, the value |NULL| is returned.
6435 Otherwise |p| will be a non-NULL pointer to a node such that
6436 |undefined<type(p)<mp_structured|.
6439 static mp_node mp_find_variable (MP mp, mp_node t) {
6440 mp_node p, q, r, s; /* nodes in the ``value'' line */
6442 mp_node pp, qq, rr, ss; /* nodes in the ``collective'' line */
6444 p_sym = mp_sym_sym (t);
6446 if ((eq_type (p_sym) % mp_outer_tag) != mp_tag_token)
6448 if (equiv_node (p_sym) == NULL)
6449 mp_new_root (mp, p_sym);
6450 p = equiv_node (p_sym);
6453 /* Make sure that both nodes |p| and |pp| are of |mp_structured| type */
6454 /* Although |pp| and |p| begin together, they diverge when a subscript occurs;
6455 |pp|~stays in the collective line while |p|~goes through actual subscript
6457 if (mp_type (pp) != mp_structured) {
6458 if (mp_type (pp) > mp_structured)
6460 ss = mp_new_structure (mp, pp);
6464 } /* now |type(pp)=mp_structured| */
6465 if (mp_type (p) != mp_structured) { /* it cannot be |>mp_structured| */
6466 p = mp_new_structure (mp, p); /* now |type(p)=mp_structured| */
6469 if (mp_type (t) != mp_symbol_node) {
6470 /* Descend one level for the subscript |value(t)| */
6471 /* We want this part of the program to be reasonably fast, in case there are
6472 lots of subscripts at the same level of the data structure. Therefore
6473 we store an ``infinite'' value in the word that appears at the end of the
6474 subscript list, even though that word isn't part of a subscript node. */
6475 mp_number nn, save_subscript; /* temporary storage */
6477 new_number (save_subscript);
6478 number_clone (nn, value_number (t));
6479 pp = mp_link (attr_head (pp)); /* now |hashloc(pp)=collective_subscript| */
6480 q = mp_link (attr_head (p));
6481 number_clone (save_subscript, subscript (q));
6482 set_number_to_inf(subscript (q));
6484 set_mp_link (s, subscr_head (p));
6488 } while (number_greater (nn, subscript (s)));
6489 if (number_equal(nn, subscript (s))) {
6492 mp_value_node p1 = mp_get_subscr_node (mp);
6493 if (r == mp->temp_head)
6494 set_subscr_head (p, (mp_node) p1);
6496 set_mp_link (r, (mp_node) p1);
6497 set_mp_link (p1, s);
6498 number_clone (subscript (p1), nn);
6499 mp_name_type (p1) = mp_subscr;
6500 mp_type (p1) = mp_undefined;
6503 number_clone (subscript (q), save_subscript);
6504 free_number (save_subscript);
6507 /* Descend one level for the attribute |mp_sym_info(t)| */
6508 mp_sym nn1 = mp_sym_sym (t);
6509 ss = attr_head (pp);
6513 } while (nn1 > hashloc (ss));
6514 if (nn1 < hashloc (ss)) {
6515 qq = (mp_node) mp_get_attr_node (mp);
6516 set_mp_link (rr, qq);
6517 set_mp_link (qq, ss);
6518 set_hashloc (qq, nn1);
6519 mp_name_type (qq) = mp_attr;
6520 mp_type (qq) = mp_undefined;
6521 set_parent ((mp_value_node) qq, pp);
6533 } while (nn1 > hashloc (s));
6534 if (nn1 == hashloc (s)) {
6537 q = (mp_node) mp_get_attr_node (mp);
6540 set_hashloc (q, nn1);
6541 mp_name_type (q) = mp_attr;
6542 mp_type (q) = mp_undefined;
6543 set_parent ((mp_value_node) q, p);
6550 if (mp_type (pp) >= mp_structured) {
6551 if (mp_type (pp) == mp_structured)
6552 pp = attr_head (pp);
6556 if (mp_type (p) == mp_structured)
6558 if (mp_type (p) == mp_undefined) {
6559 if (mp_type (pp) == mp_undefined) {
6560 mp_type (pp) = mp_numeric_type;
6561 set_value_number (pp, zero_t);
6563 mp_type (p) = mp_type (pp);
6564 set_value_number (p, zero_t);
6570 @ Variables lose their former values when they appear in a type declaration,
6571 or when they are defined to be macros or \&{let} equal to something else.
6572 A subroutine will be defined later that recycles the storage associated
6573 with any particular |type| or |value|; our goal now is to study a higher
6574 level process called |flush_variable|, which selectively frees parts of a
6577 This routine has some complexity because of examples such as
6578 `\hbox{\tt numeric x[]a[]b}'
6579 which recycles all variables of the form \.{x[i]a[j]b} (and no others), while
6580 `\hbox{\tt vardef x[]a[]=...}'
6581 discards all variables of the form \.{x[i]a[j]} followed by an arbitrary
6582 suffix, except for the collective node \.{x[]a[]} itself. The obvious way
6583 to handle such examples is to use recursion; so that's what we~do.
6586 Parameter |p| points to the root information of the variable;
6587 parameter |t| points to a list of symbolic nodes that represent
6588 suffixes, with |info=collective_subscript| for subscripts.
6591 void mp_flush_cur_exp (MP mp, mp_value v);
6594 static void mp_flush_variable (MP mp, mp_node p, mp_node t,
6595 boolean discard_suffixes) {
6596 mp_node q, r = NULL; /* list manipulation */
6597 mp_sym n; /* attribute to match */
6599 if (mp_type (p) != mp_structured) {
6604 if (n == collective_subscript) {
6605 q = subscr_head (p);
6606 while (mp_name_type (q) == mp_subscr) {
6607 mp_flush_variable (mp, q, t, discard_suffixes);
6609 if (mp_type (q) == mp_structured) {
6613 set_subscr_head (p, mp_link (q));
6615 set_mp_link (r, mp_link (q));
6616 mp_free_value_node (mp, q);
6621 q = (r==NULL ? subscr_head (p) : mp_link (r));
6627 } while (hashloc (p) < n);
6628 if (hashloc (p) != n) {
6632 if (discard_suffixes) {
6633 mp_flush_below_variable (mp, p);
6635 if (mp_type (p) == mp_structured) {
6638 mp_recycle_value (mp, p);
6643 @ The next procedure is simpler; it wipes out everything but |p| itself,
6644 which becomes undefined.
6647 static void mp_flush_below_variable (MP mp, mp_node p);
6650 void mp_flush_below_variable (MP mp, mp_node p) {
6651 mp_node q, r; /* list manipulation registers */
6652 FUNCTION_TRACE2 ("mp_flush_below_variable
(%p
)\n
", p);
6653 if (mp_type (p) != mp_structured) {
6654 mp_recycle_value (mp, p); /* this sets |type(p)=undefined| */
6656 q = subscr_head (p);
6657 while (mp_name_type (q) == mp_subscr) {
6658 mp_flush_below_variable (mp, q);
6661 mp_free_value_node (mp, r);
6665 mp_recycle_value (mp, r);
6666 mp_free_value_node (mp, r);
6668 mp_flush_below_variable (mp, q);
6671 mp_free_value_node (mp, r);
6672 } while (q != mp->end_attr);
6673 mp_type (p) = mp_undefined;
6678 @ Just before assigning a new value to a variable, we will recycle the
6679 old value and make the old value undefined. The |und_type| routine
6680 determines what type of undefined value should be given, based on
6681 the current type before recycling.
6684 static quarterword mp_und_type (MP mp, mp_node p) {
6686 switch (mp_type (p)) {
6688 return mp_undefined;
6689 case mp_boolean_type:
6690 case mp_unknown_boolean:
6691 return mp_unknown_boolean;
6692 case mp_string_type:
6693 case mp_unknown_string:
6694 return mp_unknown_string;
6696 case mp_unknown_pen:
6697 return mp_unknown_pen;
6699 case mp_unknown_path:
6700 return mp_unknown_path;
6701 case mp_picture_type:
6702 case mp_unknown_picture:
6703 return mp_unknown_picture;
6704 case mp_transform_type:
6706 case mp_cmykcolor_type:
6708 case mp_numeric_type:
6712 case mp_proto_dependent:
6713 case mp_independent:
6714 return mp_numeric_type;
6715 default: /* there are no other valid cases, but please the compiler */
6722 @ The |clear_symbol| routine is used when we want to redefine the equivalent
6723 of a symbolic token. It must remove any variable structure or macro
6724 definition that is currently attached to that symbol. If the |saving|
6725 parameter is true, a subsidiary structure is saved instead of destroyed.
6728 static void mp_clear_symbol (MP mp, mp_sym p, boolean saving) {
6729 mp_node q; /* |equiv(p)| */
6730 FUNCTION_TRACE3 ("mp_clear_symbol
(%p
,%d
)\n
", p, saving);
6732 switch (eq_type (p) % mp_outer_tag) {
6733 case mp_defined_macro:
6734 case mp_secondary_primary_macro:
6735 case mp_tertiary_secondary_macro:
6736 case mp_expression_tertiary_macro:
6738 mp_delete_mac_ref (mp, q);
6743 mp_name_type (q) = mp_saved_root;
6745 mp_flush_below_variable (mp, q);
6746 mp_free_value_node (mp, q);
6753 set_equiv (p, mp->frozen_undefined->v.data.indep.serial);
6754 set_eq_type (p, mp->frozen_undefined->type);
6758 @* Saving and restoring equivalents.
6759 The nested structure given by \&{begingroup} and \&{endgroup}
6760 allows |eqtb| entries to be saved and restored, so that temporary changes
6761 can be made without difficulty. When the user requests a current value to
6762 be saved, \MP\ puts that value into its ``save stack.'' An appearance of
6763 \&{endgroup} ultimately causes the old values to be removed from the save
6764 stack and put back in their former places.
6766 The save stack is a linked list containing three kinds of entries,
6767 distinguished by their |type| fields. If |p| points to a saved item,
6771 |p->type=0| stands for a group boundary; each \&{begingroup} contributes
6772 such an item to the save stack and each \&{endgroup} cuts back the stack
6773 until the most recent such entry has been removed.
6776 |p->type=mp_normal_sym| means that |p->value| holds the former
6777 contents of |eqtb[q]| (saved in the |knot| field of the value, which
6778 is otherwise unused for variables). Such save stack entries are generated by \&{save}
6782 |p->type=mp_internal_sym| means that |p->value| is a |mp_internal|
6783 to be restored to internal parameter number~|q| (saved in the |serial| field of the value, which
6784 is otherwise unused for internals). Such entries are generated by \&{interim} commands.
6787 The global variable |save_ptr| points to the top item on the save stack.
6790 typedef struct mp_save_data {
6793 struct mp_save_data *link;
6797 mp_save_data *save_ptr; /* the most recently saved item */
6800 mp->save_ptr = NULL;
6802 @ Saving a boundary item
6804 static void mp_save_boundary (MP mp) {
6805 mp_save_data *p; /* temporary register */
6806 FUNCTION_TRACE1 ("mp_save_boundary
()\n
");
6807 p = xmalloc (1, sizeof (mp_save_data));
6809 p->link = mp->save_ptr;
6814 @ The |save_variable| routine is given a hash address |q|; it salts this
6815 address in the save stack, together with its current equivalent,
6816 then makes token~|q| behave as though it were brand new.
6818 Nothing is stacked when |save_ptr=NULL|, however; there's no way to remove
6819 things from the stack when the program is not inside a group, so there's
6820 no point in wasting the space.
6823 static void mp_save_variable (MP mp, mp_sym q) {
6824 mp_save_data *p; /* temporary register */
6825 FUNCTION_TRACE2 ("mp_save_variable
(%p
)\n
", q);
6826 if (mp->save_ptr != NULL) {
6827 p = xmalloc (1, sizeof (mp_save_data));
6828 p->type = mp_normal_sym;
6829 p->link = mp->save_ptr;
6830 p->value.v.data.indep.scale = eq_type (q);
6831 p->value.v.data.indep.serial = equiv(q);
6832 p->value.v.data.node = equiv_node(q);
6833 p->value.v.data.p = (mp_knot)q;
6836 mp_clear_symbol (mp, q, (mp->save_ptr != NULL));
6838 static void mp_unsave_variable (MP mp) {
6839 mp_sym q = (mp_sym)mp->save_ptr->value.v.data.p;
6840 if (number_positive(internal_value (mp_tracing_restores))) {
6841 mp_begin_diagnostic (mp);
6842 mp_print_nl (mp, "{restoring
");
6844 mp_print_char (mp, xord ('}'));
6845 mp_end_diagnostic (mp, false);
6847 mp_clear_symbol (mp, q, false);
6848 set_eq_type(q, mp->save_ptr->value.v.data.indep.scale);
6849 set_equiv (q,mp->save_ptr->value.v.data.indep.serial);
6850 q->v.data.node = mp->save_ptr->value.v.data.node;
6851 if (eq_type (q) % mp_outer_tag == mp_tag_token) {
6852 mp_node pp = q->v.data.node;
6854 mp_name_type (pp) = mp_root;
6858 @ Similarly, |save_internal| is given the location |q| of an internal
6859 quantity like |mp_tracing_pens|. It creates a save stack entry of the
6863 static void mp_save_internal (MP mp, halfword q) {
6864 mp_save_data *p; /* new item for the save stack */
6865 FUNCTION_TRACE2 ("mp_save_internal
(%d
)\n
", q);
6866 if (mp->save_ptr != NULL) {
6867 p = xmalloc (1, sizeof (mp_save_data));
6868 p->type = mp_internal_sym;
6869 p->link = mp->save_ptr;
6870 p->value = mp->internal[q];
6871 p->value.v.data.indep.serial = q;
6872 new_number(p->value.v.data.n);
6873 number_clone(p->value.v.data.n, mp->internal[q].v.data.n);
6878 static void mp_unsave_internal (MP mp) {
6879 halfword q = mp->save_ptr->value.v.data.indep.serial;
6880 mp_internal saved = mp->save_ptr->value;
6881 if (number_positive(internal_value (mp_tracing_restores))) {
6882 mp_begin_diagnostic (mp);
6883 mp_print_nl (mp, "{restoring
");
6884 mp_print (mp, internal_name (q));
6885 mp_print_char (mp, xord ('='));
6886 if (internal_type (q) == mp_known) {
6887 print_number (saved.v.data.n);
6888 } else if (internal_type (q) == mp_string_type) {
6889 char *s = mp_str (mp, saved.v.data.str);
6892 mp_confusion (mp, "internal_restore
");
6894 mp_print_char (mp, xord ('}'));
6895 mp_end_diagnostic (mp, false);
6897 free_number (mp->internal[q].v.data.n);
6898 mp->internal[q] = saved;
6901 @ At the end of a group, the |unsave| routine restores all of the saved
6902 equivalents in reverse order. This routine will be called only when there
6903 is at least one boundary item on the save stack.
6906 static void mp_unsave (MP mp) {
6907 mp_save_data *p; /* saved item */
6908 FUNCTION_TRACE1 ("mp_unsave
()\n
");
6909 while (mp->save_ptr->type != 0) {
6910 if (mp->save_ptr->type == mp_internal_sym) {
6911 mp_unsave_internal(mp);
6913 mp_unsave_variable(mp);
6915 p = mp->save_ptr->link;
6916 xfree (mp->save_ptr);
6919 p = mp->save_ptr->link;
6920 xfree (mp->save_ptr);
6925 @* Data structures for paths.
6926 When a \MP\ user specifies a path, \MP\ will create a list of knots
6927 and control points for the associated cubic spline curves. If the
6928 knots are $z_0$, $z_1$, \dots, $z_n$, there are control points
6929 $z_k^+$ and $z_{k+1}^-$ such that the cubic splines between knots
6930 $z_k$ and $z_{k+1}$ are defined by B\'ezier's formula
6931 @:Bezier}{B\'ezier, Pierre Etienne@>
6932 $$\eqalign{z(t)&=B(z_k,z_k^+,z_{k+1}^-,z_{k+1};t)\cr
6933 &=(1-t)^3z_k+3(1-t)^2tz_k^++3(1-t)t^2z_{k+1}^-+t^3z_{k+1}\cr}$$
6936 There is a 8-word node for each knot $z_k$, containing one word of
6937 control information and six words for the |x| and |y| coordinates of
6938 $z_k^-$ and $z_k$ and~$z_k^+$. The control information appears in the
6939 |mp_left_type| and |mp_right_type| fields, which each occupy a quarter of
6940 the first word in the node; they specify properties of the curve as it
6941 enters and leaves the knot. There's also a halfword |link| field,
6942 which points to the following knot, and a final supplementary word (of
6943 which only a quarter is used).
6945 If the path is a closed contour, knots 0 and |n| are identical;
6946 i.e., the |link| in knot |n-1| points to knot~0. But if the path
6947 is not closed, the |mp_left_type| of knot~0 and the |mp_right_type| of knot~|n|
6948 are equal to |endpoint|. In the latter case the |link| in knot~|n| points
6949 to knot~0, and the control points $z_0^-$ and $z_n^+$ are not used.
6951 @d mp_next_knot(A) (A)->next /* the next knot in this list */
6952 @d mp_left_type(A) (A)->data.types.left_type /* characterizes the path entering this knot */
6953 @d mp_right_type(A) (A)->data.types.right_type /* characterizes the path leaving this knot */
6954 @d mp_prev_knot(A) (A)->data.prev /* the previous knot in this list (only for pens) */
6955 @d mp_knot_info(A) (A)->data.info /* temporary info, used during splitting */
6957 @<Exported types...@>=
6958 typedef struct mp_knot_data *mp_knot;
6959 typedef struct mp_knot_data {
6960 mp_number x_coord; /* the |x| coordinate of this knot */
6961 mp_number y_coord; /* the |y| coordinate of this knot */
6962 mp_number left_x; /* the |x| coordinate of previous control point */
6963 mp_number left_y; /* the |y| coordinate of previous control point */
6964 mp_number right_x; /* the |x| coordinate of next control point */
6965 mp_number right_y; /* the |y| coordinate of next control point */
6969 unsigned short left_type;
6970 unsigned short right_type;
6975 unsigned char originator;
6980 @d mp_gr_next_knot(A) (A)->next /* the next knot in this list */
6982 @<Exported types...@>=
6983 typedef struct mp_gr_knot_data *mp_gr_knot;
6984 typedef struct mp_gr_knot_data {
6994 unsigned short left_type;
6995 unsigned short right_type;
7000 unsigned char originator;
7004 @ @<MPlib header stuff@>=
7006 mp_endpoint = 0, /* |mp_left_type| at path beginning and |mp_right_type| at path end */
7007 mp_explicit, /* |mp_left_type| or |mp_right_type| when control points are known */
7008 mp_given, /* |mp_left_type| or |mp_right_type| when a direction is given */
7009 mp_curl, /* |mp_left_type| or |mp_right_type| when a curl is desired */
7010 mp_open, /* |mp_left_type| or |mp_right_type| when \MP\ should choose the direction */
7014 @ Before the B\'ezier control points have been calculated, the memory
7015 space they will ultimately occupy is taken up by information that can be
7016 used to compute them. There are four cases:
7019 \textindent{$\bullet$} If |mp_right_type=mp_open|, the curve should leave
7020 the knot in the same direction it entered; \MP\ will figure out a
7024 \textindent{$\bullet$} If |mp_right_type=mp_curl|, the curve should leave the
7025 knot in a direction depending on the angle at which it enters the next
7026 knot and on the curl parameter stored in |right_curl|.
7029 \textindent{$\bullet$} If |mp_right_type=mp_given|, the curve should leave the
7030 knot in a nonzero direction stored as an |angle| in |right_given|.
7033 \textindent{$\bullet$} If |mp_right_type=mp_explicit|, the B\'ezier control
7034 point for leaving this knot has already been computed; it is in the
7035 |mp_right_x| and |mp_right_y| fields.
7038 The rules for |mp_left_type| are similar, but they refer to the curve entering
7039 the knot, and to \\{left} fields instead of \\{right} fields.
7041 Non-|explicit| control points will be chosen based on ``tension'' parameters
7042 in the |left_tension| and |right_tension| fields. The
7043 `\&{atleast}' option is represented by negative tension values.
7044 @:at_least_}{\&{atleast} primitive@>
7046 For example, the \MP\ path specification
7047 $$\.{z0..z1..tension atleast 1..\{curl 2\}z2..z3\{-1,-2\}..tension
7049 where \.p is the path `\.{z4..controls z45 and z54..z5}', will be represented
7051 \def\lodash{\hbox to 1.1em{\thinspace\hrulefill\thinspace}}
7052 $$\vbox{\halign{#\hfil&&\qquad#\hfil\cr
7053 |mp_left_type|&\\{left} info&|x_coord,y_coord|&|mp_right_type|&\\{right} info\cr
7055 |endpoint|&\lodash$,\,$\lodash&$x_0,y_0$&|curl|&$1.0,1.0$\cr
7056 |open|&\lodash$,1.0$&$x_1,y_1$&|open|&\lodash$,-1.0$\cr
7057 |curl|&$2.0,-1.0$&$x_2,y_2$&|curl|&$2.0,1.0$\cr
7058 |given|&$d,1.0$&$x_3,y_3$&|given|&$d,3.0$\cr
7059 |open|&\lodash$,4.0$&$x_4,y_4$&|explicit|&$x_{45},y_{45}$\cr
7060 |explicit|&$x_{54},y_{54}$&$x_5,y_5$&|endpoint|&\lodash$,\,$\lodash\cr}}$$
7061 Here |d| is the |angle| obtained by calling |n_arg(-unity,-two)|.
7062 Of course, this example is more complicated than anything a normal user
7065 These types must satisfy certain restrictions because of the form of \MP's
7067 (i)~|open| type never appears in the same node together with |endpoint|,
7069 (ii)~The |mp_right_type| of a node is |explicit| if and only if the
7070 |mp_left_type| of the following node is |explicit|.
7071 (iii)~|endpoint| types occur only at the ends, as mentioned above.
7073 @d left_curl left_x /* curl information when entering this knot */
7074 @d left_given left_x /* given direction when entering this knot */
7075 @d left_tension left_y /* tension information when entering this knot */
7076 @d right_curl right_x /* curl information when leaving this knot */
7077 @d right_given right_x /* given direction when leaving this knot */
7078 @d right_tension right_y /* tension information when leaving this knot */
7080 @ Knots can be user-supplied, or they can be created by program code,
7081 like the |split_cubic| function, or |copy_path|. The distinction is
7082 needed for the cleanup routine that runs after |split_cubic|, because
7083 it should only delete knots it has previously inserted, and never
7084 anything that was user-supplied. In order to be able to differentiate
7085 one knot from another, we will set |originator(p):=mp_metapost_user| when
7086 it appeared in the actual metapost program, and
7087 |originator(p):=mp_program_code| in all other cases.
7089 @d mp_originator(A) (A)->originator /* the creator of this knot */
7092 enum mp_knot_originator {
7093 mp_program_code = 0, /* not created by a user */
7094 mp_metapost_user /* created by a user */
7097 @ Here is a routine that prints a given knot list
7098 in symbolic form. It illustrates the conventions discussed above,
7099 and checks for anomalies that might arise while \MP\ is being debugged.
7102 static void mp_pr_path (MP mp, mp_knot h);
7105 void mp_pr_path (MP mp, mp_knot h) {
7106 mp_knot p, q; /* for list traversal */
7109 q = mp_next_knot (p);
7110 if ((p == NULL) || (q == NULL)) {
7111 mp_print_nl (mp, "???
");
7112 return; /* this won't happen */
7115 @<Print information for adjacent knots |p| and |q|@>;
7118 if (p && ((p != h) || (mp_left_type (h) != mp_endpoint))) {
7119 @<Print two dots, followed by |given| or |curl| if present@>;
7122 if (mp_left_type (h) != mp_endpoint)
7123 mp_print (mp, "cycle
");
7127 @ @<Print information for adjacent knots...@>=
7128 mp_print_two (mp, p->x_coord, p->y_coord);
7129 switch (mp_right_type (p)) {
7131 if (mp_left_type (p) == mp_open)
7132 mp_print (mp, "{open?
}"); /* can't happen */
7134 if ((mp_left_type (q) != mp_endpoint) || (q != h))
7135 q = NULL; /* force an error */
7139 @<Print control points between |p| and |q|, then |goto done1|@>;
7142 @<Print information for a curve that begins |open|@>;
7146 @<Print information for a curve that begins |curl| or |given|@>;
7149 mp_print (mp, "???
"); /* can't happen */
7153 if (mp_left_type (q) <= mp_explicit) {
7154 mp_print (mp, "..control?
"); /* can't happen */
7156 } else if ((!number_equal(p->right_tension, unity_t)) || (!number_equal(q->left_tension, unity_t))) {
7157 @<Print tension between |p| and |q|@>;
7160 @ Since |n_sin_cos| produces |fraction| results, which we will print as if they
7161 were |scaled|, the magnitude of a |given| direction vector will be~4096.
7163 @<Print two dots...@>=
7165 mp_number n_sin, n_cos;
7166 new_fraction (n_sin);
7167 new_fraction (n_cos);
7168 mp_print_nl (mp, " ..
");
7169 if (mp_left_type (p) == mp_given) {
7170 n_sin_cos (p->left_given, n_cos, n_sin);
7171 mp_print_char (mp, xord ('{'));
7172 print_number (n_cos);
7173 mp_print_char (mp, xord (','));
7174 print_number (n_sin);
7175 mp_print_char (mp, xord ('}'));
7176 } else if (mp_left_type (p) == mp_curl) {
7177 mp_print (mp, "{curl
");
7178 print_number (p->left_curl);
7179 mp_print_char (mp, xord ('}'));
7181 free_number (n_sin);
7182 free_number (n_cos);
7186 @ @<Print tension between |p| and |q|@>=
7190 mp_print (mp, "..tension
");
7191 if (number_negative(p->right_tension))
7192 mp_print (mp, "atleast
");
7193 number_clone (v1, p->right_tension);
7196 if (!number_equal(p->right_tension, q->left_tension)) {
7197 mp_print (mp, " and
");
7198 if (number_negative(q->left_tension))
7199 mp_print (mp, "atleast
");
7200 number_clone (v1, p->left_tension);
7208 @ @<Print control points between |p| and |q|, then |goto done1|@>=
7210 mp_print (mp, "..controls
");
7211 mp_print_two (mp, p->right_x, p->right_y);
7212 mp_print (mp, " and
");
7213 if (mp_left_type (q) != mp_explicit) {
7214 mp_print (mp, "??
"); /* can't happen */
7217 mp_print_two (mp, q->left_x, q->left_y);
7223 @ @<Print information for a curve that begins |open|@>=
7224 if ((mp_left_type (p) != mp_explicit) && (mp_left_type (p) != mp_open)) {
7225 mp_print (mp, "{open?
}"); /* can't happen */
7229 @ A curl of 1 is shown explicitly, so that the user sees clearly that
7230 \MP's default curl is present.
7232 @<Print information for a curve that begins |curl|...@>=
7234 if (mp_left_type (p) == mp_open)
7235 mp_print (mp, "??
"); /* can't happen */
7237 if (mp_right_type (p) == mp_curl) {
7238 mp_print (mp, "{curl
");
7239 print_number (p->right_curl);
7241 mp_number n_sin, n_cos;
7242 new_fraction (n_sin);
7243 new_fraction (n_cos);
7244 n_sin_cos (p->right_given, n_cos, n_sin);
7245 mp_print_char (mp, xord ('{'));
7246 print_number (n_cos);
7247 mp_print_char (mp, xord (','));
7248 print_number (n_sin);
7249 free_number (n_sin);
7250 free_number (n_cos);
7252 mp_print_char (mp, xord ('}'));
7256 @ It is convenient to have another version of |pr_path| that prints the path
7257 as a diagnostic message.
7260 static void mp_print_path (MP mp, mp_knot h, const char *s, boolean nuline);
7263 void mp_print_path (MP mp, mp_knot h, const char *s, boolean nuline) {
7264 mp_print_diagnostic (mp, "Path
", s, nuline);
7266 @.Path at line...@>;
7268 mp_end_diagnostic (mp, true);
7273 static mp_knot mp_new_knot (MP mp);
7276 static mp_knot mp_new_knot (MP mp) {
7278 if (mp->knot_nodes) {
7280 mp->knot_nodes = q->next;
7281 mp->num_knot_nodes--;
7283 q = mp_xmalloc (mp, 1, sizeof (struct mp_knot_data));
7285 memset(q,0,sizeof (struct mp_knot_data));
7286 new_number(q->x_coord);
7287 new_number(q->y_coord);
7288 new_number(q->left_x);
7289 new_number(q->left_y);
7290 new_number(q->right_x);
7291 new_number(q->right_y);
7297 static mp_gr_knot mp_gr_new_knot (MP mp);
7300 static mp_gr_knot mp_gr_new_knot (MP mp) {
7301 mp_gr_knot q = mp_xmalloc (mp, 1, sizeof (struct mp_gr_knot_data));
7306 @ If we want to duplicate a knot node, we can say |copy_knot|:
7309 static mp_knot mp_copy_knot (MP mp, mp_knot p) {
7311 if (mp->knot_nodes) {
7313 mp->knot_nodes = q->next;
7314 mp->num_knot_nodes--;
7316 q = mp_xmalloc (mp, 1, sizeof (struct mp_knot_data));
7318 memcpy (q, p, sizeof (struct mp_knot_data));
7319 if (mp->math_mode > mp_math_double_mode) {
7320 new_number(q->x_coord);
7321 new_number(q->y_coord);
7322 new_number(q->left_x);
7323 new_number(q->left_y);
7324 new_number(q->right_x);
7325 new_number(q->right_y);
7326 number_clone(q->x_coord, p->x_coord);
7327 number_clone(q->y_coord, p->y_coord);
7328 number_clone(q->left_x, p->left_x);
7329 number_clone(q->left_y, p->left_y);
7330 number_clone(q->right_x, p->right_x);
7331 number_clone(q->right_y, p->right_y);
7333 mp_next_knot (q) = NULL;
7337 @ If we want to export a knot node, we can say |export_knot|:
7340 static mp_gr_knot mp_export_knot (MP mp, mp_knot p) {
7341 mp_gr_knot q; /* the copy */
7342 q = mp_gr_new_knot (mp);
7343 q->x_coord = number_to_double(p->x_coord);
7344 q->y_coord = number_to_double(p->y_coord);
7345 q->left_x = number_to_double(p->left_x);
7346 q->left_y = number_to_double(p->left_y);
7347 q->right_x = number_to_double(p->right_x);
7348 q->right_y = number_to_double(p->right_y);
7349 q->data.types.left_type = mp_left_type(p);
7350 q->data.types.right_type = mp_left_type(p);
7351 q->data.info = mp_knot_info(p);
7352 mp_gr_next_knot (q) = NULL;
7357 @ The |copy_path| routine makes a clone of a given path.
7360 static mp_knot mp_copy_path (MP mp, mp_knot p) {
7361 mp_knot q, pp, qq; /* for list manipulation */
7364 q = mp_copy_knot (mp, p);
7366 pp = mp_next_knot (p);
7368 mp_next_knot (qq) = mp_copy_knot (mp, pp);
7369 qq = mp_next_knot (qq);
7370 pp = mp_next_knot (pp);
7372 mp_next_knot (qq) = q;
7376 @ The |export_path| routine makes a clone of a given path
7377 and converts the |value|s therein to |double|s.
7380 static mp_gr_knot mp_export_path (MP mp, mp_knot p) {
7381 mp_knot pp; /* for list manipulation */
7385 q = mp_export_knot (mp, p);
7387 pp = mp_next_knot (p);
7389 mp_gr_next_knot (qq) = mp_export_knot (mp, pp);
7390 qq = mp_gr_next_knot (qq);
7391 pp = mp_next_knot (pp);
7393 mp_gr_next_knot (qq) = q;
7397 @ If we want to import a knot node, we can say |import_knot|:
7400 static mp_knot mp_import_knot (MP mp, mp_gr_knot p) {
7401 mp_knot q; /* the copy */
7402 q = mp_new_knot (mp);
7403 set_number_from_double(q->x_coord, p->x_coord);
7404 set_number_from_double(q->y_coord, p->y_coord);
7405 set_number_from_double(q->left_x, p->left_x);
7406 set_number_from_double(q->left_y, p->left_y);
7407 set_number_from_double(q->right_x, p->right_x);
7408 set_number_from_double(q->right_y, p->right_y);
7409 mp_left_type(q) = p->data.types.left_type;
7410 mp_left_type(q) = p->data.types.right_type;
7411 mp_knot_info(q) = p->data.info;
7412 mp_next_knot (q) = NULL;
7417 @ The |import_path| routine makes a clone of a given path
7418 and converts the |value|s therein to |scaled|s.
7421 static mp_knot mp_import_path (MP mp, mp_gr_knot p) {
7422 mp_gr_knot pp; /* for list manipulation */
7426 q = mp_import_knot (mp, p);
7428 pp = mp_gr_next_knot (p);
7430 mp_next_knot (qq) = mp_import_knot (mp, pp);
7431 qq = mp_next_knot (qq);
7432 pp = mp_gr_next_knot (pp);
7434 mp_next_knot (qq) = q;
7439 @ Just before |ship_out|, knot lists are exported for printing.
7441 @ The |export_knot_list| routine therefore also makes a clone
7445 static mp_gr_knot mp_export_knot_list (MP mp, mp_knot p) {
7446 mp_gr_knot q; /* the exported copy */
7449 q = mp_export_path (mp, p);
7452 static mp_knot mp_import_knot_list (MP mp, mp_gr_knot q) {
7453 mp_knot p; /* the imported copy */
7456 p = mp_import_path (mp, q);
7460 @ Similarly, there's a way to copy the {\sl reverse\/} of a path. This procedure
7461 returns a pointer to the first node of the copy, if the path is a cycle,
7462 but to the final node of a non-cyclic copy. The global
7463 variable |path_tail| will point to the final node of the original path;
7464 this trick makes it easier to implement `\&{doublepath}'.
7466 All node types are assumed to be |endpoint| or |explicit| only.
7469 static mp_knot mp_htap_ypoc (MP mp, mp_knot p) {
7470 mp_knot q, pp, qq, rr; /* for list manipulation */
7471 q = mp_new_knot (mp); /* this will correspond to |p| */
7475 mp_right_type (qq) = mp_left_type (pp);
7476 mp_left_type (qq) = mp_right_type (pp);
7477 number_clone (qq->x_coord, pp->x_coord);
7478 number_clone (qq->y_coord, pp->y_coord);
7479 number_clone (qq->right_x, pp->left_x);
7480 number_clone (qq->right_y, pp->left_y);
7481 number_clone (qq->left_x, pp->right_x);
7482 number_clone (qq->left_y, pp->right_y);
7483 mp_originator (qq) = mp_originator (pp);
7484 if (mp_next_knot (pp) == p) {
7485 mp_next_knot (q) = qq;
7489 rr = mp_new_knot (mp);
7490 mp_next_knot (rr) = qq;
7492 pp = mp_next_knot (pp);
7498 mp_knot path_tail; /* the node that links to the beginning of a path */
7500 @ When a cyclic list of knot nodes is no longer needed, it can be recycled by
7501 calling the following subroutine.
7504 static void mp_toss_knot_list (MP mp, mp_knot p);
7505 static void mp_toss_knot (MP mp, mp_knot p);
7506 static void mp_free_knot (MP mp, mp_knot p);
7509 void mp_free_knot (MP mp, mp_knot q) {
7510 free_number (q->x_coord);
7511 free_number (q->y_coord);
7512 free_number (q->left_x);
7513 free_number (q->left_y);
7514 free_number (q->right_x);
7515 free_number (q->right_y);
7518 void mp_toss_knot (MP mp, mp_knot q) {
7519 if (mp->num_knot_nodes < max_num_knot_nodes) {
7520 q->next = mp->knot_nodes;
7522 mp->num_knot_nodes++;
7525 if (mp->math_mode > mp_math_double_mode) {
7531 void mp_toss_knot_list (MP mp, mp_knot p) {
7532 mp_knot q; /* the node being freed */
7533 mp_knot r; /* the next node */
7537 if (mp->math_mode > mp_math_double_mode) {
7539 r = mp_next_knot (q);
7540 mp_toss_knot(mp, q);
7545 r = mp_next_knot (q);
7546 if (mp->num_knot_nodes < max_num_knot_nodes) {
7547 q->next = mp->knot_nodes;
7549 mp->num_knot_nodes++;
7559 @* Choosing control points.
7560 Now we must actually delve into one of \MP's more difficult routines,
7561 the |make_choices| procedure that chooses angles and control points for
7562 the splines of a curve when the user has not specified them explicitly.
7563 The parameter to |make_choices| points to a list of knots and
7564 path information, as described above.
7566 A path decomposes into independent segments at ``breakpoint'' knots,
7567 which are knots whose left and right angles are both prespecified in
7568 some way (i.e., their |mp_left_type| and |mp_right_type| aren't both open).
7571 void mp_make_choices (MP mp, mp_knot knots) {
7572 mp_knot h; /* the first breakpoint */
7573 mp_knot p, q; /* consecutive breakpoints being processed */
7574 @<Other local variables for |make_choices|@>;
7575 FUNCTION_TRACE1 ("make_choices
()\n
");
7576 check_arith(); /* make sure that |arith_error=false| */
7577 if (number_positive(internal_value (mp_tracing_choices)))
7578 mp_print_path (mp, knots, ", before choices
", true);
7579 @<If consecutive knots are equal, join them explicitly@>;
7580 @<Find the first breakpoint, |h|, on the path;
7581 insert an artificial breakpoint if the path is an unbroken cycle@>;
7584 @<Fill in the control points between |p| and the next breakpoint,
7585 then advance |p| to that breakpoint@>;
7587 if (number_positive(internal_value (mp_tracing_choices)))
7588 mp_print_path (mp, knots, ", after choices
", true);
7589 if (mp->arith_error) {
7590 @<Report an unexpected problem during the choice-making@>;
7595 void mp_make_choices (MP mp, mp_knot knots);
7597 @ @<Report an unexpected problem during the choice...@>=
7599 const char *hlp[] = {
7600 "The path that I just computed is out of range.
",
7601 "So it will probably look funny. Proceed
, for a laugh.
",
7603 mp_back_error (mp, "Some number got too big
", hlp, true);
7604 @.Some number got too big@>;
7606 mp->arith_error = false;
7610 @ Two knots in a row with the same coordinates will always be joined
7611 by an explicit ``curve'' whose control points are identical with the
7614 @<If consecutive knots are equal, join them explicitly@>=
7617 q = mp_next_knot (p);
7618 if (number_equal (p->x_coord, q->x_coord) &&
7619 number_equal (p->y_coord, q->y_coord) &&
7620 mp_right_type (p) > mp_explicit) {
7621 mp_right_type (p) = mp_explicit;
7622 if (mp_left_type (p) == mp_open) {
7623 mp_left_type (p) = mp_curl;
7624 set_number_to_unity(p->left_curl);
7626 mp_left_type (q) = mp_explicit;
7627 if (mp_right_type (q) == mp_open) {
7628 mp_right_type (q) = mp_curl;
7629 set_number_to_unity(q->right_curl);
7631 number_clone (p->right_x, p->x_coord);
7632 number_clone (q->left_x, p->x_coord);
7633 number_clone (p->right_y, p->y_coord);
7634 number_clone (q->left_y, p->y_coord);
7637 } while (p != knots)
7639 @ If there are no breakpoints, it is necessary to compute the direction
7640 angles around an entire cycle. In this case the |mp_left_type| of the first
7641 node is temporarily changed to |end_cycle|.
7643 @<Find the first breakpoint, |h|, on the path...@>=
7646 if (mp_left_type (h) != mp_open)
7648 if (mp_right_type (h) != mp_open)
7650 h = mp_next_knot (h);
7652 mp_left_type (h) = mp_end_cycle;
7658 @ If |mp_right_type(p)<given| and |q=mp_link(p)|, we must have
7659 |mp_right_type(p)=mp_left_type(q)=mp_explicit| or |endpoint|.
7661 @<Fill in the control points between |p| and the next breakpoint...@>=
7662 q = mp_next_knot (p);
7663 if (mp_right_type (p) >= mp_given) {
7664 while ((mp_left_type (q) == mp_open) && (mp_right_type (q) == mp_open)) {
7665 q = mp_next_knot (q);
7667 @<Fill in the control information between consecutive breakpoints |p| and |q|@>;
7668 } else if (mp_right_type (p) == mp_endpoint) {
7669 @<Give reasonable values for the unused control points between |p| and~|q|@>;
7673 @ This step makes it possible to transform an explicitly computed path without
7674 checking the |mp_left_type| and |mp_right_type| fields.
7676 @<Give reasonable values for the unused control points between |p| and~|q|@>=
7678 number_clone (p->right_x, p->x_coord);
7679 number_clone (p->right_y, p->y_coord);
7680 number_clone (q->left_x, q->x_coord);
7681 number_clone (q->left_y, q->y_coord);
7685 @ Before we can go further into the way choices are made, we need to
7686 consider the underlying theory. The basic ideas implemented in |make_choices|
7687 are due to John Hobby, who introduced the notion of ``mock curvature''
7688 @^Hobby, John Douglas@>
7689 at a knot. Angles are chosen so that they preserve mock curvature when
7690 a knot is passed, and this has been found to produce excellent results.
7692 It is convenient to introduce some notations that simplify the necessary
7693 formulas. Let $d_{k,k+1}=\vert z\k-z_k\vert$ be the (nonzero) distance
7694 between knots |k| and |k+1|; and let
7695 $${z\k-z_k\over z_k-z_{k-1}}={d_{k,k+1}\over d_{k-1,k}}e^{i\psi_k}$$
7696 so that a polygonal line from $z_{k-1}$ to $z_k$ to $z\k$ turns left
7697 through an angle of~$\psi_k$. We assume that $\vert\psi_k\vert\L180^\circ$.
7698 The control points for the spline from $z_k$ to $z\k$ will be denoted by
7699 $$\eqalign{z_k^+&=z_k+
7700 \textstyle{1\over3}\rho_k e^{i\theta_k}(z\k-z_k),\cr
7702 \textstyle{1\over3}\sigma\k e^{-i\phi\k}(z\k-z_k),\cr}$$
7703 where $\rho_k$ and $\sigma\k$ are nonnegative ``velocity ratios'' at the
7704 beginning and end of the curve, while $\theta_k$ and $\phi\k$ are the
7705 corresponding ``offset angles.'' These angles satisfy the condition
7706 $$\theta_k+\phi_k+\psi_k=0,\eqno(*)$$
7707 whenever the curve leaves an intermediate knot~|k| in the direction that
7710 @ Let $\alpha_k$ and $\beta\k$ be the reciprocals of the ``tension'' of
7711 the curve at its beginning and ending points. This means that
7712 $\rho_k=\alpha_k f(\theta_k,\phi\k)$ and $\sigma\k=\beta\k f(\phi\k,\theta_k)$,
7713 where $f(\theta,\phi)$ is \MP's standard velocity function defined in
7714 the |velocity| subroutine. The cubic spline $B(z_k^{\phantom+},z_k^+,
7715 z\k^-,z\k^{\phantom+};t)$
7718 $${2\sigma\k\sin(\theta_k+\phi\k)-6\sin\theta_k\over\rho_k^2d_{k,k+1}}
7719 \qquad{\rm and}\qquad
7720 {2\rho_k\sin(\theta_k+\phi\k)-6\sin\phi\k\over\sigma\k^2d_{k,k+1}}$$
7721 at |t=0| and |t=1|, respectively. The mock curvature is the linear
7723 approximation to this true curvature that arises in the limit for
7724 small $\theta_k$ and~$\phi\k$, if second-order terms are discarded.
7725 The standard velocity function satisfies
7726 $$f(\theta,\phi)=1+O(\theta^2+\theta\phi+\phi^2);$$
7727 hence the mock curvatures are respectively
7728 $${2\beta\k(\theta_k+\phi\k)-6\theta_k\over\alpha_k^2d_{k,k+1}}
7729 \qquad{\rm and}\qquad
7730 {2\alpha_k(\theta_k+\phi\k)-6\phi\k\over\beta\k^2d_{k,k+1}}.\eqno(**)$$
7732 @ The turning angles $\psi_k$ are given, and equation $(*)$ above
7733 determines $\phi_k$ when $\theta_k$ is known, so the task of
7734 angle selection is essentially to choose appropriate values for each
7735 $\theta_k$. When equation~$(*)$ is used to eliminate $\phi$~variables
7736 from $(**)$, we obtain a system of linear equations of the form
7737 $$A_k\theta_{k-1}+(B_k+C_k)\theta_k+D_k\theta\k=-B_k\psi_k-D_k\psi\k,$$
7739 $$A_k={\alpha_{k-1}\over\beta_k^2d_{k-1,k}},
7740 \qquad B_k={3-\alpha_{k-1}\over\beta_k^2d_{k-1,k}},
7741 \qquad C_k={3-\beta\k\over\alpha_k^2d_{k,k+1}},
7742 \qquad D_k={\beta\k\over\alpha_k^2d_{k,k+1}}.$$
7743 The tensions are always $3\over4$ or more, hence each $\alpha$ and~$\beta$
7744 will be at most $4\over3$. It follows that $B_k\G{5\over4}A_k$ and
7745 $C_k\G{5\over4}D_k$; hence the equations are diagonally dominant;
7746 hence they have a unique solution. Moreover, in most cases the tensions
7747 are equal to~1, so that $B_k=2A_k$ and $C_k=2D_k$. This makes the
7748 solution numerically stable, and there is an exponential damping
7749 effect: The data at knot $k\pm j$ affects the angle at knot~$k$ by
7750 a factor of~$O(2^{-j})$.
7752 @ However, we still must consider the angles at the starting and ending
7753 knots of a non-cyclic path. These angles might be given explicitly, or
7754 they might be specified implicitly in terms of an amount of ``curl.''
7756 Let's assume that angles need to be determined for a non-cyclic path
7757 starting at $z_0$ and ending at~$z_n$. Then equations of the form
7758 $$A_k\theta_{k-1}+(B_k+C_k)\theta_k+D_k\theta_{k+1}=R_k$$
7759 have been given for $0<k<n$, and it will be convenient to introduce
7760 equations of the same form for $k=0$ and $k=n$, where
7761 $$A_0=B_0=C_n=D_n=0.$$
7762 If $\theta_0$ is supposed to have a given value $E_0$, we simply
7763 define $C_0=1$, $D_0=0$, and $R_0=E_0$. Otherwise a curl
7764 parameter, $\gamma_0$, has been specified at~$z_0$; this means
7765 that the mock curvature at $z_0$ should be $\gamma_0$ times the
7766 mock curvature at $z_1$; i.e.,
7767 $${2\beta_1(\theta_0+\phi_1)-6\theta_0\over\alpha_0^2d_{01}}
7768 =\gamma_0{2\alpha_0(\theta_0+\phi_1)-6\phi_1\over\beta_1^2d_{01}}.$$
7769 This equation simplifies to
7770 $$(\alpha_0\chi_0+3-\beta_1)\theta_0+
7771 \bigl((3-\alpha_0)\chi_0+\beta_1\bigr)\theta_1=
7772 -\bigl((3-\alpha_0)\chi_0+\beta_1\bigr)\psi_1,$$
7773 where $\chi_0=\alpha_0^2\gamma_0/\beta_1^2$; so we can set $C_0=
7774 \chi_0\alpha_0+3-\beta_1$, $D_0=(3-\alpha_0)\chi_0+\beta_1$, $R_0=-D_0\psi_1$.
7775 It can be shown that $C_0>0$ and $C_0B_1-A_1D_0>0$ when $\gamma_0\G0$,
7776 hence the linear equations remain nonsingular.
7778 Similar considerations apply at the right end, when the final angle $\phi_n$
7779 may or may not need to be determined. It is convenient to let $\psi_n=0$,
7780 hence $\theta_n=-\phi_n$. We either have an explicit equation $\theta_n=E_n$,
7782 $$\bigl((3-\beta_n)\chi_n+\alpha_{n-1}\bigr)\theta_{n-1}+
7783 (\beta_n\chi_n+3-\alpha_{n-1})\theta_n=0,\qquad
7784 \chi_n={\beta_n^2\gamma_n\over\alpha_{n-1}^2}.$$
7786 When |make_choices| chooses angles, it must compute the coefficients of
7787 these linear equations, then solve the equations. To compute the coefficients,
7788 it is necessary to compute arctangents of the given turning angles~$\psi_k$.
7789 When the equations are solved, the chosen directions $\theta_k$ are put
7790 back into the form of control points by essentially computing sines and
7793 @ OK, we are ready to make the hard choices of |make_choices|.
7794 Most of the work is relegated to an auxiliary procedure
7795 called |solve_choices|, which has been introduced to keep
7796 |make_choices| from being extremely long.
7798 @<Fill in the control information between...@>=
7799 @<Calculate the turning angles $\psi_k$ and the distances $d_{k,k+1}$;
7800 set $n$ to the length of the path@>;
7801 @<Remove |open| types at the breakpoints@>;
7802 mp_solve_choices (mp, p, q, n)
7805 @ It's convenient to precompute quantities that will be needed several
7806 times later. The values of |delta_x[k]| and |delta_y[k]| will be the
7807 coordinates of $z\k-z_k$, and the magnitude of this vector will be
7808 |delta[k]=@t$d_{k,k+1}$@>|. The path angle $\psi_k$ between $z_k-z_{k-1}$
7809 and $z\k-z_k$ will be stored in |psi[k]|.
7812 int path_size; /* maximum number of knots between breakpoints of a path */
7815 mp_number *delta; /* knot differences */
7816 mp_number *psi; /* turning angles */
7818 @ @<Dealloc variables@>=
7821 for (k = 0; k<mp->path_size; k++) {
7822 free_number (mp->delta_x[k]);
7823 free_number (mp->delta_y[k]);
7824 free_number (mp->delta[k]);
7825 free_number (mp->psi[k]);
7827 xfree (mp->delta_x);
7828 xfree (mp->delta_y);
7833 @ @<Other local variables for |make_choices|@>=
7834 int k, n; /* current and final knot numbers */
7835 mp_knot s, t; /* registers for list traversal */
7837 @ @<Calculate the turning angles...@>=
7839 mp_number sine, cosine; /* trig functions of various angles */
7840 new_fraction (sine);
7841 new_fraction (cosine);
7847 t = mp_next_knot (s);
7848 set_number_from_substraction(mp->delta_x[k], t->x_coord, s->x_coord);
7849 set_number_from_substraction(mp->delta_y[k], t->y_coord, s->y_coord);
7850 pyth_add (mp->delta[k], mp->delta_x[k], mp->delta_y[k]);
7852 mp_number arg1, arg2, r1, r2;
7857 make_fraction (r1, mp->delta_y[k - 1], mp->delta[k - 1]);
7858 number_clone (sine, r1);
7859 make_fraction (r2, mp->delta_x[k - 1], mp->delta[k - 1]);
7860 number_clone (cosine, r2);
7861 take_fraction (r1, mp->delta_x[k], cosine);
7862 take_fraction (r2, mp->delta_y[k], sine);
7863 set_number_from_addition (arg1, r1, r2);
7864 take_fraction (r1, mp->delta_y[k], cosine);
7865 take_fraction (r2, mp->delta_x[k], sine);
7866 set_number_from_substraction (arg2, r1, r2);
7867 n_arg (mp->psi[k], arg1, arg2 );
7875 if (k == mp->path_size) {
7876 mp_reallocate_paths (mp, mp->path_size + (mp->path_size / 4));
7877 goto RESTART; /* retry, loop size has changed */
7881 } while (!((k >= n) && (mp_left_type (s) != mp_end_cycle)));
7883 set_number_to_zero(mp->psi[k]);
7885 number_clone(mp->psi[k], mp->psi[1]);
7887 free_number (cosine);
7891 @ When we get to this point of the code, |mp_right_type(p)| is either
7892 |given| or |curl| or |open|. If it is |open|, we must have
7893 |mp_left_type(p)=mp_end_cycle| or |mp_left_type(p)=mp_explicit|. In the latter
7894 case, the |open| type is converted to |given|; however, if the
7895 velocity coming into this knot is zero, the |open| type is
7896 converted to a |curl|, since we don't know the incoming direction.
7898 Similarly, |mp_left_type(q)| is either |given| or |curl| or |open| or
7899 |mp_end_cycle|. The |open| possibility is reduced either to |given| or to |curl|.
7901 @<Remove |open| types at the breakpoints@>=
7903 mp_number delx, dely; /* directions where |open| meets |explicit| */
7906 if (mp_left_type (q) == mp_open) {
7907 set_number_from_substraction(delx, q->right_x, q->x_coord);
7908 set_number_from_substraction(dely, q->right_y, q->y_coord);
7909 if (number_zero(delx) && number_zero(dely)) {
7910 mp_left_type (q) = mp_curl;
7911 set_number_to_unity(q->left_curl);
7913 mp_left_type (q) = mp_given;
7914 n_arg (q->left_given, delx, dely);
7917 if ((mp_right_type (p) == mp_open) && (mp_left_type (p) == mp_explicit)) {
7918 set_number_from_substraction(delx, p->x_coord, p->left_x);
7919 set_number_from_substraction(dely, p->y_coord, p->left_y);
7920 if (number_zero(delx) && number_zero(dely)) {
7921 mp_right_type (p) = mp_curl;
7922 set_number_to_unity(p->right_curl);
7924 mp_right_type (p) = mp_given;
7925 n_arg (p->right_given, delx, dely);
7932 @ Linear equations need to be solved whenever |n>1|; and also when |n=1|
7933 and exactly one of the breakpoints involves a curl. The simplest case occurs
7934 when |n=1| and there is a curl at both breakpoints; then we simply draw
7937 But before coding up the simple cases, we might as well face the general case,
7938 since we must deal with it sooner or later, and since the general case
7939 is likely to give some insight into the way simple cases can be handled best.
7941 When there is no cycle, the linear equations to be solved form a tridiagonal
7942 system, and we can apply the standard technique of Gaussian elimination
7943 to convert that system to a sequence of equations of the form
7944 $$\theta_0+u_0\theta_1=v_0,\quad
7945 \theta_1+u_1\theta_2=v_1,\quad\ldots,\quad
7946 \theta_{n-1}+u_{n-1}\theta_n=v_{n-1},\quad
7948 It is possible to do this diagonalization while generating the equations.
7949 Once $\theta_n$ is known, it is easy to determine $\theta_{n-1}$, \dots,
7950 $\theta_1$, $\theta_0$; thus, the equations will be solved.
7952 The procedure is slightly more complex when there is a cycle, but the
7953 basic idea will be nearly the same. In the cyclic case the right-hand
7954 sides will be $v_k+w_k\theta_0$ instead of simply $v_k$, and we will start
7955 the process off with $u_0=v_0=0$, $w_0=1$. The final equation will be not
7956 $\theta_n=v_n$ but $\theta_n+u_n\theta_1=v_n+w_n\theta_0$; an appropriate
7957 ending routine will take account of the fact that $\theta_n=\theta_0$ and
7958 eliminate the $w$'s from the system, after which the solution can be
7961 When $u_k$, $v_k$, and $w_k$ are being computed, the three pointer
7962 variables |r|, |s|,~|t| will point respectively to knots |k-1|, |k|,
7963 and~|k+1|. The $u$'s and $w$'s are scaled by $2^{28}$, i.e., they are
7964 of type |fraction|; the $\theta$'s and $v$'s are of type |angle|.
7967 mp_number *theta; /* values of $\theta_k$ */
7968 mp_number *uu; /* values of $u_k$ */
7969 mp_number *vv; /* values of $v_k$ */
7970 mp_number *ww; /* values of $w_k$ */
7972 @ @<Dealloc variables@>=
7975 for (k = 0; k<mp->path_size; k++) {
7976 free_number (mp->theta[k]);
7977 free_number (mp->uu[k]);
7978 free_number (mp->vv[k]);
7979 free_number (mp->ww[k]);
7988 static void mp_reallocate_paths (MP mp, int l);
7991 void mp_reallocate_paths (MP mp, int l) {
7993 XREALLOC (mp->delta_x, l, mp_number);
7994 XREALLOC (mp->delta_y, l, mp_number);
7995 XREALLOC (mp->delta, l, mp_number);
7996 XREALLOC (mp->psi, l, mp_number);
7997 XREALLOC (mp->theta, l, mp_number);
7998 XREALLOC (mp->uu, l, mp_number);
7999 XREALLOC (mp->vv, l, mp_number);
8000 XREALLOC (mp->ww, l, mp_number);
8001 for (k = mp->path_size; k<l; k++) {
8002 new_number (mp->delta_x[k]);
8003 new_number (mp->delta_y[k]);
8004 new_number (mp->delta[k]);
8005 new_angle (mp->psi[k]);
8006 new_angle (mp->theta[k]);
8007 new_fraction (mp->uu[k]);
8008 new_angle (mp->vv[k]);
8009 new_fraction (mp->ww[k]);
8015 @ Our immediate problem is to get the ball rolling by setting up the
8016 first equation or by realizing that no equations are needed, and to fit
8017 this initialization into a framework suitable for the overall computation.
8020 static void mp_solve_choices (MP mp, mp_knot p, mp_knot q, halfword n);
8023 void mp_solve_choices (MP mp, mp_knot p, mp_knot q, halfword n) {
8024 int k; /* current knot number */
8025 mp_knot r, s, t; /* registers for list traversal */
8028 FUNCTION_TRACE2 ("solve_choices
(%d
)\n
", n);
8033 t = mp_next_knot (s);
8035 @<Get the linear equations started; or |return|
8036 with the control points in place, if linear equations
8039 switch (mp_left_type (s)) {
8042 @<Set up equation to match mock curvatures
8043 at $z_k$; then |goto found| with $\theta_n$
8044 adjusted to equal $\theta_0$, if a cycle has ended@>;
8047 @<Set up equation for a curl at $\theta_n$
8051 @<Calculate the given value of $\theta_n$
8054 } /* there are no other cases */
8061 @<Finish choosing angles and assigning control points@>;
8066 @ On the first time through the loop, we have |k=0| and |r| is not yet
8067 defined. The first linear equation, if any, will have $A_0=B_0=0$.
8069 @<Get the linear equations started...@>=
8070 switch (mp_right_type (s)) {
8072 if (mp_left_type (t) == mp_given) {
8073 @<Reduce to simple case of two givens and |return|@>
8075 @<Set up the equation for a given value of $\theta_0$@>;
8079 if (mp_left_type (t) == mp_curl) {
8080 @<Reduce to simple case of straight line and |return|@>
8082 @<Set up the equation for a curl at $\theta_0$@>;
8086 set_number_to_zero(mp->uu[0]);
8087 set_number_to_zero(mp->vv[0]);
8088 number_clone(mp->ww[0], fraction_one_t);
8089 /* this begins a cycle */
8091 } /* there are no other cases */
8094 @ The general equation that specifies equality of mock curvature at $z_k$ is
8095 $$A_k\theta_{k-1}+(B_k+C_k)\theta_k+D_k\theta\k=-B_k\psi_k-D_k\psi\k,$$
8096 as derived above. We want to combine this with the already-derived equation
8097 $\theta_{k-1}+u_{k-1}\theta_k=v_{k-1}+w_{k-1}\theta_0$ in order to obtain
8099 $\theta_k+u_k\theta\k=v_k+w_k\theta_0$. This can be done by dividing the
8101 $$(B_k-u_{k-1}A_k+C_k)\theta_k+D_k\theta\k=-B_k\psi_k-D_k\psi\k-A_kv_{k-1}
8102 -A_kw_{k-1}\theta_0$$
8103 by $B_k-u_{k-1}A_k+C_k$. The trick is to do this carefully with
8104 fixed-point arithmetic, avoiding the chance of overflow while retaining
8107 The calculations will be performed in several registers that
8108 provide temporary storage for intermediate quantities.
8110 @ @<Set up equation to match mock curvatures...@>=
8112 mp_number aa, bb, cc, acc; /* temporary registers */
8113 mp_number dd, ee; /* likewise, but |scaled| */
8120 @<Calculate the values $\\{aa}=A_k/B_k$, $\\{bb}=D_k/C_k$,
8121 $\\{dd}=(3-\alpha_{k-1})d_{k,k+1}$, $\\{ee}=(3-\beta\k)d_{k-1,k}$,
8122 and $\\{cc}=(B_k-u_{k-1}A_k)/B_k$@>;
8123 @<Calculate the ratio $\\{ff}=C_k/(C_k+B_k-u_{k-1}A_k)$@>;
8124 take_fraction (mp->uu[k], ff, bb);
8125 @<Calculate the values of $v_k$ and $w_k$@>;
8126 if (mp_left_type (s) == mp_end_cycle) {
8127 @<Adjust $\theta_n$ to equal $\theta_0$ and |goto found|@>;
8138 @ Since tension values are never less than 3/4, the values |aa| and
8139 |bb| computed here are never more than 4/5.
8141 @<Calculate the values $\\{aa}=...@>=
8144 new_number (absval);
8145 number_clone (absval, r->right_tension);
8146 number_abs (absval);
8147 if (number_equal (absval, unity_t)) {
8148 number_clone (aa, fraction_half_t);
8149 number_clone (dd, mp->delta[k]);
8152 mp_number arg1, arg2, ret;
8155 number_clone (arg2, r->right_tension);
8157 number_multiply_int (arg2, 3);
8158 number_substract (arg2, unity_t);
8159 make_fraction (aa, unity_t, arg2);
8160 number_clone (arg2, r->right_tension);
8163 make_fraction (ret, unity_t, arg2);
8164 set_number_from_substraction (arg1, fraction_three_t, ret);
8165 take_fraction (arg2, mp->delta[k], arg1);
8166 number_clone (dd, arg2);
8171 number_clone (absval, t->left_tension);
8172 number_abs (absval);
8173 if (number_equal (absval, unity_t)) {
8174 number_clone (bb, fraction_half_t);
8175 number_clone (ee, mp->delta[k - 1]);
8178 mp_number arg1, arg2, ret;
8181 number_clone (arg2, t->left_tension);
8183 number_multiply_int (arg2, 3);
8184 number_substract (arg2, unity_t);
8185 make_fraction (bb, unity_t, arg2);
8186 number_clone (arg2, t->left_tension);
8189 make_fraction (ret, unity_t, arg2);
8190 set_number_from_substraction (arg1,fraction_three_t, ret);
8191 take_fraction (ee, mp->delta[k - 1], arg1);
8196 free_number (absval);
8201 take_fraction (r1, mp->uu[k - 1], aa);
8202 set_number_from_substraction (cc, fraction_one_t, r1);
8206 @ The ratio to be calculated in this step can be written in the form
8207 $$\beta_k^2\cdot\\{ee}\over\beta_k^2\cdot\\{ee}+\alpha_k^2\cdot
8208 \\{cc}\cdot\\{dd},$$
8209 because of the quantities just calculated. The values of |dd| and |ee|
8210 will not be needed after this step has been performed.
8212 @<Calculate the ratio $\\{ff}=C_k/(C_k+B_k-u_{k-1}A_k)$@>=
8217 number_clone (arg2, dd);
8218 take_fraction (dd, arg2, cc);
8221 number_clone (lt, s->left_tension);
8223 number_clone (rt, s->right_tension);
8225 if (!number_equal(lt, rt)) { /* $\beta_k^{-1}\ne\alpha_k^{-1}$ */
8228 if (number_less(lt, rt)) {
8229 make_fraction (r1, lt, rt); /* $\alpha_k^2/\beta_k^2$ */
8230 take_fraction (ff, r1, r1);
8231 number_clone (r1, dd);
8232 take_fraction (dd, r1, ff);
8234 make_fraction (r1, rt, lt); /* $\beta_k^2/\alpha_k^2$ */
8235 take_fraction (ff, r1, r1);
8236 number_clone (r1, ee);
8237 take_fraction (ee, r1, ff);
8243 set_number_from_addition (arg2, dd, ee);
8244 make_fraction (ff, ee, arg2);
8249 @ The value of $u_{k-1}$ will be |<=1| except when $k=1$ and the previous
8250 equation was specified by a curl. In that case we must use a special
8251 method of computation to prevent overflow.
8253 Fortunately, the calculations turn out to be even simpler in this ``hard''
8254 case. The curl equation makes $w_0=0$ and $v_0=-u_0\psi_1$, hence
8255 $-B_1\psi_1-A_1v_0=-(B_1-u_0A_1)\psi_1=-\\{cc}\cdot B_1\psi_1$.
8257 @<Calculate the values of $v_k$ and $w_k$@>=
8258 take_fraction (acc, mp->psi[k + 1], mp->uu[k]);
8259 number_negate (acc);
8260 if (mp_right_type (r) == mp_curl) {
8264 set_number_from_substraction (arg2, fraction_one_t, ff);
8265 take_fraction (r1, mp->psi[1], arg2);
8266 set_number_to_zero(mp->ww[k]);
8267 set_number_from_substraction(mp->vv[k], acc, r1);
8274 set_number_from_substraction (arg1, fraction_one_t, ff);
8275 make_fraction (ff, arg1, cc); /* this is $B_k/(C_k+B_k-u_{k-1}A_k)<5$ */
8277 take_fraction (r1, mp->psi[k], ff);
8278 number_substract (acc, r1);
8279 number_clone (r1, ff);
8280 take_fraction (ff, r1, aa); /* this is $A_k/(C_k+B_k-u_{k-1}A_k)$ */
8281 take_fraction (r1, mp->vv[k - 1], ff);
8282 set_number_from_substraction(mp->vv[k], acc, r1 );
8283 if (number_zero(mp->ww[k - 1])) {
8284 set_number_to_zero(mp->ww[k]);
8286 take_fraction (mp->ww[k], mp->ww[k - 1], ff);
8287 number_negate(mp->ww[k]);
8293 @ When a complete cycle has been traversed, we have $\theta_k+u_k\theta\k=
8294 v_k+w_k\theta_0$, for |1<=k<=n|. We would like to determine the value of
8295 $\theta_n$ and reduce the system to the form $\theta_k+u_k\theta\k=v_k$
8296 for |0<=k<n|, so that the cyclic case can be finished up just as if there
8299 The idea in the following code is to observe that
8300 $$\eqalign{\theta_n&=v_n+w_n\theta_0-u_n\theta_1=\cdots\cr
8301 &=v_n+w_n\theta_0-u_n\bigl(v_1+w_1\theta_0-u_1(v_2+\cdots
8302 -u_{n-2}(v_{n-1}+w_{n-1}\theta_0-u_{n-1}\theta_0))\bigr),\cr}$$
8303 so we can solve for $\theta_n=\theta_0$.
8305 @<Adjust $\theta_n$ to equal $\theta_0$ and |goto found|@>=
8310 set_number_to_zero (aa);
8311 number_clone (bb, fraction_one_t); /* we have |k=n| */
8316 take_fraction (r1, aa, mp->uu[k]);
8317 set_number_from_substraction (aa, mp->vv[k], r1);
8318 take_fraction (r1, bb, mp->uu[k]);
8319 set_number_from_substraction (bb, mp->ww[k], r1);
8320 } while (k != n); /* now $\theta_n=\\{aa}+\\{bb}\cdot\theta_n$ */
8321 set_number_from_substraction (arg2, fraction_one_t, bb);
8322 make_fraction (r1, aa, arg2);
8323 number_clone (aa, r1);
8324 number_clone(mp->theta[n], aa);
8325 number_clone(mp->vv[0], aa);
8326 for (k = 1; k < n; k++) {
8327 take_fraction (r1, aa, mp->ww[k]);
8328 number_add(mp->vv[k], r1);
8343 void mp_reduce_angle (MP mp, mp_number *a) {
8345 FUNCTION_TRACE2 ("reduce_angle
(%f
)\n
", number_to_double(*a));
8347 number_clone(abs_a, *a);
8349 if ( number_greater(abs_a, one_eighty_deg_t)) {
8350 if (number_positive(*a)) {
8351 number_substract(*a, three_sixty_deg_t);
8353 number_add(*a, three_sixty_deg_t);
8360 void mp_reduce_angle (MP mp, mp_number *a);
8363 @ @<Calculate the given value of $\theta_n$...@>=
8367 n_arg (narg, mp->delta_x[n - 1], mp->delta_y[n - 1]);
8368 set_number_from_substraction(mp->theta[n], s->left_given, narg);
8370 mp_reduce_angle (mp, &mp->theta[n]);
8375 @ @<Set up the equation for a given value of $\theta_0$@>=
8379 n_arg (narg, mp->delta_x[0], mp->delta_y[0]);
8380 set_number_from_substraction(mp->vv[0], s->right_given, narg);
8382 mp_reduce_angle (mp, &mp->vv[0]);
8383 set_number_to_zero(mp->uu[0]);
8384 set_number_to_zero(mp->ww[0]);
8388 @ @<Set up the equation for a curl at $\theta_0$@>=
8390 mp_number lt, rt, cc; /* tension values */
8394 number_clone (cc, s->right_curl);
8395 number_clone (lt, t->left_tension);
8397 number_clone (rt, s->right_tension);
8399 if (number_unity(rt) && number_unity(lt)) {
8400 mp_number arg1, arg2;
8403 number_clone (arg1, cc);
8404 number_double (arg1);
8405 number_add (arg1, unity_t);
8406 number_clone (arg2, cc);
8407 number_add (arg2, two_t);
8408 make_fraction (mp->uu[0], arg1, arg2);
8412 mp_curl_ratio (mp, &mp->uu[0], cc, rt, lt);
8414 take_fraction (mp->vv[0], mp->psi[1], mp->uu[0]);
8415 number_negate(mp->vv[0]);
8416 set_number_to_zero(mp->ww[0]);
8423 @ @<Set up equation for a curl at $\theta_n$...@>=
8425 mp_number lt, rt, cc; /* tension values */
8429 number_clone (cc, s->left_curl);
8430 number_clone (lt, s->left_tension);
8432 number_clone (rt, r->right_tension);
8434 if (number_unity(rt) && number_unity(lt)) {
8435 mp_number arg1, arg2;
8438 number_clone (arg1, cc);
8439 number_double (arg1);
8440 number_add (arg1, unity_t);
8441 number_clone (arg2, cc);
8442 number_add (arg2, two_t);
8443 make_fraction (ff, arg1, arg2);
8447 mp_curl_ratio (mp, &ff, cc, lt, rt);
8450 mp_number arg1, arg2, r1;
8452 new_fraction (arg1);
8454 take_fraction (arg1, mp->vv[n - 1], ff);
8455 take_fraction (r1, ff, mp->uu[n - 1]);
8456 set_number_from_substraction (arg2, fraction_one_t, r1);
8457 make_fraction (mp->theta[n], arg1, arg2);
8458 number_negate(mp->theta[n]);
8470 @ The |curl_ratio| subroutine has three arguments, which our previous notation
8471 encourages us to call $\gamma$, $\alpha^{-1}$, and $\beta^{-1}$. It is
8472 a somewhat tedious program to calculate
8473 $${(3-\alpha)\alpha^2\gamma+\beta^3\over
8474 \alpha^3\gamma+(3-\beta)\beta^2},$$
8475 with the result reduced to 4 if it exceeds 4. (This reduction of curl
8476 is necessary only if the curl and tension are both large.)
8477 The values of $\alpha$ and $\beta$ will be at most~4/3.
8480 static void mp_curl_ratio (MP mp, mp_number *ret, mp_number gamma, mp_number a_tension,
8481 mp_number b_tension);
8484 void mp_curl_ratio (MP mp, mp_number *ret, mp_number gamma_orig, mp_number a_tension, mp_number b_tension) {
8485 mp_number alpha, beta, gamma, num, denom, ff; /* registers */
8488 new_fraction (alpha);
8489 new_fraction (beta);
8490 new_fraction (gamma);
8492 new_fraction (denom);
8494 make_fraction (alpha, unity_t, a_tension);
8495 make_fraction (beta, unity_t, b_tension);
8496 number_clone (gamma, gamma_orig);
8497 if (number_lessequal(alpha, beta)) {
8498 make_fraction (ff, alpha, beta);
8499 number_clone (arg1, ff);
8500 take_fraction (ff, arg1, arg1);
8501 number_clone (arg1, gamma);
8502 take_fraction (gamma, arg1, ff);
8503 convert_fraction_to_scaled (beta);
8504 take_fraction (denom, gamma, alpha);
8505 number_add (denom, three_t);
8507 make_fraction (ff, beta, alpha);
8508 number_clone (arg1, ff);
8509 take_fraction (ff, arg1, arg1);
8510 take_fraction (arg1, beta, ff);
8511 convert_fraction_to_scaled (arg1);
8512 number_clone (beta, arg1);
8513 take_fraction (denom, gamma, alpha);
8514 set_number_from_div (arg1, ff, twelvebits_3);
8515 number_add (denom, arg1);
8517 number_substract (denom, beta);
8518 set_number_from_substraction (arg1, fraction_three_t, alpha);
8519 take_fraction (num, gamma, arg1);
8520 number_add (num, beta);
8521 number_clone (arg1, denom);
8522 number_double (arg1);
8523 number_double (arg1); /* arg1 = 4*denom */
8524 if (number_greaterequal(num, arg1)) {
8525 number_clone(*ret, fraction_four_t);
8527 make_fraction (*ret, num, denom);
8529 free_number (alpha);
8531 free_number (gamma);
8533 free_number (denom);
8539 @ We're in the home stretch now.
8541 @<Finish choosing angles and assigning control points@>=
8545 for (k = n - 1; k >= 0; k--) {
8546 take_fraction (r1, mp->theta[k + 1], mp->uu[k]);
8547 set_number_from_substraction(mp->theta[k], mp->vv[k], r1);
8557 t = mp_next_knot (s);
8558 n_sin_cos (mp->theta[k], mp->ct, mp->st);
8559 number_clone (arg, mp->psi[k + 1]);
8560 number_negate (arg);
8561 number_substract (arg, mp->theta[k + 1]);
8562 n_sin_cos (arg, mp->cf, mp->sf);
8563 mp_set_controls (mp, s, t, k);
8571 @ The |set_controls| routine actually puts the control points into
8572 a pair of consecutive nodes |p| and~|q|. Global variables are used to
8573 record the values of $\sin\theta$, $\cos\theta$, $\sin\phi$, and
8574 $\cos\phi$ needed in this calculation.
8580 mp_number cf; /* sines and cosines */
8582 @ @<Initialize table...@>=
8583 new_fraction (mp->st);
8584 new_fraction (mp->ct);
8585 new_fraction (mp->sf);
8586 new_fraction (mp->cf);
8589 free_number (mp->st);
8590 free_number (mp->ct);
8591 free_number (mp->sf);
8592 free_number (mp->cf);
8596 static void mp_set_controls (MP mp, mp_knot p, mp_knot q, integer k);
8599 void mp_set_controls (MP mp, mp_knot p, mp_knot q, integer k) {
8600 mp_number rr, ss; /* velocities, divided by thrice the tension */
8601 mp_number lt, rt; /* tensions */
8602 mp_number sine; /* $\sin(\theta+\phi)$ */
8610 number_clone(lt, q->left_tension);
8612 number_clone(rt, p->right_tension);
8614 new_fraction (sine);
8617 velocity (rr, mp->st, mp->ct, mp->sf, mp->cf, rt);
8618 velocity (ss, mp->sf, mp->cf, mp->st, mp->ct, lt);
8619 if (number_negative(p->right_tension) || number_negative(q->left_tension)) {
8620 @<Decrease the velocities,
8621 if necessary, to stay inside the bounding triangle@>;
8623 take_fraction (r1, mp->delta_x [k], mp->ct);
8624 take_fraction (r2, mp->delta_y [k], mp->st);
8625 number_substract (r1, r2);
8626 take_fraction (tmp, r1, rr);
8627 set_number_from_addition (p->right_x, p->x_coord, tmp);
8628 take_fraction (r1, mp->delta_y[k], mp->ct);
8629 take_fraction (r2, mp->delta_x[k], mp->st);
8630 number_add (r1, r2);
8631 take_fraction (tmp, r1, rr);
8632 set_number_from_addition (p->right_y, p->y_coord, tmp);
8633 take_fraction (r1, mp->delta_x[k], mp->cf);
8634 take_fraction (r2, mp->delta_y[k], mp->sf);
8635 number_add (r1, r2);
8636 take_fraction (tmp, r1, ss);
8637 set_number_from_substraction (q->left_x, q->x_coord, tmp);
8638 take_fraction (r1, mp->delta_y[k], mp->cf);
8639 take_fraction (r2, mp->delta_x[k], mp->sf);
8640 number_substract (r1, r2);
8641 take_fraction (tmp, r1, ss);
8642 set_number_from_substraction(q->left_y, q->y_coord, tmp);
8643 mp_right_type (p) = mp_explicit;
8644 mp_left_type (q) = mp_explicit;
8656 @ The boundedness conditions $\\{rr}\L\sin\phi\,/\sin(\theta+\phi)$ and
8657 $\\{ss}\L\sin\theta\,/\sin(\theta+\phi)$ are to be enforced if $\sin\theta$,
8658 $\sin\phi$, and $\sin(\theta+\phi)$ all have the same sign. Otherwise
8659 there is no ``bounding triangle.''
8661 @<Decrease the velocities, if necessary...@>=
8662 if ((number_nonnegative(mp->st) && number_nonnegative(mp->sf)) || (number_nonpositive(mp->st) && number_nonpositive(mp->sf))) {
8663 mp_number r1, r2, arg1;
8665 new_number (ab_vs_cd);
8669 number_clone (arg1, mp->st);
8671 take_fraction (r1, arg1, mp->cf);
8672 number_clone (arg1, mp->sf);
8674 take_fraction (r2, arg1, mp->ct);
8675 set_number_from_addition (sine, r1, r2);
8676 if (number_positive(sine)) {
8677 set_number_from_addition (arg1, fraction_one_t, unity_t); /* safety factor */
8678 number_clone (r1, sine);
8679 take_fraction (sine, r1, arg1);
8680 if (number_negative(p->right_tension)) {
8681 number_clone (arg1, mp->sf);
8683 ab_vs_cd (ab_vs_cd, arg1, fraction_one_t, rr, sine);
8684 if (number_negative(ab_vs_cd)) {
8685 number_clone (arg1, mp->sf);
8687 make_fraction (rr, arg1, sine);
8690 if (number_negative(q->left_tension)) {
8691 number_clone (arg1, mp->st);
8693 ab_vs_cd (ab_vs_cd, arg1, fraction_one_t, ss, sine);
8694 if (number_negative(ab_vs_cd)) {
8695 number_clone (arg1, mp->st);
8697 make_fraction (ss, arg1, sine);
8704 free_number (ab_vs_cd);
8707 @ Only the simple cases remain to be handled.
8709 @<Reduce to simple case of two givens and |return|@>=
8714 n_arg (narg, mp->delta_x[0], mp->delta_y[0]);
8716 set_number_from_substraction (arg1, p->right_given, narg);
8717 n_sin_cos (arg1, mp->ct, mp->st);
8718 set_number_from_substraction (arg1, q->left_given, narg);
8719 n_sin_cos (arg1, mp->cf, mp->sf);
8720 number_negate (mp->sf);
8721 mp_set_controls (mp, p, q, 0);
8729 @ @<Reduce to simple case of straight line and |return|@>=
8731 mp_number lt, rt; /* tension values */
8732 mp_right_type (p) = mp_explicit;
8733 mp_left_type (q) = mp_explicit;
8736 number_clone (lt, q->left_tension);
8738 number_clone (rt, p->right_tension);
8740 if (number_unity(rt)) {
8743 if (number_nonnegative(mp->delta_x[0])) {
8744 set_number_from_addition (arg2, mp->delta_x[0], epsilon_t);
8746 set_number_from_substraction (arg2, mp->delta_x[0], epsilon_t);
8748 number_int_div (arg2, 3);
8749 set_number_from_addition (p->right_x, p->x_coord, arg2);
8750 if (number_nonnegative(mp->delta_y[0])) {
8751 set_number_from_addition (arg2, mp->delta_y[0], epsilon_t);
8753 set_number_from_substraction (arg2, mp->delta_y[0], epsilon_t);
8755 number_int_div (arg2, 3);
8756 set_number_from_addition (p->right_y, p->y_coord, arg2);
8762 number_clone (arg2, rt);
8763 number_multiply_int (arg2, 3);
8764 make_fraction (ff, unity_t, arg2); /* $\alpha/3$ */
8766 take_fraction (r1, mp->delta_x[0], ff);
8767 set_number_from_addition (p->right_x, p->x_coord, r1);
8768 take_fraction (r1, mp->delta_y[0], ff);
8769 set_number_from_addition (p->right_y, p->y_coord, r1);
8771 if (number_unity(lt)) {
8774 if (number_nonnegative(mp->delta_x[0])) {
8775 set_number_from_addition (arg2, mp->delta_x[0], epsilon_t);
8777 set_number_from_substraction (arg2, mp->delta_x[0], epsilon_t);
8779 number_int_div (arg2, 3);
8780 set_number_from_substraction (q->left_x, q->x_coord, arg2);
8781 if (number_nonnegative(mp->delta_y[0])) {
8782 set_number_from_addition (arg2, mp->delta_y[0], epsilon_t);
8784 set_number_from_substraction (arg2, mp->delta_y[0], epsilon_t);
8786 number_int_div (arg2, 3);
8787 set_number_from_substraction (q->left_y, q->y_coord, arg2);
8793 number_clone (arg2, lt);
8794 number_multiply_int (arg2, 3);
8795 make_fraction (ff, unity_t, arg2); /* $\beta/3$ */
8797 take_fraction (r1, mp->delta_x[0], ff);
8798 set_number_from_substraction(q->left_x, q->x_coord, r1);
8799 take_fraction (r1, mp->delta_y[0], ff);
8800 set_number_from_substraction(q->left_y, q->y_coord, r1);
8809 @ Various subroutines that are useful for the new (1.770) exported
8810 api for solving path choices
8813 #define TOO_LARGE(a) (fabs((a))>4096.0)
8814 #define PI 3.1415926535897932384626433832795028841971
8816 static int out_of_range(MP mp, double a)
8820 set_number_from_double(t,fabs(a));
8821 if (number_greaterequal(t,inf_t)) {
8829 static int mp_link_knotpair (MP mp, mp_knot p, mp_knot q);
8830 static int mp_link_knotpair (MP mp, mp_knot p, mp_knot q)
8832 if (p==NULL ||q==NULL) return 0;
8834 set_number_from_double(p->right_tension, 1.0);
8835 if (mp_right_type(p)==mp_endpoint) {
8836 mp_right_type(p) = mp_open;
8838 set_number_from_double(q->left_tension, 1.0);
8839 if (mp_left_type(q) == mp_endpoint) {
8840 mp_left_type(q) = mp_open;
8845 int mp_close_path_cycle (MP mp, mp_knot p, mp_knot q)
8847 return mp_link_knotpair(mp,p,q);
8850 int mp_close_path (MP mp, mp_knot q, mp_knot first)
8852 if (q==NULL || first==NULL) return 0;
8854 mp_right_type(q) = mp_endpoint;
8855 set_number_from_double(q->right_tension, 1.0);
8856 mp_left_type(first) = mp_endpoint;
8857 set_number_from_double(first->left_tension, 1.0);
8861 mp_knot mp_create_knot (MP mp)
8863 mp_knot q = mp_new_knot(mp);
8864 mp_left_type(q) = mp_endpoint;
8865 mp_right_type(q) = mp_endpoint;
8869 int mp_set_knot (MP mp, mp_knot p, double x, double y)
8871 if (out_of_range(mp, x)) return 0;
8872 if (out_of_range(mp, y)) return 0;
8873 if (p==NULL) return 0;
8874 set_number_from_double(p->x_coord, x);
8875 set_number_from_double(p->y_coord, y);
8879 mp_knot mp_append_knot (MP mp, mp_knot p, double x, double y)
8881 mp_knot q = mp_create_knot(mp);
8882 if (q==NULL) return NULL;
8883 if (!mp_set_knot(mp, q, x, y)) {
8887 if (p == NULL) return q;
8888 if (!mp_link_knotpair(mp, p,q)) {
8895 int mp_set_knot_curl (MP mp, mp_knot q, double value) {
8896 if (q==NULL) return 0;
8897 if (TOO_LARGE(value)) return 0;
8898 mp_right_type(q)=mp_curl;
8899 set_number_from_double(q->right_curl, value);
8900 if (mp_left_type(q)==mp_open) {
8901 mp_left_type(q)=mp_curl;
8902 set_number_from_double(q->left_curl, value);
8907 int mp_set_knot_left_curl (MP mp, mp_knot q, double value) {
8908 if (q==NULL) return 0;
8909 if (TOO_LARGE(value)) return 0;
8910 mp_left_type(q)=mp_curl;
8911 set_number_from_double(q->left_curl, value);
8912 if (mp_right_type(q)==mp_open) {
8913 mp_right_type(q)=mp_curl;
8914 set_number_from_double(q->right_curl, value);
8919 int mp_set_knot_right_curl (MP mp, mp_knot q, double value) {
8920 if (q==NULL) return 0;
8921 if (TOO_LARGE(value)) return 0;
8922 mp_right_type(q)=mp_curl;
8923 set_number_from_double(q->right_curl, value);
8924 if (mp_left_type(q)==mp_open) {
8925 mp_left_type(q)=mp_curl;
8926 set_number_from_double(q->left_curl, value);
8931 int mp_set_knotpair_curls (MP mp, mp_knot p, mp_knot q, double t1, double t2) {
8932 if (p==NULL || q==NULL) return 0;
8933 if (mp_set_knot_curl(mp, p, t1))
8934 return mp_set_knot_curl(mp, q, t2);
8938 int mp_set_knotpair_tensions (MP mp, mp_knot p, mp_knot q, double t1, double t2) {
8939 if (p==NULL || q==NULL) return 0;
8940 if (TOO_LARGE(t1)) return 0;
8941 if (TOO_LARGE(t2)) return 0;
8942 if ((fabs(t1)<0.75)) return 0;
8943 if ((fabs(t2)<0.75)) return 0;
8944 set_number_from_double(p->right_tension, t1);
8945 set_number_from_double(q->left_tension, t2);
8949 int mp_set_knot_left_tension (MP mp, mp_knot p, double t1) {
8950 if (p==NULL) return 0;
8951 if (TOO_LARGE(t1)) return 0;
8952 if ((fabs(t1)<0.75)) return 0;
8953 set_number_from_double(p->left_tension, t1);
8957 int mp_set_knot_right_tension (MP mp, mp_knot p, double t1) {
8958 if (p==NULL) return 0;
8959 if (TOO_LARGE(t1)) return 0;
8960 if ((fabs(t1)<0.75)) return 0;
8961 set_number_from_double(p->right_tension, t1);
8965 int mp_set_knotpair_controls (MP mp, mp_knot p, mp_knot q, double x1, double y1, double x2, double y2) {
8966 if (p==NULL || q==NULL) return 0;
8967 if (out_of_range(mp, x1)) return 0;
8968 if (out_of_range(mp, y1)) return 0;
8969 if (out_of_range(mp, x2)) return 0;
8970 if (out_of_range(mp, y2)) return 0;
8971 mp_right_type(p)=mp_explicit;
8972 set_number_from_double(p->right_x, x1);
8973 set_number_from_double(p->right_y, y1);
8974 mp_left_type(q)=mp_explicit;
8975 set_number_from_double(q->left_x, x2);
8976 set_number_from_double(q->left_y, y2);
8980 int mp_set_knot_left_control (MP mp, mp_knot p, double x1, double y1) {
8981 if (p==NULL) return 0;
8982 if (out_of_range(mp, x1)) return 0;
8983 if (out_of_range(mp, y1)) return 0;
8984 mp_left_type(p)=mp_explicit;
8985 set_number_from_double(p->left_x, x1);
8986 set_number_from_double(p->left_y, y1);
8990 int mp_set_knot_right_control (MP mp, mp_knot p, double x1, double y1) {
8991 if (p==NULL) return 0;
8992 if (out_of_range(mp, x1)) return 0;
8993 if (out_of_range(mp, y1)) return 0;
8994 mp_right_type(p)=mp_explicit;
8995 set_number_from_double(p->right_x, x1);
8996 set_number_from_double(p->right_y, y1);
9000 int mp_set_knot_direction (MP mp, mp_knot q, double x, double y) {
9002 if (q==NULL) return 0;
9003 if (TOO_LARGE(x)) return 0;
9004 if (TOO_LARGE(y)) return 0;
9005 if (!(x==0 && y == 0))
9006 value = atan2 (y, x) * (180.0 / PI) * 16.0;
9007 mp_right_type(q)=mp_given;
9008 set_number_from_double(q->right_curl, value);
9009 if (mp_left_type(q)==mp_open) {
9010 mp_left_type(q)=mp_given;
9011 set_number_from_double(q->left_curl, value);
9016 int mp_set_knotpair_directions (MP mp, mp_knot p, mp_knot q, double x1, double y1, double x2, double y2) {
9017 if (p==NULL || q==NULL) return 0;
9018 if (mp_set_knot_direction(mp,p, x1, y1))
9019 return mp_set_knot_direction(mp,q, x2, y2);
9025 static int path_needs_fixing (mp_knot source);
9026 static int path_needs_fixing (mp_knot source) {
9027 mp_knot sourcehead = source;
9029 source = source->next;
9030 } while (source && source != sourcehead);
9037 int mp_solve_path (MP mp, mp_knot first)
9039 int saved_arith_error = mp->arith_error;
9040 jmp_buf *saved_jump_buf = mp->jump_buf;
9042 if (first==NULL) return 0;
9043 if (path_needs_fixing(first)) return 0;
9044 mp->jump_buf = malloc(sizeof(jmp_buf));
9045 if (mp->jump_buf == NULL || setjmp(*(mp->jump_buf)) != 0) {
9048 mp->arith_error = 0;
9049 mp_make_choices(mp, first);
9050 if (mp->arith_error)
9052 mp->arith_error = saved_arith_error;
9054 mp->jump_buf = saved_jump_buf;
9058 void mp_free_path (MP mp, mp_knot p) {
9059 mp_toss_knot_list(mp, p);
9062 @ @<Exported function headers@>=
9063 int mp_close_path_cycle (MP mp, mp_knot p, mp_knot q);
9064 int mp_close_path (MP mp, mp_knot q, mp_knot first);
9065 mp_knot mp_create_knot (MP mp);
9066 int mp_set_knot (MP mp, mp_knot p, double x, double y);
9067 mp_knot mp_append_knot (MP mp, mp_knot p, double x, double y);
9068 int mp_set_knot_curl (MP mp, mp_knot q, double value);
9069 int mp_set_knot_left_curl (MP mp, mp_knot q, double value);
9070 int mp_set_knot_right_curl (MP mp, mp_knot q, double value);
9071 int mp_set_knotpair_curls (MP mp, mp_knot p, mp_knot q, double t1, double t2) ;
9072 int mp_set_knotpair_tensions (MP mp, mp_knot p, mp_knot q, double t1, double t2) ;
9073 int mp_set_knot_left_tension (MP mp, mp_knot p, double t1);
9074 int mp_set_knot_right_tension (MP mp, mp_knot p, double t1);
9075 int mp_set_knot_left_control (MP mp, mp_knot p, double t1, double t2);
9076 int mp_set_knot_right_control (MP mp, mp_knot p, double t1, double t2);
9077 int mp_set_knotpair_controls (MP mp, mp_knot p, mp_knot q, double x1, double y1, double x2, double y2) ;
9078 int mp_set_knot_direction (MP mp, mp_knot q, double x, double y) ;
9079 int mp_set_knotpair_directions (MP mp, mp_knot p, mp_knot q, double x1, double y1, double x2, double y2) ;
9080 int mp_solve_path (MP mp, mp_knot first);
9081 void mp_free_path (MP mp, mp_knot p);
9083 @ Simple accessors for |mp_knot|.
9086 mp_number mp_knot_x_coord(MP mp, mp_knot p) { return p->x_coord; }
9087 mp_number mp_knot_y_coord(MP mp, mp_knot p) { return p->y_coord; }
9088 mp_number mp_knot_left_x (MP mp, mp_knot p) { return p->left_x; }
9089 mp_number mp_knot_left_y (MP mp, mp_knot p) { return p->left_y; }
9090 mp_number mp_knot_right_x(MP mp, mp_knot p) { return p->right_x; }
9091 mp_number mp_knot_right_y(MP mp, mp_knot p) { return p->right_y; }
9092 int mp_knot_right_type(MP mp, mp_knot p) { return mp_right_type(p);}
9093 int mp_knot_left_type (MP mp, mp_knot p) { return mp_left_type(p);}
9094 mp_knot mp_knot_next (MP mp, mp_knot p) { return p->next; }
9095 double mp_number_as_double(MP mp, mp_number n) {
9096 return number_to_double(n);
9099 @ @<Exported function headers@>=
9100 #define mp_knot_left_curl mp_knot_left_x
9101 #define mp_knot_left_given mp_knot_left_x
9102 #define mp_knot_left_tension mp_knot_left_y
9103 #define mp_knot_right_curl mp_knot_right_x
9104 #define mp_knot_right_given mp_knot_right_x
9105 #define mp_knot_right_tension mp_knot_right_y
9106 mp_number mp_knot_x_coord(MP mp, mp_knot p);
9107 mp_number mp_knot_y_coord(MP mp, mp_knot p);
9108 mp_number mp_knot_left_x(MP mp, mp_knot p);
9109 mp_number mp_knot_left_y(MP mp, mp_knot p);
9110 mp_number mp_knot_right_x(MP mp, mp_knot p);
9111 mp_number mp_knot_right_y(MP mp, mp_knot p);
9112 int mp_knot_right_type(MP mp, mp_knot p);
9113 int mp_knot_left_type(MP mp, mp_knot p);
9114 mp_knot mp_knot_next(MP mp, mp_knot p);
9115 double mp_number_as_double(MP mp, mp_number n);
9119 \MP's \&{llcorner}, \&{lrcorner}, \&{ulcorner}, and \&{urcorner} operators
9120 allow the user to measure the bounding box of anything that can go into a
9121 picture. It's easy to get rough bounds on the $x$ and $y$ extent of a path
9122 by just finding the bounding box of the knots and the control points. We
9123 need a more accurate version of the bounding box, but we can still use the
9124 easy estimate to save time by focusing on the interesting parts of the path.
9126 @ Computing an accurate bounding box involves a theme that will come up again
9127 and again. Given a Bernshte{\u\i}n polynomial
9128 @^Bernshte{\u\i}n, Serge{\u\i} Natanovich@>
9129 $$B(z_0,z_1,\ldots,z_n;t)=\sum_k{n\choose k}t^k(1-t)^{n-k}z_k,$$
9130 we can conveniently bisect its range as follows:
9133 \textindent{1)} Let $z_k^{(0)}=z_k$, for |0<=k<=n|.
9136 \textindent{2)} Let $z_k^{(j+1)}={1\over2}(z_k^{(j)}+z\k^{(j)})$, for
9137 |0<=k<n-j|, for |0<=j<n|.
9141 $$B(z_0,z_1,\ldots,z_n;t)=B(z_0^{(0)},z_0^{(1)},\ldots,z_0^{(n)};2t)
9142 =B(z_0^{(n)},z_1^{(n-1)},\ldots,z_n^{(0)};2t-1).$$
9143 This formula gives us the coefficients of polynomials to use over the ranges
9144 $0\L t\L{1\over2}$ and ${1\over2}\L t\L1$.
9146 @ Here is a routine that computes the $x$ or $y$ coordinate of the point on
9147 a cubic corresponding to the |fraction| value~|t|.
9150 static void mp_eval_cubic (MP mp, mp_number *r, mp_knot p, mp_knot q, quarterword c,
9152 mp_number x1, x2, x3; /* intermediate values */
9156 if (c == mp_x_code) {
9157 set_number_from_of_the_way(x1, t, p->x_coord, p->right_x);
9158 set_number_from_of_the_way(x2, t, p->right_x, q->left_x);
9159 set_number_from_of_the_way(x3, t, q->left_x, q->x_coord);
9161 set_number_from_of_the_way(x1, t, p->y_coord, p->right_y);
9162 set_number_from_of_the_way(x2, t, p->right_y, q->left_y);
9163 set_number_from_of_the_way(x3, t, q->left_y, q->y_coord);
9165 set_number_from_of_the_way(x1, t, x1, x2);
9166 set_number_from_of_the_way(x2, t, x2, x3);
9167 set_number_from_of_the_way(*r, t, x1, x2);
9174 @ The actual bounding box information is stored in global variables.
9175 Since it is convenient to address the $x$ and $y$ information
9176 separately, we define arrays indexed by |x_code..y_code| and use
9177 macros to give them more convenient names.
9181 mp_x_code = 0, /* index for |minx| and |maxx| */
9182 mp_y_code /* index for |miny| and |maxy| */
9186 @d mp_minx mp->bbmin[mp_x_code]
9187 @d mp_maxx mp->bbmax[mp_x_code]
9188 @d mp_miny mp->bbmin[mp_y_code]
9189 @d mp_maxy mp->bbmax[mp_y_code]
9192 mp_number bbmin[mp_y_code + 1];
9193 mp_number bbmax[mp_y_code + 1];
9194 /* the result of procedures that compute bounding box information */
9196 @ @<Initialize table ...@>=
9199 for (i=0;i<=mp_y_code;i++) {
9200 new_number(mp->bbmin[i]);
9201 new_number(mp->bbmax[i]);
9208 for (i=0;i<=mp_y_code;i++) {
9209 free_number(mp->bbmin[i]);
9210 free_number(mp->bbmax[i]);
9215 @ Now we're ready for the key part of the bounding box computation.
9216 The |bound_cubic| procedure updates |bbmin[c]| and |bbmax[c]| based on
9217 $$B(\hbox{|knot_coord(p)|}, \hbox{|right_coord(p)|},
9218 \hbox{|left_coord(q)|}, \hbox{|knot_coord(q)|};t)
9220 for $0<t\le1$. In other words, the procedure adjusts the bounds to
9221 accommodate |knot_coord(q)| and any extremes over the range $0<t<1$.
9222 The |c| parameter is |x_code| or |y_code|.
9225 static void mp_bound_cubic (MP mp, mp_knot p, mp_knot q, quarterword c) {
9226 boolean wavy; /* whether we need to look for extremes */
9227 mp_number del1, del2, del3, del, dmax; /* proportional to the control
9228 points of a quadratic derived from a cubic */
9229 mp_number t, tt; /* where a quadratic crosses zero */
9230 mp_number x; /* a value that |bbmin[c]| and |bbmax[c]| must accommodate */
9234 if (c == mp_x_code) {
9235 number_clone(x, q->x_coord);
9237 number_clone(x, q->y_coord);
9244 @<Adjust |bbmin[c]| and |bbmax[c]| to accommodate |x|@>;
9245 @<Check the control points against the bounding box and set |wavy:=true|
9246 if any of them lie outside@>;
9248 if (c == mp_x_code) {
9249 set_number_from_substraction(del1, p->right_x, p->x_coord);
9250 set_number_from_substraction(del2, q->left_x, p->right_x);
9251 set_number_from_substraction(del3, q->x_coord, q->left_x);
9253 set_number_from_substraction(del1, p->right_y, p->y_coord);
9254 set_number_from_substraction(del2, q->left_y, p->right_y);
9255 set_number_from_substraction(del3, q->y_coord, q->left_y);
9257 @<Scale up |del1|, |del2|, and |del3| for greater accuracy;
9258 also set |del| to the first nonzero element of |(del1,del2,del3)|@>;
9259 if (number_negative(del)) {
9260 number_negate (del1);
9261 number_negate (del2);
9262 number_negate (del3);
9264 crossing_point (t, del1, del2, del3);
9265 if (number_less(t, fraction_one_t)) {
9266 @<Test the extremes of the cubic against the bounding box@>;
9280 @ @<Adjust |bbmin[c]| and |bbmax[c]| to accommodate |x|@>=
9281 if (number_less(x, mp->bbmin[c]))
9282 number_clone(mp->bbmin[c], x);
9283 if (number_greater(x, mp->bbmax[c]))
9284 number_clone(mp->bbmax[c], x)
9286 @ @<Check the control points against the bounding box and set...@>=
9288 if (c == mp_x_code) {
9289 if (number_lessequal(mp->bbmin[c], p->right_x))
9290 if (number_lessequal (p->right_x, mp->bbmax[c]))
9291 if (number_lessequal(mp->bbmin[c], q->left_x))
9292 if (number_lessequal (q->left_x, mp->bbmax[c]))
9295 if (number_lessequal(mp->bbmin[c], p->right_y))
9296 if (number_lessequal (p->right_y, mp->bbmax[c]))
9297 if (number_lessequal(mp->bbmin[c], q->left_y))
9298 if (number_lessequal (q->left_y, mp->bbmax[c]))
9303 @ If |del1=del2=del3=0|, it's impossible to obey the title of this
9304 section. We just set |del=0| in that case.
9306 @<Scale up |del1|, |del2|, and |del3| for greater accuracy...@>=
9307 if (number_nonzero(del1)) {
9308 number_clone (del, del1);
9309 } else if (number_nonzero(del2)) {
9310 number_clone (del, del2);
9312 number_clone (del, del3);
9314 if (number_nonzero(del)) {
9316 new_number(absval1);
9317 number_clone (dmax, del1);
9319 number_clone (absval1, del2);
9320 number_abs(absval1);
9321 if (number_greater(absval1, dmax)) {
9322 number_clone(dmax, absval1);
9324 number_clone (absval1, del3);
9325 number_abs(absval1);
9326 if (number_greater(absval1, dmax)) {
9327 number_clone(dmax, absval1);
9329 while (number_less(dmax, fraction_half_t)) {
9330 number_double(dmax);
9331 number_double(del1);
9332 number_double(del2);
9333 number_double(del3);
9335 free_number (absval1);
9338 @ Since |crossing_point| has tried to choose |t| so that
9339 $B(|del1|,|del2|,|del3|;\tau)$ crosses zero at $\tau=|t|$ with negative
9340 slope, the value of |del2| computed below should not be positive.
9341 But rounding error could make it slightly positive in which case we
9342 must cut it to zero to avoid confusion.
9344 @<Test the extremes of the cubic against the bounding box@>=
9346 mp_eval_cubic (mp, &x, p, q, c, t);
9347 @<Adjust |bbmin[c]| and |bbmax[c]| to accommodate |x|@>;
9348 set_number_from_of_the_way(del2, t, del2, del3);
9349 /* now |0,del2,del3| represent the derivative on the remaining interval */
9350 if (number_positive(del2))
9351 set_number_to_zero(del2);
9353 mp_number arg2, arg3;
9356 number_clone(arg2, del2);
9357 number_negate(arg2);
9358 number_clone(arg3, del3);
9359 number_negate(arg3);
9360 crossing_point (tt, zero_t, arg2, arg3);
9364 if (number_less(tt, fraction_one_t)) {
9365 @<Test the second extreme against the bounding box@>;
9370 @ @<Test the second extreme against the bounding box@>=
9374 set_number_from_of_the_way (arg, t, tt, fraction_one_t);
9375 mp_eval_cubic (mp, &x, p, q, c, arg);
9377 @<Adjust |bbmin[c]| and |bbmax[c]| to accommodate |x|@>;
9381 @ Finding the bounding box of a path is basically a matter of applying
9382 |bound_cubic| twice for each pair of adjacent knots.
9385 static void mp_path_bbox (MP mp, mp_knot h) {
9386 mp_knot p, q; /* a pair of adjacent knots */
9387 number_clone(mp_minx, h->x_coord);
9388 number_clone(mp_miny, h->y_coord);
9389 number_clone (mp_maxx, mp_minx);
9390 number_clone (mp_maxy, mp_miny);
9393 if (mp_right_type (p) == mp_endpoint)
9395 q = mp_next_knot (p);
9396 mp_bound_cubic (mp, p, q, mp_x_code);
9397 mp_bound_cubic (mp, p, q, mp_y_code);
9403 @ Another important way to measure a path is to find its arc length. This
9404 is best done by using the general bisection algorithm to subdivide the path
9405 until obtaining ``well behaved'' subpaths whose arc lengths can be approximated
9408 Since the arc length is the integral with respect to time of the magnitude of
9409 the velocity, it is natural to use Simpson's rule for the approximation.
9411 If $\dot B(t)$ is the spline velocity, Simpson's rule gives
9412 $$ \vb\dot B(0)\vb + 4\vb\dot B({1\over2})\vb + \vb\dot B(1)\vb \over 6 $$
9413 for the arc length of a path of length~1. For a cubic spline
9414 $B(z_0,z_1,z_2,z_3;t)$, the time derivative $\dot B(t)$ is
9415 $3B(dz_0,dz_1,dz_2;t)$, where $dz_i=z_{i+1}-z_i$. Hence the arc length
9417 $$ {\vb dz_0\vb \over 2} + 2\vb dz_{02}\vb + {\vb dz_2\vb \over 2}, $$
9419 $$ dz_{02}={1\over2}\left({dz_0+dz_1\over 2}+{dz_1+dz_2\over 2}\right)$$
9420 is the result of the bisection algorithm.
9422 @ The remaining problem is how to decide when a subpath is ``well behaved.''
9423 This could be done via the theoretical error bound for Simpson's rule,
9425 but this is impractical because it requires an estimate of the fourth
9426 derivative of the quantity being integrated. It is much easier to just perform
9427 a bisection step and see how much the arc length estimate changes. Since the
9428 error for Simpson's rule is proportional to the fourth power of the sample
9429 spacing, the remaining error is typically about $1\over16$ of the amount of
9430 the change. We say ``typically'' because the error has a pseudo-random behavior
9431 that could cause the two estimates to agree when each contain large errors.
9433 To protect against disasters such as undetected cusps, the bisection process
9434 should always continue until all the $dz_i$ vectors belong to a single
9435 $90^\circ$ sector. This ensures that no point on the spline can have velocity
9436 less than 70\% of the minimum of $\vb dz_0\vb$, $\vb dz_1\vb$ and $\vb dz_2\vb$.
9437 If such a spline happens to produce an erroneous arc length estimate that
9438 is little changed by bisection, the amount of the error is likely to be fairly
9439 small. We will try to arrange things so that freak accidents of this type do
9440 not destroy the inverse relationship between the \&{arclength} and
9441 \&{arctime} operations.
9442 @:arclength_}{\&{arclength} primitive@>
9443 @:arctime_}{\&{arctime} primitive@>
9445 @ The \&{arclength} and \&{arctime} operations are both based on a recursive
9447 function that finds the arc length of a cubic spline given $dz_0$, $dz_1$,
9448 $dz_2$. This |arc_test| routine also takes an arc length goal |a_goal| and
9449 returns the time when the arc length reaches |a_goal| if there is such a time.
9450 Thus the return value is either an arc length less than |a_goal| or, if the
9451 arc length would be at least |a_goal|, it returns a time value decreased by
9452 |two|. This allows the caller to use the sign of the result to distinguish
9453 between arc lengths and time values. On certain types of overflow, it is
9454 possible for |a_goal| and the result of |arc_test| both to be |EL_GORDO|.
9455 Otherwise, the result is always less than |a_goal|.
9457 Rather than halving the control point coordinates on each recursive call to
9458 |arc_test|, it is better to keep them proportional to velocity on the original
9459 curve and halve the results instead. This means that recursive calls can
9460 potentially use larger error tolerances in their arc length estimates. How
9461 much larger depends on to what extent the errors behave as though they are
9462 independent of each other. To save computing time, we use optimistic assumptions
9463 and increase the tolerance by a factor of about $\sqrt2$ for each recursive
9466 In addition to the tolerance parameter, |arc_test| should also have parameters
9467 for ${1\over3}\vb\dot B(0)\vb$, ${2\over3}\vb\dot B({1\over2})\vb$, and
9468 ${1\over3}\vb\dot B(1)\vb$. These quantities are relatively expensive to compute
9469 and they are needed in different instances of |arc_test|.
9472 static void mp_arc_test (MP mp, mp_number *ret, mp_number dx0, mp_number dy0, mp_number dx1,
9473 mp_number dy1, mp_number dx2, mp_number dy2, mp_number v0,
9474 mp_number v02, mp_number v2, mp_number a_goal, mp_number tol_orig) {
9475 boolean simple; /* are the control points confined to a $90^\circ$ sector? */
9476 mp_number dx01, dy01, dx12, dy12, dx02, dy02; /* bisection results */
9477 mp_number v002, v022; /* twice the velocity magnitudes at $t={1\over4}$ and $t={3\over4}$ */
9478 mp_number arc; /* best arc length estimate before recursion */
9479 mp_number arc1; /* arc length estimate for the first half */
9492 new_number (simply);
9494 number_clone(tol, tol_orig);
9495 @<Bisect the B\'ezier quadratic given by |dx0|, |dy0|, |dx1|, |dy1|,
9497 @<Initialize |v002|, |v022|, and the arc length estimate |arc|; if it overflows
9498 set |arc_test| and |return|@>;
9499 @<Test if the control points are confined to one quadrant or rotating them
9500 $45^\circ$ would put them in one quadrant. Then set |simple| appropriately@>;
9502 set_number_from_addition(simply, v0, v2);
9503 number_halfp (simply);
9504 number_negate (simply);
9505 number_add (simply, arc);
9506 number_substract (simply, v02);
9507 number_abs (simply);
9509 if (simple && number_lessequal(simply, tol)) {
9510 if (number_less(arc, a_goal)){
9511 number_clone(*ret, arc);
9513 @<Estimate when the arc length reaches |a_goal| and set |arc_test| to
9514 that time minus |two|@>;
9517 @<Use one or two recursive calls to compute the |arc_test| function@>;
9530 free_number (simply);
9535 @ The |tol| value should by multiplied by $\sqrt 2$ before making recursive
9536 calls, but $1.5$ is an adequate approximation. It is best to avoid using
9537 |make_fraction| in this inner loop.
9540 @<Use one or two recursive calls to compute the |arc_test| function@>=
9542 mp_number a_new, a_aux; /* the sum of these gives the |a_goal| */
9543 mp_number a, b; /* results of recursive calls */
9544 mp_number half_v02; /* |halfp(v02)|, a recursion argument */
9547 new_number(half_v02);
9548 @<Set |a_new| and |a_aux| so their sum is |2*a_goal| and |a_new| is as
9549 large as possible@>;
9551 mp_number halfp_tol;
9552 new_number(halfp_tol);
9553 number_clone (halfp_tol, tol);
9554 number_halfp (halfp_tol);
9555 number_add(tol, halfp_tol);
9556 free_number (halfp_tol);
9558 number_clone(half_v02, v02);
9559 number_halfp(half_v02);
9561 mp_arc_test (mp, &a, dx0, dy0, dx01, dy01, dx02, dy02,
9562 v0, v002, half_v02, a_new, tol);
9563 if (number_negative(a)) {
9564 set_number_to_unity(*ret);
9565 number_double(*ret); /* two */
9566 number_substract(*ret, a); /* two - a */
9568 number_negate(*ret); /* -halfp(two - a) */
9570 @<Update |a_new| to reduce |a_new+a_aux| by |a|@>;
9572 mp_arc_test (mp, &b, dx02, dy02, dx12, dy12, dx2, dy2,
9573 half_v02, v022, v2, a_new, tol);
9574 if (number_negative(b)) {
9577 number_clone(tmp, b);
9581 number_clone(*ret, tmp);
9582 set_number_to_unity(tmp);
9584 number_substract(*ret, tmp); /* (-(halfp(-b)) - 1/2) */
9587 set_number_from_substraction(*ret, b, a);
9589 set_number_from_addition(*ret, a, *ret); /* (a + half(b - a)) */
9593 free_number (half_v02);
9594 free_number (a_aux);
9595 free_number (a_new);
9601 @ @<Set |a_new| and |a_aux| so their sum is |2*a_goal| and |a_new| is...@>=
9602 set_number_to_inf(a_aux);
9603 number_substract(a_aux, a_goal);
9604 if (number_greater(a_goal, a_aux)) {
9605 set_number_from_substraction(a_aux, a_goal, a_aux);
9606 set_number_to_inf(a_new);
9608 set_number_from_addition(a_new, a_goal, a_goal);
9609 set_number_to_zero(a_aux);
9613 @ There is no need to maintain |a_aux| at this point so we use it as a temporary
9614 to force the additions and subtractions to be done in an order that avoids
9617 @<Update |a_new| to reduce |a_new+a_aux| by |a|@>=
9618 if (number_greater(a, a_aux)) {
9619 number_substract(a_aux, a);
9620 number_add(a_new, a_aux);
9623 @ This code assumes all {\it dx} and {\it dy} variables have magnitude less than
9624 |fraction_four|. To simplify the rest of the |arc_test| routine, we strengthen
9625 this assumption by requiring the norm of each $({\it dx},{\it dy})$ pair to obey
9626 this bound. Note that recursive calls will maintain this invariant.
9628 @<Bisect the B\'ezier quadratic given by |dx0|, |dy0|, |dx1|, |dy1|,...@>=
9629 set_number_from_addition(dx01, dx0, dx1);
9631 set_number_from_addition(dx12, dx1, dx2);
9633 set_number_from_addition(dx02, dx01, dx12);
9635 set_number_from_addition(dy01, dy0, dy1);
9637 set_number_from_addition(dy12, dy1, dy2);
9639 set_number_from_addition(dy02, dy01, dy12);
9642 @ We should be careful to keep |arc<EL_GORDO| so that calling |arc_test| with
9643 |a_goal=EL_GORDO| is guaranteed to yield the arc length.
9645 @<Initialize |v002|, |v022|, and the arc length estimate |arc|;...@>=
9647 mp_number tmp, arg1, arg2 ;
9651 set_number_from_addition(arg1, dx0, dx02);
9653 number_add(arg1, dx01);
9654 set_number_from_addition(arg2, dy0, dy02);
9656 number_add(arg2, dy01);
9657 pyth_add (v002, arg1, arg2);
9659 set_number_from_addition(arg1, dx02, dx2);
9661 number_add(arg1, dx12);
9662 set_number_from_addition(arg2, dy02, dy2);
9664 number_add(arg2, dy12);
9665 pyth_add (v022, arg1, arg2);
9669 number_clone (tmp, v02);
9670 number_add_scaled (tmp, 2);
9673 set_number_from_addition(arc1, v0, tmp);
9674 number_halfp (arc1);
9675 number_substract (arc1, v002);
9677 set_number_from_addition(arc1, v002, arc1);
9679 set_number_from_addition(arc, v2, tmp);
9681 number_substract (arc, v022);
9683 set_number_from_addition(arc, v022, arc);
9685 /* reuse |tmp| for the next |if| test: */
9686 set_number_to_inf(tmp);
9687 number_substract(tmp,arc1);
9688 if (number_less(arc, tmp)) {
9690 number_add(arc, arc1);
9693 mp->arith_error = true;
9694 if (number_infinite(a_goal)) {
9695 set_number_to_inf(*ret);
9697 set_number_to_unity(*ret);
9698 number_double(*ret);
9699 number_negate(*ret); /* -two */
9706 @ @<Test if the control points are confined to one quadrant or rotating...@>=
9707 simple = ((number_nonnegative(dx0) && number_nonnegative(dx1) && number_nonnegative(dx2)) ||
9708 (number_nonpositive(dx0) && number_nonpositive(dx1) && number_nonpositive(dx2)));
9710 simple = (number_nonnegative(dy0) && number_nonnegative(dy1) && number_nonnegative(dy2)) ||
9711 (number_nonpositive(dy0) && number_nonpositive(dy1) && number_nonpositive(dy2));
9714 simple = (number_greaterequal(dx0, dy0) && number_greaterequal(dx1, dy1) && number_greaterequal(dx2, dy2)) ||
9715 (number_lessequal(dx0, dy0) && number_lessequal(dx1, dy1) && number_lessequal(dx2, dy2));
9717 mp_number neg_dx0, neg_dx1, neg_dx2;
9718 new_number(neg_dx0);
9719 new_number(neg_dx1);
9720 new_number(neg_dx2);
9721 number_clone(neg_dx0, dx0);
9722 number_clone(neg_dx1, dx1);
9723 number_clone(neg_dx2, dx2);
9724 number_negate(neg_dx0);
9725 number_negate(neg_dx1);
9726 number_negate(neg_dx2);
9728 (number_greaterequal(neg_dx0, dy0) && number_greaterequal(neg_dx1, dy1) && number_greaterequal(neg_dx2, dy2)) ||
9729 (number_lessequal(neg_dx0, dy0) && number_lessequal(neg_dx1, dy1) && number_lessequal(neg_dx2, dy2));
9730 free_number (neg_dx0);
9731 free_number (neg_dx1);
9732 free_number (neg_dx2);
9736 @ Since Simpson's rule is based on approximating the integrand by a parabola,
9738 it is appropriate to use the same approximation to decide when the integral
9739 reaches the intermediate value |a_goal|. At this point
9741 {\vb\dot B(0)\vb\over 3} &= \hbox{|v0|}, \qquad
9742 {\vb\dot B({1\over4})\vb\over 3} = {\hbox{|v002|}\over 2}, \qquad
9743 {\vb\dot B({1\over2})\vb\over 3} = {\hbox{|v02|}\over 2}, \cr
9744 {\vb\dot B({3\over4})\vb\over 3} &= {\hbox{|v022|}\over 2}, \qquad
9745 {\vb\dot B(1)\vb\over 3} = \hbox{|v2|} \cr
9749 $$ {\vb\dot B(t)\vb\over 3} \approx
9750 \cases{B\left(\hbox{|v0|},
9751 \hbox{|v002|}-{1\over 2}\hbox{|v0|}-{1\over 4}\hbox{|v02|},
9752 {1\over 2}\hbox{|v02|}; 2t \right)&
9753 if $t\le{1\over 2}$\cr
9754 B\left({1\over 2}\hbox{|v02|},
9755 \hbox{|v022|}-{1\over 4}\hbox{|v02|}-{1\over 2}\hbox{|v2|},
9756 \hbox{|v2|}; 2t-1 \right)&
9757 if $t\ge{1\over 2}$.\cr}
9760 We can integrate $\vb\dot B(t)\vb$ by using
9761 $$\int 3B(a,b,c;\tau)\,dt =
9762 {B(0,a,a+b,a+b+c;\tau) + {\rm constant} \over {d\tau\over dt}}.
9765 This construction allows us to find the time when the arc length reaches
9766 |a_goal| by solving a cubic equation of the form
9767 $$ B(0,a,a+b,a+b+c;\tau) = x, $$
9768 where $\tau$ is $2t$ or $2t+1$, $x$ is |a_goal| or |a_goal-arc1|, and $a$, $b$,
9769 and $c$ are the Bernshte{\u\i}n coefficients from $(*)$ divided by
9770 @^Bernshte{\u\i}n, Serge{\u\i} Natanovich@>
9771 $d\tau\over dt$. We shall define a function |solve_rising_cubic| that finds
9772 $\tau$ given $a$, $b$, $c$, and $x$.
9774 @<Estimate when the arc length reaches |a_goal| and set |arc_test| to...@>=
9786 number_clone(tmp, v02);
9787 number_add_scaled(tmp, 2);
9789 number_half(tmp); /* (v02+2) / 4 */
9790 if (number_lessequal(a_goal, arc1)) {
9791 number_clone(tmp2, v0);
9793 set_number_from_substraction(tmp3, arc1, tmp2);
9794 number_substract(tmp3, tmp);
9795 mp_solve_rising_cubic (mp, &tmp5, tmp2, tmp3, tmp, a_goal);
9796 number_halfp (tmp5);
9797 set_number_to_unity(tmp3);
9798 number_substract(tmp5, tmp3);
9799 number_substract(tmp5, tmp3);
9800 number_clone(*ret, tmp5);
9802 number_clone(tmp2, v2);
9804 set_number_from_substraction(tmp3, arc, arc1);
9805 number_substract(tmp3, tmp);
9806 number_substract(tmp3, tmp2);
9807 set_number_from_substraction(tmp4, a_goal, arc1);
9808 mp_solve_rising_cubic (mp, &tmp5, tmp, tmp3, tmp2, tmp4);
9810 set_number_to_unity(tmp2);
9811 set_number_to_unity(tmp3);
9813 number_substract(tmp2, tmp3);
9814 number_substract(tmp2, tmp3);
9815 set_number_from_addition(*ret, tmp2, tmp5);
9826 @ Here is the |solve_rising_cubic| routine that finds the time~$t$ when
9827 $$ B(0, a, a+b, a+b+c; t) = x. $$
9828 This routine is based on |crossing_point| but is simplified by the
9829 assumptions that $B(a,b,c;t)\ge0$ for $0\le t\le1$ and that |0<=x<=a+b+c|.
9830 If rounding error causes this condition to be violated slightly, we just ignore
9831 it and proceed with binary search. This finds a time when the function value
9832 reaches |x| and the slope is positive.
9835 static void mp_solve_rising_cubic (MP mp, mp_number *ret, mp_number a, mp_number b, mp_number c, mp_number x);
9838 void mp_solve_rising_cubic (MP mp, mp_number *ret, mp_number a_orig, mp_number b_orig, mp_number c_orig, mp_number x_orig) {
9840 mp_number a, b, c, x; /* local versions of arguments */
9841 mp_number ab, bc, ac; /* bisection results */
9842 mp_number t; /* $2^k+q$ where unscaled answer is in $[q2^{-k},(q+1)2^{-k})$ */
9843 mp_number xx; /* temporary for updating |x| */
9844 mp_number neg_x; /* temporary for an |if| */
9845 if (number_negative(a_orig) || number_negative(c_orig))
9846 mp_confusion (mp, "rising?
");
9847 @:this can't happen rising?}{\quad rising?@>;
9854 number_clone(a, a_orig);
9855 number_clone(b, b_orig);
9856 number_clone(c, c_orig);
9857 number_clone(x, x_orig);
9863 set_number_from_addition(abc, a, b);
9865 if (number_nonpositive(x)) {
9866 set_number_to_zero(*ret);
9867 } else if (number_greaterequal(x, abc)) {
9868 set_number_to_unity(*ret);
9870 number_clone (t, epsilon_t);
9871 @<Rescale if necessary to make sure |a|, |b|, and |c| are all less than
9875 @<Subdivide the B\'ezier quadratic defined by |a|, |b|, |c|@>;
9877 number_substract(xx, a);
9878 number_substract(xx, ab);
9879 number_substract(xx, ac);
9880 number_clone(neg_x, x);
9881 number_negate(neg_x);
9882 if (number_less(xx, neg_x)) {
9884 number_clone(b, ab);
9885 number_clone(c, ac);
9888 number_clone(a, ac);
9889 number_clone(b, bc);
9890 number_add (t, epsilon_t);
9892 } while (number_less (t, unity_t));
9893 set_number_from_substraction(*ret, t, unity_t);
9905 free_number (neg_x);
9909 @ @<Subdivide the B\'ezier quadratic defined by |a|, |b|, |c|@>=
9910 set_number_from_addition(ab, a, b);
9912 set_number_from_addition(bc, b, c);
9914 set_number_from_addition(ac, ab, bc);
9917 @ The upper bound on |a|, |b|, and |c|:
9919 @d one_third_inf_t ((math_data *)mp->math)->one_third_inf_t
9921 @<Rescale if necessary to make sure |a|, |b|, and |c| are all less than...@>=
9922 while (number_greater(a, one_third_inf_t) ||
9923 number_greater(b, one_third_inf_t) ||
9924 number_greater(c, one_third_inf_t)) {
9932 @ It is convenient to have a simpler interface to |arc_test| that requires no
9933 unnecessary arguments and ensures that each $({\it dx},{\it dy})$ pair has
9934 length less than |fraction_four|.
9937 static void mp_do_arc_test (MP mp, mp_number *ret, mp_number dx0, mp_number dy0, mp_number dx1,
9938 mp_number dy1, mp_number dx2, mp_number dy2, mp_number a_goal) {
9939 mp_number v0, v1, v2; /* length of each $({\it dx},{\it dy})$ pair */
9940 mp_number v02; /* twice the norm of the quadratic at $t={1\over2}$ */
9944 pyth_add (v0, dx0, dy0);
9945 pyth_add (v1, dx1, dy1);
9946 pyth_add (v2, dx2, dy2);
9947 if ((number_greaterequal(v0, fraction_four_t)) ||
9948 (number_greaterequal(v1, fraction_four_t)) ||
9949 (number_greaterequal(v2, fraction_four_t))) {
9950 mp->arith_error = true;
9951 if (number_infinite(a_goal)) {
9952 set_number_to_inf(*ret);
9954 set_number_to_unity(*ret);
9955 number_double(*ret);
9956 number_negate(*ret);
9959 mp_number arg1, arg2;
9963 set_number_from_addition(arg1, dx0, dx2);
9965 number_add(arg1, dx1);
9966 set_number_from_addition(arg2, dy0, dy2);
9968 number_add(arg2, dy1);
9969 pyth_add (v02, arg1, arg2);
9972 mp_arc_test (mp, ret, dx0, dy0, dx1, dy1, dx2, dy2, v0, v02, v2, a_goal, arc_tol_k);
9981 @ Now it is easy to find the arc length of an entire path.
9984 static void mp_get_arc_length (MP mp, mp_number *ret, mp_knot h) {
9985 mp_knot p, q; /* for traversing the path */
9986 mp_number a; /* current arc length */
9987 mp_number a_tot; /* total arc length */
9988 mp_number arg1, arg2, arg3, arg4, arg5, arg6;
9999 new_number(arcgoal);
10000 set_number_to_inf(arcgoal);
10001 while (mp_right_type (p) != mp_endpoint) {
10002 q = mp_next_knot (p);
10003 set_number_from_substraction(arg1, p->right_x, p->x_coord);
10004 set_number_from_substraction(arg2, p->right_y, p->y_coord);
10005 set_number_from_substraction(arg3, q->left_x, p->right_x);
10006 set_number_from_substraction(arg4, q->left_y, p->right_y);
10007 set_number_from_substraction(arg5, q->x_coord, q->left_x);
10008 set_number_from_substraction(arg6, q->y_coord, q->left_y);
10009 mp_do_arc_test (mp, &a, arg1, arg2, arg3, arg4, arg5, arg6, arcgoal);
10010 slow_add (a_tot, a, a_tot);
10016 free_number (arcgoal);
10018 free_number (arg1);
10019 free_number (arg2);
10020 free_number (arg3);
10021 free_number (arg4);
10022 free_number (arg5);
10023 free_number (arg6);
10025 number_clone (*ret, a_tot);
10026 free_number (a_tot);
10030 @ The inverse operation of finding the time on a path~|h| when the arc length
10031 reaches some value |arc0| can also be accomplished via |do_arc_test|. Some care
10032 is required to handle very large times or negative times on cyclic paths. For
10033 non-cyclic paths, |arc0| values that are negative or too large cause
10034 |get_arc_time| to return 0 or the length of path~|h|.
10036 If |arc0| is greater than the arc length of a cyclic path~|h|, the result is a
10037 time value greater than the length of the path. Since it could be much greater,
10038 we must be prepared to compute the arc length of path~|h| and divide this into
10039 |arc0| to find how many multiples of the length of path~|h| to add.
10042 static void mp_get_arc_time (MP mp, mp_number *ret, mp_knot h, mp_number arc0_orig) {
10043 mp_knot p, q; /* for traversing the path */
10044 mp_number t_tot; /* accumulator for the result */
10045 mp_number t; /* the result of |do_arc_test| */
10046 mp_number arc, arc0; /* portion of |arc0| not used up so far */
10047 mp_number arg1, arg2, arg3, arg4, arg5, arg6; /* |do_arc_test| arguments */
10048 if (number_negative(arc0_orig)) {
10049 @<Deal with a negative |arc0_orig| value and |return|@>;
10051 new_number (t_tot);
10053 number_clone(arc0, arc0_orig);
10054 if (number_infinite(arc0)) {
10055 number_add_scaled (arc0, -1);
10058 number_clone(arc, arc0);
10067 while ((mp_right_type (p) != mp_endpoint) && number_positive(arc)) {
10068 q = mp_next_knot (p);
10069 set_number_from_substraction(arg1, p->right_x, p->x_coord);
10070 set_number_from_substraction(arg2, p->right_y, p->y_coord);
10071 set_number_from_substraction(arg3, q->left_x, p->right_x);
10072 set_number_from_substraction(arg4, q->left_y, p->right_y);
10073 set_number_from_substraction(arg5, q->x_coord, q->left_x);
10074 set_number_from_substraction(arg6, q->y_coord, q->left_y);
10075 mp_do_arc_test (mp, &t, arg1, arg2, arg3, arg4, arg5, arg6, arc);
10076 @<Update |arc| and |t_tot| after |do_arc_test| has just returned |t|@>;
10078 @<Update |t_tot| and |arc| to avoid going around the cyclic
10079 path too many times but set |arith_error:=true| and |goto done| on
10085 number_clone (*ret, t_tot);
10087 free_number (t_tot);
10090 free_number (arc0);
10091 free_number (arg1);
10092 free_number (arg2);
10093 free_number (arg3);
10094 free_number (arg4);
10095 free_number (arg5);
10096 free_number (arg6);
10100 @ @<Update |arc| and |t_tot| after |do_arc_test| has just returned |t|@>=
10101 if (number_negative(t)) {
10102 number_add (t_tot, t);
10103 number_add (t_tot, two_t);
10104 set_number_to_zero(arc);
10106 number_add (t_tot, unity_t);
10107 number_substract(arc, t);
10111 @ @<Deal with a negative |arc0_orig| value and |return|@>=
10113 if (mp_left_type (h) == mp_endpoint) {
10114 set_number_to_zero (*ret);
10116 mp_number neg_arc0;
10117 p = mp_htap_ypoc (mp, h);
10118 new_number(neg_arc0);
10119 number_clone(neg_arc0, arc0_orig);
10120 number_negate(neg_arc0);
10121 mp_get_arc_time (mp, ret, p, neg_arc0);
10122 number_negate(*ret);
10123 mp_toss_knot_list (mp, p);
10124 free_number (neg_arc0);
10131 @ @<Update |t_tot| and |arc| to avoid going around the cyclic...@>=
10132 if (number_positive(arc)) {
10133 mp_number n, n1, d1, v1;
10139 set_number_from_substraction (d1, arc0, arc); /* d1 = arc0 - arc */
10140 set_number_from_div (n1, arc, d1); /* n1 = (arc / d1) */
10141 number_clone (n, n1);
10142 set_number_from_mul (n1, n1, d1); /* n1 = (n1 * d1) */
10143 number_substract (arc, n1); /* arc = arc - n1 */
10145 number_clone (d1, inf_t); /* reuse d1 */
10146 number_clone (v1, n); /* v1 = n */
10147 number_add (v1, epsilon_t); /* v1 = n1+1 */
10148 set_number_from_div (d1, d1, v1); /* |d1 = EL_GORDO / v1| */
10149 if (number_greater (t_tot, d1)) {
10150 mp->arith_error = true;
10152 set_number_to_inf(*ret);
10159 set_number_from_mul (t_tot, t_tot, v1);
10166 @* Data structures for pens.
10167 A Pen in \MP\ can be either elliptical or polygonal. Elliptical pens result
10168 in \ps\ \&{stroke} commands, while anything drawn with a polygonal pen is
10169 @:stroke}{\&{stroke} command@>
10170 converted into an area fill as described in the next part of this program.
10171 The mathematics behind this process is based on simple aspects of the theory
10172 of tracings developed by Leo Guibas, Lyle Ramshaw, and Jorge Stolfi
10173 [``A kinematic framework for computational geometry,'' Proc.\ IEEE Symp.\
10174 Foundations of Computer Science {\bf 24} (1983), 100--111].
10176 Polygonal pens are created from paths via \MP's \&{makepen} primitive.
10177 @:makepen_}{\&{makepen} primitive@>
10178 This path representation is almost sufficient for our purposes except that
10179 a pen path should always be a convex polygon with the vertices in
10180 counter-clockwise order.
10181 Since we will need to scan pen polygons both forward and backward, a pen
10182 should be represented as a doubly linked ring of knot nodes. There is
10183 room for the extra back pointer because we do not need the
10184 |mp_left_type| or |mp_right_type| fields. In fact, we don't need the |left_x|,
10185 |left_y|, |right_x|, or |right_y| fields either but we leave these alone
10186 so that certain procedures can operate on both pens and paths. In particular,
10187 pens can be copied using |copy_path| and recycled using |toss_knot_list|.
10189 @ The |make_pen| procedure turns a path into a pen by initializing
10190 the |prev_knot| pointers and making sure the knots form a convex polygon.
10191 Thus each cubic in the given path becomes a straight line and the control
10192 points are ignored. If the path is not cyclic, the ends are connected by a
10195 @d copy_pen(A) mp_make_pen(mp, mp_copy_path(mp, (A)),false)
10198 static mp_knot mp_make_pen (MP mp, mp_knot h, boolean need_hull) {
10199 mp_knot p, q; /* two consecutive knots */
10203 q = mp_next_knot (q);
10204 mp_prev_knot (q) = p;
10207 h = mp_convex_hull (mp, h);
10208 @<Make sure |h| isn't confused with an elliptical pen@>;
10214 @ The only information required about an elliptical pen is the overall
10215 transformation that has been applied to the original \&{pencircle}.
10216 @:pencircle_}{\&{pencircle} primitive@>
10217 Since it suffices to keep track of how the three points $(0,0)$, $(1,0)$,
10218 and $(0,1)$ are transformed, an elliptical pen can be stored in a single
10219 knot node and transformed as if it were a path.
10221 @d pen_is_elliptical(A) ((A)==mp_next_knot((A)))
10224 static mp_knot mp_get_pen_circle (MP mp, mp_number diam) {
10225 mp_knot h; /* the knot node to return */
10226 h = mp_new_knot (mp);
10227 mp_next_knot (h) = h;
10228 mp_prev_knot (h) = h;
10229 mp_originator (h) = mp_program_code;
10230 set_number_to_zero(h->x_coord);
10231 set_number_to_zero(h->y_coord);
10232 number_clone(h->left_x, diam);
10233 set_number_to_zero(h->left_y);
10234 set_number_to_zero(h->right_x);
10235 number_clone(h->right_y, diam);
10240 @ If the polygon being returned by |make_pen| has only one vertex, it will
10241 be interpreted as an elliptical pen. This is no problem since a degenerate
10242 polygon can equally well be thought of as a degenerate ellipse. We need only
10243 initialize the |left_x|, |left_y|, |right_x|, and |right_y| fields.
10245 @<Make sure |h| isn't confused with an elliptical pen@>=
10246 if (pen_is_elliptical (h)) {
10247 number_clone(h->left_x, h->x_coord);
10248 number_clone(h->left_y, h->y_coord);
10249 number_clone(h->right_x, h->x_coord);
10250 number_clone(h->right_y, h->y_coord);
10253 @ Printing a polygonal pen is very much like printing a path
10256 static void mp_pr_pen (MP mp, mp_knot h);
10259 void mp_pr_pen (MP mp, mp_knot h) {
10260 mp_knot p, q; /* for list traversal */
10261 if (pen_is_elliptical (h)) {
10262 @<Print the elliptical pen |h|@>;
10266 mp_print_two (mp, p->x_coord, p->y_coord);
10267 mp_print_nl (mp, " ..
");
10268 @<Advance |p| making sure the links are OK and |return| if there is
10271 mp_print (mp, "cycle
");
10276 @ @<Advance |p| making sure the links are OK and |return| if there is...@>=
10277 q = mp_next_knot (p);
10278 if ((q == NULL) || (mp_prev_knot (q) != p)) {
10279 mp_print_nl (mp, "???
");
10280 return; /* this won't happen */
10285 @ @<Print the elliptical pen |h|@>=
10289 mp_print (mp, "pencircle transformed
(");
10290 print_number (h->x_coord);
10291 mp_print_char (mp, xord (','));
10292 print_number (h->y_coord);
10293 mp_print_char (mp, xord (','));
10294 set_number_from_substraction (v1, h->left_x, h->x_coord);
10296 mp_print_char (mp, xord (','));
10297 set_number_from_substraction (v1, h->right_x, h->x_coord);
10299 mp_print_char (mp, xord (','));
10300 set_number_from_substraction (v1, h->left_y, h->y_coord);
10302 mp_print_char (mp, xord (','));
10303 set_number_from_substraction (v1, h->right_y, h->y_coord);
10305 mp_print_char (mp, xord (')'));
10310 @ Here us another version of |pr_pen| that prints the pen as a diagnostic
10314 static void mp_print_pen (MP mp, mp_knot h, const char *s, boolean nuline);
10317 void mp_print_pen (MP mp, mp_knot h, const char *s, boolean nuline) {
10318 mp_print_diagnostic (mp, "Pen
", s, nuline);
10320 @.Pen at line...@>;
10322 mp_end_diagnostic (mp, true);
10326 @ Making a polygonal pen into a path involves restoring the |mp_left_type| and
10327 |mp_right_type| fields and setting the control points so as to make a polygonal
10331 static void mp_make_path (MP mp, mp_knot h) {
10332 mp_knot p; /* for traversing the knot list */
10333 quarterword k; /* a loop counter */
10334 @<Other local variables in |make_path|@>;
10335 FUNCTION_TRACE1 ("make_path
()\n
");
10336 if (pen_is_elliptical (h)) {
10337 FUNCTION_TRACE1 ("make_path
(elliptical
)\n
");
10338 @<Make the elliptical pen |h| into a path@>;
10342 mp_left_type (p) = mp_explicit;
10343 mp_right_type (p) = mp_explicit;
10344 @<copy the coordinates of knot |p| into its control points@>;
10345 p = mp_next_knot (p);
10351 @ @<copy the coordinates of knot |p| into its control points@>=
10352 number_clone (p->left_x, p->x_coord);
10353 number_clone (p->left_y, p->y_coord);
10354 number_clone (p->right_x, p->x_coord);
10355 number_clone (p->right_y, p->y_coord)
10358 @ We need an eight knot path to get a good approximation to an ellipse.
10360 @<Make the elliptical pen |h| into a path@>=
10362 mp_number center_x, center_y; /* translation parameters for an elliptical pen */
10363 mp_number width_x, width_y; /* the effect of a unit change in $x$ */
10364 mp_number height_x, height_y; /* the effect of a unit change in $y$ */
10365 mp_number dx, dy; /* the vector from knot |p| to its right control point */
10366 new_number (center_x);
10367 new_number (center_y);
10368 new_number (width_x);
10369 new_number (width_y);
10370 new_number (height_x);
10371 new_number (height_y);
10374 @<Extract the transformation parameters from the elliptical pen~|h|@>;
10376 for (k = 0; k <= 7; k++) {
10377 @<Initialize |p| as the |k|th knot of a circle of unit diameter,
10378 transforming it appropriately@>;
10380 mp_next_knot (p) = h;
10382 mp_next_knot (p) = mp_new_knot (mp);
10383 p = mp_next_knot (p);
10387 free_number (center_x);
10388 free_number (center_y);
10389 free_number (width_x);
10390 free_number (width_y);
10391 free_number (height_x);
10392 free_number (height_y);
10396 @ @<Extract the transformation parameters from the elliptical pen~|h|@>=
10397 number_clone (center_x, h->x_coord);
10398 number_clone (center_y, h->y_coord);
10399 set_number_from_substraction (width_x, h->left_x, center_x);
10400 set_number_from_substraction (width_y, h->left_y, center_y);
10401 set_number_from_substraction (height_x, h->right_x, center_x);
10402 set_number_from_substraction (height_y, h->right_y, center_y);
10404 @ @<Other local variables in |make_path|@>=
10406 /* |k| advanced $270^\circ$ around the ring (cf. $\sin\theta=\cos(\theta+270)$) */
10408 @ The only tricky thing here are the tables |half_cos| and |d_cos| used to
10409 find the point $k/8$ of the way around the circle and the direction vector
10412 @<Initialize |p| as the |k|th knot of a circle of unit diameter,...@>=
10418 take_fraction (r1, mp->half_cos[k], width_x);
10419 take_fraction (r2, mp->half_cos[kk], height_x);
10420 number_add (r1, r2);
10421 set_number_from_addition (p->x_coord, center_x, r1);
10422 take_fraction (r1, mp->half_cos[k], width_y);
10423 take_fraction (r2, mp->half_cos[kk], height_y);
10424 number_add (r1, r2);
10425 set_number_from_addition (p->y_coord, center_y, r1);
10426 take_fraction (r1, mp->d_cos[kk], width_x);
10427 take_fraction (r2, mp->d_cos[k], height_x);
10428 number_clone (dx, r1);
10429 number_negate (dx);
10430 number_add (dx, r2);
10431 take_fraction (r1, mp->d_cos[kk], width_y);
10432 take_fraction (r2, mp->d_cos[k], height_y);
10433 number_clone (dy, r1);
10434 number_negate (dy);
10435 number_add (dy, r2);
10436 set_number_from_addition (p->right_x, p->x_coord, dx);
10437 set_number_from_addition (p->right_y, p->y_coord, dy);
10438 set_number_from_substraction (p->left_x, p->x_coord, dx);
10439 set_number_from_substraction (p->left_y, p->y_coord, dy);
10443 mp_left_type (p) = mp_explicit;
10444 mp_right_type (p) = mp_explicit;
10445 mp_originator (p) = mp_program_code
10448 mp_number half_cos[8]; /* ${1\over2}\cos(45k)$ */
10449 mp_number d_cos[8]; /* a magic constant times $\cos(45k)$ */
10451 @ The magic constant for |d_cos| is the distance between $({1\over2},0)$ and
10452 $({1\over4}\sqrt2,{1\over4}\sqrt2)$ times the result of the |velocity|
10453 function for $\theta=\phi=22.5^\circ$. This comes out to be
10454 $$ d = {\sqrt{2-\sqrt2}\over 3+3\cos22.5^\circ}
10455 \approx 0.132608244919772.
10459 for (k = 0; k <= 7; k++) {
10460 new_fraction (mp->half_cos[k]);
10461 new_fraction (mp->d_cos[k]);
10463 number_clone (mp->half_cos[0], fraction_half_t);
10464 number_clone (mp->half_cos[1], twentysixbits_sqrt2_t);
10465 number_clone (mp->half_cos[2], zero_t);
10466 number_clone (mp->d_cos[0], twentyeightbits_d_t);
10467 number_clone (mp->d_cos[1], twentysevenbits_sqrt2_d_t);
10468 number_clone (mp->d_cos[2], zero_t);
10469 for (k = 3; k <= 4; k++) {
10470 number_clone (mp->half_cos[k], mp->half_cos[4 - k]);
10471 number_negate (mp->half_cos[k]);
10472 number_clone (mp->d_cos[k], mp->d_cos[4 - k]);
10473 number_negate (mp->d_cos[k]);
10475 for (k = 5; k <= 7; k++) {
10476 number_clone (mp->half_cos[k], mp->half_cos[8 - k]);
10477 number_clone (mp->d_cos[k], mp->d_cos[8 - k]);
10481 for (k = 0; k <= 7; k++) {
10482 free_number (mp->half_cos[k]);
10483 free_number (mp->d_cos[k]);
10487 @ The |convex_hull| function forces a pen polygon to be convex when it is
10488 returned by |make_pen| and after any subsequent transformation where rounding
10489 error might allow the convexity to be lost.
10490 The convex hull algorithm used here is described by F.~P. Preparata and
10491 M.~I. Shamos [{\sl Computational Geometry}, Springer-Verlag, 1985].
10494 static mp_knot mp_convex_hull (MP mp, mp_knot h);
10497 mp_knot mp_convex_hull (MP mp, mp_knot h) { /* Make a polygonal pen convex */
10498 mp_knot l, r; /* the leftmost and rightmost knots */
10499 mp_knot p, q; /* knots being scanned */
10500 mp_knot s; /* the starting point for an upcoming scan */
10501 mp_number dx, dy; /* a temporary pointer */
10505 if (pen_is_elliptical (h)) {
10508 @<Set |l| to the leftmost knot in polygon~|h|@>;
10509 @<Set |r| to the rightmost knot in polygon~|h|@>;
10511 s = mp_next_knot (r);
10512 @<Find any knots on the path from |l| to |r| above the |l|-|r| line and
10513 move them past~|r|@>;
10514 @<Find any knots on the path from |s| to |l| below the |l|-|r| line and
10515 move them past~|l|@>;
10516 @<Sort the path from |l| to |r| by increasing $x$@>;
10517 @<Sort the path from |r| to |l| by decreasing $x$@>;
10519 if (l != mp_next_knot (l)) {
10520 @<Do a Gramm scan and remove vertices where there is no left turn@>;
10530 @ All comparisons are done primarily on $x$ and secondarily on $y$.
10532 @<Set |l| to the leftmost knot in polygon~|h|@>=
10534 p = mp_next_knot (h);
10536 if (number_lessequal (p->x_coord, l->x_coord))
10537 if ((number_less (p->x_coord, l->x_coord)) ||
10538 (number_less (p->y_coord, l->y_coord)))
10540 p = mp_next_knot (p);
10544 @ @<Set |r| to the rightmost knot in polygon~|h|@>=
10546 p = mp_next_knot (h);
10548 if (number_greaterequal(p->x_coord, r->x_coord))
10549 if (number_greater (p->x_coord, r->x_coord) ||
10550 number_greater (p->y_coord, r->y_coord))
10552 p = mp_next_knot (p);
10556 @ @<Find any knots on the path from |l| to |r| above the |l|-|r| line...@>=
10558 mp_number ab_vs_cd;
10559 mp_number arg1, arg2;
10562 new_number (ab_vs_cd);
10563 set_number_from_substraction (dx, r->x_coord, l->x_coord);
10564 set_number_from_substraction (dy, r->y_coord, l->y_coord);
10565 p = mp_next_knot (l);
10567 q = mp_next_knot (p);
10568 set_number_from_substraction (arg1, p->y_coord, l->y_coord);
10569 set_number_from_substraction (arg2, p->x_coord, l->x_coord);
10570 ab_vs_cd (ab_vs_cd, dx, arg1, dy, arg2);
10571 if (number_positive(ab_vs_cd))
10572 mp_move_knot (mp, p, r);
10575 free_number (ab_vs_cd);
10576 free_number (arg1);
10577 free_number (arg2);
10581 @ The |move_knot| procedure removes |p| from a doubly linked list and inserts
10584 @ @<Declarations@>=
10585 static void mp_move_knot (MP mp, mp_knot p, mp_knot q);
10588 void mp_move_knot (MP mp, mp_knot p, mp_knot q) {
10590 mp_next_knot (mp_prev_knot (p)) = mp_next_knot (p);
10591 mp_prev_knot (mp_next_knot (p)) = mp_prev_knot (p);
10592 mp_prev_knot (p) = q;
10593 mp_next_knot (p) = mp_next_knot (q);
10594 mp_next_knot (q) = p;
10595 mp_prev_knot (mp_next_knot (p)) = p;
10599 @ @<Find any knots on the path from |s| to |l| below the |l|-|r| line...@>=
10601 mp_number ab_vs_cd;
10602 mp_number arg1, arg2;
10603 new_number (ab_vs_cd);
10608 q = mp_next_knot (p);
10609 set_number_from_substraction (arg1, p->y_coord, l->y_coord);
10610 set_number_from_substraction (arg2, p->x_coord, l->x_coord);
10611 ab_vs_cd (ab_vs_cd, dx, arg1, dy, arg2);
10612 if (number_negative(ab_vs_cd))
10613 mp_move_knot (mp, p, l);
10616 free_number (ab_vs_cd);
10617 free_number (arg1);
10618 free_number (arg2);
10622 @ The list is likely to be in order already so we just do linear insertions.
10623 Secondary comparisons on $y$ ensure that the sort is consistent with the
10624 choice of |l| and |r|.
10626 @<Sort the path from |l| to |r| by increasing $x$@>=
10627 p = mp_next_knot (l);
10629 q = mp_prev_knot (p);
10630 while (number_greater(q->x_coord, p->x_coord))
10631 q = mp_prev_knot (q);
10632 while (number_equal(q->x_coord, p->x_coord)) {
10633 if (number_greater(q->y_coord, p->y_coord))
10634 q = mp_prev_knot (q);
10638 if (q == mp_prev_knot (p)) {
10639 p = mp_next_knot (p);
10641 p = mp_next_knot (p);
10642 mp_move_knot (mp, mp_prev_knot (p), q);
10647 @ @<Sort the path from |r| to |l| by decreasing $x$@>=
10648 p = mp_next_knot (r);
10650 q = mp_prev_knot (p);
10651 while (number_less(q->x_coord, p->x_coord))
10652 q = mp_prev_knot (q);
10653 while (number_equal(q->x_coord, p->x_coord)) {
10654 if (number_less (q->y_coord, p->y_coord))
10655 q = mp_prev_knot (q);
10659 if (q == mp_prev_knot (p)) {
10660 p = mp_next_knot (p);
10662 p = mp_next_knot (p);
10663 mp_move_knot (mp, mp_prev_knot (p), q);
10668 @ The condition involving |ab_vs_cd| tests if there is not a left turn
10669 at knot |q|. There usually will be a left turn so we streamline the case
10670 where the |then| clause is not executed.
10672 @<Do a Gramm scan and remove vertices where there...@>=
10674 mp_number ab_vs_cd;
10675 mp_number arg1, arg2;
10678 new_number (ab_vs_cd);
10680 q = mp_next_knot (l);
10682 set_number_from_substraction (dx, q->x_coord, p->x_coord);
10683 set_number_from_substraction (dy, q->y_coord, p->y_coord);
10685 q = mp_next_knot (q);
10689 set_number_from_substraction (arg1, q->y_coord, p->y_coord);
10690 set_number_from_substraction (arg2, q->x_coord, p->x_coord);
10691 ab_vs_cd (ab_vs_cd, dx, arg1, dy, arg2);
10692 if (number_nonpositive(ab_vs_cd)) {
10693 @<Remove knot |p| and back up |p| and |q| but don't go past |l|@>;
10697 free_number (ab_vs_cd);
10698 free_number (arg1);
10699 free_number (arg2);
10703 @ @<Remove knot |p| and back up |p| and |q| but don't go past |l|@>=
10705 s = mp_prev_knot (p);
10707 mp_next_knot (s) = q;
10708 mp_prev_knot (q) = s;
10712 p = mp_prev_knot (s);
10718 @ The |find_offset| procedure sets global variables |(cur_x,cur_y)| to the
10719 offset associated with the given direction |(x,y)|. If two different offsets
10720 apply, it chooses one of them.
10723 static void mp_find_offset (MP mp, mp_number x_orig, mp_number y_orig, mp_knot h) {
10724 mp_knot p, q; /* consecutive knots */
10725 if (pen_is_elliptical (h)) {
10726 mp_fraction xx, yy; /* untransformed offset for an elliptical pen */
10727 mp_number wx, wy, hx, hy; /* the transformation matrix for an elliptical pen */
10728 mp_fraction d; /* a temporary register */
10736 @<Find the offset for |(x,y)| on the elliptical pen~|h|@>
10745 mp_number ab_vs_cd;
10746 mp_number arg1, arg2;
10749 new_number (ab_vs_cd);
10753 q = mp_next_knot (q);
10754 set_number_from_substraction (arg1, q->x_coord, p->x_coord);
10755 set_number_from_substraction (arg2, q->y_coord, p->y_coord);
10756 ab_vs_cd (ab_vs_cd, arg1, y_orig, arg2, x_orig);
10757 } while (number_negative(ab_vs_cd));
10760 q = mp_next_knot (q);
10761 set_number_from_substraction (arg1, q->x_coord, p->x_coord);
10762 set_number_from_substraction (arg2, q->y_coord, p->y_coord);
10763 ab_vs_cd (ab_vs_cd, arg1, y_orig, arg2, x_orig);
10764 } while (number_positive(ab_vs_cd));
10765 number_clone (mp->cur_x, p->x_coord);
10766 number_clone (mp->cur_y, p->y_coord);
10767 free_number (ab_vs_cd);
10768 free_number (arg1);
10769 free_number (arg2);
10776 mp_number cur_y; /* all-purpose return value registers */
10778 @ @<Initialize table entries@>=
10779 new_number (mp->cur_x);
10780 new_number (mp->cur_y);
10783 free_number (mp->cur_x);
10784 free_number (mp->cur_y);
10786 @ @<Find the offset for |(x,y)| on the elliptical pen~|h|@>=
10787 if (number_zero(x_orig) && number_zero(y_orig)) {
10788 number_clone(mp->cur_x, h->x_coord);
10789 number_clone(mp->cur_y, h->y_coord);
10791 mp_number x, y, abs_x, abs_y;
10796 number_clone(x, x_orig);
10797 number_clone(y, y_orig);
10798 @<Find the non-constant part of the transformation for |h|@>;
10799 number_clone(abs_x, x);
10800 number_clone(abs_y, y);
10803 while (number_less(abs_x, fraction_half_t) && number_less(abs_y, fraction_half_t)) {
10806 number_clone(abs_x, x);
10807 number_clone(abs_y, y);
10811 @<Make |(xx,yy)| the offset on the untransformed \&{pencircle} for the
10812 untransformed version of |(x,y)|@>;
10817 take_fraction (r1, xx, wx);
10818 take_fraction (r2, yy, hx);
10819 number_add(r1, r2);
10820 set_number_from_addition(mp->cur_x, h->x_coord, r1);
10821 take_fraction (r1, xx, wy);
10822 take_fraction (r2, yy, hy);
10823 number_add(r1, r2);
10824 set_number_from_addition(mp->cur_y, h->y_coord, r1);
10828 free_number(abs_x);
10829 free_number(abs_y);
10835 @ @<Find the non-constant part of the transformation for |h|@>=
10837 set_number_from_substraction(wx, h->left_x, h->x_coord);
10838 set_number_from_substraction(wy, h->left_y, h->y_coord);
10839 set_number_from_substraction(hx, h->right_x, h->x_coord);
10840 set_number_from_substraction(hy, h->right_y, h->y_coord);
10844 @ @<Make |(xx,yy)| the offset on the untransformed \&{pencircle} for the...@>=
10846 mp_number r1, r2, arg1;
10850 take_fraction (r1, x, hy);
10851 number_clone (arg1, hx);
10852 number_negate (arg1);
10853 take_fraction (r2, y, arg1);
10854 number_add (r1, r2);
10855 number_negate (r1);
10856 number_clone(yy, r1);
10857 number_clone (arg1, wy);
10858 number_negate (arg1);
10859 take_fraction (r1, x, arg1);
10860 take_fraction (r2, y, wx);
10861 number_add (r1, r2);
10862 number_clone(xx, r1);
10863 free_number (arg1);
10867 pyth_add (d, xx, yy);
10868 if (number_positive(d)) {
10870 new_fraction (ret);
10871 make_fraction (ret, xx, d);
10873 number_clone(xx, ret);
10874 make_fraction (ret, yy, d);
10876 number_clone(yy, ret);
10880 @ Finding the bounding box of a pen is easy except if the pen is elliptical.
10881 But we can handle that case by just calling |find_offset| twice. The answer
10882 is stored in the global variables |minx|, |maxx|, |miny|, and |maxy|.
10885 static void mp_pen_bbox (MP mp, mp_knot h) {
10886 mp_knot p; /* for scanning the knot list */
10887 if (pen_is_elliptical (h)) {
10888 @<Find the bounding box of an elliptical pen@>;
10890 number_clone (mp_minx, h->x_coord);
10891 number_clone (mp_maxx, mp_minx);
10892 number_clone (mp_miny, h->y_coord);
10893 number_clone (mp_maxy, mp_miny);
10894 p = mp_next_knot (h);
10896 if (number_less (p->x_coord, mp_minx))
10897 number_clone (mp_minx, p->x_coord);
10898 if (number_less (p->y_coord, mp_miny))
10899 number_clone (mp_miny, p->y_coord);
10900 if (number_greater (p->x_coord, mp_maxx))
10901 number_clone (mp_maxx, p->x_coord);
10902 if (number_greater (p->y_coord, mp_maxy))
10903 number_clone (mp_maxy, p->y_coord);
10904 p = mp_next_knot (p);
10910 @ @<Find the bounding box of an elliptical pen@>=
10912 mp_number arg1, arg2;
10914 new_fraction (arg2);
10915 number_clone(arg2, fraction_one_t);
10916 mp_find_offset (mp, arg1, arg2, h);
10917 number_clone (mp_maxx, mp->cur_x);
10918 number_clone (mp_minx, h->x_coord);
10919 number_double (mp_minx);
10920 number_substract (mp_minx, mp->cur_x);
10921 number_negate (arg2);
10922 mp_find_offset (mp, arg2, arg1, h);
10923 number_clone (mp_maxy, mp->cur_y);
10924 number_clone (mp_miny, h->y_coord);
10925 number_double (mp_miny);
10926 number_substract (mp_miny, mp->cur_y);
10932 @* Numerical values.
10934 This first set goes into the header
10936 @<MPlib internal header stuff@>=
10937 #define mp_fraction mp_number
10938 #define mp_angle mp_number
10939 #define new_number(A) (((math_data *)(mp->math))->allocate)(mp, &(A), mp_scaled_type)
10940 #define new_fraction(A) (((math_data *)(mp->math))->allocate)(mp, &(A), mp_fraction_type)
10941 #define new_angle(A) (((math_data *)(mp->math))->allocate)(mp, &(A), mp_angle_type)
10942 #define free_number(A) (((math_data *)(mp->math))->free)(mp, &(A))
10945 @d set_precision() (((math_data *)(mp->math))->set_precision)(mp)
10946 @d free_math() (((math_data *)(mp->math))->free_math)(mp)
10947 @d scan_numeric_token(A) (((math_data *)(mp->math))->scan_numeric)(mp, A)
10948 @d scan_fractional_token(A) (((math_data *)(mp->math))->scan_fractional)(mp, A)
10949 @d set_number_from_of_the_way(A,t,B,C) (((math_data *)(mp->math))->from_oftheway)(mp, &(A),t,B,C)
10950 @d set_number_from_int(A,B) (((math_data *)(mp->math))->from_int)(&(A),B)
10951 @d set_number_from_scaled(A,B) (((math_data *)(mp->math))->from_scaled)(&(A),B)
10952 @d set_number_from_boolean(A,B) (((math_data *)(mp->math))->from_boolean)(&(A),B)
10953 @d set_number_from_double(A,B) (((math_data *)(mp->math))->from_double)(&(A),B)
10954 @d set_number_from_addition(A,B,C) (((math_data *)(mp->math))->from_addition)(&(A),B,C)
10955 @d set_number_from_substraction(A,B,C) (((math_data *)(mp->math))->from_substraction)(&(A),B,C)
10956 @d set_number_from_div(A,B,C) (((math_data *)(mp->math))->from_div)(&(A),B,C)
10957 @d set_number_from_mul(A,B,C) (((math_data *)(mp->math))->from_mul)(&(A),B,C)
10958 @d number_int_div(A,C) (((math_data *)(mp->math))->from_int_div)(&(A),A,C)
10959 @d set_number_from_int_mul(A,B,C) (((math_data *)(mp->math))->from_int_mul)(&(A),B,C)
10961 @d set_number_to_unity(A) (((math_data *)(mp->math))->clone)(&(A), unity_t)
10962 @d set_number_to_zero(A) (((math_data *)(mp->math))->clone)(&(A), zero_t)
10963 @d set_number_to_inf(A) (((math_data *)(mp->math))->clone)(&(A), inf_t)
10964 @d set_number_to_neg_inf(A) do { set_number_to_inf(A); number_negate (A); } while (0)
10966 @d init_randoms(A) (((math_data *)(mp->math))->init_randoms)(mp,A)
10967 @d print_number(A) (((math_data *)(mp->math))->print)(mp,A)
10968 @d number_tostring(A) (((math_data *)(mp->math))->tostring)(mp,A)
10969 @d make_scaled(R,A,B) (((math_data *)(mp->math))->make_scaled)(mp,&(R),A,B)
10970 @d take_scaled(R,A,B) (((math_data *)(mp->math))->take_scaled)(mp,&(R),A,B)
10971 @d make_fraction(R,A,B) (((math_data *)(mp->math))->make_fraction)(mp,&(R),A,B)
10972 @d take_fraction(R,A,B) (((math_data *)(mp->math))->take_fraction)(mp,&(R),A,B)
10973 @d pyth_add(R,A,B) (((math_data *)(mp->math))->pyth_add)(mp,&(R),A,B)
10974 @d pyth_sub(R,A,B) (((math_data *)(mp->math))->pyth_sub)(mp,&(R),A,B)
10975 @d n_arg(R,A,B) (((math_data *)(mp->math))->n_arg)(mp,&(R),A,B)
10976 @d m_log(R,A) (((math_data *)(mp->math))->m_log)(mp,&(R),A)
10977 @d m_exp(R,A) (((math_data *)(mp->math))->m_exp)(mp,&(R),A)
10978 @d m_unif_rand(R,A) (((math_data *)(mp->math))->m_unif_rand)(mp,&(R),A)
10979 @d m_norm_rand(R) (((math_data *)(mp->math))->m_norm_rand)(mp,&(R))
10980 @d velocity(R,A,B,C,D,E) (((math_data *)(mp->math))->velocity)(mp,&(R),A,B,C,D,E)
10981 @d ab_vs_cd(R,A,B,C,D) (((math_data *)(mp->math))->ab_vs_cd)(mp,&(R),A,B,C,D)
10982 @d crossing_point(R,A,B,C) (((math_data *)(mp->math))->crossing_point)(mp,&(R),A,B,C)
10983 @d n_sin_cos(A,S,C) (((math_data *)(mp->math))->sin_cos)(mp,A,&(S),&(C))
10984 @d square_rt(A,S) (((math_data *)(mp->math))->sqrt)(mp,&(A),S)
10985 @d slow_add(R,A,B) (((math_data *)(mp->math))->slow_add)(mp,&(R),A,B)
10986 @d round_unscaled(A) (((math_data *)(mp->math))->round_unscaled)(A)
10987 @d floor_scaled(A) (((math_data *)(mp->math))->floor_scaled)(&(A))
10988 @d fraction_to_round_scaled(A) (((math_data *)(mp->math))->fraction_to_round_scaled)(&(A))
10989 @d number_to_int(A) (((math_data *)(mp->math))->to_int)(A)
10990 @d number_to_boolean(A) (((math_data *)(mp->math))->to_boolean)(A)
10991 @d number_to_scaled(A) (((math_data *)(mp->math))->to_scaled)(A)
10992 @d number_to_double(A) (((math_data *)(mp->math))->to_double)(A)
10993 @d number_negate(A) (((math_data *)(mp->math))->negate)(&(A))
10994 @d number_add(A,B) (((math_data *)(mp->math))->add)(&(A),B)
10995 @d number_substract(A,B) (((math_data *)(mp->math))->substract)(&(A),B)
10996 @d number_half(A) (((math_data *)(mp->math))->half)(&(A))
10997 @d number_halfp(A) (((math_data *)(mp->math))->halfp)(&(A))
10998 @d number_double(A) (((math_data *)(mp->math))->do_double)(&(A))
10999 @d number_add_scaled(A,B) (((math_data *)(mp->math))->add_scaled)(&(A),B)
11000 @d number_multiply_int(A,B) (((math_data *)(mp->math))->multiply_int)(&(A),B)
11001 @d number_divide_int(A,B) (((math_data *)(mp->math))->divide_int)(&(A),B)
11002 @d number_abs(A) (((math_data *)(mp->math))->abs)(&(A))
11003 @d number_modulo(A,B) (((math_data *)(mp->math))->modulo)(&(A), B)
11004 @d number_nonequalabs(A,B) (((math_data *)(mp->math))->nonequalabs)(A,B)
11005 @d number_odd(A) (((math_data *)(mp->math))->odd)(A)
11006 @d number_equal(A,B) (((math_data *)(mp->math))->equal)(A,B)
11007 @d number_greater(A,B) (((math_data *)(mp->math))->greater)(A,B)
11008 @d number_less(A,B) (((math_data *)(mp->math))->less)(A,B)
11009 @d number_clone(A,B) (((math_data *)(mp->math))->clone)(&(A),B)
11010 @d number_swap(A,B) (((math_data *)(mp->math))->swap)(&(A),&(B));
11011 @d convert_scaled_to_angle(A) (((math_data *)(mp->math))->scaled_to_angle)(&(A));
11012 @d convert_angle_to_scaled(A) (((math_data *)(mp->math))->angle_to_scaled)(&(A));
11013 @d convert_fraction_to_scaled(A) (((math_data *)(mp->math))->fraction_to_scaled)(&(A));
11014 @d convert_scaled_to_fraction(A) (((math_data *)(mp->math))->scaled_to_fraction)(&(A));
11016 @d number_zero(A) number_equal(A, zero_t)
11017 @d number_infinite(A) number_equal(A, inf_t)
11018 @d number_unity(A) number_equal(A, unity_t)
11019 @d number_negative(A) number_less(A, zero_t)
11020 @d number_nonnegative(A) (!number_negative(A))
11021 @d number_positive(A) number_greater(A, zero_t)
11022 @d number_nonpositive(A) (!number_positive(A))
11023 @d number_nonzero(A) (!number_zero(A))
11024 @d number_greaterequal(A,B) (!number_less(A,B))
11025 @d number_lessequal(A,B) (!number_greater(A,B))
11027 @* Edge structures.
11028 Now we come to \MP's internal scheme for representing pictures.
11029 The representation is very different from \MF's edge structures
11030 because \MP\ pictures contain \ps\ graphics objects instead of pixel
11031 images. However, the basic idea is somewhat similar in that shapes
11032 are represented via their boundaries.
11034 The main purpose of edge structures is to keep track of graphical objects
11035 until it is time to translate them into \ps. Since \MP\ does not need to
11036 know anything about an edge structure other than how to translate it into
11037 \ps\ and how to find its bounding box, edge structures can be just linked
11038 lists of graphical objects. \MP\ has no easy way to determine whether
11039 two such objects overlap, but it suffices to draw the first one first and
11040 let the second one overwrite it if necessary.
11042 @<MPlib header stuff@>=
11043 enum mp_graphical_object_code {
11044 @<Graphical object codes@>
11048 @ Let's consider the types of graphical objects one at a time.
11049 First of all, a filled contour is represented by a eight-word node. The first
11050 word contains |type| and |link| fields, and the next six words contain a
11051 pointer to a cyclic path and the value to use for \ps' \&{currentrgbcolor}
11052 parameter. If a pen is used for filling |pen_p|, |ljoin| and |miterlim|
11053 give the relevant information.
11055 @d mp_path_p(A) (A)->path_p_ /* a pointer to the path that needs filling */
11056 @d mp_pen_p(A) (A)->pen_p_ /* a pointer to the pen to fill or stroke with */
11057 @d mp_color_model(A) ((mp_fill_node)(A))->color_model_ /* the color model */
11062 @d mp_pre_script(A) ((mp_fill_node)(A))->pre_script_
11063 @d mp_post_script(A) ((mp_fill_node)(A))->post_script_
11065 @<MPlib internal header stuff@>=
11066 typedef struct mp_fill_node_data {
11068 halfword color_model_;
11073 mp_string pre_script_;
11074 mp_string post_script_;
11077 unsigned char ljoin;
11078 mp_number miterlim;
11079 } mp_fill_node_data;
11080 typedef struct mp_fill_node_data *mp_fill_node;
11082 @ @<Graphical object codes@>=
11085 @ Make a fill node for cyclic path |p| and color black.
11087 @d fill_node_size sizeof(struct mp_fill_node_data)
11090 static mp_node mp_new_fill_node (MP mp, mp_knot p) {
11091 mp_fill_node t = malloc_node (fill_node_size);
11092 mp_type (t) = mp_fill_node_type;
11094 mp_pen_p (t) = NULL; /* |NULL| means don't use a pen */
11095 new_number(t->red);
11096 new_number(t->green);
11097 new_number(t->blue);
11098 new_number(t->black);
11099 new_number(t->miterlim);
11101 mp_color_model (t) = mp_uninitialized_model;
11102 mp_pre_script (t) = NULL;
11103 mp_post_script (t) = NULL;
11104 /* Set the |ljoin| and |miterlim| fields in object |t| */
11105 if (number_greater(internal_value (mp_linejoin), unity_t))
11107 else if (number_positive(internal_value (mp_linejoin)))
11111 if (number_less(internal_value (mp_miterlimit), unity_t)) {
11112 set_number_to_unity(t->miterlim);
11114 number_clone(t->miterlim,internal_value (mp_miterlimit));
11116 return (mp_node) t;
11120 static void mp_free_fill_node (MP mp, mp_fill_node p) {
11121 mp_toss_knot_list (mp, mp_path_p (p));
11122 if (mp_pen_p (p) != NULL)
11123 mp_toss_knot_list (mp, mp_pen_p (p));
11124 if (mp_pre_script (p) != NULL)
11125 delete_str_ref (mp_pre_script (p));
11126 if (mp_post_script (p) != NULL)
11127 delete_str_ref (mp_post_script (p));
11128 free_number(p->red);
11129 free_number(p->green);
11130 free_number(p->blue);
11131 free_number(p->black);
11132 free_number(p->miterlim);
11133 mp_free_node (mp, (mp_node)p, fill_node_size);
11138 @ A stroked path is represented by an eight-word node that is like a filled
11139 contour node except that it contains the current \&{linecap} value, a scale
11140 factor for the dash pattern, and a pointer that is non-NULL if the stroke
11141 is to be dashed. The purpose of the scale factor is to allow a picture to
11142 be transformed without touching the picture that |dash_p| points to.
11144 @d mp_dash_p(A) ((mp_stroked_node)(A))->dash_p_ /* a pointer to the edge structure that gives the dash pattern */
11146 @<MPlib internal header stuff@>=
11147 typedef struct mp_stroked_node_data {
11149 halfword color_model_;
11154 mp_string pre_script_;
11155 mp_string post_script_;
11158 unsigned char ljoin;
11159 mp_number miterlim;
11160 unsigned char lcap;
11162 mp_number dash_scale;
11163 } mp_stroked_node_data;
11164 typedef struct mp_stroked_node_data *mp_stroked_node;
11167 @ @<Graphical object codes@>=
11168 mp_stroked_code = 2,
11170 @ Make a stroked node for path |p| with |mp_pen_p(p)| temporarily |NULL|.
11172 @d stroked_node_size sizeof(struct mp_stroked_node_data)
11175 static mp_node mp_new_stroked_node (MP mp, mp_knot p) {
11176 mp_stroked_node t = malloc_node (stroked_node_size);
11177 mp_type (t) = mp_stroked_node_type;
11179 mp_pen_p (t) = NULL;
11180 mp_dash_p (t) = NULL;
11181 new_number(t->dash_scale);
11182 set_number_to_unity(t->dash_scale);
11183 new_number(t->red);
11184 new_number(t->green);
11185 new_number(t->blue);
11186 new_number(t->black);
11187 new_number(t->miterlim);
11189 mp_pre_script (t) = NULL;
11190 mp_post_script (t) = NULL;
11191 /* Set the |ljoin| and |miterlim| fields in object |t| */
11192 if (number_greater(internal_value (mp_linejoin), unity_t))
11194 else if (number_positive(internal_value (mp_linejoin)))
11198 if (number_less(internal_value (mp_miterlimit), unity_t)) {
11199 set_number_to_unity(t->miterlim);
11201 number_clone(t->miterlim,internal_value (mp_miterlimit));
11203 if (number_greater(internal_value (mp_linecap), unity_t))
11205 else if (number_positive(internal_value (mp_linecap)))
11209 return (mp_node) t;
11213 static mp_edge_header_node mp_free_stroked_node (MP mp, mp_stroked_node p) {
11214 mp_edge_header_node e = NULL;
11215 mp_toss_knot_list (mp, mp_path_p (p));
11216 if (mp_pen_p (p) != NULL)
11217 mp_toss_knot_list (mp, mp_pen_p (p));
11218 if (mp_pre_script (p) != NULL)
11219 delete_str_ref (mp_pre_script (p));
11220 if (mp_post_script (p) != NULL)
11221 delete_str_ref (mp_post_script (p));
11222 e = (mp_edge_header_node)mp_dash_p (p);
11223 free_number(p->dash_scale);
11224 free_number(p->red);
11225 free_number(p->green);
11226 free_number(p->blue);
11227 free_number(p->black);
11228 free_number(p->miterlim);
11229 mp_free_node (mp, (mp_node)p, stroked_node_size);
11233 @ When a dashed line is computed in a transformed coordinate system, the dash
11234 lengths get scaled like the pen shape and we need to compensate for this. Since
11235 there is no unique scale factor for an arbitrary transformation, we use the
11236 the square root of the determinant. The properties of the determinant make it
11237 easier to maintain the |dash_scale|. The computation is fairly straight-forward
11238 except for the initialization of the scale factor |s|. The factor of 64 is
11239 needed because |square_rt| scales its result by $2^8$ while we need $2^{14}$
11240 to counteract the effect of |take_fraction|.
11243 void mp_sqrt_det (MP mp, mp_number *ret, mp_number a_orig, mp_number b_orig, mp_number c_orig, mp_number d_orig) {
11245 mp_number maxabs; /* $max(|a|,|b|,|c|,|d|)$ */
11246 unsigned s; /* amount by which the result of |square_rt| needs to be scaled */
11251 new_number(maxabs);
11252 number_clone(a, a_orig);
11253 number_clone(b, b_orig);
11254 number_clone(c, c_orig);
11255 number_clone(d, d_orig);
11256 /* Initialize |maxabs| */
11260 number_clone(maxabs, a);
11261 number_abs(maxabs);
11262 number_clone(tmp, b);
11264 if (number_greater(tmp, maxabs))
11265 number_clone(maxabs, tmp);
11266 number_clone(tmp, c);
11268 if (number_greater(tmp, maxabs))
11269 number_clone(maxabs, tmp);
11270 number_clone(tmp, d);
11272 if (number_greater(tmp, maxabs))
11273 number_clone(maxabs, tmp);
11279 while ((number_less(maxabs, fraction_one_t)) && (s > 1)) {
11284 number_double(maxabs);
11291 take_fraction (r1, a, d);
11292 take_fraction (r2, b, c);
11293 number_substract (r1, r2);
11295 square_rt(*ret, r1);
11296 number_multiply_int(*ret, s);
11304 free_number(maxabs);
11307 static void mp_get_pen_scale (MP mp, mp_number *ret, mp_knot p) {
11309 set_number_to_zero(*ret);
11316 set_number_from_substraction(a, p->left_x, p->x_coord);
11317 set_number_from_substraction(b, p->right_x, p->x_coord);
11318 set_number_from_substraction(c, p->left_y, p->y_coord);
11319 set_number_from_substraction(d, p->right_y, p->y_coord);
11320 mp_sqrt_det (mp, ret, a, b, c, d);
11329 @ @<Declarations@>=
11330 static void mp_sqrt_det (MP mp, mp_number *ret, mp_number a, mp_number b, mp_number c, mp_number d);
11332 @ When a picture contains text, this is represented by a fourteen-word node
11333 where the color information and |type| and |link| fields are augmented by
11334 additional fields that describe the text and how it is transformed.
11335 The |path_p| and |mp_pen_p| pointers are replaced by a number that identifies
11336 the font and a string number that gives the text to be displayed.
11337 The |width|, |height|, and |depth| fields
11338 give the dimensions of the text at its design size, and the remaining six
11339 words give a transformation to be applied to the text. The |new_text_node|
11340 function initializes everything to default values so that the text comes out
11341 black with its reference point at the origin.
11343 @d mp_text_p(A) ((mp_text_node)(A))->text_p_ /* a string pointer for the text to display */
11344 @d mp_font_n(A) ((mp_text_node)(A))->font_n_ /* the font number */
11346 @<MPlib internal header stuff@>=
11347 typedef struct mp_text_node_data {
11349 halfword color_model_;
11354 mp_string pre_script_;
11355 mp_string post_script_;
11367 } mp_text_node_data;
11368 typedef struct mp_text_node_data *mp_text_node;
11370 @ @<Graphical object codes@>=
11373 @ Make a text node for font |f| and text string |s|.
11375 @d text_node_size sizeof(struct mp_text_node_data)
11378 static mp_node mp_new_text_node (MP mp, char *f, mp_string s) {
11379 mp_text_node t = malloc_node (text_node_size);
11380 mp_type (t) = mp_text_node_type;
11383 mp_font_n (t) = (halfword) mp_find_font (mp, f); /* this identifies the font */
11384 new_number(t->red);
11385 new_number(t->green);
11386 new_number(t->blue);
11387 new_number(t->black);
11388 new_number(t->width);
11389 new_number(t->height);
11390 new_number(t->depth);
11392 mp_pre_script (t) = NULL;
11393 mp_post_script (t) = NULL;
11396 new_number(t->txx);
11397 new_number(t->txy);
11398 new_number(t->tyx);
11399 new_number(t->tyy);
11400 /* |tx_val (t) = 0; ty_val (t) = 0;| */
11401 /* |txy_val (t) = 0; tyx_val (t) = 0;| */
11402 set_number_to_unity(t->txx);
11403 set_number_to_unity(t->tyy);
11404 mp_set_text_box (mp, t); /* this finds the bounding box */
11405 return (mp_node) t;
11409 static void mp_free_text_node (MP mp, mp_text_node p) {
11410 /* |delete_str_ref (mp_text_p (p));| */ /* gives errors */
11411 if (mp_pre_script (p) != NULL)
11412 delete_str_ref (mp_pre_script (p));
11413 if (mp_post_script (p) != NULL)
11414 delete_str_ref (mp_post_script (p));
11415 free_number(p->red);
11416 free_number(p->green);
11417 free_number(p->blue);
11418 free_number(p->black);
11419 free_number(p->width);
11420 free_number(p->height);
11421 free_number(p->depth);
11422 free_number(p->tx);
11423 free_number(p->ty);
11424 free_number(p->txx);
11425 free_number(p->txy);
11426 free_number(p->tyx);
11427 free_number(p->tyy);
11428 mp_free_node (mp, (mp_node)p, text_node_size);
11431 @ The last two types of graphical objects that can occur in an edge structure
11432 are clipping paths and \&{setbounds} paths. These are slightly more difficult
11433 @:set_bounds_}{\&{setbounds} primitive@>
11434 to implement because we must keep track of exactly what is being clipped or
11435 bounded when pictures get merged together. For this reason, each clipping or
11436 \&{setbounds} operation is represented by a pair of nodes: first comes a
11437 node whose |path_p| gives the relevant path, then there is the list
11438 of objects to clip or bound followed by a closing node.
11440 @d has_color(A) (mp_type((A))<mp_start_clip_node_type)
11441 /* does a graphical object have color fields? */
11442 @d has_pen(A) (mp_type((A))<mp_text_node_type)
11443 /* does a graphical object have a |mp_pen_p| field? */
11444 @d is_start_or_stop(A) (mp_type((A))>=mp_start_clip_node_type)
11445 @d is_stop(A) (mp_type((A))>=mp_stop_clip_node_type)
11447 @<MPlib internal header stuff@>=
11448 typedef struct mp_start_clip_node_data {
11451 } mp_start_clip_node_data;
11452 typedef struct mp_start_clip_node_data *mp_start_clip_node;
11453 typedef struct mp_start_bounds_node_data {
11456 } mp_start_bounds_node_data;
11457 typedef struct mp_start_bounds_node_data *mp_start_bounds_node;
11458 typedef struct mp_stop_clip_node_data {
11460 } mp_stop_clip_node_data;
11461 typedef struct mp_stop_clip_node_data *mp_stop_clip_node;
11462 typedef struct mp_stop_bounds_node_data {
11464 } mp_stop_bounds_node_data;
11465 typedef struct mp_stop_bounds_node_data *mp_stop_bounds_node;
11468 @ @<Graphical object codes@>=
11469 mp_start_clip_code = 4, /* |type| of a node that starts clipping */
11470 mp_start_bounds_code = 5, /* |type| of a node that gives a \&{setbounds} path */
11471 mp_stop_clip_code = 6, /* |type| of a node that stops clipping */
11472 mp_stop_bounds_code = 7, /* |type| of a node that stops \&{setbounds} */
11477 @d start_clip_size sizeof(struct mp_start_clip_node_data)
11478 @d stop_clip_size sizeof(struct mp_stop_clip_node_data)
11479 @d start_bounds_size sizeof(struct mp_start_bounds_node_data)
11480 @d stop_bounds_size sizeof(struct mp_stop_bounds_node_data)
11483 static mp_node mp_new_bounds_node (MP mp, mp_knot p, quarterword c) {
11484 /* make a node of type |c| where |p| is the clipping or \&{setbounds} path */
11485 if (c == mp_start_clip_node_type) {
11486 mp_start_clip_node t; /* the new node */
11487 t = (mp_start_clip_node) malloc_node (start_clip_size);
11491 return (mp_node) t;
11492 } else if (c == mp_start_bounds_node_type) {
11493 mp_start_bounds_node t; /* the new node */
11494 t = (mp_start_bounds_node) malloc_node (start_bounds_size);
11498 return (mp_node) t;
11499 } else if (c == mp_stop_clip_node_type) {
11500 mp_stop_clip_node t; /* the new node */
11501 t = (mp_stop_clip_node) malloc_node (stop_clip_size);
11504 return (mp_node) t;
11505 } else if (c == mp_stop_bounds_node_type) {
11506 mp_stop_bounds_node t; /* the new node */
11507 t = (mp_stop_bounds_node) malloc_node (stop_bounds_size);
11510 return (mp_node) t;
11519 static void mp_free_start_clip_node (MP mp, mp_start_clip_node p) {
11520 mp_toss_knot_list (mp, mp_path_p (p));
11521 mp_free_node (mp, (mp_node)p, start_clip_size);
11523 static void mp_free_start_bounds_node (MP mp, mp_start_bounds_node p) {
11524 mp_toss_knot_list (mp, mp_path_p (p));
11525 mp_free_node (mp, (mp_node)p, start_bounds_size);
11527 static void mp_free_stop_clip_node (MP mp, mp_stop_clip_node p) {
11528 mp_free_node (mp, (mp_node)p, stop_clip_size);
11530 static void mp_free_stop_bounds_node (MP mp, mp_stop_bounds_node p) {
11531 mp_free_node (mp, (mp_node)p, stop_bounds_size);
11535 @ All the essential information in an edge structure is encoded as a linked list
11536 of graphical objects as we have just seen, but it is helpful to add some
11537 redundant information. A single edge structure might be used as a dash pattern
11538 many times, and it would be nice to avoid scanning the same structure
11539 repeatedly. Thus, an edge structure known to be a suitable dash pattern
11540 has a header that gives a list of dashes in a sorted order designed for rapid
11541 translation into \ps.
11543 Each dash is represented by a three-word node containing the initial and final
11544 $x$~coordinates as well as the usual |link| field. The |link| fields points to
11545 the dash node with the next higher $x$-coordinates and the final link points
11546 to a special location called |null_dash|. (There should be no overlap between
11547 dashes). Since the $y$~coordinate of the dash pattern is needed to determine
11548 the period of repetition, this needs to be stored in the edge header along
11549 with a pointer to the list of dash nodes.
11551 The |dash_info| is explained below.
11553 @d dash_list(A) (mp_dash_node)(((mp_dash_node)(A))->link) /* in an edge header this points to the first dash node */
11554 @d set_dash_list(A,B) ((mp_dash_node)(A))->link=(mp_node)((B)) /* in an edge header this points to the first dash node */
11556 @<MPlib internal header stuff@>=
11557 typedef struct mp_dash_node_data {
11559 mp_number start_x; /* the starting $x$~coordinate in a dash node */
11560 mp_number stop_x; /* the ending $x$~coordinate in a dash node */
11561 mp_number dash_y; /* $y$ value for the dash list in an edge header */
11562 mp_node dash_info_;
11563 } mp_dash_node_data;
11566 typedef struct mp_dash_node_data *mp_dash_node;
11568 @ @<Initialize table entries@>=
11569 mp->null_dash = mp_get_dash_node (mp);
11571 @ @<Free table entries@>=
11572 mp_free_node (mp, (mp_node)mp->null_dash, dash_node_size);
11575 @d dash_node_size sizeof(struct mp_dash_node_data)
11578 static mp_dash_node mp_get_dash_node (MP mp) {
11579 mp_dash_node p = (mp_dash_node) malloc_node (dash_node_size);
11581 new_number(p->start_x);
11582 new_number(p->stop_x);
11583 new_number(p->dash_y);
11584 mp_type (p) = mp_dash_node_type;
11589 @ It is also convenient for an edge header to contain the bounding
11590 box information needed by the \&{llcorner} and \&{urcorner} operators
11591 so that this does not have to be recomputed unnecessarily. This is done by
11592 adding fields for the $x$~and $y$ extremes as well as a pointer that indicates
11593 how far the bounding box computation has gotten. Thus if the user asks for
11594 the bounding box and then adds some more text to the picture before asking
11595 for more bounding box information, the second computation need only look at
11596 the additional text.
11598 When the bounding box has not been computed, the |bblast| pointer points
11599 to a dummy link at the head of the graphical object list while the |minx_val|
11600 and |miny_val| fields contain |EL_GORDO| and the |maxx_val| and |maxy_val|
11601 fields contain |-EL_GORDO|.
11603 Since the bounding box of pictures containing objects of type
11604 |mp_start_bounds_node| depends on the value of \&{truecorners}, the bounding box
11605 @:mp_true_corners_}{\&{truecorners} primitive@>
11606 data might not be valid for all values of this parameter. Hence, the |bbtype|
11607 field is needed to keep track of this.
11609 @d bblast(A) ((mp_edge_header_node)(A))->bblast_ /* last item considered in bounding box computation */
11610 @d edge_list(A) ((mp_edge_header_node)(A))->list_ /* where the object list begins in an edge header */
11612 @<MPlib internal header stuff@>=
11613 typedef struct mp_edge_header_node_data {
11618 mp_node dash_info_;
11624 int bbtype; /* tells how bounding box data depends on \&{truecorners} */
11626 mp_node obj_tail_; /* explained below */
11627 halfword ref_count_; /* explained below */
11628 } mp_edge_header_node_data;
11629 typedef struct mp_edge_header_node_data *mp_edge_header_node;
11632 @d no_bounds 0 /* |bbtype| value when bounding box data is valid for all \&{truecorners} values */
11633 @d bounds_set 1 /* |bbtype| value when bounding box data is for \&{truecorners}${}\le 0$ */
11634 @d bounds_unset 2 /* |bbtype| value when bounding box data is for \&{truecorners}${}>0$ */
11636 static void mp_init_bbox (MP mp, mp_edge_header_node h) {
11637 /* Initialize the bounding box information in edge structure |h| */
11639 bblast (h) = edge_list (h);
11640 h->bbtype = no_bounds;
11641 set_number_to_inf(h->minx);
11642 set_number_to_inf(h->miny);
11643 set_number_to_neg_inf(h->maxx);
11644 set_number_to_neg_inf(h->maxy);
11648 @ The only other entries in an edge header are a reference count in the first
11649 word and a pointer to the tail of the object list in the last word.
11651 @d obj_tail(A) ((mp_edge_header_node)(A))->obj_tail_ /* points to the last entry in the object list */
11652 @d edge_ref_count(A) ((mp_edge_header_node)(A))->ref_count_
11654 @d edge_header_size sizeof(struct mp_edge_header_node_data)
11657 static mp_edge_header_node mp_get_edge_header_node (MP mp) {
11658 mp_edge_header_node p = (mp_edge_header_node) malloc_node (edge_header_size);
11659 mp_type (p) = mp_edge_header_node_type;
11660 new_number(p->start_x);
11661 new_number(p->stop_x);
11662 new_number(p->dash_y);
11663 new_number(p->minx);
11664 new_number(p->miny);
11665 new_number(p->maxx);
11666 new_number(p->maxy);
11667 p->list_ = mp_get_token_node (mp); /* or whatever, just a need a link handle */
11670 static void mp_init_edges (MP mp, mp_edge_header_node h) {
11671 /* initialize an edge header to NULL values */
11672 set_dash_list (h, mp->null_dash);
11673 obj_tail (h) = edge_list (h);
11674 mp_link (edge_list (h)) = NULL;
11675 edge_ref_count (h) = 0;
11676 mp_init_bbox (mp, h);
11680 @ Here is how edge structures are deleted. The process can be recursive because
11681 of the need to dereference edge structures that are used as dash patterns.
11684 @d add_edge_ref(A) incr(edge_ref_count((A)))
11685 @d delete_edge_ref(A) {
11686 if ( edge_ref_count((A))==0 )
11687 mp_toss_edges(mp, (mp_edge_header_node)(A));
11689 decr(edge_ref_count((A)));
11693 static void mp_flush_dash_list (MP mp, mp_edge_header_node h);
11694 static mp_edge_header_node mp_toss_gr_object (MP mp, mp_node p);
11695 static void mp_toss_edges (MP mp, mp_edge_header_node h);
11698 void mp_toss_edges (MP mp, mp_edge_header_node h) {
11699 mp_node p, q; /* pointers that scan the list being recycled */
11700 mp_edge_header_node r; /* an edge structure that object |p| refers to */
11701 mp_flush_dash_list (mp, h);
11702 q = mp_link (edge_list (h));
11703 while ((q != NULL)) {
11706 r = mp_toss_gr_object (mp, p);
11708 delete_edge_ref (r);
11710 free_number(h->start_x);
11711 free_number(h->stop_x);
11712 free_number(h->dash_y);
11713 free_number(h->minx);
11714 free_number(h->miny);
11715 free_number(h->maxx);
11716 free_number(h->maxy);
11717 mp_free_token_node (mp, h->list_);
11718 mp_free_node (mp, (mp_node)h, edge_header_size);
11720 void mp_flush_dash_list (MP mp, mp_edge_header_node h) {
11721 mp_dash_node p, q; /* pointers that scan the list being recycled */
11723 while (q != mp->null_dash) { /* todo: NULL check should not be needed */
11725 q = (mp_dash_node)mp_link (q);
11726 mp_free_node (mp, (mp_node)p, dash_node_size);
11728 set_dash_list (h,mp->null_dash);
11730 mp_edge_header_node mp_toss_gr_object (MP mp, mp_node p) {
11731 /* returns an edge structure that needs to be dereferenced */
11732 mp_edge_header_node e = NULL; /* the edge structure to return */
11733 switch (mp_type (p)) {
11734 case mp_fill_node_type:
11735 mp_free_fill_node (mp, (mp_fill_node)p);
11737 case mp_stroked_node_type:
11738 e = mp_free_stroked_node (mp, (mp_stroked_node)p);
11740 case mp_text_node_type:
11741 mp_free_text_node(mp, (mp_text_node)p);
11743 case mp_start_clip_node_type:
11744 mp_free_start_clip_node(mp, (mp_start_clip_node)p);
11746 case mp_start_bounds_node_type:
11747 mp_free_start_bounds_node(mp, (mp_start_bounds_node)p);
11749 case mp_stop_clip_node_type:
11750 mp_free_stop_clip_node(mp, (mp_stop_clip_node)p);
11752 case mp_stop_bounds_node_type:
11753 mp_free_stop_bounds_node(mp, (mp_stop_bounds_node)p);
11755 default: /* there are no other valid cases, but please the compiler */
11762 @ If we use |add_edge_ref| to ``copy'' edge structures, the real copying needs
11763 to be done before making a significant change to an edge structure. Much of
11764 the work is done in a separate routine |copy_objects| that copies a list of
11765 graphical objects into a new edge header.
11768 static mp_edge_header_node mp_private_edges (MP mp, mp_edge_header_node h) {
11769 /* make a private copy of the edge structure headed by |h| */
11770 mp_edge_header_node hh; /* the edge header for the new copy */
11771 mp_dash_node p, pp; /* pointers for copying the dash list */
11772 assert (mp_type (h) == mp_edge_header_node_type);
11773 if (edge_ref_count (h) == 0) {
11776 decr (edge_ref_count (h));
11777 hh = (mp_edge_header_node)mp_copy_objects (mp, mp_link (edge_list (h)), NULL);
11778 @<Copy the dash list from |h| to |hh|@>;
11779 @<Copy the bounding box information from |h| to |hh| and make |bblast(hh)|
11780 point into the new object list@>;
11786 @ Here we use the fact that |dash_list(hh)=mp_link(hh)|.
11787 @^data structure assumptions@>
11789 @<Copy the dash list from |h| to |hh|@>=
11790 pp = (mp_dash_node)hh;
11792 while ((p != mp->null_dash)) {
11793 mp_link (pp) = (mp_node)mp_get_dash_node (mp);
11794 pp = (mp_dash_node)mp_link (pp);
11795 number_clone(pp->start_x, p->start_x);
11796 number_clone(pp->stop_x, p->stop_x);
11797 p = (mp_dash_node)mp_link (p);
11799 mp_link (pp) = (mp_node)mp->null_dash;
11800 number_clone(hh->dash_y, h->dash_y )
11803 @ |h| is an edge structure
11806 static mp_dash_object *mp_export_dashes (MP mp, mp_stroked_node q, mp_number w) {
11809 mp_number scf; /* scale factor */
11811 double *dashes = NULL;
11812 int num_dashes = 1;
11813 h = (mp_dash_node)mp_dash_p (q);
11814 if (h == NULL || dash_list (h) == mp->null_dash)
11818 mp_get_pen_scale (mp, &scf, mp_pen_p (q));
11819 if (number_zero(scf)) {
11820 if (number_zero(w)) {
11821 number_clone(scf, q->dash_scale);
11829 make_scaled (ret, w, scf);
11830 take_scaled (scf, ret, q->dash_scale);
11833 number_clone(w, scf);
11834 d = xmalloc (1, sizeof (mp_dash_object));
11835 add_var_used (sizeof (mp_dash_object));
11836 set_number_from_addition(mp->null_dash->start_x, p->start_x, h->dash_y);
11838 mp_number ret, arg1;
11841 new_number (dashoff);
11842 while (p != mp->null_dash) {
11843 dashes = xrealloc (dashes, (num_dashes + 2), sizeof (double));
11844 set_number_from_substraction (arg1, p->stop_x, p->start_x);
11845 take_scaled (ret, arg1, scf);
11846 dashes[(num_dashes - 1)] = number_to_double (ret);
11847 set_number_from_substraction (arg1, ((mp_dash_node)mp_link (p))->start_x, p->stop_x);
11848 take_scaled (ret, arg1, scf);
11849 dashes[(num_dashes)] = number_to_double (ret);
11850 dashes[(num_dashes + 1)] = -1.0; /* terminus */
11852 p = (mp_dash_node)mp_link (p);
11855 mp_dash_offset (mp, &dashoff, h);
11856 take_scaled (ret, dashoff, scf);
11857 d->offset = number_to_double(ret);
11859 free_number (arg1);
11861 free_number (dashoff);
11867 @ @<Copy the bounding box information from |h| to |hh|...@>=
11868 number_clone(hh->minx, h->minx);
11869 number_clone(hh->miny, h->miny);
11870 number_clone(hh->maxx, h->maxx);
11871 number_clone(hh->maxy, h->maxy);
11872 hh->bbtype = h->bbtype;
11873 p = (mp_dash_node)edge_list (h);
11874 pp = (mp_dash_node)edge_list (hh);
11875 while ((p != (mp_dash_node)bblast (h))) {
11877 mp_confusion (mp, "bblast
");
11878 @:this can't happen bblast}{\quad bblast@>;
11879 p = (mp_dash_node)mp_link (p);
11880 pp = (mp_dash_node)mp_link (pp);
11882 bblast (hh) = (mp_node)pp
11884 @ Here is the promised routine for copying graphical objects into a new edge
11885 structure. It starts copying at object~|p| and stops just before object~|q|.
11886 If |q| is NULL, it copies the entire sublist headed at |p|. The resulting edge
11887 structure requires further initialization by |init_bbox|.
11890 static mp_edge_header_node mp_copy_objects (MP mp, mp_node p, mp_node q);
11893 mp_edge_header_node mp_copy_objects (MP mp, mp_node p, mp_node q) {
11894 mp_edge_header_node hh; /* the new edge header */
11895 mp_node pp; /* the last newly copied object */
11896 quarterword k = 0; /* temporary register */
11897 hh = mp_get_edge_header_node (mp);
11898 set_dash_list (hh, mp->null_dash);
11899 edge_ref_count (hh) = 0;
11900 pp = edge_list (hh);
11902 @<Make |mp_link(pp)| point to a copy of object |p|, and update |p| and |pp|@>;
11904 obj_tail (hh) = pp;
11905 mp_link (pp) = NULL;
11910 @ @<Make |mp_link(pp)| point to a copy of object |p|, and update |p| and |pp|@>=
11912 switch (mp_type (p)) {
11913 case mp_start_clip_node_type:
11914 k = start_clip_size;
11916 case mp_start_bounds_node_type:
11917 k = start_bounds_size;
11919 case mp_fill_node_type:
11920 k = fill_node_size;
11922 case mp_stroked_node_type:
11923 k = stroked_node_size;
11925 case mp_text_node_type:
11926 k = text_node_size;
11928 case mp_stop_clip_node_type:
11929 k = stop_clip_size;
11931 case mp_stop_bounds_node_type:
11932 k = stop_bounds_size;
11934 default: /* there are no other valid cases, but please the compiler */
11937 mp_link (pp) = malloc_node ((size_t) k); /* |gr_object| */
11939 memcpy (pp, p, (size_t) k);
11941 @<Fix anything in graphical object |pp| that should differ from the
11942 corresponding field in |p|@>;
11947 @ @<Fix anything in graphical object |pp| that should differ from the...@>=
11948 switch (mp_type (p)) {
11949 case mp_start_clip_node_type:
11951 mp_start_clip_node tt = (mp_start_clip_node)pp;
11952 mp_start_clip_node t = (mp_start_clip_node)p;
11953 mp_path_p (tt) = mp_copy_path (mp, mp_path_p (t));
11956 case mp_start_bounds_node_type:
11958 mp_start_bounds_node tt = (mp_start_bounds_node)pp;
11959 mp_start_bounds_node t = (mp_start_bounds_node)p;
11960 mp_path_p (tt) = mp_copy_path (mp, mp_path_p (t));
11963 case mp_fill_node_type:
11965 mp_fill_node tt = (mp_fill_node)pp;
11966 mp_fill_node t = (mp_fill_node)p;
11967 new_number(tt->red); number_clone(tt->red, t->red);
11968 new_number(tt->green); number_clone(tt->green, t->green);
11969 new_number(tt->blue); number_clone(tt->blue, t->blue);
11970 new_number(tt->black); number_clone(tt->black, t->black);
11971 new_number(tt->miterlim); number_clone(tt->miterlim,t->miterlim);
11972 mp_path_p (tt) = mp_copy_path (mp, mp_path_p (t));
11973 if (mp_pre_script (p) != NULL)
11974 add_str_ref (mp_pre_script (p));
11975 if (mp_post_script (p) != NULL)
11976 add_str_ref (mp_post_script (p));
11977 if (mp_pen_p (t) != NULL)
11978 mp_pen_p (tt) = copy_pen (mp_pen_p (t));
11981 case mp_stroked_node_type:
11983 mp_stroked_node tt = (mp_stroked_node)pp;
11984 mp_stroked_node t = (mp_stroked_node)p;
11985 new_number(tt->red); number_clone(tt->red, t->red);
11986 new_number(tt->green); number_clone(tt->green, t->green);
11987 new_number(tt->blue); number_clone(tt->blue, t->blue);
11988 new_number(tt->black); number_clone(tt->black, t->black);
11989 new_number(tt->miterlim); number_clone(tt->miterlim,t->miterlim);
11990 new_number(tt->dash_scale); number_clone(tt->dash_scale,t->dash_scale);
11991 if (mp_pre_script (p) != NULL)
11992 add_str_ref (mp_pre_script (p));
11993 if (mp_post_script (p) != NULL)
11994 add_str_ref (mp_post_script (p));
11995 mp_path_p (tt) = mp_copy_path (mp, mp_path_p (t));
11996 mp_pen_p (tt) = copy_pen (mp_pen_p (t));
11997 if (mp_dash_p (p) != NULL)
11998 add_edge_ref (mp_dash_p (pp));
12001 case mp_text_node_type:
12003 mp_text_node tt = (mp_text_node)pp;
12004 mp_text_node t = (mp_text_node)p;
12005 new_number(tt->red); number_clone(tt->red, t->red);
12006 new_number(tt->green); number_clone(tt->green, t->green);
12007 new_number(tt->blue); number_clone(tt->blue, t->blue);
12008 new_number(tt->black); number_clone(tt->black, t->black);
12009 new_number(tt->width); number_clone(tt->width, t->width);
12010 new_number(tt->height); number_clone(tt->height, t->height);
12011 new_number(tt->depth); number_clone(tt->depth, t->depth);
12012 new_number(tt->tx); number_clone(tt->tx, t->tx);
12013 new_number(tt->ty); number_clone(tt->ty, t->ty);
12014 new_number(tt->txx); number_clone(tt->txx, t->txx);
12015 new_number(tt->tyx); number_clone(tt->tyx, t->tyx);
12016 new_number(tt->txy); number_clone(tt->txy, t->txy);
12017 new_number(tt->tyy); number_clone(tt->tyy, t->tyy);
12018 if (mp_pre_script (p) != NULL)
12019 add_str_ref (mp_pre_script (p));
12020 if (mp_post_script (p) != NULL)
12021 add_str_ref (mp_post_script (p));
12022 add_str_ref (mp_text_p (pp));
12025 case mp_stop_clip_node_type:
12026 case mp_stop_bounds_node_type:
12028 default: /* there are no other valid cases, but please the compiler */
12033 @ Here is one way to find an acceptable value for the second argument to
12034 |copy_objects|. Given a non-NULL graphical object list, |skip_1component|
12035 skips past one picture component, where a ``picture component'' is a single
12036 graphical object, or a start bounds or start clip object and everything up
12037 through the matching stop bounds or stop clip object.
12040 static mp_node mp_skip_1component (MP mp, mp_node p) {
12041 integer lev; /* current nesting level */
12045 if (is_start_or_stop (p)) {
12052 } while (lev != 0);
12057 @ Here is a diagnostic routine for printing an edge structure in symbolic form.
12060 static void mp_print_edges (MP mp, mp_node h, const char *s, boolean nuline);
12063 void mp_print_edges (MP mp, mp_node h, const char *s, boolean nuline) {
12064 mp_node p; /* a graphical object to be printed */
12065 mp_number scf; /* a scale factor for the dash pattern */
12066 boolean ok_to_dash; /* |false| for polygonal pen strokes */
12068 mp_print_diagnostic (mp, "Edge structure
", s, nuline);
12070 while (mp_link (p) != NULL) {
12073 switch (mp_type (p)) {
12074 @<Cases for printing graphical object node |p|@>;
12076 mp_print (mp, "[unknown object type
!]");
12080 mp_print_nl (mp, "End edges
");
12081 if (p != obj_tail (h))
12082 mp_print (mp, "?
");
12084 mp_end_diagnostic (mp, true);
12089 @ @<Cases for printing graphical object node |p|@>=
12090 case mp_fill_node_type:
12091 mp_print (mp, "Filled contour
");
12092 mp_print_obj_color (mp, p);
12093 mp_print_char (mp, xord (':'));
12095 mp_pr_path (mp, mp_path_p ((mp_fill_node) p));
12097 if ((mp_pen_p ((mp_fill_node) p) != NULL)) {
12098 @<Print join type for graphical object |p|@>;
12099 mp_print (mp, " with pen
");
12101 mp_pr_pen (mp, mp_pen_p ((mp_fill_node) p));
12105 @ @<Print join type for graphical object |p|@>=
12106 switch (((mp_stroked_node)p)->ljoin) {
12108 mp_print (mp, "mitered joins limited
");
12109 print_number (((mp_stroked_node)p)->miterlim);
12112 mp_print (mp, "round joins
");
12115 mp_print (mp, "beveled joins
");
12118 mp_print (mp, "?? joins
");
12124 @ For stroked nodes, we need to print |lcap_val(p)| as well.
12126 @<Print join and cap types for stroked node |p|@>=
12127 switch (((mp_stroked_node)p)->lcap ) {
12129 mp_print (mp, "butt
");
12132 mp_print (mp, "round
");
12135 mp_print (mp, "square
");
12138 mp_print (mp, "??
");
12142 mp_print (mp, " ends
, ");
12143 @<Print join type for graphical object |p|@>
12146 @ Here is a routine that prints the color of a graphical object if it isn't
12147 black (the default color).
12150 static void mp_print_obj_color (MP mp, mp_node p);
12153 void mp_print_obj_color (MP mp, mp_node p) {
12154 mp_stroked_node p0 = (mp_stroked_node) p;
12155 if (mp_color_model (p) == mp_grey_model) {
12156 if (number_positive(p0->grey)) {
12157 mp_print (mp, "greyed
");
12158 mp_print_char (mp, xord ('('));
12159 print_number (p0->grey);
12160 mp_print_char (mp, xord (')'));
12162 } else if (mp_color_model (p) == mp_cmyk_model) {
12163 if (number_positive(p0->cyan) || number_positive(p0->magenta) ||
12164 number_positive(p0->yellow) || number_positive(p0->black)) {
12165 mp_print (mp, "processcolored
");
12166 mp_print_char (mp, xord ('('));
12167 print_number (p0->cyan);
12168 mp_print_char (mp, xord (','));
12169 print_number (p0->magenta);
12170 mp_print_char (mp, xord (','));
12171 print_number (p0->yellow);
12172 mp_print_char (mp, xord (','));
12173 print_number (p0->black);
12174 mp_print_char (mp, xord (')'));
12176 } else if (mp_color_model (p) == mp_rgb_model) {
12177 if (number_positive(p0->red) || number_positive(p0->green) ||
12178 number_positive(p0->blue)) {
12179 mp_print (mp, "colored
");
12180 mp_print_char (mp, xord ('('));
12181 print_number (p0->red);
12182 mp_print_char (mp, xord (','));
12183 print_number (p0->green);
12184 mp_print_char (mp, xord (','));
12185 print_number (p0->blue);
12186 mp_print_char (mp, xord (')'));
12192 @ @<Cases for printing graphical object node |p|@>=
12193 case mp_stroked_node_type:
12194 mp_print (mp, "Filled pen stroke
");
12195 mp_print_obj_color (mp, p);
12196 mp_print_char (mp, xord (':'));
12198 mp_pr_path (mp, mp_path_p ((mp_stroked_node) p));
12199 if (mp_dash_p (p) != NULL) {
12200 mp_print_nl (mp, "dashed
(");
12201 @<Finish printing the dash pattern that |p| refers to@>;
12204 @<Print join and cap types for stroked node |p|@>;
12205 mp_print (mp, " with pen
");
12207 if (mp_pen_p ((mp_stroked_node) p) == NULL) {
12208 mp_print (mp, "???
"); /* shouldn't happen */
12211 mp_pr_pen (mp, mp_pen_p ((mp_stroked_node) p));
12215 @ Normally, the |dash_list| field in an edge header is set to |null_dash|
12216 when it is not known to define a suitable dash pattern. This is disallowed
12217 here because the |mp_dash_p| field should never point to such an edge header.
12218 Note that memory is allocated for |start_x(null_dash)| and we are free to
12219 give it any convenient value.
12221 @<Finish printing the dash pattern that |p| refers to@>=
12223 mp_dash_node ppd, hhd;
12224 ok_to_dash = pen_is_elliptical (mp_pen_p ((mp_stroked_node) p));
12226 set_number_to_unity (scf);
12228 number_clone(scf, ((mp_stroked_node) p)->dash_scale);
12229 hhd = (mp_dash_node)mp_dash_p (p);
12230 ppd = dash_list (hhd);
12231 if ((ppd == mp->null_dash) || number_negative(hhd->dash_y)) {
12232 mp_print (mp, " ??
");
12235 mp_number ret, arg1;
12238 new_number (dashoff);
12239 set_number_from_addition(mp->null_dash->start_x, ppd->start_x, hhd->dash_y );
12240 while (ppd != mp->null_dash) {
12241 mp_print (mp, "on
");
12242 set_number_from_substraction (arg1, ppd->stop_x, ppd->start_x);
12243 take_scaled (ret, arg1, scf);
12244 print_number ( ret);
12245 mp_print (mp, " off
");
12246 set_number_from_substraction (arg1, ((mp_dash_node)mp_link (ppd))->start_x, ppd->stop_x);
12247 take_scaled (ret, arg1, scf);
12248 print_number (ret);
12249 ppd = (mp_dash_node)mp_link (ppd);
12250 if (ppd != mp->null_dash)
12251 mp_print_char (mp, xord (' '));
12253 mp_print (mp, ") shifted
");
12254 mp_dash_offset (mp, &dashoff, hhd);
12255 take_scaled (ret, dashoff, scf);
12256 number_negate (ret);
12257 print_number (ret);
12258 free_number (dashoff);
12260 free_number (arg1);
12261 if (!ok_to_dash || number_zero(hhd->dash_y) )
12262 mp_print (mp, " (this will be ignored
)");
12266 @ @<Declarations@>=
12267 static void mp_dash_offset (MP mp, mp_number *x, mp_dash_node h);
12270 void mp_dash_offset (MP mp, mp_number *x, mp_dash_node h) {
12271 if (dash_list (h) == mp->null_dash || number_negative(h->dash_y ))
12272 mp_confusion (mp, "dash0
");
12273 @:this can't happen dash0}{\quad dash0@>;
12274 if (number_zero(h->dash_y)) {
12275 set_number_to_zero(*x);
12277 number_clone (*x, (dash_list (h))->start_x );
12278 number_modulo (*x, h->dash_y);
12279 number_negate (*x);
12280 if (number_negative(*x))
12281 number_add(*x, h->dash_y);
12286 @ @<Cases for printing graphical object node |p|@>=
12287 case mp_text_node_type:
12289 mp_text_node p0 = (mp_text_node)p;
12290 mp_print_char (mp, xord ('"'
));
12291 mp_print_str
(mp
, mp_text_p
(p
));
12292 mp_print
(mp
, "\" infont \
"");
12293 mp_print
(mp
, mp-
>font_name
[mp_font_n
(p
)]);
12294 mp_print_char
(mp
, xord
('
"'));
12296 mp_print_obj_color (mp, p);
12297 mp_print (mp, "transformed
");
12298 mp_print_char (mp, xord ('('));
12299 print_number (p0->tx);
12300 mp_print_char (mp, xord (','));
12301 print_number (p0->ty);
12302 mp_print_char (mp, xord (','));
12303 print_number (p0->txx);
12304 mp_print_char (mp, xord (','));
12305 print_number (p0->txy);
12306 mp_print_char (mp, xord (','));
12307 print_number (p0->tyx);
12308 mp_print_char (mp, xord (','));
12309 print_number (p0->tyy);
12310 mp_print_char (mp, xord (')'));
12314 @ @<Cases for printing graphical object node |p|@>=
12315 case mp_start_clip_node_type:
12316 mp_print (mp, "clipping path
:");
12318 mp_pr_path (mp, mp_path_p ((mp_start_clip_node) p));
12320 case mp_stop_clip_node_type:
12321 mp_print (mp, "stop clipping
");
12324 @ @<Cases for printing graphical object node |p|@>=
12325 case mp_start_bounds_node_type:
12326 mp_print (mp, "setbounds path
:");
12328 mp_pr_path (mp, mp_path_p ((mp_start_bounds_node) p));
12330 case mp_stop_bounds_node_type:
12331 mp_print (mp, "end of setbounds
");
12334 @ To initialize the |dash_list| field in an edge header~|h|, we need a
12335 subroutine that scans an edge structure and tries to interpret it as a dash
12336 pattern. This can only be done when there are no filled regions or clipping
12337 paths and all the pen strokes have the same color. The first step is to let
12338 $y_0$ be the initial $y$~coordinate of the first pen stroke. Then we implicitly
12339 project all the pen stroke paths onto the line $y=y_0$ and require that there
12340 be no retracing. If the resulting paths cover a range of $x$~coordinates of
12341 length $\Delta x$, we set |dash_y(h)| to the length of the dash pattern by
12342 finding the maximum of $\Delta x$ and the absolute value of~$y_0$.
12345 static mp_edge_header_node mp_make_dashes (MP mp, mp_edge_header_node h) { /* returns |h| or |NULL| */
12346 mp_node p; /* this scans the stroked nodes in the object list */
12347 mp_node p0; /* if not |NULL| this points to the first stroked node */
12348 mp_knot pp, qq, rr; /* pointers into |mp_path_p(p)| */
12349 mp_dash_node d, dd; /* pointers used to create the dash list */
12351 @<Other local variables in |make_dashes|@>;
12352 if (dash_list (h) != mp->null_dash)
12354 new_number (y0); /* the initial $y$ coordinate */
12356 p = mp_link (edge_list (h));
12357 while (p != NULL) {
12358 if (mp_type (p) != mp_stroked_node_type) {
12359 @<Compain that the edge structure contains a node of the wrong type
12360 and |goto not_found|@>;
12362 pp = mp_path_p ((mp_stroked_node) p);
12365 number_clone(y0, pp->y_coord);
12367 @<Make |d| point to a new dash node created from stroke |p| and path |pp|
12368 or |goto not_found| if there is an error@>;
12369 @<Insert |d| into the dash list and |goto not_found| if there is an error@>;
12372 if (dash_list (h) == mp->null_dash)
12373 goto NOT_FOUND; /* No error message */
12374 @<Scan |dash_list(h)| and deal with any dashes that are themselves dashed@>;
12375 @<Set |dash_y(h)| and merge the first and last dashes if necessary@>;
12380 @<Flush the dash list, recycle |h| and return |NULL|@>;
12384 @ @<Compain that the edge structure contains a node of the wrong type...@>=
12386 const char *hlp[] = {
12387 "When you say `dashed p'
, picture p should not contain any
",
12388 "text
, filled regions
, or clipping paths. This time it did
",
12389 "so I'll just make it a solid line instead.
",
12391 mp_back_error (mp, "Picture is too complicated to use as a dash pattern
", hlp, true);
12392 mp_get_x_next (mp);
12397 @ A similar error occurs when monotonicity fails.
12400 static void mp_x_retrace_error (MP mp);
12403 void mp_x_retrace_error (MP mp) {
12404 const char *hlp[] = {
12405 "When you say `dashed p'
, every path in p should be monotone
",
12406 "in x and there must be no overlapping. This failed
",
12407 "so I'll just make it a solid line instead.
",
12409 mp_back_error (mp, "Picture is too complicated to use as a dash pattern
", hlp, true);
12410 mp_get_x_next (mp);
12414 @ We stash |p| in |dash_info(d)| if |mp_dash_p(p)<>0| so that subsequent processing can
12415 handle the case where the pen stroke |p| is itself dashed.
12417 @d dash_info(A) ((mp_dash_node)(A))->dash_info_ /* in an edge header this points to the first dash node */
12419 @<Make |d| point to a new dash node created from stroke |p| and path...@>=
12420 @<Make sure |p| and |p0| are the same color and |goto not_found| if there is
12423 if (mp_next_knot (pp) != pp) {
12426 rr = mp_next_knot (rr);
12427 @<Check for retracing between knots |qq| and |rr| and |goto not_found|
12428 if there is a problem@>;
12429 } while (mp_right_type (rr) != mp_endpoint);
12431 d = (mp_dash_node)mp_get_dash_node (mp);
12432 if (mp_dash_p (p) == NULL)
12433 dash_info (d) = NULL;
12436 if (number_less (pp->x_coord, rr->x_coord)) {
12437 number_clone(d->start_x, pp->x_coord);
12438 number_clone(d->stop_x, rr->x_coord);
12440 number_clone(d->start_x, rr->x_coord);
12441 number_clone(d->stop_x, pp->x_coord);
12445 @ We also need to check for the case where the segment from |qq| to |rr| is
12446 monotone in $x$ but is reversed relative to the path from |pp| to |qq|.
12448 @<Check for retracing between knots |qq| and |rr| and |goto not_found|...@>=
12450 mp_number x0, x1, x2, x3; /* $x$ coordinates of the segment from |qq| to |rr| */
12455 number_clone(x0, qq->x_coord);
12456 number_clone(x1, qq->right_x);
12457 number_clone(x2, rr->left_x);
12458 number_clone(x3, rr->x_coord);
12459 if (number_greater(x0, x1) || number_greater(x1, x2) || number_greater(x2, x3)) {
12460 if (number_less(x0, x1) || number_less(x1, x2) || number_less(x2, x3)) {
12461 mp_number a1, a2, a3, a4;
12468 set_number_from_substraction(a1, x2, x1);
12469 set_number_from_substraction(a2, x2, x1);
12470 set_number_from_substraction(a3, x1, x0);
12471 set_number_from_substraction(a4, x3, x2);
12472 ab_vs_cd (test, a1, a2, a3, a4);
12477 if (number_positive(test)) {
12478 mp_x_retrace_error (mp);
12489 if (number_greater(pp->x_coord, x0) || number_greater(x0, x3)) {
12490 if (number_less (pp->x_coord, x0) || number_less(x0, x3)) {
12491 mp_x_retrace_error (mp);
12505 @ @<Make sure |p| and |p0| are the same color and |goto not_found|...@>=
12506 if (!number_equal(((mp_stroked_node)p)->red, ((mp_stroked_node)p0)->red) ||
12507 !number_equal(((mp_stroked_node)p)->black, ((mp_stroked_node)p0)->black) ||
12508 !number_equal(((mp_stroked_node)p)->green, ((mp_stroked_node)p0)->green) ||
12509 !number_equal(((mp_stroked_node)p)->blue, ((mp_stroked_node)p0)->blue)
12511 const char *hlp[] = {
12512 "When you say `dashed p'
, everything in picture p should
",
12513 "be the same color. I can\'t handle your color changes
",
12514 "so I'll just make it a solid line instead.
",
12516 mp_back_error (mp, "Picture is too complicated to use as a dash pattern
", hlp, true);
12517 mp_get_x_next (mp);
12521 @ @<Insert |d| into the dash list and |goto not_found| if there is an error@>=
12522 number_clone(mp->null_dash->start_x, d->stop_x);
12523 dd = (mp_dash_node)h; /* this makes |mp_link(dd)=dash_list(h)| */
12524 while (number_less(((mp_dash_node)mp_link (dd))->start_x, d->stop_x ))
12525 dd = (mp_dash_node)mp_link (dd);
12526 if (dd != (mp_dash_node)h) {
12527 if (number_greater(dd->stop_x, d->start_x)) {
12528 mp_x_retrace_error (mp);
12532 mp_link (d) = mp_link (dd);
12533 mp_link (dd) = (mp_node)d
12535 @ @<Set |dash_y(h)| and merge the first and last dashes if necessary@>=
12537 while ((mp_link (d) != (mp_node)mp->null_dash))
12538 d = (mp_dash_node)mp_link (d);
12539 dd = dash_list (h);
12540 set_number_from_substraction(h->dash_y, d->stop_x, dd->start_x);
12543 new_number (absval);
12544 number_clone (absval, y0);
12545 number_abs (absval);
12546 if (number_greater (absval, h->dash_y) ) {
12547 number_clone(h->dash_y, absval);
12548 } else if (d != dd) {
12549 set_dash_list (h, mp_link (dd));
12550 set_number_from_addition(d->stop_x, dd->stop_x, h->dash_y);
12551 mp_free_node (mp, (mp_node)dd, dash_node_size);
12553 free_number (absval);
12555 @ We get here when the argument is a NULL picture or when there is an error.
12556 Recovering from an error involves making |dash_list(h)| empty to indicate
12557 that |h| is not known to be a valid dash pattern. We also dereference |h|
12558 since it is not being used for the return value.
12560 @<Flush the dash list, recycle |h| and return |NULL|@>=
12561 mp_flush_dash_list (mp, h);
12562 delete_edge_ref (h);
12565 @ Having carefully saved the dashed stroked nodes in the
12566 corresponding dash nodes, we must be prepared to break up these dashes into
12569 @<Scan |dash_list(h)| and deal with any dashes that are themselves dashed@>=
12571 mp_number hsf; /* the dash pattern from |hh| gets scaled by this */
12573 d = (mp_dash_node)h; /* now |mp_link(d)=dash_list(h)| */
12574 while (mp_link (d) != (mp_node)mp->null_dash) {
12575 ds = dash_info (mp_link (d));
12577 d = (mp_dash_node)mp_link (d);
12579 hh = (mp_edge_header_node)mp_dash_p (ds);
12580 number_clone(hsf, ((mp_stroked_node)ds)->dash_scale);
12582 mp_confusion (mp, "dash1
");
12583 @:this can't happen dash0}{\quad dash1@>;
12584 /* clang: dereference null pointer 'hh' */ assert(hh);
12585 if (number_zero(((mp_dash_node)hh)->dash_y )) {
12586 d = (mp_dash_node)mp_link (d);
12588 if (dash_list (hh) == NULL)
12589 mp_confusion (mp, "dash1
");
12590 @:this can't happen dash0}{\quad dash1@>;
12591 @<Replace |mp_link(d)| by a dashed version as determined by edge header
12592 |hh| and scale factor |ds|@>;
12599 @ @<Other local variables in |make_dashes|@>=
12600 mp_dash_node dln; /* |mp_link(d)| */
12601 mp_edge_header_node hh; /* an edge header that tells how to break up |dln| */
12602 mp_node ds; /* the stroked node from which |hh| and |hsf| are derived */
12604 @ @<Replace |mp_link(d)| by a dashed version as determined by edge header...@>=
12606 mp_number xoff; /* added to $x$ values in |dash_list(hh)| to match |dln| */
12611 dln = (mp_dash_node)mp_link (d);
12612 dd = dash_list (hh);
12613 /* clang: dereference null pointer 'dd' */ assert(dd);
12615 new_number (dashoff);
12616 mp_dash_offset (mp, &dashoff, (mp_dash_node)hh);
12617 take_scaled (r1, hsf, dd->start_x);
12618 take_scaled (r2, hsf, dashoff);
12619 number_add (r1, r2);
12620 set_number_from_substraction(xoff, dln->start_x, r1);
12621 free_number (dashoff);
12622 take_scaled (r1, hsf, dd->start_x);
12623 take_scaled (r2, hsf, hh->dash_y);
12624 set_number_from_addition(mp->null_dash->start_x, r1, r2);
12625 number_clone(mp->null_dash->stop_x, mp->null_dash->start_x);
12626 @<Advance |dd| until finding the first dash that overlaps |dln| when
12627 offset by |xoff|@>;
12628 while (number_lessequal(dln->start_x, dln->stop_x)) {
12629 @<If |dd| has `fallen off the end', back up to the beginning and fix |xoff|@>;
12630 @<Insert a dash between |d| and |dln| for the overlap with the offset version
12632 dd = (mp_dash_node)mp_link (dd);
12633 take_scaled (r1, hsf, dd->start_x);
12634 set_number_from_addition(dln->start_x , xoff, r1);
12639 mp_link (d) = mp_link (dln);
12640 mp_free_node (mp, (mp_node)dln, dash_node_size);
12644 @ The name of this module is a bit of a lie because we just find the
12645 first |dd| where |take_scaled (hsf, stop_x(dd))| is large enough to make an
12646 overlap possible. It could be that the unoffset version of dash |dln| falls
12647 in the gap between |dd| and its predecessor.
12649 @<Advance |dd| until finding the first dash that overlaps |dln| when...@>=
12653 take_scaled (r1, hsf, dd->stop_x);
12654 number_add (r1, xoff);
12655 while (number_less(r1, dln->start_x)) {
12656 dd = (mp_dash_node)mp_link (dd);
12657 take_scaled (r1, hsf, dd->stop_x);
12658 number_add (r1, xoff);
12663 @ @<If |dd| has `fallen off the end', back up to the beginning and fix...@>=
12664 if (dd == mp->null_dash) {
12667 dd = dash_list (hh);
12668 take_scaled (ret, hsf, hh->dash_y);
12669 number_add(xoff, ret);
12673 @ At this point we already know that |start_x(dln)<=xoff+take_scaled(hsf,stop_x(dd))|.
12675 @<Insert a dash between |d| and |dln| for the overlap with the offset...@>=
12679 take_scaled (r1, hsf, dd->start_x);
12680 number_add (r1, xoff);
12681 if (number_lessequal(r1, dln->stop_x)) {
12682 mp_link (d) = (mp_node)mp_get_dash_node (mp);
12683 d = (mp_dash_node)mp_link (d);
12684 mp_link (d) = (mp_node)dln;
12685 take_scaled (r1, hsf, dd->start_x );
12686 number_add (r1, xoff);
12687 if (number_greater(dln->start_x, r1))
12688 number_clone(d->start_x, dln->start_x);
12690 number_clone(d->start_x, r1);
12692 take_scaled (r1, hsf, dd->stop_x);
12693 number_add (r1, xoff);
12694 if (number_less(dln->stop_x, r1))
12695 number_clone(d->stop_x, dln->stop_x );
12697 number_clone(d->stop_x, r1);
12703 @ The next major task is to update the bounding box information in an edge
12704 header~|h|. This is done via a procedure |adjust_bbox| that enlarges an edge
12705 header's bounding box to accommodate the box computed by |path_bbox| or
12706 |pen_bbox|. (This is stored in global variables |minx|, |miny|, |maxx|, and
12710 static void mp_adjust_bbox (MP mp, mp_edge_header_node h) {
12711 if (number_less (mp_minx, h->minx))
12712 number_clone(h->minx, mp_minx);
12713 if (number_less (mp_miny, h->miny))
12714 number_clone(h->miny, mp_miny);
12715 if (number_greater (mp_maxx, h->maxx))
12716 number_clone(h->maxx, mp_maxx);
12717 if (number_greater (mp_maxy, h->maxy))
12718 number_clone(h->maxy, mp_maxy);
12722 @ Here is a special routine for updating the bounding box information in
12723 edge header~|h| to account for the squared-off ends of a non-cyclic path~|p|
12724 that is to be stroked with the pen~|pp|.
12727 static void mp_box_ends (MP mp, mp_knot p, mp_knot pp, mp_edge_header_node h) {
12728 mp_knot q; /* a knot node adjacent to knot |p| */
12729 mp_fraction dx, dy; /* a unit vector in the direction out of the path at~|p| */
12730 mp_number d; /* a factor for adjusting the length of |(dx,dy)| */
12731 mp_number z; /* a coordinate being tested against the bounding box */
12732 mp_number xx, yy; /* the extreme pen vertex in the |(dx,dy)| direction */
12733 integer i; /* a loop counter */
12740 if (mp_right_type (p) != mp_endpoint) {
12741 q = mp_next_knot (p);
12743 @<Make |(dx,dy)| the final direction for the path segment from
12744 |q| to~|p|; set~|d|@>;
12745 pyth_add (d, dx, dy);
12746 if (number_positive(d)) {
12747 @<Normalize the direction |(dx,dy)| and find the pen offset |(xx,yy)|@>;
12748 for (i = 1; i <= 2; i++) {
12749 @<Use |(dx,dy)| to generate a vertex of the square end cap and
12750 update the bounding box to accommodate it@>;
12755 if (mp_right_type (p) == mp_endpoint) {
12758 @<Advance |p| to the end of the path and make |q| the previous knot@>;
12772 @ @<Make |(dx,dy)| the final direction for the path segment from...@>=
12773 if (q == mp_next_knot (p)) {
12774 set_number_from_substraction(dx, p->x_coord, p->right_x);
12775 set_number_from_substraction(dy, p->y_coord, p->right_y);
12776 if (number_zero(dx) && number_zero(dy)) {
12777 set_number_from_substraction(dx, p->x_coord, q->left_x);
12778 set_number_from_substraction(dy, p->y_coord, q->left_y);
12781 set_number_from_substraction(dx, p->x_coord, p->left_x);
12782 set_number_from_substraction(dy, p->y_coord, p->left_y);
12783 if (number_zero(dx) && number_zero(dy)) {
12784 set_number_from_substraction(dx, p->x_coord, q->right_x);
12785 set_number_from_substraction(dy, p->y_coord, q->right_y);
12788 set_number_from_substraction(dx, p->x_coord, q->x_coord);
12789 set_number_from_substraction(dy, p->y_coord, q->y_coord);
12792 @ @<Normalize the direction |(dx,dy)| and find the pen offset |(xx,yy)|@>=
12797 make_fraction (r, dx, d);
12798 number_clone(dx, r);
12799 make_fraction (r, dy, d);
12800 number_clone(dy, r);
12802 number_clone(arg1, dy);
12803 number_negate(arg1);
12804 mp_find_offset (mp, arg1, dx, pp);
12806 number_clone(xx, mp->cur_x);
12807 number_clone(yy, mp->cur_y);
12810 @ @<Use |(dx,dy)| to generate a vertex of the square end cap and...@>=
12812 mp_number r1, r2, arg1;
12816 mp_find_offset (mp, dx, dy, pp);
12817 set_number_from_substraction (arg1, xx, mp->cur_x);
12818 take_fraction (r1, arg1, dx);
12819 set_number_from_substraction (arg1, yy, mp->cur_y);
12820 take_fraction (r2, arg1, dy);
12821 set_number_from_addition(d, r1, r2);
12822 if ((number_negative(d) && (i == 1)) || (number_positive(d) && (i == 2)))
12823 mp_confusion (mp, "box_ends
");
12824 @:this can't happen box ends}{\quad\\{box\_ends}@>;
12825 take_fraction (r1, d, dx);
12826 set_number_from_addition(z, p->x_coord, mp->cur_x);
12827 number_add (z, r1);
12828 if (number_less(z, h->minx))
12829 number_clone(h->minx, z);
12830 if (number_greater(z, h->maxx))
12831 number_clone(h->maxx, z);
12832 take_fraction (r1, d, dy);
12833 set_number_from_addition(z, p->y_coord, mp->cur_y);
12834 number_add (z, r1);
12835 if (number_less(z, h->miny))
12836 number_clone(h->miny, z);
12837 if (number_greater(z, h->maxy))
12838 number_clone(h->maxy, z);
12841 free_number (arg1);
12844 @ @<Advance |p| to the end of the path and make |q| the previous knot@>=
12847 p = mp_next_knot (p);
12848 } while (mp_right_type (p) != mp_endpoint)
12850 @ The major difficulty in finding the bounding box of an edge structure is the
12851 effect of clipping paths. We treat them conservatively by only clipping to the
12852 clipping path's bounding box, but this still
12853 requires recursive calls to |set_bbox| in order to find the bounding box of
12855 the objects to be clipped. Such calls are distinguished by the fact that the
12856 boolean parameter |top_level| is false.
12859 void mp_set_bbox (MP mp, mp_edge_header_node h, boolean top_level) {
12860 mp_node p; /* a graphical object being considered */
12861 integer lev; /* nesting level for |mp_start_bounds_node| nodes */
12862 /* Wipe out any existing bounding box information if |bbtype(h)| is
12863 incompatible with |internal[mp_true_corners]| */
12864 switch (h->bbtype ) {
12868 if (number_positive(internal_value (mp_true_corners)))
12869 mp_init_bbox (mp, h);
12872 if (number_nonpositive(internal_value (mp_true_corners)))
12873 mp_init_bbox (mp, h);
12875 } /* there are no other cases */
12877 while (mp_link (bblast (h)) != NULL) {
12878 p = mp_link (bblast (h));
12880 switch (mp_type (p)) {
12881 case mp_stop_clip_node_type:
12883 mp_confusion (mp, "bbox
");
12886 @:this can't happen bbox}{\quad bbox@>;
12888 @<Other cases for updating the bounding box based on the type of object |p|@>;
12889 default: /* there are no other valid cases, but please the compiler */
12894 mp_confusion (mp, "bbox
");
12898 @ @<Declarations@>=
12899 static void mp_set_bbox (MP mp, mp_edge_header_node h, boolean top_level);
12902 @ @<Other cases for updating the bounding box...@>=
12903 case mp_fill_node_type:
12904 mp_path_bbox (mp, mp_path_p ((mp_fill_node) p));
12905 if (mp_pen_p ((mp_fill_node) p) != NULL) {
12906 mp_number x0a, y0a, x1a, y1a;
12911 number_clone (x0a, mp_minx);
12912 number_clone (y0a, mp_miny);
12913 number_clone (x1a, mp_maxx);
12914 number_clone (y1a, mp_maxy);
12915 mp_pen_bbox (mp, mp_pen_p ((mp_fill_node) p));
12916 number_add (mp_minx, x0a);
12917 number_add (mp_miny, y0a);
12918 number_add (mp_maxx, x1a);
12919 number_add (mp_maxy, y1a);
12925 mp_adjust_bbox (mp, h);
12928 @ @<Other cases for updating the bounding box...@>=
12929 case mp_start_bounds_node_type:
12930 if (number_positive (internal_value (mp_true_corners))) {
12931 h->bbtype = bounds_unset;
12933 h->bbtype = bounds_set;
12934 mp_path_bbox (mp, mp_path_p ((mp_start_bounds_node) p));
12935 mp_adjust_bbox (mp, h);
12936 @<Scan to the matching |mp_stop_bounds_node| node and update |p| and
12940 case mp_stop_bounds_node_type:
12941 if (number_nonpositive (internal_value (mp_true_corners)))
12942 mp_confusion (mp, "bbox2
");
12943 @:this can't happen bbox2}{\quad bbox2@>;
12946 @ @<Scan to the matching |mp_stop_bounds_node| node and update |p| and...@>=
12949 if (mp_link (p) == NULL)
12950 mp_confusion (mp, "bbox2
");
12951 @:this can't happen bbox2}{\quad bbox2@>;
12952 /* clang: dereference null pointer */ assert(mp_link(p));
12954 if (mp_type (p) == mp_start_bounds_node_type)
12956 else if (mp_type (p) == mp_stop_bounds_node_type)
12961 @ It saves a lot of grief here to be slightly conservative and not account for
12962 omitted parts of dashed lines. We also don't worry about the material omitted
12963 when using butt end caps. The basic computation is for round end caps and
12964 |box_ends| augments it for square end caps.
12966 @<Other cases for updating the bounding box...@>=
12967 case mp_stroked_node_type:
12968 mp_path_bbox (mp, mp_path_p ((mp_stroked_node) p));
12970 mp_number x0a, y0a, x1a, y1a;
12975 number_clone (x0a, mp_minx);
12976 number_clone (y0a, mp_miny);
12977 number_clone (x1a, mp_maxx);
12978 number_clone (y1a, mp_maxy);
12979 mp_pen_bbox (mp, mp_pen_p ((mp_stroked_node) p));
12980 number_add (mp_minx, x0a);
12981 number_add (mp_miny, y0a);
12982 number_add (mp_maxx, x1a);
12983 number_add (mp_maxy, y1a);
12989 mp_adjust_bbox (mp, h);
12990 if ((mp_left_type (mp_path_p ((mp_stroked_node) p)) == mp_endpoint)
12991 && (((mp_stroked_node) p)->lcap == 2))
12992 mp_box_ends (mp, mp_path_p ((mp_stroked_node) p),
12993 mp_pen_p ((mp_stroked_node) p), h);
12996 @ The height width and depth information stored in a text node determines a
12997 rectangle that needs to be transformed according to the transformation
12998 parameters stored in the text node.
13000 @<Other cases for updating the bounding box...@>=
13001 case mp_text_node_type:
13003 mp_number x0a, y0a, x1a, y1a, arg1;
13004 mp_text_node p0 = (mp_text_node)p;
13010 number_clone (arg1, p0->depth);
13011 number_negate (arg1);
13012 take_scaled (x1a, p0->txx, p0->width);
13013 take_scaled (y0a, p0->txy, arg1);
13014 take_scaled (y1a, p0->txy, p0->height);
13015 number_clone (mp_minx, p0->tx);
13016 number_clone (mp_maxx, mp_minx);
13017 if (number_less(y0a, y1a)) {
13018 number_add (mp_minx, y0a);
13019 number_add (mp_maxx, y1a);
13021 number_add (mp_minx, y1a);
13022 number_add (mp_maxx, y0a);
13024 if (number_negative(x1a))
13025 number_add (mp_minx, x1a);
13027 number_add (mp_maxx, x1a);
13028 take_scaled (x1a, p0->tyx, p0->width);
13029 number_clone (arg1, p0->depth);
13030 number_negate (arg1);
13031 take_scaled (y0a, p0->tyy, arg1);
13032 take_scaled (y1a, p0->tyy, p0->height);
13033 number_clone (mp_miny, p0->ty);
13034 number_clone (mp_maxy, mp_miny);
13035 if (number_less (y0a, y1a)) {
13036 number_add (mp_miny, y0a);
13037 number_add (mp_maxy, y1a);
13039 number_add (mp_miny, y1a);
13040 number_add (mp_maxy, y0a);
13042 if (number_negative(x1a))
13043 number_add (mp_miny, x1a);
13045 number_add (mp_maxy, x1a);
13046 mp_adjust_bbox (mp, h);
13051 free_number (arg1);
13055 @ This case involves a recursive call that advances |bblast(h)| to the node of
13056 type |mp_stop_clip_node| that matches |p|.
13058 @<Other cases for updating the bounding box...@>=
13059 case mp_start_clip_node_type:
13061 mp_number sminx, sminy, smaxx, smaxy;
13062 /* for saving the bounding box during recursive calls */
13063 mp_number x0a, y0a, x1a, y1a;
13068 new_number (sminx);
13069 new_number (sminy);
13070 new_number (smaxx);
13071 new_number (smaxy);
13072 mp_path_bbox (mp, mp_path_p ((mp_start_clip_node) p));
13073 number_clone (x0a, mp_minx);
13074 number_clone (y0a, mp_miny);
13075 number_clone (x1a, mp_maxx);
13076 number_clone (y1a, mp_maxy);
13077 number_clone (sminx, h->minx);
13078 number_clone (sminy, h->miny);
13079 number_clone (smaxx, h->maxx);
13080 number_clone (smaxy, h->maxy);
13081 @<Reinitialize the bounding box in header |h| and call |set_bbox| recursively
13082 starting at |mp_link(p)|@>;
13083 @<Clip the bounding box in |h| to the rectangle given by |x0a|, |x1a|,
13085 number_clone (mp_minx, sminx);
13086 number_clone (mp_miny, sminy);
13087 number_clone (mp_maxx, smaxx);
13088 number_clone (mp_maxy, smaxy);
13089 mp_adjust_bbox (mp, h);
13090 free_number (sminx);
13091 free_number (sminy);
13092 free_number (smaxx);
13093 free_number (smaxy);
13101 @ @<Reinitialize the bounding box in header |h| and call |set_bbox|...@>=
13102 set_number_to_inf(h->minx);
13103 set_number_to_inf(h->miny);
13104 set_number_to_neg_inf(h->maxx);
13105 set_number_to_neg_inf(h->maxy);
13106 mp_set_bbox (mp, h, false)
13109 @ @<Clip the bounding box in |h| to the rectangle given by |x0a|, |x1a|,...@>=
13110 if (number_less(h->minx, x0a))
13111 number_clone(h->minx, x0a);
13112 if (number_less(h->miny, y0a))
13113 number_clone(h->miny, y0a);
13114 if (number_greater(h->maxx, x1a))
13115 number_clone(h->maxx, x1a);
13116 if (number_greater(h->maxy, y1a))
13117 number_clone(h->maxy, y1a);
13119 @* Finding an envelope.
13120 When \MP\ has a path and a polygonal pen, it needs to express the desired
13121 shape in terms of things \ps\ can understand. The present task is to compute
13122 a new path that describes the region to be filled. It is convenient to
13123 define this as a two step process where the first step is determining what
13124 offset to use for each segment of the path.
13126 @ Given a pointer |c| to a cyclic path,
13127 and a pointer~|h| to the first knot of a pen polygon,
13128 the |offset_prep| routine changes the path into cubics that are
13129 associated with particular pen offsets. Thus if the cubic between |p|
13130 and~|q| is associated with the |k|th offset and the cubic between |q| and~|r|
13131 has offset |l| then |mp_info(q)=zero_off+l-k|. (The constant |zero_off| is added
13132 to because |l-k| could be negative.)
13134 After overwriting the type information with offset differences, we no longer
13135 have a true path so we refer to the knot list returned by |offset_prep| as an
13138 Since an envelope spec only determines relative changes in pen offsets,
13139 |offset_prep| sets a global variable |spec_offset| to the relative change from
13140 |h| to the first offset.
13142 @d zero_off 16384 /* added to offset changes to make them positive */
13145 integer spec_offset; /* number of pen edges between |h| and the initial offset */
13148 static mp_knot mp_offset_prep (MP mp, mp_knot c, mp_knot h) {
13149 int n; /* the number of vertices in the pen polygon */
13150 mp_knot c0, p, q, q0, r, w, ww; /* for list manipulation */
13151 int k_needed; /* amount to be added to |mp_info(p)| when it is computed */
13152 mp_knot w0; /* a pointer to pen offset to use just before |p| */
13153 mp_number dxin, dyin; /* the direction into knot |p| */
13154 int turn_amt; /* change in pen offsets for the current cubic */
13155 mp_number max_coef; /* used while scaling */
13157 @<Other local variables for |offset_prep|@>;
13158 new_number(max_coef);
13189 @<Initialize the pen size~|n|@>;
13190 @<Initialize the incoming direction and pen offset at |c|@>;
13195 q = mp_next_knot (p);
13196 @<Split the cubic between |p| and |q|, if necessary, into cubics
13197 associated with single offsets, after which |q| should
13198 point to the end of the final such cubic@>;
13200 @<Advance |p| to node |q|, removing any ``dead'' cubics that
13201 might have been introduced by the splitting process@>;
13203 @<Fix the offset change in |mp_knot_info(c)| and set |c| to the return value of
13207 free_number (dxin);
13208 free_number (dyin);
13217 free_number (max_coef);
13240 @ We shall want to keep track of where certain knots on the cyclic path
13241 wind up in the envelope spec. It doesn't suffice just to keep pointers to
13242 knot nodes because some nodes are deleted while removing dead cubics. Thus
13243 |offset_prep| updates the following pointers
13247 mp_knot spec_p2; /* pointers to distinguished knots */
13250 mp->spec_p1 = NULL;
13251 mp->spec_p2 = NULL;
13253 @ @<Initialize the pen size~|n|@>=
13258 p = mp_next_knot (p);
13261 @ Since the true incoming direction isn't known yet, we just pick a direction
13262 consistent with the pen offset~|h|. If this is wrong, it can be corrected
13265 @<Initialize the incoming direction and pen offset at |c|@>=
13267 mp_knot hn = mp_next_knot (h);
13268 mp_knot hp = mp_prev_knot (h);
13269 set_number_from_substraction(dxin, hn->x_coord, hp->x_coord);
13270 set_number_from_substraction(dyin, hn->y_coord, hp->y_coord);
13271 if (number_zero(dxin) && number_zero(dyin)) {
13272 set_number_from_substraction(dxin, hp->y_coord, h->y_coord);
13273 set_number_from_substraction(dyin, h->x_coord, hp->x_coord);
13278 @ We must be careful not to remove the only cubic in a cycle.
13280 But we must also be careful for another reason. If the user-supplied
13281 path starts with a set of degenerate cubics, the target node |q| can
13282 be collapsed to the initial node |p| which might be the same as the
13283 initial node |c| of the curve. This would cause the |offset_prep| routine
13284 to bail out too early, causing distress later on. (See for example
13285 the testcase reported by Bogus\l{}aw Jackowski in tracker id 267, case 52c
13288 @<Advance |p| to node |q|, removing any ``dead'' cubics...@>=
13291 r = mp_next_knot (p);
13292 if (number_equal (p->x_coord, p->right_x) &&
13293 number_equal (p->y_coord, p->right_y) &&
13294 number_equal (p->x_coord, r->left_x) &&
13295 number_equal (p->y_coord, r->left_y) &&
13296 number_equal (p->x_coord, r->x_coord) &&
13297 number_equal (p->y_coord, r->y_coord) &&
13298 r != p && r != q) {
13299 @<Remove the cubic following |p| and update the data structures
13300 to merge |r| into |p|@>;
13304 /* Check if we removed too much */
13305 if ((q != q0) && (q != c || c == c0))
13306 q = mp_next_knot (q)
13309 @ @<Remove the cubic following |p| and update the data structures...@>=
13311 k_needed = mp_knot_info (p) - zero_off;
13315 mp_knot_info (p) = k_needed + mp_knot_info (r);
13319 mp_knot_info (p) = mp_knot_info (c);
13322 if (r == mp->spec_p1)
13324 if (r == mp->spec_p2)
13327 mp_remove_cubic (mp, p);
13331 @ Not setting the |info| field of the newly created knot allows the splitting
13332 routine to work for paths.
13335 static void mp_split_cubic (MP mp, mp_knot p, mp_number t);
13338 void mp_split_cubic (MP mp, mp_knot p, mp_number t) { /* splits the cubic after |p| */
13339 mp_number v; /* an intermediate value */
13340 mp_knot q, r; /* for list manipulation */
13341 q = mp_next_knot (p);
13342 r = mp_new_knot (mp);
13343 mp_next_knot (p) = r;
13344 mp_next_knot (r) = q;
13345 mp_originator (r) = mp_program_code;
13346 mp_left_type (r) = mp_explicit;
13347 mp_right_type (r) = mp_explicit;
13349 set_number_from_of_the_way (v, t, p->right_x, q->left_x);
13350 set_number_from_of_the_way (p->right_x, t, p->x_coord, p->right_x);
13351 set_number_from_of_the_way (q->left_x, t, q->left_x, q->x_coord);
13352 set_number_from_of_the_way (r->left_x, t, p->right_x, v);
13353 set_number_from_of_the_way (r->right_x, t, v, q->left_x);
13354 set_number_from_of_the_way (r->x_coord, t, r->left_x, r->right_x);
13355 set_number_from_of_the_way (v, t, p->right_y, q->left_y);
13356 set_number_from_of_the_way (p->right_y, t, p->y_coord, p->right_y);
13357 set_number_from_of_the_way (q->left_y, t, q->left_y, q->y_coord);
13358 set_number_from_of_the_way (r->left_y, t, p->right_y, v);
13359 set_number_from_of_the_way (r->right_y, t, v, q->left_y);
13360 set_number_from_of_the_way (r->y_coord, t, r->left_y, r->right_y);
13365 @ This does not set |mp_knot_info(p)| or |mp_right_type(p)|.
13368 static void mp_remove_cubic (MP mp, mp_knot p);
13371 void mp_remove_cubic (MP mp, mp_knot p) { /* removes the dead cubic following~|p| */
13372 mp_knot q; /* the node that disappears */
13374 q = mp_next_knot (p);
13375 mp_next_knot (p) = mp_next_knot (q);
13376 number_clone (p->right_x, q->right_x);
13377 number_clone (p->right_y, q->right_y);
13382 @ Let $d\prec d'$ mean that the counter-clockwise angle from $d$ to~$d'$ is
13383 strictly between zero and $180^\circ$. Then we can define $d\preceq d'$ to
13384 mean that the angle could be zero or $180^\circ$. If $w_k=(u_k,v_k)$ is the
13385 $k$th pen offset, the $k$th pen edge direction is defined by the formula
13386 $$d_k=(u\k-u_k,\,v\k-v_k).$$
13387 When listed by increasing $k$, these directions occur in counter-clockwise
13388 order so that $d_k\preceq d\k$ for all~$k$.
13389 The goal of |offset_prep| is to find an offset index~|k| to associate with
13390 each cubic, such that the direction $d(t)$ of the cubic satisfies
13391 $$d_{k-1}\preceq d(t)\preceq d_k\qquad\hbox{for $0\le t\le 1$.}\eqno(*)$$
13392 We may have to split a cubic into many pieces before each
13393 piece corresponds to a unique offset.
13395 @<Split the cubic between |p| and |q|, if necessary, into cubics...@>=
13396 mp_knot_info (p) = zero_off + k_needed;
13398 @<Prepare for derivative computations;
13399 |goto not_found| if the current cubic is dead@>;
13400 @<Find the initial direction |(dx,dy)|@>;
13401 @<Update |mp_knot_info(p)| and find the offset $w_k$ such that
13402 $d_{k-1}\preceq(\\{dx},\\{dy})\prec d_k$; also advance |w0| for
13403 the direction change at |p|@>;
13404 @<Find the final direction |(dxin,dyin)|@>;
13405 @<Decide on the net change in pen offsets and set |turn_amt|@>;
13406 @<Complete the offset splitting process@>;
13407 w0 = mp_pen_walk (mp, w0, turn_amt)
13410 @ @<Declarations@>=
13411 static mp_knot mp_pen_walk (MP mp, mp_knot w, integer k);
13414 mp_knot mp_pen_walk (MP mp, mp_knot w, integer k) {
13415 /* walk |k| steps around a pen from |w| */
13418 w = mp_next_knot (w);
13422 w = mp_prev_knot (w);
13429 @ The direction of a cubic $B(z_0,z_1,z_2,z_3;t)=\bigl(x(t),y(t)\bigr)$ can be
13430 calculated from the quadratic polynomials
13431 ${1\over3}x'(t)=B(x_1-x_0,x_2-x_1,x_3-x_2;t)$ and
13432 ${1\over3}y'(t)=B(y_1-y_0,y_2-y_1,y_3-y_2;t)$.
13433 Since we may be calculating directions from several cubics
13434 split from the current one, it is desirable to do these calculations
13435 without losing too much precision. ``Scaled up'' values of the
13436 derivatives, which will be less tainted by accumulated errors than
13437 derivatives found from the cubics themselves, are maintained in
13438 local variables |x0|, |x1|, and |x2|, representing $X_0=2^l(x_1-x_0)$,
13439 $X_1=2^l(x_2-x_1)$, and $X_2=2^l(x_3-x_2)$; similarly |y0|, |y1|, and~|y2|
13440 represent $Y_0=2^l(y_1-y_0)$, $Y_1=2^l(y_2-y_1)$, and $Y_2=2^l(y_3-y_2)$.
13442 @<Other local variables for |offset_prep|@>=
13443 mp_number x0, x1, x2, y0, y1, y2; /* representatives of derivatives */
13444 mp_number t0, t1, t2; /* coefficients of polynomial for slope testing */
13445 mp_number du, dv, dx, dy; /* for directions of the pen and the curve */
13446 mp_number dx0, dy0; /* initial direction for the first cubic in the curve */
13447 mp_number x0a, x1a, x2a, y0a, y1a, y2a; /* intermediate values */
13448 mp_number t; /* where the derivative passes through zero */
13449 mp_number s; /* a temporary value */
13451 @ @<Prepare for derivative computations...@>=
13452 set_number_from_substraction(x0, p->right_x, p->x_coord);
13453 set_number_from_substraction(x2, q->x_coord, q->left_x);
13454 set_number_from_substraction(x1, q->left_x, p->right_x);
13455 set_number_from_substraction(y0, p->right_y, p->y_coord);
13456 set_number_from_substraction(y2, q->y_coord, q->left_y);
13457 set_number_from_substraction(y1, q->left_y, p->right_y);
13460 new_number (absval);
13461 number_clone(absval, x1);
13462 number_abs(absval);
13463 number_clone(max_coef, x0);
13464 number_abs (max_coef);
13465 if (number_greater(absval, max_coef)) {
13466 number_clone(max_coef, absval);
13468 number_clone(absval, x2);
13469 number_abs(absval);
13470 if (number_greater(absval, max_coef)) {
13471 number_clone(max_coef, absval);
13473 number_clone(absval, y0);
13474 number_abs(absval);
13475 if (number_greater(absval, max_coef)) {
13476 number_clone(max_coef, absval);
13478 number_clone(absval, y1);
13479 number_abs(absval);
13480 if (number_greater(absval, max_coef)) {
13481 number_clone(max_coef, absval);
13483 number_clone(absval, y2);
13484 number_abs(absval);
13485 if (number_greater(absval, max_coef)) {
13486 number_clone(max_coef, absval);
13488 if (number_zero(max_coef)) {
13491 free_number (absval);
13493 while (number_less(max_coef, fraction_half_t)) {
13494 number_double (max_coef);
13495 number_double (x0);
13496 number_double (x1);
13497 number_double (x2);
13498 number_double (y0);
13499 number_double (y1);
13500 number_double (y2);
13504 @ Let us first solve a special case of the problem: Suppose we
13505 know an index~$k$ such that either (i)~$d(t)\succeq d_{k-1}$ for all~$t$
13506 and $d(0)\prec d_k$, or (ii)~$d(t)\preceq d_k$ for all~$t$ and
13507 $d(0)\succ d_{k-1}$.
13508 Then, in a sense, we're halfway done, since one of the two relations
13509 in $(*)$ is satisfied, and the other couldn't be satisfied for
13510 any other value of~|k|.
13512 Actually, the conditions can be relaxed somewhat since a relation such as
13513 $d(t)\succeq d_{k-1}$ restricts $d(t)$ to a half plane when all that really
13514 matters is whether $d(t)$ crosses the ray in the $d_{k-1}$ direction from
13515 the origin. The condition for case~(i) becomes $d_{k-1}\preceq d(0)\prec d_k$
13516 and $d(t)$ never crosses the $d_{k-1}$ ray in the clockwise direction.
13517 Case~(ii) is similar except $d(t)$ cannot cross the $d_k$ ray in the
13518 counterclockwise direction.
13520 The |fin_offset_prep| subroutine solves the stated subproblem.
13521 It has a parameter called |rise| that is |1| in
13522 case~(i), |-1| in case~(ii). Parameters |x0| through |y2| represent
13523 the derivative of the cubic following |p|.
13524 The |w| parameter should point to offset~$w_k$ and |mp_info(p)| should already
13525 be set properly. The |turn_amt| parameter gives the absolute value of the
13526 overall net change in pen offsets.
13529 static void mp_fin_offset_prep (MP mp, mp_knot p, mp_knot w, mp_number
13530 x0, mp_number x1, mp_number x2, mp_number y0,
13531 mp_number y1, mp_number y2, integer rise,
13535 void mp_fin_offset_prep (MP mp, mp_knot p, mp_knot w, mp_number
13536 x0, mp_number x1, mp_number x2, mp_number y0, mp_number y1,
13537 mp_number y2, integer rise, integer turn_amt) {
13538 mp_knot ww; /* for list manipulation */
13539 mp_number du, dv; /* for slope calculation */
13540 mp_number t0, t1, t2; /* test coefficients */
13541 mp_number t; /* place where the derivative passes a critical slope */
13542 mp_number s; /* slope or reciprocal slope */
13543 mp_number v; /* intermediate value for updating |x0..y2| */
13544 mp_knot q; /* original |mp_next_knot(p)| */
13545 q = mp_next_knot (p);
13556 ww = mp_next_knot (w); /* a pointer to $w\k$ */
13558 ww = mp_prev_knot (w); /* a pointer to $w_{k-1}$ */
13559 @<Compute test coefficients |(t0,t1,t2)|
13560 for $d(t)$ versus $d_k$ or $d_{k-1}$@>;
13561 crossing_point (t, t0, t1, t2);
13562 if (number_greaterequal(t, fraction_one_t)) {
13564 number_clone(t, fraction_one_t);
13568 @<Split the cubic at $t$,
13569 and split off another cubic if the derivative crosses back@>;
13584 @ We want $B(\\{t0},\\{t1},\\{t2};t)$ to be the dot product of $d(t)$ with a
13585 $-90^\circ$ rotation of the vector from |w| to |ww|. This makes the resulting
13586 function cross from positive to negative when $d_{k-1}\preceq d(t)\preceq d_k$
13589 @<Compute test coefficients |(t0,t1,t2)| for $d(t)$ versus...@>=
13591 mp_number abs_du, abs_dv;
13592 new_number (abs_du);
13593 new_number (abs_dv);
13594 set_number_from_substraction(du, ww->x_coord, w->x_coord);
13595 set_number_from_substraction(dv, ww->y_coord, w->y_coord);
13596 number_clone(abs_du, du);
13597 number_abs(abs_du);
13598 number_clone(abs_dv, dv);
13599 number_abs(abs_dv);
13600 if (number_greaterequal(abs_du, abs_dv)) {
13603 make_fraction (s, dv, du);
13604 take_fraction (r1, x0, s);
13605 set_number_from_substraction(t0, r1, y0);
13606 take_fraction (r1, x1, s);
13607 set_number_from_substraction(t1, r1, y1);
13608 take_fraction (r1, x2, s);
13609 set_number_from_substraction(t2, r1, y2);
13610 if (number_negative(du)) {
13611 number_negate (t0);
13612 number_negate (t1);
13613 number_negate (t2);
13619 make_fraction (s, du, dv);
13620 take_fraction (r1, y0, s);
13621 set_number_from_substraction(t0, x0, r1);
13622 take_fraction (r1, y1, s);
13623 set_number_from_substraction(t1, x1, r1);
13624 take_fraction (r1, y2, s);
13625 set_number_from_substraction(t2, x2, r1);
13626 if (number_negative(dv)) {
13627 number_negate (t0);
13628 number_negate (t1);
13629 number_negate (t2);
13633 free_number (abs_du);
13634 free_number (abs_dv);
13635 if (number_negative(t0))
13636 set_number_to_zero(t0); /* should be positive without rounding error */
13640 @ The curve has crossed $d_k$ or $d_{k-1}$; its initial segment satisfies
13641 $(*)$, and it might cross again and return towards $s_{k-1}$ or $s_k$,
13642 respectively, yielding another solution of $(*)$.
13644 @<Split the cubic at $t$, and split off another...@>=
13646 mp_split_cubic (mp, p, t);
13647 p = mp_next_knot (p);
13648 mp_knot_info (p) = zero_off + rise;
13650 set_number_from_of_the_way(v, t, x0, x1);
13651 set_number_from_of_the_way(x1, t, x1, x2);
13652 set_number_from_of_the_way(x0, t, v, x1);
13653 set_number_from_of_the_way(v, t, y0, y1);
13654 set_number_from_of_the_way(y1, t, y1, y2);
13655 set_number_from_of_the_way(y0, t, v, y1);
13656 if (turn_amt < 0) {
13657 mp_number arg1, arg2, arg3;
13661 set_number_from_of_the_way(t1, t, t1, t2);
13662 if (number_positive(t1))
13663 set_number_to_zero(t1); /* without rounding error, |t1| would be |<=0| */
13664 number_clone(arg2, t1);
13665 number_negate(arg2);
13666 number_clone(arg3, t2);
13667 number_negate(arg3);
13668 crossing_point (t, arg1, arg2, arg3);
13669 free_number (arg1);
13670 free_number (arg2);
13671 free_number (arg3);
13672 if (number_greater(t, fraction_one_t))
13673 number_clone(t, fraction_one_t);
13675 if (number_equal(t,fraction_one_t) && (mp_next_knot (p) != q)) {
13676 mp_knot_info (mp_next_knot (p)) = mp_knot_info (mp_next_knot (p)) - rise;
13678 mp_split_cubic (mp, p, t);
13679 mp_knot_info (mp_next_knot (p)) = zero_off - rise;
13680 set_number_from_of_the_way(v, t, x1, x2);
13681 set_number_from_of_the_way(x1, t, x0, x1);
13682 set_number_from_of_the_way(x2, t, x1, v);
13683 set_number_from_of_the_way(v, t, y1, y2);
13684 set_number_from_of_the_way(y1, t, y0, y1);
13685 set_number_from_of_the_way(y2, t, y1, v);
13691 @ Now we must consider the general problem of |offset_prep|, when
13692 nothing is known about a given cubic. We start by finding its
13693 direction in the vicinity of |t=0|.
13695 If $z'(t)=0$, the given cubic is numerically unstable but |offset_prep|
13696 has not yet introduced any more numerical errors. Thus we can compute
13697 the true initial direction for the given cubic, even if it is almost
13700 @<Find the initial direction |(dx,dy)|@>=
13701 number_clone(dx, x0);
13702 number_clone(dy, y0);
13703 if (number_zero(dx) && number_zero(dy)) {
13704 number_clone(dx, x1);
13705 number_clone(dy, y1);
13706 if (number_zero(dx) && number_zero(dy)) {
13707 number_clone(dx, x2);
13708 number_clone(dy, y2);
13712 number_clone(dx0, dx);
13713 number_clone(dy0, dy);
13716 @ @<Find the final direction |(dxin,dyin)|@>=
13717 number_clone(dxin, x2);
13718 number_clone(dyin, y2);
13719 if (number_zero(dxin) && number_zero(dyin)) {
13720 number_clone(dxin, x1);
13721 number_clone(dyin, y1);
13722 if (number_zero(dxin) && number_zero(dyin)) {
13723 number_clone(dxin, x0);
13724 number_clone(dyin, y0);
13728 @ The next step is to bracket the initial direction between consecutive
13729 edges of the pen polygon. We must be careful to turn clockwise only if
13730 this makes the turn less than $180^\circ$. (A $180^\circ$ turn must be
13731 counter-clockwise in order to make \&{doublepath} envelopes come out
13732 @:double_path_}{\&{doublepath} primitive@>
13733 right.) This code depends on |w0| being the offset for |(dxin,dyin)|.
13735 @<Update |mp_knot_info(p)| and find the offset $w_k$ such that...@>=
13737 mp_number ab_vs_cd;
13738 new_number (ab_vs_cd);
13739 ab_vs_cd (ab_vs_cd, dy, dxin, dx, dyin);
13740 turn_amt = mp_get_turn_amt (mp, w0, dx, dy, number_nonnegative(ab_vs_cd));
13741 free_number (ab_vs_cd);
13742 w = mp_pen_walk (mp, w0, turn_amt);
13744 mp_knot_info (p) = mp_knot_info (p) + turn_amt;
13747 @ Decide how many pen offsets to go away from |w| in order to find the offset
13748 for |(dx,dy)|, going counterclockwise if |ccw| is |true|. This assumes that
13749 |w| is the offset for some direction $(x',y')$ from which the angle to |(dx,dy)|
13750 in the sense determined by |ccw| is less than or equal to $180^\circ$.
13752 If the pen polygon has only two edges, they could both be parallel
13753 to |(dx,dy)|. In this case, we must be careful to stop after crossing the first
13754 such edge in order to avoid an infinite loop.
13757 static integer mp_get_turn_amt (MP mp, mp_knot w, mp_number dx,
13758 mp_number dy, boolean ccw);
13761 integer mp_get_turn_amt (MP mp, mp_knot w, mp_number dx, mp_number dy, boolean ccw) {
13762 mp_knot ww; /* a neighbor of knot~|w| */
13763 integer s; /* turn amount so far */
13764 mp_number t; /* |ab_vs_cd| result */
13765 mp_number arg1, arg2;
13771 ww = mp_next_knot (w);
13773 set_number_from_substraction (arg1, ww->x_coord, w->x_coord);
13774 set_number_from_substraction (arg2, ww->y_coord, w->y_coord);
13775 ab_vs_cd (t, dy, arg1, dx, arg2);
13776 if (number_negative(t))
13780 ww = mp_next_knot (ww);
13781 } while (number_positive(t));
13783 ww = mp_prev_knot (w);
13784 set_number_from_substraction (arg1, w->x_coord, ww->x_coord);
13785 set_number_from_substraction (arg2, w->y_coord, ww->y_coord);
13786 ab_vs_cd (t, dy, arg1, dx, arg2);
13787 while (number_negative(t)) {
13790 ww = mp_prev_knot (ww);
13791 set_number_from_substraction (arg1, w->x_coord, ww->x_coord);
13792 set_number_from_substraction (arg2, w->y_coord, ww->y_coord);
13793 ab_vs_cd (t, dy, arg1, dx, arg2);
13797 free_number (arg1);
13798 free_number (arg2);
13803 @ When we're all done, the final offset is |w0| and the final curve direction
13804 is |(dxin,dyin)|. With this knowledge of the incoming direction at |c|, we
13805 can correct |mp_info(c)| which was erroneously based on an incoming offset
13808 @d fix_by(A) mp_knot_info(c)=mp_knot_info(c)+(A)
13810 @<Fix the offset change in |mp_knot_info(c)| and set |c| to the return value of...@>=
13811 mp->spec_offset = mp_knot_info (c) - zero_off;
13812 if (mp_next_knot (c) == c) {
13813 mp_knot_info (c) = zero_off + n;
13815 mp_number ab_vs_cd;
13816 new_number (ab_vs_cd);
13820 w0 = mp_next_knot (w0);
13822 while (mp_knot_info (c) <= zero_off - n)
13824 while (mp_knot_info (c) > zero_off)
13826 ab_vs_cd (ab_vs_cd, dy0, dxin, dx0, dyin);
13827 if ((mp_knot_info (c) != zero_off) && number_nonnegative(ab_vs_cd))
13829 free_number (ab_vs_cd);
13833 @ Finally we want to reduce the general problem to situations that
13834 |fin_offset_prep| can handle. We split the cubic into at most three parts
13835 with respect to $d_{k-1}$, and apply |fin_offset_prep| to each part.
13837 @<Complete the offset splitting process@>=
13838 ww = mp_prev_knot (w);
13839 @<Compute test coeff...@>;
13840 @<Find the first |t| where $d(t)$ crosses $d_{k-1}$ or set
13841 |t:=fraction_one+1|@>;
13842 if (number_greater(t, fraction_one_t)) {
13843 mp_fin_offset_prep (mp, p, w, x0, x1, x2, y0, y1, y2, 1, turn_amt);
13845 mp_split_cubic (mp, p, t);
13846 r = mp_next_knot (p);
13847 set_number_from_of_the_way(x1a, t, x0, x1);
13848 set_number_from_of_the_way(x1, t, x1, x2);
13849 set_number_from_of_the_way(x2a, t, x1a, x1);
13850 set_number_from_of_the_way(y1a, t, y0, y1);
13851 set_number_from_of_the_way(y1, t, y1, y2);
13852 set_number_from_of_the_way(y2a, t, y1a, y1);
13853 mp_fin_offset_prep (mp, p, w, x0, x1a, x2a, y0, y1a, y2a, 1, 0);
13854 number_clone(x0, x2a);
13855 number_clone(y0, y2a);
13856 mp_knot_info (r) = zero_off - 1;
13857 if (turn_amt >= 0) {
13858 mp_number arg1, arg2, arg3;
13862 set_number_from_of_the_way(t1, t, t1, t2);
13863 if (number_positive(t1))
13864 set_number_to_zero(t1);
13865 number_clone(arg2, t1);
13866 number_negate(arg2);
13867 number_clone(arg3, t2);
13868 number_negate(arg3);
13869 crossing_point (t, arg1, arg2, arg3);
13870 free_number (arg1);
13871 free_number (arg2);
13872 free_number (arg3);
13873 if (number_greater(t, fraction_one_t))
13874 number_clone (t, fraction_one_t);
13875 @<Split off another rising cubic for |fin_offset_prep|@>;
13876 mp_fin_offset_prep (mp, r, ww, x0, x1, x2, y0, y1, y2, -1, 0);
13878 mp_fin_offset_prep (mp, r, ww, x0, x1, x2, y0, y1, y2, -1, (-1 - turn_amt));
13883 @ @<Split off another rising cubic for |fin_offset_prep|@>=
13884 mp_split_cubic (mp, r, t);
13885 mp_knot_info (mp_next_knot (r)) = zero_off + 1;
13886 set_number_from_of_the_way(x1a, t, x1, x2);
13887 set_number_from_of_the_way(x1, t, x0, x1);
13888 set_number_from_of_the_way(x0a, t, x1, x1a);
13889 set_number_from_of_the_way(y1a, t, y1, y2);
13890 set_number_from_of_the_way(y1, t, y0, y1);
13891 set_number_from_of_the_way(y0a, t, y1, y1a);
13892 mp_fin_offset_prep (mp, mp_next_knot (r), w, x0a, x1a, x2, y0a, y1a, y2, 1, turn_amt);
13893 number_clone(x2, x0a);
13894 number_clone(y2, y0a)
13896 @ At this point, the direction of the incoming pen edge is |(-du,-dv)|.
13897 When the component of $d(t)$ perpendicular to |(-du,-dv)| crosses zero, we
13898 need to decide whether the directions are parallel or antiparallel. We
13899 can test this by finding the dot product of $d(t)$ and |(-du,-dv)|, but this
13900 should be avoided when the value of |turn_amt| already determines the
13901 answer. If |t2<0|, there is one crossing and it is antiparallel only if
13902 |turn_amt>=0|. If |turn_amt<0|, there should always be at least one
13903 crossing and the first crossing cannot be antiparallel.
13905 @<Find the first |t| where $d(t)$ crosses $d_{k-1}$ or set...@>=
13906 crossing_point (t, t0, t1, t2);
13907 if (turn_amt >= 0) {
13908 if (number_negative(t2)) {
13909 number_clone(t, fraction_one_t);
13910 number_add_scaled (t, 1);
13912 mp_number tmp, arg1, r1;
13916 set_number_from_of_the_way(u0, t, x0, x1);
13917 set_number_from_of_the_way(u1, t, x1, x2);
13918 set_number_from_of_the_way(tmp, t, u0, u1);
13919 number_clone (arg1, du);
13921 take_fraction (ss, arg1, tmp);
13922 set_number_from_of_the_way(v0, t, y0, y1);
13923 set_number_from_of_the_way(v1, t, y1, y2);
13924 set_number_from_of_the_way(tmp, t, v0, v1);
13925 number_clone (arg1, dv);
13927 take_fraction (r1, arg1, tmp);
13928 number_add (ss, r1);
13930 if (number_negative(ss)) {
13931 number_clone(t, fraction_one_t);
13932 number_add_scaled (t, 1);
13937 } else if (number_greater(t, fraction_one_t)) {
13938 number_clone (t, fraction_one_t);
13941 @ @<Other local variables for |offset_prep|@>=
13942 mp_number u0, u1, v0, v1; /* intermediate values for $d(t)$ calculation */
13943 int d_sign; /* sign of overall change in direction for this cubic */
13945 @ If the cubic almost has a cusp, it is a numerically ill-conditioned
13946 problem to decide which way it loops around but that's OK as long we're
13947 consistent. To make \&{doublepath} envelopes work properly, reversing
13948 the path should always change the sign of |turn_amt|.
13950 @<Decide on the net change in pen offsets and set |turn_amt|@>=
13952 mp_number ab_vs_cd;
13953 new_number (ab_vs_cd);
13954 ab_vs_cd (ab_vs_cd, dx, dyin, dxin, dy);
13955 if (number_negative (ab_vs_cd))
13957 else if (number_zero (ab_vs_cd))
13961 free_number (ab_vs_cd);
13964 @<Check rotation direction based on node position@>
13967 if (number_zero(dx)) {
13968 if (number_positive(dy))
13973 if (number_positive(dx))
13979 @<Make |ss| negative if and only if the total change in direction is
13980 more than $180^\circ$@>;
13981 turn_amt = mp_get_turn_amt (mp, w, dxin, dyin, (d_sign > 0));
13982 if (number_negative(ss))
13983 turn_amt = turn_amt - d_sign * n
13985 @ We check rotation direction by looking at the vector connecting the current
13986 node with the next. If its angle with incoming and outgoing tangents has the
13987 same sign, we pick this as |d_sign|, since it means we have a flex, not a cusp.
13988 Otherwise we proceed to the cusp code.
13990 @<Check rotation direction based on node position@>=
13992 mp_number ab_vs_cd1, ab_vs_cd2, t;
13993 new_number (ab_vs_cd1);
13994 new_number (ab_vs_cd2);
13996 set_number_from_substraction(u0, q->x_coord, p->x_coord);
13997 set_number_from_substraction(u1, q->y_coord, p->y_coord);
13998 ab_vs_cd (ab_vs_cd1, dx, u1, u0, dy);
13999 ab_vs_cd (ab_vs_cd2, u0, dyin, dxin, u1);
14000 set_number_from_addition (t, ab_vs_cd1, ab_vs_cd2);
14002 if (number_negative (t))
14004 else if (number_zero (t))
14009 free_number (ab_vs_cd1);
14010 free_number (ab_vs_cd2);
14013 @ In order to be invariant under path reversal, the result of this computation
14014 should not change when |x0|, |y0|, $\ldots$ are all negated and |(x0,y0)| is
14015 then swapped with |(x2,y2)|. We make use of the identities
14016 |take_fraction(-a,-b)=take_fraction(a,b)| and
14017 |t_of_the_way(-a,-b)=-(t_of_the_way(a,b))|.
14019 @<Make |ss| negative if and only if the total change in direction is...@>=
14021 mp_number r1, r2, arg1;
14025 take_fraction (r1, x0, y2);
14026 take_fraction (r2, x2, y0);
14029 set_number_from_substraction(t0, r1, r2);
14030 set_number_from_addition (arg1, y0, y2);
14031 take_fraction (r1, x1, arg1);
14032 set_number_from_addition (arg1, x0, x2);
14033 take_fraction (r1, y1, arg1);
14036 set_number_from_substraction(t1, r1, r2);
14037 free_number (arg1);
14041 if (number_zero(t0))
14042 set_number_from_scaled(t0, d_sign); /* path reversal always negates |d_sign| */
14043 if (number_positive(t0)) {
14046 number_clone(arg3, t0);
14047 number_negate(arg3);
14048 crossing_point (t, t0, t1, arg3);
14049 free_number (arg3);
14050 set_number_from_of_the_way(u0, t, x0, x1);
14051 set_number_from_of_the_way(u1, t, x1, x2);
14052 set_number_from_of_the_way(v0, t, y0, y1);
14053 set_number_from_of_the_way(v1, t, y1, y2);
14057 number_clone(arg1, t0);
14058 number_negate(arg1);
14059 crossing_point (t, arg1, t1, t0);
14060 free_number (arg1);
14061 set_number_from_of_the_way(u0, t, x2, x1);
14062 set_number_from_of_the_way(u1, t, x1, x0);
14063 set_number_from_of_the_way(v0, t, y2, y1);
14064 set_number_from_of_the_way(v1, t, y1, y0);
14067 mp_number tmp1, tmp2, r1, r2, arg1;
14073 set_number_from_of_the_way(tmp1, t, u0, u1);
14074 set_number_from_of_the_way(tmp2, t, v0, v1);
14075 set_number_from_addition(arg1, x0, x2);
14076 take_fraction (r1, arg1, tmp1);
14077 set_number_from_addition(arg1, y0, y2);
14078 take_fraction (r2, arg1, tmp2);
14079 set_number_from_addition (ss, r1, r2);
14080 free_number (arg1);
14083 free_number (tmp1);
14084 free_number (tmp2);
14088 @ Here's a routine that prints an envelope spec in symbolic form. It assumes
14089 that the |cur_pen| has not been walked around to the first offset.
14092 static void mp_print_spec (MP mp, mp_knot cur_spec, mp_knot cur_pen,
14094 mp_knot p, q; /* list traversal */
14095 mp_knot w; /* the current pen offset */
14096 mp_print_diagnostic (mp, "Envelope spec
", s, true);
14098 w = mp_pen_walk (mp, cur_pen, mp->spec_offset);
14100 mp_print_two (mp, cur_spec->x_coord, cur_spec->y_coord);
14101 mp_print (mp, " % beginning with offset
");
14102 mp_print_two (mp, w->x_coord, w->y_coord);
14105 q = mp_next_knot (p);
14106 @<Print the cubic between |p| and |q|@>;
14108 if ((p == cur_spec) || (mp_knot_info (p) != zero_off))
14111 if (mp_knot_info (p) != zero_off) {
14112 @<Update |w| as indicated by |mp_knot_info(p)| and print an explanation@>;
14114 } while (p != cur_spec);
14115 mp_print_nl (mp, " & cycle");
14116 mp_end_diagnostic (mp, true);
14120 @ @<Update |w| as indicated by |mp_knot_info(p)| and print an explanation@>=
14122 w = mp_pen_walk (mp, w, (mp_knot_info (p) - zero_off));
14123 mp_print (mp, " % ");
14124 if (mp_knot_info (p) > zero_off)
14125 mp_print (mp, "counter");
14126 mp_print (mp, "clockwise to offset ");
14127 mp_print_two (mp, w->x_coord, w->y_coord);
14131 @ @<Print the cubic between |p| and |q|@>=
14133 mp_print_nl (mp, " ..controls ");
14134 mp_print_two (mp, p->right_x, p->right_y);
14135 mp_print (mp, " and ");
14136 mp_print_two (mp, q->left_x, q->left_y);
14137 mp_print_nl (mp, " ..");
14138 mp_print_two (mp, q->x_coord, q->y_coord);
14142 @ Once we have an envelope spec, the remaining task to construct the actual
14143 envelope by offsetting each cubic as determined by the |info| fields in
14144 the knots. First we use |offset_prep| to convert the |c| into an envelope
14145 spec. Then we add the offsets so that |c| becomes a cyclic path that represents
14148 The |ljoin| and |miterlim| parameters control the treatment of points where the
14149 pen offset changes, and |lcap| controls the endpoints of a \&{doublepath}.
14150 The endpoints are easily located because |c| is given in undoubled form
14151 and then doubled in this procedure. We use |spec_p1| and |spec_p2| to keep
14152 track of the endpoints and treat them like very sharp corners.
14153 Butt end caps are treated like beveled joins; round end caps are treated like
14154 round joins; and square end caps are achieved by setting |join_type:=3|.
14156 None of these parameters apply to inside joins where the convolution tracing
14157 has retrograde lines. In such cases we use a simple connect-the-endpoints
14158 approach that is achieved by setting |join_type:=2|.
14161 static mp_knot mp_make_envelope (MP mp, mp_knot c, mp_knot h, quarterword ljoin,
14162 quarterword lcap, mp_number miterlim) {
14163 mp_knot p, q, r, q0; /* for manipulating the path */
14164 mp_knot w, w0; /* the pen knot for the current offset */
14165 halfword k, k0; /* controls pen edge insertion */
14166 mp_number qx, qy; /* unshifted coordinates of |q| */
14167 mp_fraction dxin, dyin, dxout, dyout; /* directions at |q| when square or mitered */
14168 int join_type = 0; /* codes |0..3| for mitered, round, beveled, or square */
14169 @<Other local variables for |make_envelope|@>;
14170 new_number (max_ht);
14172 new_fraction(dxin);
14173 new_fraction(dyin);
14174 new_fraction(dxout);
14175 new_fraction(dyout);
14176 mp->spec_p1 = NULL;
14177 mp->spec_p2 = NULL;
14180 @<If endpoint, double the path |c|, and set |spec_p1| and |spec_p2|@>;
14181 @<Use |offset_prep| to compute the envelope spec then walk |h| around to
14182 the initial offset@>;
14186 q = mp_next_knot (p);
14188 number_clone (qx, q->x_coord);
14189 number_clone (qy, q->y_coord);
14190 k = mp_knot_info (q);
14193 if (k != zero_off) {
14194 @<Set |join_type| to indicate how to handle offset changes at~|q|@>;
14196 @<Add offset |w| to the cubic from |p| to |q|@>;
14197 while (k != zero_off) {
14198 @<Step |w| and move |k| one step closer to |zero_off|@>;
14199 if ((join_type == 1) || (k == zero_off)) {
14200 mp_number xtot, ytot;
14203 set_number_from_addition (xtot, qx, w->x_coord);
14204 set_number_from_addition (ytot, qy, w->y_coord);
14205 q = mp_insert_knot (mp, q, xtot, ytot);
14208 if (q != mp_next_knot (p)) {
14209 @<Set |p=mp_link(p)| and add knots between |p| and |q| as
14210 required by |join_type|@>;
14214 free_number (max_ht);
14218 free_number (dxin);
14219 free_number (dyin);
14220 free_number (dxout);
14221 free_number (dyout);
14226 @ @<Use |offset_prep| to compute the envelope spec then walk |h| around to...@>=
14227 c = mp_offset_prep (mp, c, h);
14228 if (number_positive(internal_value (mp_tracing_specs)))
14229 mp_print_spec (mp, c, h, "");
14230 h = mp_pen_walk (mp, h, mp->spec_offset)
14233 @ Mitered and squared-off joins depend on path directions that are difficult to
14234 compute for degenerate cubics. The envelope spec computed by |offset_prep| can
14235 have degenerate cubics only if the entire cycle collapses to a single
14236 degenerate cubic. Setting |join_type:=2| in this case makes the computed
14237 envelope degenerate as well.
14239 @<Set |join_type| to indicate how to handle offset changes at~|q|@>=
14240 if (k < zero_off) {
14243 if ((q != mp->spec_p1) && (q != mp->spec_p2))
14245 else if (lcap == 2)
14248 join_type = 2 - lcap;
14249 if ((join_type == 0) || (join_type == 3)) {
14250 @<Set the incoming and outgoing directions at |q|; in case of
14251 degeneracy set |join_type:=2|@>;
14252 if (join_type == 0) {
14253 @<If |miterlim| is less than the secant of half the angle at |q|
14254 then set |join_type:=2|@>;
14260 @ @<If |miterlim| is less than the secant of half the angle at |q|...@>=
14265 take_fraction (r1, dxin, dxout);
14266 take_fraction (r2, dyin, dyout);
14267 number_add (r1, r2);
14269 number_add (r1, fraction_half_t);
14270 take_fraction (tmp, miterlim, r1);
14271 if (number_less(tmp, unity_t)) {
14274 take_scaled (ret, miterlim, tmp);
14275 if (number_less(ret, unity_t))
14284 @ @<Other local variables for |make_envelope|@>=
14285 mp_number tmp; /* a temporary value */
14287 @ The coordinates of |p| have already been shifted unless |p| is the first
14288 knot in which case they get shifted at the very end.
14290 @<Add offset |w| to the cubic from |p| to |q|@>=
14291 number_add (p->right_x, w->x_coord);
14292 number_add (p->right_y, w->y_coord);
14293 number_add (q->left_x, w->x_coord);
14294 number_add (q->left_y, w->y_coord);
14295 number_add (q->x_coord, w->x_coord);
14296 number_add (q->y_coord, w->y_coord);
14297 mp_left_type (q) = mp_explicit;
14298 mp_right_type (q) = mp_explicit
14300 @ @<Step |w| and move |k| one step closer to |zero_off|@>=
14301 if (k > zero_off) {
14302 w = mp_next_knot (w);
14305 w = mp_prev_knot (w);
14310 @ The cubic from |q| to the new knot at |(x,y)| becomes a line segment and
14311 the |mp_right_x| and |mp_right_y| fields of |r| are set from |q|. This is done in
14312 case the cubic containing these control points is ``yet to be examined.''
14315 static mp_knot mp_insert_knot (MP mp, mp_knot q, mp_number x, mp_number y);
14318 mp_knot mp_insert_knot (MP mp, mp_knot q, mp_number x, mp_number y) {
14319 /* returns the inserted knot */
14320 mp_knot r; /* the new knot */
14321 r = mp_new_knot (mp);
14322 mp_next_knot (r) = mp_next_knot (q);
14323 mp_next_knot (q) = r;
14324 number_clone (r->right_x, q->right_x);
14325 number_clone (r->right_y, q->right_y);
14326 number_clone (r->x_coord, x);
14327 number_clone (r->y_coord, y);
14328 number_clone (q->right_x, q->x_coord);
14329 number_clone (q->right_y, q->y_coord);
14330 number_clone (r->left_x, r->x_coord);
14331 number_clone (r->left_y, r->y_coord);
14332 mp_left_type (r) = mp_explicit;
14333 mp_right_type (r) = mp_explicit;
14334 mp_originator (r) = mp_program_code;
14339 @ After setting |p:=mp_link(p)|, either |join_type=1| or |q=mp_link(p)|.
14341 @<Set |p=mp_link(p)| and add knots between |p| and |q| as...@>=
14343 p = mp_next_knot (p);
14344 if ((join_type == 0) || (join_type == 3)) {
14345 if (join_type == 0) {
14346 @<Insert a new knot |r| between |p| and |q| as required for a mitered join@>
14348 @<Make |r| the last of two knots inserted between |p| and |q| to form a
14352 number_clone (r->right_x, r->x_coord);
14353 number_clone (r->right_y, r->y_coord);
14359 @ For very small angles, adding a knot is unnecessary and would cause numerical
14360 problems, so we just set |r:=NULL| in that case.
14362 @d near_zero_angle_k ((math_data *)mp->math)->near_zero_angle_t
14364 @<Insert a new knot |r| between |p| and |q| as required for a mitered join@>=
14366 mp_number det; /* a determinant used for mitered join calculations */
14371 new_fraction (det);
14372 new_fraction (absdet);
14373 take_fraction (r1, dyout, dxin);
14374 take_fraction (r2, dxout, dyin);
14375 set_number_from_substraction(det, r1, r2);
14376 number_clone (absdet, det);
14377 number_abs (absdet);
14378 if (number_less (absdet, near_zero_angle_k)) {
14379 r = NULL; /* sine $<10^{-4}$ */
14381 mp_number xtot, ytot, xsub, ysub;
14382 new_fraction(xsub);
14383 new_fraction(ysub);
14386 set_number_from_substraction (tmp, q->x_coord, p->x_coord);
14387 take_fraction (r1, tmp, dyout);
14388 set_number_from_substraction (tmp, q->y_coord, p->y_coord);
14389 take_fraction (r2, tmp, dxout);
14390 set_number_from_substraction (tmp, r1, r2);
14391 make_fraction (r1, tmp, det);
14392 number_clone (tmp, r1);
14393 take_fraction (xsub, tmp, dxin);
14394 take_fraction (ysub, tmp, dyin);
14395 set_number_from_addition(xtot, p->x_coord, xsub);
14396 set_number_from_addition(ytot, p->y_coord, ysub);
14397 r = mp_insert_knot (mp, p, xtot, ytot);
14398 free_number (xtot);
14399 free_number (ytot);
14400 free_number (xsub);
14401 free_number (ysub);
14406 free_number (absdet);
14410 @ @<Make |r| the last of two knots inserted between |p| and |q| to form a...@>=
14412 mp_number ht_x, ht_y; /* perpendicular to the segment from |p| to |q| */
14413 mp_number ht_x_abs, ht_y_abs; /* absolutes */
14414 mp_number xtot, ytot, xsub, ysub;
14415 new_fraction(xsub);
14416 new_fraction(ysub);
14419 new_fraction (ht_x);
14420 new_fraction (ht_y);
14421 new_fraction (ht_x_abs);
14422 new_fraction (ht_y_abs);
14423 set_number_from_substraction(ht_x, w->y_coord, w0->y_coord);
14424 set_number_from_substraction(ht_y, w0->x_coord, w->x_coord);
14425 number_clone (ht_x_abs, ht_x);
14426 number_clone (ht_y_abs, ht_y);
14427 number_abs (ht_x_abs);
14428 number_abs (ht_y_abs);
14429 while (number_less(ht_x_abs, fraction_half_t) && number_less(ht_y_abs, fraction_half_t)) {
14430 number_double(ht_x);
14431 number_double(ht_y);
14432 number_clone (ht_x_abs, ht_x);
14433 number_clone (ht_y_abs, ht_y);
14434 number_abs (ht_x_abs);
14435 number_abs (ht_y_abs);
14437 @<Scan the pen polygon between |w0| and |w| and make |max_ht| the range dot
14438 product with |(ht_x,ht_y)|@>;
14443 take_fraction (r1, dxin, ht_x);
14444 take_fraction (r2, dyin, ht_y);
14445 number_add (r1, r2);
14446 make_fraction (tmp, max_ht, r1);
14450 take_fraction (xsub, tmp, dxin);
14451 take_fraction (ysub, tmp, dyin);
14452 set_number_from_addition(xtot, p->x_coord, xsub);
14453 set_number_from_addition(ytot, p->y_coord, ysub);
14454 r = mp_insert_knot (mp, p, xtot, ytot);
14455 /* clang: value never read */ assert(r);
14460 take_fraction (r1, dxout, ht_x);
14461 take_fraction (r2, dyout, ht_y);
14462 number_add (r1, r2);
14463 make_fraction (tmp, max_ht, r1);
14467 take_fraction (xsub, tmp, dxout);
14468 take_fraction (ysub, tmp, dyout);
14469 set_number_from_addition(xtot, q->x_coord, xsub);
14470 set_number_from_addition(ytot, q->y_coord, ysub);
14471 r = mp_insert_knot (mp, p, xtot, ytot);
14472 free_number (xsub);
14473 free_number (ysub);
14474 free_number (xtot);
14475 free_number (ytot);
14476 free_number (ht_x);
14477 free_number (ht_y);
14478 free_number (ht_x_abs);
14479 free_number (ht_y_abs);
14483 @ @<Other local variables for |make_envelope|@>=
14484 mp_number max_ht; /* maximum height of the pen polygon above the |w0|-|w| line */
14485 halfword kk; /* keeps track of the pen vertices being scanned */
14486 mp_knot ww; /* the pen vertex being tested */
14488 @ The dot product of the vector from |w0| to |ww| with |(ht_x,ht_y)| ranges
14489 from zero to |max_ht|.
14491 @<Scan the pen polygon between |w0| and |w| and make |max_ht| the range...@>=
14492 set_number_to_zero (max_ht);
14496 @<Step |ww| and move |kk| one step closer to |k0|@>;
14503 set_number_from_substraction (tmp, ww->x_coord, w0->x_coord);
14504 take_fraction (r1, tmp, ht_x);
14505 set_number_from_substraction (tmp, ww->y_coord, w0->y_coord);
14506 take_fraction (r2, tmp, ht_y);
14507 set_number_from_addition (tmp, r1, r2);
14511 if (number_greater(tmp, max_ht))
14512 number_clone(max_ht, tmp);
14516 @ @<Step |ww| and move |kk| one step closer to |k0|@>=
14518 ww = mp_next_knot (ww);
14521 ww = mp_prev_knot (ww);
14526 @ @<If endpoint, double the path |c|, and set |spec_p1| and |spec_p2|@>=
14527 if (mp_left_type (c) == mp_endpoint) {
14528 mp->spec_p1 = mp_htap_ypoc (mp, c);
14529 mp->spec_p2 = mp->path_tail;
14530 mp_originator (mp->spec_p1) = mp_program_code;
14531 mp_next_knot (mp->spec_p2) = mp_next_knot (mp->spec_p1);
14532 mp_next_knot (mp->spec_p1) = c;
14533 mp_remove_cubic (mp, mp->spec_p1);
14535 if (c != mp_next_knot (c)) {
14536 mp_originator (mp->spec_p2) = mp_program_code;
14537 mp_remove_cubic (mp, mp->spec_p2);
14539 @<Make |c| look like a cycle of length one@>;
14543 @ @<Make |c| look like a cycle of length one@>=
14545 mp_left_type (c) = mp_explicit;
14546 mp_right_type (c) = mp_explicit;
14547 number_clone(c->left_x, c->x_coord);
14548 number_clone(c->left_y, c->y_coord);
14549 number_clone(c->right_x, c->x_coord);
14550 number_clone(c->right_y, c->y_coord);
14554 @ In degenerate situations we might have to look at the knot preceding~|q|.
14555 That knot is |p| but if |p<>c|, its coordinates have already been offset by |w|.
14557 @<Set the incoming and outgoing directions at |q|; in case of...@>=
14559 set_number_from_substraction(dxin, q->x_coord, q->left_x);
14560 set_number_from_substraction(dyin, q->y_coord, q->left_y);
14561 if (number_zero(dxin) && number_zero(dyin)) {
14562 set_number_from_substraction(dxin, q->x_coord, p->right_x);
14563 set_number_from_substraction(dyin, q->y_coord, p->right_y);
14564 if (number_zero(dxin) && number_zero(dyin)) {
14565 set_number_from_substraction(dxin, q->x_coord, p->x_coord);
14566 set_number_from_substraction(dyin, q->y_coord, p->y_coord);
14567 if (p != c) { /* the coordinates of |p| have been offset by |w| */
14568 number_add(dxin, w->x_coord);
14569 number_add(dyin, w->y_coord);
14573 pyth_add (tmp, dxin, dyin);
14574 if (number_zero(tmp)) {
14579 make_fraction (r1, dxin, tmp);
14580 number_clone(dxin, r1);
14581 make_fraction (r1, dyin, tmp);
14582 number_clone(dyin, r1);
14584 @<Set the outgoing direction at |q|@>;
14589 @ If |q=c| then the coordinates of |r| and the control points between |q|
14590 and~|r| have already been offset by |h|.
14592 @<Set the outgoing direction at |q|@>=
14594 set_number_from_substraction(dxout, q->right_x, q->x_coord);
14595 set_number_from_substraction(dyout, q->right_y, q->y_coord);
14596 if (number_zero(dxout) && number_zero(dyout)) {
14597 r = mp_next_knot (q);
14598 set_number_from_substraction(dxout, r->left_x, q->x_coord);
14599 set_number_from_substraction(dyout, r->left_y, q->y_coord);
14600 if (number_zero(dxout) && number_zero(dyout)) {
14601 set_number_from_substraction(dxout, r->x_coord, q->x_coord);
14602 set_number_from_substraction(dyout, r->y_coord, q->y_coord);
14606 number_substract(dxout, h->x_coord);
14607 number_substract(dyout, h->y_coord);
14609 pyth_add (tmp, dxout, dyout);
14610 if (number_zero(tmp)) {
14611 /* |mp_confusion (mp, "degenerate spec");| */
14612 @:this can't happen degerate spec}{\quad degenerate spec@>;
14613 /* But apparently, it actually can happen. The test case is this:
14616 linejoin := mitered;
14617 p:= (10,0)..(0,10)..(-10,0)..(0,-10)..cycle;
14618 addto currentpicture contour p withpen pensquare;
14620 The reason for failure here is the addition of |r != q| in revision 1757
14621 in ``Advance |p| to node |q|, removing any ``dead'' cubics'', which itself
14622 was needed to fix a bug with disappearing knots in a path that was rotated
14623 exactly 45 degrees (luatex.org bug 530).
14628 make_fraction (r1, dxout, tmp);
14629 number_clone(dxout, r1);
14630 make_fraction (r1, dyout, tmp);
14631 number_clone(dyout, r1);
14637 @* Direction and intersection times.
14638 A path of length $n$ is defined parametrically by functions $x(t)$ and
14639 $y(t)$, for |0<=t<=n|; we can regard $t$ as the ``time'' at which the path
14640 reaches the point $\bigl(x(t),y(t)\bigr)$. In this section of the program
14641 we shall consider operations that determine special times associated with
14642 given paths: the first time that a path travels in a given direction, and
14643 a pair of times at which two paths cross each other.
14645 @ Let's start with the easier task. The function |find_direction_time| is
14646 given a direction |(x,y)| and a path starting at~|h|. If the path never
14647 travels in direction |(x,y)|, the direction time will be~|-1|; otherwise
14648 it will be nonnegative.
14650 Certain anomalous cases can arise: If |(x,y)=(0,0)|, so that the given
14651 direction is undefined, the direction time will be~0. If $\bigl(x'(t),
14652 y'(t)\bigr)=(0,0)$, so that the path direction is undefined, it will be
14653 assumed to match any given direction at time~|t|.
14655 The routine solves this problem in nondegenerate cases by rotating the path
14656 and the given direction so that |(x,y)=(1,0)|; i.e., the main task will be
14657 to find when a given path first travels ``due east.''
14660 static void mp_find_direction_time (MP mp, mp_number *ret, mp_number x_orig, mp_number y_orig, mp_knot h) {
14661 mp_number max; /* $\max\bigl(\vert x\vert,\vert y\vert\bigr)$ */
14662 mp_knot p, q; /* for list traversal */
14663 mp_number n; /* the direction time at knot |p| */
14664 mp_number tt; /* the direction time within a cubic */
14666 mp_number abs_x, abs_y;
14667 /* Other local variables for |find_direction_time| */
14668 mp_number x1, x2, x3, y1, y2, y3; /* multiples of rotated derivatives */
14669 mp_number phi; /* angles of exit and entry at a knot */
14670 mp_number t; /* temp storage */
14671 mp_number ab_vs_cd;
14681 new_number (ab_vs_cd);
14682 set_number_to_zero (*ret); /* just in case */
14685 new_number (abs_x);
14686 new_number (abs_y);
14689 number_clone (x, x_orig);
14690 number_clone (y, y_orig);
14691 number_clone (abs_x, x_orig);
14692 number_clone (abs_y, y_orig);
14693 number_abs (abs_x);
14694 number_abs (abs_y);
14695 /* Normalize the given direction for better accuracy;
14696 but |return| with zero result if it's zero */
14697 if (number_less(abs_x, abs_y)) {
14700 make_fraction (r1, x, abs_y);
14701 number_clone(x, r1);
14703 if (number_positive(y)) {
14704 number_clone(y, fraction_one_t);
14706 number_clone(y, fraction_one_t);
14709 } else if (number_zero(x)) {
14714 make_fraction (r1, y, abs_x);
14715 number_clone(y, r1);
14717 if (number_positive(x)) {
14718 number_clone(x, fraction_one_t);
14720 number_clone(x, fraction_one_t);
14727 if (mp_right_type (p) == mp_endpoint)
14729 q = mp_next_knot (p);
14730 @<Rotate the cubic between |p| and |q|; then
14731 |goto found| if the rotated cubic travels due east at some time |tt|;
14732 but |break| if an entire cyclic path has been traversed@>;
14734 number_add(n, unity_t);
14736 set_number_to_unity (*ret);
14737 number_negate(*ret);
14740 set_number_from_addition (*ret, n, tt);
14745 free_number (abs_x);
14746 free_number (abs_y);
14747 /* Free local variables for |find_direction_time| */
14756 free_number (ab_vs_cd);
14765 @ Since we're interested in the tangent directions, we work with the
14766 derivative $${1\over3}B'(x_0,x_1,x_2,x_3;t)=
14767 B(x_1-x_0,x_2-x_1,x_3-x_2;t)$$ instead of
14768 $B(x_0,x_1,x_2,x_3;t)$ itself. The derived coefficients are also scale-d up
14769 in order to achieve better accuracy.
14771 The given path may turn abruptly at a knot, and it might pass the critical
14772 tangent direction at such a time. Therefore we remember the direction |phi|
14773 in which the previous rotated cubic was traveling. (The value of |phi| will be
14774 undefined on the first cubic, i.e., when |n=0|.)
14777 number_clone (tt, t);
14778 fraction_to_round_scaled (tt);
14782 @<Rotate the cubic between |p| and |q|; then...@>=
14783 set_number_to_zero(tt);
14784 /* Set local variables |x1,x2,x3| and |y1,y2,y3| to multiples of the control
14785 points of the rotated derivatives */
14788 new_number (absval);
14789 set_number_from_substraction(x1, p->right_x, p->x_coord);
14790 set_number_from_substraction(x2, q->left_x, p->right_x);
14791 set_number_from_substraction(x3, q->x_coord, q->left_x);
14792 set_number_from_substraction(y1, p->right_y, p->y_coord);
14793 set_number_from_substraction(y2, q->left_y, p->right_y);
14794 set_number_from_substraction(y3, q->y_coord, q->left_y);
14795 number_clone(absval, x2);
14796 number_abs(absval);
14797 number_clone(max, x1);
14799 if (number_greater(absval, max)) {
14800 number_clone(max, absval);
14802 number_clone(absval, x3);
14803 number_abs(absval);
14804 if (number_greater(absval, max)) {
14805 number_clone(max, absval);
14807 number_clone(absval, y1);
14808 number_abs(absval);
14809 if (number_greater(absval, max)) {
14810 number_clone(max, absval);
14812 number_clone(absval, y2);
14813 number_abs(absval);
14814 if (number_greater(absval, max)) {
14815 number_clone(max, absval);
14817 number_clone(absval, y3);
14818 number_abs(absval);
14819 if (number_greater(absval, max)) {
14820 number_clone(max, absval);
14822 free_number (absval);
14823 if (number_zero(max))
14825 while (number_less (max, fraction_half_t)) {
14826 number_double(max);
14834 number_clone(t, x1);
14839 take_fraction (r1, x1, x);
14840 take_fraction (r2, y1, y);
14841 set_number_from_addition(x1, r1, r2);
14842 take_fraction (r1, y1, x);
14843 take_fraction (r2, t, y);
14844 set_number_from_substraction(y1, r1, r2);
14845 number_clone(t, x2);
14846 take_fraction (r1, x2, x);
14847 take_fraction (r2, y2, y);
14848 set_number_from_addition(x2, r1, r2);
14849 take_fraction (r1, y2, x);
14850 take_fraction (r2, t, y);
14851 set_number_from_substraction(y2, r1, r2);
14852 number_clone(t, x3);
14853 take_fraction (r1, x3 ,x);
14854 take_fraction (r2, y3, y);
14855 set_number_from_addition(x3, r1, r2);
14856 take_fraction (r1, y3, x);
14857 take_fraction (r2, t, y);
14858 set_number_from_substraction(y3, r1, r2);
14863 if (number_zero(y1))
14864 if (number_zero(x1) || number_positive(x1))
14866 if (number_positive(n)) {
14867 /* Exit to |found| if an eastward direction occurs at knot |p| */
14871 n_arg (theta, x1, y1);
14873 set_number_from_substraction (tmp, theta, one_eighty_deg_t);
14875 if (number_nonnegative(theta) && number_nonpositive(phi) && number_greaterequal(phi, tmp)) {
14877 free_number (theta);
14880 set_number_from_addition (tmp, theta, one_eighty_deg_t);
14881 if (number_nonpositive(theta) && number_nonnegative(phi) && number_lessequal(phi, tmp)) {
14883 free_number (theta);
14887 free_number (theta);
14892 if (number_nonzero(x3) || number_nonzero(y3)) {
14893 n_arg (phi, x3, y3);
14895 /* Exit to |found| if the curve whose derivatives are specified by
14896 |x1,x2,x3,y1,y2,y3| travels eastward at some time~|tt| */
14897 /* In this step we want to use the |crossing_point| routine to find the
14898 roots of the quadratic equation $B(y_1,y_2,y_3;t)=0$.
14899 Several complications arise: If the quadratic equation has a double root,
14900 the curve never crosses zero, and |crossing_point| will find nothing;
14901 this case occurs iff $y_1y_3=y_2^2$ and $y_1y_2<0$. If the quadratic
14902 equation has simple roots, or only one root, we may have to negate it
14903 so that $B(y_1,y_2,y_3;t)$ crosses from positive to negative at its first root.
14904 And finally, we need to do special things if $B(y_1,y_2,y_3;t)$ is
14905 identically zero. */
14906 if (number_negative(x1))
14907 if (number_negative(x2))
14908 if (number_negative(x3))
14911 ab_vs_cd (ab_vs_cd, y1, y3, y2, y2);
14912 if (number_zero(ab_vs_cd)) {
14913 /* Handle the test for eastward directions when $y_1y_3=y_2^2$;
14914 either |goto found| or |goto done| */
14916 ab_vs_cd (ab_vs_cd, y1, y2, zero_t, zero_t);
14917 if (number_negative(ab_vs_cd)) {
14918 mp_number tmp, arg2;
14921 set_number_from_substraction (arg2, y1, y2);
14922 make_fraction (t, y1, arg2);
14923 free_number (arg2);
14924 set_number_from_of_the_way(x1, t, x1, x2);
14925 set_number_from_of_the_way(x2, t, x2, x3);
14926 set_number_from_of_the_way(tmp, t, x1, x2);
14927 if (number_zero(tmp) || number_positive(tmp)) {
14932 } else if (number_zero(y3)) {
14933 if (number_zero(y1)) {
14934 /* Exit to |found| if the derivative $B(x_1,x_2,x_3;t)$ becomes |>=0| */
14935 /* At this point we know that the derivative of |y(t)| is identically zero,
14936 and that |x1<0|; but either |x2>=0| or |x3>=0|, so there's some hope of
14939 mp_number arg1, arg2, arg3;
14943 number_clone(arg1, x1);
14944 number_negate(arg1);
14945 number_clone(arg2, x2);
14946 number_negate(arg2);
14947 number_clone(arg3, x3);
14948 number_negate(arg3);
14949 crossing_point (t, arg1, arg2, arg3);
14950 free_number (arg1);
14951 free_number (arg2);
14952 free_number (arg3);
14953 if (number_lessequal (t, fraction_one_t))
14955 ab_vs_cd (ab_vs_cd, x1, x3, x2, x2);
14956 if (number_nonpositive(ab_vs_cd)) {
14959 set_number_from_substraction (arg2, x1, x2);
14960 make_fraction (t, x1, arg2);
14961 free_number (arg2);
14968 } else if (number_zero(x3) || number_positive(x3)) {
14969 set_number_to_unity(tt);
14979 if (number_zero(y1) || number_negative(y1)) {
14980 if (number_negative(y1)) {
14984 } else if (number_positive(y2)) {
14989 /* Check the places where $B(y_1,y_2,y_3;t)=0$ to see if
14990 $B(x_1,x_2,x_3;t)\ge0$ */
14991 /* The quadratic polynomial $B(y_1,y_2,y_3;t)$ begins |>=0| and has at most
14992 two roots, because we know that it isn't identically zero.
14994 It must be admitted that the |crossing_point| routine is not perfectly accurate;
14995 rounding errors might cause it to find a root when $y_1y_3>y_2^2$, or to
14996 miss the roots when $y_1y_3<y_2^2$. The rotation process is itself
14997 subject to rounding errors. Yet this code optimistically tries to
14998 do the right thing.
15001 crossing_point (t, y1, y2, y3);
15002 if (number_greater (t, fraction_one_t))
15004 set_number_from_of_the_way(y2, t, y2, y3);
15005 set_number_from_of_the_way(x1, t, x1, x2);
15006 set_number_from_of_the_way(x2, t, x2, x3);
15007 set_number_from_of_the_way(x1, t, x1, x2);
15008 if (number_zero(x1) || number_positive(x1))
15010 if (number_positive(y2))
15011 set_number_to_zero(y2);
15012 number_clone(tt, t);
15014 mp_number arg1, arg2, arg3;
15018 number_clone(arg2, y2);
15019 number_negate(arg2);
15020 number_clone(arg3, y3);
15021 number_negate(arg3);
15022 crossing_point (t, arg1, arg2, arg3);
15023 free_number (arg1);
15024 free_number (arg2);
15025 free_number (arg3);
15027 if (number_greater (t, fraction_one_t))
15032 set_number_from_of_the_way(x1, t, x1, x2);
15033 set_number_from_of_the_way(x2, t, x2, x3);
15034 set_number_from_of_the_way(tmp, t, x1, x2);
15035 if (number_nonnegative(tmp)) {
15037 set_number_from_of_the_way (t, t, tt, fraction_one_t);
15045 @ The intersection of two cubics can be found by an interesting variant
15046 of the general bisection scheme described in the introduction to
15048 Given $w(t)=B(w_0,w_1,w_2,w_3;t)$ and $z(t)=B(z_0,z_1,z_2,z_3;t)$,
15049 we wish to find a pair of times $(t_1,t_2)$ such that $w(t_1)=z(t_2)$,
15050 if an intersection exists. First we find the smallest rectangle that
15051 encloses the points $\{w_0,w_1,w_2,w_3\}$ and check that it overlaps
15052 the smallest rectangle that encloses
15053 $\{z_0,z_1,z_2,z_3\}$; if not, the cubics certainly don't intersect.
15054 But if the rectangles do overlap, we bisect the intervals, getting
15055 new cubics $w'$ and~$w''$, $z'$~and~$z''$; the intersection routine first
15056 tries for an intersection between $w'$ and~$z'$, then (if unsuccessful)
15057 between $w'$ and~$z''$, then (if still unsuccessful) between $w''$ and~$z'$,
15058 finally (if thrice unsuccessful) between $w''$ and~$z''$. After $l$~successful
15059 levels of bisection we will have determined the intersection times $t_1$
15060 and~$t_2$ to $l$~bits of accuracy.
15062 \def\submin{_{\rm min}} \def\submax{_{\rm max}}
15063 As before, it is better to work with the numbers $W_k=2^l(w_k-w_{k-1})$
15064 and $Z_k=2^l(z_k-z_{k-1})$ rather than the coefficients $w_k$ and $z_k$
15065 themselves. We also need one other quantity, $\Delta=2^l(w_0-z_0)$,
15066 to determine when the enclosing rectangles overlap. Here's why:
15067 The $x$~coordinates of~$w(t)$ are between $u\submin$ and $u\submax$,
15068 and the $x$~coordinates of~$z(t)$ are between $x\submin$ and $x\submax$,
15069 if we write $w_k=(u_k,v_k)$ and $z_k=(x_k,y_k)$ and $u\submin=
15070 \min(u_0,u_1,u_2,u_3)$, etc. These intervals of $x$~coordinates
15071 overlap if and only if $u\submin\L x\submax$ and
15072 $x\submin\L u\submax$. Letting
15073 $$U\submin=\min(0,U_1,U_1+U_2,U_1+U_2+U_3),\;
15074 U\submax=\max(0,U_1,U_1+U_2,U_1+U_2+U_3),$$
15075 we have $2^lu\submin=2^lu_0+U\submin$, etc.; the condition for overlap
15077 $$X\submin-U\submax\L 2^l(u_0-x_0)\L X\submax-U\submin.$$
15078 Thus we want to maintain the quantity $2^l(u_0-x_0)$; similarly,
15079 the quantity $2^l(v_0-y_0)$ accounts for the $y$~coordinates. The
15080 coordinates of $\Delta=2^l(w_0-z_0)$ must stay bounded as $l$ increases,
15081 because of the overlap condition; i.e., we know that $X\submin$,
15082 $X\submax$, and their relatives are bounded, hence $X\submax-
15083 U\submin$ and $X\submin-U\submax$ are bounded.
15085 @ Incidentally, if the given cubics intersect more than once, the process
15086 just sketched will not necessarily find the lexicographically smallest pair
15087 $(t_1,t_2)$. The solution actually obtained will be smallest in ``shuffled
15088 order''; i.e., if $t_1=(.a_1a_2\ldots a_{16})_2$ and
15089 $t_2=(.b_1b_2\ldots b_{16})_2$, then we will minimize
15090 $a_1b_1a_2b_2\ldots a_{16}b_{16}$, not
15091 $a_1a_2\ldots a_{16}b_1b_2\ldots b_{16}$.
15092 Shuffled order agrees with lexicographic order if all pairs of solutions
15093 $(t_1,t_2)$ and $(t_1',t_2')$ have the property that $t_1<t_1'$ iff
15094 $t_2<t_2'$; but in general, lexicographic order can be quite different,
15095 and the bisection algorithm would be substantially less efficient if it were
15096 constrained by lexicographic order.
15098 For example, suppose that an overlap has been found for $l=3$ and
15099 $(t_1,t_2)= (.101,.011)$ in binary, but that no overlap is produced by
15100 either of the alternatives $(.1010,.0110)$, $(.1010,.0111)$ at level~4.
15101 Then there is probably an intersection in one of the subintervals
15102 $(.1011,.011x)$; but lexicographic order would require us to explore
15103 $(.1010,.1xxx)$ and $(.1011,.00xx)$ and $(.1011,.010x)$ first. We wouldn't
15104 want to store all of the subdivision data for the second path, so the
15105 subdivisions would have to be regenerated many times. Such inefficiencies
15106 would be associated with every `1' in the binary representation of~$t_1$.
15108 @ The subdivision process introduces rounding errors, hence we need to
15109 make a more liberal test for overlap. It is not hard to show that the
15110 computed values of $U_i$ differ from the truth by at most~$l$, on
15111 level~$l$, hence $U\submin$ and $U\submax$ will be at most $3l$ in error.
15112 If $\beta$ is an upper bound on the absolute error in the computed
15113 components of $\Delta=(|delx|,|dely|)$ on level~$l$, we will replace
15114 the test `$X\submin-U\submax\L|delx|$' by the more liberal test
15115 `$X\submin-U\submax\L|delx|+|tol|$', where $|tol|=6l+\beta$.
15117 More accuracy is obtained if we try the algorithm first with |tol=0|;
15118 the more liberal tolerance is used only if an exact approach fails.
15119 It is convenient to do this double-take by letting `3' in the preceding
15120 paragraph be a parameter, which is first 0, then 3.
15123 unsigned int tol_step; /* either 0 or 3, usually */
15125 @ We shall use an explicit stack to implement the recursive bisection
15126 method described above. The |bisect_stack| array will contain numerous 5-word
15127 packets like $(U_1,U_2,U_3,U\submin,U\submax)$, as well as 20-word packets
15128 comprising the 5-word packets for $U$, $V$, $X$, and~$Y$.
15130 The following macros define the allocation of stack positions to
15131 the quantities needed for bisection-intersection.
15133 @d stack_1(A) mp->bisect_stack[(A)] /* $U_1$, $V_1$, $X_1$, or $Y_1$ */
15134 @d stack_2(A) mp->bisect_stack[(A)+1] /* $U_2$, $V_2$, $X_2$, or $Y_2$ */
15135 @d stack_3(A) mp->bisect_stack[(A)+2] /* $U_3$, $V_3$, $X_3$, or $Y_3$ */
15136 @d stack_min(A) mp->bisect_stack[(A)+3]
15137 /* $U\submin$, $V\submin$, $X\submin$, or $Y\submin$ */
15138 @d stack_max(A) mp->bisect_stack[(A)+4]
15139 /* $U\submax$, $V\submax$, $X\submax$, or $Y\submax$ */
15140 @d int_packets 20 /* number of words to represent $U_k$, $V_k$, $X_k$, and $Y_k$ */
15142 @d u_packet(A) ((A)-5)
15143 @d v_packet(A) ((A)-10)
15144 @d x_packet(A) ((A)-15)
15145 @d y_packet(A) ((A)-20)
15146 @d l_packets (mp->bisect_ptr-int_packets)
15147 @d r_packets mp->bisect_ptr
15148 @d ul_packet u_packet(l_packets) /* base of $U'_k$ variables */
15149 @d vl_packet v_packet(l_packets) /* base of $V'_k$ variables */
15150 @d xl_packet x_packet(l_packets) /* base of $X'_k$ variables */
15151 @d yl_packet y_packet(l_packets) /* base of $Y'_k$ variables */
15152 @d ur_packet u_packet(r_packets) /* base of $U''_k$ variables */
15153 @d vr_packet v_packet(r_packets) /* base of $V''_k$ variables */
15154 @d xr_packet x_packet(r_packets) /* base of $X''_k$ variables */
15155 @d yr_packet y_packet(r_packets) /* base of $Y''_k$ variables */
15157 @d u1l stack_1(ul_packet) /* $U'_1$ */
15158 @d u2l stack_2(ul_packet) /* $U'_2$ */
15159 @d u3l stack_3(ul_packet) /* $U'_3$ */
15160 @d v1l stack_1(vl_packet) /* $V'_1$ */
15161 @d v2l stack_2(vl_packet) /* $V'_2$ */
15162 @d v3l stack_3(vl_packet) /* $V'_3$ */
15163 @d x1l stack_1(xl_packet) /* $X'_1$ */
15164 @d x2l stack_2(xl_packet) /* $X'_2$ */
15165 @d x3l stack_3(xl_packet) /* $X'_3$ */
15166 @d y1l stack_1(yl_packet) /* $Y'_1$ */
15167 @d y2l stack_2(yl_packet) /* $Y'_2$ */
15168 @d y3l stack_3(yl_packet) /* $Y'_3$ */
15169 @d u1r stack_1(ur_packet) /* $U''_1$ */
15170 @d u2r stack_2(ur_packet) /* $U''_2$ */
15171 @d u3r stack_3(ur_packet) /* $U''_3$ */
15172 @d v1r stack_1(vr_packet) /* $V''_1$ */
15173 @d v2r stack_2(vr_packet) /* $V''_2$ */
15174 @d v3r stack_3(vr_packet) /* $V''_3$ */
15175 @d x1r stack_1(xr_packet) /* $X''_1$ */
15176 @d x2r stack_2(xr_packet) /* $X''_2$ */
15177 @d x3r stack_3(xr_packet) /* $X''_3$ */
15178 @d y1r stack_1(yr_packet) /* $Y''_1$ */
15179 @d y2r stack_2(yr_packet) /* $Y''_2$ */
15180 @d y3r stack_3(yr_packet) /* $Y''_3$ */
15182 @d stack_dx mp->bisect_stack[mp->bisect_ptr] /* stacked value of |delx| */
15183 @d stack_dy mp->bisect_stack[mp->bisect_ptr+1] /* stacked value of |dely| */
15184 @d stack_tol mp->bisect_stack[mp->bisect_ptr+2] /* stacked value of |tol| */
15185 @d stack_uv mp->bisect_stack[mp->bisect_ptr+3] /* stacked value of |uv| */
15186 @d stack_xy mp->bisect_stack[mp->bisect_ptr+4] /* stacked value of |xy| */
15187 @d int_increment (int_packets+int_packets+5) /* number of stack words per level */
15190 mp_number *bisect_stack;
15191 integer bisect_ptr;
15193 @ @<Allocate or initialize ...@>=
15194 mp->bisect_stack = xmalloc ((bistack_size + 1), sizeof (mp_number));
15197 for (i=0;i<bistack_size + 1;i++) {
15198 new_number (mp->bisect_stack[i]);
15202 @ @<Dealloc variables@>=
15205 for (i=0;i<bistack_size + 1;i++) {
15206 free_number (mp->bisect_stack[i]);
15209 xfree (mp->bisect_stack);
15211 @ @<Check the ``constant''...@>=
15212 if (int_packets + 17 * int_increment > bistack_size)
15215 @ Computation of the min and max is a tedious but fairly fast sequence of
15216 instructions; exactly four comparisons are made in each branch.
15219 debug_number (stack_1(A));
15220 debug_number (stack_3(A));
15221 debug_number (stack_2(A));
15222 debug_number (stack_min(A));
15223 debug_number (stack_max(A));
15224 if ( number_negative(stack_1((A))) ) {
15225 if ( number_nonnegative (stack_3((A))) ) {
15226 if ( number_negative (stack_2((A))) )
15227 set_number_from_addition (stack_min((A)), stack_1((A)), stack_2((A)));
15229 number_clone (stack_min((A)), stack_1((A)));
15230 set_number_from_addition (stack_max((A)), stack_1((A)), stack_2((A)));
15231 number_add (stack_max((A)), stack_3((A)));
15232 if ( number_negative (stack_max((A))) )
15233 set_number_to_zero (stack_max((A)));
15235 set_number_from_addition (stack_min((A)), stack_1((A)), stack_2((A)));
15236 number_add (stack_min((A)), stack_3((A)));
15237 if ( number_greater (stack_min((A)), stack_1((A))))
15238 number_clone (stack_min((A)), stack_1((A)));
15239 set_number_from_addition (stack_max((A)), stack_1((A)), stack_2((A)));
15240 if ( number_negative (stack_max((A))) )
15241 set_number_to_zero (stack_max((A)));
15243 } else if ( number_nonpositive (stack_3((A)))) {
15244 if ( number_positive (stack_2((A))) )
15245 set_number_from_addition (stack_max((A)), stack_1((A)), stack_2((A)));
15247 number_clone (stack_max((A)), stack_1((A)));
15248 set_number_from_addition (stack_min((A)), stack_1((A)), stack_2((A)));
15249 number_add (stack_min((A)), stack_3((A)));
15250 if ( number_positive (stack_min((A))) )
15251 set_number_to_zero (stack_min((A)));
15253 set_number_from_addition (stack_max((A)), stack_1((A)), stack_2((A)));
15254 number_add (stack_max((A)), stack_3((A)));
15255 if ( number_less (stack_max((A)), stack_1((A))))
15256 number_clone (stack_max((A)), stack_1((A)));
15257 set_number_from_addition (stack_min((A)), stack_1((A)), stack_2((A)));
15258 if ( number_positive (stack_min((A))) )
15259 set_number_to_zero (stack_min((A)));
15262 @ It's convenient to keep the current values of $l$, $t_1$, and $t_2$ in
15263 the integer form $2^l+2^lt_1$ and $2^l+2^lt_2$. The |cubic_intersection|
15264 routine uses global variables |cur_t| and |cur_tt| for this purpose;
15265 after successful completion, |cur_t| and |cur_tt| will contain |unity|
15266 plus the |scaled| values of $t_1$ and~$t_2$.
15268 The values of |cur_t| and |cur_tt| will be set to zero if |cubic_intersection|
15269 finds no intersection. The routine gives up and gives an approximate answer
15270 if it has backtracked
15271 more than 5000 times (otherwise there are cases where several minutes
15272 of fruitless computation would be possible).
15274 @d max_patience 5000
15278 mp_number cur_tt; /* controls and results of |cubic_intersection| */
15279 integer time_to_go; /* this many backtracks before giving up */
15280 mp_number max_t; /* maximum of $2^{l+1}$ so far achieved */
15282 @ @<Initialize table ...@>=
15283 new_number (mp->cur_t);
15284 new_number (mp->cur_tt);
15285 new_number (mp->max_t);
15288 free_number (mp->cur_t);
15289 free_number (mp->cur_tt);
15290 free_number (mp->max_t);
15292 @ The given cubics $B(w_0,w_1,w_2,w_3;t)$ and
15293 $B(z_0,z_1,z_2,z_3;t)$ are specified in adjacent knot nodes |(p,mp_link(p))|
15294 and |(pp,mp_link(pp))|, respectively.
15299 static void mp_cubic_intersection (MP mp, mp_knot p, mp_knot pp) {
15300 mp_knot q, qq; /* |mp_link(p)|, |mp_link(pp)| */
15301 mp->time_to_go = max_patience;
15302 set_number_from_scaled (mp->max_t, 2);
15303 @<Initialize for intersections at level zero@>;
15306 if (number_to_scaled (mp->delx) - mp->tol <=
15307 number_to_scaled (stack_max (x_packet (mp->xy))) - number_to_scaled (stack_min (u_packet (mp->uv))))
15308 if (number_to_scaled (mp->delx) + mp->tol >=
15309 number_to_scaled (stack_min (x_packet (mp->xy))) - number_to_scaled (stack_max (u_packet (mp->uv))))
15310 if (number_to_scaled (mp->dely) - mp->tol <=
15311 number_to_scaled (stack_max (y_packet (mp->xy))) - number_to_scaled (stack_min (v_packet (mp->uv))))
15312 if (number_to_scaled (mp->dely) + mp->tol >=
15313 number_to_scaled (stack_min (y_packet (mp->xy))) - number_to_scaled (stack_max (v_packet (mp->uv)))) {
15314 if (number_to_scaled (mp->cur_t) >= number_to_scaled (mp->max_t)) {
15315 if (number_equal(mp->max_t, two_t)) { /* we've done 17 bisections */
15316 set_number_from_scaled (mp->cur_t, ((number_to_scaled (mp->cur_t) + 1)/2));
15317 set_number_from_scaled (mp->cur_tt, ((number_to_scaled (mp->cur_tt) + 1)/2));
15320 number_double(mp->max_t);
15321 number_clone (mp->appr_t, mp->cur_t);
15322 number_clone (mp->appr_tt, mp->cur_tt);
15324 @<Subdivide for a new level of intersection@>;
15327 if (mp->time_to_go > 0) {
15328 decr (mp->time_to_go);
15330 while (number_less (mp->appr_t, unity_t)) {
15331 number_double(mp->appr_t);
15332 number_double(mp->appr_tt);
15334 number_clone (mp->cur_t, mp->appr_t);
15335 number_clone (mp->cur_tt, mp->appr_tt);
15339 /* Advance to the next pair |(cur_t,cur_tt)| */
15340 if (odd (number_to_scaled (mp->cur_tt))) {
15341 if (odd (number_to_scaled (mp->cur_t))) {
15342 /* Descend to the previous level and |goto not_found| */
15344 set_number_from_scaled (mp->cur_t, half (number_to_scaled (mp->cur_t)));
15345 set_number_from_scaled (mp->cur_tt, half (number_to_scaled (mp->cur_tt)));
15346 if (number_to_scaled (mp->cur_t) == 0)
15348 mp->bisect_ptr -= int_increment;
15349 mp->three_l -= (integer) mp->tol_step;
15350 number_clone (mp->delx, stack_dx);
15351 number_clone (mp->dely, stack_dy);
15352 mp->tol = number_to_scaled (stack_tol);
15353 mp->uv = number_to_scaled (stack_uv);
15354 mp->xy = number_to_scaled (stack_xy);
15359 set_number_from_scaled (mp->cur_t, number_to_scaled (mp->cur_t) + 1);
15360 number_add (mp->delx, stack_1 (u_packet (mp->uv)));
15361 number_add (mp->delx, stack_2 (u_packet (mp->uv)));
15362 number_add (mp->delx, stack_3 (u_packet (mp->uv)));
15363 number_add (mp->dely, stack_1 (v_packet (mp->uv)));
15364 number_add (mp->dely, stack_2 (v_packet (mp->uv)));
15365 number_add (mp->dely, stack_3 (v_packet (mp->uv)));
15366 mp->uv = mp->uv + int_packets; /* switch from |l_packets| to |r_packets| */
15367 set_number_from_scaled (mp->cur_tt, number_to_scaled (mp->cur_tt) - 1);
15368 mp->xy = mp->xy - int_packets;
15369 number_add (mp->delx, stack_1 (x_packet (mp->xy)));
15370 number_add (mp->delx, stack_2 (x_packet (mp->xy)));
15371 number_add (mp->delx, stack_3 (x_packet (mp->xy)));
15372 number_add (mp->dely, stack_1 (y_packet (mp->xy)));
15373 number_add (mp->dely, stack_2 (y_packet (mp->xy)));
15374 number_add (mp->dely, stack_3 (y_packet (mp->xy)));
15377 set_number_from_scaled (mp->cur_tt, number_to_scaled (mp->cur_tt) + 1);
15378 mp->tol = mp->tol + mp->three_l;
15379 number_substract (mp->delx, stack_1 (x_packet (mp->xy)));
15380 number_substract (mp->delx, stack_2 (x_packet (mp->xy)));
15381 number_substract (mp->delx, stack_3 (x_packet (mp->xy)));
15382 number_substract (mp->dely, stack_1 (y_packet (mp->xy)));
15383 number_substract (mp->dely, stack_2 (y_packet (mp->xy)));
15384 number_substract (mp->dely, stack_3 (y_packet (mp->xy)));
15385 mp->xy = mp->xy + int_packets; /* switch from |l_packets| to |r_packets| */
15391 @ The following variables are global, although they are used only by
15392 |cubic_intersection|, because it is necessary on some machines to
15393 split |cubic_intersection| up into two procedures.
15397 mp_number dely; /* the components of $\Delta=2^l(w_0-z_0)$ */
15398 integer tol; /* bound on the uncertainty in the overlap test */
15400 integer xy; /* pointers to the current packets of interest */
15401 integer three_l; /* |tol_step| times the bisection level */
15403 mp_number appr_tt; /* best approximations known to the answers */
15405 @ @<Initialize table ...@>=
15406 new_number (mp->delx);
15407 new_number (mp->dely);
15408 new_number (mp->appr_t);
15409 new_number (mp->appr_tt);
15412 free_number (mp->delx);
15413 free_number (mp->dely);
15414 free_number (mp->appr_t);
15415 free_number (mp->appr_tt);
15417 @ We shall assume that the coordinates are sufficiently non-extreme that
15418 integer overflow will not occur.
15419 @^overflow in arithmetic@>
15421 @<Initialize for intersections at level zero@>=
15422 q = mp_next_knot (p);
15423 qq = mp_next_knot (pp);
15424 mp->bisect_ptr = int_packets;
15425 set_number_from_substraction (u1r, p->right_x, p->x_coord);
15426 set_number_from_substraction (u2r, q->left_x, p->right_x);
15427 set_number_from_substraction (u3r, q->x_coord, q->left_x);
15428 set_min_max (ur_packet);
15429 set_number_from_substraction (v1r, p->right_y, p->y_coord );
15430 set_number_from_substraction (v2r, q->left_y, p->right_y);
15431 set_number_from_substraction (v3r, q->y_coord, q->left_y );
15432 set_min_max (vr_packet);
15433 set_number_from_substraction (x1r, pp->right_x, pp->x_coord );
15434 set_number_from_substraction (x2r, qq->left_x, pp->right_x );
15435 set_number_from_substraction (x3r, qq->x_coord, qq->left_x );
15436 set_min_max (xr_packet);
15437 set_number_from_substraction (y1r, pp->right_y, pp->y_coord );
15438 set_number_from_substraction (y2r, qq->left_y, pp->right_y);
15439 set_number_from_substraction (y3r, qq->y_coord, qq->left_y);
15440 set_min_max (yr_packet);
15441 set_number_from_substraction (mp->delx, p->x_coord, pp->x_coord );
15442 set_number_from_substraction (mp->dely, p->y_coord, pp->y_coord );
15444 mp->uv = r_packets;
15445 mp->xy = r_packets;
15447 set_number_from_scaled (mp->cur_t, 1);
15448 set_number_from_scaled (mp->cur_tt, 1)
15452 @<Subdivide for a new level of intersection@>=
15453 number_clone (stack_dx, mp->delx);
15454 number_clone (stack_dy, mp->dely);
15455 set_number_from_scaled (stack_tol, mp->tol);
15456 set_number_from_scaled (stack_uv, mp->uv);
15457 set_number_from_scaled (stack_xy, mp->xy);
15458 mp->bisect_ptr = mp->bisect_ptr + int_increment;
15459 number_double (mp->cur_t);
15460 number_double (mp->cur_tt);
15461 number_clone (u1l, stack_1 (u_packet (mp->uv)));
15462 number_clone (u3r, stack_3 (u_packet (mp->uv)));
15463 set_number_from_addition (u2l, u1l, stack_2 (u_packet (mp->uv))); number_half (u2l);
15464 set_number_from_addition (u2r, u3r, stack_2 (u_packet (mp->uv))); number_half (u2r);
15465 set_number_from_addition (u3l, u2l, u2r); number_half (u3l);
15466 number_clone (u1r, u3l);
15467 set_min_max (ul_packet);
15468 set_min_max (ur_packet);
15469 number_clone (v1l, stack_1 (v_packet (mp->uv)));
15470 number_clone (v3r, stack_3 (v_packet (mp->uv)));
15471 set_number_from_addition (v2l, v1l, stack_2 (v_packet (mp->uv))); number_half(v2l);
15472 set_number_from_addition (v2r, v3r, stack_2 (v_packet (mp->uv))); number_half(v2r);
15473 set_number_from_addition (v3l, v2l, v2r); number_half(v3l);
15474 number_clone (v1r, v3l);
15475 set_min_max (vl_packet);
15476 set_min_max (vr_packet);
15477 number_clone (x1l, stack_1 (x_packet (mp->xy)));
15478 number_clone (x3r, stack_3 (x_packet (mp->xy)));
15479 set_number_from_addition (x2l, x1l, stack_2 (x_packet (mp->xy))); number_half(x2l);
15480 set_number_from_addition (x2r, x3r, stack_2 (x_packet (mp->xy))); number_half(x2r);
15481 set_number_from_addition (x3l, x2l, x2r); number_half(x3l);
15482 number_clone (x1r, x3l);
15483 set_min_max (xl_packet);
15484 set_min_max (xr_packet);
15485 number_clone (y1l, stack_1 (y_packet (mp->xy)));
15486 number_clone (y3r, stack_3 (y_packet (mp->xy)));
15487 set_number_from_addition (y2l, y1l, stack_2 (y_packet (mp->xy))); number_half (y2l);
15488 set_number_from_addition (y2r, y3r, stack_2 (y_packet (mp->xy))); number_half (y2r);
15489 set_number_from_addition (y3l, y2l, y2r); number_half (y3l);
15490 number_clone (y1r, y3l);
15491 set_min_max (yl_packet);
15492 set_min_max (yr_packet);
15493 mp->uv = l_packets;
15494 mp->xy = l_packets;
15495 number_double(mp->delx);
15496 number_double(mp->dely);
15497 mp->tol = mp->tol - mp->three_l + (integer) mp->tol_step;
15498 mp->tol += mp->tol;
15499 mp->three_l = mp->three_l + (integer) mp->tol_step
15501 @ The |path_intersection| procedure is much simpler.
15502 It invokes |cubic_intersection| in lexicographic order until finding a
15503 pair of cubics that intersect. The final intersection times are placed in
15504 |cur_t| and~|cur_tt|.
15507 static void mp_path_intersection (MP mp, mp_knot h, mp_knot hh) {
15508 mp_knot p, pp; /* link registers that traverse the given paths */
15509 mp_number n, nn; /* integer parts of intersection times, minus |unity| */
15510 @<Change one-point paths into dead cycles@>;
15515 set_number_to_unity(n);
15519 if (mp_right_type (p) != mp_endpoint) {
15520 set_number_to_unity(nn);
15521 number_negate (nn);
15524 if (mp_right_type (pp) != mp_endpoint) {
15525 mp_cubic_intersection (mp, p, pp);
15526 if (number_positive (mp->cur_t)) {
15527 number_add (mp->cur_t, n);
15528 number_add (mp->cur_tt, nn);
15532 number_add(nn, unity_t);
15533 pp = mp_next_knot (pp);
15534 } while (pp != hh);
15536 number_add(n, unity_t);
15537 p = mp_next_knot (p);
15539 mp->tol_step = mp->tol_step + 3;
15540 } while (mp->tol_step <= 3);
15541 number_clone (mp->cur_t, unity_t);
15542 number_negate (mp->cur_t);
15543 number_clone (mp->cur_tt, unity_t);
15544 number_negate (mp->cur_tt);
15551 @ @<Change one-point paths...@>=
15552 if (mp_right_type (h) == mp_endpoint) {
15553 number_clone (h->right_x, h->x_coord);
15554 number_clone (h->left_x, h->x_coord);
15555 number_clone (h->right_y, h->y_coord);
15556 number_clone (h->left_y, h->y_coord);
15557 mp_right_type (h) = mp_explicit;
15559 if (mp_right_type (hh) == mp_endpoint) {
15560 number_clone (hh->right_x, hh->x_coord);
15561 number_clone (hh->left_x, hh->x_coord);
15562 number_clone (hh->right_y, hh->y_coord);
15563 number_clone (hh->left_y, hh->y_coord);
15564 mp_right_type (hh) = mp_explicit;
15567 @* Dynamic linear equations.
15568 \MP\ users define variables implicitly by stating equations that should be
15569 satisfied; the computer is supposed to be smart enough to solve those equations.
15570 And indeed, the computer tries valiantly to do so, by distinguishing five
15571 different types of numeric values:
15574 |type(p)=mp_known| is the nice case, when |value(p)| is the |scaled| value
15575 of the variable whose address is~|p|.
15578 |type(p)=mp_dependent| means that |value(p)| is not present, but |dep_list(p)|
15579 points to a {\sl dependency list\/} that expresses the value of variable~|p|
15580 as a |scaled| number plus a sum of independent variables with |fraction|
15584 |type(p)=mp_independent| means that |indep_value(p)=s|, where |s>0| is a ``serial
15585 number'' reflecting the time this variable was first used in an equation;
15586 and there is an extra field |indep_scale(p)=m|, with |0<=m<64|, each dependent
15587 variable that refers to this one is actually referring to the future value of
15588 this variable times~$2^m$. (Usually |m=0|, but higher degrees of
15589 scaling are sometimes needed to keep the coefficients in dependency lists
15590 from getting too large. The value of~|m| will always be even.)
15593 |type(p)=mp_numeric_type| means that variable |p| hasn't appeared in an
15594 equation before, but it has been explicitly declared to be numeric.
15597 |type(p)=undefined| means that variable |p| hasn't appeared before.
15599 \smallskip\noindent
15600 We have actually discussed these five types in the reverse order of their
15601 history during a computation: Once |known|, a variable never again
15602 becomes |dependent|; once |dependent|, it almost never again becomes
15603 |mp_independent|; once |mp_independent|, it never again becomes |mp_numeric_type|;
15604 and once |mp_numeric_type|, it never again becomes |undefined| (except
15605 of course when the user specifically decides to scrap the old value
15606 and start again). A backward step may, however, take place: Sometimes
15607 a |dependent| variable becomes |mp_independent| again, when one of the
15608 independent variables it depends on is reverting to |undefined|.
15610 @d indep_scale(A) ((mp_value_node)(A))->data.indep.scale
15611 @d set_indep_scale(A,B) ((mp_value_node)(A))->data.indep.scale=(B)
15612 @d indep_value(A) ((mp_value_node)(A))->data.indep.serial
15613 @d set_indep_value(A,B) ((mp_value_node)(A))->data.indep.serial=(B)
15617 void mp_new_indep(MP mp, mp_node p) { /* create a new independent variable */
15618 if ( mp->serial_no>=max_integer ) {
15619 mp_fatal_error(mp, "variable instance identifiers exhausted");
15621 mp_type(p)=mp_independent;
15622 mp->serial_no=mp->serial_no+1;
15623 set_indep_scale(p,0);
15624 set_indep_value(p,mp->serial_no);
15627 @ @<Declarations@>=
15628 void mp_new_indep(MP mp, mp_node p);
15632 integer serial_no; /* the most recent serial number */
15634 @ But how are dependency lists represented? It's simple: The linear combination
15635 $\alpha_1v_1+\cdots+\alpha_kv_k+\beta$ appears in |k+1| value nodes. If
15636 |q=dep_list(p)| points to this list, and if |k>0|, then |dep_value(q)=
15637 @t$\alpha_1$@>| (which is a |fraction|); |dep_info(q)| points to the location
15638 of $\alpha_1$; and |mp_link(p)| points to the dependency list
15639 $\alpha_2v_2+\cdots+\alpha_kv_k+\beta$. On the other hand if |k=0|,
15640 then |dep_value(q)=@t$\beta$@>| (which is |scaled|) and |dep_info(q)=NULL|.
15641 The independent variables $v_1$, \dots,~$v_k$ have been sorted so that
15642 they appear in decreasing order of their |value| fields (i.e., of
15643 their serial numbers). \ (It is convenient to use decreasing order,
15644 since |value(NULL)=0|. If the independent variables were not sorted by
15645 serial number but by some other criterion, such as their location in |mem|,
15646 the equation-solving mechanism would be too system-dependent, because
15647 the ordering can affect the computed results.)
15649 The |link| field in the node that contains the constant term $\beta$ is
15650 called the {\sl final link\/} of the dependency list. \MP\ maintains
15651 a doubly-linked master list of all dependency lists, in terms of a permanently
15653 in |mem| called |dep_head|. If there are no dependencies, we have
15654 |mp_link(dep_head)=dep_head| and |prev_dep(dep_head)=dep_head|;
15655 otherwise |mp_link(dep_head)| points to the first dependent variable, say~|p|,
15656 and |prev_dep(p)=dep_head|. We have |type(p)=mp_dependent|, and |dep_list(p)|
15657 points to its dependency list. If the final link of that dependency list
15658 occurs in location~|q|, then |mp_link(q)| points to the next dependent
15659 variable (say~|r|); and we have |prev_dep(r)=q|, etc.
15661 Dependency nodes sometimes mutate into value nodes and vice versa, so their
15662 structures have to match.
15664 @d dep_value(A) ((mp_value_node)(A))->data.n
15665 @d set_dep_value(A,B) do_set_dep_value(mp,(A),(B))
15666 @d dep_info(A) get_dep_info(mp, (A))
15667 @d set_dep_info(A,B) do {
15668 mp_value_node d = (mp_value_node)(B);
15669 FUNCTION_TRACE4("set_dep_info(%p,%p) on %d\n",(A),d,__LINE__);
15670 ((mp_value_node)(A))->parent_ = (mp_node)d;
15672 @d dep_list(A) ((mp_value_node)(A))->attr_head_ /* half of the |value| field in a |dependent| variable */
15673 @d set_dep_list(A,B) do {
15674 mp_value_node d = (mp_value_node)(B);
15675 FUNCTION_TRACE4("set_dep_list(%p,%p) on %d\n",(A),d,__LINE__);
15676 dep_list((A)) = (mp_node)d;
15678 @d prev_dep(A) ((mp_value_node)(A))->subscr_head_ /* the other half; makes a doubly linked list */
15679 @d set_prev_dep(A,B) do {
15680 mp_value_node d = (mp_value_node)(B);
15681 FUNCTION_TRACE4("set_prev_dep(%p,%p) on %d\n",(A),d,__LINE__);
15682 prev_dep((A)) = (mp_node)d;
15686 static mp_node get_dep_info (MP mp, mp_value_node p) {
15688 d = p->parent_; /* half of the |value| field in a |dependent| variable */
15689 FUNCTION_TRACE3 ("%p = dep_info(%p)\n", d, p);
15692 static void do_set_dep_value (MP mp, mp_value_node p, mp_number q) {
15693 number_clone (p->data.n, q); /* half of the |value| field in a |dependent| variable */
15694 FUNCTION_TRACE3("set_dep_value(%p,%d)\n", p, q);
15695 p->attr_head_ = NULL;
15696 p->subscr_head_ = NULL;
15699 @ @<Declarations...@>=
15700 static mp_node get_dep_info (MP mp, mp_value_node p);
15705 static mp_value_node mp_get_dep_node (MP mp) {
15706 mp_value_node p = (mp_value_node) mp_get_value_node (mp);
15707 mp_type (p) = mp_dep_node_type;
15710 static void mp_free_dep_node (MP mp, mp_value_node p) {
15711 mp_free_value_node (mp, (mp_node) p);
15715 @ @<Declarations...@>=
15716 static void mp_free_dep_node (MP mp, mp_value_node p);
15718 @ @<Initialize table entries@>=
15720 mp->dep_head = mp_get_dep_node (mp);
15721 set_mp_link (mp->dep_head, (mp_node) mp->dep_head);
15722 set_prev_dep (mp->dep_head, (mp_node) mp->dep_head);
15723 set_dep_info (mp->dep_head, NULL);
15724 set_dep_list (mp->dep_head, NULL);
15726 @ @<Free table entries@>=
15727 mp_free_dep_node (mp, mp->dep_head);
15729 @ Actually the description above contains a little white lie. There's
15730 another kind of variable called |mp_proto_dependent|, which is
15731 just like a |dependent| one except that the $\alpha$ coefficients
15732 in its dependency list are |scaled| instead of being fractions.
15733 Proto-dependency lists are mixed with dependency lists in the
15734 nodes reachable from |dep_head|.
15736 @ Here is a procedure that prints a dependency list in symbolic form.
15737 The second parameter should be either |dependent| or |mp_proto_dependent|,
15738 to indicate the scaling of the coefficients.
15741 static void mp_print_dependency (MP mp, mp_value_node p, quarterword t);
15744 void mp_print_dependency (MP mp, mp_value_node p, quarterword t) {
15745 mp_number v; /* a coefficient */
15746 mp_value_node pp; /* for list manipulation */
15751 number_clone (v, dep_value (p));
15754 if (q == NULL) { /* the constant term */
15755 if (number_nonzero(v) || (p == pp)) {
15756 if (number_positive(dep_value (p)))
15758 mp_print_char (mp, xord ('+'));
15759 print_number (dep_value (p));
15763 /* Print the coefficient, unless it's $\pm1.0$ */
15764 if (number_negative(dep_value (p)))
15765 mp_print_char (mp, xord ('-'));
15767 mp_print_char (mp, xord ('+'));
15768 if (t == mp_dependent) {
15769 fraction_to_round_scaled (v);
15771 if (!number_equal (v, unity_t))
15774 if (mp_type (q) != mp_independent)
15775 mp_confusion (mp, "dep");
15776 mp_print_variable_name (mp, q);
15777 set_number_from_scaled (v, indep_scale(q));
15778 while (number_positive (v)) {
15779 mp_print (mp, "*4");
15780 number_add_scaled (v, -2);
15782 p = (mp_value_node) mp_link (p);
15788 @ The maximum absolute value of a coefficient in a given dependency list
15789 is returned by the following simple function.
15792 static void mp_max_coef (MP mp, mp_number *x, mp_value_node p) {
15795 set_number_to_zero (*x);
15796 while (dep_info (p) != NULL) {
15797 number_clone (absv, dep_value (p));
15799 if (number_greater (absv, *x)) {
15800 number_clone (*x, absv);
15802 p = (mp_value_node) mp_link (p);
15804 free_number (absv);
15808 @ One of the main operations needed on dependency lists is to add a multiple
15809 of one list to the other; we call this |p_plus_fq|, where |p| and~|q| point
15810 to dependency lists and |f| is a fraction.
15812 If the coefficient of any independent variable becomes |coef_bound| or
15813 more, in absolute value, this procedure changes the type of that variable
15814 to `|independent_needing_fix|', and sets the global variable |fix_needed|
15815 to~|true|. The value of $|coef_bound|=\mu$ is chosen so that
15816 $\mu^2+\mu<8$; this means that the numbers we deal with won't
15817 get too large. (Instead of the ``optimum'' $\mu=(\sqrt{33}-1)/2\approx
15818 2.3723$, the safer value 7/3 is taken as the threshold.)
15820 The changes mentioned in the preceding paragraph are actually done only if
15821 the global variable |watch_coefs| is |true|. But it usually is; in fact,
15822 it is |false| only when \MP\ is making a dependency list that will soon
15823 be equated to zero.
15825 Several procedures that act on dependency lists, including |p_plus_fq|,
15826 set the global variable |dep_final| to the final (constant term) node of
15827 the dependency list that they produce.
15829 @d independent_needing_fix 0
15832 boolean fix_needed; /* does at least one |independent| variable need scaling? */
15833 boolean watch_coefs; /* should we scale coefficients that exceed |coef_bound|? */
15834 mp_value_node dep_final; /* location of the constant term and final link */
15837 mp->fix_needed = false;
15838 mp->watch_coefs = true;
15840 @ The |p_plus_fq| procedure has a fourth parameter, |t|, that should be
15841 set to |mp_proto_dependent| if |p| is a proto-dependency list. In this
15842 case |f| will be |scaled|, not a |fraction|. Similarly, the fifth parameter~|tt|
15843 should be |mp_proto_dependent| if |q| is a proto-dependency list.
15845 List |q| is unchanged by the operation; but list |p| is totally destroyed.
15847 The final link of the dependency list or proto-dependency list returned
15848 by |p_plus_fq| is the same as the original final link of~|p|. Indeed, the
15849 constant term of the result will be located in the same |mem| location
15850 as the original constant term of~|p|.
15852 Coefficients of the result are assumed to be zero if they are less than
15853 a certain threshold. This compensates for inevitable rounding errors,
15854 and tends to make more variables `|known|'. The threshold is approximately
15855 $10^{-5}$ in the case of normal dependency lists, $10^{-4}$ for
15856 proto-dependencies.
15858 @d fraction_threshold_k ((math_data *)mp->math)->fraction_threshold_t
15859 @d half_fraction_threshold_k ((math_data *)mp->math)->half_fraction_threshold_t
15860 @d scaled_threshold_k ((math_data *)mp->math)->scaled_threshold_t
15861 @d half_scaled_threshold_k ((math_data *)mp->math)->half_scaled_threshold_t
15864 static mp_value_node mp_p_plus_fq (MP mp, mp_value_node p, mp_number f,
15865 mp_value_node q, mp_variable_type t,
15866 mp_variable_type tt);
15869 static mp_value_node mp_p_plus_fq (MP mp, mp_value_node p, mp_number f,
15870 mp_value_node q, mp_variable_type t,
15871 mp_variable_type tt) {
15872 mp_node pp, qq; /* |dep_info(p)| and |dep_info(q)|, respectively */
15873 mp_value_node r, s; /* for list manipulation */
15874 mp_number threshold, half_threshold; /* defines a neighborhood of zero */
15875 mp_number v, vv; /* temporary registers */
15878 new_number (threshold);
15879 new_number (half_threshold);
15880 if (t == mp_dependent) {
15881 number_clone (threshold, fraction_threshold_k);
15882 number_clone (half_threshold, half_fraction_threshold_k);
15884 number_clone (threshold, scaled_threshold_k);
15885 number_clone (half_threshold, half_scaled_threshold_k);
15887 r = (mp_value_node) mp->temp_head;
15895 /* Contribute a term from |p|, plus |f| times the
15896 corresponding term from |q| */
15901 if (tt == mp_dependent) {
15902 take_fraction (r1, f, dep_value (q));
15904 take_scaled (r1, f, dep_value (q));
15906 set_number_from_addition (v, dep_value (p), r1);
15908 set_dep_value (p, v);
15910 p = (mp_value_node) mp_link (p);
15911 number_clone (absv, v);
15913 if (number_less (absv, threshold)) {
15914 mp_free_dep_node (mp, s);
15916 if (number_greaterequal (absv, coef_bound_k) && mp->watch_coefs) {
15917 mp_type (qq) = independent_needing_fix;
15918 /* If we set this , then we can drop (mp_type(pp) == independent_needing_fix && mp->fix_needed) later */
15919 /* set_number_from_scaled (value_number (qq), indep_value(qq)); */
15920 mp->fix_needed = true;
15922 set_mp_link (r, (mp_node) s);
15925 free_number (absv);
15927 q = (mp_value_node) mp_link (q);
15933 set_number_to_neg_inf(v);
15934 else if (mp_type(pp) == mp_independent || (mp_type(pp) == independent_needing_fix && mp->fix_needed))
15935 set_number_from_scaled(v, indep_value(pp));
15937 number_clone (v, value_number (pp));
15939 set_number_to_neg_inf(vv);
15940 else if (mp_type(qq) == mp_independent || (mp_type(qq) == independent_needing_fix && mp->fix_needed))
15941 set_number_from_scaled(vv, indep_value(qq));
15943 number_clone (vv, value_number (qq));
15944 if (number_less (v, vv)) {
15945 /* Contribute a term from |q|, multiplied by~|f| */
15950 mp_number arg1, arg2;
15954 number_clone (arg1, f);
15955 number_clone (arg2, dep_value (q));
15956 if (tt == mp_dependent) {
15957 take_fraction (r1, arg1, arg2);
15959 take_scaled (r1, arg1, arg2);
15961 number_clone (v, r1);
15963 free_number (arg1);
15964 free_number (arg2);
15966 number_clone (absv, v);
15968 if (number_greater (absv, half_threshold)) {
15969 s = mp_get_dep_node (mp);
15970 set_dep_info (s, qq);
15971 set_dep_value (s, v);
15972 if (number_greaterequal(absv, coef_bound_k) && mp->watch_coefs) {
15973 /* clang: dereference of a null pointer ('qq') */ assert(qq);
15974 mp_type (qq) = independent_needing_fix;
15975 mp->fix_needed = true;
15977 set_mp_link (r, (mp_node) s);
15980 q = (mp_value_node) mp_link (q);
15982 free_number (absv);
15985 set_mp_link (r, (mp_node) p);
15987 p = (mp_value_node) mp_link (p);
15994 mp_number arg1, arg2;
15998 number_clone (arg1, dep_value (q));
15999 number_clone (arg2, f);
16000 if (t == mp_dependent) {
16001 take_fraction (r1, arg1, arg2);
16003 take_scaled (r1, arg1, arg2);
16005 slow_add (arg1, dep_value (p), r1);
16006 set_dep_value (p, arg1);
16008 free_number (arg1);
16009 free_number (arg2);
16011 set_mp_link (r, (mp_node) p);
16013 free_number (threshold);
16014 free_number (half_threshold);
16017 return (mp_value_node) mp_link (mp->temp_head);
16021 @ It is convenient to have another subroutine for the special case
16022 of |p_plus_fq| when |f=1.0|. In this routine lists |p| and |q| are
16023 both of the same type~|t| (either |dependent| or |mp_proto_dependent|).
16026 static mp_value_node mp_p_plus_q (MP mp, mp_value_node p, mp_value_node q,
16027 mp_variable_type t) {
16028 mp_node pp, qq; /* |dep_info(p)| and |dep_info(q)|, respectively */
16029 mp_value_node s; /* for list manipulation */
16030 mp_value_node r; /* for list manipulation */
16031 mp_number threshold; /* defines a neighborhood of zero */
16032 mp_number v, vv; /* temporary register */
16035 new_number (threshold);
16036 if (t == mp_dependent)
16037 number_clone (threshold, fraction_threshold_k);
16039 number_clone (threshold, scaled_threshold_k);
16040 r = (mp_value_node) mp->temp_head;
16048 /* Contribute a term from |p|, plus the corresponding term from |q| */
16051 set_number_from_addition (v, dep_value (p), dep_value (q));
16052 set_dep_value (p, v);
16054 p = (mp_value_node) mp_link (p);
16056 number_clone (test, v);
16058 if (number_less (test, threshold)) {
16059 mp_free_dep_node (mp, s);
16061 if (number_greaterequal(test, coef_bound_k) && mp->watch_coefs) {
16062 mp_type (qq) = independent_needing_fix;
16063 /* If we set this , then we can drop (mp_type(pp) == independent_needing_fix && mp->fix_needed) later */
16064 /* set_number_from_scaled (value_number (qq), indep_value(qq)); */
16065 mp->fix_needed = true;
16067 set_mp_link (r, (mp_node) s);
16070 free_number (test);
16071 q = (mp_value_node) mp_link (q);
16077 set_number_to_zero (v);
16078 else if (mp_type(pp) == mp_independent || (mp_type(pp) == independent_needing_fix && mp->fix_needed))
16079 set_number_from_scaled (v, indep_value(pp));
16081 number_clone (v, value_number (pp));
16083 set_number_to_zero (vv);
16084 else if (mp_type(qq) == mp_independent || (mp_type(qq) == independent_needing_fix && mp->fix_needed))
16085 set_number_from_scaled (vv, indep_value(qq));
16087 number_clone (vv, value_number (qq));
16088 if (number_less (v, vv)) {
16089 s = mp_get_dep_node (mp);
16090 set_dep_info (s, qq);
16091 set_dep_value (s, dep_value (q));
16092 q = (mp_value_node) mp_link (q);
16094 set_mp_link (r, (mp_node) s);
16097 set_mp_link (r, (mp_node) p);
16099 p = (mp_value_node) mp_link (p);
16107 slow_add (r1, dep_value (p), dep_value (q));
16108 set_dep_value (p, r1);
16111 set_mp_link (r, (mp_node) p);
16115 free_number (threshold);
16116 return (mp_value_node) mp_link (mp->temp_head);
16119 @ A somewhat simpler routine will multiply a dependency list
16120 by a given constant~|v|. The constant is either a |fraction| less than
16121 |fraction_one|, or it is |scaled|. In the latter case we might be forced to
16122 convert a dependency list to a proto-dependency list.
16123 Parameters |t0| and |t1| are the list types before and after;
16124 they should agree unless |t0=mp_dependent| and |t1=mp_proto_dependent|
16125 and |v_is_scaled=true|.
16128 static mp_value_node mp_p_times_v (MP mp, mp_value_node p, mp_number v,
16129 quarterword t0, quarterword t1,
16130 boolean v_is_scaled) {
16131 mp_value_node r, s; /* for list manipulation */
16132 mp_number w; /* tentative coefficient */
16133 mp_number threshold;
16134 boolean scaling_down;
16135 new_number (threshold);
16138 scaling_down = true;
16140 scaling_down = (!v_is_scaled);
16141 if (t1 == mp_dependent)
16142 number_clone (threshold, half_fraction_threshold_k);
16144 number_clone (threshold, half_scaled_threshold_k);
16145 r = (mp_value_node) mp->temp_head;
16146 while (dep_info (p) != NULL) {
16149 if (scaling_down) {
16150 take_fraction (w, v, dep_value (p));
16152 take_scaled (w, v, dep_value (p));
16154 number_clone (test, w);
16156 if (number_lessequal (test, threshold)) {
16157 s = (mp_value_node) mp_link (p);
16158 mp_free_dep_node (mp, p);
16161 if (number_greaterequal(test, coef_bound_k)) {
16162 mp->fix_needed = true;
16163 mp_type (dep_info (p)) = independent_needing_fix;
16165 set_mp_link (r, (mp_node) p);
16167 set_dep_value (p, w);
16168 p = (mp_value_node) mp_link (p);
16170 free_number (test);
16172 set_mp_link (r, (mp_node) p);
16177 take_scaled (r1, dep_value (p), v);
16179 take_fraction (r1, dep_value (p), v);
16181 set_dep_value (p, r1);
16185 free_number (threshold);
16186 return (mp_value_node) mp_link (mp->temp_head);
16190 @ Similarly, we sometimes need to divide a dependency list
16191 by a given |scaled| constant.
16194 static mp_value_node mp_p_over_v (MP mp, mp_value_node p, mp_number v, quarterword
16195 t0, quarterword t1);
16198 @d p_over_v_threshold_k ((math_data *)mp->math)->p_over_v_threshold_t
16201 mp_value_node mp_p_over_v (MP mp, mp_value_node p, mp_number v_orig, quarterword
16202 t0, quarterword t1) {
16203 mp_value_node r, s; /* for list manipulation */
16204 mp_number w; /* tentative coefficient */
16205 mp_number threshold;
16207 boolean scaling_down;
16210 new_number (threshold);
16211 number_clone (v, v_orig);
16213 scaling_down = true;
16215 scaling_down = false;
16216 if (t1 == mp_dependent)
16217 number_clone (threshold, half_fraction_threshold_k);
16219 number_clone (threshold, half_scaled_threshold_k);
16220 r = (mp_value_node) mp->temp_head;
16221 while (dep_info (p) != NULL) {
16222 if (scaling_down) {
16226 number_clone (absv, v);
16228 if (number_less (absv, p_over_v_threshold_k)) {
16229 number_clone (x, v);
16230 convert_scaled_to_fraction (x);
16231 make_scaled (w, dep_value (p), x);
16233 number_clone (x, dep_value (p));
16234 fraction_to_round_scaled (x);
16235 make_scaled (w, x, v);
16238 free_number (absv);
16240 make_scaled (w, dep_value (p), v);
16245 number_clone (test, w);
16247 if (number_lessequal (test, threshold)) {
16248 s = (mp_value_node) mp_link (p);
16249 mp_free_dep_node (mp, p);
16252 if (number_greaterequal (test, coef_bound_k)) {
16253 mp->fix_needed = true;
16254 mp_type (dep_info (p)) = independent_needing_fix;
16256 set_mp_link (r, (mp_node) p);
16258 set_dep_value (p, w);
16259 p = (mp_value_node) mp_link (p);
16261 free_number (test);
16264 set_mp_link (r, (mp_node) p);
16268 make_scaled (ret, dep_value (p), v);
16269 set_dep_value (p, ret);
16274 free_number (threshold);
16275 return (mp_value_node) mp_link (mp->temp_head);
16279 @ Here's another utility routine for dependency lists. When an independent
16280 variable becomes dependent, we want to remove it from all existing
16281 dependencies. The |p_with_x_becoming_q| function computes the
16282 dependency list of~|p| after variable~|x| has been replaced by~|q|.
16284 This procedure has basically the same calling conventions as |p_plus_fq|:
16285 List~|q| is unchanged; list~|p| is destroyed; the constant node and the
16286 final link are inherited from~|p|; and the fourth parameter tells whether
16287 or not |p| is |mp_proto_dependent|. However, the global variable |dep_final|
16288 is not altered if |x| does not occur in list~|p|.
16291 static mp_value_node mp_p_with_x_becoming_q (MP mp, mp_value_node p,
16292 mp_node x, mp_node q,
16294 mp_value_node r, s; /* for list manipulation */
16295 integer sx; /* serial number of |x| */
16297 r = (mp_value_node) mp->temp_head;
16298 sx = indep_value (x);
16299 while (dep_info (s) != NULL && indep_value (dep_info (s)) > sx) {
16301 s = (mp_value_node) mp_link (s);
16303 if (dep_info (s) == NULL || dep_info (s) != x) {
16309 set_mp_link (mp->temp_head, (mp_node) p);
16310 set_mp_link (r, mp_link (s));
16311 number_clone (v1, dep_value (s));
16312 mp_free_dep_node (mp, s);
16313 ret = mp_p_plus_fq (mp, (mp_value_node) mp_link (mp->temp_head), v1,
16314 (mp_value_node) q, t, mp_dependent);
16321 @ Here's a simple procedure that reports an error when a variable
16322 has just received a known value that's out of the required range.
16325 static void mp_val_too_big (MP mp, mp_number x);
16328 static void mp_val_too_big (MP mp, mp_number x) {
16329 if (number_positive (internal_value (mp_warning_check))) {
16331 const char *hlp[] = {
16332 "The equation I just processed has given some variable a",
16333 "value outside of the safetyp range. Continue and I'll try",
16334 "to cope with that big value; but it might be dangerous.",
16335 "(Set warningcheck:=0 to suppress this message.)",
16337 mp_snprintf (msg, 256, "Value is too large (%s)", number_tostring(x));
16338 mp_error (mp, msg, hlp, true);
16342 @ When a dependent variable becomes known, the following routine
16343 removes its dependency list. Here |p| points to the variable, and
16344 |q| points to the dependency list (which is one node long).
16347 static void mp_make_known (MP mp, mp_value_node p, mp_value_node q);
16350 void mp_make_known (MP mp, mp_value_node p, mp_value_node q) {
16351 mp_variable_type t; /* the previous type */
16354 set_prev_dep (mp_link (q), prev_dep (p));
16355 set_mp_link (prev_dep (p), mp_link (q));
16357 mp_type (p) = mp_known;
16358 set_value_number (p, dep_value (q));
16359 mp_free_dep_node (mp, q);
16360 number_clone (absp, value_number (p));
16362 if (number_greaterequal (absp, warning_limit_t))
16363 mp_val_too_big (mp, value_number (p));
16364 if ((number_positive(internal_value (mp_tracing_equations)))
16365 && mp_interesting (mp, (mp_node) p)) {
16366 mp_begin_diagnostic (mp);
16367 mp_print_nl (mp, "#### ");
16368 mp_print_variable_name (mp, (mp_node) p);
16369 mp_print_char (mp, xord ('='));
16370 print_number (value_number (p));
16371 mp_end_diagnostic (mp, false);
16373 if (cur_exp_node () == (mp_node) p && mp->cur_exp.type == t) {
16374 mp->cur_exp.type = mp_known;
16375 set_cur_exp_value_number (value_number (p));
16376 mp_free_value_node (mp, (mp_node) p);
16378 free_number (absp);
16382 @ The |fix_dependencies| routine is called into action when |fix_needed|
16383 has been triggered. The program keeps a list~|s| of independent variables
16384 whose coefficients must be divided by~4.
16386 In unusual cases, this fixup process might reduce one or more coefficients
16387 to zero, so that a variable will become known more or less by default.
16390 static void mp_fix_dependencies (MP mp);
16393 @d independent_being_fixed 1 /* this variable already appears in |s| */
16395 static void mp_fix_dependencies (MP mp) {
16396 mp_value_node p, q, r, s, t; /* list manipulation registers */
16397 mp_node x; /* an independent variable */
16398 r = (mp_value_node) mp_link (mp->dep_head);
16400 while (r != mp->dep_head) {
16402 /* Run through the dependency list for variable |t|, fixing
16403 all nodes, and ending with final link~|q| */
16406 q = (mp_value_node) dep_list(t);
16408 q = (mp_value_node) mp_link (r);
16413 if (mp_type (x) <= independent_being_fixed) {
16414 if (mp_type (x) < independent_being_fixed) {
16415 p = mp_get_dep_node (mp);
16416 set_mp_link (p, (mp_node) s);
16418 set_dep_info (s, x);
16419 mp_type (x) = independent_being_fixed;
16421 set_dep_value (q, dep_value (q));
16422 number_divide_int (dep_value (q), 4);
16423 if (number_zero(dep_value (q))) {
16424 set_mp_link (r, mp_link (q));
16425 mp_free_dep_node (mp, q);
16432 r = (mp_value_node) mp_link (q);
16433 if (q == (mp_value_node) dep_list (t))
16434 mp_make_known (mp, t, q);
16436 while (s != NULL) {
16437 p = (mp_value_node) mp_link (s);
16439 mp_free_dep_node (mp, s);
16441 mp_type (x) = mp_independent;
16442 set_indep_scale (x, indep_scale (x) + 2);
16444 mp->fix_needed = false;
16448 @ The |new_dep| routine installs a dependency list~|p| based on the value node~|q|,
16449 linking it into the list of all known dependencies. It replaces |q| with the new
16450 dependency node. We assume that |dep_final| points to the final node of list~|p|.
16453 static void mp_new_dep (MP mp, mp_node q, mp_variable_type newtype,
16455 mp_node r; /* what used to be the first dependency */
16456 FUNCTION_TRACE4 ("mp_new_dep(%p,%d,%p)\n", q, newtype, p);
16457 mp_type (q) = newtype;
16458 set_dep_list (q, p);
16459 set_prev_dep (q, (mp_node) mp->dep_head);
16460 r = mp_link (mp->dep_head);
16461 set_mp_link (mp->dep_final, r);
16462 set_prev_dep (r, (mp_node) mp->dep_final);
16463 set_mp_link (mp->dep_head, q);
16467 @ Here is one of the ways a dependency list gets started.
16468 The |const_dependency| routine produces a list that has nothing but
16472 static mp_value_node mp_const_dependency (MP mp, mp_number v) {
16473 mp->dep_final = mp_get_dep_node (mp);
16474 set_dep_value (mp->dep_final, v);
16475 set_dep_info (mp->dep_final, NULL);
16476 FUNCTION_TRACE3 ("%p = mp_const_dependency(%d)\n", mp->dep_final, number_to_scaled (v));
16477 return mp->dep_final;
16481 @ And here's a more interesting way to start a dependency list from scratch:
16482 The parameter to |single_dependency| is the location of an
16483 independent variable~|x|, and the result is the simple dependency list
16486 In the unlikely event that the given independent variable has been doubled so
16487 often that we can't refer to it with a nonzero coefficient,
16488 |single_dependency| returns the simple list `0'. This case can be
16489 recognized by testing that the returned list pointer is equal to
16492 @d two_to_the(A) (1<<(unsigned)(A))
16495 static mp_value_node mp_single_dependency (MP mp, mp_node p) {
16496 mp_value_node q, rr; /* the new dependency list */
16497 integer m; /* the number of doublings */
16498 m = indep_scale (p);
16500 q = mp_const_dependency (mp, zero_t);
16502 q = mp_get_dep_node (mp);
16503 set_dep_value (q, zero_t);
16504 set_number_from_scaled (dep_value (q), (integer) two_to_the (28 - m));
16505 set_dep_info (q, p);
16506 rr = mp_const_dependency (mp, zero_t);
16507 set_mp_link (q, (mp_node) rr);
16509 FUNCTION_TRACE3 ("%p = mp_single_dependency(%p)\n", q, p);
16514 @ We sometimes need to make an exact copy of a dependency list.
16517 static mp_value_node mp_copy_dep_list (MP mp, mp_value_node p) {
16518 mp_value_node q; /* the new dependency list */
16519 FUNCTION_TRACE2 ("mp_copy_dep_list(%p)\n", p);
16520 q = mp_get_dep_node (mp);
16523 set_dep_info (mp->dep_final, dep_info (p));
16524 set_dep_value (mp->dep_final, dep_value (p));
16525 if (dep_info (mp->dep_final) == NULL)
16527 set_mp_link (mp->dep_final, (mp_node) mp_get_dep_node (mp));
16528 mp->dep_final = (mp_value_node) mp_link (mp->dep_final);
16529 p = (mp_value_node) mp_link (p);
16535 @ But how do variables normally become known? Ah, now we get to the heart of the
16536 equation-solving mechanism. The |linear_eq| procedure is given a |dependent|
16537 or |mp_proto_dependent| list,~|p|, in which at least one independent variable
16538 appears. It equates this list to zero, by choosing an independent variable
16539 with the largest coefficient and making it dependent on the others. The
16540 newly dependent variable is eliminated from all current dependencies,
16541 thereby possibly making other dependent variables known.
16543 The given list |p| is, of course, totally destroyed by all this processing.
16546 static mp_value_node find_node_with_largest_coefficient(MP mp, mp_value_node p, mp_number *v);
16547 static void display_new_dependency (MP mp, mp_value_node p, mp_node x, integer n);
16548 static void change_to_known (MP mp, mp_value_node p, mp_node x, mp_value_node final_node, integer n);
16549 static mp_value_node divide_p_by_minusv_removing_q (MP mp, mp_value_node p, mp_value_node q,
16550 mp_value_node *final_node, mp_number v, quarterword t);
16551 static mp_value_node divide_p_by_2_n (MP mp, mp_value_node p, integer n);
16552 static void mp_linear_eq (MP mp, mp_value_node p, quarterword t) {
16553 mp_value_node r; /* for link manipulation */
16554 mp_node x; /* the variable that loses its independence */
16555 integer n; /* the number of times |x| had been halved */
16556 mp_number v; /* the coefficient of |x| in list |p| */
16557 mp_value_node prev_r; /* lags one step behind |r| */
16558 mp_value_node final_node; /* the constant term of the new dependency list */
16561 FUNCTION_TRACE3 ("mp_linear_eq(%p,%d)\n", p, t);
16562 qq = find_node_with_largest_coefficient(mp, p, &v);
16564 n = indep_scale (x);
16565 p = divide_p_by_minusv_removing_q(mp, p, qq, &final_node, v, t);
16566 if (number_positive (internal_value (mp_tracing_equations))) {
16567 display_new_dependency(mp,p,(mp_node)x,n);
16569 prev_r = (mp_value_node) mp->dep_head;
16570 r = (mp_value_node) mp_link (mp->dep_head);
16571 while (r != mp->dep_head) {
16572 mp_value_node s = (mp_value_node) dep_list (r);
16573 mp_value_node q = mp_p_with_x_becoming_q (mp, s, x, (mp_node) p, mp_type (r));
16574 if (dep_info (q) == NULL) {
16575 mp_make_known (mp, r, q);
16577 set_dep_list (r, q);
16579 q = (mp_value_node) mp_link (q);
16580 } while (dep_info (q) != NULL);
16583 r = (mp_value_node) mp_link (prev_r);
16586 p = divide_p_by_2_n(mp, p, n);
16588 change_to_known(mp,p,(mp_node)x,final_node,n);
16589 if (mp->fix_needed)
16590 mp_fix_dependencies (mp);
16597 static mp_value_node find_node_with_largest_coefficient(MP mp, mp_value_node p, mp_number *v) {
16598 mp_number vabs; /* its absolute value of v*/
16599 mp_number rabs; /* the absolute value of |dep_value(r)| */
16600 mp_value_node q = p;
16601 mp_value_node r = (mp_value_node) mp_link (p);
16604 number_clone (*v, dep_value (q));
16605 while (dep_info (r) != NULL) {
16606 number_clone (vabs, *v);
16608 number_clone (rabs, dep_value (r));
16610 if (number_greater (rabs, vabs)) {
16612 number_clone (*v, dep_value (r));
16614 r = (mp_value_node) mp_link (r);
16616 free_number (vabs);
16617 free_number (rabs);
16622 @ Here we want to change the coefficients from |scaled| to |fraction|,
16623 except in the constant term. In the common case of a trivial equation
16624 like `\.{x=3.14}', we will have |v=-fraction_one|, |q=p|, and |t=mp_dependent|.
16627 static mp_value_node divide_p_by_minusv_removing_q (MP mp, mp_value_node p, mp_value_node q,
16628 mp_value_node *final_node, mp_number v, quarterword t) {
16629 mp_value_node r; /* for link manipulation */
16631 s = (mp_value_node) mp->temp_head;
16632 set_mp_link (s, (mp_node) p);
16636 set_mp_link (s, mp_link (r));
16637 mp_free_dep_node (mp, r);
16639 mp_number w; /* a tentative coefficient */
16643 make_fraction (w, dep_value (r), v);
16644 number_clone (absw, w);
16646 if (number_lessequal (absw, half_fraction_threshold_k)) {
16647 set_mp_link (s, mp_link (r));
16648 mp_free_dep_node (mp, r);
16651 set_dep_value (r, w);
16655 free_number (absw);
16657 r = (mp_value_node) mp_link (s);
16658 } while (dep_info (r) != NULL);
16660 if (t == mp_proto_dependent) {
16663 make_scaled (ret, dep_value (r), v);
16664 number_negate (ret);
16665 set_dep_value (r, ret);
16667 } else if (number_to_scaled (v) != -number_to_scaled (fraction_one_t)) {
16669 new_fraction (ret);
16670 make_fraction (ret, dep_value (r), v);
16671 number_negate (ret);
16672 set_dep_value (r, ret);
16676 return (mp_value_node) mp_link (mp->temp_head);
16682 static void display_new_dependency (MP mp, mp_value_node p, mp_node x, integer n) {
16683 if (mp_interesting (mp, x)) {
16685 mp_begin_diagnostic (mp);
16686 mp_print_nl (mp, "## ");
16687 mp_print_variable_name (mp, x);
16690 mp_print (mp, "*4");
16693 mp_print_char (mp, xord ('='));
16694 mp_print_dependency (mp, p, mp_dependent);
16695 mp_end_diagnostic (mp, false);
16699 @ The |n > 0| test is repeated here because it is of vital importance to the
16700 function's functioning.
16703 static mp_value_node divide_p_by_2_n (MP mp, mp_value_node p, integer n) {
16704 mp_value_node pp = NULL;
16706 /* Divide list |p| by $2^n$ */
16710 mp_number w; /* a tentative coefficient */
16713 s = (mp_value_node) mp->temp_head;
16714 set_mp_link (mp->temp_head, (mp_node) p);
16718 set_number_to_zero (w);
16720 number_clone (w, dep_value (r));
16721 number_divide_int (w, two_to_the (n));
16723 number_clone (absw, w);
16725 if (number_lessequal(absw, half_fraction_threshold_k) && (dep_info (r) != NULL)) {
16726 set_mp_link (s, mp_link (r));
16727 mp_free_dep_node (mp, r);
16729 set_dep_value (r, w);
16732 r = (mp_value_node) mp_link (s);
16733 } while (dep_info (s) != NULL);
16734 pp = (mp_value_node) mp_link (mp->temp_head);
16735 free_number (absw);
16743 static void change_to_known (MP mp, mp_value_node p, mp_node x, mp_value_node final_node, integer n) {
16744 if (dep_info (p) == NULL) {
16747 mp_type (x) = mp_known;
16748 set_value_number (x, dep_value (p));
16749 number_clone (absx, value_number (x));
16751 if (number_greaterequal (absx, warning_limit_t))
16752 mp_val_too_big (mp, value_number (x));
16753 free_number (absx);
16754 mp_free_dep_node (mp, p);
16755 if (cur_exp_node () == x && mp->cur_exp.type == mp_independent) {
16756 set_cur_exp_value_number (value_number (x));
16757 mp->cur_exp.type = mp_known;
16758 mp_free_value_node (mp, x);
16761 mp->dep_final = final_node;
16762 mp_new_dep (mp, x, mp_dependent, p);
16763 if (cur_exp_node () == x && mp->cur_exp.type == mp_independent) {
16764 mp->cur_exp.type = mp_dependent;
16769 @* Dynamic nonlinear equations.
16770 Variables of numeric type are maintained by the general scheme of
16771 independent, dependent, and known values that we have just studied;
16772 and the components of pair and transform variables are handled in the
16773 same way. But \MP\ also has five other types of values: \&{boolean},
16774 \&{string}, \&{pen}, \&{path}, and \&{picture}; what about them?
16776 Equations are allowed between nonlinear quantities, but only in a
16777 simple form. Two variables that haven't yet been assigned values are
16778 either equal to each other, or they're not.
16780 Before a boolean variable has received a value, its type is |mp_unknown_boolean|;
16781 similarly, there are variables whose type is |mp_unknown_string|, |mp_unknown_pen|,
16782 |mp_unknown_path|, and |mp_unknown_picture|. In such cases the value is either
16783 |NULL| (which means that no other variables are equivalent to this one), or
16784 it points to another variable of the same undefined type. The pointers in the
16785 latter case form a cycle of nodes, which we shall call a ``ring.''
16786 Rings of undefined variables may include capsules, which arise as
16787 intermediate results within expressions or as \&{expr} parameters to macros.
16789 When one member of a ring receives a value, the same value is given to
16790 all the other members. In the case of paths and pictures, this implies
16791 making separate copies of a potentially large data structure; users should
16792 restrain their enthusiasm for such generality, unless they have lots and
16793 lots of memory space.
16795 @ The following procedure is called when a capsule node is being
16796 added to a ring (e.g., when an unknown variable is mentioned in an expression).
16799 static mp_node mp_new_ring_entry (MP mp, mp_node p) {
16800 mp_node q; /* the new capsule node */
16801 q = mp_get_value_node (mp);
16802 mp_name_type (q) = mp_capsule;
16803 mp_type (q) = mp_type (p);
16804 if (value_node (p) == NULL)
16805 set_value_node (q, p);
16807 set_value_node (q, value_node (p));
16808 set_value_node (p, q);
16813 @ Conversely, we might delete a capsule or a variable before it becomes known.
16814 The following procedure simply detaches a quantity from its ring,
16815 without recycling the storage.
16818 static void mp_ring_delete (MP mp, mp_node p);
16821 void mp_ring_delete (MP mp, mp_node p) {
16824 q = value_node (p);
16825 if (q != NULL && q != p) {
16826 while (value_node (q) != p)
16827 q = value_node (q);
16828 set_value_node (q, value_node (p));
16833 @ Eventually there might be an equation that assigns values to all of the
16834 variables in a ring. The |nonlinear_eq| subroutine does the necessary
16835 propagation of values.
16837 If the parameter |flush_p| is |true|, node |p| itself needn't receive a
16838 value, it will soon be recycled.
16841 static void mp_nonlinear_eq (MP mp, mp_value v, mp_node p, boolean flush_p) {
16842 mp_variable_type t; /* the type of ring |p| */
16843 mp_node q, r; /* link manipulation registers */
16844 t = (mp_type (p) - unknown_tag);
16845 q = value_node (p);
16847 mp_type (p) = mp_vacuous;
16851 r = value_node (q);
16854 case mp_boolean_type:
16855 set_value_number (q, v.data.n);
16857 case mp_string_type:
16858 set_value_str (q, v.data.str);
16859 add_str_ref (v.data.str);
16862 set_value_knot (q, copy_pen (v.data.p));
16865 set_value_knot (q, mp_copy_path (mp, v.data.p));
16867 case mp_picture_type:
16868 set_value_node (q, v.data.node);
16869 add_edge_ref (v.data.node);
16873 } /* there ain't no more cases */
16879 @ If two members of rings are equated, and if they have the same type,
16880 the |ring_merge| procedure is called on to make them equivalent.
16883 static void mp_ring_merge (MP mp, mp_node p, mp_node q) {
16884 mp_node r; /* traverses one list */
16885 r = value_node (p);
16888 exclaim_redundant_equation(mp);
16891 r = value_node (r);
16893 r = value_node (p);
16894 set_value_node (p, value_node (q));
16895 set_value_node (q, r);
16900 static void exclaim_redundant_equation (MP mp) {
16901 const char *hlp[] = {
16902 "I already knew that this equation was true.",
16903 "But perhaps no harm has been done; let's continue.",
16905 mp_back_error (mp, "Redundant equation", hlp, true);
16906 mp_get_x_next (mp);
16909 @ @<Declarations@>=
16910 static void exclaim_redundant_equation (MP mp);
16912 @* Introduction to the syntactic routines.
16913 Let's pause a moment now and try to look at the Big Picture.
16914 The \MP\ program consists of three main parts: syntactic routines,
16915 semantic routines, and output routines. The chief purpose of the
16916 syntactic routines is to deliver the user's input to the semantic routines,
16917 while parsing expressions and locating operators and operands. The
16918 semantic routines act as an interpreter responding to these operators,
16919 which may be regarded as commands. And the output routines are
16920 periodically called on to produce compact font descriptions that can be
16921 used for typesetting or for making interim proof drawings. We have
16922 discussed the basic data structures and many of the details of semantic
16923 operations, so we are good and ready to plunge into the part of \MP\ that
16924 actually controls the activities.
16926 Our current goal is to come to grips with the |get_next| procedure,
16927 which is the keystone of \MP's input mechanism. Each call of |get_next|
16928 sets the value of three variables |cur_cmd|, |cur_mod|, and |cur_sym|,
16929 representing the next input token.
16930 $$\vbox{\halign{#\hfil\cr
16931 \hbox{|cur_cmd| denotes a command code from the long list of codes
16933 \hbox{|cur_mod| denotes a modifier or operand of the command code;}\cr
16934 \hbox{|cur_sym| is the hash address of the symbolic token that was
16936 \hbox{\qquad or zero in the case of a numeric or string
16937 or capsule token.}\cr}}$$
16938 Underlying this external behavior of |get_next| is all the machinery
16939 necessary to convert from character files to tokens. At a given time we
16940 may be only partially finished with the reading of several files (for
16941 which \&{input} was specified), and partially finished with the expansion
16942 of some user-defined macros and/or some macro parameters, and partially
16943 finished reading some text that the user has inserted online,
16944 and so on. When reading a character file, the characters must be
16945 converted to tokens; comments and blank spaces must
16946 be removed, numeric and string tokens must be evaluated.
16948 To handle these situations, which might all be present simultaneously,
16949 \MP\ uses various stacks that hold information about the incomplete
16950 activities, and there is a finite state control for each level of the
16951 input mechanism. These stacks record the current state of an implicitly
16952 recursive process, but the |get_next| procedure is not recursive.
16954 @d cur_cmd() (unsigned)(mp->cur_mod_->type)
16955 @d set_cur_cmd(A) mp->cur_mod_->type=(A)
16956 @d cur_mod_int() number_to_int (mp->cur_mod_->data.n) /* operand of current command */
16957 @d cur_mod() number_to_scaled (mp->cur_mod_->data.n) /* operand of current command */
16958 @d cur_mod_number() mp->cur_mod_->data.n /* operand of current command */
16959 @d set_cur_mod(A) set_number_from_scaled (mp->cur_mod_->data.n, (A))
16960 @d set_cur_mod_number(A) number_clone (mp->cur_mod_->data.n, (A))
16961 @d cur_mod_node() mp->cur_mod_->data.node
16962 @d set_cur_mod_node(A) mp->cur_mod_->data.node=(A)
16963 @d cur_mod_str() mp->cur_mod_->data.str
16964 @d set_cur_mod_str(A) mp->cur_mod_->data.str=(A)
16965 @d cur_sym() mp->cur_mod_->data.sym
16966 @d set_cur_sym(A) mp->cur_mod_->data.sym=(A)
16967 @d cur_sym_mod() mp->cur_mod_->name_type
16968 @d set_cur_sym_mod(A) mp->cur_mod_->name_type=(A)
16971 mp_node cur_mod_; /* current command, symbol, and its operands */
16973 @ @<Initialize table...@>=
16974 mp->cur_mod_ = mp_get_symbolic_node(mp);
16976 @ @<Free table...@>=
16977 mp_free_symbolic_node(mp, mp->cur_mod_);
16979 @ The |print_cmd_mod| routine prints a symbolic interpretation of a
16980 command code and its modifier.
16981 It consists of a rather tedious sequence of print
16982 commands, and most of it is essentially an inverse to the |primitive|
16983 routine that enters a \MP\ primitive into |hash| and |eqtb|. Therefore almost
16984 all of this procedure appears elsewhere in the program, together with the
16985 corresponding |primitive| calls.
16988 static void mp_print_cmd_mod (MP mp, integer c, integer m);
16991 void mp_print_cmd_mod (MP mp, integer c, integer m) {
16993 @<Cases of |print_cmd_mod| for symbolic printing of primitives@>
16995 mp_print (mp, "[unknown command code!]");
17001 @ Here is a procedure that displays a given command in braces, in the
17002 user's transcript file.
17004 @d show_cur_cmd_mod mp_show_cmd_mod(mp, cur_cmd(),cur_mod())
17007 static void mp_show_cmd_mod (MP mp, integer c, integer m) {
17008 mp_begin_diagnostic (mp);
17009 mp_print_nl (mp, "{");
17010 mp_print_cmd_mod (mp, c, m);
17011 mp_print_char (mp, xord ('}'));
17012 mp_end_diagnostic (mp, false);
17016 @* Input stacks and states.
17017 The state of \MP's input mechanism appears in the input stack, whose
17018 entries are records with five fields, called |index|, |start|, |loc|,
17019 |limit|, and |name|. The top element of this stack is maintained in a
17020 global variable for which no subscripting needs to be done; the other
17021 elements of the stack appear in an array. Hence the stack is declared thus:
17025 char *long_name_field;
17026 halfword start_field, loc_field, limit_field;
17027 mp_node nstart_field, nloc_field;
17028 mp_string name_field;
17029 quarterword index_field;
17033 in_state_record *input_stack;
17034 integer input_ptr; /* first unused location of |input_stack| */
17035 integer max_in_stack; /* largest value of |input_ptr| when pushing */
17036 in_state_record cur_input; /* the ``top'' input state */
17037 int stack_size; /* maximum number of simultaneous input sources */
17039 @ @<Allocate or initialize ...@>=
17040 mp->stack_size = 16;
17041 mp->input_stack = xmalloc ((mp->stack_size + 1), sizeof (in_state_record));
17043 @ @<Dealloc variables@>=
17044 xfree (mp->input_stack);
17046 @ We've already defined the special variable |loc==cur_input.loc_field|
17047 in our discussion of basic input-output routines. The other components of
17048 |cur_input| are defined in the same way:
17050 @d iindex mp->cur_input.index_field /* reference for buffer information */
17051 @d start mp->cur_input.start_field /* starting position in |buffer| */
17052 @d limit mp->cur_input.limit_field /* end of current line in |buffer| */
17053 @d name mp->cur_input.name_field /* name of the current file */
17055 @ Let's look more closely now at the five control variables
17056 (|index|,~|start|,~|loc|,~|limit|,~|name|),
17057 assuming that \MP\ is reading a line of characters that have been input
17058 from some file or from the user's terminal. There is an array called
17059 |buffer| that acts as a stack of all lines of characters that are
17060 currently being read from files, including all lines on subsidiary
17061 levels of the input stack that are not yet completed. \MP\ will return to
17062 the other lines when it is finished with the present input file.
17064 (Incidentally, on a machine with byte-oriented addressing, it would be
17065 appropriate to combine |buffer| with the |str_pool| array,
17066 letting the buffer entries grow downward from the top of the string pool
17067 and checking that these two tables don't bump into each other.)
17069 The line we are currently working on begins in position |start| of the
17070 buffer; the next character we are about to read is |buffer[loc]|; and
17071 |limit| is the location of the last character present. We always have
17072 |loc<=limit|. For convenience, |buffer[limit]| has been set to |"%"|, so
17073 that the end of a line is easily sensed.
17075 The |name| variable is a string number that designates the name of
17076 the current file, if we are reading an ordinary text file. Special codes
17077 |is_term..max_spec_src| indicate other sources of input text.
17079 @d is_term (mp_string)0 /* |name| value when reading from the terminal for normal input */
17080 @d is_read (mp_string)1 /* |name| value when executing a \&{readstring} or \&{readfrom} */
17081 @d is_scantok (mp_string)2 /* |name| value when reading text generated by \&{scantokens} */
17082 @d max_spec_src is_scantok
17084 @ Additional information about the current line is available via the
17085 |index| variable, which counts how many lines of characters are present
17086 in the buffer below the current level. We have |index=0| when reading
17087 from the terminal and prompting the user for each line; then if the user types,
17088 e.g., `\.{input figs}', we will have |index=1| while reading
17089 the file \.{figs.mp}. However, it does not follow that |index| is the
17090 same as the input stack pointer, since many of the levels on the input
17091 stack may come from token lists and some |index| values may correspond
17092 to \.{MPX} files that are not currently on the stack.
17094 The global variable |in_open| is equal to the highest |index| value counting
17095 \.{MPX} files but excluding token-list input levels. Thus, the number of
17096 partially read lines in the buffer is |in_open+1| and we have |in_open>=index|
17097 when we are not reading a token list.
17099 If we are not currently reading from the terminal,
17100 we are reading from the file variable |input_file[index]|. We use
17101 the notation |terminal_input| as a convenient abbreviation for |name=is_term|,
17102 and |cur_file| as an abbreviation for |input_file[index]|.
17104 When \MP\ is not reading from the terminal, the global variable |line| contains
17105 the line number in the current file, for use in error messages. More precisely,
17106 |line| is a macro for |line_stack[index]| and the |line_stack| array gives
17107 the line number for each file in the |input_file| array.
17109 When an \.{MPX} file is opened the file name is stored in the |mpx_name|
17110 array so that the name doesn't get lost when the file is temporarily removed
17111 from the input stack.
17112 Thus when |input_file[k]| is an \.{MPX} file, its name is |mpx_name[k]|
17113 and it contains translated \TeX\ pictures for |input_file[k-1]|.
17114 Since this is not an \.{MPX} file, we have
17115 $$ \hbox{|mpx_name[k-1]<=absent|}. $$
17116 This |name| field is set to |finished| when |input_file[k]| is completely
17119 If more information about the input state is needed, it can be
17120 included in small arrays like those shown here. For example,
17121 the current page or segment number in the input file might be put
17122 into a variable |page|, that is really a macro for the current entry
17123 in `\ignorespaces|page_stack:array[0..max_in_open] of integer|\unskip'
17124 by analogy with |line_stack|.
17125 @^system dependencies@>
17127 @d terminal_input (name==is_term) /* are we reading from the terminal? */
17128 @d cur_file mp->input_file[iindex] /* the current |void *| variable */
17129 @d line mp->line_stack[iindex] /* current line number in the current source file */
17130 @d in_ext mp->inext_stack[iindex] /* a string used to construct \.{MPX} file names */
17131 @d in_name mp->iname_stack[iindex] /* a string used to construct \.{MPX} file names */
17132 @d in_area mp->iarea_stack[iindex] /* another string for naming \.{MPX} files */
17133 @d absent (mp_string)1 /* |name_field| value for unused |mpx_in_stack| entries */
17134 @d mpx_reading (mp->mpx_name[iindex]>absent)
17135 /* when reading a file, is it an \.{MPX} file? */
17137 /* |name_field| value when the corresponding \.{MPX} file is finished */
17140 integer in_open; /* the number of lines in the buffer, less one */
17141 integer in_open_max; /* highest value of |in_open| ever seen */
17142 unsigned int open_parens; /* the number of open text files */
17144 integer *line_stack; /* the line number for each file */
17145 char **inext_stack; /* used for naming \.{MPX} files */
17146 char **iname_stack; /* used for naming \.{MPX} files */
17147 char **iarea_stack; /* used for naming \.{MPX} files */
17148 mp_string *mpx_name;
17150 @ @<Declarations@>=
17151 static void mp_reallocate_input_stack (MP mp, int newsize);
17154 static void mp_reallocate_input_stack (MP mp, int newsize) {
17156 int n = newsize +1;
17157 XREALLOC (mp->input_file, n, void *);
17158 XREALLOC (mp->line_stack, n, integer);
17159 XREALLOC (mp->inext_stack, n, char *);
17160 XREALLOC (mp->iname_stack, n, char *);
17161 XREALLOC (mp->iarea_stack, n, char *);
17162 XREALLOC (mp->mpx_name, n, mp_string);
17163 for (k = mp->max_in_open; k <= n; k++) {
17164 mp->input_file[k] = NULL;
17165 mp->line_stack[k] = 0;
17166 mp->inext_stack[k] = NULL;
17167 mp->iname_stack[k] = NULL;
17168 mp->iarea_stack[k] = NULL;
17169 mp->mpx_name[k] = NULL;
17171 mp->max_in_open = newsize;
17175 @ This has to be more than |file_bottom|, so:
17176 @<Allocate or ...@>=
17177 mp_reallocate_input_stack (mp, file_bottom+4);
17179 @ @<Dealloc variables@>=
17182 for (l = 0; l <= mp->max_in_open; l++) {
17183 xfree (mp->inext_stack[l]);
17184 xfree (mp->iname_stack[l]);
17185 xfree (mp->iarea_stack[l]);
17188 xfree (mp->input_file);
17189 xfree (mp->line_stack);
17190 xfree (mp->inext_stack);
17191 xfree (mp->iname_stack);
17192 xfree (mp->iarea_stack);
17193 xfree (mp->mpx_name);
17196 @ However, all this discussion about input state really applies only to the
17197 case that we are inputting from a file. There is another important case,
17198 namely when we are currently getting input from a token list. In this case
17199 |iindex>max_in_open|, and the conventions about the other state variables
17202 \yskip\hang|nloc| is a pointer to the current node in the token list, i.e.,
17203 the node that will be read next. If |nloc=NULL|, the token list has been
17206 \yskip\hang|start| points to the first node of the token list; this node
17207 may or may not contain a reference count, depending on the type of token
17210 \yskip\hang|token_type|, which takes the place of |iindex| in the
17211 discussion above, is a code number that explains what kind of token list
17214 \yskip\hang|name| points to the |eqtb| address of the control sequence
17215 being expanded, if the current token list is a macro not defined by
17216 \&{vardef}. Macros defined by \&{vardef} have |name=NULL|; their name
17217 can be deduced by looking at their first two parameters.
17219 \yskip\hang|param_start|, which takes the place of |limit|, tells where
17220 the parameters of the current macro or loop text begin in the |param_stack|.
17222 \yskip\noindent The |token_type| can take several values, depending on
17223 where the current token list came from:
17226 \indent|forever_text|, if the token list being scanned is the body of
17227 a \&{forever} loop;
17229 \indent|loop_text|, if the token list being scanned is the body of
17230 a \&{for} or \&{forsuffixes} loop;
17232 \indent|parameter|, if a \&{text} or \&{suffix} parameter is being scanned;
17234 \indent|backed_up|, if the token list being scanned has been inserted as
17235 `to be read again'.
17237 \indent|inserted|, if the token list being scanned has been inserted as
17238 part of error recovery;
17240 \indent|macro|, if the expansion of a user-defined symbolic token is being
17244 The token list begins with a reference count if and only if |token_type=
17246 @^reference counts@>
17248 @d nloc mp->cur_input.nloc_field /* location of next node node */
17249 @d nstart mp->cur_input.nstart_field /* location of next node node */
17251 @d token_type iindex /* type of current token list */
17252 @d token_state (iindex<=macro) /* are we scanning a token list? */
17253 @d file_state (iindex>macro) /* are we scanning a file line? */
17254 @d param_start limit /* base of macro parameters in |param_stack| */
17255 @d forever_text 0 /* |token_type| code for loop texts */
17256 @d loop_text 1 /* |token_type| code for loop texts */
17257 @d parameter 2 /* |token_type| code for parameter texts */
17258 @d backed_up 3 /* |token_type| code for texts to be reread */
17259 @d inserted 4 /* |token_type| code for inserted texts */
17260 @d macro 5 /* |token_type| code for macro replacement texts */
17261 @d file_bottom 6 /* lowest file code */
17263 @ The |param_stack| is an auxiliary array used to hold pointers to the token
17264 lists for parameters at the current level and subsidiary levels of input.
17265 This stack grows at a different rate from the others, and is dynamically reallocated
17269 mp_node *param_stack; /* token list pointers for parameters */
17270 integer param_ptr; /* first unused entry in |param_stack| */
17271 integer max_param_stack; /* largest value of |param_ptr| */
17273 @ @<Allocate or initialize ...@>=
17274 mp->param_stack = xmalloc ((mp->param_size + 1), sizeof (mp_node));
17277 static void mp_check_param_size (MP mp, int k) {
17278 while (k >= mp->param_size) {
17279 XREALLOC (mp->param_stack, (k + k / 4), mp_node);
17280 mp->param_size = k + k / 4;
17285 @ @<Dealloc variables@>=
17286 xfree (mp->param_stack);
17288 @ Notice that the |line| isn't valid when |token_state| is true because it
17289 depends on |iindex|. If we really need to know the line number for the
17290 topmost file in the iindex stack we use the following function. If a page
17291 number or other information is needed, this routine should be modified to
17292 compute it as well.
17293 @^system dependencies@>
17296 static integer mp_true_line (MP mp);
17299 integer mp_true_line (MP mp) {
17300 int k; /* an index into the input stack */
17301 if (file_state && (name > max_spec_src)) {
17306 ((mp->input_stack[(k - 1)].index_field < file_bottom) ||
17307 (mp->input_stack[(k - 1)].name_field <= max_spec_src))) {
17310 return (k > 0 ? mp->line_stack[(k - 1) + file_bottom] : 0);
17315 @ Thus, the ``current input state'' can be very complicated indeed; there
17316 can be many levels and each level can arise in a variety of ways. The
17317 |show_context| procedure, which is used by \MP's error-reporting routine to
17318 print out the current input state on all levels down to the most recent
17319 line of characters from an input file, illustrates most of these conventions.
17320 The global variable |file_ptr| contains the lowest level that was
17321 displayed by this procedure.
17324 integer file_ptr; /* shallowest level shown by |show_context| */
17326 @ The status at each level is indicated by printing two lines, where the first
17327 line indicates what was read so far and the second line shows what remains
17328 to be read. The context is cropped, if necessary, so that the first line
17329 contains at most |half_error_line| characters, and the second contains
17330 at most |error_line|. Non-current input levels whose |token_type| is
17331 `|backed_up|' are shown only if they have not been fully read.
17334 void mp_show_context (MP mp) { /* prints where the scanner is */
17335 unsigned old_setting; /* saved |selector| setting */
17336 @<Local variables for formatting calculations@>;
17337 mp->file_ptr = mp->input_ptr;
17338 mp->input_stack[mp->file_ptr] = mp->cur_input;
17339 /* store current state */
17341 mp->cur_input = mp->input_stack[mp->file_ptr]; /* enter into the context */
17342 @<Display the current context@>;
17344 if ((name > max_spec_src) || (mp->file_ptr == 0))
17346 decr (mp->file_ptr);
17348 mp->cur_input = mp->input_stack[mp->input_ptr]; /* restore original state */
17352 @ @<Display the current context@>=
17353 if ((mp->file_ptr == mp->input_ptr) || file_state ||
17354 (token_type != backed_up) || (nloc != NULL)) {
17355 /* we omit backed-up token lists that have already been read */
17356 mp->tally = 0; /* get ready to count characters */
17357 old_setting = mp->selector;
17359 @<Print location of current line@>;
17360 @<Pseudoprint the line@>;
17362 @<Print type of token list@>;
17363 @<Pseudoprint the token list@>;
17365 mp->selector = old_setting; /* stop pseudoprinting */
17366 @<Print two lines using the tricky pseudoprinted information@>;
17369 @ This routine should be changed, if necessary, to give the best possible
17370 indication of where the current line resides in the input file.
17371 For example, on some systems it is best to print both a page and line number.
17372 @^system dependencies@>
17374 @<Print location of current line@>=
17375 if (name > max_spec_src) {
17376 mp_print_nl (mp, "l.");
17377 mp_print_int (mp, mp_true_line (mp));
17378 } else if (terminal_input) {
17379 if (mp->file_ptr == 0)
17380 mp_print_nl (mp, "<*>");
17382 mp_print_nl (mp, "<insert>");
17383 } else if (name == is_scantok) {
17384 mp_print_nl (mp, "<scantokens>");
17386 mp_print_nl (mp, "<read>");
17388 mp_print_char (mp, xord (' '))
17391 @ Can't use case statement here because the |token_type| is not
17392 a constant expression.
17394 @<Print type of token list@>=
17396 if (token_type == forever_text) {
17397 mp_print_nl (mp, "<forever> ");
17398 } else if (token_type == loop_text) {
17399 @<Print the current loop value@>;
17400 } else if (token_type == parameter) {
17401 mp_print_nl (mp, "<argument> ");
17402 } else if (token_type == backed_up) {
17404 mp_print_nl (mp, "<recently read> ");
17406 mp_print_nl (mp, "<to be read again> ");
17407 } else if (token_type == inserted) {
17408 mp_print_nl (mp, "<inserted text> ");
17409 } else if (token_type == macro) {
17412 mp_print_str (mp, name);
17414 @<Print the name of a \&{vardef}'d macro@>;
17415 mp_print (mp, "->");
17417 mp_print_nl (mp, "?"); /* this should never happen */
17423 @ The parameter that corresponds to a loop text is either a token list
17424 (in the case of \&{forsuffixes}) or a ``capsule'' (in the case of \&{for}).
17425 We'll discuss capsules later; for now, all we need to know is that
17426 the |link| field in a capsule parameter is |void| and that
17427 |print_exp(p,0)| displays the value of capsule~|p| in abbreviated form.
17429 @<Print the current loop value@>=
17432 mp_print_nl (mp, "<for(");
17433 pp = mp->param_stack[param_start];
17435 if (mp_link (pp) == MP_VOID)
17436 mp_print_exp (mp, pp, 0); /* we're in a \&{for} loop */
17438 mp_show_token_list (mp, pp, NULL, 20, mp->tally);
17440 mp_print (mp, ")> ");
17444 @ The first two parameters of a macro defined by \&{vardef} will be token
17445 lists representing the macro's prefix and ``at point.'' By putting these
17446 together, we get the macro's full name.
17448 @<Print the name of a \&{vardef}'d macro@>=
17450 mp_node pp = mp->param_stack[param_start];
17452 mp_show_token_list (mp, mp->param_stack[param_start + 1], NULL, 20,
17456 while (mp_link (qq) != NULL)
17458 mp_link (qq) = mp->param_stack[param_start + 1];
17459 mp_show_token_list (mp, pp, NULL, 20, mp->tally);
17460 mp_link (qq) = NULL;
17465 @ Now it is necessary to explain a little trick. We don't want to store a long
17466 string that corresponds to a token list, because that string might take up
17467 lots of memory; and we are printing during a time when an error message is
17468 being given, so we dare not do anything that might overflow one of \MP's
17469 tables. So `pseudoprinting' is the answer: We enter a mode of printing
17470 that stores characters into a buffer of length |error_line|, where character
17471 $k+1$ is placed into \hbox{|trick_buf[k mod error_line]|} if
17472 |k<trick_count|, otherwise character |k| is dropped. Initially we set
17473 |tally:=0| and |trick_count:=1000000|; then when we reach the
17474 point where transition from line 1 to line 2 should occur, we
17475 set |first_count:=tally| and |trick_count:=@tmax@>(error_line,
17476 tally+1+error_line-half_error_line)|. At the end of the
17477 pseudoprinting, the values of |first_count|, |tally|, and
17478 |trick_count| give us all the information we need to print the two lines,
17479 and all of the necessary text is in |trick_buf|.
17481 Namely, let |l| be the length of the descriptive information that appears
17482 on the first line. The length of the context information gathered for that
17483 line is |k=first_count|, and the length of the context information
17484 gathered for line~2 is $m=\min(|tally|, |trick_count|)-k$. If |l+k<=h|,
17485 where |h=half_error_line|, we print |trick_buf[0..k-1]| after the
17486 descriptive information on line~1, and set |n:=l+k|; here |n| is the
17487 length of line~1. If $l+k>h$, some cropping is necessary, so we set |n:=h|
17488 and print `\.{...}' followed by
17489 $$\hbox{|trick_buf[(l+k-h+3)..k-1]|,}$$
17490 where subscripts of |trick_buf| are circular modulo |error_line|. The
17491 second line consists of |n|~spaces followed by |trick_buf[k..(k+m-1)]|,
17492 unless |n+m>error_line|; in the latter case, further cropping is done.
17493 This is easier to program than to explain.
17495 @<Local variables for formatting...@>=
17496 int i; /* index into |buffer| */
17497 integer l; /* length of descriptive information on line 1 */
17498 integer m; /* context information gathered for line 2 */
17499 int n; /* length of line 1 */
17500 integer p; /* starting or ending place in |trick_buf| */
17501 integer q; /* temporary index */
17503 @ The following code tells the print routines to gather
17504 the desired information.
17506 @d begin_pseudoprint {
17507 l=mp->tally; mp->tally=0; mp->selector=pseudo;
17508 mp->trick_count=1000000;
17510 @d set_trick_count() {
17511 mp->first_count=mp->tally;
17512 mp->trick_count=mp->tally+1+mp->error_line-mp->half_error_line;
17513 if ( mp->trick_count<mp->error_line ) mp->trick_count=mp->error_line;
17516 @ And the following code uses the information after it has been gathered.
17518 @<Print two lines using the tricky pseudoprinted information@>=
17519 if (mp->trick_count == 1000000)
17521 /* |set_trick_count| must be performed */
17522 if (mp->tally < mp->trick_count)
17523 m = mp->tally - mp->first_count;
17525 m = mp->trick_count - mp->first_count; /* context on line 2 */
17526 if (l + mp->first_count <= mp->half_error_line) {
17528 n = l + mp->first_count;
17530 mp_print (mp, "...");
17531 p = l + mp->first_count - mp->half_error_line + 3;
17532 n = mp->half_error_line;
17534 for (q = p; q <= mp->first_count - 1; q++) {
17535 mp_print_char (mp, mp->trick_buf[q % mp->error_line]);
17538 for (q = 1; q <= n; q++) {
17539 mp_print_char (mp, xord (' ')); /* print |n| spaces to begin line~2 */
17541 if (m + n <= mp->error_line)
17542 p = mp->first_count + m;
17544 p = mp->first_count + (mp->error_line - n - 3);
17545 for (q = mp->first_count; q <= p - 1; q++) {
17546 mp_print_char (mp, mp->trick_buf[q % mp->error_line]);
17548 if (m + n > mp->error_line)
17549 mp_print (mp, "...")
17552 @ But the trick is distracting us from our current goal, which is to
17553 understand the input state. So let's concentrate on the data structures that
17554 are being pseudoprinted as we finish up the |show_context| procedure.
17556 @<Pseudoprint the line@>=
17559 for (i = start; i <= limit - 1; i++) {
17562 mp_print_char (mp, mp->buffer[i]);
17566 @ @<Pseudoprint the token list@>=
17568 if (token_type != macro)
17569 mp_show_token_list (mp, nstart, nloc, 100000, 0);
17571 mp_show_macro (mp, nstart, nloc, 100000)
17574 @* Maintaining the input stacks.
17575 The following subroutines change the input status in commonly needed ways.
17577 First comes |push_input|, which stores the current state and creates a
17578 new level (having, initially, the same properties as the old).
17580 @d push_input { /* enter a new input level, save the old */
17581 if ( mp->input_ptr>mp->max_in_stack ) {
17582 mp->max_in_stack=mp->input_ptr;
17583 if ( mp->input_ptr==mp->stack_size ) {
17584 int l = (mp->stack_size+(mp->stack_size/4));
17585 XREALLOC(mp->input_stack, l, in_state_record);
17586 mp->stack_size = l;
17589 mp->input_stack[mp->input_ptr]=mp->cur_input; /* stack the record */
17590 incr(mp->input_ptr);
17593 @ And of course what goes up must come down.
17595 @d pop_input { /* leave an input level, re-enter the old */
17596 decr(mp->input_ptr); mp->cur_input=mp->input_stack[mp->input_ptr];
17599 @ Here is a procedure that starts a new level of token-list input, given
17600 a token list |p| and its type |t|. If |t=macro|, the calling routine should
17601 set |name|, reset~|loc|, and increase the macro's reference count.
17603 @d back_list(A) mp_begin_token_list(mp, (A), (quarterword)backed_up) /* backs up a simple token list */
17606 static void mp_begin_token_list (MP mp, mp_node p, quarterword t) {
17610 param_start = mp->param_ptr;
17615 @ When a token list has been fully scanned, the following computations
17616 should be done as we leave that level of input.
17620 static void mp_end_token_list (MP mp) { /* leave a token-list input level */
17621 mp_node p; /* temporary register */
17622 if (token_type >= backed_up) { /* token list to be deleted */
17623 if (token_type <= inserted) {
17624 mp_flush_token_list (mp, nstart);
17627 mp_delete_mac_ref (mp, nstart); /* update reference count */
17630 while (mp->param_ptr > param_start) { /* parameters must be flushed */
17631 decr (mp->param_ptr);
17632 p = mp->param_stack[mp->param_ptr];
17634 if (mp_link (p) == MP_VOID) { /* it's an \&{expr} parameter */
17635 mp_recycle_value (mp, p);
17636 mp_free_value_node (mp, p);
17638 mp_flush_token_list (mp, p); /* it's a \&{suffix} or \&{text} parameter */
17648 @ The contents of |cur_cmd,cur_mod,cur_sym| are placed into an equivalent
17649 token by the |cur_tok| routine.
17653 @<Declare the procedure called |make_exp_copy|@>;
17654 static mp_node mp_cur_tok (MP mp) {
17655 mp_node p; /* a new token node */
17656 if (cur_sym() == NULL && (cur_sym_mod() == 0 || cur_sym_mod() == mp_normal_sym)) {
17657 if (cur_cmd() == mp_capsule_token) {
17658 mp_number save_exp_num; /* possible |cur_exp| numerical to be restored */
17659 mp_value save_exp = mp->cur_exp; /* |cur_exp| to be restored */
17660 new_number (save_exp_num);
17661 number_clone (save_exp_num, cur_exp_value_number());
17662 mp_make_exp_copy (mp, cur_mod_node());
17663 p = mp_stash_cur_exp (mp);
17664 mp_link (p) = NULL;
17665 mp->cur_exp = save_exp;
17666 number_clone (mp->cur_exp.data.n, save_exp_num);
17667 free_number (save_exp_num);
17669 p = mp_get_token_node (mp);
17670 mp_name_type (p) = mp_token;
17671 if (cur_cmd() == mp_numeric_token) {
17672 set_value_number (p, cur_mod_number());
17673 mp_type (p) = mp_known;
17675 set_value_str (p, cur_mod_str());
17676 mp_type (p) = mp_string_type;
17680 p = mp_get_symbolic_node (mp);
17681 set_mp_sym_sym (p, cur_sym());
17682 mp_name_type (p) = cur_sym_mod();
17688 @ Sometimes \MP\ has read too far and wants to ``unscan'' what it has
17689 seen. The |back_input| procedure takes care of this by putting the token
17690 just scanned back into the input stream, ready to be read again.
17691 If |cur_sym<>0|, the values of |cur_cmd| and |cur_mod| are irrelevant.
17694 static void mp_back_input (MP mp);
17697 void mp_back_input (MP mp) { /* undoes one token of input */
17698 mp_node p; /* a token list of length one */
17699 p = mp_cur_tok (mp);
17700 while (token_state && (nloc == NULL))
17701 mp_end_token_list (mp); /* conserve stack space */
17706 @ The |back_error| routine is used when we want to restore or replace an
17707 offending token just before issuing an error message. We disable interrupts
17708 during the call of |back_input| so that the help message won't be lost.
17711 static void mp_back_error (MP mp, const char *msg, const char **hlp, boolean deletions_allowed) ;
17714 static void mp_back_error (MP mp, const char *msg, const char **hlp, boolean deletions_allowed) {
17715 /* back up one token and call |error| */
17716 mp->OK_to_interrupt = false;
17717 mp_back_input (mp);
17718 mp->OK_to_interrupt = true;
17719 mp_error (mp, msg, hlp, deletions_allowed);
17721 static void mp_ins_error (MP mp, const char *msg, const char **hlp, boolean deletions_allowed) {
17722 /* back up one inserted token and call |error| */
17723 mp->OK_to_interrupt = false;
17724 mp_back_input (mp);
17725 token_type = (quarterword) inserted;
17726 mp->OK_to_interrupt = true;
17727 mp_error (mp, msg, hlp, deletions_allowed);
17731 @ The |begin_file_reading| procedure starts a new level of input for lines
17732 of characters to be read from a file, or as an insertion from the
17733 terminal. It does not take care of opening the file, nor does it set |loc|
17734 or |limit| or |line|.
17735 @^system dependencies@>
17738 void mp_begin_file_reading (MP mp) {
17739 if (mp->in_open == (mp->max_in_open-1))
17740 mp_reallocate_input_stack (mp, (mp->max_in_open + mp->max_in_open / 4));
17741 if (mp->first == mp->buf_size)
17742 mp_reallocate_buffer (mp, (mp->buf_size + mp->buf_size / 4));
17745 iindex = (quarterword) mp->in_open;
17746 if (mp->in_open_max < mp->in_open)
17747 mp->in_open_max = mp->in_open;
17748 mp->mpx_name[iindex] = absent;
17749 start = (halfword) mp->first;
17750 name = is_term; /* |terminal_input| is now |true| */
17754 @ Conversely, the variables must be downdated when such a level of input
17755 is finished. Any associated \.{MPX} file must also be closed and popped
17756 off the file stack. While finishing preloading, it is possible that the file
17757 does not actually end with 'dump', so we capture that case here as well.
17760 static void mp_end_file_reading (MP mp) {
17761 if (mp->reading_preload && mp->input_ptr == 0) {
17762 set_cur_sym(mp->frozen_dump);
17763 mp_back_input (mp);
17766 if (mp->in_open > iindex) {
17767 if ((mp->mpx_name[mp->in_open] == absent) || (name <= max_spec_src)) {
17768 mp_confusion (mp, "endinput");
17769 @:this can't happen endinput}{\quad endinput@>;
17771 (mp->close_file) (mp, mp->input_file[mp->in_open]); /* close an \.{MPX} file */
17772 delete_str_ref (mp->mpx_name[mp->in_open]);
17773 decr (mp->in_open);
17776 mp->first = (size_t) start;
17777 if (iindex != mp->in_open)
17778 mp_confusion (mp, "endinput");
17779 if (name > max_spec_src) {
17780 (mp->close_file) (mp, cur_file);
17786 decr (mp->in_open);
17790 @ Here is a function that tries to resume input from an \.{MPX} file already
17791 associated with the current input file. It returns |false| if this doesn't
17795 static boolean mp_begin_mpx_reading (MP mp) {
17796 if (mp->in_open != iindex + 1) {
17799 if (mp->mpx_name[mp->in_open] <= absent)
17800 mp_confusion (mp, "mpx");
17801 if (mp->first == mp->buf_size)
17802 mp_reallocate_buffer (mp, (mp->buf_size + (mp->buf_size / 4)));
17804 iindex = (quarterword) mp->in_open;
17805 start = (halfword) mp->first;
17806 name = mp->mpx_name[mp->in_open];
17807 add_str_ref (name);
17808 /* Put an empty line in the input buffer */
17809 /* We want to make it look as though we have just read a blank line
17810 without really doing so. */
17811 mp->last = mp->first;
17812 limit = (halfword) mp->last;
17813 /* simulate |input_ln| and |firm_up_the_line| */
17814 mp->buffer[limit] = xord ('%');
17815 mp->first = (size_t) (limit + 1);
17822 @ This procedure temporarily stops reading an \.{MPX} file.
17825 static void mp_end_mpx_reading (MP mp) {
17826 if (mp->in_open != iindex)
17827 mp_confusion (mp, "mpx");
17828 @:this can't happen mpx}{\quad mpx@>;
17830 /* Complain that we are not at the end of a line in the \.{MPX} file */
17831 /* Here we enforce a restriction that simplifies the input stacks considerably.
17832 This should not inconvenience the user because \.{MPX} files are generated
17833 by an auxiliary program called \.{DVItoMP}. */
17834 const char *hlp[] = {
17835 "This file contains picture expressions for btex...etex",
17836 "blocks. Such files are normally generated automatically",
17837 "but this one seems to be messed up. I'm going to ignore",
17838 "the rest of this line.",
17840 mp_error (mp, "`mpxbreak' must be at the end of a line", hlp, true);
17842 mp->first = (size_t) start;
17846 @ In order to keep the stack from overflowing during a long sequence of
17847 inserted `\.{show}' commands, the following routine removes completed
17848 error-inserted lines from memory.
17851 void mp_clear_for_error_prompt (MP mp) {
17852 while (file_state && terminal_input && (mp->input_ptr > 0) && (loc == limit))
17853 mp_end_file_reading (mp);
17859 @ To get \MP's whole input mechanism going, we perform the following
17862 @<Initialize the input routines@>=
17865 mp->max_in_stack = file_bottom;
17866 mp->in_open = file_bottom;
17867 mp->open_parens = 0;
17868 mp->max_buf_stack = 0;
17870 mp->max_param_stack = 0;
17873 iindex = file_bottom;
17876 mp->mpx_name[file_bottom] = absent;
17877 mp->force_eof = false;
17878 if (!mp_init_terminal (mp))
17880 limit = (halfword) mp->last;
17881 mp->first = mp->last + 1;
17882 /* |init_terminal| has set |loc| and |last| */
17886 @* Getting the next token.
17887 The heart of \MP's input mechanism is the |get_next| procedure, which
17888 we shall develop in the next few sections of the program. Perhaps we
17889 shouldn't actually call it the ``heart,'' however; it really acts as \MP's
17890 eyes and mouth, reading the source files and gobbling them up. And it also
17891 helps \MP\ to regurgitate stored token lists that are to be processed again.
17893 The main duty of |get_next| is to input one token and to set |cur_cmd|
17894 and |cur_mod| to that token's command code and modifier. Furthermore, if
17895 the input token is a symbolic token, that token's |hash| address
17896 is stored in |cur_sym|; otherwise |cur_sym| is set to zero.
17898 Underlying this simple description is a certain amount of complexity
17899 because of all the cases that need to be handled.
17900 However, the inner loop of |get_next| is reasonably short and fast.
17902 @ Before getting into |get_next|, we need to consider a mechanism by which
17903 \MP\ helps keep errors from propagating too far. Whenever the program goes
17904 into a mode where it keeps calling |get_next| repeatedly until a certain
17905 condition is met, it sets |scanner_status| to some value other than |normal|.
17906 Then if an input file ends, or if an `\&{outer}' symbol appears,
17907 an appropriate error recovery will be possible.
17909 The global variable |warning_info| helps in this error recovery by providing
17910 additional information. For example, |warning_info| might indicate the
17911 name of a macro whose replacement text is being scanned.
17913 @d normal 0 /* |scanner_status| at ``quiet times'' */
17914 @d skipping 1 /* |scanner_status| when false conditional text is being skipped */
17915 @d flushing 2 /* |scanner_status| when junk after a statement is being ignored */
17916 @d absorbing 3 /* |scanner_status| when a \&{text} parameter is being scanned */
17917 @d var_defining 4 /* |scanner_status| when a \&{vardef} is being scanned */
17918 @d op_defining 5 /* |scanner_status| when a macro \&{def} is being scanned */
17919 @d loop_defining 6 /* |scanner_status| when a \&{for} loop is being scanned */
17922 #define tex_flushing 7 /* |scanner_status| when skipping \TeX\ material */
17923 integer scanner_status; /* are we scanning at high speed? */
17924 mp_sym warning_info; /* if so, what else do we need to know,
17925 in case an error occurs? */
17926 integer warning_line;
17927 mp_node warning_info_node;
17929 @ @<Initialize the input routines@>=
17930 mp->scanner_status = normal;
17932 @ The following subroutine
17933 is called when an `\&{outer}' symbolic token has been scanned or
17934 when the end of a file has been reached. These two cases are distinguished
17935 by |cur_sym|, which is zero at the end of a file.
17938 static boolean mp_check_outer_validity (MP mp) {
17939 mp_node p; /* points to inserted token list */
17940 if (mp->scanner_status == normal) {
17942 } else if (mp->scanner_status == tex_flushing) {
17943 @<Check if the file has ended while flushing \TeX\ material and set the
17944 result value for |check_outer_validity|@>;
17946 @<Back up an outer symbolic token so that it can be reread@>;
17947 if (mp->scanner_status > skipping) {
17948 @<Tell the user what has run away and try to recover@>;
17951 const char *hlp[] = {
17952 "A forbidden `outer' token occurred in skipped text.",
17953 "This kind of error happens when you say `if...' and forget",
17954 "the matching `fi'. I've inserted a `fi'; this might work.",
17956 mp_snprintf(msg, 256, "Incomplete if; all text was ignored after line %d", (int)mp->warning_line);
17957 @.Incomplete if...@>;
17958 if (cur_sym() == NULL) {
17959 hlp[0] = "The file ended while I was skipping conditional text.";
17961 set_cur_sym (mp->frozen_fi);
17962 mp_ins_error (mp, msg, hlp, false);
17969 @ @<Check if the file has ended while flushing \TeX\ material and set...@>=
17970 if (cur_sym() != NULL) {
17974 const char *hlp[] = {
17975 "The file ended while I was looking for the `etex' to",
17976 "finish this TeX material. I've inserted `etex' now.",
17978 mp_snprintf(msg, 256, "TeX mode didn't end; all text was ignored after line %d", (int)mp->warning_line);
17979 set_cur_sym(mp->frozen_etex);
17980 mp_ins_error (mp, msg, hlp, false);
17985 @ @<Back up an outer symbolic token so that it can be reread@>=
17986 if (cur_sym() != NULL) {
17987 p = mp_get_symbolic_node (mp);
17988 set_mp_sym_sym (p, cur_sym());
17989 mp_name_type (p) = cur_sym_mod();
17990 back_list (p); /* prepare to read the symbolic token again */
17993 @ @<Tell the user what has run away...@>=
17996 const char *msg_start = NULL;
17997 const char *hlp[] = {
17998 "I suspect you have forgotten an `enddef',",
17999 "causing me to read past where you wanted me to stop.",
18000 "I'll try to recover; but if the error is serious,",
18001 "you'd better type `E' or `X' now and fix your file.",
18003 mp_runaway (mp); /* print the definition-so-far */
18004 if (cur_sym() == NULL) {
18005 msg_start = "File ended while scanning";
18006 @.File ended while scanning...@>
18008 msg_start = "Forbidden token found while scanning";
18009 @.Forbidden token found...@>
18011 switch (mp->scanner_status) {
18012 @<Complete the error message,
18013 and set |cur_sym| to a token that might help recover from the error@>
18014 } /* there are no other cases */
18015 mp_ins_error (mp, msg, hlp, true);
18019 @ As we consider various kinds of errors, it is also appropriate to
18020 change the first line of the help message just given; |help_line[3]|
18021 points to the string that might be changed.
18023 @<Complete the error message,...@>=
18025 mp_snprintf (msg, 256, "%s to the end of the statement", msg_start);
18026 hlp[0] = "A previous error seems to have propagated,";
18027 set_cur_sym(mp->frozen_semicolon);
18030 mp_snprintf (msg, 256, "%s a text argument", msg_start);
18031 hlp[0] = "It seems that a right delimiter was left out,";
18032 if (mp->warning_info == NULL) {
18033 set_cur_sym(mp->frozen_end_group);
18035 set_cur_sym(mp->frozen_right_delimiter);
18036 /* the next line makes sure that the inserted delimiter will
18037 match the delimiter that already was read. */
18038 set_equiv_sym (cur_sym(), mp->warning_info);
18044 int old_setting = mp->selector;
18045 mp->selector = new_string;
18046 mp_print_variable_name (mp, mp->warning_info_node);
18047 s = mp_make_string (mp);
18048 mp->selector = old_setting;
18049 mp_snprintf (msg, 256, "%s the definition of %s", msg_start, s->str);
18052 set_cur_sym(mp->frozen_end_def);
18056 char *s = mp_str(mp, text(mp->warning_info));
18057 mp_snprintf (msg, 256, "%s the definition of %s", msg_start, s);
18059 set_cur_sym(mp->frozen_end_def);
18061 case loop_defining:
18063 char *s = mp_str(mp, text(mp->warning_info));
18064 mp_snprintf (msg, 256, "%s the text of a %s loop", msg_start, s);
18066 hlp[0] = "I suspect you have forgotten an `endfor',";
18067 set_cur_sym(mp->frozen_end_for);
18070 @ The |runaway| procedure displays the first part of the text that occurred
18071 when \MP\ began its special |scanner_status|, if that text has been saved.
18074 static void mp_runaway (MP mp);
18077 void mp_runaway (MP mp) {
18078 if (mp->scanner_status > flushing) {
18079 mp_print_nl (mp, "Runaway ");
18080 switch (mp->scanner_status) {
18082 mp_print (mp, "text?");
18086 mp_print (mp, "definition?");
18088 case loop_defining:
18089 mp_print (mp, "loop?");
18091 } /* there are no other cases */
18093 mp_show_token_list (mp, mp_link (mp->hold_head), NULL, mp->error_line - 10,
18099 @ We need to mention a procedure that may be called by |get_next|.
18102 static void mp_firm_up_the_line (MP mp);
18104 @ And now we're ready to take the plunge into |get_next| itself.
18105 Note that the behavior depends on the |scanner_status| because percent signs
18106 and double quotes need to be passed over when skipping TeX material.
18109 void mp_get_next (MP mp) {
18110 /* sets |cur_cmd|, |cur_mod|, |cur_sym| to next token */
18111 mp_sym cur_sym_; /* speed up access */
18114 set_cur_sym_mod(0);
18116 int k; /* an index into |buffer| */
18117 ASCII_code c; /* the current character in the buffer */
18118 int cclass; /* its class number */
18119 /* Input from external file; |goto restart| if no input found,
18120 or |return| if a non-symbolic token is found */
18121 /* A percent sign appears in |buffer[limit]|; this makes it unnecessary
18122 to have a special test for end-of-line. */
18124 c = mp->buffer[loc];
18126 cclass = mp->char_class[c];
18129 scan_numeric_token((c - '0'));
18133 cclass = mp->char_class[mp->buffer[loc]];
18134 if (cclass > period_class) {
18136 } else if (cclass < period_class) { /* |class=digit_class| */
18137 scan_fractional_token(0);
18144 case percent_class:
18145 if (mp->scanner_status == tex_flushing) {
18149 /* Move to next line of file, or |goto restart| if there is no next line */
18150 switch (move_to_next_line(mp)) {
18151 case 1: goto RESTART; break;
18152 case 2: goto COMMON_ENDING; break;
18159 if (mp->scanner_status == tex_flushing) {
18162 if (mp->buffer[loc] == '"') {
18163 set_cur_mod_str
(mp_rts
(mp
,""));
18166 mp-
>buffer
[limit
+ 1] = xord
('
"');
18169 } while (mp->buffer[loc] != '"'
);
18171 /* Decry the missing string delimiter and |goto restart|
*/
18172 /* We go to |restart| after this error message
, not to |SWITCH|
,
18173 because the |clear_for_error_prompt| routine might have reinstated
18174 |token_state| after |error| has finished.
*/
18175 const char
*hlp
[] = {
18176 "Strings should finish on the same line as they began.",
18177 "I've deleted the partial string; you might want to",
18178 "insert another by typing, e.g., `I\"new string\
"'.",
18180 loc
= limit
; /* the next character to be read on this line will be |
"%"|
*/
18181 mp_error
(mp
, "Incomplete string token has been flushed", hlp
, false
);
18184 str_room
((size_t
) (loc
- k
));
18186 append_char
(mp-
>buffer
[k
]);
18188 } while
(k
!= loc
);
18189 set_cur_mod_str
(mp_make_string
(mp
));
18192 set_cur_cmd
((mp_variable_type
)mp_string_token
);
18196 case isolated_classes
:
18200 case invalid_class
:
18201 if
(mp-
>scanner_status
== tex_flushing
) {
18204 /* Decry the invalid character and |goto restart|
*/
18205 /* We go to |restart| instead of to |SWITCH|
, because we might enter
18206 |token_state| after the error has been dealt with
18207 (cf.\ |clear_for_error_prompt|
).
*/
18208 const char
*hlp
[] = {
18209 "A funny symbol that I can\'t read has just been input.",
18210 "Continue, and I'll forget that it ever happened.",
18212 mp_error
(mp
, "Text line contains an invalid character", hlp
, false
);
18217 break
; /* letters
, etc.
*/
18220 while
(mp-
>char_class
[mp-
>buffer
[loc
]] == cclass
)
18223 set_cur_sym
(mp_id_lookup
(mp
, (char
*) (mp-
>buffer
+ k
), (size_t
) (loc
- k
), true
));
18226 /* Input from token list
; |goto restart| if end of list or
18227 if a parameter needs to be expanded
,
18228 or |return| if a non-symbolic token is found
*/
18229 if
(nloc
!= NULL && mp_type (nloc) == mp_symbol_node) { /* symbolic token */
18230 int cur_sym_mod_
= mp_name_type
(nloc
);
18231 halfword cur_info
= mp_sym_info
(nloc
);
18232 set_cur_sym
(mp_sym_sym
(nloc
));
18233 set_cur_sym_mod
(cur_sym_mod_
);
18234 nloc
= mp_link
(nloc
); /* move to next
*/
18235 if
(cur_sym_mod_
== mp_expr_sym
) {
18236 set_cur_cmd
((mp_variable_type
)mp_capsule_token
);
18237 set_cur_mod_node
(mp-
>param_stack
[param_start
+ cur_info
]);
18238 set_cur_sym_mod
(0);
18241 } else if
(cur_sym_mod_
== mp_suffix_sym || cur_sym_mod_
== mp_text_sym
) {
18242 mp_begin_token_list
(mp
,
18243 mp-
>param_stack
[param_start
+ cur_info
],
18244 (quarterword
) parameter
);
18247 } else if
(nloc
!= NULL) {
18248 /* Get a stored numeric or string or capsule token and |return|
*/
18249 if
(mp_name_type
(nloc
) == mp_token
) {
18250 if
(mp_type
(nloc
) == mp_known
) {
18251 set_cur_mod_number
(value_number
(nloc
));
18252 set_cur_cmd
((mp_variable_type
)mp_numeric_token
);
18254 set_cur_mod_str
(value_str
(nloc
));
18255 set_cur_cmd
((mp_variable_type
)mp_string_token
);
18256 add_str_ref
(cur_mod_str
());
18259 set_cur_mod_node
(nloc
);
18260 set_cur_cmd
((mp_variable_type
)mp_capsule_token
);
18262 nloc
= mp_link
(nloc
);
18264 } else
{ /* we are done with this token list
*/
18265 mp_end_token_list
(mp
);
18266 goto RESTART
; /* resume previous level
*/
18270 /* When a symbolic token is declared to be `\
&{outer}', its command code
18271 is increased by |outer_tag|.
*/
18272 cur_sym_
= cur_sym
();
18273 set_cur_cmd
(eq_type
(cur_sym_
));
18274 set_cur_mod
(equiv
(cur_sym_
));
18275 set_cur_mod_node
(equiv_node
(cur_sym_
));
18276 if
(cur_cmd
() >= mp_outer_tag
) {
18277 if
(mp_check_outer_validity
(mp
))
18278 set_cur_cmd
(cur_cmd
() - mp_outer_tag
);
18284 @ The global variable |force_eof| is normally |false|
; it is set |true|
18285 by an \
&{endinput} command.
18288 boolean force_eof
; /* should the next \
&{input} be aborted early? */
18290 @ @
<Declarations@
>=
18291 static int move_to_next_line
(MP mp
);
18294 static int move_to_next_line
(MP mp
) {
18295 if
(name
> max_spec_src
) {
18296 /* Read next line of file into |buffer|
, or return
1
18297 (|goto restart|
) if the file has ended
*/
18298 /* We must decrement |loc| in order to leave the buffer in a valid state
18299 when an error condition causes us to |goto restart| without calling
18300 |end_file_reading|.
*/
18303 mp-
>first
= (size_t
) start
;
18304 if
(!mp-
>force_eof
) {
18305 if
(mp_input_ln
(mp
, cur_file
)) /* not end of file
*/
18306 mp_firm_up_the_line
(mp
); /* this sets |limit|
*/
18308 mp-
>force_eof
= true
;
18310 if
(mp-
>force_eof
) {
18311 mp-
>force_eof
= false
;
18314 /* Complain that the \.
{MPX
} file ended unexpectly
; then set
18315 |cur_sym
:=mp-
>frozen_mpx_break| and |goto comon_ending|
*/
18316 /* We should never actually come to the end of an \.
{MPX
} file because such
18317 files should have an \
&{mpxbreak} after the translation of the last
18318 \
&{btex}$\,\ldots\,$\&{etex} block. */
18319 const char
*hlp
[] = {"The file had too few picture expressions for btex...etex",
18320 "blocks. Such files are normally generated automatically",
18321 "but this one got messed up. You might want to insert a",
18322 "picture expression now.",
18324 mp-
>mpx_name
[iindex
] = mpx_finished
;
18325 mp_error
(mp
, "mpx file ended unexpectedly", hlp
, false
);
18326 set_cur_sym
(mp-
>frozen_mpx_break
);
18329 mp_print_char
(mp
, xord
('
)'
));
18330 decr
(mp-
>open_parens
);
18331 update_terminal
(); /* show user that file has been read
*/
18332 mp_end_file_reading
(mp
); /* resume previous level
*/
18333 if
(mp_check_outer_validity
(mp
))
18339 mp-
>buffer
[limit
] = xord
('
%'
);
18340 mp-
>first
= (size_t
) (limit
+ 1);
18341 loc
= start
; /* ready to read
*/
18346 if
(mp-
>input_ptr
> 0) {
18347 /* text was inserted during error recovery or by \
&{scantokens} */
18348 mp_end_file_reading
(mp
);
18350 return
1; /* resume previous level
*/
18352 if
(mp-
>job_name
== NULL
18353 && (mp->selector < log_only || mp->selector >= write_file))
18354 mp_open_log_file
(mp
);
18355 if
(mp-
>interaction
> mp_nonstop_mode
) {
18356 if
(limit
== start
) /* previous line was empty
*/
18357 mp_print_nl
(mp
, "(Please type a command or say `end')");
18359 mp-
>first
= (size_t
) start
;
18360 prompt_input
("*"); /* input on-line into |buffer|
*/
18361 limit
= (halfword
) mp-
>last
;
18362 mp-
>buffer
[limit
] = xord
('
%'
);
18363 mp-
>first
= (size_t
) (limit
+ 1);
18366 mp_fatal_error
(mp
, "*** (job aborted, no legal end found)");
18367 /* nonstop mode
, which is intended for overnight batch processing
,
18368 never waits for on-line input
*/
18375 @ If the user has set the |mp_pausing| parameter to some positive value
,
18376 and if nonstop mode has not been selected
, each line of input is displayed
18377 on the terminal and the transcript file
, followed by `\.
{=>}'.
18378 \MP\ waits for a response. If the response is
NULL (i.e.
, if nothing is
18379 typed except perhaps a few blank spaces
), the original
18380 line is accepted as it stands
; otherwise the line typed is
18381 used instead of the line in the file.
18384 void mp_firm_up_the_line
(MP mp
) {
18385 size_t k
; /* an index into |buffer|
*/
18386 limit
= (halfword
) mp-
>last
;
18387 if
((!mp-
>noninteractive
)
18388 && (number_positive (internal_value (mp_pausing)))
18389 && (mp->interaction > mp_nonstop_mode)) {
18390 wake_up_terminal
();
18392 if
(start
< limit
) {
18393 for
(k
= (size_t
) start
; k
< (size_t
) limit
; k
++) {
18394 mp_print_char
(mp
, mp-
>buffer
[k
]);
18397 mp-
>first
= (size_t
) limit
;
18398 prompt_input
("=>"); /* wait for user response
*/
18400 if
(mp-
>last
> mp-
>first
) {
18401 for
(k
= mp-
>first
; k
< mp-
>last
; k
++) { /* move line down in buffer
*/
18402 mp-
>buffer
[k
+ (size_t
) start
- mp-
>first
] = mp-
>buffer
[k
];
18404 limit
= (halfword
) ((size_t
) start
+ mp-
>last
- mp-
>first
);
18410 @
* Dealing with \TeX\ material.
18411 The \
&{btex}$\,\ldots\,$\&{etex} and \&{verbatimtex}$\,\ldots\,$\&{etex}
18412 features need to be implemented at a low level in the scanning process
18413 so that \MP\ can stay in synch with the a preprocessor that treats
18414 blocks of \TeX\ material as they occur in the input file without trying
18415 to expand \MP\ macros. Thus we need a special version of |get_next|
18416 that does not expand macros and such but does handle \
&{btex},
18417 \
&{verbatimtex}, etc.
18419 The special version of |get_next| is called |get_t_next|. It works by flushing
18420 \
&{btex}$\,\ldots\,$\&{etex} and \&{verbatimtex}\allowbreak
18421 $\
,\ldots\
,$\
&{etex} blocks, switching to the \.{MPX} file when it sees
18422 \
&{btex}, and switching back when it sees \&{mpxbreak}.
18428 mp_primitive
(mp
, "btex", mp_start_tex
, btex_code
);
18429 @
:btex_
}{\
&{btex} primitive@>;
18430 mp_primitive
(mp
, "verbatimtex", mp_start_tex
, verbatim_code
);
18431 @
:verbatimtex_
}{\
&{verbatimtex} primitive@>;
18432 mp_primitive
(mp
, "etex", mp_etex_marker
, 0);
18433 mp-
>frozen_etex
= mp_frozen_primitive
(mp
, "etex", mp_etex_marker
, 0);
18434 @
:etex_
}{\
&{etex} primitive@>;
18435 mp_primitive
(mp
, "mpxbreak", mp_mpx_break
, 0);
18436 mp-
>frozen_mpx_break
= mp_frozen_primitive
(mp
, "mpxbreak", mp_mpx_break
, 0);
18437 @
:mpx_break_
}{\
&{mpxbreak} primitive@>
18440 @ @
<Cases of |print_cmd...@
>=
18442 if
(m
== btex_code
)
18443 mp_print
(mp
, "btex");
18445 mp_print
(mp
, "verbatimtex");
18447 case mp_etex_marker
:
18448 mp_print
(mp
, "etex");
18451 mp_print
(mp
, "mpxbreak");
18454 @ Actually
, |get_t_next| is a macro that avoids procedure overhead except
18455 in the unusual case where \
&{btex}, \&{verbatimtex}, \&{etex}, or \&{mpxbreak}
18458 @d get_t_next
(a
) do
{
18460 if
(cur_cmd
() <= mp_max_pre_command
)
18465 @ @
<Declarations@
>=
18466 static void mp_t_next
(MP mp
);
18467 static void mp_start_mpx_input
(MP mp
);
18470 static void mp_t_next
(MP mp
) {
18471 int old_status
; /* saves the |scanner_status|
*/
18472 integer old_info
; /* saves the |warning_info|
*/
18474 if
((mp-
>extensions
== 1) && (cur_cmd() == mp_start_tex)) {
18475 @
<Pass btex ... etex to script@
>;
18478 while
(cur_cmd
() <= mp_max_pre_command
) {
18479 if
(cur_cmd
() == mp_mpx_break
) {
18480 if
(!file_state ||
(mp-
>mpx_name
[iindex
] == absent
)) {
18481 @
<Complain about a misplaced \
&{mpxbreak}@>;
18483 mp_end_mpx_reading
(mp
);
18486 } else if
(cur_cmd
() == mp_start_tex
) {
18487 if
(token_state ||
(name
<= max_spec_src
)) {
18488 @
<Complain that we are not reading a file@
>;
18489 } else if
(mpx_reading
) {
18490 @
<Complain that \.
{MPX
} files cannot contain \TeX\ material@
>;
18491 } else if
((cur_mod
() != verbatim_code
) &&
18492 (mp-
>mpx_name
[iindex
] != mpx_finished
)) {
18493 if
(!mp_begin_mpx_reading
(mp
))
18494 mp_start_mpx_input
(mp
);
18499 @
<Complain about a misplaced \
&{etex}@>;
18501 goto COMMON_ENDING
;
18503 @
<Flush the \TeX\ material@
>;
18511 @ We could be in the middle of an operation such as skipping false conditional
18512 text when \TeX\ material is encountered
, so we must be careful to save the
18515 @
<Flush the \TeX\ material@
>=
18516 old_status
= mp-
>scanner_status
;
18517 old_info
= mp-
>warning_line
;
18518 mp-
>scanner_status
= tex_flushing
;
18519 mp-
>warning_line
= line
;
18522 } while
(cur_cmd
() != mp_etex_marker
);
18523 mp-
>scanner_status
= old_status
;
18524 mp-
>warning_line
= old_info
18526 @ @
<Complain that \.
{MPX
} files cannot contain \TeX\ material@
>=
18528 const char
*hlp
[] = {
18529 "This file contains picture expressions for btex...etex",
18530 "blocks. Such files are normally generated automatically",
18531 "but this one seems to be messed up. I'll just keep going",
18532 "and hope for the best.",
18534 mp_error
(mp
, "An mpx file cannot contain btex or verbatimtex blocks", hlp
, true
);
18538 @ @
<Complain that we are not reading a file@
>=
18540 const char
*hlp
[] = {
18541 "I'll have to ignore this preprocessor command because it",
18542 "only works when there is a file to preprocess. You might",
18543 "want to delete everything up to the next `etex`.",
18545 mp_error
(mp
, "You can only use `btex' or `verbatimtex' in a file", hlp
, true
);
18549 @ @
<Complain about a misplaced \
&{mpxbreak}@>=
18551 const char
*hlp
[] = {
18552 "I'll ignore this preprocessor command because it",
18553 "doesn't belong here",
18555 mp_error
(mp
, "Misplaced mpxbreak", hlp
, true
);
18559 @ @
<Complain about a misplaced \
&{etex}@>=
18561 const char
*hlp
[] = {
18562 "There is no btex or verbatimtex for this to match",
18564 mp_error
(mp
, "Extra etex will be ignored", hlp
, true
);
18568 @
* Scanning macro definitions.
18569 \MP\ has a variety of ways to tuck tokens away into token lists for later
18570 use
: Macros can be defined with \
&{def}, \&{vardef}, \&{primarydef}, etc.;
18571 repeatable code can be defined with \
&{for}, \&{forever}, \&{forsuffixes}.
18572 All such operations are handled by the routines in this part of the program.
18574 The modifier part of each command code is zero for the ``ending delimiters''
18575 like \
&{enddef} and \&{endfor}.
18577 @d start_def
1 /* command modifier for \
&{def} */
18578 @d var_def
2 /* command modifier for \
&{vardef} */
18579 @d end_def
0 /* command modifier for \
&{enddef} */
18580 @d start_forever
1 /* command modifier for \
&{forever} */
18581 @d start_for
2 /* command modifier for \
&{forever} */
18582 @d start_forsuffixes
3 /* command modifier for \
&{forever} */
18583 @d end_for
0 /* command modifier for \
&{endfor} */
18586 mp_primitive
(mp
, "def", mp_macro_def
, start_def
);
18587 @
:def_
}{\
&{def} primitive@>;
18588 mp_primitive
(mp
, "vardef", mp_macro_def
, var_def
);
18589 @
:var_def_
}{\
&{vardef} primitive@>;
18590 mp_primitive
(mp
, "primarydef", mp_macro_def
, mp_secondary_primary_macro
);
18591 @
:primary_def_
}{\
&{primarydef} primitive@>;
18592 mp_primitive
(mp
, "secondarydef", mp_macro_def
, mp_tertiary_secondary_macro
);
18593 @
:secondary_def_
}{\
&{secondarydef} primitive@>;
18594 mp_primitive
(mp
, "tertiarydef", mp_macro_def
, mp_expression_tertiary_macro
);
18595 @
:tertiary_def_
}{\
&{tertiarydef} primitive@>;
18596 mp_primitive
(mp
, "enddef", mp_macro_def
, end_def
);
18597 mp-
>frozen_end_def
= mp_frozen_primitive
(mp
, "enddef", mp_macro_def
, end_def
);
18598 @
:end_def_
}{\
&{enddef} primitive@>;
18599 mp_primitive
(mp
, "for", mp_iteration
, start_for
);
18600 @
:for_
}{\
&{for} primitive@>;
18601 mp_primitive
(mp
, "forsuffixes", mp_iteration
, start_forsuffixes
);
18602 @
:for_suffixes_
}{\
&{forsuffixes} primitive@>;
18603 mp_primitive
(mp
, "forever", mp_iteration
, start_forever
);
18604 @
:forever_
}{\
&{forever} primitive@>;
18605 mp_primitive
(mp
, "endfor", mp_iteration
, end_for
);
18606 mp-
>frozen_end_for
= mp_frozen_primitive
(mp
, "endfor", mp_iteration
, end_for
);
18607 @
:end_for_
}{\
&{endfor} primitive@>
18610 @ @
<Cases of |print_cmd...@
>=
18612 if
(m
<= var_def
) {
18613 if
(m
== start_def
)
18614 mp_print
(mp
, "def");
18615 else if
(m
< start_def
)
18616 mp_print
(mp
, "enddef");
18618 mp_print
(mp
, "vardef");
18619 } else if
(m
== mp_secondary_primary_macro
) {
18620 mp_print
(mp
, "primarydef");
18621 } else if
(m
== mp_tertiary_secondary_macro
) {
18622 mp_print
(mp
, "secondarydef");
18624 mp_print
(mp
, "tertiarydef");
18628 if
(m
== start_forever
)
18629 mp_print
(mp
, "forever");
18630 else if
(m
== end_for
)
18631 mp_print
(mp
, "endfor");
18632 else if
(m
== start_for
)
18633 mp_print
(mp
, "for");
18635 mp_print
(mp
, "forsuffixes");
18638 @ Different macro-absorbing operations have different syntaxes
, but they
18639 also have a lot in common. There is a list of special symbols that are to
18640 be replaced by parameter tokens
; there is a special command code that
18641 ends the definition
; the quotation conventions are identical. Therefore
18642 it makes sense to have most of the work done by a single subroutine. That
18643 subroutine is called |scan_toks|.
18645 The first parameter to |scan_toks| is the command code that will
18646 terminate scanning
(either |macro_def| or |iteration|
).
18648 The second parameter
, |subst_list|
, points to a
(possibly empty
) list
18649 of non-symbolic nodes whose |info| and |value| fields specify symbol tokens
18650 before and after replacement. The list will be returned to free storage
18653 The third parameter is simply appended to the token list that is built.
18654 And the final parameter tells how many of the special operations
18655 \.
{\#\
AT!}, \.
{\
AT!}, and \.
{\
AT!\#
} are to be replaced by suffix parameters.
18656 When such parameters are present
, they are called \.
{(SUFFIX0
)},
18657 \.
{(SUFFIX1
)}, and \.
{(SUFFIX2
)}.
18660 typedef struct mp_subst_list_item
{
18661 mp_name_type_type info_mod
;
18662 quarterword value_mod
;
18664 halfword value_data
;
18665 struct mp_subst_list_item
*link
;
18666 } mp_subst_list_item
;
18670 static mp_node mp_scan_toks
(MP mp
, mp_command_code terminator
,
18671 mp_subst_list_item
* subst_list
, mp_node tail_end
,
18672 quarterword suffix_count
) {
18673 mp_node p
; /* tail of the token list being built
*/
18674 mp_subst_list_item
*q
= NULL; /* temporary for link management
*/
18675 integer balance
; /* left delimiters minus right delimiters
*/
18677 quarterword cur_data_mod
= 0;
18680 mp_link
(mp-
>hold_head
) = NULL;
18684 if
(cur_sym
() != NULL) {
18685 @
<Substitute for |cur_sym|
, if it's on the |subst_list|@
>;
18686 if
(cur_cmd
() == terminator
) {
18687 @
<Adjust the balance
; |break| if it's zero@
>;
18688 } else if
(cur_cmd
() == mp_macro_special
) {
18689 /* Handle quoted symbols
, \.
{\#\
AT!}, \.
{\
AT!}, or \.
{\
AT!\#
} */
18690 if
(cur_mod
() == quote
) {
18692 } else if
(cur_mod
() <= suffix_count
) {
18693 cur_data
= cur_mod
() - 1;
18694 cur_data_mod
= mp_suffix_sym
;
18698 if
(cur_data
!= -1) {
18699 mp_node pp
= mp_get_symbolic_node
(mp
);
18700 set_mp_sym_info
(pp
, cur_data
);
18701 mp_name_type
(pp
) = cur_data_mod
;
18704 mp_link
(p
) = mp_cur_tok
(mp
);
18708 mp_link
(p
) = tail_end
;
18709 while
(subst_list
) {
18710 q
= subst_list-
>link
;
18711 xfree
(subst_list
);
18714 return mp_link
(mp-
>hold_head
);
18719 void mp_print_sym
(mp_sym sym
) {
18720 printf
("{type = %d, v = {type = %d, data = {indep = {scale = %d, serial = %d}, n = %d, str = %p, sym = %p, node = %p, p = %p}}, text = %p}\n", sym-
>type
, sym-
>v.type
, (int
)sym-
>v.data.indep.scale
, (int
)sym-
>v.data.indep.serial
,
18721 sym-
>v.data.n.type
, sym-
>v.data.str
, sym-
>v.data.sym
, sym-
>v.data.node
, sym-
>v.data.p
, sym-
>text
);
18722 if
(is_number
(sym-
>v.data.n
)) {
18723 mp_number n
= sym-
>v.data.n
;
18724 printf
("{data = {dval = %f, val = %d}, type = %d}\n", n.data.dval
, n.data.val
, n.type
);
18726 if
(sym-
>text
!= NULL) {
18727 mp_string t
= sym-
>text
;
18728 printf
("{str = %p \"%s\
", len = %d, refs = %d}\n", t-
>str
, t-
>str
, (int
)t-
>len
, t-
>refs
);
18734 void mp_print_sym
(mp_sym sym
) ;
18736 @ @
<Substitute for |cur_sym|...@
>=
18739 while
(q
!= NULL) {
18740 if
(q-
>info
== cur_sym
() && q->info_mod == cur_sym_mod()) {
18741 cur_data
= q-
>value_data
;
18742 cur_data_mod
= q-
>value_mod
;
18743 set_cur_cmd
((mp_variable_type
)mp_relax
);
18751 @ @
<Adjust the balance
; |break| if it's zero@
>=
18752 if
(cur_mod
() > 0) {
18761 @ Four commands are intended to be used only within macro texts
: \
&{quote},
18762 \.
{\#\
AT!}, \.
{\
AT!}, and \.
{\
AT!\#
}. They are variants of a single command
18763 code called |macro_special|.
18765 @d quote
0 /* |macro_special| modifier for \
&{quote} */
18766 @d macro_prefix
1 /* |macro_special| modifier for \.
{\#\
AT!} */
18767 @d macro_at
2 /* |macro_special| modifier for \.
{\
AT!} */
18768 @d macro_suffix
3 /* |macro_special| modifier for \.
{\
AT!\#
} */
18771 mp_primitive
(mp
, "quote", mp_macro_special
, quote
);
18772 @
:quote_
}{\
&{quote} primitive@>;
18773 mp_primitive
(mp
, "#@@", mp_macro_special
, macro_prefix
);
18774 @
:]]]\#\
AT!_
}{\.
{\#\
AT!} primitive@
>;
18775 mp_primitive
(mp
, "@@", mp_macro_special
, macro_at
);
18776 @
:]]]\
AT!_
}{\.
{\
AT!} primitive@
>;
18777 mp_primitive
(mp
, "@@#", mp_macro_special
, macro_suffix
);
18778 @
:]]]\
AT!\#_
}{\.
{\
AT!\#
} primitive@
>
18781 @ @
<Cases of |print_cmd...@
>=
18782 case mp_macro_special
:
18785 mp_print
(mp
, "#@@");
18788 mp_print_char
(mp
, xord
('@@'
));
18791 mp_print
(mp
, "@@#");
18794 mp_print
(mp
, "quote");
18799 @ Here is a routine that's used whenever a token will be redefined. If
18800 the user's token is unredefinable
, the `|mp-
>frozen_inaccessible|' token is
18801 substituted
; the latter is redefinable but essentially impossible to use
,
18802 hence \MP's tables won't get fouled up.
18805 static void mp_get_symbol
(MP mp
) { /* sets |cur_sym| to a safe symbol
*/
18808 if
((cur_sym
() == NULL) || mp_is_frozen
(mp
, cur_sym
())) {
18809 const char
*hlp
[] = {
18810 "Sorry: You can\'t redefine a number, string, or expr.",
18811 "I've inserted an inaccessible symbol so that your",
18812 "definition will be completed without mixing me up too badly.",
18814 if
(cur_sym
() != NULL)
18815 hlp
[0] = "Sorry: You can\'t redefine my error-recovery tokens.";
18816 else if
(cur_cmd
() == mp_string_token
)
18817 delete_str_ref
(cur_mod_str
());
18818 set_cur_sym
(mp-
>frozen_inaccessible
);
18819 mp_ins_error
(mp
, "Missing symbolic token inserted", hlp
, true
);
18820 @.Missing symbolic token...@
>;
18826 @ Before we actually redefine a symbolic token
, we need to clear away its
18827 former value
, if it was a variable. The following stronger version of
18828 |get_symbol| does that.
18831 static void mp_get_clear_symbol
(MP mp
) {
18832 mp_get_symbol
(mp
);
18833 mp_clear_symbol
(mp
, cur_sym
(), false
);
18837 @ Here's another little subroutine
; it checks that an equals sign
18838 or assignment sign comes along at the proper place in a macro definition.
18841 static void mp_check_equals
(MP mp
) {
18842 if
(cur_cmd
() != mp_equals
)
18843 if
(cur_cmd
() != mp_assignment
) {
18844 const char
*hlp
[] = {
18845 "The next thing in this `def' should have been `=',",
18846 "because I've already looked at the definition heading.",
18847 "But don't worry; I'll pretend that an equals sign",
18848 "was present. Everything from here to `enddef'",
18849 "will be the replacement text of this macro.",
18851 mp_back_error
(mp
, "Missing `=' has been inserted", hlp
, true
);
18857 @ A \
&{primarydef}, \&{secondarydef}, or \&{tertiarydef} is rather easily
18858 handled now that we have |scan_toks|. In this case there are
18859 two parameters
, which will be \.
{EXPR0
} and \.
{EXPR1
}.
18862 static void mp_make_op_def
(MP mp
) {
18863 mp_command_code m
; /* the type of definition
*/
18864 mp_node q
, r
; /* for list manipulation
*/
18865 mp_subst_list_item
*qm
= NULL, *qn
= NULL;
18867 mp_get_symbol
(mp
);
18868 qm
= xmalloc
(1, sizeof
(mp_subst_list_item
));
18870 qm-
>info
= cur_sym
();
18871 qm-
>info_mod
= cur_sym_mod
();
18872 qm-
>value_data
= 0;
18873 qm-
>value_mod
= mp_expr_sym
;
18874 mp_get_clear_symbol
(mp
);
18875 mp-
>warning_info
= cur_sym
();
18876 mp_get_symbol
(mp
);
18877 qn
= xmalloc
(1, sizeof
(mp_subst_list_item
));
18879 qn-
>info
= cur_sym
();
18880 qn-
>info_mod
= cur_sym_mod
();
18881 qn-
>value_data
= 1;
18882 qn-
>value_mod
= mp_expr_sym
;
18884 mp_check_equals
(mp
);
18885 mp-
>scanner_status
= op_defining
;
18886 q
= mp_get_symbolic_node
(mp
);
18887 set_ref_count
(q
, 0);
18888 r
= mp_get_symbolic_node
(mp
);
18890 set_mp_sym_info
(r
, mp_general_macro
);
18891 mp_name_type
(r
) = mp_macro_sym
;
18892 mp_link
(r
) = mp_scan_toks
(mp
, mp_macro_def
, qn
, NULL, 0);
18893 mp-
>scanner_status
= normal
;
18894 set_eq_type
(mp-
>warning_info
, m
);
18895 set_equiv_node
(mp-
>warning_info
, q
);
18896 mp_get_x_next
(mp
);
18900 @ Parameters to macros are introduced by the keywords \
&{expr},
18901 \
&{suffix}, \&{text}, \&{primary}, \&{secondary}, and \&{tertiary}.
18904 mp_primitive
(mp
, "expr", mp_param_type
, mp_expr_param
);
18905 @
:expr_
}{\
&{expr} primitive@>;
18906 mp_primitive
(mp
, "suffix", mp_param_type
, mp_suffix_param
);
18907 @
:suffix_
}{\
&{suffix} primitive@>;
18908 mp_primitive
(mp
, "text", mp_param_type
, mp_text_param
);
18909 @
:text_
}{\
&{text} primitive@>;
18910 mp_primitive
(mp
, "primary", mp_param_type
, mp_primary_macro
);
18911 @
:primary_
}{\
&{primary} primitive@>;
18912 mp_primitive
(mp
, "secondary", mp_param_type
, mp_secondary_macro
);
18913 @
:secondary_
}{\
&{secondary} primitive@>;
18914 mp_primitive
(mp
, "tertiary", mp_param_type
, mp_tertiary_macro
);
18915 @
:tertiary_
}{\
&{tertiary} primitive@>
18918 @ @
<Cases of |print_cmd...@
>=
18919 case mp_param_type
:
18920 if
(m
== mp_expr_param
)
18921 mp_print
(mp
, "expr");
18922 else if
(m
== mp_suffix_param
)
18923 mp_print
(mp
, "suffix");
18924 else if
(m
== mp_text_param
)
18925 mp_print
(mp
, "text");
18926 else if
(m
== mp_primary_macro
)
18927 mp_print
(mp
, "primary");
18928 else if
(m
== mp_secondary_macro
)
18929 mp_print
(mp
, "secondary");
18931 mp_print
(mp
, "tertiary");
18934 @ Let's turn next to the more complex processing associated with \
&{def}
18935 and \
&{vardef}. When the following procedure is called, |cur_mod|
18936 should be either |start_def| or |var_def|.
18938 Note that although the macro scanner allows |def
= := enddef| and
18939 |def
:= = enddef|
; |def
= = enddef| and |def
:= := enddef| will generate
18940 an error because by the time the second of the two identical tokens is
18941 seen
, its meaning has already become undefined.
18944 static void mp_scan_def
(MP mp
) {
18945 int m
; /* the type of definition
*/
18946 int n
; /* the number of special suffix parameters
*/
18947 int k
; /* the total number of parameters
*/
18948 int c
; /* the kind of macro we're defining
*/
18949 mp_subst_list_item
*r
= NULL, *rp
= NULL; /* parameter-substitution list
*/
18950 mp_node q
; /* tail of the macro token list
*/
18951 mp_node p
; /* temporary storage
*/
18952 quarterword sym_type
; /* |expr_sym|
, |suffix_sym|
, or |text_sym|
*/
18953 mp_sym l_delim
, r_delim
; /* matching delimiters
*/
18955 c
= mp_general_macro
;
18956 mp_link
(mp-
>hold_head
) = NULL;
18957 q
= mp_get_symbolic_node
(mp
);
18958 set_ref_count
(q
, 0);
18960 /* Scan the token or variable to be defined
;
18961 set |n|
, |scanner_status|
, and |warning_info|
*/
18962 if
(m
== start_def
) {
18963 mp_get_clear_symbol
(mp
);
18964 mp-
>warning_info
= cur_sym
();
18966 mp-
>scanner_status
= op_defining
;
18968 set_eq_type
(mp-
>warning_info
, mp_defined_macro
);
18969 set_equiv_node
(mp-
>warning_info
, q
);
18970 } else
{ /* |var_def|
*/
18971 p
= mp_scan_declared_variable
(mp
);
18972 mp_flush_variable
(mp
, equiv_node
(mp_sym_sym
(p
)), mp_link
(p
), true
);
18973 mp-
>warning_info_node
= mp_find_variable
(mp
, p
);
18974 mp_flush_node_list
(mp
, p
);
18975 if
(mp-
>warning_info_node
== NULL) {
18976 /* Change to `\.
{a bad variable
}'
*/
18977 const char
*hlp
[] = {
18978 "After `vardef a' you can\'t say `vardef a.b'.",
18979 "So I'll have to discard this definition.",
18981 mp_error
(mp
, "This variable already starts with a macro", hlp
, true
);
18982 mp-
>warning_info_node
= mp-
>bad_vardef
;
18984 mp-
>scanner_status
= var_defining
;
18986 if
(cur_cmd
() == mp_macro_special
&& cur_mod() == macro_suffix) { /* \.{\AT!\#} */
18990 mp_type
(mp-
>warning_info_node
) = (quarterword
) (mp_unsuffixed_macro
- 2 + n
);
18991 /* |mp_suffixed_macro
=mp_unsuffixed_macro
+1|
*/
18992 set_value_node
(mp-
>warning_info_node
, q
);
18996 if
(cur_cmd
() == mp_left_delimiter
) {
18997 /* Absorb delimited parameters
, putting them into lists |q| and |r|
*/
18999 l_delim
= cur_sym
();
19000 r_delim
= equiv_sym
(cur_sym
());
19002 if
((cur_cmd
() == mp_param_type
) && (cur_mod() == mp_expr_param)) {
19003 sym_type
= mp_expr_sym
;
19004 } else if
((cur_cmd
() == mp_param_type
) && (cur_mod() == mp_suffix_param)) {
19005 sym_type
= mp_suffix_sym
;
19006 } else if
((cur_cmd
() == mp_param_type
) && (cur_mod() == mp_text_param)) {
19007 sym_type
= mp_text_sym
;
19009 const char
*hlp
[] = { "You should've had `expr' or `suffix' or `text' here.", NULL };
19010 mp_back_error
(mp
, "Missing parameter type; `expr' will be assumed", hlp
, true
);
19011 sym_type
= mp_expr_sym
;
19013 /* Absorb parameter tokens for type |sym_type|
*/
19015 mp_link
(q
) = mp_get_symbolic_node
(mp
);
19017 mp_name_type
(q
) = sym_type
;
19018 set_mp_sym_info
(q
, k
);
19019 mp_get_symbol
(mp
);
19020 rp
= xmalloc
(1, sizeof
(mp_subst_list_item
));
19022 rp-
>value_data
= k
;
19023 rp-
>value_mod
= sym_type
;
19024 rp-
>info
= cur_sym
();
19025 rp-
>info_mod
= cur_sym_mod
();
19026 mp_check_param_size
(mp
, k
);
19031 } while
(cur_cmd
() == mp_comma
);
19033 mp_check_delimiter
(mp
, l_delim
, r_delim
);
19035 } while
(cur_cmd
() == mp_left_delimiter
);
19038 if
(cur_cmd
() == mp_param_type
) {
19039 /* Absorb undelimited parameters
, putting them into list |r|
*/
19040 rp
= xmalloc
(1, sizeof
(mp_subst_list_item
));
19042 rp-
>value_data
= k
;
19043 if
(cur_mod
() == mp_expr_param
) {
19044 rp-
>value_mod
= mp_expr_sym
;
19046 } else if
(cur_mod
() == mp_suffix_param
) {
19047 rp-
>value_mod
= mp_suffix_sym
;
19048 c
= mp_suffix_macro
;
19049 } else if
(cur_mod
() == mp_text_param
) {
19050 rp-
>value_mod
= mp_text_sym
;
19054 rp-
>value_mod
= mp_expr_sym
;
19056 mp_check_param_size
(mp
, k
);
19058 mp_get_symbol
(mp
);
19059 rp-
>info
= cur_sym
();
19060 rp-
>info_mod
= cur_sym_mod
();
19064 if
(c
== mp_expr_macro
) {
19065 if
(cur_cmd
() == mp_of_token
) {
19067 rp
= xmalloc
(1, sizeof
(mp_subst_list_item
));
19069 mp_check_param_size
(mp
, k
);
19070 rp-
>value_data
= k
;
19071 rp-
>value_mod
= mp_expr_sym
;
19072 mp_get_symbol
(mp
);
19073 rp-
>info
= cur_sym
();
19074 rp-
>info_mod
= cur_sym_mod
();
19081 mp_check_equals
(mp
);
19082 p
= mp_get_symbolic_node
(mp
);
19083 set_mp_sym_info
(p
, c
);
19084 mp_name_type
(p
) = mp_macro_sym
;
19086 /* Attach the replacement text to the tail of node |p|
*/
19087 /* We don't put `|mp-
>frozen_end_group|' into the replacement text of
19088 a \
&{vardef}, because the user may want to redefine `\.{endgroup}'. */
19089 if
(m
== start_def
) {
19090 mp_link
(p
) = mp_scan_toks
(mp
, mp_macro_def
, r
, NULL, (quarterword
) n
);
19092 mp_node qq
= mp_get_symbolic_node
(mp
);
19093 set_mp_sym_sym
(qq
, mp-
>bg_loc
);
19095 p
= mp_get_symbolic_node
(mp
);
19096 set_mp_sym_sym
(p
, mp-
>eg_loc
);
19097 mp_link
(qq
) = mp_scan_toks
(mp
, mp_macro_def
, r
, p
, (quarterword
) n
);
19099 if
(mp-
>warning_info_node
== mp-
>bad_vardef
)
19100 mp_flush_token_list
(mp
, value_node
(mp-
>bad_vardef
));
19101 mp-
>scanner_status
= normal
;
19102 mp_get_x_next
(mp
);
19107 mp_sym eg_loc
; /* hash addresses of `\.
{begingroup
}' and `\.
{endgroup
}'
*/
19109 @ @
<Initialize table entries@
>=
19110 mp-
>bad_vardef
= mp_get_value_node
(mp
);
19111 mp_name_type
(mp-
>bad_vardef
) = mp_root
;
19112 set_value_sym
(mp-
>bad_vardef
, mp-
>frozen_bad_vardef
);
19114 @ @
<Free table entries@
>=
19115 mp_free_value_node
(mp
, mp-
>bad_vardef
);
19118 @
* Expanding the next token.
19119 Only a few command codes |
<min_command| can possibly be returned by
19120 |get_t_next|
; in increasing order
, they are
19121 |if_test|
, |fi_or_else|
, |input|
, |iteration|
, |repeat_loop|
,
19122 |exit_test|
, |relax|
, |scan_tokens|
, |run_script|
, |expand_after|
, and |defined_macro|.
19124 \MP\ usually gets the next token of input by saying |get_x_next|. This is
19125 like |get_t_next| except that it keeps getting more tokens until
19126 finding |cur_cmd
>=min_command|. In other words
, |get_x_next| expands
19127 macros and removes conditionals or iterations or input instructions that
19130 It follows that |get_x_next| might invoke itself recursively. In fact
,
19131 there is massive recursion
, since macro expansion can involve the
19132 scanning of arbitrarily complex expressions
, which in turn involve
19133 macro expansion and conditionals
, etc.
19136 Therefore it's necessary to declare a whole bunch of |forward|
19137 procedures at this point
, and to insert some other procedures
19138 that will be invoked by |get_x_next|.
19141 static void mp_scan_primary
(MP mp
);
19142 static void mp_scan_secondary
(MP mp
);
19143 static void mp_scan_tertiary
(MP mp
);
19144 static void mp_scan_expression
(MP mp
);
19145 static void mp_scan_suffix
(MP mp
);
19146 static void mp_pass_text
(MP mp
);
19147 static void mp_conditional
(MP mp
);
19148 static void mp_start_input
(MP mp
);
19149 static void mp_begin_iteration
(MP mp
);
19150 static void mp_resume_iteration
(MP mp
);
19151 static void mp_stop_iteration
(MP mp
);
19153 @ A recursion depth counter is used to discover infinite recursions.
19154 (Near
) infinite recursion is a problem because it translates into
19155 C function calls that eat up the available call stack. A better solution
19156 would be to depend on signal trapping
, but that is problematic when
19157 Metapost is used as a library.
19160 int expand_depth_count
; /* current expansion depth
*/
19161 int expand_depth
; /* current expansion depth
*/
19163 @ The limit is set at |
10000|
, which should be enough to allow
19164 normal usages of metapost while preventing the most obvious
19165 crashes on most all operating systems
, but the value can be
19166 raised if the runtime system allows a larger C stack.
19167 @^system dependencies@
>
19169 @
<Set initial...@
>=
19170 mp-
>expand_depth
= 10000;
19172 @ Even better would be if the system allows discovery of the amount of
19173 space available on the call stack.
19174 @^system dependencies@
>
19176 In any case
, when the limit is crossed
, that is a fatal error.
19178 @d check_expansion_depth
() if
(++mp-
>expand_depth_count
>= mp-
>expand_depth
)
19179 mp_expansion_depth_error
(mp
)
19182 static void mp_expansion_depth_error
(MP mp
) {
19183 const char
*hlp
[] = {
19184 "Recursive macro expansion cannot be unlimited because of runtime",
19185 "stack constraints. The limit is 10000 recursion levels in total.",
19187 if
( mp-
>interaction
==mp_error_stop_mode
)
19188 mp-
>interaction
=mp_scroll_mode
; /* no more interaction
*/
19189 if
( mp-
>log_opened
)
19190 mp_error
(mp
, "Maximum expansion depth reached", hlp
, true
);
19191 mp-
>history
=mp_fatal_error_stop
;
19196 @ An auxiliary subroutine called |expand| is used by |get_x_next|
19197 when it has to do exotic expansion commands.
19200 static void mp_expand
(MP mp
) {
19201 size_t k
; /* something that we hope is |
<=buf_size|
*/
19202 size_t j
; /* index into |str_pool|
*/
19203 check_expansion_depth
();
19204 if
(number_greater
(internal_value
(mp_tracing_commands
), unity_t
))
19205 if
(cur_cmd
() != mp_defined_macro
)
19207 switch
(cur_cmd
()) {
19209 mp_conditional
(mp
); /* this procedure is discussed in Part
36 below
*/
19211 case mp_fi_or_else
:
19212 @
<Terminate the current conditional and skip to \
&{fi}@>;
19215 @
<Initiate or terminate input from a file@
>;
19218 if
(cur_mod
() == end_for
) {
19219 @
<Scold the user for having an extra \
&{endfor}@>;
19221 mp_begin_iteration
(mp
); /* this procedure is discussed in Part
37 below
*/
19224 case mp_repeat_loop
:
19228 @
<Exit a loop if the proper time has come@
>;
19232 case mp_expand_after
:
19233 @
<Expand the token after the next token@
>;
19235 case mp_scan_tokens
:
19236 @
<Put a string into the input buffer@
>;
19239 @
<Put a script result string into the input buffer@
>;
19242 @
<Put a maketext result string into the input buffer@
>;
19244 case mp_defined_macro
:
19245 mp_macro_call
(mp
, cur_mod_node
(), NULL, cur_sym
());
19248 break
; /* make the compiler happy
*/
19249 }; /* there are no other cases
*/
19250 mp-
>expand_depth_count--
;
19254 @ @
<Scold the user...@
>=
19256 const char
*hlp
[] = {
19257 "I'm not currently working on a for loop,",
19258 "so I had better not try to end anything.",
19260 mp_error
(mp
, "Extra `endfor'", hlp
, true
);
19261 @.Extra `endfor'@
>;
19265 @ The processing of \
&{input} involves the |start_input| subroutine,
19266 which will be declared later
; the processing of \
&{endinput} is trivial.
19269 mp_primitive
(mp
, "input", mp_input
, 0);
19270 @
:input_
}{\
&{input} primitive@>;
19271 mp_primitive
(mp
, "endinput", mp_input
, 1);
19272 @
:end_input_
}{\
&{endinput} primitive@>
19275 @ @
<Cases of |print_cmd_mod|...@
>=
19278 mp_print
(mp
, "input");
19280 mp_print
(mp
, "endinput");
19283 @ @
<Initiate or terminate input...@
>=
19285 mp-
>force_eof
= true
;
19287 mp_start_input
(mp
)
19290 @ We'll discuss the complicated parts of loop operations later. For now
19291 it suffices to know that there's a global variable called |loop_ptr|
19292 that will be |
NULL| if no loop is in progress.
19296 while
(token_state
&& (nloc == NULL))
19297 mp_end_token_list
(mp
); /* conserve stack space
*/
19298 if
(mp-
>loop_ptr
== NULL) {
19299 const char
*hlp
[] = {
19300 "I'm confused; after exiting from a loop, I still seem",
19301 "to want to repeat it. I'll try to forget the problem.",
19303 mp_error
(mp
, "Lost loop", hlp
, true
);
19306 mp_resume_iteration
(mp
); /* this procedure is in Part
37 below
*/
19311 @ @
<Exit a loop if the proper time has come@
>=
19313 mp_get_boolean
(mp
);
19314 if
(number_greater
(internal_value
(mp_tracing_commands
), unity_t
))
19315 mp_show_cmd_mod
(mp
, mp_nullary
, cur_exp_value_boolean
());
19316 if
(cur_exp_value_boolean
() == mp_true_code
) {
19317 if
(mp-
>loop_ptr
== NULL) {
19318 const char
*hlp
[] = {
19319 "Why say `exitif' when there's nothing to exit from?",
19321 if
(cur_cmd
() == mp_semicolon
)
19322 mp_error
(mp
, "No loop is in progress", hlp
, true
);
19324 mp_back_error
(mp
, "No loop is in progress", hlp
, true
);
19325 @.No loop is in progress@
>;
19327 @
<Exit prematurely from an iteration@
>;
19329 } else if
(cur_cmd
() != mp_semicolon
) {
19330 const char
*hlp
[] = {
19331 "After `exitif <boolean exp>' I expect to see a semicolon.",
19332 "I shall pretend that one was there.",
19334 mp_back_error
(mp
, "Missing `;' has been inserted", hlp
, true
);
19340 @ Here we use the fact that |forever_text| is the only |token_type| that
19341 is less than |loop_text|.
19343 @
<Exit prematurely...@
>=
19348 mp_end_file_reading
(mp
);
19350 if
(token_type
<= loop_text
)
19352 mp_end_token_list
(mp
);
19354 } while
(p
== NULL);
19355 if
(p
!= mp-
>loop_ptr-
>info
)
19356 mp_fatal_error
(mp
, "*** (loop confusion)");
19357 @.loop confusion@
>;
19358 mp_stop_iteration
(mp
); /* this procedure is in Part
34 below
*/
19362 @ @
<Expand the token after the next token@
>=
19366 p
= mp_cur_tok
(mp
);
19368 if
(cur_cmd
() < mp_min_command
)
19371 mp_back_input
(mp
);
19376 @ @
<Put a string into the input buffer@
>=
19378 mp_get_x_next
(mp
);
19379 mp_scan_primary
(mp
);
19380 if
(mp-
>cur_exp.type
!= mp_string_type
) {
19382 const char
*hlp
[] = {
19383 "I'm going to flush this expression, since",
19384 "scantokens should be followed by a known string.",
19386 memset
(&new_expr,0,sizeof(mp_value));
19387 new_number
(new_expr.data.n
);
19388 mp_disp_err
(mp
, NULL);
19389 mp_back_error
(mp
, "Not a string", hlp
, true
);
19391 mp_get_x_next
(mp
);
19392 mp_flush_cur_exp
(mp
, new_expr
);
19394 mp_back_input
(mp
);
19395 if
(cur_exp_str
()->len
> 0)
19396 @
<Pretend we're reading a new one-line file@
>;
19400 @ @
<Run a script@
>=
19403 size_t size
= strlen
(s
);
19404 memset
(&new_expr,0,sizeof(mp_value));
19405 new_number
(new_expr.data.n
);
19406 mp_begin_file_reading
(mp
);
19408 mp-
>last
= mp-
>first
;
19409 k
= mp-
>first
+ size
;
19410 if
(k
>= mp-
>max_buf_stack
) {
19411 while
(k
>= mp-
>buf_size
) {
19412 mp_reallocate_buffer
(mp
, (mp-
>buf_size
+ (mp-
>buf_size
/ 4)));
19414 mp-
>max_buf_stack
= k
+ 1;
19416 limit
= (halfword
) k
;
19417 (void
) memcpy
((mp-
>buffer
+ mp-
>first
), s
, size
);
19419 mp-
>buffer
[limit
] = xord
('
%'
);
19420 mp-
>first
= (size_t
) (limit
+ 1);
19422 mp_flush_cur_exp
(mp
, new_expr
);
19425 @ @
<Put a script result string into the input buffer@
>=
19428 if
(mp-
>extensions
== 0) {
19431 mp_get_x_next
(mp
);
19432 mp_scan_primary
(mp
);
19433 if
(mp-
>cur_exp.type
!= mp_string_type
) {
19435 const char
*hlp
[] = {
19436 "I'm going to flush this expression, since",
19437 "runscript should be followed by a known string.",
19439 memset
(&new_expr,0,sizeof(mp_value));
19440 new_number
(new_expr.data.n
);
19441 mp_disp_err
(mp
, NULL);
19442 mp_back_error
(mp
, "Not a string", hlp
, true
);
19444 mp_get_x_next
(mp
);
19445 mp_flush_cur_exp
(mp
, new_expr
);
19447 mp_back_input
(mp
);
19448 if
(cur_exp_str
()->len
> 0) {
19450 char
*s
= mp-
>run_script
(mp
,(const char
*) cur_exp_str
()->str
) ;
19456 @ @
<Pass btex ... etex to script@
>=
19459 while
((loc
< limit
- 4) && (mp->buffer[loc] == ' ')) {
19463 if
(mp-
>buffer
[loc-1
] == ' '
) {
19466 while
(loc
< limit
- 5) {
19467 if
(mp-
>buffer
[loc
] == ' '
) {
19469 if
(mp-
>buffer
[loc
] == 'e'
) {
19471 if
(mp-
>buffer
[loc
] == 't'
) {
19473 if
(mp-
>buffer
[loc
] == 'e'
) {
19475 if
(mp-
>buffer
[loc
] == 'x'
) {
19480 size
= loc
- first
+ 1 - 4 ;
19484 while
((size
> 1) && (mp->buffer[first+size-1] == ' ')) {
19488 txt
= malloc
(size
+1);
19490 (void
) memcpy
(txt
, mp-
>buffer
+ first
, size
);
19494 s
= mp-
>make_text
(mp
,txt
,(cur_mod
() == verbatim_code
)) ; /* we could pass the size
*/
19511 @ @
<Put a maketext result string into the input buffer@
>=
19513 if
(mp-
>extensions
== 0) {
19516 mp_get_x_next
(mp
);
19517 mp_scan_primary
(mp
);
19518 if
(mp-
>cur_exp.type
!= mp_string_type
) {
19520 const char
*hlp
[] = {
19521 "I'm going to flush this expression, since",
19522 "makete should be followed by a known string.",
19524 memset
(&new_expr,0,sizeof(mp_value));
19525 new_number
(new_expr.data.n
);
19526 mp_disp_err
(mp
, NULL);
19527 mp_back_error
(mp
, "Not a string", hlp
, true
);
19529 mp_get_x_next
(mp
);
19530 mp_flush_cur_exp
(mp
, new_expr
);
19532 mp_back_input
(mp
);
19533 if
(cur_exp_str
()->len
> 0) {
19535 char
*s
= mp-
>make_text
(mp
,(const char
*) cur_exp_str
()->str
,0) ;
19541 @ @
<Pretend we're reading a new one-line file@
>=
19544 memset
(&new_expr,0,sizeof(mp_value));
19545 new_number
(new_expr.data.n
);
19546 mp_begin_file_reading
(mp
);
19548 k
= mp-
>first
+ (size_t
) cur_exp_str
()->len
;
19549 if
(k
>= mp-
>max_buf_stack
) {
19550 while
(k
>= mp-
>buf_size
) {
19551 mp_reallocate_buffer
(mp
, (mp-
>buf_size
+ (mp-
>buf_size
/ 4)));
19553 mp-
>max_buf_stack
= k
+ 1;
19556 limit
= (halfword
) k
;
19557 while
(mp-
>first
< (size_t
) limit
) {
19558 mp-
>buffer
[mp-
>first
] = *(cur_exp_str
()->str
+ j
);
19562 mp-
>buffer
[limit
] = xord
('
%'
);
19563 mp-
>first
= (size_t
) (limit
+ 1);
19565 mp_flush_cur_exp
(mp
, new_expr
);
19569 @ Here finally is |get_x_next|.
19571 The expression scanning routines to be considered later
19572 communicate via the global quantities |cur_type| and |cur_exp|
;
19573 we must be very careful to save and restore these quantities while
19574 macros are being expanded.
19578 static void mp_get_x_next
(MP mp
);
19581 void mp_get_x_next
(MP mp
) {
19582 mp_node save_exp
; /* a capsule to save |cur_type| and |cur_exp|
*/
19584 if
(cur_cmd
() < mp_min_command
) {
19585 save_exp
= mp_stash_cur_exp
(mp
);
19587 if
(cur_cmd
() == mp_defined_macro
)
19588 mp_macro_call
(mp
, cur_mod_node
(), NULL, cur_sym
());
19592 } while
(cur_cmd
() < mp_min_command
);
19593 mp_unstash_cur_exp
(mp
, save_exp
); /* that restores |cur_type| and |cur_exp|
*/
19598 @ Now let's consider the |macro_call| procedure
, which is used to start up
19599 all user-defined macros. Since the arguments to a macro might be expressions
,
19600 |macro_call| is recursive.
19603 The first parameter to |macro_call| points to the reference count of the
19604 token list that defines the macro. The second parameter contains any
19605 arguments that have already been parsed
(see below
). The third parameter
19606 points to the symbolic token that names the macro. If the third parameter
19607 is |
NULL|
, the macro was defined by \
&{vardef}, so its name can be
19608 reconstructed from the prefix and ``at'' arguments found within the
19611 What is this second parameter? It's simply a linked list of symbolic items
,
19612 whose |info| fields point to the arguments. In other words
, if |arg_list
=NULL|
,
19613 no arguments have been scanned yet
; otherwise |mp_info
(arg_list
)| points to
19614 the first scanned argument
, and |mp_link
(arg_list
)| points to the list of
19615 further arguments
(if any
).
19617 Arguments of type \
&{expr} are so-called capsules, which we will
19618 discuss later when we concentrate on expressions
; they can be
19619 recognized easily because their |link| field is |void|. Arguments of type
19620 \
&{suffix} and \&{text} are token lists without reference counts.
19622 @ After argument scanning is complete
, the arguments are moved to the
19623 |param_stack|.
(They can't be put on that stack any sooner
, because
19624 the stack is growing and shrinking in unpredictable ways as more arguments
19625 are being acquired.
) Then the macro body is fed to the scanner
; i.e.
,
19626 the replacement text of the macro is placed at the top of the \MP's
19627 input stack
, so that |get_t_next| will proceed to read it next.
19630 static void mp_macro_call
(MP mp
, mp_node def_ref
, mp_node arg_list
,
19631 mp_sym macro_name
);
19634 void mp_macro_call
(MP mp
, mp_node def_ref
, mp_node arg_list
, mp_sym macro_name
) {
19635 /* invokes a user-defined control sequence
*/
19636 mp_node r
; /* current node in the macro's token list
*/
19637 mp_node p
, q
; /* for list manipulation
*/
19638 integer n
; /* the number of arguments
*/
19639 mp_node tail
= 0; /* tail of the argument list
*/
19640 mp_sym l_delim
= NULL, r_delim
= NULL; /* a delimiter pair
*/
19641 r
= mp_link
(def_ref
);
19642 add_mac_ref
(def_ref
);
19643 if
(arg_list
== NULL) {
19646 @
<Determine the number |n| of arguments already supplied
,
19647 and set |tail| to the tail of |arg_list|@
>;
19649 if
(number_positive
(internal_value
(mp_tracing_macros
))) {
19650 @
<Show the text of the macro being expanded
, and the existing arguments@
>;
19652 @
<Scan the remaining arguments
, if any
; set |r| to the first token
19653 of the replacement text@
>;
19654 @
<Feed the arguments and replacement text to the scanner@
>;
19658 @ @
<Show the text of the macro...@
>=
19659 mp_begin_diagnostic
(mp
);
19661 mp_print_macro_name
(mp
, arg_list
, macro_name
);
19663 mp_print
(mp
, "@@#"); /* indicate a suffixed macro
*/
19664 mp_show_macro
(mp
, def_ref
, NULL, 100000);
19665 if
(arg_list
!= NULL) {
19669 q
= (mp_node
)mp_sym_sym
(p
);
19670 mp_print_arg
(mp
, q
, n
, 0, 0);
19673 } while
(p
!= NULL);
19675 mp_end_diagnostic
(mp
, false
)
19678 @ @
<Declarations@
>=
19679 static void mp_print_macro_name
(MP mp
, mp_node a
, mp_sym n
);
19682 void mp_print_macro_name
(MP mp
, mp_node a
, mp_sym n
) {
19683 mp_node p
, q
; /* they traverse the first part of |a|
*/
19687 p
= (mp_node
)mp_sym_sym
(a
);
19689 mp_print_text
(mp_sym_sym
((mp_node
)mp_sym_sym
(mp_link
(a
))));
19692 while
(mp_link
(q
) != NULL)
19694 mp_link
(q
) = (mp_node
)mp_sym_sym
(mp_link
(a
));
19695 mp_show_token_list
(mp
, p
, NULL, 1000, 0);
19696 mp_link
(q
) = NULL;
19702 @ @
<Declarations@
>=
19703 static void mp_print_arg
(MP mp
, mp_node q
, integer n
, halfword b
,
19707 void mp_print_arg
(MP mp
, mp_node q
, integer n
, halfword b
, quarterword bb
) {
19708 if
(q
&& mp_link (q) == MP_VOID) {
19709 mp_print_nl
(mp
, "(EXPR");
19711 if
((bb
< mp_text_sym
) && (b != mp_text_macro))
19712 mp_print_nl
(mp
, "(SUFFIX");
19714 mp_print_nl
(mp
, "(TEXT");
19716 mp_print_int
(mp
, n
);
19717 mp_print
(mp
, ")<-");
19718 if
(q
&& mp_link (q) == MP_VOID)
19719 mp_print_exp
(mp
, q
, 1);
19721 mp_show_token_list
(mp
, q
, NULL, 1000, 0);
19725 @ @
<Determine the number |n| of arguments already supplied...@
>=
19729 while
(mp_link
(tail
) != NULL) {
19731 tail
= mp_link
(tail
);
19736 @ @
<Scan the remaining arguments
, if any
; set |r|...@
>=
19737 set_cur_cmd
(mp_comma
+ 1); /* anything |
<>comma| will do
*/
19738 while
(mp_name_type
(r
) == mp_expr_sym ||
19739 mp_name_type
(r
) == mp_suffix_sym || mp_name_type
(r
) == mp_text_sym
) {
19740 @
<Scan the delimited argument represented by |mp_sym_info
(r
)|@
>;
19743 if
(cur_cmd
() == mp_comma
) {
19745 const char
*hlp
[] = {
19746 "I'm going to assume that the comma I just read was a",
19747 "right delimiter, and then I'll begin expanding the macro.",
19748 "You might want to delete some tokens before continuing.",
19751 int old_setting
= mp-
>selector
;
19752 mp-
>selector
= new_string
;
19753 mp_print_macro_name
(mp
, arg_list
, macro_name
);
19754 rname
= mp_make_string
(mp
);
19755 mp-
>selector
= old_setting
;
19756 mp_snprintf
(msg
, 256, "Too many arguments to %s; Missing `%s' has been inserted",
19757 mp_str
(mp
, rname
), mp_str
(mp
, text
(r_delim
)));
19758 delete_str_ref
(rname
);
19759 @.Too many arguments...@
>;
19760 @.Missing `
)'...@
>;
19761 mp_error
(mp
, msg
, hlp
, true
);
19763 if
(mp_sym_info
(r
) != mp_general_macro
) {
19764 @
<Scan undelimited argument
(s
)@
>;
19769 @ At this point
, the reader will find it advisable to review the explanation
19770 of token list format that was presented earlier
, paying special attention to
19771 the conventions that apply only at the beginning of a macro's token list.
19773 On the other hand
, the reader will have to take the expression-parsing
19774 aspects of the following program on faith
; we will explain |cur_type|
19775 and |cur_exp| later.
(Several things in this program depend on each other
,
19776 and it's necessary to jump into the circle somewhere.
)
19778 @
<Scan the delimited argument represented by |mp_sym_info
(r
)|@
>=
19779 if
(cur_cmd
() != mp_comma
) {
19780 mp_get_x_next
(mp
);
19781 if
(cur_cmd
() != mp_left_delimiter
) {
19783 const char
*hlp
[] = {
19784 "That macro has more parameters than you thought.",
19785 "I'll continue by pretending that each missing argument",
19786 "is either zero or null.",
19789 int old_setting
= mp-
>selector
;
19790 mp-
>selector
= new_string
;
19791 mp_print_macro_name
(mp
, arg_list
, macro_name
);
19792 sname
= mp_make_string
(mp
);
19793 mp-
>selector
= old_setting
;
19794 mp_snprintf
(msg
, 256, "Missing argument to %s", mp_str
(mp
, sname
));
19795 @.Missing argument...@
>;
19796 delete_str_ref
(sname
);
19797 if
(mp_name_type
(r
) == mp_suffix_sym || mp_name_type
(r
) == mp_text_sym
) {
19798 set_cur_exp_value_number
(zero_t
); /* todo
: this was |null|
*/
19799 mp-
>cur_exp.type
= mp_token_list
;
19801 set_cur_exp_value_number
(zero_t
);
19802 mp-
>cur_exp.type
= mp_known
;
19804 mp_back_error
(mp
, msg
, hlp
, true
);
19805 set_cur_cmd
((mp_variable_type
)mp_right_delimiter
);
19808 l_delim
= cur_sym
();
19809 r_delim
= equiv_sym
(cur_sym
());
19811 @
<Scan the argument represented by |mp_sym_info
(r
)|@
>;
19812 if
(cur_cmd
() != mp_comma
)
19813 @
<Check that the proper right delimiter was present@
>;
19815 @
<Append the current expression to |arg_list|@
>
19818 @ @
<Check that the proper right delim...@
>=
19819 if
((cur_cmd
() != mp_right_delimiter
) ||
(equiv_sym
(cur_sym
()) != l_delim
)) {
19820 if
(mp_name_type
(mp_link
(r
)) == mp_expr_sym ||
19821 mp_name_type
(mp_link
(r
)) == mp_suffix_sym ||
19822 mp_name_type
(mp_link
(r
)) == mp_text_sym
) {
19823 const char
*hlp
[] = {
19824 "I've finished reading a macro argument and am about to",
19825 "read another; the arguments weren't delimited correctly.",
19826 "You might want to delete some tokens before continuing.",
19828 mp_back_error
(mp
, "Missing `,' has been inserted", hlp
, true
);
19830 set_cur_cmd
((mp_variable_type
)mp_comma
);
19833 const char
*hlp
[] = {
19834 "I've gotten to the end of the macro parameter list.",
19835 "You might want to delete some tokens before continuing.",
19837 mp_snprintf
(msg
, 256, "Missing `%s' has been inserted", mp_str
(mp
, text
(r_delim
)));
19839 mp_back_error
(mp
, msg
, hlp
, true
);
19843 @ A \
&{suffix} or \&{text} parameter will have been scanned as
19844 a token list pointed to by |cur_exp|
, in which case we will have
19845 |cur_type
=token_list|.
19847 @
<Append the current expression to |arg_list|@
>=
19849 p
= mp_get_symbolic_node
(mp
);
19850 if
(mp-
>cur_exp.type
== mp_token_list
)
19851 set_mp_sym_sym
(p
, mp-
>cur_exp.data.node
);
19853 set_mp_sym_sym
(p
, mp_stash_cur_exp
(mp
));
19854 if
(number_positive
(internal_value
(mp_tracing_macros
))) {
19855 mp_begin_diagnostic
(mp
);
19856 mp_print_arg
(mp
, (mp_node
)mp_sym_sym
(p
), n
, mp_sym_info
(r
), mp_name_type
(r
));
19857 mp_end_diagnostic
(mp
, false
);
19859 if
(arg_list
== NULL) {
19862 mp_link
(tail
) = p
;
19869 @ @
<Scan the argument represented by |mp_sym_info
(r
)|@
>=
19870 if
(mp_name_type
(r
) == mp_text_sym
) {
19871 mp_scan_text_arg
(mp
, l_delim
, r_delim
);
19873 mp_get_x_next
(mp
);
19874 if
(mp_name_type
(r
) == mp_suffix_sym
)
19875 mp_scan_suffix
(mp
);
19877 mp_scan_expression
(mp
);
19881 @ The parameters to |scan_text_arg| are either a pair of delimiters
19882 or zero
; the latter case is for undelimited text arguments
, which
19883 end with the first semicolon or \
&{endgroup} or \&{end} that is not
19884 contained in a group.
19887 static void mp_scan_text_arg
(MP mp
, mp_sym l_delim
, mp_sym r_delim
);
19890 void mp_scan_text_arg
(MP mp
, mp_sym l_delim
, mp_sym r_delim
) {
19891 integer balance
; /* excess of |l_delim| over |r_delim|
*/
19892 mp_node p
; /* list tail
*/
19893 mp-
>warning_info
= l_delim
;
19894 mp-
>scanner_status
= absorbing
;
19897 mp_link
(mp-
>hold_head
) = NULL;
19900 if
(l_delim
== NULL) {
19901 @
<Adjust the balance for an undelimited argument
; |break| if done@
>;
19903 @
<Adjust the balance for a delimited argument
; |break| if done@
>;
19905 mp_link
(p
) = mp_cur_tok
(mp
);
19908 set_cur_exp_node
(mp_link
(mp-
>hold_head
));
19909 mp-
>cur_exp.type
= mp_token_list
;
19910 mp-
>scanner_status
= normal
;
19914 @ @
<Adjust the balance for a delimited argument...@
>=
19915 if
(cur_cmd
() == mp_right_delimiter
) {
19916 if
(equiv_sym
(cur_sym
()) == l_delim
) {
19921 } else if
(cur_cmd
() == mp_left_delimiter
) {
19922 if
(equiv_sym
(cur_sym
()) == r_delim
)
19926 @ @
<Adjust the balance for an undelimited...@
>=
19927 if
(mp_end_of_statement
) { /* |cur_cmd
=semicolon|
, |end_group|
, or |stop|
*/
19928 if
(balance
== 1) {
19931 if
(cur_cmd
() == mp_end_group
)
19934 } else if
(cur_cmd
() == mp_begin_group
) {
19938 @ @
<Scan undelimited argument
(s
)@
>=
19940 if
(mp_sym_info
(r
) < mp_text_macro
) {
19941 mp_get_x_next
(mp
);
19942 if
(mp_sym_info
(r
) != mp_suffix_macro
) {
19943 if
((cur_cmd
() == mp_equals
) ||
(cur_cmd
() == mp_assignment
))
19944 mp_get_x_next
(mp
);
19947 switch
(mp_sym_info
(r
)) {
19948 case mp_primary_macro
:
19949 mp_scan_primary
(mp
);
19951 case mp_secondary_macro
:
19952 mp_scan_secondary
(mp
);
19954 case mp_tertiary_macro
:
19955 mp_scan_tertiary
(mp
);
19957 case mp_expr_macro
:
19958 mp_scan_expression
(mp
);
19961 @
<Scan an expression followed by `\
&{of} $\langle$primary$\rangle$'@>;
19963 case mp_suffix_macro
:
19964 @
<Scan a suffix with optional delimiters@
>;
19966 case mp_text_macro
:
19967 mp_scan_text_arg
(mp
, NULL, NULL);
19969 } /* there are no other cases
*/
19970 mp_back_input
(mp
);
19971 @
<Append the current expression to |arg_list|@
>;
19975 @ @
<Scan an expression followed by `\
&{of} $\langle$primary$\rangle$'@>=
19977 mp_scan_expression
(mp
);
19978 p
= mp_get_symbolic_node
(mp
);
19979 set_mp_sym_sym
(p
, mp_stash_cur_exp
(mp
));
19980 if
(number_positive
(internal_value
(mp_tracing_macros
))) {
19981 mp_begin_diagnostic
(mp
);
19982 mp_print_arg
(mp
, (mp_node
)mp_sym_sym
(p
), n
, 0, 0);
19983 mp_end_diagnostic
(mp
, false
);
19985 if
(arg_list
== NULL)
19988 mp_link
(tail
) = p
;
19991 if
(cur_cmd
() != mp_of_token
) {
19994 const char
*hlp
[] = {
19995 "I've got the first argument; will look now for the other.",
19997 int old_setting
= mp-
>selector
;
19998 mp-
>selector
= new_string
;
19999 mp_print_macro_name
(mp
, arg_list
, macro_name
);
20000 sname
= mp_make_string
(mp
);
20001 mp-
>selector
= old_setting
;
20002 mp_snprintf
(msg
, 256, "Missing `of' has been inserted for %s", mp_str
(mp
, sname
));
20003 delete_str_ref
(sname
);
20005 mp_back_error
(mp
, msg
, hlp
, true
);
20007 mp_get_x_next
(mp
);
20008 mp_scan_primary
(mp
);
20012 @ @
<Scan a suffix with optional delimiters@
>=
20014 if
(cur_cmd
() != mp_left_delimiter
) {
20017 l_delim
= cur_sym
();
20018 r_delim
= equiv_sym
(cur_sym
());
20019 mp_get_x_next
(mp
);
20021 mp_scan_suffix
(mp
);
20022 if
(l_delim
!= NULL) {
20023 if
((cur_cmd
() != mp_right_delimiter
) ||
(equiv_sym
(cur_sym
()) != l_delim
)) {
20025 const char
*hlp
[] = {
20026 "I've gotten to the end of the macro parameter list.",
20027 "You might want to delete some tokens before continuing.",
20029 mp_snprintf
(msg
, 256, "Missing `%s' has been inserted", mp_str
(mp
, text
(r_delim
)));
20031 mp_back_error
(mp
, msg
, hlp
, true
);
20033 mp_get_x_next
(mp
);
20038 @ Before we put a new token list on the input stack
, it is wise to clean off
20039 all token lists that have recently been depleted. Then a user macro that ends
20040 with a call to itself will not require unbounded stack space.
20042 @
<Feed the arguments and replacement text to the scanner@
>=
20043 while
(token_state
&& (nloc == NULL))
20044 mp_end_token_list
(mp
); /* conserve stack space
*/
20045 if
(mp-
>param_ptr
+ n
> mp-
>max_param_stack
) {
20046 mp-
>max_param_stack
= mp-
>param_ptr
+ n
;
20047 mp_check_param_size
(mp
, mp-
>max_param_stack
);
20048 @
:MetaPost capacity exceeded parameter stack size
}{\quad parameter stack size@
>
20050 mp_begin_token_list
(mp
, def_ref
, (quarterword
) macro
);
20052 name
= text
(macro_name
);
20059 mp-
>param_stack
[mp-
>param_ptr
] = (mp_node
)mp_sym_sym
(p
);
20060 incr
(mp-
>param_ptr
);
20062 } while
(p
!= NULL);
20063 mp_flush_node_list
(mp
, arg_list
);
20066 @ It's sometimes necessary to put a single argument onto |param_stack|.
20067 The |stack_argument| subroutine does this.
20070 static void mp_stack_argument
(MP mp
, mp_node p
) {
20071 if
(mp-
>param_ptr
== mp-
>max_param_stack
) {
20072 incr
(mp-
>max_param_stack
);
20073 mp_check_param_size
(mp
, mp-
>max_param_stack
);
20075 mp-
>param_stack
[mp-
>param_ptr
] = p
;
20076 incr
(mp-
>param_ptr
);
20080 @
* Conditional processing.
20081 Let's consider now the way \
&{if} commands are handled.
20083 Conditions can be inside conditions
, and this nesting has a stack
20084 that is independent of other stacks.
20085 Four global variables represent the top of the condition stack
:
20086 |cond_ptr| points to pushed-down entries
, if~any
; |cur_if| tells whether
20087 we are processing \
&{if} or \&{elseif}; |if_limit| specifies
20088 the largest code of a |fi_or_else| command that is syntactically legal
;
20089 and |if_line| is the line number at which the current conditional began.
20091 If no conditions are currently in progress
, the condition stack has the
20092 special state |cond_ptr
=NULL|
, |if_limit
=normal|
, |cur_if
=0|
, |if_line
=0|.
20093 Otherwise |cond_ptr| points to a non-symbolic node
; the |type|
, |name_type|
, and
20094 |link| fields of the first word contain |if_limit|
, |cur_if|
, and
20095 |cond_ptr| at the next level
, and the second word contains the
20096 corresponding |if_line|.
20098 @d if_line_field
(A
) ((mp_if_node
)(A
))->if_line_field_
20099 @d if_code
1 /* code for \
&{if} being evaluated */
20100 @d fi_code
2 /* code for \
&{fi} */
20101 @d else_code
3 /* code for \
&{else} */
20102 @d else_if_code
4 /* code for \
&{elseif} */
20104 @
<MPlib internal header stuff@
>=
20105 typedef struct mp_if_node_data
{
20107 int if_line_field_
;
20109 typedef struct mp_if_node_data
*mp_if_node
;
20112 @d if_node_size sizeof
(struct mp_if_node_data
) /* number of words in stack entry for conditionals
*/
20115 static mp_node mp_get_if_node
(MP mp
) {
20116 mp_if_node p
= (mp_if_node
) malloc_node
(if_node_size
);
20117 mp_type
(p
) = mp_if_node_type
;
20118 return
(mp_node
) p
;
20123 mp_node cond_ptr
; /* top of the condition stack
*/
20124 integer if_limit
; /* upper bound on |fi_or_else| codes
*/
20125 quarterword cur_if
; /* type of conditional being worked on
*/
20126 integer if_line
; /* line where that conditional began
*/
20129 mp-
>cond_ptr
= NULL;
20130 mp-
>if_limit
= normal
;
20135 mp_primitive
(mp
, "if", mp_if_test
, if_code
);
20136 @
:if_
}{\
&{if} primitive@>;
20137 mp_primitive
(mp
, "fi", mp_fi_or_else
, fi_code
);
20138 mp-
>frozen_fi
= mp_frozen_primitive
(mp
, "fi", mp_fi_or_else
, fi_code
);
20139 @
:fi_
}{\
&{fi} primitive@>;
20140 mp_primitive
(mp
, "else", mp_fi_or_else
, else_code
);
20141 @
:else_
}{\
&{else} primitive@>;
20142 mp_primitive
(mp
, "elseif", mp_fi_or_else
, else_if_code
);
20143 @
:else_if_
}{\
&{elseif} primitive@>
20146 @ @
<Cases of |print_cmd_mod|...@
>=
20148 case mp_fi_or_else
:
20151 mp_print
(mp
, "if");
20154 mp_print
(mp
, "fi");
20157 mp_print
(mp
, "else");
20160 mp_print
(mp
, "elseif");
20165 @ Here is a procedure that ignores text until coming to an \
&{elseif},
20166 \
&{else}, or \&{fi} at level zero of $\&{if}\ldots\&{fi}$
20167 nesting. After it has acted
, |cur_mod| will indicate the token that
20170 \MP's smallest two command codes are |if_test| and |fi_or_else|
; this
20171 makes the skipping process a bit simpler.
20174 void mp_pass_text
(MP mp
) {
20176 mp-
>scanner_status
= skipping
;
20177 mp-
>warning_line
= mp_true_line
(mp
);
20180 if
(cur_cmd
() <= mp_fi_or_else
) {
20181 if
(cur_cmd
() < mp_fi_or_else
) {
20186 if
(cur_mod
() == fi_code
)
20190 @
<Decrease the string reference count
,
20191 if the current token is a string@
>;
20194 mp-
>scanner_status
= normal
;
20198 @ @
<Decrease the string reference count...@
>=
20199 if
(cur_cmd
() == mp_string_token
) {
20200 delete_str_ref
(cur_mod_str
());
20203 @ When we begin to process a new \
&{if}, we set |if_limit:=if_code|; then
20204 if \
&{elseif} or \&{else} or \&{fi} occurs before the current \&{if}
20205 condition has been evaluated
, a colon will be inserted.
20206 A construction like `\.
{if fi
}' would otherwise get \MP\ confused.
20208 @
<Push the condition stack@
>=
20210 p
= mp_get_if_node
(mp
);
20211 mp_link
(p
) = mp-
>cond_ptr
;
20212 mp_type
(p
) = (quarterword
) mp-
>if_limit
;
20213 mp_name_type
(p
) = mp-
>cur_if
;
20214 if_line_field
(p
) = mp-
>if_line
;
20216 mp-
>if_limit
= if_code
;
20217 mp-
>if_line
= mp_true_line
(mp
);
20218 mp-
>cur_if
= if_code
;
20222 @ @
<Pop the condition stack@
>=
20224 mp_node p
= mp-
>cond_ptr
;
20225 mp-
>if_line
= if_line_field
(p
);
20226 mp-
>cur_if
= mp_name_type
(p
);
20227 mp-
>if_limit
= mp_type
(p
);
20228 mp-
>cond_ptr
= mp_link
(p
);
20229 mp_free_node
(mp
, p
, if_node_size
);
20233 @ Here's a procedure that changes the |if_limit| code corresponding to
20234 a given value of |cond_ptr|.
20237 static void mp_change_if_limit
(MP mp
, quarterword l
, mp_node p
) {
20239 if
(p
== mp-
>cond_ptr
) {
20240 mp-
>if_limit
= l
; /* that's the easy case
*/
20245 mp_confusion
(mp
, "if");
20246 @
:this can't happen if
}{\quad if@
>;
20247 /* clang
: dereference of null pointer
*/ assert
(q
);
20248 if
(mp_link
(q
) == p
) {
20258 @ The user is supposed to put colons into the proper parts of conditional
20259 statements. Therefore
, \MP\ has to check for their presence.
20262 static void mp_check_colon
(MP mp
) {
20263 if
(cur_cmd
() != mp_colon
) {
20264 const char
*hlp
[] = {
20265 "There should've been a colon after the condition.",
20266 "I shall pretend that one was there.",
20268 mp_back_error
(mp
, "Missing `:' has been inserted", hlp
, true
);
20274 @ A condition is started when the |get_x_next| procedure encounters
20275 an |if_test| command
; in that case |get_x_next| calls |conditional|
,
20276 which is a recursive procedure.
20280 void mp_conditional
(MP mp
) {
20281 mp_node save_cond_ptr
; /* |cond_ptr| corresponding to this conditional
*/
20282 int new_if_limit
; /* future value of |if_limit|
*/
20283 mp_node p
; /* temporary register
*/
20284 @
<Push the condition stack@
>;
20285 save_cond_ptr
= mp-
>cond_ptr
;
20287 mp_get_boolean
(mp
);
20288 new_if_limit
= else_if_code
;
20289 if
(number_greater
(internal_value
(mp_tracing_commands
), unity_t
)) {
20290 @
<Display the boolean value of |cur_exp|@
>;
20293 mp_check_colon
(mp
);
20294 if
(cur_exp_value_boolean
() == mp_true_code
) {
20295 mp_change_if_limit
(mp
, (quarterword
) new_if_limit
, save_cond_ptr
);
20296 return
; /* wait for \
&{elseif}, \&{else}, or \&{fi} */
20298 @
<Skip to \
&{elseif} or \&{else} or \&{fi}, then |goto done|@>;
20300 mp-
>cur_if
= (quarterword
) cur_mod
();
20301 mp-
>if_line
= mp_true_line
(mp
);
20302 if
(cur_mod
() == fi_code
) {
20303 @
<Pop the condition stack@
>
20304 } else if
(cur_mod
() == else_if_code
) {
20307 set_cur_exp_value_boolean
(mp_true_code
);
20308 new_if_limit
= fi_code
;
20309 mp_get_x_next
(mp
);
20315 @ In a construction like `\
&{if} \&{if} \&{true}: $0=1$: \\{foo}
20316 \
&{else}: \\{bar} \&{fi}', the first \&{else}
20317 that we come to after learning that the \
&{if} is false is not the
20318 \
&{else} we're looking for. Hence the following curious logic is needed.
20320 @
<Skip to \
&{elseif}...@>=
20323 if
(mp-
>cond_ptr
== save_cond_ptr
)
20325 else if
(cur_mod
() == fi_code
)
20326 @
<Pop the condition stack@
>;
20330 @ @
<Display the boolean value...@
>=
20332 mp_begin_diagnostic
(mp
);
20333 if
(cur_exp_value_boolean
() == mp_true_code
)
20334 mp_print
(mp
, "{true}");
20336 mp_print
(mp
, "{false}");
20337 mp_end_diagnostic
(mp
, false
);
20341 @ The processing of conditionals is complete except for the following
20342 code
, which is actually part of |get_x_next|. It comes into play when
20343 \
&{elseif}, \&{else}, or \&{fi} is scanned.
20345 @
<Terminate the current conditional and skip to \
&{fi}@>=
20346 if
(cur_mod
() > mp-
>if_limit
) {
20347 if
(mp-
>if_limit
== if_code
) { /* condition not yet evaluated
*/
20348 const char
*hlp
[] = { "Something was missing here", NULL };
20349 mp_back_input
(mp
);
20350 set_cur_sym
(mp-
>frozen_colon
);
20351 mp_ins_error
(mp
, "Missing `:' has been inserted", hlp
, true
);
20354 const char
*hlp
[] = {"I'm ignoring this; it doesn't match any if.", NULL};
20355 if
(cur_mod
() == fi_code
) {
20356 mp_error
(mp
, "Extra fi", hlp
, true
);
20358 } else if
(cur_mod
() == else_code
) {
20359 mp_error
(mp
, "Extra else", hlp
, true
);
20362 mp_error
(mp
, "Extra elseif", hlp
, true
);
20367 while
(cur_mod
() != fi_code
)
20368 mp_pass_text
(mp
); /* skip to \
&{fi} */
20369 @
<Pop the condition stack@
>;
20374 To bring our treatment of |get_x_next| to a close
, we need to consider what
20375 \MP\ does when it sees \
&{for}, \&{forsuffixes}, and \&{forever}.
20377 There's a global variable |loop_ptr| that keeps track of the \
&{for} loops
20378 that are currently active. If |loop_ptr
=NULL|
, no loops are in progress
;
20379 otherwise |loop_ptr.info| points to the iterative text of the current
20380 (innermost
) loop
, and |loop_ptr.link| points to the data for any other
20381 loops that enclose the current one.
20383 A loop-control node also has two other fields
, called |type| and
20384 |list|
, whose contents depend on the type of loop
:
20386 \yskip\indent|loop_ptr.type
=NULL| means that the link of |loop_ptr.list|
20387 points to a list of symbolic nodes whose |info| fields point to the
20388 remaining argument values of a suffix list and expression list.
20389 In this case
, an extra field |loop_ptr.start_list| is needed to
20390 make sure that |resume_operation| skips ahead.
20392 \yskip\indent|loop_ptr.type
=MP_VOID| means that the current loop is
20395 \yskip\indent|loop_ptr.type
=PROGRESSION_FLAG| means that
20396 |loop_ptr.value|
, |loop_ptr.step_size|
, and |loop_ptr.final_value|
20397 contain the data for an arithmetic progression.
20399 \yskip\indent|loop_ptr.type
=p
>PROGRESSION_FLAG| means that |p| points to an edge
20400 header and |loop_ptr.list| points into the graphical object list for
20403 @d PROGRESSION_FLAG
(mp_node
)(2) /* |
NULL+2|
*/
20404 /* |loop_type| value when |loop_list| points to a progression node
*/
20407 typedef struct mp_loop_data
{
20408 mp_sym var
; /* the var of the loop
*/
20409 mp_node info
; /* iterative text of this loop
*/
20410 mp_node type
; /* the special type of this loop
, or a pointer into
20412 mp_node list
; /* the remaining list elements
*/
20413 mp_node list_start
; /* head fo the list of elements
*/
20414 mp_number old_value
; /* previous value of current arithmetic value
*/
20415 mp_number value
; /* current arithmetic value
*/
20416 mp_number step_size
; /* arithmetic step size
*/
20417 mp_number final_value
; /* end arithmetic value
*/
20418 struct mp_loop_data
*link
; /* the enclosing loop
, if any
*/
20422 mp_loop_data
*loop_ptr
; /* top of the loop-control-node stack
*/
20425 mp-
>loop_ptr
= NULL;
20427 @ If the expressions that define an arithmetic progression in a
20428 \
&{for} loop don't have known numeric values, the |bad_for| subroutine
20429 screams at the user.
20432 static void mp_bad_for
(MP mp
, const char
*s
) {
20435 const char
*hlp
[] = {"When you say `for x=a step b until c',",
20436 "the initial value `a' and the step size `b'",
20437 "and the final value `c' must have known numeric values.",
20438 "I'm zeroing this one. Proceed, with fingers crossed.",
20440 memset
(&new_expr,0,sizeof(mp_value));
20441 new_number
(new_expr.data.n
);
20442 mp_disp_err
(mp
, NULL);
20443 /* show the bad expression above the message
*/
20444 mp_snprintf
(msg
, 256, "Improper %s has been replaced by 0", s
);
20445 @.Improper...replaced by
0@
>;
20446 mp_back_error
(mp
, msg
, hlp
, true
);
20447 mp_get_x_next
(mp
);
20448 mp_flush_cur_exp
(mp
, new_expr
);
20452 @ Here's what \MP\ does when \
&{for}, \&{forsuffixes}, or \&{forever}
20453 has just been scanned.
(This code requires slight familiarity with
20454 expression-parsing routines that we have not yet discussed
; but it
20455 seems to belong in the present part of the program
, even though the
20456 original author didn't write it until later. The reader may wish to
20460 void mp_begin_iteration
(MP mp
) {
20461 halfword m
; /* |start_for|
(\
&{for}) or |start_forsuffixes|
20462 (\
&{forsuffixes}) */
20463 mp_sym n
; /* hash address of the current symbol
*/
20464 mp_loop_data
*s
; /* the new loop-control node
*/
20465 mp_subst_list_item
*p
= NULL; /* substitution list for |scan_toks|
20467 mp_node q
; /* link manipulation register
*/
20470 s
= xmalloc
(1, sizeof
(mp_loop_data
));
20471 s-
>type
= s-
>list
= s-
>info
= s-
>list_start
= NULL;
20472 s-
>link
= NULL; s-
>var
= NULL;
20473 new_number
(s-
>value
);new_number
(s-
>old_value
);
20474 new_number
(s-
>step_size
);
20475 new_number
(s-
>final_value
);
20476 if
(m
== start_forever
) {
20479 mp_get_x_next
(mp
);
20481 mp_get_symbol
(mp
);
20482 p
= xmalloc
(1, sizeof
(mp_subst_list_item
));
20484 p-
>info
= cur_sym
();
20485 s-
>var
= cur_sym
();
20486 p-
>info_mod
= cur_sym_mod
();
20488 if
(m
== start_for
) {
20489 p-
>value_mod
= mp_expr_sym
;
20490 } else
{ /* |start_forsuffixes|
*/
20491 p-
>value_mod
= mp_suffix_sym
;
20493 mp_get_x_next
(mp
);
20494 if
(cur_cmd
() == mp_within_token
) {
20495 @
<Set up a picture iteration@
>;
20497 @
<Check for the assignment in a loop header@
>;
20498 @
<Scan the values to be used in the loop@
>;
20501 @
<Check for the presence of a colon@
>;
20502 @
<Scan the loop text and put it on the loop control stack@
>;
20503 mp_resume_iteration
(mp
);
20507 @ @
<Check for the assignment in a loop header@
>=
20508 if
((cur_cmd
() != mp_equals
) && (cur_cmd() != mp_assignment)) {
20509 const char
*hlp
[] = {
20510 "The next thing in this loop should have been `=' or `:='.",
20511 "But don't worry; I'll pretend that an equals sign",
20512 "was present, and I'll look for the values next.",
20514 mp_back_error
(mp
, "Missing `=' has been inserted", hlp
, true
);
20518 @ @
<Check for the presence of a colon@
>=
20519 if
(cur_cmd
() != mp_colon
) {
20520 const char
*hlp
[] = {
20521 "The next thing in this loop should have been a `:'.",
20522 "So I'll pretend that a colon was present;",
20523 "everything from here to `endfor' will be iterated.",
20525 mp_back_error
(mp
, "Missing `:' has been inserted", hlp
, true
);
20529 @ We append a special |mp-
>frozen_repeat_loop| token in place of the
20530 `\
&{endfor}' at the end of the loop. This will come through \MP's
20531 scanner at the proper time to cause the loop to be repeated.
20533 (If the user tries some shenanigan like `\
&{for} $\ldots$ \&{let}
20534 \
&{endfor}', he will be foiled by the |get_symbol| routine, which
20535 keeps frozen tokens unchanged. Furthermore the
20536 |mp-
>frozen_repeat_loop| is an \
&{outer} token, so it won't be lost
20539 @ @
<Scan the loop text...@
>=
20540 q
= mp_get_symbolic_node
(mp
);
20541 set_mp_sym_sym
(q
, mp-
>frozen_repeat_loop
);
20542 mp-
>scanner_status
= loop_defining
;
20543 mp-
>warning_info
= n
;
20544 s-
>info
= mp_scan_toks
(mp
, mp_iteration
, p
, q
, 0);
20545 mp-
>scanner_status
= normal
;
20546 s-
>link
= mp-
>loop_ptr
;
20549 @ @
<Initialize table...@
>=
20550 mp-
>frozen_repeat_loop
=
20551 mp_frozen_primitive
(mp
, " ENDFOR", mp_repeat_loop
+ mp_outer_tag
, 0);
20553 @ The loop text is inserted into \MP's scanning apparatus by the
20554 |resume_iteration| routine.
20557 void mp_resume_iteration
(MP mp
) {
20558 mp_node p
, q
; /* link registers
*/
20559 p
= mp-
>loop_ptr-
>type
;
20560 if
(p
== PROGRESSION_FLAG
) {
20561 set_cur_exp_value_number
(mp-
>loop_ptr-
>value
);
20562 if
(@
<The arithmetic progression has ended@
>) {
20563 mp_stop_iteration
(mp
);
20566 mp-
>cur_exp.type
= mp_known
;
20567 q
= mp_stash_cur_exp
(mp
); /* make |q| an \
&{expr} argument */
20568 number_clone
(mp-
>loop_ptr-
>old_value
, cur_exp_value_number
());
20569 set_number_from_addition
(mp-
>loop_ptr-
>value
, cur_exp_value_number
(), mp-
>loop_ptr-
>step_size
);
20570 /* set |value
(p
)| for the next iteration
*/
20571 /* detect numeric overflow
*/
20572 if
(number_positive
(mp-
>loop_ptr-
>step_size
) &&
20573 number_less
(mp-
>loop_ptr-
>value
, cur_exp_value_number
())) {
20574 if
(number_positive
(mp-
>loop_ptr-
>final_value
)) {
20575 number_clone
(mp-
>loop_ptr-
>value
, mp-
>loop_ptr-
>final_value
);
20576 number_add_scaled
(mp-
>loop_ptr-
>final_value
, -1);
20578 number_clone
(mp-
>loop_ptr-
>value
, mp-
>loop_ptr-
>final_value
);
20579 number_add_scaled
(mp-
>loop_ptr-
>value
, 1);
20581 } else if
(number_negative
(mp-
>loop_ptr-
>step_size
) &&
20582 number_greater
(mp-
>loop_ptr-
>value
, cur_exp_value_number
())) {
20583 if
(number_negative
(mp-
>loop_ptr-
>final_value
)) {
20584 number_clone
(mp-
>loop_ptr-
>value
, mp-
>loop_ptr-
>final_value
);
20585 number_add_scaled
(mp-
>loop_ptr-
>final_value
, 1);
20587 number_clone
(mp-
>loop_ptr-
>value
, mp-
>loop_ptr-
>final_value
);
20588 number_add_scaled
(mp-
>loop_ptr-
>value
, -1);
20591 } else if
(p
== NULL) {
20592 p
= mp-
>loop_ptr-
>list
;
20593 if
(p
!= NULL && p == mp->loop_ptr->list_start) {
20596 mp_free_symbolic_node
(mp
, q
);
20597 mp-
>loop_ptr-
>list
= p
;
20600 mp_stop_iteration
(mp
);
20603 mp-
>loop_ptr-
>list
= mp_link
(p
);
20604 q
= (mp_node
)mp_sym_sym
(p
);
20606 number_clone
(mp-
>loop_ptr-
>old_value
, q-
>data.n
);
20607 mp_free_symbolic_node
(mp
, p
);
20608 } else if
(p
== MP_VOID
) {
20609 mp_begin_token_list
(mp
, mp-
>loop_ptr-
>info
, (quarterword
) forever_text
);
20612 @
<Make |q| a capsule containing the next picture component from
20613 |loop_list
(loop_ptr
)| or |goto not_found|@
>;
20615 mp_begin_token_list
(mp
, mp-
>loop_ptr-
>info
, (quarterword
) loop_text
);
20616 mp_stack_argument
(mp
, q
);
20617 if
(number_greater
(internal_value
(mp_tracing_commands
), unity_t
)) {
20618 @
<Trace the start of a loop@
>;
20622 mp_stop_iteration
(mp
);
20626 @ @
<The arithmetic progression has ended@
>=
20627 (number_positive
(mp-
>loop_ptr-
>step_size
) && number_greater(cur_exp_value_number (), mp->loop_ptr->final_value))
20629 (number_negative
(mp-
>loop_ptr-
>step_size
) && number_less(cur_exp_value_number (), mp->loop_ptr->final_value))
20632 @ @
<Trace the start of a loop@
>=
20634 mp_begin_diagnostic
(mp
);
20635 mp_print_nl
(mp
, "{loop value=");
20637 if
((q
!= NULL) && (mp_link (q) == MP_VOID))
20638 mp_print_exp
(mp
, q
, 1);
20640 mp_show_token_list
(mp
, q
, NULL, 50, 0);
20641 mp_print_char
(mp
, xord
('
}'
));
20642 mp_end_diagnostic
(mp
, false
);
20646 @ @
<Make |q| a capsule containing the next picture component
20649 q
= mp-
>loop_ptr-
>list
;
20652 if
( ! is_start_or_stop
(q
) )
20654 else if
( ! is_stop
(q
) )
20655 q
=mp_skip_1component
(mp
, q
);
20659 set_cur_exp_node
((mp_node
)mp_copy_objects
(mp
, mp-
>loop_ptr-
>list
, q
));
20660 mp_init_bbox
(mp
, (mp_edge_header_node
)cur_exp_node
());
20661 mp-
>cur_exp.type
= mp_picture_type
;
20662 mp-
>loop_ptr-
>list
= q
;
20663 q
= mp_stash_cur_exp
(mp
);
20667 @ A level of loop control disappears when |resume_iteration| has
20668 decided not to resume
, or when an \
&{exitif} construction has removed
20669 the loop text from the input stack.
20672 void mp_stop_iteration
(MP mp
) {
20673 mp_node p
, q
; /* the usual
*/
20674 mp_loop_data
*tmp
; /* for free
() */
20675 p
= mp-
>loop_ptr-
>type
;
20676 if
(p
== PROGRESSION_FLAG
) {
20677 mp_free_symbolic_node
(mp
, mp-
>loop_ptr-
>list
);
20678 } else if
(p
== NULL) {
20679 q
= mp-
>loop_ptr-
>list
;
20680 while
(q
!= NULL) {
20681 p
= (mp_node
)mp_sym_sym
(q
);
20683 if
(mp_link
(p
) == MP_VOID
) { /* it's an \
&{expr} parameter */
20684 mp_recycle_value
(mp
, p
);
20685 mp_free_value_node
(mp
, p
);
20687 mp_flush_token_list
(mp
, p
); /* it's a \
&{suffix} or \&{text}
20693 mp_free_symbolic_node
(mp
, p
);
20695 } else if
(p
> PROGRESSION_FLAG
) {
20696 delete_edge_ref
(p
);
20698 tmp
= mp-
>loop_ptr
;
20699 mp-
>loop_ptr
= tmp-
>link
;
20700 mp_flush_token_list
(mp
, tmp-
>info
);
20701 free_number
(tmp-
>value
);
20702 free_number
(tmp-
>step_size
);
20703 free_number
(tmp-
>final_value
);
20708 @ Now that we know all about loop control
, we can finish up the
20709 missing portion of |begin_iteration| and we'll be done.
20711 The following code is performed after the `\.
=' has been scanned in a
20712 \
&{for} construction (if |m=start_for|) or a \&{forsuffixes}
20713 construction
(if |m
=start_forsuffixes|
).
20715 @
<Scan the values to be used in the loop@
>=
20717 s-
>list
= mp_get_symbolic_node
(mp
);
20718 s-
>list_start
= s-
>list
;
20721 mp_get_x_next
(mp
);
20722 if
(m
!= start_for
) {
20723 mp_scan_suffix
(mp
);
20725 if
(cur_cmd
() >= mp_colon
)
20726 if
(cur_cmd
() <= mp_comma
)
20728 mp_scan_expression
(mp
);
20729 if
(cur_cmd
() == mp_step_token
)
20730 if
(q
== s-
>list
) {
20731 @
<Prepare for step-until construction and |break|@
>;
20733 set_cur_exp_node
(mp_stash_cur_exp
(mp
));
20735 mp_link
(q
) = mp_get_symbolic_node
(mp
);
20737 set_mp_sym_sym
(q
, mp-
>cur_exp.data.node
);
20738 if
(m
== start_for
)
20739 mp_name_type
(q
) = mp_expr_sym
;
20740 else if
(m
== start_forsuffixes
)
20741 mp_name_type
(q
) = mp_suffix_sym
;
20742 mp-
>cur_exp.type
= mp_vacuous
;
20745 } while
(cur_cmd
() == mp_comma
)
20747 @ @
<Prepare for step-until construction and |break|@
>=
20749 if
(mp-
>cur_exp.type
!= mp_known
)
20750 mp_bad_for
(mp
, "initial value");
20751 number_clone
(s-
>value
, cur_exp_value_number
());
20752 number_clone
(s-
>old_value
, cur_exp_value_number
());
20753 mp_get_x_next
(mp
);
20754 mp_scan_expression
(mp
);
20755 if
(mp-
>cur_exp.type
!= mp_known
)
20756 mp_bad_for
(mp
, "step size");
20757 number_clone
(s-
>step_size
, cur_exp_value_number
());
20758 if
(cur_cmd
() != mp_until_token
) {
20759 const char
*hlp
[] = {
20760 "I assume you meant to say `until' after `step'.",
20761 "So I'll look for the final value and colon next.",
20763 mp_back_error
(mp
, "Missing `until' has been inserted", hlp
, true
);
20764 @.Missing `until'@
>;
20766 mp_get_x_next
(mp
);
20767 mp_scan_expression
(mp
);
20768 if
(mp-
>cur_exp.type
!= mp_known
)
20769 mp_bad_for
(mp
, "final value");
20770 number_clone
(s-
>final_value
, cur_exp_value_number
());
20771 s-
>type
= PROGRESSION_FLAG
;
20776 @ The last case is when we have just seen ``\
&{within}'', and we need to
20777 parse a picture expression and prepare to iterate over it.
20779 @
<Set up a picture iteration@
>=
20781 mp_get_x_next
(mp
);
20782 mp_scan_expression
(mp
);
20783 @
<Make sure the current expression is a known picture@
>;
20784 s-
>type
= mp-
>cur_exp.data.node
;
20785 mp-
>cur_exp.type
= mp_vacuous
;
20786 q
= mp_link
(edge_list
(mp-
>cur_exp.data.node
));
20788 if
(is_start_or_stop
(q
))
20789 if
(mp_skip_1component
(mp
, q
) == NULL)
20795 @ @
<Make sure the current expression is a known picture@
>=
20796 if
(mp-
>cur_exp.type
!= mp_picture_type
) {
20798 const char
*hlp
[] = { "When you say `for x in p', p must be a known picture.", NULL };
20799 memset
(&new_expr,0,sizeof(mp_value));
20800 new_number
(new_expr.data.n
);
20801 new_expr.data.node
= (mp_node
)mp_get_edge_header_node
(mp
);
20802 mp_disp_err
(mp
, NULL);
20803 mp_back_error
(mp
,"Improper iteration spec has been replaced by nullpicture", hlp
, true
);
20804 mp_get_x_next
(mp
);
20805 mp_flush_cur_exp
(mp
, new_expr
);
20806 mp_init_edges
(mp
, (mp_edge_header_node
)mp-
>cur_exp.data.node
);
20807 mp-
>cur_exp.type
= mp_picture_type
;
20811 It's time now to fret about file names. Besides the fact that different
20812 operating systems treat files in different ways
, we must cope with the
20813 fact that completely different naming conventions are used by different
20814 groups of people. The following programs show what is required for one
20815 particular operating system
; similar routines for other systems are not
20816 difficult to devise.
20817 @^system dependencies@
>
20819 \MP\ assumes that a file name has three parts
: the name proper
; its
20820 ``extension''
; and a ``file area'' where it is found in an external file
20821 system. The extension of an input file is assumed to be
20822 `\.
{.mp
}' unless otherwise specified
; it is `\.
{.log
}' on the
20823 transcript file that records each run of \MP
; it is `\.
{.tfm
}' on the font
20824 metric files that describe characters in any fonts created by \MP
; it is
20825 `\.
{.ps
}' or `.
{\it nnn
}' for some number
{\it nnn
} on the \ps\ output files.
20826 The file area can be arbitrary on input files
, but files are usually
20827 output to the user's current area. If an input file cannot be
20828 found on the specified area
, \MP\ will look for it on a special system
20829 area
; this special area is intended for commonly used input files.
20831 Simple uses of \MP\ refer only to file names that have no explicit
20832 extension or area. For example
, a person usually says `\.
{input
} \.
{cmr10
}'
20833 instead of `\.
{input
} \.
{cmr10.new
}'. Simple file
20834 names are best
, because they make the \MP\ source files portable
;
20835 whenever a file name consists entirely of letters and digits
, it should be
20836 treated in the same way by all implementations of \MP. However
, users
20837 need the ability to refer to other files in their environment
, especially
20838 when responding to error messages concerning unopenable files
; therefore
20839 we want to let them use the syntax that appears in their favorite
20842 @ \MP\ uses the same conventions that have proved to be satisfactory for
20843 \TeX\ and \MF. In order to isolate the system-dependent aspects of file names
,
20844 @^system dependencies@
>
20845 the system-independent parts of \MP\ are expressed in terms
20846 of three system-dependent
20847 procedures called |begin_name|
, |more_name|
, and |end_name|. In
20848 essence
, if the user-specified characters of the file name are $c_1\ldots c_n$
,
20849 the system-independent driver program does the operations
20850 $$|begin_name|
;\
,|more_name|
(c_1
);\
,\ldots\
,;\
,|more_name|
(c_n
);
20852 These three procedures communicate with each other via global variables.
20853 Afterwards the file name will appear in the string pool as three strings
20854 called |cur_name|\penalty10000\hskip-
.05em
,
20855 |cur_area|
, and |cur_ext|
; the latter two are
NULL (i.e.
,
20856 |
""|
), unless they were explicitly specified by the user.
20858 Actually the situation is slightly more complicated
, because \MP\ needs
20859 to know when the file name ends. The |more_name| routine is a function
20860 (with side effects
) that returns |true| on the calls |more_name|$
(c_1
)$
,
20861 \dots
, |more_name|$
(c_
{n-1
})$. The final call |more_name|$
(c_n
)$
20862 returns |false|
; or
, it returns |true| and $c_n$ is the last character
20863 on the current input line. In other words
,
20864 |more_name| is supposed to return |true| unless it is sure that the
20865 file name has been completely scanned
; and |end_name| is supposed to be able
20866 to finish the assembly of |cur_name|
, |cur_area|
, and |cur_ext| regardless of
20867 whether $|more_name|
(c_n
)$ returned |true| or |false|.
20870 char
*cur_name
; /* name of file just scanned
*/
20871 char
*cur_area
; /* file area just scanned
, or \.
{""} */
20872 char
*cur_ext
; /* file extension just scanned
, or \.
{""} */
20874 @ It is easier to maintain reference counts if we assign initial values.
20877 mp-
>cur_name
= xstrdup
("");
20878 mp-
>cur_area
= xstrdup
("");
20879 mp-
>cur_ext
= xstrdup
("");
20881 @ @
<Dealloc variables@
>=
20882 xfree
(mp-
>cur_area
);
20883 xfree
(mp-
>cur_name
);
20884 xfree
(mp-
>cur_ext
);
20886 @ The file names we shall deal with for illustrative purposes have the
20887 following structure
: If the name contains `\.
>' or `\.
:'
, the file area
20888 consists of all characters up to and including the final such character
;
20889 otherwise the file area is null. If the remaining file name contains
20890 `\..'
, the file extension consists of all such characters from the first
20891 remaining `\..' to the end
, otherwise the file extension is null.
20892 @^system dependencies@
>
20894 We can scan such file names easily by using two global variables that keep track
20895 of the occurrences of area and extension delimiters.
20898 integer area_delimiter
;
20899 /* most recent `\.
>' or `\.
:' relative to |str_start
[str_ptr
]|
*/
20900 integer ext_delimiter
; /* the relevant `\..'
, if any
*/
20901 boolean quoted_filename
; /* whether the filename is wrapped in
" markers */
20903 @ Here now is the first of the system-dependent routines for file name scanning.
20904 @^system dependencies@>
20907 static void mp_begin_name (MP mp);
20908 static boolean mp_more_name (MP mp, ASCII_code c);
20909 static void mp_end_name (MP mp);
20912 void mp_begin_name (MP mp) {
20913 xfree (mp->cur_name);
20914 xfree (mp->cur_area);
20915 xfree (mp->cur_ext);
20916 mp->area_delimiter = -1;
20917 mp->ext_delimiter = -1;
20918 mp->quoted_filename = false;
20922 @ And here's the second.
20923 @^system dependencies@>
20927 #define IS_DIR_SEP(c) (c=='/' || c=='\\')
20929 boolean mp_more_name (MP mp, ASCII_code c) {
20931 mp-
>quoted_filename
= !mp-
>quoted_filename
;
20932 } else if
((c
== ' ' || c
== '\t'
) && (mp->quoted_filename == false)) {
20935 if
(IS_DIR_SEP
(c
)) {
20936 mp-
>area_delimiter
= (integer
) mp-
>cur_length
;
20937 mp-
>ext_delimiter
= -1;
20938 } else if
(c
== '.'
) {
20939 mp-
>ext_delimiter
= (integer
) mp-
>cur_length
;
20941 append_char
(c
); /* contribute |c| to the current string
*/
20948 @^system dependencies@
>
20950 @d copy_pool_segment
(A
,B
,C
) {
20951 A
= xmalloc
(C
+1,sizeof
(char
));
20952 (void
)memcpy
(A
,(char
*)(mp-
>cur_string
+B
),C
);
20956 void mp_end_name
(MP mp
) {
20957 size_t s
= 0; /* length of area
, name
, and extension
*/
20960 if
(mp-
>area_delimiter
< 0) {
20961 mp-
>cur_area
= xstrdup
("");
20963 len
= (size_t
) mp-
>area_delimiter
- s
+ 1;
20964 copy_pool_segment
(mp-
>cur_area
, s
, len
);
20967 if
(mp-
>ext_delimiter
< 0) {
20968 mp-
>cur_ext
= xstrdup
("");
20969 len
= (unsigned
) (mp-
>cur_length
- s
);
20971 copy_pool_segment
(mp-
>cur_ext
, mp-
>ext_delimiter
,
20972 (mp-
>cur_length
- (size_t
) mp-
>ext_delimiter
));
20973 len
= (size_t
) mp-
>ext_delimiter
- s
;
20975 copy_pool_segment
(mp-
>cur_name
, s
, len
);
20976 mp_reset_cur_string
(mp
);
20980 @ Conversely
, here is a routine that takes three strings and prints a file
20981 name that might have produced them.
(The routine is system dependent
, because
20982 some operating systems put the file area last instead of first.
)
20983 @^system dependencies@
>
20985 @
<Basic printing...@
>=
20986 static void mp_print_file_name
(MP mp
, char
*n
, char
*a
, char
*e
) {
20987 boolean must_quote
= false
;
20988 if
(((a
!= NULL) && (strchr (a, ' ') != NULL)) ||
20989 ((n
!= NULL) && (strchr (n, ' ') != NULL)) ||
20990 ((e
!= NULL) && (strchr (e, ' ') != NULL)))
20993 mp_print_char
(mp
, (ASCII_code
) '
"');
20998 mp_print_char (mp, (ASCII_code) '"'
);
21002 @ Another system-dependent routine is needed to convert three internal
21004 to the |name_of_file| value that is used to open files. The present code
21005 allows both lowercase and uppercase letters in the file name.
21006 @^system dependencies@
>
21008 @d append_to_name
(A
) { mp-
>name_of_file
[k
++]=(char
)xchr
(xord
((ASCII_code
)(A
))); }
21011 void mp_pack_file_name
(MP mp
, const char
*n
, const char
*a
, const char
*e
) {
21012 integer k
; /* number of positions filled in |name_of_file|
*/
21013 const char
*j
; /* a character index
*/
21016 assert
(n
!= NULL);
21017 xfree
(mp-
>name_of_file
);
21018 slen
= strlen
(n
) + 1;
21020 slen
+= strlen
(a
);
21022 slen
+= strlen
(e
);
21023 mp-
>name_of_file
= xmalloc
(slen
, 1);
21025 for
(j
= a
; *j
!= '\
0'
; j
++) {
21026 append_to_name
(*j
);
21029 for
(j
= n
; *j
!= '\
0'
; j
++) {
21030 append_to_name
(*j
);
21033 for
(j
= e
; *j
!= '\
0'
; j
++) {
21034 append_to_name
(*j
);
21037 mp-
>name_of_file
[k
] = 0;
21041 @ @
<Internal library declarations@
>=
21042 void mp_pack_file_name
(MP mp
, const char
*n
, const char
*a
, const char
*e
);
21044 @ @
<Option variables@
>=
21045 char
*mem_name
; /* for commandline
*/
21047 @ Stripping a |.mem| extension here is for backward compatibility.
21049 @
<Find and load preload file
, if required@
>=
21050 if
(!opt-
>ini_version
) {
21051 mp-
>mem_name
= xstrdup
(opt-
>mem_name
);
21052 if
(mp-
>mem_name
) {
21053 size_t l
= strlen
(mp-
>mem_name
);
21055 char
*test
= strstr
(mp-
>mem_name
, ".mem");
21056 if
(test
== mp-
>mem_name
+ l
- 4) {
21061 if
(mp-
>mem_name
!= NULL) {
21062 if
(!mp_open_mem_file
(mp
)) {
21063 mp-
>history
= mp_fatal_error_stop
;
21071 @ @
<Dealloc variables@
>=
21072 xfree
(mp-
>mem_name
);
21074 @ This part of the program becomes active when a ``virgin'' \MP\ is
21075 trying to get going
, just after the preliminary initialization.
21076 The buffer contains the first line of input in |buffer
[loc..
(last-1
)]|
,
21077 where |loc
<last| and |buffer
[loc
]<>""|.
21080 static boolean mp_open_mem_name
(MP mp
);
21081 static boolean mp_open_mem_file
(MP mp
);
21084 boolean mp_open_mem_name
(MP mp
) {
21085 if
(mp-
>mem_name
!= NULL) {
21086 size_t l
= strlen
(mp-
>mem_name
);
21087 char
*s
= xstrdup
(mp-
>mem_name
);
21089 char
*test
= strstr
(s
, ".mp");
21090 if
(test
== NULL || test
!= s
+ l
- 4) {
21091 s
= xrealloc
(s
, l
+ 5, 1);
21095 s
= xrealloc
(s
, l
+ 5, 1);
21098 s
= (mp-
>find_file
) (mp
, s
, "r", mp_filetype_program
);
21099 xfree
(mp-
>name_of_file
);
21102 mp-
>name_of_file
= xstrdup
(s
);
21103 mp-
>mem_file
= (mp-
>open_file
) (mp
, s
, "r", mp_filetype_program
);
21110 boolean mp_open_mem_file
(MP mp
) {
21111 if
(mp-
>mem_file
!= NULL)
21113 if
(mp_open_mem_name
(mp
))
21115 if
(mp_xstrcmp
(mp-
>mem_name
, "plain")) {
21116 wake_up_terminal
();
21117 wterm
("Sorry, I can\'t find the '");
21118 wterm
(mp-
>mem_name
);
21119 wterm
("' preload file; will try 'plain'.");
21121 @.Sorry
, I can't find...@
>;
21123 /* now pull out all the stops
: try for the system \.
{plain
} file
*/
21124 xfree
(mp-
>mem_name
);
21125 mp-
>mem_name
= xstrdup
("plain");
21126 if
(mp_open_mem_name
(mp
))
21129 wake_up_terminal
();
21130 wterm_ln
("I can't find the 'plain' preload file!\n");
21131 @.I can't find PLAIN...@
>
21137 @ Operating systems often make it possible to determine the exact name
(and
21138 possible version number
) of a file that has been opened. The following routine
,
21139 which simply makes a \MP\ string from the value of |name_of_file|
, should
21140 ideally be changed to deduce the full name of file~|f|
, which is the file
21141 most recently opened
, if it is possible to do this.
21142 @^system dependencies@
>
21145 static mp_string mp_make_name_string
(MP mp
) {
21146 int k
; /* index into |name_of_file|
*/
21147 int name_length
= (int
) strlen
(mp-
>name_of_file
);
21148 str_room
(name_length
);
21149 for
(k
= 0; k
< name_length
; k
++) {
21150 append_char
(xord
((ASCII_code
) mp-
>name_of_file
[k
]));
21152 return mp_make_string
(mp
);
21156 @ Now let's consider the ``driver''
21157 routines by which \MP\ deals with file names
21158 in a system-independent manner. First comes a procedure that looks for a
21159 file name in the input by taking the information from the input buffer.
21160 (We can't use |get_next|
, because the conversion to tokens would
21161 destroy necessary information.
)
21163 This procedure doesn't allow semicolons or percent signs to be part of
21164 file names
, because of other conventions of \MP.
21165 {\sl The
{\logos METAFONT\
/}book
} doesn't
21166 use semicolons or percents immediately after file names
, but some users
21167 no doubt will find it natural to do so
; therefore system-dependent
21168 changes to allow such characters in file names should probably
21169 be made with reluctance
, and only when an entire file name that
21170 includes special characters is ``quoted'' somehow.
21171 @^system dependencies@
>
21174 static void mp_scan_file_name
(MP mp
) {
21175 mp_begin_name
(mp
);
21176 while
(mp-
>buffer
[loc
] == ' '
)
21179 if
((mp-
>buffer
[loc
] == '
;'
) ||
(mp-
>buffer
[loc
] == '
%'
))
21181 if
(!mp_more_name
(mp
, mp-
>buffer
[loc
]))
21189 @ Here is another version that takes its input from a string.
21191 @
<Declare subroutines for parsing file names@
>=
21192 void mp_str_scan_file
(MP mp
, mp_string s
);
21195 void mp_str_scan_file
(MP mp
, mp_string s
) {
21196 size_t p
, q
; /* current position and stopping point
*/
21197 mp_begin_name
(mp
);
21201 if
(!mp_more_name
(mp
, *(s-
>str
+ p
)))
21209 @ And one that reads from a |char
*|.
21211 @
<Declare subroutines for parsing file names@
>=
21212 extern void mp_ptr_scan_file
(MP mp
, char
*s
);
21215 void mp_ptr_scan_file
(MP mp
, char
*s
) {
21216 char
*p
, *q
; /* current position and stopping point
*/
21217 mp_begin_name
(mp
);
21219 q
= p
+ strlen
(s
);
21221 if
(!mp_more_name
(mp
, (ASCII_code
) (*p
)))
21229 @ The option variable |job_name| contains the file name that was first
21230 \
&{input} by the user. This name is used to initialize the |job_name| global
21231 as well as the |mp_job_name| internal
, and is extended by `\.
{.log
}' and
21232 `\.
{ps
}' and `\.
{.mem
}' and `\.
{.tfm
}' in order to make the names of \MP's
21236 boolean log_opened
; /* has the transcript file been opened?
*/
21237 char
*log_name
; /* full name of the log file
*/
21239 @ @
<Option variables@
>=
21240 char
*job_name
; /* principal file name
*/
21242 @ Initially |job_name
=NULL|
; it becomes nonzero as soon as the true name is known.
21243 We have |job_name
=NULL| if and only if the `\.
{log
}' file has not been opened
,
21244 except of course for a short time just after |job_name| has become nonzero.
21246 @
<Allocate or ...@
>=
21247 mp-
>job_name
= mp_xstrdup
(mp
, opt-
>job_name
);
21249 if
(mp-
>job_name
!= NULL) {
21250 char
*s
= mp-
>job_name
+ strlen
(mp-
>job_name
);
21251 while
(s
> mp-
>job_name
) {
21259 if
(opt-
>noninteractive
) {
21260 if
(mp-
>job_name
== NULL)
21261 mp-
>job_name
= mp_xstrdup
(mp
, mp-
>mem_name
);
21263 mp-
>log_opened
= false
;
21265 @ Cannot do this earlier because at the |
<Allocate or ...
>|
, the string
21266 pool is not yet initialized.
21268 @
<Fix up |mp-
>internal
[mp_job_name
]|@
>=
21269 if
(mp-
>job_name
!= NULL) {
21270 if
(internal_string
(mp_job_name
) != 0)
21271 delete_str_ref
(internal_string
(mp_job_name
));
21272 set_internal_string
(mp_job_name
, mp_rts
(mp
, mp-
>job_name
));
21275 @ @
<Dealloc variables@
>=
21276 xfree
(mp-
>job_name
);
21278 @ Here is a routine that manufactures the output file names
, assuming that
21279 |job_name
<>0|. It ignores and changes the current settings of |cur_area|
21282 @d pack_cur_name mp_pack_file_name
(mp
, mp-
>cur_name
,mp-
>cur_area
,mp-
>cur_ext
)
21284 @
<Internal library ...@
>=
21285 void mp_pack_job_name
(MP mp
, const char
*s
);
21288 void mp_pack_job_name
(MP mp
, const char
*s
) { /* |s
= ".log"|
, |
".mem"|
, |
".ps"|
, or .\\
{nnn
} */
21289 xfree
(mp-
>cur_name
);
21290 mp-
>cur_name
= xstrdup
(mp-
>job_name
);
21291 xfree
(mp-
>cur_area
);
21292 mp-
>cur_area
= xstrdup
("");
21293 xfree
(mp-
>cur_ext
);
21294 mp-
>cur_ext
= xstrdup
(s
);
21299 @ If some trouble arises when \MP\ tries to open a file
, the following
21300 routine calls upon the user to supply another file name. Parameter~|s|
21301 is used in the error message to identify the type of file
; parameter~|e|
21302 is the default extension if none is given. Upon exit from the routine
,
21303 variables |cur_name|
, |cur_area|
, |cur_ext|
, and |name_of_file| are
21304 ready for another attempt at file opening.
21306 @
<Internal library ...@
>=
21307 void mp_prompt_file_name
(MP mp
, const char
*s
, const char
*e
);
21310 void mp_prompt_file_name
(MP mp
, const char
*s
, const char
*e
) {
21311 size_t k
; /* index into |buffer|
*/
21312 char
*saved_cur_name
;
21313 if
(mp-
>interaction
== mp_scroll_mode
)
21314 wake_up_terminal
();
21315 if
(strcmp
(s
, "input file name") == 0) {
21316 mp_print_err
(mp
, "I can\'t open file `");
21317 @.I can't find file x@
>
21319 mp_print_err
(mp
, "I can\'t write on file `");
21320 @.I can't write on file x@
>
21322 if
(strcmp
(s
, "file name for output") == 0) {
21323 mp_print
(mp
, mp-
>name_of_file
);
21325 mp_print_file_name
(mp
, mp-
>cur_name
, mp-
>cur_area
, mp-
>cur_ext
);
21327 mp_print
(mp
, "'.");
21328 if
(strcmp
(e
, "") == 0)
21329 mp_show_context
(mp
);
21330 mp_print_nl
(mp
, "Please type another ");
21332 @.Please type...@
>;
21333 if
(mp-
>noninteractive || mp-
>interaction
< mp_scroll_mode
)
21334 mp_fatal_error
(mp
, "*** (job aborted, file error in nonstop mode)");
21335 @.job aborted
, file error...@
>;
21336 saved_cur_name
= xstrdup
(mp-
>cur_name
);
21338 prompt_input
(": ");
21339 @
<Scan file name in the buffer@
>;
21340 if
(strcmp
(mp-
>cur_ext
, "") == 0)
21341 mp-
>cur_ext
= xstrdup
(e
);
21342 if
(strlen
(mp-
>cur_name
) == 0) {
21343 mp-
>cur_name
= saved_cur_name
;
21345 xfree
(saved_cur_name
);
21351 @ @
<Scan file name in the buffer@
>=
21353 mp_begin_name
(mp
);
21355 while
((mp-
>buffer
[k
] == ' '
) && (k < mp->last))
21360 if
(!mp_more_name
(mp
, mp-
>buffer
[k
]))
21368 @ The |open_log_file| routine is used to open the transcript file and to help
21369 it catch up to what has previously been printed on the terminal.
21372 void mp_open_log_file
(MP mp
) {
21373 unsigned old_setting
; /* previous |selector| setting
*/
21374 int k
; /* index into |months| and |buffer|
*/
21375 int l
; /* end of first input line
*/
21376 integer m
; /* the current month
*/
21377 const char
*months
= "JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC";
21378 /* abbreviations of month names
*/
21379 if
(mp-
>log_opened
)
21381 old_setting
= mp-
>selector
;
21382 if
(mp-
>job_name
== NULL) {
21383 mp-
>job_name
= xstrdup
("mpout");
21384 @
<Fix up |mp-
>internal
[mp_job_name
]|@
>;
21386 mp_pack_job_name
(mp
, ".log");
21387 while
(!mp_open_out
(mp
, &mp->log_file, mp_filetype_log)) {
21388 @
<Try to get a different log file name@
>;
21390 mp-
>log_name
= xstrdup
(mp-
>name_of_file
);
21391 mp-
>selector
= log_only
;
21392 mp-
>log_opened
= true
;
21393 @
<Print the banner line
, including the date and time@
>;
21394 mp-
>input_stack
[mp-
>input_ptr
] = mp-
>cur_input
;
21395 /* make sure bottom level is in memory
*/
21396 if
(!mp-
>noninteractive
) {
21397 mp_print_nl
(mp
, "**");
21399 l
= mp-
>input_stack
[0].limit_field
- 1; /* last position of first line
*/
21400 for
(k
= 0; k
<= l
; k
++)
21401 mp_print_char
(mp
, mp-
>buffer
[k
]);
21402 mp_print_ln
(mp
); /* now the transcript file contains the first line of input
*/
21404 mp-
>selector
= old_setting
+ 2; /* |log_only| or |term_and_log|
*/
21408 @ @
<Dealloc variables@
>=
21409 xfree
(mp-
>log_name
);
21411 @ Sometimes |open_log_file| is called at awkward moments when \MP\ is
21412 unable to print error messages or even to |show_context|.
21413 The |prompt_file_name| routine can result in a |fatal_error|
, but the |error|
21414 routine will not be invoked because |log_opened| will be false.
21416 The normal idea of |mp_batch_mode| is that nothing at all should be written
21417 on the terminal. However
, in the unusual case that
21418 no log file could be opened
, we make an exception and allow
21419 an explanatory message to be seen.
21421 Incidentally
, the program always refers to the log file as a `\.
{transcript
21422 file
}'
, because some systems cannot use the extension `\.
{.log
}' for
21425 @
<Try to get a different log file name@
>=
21427 mp-
>selector
= term_only
;
21428 mp_prompt_file_name
(mp
, "transcript file name", ".log");
21432 @ @
<Print the banner...@
>=
21435 mp_print
(mp
, " ");
21436 mp_print_int
(mp
, round_unscaled
(internal_value
(mp_day
)));
21437 mp_print_char
(mp
, xord
(' '
));
21438 m
= round_unscaled
(internal_value
(mp_month
));
21439 for
(k
= 3 * m
- 3; k
< 3 * m
; k
++) {
21440 wlog_chr
((unsigned char
) months
[k
]);
21442 mp_print_char
(mp
, xord
(' '
));
21443 mp_print_int
(mp
, round_unscaled
(internal_value
(mp_year
)));
21444 mp_print_char
(mp
, xord
(' '
));
21445 mp_print_dd
(mp
, round_unscaled
(internal_value
(mp_hour
)));
21446 mp_print_char
(mp
, xord
('
:'
));
21447 mp_print_dd
(mp
, round_unscaled
(internal_value
(mp_minute
)));
21451 @ The |try_extension| function tries to open an input file determined by
21452 |cur_name|
, |cur_area|
, and the argument |ext|. It returns |false| if it
21453 can't find the file in |cur_area| or the appropriate system area.
21456 static boolean mp_try_extension
(MP mp
, const char
*ext
) {
21457 mp_pack_file_name
(mp
, mp-
>cur_name
, mp-
>cur_area
, ext
);
21458 in_name
= xstrdup
(mp-
>cur_name
);
21459 in_area
= xstrdup
(mp-
>cur_area
);
21460 in_ext
= xstrdup
(ext
);
21461 if
(mp_open_in
(mp
, &cur_file, mp_filetype_program)) {
21464 mp_pack_file_name
(mp
, mp-
>cur_name
, NULL, ext
);
21465 return mp_open_in
(mp
, &cur_file, mp_filetype_program);
21470 @ Let's turn now to the procedure that is used to initiate file reading
21471 when an `\.
{input
}' command is being processed.
21474 void mp_start_input
(MP mp
) { /* \MP\ will \.
{input
} something
*/
21475 char
*fname
= NULL;
21476 @
<Put the desired file name in |
(cur_name
,cur_ext
,cur_area
)|@
>;
21478 mp_begin_file_reading
(mp
); /* set up |cur_file| and new level of input
*/
21479 if
(strlen
(mp-
>cur_ext
) == 0) {
21480 if
(mp_try_extension
(mp
, ".mp"))
21482 else if
(mp_try_extension
(mp
, ""))
21484 else if
(mp_try_extension
(mp
, ".mf"))
21486 } else if
(mp_try_extension
(mp
, mp-
>cur_ext
)) {
21489 mp_end_file_reading
(mp
); /* remove the level that didn't work
*/
21490 mp_prompt_file_name
(mp
, "input file name", "");
21492 name
= mp_make_name_string
(mp
);
21493 fname
= xstrdup
(mp-
>name_of_file
);
21494 if
(mp-
>job_name
== NULL) {
21495 mp-
>job_name
= xstrdup
(mp-
>cur_name
);
21496 @
<Fix up |mp-
>internal
[mp_job_name
]|@
>;
21498 if
(!mp-
>log_opened
) {
21499 mp_open_log_file
(mp
);
21500 } /* |open_log_file| doesn't |show_context|
, so |limit|
21501 and |loc| needn't be set to meaningful values yet
*/
21502 if
(((int
) mp-
>term_offset
+ (int
) strlen
(fname
)) > (mp-
>max_print_line
- 2))
21504 else if
((mp-
>term_offset
> 0) ||
(mp-
>file_offset
> 0))
21505 mp_print_char
(mp
, xord
(' '
));
21506 mp_print_char
(mp
, xord
('
('
));
21507 incr
(mp-
>open_parens
);
21508 mp_print
(mp
, fname
);
21511 @
<Flush |name| and replace it with |cur_name| if it won't be needed@
>;
21512 @
<Read the first line of the new file@
>;
21516 @ This code should be omitted if |make_name_string| returns something other
21517 than just a copy of its argument and the full file name is needed for opening
21518 \.
{MPX
} files or implementing the switch-to-editor option.
21519 @^system dependencies@
>
21521 @
<Flush |name| and replace it with |cur_name| if it won't be needed@
>=
21522 mp_flush_string
(mp
, name
);
21523 name
= mp_rts
(mp
, mp-
>cur_name
);
21524 xfree
(mp-
>cur_name
)
21527 @ If the file is empty
, it is considered to contain a single blank line
,
21528 so there is no need to test the return value.
21530 @
<Read the first line...@
>=
21533 (void
) mp_input_ln
(mp
, cur_file
);
21534 mp_firm_up_the_line
(mp
);
21535 mp-
>buffer
[limit
] = xord
('
%'
);
21536 mp-
>first
= (size_t
) (limit
+ 1);
21541 @ @
<Put the desired file name in |
(cur_name
,cur_ext
,cur_area
)|@
>=
21542 while
(token_state
&& (nloc == NULL))
21543 mp_end_token_list
(mp
);
21545 const char
*hlp
[] = {
21546 "Sorry...I've converted what follows to tokens,",
21547 "possibly garbaging the name you gave.",
21548 "Please delete the tokens and insert the name again.",
21550 mp_error
(mp
, "File names can't appear within macros", hlp
, true
);
21551 @.File names can't...@
>;
21554 mp_scan_file_name
(mp
);
21556 xfree
(mp-
>cur_name
);
21557 mp-
>cur_name
= xstrdup
("");
21558 xfree
(mp-
>cur_ext
);
21559 mp-
>cur_ext
= xstrdup
("");
21560 xfree
(mp-
>cur_area
);
21561 mp-
>cur_area
= xstrdup
("");
21565 @ The following simple routine starts reading the \.
{MPX
} file associated
21566 with the current input file.
21569 void mp_start_mpx_input
(MP mp
) {
21570 char
*origname
= NULL; /* a copy of nameoffile
*/
21571 mp_pack_file_name
(mp
, in_name
, in_area
, in_ext
);
21572 origname
= xstrdup
(mp-
>name_of_file
);
21573 mp_pack_file_name
(mp
, in_name
, in_area
, ".mpx");
21574 if
(!(mp-
>run_make_mpx
) (mp
, origname
, mp-
>name_of_file
))
21576 mp_begin_file_reading
(mp
);
21577 if
(!mp_open_in
(mp
, &cur_file, mp_filetype_program)) {
21578 mp_end_file_reading
(mp
);
21581 name
= mp_make_name_string
(mp
);
21582 mp-
>mpx_name
[iindex
] = name
;
21583 add_str_ref
(name
);
21584 @
<Read the first line of the new file@
>;
21588 @
<Explain that the \.
{MPX
} file can't be read and |succumb|@
>;
21593 @ This should ideally be changed to do whatever is necessary to create the
21594 \.
{MPX
} file given by |name_of_file| if it does not exist or if it is out
21595 of date. This requires invoking \.
{MPtoTeX
} on the |origname| and passing
21596 the results through \TeX\ and \.
{DVItoMP
}.
(It is possible to use a
21597 completely different typesetting program if suitable postprocessor is
21598 available to perform the function of \.
{DVItoMP
}.
)
21599 @^system dependencies@
>
21601 @ @
<Exported types@
>=
21602 typedef int
(*mp_makempx_cmd
) (MP mp
, char
*origname
, char
*mtxname
);
21604 @ @
<Option variables@
>=
21605 mp_makempx_cmd run_make_mpx
;
21607 @ @
<Allocate or initialize ...@
>=
21608 set_callback_option
(run_make_mpx
);
21610 @ @
<Declarations@
>=
21611 static int mp_run_make_mpx
(MP mp
, char
*origname
, char
*mtxname
);
21613 @ The default does nothing.
21615 int mp_run_make_mpx
(MP mp
, char
*origname
, char
*mtxname
) {
21623 @ @
<Explain that the \.
{MPX
} file can't be read and |succumb|@
>=
21625 const char
*hlp
[] = {
21626 "The two files given above are one of your source files",
21627 "and an auxiliary file I need to read to find out what your",
21628 "btex..etex blocks mean. If you don't know why I had trouble,",
21629 "try running it manually through MPtoTeX, TeX, and DVItoMP",
21631 if
(mp-
>interaction
== mp_error_stop_mode
)
21632 wake_up_terminal
();
21633 mp_print_nl
(mp
, ">> ");
21634 mp_print
(mp
, origname
);
21635 mp_print_nl
(mp
, ">> ");
21636 mp_print
(mp
, mp-
>name_of_file
);
21638 if
( mp-
>interaction
==mp_error_stop_mode
)
21639 mp-
>interaction
=mp_scroll_mode
; /* no more interaction
*/
21640 if
( mp-
>log_opened
)
21641 mp_error
(mp
, "! Unable to read mpx file", hlp
, true
);
21642 mp-
>history
=mp_fatal_error_stop
;
21643 mp_jump_out
(mp
); /* irrecoverable error
*/
21646 @ The last file-opening commands are for files accessed via the \
&{readfrom}
21647 @
:read_from_
}{\
&{readfrom} primitive@>
21648 operator and the \
&{write} command. Such files are stored in separate arrays.
21649 @
:write_
}{\
&{write} primitive@>
21651 @
<Types in the outer block@
>=
21652 typedef unsigned int readf_index
; /* |
0..max_read_files|
*/
21653 typedef unsigned int write_index
; /* |
0..max_write_files|
*/
21656 readf_index max_read_files
; /* maximum number of simultaneously open \
&{readfrom} files */
21657 void
**rd_file
; /* \
&{readfrom} files */
21658 char
**rd_fname
; /* corresponding file name or
0 if file not open
*/
21659 readf_index read_files
; /* number of valid entries in the above arrays
*/
21660 write_index max_write_files
; /* maximum number of simultaneously open \
&{write} */
21661 void
**wr_file
; /* \
&{write} files */
21662 char
**wr_fname
; /* corresponding file name or
0 if file not open
*/
21663 write_index write_files
; /* number of valid entries in the above arrays
*/
21665 @ @
<Allocate or initialize ...@
>=
21666 mp-
>max_read_files
= 8;
21667 mp-
>rd_file
= xmalloc
((mp-
>max_read_files
+ 1), sizeof
(void
*));
21668 mp-
>rd_fname
= xmalloc
((mp-
>max_read_files
+ 1), sizeof
(char
*));
21669 memset
(mp-
>rd_fname
, 0, sizeof
(char
*) * (mp-
>max_read_files
+ 1));
21670 mp-
>max_write_files
= 8;
21671 mp-
>wr_file
= xmalloc
((mp-
>max_write_files
+ 1), sizeof
(void
*));
21672 mp-
>wr_fname
= xmalloc
((mp-
>max_write_files
+ 1), sizeof
(char
*));
21673 memset
(mp-
>wr_fname
, 0, sizeof
(char
*) * (mp-
>max_write_files
+ 1));
21676 @ This routine starts reading the file named by string~|s| without setting
21677 |loc|
, |limit|
, or |name|. It returns |false| if the file is empty or cannot
21678 be opened. Otherwise it updates |rd_file
[n
]| and |rd_fname
[n
]|.
21681 static boolean mp_start_read_input
(MP mp
, char
*s
, readf_index n
) {
21682 mp_ptr_scan_file
(mp
, s
);
21684 mp_begin_file_reading
(mp
);
21685 if
(!mp_open_in
(mp
, &mp->rd_file[n], (int) (mp_filetype_text + n)))
21687 if
(!mp_input_ln
(mp
, mp-
>rd_file
[n
])) {
21688 (mp-
>close_file
) (mp
, mp-
>rd_file
[n
]);
21691 mp-
>rd_fname
[n
] = xstrdup
(s
);
21694 mp_end_file_reading
(mp
);
21699 @ Open |wr_file
[n
]| using file name~|s| and update |wr_fname
[n
]|.
21702 static void mp_open_write_file
(MP mp
, char
*s
, readf_index n
);
21705 void mp_open_write_file
(MP mp
, char
*s
, readf_index n
) {
21706 mp_ptr_scan_file
(mp
, s
);
21708 while
(!mp_open_out
(mp
, &mp->wr_file[n], (int) (mp_filetype_text + n)))
21709 mp_prompt_file_name
(mp
, "file name for write output", "");
21710 mp-
>wr_fname
[n
] = xstrdup
(s
);
21714 @
* Introduction to the parsing routines.
21715 We come now to the central nervous system that sparks many of \MP's activities.
21716 By evaluating expressions
, from their primary constituents to ever larger
21717 subexpressions
, \MP\ builds the structures that ultimately define complete
21718 pictures or fonts of type.
21720 Four mutually recursive subroutines are involved in this process
: We call them
21721 $$\hbox
{|scan_primary|
, |scan_secondary|
, |scan_tertiary|
,
21722 and |scan_expression|.
}$$
21724 Each of them is parameterless and begins with the first token to be scanned
21725 already represented in |cur_cmd|
, |cur_mod|
, and |cur_sym|. After execution
,
21726 the value of the primary or secondary or tertiary or expression that was
21727 found will appear in the global variables |cur_type| and |cur_exp|. The
21728 token following the expression will be represented in |cur_cmd|
, |cur_mod|
,
21731 Technically speaking
, the parsing algorithms are ``LL
(1),'' more or less
;
21732 backup mechanisms have been added in order to provide reasonable error
21735 @d cur_exp_value_boolean
() number_to_int
(mp-
>cur_exp.data.n
)
21736 @d cur_exp_value_number
() mp-
>cur_exp.data.n
21737 @d cur_exp_node
() mp-
>cur_exp.data.node
21738 @d cur_exp_str
() mp-
>cur_exp.data.str
21739 @d cur_exp_knot
() mp-
>cur_exp.data.p
21741 @d set_cur_exp_value_scaled
(A
) do
{
21742 if
(cur_exp_str
()) {
21743 delete_str_ref
(cur_exp_str
());
21745 set_number_from_scaled
(mp-
>cur_exp.data.n
, (A
));
21746 cur_exp_node
() = NULL;
21747 cur_exp_str
() = NULL;
21748 cur_exp_knot
() = NULL;
21750 @d set_cur_exp_value_boolean
(A
) do
{
21751 if
(cur_exp_str
()) {
21752 delete_str_ref
(cur_exp_str
());
21754 set_number_from_int
(mp-
>cur_exp.data.n
, (A
));
21755 cur_exp_node
() = NULL;
21756 cur_exp_str
() = NULL;
21757 cur_exp_knot
() = NULL;
21759 @d set_cur_exp_value_number
(A
) do
{
21760 if
(cur_exp_str
()) {
21761 delete_str_ref
(cur_exp_str
());
21763 number_clone
(mp-
>cur_exp.data.n
, (A
));
21764 cur_exp_node
() = NULL;
21765 cur_exp_str
() = NULL;
21766 cur_exp_knot
() = NULL;
21768 @d set_cur_exp_node
(A
) do
{
21769 if
(cur_exp_str
()) {
21770 delete_str_ref
(cur_exp_str
());
21772 cur_exp_node
() = A
;
21773 cur_exp_str
() = NULL;
21774 cur_exp_knot
() = NULL;
21775 set_number_to_zero
(mp-
>cur_exp.data.n
);
21777 @d set_cur_exp_str
(A
) do
{
21778 if
(cur_exp_str
()) {
21779 delete_str_ref
(cur_exp_str
());
21782 add_str_ref
(cur_exp_str
());
21783 cur_exp_node
() = NULL;
21784 cur_exp_knot
() = NULL;
21785 set_number_to_zero
(mp-
>cur_exp.data.n
);
21787 @d set_cur_exp_knot
(A
) do
{
21788 if
(cur_exp_str
()) {
21789 delete_str_ref
(cur_exp_str
());
21791 cur_exp_knot
() = A
;
21792 cur_exp_node
() = NULL;
21793 cur_exp_str
() = NULL;
21794 set_number_to_zero
(mp-
>cur_exp.data.n
);
21799 mp_value cur_exp
; /* the value of the expression just found
*/
21802 memset
(&mp->cur_exp.data, 0, sizeof (mp_value));
21803 new_number
(mp-
>cur_exp.data.n
);
21805 @ @
<Free table ...@
>=
21806 free_number
(mp-
>cur_exp.data.n
);
21808 @ Many different kinds of expressions are possible
, so it is wise to have
21809 precise descriptions of what |cur_type| and |cur_exp| mean in all cases
:
21812 |cur_type
=mp_vacuous| means that this expression didn't turn out to have a
21813 value at all
, because it arose from a \
&{begingroup}$\,\ldots\,$\&{endgroup}
21814 construction in which there was no expression before the \
&{endgroup}.
21815 In this case |cur_exp| has some irrelevant value.
21818 |cur_type
=mp_boolean_type| means that |cur_exp| is either |true_code|
21822 |cur_type
=mp_unknown_boolean| means that |cur_exp| points to a capsule
21824 a ring of equivalent booleans whose value has not yet been defined.
21827 |cur_type
=mp_string_type| means that |cur_exp| is a string number
(i.e.
, an
21828 integer in the range |
0<=cur_exp
<str_ptr|
). That string's reference count
21829 includes this particular reference.
21832 |cur_type
=mp_unknown_string| means that |cur_exp| points to a capsule
21834 a ring of equivalent strings whose value has not yet been defined.
21837 |cur_type
=mp_pen_type| means that |cur_exp| points to a node in a pen. Nobody
21838 else points to any of the nodes in this pen. The pen may be polygonal or
21842 |cur_type
=mp_unknown_pen| means that |cur_exp| points to a capsule
21844 a ring of equivalent pens whose value has not yet been defined.
21847 |cur_type
=mp_path_type| means that |cur_exp| points to a the first node of
21848 a path
; nobody else points to this particular path. The control points of
21849 the path will have been chosen.
21852 |cur_type
=mp_unknown_path| means that |cur_exp| points to a capsule
21854 a ring of equivalent paths whose value has not yet been defined.
21857 |cur_type
=mp_picture_type| means that |cur_exp| points to an edge header node.
21858 There may be other pointers to this particular set of edges. The header node
21859 contains a reference count that includes this particular reference.
21862 |cur_type
=mp_unknown_picture| means that |cur_exp| points to a capsule
21864 a ring of equivalent pictures whose value has not yet been defined.
21867 |cur_type
=mp_transform_type| means that |cur_exp| points to a |mp_transform_type|
21868 capsule node. The |value| part of this capsule
21869 points to a transform node that contains six numeric values
,
21870 each of which is |independent|
, |dependent|
, |mp_proto_dependent|
, or |known|.
21873 |cur_type
=mp_color_type| means that |cur_exp| points to a |color_type|
21874 capsule node. The |value| part of this capsule
21875 points to a color node that contains three numeric values
,
21876 each of which is |independent|
, |dependent|
, |mp_proto_dependent|
, or |known|.
21879 |cur_type
=mp_cmykcolor_type| means that |cur_exp| points to a |mp_cmykcolor_type|
21880 capsule node. The |value| part of this capsule
21881 points to a color node that contains four numeric values
,
21882 each of which is |independent|
, |dependent|
, |mp_proto_dependent|
, or |known|.
21885 |cur_type
=mp_pair_type| means that |cur_exp| points to a capsule
21886 node whose type is |mp_pair_type|. The |value| part of this capsule
21887 points to a pair node that contains two numeric values
,
21888 each of which is |independent|
, |dependent|
, |mp_proto_dependent|
, or |known|.
21891 |cur_type
=mp_known| means that |cur_exp| is a |scaled| value.
21894 |cur_type
=mp_dependent| means that |cur_exp| points to a capsule node whose type
21895 is |dependent|. The |dep_list| field in this capsule points to the associated
21899 |cur_type
=mp_proto_dependent| means that |cur_exp| points to a |mp_proto_dependent|
21900 capsule node. The |dep_list| field in this capsule
21901 points to the associated dependency list.
21904 |cur_type
=independent| means that |cur_exp| points to a capsule node
21905 whose type is |independent|. This somewhat unusual case can arise
, for
21906 example
, in the expression
21907 `$x
+\
&{begingroup}\penalty0\,\&{string}\,x; 0\,\&{endgroup}$'.
21910 |cur_type
=mp_token_list| means that |cur_exp| points to a linked list of
21913 \smallskip\noindent
21914 The possible settings of |cur_type| have been listed here in increasing
21915 numerical order. Notice that |cur_type| will never be |mp_numeric_type| or
21916 |suffixed_macro| or |mp_unsuffixed_macro|
, although variables of those types
21917 are allowed. Conversely
, \MP\ has no variables of type |mp_vacuous| or
21920 @ Capsules are non-symbolic nodes that have a similar meaning
21921 to |cur_type| and |cur_exp|. Such nodes have |name_type
=capsule|
,
21922 and their |type| field is one of the possibilities for |cur_type| listed above.
21923 Also |link
<=void| in capsules that aren't part of a token list.
21925 The |value| field of a capsule is
, in most cases
, the value that
21926 corresponds to its |type|
, as |cur_exp| corresponds to |cur_type|.
21927 However
, when |cur_exp| would point to a capsule
,
21928 no extra layer of indirection is present
; the |value|
21929 field is what would have been called |value
(cur_exp
)| if it had not been
21930 encapsulated. Furthermore
, if the type is |dependent| or
21931 |mp_proto_dependent|
, the |value| field of a capsule is replaced by
21932 |dep_list| and |prev_dep| fields
, since dependency lists in capsules are
21933 always part of the general |dep_list| structure.
21935 The |get_x_next| routine is careful not to change the values of |cur_type|
21936 and |cur_exp| when it gets an expanded token. However
, |get_x_next| might
21937 call a macro
, which might parse an expression
, which might execute lots of
21938 commands in a group
; hence it's possible that |cur_type| might change
21939 from
, say
, |mp_unknown_boolean| to |mp_boolean_type|
, or from |dependent| to
21940 |known| or |independent|
, during the time |get_x_next| is called. The
21941 programs below are careful to stash sensitive intermediate results in
21942 capsules
, so that \MP's generality doesn't cause trouble.
21944 Here's a procedure that illustrates these conventions. It takes
21945 the contents of $
(|cur_type|\kern-
.3pt
,|cur_exp|\kern-
.3pt
)$
21946 and stashes them away in a
21947 capsule. It is not used when |cur_type
=mp_token_list|.
21948 After the operation
, |cur_type
=mp_vacuous|
; hence there is no need to
21949 copy path lists or to update reference counts
, etc.
21951 The special link |MP_VOID| is put on the capsule returned by
21952 |stash_cur_exp|
, because this procedure is used to store macro parameters
21953 that must be easily distinguishable from token lists.
21955 @
<Declare the stashing
/unstashing routines@
>=
21956 static mp_node mp_stash_cur_exp
(MP mp
) {
21957 mp_node p
; /* the capsule that will be returned
*/
21958 mp_variable_type exp_type
= mp-
>cur_exp.type
;
21959 switch
(exp_type
) {
21960 case unknown_types
:
21961 case mp_transform_type
:
21962 case mp_color_type
:
21965 case mp_proto_dependent
:
21966 case mp_independent
:
21967 case mp_cmykcolor_type
:
21968 p
= cur_exp_node
();
21970 /* |case mp_path_type
: case mp_pen_type
: case mp_string_type
:|
*/
21972 p
= mp_get_value_node
(mp
);
21973 mp_name_type
(p
) = mp_capsule
;
21974 mp_type
(p
) = mp-
>cur_exp.type
;
21975 set_value_number
(p
, cur_exp_value_number
()); /* this also resets the rest to
0/NULL */
21976 if
(cur_exp_str
()) {
21977 set_value_str
(p
, cur_exp_str
());
21978 } else if
(cur_exp_knot
()) {
21979 set_value_knot
(p
, cur_exp_knot
());
21980 } else if
(cur_exp_node
()) {
21981 set_value_node
(p
, cur_exp_node
());
21985 mp-
>cur_exp.type
= mp_vacuous
;
21986 mp_link
(p
) = MP_VOID
;
21991 @ The inverse of |stash_cur_exp| is the following procedure
, which
21992 deletes an unnecessary capsule and puts its contents into |cur_type|
21995 The program steps of \MP\ can be divided into two categories
: those in
21996 which |cur_type| and |cur_exp| are ``alive'' and those in which they are
21997 ``dead
,'' in the sense that |cur_type| and |cur_exp| contain relevant
21998 information or not. It's important not to ignore them when they're alive
,
21999 and it's important not to pay attention to them when they're dead.
22001 There's also an intermediate category
: If |cur_type
=mp_vacuous|
, then
22002 |cur_exp| is irrelevant
, hence we can proceed without caring if |cur_type|
22003 and |cur_exp| are alive or dead. In such cases we say that |cur_type|
22004 and |cur_exp| are
{\sl dormant
}. It is permissible to call |get_x_next|
22005 only when they are alive or dormant.
22007 The \\
{stash
} procedure above assumes that |cur_type| and |cur_exp|
22008 are alive or dormant. The \\
{unstash
} procedure assumes that they are
22009 dead or dormant
; it resuscitates them.
22011 @
<Declare the stashing
/unstashing...@
>=
22012 static void mp_unstash_cur_exp
(MP mp
, mp_node p
);
22015 void mp_unstash_cur_exp
(MP mp
, mp_node p
) {
22016 mp-
>cur_exp.type
= mp_type
(p
);
22017 switch
(mp-
>cur_exp.type
) {
22018 case unknown_types
:
22019 case mp_transform_type
:
22020 case mp_color_type
:
22023 case mp_proto_dependent
:
22024 case mp_independent
:
22025 case mp_cmykcolor_type
:
22026 set_cur_exp_node
(p
);
22028 case mp_token_list
: /* this is how symbols are stashed
*/
22029 set_cur_exp_node
(value_node
(p
));
22030 mp_free_value_node
(mp
, p
);
22034 set_cur_exp_knot
(value_knot
(p
));
22035 mp_free_value_node
(mp
, p
);
22037 case mp_string_type
:
22038 set_cur_exp_str
(value_str
(p
));
22039 mp_free_value_node
(mp
, p
);
22041 case mp_picture_type
:
22042 set_cur_exp_node
(value_node
(p
));
22043 mp_free_value_node
(mp
, p
);
22045 case mp_boolean_type
:
22047 set_cur_exp_value_number
(value_number
(p
));
22048 mp_free_value_node
(mp
, p
);
22051 set_cur_exp_value_number
(value_number
(p
));
22052 if
(value_knot
(p
)) {
22053 set_cur_exp_knot
(value_knot
(p
));
22054 } else if
(value_node
(p
)) {
22055 set_cur_exp_node
(value_node
(p
));
22056 } else if
(value_str
(p
)) {
22057 set_cur_exp_str
(value_str
(p
));
22059 mp_free_value_node
(mp
, p
);
22065 @ The following procedure prints the values of expressions in an
22066 abbreviated format. If its first parameter |p| is
NULL, the value of
22067 |
(cur_type
,cur_exp
)| is displayed
; otherwise |p| should be a capsule
22068 containing the desired value. The second parameter controls the amount of
22069 output. If it is~
0, dependency lists will be abbreviated to
22070 `\.
{linearform
}' unless they consist of a single term. If it is greater
22071 than~
1, complicated structures
(pens
, pictures
, and paths
) will be displayed
22076 @
<Declare the procedure called |print_dp|@
>;
22077 @
<Declare the stashing
/unstashing routines@
>;
22078 static void mp_print_exp
(MP mp
, mp_node p
, quarterword verbosity
);
22081 void mp_print_exp
(MP mp
, mp_node p
, quarterword verbosity
) {
22082 boolean restore_cur_exp
; /* should |cur_exp| be restored?
*/
22083 mp_variable_type t
; /* the type of the expression
*/
22084 mp_number vv
; /* the value of the expression
*/
22088 restore_cur_exp
= false
;
22090 p
= mp_stash_cur_exp
(mp
);
22091 restore_cur_exp
= true
;
22094 if
(t
< mp_dependent
) { /* no dep list
, could be a capsule
*/
22095 if
(t
!= mp_vacuous
&& t != mp_known && value_node (p) != NULL)
22096 v
= value_node
(p
);
22098 number_clone
(vv
, value_number
(p
));
22099 } else if
(t
< mp_independent
) {
22100 v
= (mp_node
) dep_list
((mp_value_node
) p
);
22102 @
<Print an abbreviated value of |v| or |vv| with format depending on |t|@
>;
22103 if
(restore_cur_exp
)
22104 mp_unstash_cur_exp
(mp
, p
);
22109 @ @
<Print an abbreviated value of |v| or |vv| with format depending on |t|@
>=
22112 mp_print
(mp
, "vacuous");
22114 case mp_boolean_type
:
22115 if
(number_to_boolean
(vv
) == mp_true_code
)
22116 mp_print
(mp
, "true");
22118 mp_print
(mp
, "false");
22120 case unknown_types
:
22121 case mp_numeric_type
:
22122 @
<Display a variable that's been declared but not defined@
>;
22124 case mp_string_type
:
22125 mp_print_char
(mp
, xord
('
"'));
22126 mp_print_str (mp, value_str (p));
22127 mp_print_char (mp, xord ('"'
));
22131 case mp_picture_type
:
22132 @
<Display a complex type@
>;
22134 case mp_transform_type
:
22135 if
(number_zero
(vv
) && v == NULL)
22136 mp_print_type
(mp
, t
);
22138 @
<Display a transform node@
>;
22140 case mp_color_type
:
22141 if
(number_zero
(vv
) && v == NULL)
22142 mp_print_type
(mp
, t
);
22144 @
<Display a color node@
>;
22147 if
(number_zero
(vv
) && v == NULL)
22148 mp_print_type
(mp
, t
);
22150 @
<Display a pair node@
>;
22152 case mp_cmykcolor_type
:
22153 if
(number_zero
(vv
) && v == NULL)
22154 mp_print_type
(mp
, t
);
22156 @
<Display a cmykcolor node@
>;
22162 case mp_proto_dependent
:
22163 mp_print_dp
(mp
, t
, (mp_value_node
) v
, verbosity
);
22165 case mp_independent
:
22166 mp_print_variable_name
(mp
, p
);
22169 mp_confusion
(mp
, "exp");
22171 @
:this can't happen exp
}{\quad exp@
>
22175 @ @
<Display big node item |v|@
>=
22177 if
(mp_type
(v
) == mp_known
)
22178 print_number
(value_number
(v
));
22179 else if
(mp_type
(v
) == mp_independent
)
22180 mp_print_variable_name
(mp
, v
);
22182 mp_print_dp
(mp
, mp_type
(v
), (mp_value_node
) dep_list
((mp_value_node
) v
),
22187 @ In these cases
, |v| starts as the big node.
22189 @
<Display a pair node@
>=
22192 mp_print_char
(mp
, xord
('
('
));
22193 /* clang
: dereference of null pointer
*/ assert
(vvv
);
22195 @
<Display big node item |v|@
>;
22196 mp_print_char
(mp
, xord
('
,'
));
22198 @
<Display big node item |v|@
>;
22199 mp_print_char
(mp
, xord
('
)'
));
22203 @ @
<Display a transform node@
>=
22206 mp_print_char
(mp
, xord
('
('
));
22207 /* clang
: dereference of null pointer
*/ assert
(vvv
);
22209 @
<Display big node item |v|@
>;
22210 mp_print_char
(mp
, xord
('
,'
));
22212 @
<Display big node item |v|@
>;
22213 mp_print_char
(mp
, xord
('
,'
));
22215 @
<Display big node item |v|@
>;
22216 mp_print_char
(mp
, xord
('
,'
));
22218 @
<Display big node item |v|@
>;
22219 mp_print_char
(mp
, xord
('
,'
));
22221 @
<Display big node item |v|@
>;
22222 mp_print_char
(mp
, xord
('
,'
));
22224 @
<Display big node item |v|@
>;
22225 mp_print_char
(mp
, xord
('
)'
));
22229 @ @
<Display a color node@
>=
22232 mp_print_char
(mp
, xord
('
('
));
22233 /* clang
: dereference of null pointer
*/ assert
(vvv
);
22234 v
= red_part
(vvv
);
22235 @
<Display big node item |v|@
>;
22236 mp_print_char
(mp
, xord
('
,'
));
22237 v
= green_part
(vvv
);
22238 @
<Display big node item |v|@
>;
22239 mp_print_char
(mp
, xord
('
,'
));
22240 v
= blue_part
(vvv
);
22241 @
<Display big node item |v|@
>;
22242 mp_print_char
(mp
, xord
('
)'
));
22246 @ @
<Display a cmykcolor node@
>=
22249 mp_print_char
(mp
, xord
('
('
));
22250 /* clang
: dereference of null pointer
*/ assert
(vvv
);
22251 v
= cyan_part
(vvv
);
22252 @
<Display big node item |v|@
>;
22253 mp_print_char
(mp
, xord
('
,'
));
22254 v
= magenta_part
(vvv
);
22255 @
<Display big node item |v|@
>;
22256 mp_print_char
(mp
, xord
('
,'
));
22257 v
= yellow_part
(vvv
);
22258 @
<Display big node item |v|@
>;
22259 mp_print_char
(mp
, xord
('
,'
));
22260 v
= black_part
(vvv
);
22261 @
<Display big node item |v|@
>;
22262 mp_print_char
(mp
, xord
('
)'
));
22266 @ Values of type \
&{picture}, \&{path}, and \&{pen} are displayed verbosely
22267 in the log file only
, unless the user has given a positive value to
22270 @
<Display a complex type@
>=
22271 if
(verbosity
<= 1) {
22272 mp_print_type
(mp
, t
);
22274 if
(mp-
>selector
== term_and_log
)
22275 if
(number_nonpositive
(internal_value
(mp_tracing_online
))) {
22276 mp-
>selector
= term_only
;
22277 mp_print_type
(mp
, t
);
22278 mp_print
(mp
, " (see the transcript file)");
22279 mp-
>selector
= term_and_log
;
22283 mp_print_pen
(mp
, value_knot
(p
), "", false
);
22286 mp_print_path
(mp
, value_knot
(p
), "", false
);
22288 case mp_picture_type
:
22289 mp_print_edges
(mp
, v
, "", false
);
22297 @ @
<Declare the procedure called |print_dp|@
>=
22298 static void mp_print_dp
(MP mp
, quarterword t
, mp_value_node p
,
22299 quarterword verbosity
) {
22300 mp_value_node q
; /* the node following |p|
*/
22301 q
= (mp_value_node
) mp_link
(p
);
22302 if
((dep_info
(q
) == NULL) ||
(verbosity
> 0))
22303 mp_print_dependency
(mp
, p
, t
);
22305 mp_print
(mp
, "linearform");
22309 @ The displayed name of a variable in a ring will not be a capsule unless
22310 the ring consists entirely of capsules.
22312 @
<Display a variable that's been declared but not defined@
>=
22314 mp_print_type
(mp
, t
);
22316 mp_print_char
(mp
, xord
(' '
));
22317 while
((mp_name_type
(v
) == mp_capsule
) && (v != p))
22318 v
= value_node
(v
);
22319 mp_print_variable_name
(mp
, v
);
22324 @ When errors are detected during parsing
, it is often helpful to
22325 display an expression just above the error message
, using |disp_err|
22326 just before |mp_error|.
22329 static void mp_disp_err
(MP mp
, mp_node p
);
22332 void mp_disp_err
(MP mp
, mp_node p
) {
22333 if
(mp-
>interaction
== mp_error_stop_mode
)
22334 wake_up_terminal
();
22335 mp_print_nl
(mp
, ">> ");
22337 mp_print_exp
(mp
, p
, 1); /* ``medium verbose'' printing of the expression
*/
22341 @ If |cur_type| and |cur_exp| contain relevant information that should
22342 be recycled
, we will use the following procedure
, which changes |cur_type|
22343 to |known| and stores a given value in |cur_exp|. We can think of |cur_type|
22344 and |cur_exp| as either alive or dormant after this has been done
,
22345 because |cur_exp| will not contain a pointer value.
22348 void mp_flush_cur_exp
(MP mp
, mp_value v
) {
22349 if
(is_number
(mp-
>cur_exp.data.n
)) {
22350 free_number
(mp-
>cur_exp.data.n
);
22352 switch
(mp-
>cur_exp.type
) {
22353 case unknown_types
:
22354 case mp_transform_type
:
22355 case mp_color_type
:
22358 case mp_proto_dependent
:
22359 case mp_independent
:
22360 case mp_cmykcolor_type
:
22361 mp_recycle_value
(mp
, cur_exp_node
());
22362 mp_free_value_node
(mp
, cur_exp_node
());
22364 case mp_string_type
:
22365 delete_str_ref
(cur_exp_str
());
22369 mp_toss_knot_list
(mp
, cur_exp_knot
());
22371 case mp_picture_type
:
22372 delete_edge_ref
(cur_exp_node
());
22378 mp-
>cur_exp.type
= mp_known
;
22382 @ There's a much more general procedure that is capable of releasing
22383 the storage associated with any non-symbolic value packet.
22386 static void mp_recycle_value
(MP mp
, mp_node p
);
22389 static void mp_recycle_value
(MP mp
, mp_node p
) {
22390 mp_variable_type t
; /* a type code
*/
22391 FUNCTION_TRACE2
("mp_recycle_value(%p)\n", p
);
22392 if
(p
==NULL || p
==MP_VOID
)
22397 case mp_boolean_type
:
22399 case mp_numeric_type
:
22401 case unknown_types
:
22402 mp_ring_delete
(mp
, p
);
22404 case mp_string_type
:
22405 delete_str_ref
(value_str
(p
));
22409 mp_toss_knot_list
(mp
, value_knot
(p
));
22411 case mp_picture_type
:
22412 delete_edge_ref
(value_node
(p
));
22414 case mp_cmykcolor_type
:
22415 if
(value_node
(p
) != NULL) {
22416 mp_recycle_value
(mp
, cyan_part
(value_node
(p
)));
22417 mp_recycle_value
(mp
, magenta_part
(value_node
(p
)));
22418 mp_recycle_value
(mp
, yellow_part
(value_node
(p
)));
22419 mp_recycle_value
(mp
, black_part
(value_node
(p
)));
22420 mp_free_value_node
(mp
, cyan_part
(value_node
(p
)));
22421 mp_free_value_node
(mp
, magenta_part
(value_node
(p
)));
22422 mp_free_value_node
(mp
, black_part
(value_node
(p
)));
22423 mp_free_value_node
(mp
, yellow_part
(value_node
(p
)));
22424 mp_free_node
(mp
, value_node
(p
), cmykcolor_node_size
);
22428 if
(value_node
(p
) != NULL) {
22429 mp_recycle_value
(mp
, x_part
(value_node
(p
)));
22430 mp_recycle_value
(mp
, y_part
(value_node
(p
)));
22431 mp_free_value_node
(mp
, x_part
(value_node
(p
)));
22432 mp_free_value_node
(mp
, y_part
(value_node
(p
)));
22433 mp_free_pair_node
(mp
, value_node
(p
));
22436 case mp_color_type
:
22437 if
(value_node
(p
) != NULL) {
22438 mp_recycle_value
(mp
, red_part
(value_node
(p
)));
22439 mp_recycle_value
(mp
, green_part
(value_node
(p
)));
22440 mp_recycle_value
(mp
, blue_part
(value_node
(p
)));
22441 mp_free_value_node
(mp
, red_part
(value_node
(p
)));
22442 mp_free_value_node
(mp
, green_part
(value_node
(p
)));
22443 mp_free_value_node
(mp
, blue_part
(value_node
(p
)));
22444 mp_free_node
(mp
, value_node
(p
), color_node_size
);
22447 case mp_transform_type
:
22448 if
(value_node
(p
) != NULL) {
22449 mp_recycle_value
(mp
, tx_part
(value_node
(p
)));
22450 mp_recycle_value
(mp
, ty_part
(value_node
(p
)));
22451 mp_recycle_value
(mp
, xx_part
(value_node
(p
)));
22452 mp_recycle_value
(mp
, xy_part
(value_node
(p
)));
22453 mp_recycle_value
(mp
, yx_part
(value_node
(p
)));
22454 mp_recycle_value
(mp
, yy_part
(value_node
(p
)));
22455 mp_free_value_node
(mp
, tx_part
(value_node
(p
)));
22456 mp_free_value_node
(mp
, ty_part
(value_node
(p
)));
22457 mp_free_value_node
(mp
, xx_part
(value_node
(p
)));
22458 mp_free_value_node
(mp
, xy_part
(value_node
(p
)));
22459 mp_free_value_node
(mp
, yx_part
(value_node
(p
)));
22460 mp_free_value_node
(mp
, yy_part
(value_node
(p
)));
22461 mp_free_node
(mp
, value_node
(p
), transform_node_size
);
22465 case mp_proto_dependent
:
22466 /* Recycle a dependency list
*/
22468 mp_value_node qq
= (mp_value_node
) dep_list
((mp_value_node
) p
);
22469 while
(dep_info
(qq
) != NULL)
22470 qq
= (mp_value_node
) mp_link
(qq
);
22471 set_mp_link
(prev_dep
((mp_value_node
) p
), mp_link
(qq
));
22472 set_prev_dep
(mp_link
(qq
), prev_dep
((mp_value_node
) p
));
22473 set_mp_link
(qq
, NULL);
22474 mp_flush_node_list
(mp
, (mp_node
) dep_list
((mp_value_node
) p
));
22477 case mp_independent
:
22478 @
<Recycle an independent variable@
>;
22480 case mp_token_list
:
22481 case mp_structured
:
22482 mp_confusion
(mp
, "recycle");
22484 case mp_unsuffixed_macro
:
22485 case mp_suffixed_macro
:
22486 mp_delete_mac_ref
(mp
, value_node
(p
));
22488 default
: /* there are no other valid cases
, but please the compiler
*/
22491 mp_type
(p
) = mp_undefined
;
22494 @ When an independent variable disappears
, it simply fades away
, unless
22495 something depends on it. In the latter case
, a dependent variable whose
22496 coefficient of dependence is maximal will take its place.
22497 The relevant algorithm is due to Ignacio~A. Zabala
, who implemented it
22498 as part of his Ph.n-
>data. thesis
(Stanford University
, December
1982).
22499 @^Zabala Salelles
, Ignacio Andr\'es@
>
22501 For example
, suppose that variable $x$ is being recycled
, and that the
22502 only variables depending on~$x$ are $y
=2x
+a$ and $z
=x
+b$. In this case
22503 we want to make $y$ independent and $z
=.5y-
.5a
+b$
; no other variables
22504 will depend on~$y$. If $\\
{tracingequations
}>0$ in this situation
,
22505 we will print `\.
{\#\#\#
-2x
=-y
+a
}'.
22507 There's a slight complication
, however
: An independent variable $x$
22508 can occur both in dependency lists and in proto-dependency lists.
22509 This makes it necessary to be careful when deciding which coefficient
22512 Furthermore
, this complication is not so slight when
22513 a proto-dependent variable is chosen to become independent. For example
,
22514 suppose that $y
=2x
+100a$ is proto-dependent while $z
=x
+b$ is dependent
;
22515 then we must change $z
=.5y-50a
+b$ to a proto-dependency
, because of the
22516 large coefficient `
50'.
22518 In order to deal with these complications without wasting too much time
,
22519 we shall link together the occurrences of~$x$ among all the linear
22520 dependencies
, maintaining separate lists for the dependent and
22521 proto-dependent cases.
22523 @
<Recycle an independent variable@
>=
22525 mp_value_node q
, r
, s
;
22526 mp_node pp
; /* link manipulation register
*/
22527 mp_number v
; /* a value
*/
22528 mp_number test
; /* a temporary value
*/
22531 if
(t
< mp_dependent
)
22532 number_clone
(v
, value_number
(p
));
22533 set_number_to_zero
(mp-
>max_c
[mp_dependent
]);
22534 set_number_to_zero
(mp-
>max_c
[mp_proto_dependent
]);
22535 mp-
>max_link
[mp_dependent
] = NULL;
22536 mp-
>max_link
[mp_proto_dependent
] = NULL;
22537 q
= (mp_value_node
) mp_link
(mp-
>dep_head
);
22538 while
(q
!= mp-
>dep_head
) {
22539 s
= (mp_value_node
) mp-
>temp_head
;
22540 set_mp_link
(s
, dep_list
(q
));
22542 r
= (mp_value_node
) mp_link
(s
);
22543 if
(dep_info
(r
) == NULL)
22545 if
(dep_info
(r
) != p
) {
22549 if
(mp_link
(s
) == dep_list
(q
)) { /* reset the |dep_list|
*/
22550 set_dep_list
(q
, mp_link
(r
));
22552 set_mp_link
(s
, mp_link
(r
));
22553 set_dep_info
(r
, (mp_node
) q
);
22554 number_clone
(test
, dep_value
(r
));
22556 if
(number_greater
(test
, mp-
>max_c
[t
])) {
22557 /* Record a new maximum coefficient of type |t|
*/
22558 if
(number_positive
(mp-
>max_c
[t
])) {
22559 set_mp_link
(mp-
>max_ptr
[t
], (mp_node
) mp-
>max_link
[t
]);
22560 mp-
>max_link
[t
] = mp-
>max_ptr
[t
];
22562 number_clone
(mp-
>max_c
[t
], test
);
22563 mp-
>max_ptr
[t
] = r
;
22565 set_mp_link
(r
, (mp_node
) mp-
>max_link
[t
]);
22566 mp-
>max_link
[t
] = r
;
22570 q
= (mp_value_node
) mp_link
(r
);
22572 if
(number_positive
(mp-
>max_c
[mp_dependent
]) || number_positive
(mp-
>max_c
[mp_proto_dependent
])) {
22573 /* Choose a dependent variable to take the place of the disappearing
22574 independent variable
, and change all remaining dependencies
22576 mp_number test
, ret
; /* temporary use
*/
22579 number_clone
(test
, mp-
>max_c
[mp_dependent
]);
22580 number_divide_int
(test
, 4096);
22581 if
(number_greaterequal
(test
, mp-
>max_c
[mp_proto_dependent
]))
22584 t
= mp_proto_dependent
;
22586 /* Let |s
=max_ptr
[t
]|. At this point we have $|value|
(s
)=\pm|max_c|
[t
]$
,
22587 and |dep_info
(s
)| points to the dependent variable~|pp| of type~|t| from
22588 whose dependency list we have removed node~|s|. We must reinsert
22589 node~|s| into the dependency list
, with coefficient $
-1.0$
, and with
22590 |pp| as the new independent variable. Since |pp| will have a larger serial
22591 number than any other variable
, we can put node |s| at the head of the
22593 /* Determine the dependency list |s| to substitute for the independent
22596 s
= mp-
>max_ptr
[t
];
22597 pp
= (mp_node
) dep_info
(s
);
22598 number_clone
(v
, dep_value
(s
));
22599 if
(t
== mp_dependent
) {
22600 set_dep_value
(s
, fraction_one_t
);
22602 set_dep_value
(s
, unity_t
);
22604 number_negate
(dep_value
(s
));
22605 r
= (mp_value_node
) dep_list
((mp_value_node
) pp
);
22606 set_mp_link
(s
, (mp_node
) r
);
22607 while
(dep_info
(r
) != NULL)
22608 r
= (mp_value_node
) mp_link
(r
);
22609 q
= (mp_value_node
) mp_link
(r
);
22610 set_mp_link
(r
, NULL);
22611 set_prev_dep
(q
, prev_dep
((mp_value_node
) pp
));
22612 set_mp_link
(prev_dep
((mp_value_node
) pp
), (mp_node
) q
);
22613 mp_new_indep
(mp
, pp
);
22614 if
(cur_exp_node
() == pp
&& mp->cur_exp.type == t)
22615 mp-
>cur_exp.type
= mp_independent
;
22616 if
(number_positive
(internal_value
(mp_tracing_equations
))) {
22617 /* Show the transformed dependency
*/
22618 if
(mp_interesting
(mp
, p
)) {
22619 mp_begin_diagnostic
(mp
);
22620 mp_show_transformed_dependency
(mp
, v
, t
, p
);
22621 mp_print_dependency
(mp
, s
, t
);
22622 mp_end_diagnostic
(mp
, false
);
22626 t
= (quarterword
) (mp_dependent
+ mp_proto_dependent
- t
); /* complement |t|
*/
22627 if
(number_positive
(mp-
>max_c
[t
])) {
22628 /* we need to pick up an unchosen dependency
*/
22629 set_mp_link
(mp-
>max_ptr
[t
], (mp_node
) mp-
>max_link
[t
]);
22630 mp-
>max_link
[t
] = mp-
>max_ptr
[t
];
22632 /* Finally
, there are dependent and proto-dependent variables whose
22633 dependency lists must be brought up to date.
*/
22634 if
(t
!= mp_dependent
) {
22635 /* Substitute new dependencies in place of |p|
*/
22636 for
(t
= mp_dependent
; t
<= mp_proto_dependent
; t
=t
+1) {
22637 r
= mp-
>max_link
[t
];
22638 while
(r
!= NULL) {
22639 q
= (mp_value_node
) dep_info
(r
);
22640 number_clone
(test
, v
);
22641 number_negate
(test
);
22642 make_fraction
(ret
, dep_value
(r
), test
);
22643 set_dep_list
(q
, mp_p_plus_fq
(mp
, (mp_value_node
) dep_list
(q
), ret
, s
, t
, mp_dependent
));
22644 if
(dep_list
(q
) == (mp_node
) mp-
>dep_final
)
22645 mp_make_known
(mp
, q
, mp-
>dep_final
);
22647 r
= (mp_value_node
) mp_link
(r
);
22648 mp_free_dep_node
(mp
, q
);
22652 /* Substitute new proto-dependencies in place of |p|
*/
22653 for
(t
= mp_dependent
; t
<= mp_proto_dependent
; t
=t
+1) {
22654 r
= mp-
>max_link
[t
];
22655 while
(r
!= NULL) {
22656 q
= (mp_value_node
) dep_info
(r
);
22657 if
(t
== mp_dependent
) { /* for safety's sake
, we change |q| to |mp_proto_dependent|
*/
22658 if
(cur_exp_node
() == (mp_node
) q
&& mp->cur_exp.type == mp_dependent)
22659 mp-
>cur_exp.type
= mp_proto_dependent
;
22660 set_dep_list
(q
, mp_p_over_v
(mp
, (mp_value_node
) dep_list
(q
),
22661 unity_t
, mp_dependent
,
22662 mp_proto_dependent
));
22663 mp_type
(q
) = mp_proto_dependent
;
22664 fraction_to_round_scaled
(dep_value
(r
));
22666 number_clone
(test
, v
);
22667 number_negate
(test
);
22668 make_scaled
(ret
, dep_value
(r
), test
);
22669 set_dep_list
(q
, mp_p_plus_fq
(mp
, (mp_value_node
) dep_list
(q
),
22671 mp_proto_dependent
,
22672 mp_proto_dependent
));
22673 if
(dep_list
(q
) == (mp_node
) mp-
>dep_final
)
22674 mp_make_known
(mp
, q
, mp-
>dep_final
);
22676 r
= (mp_value_node
) mp_link
(r
);
22677 mp_free_dep_node
(mp
, q
);
22681 mp_flush_node_list
(mp
, (mp_node
) s
);
22682 if
(mp-
>fix_needed
)
22683 mp_fix_dependencies
(mp
);
22691 @ @
<Declarations@
>=
22692 static void mp_show_transformed_dependency
(MP mp
, mp_number v
, mp_variable_type t
, mp_node p
);
22695 static void mp_show_transformed_dependency
(MP mp
, mp_number v
, mp_variable_type t
, mp_node p
)
22697 mp_number vv
; /* for temp use
*/
22699 mp_print_nl
(mp
, "### ");
22700 if
(number_positive
(v
))
22701 mp_print_char
(mp
, xord
('
-'
));
22702 if
(t
== mp_dependent
) {
22703 number_clone
(vv
, mp-
>max_c
[mp_dependent
]);
22704 fraction_to_round_scaled
(vv
);
22706 number_clone
(vv
, mp-
>max_c
[mp_proto_dependent
]);
22708 if
(!number_equal
(vv
, unity_t
)) {
22711 mp_print_variable_name
(mp
, p
);
22712 while
(indep_scale
(p
) > 0) {
22713 mp_print
(mp
, "*4");
22714 set_indep_scale
(p
, indep_scale
(p
)-2);
22716 if
(t
== mp_dependent
)
22717 mp_print_char
(mp
, xord
('
='
));
22719 mp_print
(mp
, " = ");
22724 @ The code for independency removal makes use of three non-symbolic arrays.
22727 mp_number max_c
[mp_proto_dependent
+ 1]; /* max coefficient magnitude
*/
22728 mp_value_node max_ptr
[mp_proto_dependent
+ 1]; /* where |p| occurs with |max_c|
*/
22729 mp_value_node max_link
[mp_proto_dependent
+ 1]; /* other occurrences of |p|
*/
22732 @ @
<Initialize table ... @
>=
22735 for
(i
=0;i
<mp_proto_dependent
+ 1;i
++) {
22736 new_number
(mp-
>max_c
[i
]);
22743 for
(i
=0;i
<mp_proto_dependent
+ 1;i
++) {
22744 free_number
(mp-
>max_c
[i
]);
22748 @ A global variable |var_flag| is set to a special command code
22749 just before \MP\ calls |scan_expression|
, if the expression should be
22750 treated as a variable when this command code immediately follows. For
22751 example
, |var_flag| is set to |assignment| at the beginning of a
22752 statement
, because we want to know the
{\sl location\
/} of a variable at
22753 the left of `\.
{:=}'
, not the
{\sl value\
/} of that variable.
22755 The |scan_expression| subroutine calls |scan_tertiary|
,
22756 which calls |scan_secondary|
, which calls |scan_primary|
, which sets
22757 |var_flag
:=0|. In this way each of the scanning routines ``knows''
22758 when it has been called with a special |var_flag|
, but |var_flag| is
22761 A variable preceding a command that equals |var_flag| is converted to a
22762 token list rather than a value. Furthermore
, an `\.
{=}' sign following an
22763 expression with |var_flag
=assignment| is not considered to be a relation
22764 that produces boolean expressions.
22768 int var_flag
; /* command that wants a variable
*/
22773 @
* Parsing primary expressions.
22774 The first parsing routine
, |scan_primary|
, is also the most complicated one
,
22775 since it involves so many different cases. But each case---with one
22776 exception---is fairly simple by itself.
22778 When |scan_primary| begins
, the first token of the primary to be scanned
22779 should already appear in |cur_cmd|
, |cur_mod|
, and |cur_sym|. The values
22780 of |cur_type| and |cur_exp| should be either dead or dormant
, as explained
22781 earlier. If |cur_cmd| is not between |min_primary_command| and
22782 |max_primary_command|
, inclusive
, a syntax error will be signaled.
22784 Later we'll come to procedures that perform actual operations like
22785 addition
, square root
, and so on
; our purpose now is to do the parsing.
22786 But we might as well mention those future procedures now
, so that the
22787 suspense won't be too bad
:
22790 |do_nullary
(c
)| does primitive operations that have no operands
(e.g.
,
22791 `\
&{true}' or `\&{pencircle}');
22794 |do_unary
(c
)| applies a primitive operation to the current expression
;
22797 |do_binary
(p
,c
)| applies a primitive operation to the capsule~|p|
22798 and the current expression.
22800 @
<Declare the basic parsing subroutines@
>=
22801 static void check_for_mediation
(MP mp
);
22802 void mp_scan_primary
(MP mp
) {
22803 mp_command_code my_var_flag
; /* initial value of |my_var_flag|
*/
22804 my_var_flag
= mp-
>var_flag
;
22808 /* Supply diagnostic information
, if requested
*/
22809 if
(mp-
>interrupt
!= 0) {
22810 if
(mp-
>OK_to_interrupt
) {
22811 mp_back_input
(mp
);
22813 mp_get_x_next
(mp
);
22816 switch
(cur_cmd
()) {
22817 case mp_left_delimiter
:
22819 /* Scan a delimited primary
*/
22820 mp_node p
, q
, r
; /* for list manipulation
*/
22821 mp_sym l_delim
, r_delim
; /* hash addresses of a delimiter pair
*/
22822 l_delim
= cur_sym
();
22823 r_delim
= equiv_sym
(cur_sym
());
22824 mp_get_x_next
(mp
);
22825 mp_scan_expression
(mp
);
22826 if
((cur_cmd
() == mp_comma
) && (mp->cur_exp.type >= mp_known)) {
22827 /* Scan the rest of a delimited set of numerics
*/
22828 /* This code uses the fact that |red_part| and |green_part|
22829 are synonymous with |x_part| and |y_part|.
*/
22830 p
= mp_stash_cur_exp
(mp
);
22831 mp_get_x_next
(mp
);
22832 mp_scan_expression
(mp
);
22833 /* Make sure the second part of a pair or color has a numeric type
*/
22834 if
(mp-
>cur_exp.type
< mp_known
) {
22835 const char
*hlp
[] = {
22836 "I've started to scan a pair `(a,b)' or a color `(a,b,c)';",
22837 "but after finding a nice `a' I found a `b' that isn't",
22838 "of numeric type. So I've changed that part to zero.",
22839 "(The b that I didn't like appears above the error message.)",
22842 memset
(&new_expr,0,sizeof(mp_value));
22843 mp_disp_err
(mp
, NULL);
22844 new_number
(new_expr.data.n
);
22845 set_number_to_zero
(new_expr.data.n
);
22846 mp_back_error
(mp
,"Nonnumeric ypart has been replaced by 0", hlp
, true
);
22847 mp_get_x_next
(mp
);
22848 mp_flush_cur_exp
(mp
, new_expr
);
22851 q
= mp_get_value_node
(mp
);
22852 mp_name_type
(q
) = mp_capsule
;
22853 if
(cur_cmd
() == mp_comma
) {
22854 mp_init_color_node
(mp
, q
);
22855 r
= value_node
(q
);
22856 mp_stash_in
(mp
, y_part
(r
));
22857 mp_unstash_cur_exp
(mp
, p
);
22858 mp_stash_in
(mp
, x_part
(r
));
22859 /* Scan the last of a triplet of numerics
*/
22860 mp_get_x_next
(mp
);
22861 mp_scan_expression
(mp
);
22862 if
(mp-
>cur_exp.type
< mp_known
) {
22864 const char
*hlp
[] = {
22865 "I've just scanned a color `(a,b,c)' or cmykcolor(a,b,c,d); but the `c'",
22866 "isn't of numeric type. So I've changed that part to zero.",
22867 "(The c that I didn't like appears above the error message.)",
22869 memset
(&new_expr,0,sizeof(mp_value));
22870 mp_disp_err
(mp
, NULL);
22871 new_number
(new_expr.data.n
);
22872 set_number_to_zero
(new_expr.data.n
);
22873 mp_back_error
(mp
,"Nonnumeric third part has been replaced by 0", hlp
, true
);
22874 mp_get_x_next
(mp
);
22875 mp_flush_cur_exp
(mp
, new_expr
);
22877 mp_stash_in
(mp
, blue_part
(r
));
22879 if
(cur_cmd
() == mp_comma
) {
22880 mp_node t
; /* a token
*/
22881 mp_init_cmykcolor_node
(mp
, q
);
22882 t
= value_node
(q
);
22883 mp_type
(cyan_part
(t
)) = mp_type
(red_part
(r
));
22884 set_value_number
(cyan_part
(t
), value_number
(red_part
(r
)));
22885 mp_type
(magenta_part
(t
)) = mp_type
(green_part
(r
));
22886 set_value_number
(magenta_part
(t
), value_number
(green_part
(r
)));
22887 mp_type
(yellow_part
(t
)) = mp_type
(blue_part
(r
));
22888 set_value_number
(yellow_part
(t
), value_number
(blue_part
(r
)));
22889 mp_recycle_value
(mp
, r
);
22891 /* Scan the last of a quartet of numerics
*/
22892 mp_get_x_next
(mp
);
22893 mp_scan_expression
(mp
);
22894 if
(mp-
>cur_exp.type
< mp_known
) {
22895 const char
*hlp
[] = {
22896 "I've just scanned a cmykcolor `(c,m,y,k)'; but the `k' isn't",
22897 "of numeric type. So I've changed that part to zero.",
22898 "(The k that I didn't like appears above the error message.)",
22901 memset
(&new_expr,0,sizeof(mp_value));
22902 new_number
(new_expr.data.n
);
22903 mp_disp_err
(mp
, NULL);
22904 set_number_to_zero
(new_expr.data.n
);
22905 mp_back_error
(mp
,"Nonnumeric blackpart has been replaced by 0", hlp
, true
);
22906 mp_get_x_next
(mp
);
22907 mp_flush_cur_exp
(mp
, new_expr
);
22909 mp_stash_in
(mp
, black_part
(r
));
22913 mp_init_pair_node
(mp
, q
);
22914 r
= value_node
(q
);
22915 mp_stash_in
(mp
, y_part
(r
));
22916 mp_unstash_cur_exp
(mp
, p
);
22917 mp_stash_in
(mp
, x_part
(r
));
22919 mp_check_delimiter
(mp
, l_delim
, r_delim
);
22920 mp-
>cur_exp.type
= mp_type
(q
);
22921 set_cur_exp_node
(q
);
22924 mp_check_delimiter
(mp
, l_delim
, r_delim
);
22928 case mp_begin_group
:
22929 /* Scan a grouped primary
*/
22930 /* The local variable |group_line| keeps track of the line
22931 where a \
&{begingroup} command occurred; this will be useful
22932 in an error message if the group doesn't actually end.
*/
22934 integer group_line
; /* where a group began
*/
22935 group_line
= mp_true_line
(mp
);
22936 if
(number_positive
(internal_value
(mp_tracing_commands
)))
22938 mp_save_boundary
(mp
);
22940 mp_do_statement
(mp
); /* ends with |cur_cmd
>=semicolon|
*/
22941 } while
(cur_cmd
() == mp_semicolon
);
22942 if
(cur_cmd
() != mp_end_group
) {
22944 const char
*hlp
[] = {
22945 "I saw a `begingroup' back there that hasn't been matched",
22946 "by `endgroup'. So I've inserted `endgroup' now.",
22948 mp_snprintf
(msg
, 256, "A group begun on line %d never ended", (int
)group_line
);
22949 mp_back_error
(mp
, msg
, hlp
, true
);
22950 set_cur_cmd
((mp_variable_type
)mp_end_group
);
22953 /* this might change |cur_type|
, if independent variables are recycled
*/
22954 if
(number_positive
(internal_value
(mp_tracing_commands
)))
22958 case mp_string_token
:
22959 /* Scan a string constant
*/
22960 mp-
>cur_exp.type
= mp_string_type
;
22961 set_cur_exp_str
(cur_mod_str
());
22963 case mp_numeric_token
:
22965 /* Scan a primary that starts with a numeric token
*/
22966 /* A numeric token might be a primary by itself
, or it might be the
22967 numerator of a fraction composed solely of numeric tokens
, or it might
22968 multiply the primary that follows
(provided that the primary doesn't begin
22969 with a plus sign or a minus sign
). The code here uses the facts that
22970 |max_primary_command
=plus_or_minus| and
22971 |max_primary_command-1
=numeric_token|. If a fraction is found that is less
22972 than unity
, we try to retain higher precision when we use it in scalar
22974 mp_number num
, denom
; /* for primaries that are fractions
, like `
1/2'
*/
22976 new_number
(denom
);
22977 set_cur_exp_value_number
(cur_mod_number
());
22978 mp-
>cur_exp.type
= mp_known
;
22979 mp_get_x_next
(mp
);
22980 if
(cur_cmd
() != mp_slash
) {
22981 set_number_to_zero
(num
);
22982 set_number_to_zero
(denom
);
22984 mp_get_x_next
(mp
);
22985 if
(cur_cmd
() != mp_numeric_token
) {
22986 mp_back_input
(mp
);
22987 set_cur_cmd
((mp_variable_type
)mp_slash
);
22988 set_cur_mod
(mp_over
);
22989 set_cur_sym
(mp-
>frozen_slash
);
22991 free_number
(denom
);
22994 number_clone
(num
, cur_exp_value_number
());
22995 number_clone
(denom
, cur_mod_number
());
22996 if
(number_zero
(denom
)) {
22997 /* Protest division by zero
*/
22998 const char
*hlp
[] = { "I'll pretend that you meant to divide by 1.", NULL };
22999 mp_error
(mp
, "Division by zero", hlp
, true
);
23003 make_scaled
(ret
, num
, denom
);
23004 set_cur_exp_value_number
(ret
);
23008 mp_get_x_next
(mp
);
23010 if
(cur_cmd
() >= mp_min_primary_command
) {
23011 if
(cur_cmd
() < mp_numeric_token
) { /* in particular
, |cur_cmd
<>plus_or_minus|
*/
23012 mp_node p
; /* for list manipulation
*/
23013 mp_number absnum
, absdenom
;
23014 new_number
(absnum
);
23015 new_number
(absdenom
);
23016 p
= mp_stash_cur_exp
(mp
);
23017 mp_scan_primary
(mp
);
23018 number_clone
(absnum
, num
);
23019 number_abs
(absnum
);
23020 number_clone
(absdenom
, denom
);
23021 number_abs
(absdenom
);
23022 if
(number_greaterequal
(absnum
, absdenom
) ||
(mp-
>cur_exp.type
< mp_color_type
)) {
23023 mp_do_binary
(mp
, p
, mp_times
);
23025 mp_frac_mult
(mp
, num
, denom
);
23026 mp_free_value_node
(mp
, p
);
23028 free_number
(absnum
);
23029 free_number
(absdenom
);
23033 free_number
(denom
);
23038 /* Scan a nullary operation
*/
23039 mp_do_nullary
(mp
, (quarterword
) cur_mod
());
23044 case mp_plus_or_minus
:
23046 /* Scan a unary operation
*/
23047 quarterword c
; /* a primitive operation code
*/
23048 c
= (quarterword
) cur_mod
();
23049 mp_get_x_next
(mp
);
23050 mp_scan_primary
(mp
);
23051 mp_do_unary
(mp
, c
);
23055 case mp_primary_binary
:
23057 /* Scan a binary operation with `\
&{of}' between its operands */
23058 mp_node p
; /* for list manipulation
*/
23059 quarterword c
; /* a primitive operation code
*/
23060 c
= (quarterword
) cur_mod
();
23061 mp_get_x_next
(mp
);
23062 mp_scan_expression
(mp
);
23063 if
(cur_cmd
() != mp_of_token
) {
23066 const char
*hlp
[] = {
23067 "I've got the first argument; will look now for the other.",
23069 int old_setting
= mp-
>selector
;
23070 mp-
>selector
= new_string
;
23071 mp_print_cmd_mod
(mp
, mp_primary_binary
, c
);
23072 mp-
>selector
= old_setting
;
23073 sname
= mp_make_string
(mp
);
23074 mp_snprintf
(msg
, 256, "Missing `of' has been inserted for %s", mp_str
(mp
, sname
));
23075 delete_str_ref
(sname
);
23076 mp_back_error
(mp
, msg
, hlp
, true
);
23078 p
= mp_stash_cur_exp
(mp
);
23079 mp_get_x_next
(mp
);
23080 mp_scan_primary
(mp
);
23081 mp_do_binary
(mp
, p
, c
);
23086 /* Convert a suffix to a string
*/
23087 mp_get_x_next
(mp
);
23088 mp_scan_suffix
(mp
);
23089 mp-
>old_setting
= mp-
>selector
;
23090 mp-
>selector
= new_string
;
23091 mp_show_token_list
(mp
, cur_exp_node
(), NULL, 100000, 0);
23092 mp_flush_token_list
(mp
, cur_exp_node
());
23093 set_cur_exp_str
(mp_make_string
(mp
));
23094 mp-
>selector
= mp-
>old_setting
;
23095 mp-
>cur_exp.type
= mp_string_type
;
23098 case mp_internal_quantity
:
23099 /* Scan an internal numeric quantity
*/
23100 /* If an internal quantity appears all by itself on the left of an
23101 assignment
, we return a token list of length one
, containing the address
23102 of the internal quantity
, with |name_type| equal to |mp_internal_sym|.
23103 (This accords with the conventions of the save stack
, as described earlier.
) */
23105 halfword qq
= cur_mod
();
23106 if
(my_var_flag
== mp_assignment
) {
23107 mp_get_x_next
(mp
);
23108 if
(cur_cmd
() == mp_assignment
) {
23109 set_cur_exp_node
(mp_get_symbolic_node
(mp
));
23110 set_mp_sym_info
(cur_exp_node
(), qq
);
23111 mp_name_type
(cur_exp_node
()) = mp_internal_sym
;
23112 mp-
>cur_exp.type
= mp_token_list
;
23115 mp_back_input
(mp
);
23117 if
(internal_type
(qq
) == mp_string_type
) {
23118 set_cur_exp_str
(internal_string
(qq
));
23120 set_cur_exp_value_number
(internal_value
(qq
));
23122 mp-
>cur_exp.type
= internal_type
(qq
);
23125 case mp_capsule_token
:
23126 mp_make_exp_copy
(mp
, cur_mod_node
());
23129 @
<Scan a variable primary
; |goto restart| if it turns out to be a macro@
>;
23132 mp_bad_exp
(mp
, "A primary");
23136 mp_get_x_next
(mp
); /* the routines |goto done| if they don't want this
*/
23138 check_for_mediation
(mp
);
23141 @ Expressions of the form `\.
{a
[b
,c
]}' are converted into
23142 `\.
{b
+a
*(c-b
)}'
, without checking the types of \.b~or~\.c
,
23143 provided that \.a is numeric.
23145 @
<Declare the basic parsing subroutines@
>=
23146 static void check_for_mediation
(MP mp
) {
23147 mp_node p
, q
, r
; /* for list manipulation
*/
23148 if
(cur_cmd
() == mp_left_bracket
) {
23149 if
(mp-
>cur_exp.type
>= mp_known
) {
23150 /* Scan a mediation construction
*/
23151 p
= mp_stash_cur_exp
(mp
);
23152 mp_get_x_next
(mp
);
23153 mp_scan_expression
(mp
);
23154 if
(cur_cmd
() != mp_comma
) {
23155 /* Put the left bracket and the expression back to be rescanned
*/
23156 /* The left bracket that we thought was introducing a subscript might have
23157 actually been the left bracket in a mediation construction like `\.
{x
[a
,b
]}'.
23158 So we don't issue an error message at this point
; but we do want to back up
23159 so as to avoid any embarrassment about our incorrect assumption.
*/
23160 mp_back_input
(mp
); /* that was the token following the current expression
*/
23162 set_cur_cmd
((mp_variable_type
)mp_left_bracket
);
23163 set_cur_mod_number
(zero_t
);
23164 set_cur_sym
(mp-
>frozen_left_bracket
);
23165 mp_unstash_cur_exp
(mp
, p
);
23167 q
= mp_stash_cur_exp
(mp
);
23168 mp_get_x_next
(mp
);
23169 mp_scan_expression
(mp
);
23170 if
(cur_cmd
() != mp_right_bracket
) {
23171 const char
*hlp
[] = {
23172 "I've scanned an expression of the form `a[b,c',",
23173 "so a right bracket should have come next.",
23174 "I shall pretend that one was there.",
23176 mp_back_error
(mp
, "Missing `]' has been inserted", hlp
, true
);
23178 r
= mp_stash_cur_exp
(mp
);
23179 mp_make_exp_copy
(mp
, q
);
23180 mp_do_binary
(mp
, r
, mp_minus
);
23181 mp_do_binary
(mp
, p
, mp_times
);
23182 mp_do_binary
(mp
, q
, mp_plus
);
23183 mp_get_x_next
(mp
);
23190 @ Errors at the beginning of expressions are flagged by |bad_exp|.
23193 static void mp_bad_exp
(MP mp
, const char
*s
) {
23196 const char
*hlp
[] = {
23197 "I'm afraid I need some sort of value in order to continue,",
23198 "so I've tentatively inserted `0'. You may want to",
23199 "delete this zero and insert something else;",
23200 "see Chapter 27 of The METAFONTbook for an example.",
23202 @
:METAFONTbook
}{\sl The
{\logos METAFONT\
/}book@
>;
23205 int old_selector
= mp-
>selector
;
23206 mp-
>selector
= new_string
;
23207 mp_print_cmd_mod
(mp
, cur_cmd
(), cur_mod
());
23208 mp-
>selector
= old_selector
;
23209 cm
= mp_make_string
(mp
);
23210 mp_snprintf
(msg
, 256, "%s expression can't begin with `%s'", s
, mp_str
(mp
, cm
));
23211 delete_str_ref
(cm
);
23213 mp_back_input
(mp
);
23215 set_cur_cmd
((mp_variable_type
)mp_numeric_token
);
23216 set_cur_mod_number
(zero_t
);
23217 mp_ins_error
(mp
, msg
, hlp
, true
);
23218 save_flag
= mp-
>var_flag
;
23220 mp_get_x_next
(mp
);
23221 mp-
>var_flag
= save_flag
;
23225 @ The |stash_in| subroutine puts the current
(numeric
) expression into a field
23226 within a ``big node.''
23229 static void mp_stash_in
(MP mp
, mp_node p
) {
23230 mp_value_node q
; /* temporary register
*/
23231 mp_type
(p
) = mp-
>cur_exp.type
;
23232 if
(mp-
>cur_exp.type
== mp_known
) {
23233 set_value_number
(p
, cur_exp_value_number
());
23235 if
(mp-
>cur_exp.type
== mp_independent
) {
23236 /* Stash an independent |cur_exp| into a big node
*/
23237 /* In rare cases the current expression can become |independent|. There
23238 may be many dependency lists pointing to such an independent capsule
,
23239 so we can't simply move it into place within a big node. Instead
,
23240 we copy it
, then recycle it.
*/
23241 q
= mp_single_dependency
(mp
, cur_exp_node
());
23242 if
(q
== mp-
>dep_final
) {
23243 mp_type
(p
) = mp_known
;
23244 set_value_number
(p
, zero_t
);
23245 mp_free_dep_node
(mp
, q
);
23247 mp_new_dep
(mp
, p
, mp_dependent
, q
);
23249 mp_recycle_value
(mp
, cur_exp_node
());
23250 mp_free_value_node
(mp
, cur_exp_node
());
23252 set_dep_list
((mp_value_node
) p
,
23253 dep_list
((mp_value_node
) cur_exp_node
()));
23254 set_prev_dep
((mp_value_node
) p
,
23255 prev_dep
((mp_value_node
) cur_exp_node
()));
23256 set_mp_link
(prev_dep
((mp_value_node
) p
), p
);
23257 mp_free_dep_node
(mp
, (mp_value_node
) cur_exp_node
());
23260 mp-
>cur_exp.type
= mp_vacuous
;
23263 @ The most difficult part of |scan_primary| has been saved for last
, since
23264 it was necessary to build up some confidence first. We can now face the task
23265 of scanning a variable.
23267 As we scan a variable
, we build a token list containing the relevant
23268 names and subscript values
, simultaneously following along in the
23269 ``collective'' structure to see if we are actually dealing with a macro
23270 instead of a value.
23272 The local variables |pre_head| and |post_head| will point to the beginning
23273 of the prefix and suffix lists
; |tail| will point to the end of the list
23274 that is currently growing.
23276 Another local variable
, |tt|
, contains partial information about the
23277 declared type of the variable-so-far. If |tt
>=mp_unsuffixed_macro|
, the
23278 relation |tt
=mp_type
(q
)| will always hold. If |tt
=undefined|
, the routine
23279 doesn't bother to update its information about type. And if
23280 |undefined
<tt
<mp_unsuffixed_macro|
, the precise value of |tt| isn't critical.
23282 @ @
<Scan a variable primary...@
>=
23284 mp_node p
, q
; /* for list manipulation
*/
23285 mp_node t
; /* a token
*/
23286 mp_node pre_head
, post_head
, tail
; /* prefix and suffix list variables
*/
23287 quarterword tt
; /* approximation to the type of the variable-so-far
*/
23288 mp_node macro_ref
= 0; /* reference count for a suffixed macro
*/
23289 pre_head
= mp_get_symbolic_node
(mp
);
23294 t
= mp_cur_tok
(mp
);
23295 mp_link
(tail
) = t
;
23296 if
(tt
!= mp_undefined
) {
23297 /* Find the approximate type |tt| and corresponding~|q|
*/
23298 /* Every time we call |get_x_next|
, there's a chance that the variable we've
23299 been looking at will disappear. Thus
, we cannot safely keep |q| pointing
23300 into the variable structure
; we need to start searching from the root each
23303 p
= mp_link
(pre_head
);
23304 qq
= mp_sym_sym
(p
);
23306 if
(eq_type
(qq
) % mp_outer_tag
== mp_tag_token
) {
23307 q
= equiv_node
(qq
);
23316 if
(mp_type
(q
) != mp_structured
)
23318 q
= mp_link
(attr_head
(q
)); /* the |collective_subscript| attribute
*/
23319 if
(mp_type
(p
) == mp_symbol_node
) { /* it's not a subscript
*/
23322 } while
(!(hashloc
(q
) >= mp_sym_sym
(p
)));
23323 if
(hashloc
(q
) > mp_sym_sym
(p
))
23330 if
(tt
>= mp_unsuffixed_macro
) {
23331 /* Either begin an unsuffixed macro call or
23332 prepare for a suffixed one
*/
23333 mp_link
(tail
) = NULL;
23334 if
(tt
> mp_unsuffixed_macro
) { /* |tt
=mp_suffixed_macro|
*/
23335 post_head
= mp_get_symbolic_node
(mp
);
23337 mp_link
(tail
) = t
;
23339 macro_ref
= value_node
(q
);
23340 add_mac_ref
(macro_ref
);
23342 /* Set up unsuffixed macro call and |goto restart|
*/
23343 /* The only complication associated with macro calling is that the prefix
23344 and ``at'' parameters must be packaged in an appropriate list of lists.
*/
23345 p
= mp_get_symbolic_node
(mp
);
23346 set_mp_sym_sym
(pre_head
, mp_link
(pre_head
));
23347 mp_link
(pre_head
) = p
;
23348 set_mp_sym_sym
(p
, t
);
23349 mp_macro_call
(mp
, value_node
(q
), pre_head
, NULL);
23350 mp_get_x_next
(mp
);
23355 mp_get_x_next
(mp
);
23357 if
(cur_cmd
() == mp_left_bracket
) {
23358 /* Scan for a subscript
; replace |cur_cmd| by |numeric_token| if found
*/
23359 mp_get_x_next
(mp
);
23360 mp_scan_expression
(mp
);
23361 if
(cur_cmd
() != mp_right_bracket
) {
23362 /* Put the left bracket and the expression back to be rescanned
*/
23363 /* The left bracket that we thought was introducing a subscript might have
23364 actually been the left bracket in a mediation construction like `\.
{x
[a
,b
]}'.
23365 So we don't issue an error message at this point
; but we do want to back up
23366 so as to avoid any embarrassment about our incorrect assumption.
*/
23367 mp_back_input
(mp
); /* that was the token following the current expression
*/
23369 set_cur_cmd
((mp_variable_type
)mp_left_bracket
);
23370 set_cur_mod_number
(zero_t
);
23371 set_cur_sym
(mp-
>frozen_left_bracket
);
23374 if
(mp-
>cur_exp.type
!= mp_known
)
23375 mp_bad_subscript
(mp
);
23376 set_cur_cmd
((mp_variable_type
)mp_numeric_token
);
23377 set_cur_mod_number
(cur_exp_value_number
());
23381 if
(cur_cmd
() > mp_max_suffix_token
)
23383 if
(cur_cmd
() < mp_min_suffix_token
)
23385 } /* now |cur_cmd| is |internal_quantity|
, |tag_token|
, or |numeric_token|
*/
23386 /* Handle unusual cases that masquerade as variables
, and |goto restart| or
23387 |goto done| if appropriate
; otherwise make a copy of the variable and |goto done|
*/
23388 /* If the variable does exist
, we also need to check
23389 for a few other special cases before deciding that a plain old ordinary
23390 variable has
, indeed
, been scanned.
*/
23391 if
(post_head
!= NULL) {
23392 /* Set up suffixed macro call and |goto restart|
*/
23393 /* If the ``variable'' that turned out to be a suffixed macro no longer exists
,
23394 we don't care
, because we have reserved a pointer
(|macro_ref|
) to its
23396 mp_back_input
(mp
);
23397 p
= mp_get_symbolic_node
(mp
);
23398 q
= mp_link
(post_head
);
23399 set_mp_sym_sym
(pre_head
, mp_link
(pre_head
));
23400 mp_link
(pre_head
) = post_head
;
23401 set_mp_sym_sym
(post_head
, q
);
23402 mp_link
(post_head
) = p
;
23403 set_mp_sym_sym
(p
, mp_link
(q
));
23404 mp_link
(q
) = NULL;
23405 mp_macro_call
(mp
, macro_ref
, pre_head
, NULL);
23406 decr_mac_ref
(macro_ref
);
23407 mp_get_x_next
(mp
);
23410 q
= mp_link
(pre_head
);
23411 mp_free_symbolic_node
(mp
, pre_head
);
23412 if
(cur_cmd
() == my_var_flag
) {
23413 mp-
>cur_exp.type
= mp_token_list
;
23414 set_cur_exp_node
(q
);
23417 p
= mp_find_variable
(mp
, q
);
23419 mp_make_exp_copy
(mp
, p
);
23422 const char
*hlp
[] = {
23423 "While I was evaluating the suffix of this variable,",
23424 "something was redefined, and it's no longer a variable!",
23425 "In order to get back on my feet, I've inserted `0' instead.",
23427 char
*msg
= mp_obliterated
(mp
, q
);
23428 memset
(&new_expr,0,sizeof(mp_value));
23429 new_number
(new_expr.data.n
);
23430 set_number_to_zero
(new_expr.data.n
);
23431 mp_back_error
(mp
, msg
, hlp
, true
);
23433 mp_get_x_next
(mp
);
23434 mp_flush_cur_exp
(mp
, new_expr
);
23436 mp_flush_node_list
(mp
, q
);
23441 @ Here's a routine that puts the current expression back to be read again.
23444 static void mp_back_expr
(MP mp
) {
23445 mp_node p
; /* capsule token
*/
23446 p
= mp_stash_cur_exp
(mp
);
23447 mp_link
(p
) = NULL;
23452 @ Unknown subscripts lead to the following error message.
23455 static void mp_bad_subscript
(MP mp
) {
23457 const char
*hlp
[] = {
23458 "A bracketed subscript must have a known numeric value;",
23459 "unfortunately, what I found was the value that appears just",
23460 "above this error message. So I'll try a zero subscript.",
23462 memset
(&new_expr,0,sizeof(mp_value));
23463 new_number
(new_expr.data.n
);
23464 mp_disp_err
(mp
, NULL);
23465 mp_error
(mp
, "Improper subscript has been replaced by zero", hlp
, true
);
23466 @.Improper subscript...@
>;
23467 mp_flush_cur_exp
(mp
, new_expr
);
23471 @ How do things stand now? Well
, we have scanned an entire variable name
,
23472 including possible subscripts and
/or attributes
; |cur_cmd|
, |cur_mod|
, and
23473 |cur_sym| represent the token that follows. If |post_head
=NULL|
, a
23474 token list for this variable name starts at |mp_link
(pre_head
)|
, with all
23475 subscripts evaluated. But if |post_head
<>NULL|
, the variable turned out
23476 to be a suffixed macro
; |pre_head| is the head of the prefix list
, while
23477 |post_head| is the head of a token list containing both `\.
{\
AT!}' and
23480 Our immediate problem is to see if this variable still exists.
(Variable
23481 structures can change drastically whenever we call |get_x_next|
; users
23482 aren't supposed to do this
, but the fact that it is possible means that
23483 we must be cautious.
)
23485 The following procedure creates an error message for when a variable
23486 unexpectedly disappears.
23489 static char
*mp_obliterated
(MP mp
, mp_node q
) {
23492 int old_setting
= mp-
>selector
;
23493 mp-
>selector
= new_string
;
23494 mp_show_token_list
(mp
, q
, NULL, 1000, 0);
23495 sname
= mp_make_string
(mp
);
23496 mp-
>selector
= old_setting
;
23497 mp_snprintf
(msg
, 256, "Variable %s has been obliterated", mp_str
(mp
, sname
));
23498 @.Variable...obliterated@
>;
23499 delete_str_ref
(sname
);
23500 return xstrdup
(msg
);
23504 @ Our remaining job is simply to make a copy of the value that has been
23505 found. Some cases are harder than others
, but complexity arises solely
23506 because of the multiplicity of possible cases.
23508 @
<Declare the procedure called |make_exp_copy|@
>=
23509 @
<Declare subroutines needed by |make_exp_copy|@
>;
23510 static void mp_make_exp_copy
(MP mp
, mp_node p
) {
23511 mp_node t
; /* register
(s
) for list manipulation
*/
23514 mp-
>cur_exp.type
= mp_type
(p
);
23515 switch
(mp-
>cur_exp.type
) {
23517 case mp_boolean_type
:
23519 set_cur_exp_value_number
(value_number
(p
));
23521 case unknown_types
:
23522 t
= mp_new_ring_entry
(mp
, p
);
23523 set_cur_exp_node
(t
);
23525 case mp_string_type
:
23526 set_cur_exp_str
(value_str
(p
));
23528 case mp_picture_type
:
23529 set_cur_exp_node
(value_node
(p
));
23530 add_edge_ref
(cur_exp_node
());
23533 set_cur_exp_knot
(copy_pen
(value_knot
(p
)));
23536 set_cur_exp_knot
(mp_copy_path
(mp
, value_knot
(p
)));
23538 case mp_transform_type
:
23539 case mp_color_type
:
23540 case mp_cmykcolor_type
:
23542 /* Copy the big node |p|
*/
23543 /* The most tedious case arises when the user refers to a
23544 \
&{pair}, \&{color}, or \&{transform} variable; we must copy several fields,
23545 each of which can be |independent|
, |dependent|
, |mp_proto_dependent|
,
23547 if
(value_node
(p
) == NULL) {
23548 switch
(mp_type
(p
)) {
23550 mp_init_pair_node
(mp
, p
);
23552 case mp_color_type
:
23553 mp_init_color_node
(mp
, p
);
23555 case mp_cmykcolor_type
:
23556 mp_init_cmykcolor_node
(mp
, p
);
23558 case mp_transform_type
:
23559 mp_init_transform_node
(mp
, p
);
23561 default
: /* there are no other valid cases
, but please the compiler
*/
23565 t
= mp_get_value_node
(mp
);
23566 mp_name_type
(t
) = mp_capsule
;
23567 q
= (mp_value_node
)value_node
(p
);
23568 switch
(mp-
>cur_exp.type
) {
23570 mp_init_pair_node
(mp
, t
);
23571 mp_install
(mp
, y_part
(value_node
(t
)), y_part
(q
));
23572 mp_install
(mp
, x_part
(value_node
(t
)), x_part
(q
));
23574 case mp_color_type
:
23575 mp_init_color_node
(mp
, t
);
23576 mp_install
(mp
, blue_part
(value_node
(t
)), blue_part
(q
));
23577 mp_install
(mp
, green_part
(value_node
(t
)), green_part
(q
));
23578 mp_install
(mp
, red_part
(value_node
(t
)), red_part
(q
));
23580 case mp_cmykcolor_type
:
23581 mp_init_cmykcolor_node
(mp
, t
);
23582 mp_install
(mp
, black_part
(value_node
(t
)), black_part
(q
));
23583 mp_install
(mp
, yellow_part
(value_node
(t
)), yellow_part
(q
));
23584 mp_install
(mp
, magenta_part
(value_node
(t
)), magenta_part
(q
));
23585 mp_install
(mp
, cyan_part
(value_node
(t
)), cyan_part
(q
));
23587 case mp_transform_type
:
23588 mp_init_transform_node
(mp
, t
);
23589 mp_install
(mp
, yy_part
(value_node
(t
)), yy_part
(q
));
23590 mp_install
(mp
, yx_part
(value_node
(t
)), yx_part
(q
));
23591 mp_install
(mp
, xy_part
(value_node
(t
)), xy_part
(q
));
23592 mp_install
(mp
, xx_part
(value_node
(t
)), xx_part
(q
));
23593 mp_install
(mp
, ty_part
(value_node
(t
)), ty_part
(q
));
23594 mp_install
(mp
, tx_part
(value_node
(t
)), tx_part
(q
));
23596 default
: /* there are no other valid cases
, but please the compiler
*/
23599 set_cur_exp_node
(t
);
23602 case mp_proto_dependent
:
23603 mp_encapsulate
(mp
,
23604 mp_copy_dep_list
(mp
,
23605 (mp_value_node
) dep_list
((mp_value_node
)
23608 case mp_numeric_type
:
23609 mp_new_indep
(mp
, p
);
23612 case mp_independent
:
23613 q
= mp_single_dependency
(mp
, p
);
23614 if
(q
== mp-
>dep_final
) {
23615 mp-
>cur_exp.type
= mp_known
;
23616 set_cur_exp_value_number
(zero_t
);
23617 mp_free_dep_node
(mp
, q
);
23619 mp-
>cur_exp.type
= mp_dependent
;
23620 mp_encapsulate
(mp
, q
);
23624 mp_confusion
(mp
, "copy");
23625 @
:this can't happen copy
}{\quad copy@
>;
23631 @ The |encapsulate| subroutine assumes that |dep_final| is the
23632 tail of dependency list~|p|.
23634 @
<Declare subroutines needed by |make_exp_copy|@
>=
23635 static void mp_encapsulate
(MP mp
, mp_value_node p
) {
23636 mp_node q
= mp_get_value_node
(mp
);
23637 FUNCTION_TRACE2
("mp_encapsulate(%p)\n", p
);
23638 mp_name_type
(q
) = mp_capsule
;
23639 mp_new_dep
(mp
, q
, mp-
>cur_exp.type
, p
);
23640 set_cur_exp_node
(q
);
23643 @ The |install| procedure copies a numeric field~|q| into field~|r| of
23644 a big node that will be part of a capsule.
23646 @
<Declare subroutines needed by |make_exp_copy|@
>=
23647 static void mp_install
(MP mp
, mp_node r
, mp_node q
) {
23648 mp_value_node p
; /* temporary register
*/
23649 if
(mp_type
(q
) == mp_known
) {
23650 mp_type
(r
) = mp_known
;
23651 set_value_number
(r
, value_number
(q
));
23652 } else if
(mp_type
(q
) == mp_independent
) {
23653 p
= mp_single_dependency
(mp
, q
);
23654 if
(p
== mp-
>dep_final
) {
23655 mp_type
(r
) = mp_known
;
23656 set_value_number
(r
, zero_t
);
23657 mp_free_dep_node
(mp
, p
);
23659 mp_new_dep
(mp
, r
, mp_dependent
, p
);
23662 mp_new_dep
(mp
, r
, mp_type
(q
),
23663 mp_copy_dep_list
(mp
, (mp_value_node
) dep_list
((mp_value_node
)
23669 @ Here is a comparatively simple routine that is used to scan the
23670 \
&{suffix} parameters of a macro.
23672 @
<Declare the basic parsing subroutines@
>=
23673 static void mp_scan_suffix
(MP mp
) {
23674 mp_node h
, t
; /* head and tail of the list being built
*/
23675 mp_node p
; /* temporary register
*/
23676 h
= mp_get_symbolic_node
(mp
);
23679 if
(cur_cmd
() == mp_left_bracket
) {
23680 /* Scan a bracketed subscript and set |cur_cmd
:=numeric_token|
*/
23681 mp_get_x_next
(mp
);
23682 mp_scan_expression
(mp
);
23683 if
(mp-
>cur_exp.type
!= mp_known
)
23684 mp_bad_subscript
(mp
);
23685 if
(cur_cmd
() != mp_right_bracket
) {
23686 const char
*hlp
[] = {
23687 "I've seen a `[' and a subscript value, in a suffix,",
23688 "so a right bracket should have come next.",
23689 "I shall pretend that one was there.",
23691 mp_back_error
(mp
, "Missing `]' has been inserted", hlp
, true
);
23693 set_cur_cmd
((mp_variable_type
)mp_numeric_token
);
23694 set_cur_mod_number
(cur_exp_value_number
());
23697 if
(cur_cmd
() == mp_numeric_token
) {
23700 number_clone
(arg1
, cur_mod_number
());
23701 p
= mp_new_num_tok
(mp
, arg1
);
23702 free_number
(arg1
);
23703 } else if
((cur_cmd
() == mp_tag_token
) ||
(cur_cmd
() == mp_internal_quantity
)) {
23704 p
= mp_get_symbolic_node
(mp
);
23705 set_mp_sym_sym
(p
, cur_sym
());
23706 mp_name_type
(p
) = cur_sym_mod
();
23712 mp_get_x_next
(mp
);
23714 set_cur_exp_node
(mp_link
(h
));
23715 mp_free_symbolic_node
(mp
, h
);
23716 mp-
>cur_exp.type
= mp_token_list
;
23719 @
* Parsing secondary and higher expressions.
23721 After the intricacies of |scan_primary|\kern-1pt
,
23722 the |scan_secondary| routine is
23723 refreshingly simple. It's not trivial
, but the operations are relatively
23724 straightforward
; the main difficulty is
, again
, that expressions and data
23725 structures might change drastically every time we call |get_x_next|
, so a
23726 cautious approach is mandatory. For example
, a macro defined by
23727 \
&{primarydef} might have disappeared by the time its second argument has
23728 been scanned
; we solve this by increasing the reference count of its token
23729 list
, so that the macro can be called even after it has been clobbered.
23731 @
<Declare the basic parsing subroutines@
>=
23732 static void mp_scan_secondary
(MP mp
) {
23733 mp_node p
; /* for list manipulation
*/
23734 halfword c
, d
; /* operation codes or modifiers
*/
23736 mp_sym mac_name
= NULL; /* token defined with \
&{primarydef} */
23738 if
((cur_cmd
() < mp_min_primary_command
) ||
23739 (cur_cmd
() > mp_max_primary_command
))
23740 mp_bad_exp
(mp
, "A secondary");
23741 @.A secondary expression...@
>;
23742 mp_scan_primary
(mp
);
23744 if
(cur_cmd
() <= mp_max_secondary_command
&&
23745 cur_cmd
() >= mp_min_secondary_command
) {
23746 p
= mp_stash_cur_exp
(mp
);
23749 if
(d
== mp_secondary_primary_macro
) {
23750 cc
= cur_mod_node
();
23751 mac_name
= cur_sym
();
23754 mp_get_x_next
(mp
);
23755 mp_scan_primary
(mp
);
23756 if
(d
!= mp_secondary_primary_macro
) {
23757 mp_do_binary
(mp
, p
, c
);
23759 mp_back_input
(mp
);
23760 mp_binary_mac
(mp
, p
, cc
, mac_name
);
23762 mp_get_x_next
(mp
);
23770 @ The following procedure calls a macro that has two parameters
,
23774 static void mp_binary_mac
(MP mp
, mp_node p
, mp_node c
, mp_sym n
) {
23775 mp_node q
, r
; /* nodes in the parameter list
*/
23776 q
= mp_get_symbolic_node
(mp
);
23777 r
= mp_get_symbolic_node
(mp
);
23779 set_mp_sym_sym
(q
, p
);
23780 set_mp_sym_sym
(r
, mp_stash_cur_exp
(mp
));
23781 mp_macro_call
(mp
, c
, q
, n
);
23785 @ The next procedure
, |scan_tertiary|
, is pretty much the same deal.
23787 @
<Declare the basic parsing subroutines@
>=
23788 static void mp_scan_tertiary
(MP mp
) {
23789 mp_node p
; /* for list manipulation
*/
23790 halfword c
, d
; /* operation codes or modifiers
*/
23792 mp_sym mac_name
= NULL; /* token defined with \
&{secondarydef} */
23794 if
((cur_cmd
() < mp_min_primary_command
) ||
23795 (cur_cmd
() > mp_max_primary_command
))
23796 mp_bad_exp
(mp
, "A tertiary");
23797 @.A tertiary expression...@
>;
23798 mp_scan_secondary
(mp
);
23800 if
(cur_cmd
() <= mp_max_tertiary_command
) {
23801 if
(cur_cmd
() >= mp_min_tertiary_command
) {
23802 p
= mp_stash_cur_exp
(mp
);
23805 if
(d
== mp_tertiary_secondary_macro
) {
23806 cc
= cur_mod_node
();
23807 mac_name
= cur_sym
();
23810 mp_get_x_next
(mp
);
23811 mp_scan_secondary
(mp
);
23812 if
(d
!= mp_tertiary_secondary_macro
) {
23813 mp_do_binary
(mp
, p
, c
);
23815 mp_back_input
(mp
);
23816 mp_binary_mac
(mp
, p
, cc
, mac_name
);
23818 mp_get_x_next
(mp
);
23827 @ Finally we reach the deepest level in our quartet of parsing routines.
23828 This one is much like the others
; but it has an extra complication from
23829 paths
, which materialize here.
23831 @
<Declare the basic parsing subroutines@
>=
23832 static int mp_scan_path
(MP mp
);
23833 static void mp_scan_expression
(MP mp
) {
23834 int my_var_flag
; /* initial value of |var_flag|
*/
23835 my_var_flag
= mp-
>var_flag
;
23836 check_expansion_depth
();
23838 if
((cur_cmd
() < mp_min_primary_command
) ||
23839 (cur_cmd
() > mp_max_primary_command
))
23840 mp_bad_exp
(mp
, "An");
23841 @.An expression...@
>;
23842 mp_scan_tertiary
(mp
);
23844 if
(cur_cmd
() <= mp_max_expression_command
) {
23845 if
(cur_cmd
() >= mp_min_expression_command
) {
23846 if
((cur_cmd
() != mp_equals
) ||
(my_var_flag
!= mp_assignment
)) {
23847 mp_node p
; /* for list manipulation
*/
23850 halfword d
; /* operation codes or modifiers
*/
23851 mp_sym mac_name
; /* token defined with \
&{tertiarydef} */
23853 p
= mp_stash_cur_exp
(mp
);
23856 if
(d
== mp_expression_tertiary_macro
) {
23857 cc
= cur_mod_node
();
23858 mac_name
= cur_sym
();
23861 if
((d
< mp_ampersand
) ||
((d
== mp_ampersand
) &&
23862 ((mp_type
(p
) == mp_pair_type
)
23863 ||
(mp_type
(p
) == mp_path_type
)))) {
23864 /* Scan a path construction operation
; but |return| if |p| has the wrong type
*/
23866 mp_unstash_cur_exp
(mp
, p
);
23867 if
(!mp_scan_path
(mp
)) {
23868 mp-
>expand_depth_count--
;
23872 mp_get_x_next
(mp
);
23873 mp_scan_tertiary
(mp
);
23874 if
(d
!= mp_expression_tertiary_macro
) {
23875 mp_do_binary
(mp
, p
, c
);
23877 mp_back_input
(mp
);
23878 mp_binary_mac
(mp
, p
, cc
, mac_name
);
23880 mp_get_x_next
(mp
);
23888 mp-
>expand_depth_count--
;
23892 @ The reader should review the data structure conventions for paths before
23893 hoping to understand the next part of this code.
23895 @d min_tension three_quarter_unit_t
23897 @
<Declare the basic parsing subroutines@
>=
23898 static void force_valid_tension_setting
(MP mp
) {
23899 if
((mp-
>cur_exp.type
!= mp_known
) || number_less
(cur_exp_value_number
(), min_tension
)) {
23901 const char
*hlp
[] = {
23902 "The expression above should have been a number >=3/4.",
23904 memset
(&new_expr,0,sizeof(mp_value));
23905 new_number
(new_expr.data.n
);
23906 mp_disp_err
(mp
, NULL);
23907 number_clone
(new_expr.data.n
, unity_t
);
23908 mp_back_error
(mp
, "Improper tension has been set to 1", hlp
, true
);
23909 mp_get_x_next
(mp
);
23910 mp_flush_cur_exp
(mp
, new_expr
);
23913 static int mp_scan_path
(MP mp
) {
23914 mp_knot path_p
, path_q
, r
;
23916 halfword d
; /* operation code or modifier
*/
23917 boolean cycle_hit
; /* did a path expression just end with `\
&{cycle}'? */
23918 mp_number x
, y
; /* explicit coordinates or tension at a path join
*/
23919 int t
; /* knot type following a path join
*/
23922 /* Convert the left operand
, |p|
, into a partial path ending at~|q|
;
23923 but |return| if |p| doesn't have a suitable type
*/
23924 if
(mp-
>cur_exp.type
== mp_pair_type
)
23925 path_p
= mp_pair_to_knot
(mp
);
23926 else if
(mp-
>cur_exp.type
== mp_path_type
)
23927 path_p
= cur_exp_knot
();
23931 while
(mp_next_knot
(path_q
) != path_p
)
23932 path_q
= mp_next_knot
(path_q
);
23933 if
(mp_left_type
(path_p
) != mp_endpoint
) { /* open up a cycle
*/
23934 r
= mp_copy_knot
(mp
, path_p
);
23935 mp_next_knot
(path_q
) = r
;
23938 mp_left_type
(path_p
) = mp_open
;
23939 mp_right_type
(path_q
) = mp_open
;
23945 /* Determine the path join parameters
;
23946 but |goto finish_path| if there's only a direction specifier
*/
23947 /* At this point |cur_cmd| is either |ampersand|
, |left_brace|
, or |path_join|.
*/
23949 if
(cur_cmd
() == mp_left_brace
) {
23950 /* Put the pre-join direction information into node |q|
*/
23951 /* At this point |mp_right_type
(q
)| is usually |open|
, but it may have been
23952 set to some other value by a previous operation. We must maintain
23953 the value of |mp_right_type
(q
)| in cases such as
23954 `\.
{..\
{curl2\
}z\
{0,0\
}..
}'.
*/
23955 t
= mp_scan_direction
(mp
);
23956 if
(t
!= mp_open
) {
23957 mp_right_type
(path_q
) = (unsigned short
) t
;
23958 number_clone
(path_q-
>right_given
, cur_exp_value_number
());
23959 if
(mp_left_type
(path_q
) == mp_open
) {
23960 mp_left_type
(path_q
) = (unsigned short
) t
;
23961 number_clone
(path_q-
>left_given
, cur_exp_value_number
());
23962 } /* note that |left_given
(q
)=left_curl
(q
)|
*/
23966 if
(d
== mp_path_join
) {
23967 /* Determine the tension and
/or control points
*/
23968 mp_get_x_next
(mp
);
23969 if
(cur_cmd
() == mp_tension
) {
23970 /* Set explicit tensions
*/
23971 mp_get_x_next
(mp
);
23972 set_number_from_scaled
(y
, cur_cmd
());
23973 if
(cur_cmd
() == mp_at_least
)
23974 mp_get_x_next
(mp
);
23975 mp_scan_primary
(mp
);
23976 force_valid_tension_setting
(mp
);
23977 if
(number_to_scaled
(y
) == mp_at_least
) {
23978 if
(is_number
(cur_exp_value_number
()))
23979 number_negate
(cur_exp_value_number
());
23981 number_clone
(path_q-
>right_tension
, cur_exp_value_number
());
23982 if
(cur_cmd
() == mp_and_command
) {
23983 mp_get_x_next
(mp
);
23984 set_number_from_scaled
(y
, cur_cmd
());
23985 if
(cur_cmd
() == mp_at_least
)
23986 mp_get_x_next
(mp
);
23987 mp_scan_primary
(mp
);
23988 force_valid_tension_setting
(mp
);
23989 if
(number_to_scaled
(y
) == mp_at_least
) {
23990 if
(is_number
(cur_exp_value_number
()))
23991 number_negate
(cur_exp_value_number
());
23994 number_clone
(y
, cur_exp_value_number
());
23996 } else if
(cur_cmd
() == mp_controls
) {
23997 /* Set explicit control points
*/
23998 mp_right_type
(path_q
) = mp_explicit
;
24000 mp_get_x_next
(mp
);
24001 mp_scan_primary
(mp
);
24002 mp_known_pair
(mp
);
24003 number_clone
(path_q-
>right_x
, mp-
>cur_x
);
24004 number_clone
(path_q-
>right_y
, mp-
>cur_y
);
24005 if
(cur_cmd
() != mp_and_command
) {
24006 number_clone
(x
, path_q-
>right_x
);
24007 number_clone
(y
, path_q-
>right_y
);
24009 mp_get_x_next
(mp
);
24010 mp_scan_primary
(mp
);
24011 mp_known_pair
(mp
);
24012 number_clone
(x
, mp-
>cur_x
);
24013 number_clone
(y
, mp-
>cur_y
);
24017 set_number_to_unity
(path_q-
>right_tension
);
24018 set_number_to_unity
(y
);
24019 mp_back_input
(mp
); /* default tension
*/
24022 if
(cur_cmd
() != mp_path_join
) {
24023 const char
*hlp
[] = { "A path join command should end with two dots.", NULL};
24024 mp_back_error
(mp
, "Missing `..' has been inserted", hlp
, true
);
24028 } else if
(d
!= mp_ampersand
) {
24031 mp_get_x_next
(mp
);
24032 if
(cur_cmd
() == mp_left_brace
) {
24033 /* Put the post-join direction information into |x| and |t|
*/
24034 /* Since |left_tension| and |mp_left_y| share the same position in knot nodes
,
24035 and since |left_given| is similarly equivalent to |left_x|
, we use
24036 |x| and |y| to hold the given direction and tension information when
24037 there are no explicit control points.
*/
24038 t
= mp_scan_direction
(mp
);
24039 if
(mp_right_type
(path_q
) != mp_explicit
)
24040 number_clone
(x
, cur_exp_value_number
());
24042 t
= mp_explicit
; /* the direction information is superfluous
*/
24044 } else if
(mp_right_type
(path_q
) != mp_explicit
) {
24046 set_number_to_zero
(x
);
24049 if
(cur_cmd
() == mp_cycle
) {
24050 /* Get ready to close a cycle
*/
24051 /* If a person tries to define an entire path by saying `\.
{(x
,y
)\
&cycle}',
24052 we silently change the specification to `\.
{(x
,y
)..cycle
}'
, since a cycle
24053 shouldn't have length zero.
*/
24055 mp_get_x_next
(mp
);
24058 if
(d
== mp_ampersand
) {
24059 if
(path_p
== path_q
) {
24061 set_number_to_unity
(path_q-
>right_tension
);
24062 set_number_to_unity
(y
);
24066 mp_scan_tertiary
(mp
);
24067 /* Convert the right operand
, |cur_exp|
,
24068 into a partial path from |pp| to~|qq|
*/
24069 if
(mp-
>cur_exp.type
!= mp_path_type
)
24070 pp
= mp_pair_to_knot
(mp
);
24072 pp
= cur_exp_knot
();
24074 while
(mp_next_knot
(qq
) != pp
)
24075 qq
= mp_next_knot
(qq
);
24076 if
(mp_left_type
(pp
) != mp_endpoint
) { /* open up a cycle
*/
24077 r
= mp_copy_knot
(mp
, pp
);
24078 mp_next_knot
(qq
) = r
;
24081 mp_left_type
(pp
) = mp_open
;
24082 mp_right_type
(qq
) = mp_open
;
24084 /* Join the partial paths and reset |p| and |q| to the head and tail
24086 if
(d
== mp_ampersand
) {
24087 if
(!(number_equal
(path_q-
>x_coord
, pp-
>x_coord
)) ||
24088 !(number_equal
(path_q-
>y_coord
, pp-
>y_coord
))) {
24089 const char
*hlp
[] = {
24090 "When you join paths `p&q', the ending point of p",
24091 "must be exactly equal to the starting point of q.",
24092 "So I'm going to pretend that you said `p..q' instead.",
24094 mp_back_error
(mp
, "Paths don't touch; `&' will be changed to `..'", hlp
, true
);
24095 @.Paths don't touch@
>;
24096 mp_get_x_next
(mp
);
24098 set_number_to_unity
(path_q-
>right_tension
);
24099 set_number_to_unity
(y
);
24102 /* Plug an opening in |mp_right_type
(pp
)|
, if possible
*/
24103 if
(mp_right_type
(pp
) == mp_open
) {
24104 if
((t
== mp_curl
) ||
(t
== mp_given
)) {
24105 mp_right_type
(pp
) = (unsigned short
) t
;
24106 number_clone
(pp-
>right_given
, x
);
24109 if
(d
== mp_ampersand
) {
24110 /* Splice independent paths together
*/
24111 if
(mp_left_type
(path_q
) == mp_open
)
24112 if
(mp_right_type
(path_q
) == mp_open
) {
24113 mp_left_type
(path_q
) = mp_curl
;
24114 set_number_to_unity
(path_q-
>left_curl
);
24116 if
(mp_right_type
(pp
) == mp_open
)
24117 if
(t
== mp_open
) {
24118 mp_right_type
(pp
) = mp_curl
;
24119 set_number_to_unity
(pp-
>right_curl
);
24121 mp_right_type
(path_q
) = mp_right_type
(pp
);
24122 mp_next_knot
(path_q
) = mp_next_knot
(pp
);
24123 number_clone
(path_q-
>right_x
, pp-
>right_x
);
24124 number_clone
(path_q-
>right_y
, pp-
>right_y
);
24130 /* Plug an opening in |mp_right_type
(q
)|
, if possible
*/
24131 if
(mp_right_type
(path_q
) == mp_open
) {
24132 if
((mp_left_type
(path_q
) == mp_curl
) ||
(mp_left_type
(path_q
) == mp_given
)) {
24133 mp_right_type
(path_q
) = mp_left_type
(path_q
);
24134 number_clone
(path_q-
>right_given
, path_q-
>left_given
);
24138 mp_next_knot
(path_q
) = pp
;
24139 number_clone
(pp-
>left_y
, y
);
24140 if
(t
!= mp_open
) {
24141 number_clone
(pp-
>left_x
, x
);
24142 mp_left_type
(pp
) = (unsigned short
) t
;
24147 if
(cur_cmd
() >= mp_min_expression_command
)
24148 if
(cur_cmd
() <= mp_ampersand
)
24150 goto CONTINUE_PATH
;
24152 /* Choose control points for the path and put the result into |cur_exp|
*/
24154 if
(d
== mp_ampersand
)
24157 mp_left_type
(path_p
) = mp_endpoint
;
24158 if
(mp_right_type
(path_p
) == mp_open
) {
24159 mp_right_type
(path_p
) = mp_curl
;
24160 set_number_to_unity
(path_p-
>right_curl
);
24162 mp_right_type
(path_q
) = mp_endpoint
;
24163 if
(mp_left_type
(path_q
) == mp_open
) {
24164 mp_left_type
(path_q
) = mp_curl
;
24165 set_number_to_unity
(path_q-
>left_curl
);
24167 mp_next_knot
(path_q
) = path_p
;
24169 mp_make_choices
(mp
, path_p
);
24170 mp-
>cur_exp.type
= mp_path_type
;
24171 set_cur_exp_knot
(path_p
);
24179 @ A pair of numeric values is changed into a knot node for a one-point path
24180 when \MP\ discovers that the pair is part of a path.
24183 static mp_knot mp_pair_to_knot
(MP mp
) { /* convert a pair to a knot with two endpoints
*/
24184 mp_knot q
; /* the new node
*/
24185 q
= mp_new_knot
(mp
);
24186 mp_left_type
(q
) = mp_endpoint
;
24187 mp_right_type
(q
) = mp_endpoint
;
24188 mp_originator
(q
) = mp_metapost_user
;
24189 mp_next_knot
(q
) = q
;
24190 mp_known_pair
(mp
);
24191 number_clone
(q-
>x_coord
, mp-
>cur_x
);
24192 number_clone
(q-
>y_coord
, mp-
>cur_y
);
24197 @ The |known_pair| subroutine sets |cur_x| and |cur_y| to the components
24198 of the current expression
, assuming that the current expression is a
24199 pair of known numerics. Unknown components are zeroed
, and the
24200 current expression is flushed.
24203 static void mp_known_pair
(MP mp
);
24206 void mp_known_pair
(MP mp
) {
24208 mp_node p
; /* the pair node
*/
24209 memset
(&new_expr,0,sizeof(mp_value));
24210 new_number
(new_expr.data.n
);
24211 if
(mp-
>cur_exp.type
!= mp_pair_type
) {
24212 const char
*hlp
[] = {
24213 "I need x and y numbers for this part of the path.",
24214 "The value I found (see above) was no good;",
24215 "so I'll try to keep going by using zero instead.",
24216 "(Chapter 27 of The METAFONTbook explains that",
24217 "you might want to type `I ??" "?' now.)",
24219 mp_disp_err
(mp
, NULL);
24220 mp_back_error
(mp
, "Undefined coordinates have been replaced by (0,0)", hlp
, true
);
24221 mp_get_x_next
(mp
);
24222 mp_flush_cur_exp
(mp
, new_expr
);
24223 set_number_to_zero
(mp-
>cur_x
);
24224 set_number_to_zero
(mp-
>cur_y
);
24226 p
= value_node
(cur_exp_node
());
24227 /* Make sure that both |x| and |y| parts of |p| are known
;
24228 copy them into |cur_x| and |cur_y|
*/
24229 if
(mp_type
(x_part
(p
)) == mp_known
) {
24230 number_clone
(mp-
>cur_x
, value_number
(x_part
(p
)));
24232 const char
*hlp
[] = {
24233 "I need a `known' x value for this part of the path.",
24234 "The value I found (see above) was no good;",
24235 "so I'll try to keep going by using zero instead.",
24236 "(Chapter 27 of The METAFONTbook explains that",
24237 "you might want to type `I ??" "?' now.)",
24239 mp_disp_err
(mp
, x_part
(p
));
24240 mp_back_error
(mp
, "Undefined x coordinate has been replaced by 0", hlp
, true
);
24241 mp_get_x_next
(mp
);
24242 mp_recycle_value
(mp
, x_part
(p
));
24243 set_number_to_zero
(mp-
>cur_x
);
24245 if
(mp_type
(y_part
(p
)) == mp_known
) {
24246 number_clone
(mp-
>cur_y
, value_number
(y_part
(p
)));
24248 const char
*hlp
[] = {
24249 "I need a `known' y value for this part of the path.",
24250 "The value I found (see above) was no good;",
24251 "so I'll try to keep going by using zero instead.",
24252 "(Chapter 27 of The METAFONTbook explains that",
24253 "you might want to type `I ??" "?' now.)",
24255 mp_disp_err
(mp
, y_part
(p
));
24256 mp_back_error
(mp
, "Undefined y coordinate has been replaced by 0", hlp
, true
);
24257 mp_get_x_next
(mp
);
24258 mp_recycle_value
(mp
, y_part
(p
));
24259 set_number_to_zero
(mp-
>cur_y
);
24261 mp_flush_cur_exp
(mp
, new_expr
);
24265 @ The |scan_direction| subroutine looks at the directional information
24266 that is enclosed in braces
, and also scans ahead to the following character.
24267 A type code is returned
, either |open|
(if the direction was $
(0,0)$
),
24268 or |curl|
(if the direction was a curl of known value |cur_exp|
), or
24269 |given|
(if the direction is given by the |angle| value that now
24270 appears in |cur_exp|
).
24272 There's nothing difficult about this subroutine
, but the program is rather
24273 lengthy because a variety of potential errors need to be nipped in the bud.
24276 static quarterword mp_scan_direction
(MP mp
) {
24277 int t
; /* the type of information found
*/
24278 mp_get_x_next
(mp
);
24279 if
(cur_cmd
() == mp_curl_command
) {
24280 /* Scan a curl specification
*/
24281 mp_get_x_next
(mp
);
24282 mp_scan_expression
(mp
);
24283 if
((mp-
>cur_exp.type
!= mp_known
) ||
(number_negative
(cur_exp_value_number
()))) {
24285 const char
*hlp
[] = { "A curl must be a known, nonnegative number.", NULL };
24286 memset
(&new_expr,0,sizeof(mp_value));
24287 new_number
(new_expr.data.n
);
24288 set_number_to_unity
(new_expr.data.n
);
24289 mp_disp_err
(mp
, NULL);
24290 mp_back_error
(mp
, "Improper curl has been replaced by 1", hlp
, true
);
24291 mp_get_x_next
(mp
);
24292 mp_flush_cur_exp
(mp
, new_expr
);
24297 /* Scan a given direction
*/
24298 mp_scan_expression
(mp
);
24299 if
(mp-
>cur_exp.type
> mp_pair_type
) {
24300 /* Get given directions separated by commas
*/
24303 if
(mp-
>cur_exp.type
!= mp_known
) {
24305 const char
*hlp
[] = {
24306 "I need a `known' x value for this part of the path.",
24307 "The value I found (see above) was no good;",
24308 "so I'll try to keep going by using zero instead.",
24309 "(Chapter 27 of The METAFONTbook explains that",
24310 "you might want to type `I ??" "?' now.)",
24312 memset
(&new_expr,0,sizeof(mp_value));
24313 new_number
(new_expr.data.n
);
24314 set_number_to_zero
(new_expr.data.n
);
24315 mp_disp_err
(mp
, NULL);
24316 mp_back_error
(mp
, "Undefined x coordinate has been replaced by 0", hlp
, true
);
24317 mp_get_x_next
(mp
);
24318 mp_flush_cur_exp
(mp
, new_expr
);
24320 number_clone
(xx
, cur_exp_value_number
());
24321 if
(cur_cmd
() != mp_comma
) {
24322 const char
*hlp
[] = {
24323 "I've got the x coordinate of a path direction;",
24324 "will look for the y coordinate next.",
24326 mp_back_error
(mp
, "Missing `,' has been inserted", hlp
, true
);
24328 mp_get_x_next
(mp
);
24329 mp_scan_expression
(mp
);
24330 if
(mp-
>cur_exp.type
!= mp_known
) {
24332 const char
*hlp
[] = {
24333 "I need a `known' y value for this part of the path.",
24334 "The value I found (see above) was no good;",
24335 "so I'll try to keep going by using zero instead.",
24336 "(Chapter 27 of The METAFONTbook explains that",
24337 "you might want to type `I ??" "?' now.)",
24339 memset
(&new_expr,0,sizeof(mp_value));
24340 new_number
(new_expr.data.n
);
24341 set_number_to_zero
(new_expr.data.n
);
24342 mp_disp_err
(mp
, NULL);
24343 mp_back_error
(mp
, "Undefined y coordinate has been replaced by 0", hlp
, true
);
24344 mp_get_x_next
(mp
);
24345 mp_flush_cur_exp
(mp
, new_expr
);
24347 number_clone
(mp-
>cur_y
, cur_exp_value_number
());
24348 number_clone
(mp-
>cur_x
, xx
);
24352 mp_known_pair
(mp
);
24354 if
(number_zero
(mp-
>cur_x
) && number_zero(mp->cur_y))
24359 n_arg
(narg
, mp-
>cur_x
, mp-
>cur_y
);
24361 set_cur_exp_value_number
(narg
);
24362 free_number
(narg
);
24365 if
(cur_cmd
() != mp_right_brace
) {
24366 const char
*hlp
[] = {
24367 "I've scanned a direction spec for part of a path,",
24368 "so a right brace should have come next.",
24369 "I shall pretend that one was there.",
24371 mp_back_error
(mp
, "Missing `}' has been inserted", hlp
, true
);
24373 mp_get_x_next
(mp
);
24374 return
(quarterword
) t
;
24378 @ Finally
, we sometimes need to scan an expression whose value is
24379 supposed to be either |true_code| or |false_code|.
24381 @d mp_get_boolean
(mp
) do
{
24382 mp_get_x_next
(mp
);
24383 mp_scan_expression
(mp
);
24384 if
(mp-
>cur_exp.type
!= mp_boolean_type
) {
24385 do_boolean_error
(mp
);
24389 @
<Declare the basic parsing subroutines@
>=
24390 static void do_boolean_error
(MP mp
) {
24392 const char
*hlp
[] = {
24393 "The expression shown above should have had a definite",
24394 "true-or-false value. I'm changing it to `false'.",
24396 memset
(&new_expr,0,sizeof(mp_value));
24397 new_number
(new_expr.data.n
);
24398 mp_disp_err
(mp
, NULL);
24399 set_number_from_boolean
(new_expr.data.n
, mp_false_code
);
24400 mp_back_error
(mp
, "Undefined condition will be treated as `false'", hlp
, true
);
24401 mp_get_x_next
(mp
);
24402 mp_flush_cur_exp
(mp
, new_expr
);
24403 mp-
>cur_exp.type
= mp_boolean_type
;
24406 @ @
<Declarations@
>=
24407 static void do_boolean_error
(MP mp
);
24409 @
* Doing the operations.
24410 The purpose of parsing is primarily to permit people to avoid piles of
24411 parentheses. But the real work is done after the structure of an expression
24412 has been recognized
; that's when new expressions are generated. We
24413 turn now to the guts of \MP
, which handles individual operators that
24414 have come through the parsing mechanism.
24416 We'll start with the easy ones that take no operands
, then work our way
24417 up to operators with one and ultimately two arguments. In other words
,
24418 we will write the three procedures |do_nullary|
, |do_unary|
, and |do_binary|
24419 that are invoked periodically by the expression scanners.
24421 First let's make sure that all of the primitive operators are in the
24422 hash table. Although |scan_primary| and its relatives made use of the
24423 \\
{cmd
} code for these operators
, the \\
{do
} routines base everything
24424 on the \\
{mod
} code. For example
, |do_binary| doesn't care whether the
24425 operation it performs is a |primary_binary| or |secondary_binary|
, etc.
24428 mp_primitive
(mp
, "true", mp_nullary
, mp_true_code
);
24429 @
:true_
}{\
&{true} primitive@>;
24430 mp_primitive
(mp
, "false", mp_nullary
, mp_false_code
);
24431 @
:false_
}{\
&{false} primitive@>;
24432 mp_primitive
(mp
, "nullpicture", mp_nullary
, mp_null_picture_code
);
24433 @
:null_picture_
}{\
&{nullpicture} primitive@>;
24434 mp_primitive
(mp
, "nullpen", mp_nullary
, mp_null_pen_code
);
24435 @
:null_pen_
}{\
&{nullpen} primitive@>;
24436 mp_primitive
(mp
, "readstring", mp_nullary
, mp_read_string_op
);
24437 @
:read_string_
}{\
&{readstring} primitive@>;
24438 mp_primitive
(mp
, "pencircle", mp_nullary
, mp_pen_circle
);
24439 @
:pen_circle_
}{\
&{pencircle} primitive@>;
24440 mp_primitive
(mp
, "normaldeviate", mp_nullary
, mp_normal_deviate
);
24441 @
:normal_deviate_
}{\
&{normaldeviate} primitive@>;
24442 mp_primitive
(mp
, "readfrom", mp_unary
, mp_read_from_op
);
24443 @
:read_from_
}{\
&{readfrom} primitive@>;
24444 mp_primitive
(mp
, "closefrom", mp_unary
, mp_close_from_op
);
24445 @
:close_from_
}{\
&{closefrom} primitive@>;
24446 mp_primitive
(mp
, "odd", mp_unary
, mp_odd_op
);
24447 @
:odd_
}{\
&{odd} primitive@>;
24448 mp_primitive
(mp
, "known", mp_unary
, mp_known_op
);
24449 @
:known_
}{\
&{known} primitive@>;
24450 mp_primitive
(mp
, "unknown", mp_unary
, mp_unknown_op
);
24451 @
:unknown_
}{\
&{unknown} primitive@>;
24452 mp_primitive
(mp
, "not", mp_unary
, mp_not_op
);
24453 @
:not_
}{\
&{not} primitive@>;
24454 mp_primitive
(mp
, "decimal", mp_unary
, mp_decimal
);
24455 @
:decimal_
}{\
&{decimal} primitive@>;
24456 mp_primitive
(mp
, "reverse", mp_unary
, mp_reverse
);
24457 @
:reverse_
}{\
&{reverse} primitive@>;
24458 mp_primitive
(mp
, "makepath", mp_unary
, mp_make_path_op
);
24459 @
:make_path_
}{\
&{makepath} primitive@>;
24460 mp_primitive
(mp
, "makepen", mp_unary
, mp_make_pen_op
);
24461 @
:make_pen_
}{\
&{makepen} primitive@>;
24462 mp_primitive
(mp
, "oct", mp_unary
, mp_oct_op
);
24463 @
:oct_
}{\
&{oct} primitive@>;
24464 mp_primitive
(mp
, "hex", mp_unary
, mp_hex_op
);
24465 @
:hex_
}{\
&{hex} primitive@>;
24466 mp_primitive
(mp
, "ASCII", mp_unary
, mp_ASCII_op
);
24467 @
:ASCII_
}{\
&{ASCII} primitive@>;
24468 mp_primitive
(mp
, "char", mp_unary
, mp_char_op
);
24469 @
:char_
}{\
&{char} primitive@>;
24470 mp_primitive
(mp
, "length", mp_unary
, mp_length_op
);
24471 @
:length_
}{\
&{length} primitive@>;
24472 mp_primitive
(mp
, "turningnumber", mp_unary
, mp_turning_op
);
24473 @
:turning_number_
}{\
&{turningnumber} primitive@>;
24474 mp_primitive
(mp
, "xpart", mp_unary
, mp_x_part
);
24475 @
:x_part_
}{\
&{xpart} primitive@>;
24476 mp_primitive
(mp
, "ypart", mp_unary
, mp_y_part
);
24477 @
:y_part_
}{\
&{ypart} primitive@>;
24478 mp_primitive
(mp
, "xxpart", mp_unary
, mp_xx_part
);
24479 @
:xx_part_
}{\
&{xxpart} primitive@>;
24480 mp_primitive
(mp
, "xypart", mp_unary
, mp_xy_part
);
24481 @
:xy_part_
}{\
&{xypart} primitive@>;
24482 mp_primitive
(mp
, "yxpart", mp_unary
, mp_yx_part
);
24483 @
:yx_part_
}{\
&{yxpart} primitive@>;
24484 mp_primitive
(mp
, "yypart", mp_unary
, mp_yy_part
);
24485 @
:yy_part_
}{\
&{yypart} primitive@>;
24486 mp_primitive
(mp
, "redpart", mp_unary
, mp_red_part
);
24487 @
:red_part_
}{\
&{redpart} primitive@>;
24488 mp_primitive
(mp
, "greenpart", mp_unary
, mp_green_part
);
24489 @
:green_part_
}{\
&{greenpart} primitive@>;
24490 mp_primitive
(mp
, "bluepart", mp_unary
, mp_blue_part
);
24491 @
:blue_part_
}{\
&{bluepart} primitive@>;
24492 mp_primitive
(mp
, "cyanpart", mp_unary
, mp_cyan_part
);
24493 @
:cyan_part_
}{\
&{cyanpart} primitive@>;
24494 mp_primitive
(mp
, "magentapart", mp_unary
, mp_magenta_part
);
24495 @
:magenta_part_
}{\
&{magentapart} primitive@>;
24496 mp_primitive
(mp
, "yellowpart", mp_unary
, mp_yellow_part
);
24497 @
:yellow_part_
}{\
&{yellowpart} primitive@>;
24498 mp_primitive
(mp
, "blackpart", mp_unary
, mp_black_part
);
24499 @
:black_part_
}{\
&{blackpart} primitive@>;
24500 mp_primitive
(mp
, "greypart", mp_unary
, mp_grey_part
);
24501 @
:grey_part_
}{\
&{greypart} primitive@>;
24502 mp_primitive
(mp
, "colormodel", mp_unary
, mp_color_model_part
);
24503 @
:color_model_part_
}{\
&{colormodel} primitive@>;
24504 mp_primitive
(mp
, "fontpart", mp_unary
, mp_font_part
);
24505 @
:font_part_
}{\
&{fontpart} primitive@>;
24506 mp_primitive
(mp
, "textpart", mp_unary
, mp_text_part
);
24507 @
:text_part_
}{\
&{textpart} primitive@>;
24508 mp_primitive
(mp
, "prescriptpart", mp_unary
, mp_prescript_part
);
24509 @
:prescript_part_
}{\
&{prescriptpart} primitive@>;
24510 mp_primitive
(mp
, "postscriptpart", mp_unary
, mp_postscript_part
);
24511 @
:postscript_part_
}{\
&{postscriptpart} primitive@>;
24512 mp_primitive
(mp
, "pathpart", mp_unary
, mp_path_part
);
24513 @
:path_part_
}{\
&{pathpart} primitive@>;
24514 mp_primitive
(mp
, "penpart", mp_unary
, mp_pen_part
);
24515 @
:pen_part_
}{\
&{penpart} primitive@>;
24516 mp_primitive
(mp
, "dashpart", mp_unary
, mp_dash_part
);
24517 @
:dash_part_
}{\
&{dashpart} primitive@>;
24518 mp_primitive
(mp
, "sqrt", mp_unary
, mp_sqrt_op
);
24519 @
:sqrt_
}{\
&{sqrt} primitive@>;
24520 mp_primitive
(mp
, "mexp", mp_unary
, mp_m_exp_op
);
24521 @
:m_exp_
}{\
&{mexp} primitive@>;
24522 mp_primitive
(mp
, "mlog", mp_unary
, mp_m_log_op
);
24523 @
:m_log_
}{\
&{mlog} primitive@>;
24524 mp_primitive
(mp
, "sind", mp_unary
, mp_sin_d_op
);
24525 @
:sin_d_
}{\
&{sind} primitive@>;
24526 mp_primitive
(mp
, "cosd", mp_unary
, mp_cos_d_op
);
24527 @
:cos_d_
}{\
&{cosd} primitive@>;
24528 mp_primitive
(mp
, "floor", mp_unary
, mp_floor_op
);
24529 @
:floor_
}{\
&{floor} primitive@>;
24530 mp_primitive
(mp
, "uniformdeviate", mp_unary
, mp_uniform_deviate
);
24531 @
:uniform_deviate_
}{\
&{uniformdeviate} primitive@>;
24532 mp_primitive
(mp
, "charexists", mp_unary
, mp_char_exists_op
);
24533 @
:char_exists_
}{\
&{charexists} primitive@>;
24534 mp_primitive
(mp
, "fontsize", mp_unary
, mp_font_size
);
24535 @
:font_size_
}{\
&{fontsize} primitive@>;
24536 mp_primitive
(mp
, "llcorner", mp_unary
, mp_ll_corner_op
);
24537 @
:ll_corner_
}{\
&{llcorner} primitive@>;
24538 mp_primitive
(mp
, "lrcorner", mp_unary
, mp_lr_corner_op
);
24539 @
:lr_corner_
}{\
&{lrcorner} primitive@>;
24540 mp_primitive
(mp
, "ulcorner", mp_unary
, mp_ul_corner_op
);
24541 @
:ul_corner_
}{\
&{ulcorner} primitive@>;
24542 mp_primitive
(mp
, "urcorner", mp_unary
, mp_ur_corner_op
);
24543 @
:ur_corner_
}{\
&{urcorner} primitive@>;
24544 mp_primitive
(mp
, "arclength", mp_unary
, mp_arc_length
);
24545 @
:arc_length_
}{\
&{arclength} primitive@>;
24546 mp_primitive
(mp
, "angle", mp_unary
, mp_angle_op
);
24547 @
:angle_
}{\
&{angle} primitive@>;
24548 mp_primitive
(mp
, "cycle", mp_cycle
, mp_cycle_op
);
24549 @
:cycle_
}{\
&{cycle} primitive@>;
24550 mp_primitive
(mp
, "stroked", mp_unary
, mp_stroked_op
);
24551 @
:stroked_
}{\
&{stroked} primitive@>;
24552 mp_primitive
(mp
, "filled", mp_unary
, mp_filled_op
);
24553 @
:filled_
}{\
&{filled} primitive@>;
24554 mp_primitive
(mp
, "textual", mp_unary
, mp_textual_op
);
24555 @
:textual_
}{\
&{textual} primitive@>;
24556 mp_primitive
(mp
, "clipped", mp_unary
, mp_clipped_op
);
24557 @
:clipped_
}{\
&{clipped} primitive@>;
24558 mp_primitive
(mp
, "bounded", mp_unary
, mp_bounded_op
);
24559 @
:bounded_
}{\
&{bounded} primitive@>;
24560 mp_primitive
(mp
, "+", mp_plus_or_minus
, mp_plus
);
24561 @
:+ }{\.
{+} primitive@
>;
24562 mp_primitive
(mp
, "-", mp_plus_or_minus
, mp_minus
);
24563 @
:- }{\.
{-} primitive@
>;
24564 mp_primitive
(mp
, "*", mp_secondary_binary
, mp_times
);
24565 @
:* }{\.
{*} primitive@
>;
24566 mp_primitive
(mp
, "/", mp_slash
, mp_over
);
24567 mp-
>frozen_slash
= mp_frozen_primitive
(mp
, "/", mp_slash
, mp_over
);
24568 @
:/ }{\.
{/} primitive@
>;
24569 mp_primitive
(mp
, "++", mp_tertiary_binary
, mp_pythag_add
);
24570 @
:++_
}{\.
{++} primitive@
>;
24571 mp_primitive
(mp
, "+-+", mp_tertiary_binary
, mp_pythag_sub
);
24572 @
:+-+_
}{\.
{+-+} primitive@
>;
24573 mp_primitive
(mp
, "or", mp_tertiary_binary
, mp_or_op
);
24574 @
:or_
}{\
&{or} primitive@>;
24575 mp_primitive
(mp
, "and", mp_and_command
, mp_and_op
);
24576 @
:and_
}{\
&{and} primitive@>;
24577 mp_primitive
(mp
, "<", mp_expression_binary
, mp_less_than
);
24578 @
:< }{\.
{<} primitive@
>;
24579 mp_primitive
(mp
, "<=", mp_expression_binary
, mp_less_or_equal
);
24580 @
:<=_
}{\.
{<=} primitive@
>;
24581 mp_primitive
(mp
, ">", mp_expression_binary
, mp_greater_than
);
24582 @
:> }{\.
{>} primitive@
>;
24583 mp_primitive
(mp
, ">=", mp_expression_binary
, mp_greater_or_equal
);
24584 @
:>=_
}{\.
{>=} primitive@
>;
24585 mp_primitive
(mp
, "=", mp_equals
, mp_equal_to
);
24586 @
:= }{\.
{=} primitive@
>;
24587 mp_primitive
(mp
, "<>", mp_expression_binary
, mp_unequal_to
);
24588 @
:<>_
}{\.
{<>} primitive@
>;
24589 mp_primitive
(mp
, "substring", mp_primary_binary
, mp_substring_of
);
24590 @
:substring_
}{\
&{substring} primitive@>;
24591 mp_primitive
(mp
, "subpath", mp_primary_binary
, mp_subpath_of
);
24592 @
:subpath_
}{\
&{subpath} primitive@>;
24593 mp_primitive
(mp
, "directiontime", mp_primary_binary
, mp_direction_time_of
);
24594 @
:direction_time_
}{\
&{directiontime} primitive@>;
24595 mp_primitive
(mp
, "point", mp_primary_binary
, mp_point_of
);
24596 @
:point_
}{\
&{point} primitive@>;
24597 mp_primitive
(mp
, "precontrol", mp_primary_binary
, mp_precontrol_of
);
24598 @
:precontrol_
}{\
&{precontrol} primitive@>;
24599 mp_primitive
(mp
, "postcontrol", mp_primary_binary
, mp_postcontrol_of
);
24600 @
:postcontrol_
}{\
&{postcontrol} primitive@>;
24601 mp_primitive
(mp
, "penoffset", mp_primary_binary
, mp_pen_offset_of
);
24602 @
:pen_offset_
}{\
&{penoffset} primitive@>;
24603 mp_primitive
(mp
, "arctime", mp_primary_binary
, mp_arc_time_of
);
24604 @
:arc_time_of_
}{\
&{arctime} primitive@>;
24605 mp_primitive
(mp
, "mpversion", mp_nullary
, mp_version
);
24606 @
:mp_verison_
}{\
&{mpversion} primitive@>;
24607 mp_primitive
(mp
, "&", mp_ampersand
, mp_concatenate
);
24608 @
:!!!}{\.
{\
&} primitive@>;
24609 mp_primitive
(mp
, "rotated", mp_secondary_binary
, mp_rotated_by
);
24610 @
:rotated_
}{\
&{rotated} primitive@>;
24611 mp_primitive
(mp
, "slanted", mp_secondary_binary
, mp_slanted_by
);
24612 @
:slanted_
}{\
&{slanted} primitive@>;
24613 mp_primitive
(mp
, "scaled", mp_secondary_binary
, mp_scaled_by
);
24614 @
:scaled_
}{\
&{scaled} primitive@>;
24615 mp_primitive
(mp
, "shifted", mp_secondary_binary
, mp_shifted_by
);
24616 @
:shifted_
}{\
&{shifted} primitive@>;
24617 mp_primitive
(mp
, "transformed", mp_secondary_binary
, mp_transformed_by
);
24618 @
:transformed_
}{\
&{transformed} primitive@>;
24619 mp_primitive
(mp
, "xscaled", mp_secondary_binary
, mp_x_scaled
);
24620 @
:x_scaled_
}{\
&{xscaled} primitive@>;
24621 mp_primitive
(mp
, "yscaled", mp_secondary_binary
, mp_y_scaled
);
24622 @
:y_scaled_
}{\
&{yscaled} primitive@>;
24623 mp_primitive
(mp
, "zscaled", mp_secondary_binary
, mp_z_scaled
);
24624 @
:z_scaled_
}{\
&{zscaled} primitive@>;
24625 mp_primitive
(mp
, "infont", mp_secondary_binary
, mp_in_font
);
24626 @
:in_font_
}{\
&{infont} primitive@>;
24627 mp_primitive
(mp
, "intersectiontimes", mp_tertiary_binary
, mp_intersect
);
24628 @
:intersection_times_
}{\
&{intersectiontimes} primitive@>;
24629 mp_primitive
(mp
, "envelope", mp_primary_binary
, mp_envelope_of
);
24630 @
:envelope_
}{\
&{envelope} primitive@>;
24631 mp_primitive
(mp
, "glyph", mp_primary_binary
, mp_glyph_infont
);
24632 @
:glyph_infont_
}{\
&{envelope} primitive@>
24635 @ @
<Cases of |print_cmd...@
>=
24638 case mp_primary_binary
:
24639 case mp_secondary_binary
:
24640 case mp_tertiary_binary
:
24641 case mp_expression_binary
:
24643 case mp_plus_or_minus
:
24647 case mp_and_command
:
24648 mp_print_op
(mp
, (quarterword
) m
);
24651 @
OK, let's look at the simplest \\
{do
} procedure first.
24654 @
<Declare nullary action procedure@
>;
24655 static void mp_do_nullary
(MP mp
, quarterword c
) {
24657 if
(number_greater
(internal_value
(mp_tracing_commands
), two_t
))
24658 mp_show_cmd_mod
(mp
, mp_nullary
, c
);
24661 case mp_false_code
:
24662 mp-
>cur_exp.type
= mp_boolean_type
;
24663 set_cur_exp_value_boolean
(c
);
24665 case mp_null_picture_code
:
24666 mp-
>cur_exp.type
= mp_picture_type
;
24667 set_cur_exp_node
((mp_node
)mp_get_edge_header_node
(mp
));
24668 mp_init_edges
(mp
, (mp_edge_header_node
)cur_exp_node
());
24670 case mp_null_pen_code
:
24671 mp-
>cur_exp.type
= mp_pen_type
;
24672 set_cur_exp_knot
(mp_get_pen_circle
(mp
, zero_t
));
24674 case mp_normal_deviate
:
24678 /*mp_norm_rand
(mp
, &r);*/
24680 mp-
>cur_exp.type
= mp_known
;
24681 set_cur_exp_value_number
(r
);
24685 case mp_pen_circle
:
24686 mp-
>cur_exp.type
= mp_pen_type
;
24687 set_cur_exp_knot
(mp_get_pen_circle
(mp
, unity_t
));
24690 mp-
>cur_exp.type
= mp_string_type
;
24691 set_cur_exp_str
(mp_intern
(mp
, metapost_version
));
24693 case mp_read_string_op
:
24694 /* Read a string from the terminal
*/
24695 if
(mp-
>noninteractive || mp-
>interaction
<= mp_nonstop_mode
)
24696 mp_fatal_error
(mp
, "*** (cannot readstring in nonstop modes)");
24697 mp_begin_file_reading
(mp
);
24701 mp_finish_read
(mp
);
24703 } /* there are no other cases
*/
24708 @ @
<Declare nullary action procedure@
>=
24709 static void mp_finish_read
(MP mp
) { /* copy |buffer| line to |cur_exp|
*/
24711 str_room
(((int
) mp-
>last
- (int
) start
));
24712 for
(k
= (size_t
) start
; k
< mp-
>last
; k
++) {
24713 append_char
(mp-
>buffer
[k
]);
24715 mp_end_file_reading
(mp
);
24716 mp-
>cur_exp.type
= mp_string_type
;
24717 set_cur_exp_str
(mp_make_string
(mp
));
24721 @ Things get a bit more interesting when there's an operand. The
24722 operand to |do_unary| appears in |cur_type| and |cur_exp|.
24724 This complicated if test makes sure that any |bounds| or |clip|
24725 picture objects that get passed into \
&{within} do not raise an
24726 error when queried using the color part primitives
(this is needed
24727 for backward compatibility
) .
24729 @d cur_pic_item mp_link
(edge_list
(cur_exp_node
()))
24730 @d pict_color_type
(A
) ((cur_pic_item
!=NULL) &&
24731 ((!has_color
(cur_pic_item
))
24733 (((mp_color_model
(cur_pic_item
)==A
)
24735 ((mp_color_model
(cur_pic_item
)==mp_uninitialized_model
) &&
24736 (number_to_scaled
(internal_value
(mp_default_color_model
))/number_to_scaled
(unity_t
))==(A
))))))
24738 @d boolean_reset
(A
) if
( (A
) ) set_cur_exp_value_boolean
(mp_true_code
); else set_cur_exp_value_boolean
(mp_false_code
)
24740 @d type_range
(A
,B
) {
24741 if
( (mp-
>cur_exp.type
>=(A
)) && (mp->cur_exp.type<=(B)) )
24742 set_number_from_boolean
(new_expr.data.n
, mp_true_code
);
24744 set_number_from_boolean
(new_expr.data.n
, mp_false_code
);
24745 mp_flush_cur_exp
(mp
, new_expr
);
24746 mp-
>cur_exp.type
=mp_boolean_type
;
24749 if
( mp-
>cur_exp.type
==(mp_variable_type
)(A
) )
24750 set_number_from_boolean
(new_expr.data.n
, mp_true_code
);
24752 set_number_from_boolean
(new_expr.data.n
, mp_false_code
);
24753 mp_flush_cur_exp
(mp
, new_expr
);
24754 mp-
>cur_exp.type
=mp_boolean_type
;
24759 @
<Declare unary action procedures@
>;
24760 static void mp_do_unary
(MP mp
, quarterword c
) {
24761 mp_node p
; /* for list manipulation
*/
24764 if
(number_greater
(internal_value
(mp_tracing_commands
), two_t
)) {
24765 /* Trace the current unary operation
*/
24766 mp_begin_diagnostic
(mp
);
24767 mp_print_nl
(mp
, "{");
24768 mp_print_op
(mp
, c
);
24769 mp_print_char
(mp
, xord
('
('
));
24770 mp_print_exp
(mp
, NULL, 0); /* show the operand
, but not verbosely
*/
24771 mp_print
(mp
, ")}");
24772 mp_end_diagnostic
(mp
, false
);
24776 if
(mp-
>cur_exp.type
< mp_color_type
)
24777 mp_bad_unary
(mp
, mp_plus
);
24780 negate_cur_expr
(mp
);
24783 if
(mp-
>cur_exp.type
!= mp_boolean_type
) {
24784 mp_bad_unary
(mp
, mp_not_op
);
24787 if
(cur_exp_value_boolean
() == mp_true_code
)
24788 bb
= mp_false_code
;
24791 set_cur_exp_value_boolean
(bb
);
24800 case mp_uniform_deviate
:
24802 case mp_char_exists_op
:
24803 if
(mp-
>cur_exp.type
!= mp_known
) {
24804 mp_bad_unary
(mp
, c
);
24811 square_rt
(r1
, cur_exp_value_number
());
24812 set_cur_exp_value_number
(r1
);
24820 m_exp
(r1
, cur_exp_value_number
());
24821 set_cur_exp_value_number
(r1
);
24829 m_log
(r1
, cur_exp_value_number
());
24830 set_cur_exp_value_number
(r1
);
24837 mp_number n_sin
, n_cos
, arg1
, arg2
;
24840 new_fraction
(n_sin
);
24841 new_fraction
(n_cos
); /* results computed by |n_sin_cos|
*/
24842 number_clone
(arg1
, cur_exp_value_number
());
24843 number_clone
(arg2
, unity_t
);
24844 number_multiply_int
(arg2
, 360);
24845 number_modulo
(arg1
, arg2
);
24846 convert_scaled_to_angle
(arg1
);
24847 n_sin_cos
(arg1
, n_cos
, n_sin
);
24848 if
(c
== mp_sin_d_op
) {
24849 fraction_to_round_scaled
(n_sin
);
24850 set_cur_exp_value_number
(n_sin
);
24852 fraction_to_round_scaled
(n_cos
);
24853 set_cur_exp_value_number
(n_cos
);
24855 free_number
(arg1
);
24856 free_number
(arg2
);
24857 free_number
(n_sin
);
24858 free_number
(n_cos
);
24865 number_clone
(vvx
, cur_exp_value_number
());
24866 floor_scaled
(vvx
);
24867 set_cur_exp_value_number
(vvx
);
24871 case mp_uniform_deviate
:
24875 /*mp_unif_rand
(mp
, &vvx, cur_exp_value_number ());*/
24876 m_unif_rand
(vvx
, cur_exp_value_number
());
24877 set_cur_exp_value_number
(vvx
);
24883 integer vvx
= odd
(round_unscaled
(cur_exp_value_number
()));
24884 boolean_reset
(vvx
);
24885 mp-
>cur_exp.type
= mp_boolean_type
;
24888 case mp_char_exists_op
:
24889 /* Determine if a character has been shipped out
*/
24890 set_cur_exp_value_scaled
(round_unscaled
(cur_exp_value_number
()) % 256);
24891 if
(number_negative
(cur_exp_value_number
())) {
24892 halfword vv
= number_to_scaled
(cur_exp_value_number
());
24893 set_cur_exp_value_scaled
(vv
+ 256);
24895 boolean_reset
(mp-
>char_exists
[number_to_scaled
(cur_exp_value_number
())]);
24896 mp-
>cur_exp.type
= mp_boolean_type
;
24898 } /* there are no other cases
*/
24902 if
(mp_nice_pair
(mp
, cur_exp_node
(), mp-
>cur_exp.type
)) {
24904 memset
(&new_expr,0,sizeof(mp_value));
24905 new_number
(new_expr.data.n
);
24907 p
= value_node
(cur_exp_node
());
24908 n_arg
(narg
, value_number
(x_part
(p
)), value_number
(y_part
(p
)));
24909 number_clone
(new_expr.data.n
, narg
);
24910 convert_angle_to_scaled
(new_expr.data.n
);
24911 free_number
(narg
);
24912 mp_flush_cur_exp
(mp
, new_expr
);
24914 mp_bad_unary
(mp
, mp_angle_op
);
24919 if
((mp-
>cur_exp.type
== mp_pair_type
)
24920 ||
(mp-
>cur_exp.type
== mp_transform_type
))
24921 mp_take_part
(mp
, c
);
24922 else if
(mp-
>cur_exp.type
== mp_picture_type
)
24923 mp_take_pict_part
(mp
, c
);
24925 mp_bad_unary
(mp
, c
);
24931 if
(mp-
>cur_exp.type
== mp_transform_type
)
24932 mp_take_part
(mp
, c
);
24933 else if
(mp-
>cur_exp.type
== mp_picture_type
)
24934 mp_take_pict_part
(mp
, c
);
24936 mp_bad_unary
(mp
, c
);
24939 case mp_green_part
:
24941 if
(mp-
>cur_exp.type
== mp_color_type
)
24942 mp_take_part
(mp
, c
);
24943 else if
(mp-
>cur_exp.type
== mp_picture_type
) {
24945 (mp_rgb_model
) mp_take_pict_part
(mp
, c
);
24947 mp_bad_color_part
(mp
, c
);
24949 mp_bad_unary
(mp
, c
);
24952 case mp_magenta_part
:
24953 case mp_yellow_part
:
24954 case mp_black_part
:
24955 if
(mp-
>cur_exp.type
== mp_cmykcolor_type
)
24956 mp_take_part
(mp
, c
);
24957 else if
(mp-
>cur_exp.type
== mp_picture_type
) {
24959 (mp_cmyk_model
) mp_take_pict_part
(mp
, c
);
24961 mp_bad_color_part
(mp
, c
);
24963 mp_bad_unary
(mp
, c
);
24966 if
(mp-
>cur_exp.type
== mp_known
);
24967 else if
(mp-
>cur_exp.type
== mp_picture_type
) {
24969 (mp_grey_model
) mp_take_pict_part
(mp
, c
);
24971 mp_bad_color_part
(mp
, c
);
24973 mp_bad_unary
(mp
, c
);
24975 case mp_color_model_part
:
24976 if
(mp-
>cur_exp.type
== mp_picture_type
)
24977 mp_take_pict_part
(mp
, c
);
24979 mp_bad_unary
(mp
, c
);
24986 case mp_prescript_part
:
24987 case mp_postscript_part
:
24988 if
(mp-
>cur_exp.type
== mp_picture_type
)
24989 mp_take_pict_part
(mp
, c
);
24991 mp_bad_unary
(mp
, c
);
24994 if
(mp-
>cur_exp.type
!= mp_known
) {
24995 mp_bad_unary
(mp
, mp_char_op
);
24997 int vv
= round_unscaled
(cur_exp_value_number
()) % 256;
24998 set_cur_exp_value_scaled
(vv
);
24999 mp-
>cur_exp.type
= mp_string_type
;
25000 if
(number_negative
(cur_exp_value_number
())) {
25001 vv
= number_to_scaled
(cur_exp_value_number
()) + 256;
25002 set_cur_exp_value_scaled
(vv
);
25005 unsigned char ss
[2];
25006 ss
[0] = (unsigned char
) number_to_scaled
(cur_exp_value_number
());
25008 set_cur_exp_str
(mp_rtsl
(mp
, (char
*) ss
, 1));
25013 if
(mp-
>cur_exp.type
!= mp_known
) {
25014 mp_bad_unary
(mp
, mp_decimal
);
25016 mp-
>old_setting
= mp-
>selector
;
25017 mp-
>selector
= new_string
;
25018 print_number
(cur_exp_value_number
());
25019 set_cur_exp_str
(mp_make_string
(mp
));
25020 mp-
>selector
= mp-
>old_setting
;
25021 mp-
>cur_exp.type
= mp_string_type
;
25027 if
(mp-
>cur_exp.type
!= mp_string_type
)
25028 mp_bad_unary
(mp
, c
);
25030 mp_str_to_num
(mp
, c
);
25033 if
(mp-
>cur_exp.type
!= mp_string_type
) {
25034 mp_bad_unary
(mp
, mp_font_size
);
25036 /* Find the design size of the font whose name is |cur_exp|
*/
25037 /* One simple application of |find_font| is the implementation of the |font_size|
25038 operator that gets the design size for a given font name.
*/
25039 memset
(&new_expr,0,sizeof(mp_value));
25040 new_number
(new_expr.data.n
);
25041 set_number_from_scaled
(new_expr.data.n
,
25042 (mp-
>font_dsize
[mp_find_font
(mp
, mp_str
(mp
, cur_exp_str
()))] + 8) / 16);
25043 mp_flush_cur_exp
(mp
, new_expr
);
25047 /* The length operation is somewhat unusual in that it applies to a variety
25048 of different types of operands.
*/
25049 switch
(mp-
>cur_exp.type
) {
25050 case mp_string_type
:
25051 memset
(&new_expr,0,sizeof(mp_value));
25052 new_number
(new_expr.data.n
);
25053 number_clone
(new_expr.data.n
, unity_t
);
25054 number_multiply_int
(new_expr.data.n
, cur_exp_str
()->len
);
25055 mp_flush_cur_exp
(mp
, new_expr
);
25058 memset
(&new_expr,0,sizeof(mp_value));
25059 new_number
(new_expr.data.n
);
25060 mp_path_length
(mp
, &new_expr.data.n);
25061 mp_flush_cur_exp
(mp
, new_expr
);
25064 set_cur_exp_value_number
(cur_exp_value_number
());
25065 number_abs
(cur_exp_value_number
());
25067 case mp_picture_type
:
25068 memset
(&new_expr,0,sizeof(mp_value));
25069 new_number
(new_expr.data.n
);
25070 mp_pict_length
(mp
, &new_expr.data.n);
25071 mp_flush_cur_exp
(mp
, new_expr
);
25074 if
(mp_nice_pair
(mp
, cur_exp_node
(), mp-
>cur_exp.type
)) {
25075 memset
(&new_expr,0,sizeof(mp_value));
25076 new_number
(new_expr.data.n
);
25077 pyth_add
(new_expr.data.n
, value_number
(x_part
(value_node
(cur_exp_node
()))),
25078 value_number
(y_part
(value_node
(cur_exp_node
()))));
25079 mp_flush_cur_exp
(mp
, new_expr
);
25081 mp_bad_unary
(mp
, c
);
25085 case mp_turning_op
:
25086 if
(mp-
>cur_exp.type
== mp_pair_type
) {
25087 memset
(&new_expr,0,sizeof(mp_value));
25088 new_number
(new_expr.data.n
);
25089 set_number_to_zero
(new_expr.data.n
);
25090 mp_flush_cur_exp
(mp
, new_expr
);
25091 } else if
(mp-
>cur_exp.type
!= mp_path_type
) {
25092 mp_bad_unary
(mp
, mp_turning_op
);
25093 } else if
(mp_left_type
(cur_exp_knot
()) == mp_endpoint
) {
25094 memset
(&new_expr,0,sizeof(mp_value));
25095 new_number
(new_expr.data.n
);
25096 new_expr.data.p
= NULL;
25097 mp_flush_cur_exp
(mp
, new_expr
); /* not a cyclic path
*/
25099 memset
(&new_expr,0,sizeof(mp_value));
25100 new_number
(new_expr.data.n
);
25101 mp_turn_cycles_wrapper
(mp
, &new_expr.data.n, cur_exp_knot ());
25102 mp_flush_cur_exp
(mp
, new_expr
);
25105 case mp_boolean_type
:
25106 memset
(&new_expr,0,sizeof(mp_value));
25107 new_number
(new_expr.data.n
);
25108 type_range
(mp_boolean_type
, mp_unknown_boolean
);
25110 case mp_string_type
:
25111 memset
(&new_expr,0,sizeof(mp_value));
25112 new_number
(new_expr.data.n
);
25113 type_range
(mp_string_type
, mp_unknown_string
);
25116 memset
(&new_expr,0,sizeof(mp_value));
25117 new_number
(new_expr.data.n
);
25118 type_range
(mp_pen_type
, mp_unknown_pen
);
25121 memset
(&new_expr,0,sizeof(mp_value));
25122 new_number
(new_expr.data.n
);
25123 type_range
(mp_path_type
, mp_unknown_path
);
25125 case mp_picture_type
:
25126 memset
(&new_expr,0,sizeof(mp_value));
25127 new_number
(new_expr.data.n
);
25128 type_range
(mp_picture_type
, mp_unknown_picture
);
25130 case mp_transform_type
:
25131 case mp_color_type
:
25132 case mp_cmykcolor_type
:
25134 memset
(&new_expr,0,sizeof(mp_value));
25135 new_number
(new_expr.data.n
);
25138 case mp_numeric_type
:
25139 memset
(&new_expr,0,sizeof(mp_value));
25140 new_number
(new_expr.data.n
);
25141 type_range
(mp_known
, mp_independent
);
25144 case mp_unknown_op
:
25145 mp_test_known
(mp
, c
);
25148 memset
(&new_expr,0,sizeof(mp_value));
25149 new_number
(new_expr.data.n
);
25150 if
(mp-
>cur_exp.type
!= mp_path_type
)
25151 set_number_from_boolean
(new_expr.data.n
, mp_false_code
);
25152 else if
(mp_left_type
(cur_exp_knot
()) != mp_endpoint
)
25153 set_number_from_boolean
(new_expr.data.n
, mp_true_code
);
25155 set_number_from_boolean
(new_expr.data.n
, mp_false_code
);
25156 mp_flush_cur_exp
(mp
, new_expr
);
25157 mp-
>cur_exp.type
= mp_boolean_type
;
25159 case mp_arc_length
:
25160 if
(mp-
>cur_exp.type
== mp_pair_type
)
25161 mp_pair_to_path
(mp
);
25162 if
(mp-
>cur_exp.type
!= mp_path_type
) {
25163 mp_bad_unary
(mp
, mp_arc_length
);
25165 memset
(&new_expr,0,sizeof(mp_value));
25166 new_number
(new_expr.data.n
);
25167 mp_get_arc_length
(mp
, &new_expr.data.n, cur_exp_knot ());
25168 mp_flush_cur_exp
(mp
, new_expr
);
25172 case mp_stroked_op
:
25173 case mp_textual_op
:
25174 case mp_clipped_op
:
25175 case mp_bounded_op
:
25176 /* Here we use the fact that |c-filled_op
+fill_code| is the desired graphical
25178 @^data structure assumptions@
>
25179 memset
(&new_expr,0,sizeof(mp_value));
25180 new_number
(new_expr.data.n
);
25181 if
(mp-
>cur_exp.type
!= mp_picture_type
) {
25182 set_number_from_boolean
(new_expr.data.n
, mp_false_code
);
25183 } else if
(mp_link
(edge_list
(cur_exp_node
())) == NULL) {
25184 set_number_from_boolean
(new_expr.data.n
, mp_false_code
);
25185 } else if
(mp_type
(mp_link
(edge_list
(cur_exp_node
()))) ==
25186 (mp_variable_type
) (c
+ mp_fill_node_type
- mp_filled_op
)) {
25187 set_number_from_boolean
(new_expr.data.n
, mp_true_code
);
25189 set_number_from_boolean
(new_expr.data.n
, mp_false_code
);
25191 mp_flush_cur_exp
(mp
, new_expr
);
25192 mp-
>cur_exp.type
= mp_boolean_type
;
25194 case mp_make_pen_op
:
25195 if
(mp-
>cur_exp.type
== mp_pair_type
)
25196 mp_pair_to_path
(mp
);
25197 if
(mp-
>cur_exp.type
!= mp_path_type
)
25198 mp_bad_unary
(mp
, mp_make_pen_op
);
25200 mp-
>cur_exp.type
= mp_pen_type
;
25201 set_cur_exp_knot
(mp_make_pen
(mp
, cur_exp_knot
(), true
));
25204 case mp_make_path_op
:
25205 if
(mp-
>cur_exp.type
!= mp_pen_type
) {
25206 mp_bad_unary
(mp
, mp_make_path_op
);
25208 mp-
>cur_exp.type
= mp_path_type
;
25209 mp_make_path
(mp
, cur_exp_knot
());
25213 if
(mp-
>cur_exp.type
== mp_path_type
) {
25214 mp_knot pk
= mp_htap_ypoc
(mp
, cur_exp_knot
());
25215 if
(mp_right_type
(pk
) == mp_endpoint
)
25216 pk
= mp_next_knot
(pk
);
25217 mp_toss_knot_list
(mp
, cur_exp_knot
());
25218 set_cur_exp_knot
(pk
);
25219 } else if
(mp-
>cur_exp.type
== mp_pair_type
) {
25220 mp_pair_to_path
(mp
);
25222 mp_bad_unary
(mp
, mp_reverse
);
25225 case mp_ll_corner_op
:
25226 if
(!mp_get_cur_bbox
(mp
))
25227 mp_bad_unary
(mp
, mp_ll_corner_op
);
25229 mp_pair_value
(mp
, mp_minx
, mp_miny
);
25231 case mp_lr_corner_op
:
25232 if
(!mp_get_cur_bbox
(mp
))
25233 mp_bad_unary
(mp
, mp_lr_corner_op
);
25235 mp_pair_value
(mp
, mp_maxx
, mp_miny
);
25237 case mp_ul_corner_op
:
25238 if
(!mp_get_cur_bbox
(mp
))
25239 mp_bad_unary
(mp
, mp_ul_corner_op
);
25241 mp_pair_value
(mp
, mp_minx
, mp_maxy
);
25243 case mp_ur_corner_op
:
25244 if
(!mp_get_cur_bbox
(mp
))
25245 mp_bad_unary
(mp
, mp_ur_corner_op
);
25247 mp_pair_value
(mp
, mp_maxx
, mp_maxy
);
25249 case mp_read_from_op
:
25250 case mp_close_from_op
:
25251 if
(mp-
>cur_exp.type
!= mp_string_type
)
25252 mp_bad_unary
(mp
, c
);
25254 mp_do_read_or_close
(mp
, c
);
25257 } /* there are no other cases
*/
25262 @ The |nice_pair| function returns |true| if both components of a pair
25265 @
<Declare unary action procedures@
>=
25266 static boolean mp_nice_pair
(MP mp
, mp_node p
, quarterword t
) {
25268 if
(t
== mp_pair_type
) {
25269 p
= value_node
(p
);
25270 if
(mp_type
(x_part
(p
)) == mp_known
)
25271 if
(mp_type
(y_part
(p
)) == mp_known
)
25278 @ The |nice_color_or_pair| function is analogous except that it also accepts
25279 fully known colors.
25281 @
<Declare unary action procedures@
>=
25282 static boolean mp_nice_color_or_pair
(MP mp
, mp_node p
, quarterword t
) {
25287 q
= value_node
(p
);
25288 if
(mp_type
(x_part
(q
)) == mp_known
)
25289 if
(mp_type
(y_part
(q
)) == mp_known
)
25292 case mp_color_type
:
25293 q
= value_node
(p
);
25294 if
(mp_type
(red_part
(q
)) == mp_known
)
25295 if
(mp_type
(green_part
(q
)) == mp_known
)
25296 if
(mp_type
(blue_part
(q
)) == mp_known
)
25299 case mp_cmykcolor_type
:
25300 q
= value_node
(p
);
25301 if
(mp_type
(cyan_part
(q
)) == mp_known
)
25302 if
(mp_type
(magenta_part
(q
)) == mp_known
)
25303 if
(mp_type
(yellow_part
(q
)) == mp_known
)
25304 if
(mp_type
(black_part
(q
)) == mp_known
)
25312 @ @
<Declare unary action...@
>=
25313 static void mp_print_known_or_unknown_type
(MP mp
, quarterword t
, mp_node v
) {
25314 mp_print_char
(mp
, xord
('
('
));
25316 mp_print
(mp
, "unknown numeric");
25318 if
((t
== mp_pair_type
) ||
(t
== mp_color_type
) ||
(t
== mp_cmykcolor_type
))
25319 if
(!mp_nice_color_or_pair
(mp
, v
, t
))
25320 mp_print
(mp
, "unknown ");
25321 mp_print_type
(mp
, t
);
25323 mp_print_char
(mp
, xord
('
)'
));
25327 @ @
<Declare unary action...@
>=
25328 static void mp_bad_unary
(MP mp
, quarterword c
) {
25331 int old_setting
= mp-
>selector
;
25332 const char
*hlp
[] = {
25333 "I'm afraid I don't know how to apply that operation to that",
25334 "particular type. Continue, and I'll simply return the",
25335 "argument (shown above) as the result of the operation.",
25337 mp-
>selector
= new_string
;
25338 mp_print_op
(mp
, c
);
25339 mp_print_known_or_unknown_type
(mp
, mp-
>cur_exp.type
, cur_exp_node
());
25340 sname
= mp_make_string
(mp
);
25341 mp-
>selector
= old_setting
;
25342 mp_snprintf
(msg
, 256, "Not implemented: %s", mp_str
(mp
, sname
));
25343 delete_str_ref
(sname
);
25344 mp_disp_err
(mp
, NULL);
25345 mp_back_error
(mp
, msg
, hlp
, true
);
25346 @.Not implemented...@
>;
25347 mp_get_x_next
(mp
);
25352 @ Negation is easy except when the current expression
25353 is of type |independent|
, or when it is a pair with one or more
25354 |independent| components.
25356 @
<Declare unary action...@
>=
25357 static void mp_negate_dep_list
(MP mp
, mp_value_node p
) {
25360 number_negate
(dep_value
(p
));
25361 if
(dep_info
(p
) == NULL)
25363 p
= (mp_value_node
) mp_link
(p
);
25368 @ It is tempting to argue that the negative of an independent variable
25369 is an independent variable
, hence we don't have to do anything when
25370 negating it. The fallacy is that other dependent variables pointing
25371 to the current expression must change the sign of their
25372 coefficients if we make no change to the current expression.
25374 Instead
, we work around the problem by copying the current expression
25375 and recycling it afterwards
(cf.~the |stash_in| routine
).
25377 @d negate_value
(A
) if
(mp_type
(A
) == mp_known
) {
25378 set_value_number
(A
, (value_number
(A
))); /* to clear the rest
*/
25379 number_negate
(value_number
(A
));
25381 mp_negate_dep_list
(mp
, (mp_value_node
) dep_list
((mp_value_node
) A
));
25384 @
<Declare unary action...@
>=
25385 static void negate_cur_expr
(MP mp
) {
25386 mp_node p
, q
, r
; /* for list manipulation
*/
25387 switch
(mp-
>cur_exp.type
) {
25388 case mp_color_type
:
25389 case mp_cmykcolor_type
:
25391 case mp_independent
:
25392 q
= cur_exp_node
();
25393 mp_make_exp_copy
(mp
, q
);
25394 if
(mp-
>cur_exp.type
== mp_dependent
) {
25395 mp_negate_dep_list
(mp
, (mp_value_node
) dep_list
((mp_value_node
)
25397 } else if
(mp-
>cur_exp.type
<= mp_pair_type
) {
25398 /* |mp_color_type| |mp_cmykcolor_type|
, or |mp_pair_type|
*/
25399 p
= value_node
(cur_exp_node
());
25400 switch
(mp-
>cur_exp.type
) {
25407 case mp_color_type
:
25410 r
= green_part
(p
);
25415 case mp_cmykcolor_type
:
25418 r
= magenta_part
(p
);
25420 r
= yellow_part
(p
);
25422 r
= black_part
(p
);
25425 default
: /* there are no other valid cases
, but please the compiler
*/
25428 } /* if |cur_type
=mp_known| then |cur_exp
=0|
*/
25429 mp_recycle_value
(mp
, q
);
25430 mp_free_value_node
(mp
, q
);
25433 case mp_proto_dependent
:
25434 mp_negate_dep_list
(mp
, (mp_value_node
) dep_list
((mp_value_node
)
25438 if
(is_number
(cur_exp_value_number
()))
25439 number_negate
(cur_exp_value_number
());
25442 mp_bad_unary
(mp
, mp_minus
);
25447 @ If the current expression is a pair
, but the context wants it to
25448 be a path
, we call |pair_to_path|.
25450 @
<Declare unary action...@
>=
25451 static void mp_pair_to_path
(MP mp
) {
25452 set_cur_exp_knot
(mp_pair_to_knot
(mp
));
25453 mp-
>cur_exp.type
= mp_path_type
;
25458 @ @
<Declarations@
>=
25459 static void mp_bad_color_part
(MP mp
, quarterword c
);
25462 static void mp_bad_color_part
(MP mp
, quarterword c
) {
25463 mp_node p
; /* the big node
*/
25468 const char
*hlp
[] = {
25469 "You can only ask for the redpart, greenpart, bluepart of a rgb object,",
25470 "the cyanpart, magentapart, yellowpart or blackpart of a cmyk object, ",
25471 "or the greypart of a grey object. No mixing and matching, please.",
25473 memset
(&new_expr,0,sizeof(mp_value));
25474 new_number
(new_expr.data.n
);
25475 p
= mp_link
(edge_list
(cur_exp_node
()));
25476 mp_disp_err
(mp
, NULL);
25477 old_setting
= mp-
>selector
;
25478 mp-
>selector
= new_string
;
25479 mp_print_op
(mp
, c
);
25480 sname
= mp_make_string
(mp
);
25481 mp-
>selector
= old_setting
;
25482 @.Wrong picture color model...@
>;
25483 if
(mp_color_model
(p
) == mp_grey_model
)
25484 mp_snprintf
(msg
, 256, "Wrong picture color model: %s of grey object", mp_str
(mp
, sname
));
25485 else if
(mp_color_model
(p
) == mp_cmyk_model
)
25486 mp_snprintf
(msg
, 256, "Wrong picture color model: %s of cmyk object", mp_str
(mp
, sname
));
25487 else if
(mp_color_model
(p
) == mp_rgb_model
)
25488 mp_snprintf
(msg
, 256, "Wrong picture color model: %s of rgb object", mp_str
(mp
, sname
));
25489 else if
(mp_color_model
(p
) == mp_no_model
)
25490 mp_snprintf
(msg
, 256, "Wrong picture color model: %s of marking object", mp_str
(mp
, sname
));
25492 mp_snprintf
(msg
, 256, "Wrong picture color model: %s of defaulted object", mp_str
(mp
, sname
));
25493 delete_str_ref
(sname
);
25494 mp_error
(mp
, msg
, hlp
, true
);
25495 if
(c
== mp_black_part
)
25496 number_clone
(new_expr.data.n
, unity_t
);
25498 set_number_to_zero
(new_expr.data.n
);
25499 mp_flush_cur_exp
(mp
, new_expr
);
25503 @ In the following procedure
, |cur_exp| points to a capsule
, which points to
25504 a big node. We want to delete all but one part of the big node.
25506 @
<Declare unary action...@
>=
25507 static void mp_take_part
(MP mp
, quarterword c
) {
25508 mp_node p
; /* the big node
*/
25509 p
= value_node
(cur_exp_node
());
25510 set_value_node
(mp-
>temp_val
, p
);
25511 mp_type
(mp-
>temp_val
) = mp-
>cur_exp.type
;
25512 mp_link
(p
) = mp-
>temp_val
;
25513 mp_free_value_node
(mp
, cur_exp_node
());
25516 if
(mp-
>cur_exp.type
== mp_pair_type
)
25517 mp_make_exp_copy
(mp
, x_part
(p
));
25519 mp_make_exp_copy
(mp
, tx_part
(p
));
25522 if
(mp-
>cur_exp.type
== mp_pair_type
)
25523 mp_make_exp_copy
(mp
, y_part
(p
));
25525 mp_make_exp_copy
(mp
, ty_part
(p
));
25528 mp_make_exp_copy
(mp
, xx_part
(p
));
25531 mp_make_exp_copy
(mp
, xy_part
(p
));
25534 mp_make_exp_copy
(mp
, yx_part
(p
));
25537 mp_make_exp_copy
(mp
, yy_part
(p
));
25540 mp_make_exp_copy
(mp
, red_part
(p
));
25542 case mp_green_part
:
25543 mp_make_exp_copy
(mp
, green_part
(p
));
25546 mp_make_exp_copy
(mp
, blue_part
(p
));
25549 mp_make_exp_copy
(mp
, cyan_part
(p
));
25551 case mp_magenta_part
:
25552 mp_make_exp_copy
(mp
, magenta_part
(p
));
25554 case mp_yellow_part
:
25555 mp_make_exp_copy
(mp
, yellow_part
(p
));
25557 case mp_black_part
:
25558 mp_make_exp_copy
(mp
, black_part
(p
));
25561 mp_recycle_value
(mp
, mp-
>temp_val
);
25565 @ @
<Initialize table entries@
>=
25566 mp-
>temp_val
= mp_get_value_node
(mp
);
25567 mp_name_type
(mp-
>temp_val
) = mp_capsule
;
25569 @ @
<Free table entries@
>=
25570 mp_free_value_node
(mp
, mp-
>temp_val
);
25573 @ @
<Declarations@
>=
25574 static mp_edge_header_node mp_scale_edges
(MP mp
, mp_number se_sf
, mp_edge_header_node se_pic
);
25576 @ @
<Declare unary action...@
>=
25577 static void mp_take_pict_part
(MP mp
, quarterword c
) {
25578 mp_node p
; /* first graphical object in |cur_exp|
*/
25580 memset
(&new_expr,0,sizeof(mp_value));
25581 new_number
(new_expr.data.n
);
25582 p
= mp_link
(edge_list
(cur_exp_node
()));
25591 if
(mp_type
(p
) == mp_text_node_type
) {
25592 mp_text_node p0
= (mp_text_node
)p
;
25595 number_clone
(new_expr.data.n
, p0-
>tx
);
25598 number_clone
(new_expr.data.n
, p0-
>ty
);
25601 number_clone
(new_expr.data.n
, p0-
>txx
);
25604 number_clone
(new_expr.data.n
, p0-
>txy
);
25607 number_clone
(new_expr.data.n
, p0-
>tyx
);
25610 number_clone
(new_expr.data.n
, p0-
>tyy
);
25613 mp_flush_cur_exp
(mp
, new_expr
);
25618 case mp_green_part
:
25620 if
(has_color
(p
)) {
25623 number_clone
(new_expr.data.n
,((mp_stroked_node
)p
)->red
);
25625 case mp_green_part
:
25626 number_clone
(new_expr.data.n
,((mp_stroked_node
)p
)->green
);
25629 number_clone
(new_expr.data.n
,((mp_stroked_node
)p
)->blue
);
25632 mp_flush_cur_exp
(mp
, new_expr
);
25637 case mp_magenta_part
:
25638 case mp_yellow_part
:
25639 case mp_black_part
:
25640 if
(has_color
(p
)) {
25641 if
(mp_color_model
(p
) == mp_uninitialized_model
&& c == mp_black_part) {
25642 set_number_to_unity
(new_expr.data.n
);
25646 number_clone
(new_expr.data.n
,((mp_stroked_node
)p
)->cyan
);
25648 case mp_magenta_part
:
25649 number_clone
(new_expr.data.n
,((mp_stroked_node
)p
)->magenta
);
25651 case mp_yellow_part
:
25652 number_clone
(new_expr.data.n
,((mp_stroked_node
)p
)->yellow
);
25654 case mp_black_part
:
25655 number_clone
(new_expr.data.n
,((mp_stroked_node
)p
)->black
);
25659 mp_flush_cur_exp
(mp
, new_expr
);
25664 if
(has_color
(p
)) {
25665 number_clone
(new_expr.data.n
,((mp_stroked_node
)p
)->grey
);
25666 mp_flush_cur_exp
(mp
, new_expr
);
25670 case mp_color_model_part
:
25671 if
(has_color
(p
)) {
25672 if
(mp_color_model
(p
) == mp_uninitialized_model
) {
25673 number_clone
(new_expr.data.n
, internal_value
(mp_default_color_model
));
25675 number_clone
(new_expr.data.n
, unity_t
);
25676 number_multiply_int
(new_expr.data.n
, mp_color_model
(p
));
25678 mp_flush_cur_exp
(mp
, new_expr
);
25683 if
(mp_type
(p
) != mp_text_node_type
)
25686 new_expr.data.str
= mp_text_p
(p
);
25687 add_str_ref
(new_expr.data.str
);
25688 mp_flush_cur_exp
(mp
, new_expr
);
25689 mp-
>cur_exp.type
= mp_string_type
;
25692 case mp_prescript_part
:
25693 if
(!has_color
(p
)) {
25696 if
(mp_pre_script
(p
)) {
25697 new_expr.data.str
= mp_pre_script
(p
);
25698 add_str_ref
(new_expr.data.str
);
25700 new_expr.data.str
= mp_rts
(mp
,"");
25702 mp_flush_cur_exp
(mp
, new_expr
);
25703 mp-
>cur_exp.type
= mp_string_type
;
25706 case mp_postscript_part
:
25707 if
(!has_color
(p
)) {
25710 if
(mp_post_script
(p
)) {
25711 new_expr.data.str
= mp_post_script
(p
);
25712 add_str_ref
(new_expr.data.str
);
25714 new_expr.data.str
= mp_rts
(mp
,"");
25716 mp_flush_cur_exp
(mp
, new_expr
);
25717 mp-
>cur_exp.type
= mp_string_type
;
25721 if
(mp_type
(p
) != mp_text_node_type
)
25724 new_expr.data.str
= mp_rts
(mp
, mp-
>font_name
[mp_font_n
(p
)]);
25725 add_str_ref
(new_expr.data.str
);
25726 mp_flush_cur_exp
(mp
, new_expr
);
25727 mp-
>cur_exp.type
= mp_string_type
;
25731 if
(mp_type
(p
) == mp_text_node_type
) {
25733 } else if
(is_stop
(p
)) {
25734 mp_confusion
(mp
, "pict");
25736 new_expr.data.node
= NULL;
25737 switch
(mp_type
(p
)) {
25738 case mp_fill_node_type
:
25739 new_expr.data.p
= mp_copy_path
(mp
, mp_path_p
((mp_fill_node
) p
));
25741 case mp_stroked_node_type
:
25742 new_expr.data.p
= mp_copy_path
(mp
, mp_path_p
((mp_stroked_node
) p
));
25744 case mp_start_bounds_node_type
:
25745 new_expr.data.p
= mp_copy_path
(mp
, mp_path_p
((mp_start_bounds_node
) p
));
25747 case mp_start_clip_node_type
:
25748 new_expr.data.p
= mp_copy_path
(mp
, mp_path_p
((mp_start_clip_node
) p
));
25754 mp_flush_cur_exp
(mp
, new_expr
);
25755 mp-
>cur_exp.type
= mp_path_type
;
25759 if
(!has_pen
(p
)) {
25762 switch
(mp_type
(p
)) {
25763 case mp_fill_node_type
:
25764 if
(mp_pen_p
((mp_fill_node
) p
) == NULL)
25767 new_expr.data.p
= copy_pen
(mp_pen_p
((mp_fill_node
) p
));
25768 mp_flush_cur_exp
(mp
, new_expr
);
25769 mp-
>cur_exp.type
= mp_pen_type
;
25772 case mp_stroked_node_type
:
25773 if
(mp_pen_p
((mp_stroked_node
) p
) == NULL)
25776 new_expr.data.p
= copy_pen
(mp_pen_p
((mp_stroked_node
) p
));
25777 mp_flush_cur_exp
(mp
, new_expr
);
25778 mp-
>cur_exp.type
= mp_pen_type
;
25788 if
(mp_type
(p
) != mp_stroked_node_type
) {
25791 if
(mp_dash_p
(p
) == NULL) {
25794 add_edge_ref
(mp_dash_p
(p
));
25795 new_expr.data.node
= (mp_node
)mp_scale_edges
(mp
, ((mp_stroked_node
)p
)->dash_scale
,
25796 (mp_edge_header_node
)mp_dash_p
(p
));
25797 mp_flush_cur_exp
(mp
, new_expr
);
25798 mp-
>cur_exp.type
= mp_picture_type
;
25802 } /* all cases have been enumerated
*/
25806 /* Convert the current expression to a
NULL value appropriate for |c|
*/
25810 case mp_prescript_part
:
25811 case mp_postscript_part
:
25812 new_expr.data.str
= mp_rts
(mp
,"");
25813 mp_flush_cur_exp
(mp
, new_expr
);
25814 mp-
>cur_exp.type
= mp_string_type
;
25817 new_expr.data.p
= mp_new_knot
(mp
);
25818 mp_flush_cur_exp
(mp
, new_expr
);
25819 mp_left_type
(cur_exp_knot
()) = mp_endpoint
;
25820 mp_right_type
(cur_exp_knot
()) = mp_endpoint
;
25821 mp_next_knot
(cur_exp_knot
()) = cur_exp_knot
();
25822 set_number_to_zero
(cur_exp_knot
()->x_coord
);
25823 set_number_to_zero
(cur_exp_knot
()->y_coord
);
25824 mp_originator
(cur_exp_knot
()) = mp_metapost_user
;
25825 mp-
>cur_exp.type
= mp_path_type
;
25828 new_expr.data.p
= mp_get_pen_circle
(mp
, zero_t
);
25829 mp_flush_cur_exp
(mp
, new_expr
);
25830 mp-
>cur_exp.type
= mp_pen_type
;
25833 new_expr.data.node
= (mp_node
)mp_get_edge_header_node
(mp
);
25834 mp_flush_cur_exp
(mp
, new_expr
);
25835 mp_init_edges
(mp
, (mp_edge_header_node
)cur_exp_node
());
25836 mp-
>cur_exp.type
= mp_picture_type
;
25839 set_number_to_zero
(new_expr.data.n
);
25840 mp_flush_cur_exp
(mp
, new_expr
);
25845 @ @
<Declare unary action...@
>=
25846 static void mp_str_to_num
(MP mp
, quarterword c
) { /* converts a string to a number
*/
25847 integer n
; /* accumulator
*/
25848 ASCII_code m
; /* current character
*/
25849 unsigned k
; /* index into |str_pool|
*/
25850 int b
; /* radix of conversion
*/
25851 boolean bad_char
; /* did the string contain an invalid digit?
*/
25853 memset
(&new_expr,0,sizeof(mp_value));
25854 new_number
(new_expr.data.n
);
25855 if
(c
== mp_ASCII_op
) {
25856 if
(cur_exp_str
()->len
== 0)
25859 n
= cur_exp_str
()->str
[0];
25861 if
(c
== mp_oct_op
)
25867 for
(k
= 0; k
< cur_exp_str
()->len
; k
++) {
25868 m
= (ASCII_code
) (*(cur_exp_str
()->str
+ k
));
25869 if
((m
>= '
0'
) && (m <= '9'))
25870 m
= (ASCII_code
) (m
- '
0'
);
25871 else if
((m
>= 'A'
) && (m <= 'F'))
25872 m
= (ASCII_code
) (m
- 'A'
+ 10);
25873 else if
((m
>= 'a'
) && (m <= 'f'))
25874 m
= (ASCII_code
) (m
- 'a'
+ 10);
25879 if
((int
) m
>= b
) {
25888 /* Give error messages if |bad_char| or |n
>=4096|
*/
25890 const char
*hlp
[] = {"I zeroed out characters that weren't hex digits.", NULL};
25891 if
(c
== mp_oct_op
) {
25892 hlp
[0] = "I zeroed out characters that weren't in the range 0..7.";
25894 mp_disp_err
(mp
, NULL);
25895 mp_back_error
(mp
, "String contains illegal digits", hlp
, true
);
25896 mp_get_x_next
(mp
);
25898 if
((n
> 4095)) { /* todo
, this is scaled specific
*/
25899 if
(number_positive
(internal_value
(mp_warning_check
))) {
25901 const char
*hlp
[] = {
25902 "I have trouble with numbers greater than 4095; watch out.",
25903 "(Set warningcheck:=0 to suppress this message.)",
25905 mp_snprintf
(msg
, 256,"Number too large (%d)", (int
)n
);
25906 mp_back_error
(mp
, msg
, hlp
, true
);
25907 mp_get_x_next
(mp
);
25911 number_clone
(new_expr.data.n
, unity_t
);
25912 number_multiply_int
(new_expr.data.n
, n
);
25913 mp_flush_cur_exp
(mp
, new_expr
);
25916 @ @
<Declare unary action...@
>=
25917 static void mp_path_length
(MP mp
, mp_number
*n
) { /* computes the length of the current path
*/
25918 mp_knot p
; /* traverser
*/
25919 set_number_to_zero
(*n
);
25920 p
= cur_exp_knot
();
25921 if
(mp_left_type
(p
) == mp_endpoint
) {
25922 number_substract
(*n
, unity_t
); /* -unity
*/
25925 p
= mp_next_knot
(p
);
25926 number_add
(*n
, unity_t
);
25927 } while
(p
!= cur_exp_knot
());
25931 @ @
<Declare unary action...@
>=
25932 static void mp_pict_length
(MP mp
, mp_number
*n
) {
25933 /* counts interior components in picture |cur_exp|
*/
25934 mp_node p
; /* traverser
*/
25935 set_number_to_zero
(*n
);
25936 p
= mp_link
(edge_list
(cur_exp_node
()));
25938 if
(is_start_or_stop
(p
))
25939 if
(mp_skip_1component
(mp
, p
) == NULL)
25941 while
(p
!= NULL) {
25942 if
( ! is_start_or_stop
(p
) )
25944 else if
( ! is_stop
(p
))
25945 p
= mp_skip_1component
(mp
, p
);
25948 number_add
(*n
, unity_t
);
25954 @ The function |an_angle| returns the value of the |angle| primitive
, or $
0$ if the
25955 argument is |origin|.
25957 @
<Declare unary action...@
>=
25958 static void mp_an_angle
(MP mp
, mp_number
*ret
, mp_number xpar
, mp_number ypar
) {
25959 set_number_to_zero
(*ret
);
25960 if
((!(number_zero
(xpar
) && number_zero(ypar)))) {
25961 n_arg
(*ret
, xpar
, ypar
);
25966 @ The actual turning number is
(for the moment
) computed in a C function
25967 that receives eight integers corresponding to the four controlling points
,
25968 and returns a single angle. Besides those
, we have to account for discrete
25969 moves at the actual points.
25971 @d mp_floor
(a
) ((a
)>=0 ?
(int
)(a
) : -(int
)(-(a
)))
25972 @d bezier_error
(720*(256*256*16))+1
25973 @d mp_sign
(v
) ((v
)>0 ?
1 : ((v
)<0 ?
-1 : 0 ))
25974 @d mp_out
(A
) (double
)((A
)/16)
25976 @
<Declare unary action...@
>=
25977 static void mp_bezier_slope
(MP mp
, mp_number
*ret
, mp_number AX
, mp_number AY
, mp_number BX
,
25978 mp_number
BY, mp_number CX
, mp_number CY
, mp_number DX
,
25982 static void mp_bezier_slope
(MP mp
, mp_number
*ret
, mp_number AX
, mp_number AY
, mp_number BX
,
25983 mp_number
BY, mp_number CX
, mp_number CY
, mp_number DX
,
25986 mp_number deltax
, deltay
;
25987 double ax
, ay
, bx
, by
, cx
, cy
, dx
, dy
;
25988 mp_number xi
, xo
, xm
;
25990 ax
= number_to_double
(AX
);
25991 ay
= number_to_double
(AY
);
25992 bx
= number_to_double
(BX
);
25993 by
= number_to_double
(BY);
25994 cx
= number_to_double
(CX
);
25995 cy
= number_to_double
(CY
);
25996 dx
= number_to_double
(DX
);
25997 dy
= number_to_double
(DY
);
25998 new_number
(deltax
);
25999 new_number
(deltay
);
26000 set_number_from_substraction
(deltax
, BX
, AX
);
26001 set_number_from_substraction
(deltay
, BY, AY
);
26002 if
(number_zero
(deltax
) && number_zero(deltay)) {
26003 set_number_from_substraction
(deltax
, CX
, AX
);
26004 set_number_from_substraction
(deltay
, CY
, AY
);
26006 if
(number_zero
(deltax
) && number_zero(deltay)) {
26007 set_number_from_substraction
(deltax
, DX
, AX
);
26008 set_number_from_substraction
(deltay
, DY
, AY
);
26013 mp_an_angle
(mp
, &xi, deltax, deltay);
26014 set_number_from_substraction
(deltax
, CX
, BX
);
26015 set_number_from_substraction
(deltay
, CY
, BY);
26016 mp_an_angle
(mp
, &xm, deltax, deltay); /* !!! never used? */
26017 set_number_from_substraction
(deltax
, DX
, CX
);
26018 set_number_from_substraction
(deltay
, DY
, CY
);
26019 if
(number_zero
(deltax
) && number_zero(deltay)) {
26020 set_number_from_substraction
(deltax
, DX
, BX
);
26021 set_number_from_substraction
(deltay
, DY
, BY);
26023 if
(number_zero
(deltax
) && number_zero(deltay)) {
26024 set_number_from_substraction
(deltax
, DX
, AX
);
26025 set_number_from_substraction
(deltay
, DY
, AY
);
26027 mp_an_angle
(mp
, &xo, deltax, deltay);
26028 a
= (bx
- ax
) * (cy
- by
) - (cx
- bx
) * (by
- ay
); /* a
= (bp-ap
)x
(cp-bp
); */
26029 b
= (bx
- ax
) * (dy
- cy
) - (by
- ay
) * (dx
- cx
);; /* b
= (bp-ap
)x
(dp-cp
); */
26030 c
= (cx
- bx
) * (dy
- cy
) - (dx
- cx
) * (cy
- by
); /* c
= (cp-bp
)x
(dp-cp
); */
26031 if
((a
== 0) && (c == 0)) {
26032 res
= (b
== 0 ?
0 : (mp_out
(number_to_double
(xo
)) - mp_out
(number_to_double
(xi
))));
26033 } else if
((a
== 0) ||
(c
== 0)) {
26034 if
((mp_sign
(b
) == mp_sign
(a
)) ||
(mp_sign
(b
) == mp_sign
(c
))) {
26035 res
= mp_out
(number_to_double
(xo
)) - mp_out
(number_to_double
(xi
)); /* ?
*/
26038 else if
(res
> 180.0)
26041 res
= mp_out
(number_to_double
(xo
)) - mp_out
(number_to_double
(xi
)); /* ?
*/
26043 } else if
((mp_sign
(a
) * mp_sign
(c
)) < 0) {
26044 res
= mp_out
(number_to_double
(xo
)) - mp_out
(number_to_double
(xi
)); /* ?
*/
26047 else if
(res
> 180.0)
26050 if
(mp_sign
(a
) == mp_sign
(b
)) {
26051 res
= mp_out
(number_to_double
(xo
)) - mp_out
(number_to_double
(xi
)); /* ?
*/
26054 else if
(res
> 180.0)
26057 if
((b
* b
) == (4 * a
* c
)) {
26058 res
= (double
) bezier_error
;
26059 } else if
((b
* b
) < (4 * a
* c
)) {
26060 res
= mp_out
(number_to_double
(xo
)) - mp_out
(number_to_double
(xi
)); /* ?
*/
26061 if
(res
<= 0.0 && res > -180.0)
26063 else if
(res
>= 0.0 && res < 180.0)
26066 res
= mp_out
(number_to_double
(xo
)) - mp_out
(number_to_double
(xi
));
26069 else if
(res
> 180.0)
26074 free_number
(deltax
);
26075 free_number
(deltay
);
26079 set_number_from_double
(*ret
, res
);
26080 convert_scaled_to_angle
(*ret
);
26085 @d p_nextnext mp_next_knot
(mp_next_knot
(p
))
26086 @d p_next mp_next_knot
(p
)
26088 @
<Declare unary action...@
>=
26089 static void mp_turn_cycles
(MP mp
, mp_number
*turns
, mp_knot c
) {
26090 mp_angle res
, ang
; /* the angles of intermediate results
*/
26091 mp_knot p
; /* for running around the path
*/
26092 mp_number xp
, yp
; /* coordinates of next point
*/
26093 mp_number x
, y
; /* helper coordinates
*/
26094 mp_number arg1
, arg2
;
26095 mp_angle in_angle
, out_angle
; /* helper angles
*/
26096 mp_angle seven_twenty_deg_t
, neg_one_eighty_deg_t
;
26097 unsigned old_setting
; /* saved |selector| setting
*/
26098 set_number_to_zero
(*turns
);
26105 new_angle
(in_angle
);
26106 new_angle
(out_angle
);
26109 new_angle
(seven_twenty_deg_t
);
26110 new_angle
(neg_one_eighty_deg_t
);
26111 number_clone
(seven_twenty_deg_t
, three_sixty_deg_t
);
26112 number_double
(seven_twenty_deg_t
);
26113 number_clone
(neg_one_eighty_deg_t
, one_eighty_deg_t
);
26114 number_negate
(neg_one_eighty_deg_t
);
26116 old_setting
= mp-
>selector
;
26117 mp-
>selector
= term_only
;
26118 if
(number_greater
(internal_value
(mp_tracing_commands
), unity_t
)) {
26119 mp_begin_diagnostic
(mp
);
26120 mp_print_nl
(mp
, "");
26121 mp_end_diagnostic
(mp
, false
);
26124 number_clone
(xp
, p_next-
>x_coord
);
26125 number_clone
(yp
, p_next-
>y_coord
);
26126 mp_bezier_slope
(mp
, &ang, p->x_coord, p->y_coord, p->right_x, p->right_y,
26127 p_next-
>left_x
, p_next-
>left_y
, xp
, yp
);
26128 if
(number_greater
(ang
, seven_twenty_deg_t
)) {
26129 mp_error
(mp
, "Strange path", NULL, true
);
26130 mp-
>selector
= old_setting
;
26131 set_number_to_zero
(*turns
);
26134 number_add
(res
, ang
);
26135 if
(number_greater
(res
, one_eighty_deg_t
)) {
26136 number_substract
(res
, three_sixty_deg_t
);
26137 number_add
(*turns
, unity_t
);
26139 if
(number_lessequal
(res
, neg_one_eighty_deg_t
)) {
26140 number_add
(res
, three_sixty_deg_t
);
26141 number_substract
(*turns
, unity_t
);
26143 /* incoming angle at next point
*/
26144 number_clone
(x
, p_next-
>left_x
);
26145 number_clone
(y
, p_next-
>left_y
);
26146 if
(number_equal
(xp
, x
) && number_equal(yp, y)) {
26147 number_clone
(x
, p-
>right_x
);
26148 number_clone
(y
, p-
>right_y
);
26150 if
(number_equal
(xp
, x
) && number_equal(yp, y)) {
26151 number_clone
(x
, p-
>x_coord
);
26152 number_clone
(y
, p-
>y_coord
);
26154 set_number_from_substraction
(arg1
, xp
, x
);
26155 set_number_from_substraction
(arg2
, yp
, y
);
26156 mp_an_angle
(mp
, &in_angle, arg1, arg2);
26157 /* outgoing angle at next point
*/
26158 number_clone
(x
, p_next-
>right_x
);
26159 number_clone
(y
, p_next-
>right_y
);
26160 if
(number_equal
(xp
, x
) && number_equal(yp, y)) {
26161 number_clone
(x
, p_nextnext-
>left_x
);
26162 number_clone
(y
, p_nextnext-
>left_y
);
26164 if
(number_equal
(xp
, x
) && number_equal(yp, y)) {
26165 number_clone
(x
, p_nextnext-
>x_coord
);
26166 number_clone
(y
, p_nextnext-
>y_coord
);
26168 set_number_from_substraction
(arg1
, x
, xp
);
26169 set_number_from_substraction
(arg2
, y
, yp
);
26170 mp_an_angle
(mp
, &out_angle, arg1, arg2);
26171 set_number_from_substraction
(ang
, out_angle
, in_angle
);
26172 mp_reduce_angle
(mp
, &ang);
26173 if
(number_nonzero
(ang
)) {
26174 number_add
(res
, ang
);
26175 if
(number_greaterequal
(res
, one_eighty_deg_t
)) {
26176 number_substract
(res
, three_sixty_deg_t
);
26177 number_add
(*turns
, unity_t
);
26179 if
(number_lessequal
(res
, neg_one_eighty_deg_t
)) {
26180 number_add
(res
, three_sixty_deg_t
);
26181 number_substract
(*turns
, unity_t
);
26184 p
= mp_next_knot
(p
);
26186 mp-
>selector
= old_setting
;
26192 free_number
(seven_twenty_deg_t
);
26193 free_number
(neg_one_eighty_deg_t
);
26194 free_number
(in_angle
);
26195 free_number
(out_angle
);
26202 @ @
<Declare unary action...@
>=
26203 static void mp_turn_cycles_wrapper
(MP mp
, mp_number
*ret
, mp_knot c
) {
26204 if
(mp_next_knot
(c
) == c
) {
26205 /* one-knot paths always have a turning number of
1 */
26206 set_number_to_unity
(*ret
);
26208 mp_turn_cycles
(mp
, ret
, c
);
26212 @ @
<Declare unary action procedures@
>=
26213 static void mp_test_known
(MP mp
, quarterword c
) {
26214 int b
; /* is the current expression known?
*/
26215 mp_node p
; /* location in a big node
*/
26217 memset
(&new_expr,0,sizeof(mp_value));
26218 new_number
(new_expr.data.n
);
26220 switch
(mp-
>cur_exp.type
) {
26222 case mp_boolean_type
:
26223 case mp_string_type
:
26226 case mp_picture_type
:
26230 case mp_transform_type
:
26231 p
= value_node
(cur_exp_node
());
26232 if
(mp_type
(tx_part
(p
)) != mp_known
)
26234 if
(mp_type
(ty_part
(p
)) != mp_known
)
26236 if
(mp_type
(xx_part
(p
)) != mp_known
)
26238 if
(mp_type
(xy_part
(p
)) != mp_known
)
26240 if
(mp_type
(yx_part
(p
)) != mp_known
)
26242 if
(mp_type
(yy_part
(p
)) != mp_known
)
26246 case mp_color_type
:
26247 p
= value_node
(cur_exp_node
());
26248 if
(mp_type
(red_part
(p
)) != mp_known
)
26250 if
(mp_type
(green_part
(p
)) != mp_known
)
26252 if
(mp_type
(blue_part
(p
)) != mp_known
)
26256 case mp_cmykcolor_type
:
26257 p
= value_node
(cur_exp_node
());
26258 if
(mp_type
(cyan_part
(p
)) != mp_known
)
26260 if
(mp_type
(magenta_part
(p
)) != mp_known
)
26262 if
(mp_type
(yellow_part
(p
)) != mp_known
)
26264 if
(mp_type
(black_part
(p
)) != mp_known
)
26269 p
= value_node
(cur_exp_node
());
26270 if
(mp_type
(x_part
(p
)) != mp_known
)
26272 if
(mp_type
(y_part
(p
)) != mp_known
)
26279 if
(c
== mp_known_op
) {
26280 set_number_from_boolean
(new_expr.data.n
, b
);
26282 if
(b
==mp_true_code
) {
26283 set_number_from_boolean
(new_expr.data.n
, mp_false_code
);
26285 set_number_from_boolean
(new_expr.data.n
, mp_true_code
);
26288 mp_flush_cur_exp
(mp
, new_expr
);
26289 cur_exp_node
() = NULL; /* !! do not replace with |set_cur_exp_node
()|
!! */
26290 mp-
>cur_exp.type
= mp_boolean_type
;
26293 @ The |pair_value| routine changes the current expression to a
26294 given ordered pair of values.
26296 @
<Declare unary action procedures@
>=
26297 static void mp_pair_value
(MP mp
, mp_number x
, mp_number y
) {
26298 mp_node p
; /* a pair node
*/
26303 number_clone
(x1
, x
);
26304 number_clone
(y1
, y
);
26305 memset
(&new_expr,0,sizeof(mp_value));
26306 new_number
(new_expr.data.n
);
26307 p
= mp_get_value_node
(mp
);
26308 new_expr.type
= mp_type
(p
);
26309 new_expr.data.node
= p
;
26310 mp_flush_cur_exp
(mp
, new_expr
);
26311 mp-
>cur_exp.type
= mp_pair_type
;
26312 mp_name_type
(p
) = mp_capsule
;
26313 mp_init_pair_node
(mp
, p
);
26314 p
= value_node
(p
);
26315 mp_type
(x_part
(p
)) = mp_known
;
26316 set_value_number
(x_part
(p
), x1
);
26317 mp_type
(y_part
(p
)) = mp_known
;
26318 set_value_number
(y_part
(p
), y1
);
26324 @ Here is a function that sets |minx|
, |maxx|
, |miny|
, |maxy| to the bounding
26325 box of the current expression. The boolean result is |false| if the expression
26326 has the wrong type.
26328 @
<Declare unary action procedures@
>=
26329 static boolean mp_get_cur_bbox
(MP mp
) {
26330 switch
(mp-
>cur_exp.type
) {
26331 case mp_picture_type
:
26333 mp_edge_header_node p0
= (mp_edge_header_node
)cur_exp_node
();
26334 mp_set_bbox
(mp
, p0
, true
);
26335 if
(number_greater
(p0-
>minx
, p0-
>maxx
)) {
26336 set_number_to_zero
(mp_minx
);
26337 set_number_to_zero
(mp_maxx
);
26338 set_number_to_zero
(mp_miny
);
26339 set_number_to_zero
(mp_maxy
);
26341 number_clone
(mp_minx
, p0-
>minx
);
26342 number_clone
(mp_maxx
, p0-
>maxx
);
26343 number_clone
(mp_miny
, p0-
>miny
);
26344 number_clone
(mp_maxy
, p0-
>maxy
);
26349 mp_path_bbox
(mp
, cur_exp_knot
());
26352 mp_pen_bbox
(mp
, cur_exp_knot
());
26361 @ Here is a routine that interprets |cur_exp| as a file name and tries to read
26362 a line from the file or to close the file.
26364 @
<Declare unary action procedures@
>=
26365 static void mp_do_read_or_close
(MP mp
, quarterword c
) {
26367 readf_index n
, n0
; /* indices for searching |rd_fname|
*/
26368 memset
(&new_expr,0,sizeof(mp_value));
26369 new_number
(new_expr.data.n
);
26370 /* Find the |n| where |rd_fname
[n
]=cur_exp|
; if |cur_exp| must be inserted
,
26371 call |start_read_input| and |goto found| or |not_found|
*/
26372 /* Free slots in the |rd_file| and |rd_fname| arrays are marked with
NULL's in
26376 n
= mp-
>read_files
;
26377 n0
= mp-
>read_files
;
26378 fn
= mp_xstrdup
(mp
, mp_str
(mp
, cur_exp_str
()));
26379 while
(mp_xstrcmp
(fn
, mp-
>rd_fname
[n
]) != 0) {
26382 } else if
(c
== mp_close_from_op
) {
26385 if
(n0
== mp-
>read_files
) {
26386 if
(mp-
>read_files
< mp-
>max_read_files
) {
26387 incr
(mp-
>read_files
);
26392 l
= mp-
>max_read_files
+ (mp-
>max_read_files
/ 4);
26393 rd_file
= xmalloc
((l
+ 1), sizeof
(void
*));
26394 rd_fname
= xmalloc
((l
+ 1), sizeof
(char
*));
26395 for
(k
= 0; k
<= l
; k
++) {
26396 if
(k
<= mp-
>max_read_files
) {
26397 rd_file
[k
] = mp-
>rd_file
[k
];
26398 rd_fname
[k
] = mp-
>rd_fname
[k
];
26401 rd_fname
[k
] = NULL;
26404 xfree
(mp-
>rd_file
);
26405 xfree
(mp-
>rd_fname
);
26406 mp-
>max_read_files
= l
;
26407 mp-
>rd_file
= rd_file
;
26408 mp-
>rd_fname
= rd_fname
;
26412 if
(mp_start_read_input
(mp
, fn
, n
))
26417 if
(mp-
>rd_fname
[n
] == NULL) {
26421 if
(c
== mp_close_from_op
) {
26422 (mp-
>close_file
) (mp
, mp-
>rd_file
[n
]);
26426 mp_begin_file_reading
(mp
);
26428 if
(mp_input_ln
(mp
, mp-
>rd_file
[n
]))
26430 mp_end_file_reading
(mp
);
26432 /* Record the end of file and set |cur_exp| to a dummy value
*/
26433 xfree
(mp-
>rd_fname
[n
]);
26434 mp-
>rd_fname
[n
] = NULL;
26435 if
(n
== mp-
>read_files
- 1)
26436 mp-
>read_files
= n
;
26437 if
(c
== mp_close_from_op
)
26439 new_expr.data.str
= mp-
>eof_line
;
26440 add_str_ref
(new_expr.data.str
);
26441 mp_flush_cur_exp
(mp
, new_expr
);
26442 mp-
>cur_exp.type
= mp_string_type
;
26445 mp_flush_cur_exp
(mp
, new_expr
);
26446 mp-
>cur_exp.type
= mp_vacuous
;
26449 mp_flush_cur_exp
(mp
, new_expr
);
26450 mp_finish_read
(mp
);
26453 @ The string denoting end-of-file is a one-byte string at position zero
, by definition.
26454 I have to cheat a little here because
26457 mp_string eof_line
;
26460 mp-
>eof_line
= mp_rtsl
(mp
, "\0", 1);
26461 mp-
>eof_line-
>refs
= MAX_STR_REF
;
26463 @ Finally
, we have the operations that combine a capsule~|p|
26464 with the current expression.
26466 Several of the binary operations are potentially complicated by the
26467 fact that |independent| values can sneak into capsules. For example
,
26468 we've seen an instance of this difficulty in the unary operation
26469 of negation. In order to reduce the number of cases that need to be
26470 handled
, we first change the two operands
(if necessary
)
26471 to rid them of |independent| components. The original operands are
26472 put into capsules called |old_p| and |old_exp|
, which will be
26473 recycled after the binary operation has been safely carried out.
26475 @d binary_return
{ mp_finish_binary
(mp
, old_p
, old_exp
); return
; }
26478 @
<Declare binary action procedures@
>;
26479 static void mp_finish_binary
(MP mp
, mp_node old_p
, mp_node old_exp
) {
26481 /* Recycle any sidestepped |independent| capsules
*/
26482 if
(old_p
!= NULL) {
26483 mp_recycle_value
(mp
, old_p
);
26484 mp_free_value_node
(mp
, old_p
);
26486 if
(old_exp
!= NULL) {
26487 mp_recycle_value
(mp
, old_exp
);
26488 mp_free_value_node
(mp
, old_exp
);
26491 static void mp_do_binary
(MP mp
, mp_node p
, integer c
) {
26492 mp_node q
, r
, rr
; /* for list manipulation
*/
26493 mp_node old_p
, old_exp
; /* capsules to recycle
*/
26496 if
(number_greater
(internal_value
(mp_tracing_commands
), two_t
)) {
26497 /* Trace the current binary operation
*/
26498 mp_begin_diagnostic
(mp
);
26499 mp_print_nl
(mp
, "{(");
26500 mp_print_exp
(mp
, p
, 0); /* show the operand
, but not verbosely
*/
26501 mp_print_char
(mp
, xord
('
)'
));
26502 mp_print_op
(mp
, (quarterword
) c
);
26503 mp_print_char
(mp
, xord
('
('
));
26504 mp_print_exp
(mp
, NULL, 0);
26505 mp_print
(mp
, ")}");
26506 mp_end_diagnostic
(mp
, false
);
26508 /* Sidestep |independent| cases in capsule |p|
*/
26509 /* A big node is considered to be ``tarnished'' if it contains at least one
26510 independent component. We will define a simple function called `|tarnished|'
26511 that returns |
NULL| if and only if its argument is not tarnished.
*/
26512 switch
(mp_type
(p
)) {
26513 case mp_transform_type
:
26514 case mp_color_type
:
26515 case mp_cmykcolor_type
:
26517 old_p
= mp_tarnished
(mp
, p
);
26519 case mp_independent
:
26526 if
(old_p
!= NULL) {
26527 q
= mp_stash_cur_exp
(mp
);
26529 mp_make_exp_copy
(mp
, old_p
);
26530 p
= mp_stash_cur_exp
(mp
);
26531 mp_unstash_cur_exp
(mp
, q
);
26534 /* Sidestep |independent| cases in the current expression
*/
26535 switch
(mp-
>cur_exp.type
) {
26536 case mp_transform_type
:
26537 case mp_color_type
:
26538 case mp_cmykcolor_type
:
26540 old_exp
= mp_tarnished
(mp
, cur_exp_node
());
26542 case mp_independent
:
26549 if
(old_exp
!= NULL) {
26550 old_exp
= cur_exp_node
();
26551 mp_make_exp_copy
(mp
, old_exp
);
26557 /* Add or subtract the current expression from |p|
*/
26558 if
((mp-
>cur_exp.type
< mp_color_type
) ||
(mp_type
(p
) < mp_color_type
)) {
26559 mp_bad_binary
(mp
, p
, (quarterword
) c
);
26561 quarterword cc
= (quarterword
)c
;
26562 if
((mp-
>cur_exp.type
> mp_pair_type
) && (mp_type (p) > mp_pair_type)) {
26563 mp_add_or_subtract
(mp
, p
, NULL, cc
);
26565 if
(mp-
>cur_exp.type
!= mp_type
(p
)) {
26566 mp_bad_binary
(mp
, p
, cc
);
26568 q
= value_node
(p
);
26569 r
= value_node
(cur_exp_node
());
26570 switch
(mp-
>cur_exp.type
) {
26572 mp_add_or_subtract
(mp
, x_part
(q
), x_part
(r
),cc
);
26573 mp_add_or_subtract
(mp
, y_part
(q
), y_part
(r
),cc
);
26575 case mp_color_type
:
26576 mp_add_or_subtract
(mp
, red_part
(q
), red_part
(r
),cc
);
26577 mp_add_or_subtract
(mp
, green_part
(q
), green_part
(r
),cc
);
26578 mp_add_or_subtract
(mp
, blue_part
(q
), blue_part
(r
),cc
);
26580 case mp_cmykcolor_type
:
26581 mp_add_or_subtract
(mp
, cyan_part
(q
), cyan_part
(r
),cc
);
26582 mp_add_or_subtract
(mp
, magenta_part
(q
), magenta_part
(r
),cc
);
26583 mp_add_or_subtract
(mp
, yellow_part
(q
), yellow_part
(r
),cc
);
26584 mp_add_or_subtract
(mp
, black_part
(q
), black_part
(r
),cc
);
26586 case mp_transform_type
:
26587 mp_add_or_subtract
(mp
, tx_part
(q
), tx_part
(r
),cc
);
26588 mp_add_or_subtract
(mp
, ty_part
(q
), ty_part
(r
),cc
);
26589 mp_add_or_subtract
(mp
, xx_part
(q
), xx_part
(r
),cc
);
26590 mp_add_or_subtract
(mp
, xy_part
(q
), xy_part
(r
),cc
);
26591 mp_add_or_subtract
(mp
, yx_part
(q
), yx_part
(r
),cc
);
26592 mp_add_or_subtract
(mp
, yy_part
(q
), yy_part
(r
),cc
);
26594 default
: /* there are no other valid cases
, but please the compiler
*/
26602 case mp_less_or_equal
:
26603 case mp_greater_than
:
26604 case mp_greater_or_equal
:
26606 case mp_unequal_to
:
26607 check_arith
(); /* at this point |arith_error| should be |false|?
*/
26608 if
((mp-
>cur_exp.type
> mp_pair_type
) && (mp_type (p) > mp_pair_type)) {
26609 mp_add_or_subtract
(mp
, p
, NULL, mp_minus
); /* |cur_exp
:=(p
)-cur_exp|
*/
26610 } else if
(mp-
>cur_exp.type
!= mp_type
(p
)) {
26611 mp_bad_binary
(mp
, p
, (quarterword
) c
);
26613 } else if
(mp-
>cur_exp.type
== mp_string_type
) {
26614 memset
(&new_expr,0,sizeof(mp_value));
26615 new_number
(new_expr.data.n
);
26616 set_number_from_scaled
(new_expr.data.n
, mp_str_vs_str
(mp
, value_str
(p
), cur_exp_str
()));
26617 mp_flush_cur_exp
(mp
, new_expr
);
26618 } else if
((mp-
>cur_exp.type
== mp_unknown_string
) ||
26619 (mp-
>cur_exp.type
== mp_unknown_boolean
)) {
26620 /* Check if unknowns have been equated
*/
26621 /* When two unknown strings are in the same ring
, we know that they are
26622 equal. Otherwise
, we don't know whether they are equal or not
, so we
26624 q
= value_node
(cur_exp_node
());
26625 while
((q
!= cur_exp_node
()) && (q != p))
26626 q
= value_node
(q
);
26628 memset
(&new_expr,0,sizeof(mp_value));
26629 new_number
(new_expr.data.n
);
26630 set_cur_exp_node
(NULL);
26631 mp_flush_cur_exp
(mp
, new_expr
);
26634 } else if
((mp-
>cur_exp.type
<= mp_pair_type
)
26635 && (mp->cur_exp.type >= mp_transform_type)) {
26636 /* Reduce comparison of big nodes to comparison of scalars
*/
26637 /* In the following
, the |while| loops exist just so that |break| can be used
,
26638 each loop runs exactly once.
*/
26639 quarterword part_type
;
26640 q
= value_node
(p
);
26641 r
= value_node
(cur_exp_node
());
26643 switch
(mp-
>cur_exp.type
) {
26645 while
(part_type
==0) {
26647 part_type
= mp_x_part
;
26648 mp_add_or_subtract
(mp
, x_part
(q
), rr
, mp_minus
);
26649 if
(mp_type
(rr
) != mp_known ||
! number_zero
(value_number
(rr
)))
26652 part_type
= mp_y_part
;
26653 mp_add_or_subtract
(mp
, y_part
(q
), rr
, mp_minus
);
26654 if
(mp_type
(rr
) != mp_known ||
!number_zero
(value_number
(rr
)))
26657 mp_take_part
(mp
, part_type
);
26659 case mp_color_type
:
26660 while
(part_type
==0) {
26662 part_type
= mp_red_part
;
26663 mp_add_or_subtract
(mp
, red_part
(q
), rr
, mp_minus
);
26664 if
(mp_type
(rr
) != mp_known ||
! number_zero
(value_number
(rr
)))
26666 rr
= green_part
(r
);
26667 part_type
= mp_green_part
;
26668 mp_add_or_subtract
(mp
, green_part
(q
), rr
, mp_minus
);
26669 if
(mp_type
(rr
) != mp_known ||
!number_zero
(value_number
(rr
)))
26671 rr
= blue_part
(r
);
26672 part_type
= mp_blue_part
;
26673 mp_add_or_subtract
(mp
, blue_part
(q
), rr
, mp_minus
);
26674 if
(mp_type
(rr
) != mp_known ||
!number_zero
(value_number
(rr
)))
26677 mp_take_part
(mp
, part_type
);
26679 case mp_cmykcolor_type
:
26680 while
(part_type
==0) {
26681 rr
= cyan_part
(r
);
26682 part_type
= mp_cyan_part
;
26683 mp_add_or_subtract
(mp
, cyan_part
(q
), rr
, mp_minus
);
26684 if
(mp_type
(rr
) != mp_known ||
!number_zero
(value_number
(rr
)))
26686 rr
= magenta_part
(r
);
26687 part_type
= mp_magenta_part
;
26688 mp_add_or_subtract
(mp
, magenta_part
(q
), rr
, mp_minus
);
26689 if
(mp_type
(rr
) != mp_known ||
!number_zero
(value_number
(rr
)))
26691 rr
= yellow_part
(r
);
26692 part_type
= mp_yellow_part
;
26693 mp_add_or_subtract
(mp
, yellow_part
(q
), rr
, mp_minus
);
26694 if
(mp_type
(rr
) != mp_known ||
!number_zero
(value_number
(rr
)))
26696 rr
= black_part
(r
);
26697 part_type
= mp_black_part
;
26698 mp_add_or_subtract
(mp
, black_part
(q
), rr
, mp_minus
);
26699 if
(mp_type
(rr
) != mp_known ||
!number_zero
(value_number
(rr
)))
26702 mp_take_part
(mp
, part_type
);
26704 case mp_transform_type
:
26705 while
(part_type
==0) {
26707 part_type
= mp_x_part
;
26708 mp_add_or_subtract
(mp
, tx_part
(q
), rr
, mp_minus
);
26709 if
(mp_type
(rr
) != mp_known ||
!number_zero
(value_number
(rr
)))
26712 part_type
= mp_y_part
;
26713 mp_add_or_subtract
(mp
, ty_part
(q
), rr
, mp_minus
);
26714 if
(mp_type
(rr
) != mp_known ||
!number_zero
(value_number
(rr
)))
26717 part_type
= mp_xx_part
;
26718 mp_add_or_subtract
(mp
, xx_part
(q
), rr
, mp_minus
);
26719 if
(mp_type
(rr
) != mp_known ||
!number_zero
(value_number
(rr
)))
26722 part_type
= mp_xy_part
;
26723 mp_add_or_subtract
(mp
, xy_part
(q
), rr
, mp_minus
);
26724 if
(mp_type
(rr
) != mp_known ||
!number_zero
(value_number
(rr
)))
26727 part_type
= mp_yx_part
;
26728 mp_add_or_subtract
(mp
, yx_part
(q
), rr
, mp_minus
);
26729 if
(mp_type
(rr
) != mp_known ||
!number_zero
(value_number
(rr
)))
26732 part_type
= mp_yy_part
;
26733 mp_add_or_subtract
(mp
, yy_part
(q
), rr
, mp_minus
);
26734 if
(mp_type
(rr
) != mp_known ||
!number_zero
(value_number
(rr
)))
26737 mp_take_part
(mp
, part_type
);
26740 assert
(0); /* todo
: |mp-
>cur_exp.type
>mp_transform_node_type| ?
*/
26744 } else if
(mp-
>cur_exp.type
== mp_boolean_type
) {
26745 memset
(&new_expr,0,sizeof(mp_value));
26746 new_number
(new_expr.data.n
);
26747 set_number_from_boolean
(new_expr.data.n
, number_to_scaled
(cur_exp_value_number
()) -
26748 number_to_scaled
(value_number
(p
)));
26749 mp_flush_cur_exp
(mp
, new_expr
);
26751 mp_bad_binary
(mp
, p
, (quarterword
) c
);
26754 /* Compare the current expression with zero
*/
26755 if
(mp-
>cur_exp.type
!= mp_known
) {
26756 const char
*hlp
[] = {
26757 "Oh dear. I can\'t decide if the expression above is positive,",
26758 "negative, or zero. So this comparison test won't be `true'.",
26760 if
(mp-
>cur_exp.type
< mp_known
) {
26761 mp_disp_err
(mp
, p
);
26762 hlp
[0] = "The quantities shown above have not been equated.";
26765 mp_disp_err
(mp
, NULL);
26766 memset
(&new_expr,0,sizeof(mp_value));
26767 new_number
(new_expr.data.n
);
26768 set_number_from_boolean
(new_expr.data.n
, mp_false_code
);
26769 mp_back_error
(mp
,"Unknown relation will be considered false", hlp
, true
);
26770 @.Unknown relation...@
>;
26771 mp_get_x_next
(mp
);
26772 mp_flush_cur_exp
(mp
, new_expr
);
26776 boolean_reset
(number_negative
(cur_exp_value_number
()));
26778 case mp_less_or_equal
:
26779 boolean_reset
(number_nonpositive
(cur_exp_value_number
()));
26781 case mp_greater_than
:
26782 boolean_reset
(number_positive
(cur_exp_value_number
()));
26784 case mp_greater_or_equal
:
26785 boolean_reset
(number_nonnegative
(cur_exp_value_number
()));
26788 boolean_reset
(number_zero
(cur_exp_value_number
()));
26790 case mp_unequal_to
:
26791 boolean_reset
(number_nonzero
(cur_exp_value_number
()));
26793 }; /* there are no other cases
*/
26795 mp-
>cur_exp.type
= mp_boolean_type
;
26797 mp-
>arith_error
= false
; /* ignore overflow in comparisons
*/
26801 /* Here we use the sneaky fact that |and_op-false_code
=or_op-true_code|
*/
26802 if
((mp_type
(p
) != mp_boolean_type
) ||
(mp-
>cur_exp.type
!= mp_boolean_type
))
26803 mp_bad_binary
(mp
, p
, (quarterword
) c
);
26804 else if
(number_to_boolean
(p-
>data.n
) == c
+ mp_false_code
- mp_and_op
) {
26805 set_cur_exp_value_boolean
(number_to_boolean
(p-
>data.n
));
26809 if
((mp-
>cur_exp.type
< mp_color_type
) ||
(mp_type
(p
) < mp_color_type
)) {
26810 mp_bad_binary
(mp
, p
, mp_times
);
26811 } else if
((mp-
>cur_exp.type
== mp_known
) ||
(mp_type
(p
) == mp_known
)) {
26812 /* Multiply when at least one operand is known
*/
26815 if
(mp_type
(p
) == mp_known
) {
26816 number_clone
(vv
, value_number
(p
));
26817 mp_free_value_node
(mp
, p
);
26819 number_clone
(vv
, cur_exp_value_number
());
26820 mp_unstash_cur_exp
(mp
, p
);
26822 if
(mp-
>cur_exp.type
== mp_known
) {
26825 take_scaled
(ret
, cur_exp_value_number
(), vv
);
26826 set_cur_exp_value_number
(ret
);
26828 } else if
(mp-
>cur_exp.type
== mp_pair_type
) {
26829 mp_dep_mult
(mp
, (mp_value_node
) x_part
(value_node
(cur_exp_node
())), vv
, true
);
26830 mp_dep_mult
(mp
, (mp_value_node
) y_part
(value_node
(cur_exp_node
())), vv
, true
);
26831 } else if
(mp-
>cur_exp.type
== mp_color_type
) {
26832 mp_dep_mult
(mp
, (mp_value_node
) red_part
(value_node
(cur_exp_node
())), vv
, true
);
26833 mp_dep_mult
(mp
, (mp_value_node
) green_part
(value_node
(cur_exp_node
())), vv
, true
);
26834 mp_dep_mult
(mp
, (mp_value_node
) blue_part
(value_node
(cur_exp_node
())), vv
, true
);
26835 } else if
(mp-
>cur_exp.type
== mp_cmykcolor_type
) {
26836 mp_dep_mult
(mp
, (mp_value_node
) cyan_part
(value_node
(cur_exp_node
())), vv
, true
);
26837 mp_dep_mult
(mp
, (mp_value_node
) magenta_part
(value_node
(cur_exp_node
())), vv
, true
);
26838 mp_dep_mult
(mp
, (mp_value_node
) yellow_part
(value_node
(cur_exp_node
())), vv
, true
);
26839 mp_dep_mult
(mp
, (mp_value_node
) black_part
(value_node
(cur_exp_node
())), vv
, true
);
26841 mp_dep_mult
(mp
, NULL, vv
, true
);
26846 } else if
((mp_nice_color_or_pair
(mp
, p
, mp_type
(p
))
26847 && (mp->cur_exp.type > mp_pair_type))
26848 ||
(mp_nice_color_or_pair
(mp
, cur_exp_node
(), mp-
>cur_exp.type
)
26849 && (mp_type (p) > mp_pair_type))) {
26850 mp_hard_times
(mp
, p
);
26853 mp_bad_binary
(mp
, p
, mp_times
);
26857 if
((mp-
>cur_exp.type
!= mp_known
) ||
(mp_type
(p
) < mp_color_type
)) {
26858 mp_bad_binary
(mp
, p
, mp_over
);
26862 number_clone
(v_n
, cur_exp_value_number
());
26863 mp_unstash_cur_exp
(mp
, p
);
26864 if
(number_zero
(v_n
)) {
26865 /* Squeal about division by zero
*/
26866 const char
*hlp
[] = {
26867 "You're trying to divide the quantity shown above the error",
26868 "message by zero. I'm going to divide it by one instead.",
26870 mp_disp_err
(mp
, NULL);
26871 mp_back_error
(mp
, "Division by zero", hlp
, true
);
26872 mp_get_x_next
(mp
);
26875 if
(mp-
>cur_exp.type
== mp_known
) {
26878 make_scaled
(ret
, cur_exp_value_number
(), v_n
);
26879 set_cur_exp_value_number
(ret
);
26881 } else if
(mp-
>cur_exp.type
== mp_pair_type
) {
26882 mp_dep_div
(mp
, (mp_value_node
) x_part
(value_node
(cur_exp_node
())),
26884 mp_dep_div
(mp
, (mp_value_node
) y_part
(value_node
(cur_exp_node
())),
26886 } else if
(mp-
>cur_exp.type
== mp_color_type
) {
26888 (mp_value_node
) red_part
(value_node
(cur_exp_node
())),
26891 (mp_value_node
) green_part
(value_node
(cur_exp_node
())),
26894 (mp_value_node
) blue_part
(value_node
(cur_exp_node
())),
26896 } else if
(mp-
>cur_exp.type
== mp_cmykcolor_type
) {
26898 (mp_value_node
) cyan_part
(value_node
(cur_exp_node
())),
26900 mp_dep_div
(mp
, (mp_value_node
)
26901 magenta_part
(value_node
(cur_exp_node
())), v_n
);
26902 mp_dep_div
(mp
, (mp_value_node
)
26903 yellow_part
(value_node
(cur_exp_node
())), v_n
);
26905 (mp_value_node
) black_part
(value_node
(cur_exp_node
())),
26908 mp_dep_div
(mp
, NULL, v_n
);
26915 case mp_pythag_add
:
26916 case mp_pythag_sub
:
26917 if
((mp-
>cur_exp.type
== mp_known
) && (mp_type (p) == mp_known)) {
26920 if
(c
== mp_pythag_add
) {
26921 pyth_add
(r
, value_number
(p
), cur_exp_value_number
());
26923 pyth_sub
(r
, value_number
(p
), cur_exp_value_number
());
26925 set_cur_exp_value_number
(r
);
26928 mp_bad_binary
(mp
, p
, (quarterword
) c
);
26930 case mp_rotated_by
:
26931 case mp_slanted_by
:
26933 case mp_shifted_by
:
26934 case mp_transformed_by
:
26938 /* The next few sections of the program deal with affine transformations
26939 of coordinate data.
*/
26940 if
(mp_type
(p
) == mp_path_type
) {
26941 path_trans
((quarterword
) c
, p
);
26943 } else if
(mp_type
(p
) == mp_pen_type
) {
26944 pen_trans
((quarterword
) c
, p
);
26945 set_cur_exp_knot
(mp_convex_hull
(mp
, cur_exp_knot
()));
26946 /* rounding error could destroy convexity
*/
26948 } else if
((mp_type
(p
) == mp_pair_type
) ||
(mp_type
(p
) == mp_transform_type
)) {
26949 mp_big_trans
(mp
, p
, (quarterword
) c
);
26950 } else if
(mp_type
(p
) == mp_picture_type
) {
26951 mp_do_edges_trans
(mp
, p
, (quarterword
) c
);
26954 mp_bad_binary
(mp
, p
, (quarterword
) c
);
26957 case mp_concatenate
:
26958 if
((mp-
>cur_exp.type
== mp_string_type
) && (mp_type (p) == mp_string_type)) {
26959 mp_string str
= mp_cat
(mp
, value_str
(p
), cur_exp_str
());
26960 delete_str_ref
(cur_exp_str
()) ;
26961 set_cur_exp_str
(str
);
26963 mp_bad_binary
(mp
, p
, mp_concatenate
);
26965 case mp_substring_of
:
26966 if
(mp_nice_pair
(mp
, p
, mp_type
(p
)) && (mp->cur_exp.type == mp_string_type)) {
26967 mp_string str
= mp_chop_string
(mp
,
26969 round_unscaled
(value_number
(x_part
(value_node
(p
)))),
26970 round_unscaled
(value_number
(y_part
(value_node
(p
)))));
26971 delete_str_ref
(cur_exp_str
()) ;
26972 set_cur_exp_str
(str
);
26974 mp_bad_binary
(mp
, p
, mp_substring_of
);
26976 case mp_subpath_of
:
26977 if
(mp-
>cur_exp.type
== mp_pair_type
)
26978 mp_pair_to_path
(mp
);
26979 if
(mp_nice_pair
(mp
, p
, mp_type
(p
)) && (mp->cur_exp.type == mp_path_type))
26980 mp_chop_path
(mp
, value_node
(p
));
26982 mp_bad_binary
(mp
, p
, mp_subpath_of
);
26985 case mp_precontrol_of
:
26986 case mp_postcontrol_of
:
26987 if
(mp-
>cur_exp.type
== mp_pair_type
)
26988 mp_pair_to_path
(mp
);
26989 if
((mp-
>cur_exp.type
== mp_path_type
) && (mp_type (p) == mp_known))
26990 mp_find_point
(mp
, value_number
(p
), (quarterword
) c
);
26992 mp_bad_binary
(mp
, p
, (quarterword
) c
);
26994 case mp_pen_offset_of
:
26995 if
((mp-
>cur_exp.type
== mp_pen_type
) && mp_nice_pair (mp, p, mp_type (p)))
26996 mp_set_up_offset
(mp
, value_node
(p
));
26998 mp_bad_binary
(mp
, p
, mp_pen_offset_of
);
27000 case mp_direction_time_of
:
27001 if
(mp-
>cur_exp.type
== mp_pair_type
)
27002 mp_pair_to_path
(mp
);
27003 if
((mp-
>cur_exp.type
== mp_path_type
) && mp_nice_pair (mp, p, mp_type (p)))
27004 mp_set_up_direction_time
(mp
, value_node
(p
));
27006 mp_bad_binary
(mp
, p
, mp_direction_time_of
);
27008 case mp_envelope_of
:
27009 if
((mp_type
(p
) != mp_pen_type
) ||
(mp-
>cur_exp.type
!= mp_path_type
))
27010 mp_bad_binary
(mp
, p
, mp_envelope_of
);
27012 mp_set_up_envelope
(mp
, p
);
27014 case mp_glyph_infont
:
27015 if
((mp_type
(p
) != mp_string_type
&&
27016 mp_type
(p
) != mp_known
) ||
(mp-
>cur_exp.type
!= mp_string_type
))
27017 mp_bad_binary
(mp
, p
, mp_glyph_infont
);
27019 mp_set_up_glyph_infont
(mp
, p
);
27021 case mp_arc_time_of
:
27022 if
(mp-
>cur_exp.type
== mp_pair_type
)
27023 mp_pair_to_path
(mp
);
27024 if
((mp-
>cur_exp.type
== mp_path_type
) && (mp_type (p) == mp_known)) {
27025 memset
(&new_expr,0,sizeof(mp_value));
27026 new_number
(new_expr.data.n
);
27027 mp_get_arc_time
(mp
, &new_expr.data.n, cur_exp_knot (), value_number (p));
27028 mp_flush_cur_exp
(mp
, new_expr
);
27030 mp_bad_binary
(mp
, p
, (quarterword
) c
);
27034 if
(mp_type
(p
) == mp_pair_type
) {
27035 q
= mp_stash_cur_exp
(mp
);
27036 mp_unstash_cur_exp
(mp
, p
);
27037 mp_pair_to_path
(mp
);
27038 p
= mp_stash_cur_exp
(mp
);
27039 mp_unstash_cur_exp
(mp
, q
);
27041 if
(mp-
>cur_exp.type
== mp_pair_type
)
27042 mp_pair_to_path
(mp
);
27043 if
((mp-
>cur_exp.type
== mp_path_type
) && (mp_type (p) == mp_path_type)) {
27044 mp_number arg1
, arg2
;
27047 mp_path_intersection
(mp
, value_knot
(p
), cur_exp_knot
());
27048 number_clone
(arg1
, mp-
>cur_t
);
27049 number_clone
(arg2
, mp-
>cur_tt
);
27050 mp_pair_value
(mp
, arg1
, arg2
);
27051 free_number
(arg1
);
27052 free_number
(arg2
);
27054 mp_bad_binary
(mp
, p
, mp_intersect
);
27058 if
((mp-
>cur_exp.type
!= mp_string_type
) || mp_type
(p
) != mp_string_type
) {
27059 mp_bad_binary
(mp
, p
, mp_in_font
);
27061 mp_do_infont
(mp
, p
);
27065 } /* there are no other cases
*/
27066 mp_recycle_value
(mp
, p
);
27067 mp_free_value_node
(mp
, p
); /* |return| to avoid this
*/
27068 mp_finish_binary
(mp
, old_p
, old_exp
);
27072 @ @
<Declare binary action...@
>=
27073 static void mp_bad_binary
(MP mp
, mp_node p
, quarterword c
) {
27076 int old_setting
= mp-
>selector
;
27077 const char
*hlp
[] = {
27078 "I'm afraid I don't know how to apply that operation to that",
27079 "combination of types. Continue, and I'll return the second",
27080 "argument (see above) as the result of the operation.",
27082 mp-
>selector
= new_string
;
27083 if
(c
>= mp_min_of
)
27084 mp_print_op
(mp
, c
);
27085 mp_print_known_or_unknown_type
(mp
, mp_type
(p
), p
);
27086 if
(c
>= mp_min_of
)
27087 mp_print
(mp
, "of");
27089 mp_print_op
(mp
, c
);
27090 mp_print_known_or_unknown_type
(mp
, mp-
>cur_exp.type
, cur_exp_node
());
27091 sname
= mp_make_string
(mp
);
27092 mp-
>selector
= old_setting
;
27093 mp_snprintf
(msg
, 256, "Not implemented: %s", mp_str
(mp
, sname
));
27094 @.Not implemented...@
>;
27095 delete_str_ref
(sname
);
27096 mp_disp_err
(mp
, p
);
27097 mp_disp_err
(mp
, NULL);
27098 mp_back_error
(mp
, msg
, hlp
, true
);
27099 mp_get_x_next
(mp
);
27101 static void mp_bad_envelope_pen
(MP mp
) {
27102 const char
*hlp
[] = {
27103 "I'm afraid I don't know how to apply that operation to that",
27104 "combination of types. Continue, and I'll return the second",
27105 "argument (see above) as the result of the operation.",
27107 mp_disp_err
(mp
, NULL);
27108 mp_disp_err
(mp
, NULL);
27109 mp_back_error
(mp
, "Not implemented: envelope(elliptical pen)of(path)", hlp
, true
);
27110 @.Not implemented...@
>;
27111 mp_get_x_next
(mp
);
27114 @ @
<Declare binary action...@
>=
27115 static mp_node mp_tarnished
(MP mp
, mp_node p
) {
27116 mp_node q
; /* beginning of the big node
*/
27117 mp_node r
; /* moving value node pointer
*/
27119 q
= value_node
(p
);
27120 switch
(mp_type
(p
)) {
27123 if
(mp_type
(r
) == mp_independent
)
27126 if
(mp_type
(r
) == mp_independent
)
27129 case mp_color_type
:
27131 if
(mp_type
(r
) == mp_independent
)
27133 r
= green_part
(q
);
27134 if
(mp_type
(r
) == mp_independent
)
27137 if
(mp_type
(r
) == mp_independent
)
27140 case mp_cmykcolor_type
:
27142 if
(mp_type
(r
) == mp_independent
)
27144 r
= magenta_part
(q
);
27145 if
(mp_type
(r
) == mp_independent
)
27147 r
= yellow_part
(q
);
27148 if
(mp_type
(r
) == mp_independent
)
27150 r
= black_part
(q
);
27151 if
(mp_type
(r
) == mp_independent
)
27154 case mp_transform_type
:
27156 if
(mp_type
(r
) == mp_independent
)
27159 if
(mp_type
(r
) == mp_independent
)
27162 if
(mp_type
(r
) == mp_independent
)
27165 if
(mp_type
(r
) == mp_independent
)
27168 if
(mp_type
(r
) == mp_independent
)
27171 if
(mp_type
(r
) == mp_independent
)
27174 default
: /* there are no other valid cases
, but please the compiler
*/
27180 @ The first argument to |add_or_subtract| is the location of a value node
27181 in a capsule or pair node that will soon be recycled. The second argument
27182 is either a location within a pair or transform node of |cur_exp|
,
27183 or it is
NULL (which means that |cur_exp| itself should be the second
27184 argument
). The third argument is either |plus| or |minus|.
27186 The sum or difference of the numeric quantities will replace the second
27187 operand. Arithmetic overflow may go undetected
; users aren't supposed to
27188 be monkeying around with really big values.
27189 @^overflow in arithmetic@
>
27191 @
<Declare binary action...@
>=
27192 @
<Declare the procedure called |dep_finish|@
>;
27193 static void mp_add_or_subtract
(MP mp
, mp_node p
, mp_node q
, quarterword c
) {
27194 mp_variable_type s
, t
; /* operand types
*/
27195 mp_value_node r
; /* dependency list traverser
*/
27196 mp_value_node v
= NULL; /* second operand value for dep lists
*/
27197 mp_number vv
; /* second operand value for known values
*/
27200 t
= mp-
>cur_exp.type
;
27201 if
(t
< mp_dependent
)
27202 number_clone
(vv
, cur_exp_value_number
());
27204 v
= (mp_value_node
) dep_list
((mp_value_node
) cur_exp_node
());
27207 if
(t
< mp_dependent
)
27208 number_clone
(vv
, value_number
(q
));
27210 v
= (mp_value_node
) dep_list
((mp_value_node
) q
);
27212 if
(t
== mp_known
) {
27213 mp_value_node qq
= (mp_value_node
) q
;
27215 number_negate
(vv
);
27216 if
(mp_type
(p
) == mp_known
) {
27217 slow_add
(vv
, value_number
(p
), vv
);
27219 set_cur_exp_value_number
(vv
);
27221 set_value_number
(q
, vv
);
27225 /* Add a known value to the constant term of |dep_list
(p
)|
*/
27226 r
= (mp_value_node
) dep_list
((mp_value_node
) p
);
27227 while
(dep_info
(r
) != NULL)
27228 r
= (mp_value_node
) mp_link
(r
);
27229 slow_add
(vv
, dep_value
(r
), vv
);
27230 set_dep_value
(r
, vv
);
27232 qq
= mp_get_dep_node
(mp
);
27233 set_cur_exp_node
((mp_node
) qq
);
27234 mp-
>cur_exp.type
= mp_type
(p
);
27235 mp_name_type
(qq
) = mp_capsule
;
27236 /* clang
: never read
: |q
= (mp_node
) qq
;|
*/
27238 set_dep_list
(qq
, dep_list
((mp_value_node
) p
));
27239 mp_type
(qq
) = mp_type
(p
);
27240 set_prev_dep
(qq
, prev_dep
((mp_value_node
) p
));
27241 mp_link
(prev_dep
((mp_value_node
) p
)) = (mp_node
) qq
;
27242 mp_type
(p
) = mp_known
; /* this will keep the recycler from collecting non-garbage
*/
27245 mp_negate_dep_list
(mp
, v
);
27246 /* Add operand |p| to the dependency list |v|
*/
27247 /* We prefer |dependent| lists to |mp_proto_dependent| ones
, because it is
27248 nice to retain the extra accuracy of |fraction| coefficients.
27249 But we have to handle both kinds
, and mixtures too.
*/
27250 if
(mp_type
(p
) == mp_known
) {
27251 /* Add the known |value
(p
)| to the constant term of |v|
*/
27252 while
(dep_info
(v
) != NULL) {
27253 v
= (mp_value_node
) mp_link
(v
);
27255 slow_add
(vv
, value_number
(p
), dep_value
(v
));
27256 set_dep_value
(v
, vv
);
27259 r
= (mp_value_node
) dep_list
((mp_value_node
) p
);
27260 if
(t
== mp_dependent
) {
27261 if
(s
== mp_dependent
) {
27262 mp_number ret1
, ret2
;
27263 new_fraction
(ret1
);
27264 new_fraction
(ret2
);
27265 mp_max_coef
(mp
, &ret1, r);
27266 mp_max_coef
(mp
, &ret2, v);
27267 number_add
(ret1
, ret2
);
27268 free_number
(ret2
);
27269 if
(number_less
(ret1
, coef_bound_k
)) {
27270 v
= mp_p_plus_q
(mp
, v
, r
, mp_dependent
);
27271 free_number
(ret1
);
27274 free_number
(ret1
);
27275 } /* |fix_needed| will necessarily be false
*/
27276 t
= mp_proto_dependent
;
27277 v
= mp_p_over_v
(mp
, v
, unity_t
, mp_dependent
, mp_proto_dependent
);
27279 if
(s
== mp_proto_dependent
)
27280 v
= mp_p_plus_q
(mp
, v
, r
, mp_proto_dependent
);
27282 v
= mp_p_plus_fq
(mp
, v
, unity_t
, r
, mp_proto_dependent
, mp_dependent
);
27284 /* Output the answer
, |v|
(which might have become |known|
) */
27286 mp_dep_finish
(mp
, v
, (mp_value_node
) q
, t
);
27288 mp-
>cur_exp.type
= t
;
27289 mp_dep_finish
(mp
, v
, NULL, t
);
27297 @ Here's the current situation
: The dependency list |v| of type |t|
27298 should either be put into the current expression
(if |q
=NULL|
) or
27299 into location |q| within a pair node
(otherwise
). The destination
(|cur_exp|
27300 or |q|
) formerly held a dependency list with the same
27301 final pointer as the list |v|.
27303 @
<Declare the procedure called |dep_finish|@
>=
27304 static void mp_dep_finish
(MP mp
, mp_value_node v
, mp_value_node q
,
27306 mp_value_node p
; /* the destination
*/
27308 p
= (mp_value_node
) cur_exp_node
();
27311 set_dep_list
(p
, v
);
27313 if
(dep_info
(v
) == NULL) {
27314 mp_number vv
; /* the value
, if it is |known|
*/
27316 number_clone
(vv
, value_number
(v
));
27319 memset
(&new_expr,0,sizeof(mp_value));
27320 new_number
(new_expr.data.n
);
27321 number_clone
(new_expr.data.n
, vv
);
27322 mp_flush_cur_exp
(mp
, new_expr
);
27324 mp_recycle_value
(mp
, (mp_node
) p
);
27325 mp_type
(q
) = mp_known
;
27326 set_value_number
(q
, vv
);
27329 } else if
(q
== NULL) {
27330 mp-
>cur_exp.type
= t
;
27332 if
(mp-
>fix_needed
)
27333 mp_fix_dependencies
(mp
);
27336 @ @
<Declare binary action...@
>=
27337 static void mp_dep_mult
(MP mp
, mp_value_node p
, mp_number v
, boolean v_is_scaled
) {
27338 mp_value_node q
; /* the dependency list being multiplied by |v|
*/
27339 quarterword s
, t
; /* its type
, before and after
*/
27341 q
= (mp_value_node
) cur_exp_node
();
27342 } else if
(mp_type
(p
) != mp_known
) {
27346 mp_number r1
, arg1
;
27348 number_clone
(arg1
, dep_value
(p
));
27351 take_scaled
(r1
, arg1
, v
);
27354 take_fraction
(r1
, arg1
, v
);
27356 set_dep_value
(p
, r1
);
27358 free_number
(arg1
);
27363 q
= (mp_value_node
) dep_list
(q
);
27365 if
(t
== mp_dependent
) {
27367 mp_number ab_vs_cd
;
27368 mp_number arg1
, arg2
;
27369 new_number
(ab_vs_cd
);
27371 new_fraction
(arg1
);
27372 mp_max_coef
(mp
, &arg1, q);
27373 number_clone
(arg2
, v
);
27375 ab_vs_cd
(ab_vs_cd
, arg1
, arg2
, coef_bound_minus_1
, unity_t
);
27376 free_number
(arg1
);
27377 free_number
(arg2
);
27378 if
(number_nonnegative
(ab_vs_cd
)) {
27379 t
= mp_proto_dependent
;
27381 free_number
(ab_vs_cd
);
27384 q
= mp_p_times_v
(mp
, q
, v
, s
, t
, v_is_scaled
);
27385 mp_dep_finish
(mp
, q
, p
, t
);
27389 @ Here is a routine that is similar to |times|
; but it is invoked only
27390 internally
, when |v| is a |fraction| whose magnitude is at most~
1,
27391 and when |cur_type
>=mp_color_type|.
27394 static void mp_frac_mult
(MP mp
, mp_number n
, mp_number d
) {
27395 /* multiplies |cur_exp| by |n
/d|
*/
27396 mp_node old_exp
; /* a capsule to recycle
*/
27397 mp_number v
; /* |n
/d|
*/
27399 if
(number_greater
(internal_value
(mp_tracing_commands
), two_t
)) {
27400 @
<Trace the fraction multiplication@
>;
27402 switch
(mp-
>cur_exp.type
) {
27403 case mp_transform_type
:
27404 case mp_color_type
:
27405 case mp_cmykcolor_type
:
27407 old_exp
= mp_tarnished
(mp
, cur_exp_node
());
27409 case mp_independent
:
27416 if
(old_exp
!= NULL) {
27417 old_exp
= cur_exp_node
();
27418 mp_make_exp_copy
(mp
, old_exp
);
27420 make_fraction
(v
, n
, d
);
27421 if
(mp-
>cur_exp.type
== mp_known
) {
27422 mp_number r1
, arg1
;
27425 number_clone
(arg1
, cur_exp_value_number
());
27426 take_fraction
(r1
, arg1
, v
);
27427 set_cur_exp_value_number
(r1
);
27429 free_number
(arg1
);
27430 } else if
(mp-
>cur_exp.type
== mp_pair_type
) {
27431 mp_dep_mult
(mp
, (mp_value_node
) x_part
(value_node
(cur_exp_node
())), v
, false
);
27432 mp_dep_mult
(mp
, (mp_value_node
) y_part
(value_node
(cur_exp_node
())), v
, false
);
27433 } else if
(mp-
>cur_exp.type
== mp_color_type
) {
27434 mp_dep_mult
(mp
, (mp_value_node
) red_part
(value_node
(cur_exp_node
())), v
, false
);
27435 mp_dep_mult
(mp
, (mp_value_node
) green_part
(value_node
(cur_exp_node
())), v
, false
);
27436 mp_dep_mult
(mp
, (mp_value_node
) blue_part
(value_node
(cur_exp_node
())), v
, false
);
27437 } else if
(mp-
>cur_exp.type
== mp_cmykcolor_type
) {
27438 mp_dep_mult
(mp
, (mp_value_node
) cyan_part
(value_node
(cur_exp_node
())), v
, false
);
27439 mp_dep_mult
(mp
, (mp_value_node
) magenta_part
(value_node
(cur_exp_node
())), v
, false
);
27440 mp_dep_mult
(mp
, (mp_value_node
) yellow_part
(value_node
(cur_exp_node
())), v
, false
);
27441 mp_dep_mult
(mp
, (mp_value_node
) black_part
(value_node
(cur_exp_node
())), v
, false
);
27443 mp_dep_mult
(mp
, NULL, v
, false
);
27445 if
(old_exp
!= NULL) {
27446 mp_recycle_value
(mp
, old_exp
);
27447 mp_free_value_node
(mp
, old_exp
);
27453 @ @
<Trace the fraction multiplication@
>=
27455 mp_begin_diagnostic
(mp
);
27456 mp_print_nl
(mp
, "{(");
27458 mp_print_char
(mp
, xord
('
/'
));
27460 mp_print
(mp
, ")*(");
27461 mp_print_exp
(mp
, NULL, 0);
27462 mp_print
(mp
, ")}");
27463 mp_end_diagnostic
(mp
, false
);
27467 @ The |hard_times| routine multiplies a nice color or pair by a dependency list.
27469 @
<Declare binary action procedures@
>=
27470 static void mp_hard_times
(MP mp
, mp_node p
) {
27471 mp_value_node q
; /* a copy of the dependent variable |p|
*/
27472 mp_value_node pp
; /* for typecasting p
*/
27473 mp_node r
; /* a component of the big node for the nice color or pair
*/
27474 mp_number v
; /* the known value for |r|
*/
27476 if
(mp_type
(p
) <= mp_pair_type
) {
27477 q
= (mp_value_node
) mp_stash_cur_exp
(mp
);
27478 mp_unstash_cur_exp
(mp
, p
);
27480 } /* now |cur_type
=mp_pair_type| or |cur_type
=mp_color_type| or |cur_type
=mp_cmykcolor_type|
*/
27481 pp
= (mp_value_node
) p
;
27482 if
(mp-
>cur_exp.type
== mp_pair_type
) {
27483 r
= x_part
(value_node
(cur_exp_node
()));
27484 number_clone
(v
, value_number
(r
));
27485 mp_new_dep
(mp
, r
, mp_type
(pp
),
27486 mp_copy_dep_list
(mp
, (mp_value_node
) dep_list
(pp
)));
27487 mp_dep_mult
(mp
, (mp_value_node
) r
, v
, true
);
27488 r
= y_part
(value_node
(cur_exp_node
()));
27489 number_clone
(v
, value_number
(r
));
27490 mp_new_dep
(mp
, r
, mp_type
(pp
),
27491 mp_copy_dep_list
(mp
, (mp_value_node
) dep_list
(pp
)));
27492 mp_dep_mult
(mp
, (mp_value_node
) r
, v
, true
);
27493 } else if
(mp-
>cur_exp.type
== mp_color_type
) {
27494 r
= red_part
(value_node
(cur_exp_node
()));
27495 number_clone
(v
, value_number
(r
));
27496 mp_new_dep
(mp
, r
, mp_type
(pp
),
27497 mp_copy_dep_list
(mp
, (mp_value_node
) dep_list
(pp
)));
27498 mp_dep_mult
(mp
, (mp_value_node
) r
, v
, true
);
27499 r
= green_part
(value_node
(cur_exp_node
()));
27500 number_clone
(v
, value_number
(r
));
27501 mp_new_dep
(mp
, r
, mp_type
(pp
),
27502 mp_copy_dep_list
(mp
, (mp_value_node
) dep_list
(pp
)));
27503 mp_dep_mult
(mp
, (mp_value_node
) r
, v
, true
);
27504 r
= blue_part
(value_node
(cur_exp_node
()));
27505 number_clone
(v
, value_number
(r
));
27506 mp_new_dep
(mp
, r
, mp_type
(pp
),
27507 mp_copy_dep_list
(mp
, (mp_value_node
) dep_list
(pp
)));
27508 mp_dep_mult
(mp
, (mp_value_node
) r
, v
, true
);
27509 } else if
(mp-
>cur_exp.type
== mp_cmykcolor_type
) {
27510 r
= cyan_part
(value_node
(cur_exp_node
()));
27511 number_clone
(v
, value_number
(r
));
27512 mp_new_dep
(mp
, r
, mp_type
(pp
),
27513 mp_copy_dep_list
(mp
, (mp_value_node
) dep_list
(pp
)));
27514 mp_dep_mult
(mp
, (mp_value_node
) r
, v
, true
);
27515 r
= yellow_part
(value_node
(cur_exp_node
()));
27516 number_clone
(v
, value_number
(r
));
27517 mp_new_dep
(mp
, r
, mp_type
(pp
),
27518 mp_copy_dep_list
(mp
, (mp_value_node
) dep_list
(pp
)));
27519 mp_dep_mult
(mp
, (mp_value_node
) r
, v
, true
);
27520 r
= magenta_part
(value_node
(cur_exp_node
()));
27521 number_clone
(v
, value_number
(r
));
27522 mp_new_dep
(mp
, r
, mp_type
(pp
),
27523 mp_copy_dep_list
(mp
, (mp_value_node
) dep_list
(pp
)));
27524 mp_dep_mult
(mp
, (mp_value_node
) r
, v
, true
);
27525 r
= black_part
(value_node
(cur_exp_node
()));
27526 number_clone
(v
, value_number
(r
));
27527 mp_new_dep
(mp
, r
, mp_type
(pp
),
27528 mp_copy_dep_list
(mp
, (mp_value_node
) dep_list
(pp
)));
27529 mp_dep_mult
(mp
, (mp_value_node
) r
, v
, true
);
27534 @ @
<Declare binary action...@
>=
27535 static void mp_dep_div
(MP mp
, mp_value_node p
, mp_number v
) {
27536 mp_value_node q
; /* the dependency list being divided by |v|
*/
27537 quarterword s
, t
; /* its type
, before and after
*/
27539 q
= (mp_value_node
) cur_exp_node
();
27540 else if
(mp_type
(p
) != mp_known
)
27545 make_scaled
(ret
, value_number
(p
), v
);
27546 set_value_number
(p
, ret
);
27551 q
= (mp_value_node
) dep_list
(q
);
27553 if
(t
== mp_dependent
) {
27554 mp_number ab_vs_cd
;
27555 mp_number arg1
, arg2
;
27556 new_number
(ab_vs_cd
);
27558 new_fraction
(arg1
);
27559 mp_max_coef
(mp
, &arg1, q);
27560 number_clone
(arg2
, v
);
27562 ab_vs_cd
(ab_vs_cd
, arg1
, unity_t
, coef_bound_minus_1
, arg2
);
27563 free_number
(arg1
);
27564 free_number
(arg2
);
27565 if
(number_nonnegative
(ab_vs_cd
)) {
27566 t
= mp_proto_dependent
;
27568 free_number
(ab_vs_cd
);
27570 q
= mp_p_over_v
(mp
, q
, v
, s
, t
);
27571 mp_dep_finish
(mp
, q
, p
, t
);
27574 @ Let |c| be one of the eight transform operators. The procedure call
27575 |set_up_trans
(c
)| first changes |cur_exp| to a transform that corresponds to
27576 |c| and the original value of |cur_exp|.
(In particular
, |cur_exp| doesn't
27577 change at all if |c
=transformed_by|.
)
27579 Then
, if all components of the resulting transform are |known|
, they are
27580 moved to the global variables |txx|
, |txy|
, |tyx|
, |tyy|
, |tx|
, |ty|
;
27581 and |cur_exp| is changed to the known value zero.
27583 @
<Declare binary action...@
>=
27584 static void mp_set_up_trans
(MP mp
, quarterword c
) {
27585 mp_node p
, q
, r
; /* list manipulation registers
*/
27587 memset
(&new_expr,0,sizeof(mp_value));
27588 if
((c
!= mp_transformed_by
) ||
(mp-
>cur_exp.type
!= mp_transform_type
)) {
27589 /* Put the current transform into |cur_exp|
*/
27590 const char
*hlp
[] = {
27591 "The expression shown above has the wrong type,",
27592 "so I can\'t transform anything using it.",
27593 "Proceed, and I'll omit the transformation.",
27595 p
= mp_stash_cur_exp
(mp
);
27596 set_cur_exp_node
(mp_id_transform
(mp
));
27597 mp-
>cur_exp.type
= mp_transform_type
;
27598 q
= value_node
(cur_exp_node
());
27600 @
<For each of the eight cases
, change the relevant fields of |cur_exp|
27602 but do nothing if capsule |p| doesn't have the appropriate type@
>;
27603 }; /* there are no other cases
*/
27604 mp_disp_err
(mp
, p
);
27605 mp_back_error
(mp
, "Improper transformation argument", hlp
, true
);
27606 mp_get_x_next
(mp
);
27608 mp_recycle_value
(mp
, p
);
27609 mp_free_value_node
(mp
, p
);
27612 /* If the current transform is entirely known
, stash it in global variables
;
27613 otherwise |return|
*/
27614 q
= value_node
(cur_exp_node
());
27615 if
(mp_type
(tx_part
(q
)) != mp_known
)
27617 if
(mp_type
(ty_part
(q
)) != mp_known
)
27619 if
(mp_type
(xx_part
(q
)) != mp_known
)
27621 if
(mp_type
(xy_part
(q
)) != mp_known
)
27623 if
(mp_type
(yx_part
(q
)) != mp_known
)
27625 if
(mp_type
(yy_part
(q
)) != mp_known
)
27627 number_clone
(mp-
>txx
, value_number
(xx_part
(q
)));
27628 number_clone
(mp-
>txy
, value_number
(xy_part
(q
)));
27629 number_clone
(mp-
>tyx
, value_number
(yx_part
(q
)));
27630 number_clone
(mp-
>tyy
, value_number
(yy_part
(q
)));
27631 number_clone
(mp-
>tx
, value_number
(tx_part
(q
)));
27632 number_clone
(mp-
>ty
, value_number
(ty_part
(q
)));
27633 new_number
(new_expr.data.n
);
27634 set_number_to_zero
(new_expr.data.n
);
27635 mp_flush_cur_exp
(mp
, new_expr
);
27645 mp_number ty
; /* current transform coefficients
*/
27647 @ @
<Initialize table...@
>=
27648 new_number
(mp-
>txx
);
27649 new_number
(mp-
>txy
);
27650 new_number
(mp-
>tyx
);
27651 new_number
(mp-
>tyy
);
27652 new_number
(mp-
>tx
);
27653 new_number
(mp-
>ty
);
27655 @ @
<Free table...@
>=
27656 free_number
(mp-
>txx
);
27657 free_number
(mp-
>txy
);
27658 free_number
(mp-
>tyx
);
27659 free_number
(mp-
>tyy
);
27660 free_number
(mp-
>tx
);
27661 free_number
(mp-
>ty
);
27664 @ @
<For each of the eight cases...@
>=
27665 case mp_rotated_by
:
27666 if
(mp_type
(p
) == mp_known
)
27667 @
<Install sines and cosines
, then |goto done|@
>;
27669 case mp_slanted_by
:
27670 if
(mp_type
(p
) > mp_pair_type
) {
27671 mp_install
(mp
, xy_part
(q
), p
);
27676 if
(mp_type
(p
) > mp_pair_type
) {
27677 mp_install
(mp
, xx_part
(q
), p
);
27678 mp_install
(mp
, yy_part
(q
), p
);
27682 case mp_shifted_by
:
27683 if
(mp_type
(p
) == mp_pair_type
) {
27684 r
= value_node
(p
);
27685 mp_install
(mp
, tx_part
(q
), x_part
(r
));
27686 mp_install
(mp
, ty_part
(q
), y_part
(r
));
27691 if
(mp_type
(p
) > mp_pair_type
) {
27692 mp_install
(mp
, xx_part
(q
), p
);
27697 if
(mp_type
(p
) > mp_pair_type
) {
27698 mp_install
(mp
, yy_part
(q
), p
);
27703 if
(mp_type
(p
) == mp_pair_type
)
27704 @
<Install a complex multiplier
, then |goto done|@
>;
27706 case mp_transformed_by
:
27710 @ @
<Install sines and cosines
, then |goto done|@
>=
27712 mp_number n_sin
, n_cos
, arg1
, arg2
;
27715 new_fraction
(n_sin
);
27716 new_fraction
(n_cos
); /* results computed by |n_sin_cos|
*/
27717 number_clone
(arg2
, unity_t
);
27718 number_clone
(arg1
, value_number
(p
));
27719 number_multiply_int
(arg2
, 360);
27720 number_modulo
(arg1
, arg2
);
27721 convert_scaled_to_angle
(arg1
);
27722 n_sin_cos
(arg1
, n_cos
, n_sin
);
27723 fraction_to_round_scaled
(n_sin
);
27724 fraction_to_round_scaled
(n_cos
);
27725 set_value_number
(xx_part
(q
), n_cos
);
27726 set_value_number
(yx_part
(q
), n_sin
);
27727 set_value_number
(xy_part
(q
), value_number
(yx_part
(q
)));
27728 number_negate
(value_number
(xy_part
(q
)));
27729 set_value_number
(yy_part
(q
), value_number
(xx_part
(q
)));
27730 free_number
(arg1
);
27731 free_number
(arg2
);
27732 free_number
(n_sin
);
27733 free_number
(n_cos
);
27738 @ @
<Install a complex multiplier
, then |goto done|@
>=
27740 r
= value_node
(p
);
27741 mp_install
(mp
, xx_part
(q
), x_part
(r
));
27742 mp_install
(mp
, yy_part
(q
), x_part
(r
));
27743 mp_install
(mp
, yx_part
(q
), y_part
(r
));
27744 if
(mp_type
(y_part
(r
)) == mp_known
) {
27745 set_value_number
(y_part
(r
), value_number
(y_part
(r
)));
27746 number_negate
(value_number
(y_part
(r
)));
27748 mp_negate_dep_list
(mp
, (mp_value_node
) dep_list
((mp_value_node
)
27751 mp_install
(mp
, xy_part
(q
), y_part
(r
));
27756 @ Procedure |set_up_known_trans| is like |set_up_trans|
, but it
27757 insists that the transformation be entirely known.
27759 @
<Declare binary action...@
>=
27760 static void mp_set_up_known_trans
(MP mp
, quarterword c
) {
27761 mp_set_up_trans
(mp
, c
);
27762 if
(mp-
>cur_exp.type
!= mp_known
) {
27764 const char
*hlp
[] = {
27765 "I'm unable to apply a partially specified transformation",
27766 "except to a fully known pair or transform.",
27767 "Proceed, and I'll omit the transformation.",
27769 memset
(&new_expr,0,sizeof(mp_value));
27770 new_number
(new_expr.data.n
);
27771 mp_disp_err
(mp
, NULL);
27772 set_number_to_zero
(new_expr.data.n
);
27773 mp_back_error
(mp
,"Transform components aren't all known", hlp
, true
);
27774 mp_get_x_next
(mp
);
27775 mp_flush_cur_exp
(mp
, new_expr
);
27776 set_number_to_unity
(mp-
>txx
);
27777 set_number_to_zero
(mp-
>txy
);
27778 set_number_to_zero
(mp-
>tyx
);
27779 set_number_to_unity
(mp-
>tyy
);
27780 set_number_to_zero
(mp-
>tx
);
27781 set_number_to_zero
(mp-
>ty
);
27786 @ Here's a procedure that applies the transform |txx..ty| to a pair of
27787 coordinates in locations |p| and~|q|.
27789 @
<Declare binary action...@
>=
27790 static void mp_number_trans
(MP mp
, mp_number
*p
, mp_number
*q
) {
27791 mp_number r1
, r2
, v
;
27795 take_scaled
(r1
, *p
, mp-
>txx
);
27796 take_scaled
(r2
, *q
, mp-
>txy
);
27797 number_add
(r1
, r2
);
27798 set_number_from_addition
(v
, r1
, mp-
>tx
);
27799 take_scaled
(r1
, *p
, mp-
>tyx
);
27800 take_scaled
(r2
, *q
, mp-
>tyy
);
27801 number_add
(r1
, r2
);
27802 set_number_from_addition
(*q
, r1
, mp-
>ty
);
27803 number_clone
(*p
,v
);
27810 @ The simplest transformation procedure applies a transform to all
27811 coordinates of a path. The |path_trans
(c
)(p
)| macro applies
27812 a transformation defined by |cur_exp| and the transform operator |c|
27815 @d path_trans
(A
,B
) { mp_set_up_known_trans
(mp
, (A
));
27816 mp_unstash_cur_exp
(mp
, (B
));
27817 mp_do_path_trans
(mp
, cur_exp_knot
()); }
27819 @
<Declare binary action...@
>=
27820 static void mp_do_path_trans
(MP mp
, mp_knot p
) {
27821 mp_knot q
; /* list traverser
*/
27824 if
(mp_left_type
(q
) != mp_endpoint
)
27825 mp_number_trans
(mp
, &q->left_x, &q->left_y);
27826 mp_number_trans
(mp
, &q->x_coord, &q->y_coord);
27827 if
(mp_right_type
(q
) != mp_endpoint
)
27828 mp_number_trans
(mp
, &q->right_x, &q->right_y);
27829 q
= mp_next_knot
(q
);
27834 @ Transforming a pen is very similar
, except that there are no |mp_left_type|
27835 and |mp_right_type| fields.
27837 @d pen_trans
(A
,B
) { mp_set_up_known_trans
(mp
, (A
));
27838 mp_unstash_cur_exp
(mp
, (B
));
27839 mp_do_pen_trans
(mp
, cur_exp_knot
()); }
27841 @
<Declare binary action...@
>=
27842 static void mp_do_pen_trans
(MP mp
, mp_knot p
) {
27843 mp_knot q
; /* list traverser
*/
27844 if
(pen_is_elliptical
(p
)) {
27845 mp_number_trans
(mp
, &p->left_x, &p->left_y);
27846 mp_number_trans
(mp
, &p->right_x, &p->right_y);
27850 mp_number_trans
(mp
, &q->x_coord, &q->y_coord);
27851 q
= mp_next_knot
(q
);
27856 @ The next transformation procedure applies to edge structures. It will do
27857 any transformation
, but the results may be substandard if the picture contains
27858 text that uses downloaded bitmap fonts. The binary action procedure is
27859 |do_edges_trans|
, but we also need a function that just scales a picture.
27860 That routine is |scale_edges|. Both it and the underlying routine |edges_trans|
27861 should be thought of as procedures that update an edge structure |h|
, except
27862 that they have to return a
(possibly new
) structure because of the need to call
27865 @
<Declare binary action...@
>=
27866 static mp_edge_header_node mp_edges_trans
(MP mp
, mp_edge_header_node h
) {
27867 mp_node q
; /* the object being transformed
*/
27868 mp_dash_node r
, s
; /* for list manipulation
*/
27869 mp_number sx
, sy
; /* saved transformation parameters
*/
27870 mp_number sqdet
; /* square root of determinant for |dash_scale|
*/
27871 mp_number sgndet
; /* sign of the determinant
*/
27872 h
= mp_private_edges
(mp
, h
);
27876 new_number
(sgndet
);
27877 mp_sqrt_det
(mp
, &sqdet, mp->txx, mp->txy, mp->tyx, mp->tyy);
27878 ab_vs_cd
(sgndet
, mp-
>txx
, mp-
>tyy
, mp-
>txy
, mp-
>tyx
);
27879 if
(dash_list
(h
) != mp-
>null_dash
) {
27880 @
<Try to transform the dash list of |h|@
>;
27882 @
<Make the bounding box of |h| unknown if it can't be updated properly
27883 without scanning the whole structure@
>;
27884 q
= mp_link
(edge_list
(h
));
27885 while
(q
!= NULL) {
27886 @
<Transform graphical object |q|@
>;
27891 free_number
(sqdet
);
27892 free_number
(sgndet
);
27895 static void mp_do_edges_trans
(MP mp
, mp_node p
, quarterword c
) {
27896 mp_set_up_known_trans
(mp
, c
);
27897 set_value_node
(p
, (mp_node
)mp_edges_trans
(mp
, (mp_edge_header_node
)value_node
(p
)));
27898 mp_unstash_cur_exp
(mp
, p
);
27900 static mp_edge_header_node mp_scale_edges
(MP mp
, mp_number se_sf
, mp_edge_header_node se_pic
) {
27901 number_clone
(mp-
>txx
, se_sf
);
27902 number_clone
(mp-
>tyy
, se_sf
);
27903 set_number_to_zero
(mp-
>txy
);
27904 set_number_to_zero
(mp-
>tyx
);
27905 set_number_to_zero
(mp-
>tx
);
27906 set_number_to_zero
(mp-
>ty
);
27907 return mp_edges_trans
(mp
, se_pic
);
27911 @ @
<Try to transform the dash list of |h|@
>=
27912 if
(number_nonzero
(mp-
>txy
) || number_nonzero
(mp-
>tyx
) ||
27913 number_nonzero
(mp-
>ty
) || number_nonequalabs
(mp-
>txx
, mp-
>tyy
)) {
27914 mp_flush_dash_list
(mp
, h
);
27916 mp_number abs_tyy
, ret
;
27917 new_number
(abs_tyy
);
27918 if
(number_negative
(mp-
>txx
)) {
27919 @
<Reverse the dash list of |h|@
>;
27921 @
<Scale the dash list by |txx| and shift it by |tx|@
>;
27922 number_clone
(abs_tyy
, mp-
>tyy
);
27923 number_abs
(abs_tyy
);
27925 take_scaled
(ret
, h-
>dash_y
, abs_tyy
);
27926 number_clone
(h-
>dash_y
, ret
);
27928 free_number
(abs_tyy
);
27932 @ @
<Reverse the dash list of |h|@
>=
27935 set_dash_list
(h
, mp-
>null_dash
);
27936 while
(r
!= mp-
>null_dash
) {
27938 r
= (mp_dash_node
)mp_link
(r
);
27939 number_swap
(s-
>start_x
, s-
>stop_x
);
27940 mp_link
(s
) = (mp_node
)dash_list
(h
);
27941 set_dash_list
(h
, s
);
27946 @ @
<Scale the dash list by |txx| and shift it by |tx|@
>=
27951 while
(r
!= mp-
>null_dash
) {
27952 take_scaled
(arg1
, r-
>start_x
, mp-
>txx
);
27953 set_number_from_addition
(r-
>start_x
, arg1
, mp-
>tx
);
27954 take_scaled
(arg1
, r-
>stop_x
, mp-
>txx
);
27955 set_number_from_addition
(r-
>stop_x
, arg1
, mp-
>tx
);
27956 r
= (mp_dash_node
)mp_link
(r
);
27958 free_number
(arg1
);
27962 @ @
<Make the bounding box of |h| unknown if it can't be updated properly...@
>=
27963 if
(number_zero
(mp-
>txx
) && number_zero(mp->tyy)) {
27964 @
<Swap the $x$ and $y$ parameters in the bounding box of |h|@
>;
27965 } else if
(number_nonzero
(mp-
>txy
) || number_nonzero
(mp-
>tyx
)) {
27966 mp_init_bbox
(mp
, h
);
27969 if
(number_lessequal
(h-
>minx
, h-
>maxx
)) {
27970 @
<Scale the bounding box by |txx
+txy| and |tyx
+tyy|
; then shift by
27976 @ @
<Swap the $x$ and $y$ parameters in the bounding box of |h|@
>=
27978 number_swap
(h-
>minx
, h-
>miny
);
27979 number_swap
(h-
>maxx
, h-
>maxy
);
27983 @ The sum ``|txx
+txy|'' is whichever of |txx| or |txy| is nonzero. The other
27986 @
<Scale the bounding box by |txx
+txy| and |tyx
+tyy|
; then shift...@
>=
27988 mp_number tot
, ret
;
27991 set_number_from_addition
(tot
,mp-
>txx
,mp-
>txy
);
27992 take_scaled
(ret
, h-
>minx
, tot
);
27993 set_number_from_addition
(h-
>minx
,ret
, mp-
>tx
);
27994 take_scaled
(ret
, h-
>maxx
, tot
);
27995 set_number_from_addition
(h-
>maxx
,ret
, mp-
>tx
);
27997 set_number_from_addition
(tot
,mp-
>tyx
,mp-
>tyy
);
27998 take_scaled
(ret
, h-
>miny
, tot
);
27999 set_number_from_addition
(h-
>miny
, ret
, mp-
>ty
);
28000 take_scaled
(ret
, h-
>maxy
, tot
);
28001 set_number_from_addition
(h-
>maxy
, ret
, mp-
>ty
);
28003 set_number_from_addition
(tot
, mp-
>txx
, mp-
>txy
);
28004 if
(number_negative
(tot
)) {
28005 number_swap
(h-
>minx
, h-
>maxx
);
28007 set_number_from_addition
(tot
, mp-
>tyx
, mp-
>tyy
);
28008 if
(number_negative
(tot
)) {
28009 number_swap
(h-
>miny
, h-
>maxy
);
28016 @ Now we ready for the main task of transforming the graphical objects in edge
28019 @
<Transform graphical object |q|@
>=
28020 switch
(mp_type
(q
)) {
28021 case mp_fill_node_type
:
28023 mp_fill_node qq
= (mp_fill_node
) q
;
28024 mp_do_path_trans
(mp
, mp_path_p
(qq
));
28025 @
<Transform |mp_pen_p
(qq
)|
, making sure polygonal pens stay counter-clockwise@
>;
28028 case mp_stroked_node_type
:
28030 mp_stroked_node qq
= (mp_stroked_node
) q
;
28031 mp_do_path_trans
(mp
, mp_path_p
(qq
));
28032 @
<Transform |mp_pen_p
(qq
)|
, making sure polygonal pens stay counter-clockwise@
>;
28035 case mp_start_clip_node_type
:
28036 mp_do_path_trans
(mp
, mp_path_p
((mp_start_clip_node
) q
));
28038 case mp_start_bounds_node_type
:
28039 mp_do_path_trans
(mp
, mp_path_p
((mp_start_bounds_node
) q
));
28041 case mp_text_node_type
:
28042 @
<Transform the compact transformation@
>;
28044 case mp_stop_clip_node_type
:
28045 case mp_stop_bounds_node_type
:
28047 default
: /* there are no other valid cases
, but please the compiler
*/
28052 @ Note that the shift parameters |
(tx
,ty
)| apply only to the path being stroked.
28053 The |dash_scale| has to be adjusted to scale the dash lengths in |mp_dash_p
(q
)|
28054 since the \ps\ output procedures will try to compensate for the transformation
28055 we are applying to |mp_pen_p
(q
)|. Since this compensation is based on the square
28056 root of the determinant
, |sqdet| is the appropriate factor.
28058 We pass the mptrap test only if |dash_scale| is not adjusted
, nowadays
28059 (backend is changed?
)
28061 @
<Transform |mp_pen_p
(qq
)|
, making sure...@
>=
28062 if
(mp_pen_p
(qq
) != NULL) {
28063 number_clone
(sx
, mp-
>tx
);
28064 number_clone
(sy
, mp-
>ty
);
28065 set_number_to_zero
(mp-
>tx
);
28066 set_number_to_zero
(mp-
>ty
);
28067 mp_do_pen_trans
(mp
, mp_pen_p
(qq
));
28068 if
(number_nonzero
(sqdet
)
28069 && ((mp_type (q) == mp_stroked_node_type) && (mp_dash_p (q) != NULL))) {
28072 take_scaled
(ret
, ((mp_stroked_node
)q
)->dash_scale
, sqdet
);
28073 number_clone
(((mp_stroked_node
)q
)->dash_scale
, ret
);
28076 if
(!pen_is_elliptical
(mp_pen_p
(qq
)))
28077 if
(number_negative
(sgndet
))
28078 mp_pen_p
(qq
) = mp_make_pen
(mp
, mp_copy_path
(mp
, mp_pen_p
(qq
)), true
);
28079 /* this unreverses the pen
*/
28080 number_clone
(mp-
>tx
, sx
);
28081 number_clone
(mp-
>ty
, sy
);
28084 @ @
<Transform the compact transformation@
>=
28085 mp_number_trans
(mp
, &((mp_text_node)q)->tx, &((mp_text_node)q)->ty);
28086 number_clone
(sx
, mp-
>tx
);
28087 number_clone
(sy
, mp-
>ty
);
28088 set_number_to_zero
(mp-
>tx
);
28089 set_number_to_zero
(mp-
>ty
);
28090 mp_number_trans
(mp
, &((mp_text_node)q)->txx, &((mp_text_node)q)->tyx);
28091 mp_number_trans
(mp
, &((mp_text_node)q)->txy, &((mp_text_node)q)->tyy);
28092 number_clone
(mp-
>tx
, sx
);
28093 number_clone
(mp-
>ty
, sy
)
28095 @ The hard cases of transformation occur when big nodes are involved
,
28096 and when some of their components are unknown.
28098 @
<Declare binary action...@
>=
28099 @
<Declare subroutines needed by |big_trans|@
>;
28100 static void mp_big_trans
(MP mp
, mp_node p
, quarterword c
) {
28101 mp_node q
, r
, pp
, qq
; /* list manipulation registers
*/
28102 q
= value_node
(p
);
28103 if
(mp_type
(q
) == mp_pair_node_type
) {
28104 if
(mp_type
(x_part
(q
)) != mp_known ||
28105 mp_type
(y_part
(q
)) != mp_known
) {
28106 @
<Transform an unknown big node and |return|@
>;
28108 } else
{ /* |mp_transform_type|
*/
28109 if
(mp_type
(tx_part
(q
)) != mp_known ||
28110 mp_type
(ty_part
(q
)) != mp_known ||
28111 mp_type
(xx_part
(q
)) != mp_known ||
28112 mp_type
(xy_part
(q
)) != mp_known ||
28113 mp_type
(yx_part
(q
)) != mp_known ||
28114 mp_type
(yy_part
(q
)) != mp_known
) {
28115 @
<Transform an unknown big node and |return|@
>;
28118 @
<Transform a known big node@
>;
28119 } /* node |p| will now be recycled by |do_binary|
*/
28122 @ @
<Transform an unknown big node and |return|@
>=
28124 mp_set_up_known_trans
(mp
, c
);
28125 mp_make_exp_copy
(mp
, p
);
28126 r
= value_node
(cur_exp_node
());
28127 if
(mp-
>cur_exp.type
== mp_transform_type
) {
28128 mp_bilin1
(mp
, yy_part
(r
), mp-
>tyy
, xy_part
(q
), mp-
>tyx
, zero_t
);
28129 mp_bilin1
(mp
, yx_part
(r
), mp-
>tyy
, xx_part
(q
), mp-
>tyx
, zero_t
);
28130 mp_bilin1
(mp
, xy_part
(r
), mp-
>txx
, yy_part
(q
), mp-
>txy
, zero_t
);
28131 mp_bilin1
(mp
, xx_part
(r
), mp-
>txx
, yx_part
(q
), mp-
>txy
, zero_t
);
28133 mp_bilin1
(mp
, y_part
(r
), mp-
>tyy
, x_part
(q
), mp-
>tyx
, mp-
>ty
);
28134 mp_bilin1
(mp
, x_part
(r
), mp-
>txx
, y_part
(q
), mp-
>txy
, mp-
>tx
);
28139 @ Let |p| point to a value field inside a big node of |cur_exp|
,
28140 and let |q| point to a another value field. The |bilin1| procedure
28141 replaces |p| by $p\cdot t
+q\cdot u
+\delta$.
28143 @
<Declare subroutines needed by |big_trans|@
>=
28144 static void mp_bilin1
(MP mp
, mp_node p
, mp_number t
, mp_node q
,
28145 mp_number u
, mp_number delta_orig
) {
28147 new_number
(delta
);
28148 number_clone
(delta
, delta_orig
);
28149 if
(!number_equal
(t
, unity_t
)) {
28150 mp_dep_mult
(mp
, (mp_value_node
) p
, t
, true
);
28152 if
(number_nonzero
(u
)) {
28153 if
(mp_type
(q
) == mp_known
) {
28156 take_scaled
(tmp
, value_number
(q
), u
);
28157 number_add
(delta
, tmp
);
28160 /* Ensure that |type
(p
)=mp_proto_dependent|
*/
28161 if
(mp_type
(p
) != mp_proto_dependent
) {
28162 if
(mp_type
(p
) == mp_known
) {
28163 mp_new_dep
(mp
, p
, mp_type
(p
), mp_const_dependency
(mp
, value_number
(p
)));
28165 set_dep_list
((mp_value_node
) p
,
28167 (mp_value_node
) dep_list
((mp_value_node
)
28169 mp_dependent
, mp_proto_dependent
, true
));
28171 mp_type
(p
) = mp_proto_dependent
;
28173 set_dep_list
((mp_value_node
) p
,
28175 (mp_value_node
) dep_list
((mp_value_node
) p
), u
,
28176 (mp_value_node
) dep_list
((mp_value_node
) q
),
28177 mp_proto_dependent
, mp_type
(q
)));
28180 if
(mp_type
(p
) == mp_known
) {
28181 set_value_number
(p
, value_number
(p
));
28182 number_add
(value_number
(p
), delta
);
28185 mp_value_node r
; /* list traverser
*/
28187 r
= (mp_value_node
) dep_list
((mp_value_node
) p
);
28188 while
(dep_info
(r
) != NULL)
28189 r
= (mp_value_node
) mp_link
(r
);
28190 number_clone
(tmp
, value_number
(r
));
28191 number_add
(delta
, tmp
);
28192 if
(r
!= (mp_value_node
) dep_list
((mp_value_node
) p
))
28193 set_value_number
(r
, delta
);
28195 mp_recycle_value
(mp
, p
);
28196 mp_type
(p
) = mp_known
;
28197 set_value_number
(p
, delta
);
28201 if
(mp-
>fix_needed
)
28202 mp_fix_dependencies
(mp
);
28203 free_number
(delta
);
28207 @ @
<Transform a known big node@
>=
28208 mp_set_up_trans
(mp
, c
);
28209 if
(mp-
>cur_exp.type
== mp_known
) {
28210 @
<Transform known by known@
>;
28212 pp
= mp_stash_cur_exp
(mp
);
28213 qq
= value_node
(pp
);
28214 mp_make_exp_copy
(mp
, p
);
28215 r
= value_node
(cur_exp_node
());
28216 if
(mp-
>cur_exp.type
== mp_transform_type
) {
28217 mp_bilin2
(mp
, yy_part
(r
), yy_part
(qq
), value_number
(xy_part
(q
)),
28218 yx_part
(qq
), NULL);
28219 mp_bilin2
(mp
, yx_part
(r
), yy_part
(qq
), value_number
(xx_part
(q
)),
28220 yx_part
(qq
), NULL);
28221 mp_bilin2
(mp
, xy_part
(r
), xx_part
(qq
), value_number
(yy_part
(q
)),
28222 xy_part
(qq
), NULL);
28223 mp_bilin2
(mp
, xx_part
(r
), xx_part
(qq
), value_number
(yx_part
(q
)),
28224 xy_part
(qq
), NULL);
28226 mp_bilin2
(mp
, y_part
(r
), yy_part
(qq
), value_number
(x_part
(q
)),
28227 yx_part
(qq
), y_part
(qq
));
28228 mp_bilin2
(mp
, x_part
(r
), xx_part
(qq
), value_number
(y_part
(q
)),
28229 xy_part
(qq
), x_part
(qq
));
28230 mp_recycle_value
(mp
, pp
);
28231 mp_free_value_node
(mp
, pp
);
28235 @ Let |p| be a |mp_proto_dependent| value whose dependency list ends
28236 at |dep_final|. The following procedure adds |v| times another
28237 numeric quantity to~|p|.
28239 @
<Declare subroutines needed by |big_trans|@
>=
28240 static void mp_add_mult_dep
(MP mp
, mp_value_node p
, mp_number v
, mp_node r
) {
28241 if
(mp_type
(r
) == mp_known
) {
28244 take_scaled
(ret
, value_number
(r
), v
);
28245 set_dep_value
(mp-
>dep_final
, dep_value
(mp-
>dep_final
));
28246 number_add
(dep_value
(mp-
>dep_final
), ret
);
28250 mp_p_plus_fq
(mp
, (mp_value_node
) dep_list
(p
), v
,
28251 (mp_value_node
) dep_list
((mp_value_node
) r
),
28252 mp_proto_dependent
, mp_type
(r
)));
28253 if
(mp-
>fix_needed
)
28254 mp_fix_dependencies
(mp
);
28259 @ The |bilin2| procedure is something like |bilin1|
, but with known
28260 and unknown quantities reversed. Parameter |p| points to a value field
28261 within the big node for |cur_exp|
; and |type
(p
)=mp_known|. Parameters
28262 |t| and~|u| point to value fields elsewhere
; so does parameter~|q|
,
28263 unless it is |
NULL|
(which stands for zero
). Location~|p| will be
28264 replaced by $p\cdot t
+v\cdot u
+q$.
28266 @
<Declare subroutines needed by |big_trans|@
>=
28267 static void mp_bilin2
(MP mp
, mp_node p
, mp_node t
, mp_number v
,
28268 mp_node u
, mp_node q
) {
28269 mp_number vv
; /* temporary storage for |value
(p
)|
*/
28271 number_clone
(vv
, value_number
(p
));
28272 mp_new_dep
(mp
, p
, mp_proto_dependent
, mp_const_dependency
(mp
, zero_t
)); /* this sets |dep_final|
*/
28273 if
(number_nonzero
(vv
)) {
28274 mp_add_mult_dep
(mp
, (mp_value_node
) p
, vv
, t
); /* |dep_final| doesn't change
*/
28276 if
(number_nonzero
(v
)) {
28279 number_clone
(arg1
, v
);
28280 mp_add_mult_dep
(mp
, (mp_value_node
) p
, arg1
, u
);
28281 free_number
(arg1
);
28284 mp_add_mult_dep
(mp
, (mp_value_node
) p
, unity_t
, q
);
28285 if
(dep_list
((mp_value_node
) p
) == (mp_node
) mp-
>dep_final
) {
28286 number_clone
(vv
, dep_value
(mp-
>dep_final
));
28287 mp_recycle_value
(mp
, p
);
28288 mp_type
(p
) = mp_known
;
28289 set_value_number
(p
, vv
);
28295 @ @
<Transform known by known@
>=
28297 mp_make_exp_copy
(mp
, p
);
28298 r
= value_node
(cur_exp_node
());
28299 if
(mp-
>cur_exp.type
== mp_transform_type
) {
28300 mp_bilin3
(mp
, yy_part
(r
), mp-
>tyy
, value_number
(xy_part
(q
)), mp-
>tyx
, zero_t
);
28301 mp_bilin3
(mp
, yx_part
(r
), mp-
>tyy
, value_number
(xx_part
(q
)), mp-
>tyx
, zero_t
);
28302 mp_bilin3
(mp
, xy_part
(r
), mp-
>txx
, value_number
(yy_part
(q
)), mp-
>txy
, zero_t
);
28303 mp_bilin3
(mp
, xx_part
(r
), mp-
>txx
, value_number
(yx_part
(q
)), mp-
>txy
, zero_t
);
28305 mp_bilin3
(mp
, y_part
(r
), mp-
>tyy
, value_number
(x_part
(q
)), mp-
>tyx
, mp-
>ty
);
28306 mp_bilin3
(mp
, x_part
(r
), mp-
>txx
, value_number
(y_part
(q
)), mp-
>txy
, mp-
>tx
);
28310 @ Finally
, in |bilin3| everything is |known|.
28312 @
<Declare subroutines needed by |big_trans|@
>=
28313 static void mp_bilin3
(MP mp
, mp_node p
, mp_number t
,
28314 mp_number v
, mp_number u
, mp_number delta_orig
) {
28318 new_number
(delta
);
28319 number_clone
(delta
, delta_orig
);
28320 if
(!number_equal
(t
, unity_t
)) {
28321 take_scaled
(tmp
, value_number
(p
), t
);
28323 number_clone
(tmp
, value_number
(p
));
28325 number_add
(delta
, tmp
);
28326 if
(number_nonzero
(u
)) {
28329 take_scaled
(ret
, v
, u
);
28330 set_value_number
(p
, delta
);
28331 number_add
(value_number
(p
), ret
);
28334 set_value_number
(p
, delta
);
28336 free_number
(delta
);
28340 @ @
<Declare binary action...@
>=
28341 static void mp_chop_path
(MP mp
, mp_node p
) {
28342 mp_knot q
; /* a knot in the original path
*/
28343 mp_knot pp
, qq
, rr
, ss
; /* link variables for copies of path nodes
*/
28344 mp_number a
, b
; /* indices for chopping
*/
28346 boolean reversed
; /* was |a
>b|?
*/
28350 mp_path_length
(mp
, &l);
28351 number_clone
(a
, value_number
(x_part
(p
)));
28352 number_clone
(b
, value_number
(y_part
(p
)));
28353 if
(number_lessequal
(a
, b
)) {
28357 number_swap
(a
, b
);
28359 /* Dispense with the cases |a
<0| and
/or |b
>l|
*/
28360 if
(number_negative
(a
)) {
28361 if
(mp_left_type
(cur_exp_knot
()) == mp_endpoint
) {
28362 set_number_to_zero
(a
);
28363 if
(number_negative
(b
))
28364 set_number_to_zero
(b
);
28369 } while
(number_negative
(a
)); /* a cycle always has length |l
>0|
*/
28372 if
(number_greater
(b
, l
)) {
28373 if
(mp_left_type
(cur_exp_knot
()) == mp_endpoint
) {
28374 number_clone
(b
, l
);
28375 if
(number_greater
(a
, l
))
28376 number_clone
(a
, l
);
28378 while
(number_greaterequal
(a
, l
)) {
28379 number_substract
(a
, l
);
28380 number_substract
(b
, l
);
28385 q
= cur_exp_knot
();
28386 while
(number_greaterequal
(a
, unity_t
)) {
28387 q
= mp_next_knot
(q
);
28388 number_substract
(a
, unity_t
);
28389 number_substract
(b
, unity_t
);
28391 if
(number_equal
(b
, a
)) {
28392 /* Construct a path from |pp| to |qq| of length zero
*/
28393 if
(number_positive
(a
)) {
28396 number_clone
(arg1
, a
);
28397 convert_scaled_to_fraction
(arg1
);
28398 mp_split_cubic
(mp
, q
, arg1
);
28399 free_number
(arg1
);
28400 q
= mp_next_knot
(q
);
28402 pp
= mp_copy_knot
(mp
, q
);
28406 /* Construct a path from |pp| to |qq| of length $\lceil b\rceil$
*/
28407 pp
= mp_copy_knot
(mp
, q
);
28410 q
= mp_next_knot
(q
);
28412 qq
= mp_copy_knot
(mp
, q
);
28413 mp_next_knot
(rr
) = qq
;
28414 number_substract
(b
, unity_t
);
28415 } while
(number_positive
(b
));
28416 if
(number_positive
(a
)) {
28420 number_clone
(arg1
, a
);
28421 convert_scaled_to_fraction
(arg1
);
28422 mp_split_cubic
(mp
, ss
, arg1
);
28423 free_number
(arg1
);
28424 pp
= mp_next_knot
(ss
);
28425 mp_toss_knot
(mp
, ss
);
28427 mp_number arg1
, arg2
;
28430 set_number_from_substraction
(arg1
, unity_t
, a
);
28431 number_clone
(arg2
, b
);
28432 make_scaled
(b
, arg2
, arg1
);
28433 free_number
(arg1
);
28434 free_number
(arg2
);
28438 if
(number_negative
(b
)) {
28441 set_number_from_addition
(arg1
, b
, unity_t
);
28442 convert_scaled_to_fraction
(arg1
);
28443 mp_split_cubic
(mp
, rr
, arg1
);
28444 free_number
(arg1
);
28445 mp_toss_knot
(mp
, qq
);
28446 qq
= mp_next_knot
(rr
);
28450 mp_left_type
(pp
) = mp_endpoint
;
28451 mp_right_type
(qq
) = mp_endpoint
;
28452 mp_next_knot
(qq
) = pp
;
28453 mp_toss_knot_list
(mp
, cur_exp_knot
());
28455 set_cur_exp_knot
(mp_next_knot
(mp_htap_ypoc
(mp
, pp
)));
28456 mp_toss_knot_list
(mp
, pp
);
28458 set_cur_exp_knot
(pp
);
28466 @ @
<Declare binary action...@
>=
28467 static void mp_set_up_offset
(MP mp
, mp_node p
) {
28468 mp_find_offset
(mp
, value_number
(x_part
(p
)), value_number
(y_part
(p
)),
28470 mp_pair_value
(mp
, mp-
>cur_x
, mp-
>cur_y
);
28472 static void mp_set_up_direction_time
(MP mp
, mp_node p
) {
28474 memset
(&new_expr,0,sizeof(mp_value));
28475 new_number
(new_expr.data.n
);
28476 mp_find_direction_time
(mp
, &new_expr.data.n, value_number (x_part (p)),
28477 value_number
(y_part
(p
)),
28479 mp_flush_cur_exp
(mp
, new_expr
);
28481 static void mp_set_up_envelope
(MP mp
, mp_node p
) {
28482 unsigned char ljoin
, lcap
;
28483 mp_number miterlim
;
28484 mp_knot q
= mp_copy_path
(mp
, cur_exp_knot
()); /* the original path
*/
28485 new_number
(miterlim
);
28486 /* TODO
: accept elliptical pens for straight paths
*/
28487 if
(pen_is_elliptical
(value_knot
(p
))) {
28488 mp_bad_envelope_pen
(mp
);
28489 set_cur_exp_knot
(q
);
28490 mp-
>cur_exp.type
= mp_path_type
;
28493 if
(number_greater
(internal_value
(mp_linejoin
), unity_t
))
28495 else if
(number_positive
(internal_value
(mp_linejoin
)))
28499 if
(number_greater
(internal_value
(mp_linecap
), unity_t
))
28501 else if
(number_positive
(internal_value
(mp_linecap
)))
28505 if
(number_less
(internal_value
(mp_miterlimit
), unity_t
))
28506 set_number_to_unity
(miterlim
);
28508 number_clone
(miterlim
, internal_value
(mp_miterlimit
));
28509 set_cur_exp_knot
(mp_make_envelope
28510 (mp
, q
, value_knot
(p
), ljoin
, lcap
, miterlim
));
28511 mp-
>cur_exp.type
= mp_path_type
;
28515 @ This is pretty straightfoward. The one silly thing is that
28516 the output of |mp_ps_do_font_charstring| has to be un-exported.
28518 @
<Declare binary action...@
>=
28519 static void mp_set_up_glyph_infont
(MP mp
, mp_node p
) {
28520 mp_edge_object
*h
= NULL;
28521 mp_ps_font
*f
= NULL;
28522 char
*n
= mp_str
(mp
, cur_exp_str
());
28523 f
= mp_ps_font_parse
(mp
, (int
) mp_find_font
(mp
, n
));
28525 if
(mp_type
(p
) == mp_known
) {
28526 int v
= round_unscaled
(value_number
(p
));
28527 if
(v
< 0 || v
> 255) {
28529 mp_snprintf
(msg
, 256, "glyph index too high (%d)", v
);
28530 mp_error
(mp
, msg
, NULL, true
);
28532 h
= mp_ps_font_charstring
(mp
, f
, v
);
28535 n
= mp_str
(mp
, value_str
(p
));
28536 h
= mp_ps_do_font_charstring
(mp
, f
, n
);
28538 mp_ps_font_free
(mp
, f
);
28541 set_cur_exp_node
((mp_node
)mp_gr_import
(mp
, h
));
28543 set_cur_exp_node
((mp_node
)mp_get_edge_header_node
(mp
));
28544 mp_init_edges
(mp
, (mp_edge_header_node
)cur_exp_node
());
28546 mp-
>cur_exp.type
= mp_picture_type
;
28550 @ @
<Declare binary action...@
>=
28551 static void mp_find_point
(MP mp
, mp_number v_orig
, quarterword c
) {
28552 mp_knot p
; /* the path
*/
28553 mp_number n
; /* its length
*/
28557 number_clone
(v
, v_orig
);
28558 p
= cur_exp_knot
();
28559 if
(mp_left_type
(p
) == mp_endpoint
) {
28560 set_number_to_unity
(n
);
28563 set_number_to_zero
(n
);
28566 p
= mp_next_knot
(p
);
28567 number_add
(n
, unity_t
);
28568 } while
(p
!= cur_exp_knot
());
28569 if
(number_zero
(n
)) {
28570 set_number_to_zero
(v
);
28571 } else if
(number_negative
(v
)) {
28572 if
(mp_left_type
(p
) == mp_endpoint
) {
28573 set_number_to_zero
(v
);
28575 /* |v
= n
- 1 - ((-v
- 1) % n
)
28576 == - ((-v
- 1) % n
) - 1 + n|
*/
28578 number_add_scaled
(v
, -1);
28579 number_modulo
(v
, n
);
28581 number_add_scaled
(v
, -1);
28584 } else if
(number_greater
(v
, n
)) {
28585 if
(mp_left_type
(p
) == mp_endpoint
)
28586 number_clone
(v
, n
);
28588 number_modulo
(v
, n
);
28590 p
= cur_exp_knot
();
28591 while
(number_greaterequal
(v
, unity_t
)) {
28592 p
= mp_next_knot
(p
);
28593 number_substract
(v
, unity_t
);
28595 if
(number_nonzero
(v
)) {
28596 /* Insert a fractional node by splitting the cubic
*/
28597 convert_scaled_to_fraction
(v
);
28598 mp_split_cubic
(mp
, p
, v
);
28599 p
= mp_next_knot
(p
);
28601 /* Set the current expression to the desired path coordinates
*/
28604 mp_pair_value
(mp
, p-
>x_coord
, p-
>y_coord
);
28606 case mp_precontrol_of
:
28607 if
(mp_left_type
(p
) == mp_endpoint
)
28608 mp_pair_value
(mp
, p-
>x_coord
, p-
>y_coord
);
28610 mp_pair_value
(mp
, p-
>left_x
, p-
>left_y
);
28612 case mp_postcontrol_of
:
28613 if
(mp_right_type
(p
) == mp_endpoint
)
28614 mp_pair_value
(mp
, p-
>x_coord
, p-
>y_coord
);
28616 mp_pair_value
(mp
, p-
>right_x
, p-
>right_y
);
28618 } /* there are no other cases
*/
28623 @ Function |new_text_node| owns the reference count for its second argument
28624 (the text string
) but not its first
(the font name
).
28626 @
<Declare binary action...@
>=
28627 static void mp_do_infont
(MP mp
, mp_node p
) {
28628 mp_edge_header_node q
;
28630 memset
(&new_expr,0,sizeof(mp_value));
28631 new_number
(new_expr.data.n
);
28632 q
= mp_get_edge_header_node
(mp
);
28633 mp_init_edges
(mp
, q
);
28634 add_str_ref
(cur_exp_str
());
28635 mp_link
(obj_tail
(q
)) =
28636 mp_new_text_node
(mp
, mp_str
(mp
, cur_exp_str
()), value_str
(p
));
28637 obj_tail
(q
) = mp_link
(obj_tail
(q
));
28638 mp_free_value_node
(mp
, p
);
28639 new_expr.data.node
= (mp_node
)q
;
28640 mp_flush_cur_exp
(mp
, new_expr
);
28641 mp-
>cur_exp.type
= mp_picture_type
;
28645 @
* Statements and commands.
28646 The chief executive of \MP\ is the |do_statement| routine
, which
28647 contains the master switch that causes all the various pieces of \MP\
28648 to do their things
, in the right order.
28650 In a sense
, this is the grand climax of the program
: It applies all the
28651 tools that we have worked so hard to construct. In another sense
, this is
28652 the messiest part of the program
: It necessarily refers to other pieces
28653 of code all over the place
, so that a person can't fully understand what is
28654 going on without paging back and forth to be reminded of conventions that
28655 are defined elsewhere. We are now at the hub of the web.
28657 The structure of |do_statement| itself is quite simple. The first token
28658 of the statement is fetched using |get_x_next|. If it can be the first
28659 token of an expression
, we look for an equation
, an assignment
, or a
28660 title. Otherwise we use a \
&{case} construction to branch at high speed to
28661 the appropriate routine for various and sundry other types of commands
,
28662 each of which has an ``action procedure'' that does the necessary work.
28664 The program uses the fact that
28665 $$\hbox
{|min_primary_command
=max_statement_command
=type_name|
}$$
28666 to interpret a statement that starts with
, e.g.
, `\
&{string}',
28667 as a type declaration rather than a boolean expression.
28670 static void worry_about_bad_statement
(MP mp
);
28671 static void flush_unparsable_junk_after_statement
(MP mp
);
28672 void mp_do_statement
(MP mp
) { /* governs \MP's activities
*/
28673 mp-
>cur_exp.type
= mp_vacuous
;
28674 mp_get_x_next
(mp
);
28675 if
(cur_cmd
() > mp_max_primary_command
) {
28676 worry_about_bad_statement
(mp
);
28677 } else if
(cur_cmd
() > mp_max_statement_command
) {
28678 /* Do an equation
, assignment
, title
, or
28679 `$\langle\
,$expression$\
,\rangle\
,$\
&{endgroup}'; */
28680 /* The most important statements begin with expressions
*/
28682 mp-
>var_flag
= mp_assignment
;
28683 mp_scan_expression
(mp
);
28684 if
(cur_cmd
() < mp_end_group
) {
28685 if
(cur_cmd
() == mp_equals
)
28686 mp_do_equation
(mp
);
28687 else if
(cur_cmd
() == mp_assignment
)
28688 mp_do_assignment
(mp
);
28689 else if
(mp-
>cur_exp.type
== mp_string_type
) {
28691 if
(number_positive
(internal_value
(mp_tracing_titles
))) {
28692 mp_print_nl
(mp
, "");
28693 mp_print_str
(mp
, cur_exp_str
());
28696 } else if
(mp-
>cur_exp.type
!= mp_vacuous
) {
28697 const char
*hlp
[] = {
28698 "I couldn't find an `=' or `:=' after the",
28699 "expression that is shown above this error message,",
28700 "so I guess I'll just ignore it and carry on.",
28702 mp_disp_err
(mp
, NULL);
28703 mp_back_error
(mp
, "Isolated expression", hlp
, true
);
28704 mp_get_x_next
(mp
);
28706 memset
(&new_expr,0,sizeof(mp_value));
28707 new_number
(new_expr.data.n
);
28708 set_number_to_zero
(new_expr.data.n
);
28709 mp_flush_cur_exp
(mp
, new_expr
);
28710 mp-
>cur_exp.type
= mp_vacuous
;
28713 /* Do a statement that doesn't begin with an expression
*/
28714 /* If |do_statement| ends with |cur_cmd
=end_group|
, we should have
28715 |cur_type
=mp_vacuous| unless the statement was simply an expression
;
28716 in the latter case
, |cur_type| and |cur_exp| should represent that
28718 if
(number_positive
(internal_value
(mp_tracing_commands
)))
28720 switch
(cur_cmd
()) {
28722 mp_do_type_declaration
(mp
);
28725 if
(cur_mod
() > var_def
)
28726 mp_make_op_def
(mp
);
28727 else if
(cur_mod
() > end_def
)
28730 case mp_random_seed
:
28731 mp_do_random_seed
(mp
);
28733 case mp_mode_command
:
28735 mp-
>interaction
= cur_mod
();
28736 initialize_print_selector
();
28737 if
(mp-
>log_opened
)
28738 mp-
>selector
= mp-
>selector
+ 2;
28739 mp_get_x_next
(mp
);
28741 case mp_protection_command
:
28742 mp_do_protection
(mp
);
28744 case mp_delimiters
:
28745 mp_def_delims
(mp
);
28747 case mp_save_command
:
28749 mp_get_symbol
(mp
);
28750 mp_save_variable
(mp
, cur_sym
());
28751 mp_get_x_next
(mp
);
28752 } while
(cur_cmd
() == mp_comma
);
28754 case mp_interim_command
:
28755 mp_do_interim
(mp
);
28757 case mp_let_command
:
28760 case mp_new_internal
:
28761 mp_do_new_internal
(mp
);
28763 case mp_show_command
:
28764 mp_do_show_whatever
(mp
);
28766 case mp_add_to_command
:
28769 case mp_bounds_command
:
28772 case mp_ship_out_command
:
28773 mp_do_ship_out
(mp
);
28775 case mp_every_job_command
:
28776 mp_get_symbol
(mp
);
28777 mp-
>start_sym
= cur_sym
();
28778 mp_get_x_next
(mp
);
28780 case mp_message_command
:
28781 mp_do_message
(mp
);
28783 case mp_write_command
:
28786 case mp_tfm_command
:
28787 mp_do_tfm_command
(mp
);
28789 case mp_special_command
:
28790 if
(cur_mod
() == 0)
28791 mp_do_special
(mp
);
28792 else if
(cur_mod
() == 1)
28793 mp_do_mapfile
(mp
);
28795 mp_do_mapline
(mp
);
28798 break
; /* make the compiler happy
*/
28800 mp-
>cur_exp.type
= mp_vacuous
;
28802 if
(cur_cmd
() < mp_semicolon
)
28803 flush_unparsable_junk_after_statement
(mp
);
28804 mp-
>error_count
= 0;
28808 @ @
<Declarations@
>=
28809 @
<Declare action procedures for use by |do_statement|@
>
28812 @ The only command codes |
>max_primary_command| that can be present
28813 at the beginning of a statement are |semicolon| and higher
; these
28814 occur when the statement is null.
28817 static void worry_about_bad_statement
(MP mp
) {
28818 if
(cur_cmd
() < mp_semicolon
) {
28821 int old_setting
= mp-
>selector
;
28822 const char
*hlp
[] = {
28823 "I was looking for the beginning of a new statement.",
28824 "If you just proceed without changing anything, I'll ignore",
28825 "everything up to the next `;'. Please insert a semicolon",
28826 "now in front of anything that you don't want me to delete.",
28827 "(See Chapter 27 of The METAFONTbook for an example.)",
28829 mp-
>selector
= new_string
;
28830 mp_print_cmd_mod
(mp
, cur_cmd
(), cur_mod
());
28831 sname
= mp_make_string
(mp
);
28832 mp-
>selector
= old_setting
;
28833 mp_snprintf
(msg
, 256, "A statement can't begin with `%s'", mp_str
(mp
, sname
));
28834 delete_str_ref
(sname
);
28835 mp_back_error
(mp
, msg
, hlp
, true
);
28836 mp_get_x_next
(mp
);
28841 @ The help message printed here says that everything is flushed up to
28842 a semicolon
, but actually the commands |end_group| and |stop| will
28843 also terminate a statement.
28846 static void flush_unparsable_junk_after_statement
(MP mp
)
28848 const char
*hlp
[] = {
28849 "I've just read as much of that statement as I could fathom,",
28850 "so a semicolon should have been next. It's very puzzling...",
28851 "but I'll try to get myself back together, by ignoring",
28852 "everything up to the next `;'. Please insert a semicolon",
28853 "now in front of anything that you don't want me to delete.",
28854 "(See Chapter 27 of The METAFONTbook for an example.)",
28856 mp_back_error
(mp
, "Extra tokens will be flushed", hlp
, true
);
28857 mp-
>scanner_status
= flushing
;
28860 if
(cur_cmd
() == mp_string_token
) {
28861 delete_str_ref
(cur_mod_str
());
28863 } while
(!mp_end_of_statement
); /* |cur_cmd
=semicolon|
, |end_group|
, or |stop|
*/
28864 mp-
>scanner_status
= normal
;
28869 @ Equations and assignments are performed by the pair of mutually recursive
28871 routines |do_equation| and |do_assignment|. These routines are called when
28872 |cur_cmd
=equals| and when |cur_cmd
=assignment|
, respectively
; the left-hand
28873 side is in |cur_type| and |cur_exp|
, while the right-hand side is yet
28874 to be scanned. After the routines are finished
, |cur_type| and |cur_exp|
28875 will be equal to the right-hand side
(which will normally be equal
28876 to the left-hand side
).
28879 @
<Declare the procedure called |make_eq|@
>;
28880 static void mp_do_equation
(MP mp
);
28883 static void trace_equation
(MP mp
, mp_node lhs
) {
28884 mp_begin_diagnostic
(mp
);
28885 mp_print_nl
(mp
, "{(");
28886 mp_print_exp
(mp
, lhs
, 0);
28887 mp_print
(mp
, ")=(");
28888 mp_print_exp
(mp
, NULL, 0);
28889 mp_print
(mp
, ")}");
28890 mp_end_diagnostic
(mp
, false
);
28892 void mp_do_equation
(MP mp
) {
28893 mp_node lhs
; /* capsule for the left-hand side
*/
28894 lhs
= mp_stash_cur_exp
(mp
);
28895 mp_get_x_next
(mp
);
28896 mp-
>var_flag
= mp_assignment
;
28897 mp_scan_expression
(mp
);
28898 if
(cur_cmd
() == mp_equals
)
28899 mp_do_equation
(mp
);
28900 else if
(cur_cmd
() == mp_assignment
)
28901 mp_do_assignment
(mp
);
28902 if
(number_greater
(internal_value
(mp_tracing_commands
), two_t
)) {
28903 trace_equation
(mp
, lhs
);
28905 if
(mp-
>cur_exp.type
== mp_unknown_path
) {
28906 if
(mp_type
(lhs
) == mp_pair_type
) {
28907 mp_node p
; /* temporary register
*/
28908 p
= mp_stash_cur_exp
(mp
);
28909 mp_unstash_cur_exp
(mp
, lhs
);
28911 } /* in this case |make_eq| will change the pair to a path
*/
28913 mp_make_eq
(mp
, lhs
); /* equate |lhs| to |
(cur_type
,cur_exp
)|
*/
28917 @ And |do_assignment| is similar to |do_equation|
:
28920 static void mp_do_assignment
(MP mp
);
28923 static void bad_lhs
(MP mp
) {
28924 const char
*hlp
[] = {
28925 "I didn't find a variable name at the left of the `:=',",
28926 "so I'm going to pretend that you said `=' instead.",
28928 mp_disp_err
(mp
, NULL);
28929 mp_error
(mp
, "Improper `:=' will be changed to `='", hlp
, true
);
28930 mp_do_equation
(mp
);
28932 static void bad_internal_assignment
(MP mp
, mp_node lhs
) {
28934 const char
*hlp
[] = {
28935 "I can\'t set this internal quantity to anything but a known",
28936 "numeric value, so I'll have to ignore this assignment.",
28938 mp_disp_err
(mp
, NULL);
28939 if
(internal_type
(mp_sym_info
(lhs
)) == mp_known
) {
28940 mp_snprintf
(msg
, 256, "Internal quantity `%s' must receive a known numeric value",
28941 internal_name
(mp_sym_info
(lhs
)));
28943 mp_snprintf
(msg
, 256, "Internal quantity `%s' must receive a known string",
28944 internal_name
(mp_sym_info
(lhs
)));
28945 hlp
[1] = "string, so I'll have to ignore this assignment.";
28947 mp_back_error
(mp
, msg
, hlp
, true
);
28948 mp_get_x_next
(mp
);
28950 static void forbidden_internal_assignment
(MP mp
, mp_node lhs
) {
28952 const char
*hlp
[] = {
28953 "I can\'t set this internal quantity to anything just yet",
28954 "(it is read-only), so I'll have to ignore this assignment.",
28956 mp_snprintf
(msg
, 256, "Internal quantity `%s' is read-only",
28957 internal_name
(mp_sym_info
(lhs
)));
28958 mp_back_error
(mp
, msg
, hlp
, true
);
28959 mp_get_x_next
(mp
);
28961 static void bad_internal_assignment_precision
(MP mp
, mp_node lhs
, mp_number min
, mp_number max
) {
28964 const char
*hlp
[] = {
28965 "Precision values are limited by the current numbersystem.",
28968 mp_snprintf
(msg
, 256, "Bad '%s' has been ignored", internal_name
(mp_sym_info
(lhs
)));
28969 mp_snprintf
(s
, 256, "Currently I am using '%s'; the allowed precision range is [%s,%s].",
28970 mp_str
(mp
, internal_string
(mp_number_system
)), number_tostring
(min
), number_tostring
(max
));
28972 mp_back_error
(mp
, msg
, hlp
, true
);
28973 mp_get_x_next
(mp
);
28975 static void bad_expression_assignment
(MP mp
, mp_node lhs
) {
28976 const char
*hlp
[] = {
28977 "It seems you did a nasty thing---probably by accident,",
28978 "but nevertheless you nearly hornswoggled me...",
28979 "While I was evaluating the right-hand side of this",
28980 "command, something happened, and the left-hand side",
28981 "is no longer a variable! So I won't change anything.",
28983 char
*msg
= mp_obliterated
(mp
, lhs
);
28984 mp_back_error
(mp
, msg
, hlp
, true
);
28986 mp_get_x_next
(mp
);
28988 static void trace_assignment
(MP mp
, mp_node lhs
) {
28989 mp_begin_diagnostic
(mp
);
28990 mp_print_nl
(mp
, "{");
28991 if
(mp_name_type
(lhs
) == mp_internal_sym
)
28992 mp_print
(mp
, internal_name
(mp_sym_info
(lhs
)));
28994 mp_show_token_list
(mp
, lhs
, NULL, 1000, 0);
28995 mp_print
(mp
, ":=");
28996 mp_print_exp
(mp
, NULL, 0);
28997 mp_print_char
(mp
, xord
('
}'
));
28998 mp_end_diagnostic
(mp
, false
);
29000 void mp_do_assignment
(MP mp
) {
29001 if
(mp-
>cur_exp.type
!= mp_token_list
) {
29004 mp_node lhs
; /* token list for the left-hand side
*/
29005 lhs
= cur_exp_node
();
29006 mp-
>cur_exp.type
= mp_vacuous
;
29007 mp_get_x_next
(mp
);
29008 mp-
>var_flag
= mp_assignment
;
29009 mp_scan_expression
(mp
);
29010 if
(cur_cmd
() == mp_equals
)
29011 mp_do_equation
(mp
);
29012 else if
(cur_cmd
() == mp_assignment
)
29013 mp_do_assignment
(mp
);
29014 if
(number_greater
(internal_value
(mp_tracing_commands
), two_t
)) {
29015 trace_assignment
(mp
, lhs
);
29017 if
(mp_name_type
(lhs
) == mp_internal_sym
) {
29018 /* Assign the current expression to an internal variable
*/
29019 if
((mp-
>cur_exp.type
== mp_known || mp-
>cur_exp.type
== mp_string_type
)
29020 && (internal_type (mp_sym_info (lhs)) == mp->cur_exp.type)) {
29021 if
(mp_sym_info
(lhs
) == mp_number_system
) {
29022 forbidden_internal_assignment
(mp
, lhs
);
29023 } else if
(mp_sym_info
(lhs
) == mp_number_precision
) {
29024 if
(!(mp-
>cur_exp.type
== mp_known
&&
29025 (!number_less
(cur_exp_value_number
(), precision_min
)) &&
29026 (!number_greater
(cur_exp_value_number
(), precision_max
))
29028 bad_internal_assignment_precision
(mp
, lhs
, precision_min
, precision_max
);
29030 set_internal_from_cur_exp
(mp_sym_info
(lhs
));
29034 set_internal_from_cur_exp
(mp_sym_info
(lhs
));
29037 bad_internal_assignment
(mp
, lhs
);
29040 /* Assign the current expression to the variable |lhs|
*/
29041 mp_node p
; /* where the left-hand value is stored
*/
29042 mp_node q
; /* temporary capsule for the right-hand value
*/
29043 p
= mp_find_variable
(mp
, lhs
);
29045 q
= mp_stash_cur_exp
(mp
);
29046 mp-
>cur_exp.type
= mp_und_type
(mp
, p
);
29047 mp_recycle_value
(mp
, p
);
29048 mp_type
(p
) = mp-
>cur_exp.type
;
29049 set_value_number
(p
, zero_t
);
29050 mp_make_exp_copy
(mp
, p
);
29051 p
= mp_stash_cur_exp
(mp
);
29052 mp_unstash_cur_exp
(mp
, q
);
29053 mp_make_eq
(mp
, p
);
29055 bad_expression_assignment
(mp
, lhs
);
29058 mp_flush_node_list
(mp
, lhs
);
29063 @ And now we get to the nitty-gritty. The |make_eq| procedure is given
29064 a pointer to a capsule that is to be equated to the current expression.
29066 @
<Declare the procedure called |make_eq|@
>=
29067 static void mp_make_eq
(MP mp
, mp_node lhs
);
29071 static void announce_bad_equation
(MP mp
, mp_node lhs
) {
29073 const char
*hlp
[] = {
29074 "I'm sorry, but I don't know how to make such things equal.",
29075 "(See the two expressions just above the error message.)",
29077 mp_snprintf
(msg
, 256, "Equation cannot be performed (%s=%s)",
29078 (mp_type
(lhs
) <= mp_pair_type ? mp_type_string
(mp_type
(lhs
)) : "numeric"),
29079 (mp-
>cur_exp.type
<= mp_pair_type ? mp_type_string
(mp-
>cur_exp.type
) : "numeric"));
29080 mp_disp_err
(mp
, lhs
);
29081 mp_disp_err
(mp
, NULL);
29082 mp_back_error
(mp
, msg
, hlp
, true
);
29083 mp_get_x_next
(mp
);
29085 static void exclaim_inconsistent_equation
(MP mp
) {
29086 const char
*hlp
[] = {
29087 "The equation I just read contradicts what was said before.",
29088 "But don't worry; continue and I'll just ignore it.",
29090 mp_back_error
(mp
,"Inconsistent equation", hlp
, true
);
29091 mp_get_x_next
(mp
);
29093 static void exclaim_redundant_or_inconsistent_equation
(MP mp
) {
29094 const char
*hlp
[] = {
29095 "An equation between already-known quantities can't help.",
29096 "But don't worry; continue and I'll just ignore it.",
29098 mp_back_error
(mp
, "Redundant or inconsistent equation", hlp
, true
);
29099 mp_get_x_next
(mp
);
29101 static void report_redundant_or_inconsistent_equation
(MP mp
, mp_node lhs
, mp_number v
) {
29102 if
(mp-
>cur_exp.type
<= mp_string_type
) {
29103 if
(mp-
>cur_exp.type
== mp_string_type
) {
29104 if
(mp_str_vs_str
(mp
, value_str
(lhs
), cur_exp_str
()) != 0) {
29105 exclaim_inconsistent_equation
(mp
);
29107 exclaim_redundant_equation
(mp
);
29109 } else if
(!number_equal
(v
, cur_exp_value_number
())) {
29110 exclaim_inconsistent_equation
(mp
);
29112 exclaim_redundant_equation
(mp
);
29115 exclaim_redundant_or_inconsistent_equation
(mp
);
29119 void mp_make_eq
(MP mp
, mp_node lhs
) {
29121 mp_variable_type t
; /* type of the left-hand side
*/
29122 mp_number v
; /* value of the left-hand side
*/
29123 memset
(&new_expr,0,sizeof(mp_value));
29127 if
(t
<= mp_pair_type
)
29128 number_clone
(v
, value_number
(lhs
));
29129 /* For each type |t|
, make an equation or complain if |cur_type|
29130 is incompatible with~|t|
*/
29132 case mp_boolean_type
:
29133 case mp_string_type
:
29136 case mp_picture_type
:
29137 if
(mp-
>cur_exp.type
== t
+ unknown_tag
) {
29138 new_number
(new_expr.data.n
);
29139 if
(t
==mp_boolean_type
) {
29140 number_clone
(new_expr.data.n
, v
);
29141 } else if
(t
==mp_string_type
) {
29142 new_expr.data.str
= value_str
(lhs
);
29143 } else if
(t
==mp_picture_type
) {
29144 new_expr.data.node
= value_node
(lhs
);
29145 } else
{ /* pen or path
*/
29146 new_expr.data.p
= value_knot
(lhs
);
29148 mp_nonlinear_eq
(mp
, new_expr
, cur_exp_node
(), false
);
29149 mp_unstash_cur_exp
(mp
, cur_exp_node
());
29150 } else if
(mp-
>cur_exp.type
== t
) {
29151 report_redundant_or_inconsistent_equation
(mp
, lhs
, v
);
29153 announce_bad_equation
(mp
, lhs
);
29156 case unknown_types
:
29157 if
(mp-
>cur_exp.type
== t
- unknown_tag
) {
29158 mp_nonlinear_eq
(mp
, mp-
>cur_exp
, lhs
, true
);
29159 } else if
(mp-
>cur_exp.type
== t
) {
29160 mp_ring_merge
(mp
, lhs
, cur_exp_node
());
29161 } else if
(mp-
>cur_exp.type
== mp_pair_type
) {
29162 if
(t
== mp_unknown_path
) {
29163 mp_pair_to_path
(mp
);
29167 announce_bad_equation
(mp
, lhs
);
29170 case mp_transform_type
:
29171 case mp_color_type
:
29172 case mp_cmykcolor_type
:
29174 if
(mp-
>cur_exp.type
== t
) {
29175 /* Do multiple equations
*/
29176 mp_node q
= value_node
(cur_exp_node
());
29177 mp_node p
= value_node
(lhs
);
29179 case mp_transform_type
:
29180 mp_try_eq
(mp
, yy_part
(p
), yy_part
(q
));
29181 mp_try_eq
(mp
, yx_part
(p
), yx_part
(q
));
29182 mp_try_eq
(mp
, xy_part
(p
), xy_part
(q
));
29183 mp_try_eq
(mp
, xx_part
(p
), xx_part
(q
));
29184 mp_try_eq
(mp
, ty_part
(p
), ty_part
(q
));
29185 mp_try_eq
(mp
, tx_part
(p
), tx_part
(q
));
29187 case mp_color_type
:
29188 mp_try_eq
(mp
, blue_part
(p
), blue_part
(q
));
29189 mp_try_eq
(mp
, green_part
(p
), green_part
(q
));
29190 mp_try_eq
(mp
, red_part
(p
), red_part
(q
));
29192 case mp_cmykcolor_type
:
29193 mp_try_eq
(mp
, black_part
(p
), black_part
(q
));
29194 mp_try_eq
(mp
, yellow_part
(p
), yellow_part
(q
));
29195 mp_try_eq
(mp
, magenta_part
(p
), magenta_part
(q
));
29196 mp_try_eq
(mp
, cyan_part
(p
), cyan_part
(q
));
29199 mp_try_eq
(mp
, y_part
(p
), y_part
(q
));
29200 mp_try_eq
(mp
, x_part
(p
), x_part
(q
));
29202 default
: /* there are no other valid cases
, but please the compiler
*/
29206 announce_bad_equation
(mp
, lhs
);
29211 case mp_proto_dependent
:
29212 case mp_independent
:
29213 if
(mp-
>cur_exp.type
>= mp_known
) {
29214 mp_try_eq
(mp
, lhs
, NULL);
29216 announce_bad_equation
(mp
, lhs
);
29220 announce_bad_equation
(mp
, lhs
);
29222 default
: /* there are no other valid cases
, but please the compiler
*/
29223 announce_bad_equation
(mp
, lhs
);
29227 mp_recycle_value
(mp
, lhs
);
29229 mp_free_value_node
(mp
, lhs
);
29232 @ The first argument to |try_eq| is the location of a value node
29233 in a capsule that will soon be recycled. The second argument is
29234 either a location within a pair or transform node pointed to by
29235 |cur_exp|
, or it is |
NULL|
(which means that |cur_exp| itself
29236 serves as the second argument
). The idea is to leave |cur_exp| unchanged
,
29237 but to equate the two operands.
29240 static void mp_try_eq
(MP mp
, mp_node l
, mp_node r
);
29243 @d equation_threshold_k
((math_data
*)mp-
>math
)->equation_threshold_t
29246 static void deal_with_redundant_or_inconsistent_equation
(MP mp
, mp_value_node p
, mp_node r
) {
29249 number_clone
(absp
, value_number
(p
));
29251 if
(number_greater
(absp
, equation_threshold_k
)) { /* off by
.001 or more
*/
29253 const char
*hlp
[] = {
29254 "The equation I just read contradicts what was said before.",
29255 "But don't worry; continue and I'll just ignore it.",
29257 mp_snprintf
(msg
, 256, "Inconsistent equation (off by %s)", number_tostring
(value_number
(p
)));
29258 mp_back_error
(mp
, msg
, hlp
, true
);
29259 mp_get_x_next
(mp
);
29260 } else if
(r
== NULL) {
29261 exclaim_redundant_equation
(mp
);
29263 free_number
(absp
);
29264 mp_free_dep_node
(mp
, p
);
29267 void mp_try_eq
(MP mp
, mp_node l
, mp_node r
) {
29268 mp_value_node p
; /* dependency list for right operand minus left operand
*/
29269 mp_variable_type t
; /* the type of list |p|
*/
29270 mp_value_node q
; /* the constant term of |p| is here
*/
29271 mp_value_node pp
; /* dependency list for right operand
*/
29272 mp_variable_type tt
; /* the type of list |pp|
*/
29273 boolean copied
; /* have we copied a list that ought to be recycled?
*/
29274 /* Remove the left operand from its container
, negate it
, and
29275 put it into dependency list~|p| with constant term~|q|
*/
29277 if
(t
== mp_known
) {
29280 number_clone
(arg1
, value_number
(l
));
29281 number_negate
(arg1
);
29283 p
= mp_const_dependency
(mp
, arg1
);
29285 free_number
(arg1
);
29286 } else if
(t
== mp_independent
) {
29288 p
= mp_single_dependency
(mp
, l
);
29289 number_negate
(dep_value
(p
));
29292 mp_value_node ll
= (mp_value_node
) l
;
29293 p
= (mp_value_node
) dep_list
(ll
);
29296 number_negate
(dep_value
(q
));
29297 if
(dep_info
(q
) == NULL)
29299 q
= (mp_value_node
) mp_link
(q
);
29301 mp_link
(prev_dep
(ll
)) = mp_link
(q
);
29302 set_prev_dep
((mp_value_node
) mp_link
(q
), prev_dep
(ll
));
29303 mp_type
(ll
) = mp_known
;
29306 /* Add the right operand to list |p|
*/
29308 if
(mp-
>cur_exp.type
== mp_known
) {
29309 number_add
(value_number
(q
), cur_exp_value_number
());
29312 tt
= mp-
>cur_exp.type
;
29313 if
(tt
== mp_independent
)
29314 pp
= mp_single_dependency
(mp
, cur_exp_node
());
29316 pp
= (mp_value_node
) dep_list
((mp_value_node
) cur_exp_node
());
29319 if
(mp_type
(r
) == mp_known
) {
29320 number_add
(dep_value
(q
), value_number
(r
));
29324 if
(tt
== mp_independent
)
29325 pp
= mp_single_dependency
(mp
, r
);
29327 pp
= (mp_value_node
) dep_list
((mp_value_node
) r
);
29330 if
(tt
!= mp_independent
) {
29336 /* Add dependency list |pp| of type |tt| to dependency list~|p| of type~|t|
*/
29337 mp-
>watch_coefs
= false
;
29339 p
= mp_p_plus_q
(mp
, p
, pp
, (quarterword
) t
);
29340 } else if
(t
== mp_proto_dependent
) {
29341 p
= mp_p_plus_fq
(mp
, p
, unity_t
, pp
, mp_proto_dependent
, mp_dependent
);
29346 while
(dep_info
(q
) != NULL) {
29347 number_clone
(x
, dep_value
(q
));
29348 fraction_to_round_scaled
(x
);
29349 set_dep_value
(q
, x
);
29350 q
= (mp_value_node
) mp_link
(q
);
29353 t
= mp_proto_dependent
;
29354 p
= mp_p_plus_q
(mp
, p
, pp
, (quarterword
) t
);
29356 mp-
>watch_coefs
= true
;
29359 mp_flush_node_list
(mp
, (mp_node
) pp
);
29362 if
(dep_info
(p
) == NULL) {
29363 deal_with_redundant_or_inconsistent_equation
(mp
, p
, r
);
29365 mp_linear_eq
(mp
, p
, (quarterword
) t
);
29366 if
(r
== NULL && mp->cur_exp.type != mp_known) {
29367 if
(mp_type
(cur_exp_node
()) == mp_known
) {
29368 mp_node pp
= cur_exp_node
();
29369 set_cur_exp_value_number
(value_number
(pp
));
29370 mp-
>cur_exp.type
= mp_known
;
29371 mp_free_value_node
(mp
, pp
);
29377 @ Our next goal is to process type declarations. For this purpose it's
29378 convenient to have a procedure that scans a $\langle\
,$declared
29379 variable$\
,\rangle$ and returns the corresponding token list. After the
29380 following procedure has acted
, the token after the declared variable
29381 will have been scanned
, so it will appear in |cur_cmd|
, |cur_mod|
,
29385 static mp_node mp_scan_declared_variable
(MP mp
);
29388 mp_node mp_scan_declared_variable
(MP mp
) {
29389 mp_sym x
; /* hash address of the variable's root
*/
29390 mp_node h
, t
; /* head and tail of the token list to be returned
*/
29391 mp_get_symbol
(mp
);
29393 if
(cur_cmd
() != mp_tag_token
)
29394 mp_clear_symbol
(mp
, x
, false
);
29395 h
= mp_get_symbolic_node
(mp
);
29396 set_mp_sym_sym
(h
, x
);
29399 mp_get_x_next
(mp
);
29400 if
(cur_sym
() == NULL)
29402 if
(cur_cmd
() != mp_tag_token
) {
29403 if
(cur_cmd
() != mp_internal_quantity
) {
29404 if
(cur_cmd
() == mp_left_bracket
) {
29405 /* Descend past a collective subscript
*/
29406 /* If the subscript isn't collective
, we don't accept it as part of the
29407 declared variable.
*/
29408 mp_sym ll
= cur_sym
(); /* hash address of left bracket
*/
29409 mp_get_x_next
(mp
);
29410 if
(cur_cmd
() == mp_right_bracket
) {
29411 set_cur_sym
(collective_subscript
);
29413 mp_back_input
(mp
);
29415 set_cur_cmd
((mp_variable_type
)mp_left_bracket
);
29423 mp_link
(t
) = mp_get_symbolic_node
(mp
);
29425 set_mp_sym_sym
(t
, cur_sym
());
29426 mp_name_type
(t
) = cur_sym_mod
();
29428 if
((eq_type
(x
) % mp_outer_tag
) != mp_tag_token
)
29429 mp_clear_symbol
(mp
, x
, false
);
29430 if
(equiv_node
(x
) == NULL)
29431 mp_new_root
(mp
, x
);
29436 @ Type declarations are introduced by the following primitive operations.
29439 mp_primitive
(mp
, "numeric", mp_type_name
, mp_numeric_type
);
29440 @
:numeric_
}{\
&{numeric} primitive@>;
29441 mp_primitive
(mp
, "string", mp_type_name
, mp_string_type
);
29442 @
:string_
}{\
&{string} primitive@>;
29443 mp_primitive
(mp
, "boolean", mp_type_name
, mp_boolean_type
);
29444 @
:boolean_
}{\
&{boolean} primitive@>;
29445 mp_primitive
(mp
, "path", mp_type_name
, mp_path_type
);
29446 @
:path_
}{\
&{path} primitive@>;
29447 mp_primitive
(mp
, "pen", mp_type_name
, mp_pen_type
);
29448 @
:pen_
}{\
&{pen} primitive@>;
29449 mp_primitive
(mp
, "picture", mp_type_name
, mp_picture_type
);
29450 @
:picture_
}{\
&{picture} primitive@>;
29451 mp_primitive
(mp
, "transform", mp_type_name
, mp_transform_type
);
29452 @
:transform_
}{\
&{transform} primitive@>;
29453 mp_primitive
(mp
, "color", mp_type_name
, mp_color_type
);
29454 @
:color_
}{\
&{color} primitive@>;
29455 mp_primitive
(mp
, "rgbcolor", mp_type_name
, mp_color_type
);
29456 @
:color_
}{\
&{rgbcolor} primitive@>;
29457 mp_primitive
(mp
, "cmykcolor", mp_type_name
, mp_cmykcolor_type
);
29458 @
:color_
}{\
&{cmykcolor} primitive@>;
29459 mp_primitive
(mp
, "pair", mp_type_name
, mp_pair_type
);
29460 @
:pair_
}{\
&{pair} primitive@>
29463 @ @
<Cases of |print_cmd...@
>=
29465 mp_print_type
(mp
, (quarterword
) m
);
29468 @ Now we are ready to handle type declarations
, assuming that a
29469 |type_name| has just been scanned.
29471 @
<Declare action procedures for use by |do_statement|@
>=
29472 static void mp_do_type_declaration
(MP mp
);
29475 static void flush_spurious_symbols_after_declared_variable
(MP mp
);
29476 void mp_do_type_declaration
(MP mp
) {
29477 integer t
; /* the type being declared
*/
29478 mp_node p
; /* token list for a declared variable
*/
29479 mp_node q
; /* value node for the variable
*/
29480 if
(cur_mod
() >= mp_transform_type
)
29481 t
= (quarterword
) cur_mod
();
29483 t
= (quarterword
) (cur_mod
() + unknown_tag
);
29485 p
= mp_scan_declared_variable
(mp
);
29486 mp_flush_variable
(mp
, equiv_node
(mp_sym_sym
(p
)), mp_link
(p
), false
);
29487 q
= mp_find_variable
(mp
, p
);
29490 set_value_number
(q
, zero_t
); /* todo
: this was |null|
*/
29492 const char
*hlp
[] = {
29493 "You can't use, e.g., `numeric foo[]' after `vardef foo'.",
29494 "Proceed, and I'll ignore the illegal redeclaration.",
29496 mp_back_error
(mp
, "Declared variable conflicts with previous vardef", hlp
, true
);
29497 mp_get_x_next
(mp
);
29499 mp_flush_node_list
(mp
, p
);
29500 if
(cur_cmd
() < mp_comma
) {
29501 flush_spurious_symbols_after_declared_variable
(mp
);
29503 } while
(!mp_end_of_statement
);
29509 static void flush_spurious_symbols_after_declared_variable
(MP mp
)
29511 const char
*hlp
[] = {
29512 "Variables in declarations must consist entirely of",
29513 "names and collective subscripts, e.g., `x[]a'.",
29514 "Are you trying to use a reserved word in a variable name?",
29515 "I'm going to discard the junk I found here,",
29516 "up to the next comma or the end of the declaration.",
29518 if
(cur_cmd
() == mp_numeric_token
)
29519 hlp
[2] = "Explicit subscripts like `x15a' aren't permitted.";
29520 mp_back_error
(mp
, "Illegal suffix of declared variable will be flushed", hlp
, true
);
29521 mp_get_x_next
(mp
);
29522 mp-
>scanner_status
= flushing
;
29525 @
<Decrease the string reference count...@
>;
29526 } while
(cur_cmd
() < mp_comma
); /* break on either |end_of_statement| or |comma|
*/
29527 mp-
>scanner_status
= normal
;
29531 @ \MP's |main_control| procedure just calls |do_statement| repeatedly
29532 until coming to the end of the user's program.
29533 Each execution of |do_statement| concludes with
29534 |cur_cmd
=semicolon|
, |end_group|
, or |stop|.
29537 static void mp_main_control
(MP mp
) {
29539 mp_do_statement
(mp
);
29540 if
(cur_cmd
() == mp_end_group
) {
29542 const char
*hlp
[] = {
29543 "I'm not currently working on a `begingroup',",
29544 "so I had better not try to end anything.",
29546 memset
(&new_expr,0,sizeof(mp_value));
29547 new_number
(new_expr.data.n
);
29548 mp_error
(mp
, "Extra `endgroup'", hlp
, true
);
29549 mp_flush_cur_exp
(mp
, new_expr
);
29551 } while
(cur_cmd
() != mp_stop
);
29553 int mp_run
(MP mp
) {
29554 if
(mp-
>history
< mp_fatal_error_stop
) {
29555 xfree
(mp-
>jump_buf
);
29556 mp-
>jump_buf
= malloc
(sizeof
(jmp_buf
));
29557 if
(mp-
>jump_buf
== NULL || setjmp
(*(mp-
>jump_buf
)) != 0)
29558 return mp-
>history
;
29559 mp_main_control
(mp
); /* come to life
*/
29560 mp_final_cleanup
(mp
); /* prepare for death
*/
29561 mp_close_files_and_terminate
(mp
);
29563 return mp-
>history
;
29567 @ This function allows setting of internals from an external
29568 source
(like the command line or a controlling application
).
29570 It accepts two |char
*|'s
, even for numeric assignments when
29571 it calls |atoi| to get an integer from the start of the string.
29574 void mp_set_internal
(MP mp
, char
*n
, char
*v
, int isstring
) {
29575 size_t l
= strlen
(n
);
29577 const char
*errid
= NULL;
29579 mp_sym p
= mp_id_lookup
(mp
, n
, l
, false
);
29581 errid
= "variable does not exist";
29583 if
(eq_type
(p
) == mp_internal_quantity
) {
29584 if
((internal_type
(equiv
(p
)) == mp_string_type
) && (isstring)) {
29585 set_internal_string
(equiv
(p
), mp_rts
(mp
, v
));
29586 } else if
((internal_type
(equiv
(p
)) == mp_known
) && (!isstring)) {
29587 int test
= atoi
(v
);
29588 if
(test
> 16383 && mp->math_mode==mp_math_scaled_mode) {
29589 errid
= "value is too large";
29590 } else if
(test
< -16383 && mp->math_mode==mp_math_scaled_mode) {
29591 errid
= "value is too small";
29593 set_internal_from_number
(equiv
(p
), unity_t
);
29594 number_multiply_int
(internal_value
(equiv
(p
)), test
);
29597 errid
= "value has the wrong type";
29600 errid
= "variable is not an internal";
29604 if
(errid
!= NULL) {
29606 mp_snprintf
(err
, 256, "%s=\"%s\
": %s, assignment ignored.", n
, v
, errid
);
29608 mp_snprintf
(err
, 256, "%s=%d: %s, assignment ignored.", n
, atoi
(v
),
29616 @ @
<Exported function headers@
>=
29617 void mp_set_internal
(MP mp
, char
*n
, char
*v
, int isstring
);
29619 @ For |mp_execute|
, we need to define a structure to store the
29620 redirected input and output. This structure holds the five relevant
29621 streams
: the three informational output streams
, the PostScript
29622 generation stream
, and the input stream. These streams have many
29623 things in common
, so it makes sense to give them their own structure
29626 \item
{fptr
} is a virtual file pointer
29627 \item
{data
} is the data this stream holds
29628 \item
{cur
} is a cursor pointing into |data|
29629 \item
{size
} is the allocated length of the data stream
29630 \item
{used
} is the actual length of the data stream
29632 There are small differences between input and output
: |term_in| never
29633 uses |used|
, whereas the other four never use |cur|.
29635 The file |luatexdir
/tex
/texfileio.h| defines |term_in| as |stdin| and
29636 |term_out| as |stdout|. Moreover |stdio.h| for MinGW defines |stdin| as
29637 |
(&_iob[0])| and |stdout| as |(&_iob[1])|. We must avoid all that.
29639 @
<Exported types@
>=
29651 mp_stream term_out
;
29652 mp_stream error_out
;
29654 mp_stream ship_out
;
29656 struct mp_edge_object
*edges
;
29659 @ We need a function to clear an output stream
, this is called at the
29660 beginning of |mp_execute|. We also need one for destroying an output
29661 stream
, this is called just before a stream is
(re
)opened.
29664 static void mp_reset_stream
(mp_stream
* str
) {
29670 static void mp_free_stream
(mp_stream
* str
) {
29672 mp_reset_stream
(str
);
29676 @ @
<Declarations@
>=
29677 static void mp_reset_stream
(mp_stream
* str
);
29678 static void mp_free_stream
(mp_stream
* str
);
29680 @ The global instance contains a pointer instead of the actual structure
29681 even though it is essentially static
, because that makes it is easier to move
29685 mp_run_data run_data
;
29687 @ Another type is needed
: the indirection will overload some of the
29688 file pointer objects in the instance
(but not all
). For clarity
, an
29689 indirect object is used that wraps a |
FILE *|.
29692 typedef struct File
{
29696 @ Here are all of the functions that need to be overloaded for |mp_execute|.
29699 static void
*mplib_open_file
(MP mp
, const char
*fname
, const char
*fmode
,
29701 static int mplib_get_char
(void
*f
, mp_run_data
* mplib_data
);
29702 static void mplib_unget_char
(void
*f
, mp_run_data
* mplib_data
, int c
);
29703 static char
*mplib_read_ascii_file
(MP mp
, void
*ff
, size_t
* size
);
29704 static void mplib_write_ascii_file
(MP mp
, void
*ff
, const char
*s
);
29705 static void mplib_read_binary_file
(MP mp
, void
*ff
, void
**data
,
29707 static void mplib_write_binary_file
(MP mp
, void
*ff
, void
*s
, size_t size
);
29708 static void mplib_close_file
(MP mp
, void
*ff
);
29709 static int mplib_eof_file
(MP mp
, void
*ff
);
29710 static void mplib_flush_file
(MP mp
, void
*ff
);
29711 static void mplib_shipout_backend
(MP mp
, void
*h
);
29713 @ The |xmalloc
(1,1)| calls make sure the stored indirection values are unique.
29715 @d reset_stream
(a
) do
{
29716 mp_reset_stream
(&(a));
29718 ff-
>f
= xmalloc
(1,1);
29723 static void
*mplib_open_file
(MP mp
, const char
*fname
, const char
*fmode
,
29725 File
*ff
= xmalloc
(1, sizeof
(File
));
29726 mp_run_data
*run
= mp_rundata
(mp
);
29728 if
(ftype
== mp_filetype_terminal
) {
29729 if
(fmode
[0] == 'r'
) {
29731 ff-
>f
= xmalloc
(1, 1);
29732 run-
>term_in.fptr
= ff-
>f
;
29735 reset_stream
(run-
>term_out
);
29737 } else if
(ftype
== mp_filetype_error
) {
29738 reset_stream
(run-
>error_out
);
29739 } else if
(ftype
== mp_filetype_log
) {
29740 reset_stream
(run-
>log_out
);
29741 } else if
(ftype
== mp_filetype_postscript
) {
29742 mp_free_stream
(&(run->ship_out));
29743 ff-
>f
= xmalloc
(1, 1);
29744 run-
>ship_out.fptr
= ff-
>f
;
29745 } else if
(ftype
== mp_filetype_bitmap
) {
29746 mp_free_stream
(&(run->ship_out));
29747 ff-
>f
= xmalloc
(1, 1);
29748 run-
>ship_out.fptr
= ff-
>f
;
29751 char
*f
= (mp-
>find_file
) (mp
, fname
, fmode
, ftype
);
29754 realmode
[0] = *fmode
;
29757 ff-
>f
= fopen
(f
, realmode
);
29759 if
((fmode
[0] == 'r'
) && (ff->f == NULL)) {
29766 static int mplib_get_char
(void
*f
, mp_run_data
* run
) {
29768 if
(f
== run-
>term_in.fptr
&& run->term_in.data != NULL) {
29769 if
(run-
>term_in.size
== 0) {
29770 if
(run-
>term_in.cur
!= NULL) {
29771 run-
>term_in.cur
= NULL;
29773 xfree
(run-
>term_in.data
);
29777 run-
>term_in.size--
;
29778 c
= *(run-
>term_in.cur
)++;
29785 static void mplib_unget_char
(void
*f
, mp_run_data
* run
, int c
) {
29786 if
(f
== run-
>term_in.fptr
&& run->term_in.cur != NULL) {
29787 run-
>term_in.size
++;
29788 run-
>term_in.cur--
;
29793 static char
*mplib_read_ascii_file
(MP mp
, void
*ff
, size_t
* size
) {
29797 size_t len
= 0, lim
= 128;
29798 mp_run_data
*run
= mp_rundata
(mp
);
29799 FILE *f
= ((File
*) ff
)->f
;
29803 c
= mplib_get_char
(f
, run
);
29809 while
(c
!= EOF
&& c != '\n' && c != '\r') {
29810 if
(len
>= (lim
- 1)) {
29811 s
= xrealloc
(s
, (lim
+ (lim
>> 2)), 1);
29816 s
[len
++] = (char
) c
;
29817 c
= mplib_get_char
(f
, run
);
29820 c
= mplib_get_char
(f
, run
);
29821 if
(c
!= EOF
&& c != '\n')
29822 mplib_unget_char
(f
, run
, c
);
29829 static void mp_append_string
(MP mp
, mp_stream
* a
, const char
*b
) {
29830 size_t l
= strlen
(b
) + 1; /* don't forget the trailing |'\
0'|
*/
29831 if
((a-
>used
+ l
) >= a-
>size
) {
29832 a-
>size
+= 256 + (a-
>size
) / 5 + l
;
29833 a-
>data
= xrealloc
(a-
>data
, a-
>size
, 1);
29835 memcpy
(a-
>data
+ a-
>used
, b
, l
);
29838 static void mp_append_data
(MP mp
, mp_stream
* a
, void
*b
, size_t l
) {
29839 if
((a-
>used
+ l
) >= a-
>size
) {
29840 a-
>size
+= 256 + (a-
>size
) / 5 + l
;
29841 a-
>data
= xrealloc
(a-
>data
, a-
>size
, 1);
29843 memcpy
(a-
>data
+ a-
>used
, b
, l
);
29846 static void mplib_write_ascii_file
(MP mp
, void
*ff
, const char
*s
) {
29848 void
*f
= ((File
*) ff
)->f
;
29849 mp_run_data
*run
= mp_rundata
(mp
);
29851 if
(f
== run-
>term_out.fptr
) {
29852 mp_append_string
(mp
, &(run->term_out), s);
29853 } else if
(f
== run-
>error_out.fptr
) {
29854 mp_append_string
(mp
, &(run->error_out), s);
29855 } else if
(f
== run-
>log_out.fptr
) {
29856 mp_append_string
(mp
, &(run->log_out), s);
29857 } else if
(f
== run-
>ship_out.fptr
) {
29858 mp_append_string
(mp
, &(run->ship_out), s);
29860 fprintf
((FILE *) f
, "%s", s
);
29865 static void mplib_read_binary_file
(MP mp
, void
*ff
, void
**data
, size_t
* size
) {
29869 FILE *f
= ((File
*) ff
)->f
;
29871 len
= fread
(*data
, 1, *size
, f
);
29875 static void mplib_write_binary_file
(MP mp
, void
*ff
, void
*s
, size_t size
) {
29878 void
*f
= ((File
*) ff
)->f
;
29879 mp_run_data
*run
= mp_rundata
(mp
);
29881 if
(f
== run-
>ship_out.fptr
) {
29882 mp_append_data
(mp
, &(run->ship_out), s, size);
29884 (void
) fwrite
(s
, size
, 1, f
);
29889 static void mplib_close_file
(MP mp
, void
*ff
) {
29891 mp_run_data
*run
= mp_rundata
(mp
);
29892 void
*f
= ((File
*) ff
)->f
;
29894 if
(f
!= run-
>term_out.fptr
29895 && f != run->error_out.fptr
29896 && f != run->log_out.fptr
29897 && f != run->ship_out.fptr && f != run->term_in.fptr) {
29904 static int mplib_eof_file
(MP mp
, void
*ff
) {
29906 mp_run_data
*run
= mp_rundata
(mp
);
29907 FILE *f
= ((File
*) ff
)->f
;
29910 if
(f
== run-
>term_in.fptr
&& run->term_in.data != NULL) {
29911 return
(run-
>term_in.size
== 0);
29917 static void mplib_flush_file
(MP mp
, void
*ff
) {
29922 static void mplib_shipout_backend
(MP mp
, void
*voidh
) {
29923 mp_edge_header_node h
= (mp_edge_header_node
) voidh
;
29924 mp_edge_object
*hh
= mp_gr_export
(mp
, h
);
29926 mp_run_data
*run
= mp_rundata
(mp
);
29927 if
(run-
>edges
== NULL) {
29930 mp_edge_object
*p
= run-
>edges
;
29931 while
(p-
>next
!= NULL) {
29940 @ This is where we fill them all in.
29941 @
<Prepare function pointers for non-interactive use@
>=
29943 mp-
>open_file
= mplib_open_file
;
29944 mp-
>close_file
= mplib_close_file
;
29945 mp-
>eof_file
= mplib_eof_file
;
29946 mp-
>flush_file
= mplib_flush_file
;
29947 mp-
>write_ascii_file
= mplib_write_ascii_file
;
29948 mp-
>read_ascii_file
= mplib_read_ascii_file
;
29949 mp-
>write_binary_file
= mplib_write_binary_file
;
29950 mp-
>read_binary_file
= mplib_read_binary_file
;
29951 mp-
>shipout_backend
= mplib_shipout_backend
;
29955 @ Perhaps this is the most important API function in the library.
29957 @
<Exported function ...@
>=
29958 extern mp_run_data
*mp_rundata
(MP mp
);
29961 mp_run_data
*mp_rundata
(MP mp
) {
29962 return
&(mp->run_data);
29967 mp_free_stream
(&(mp->run_data.term_in));
29968 mp_free_stream
(&(mp->run_data.term_out));
29969 mp_free_stream
(&(mp->run_data.log_out));
29970 mp_free_stream
(&(mp->run_data.error_out));
29971 mp_free_stream
(&(mp->run_data.ship_out));
29973 @ @
<Finish non-interactive use@
>=
29974 xfree
(mp-
>term_out
);
29975 xfree
(mp-
>term_in
);
29976 xfree
(mp-
>err_out
);
29978 @ @
<Start non-interactive work@
>=
29979 @
<Initialize the output routines@
>;
29981 mp-
>max_in_stack
= file_bottom
;
29982 mp-
>in_open
= file_bottom
;
29983 mp-
>open_parens
= 0;
29984 mp-
>max_buf_stack
= 0;
29986 mp-
>max_param_stack
= 0;
29988 iindex
= file_bottom
;
29989 nloc
= nstart
= NULL;
29993 mp-
>mpx_name
[file_bottom
] = absent
;
29994 mp-
>force_eof
= false
;
29996 mp-
>scanner_status
= normal
;
29997 if
(!mp-
>ini_version
) {
29998 if
(!mp_load_preload_file
(mp
)) {
29999 mp-
>history
= mp_fatal_error_stop
;
30000 return mp-
>history
;
30003 mp_fix_date_and_time
(mp
);
30004 if
(mp-
>random_seed
== 0)
30006 (number_to_scaled
(internal_value
(mp_time
)) / number_to_scaled
(unity_t
)) + number_to_scaled
(internal_value
(mp_day
));
30007 init_randoms
(mp-
>random_seed
);
30008 initialize_print_selector
();
30009 mp_open_log_file
(mp
);
30010 mp_set_job_id
(mp
);
30011 mp_init_map_file
(mp
, mp-
>troff_mode
);
30012 mp-
>history
= mp_spotless
; /* ready to go
! */
30013 if
(mp-
>troff_mode
) {
30014 number_clone
(internal_value
(mp_gtroffmode
), unity_t
);
30015 number_clone
(internal_value
(mp_prologues
), unity_t
);
30017 @
<Fix up |mp-
>internal
[mp_job_name
]|@
>;
30018 if
(mp-
>start_sym
!= NULL) { /* insert the `\
&{everyjob}' symbol */
30019 set_cur_sym
(mp-
>start_sym
);
30020 mp_back_input
(mp
);
30024 int mp_execute
(MP mp
, char
*s
, size_t l
) {
30025 mp_reset_stream
(&(mp->run_data.term_out));
30026 mp_reset_stream
(&(mp->run_data.log_out));
30027 mp_reset_stream
(&(mp->run_data.error_out));
30028 mp_reset_stream
(&(mp->run_data.ship_out));
30029 if
(mp-
>finished
) {
30030 return mp-
>history
;
30031 } else if
(!mp-
>noninteractive
) {
30032 mp-
>history
= mp_fatal_error_stop
;
30033 return mp-
>history
;
30035 if
(mp-
>history
< mp_fatal_error_stop
) {
30036 xfree
(mp-
>jump_buf
);
30037 mp-
>jump_buf
= malloc
(sizeof
(jmp_buf
));
30038 if
(mp-
>jump_buf
== NULL || setjmp
(*(mp-
>jump_buf
)) != 0) {
30039 return mp-
>history
;
30041 if
(s
== NULL) { /* this signals EOF
*/
30042 mp_final_cleanup
(mp
); /* prepare for death
*/
30043 mp_close_files_and_terminate
(mp
);
30044 return mp-
>history
;
30047 mp-
>term_offset
= 0;
30048 mp-
>file_offset
= 0;
30049 /* Perhaps some sort of warning here when |data| is not
30050 * yet exhausted would be nice ... this happens after errors
30052 if
(mp-
>run_data.term_in.data
)
30053 xfree
(mp-
>run_data.term_in.data
);
30054 mp-
>run_data.term_in.data
= xstrdup
(s
);
30055 mp-
>run_data.term_in.cur
= mp-
>run_data.term_in.data
;
30056 mp-
>run_data.term_in.size
= l
;
30057 if
(mp-
>run_state
== 0) {
30058 mp-
>selector
= term_only
;
30059 @
<Start non-interactive work@
>;
30062 (void
) mp_input_ln
(mp
, mp-
>term_in
);
30063 mp_firm_up_the_line
(mp
);
30064 mp-
>buffer
[limit
] = xord
('
%'
);
30065 mp-
>first
= (size_t
) (limit
+ 1);
30068 mp_do_statement
(mp
);
30069 } while
(cur_cmd
() != mp_stop
);
30070 mp_final_cleanup
(mp
);
30071 mp_close_files_and_terminate
(mp
);
30073 return mp-
>history
;
30077 @ This function cleans up
30079 int mp_finish
(MP mp
) {
30081 if
(mp-
>finished || mp-
>history
>= mp_fatal_error_stop
) {
30082 history
= mp-
>history
;
30086 xfree
(mp-
>jump_buf
);
30087 mp-
>jump_buf
= malloc
(sizeof
(jmp_buf
));
30088 if
(mp-
>jump_buf
== NULL || setjmp
(*(mp-
>jump_buf
)) != 0) {
30089 history
= mp-
>history
;
30091 history
= mp-
>history
;
30092 mp_final_cleanup
(mp
); /* prepare for death
*/
30094 mp_close_files_and_terminate
(mp
);
30100 @ People may want to know the library version
30102 char
*mp_metapost_version
(void
) {
30103 return mp_strdup
(metapost_version
);
30105 void mp_show_library_versions
(void
) {
30106 fprintf
(stdout
, "Compiled with cairo %s; using %s\n", CAIRO_VERSION_STRING
, cairo_version_string
());
30107 fprintf
(stdout
, "Compiled with pixman %s; using %s\n", PIXMAN_VERSION_STRING
, pixman_version_string
());
30108 fprintf
(stdout
, "Compiled with libpng %s; using %s\n", PNG_LIBPNG_VER_STRING
, png_libpng_ver
);
30109 fprintf
(stdout
, "Compiled with zlib %s; using %s\n", ZLIB_VERSION
, zlibVersion
());
30110 fprintf
(stdout
, "Compiled with mpfr %s; using %s\n", MPFR_VERSION_STRING
, mpfr_get_version
());
30111 fprintf
(stdout
, "Compiled with gmp %d.%d.%d; using %s\n\n", __GNU_MP_VERSION
, __GNU_MP_VERSION_MINOR
, __GNU_MP_VERSION_PATCHLEVEL
, gmp_version
);
30114 @ @
<Exported function headers@
>=
30115 int mp_run
(MP mp
);
30116 int mp_execute
(MP mp
, char
*s
, size_t l
);
30117 int mp_finish
(MP mp
);
30118 char
*mp_metapost_version
(void
);void mp_show_library_versions
(void
);
30121 mp_primitive
(mp
, "end", mp_stop
, 0);
30122 @
:end_
}{\
&{end} primitive@>;
30123 mp_primitive
(mp
, "dump", mp_stop
, 1);
30124 mp-
>frozen_dump
= mp_frozen_primitive
(mp
, "dump", mp_stop
, 1);
30125 @
:dump_
}{\
&{dump} primitive@>
30128 @ @
<Cases of |print_cmd...@
>=
30130 if
(cur_mod
() == 0)
30131 mp_print
(mp
, "end");
30133 mp_print
(mp
, "dump");
30137 Let's turn now to statements that are classified as ``commands'' because
30138 of their imperative nature. We'll begin with simple ones
, so that it
30139 will be clear how to hook command processing into the |do_statement| routine
;
30140 then we'll tackle the tougher commands.
30142 Here's one of the simplest
:
30144 @ @
<Declare action procedures for use by |do_statement|@
>=
30145 static void mp_do_random_seed
(MP mp
);
30147 void mp_do_random_seed
(MP mp
) {
30149 memset
(&new_expr,0,sizeof(mp_value));
30150 new_number
(new_expr.data.n
);
30151 mp_get_x_next
(mp
);
30152 if
(cur_cmd
() != mp_assignment
) {
30153 const char
*hlp
[] = { "Always say `randomseed:=<numeric expression>'.", NULL };
30154 mp_back_error
(mp
, "Missing `:=' has been inserted", hlp
, true
);
30157 mp_get_x_next
(mp
);
30158 mp_scan_expression
(mp
);
30159 if
(mp-
>cur_exp.type
!= mp_known
) {
30160 const char
*hlp
[] = {
30161 "Your expression was too random for me to handle,",
30162 "so I won't change the random seed just now.",
30164 mp_disp_err
(mp
, NULL);
30165 mp_back_error
(mp
, "Unknown value will be ignored", hlp
, true
);
30166 @.Unknown value...ignored@
>;
30167 mp_get_x_next
(mp
);
30168 mp_flush_cur_exp
(mp
, new_expr
);
30170 @
<Initialize the random seed to |cur_exp|@
>;
30175 @ @
<Initialize the random seed to |cur_exp|@
>=
30177 init_randoms
(number_to_scaled
(cur_exp_value_number
()));
30178 if
(mp-
>selector
>= log_only
&& mp->selector < write_file) {
30179 mp-
>old_setting
= mp-
>selector
;
30180 mp-
>selector
= log_only
;
30181 mp_print_nl
(mp
, "{randomseed:=");
30182 print_number
(cur_exp_value_number
());
30183 mp_print_char
(mp
, xord
('
}'
));
30184 mp_print_nl
(mp
, "");
30185 mp-
>selector
= mp-
>old_setting
;
30190 @ And here's another simple one
(somewhat different in flavor
):
30193 mp_primitive
(mp
, "batchmode", mp_mode_command
, mp_batch_mode
);
30194 @
:mp_batch_mode_
}{\
&{batchmode} primitive@>;
30195 mp_primitive
(mp
, "nonstopmode", mp_mode_command
, mp_nonstop_mode
);
30196 @
:mp_nonstop_mode_
}{\
&{nonstopmode} primitive@>;
30197 mp_primitive
(mp
, "scrollmode", mp_mode_command
, mp_scroll_mode
);
30198 @
:mp_scroll_mode_
}{\
&{scrollmode} primitive@>;
30199 mp_primitive
(mp
, "errorstopmode", mp_mode_command
, mp_error_stop_mode
);
30200 @
:mp_error_stop_mode_
}{\
&{errorstopmode} primitive@>
30203 @ @
<Cases of |print_cmd_mod|...@
>=
30204 case mp_mode_command
:
30206 case mp_batch_mode
:
30207 mp_print
(mp
, "batchmode");
30209 case mp_nonstop_mode
:
30210 mp_print
(mp
, "nonstopmode");
30212 case mp_scroll_mode
:
30213 mp_print
(mp
, "scrollmode");
30216 mp_print
(mp
, "errorstopmode");
30221 @ The `\
&{inner}' and `\&{outer}' commands are only slightly harder.
30224 mp_primitive
(mp
, "inner", mp_protection_command
, 0);
30225 @
:inner_
}{\
&{inner} primitive@>;
30226 mp_primitive
(mp
, "outer", mp_protection_command
, 1);
30227 @
:outer_
}{\
&{outer} primitive@>
30230 @ @
<Cases of |print_cmd...@
>=
30231 case mp_protection_command
:
30233 mp_print
(mp
, "inner");
30235 mp_print
(mp
, "outer");
30238 @ @
<Declare action procedures for use by |do_statement|@
>=
30239 static void mp_do_protection
(MP mp
);
30242 void mp_do_protection
(MP mp
) {
30243 int m
; /* 0 to unprotect
, 1 to protect
*/
30244 halfword t
; /* the |eq_type| before we change it
*/
30247 mp_get_symbol
(mp
);
30248 t
= eq_type
(cur_sym
());
30250 if
(t
>= mp_outer_tag
)
30251 set_eq_type
(cur_sym
(), (t
- mp_outer_tag
));
30252 } else if
(t
< mp_outer_tag
) {
30253 set_eq_type
(cur_sym
(), (t
+ mp_outer_tag
));
30255 mp_get_x_next
(mp
);
30256 } while
(cur_cmd
() == mp_comma
);
30260 @ \MP\ never defines the tokens `\.
(' and `\.
)' to be primitives
, but
30261 plain \MP\ begins with the declaration `\
&{delimiters} \.{()}'. Such a
30262 declaration assigns the command code |left_delimiter| to `\.
{(}' and
30263 |right_delimiter| to `\.
{)}'
; the |equiv| of each delimiter is the
30264 hash address of its mate.
30266 @ @
<Declare action procedures for use by |do_statement|@
>=
30267 static void mp_def_delims
(MP mp
);
30270 void mp_def_delims
(MP mp
) {
30271 mp_sym l_delim
, r_delim
; /* the new delimiter pair
*/
30272 mp_get_clear_symbol
(mp
);
30273 l_delim
= cur_sym
();
30274 mp_get_clear_symbol
(mp
);
30275 r_delim
= cur_sym
();
30276 set_eq_type
(l_delim
, mp_left_delimiter
);
30277 set_equiv_sym
(l_delim
, r_delim
);
30278 set_eq_type
(r_delim
, mp_right_delimiter
);
30279 set_equiv_sym
(r_delim
, l_delim
);
30280 mp_get_x_next
(mp
);
30284 @ Here is a procedure that is called when \MP\ has reached a point
30285 where some right delimiter is mandatory.
30288 static void mp_check_delimiter
(MP mp
, mp_sym l_delim
, mp_sym r_delim
);
30291 void mp_check_delimiter
(MP mp
, mp_sym l_delim
, mp_sym r_delim
) {
30292 if
(cur_cmd
() == mp_right_delimiter
)
30293 if
(equiv_sym
(cur_sym
()) == l_delim
)
30295 if
(cur_sym
() != r_delim
) {
30297 const char
*hlp
[] = {
30298 "I found no right delimiter to match a left one. So I've",
30299 "put one in, behind the scenes; this may fix the problem.",
30301 mp_snprintf
(msg
, 256, "Missing `%s' has been inserted", mp_str
(mp
, text
(r_delim
)));
30303 mp_back_error
(mp
, msg
, hlp
, true
);
30306 const char
*hlp
[] = {
30307 "Strange: This token has lost its former meaning!",
30308 "I'll read it as a right delimiter this time;",
30309 "but watch out, I'll probably miss it later.",
30311 mp_snprintf
(msg
, 256, "The token `%s' is no longer a right delimiter", mp_str
(mp
, text
(r_delim
)));
30312 @.The token...delimiter@
>;
30313 mp_error
(mp
, msg
, hlp
, true
);
30318 @ The next four commands save or change the values associated with tokens.
30320 @ @
<Declare action procedures for use by |do_statement|@
>=
30321 static void mp_do_statement
(MP mp
);
30322 static void mp_do_interim
(MP mp
);
30325 void mp_do_interim
(MP mp
) {
30326 mp_get_x_next
(mp
);
30327 if
(cur_cmd
() != mp_internal_quantity
) {
30329 const char
*hlp
[] = {
30330 "Something like `tracingonline' should follow `interim'.",
30332 mp_snprintf
(msg
, 256, "The token `%s' isn't an internal quantity",
30333 (cur_sym
() == NULL ?
"(%CAPSULE)" : mp_str
(mp
, text
(cur_sym
()))));
30334 @.The token...quantity@
>;
30335 mp_back_error
(mp
, msg
, hlp
, true
);
30337 mp_save_internal
(mp
, cur_mod
());
30338 mp_back_input
(mp
);
30340 mp_do_statement
(mp
);
30344 @ The following procedure is careful not to undefine the left-hand symbol
30345 too soon
, lest commands like `
{\tt let x
=x
}' have a surprising effect.
30347 @
<Declare action procedures for use by |do_statement|@
>=
30348 static void mp_do_let
(MP mp
);
30351 void mp_do_let
(MP mp
) {
30352 mp_sym l
; /* hash location of the left-hand symbol
*/
30353 mp_get_symbol
(mp
);
30355 mp_get_x_next
(mp
);
30356 if
(cur_cmd
() != mp_equals
&& cur_cmd() != mp_assignment) {
30357 const char
*hlp
[] = {
30358 "You should have said `let symbol = something'.",
30359 "But don't worry; I'll pretend that an equals sign",
30360 "was present. The next token I read will be `something'.",
30362 mp_back_error
(mp
, "Missing `=' has been inserted", hlp
, true
);
30365 mp_get_symbol
(mp
);
30366 switch
(cur_cmd
()) {
30367 case mp_defined_macro
:
30368 case mp_secondary_primary_macro
:
30369 case mp_tertiary_secondary_macro
:
30370 case mp_expression_tertiary_macro
:
30371 add_mac_ref
(cur_mod_node
());
30376 mp_clear_symbol
(mp
, l
, false
);
30377 set_eq_type
(l
, cur_cmd
());
30378 if
(cur_cmd
() == mp_tag_token
)
30379 set_equiv
(l
, 0); /* todo
: this was |null|
*/
30380 else if
(cur_cmd
() == mp_defined_macro ||
30381 cur_cmd
() == mp_secondary_primary_macro ||
30382 cur_cmd
() == mp_tertiary_secondary_macro ||
30383 cur_cmd
() == mp_expression_tertiary_macro
)
30384 set_equiv_node
(l
, cur_mod_node
());
30385 else if
(cur_cmd
() == mp_left_delimiter ||
30386 cur_cmd
() == mp_right_delimiter
)
30387 set_equiv_sym
(l
, equiv_sym
(cur_sym
()));
30389 set_equiv
(l
, cur_mod
());
30390 mp_get_x_next
(mp
);
30394 @ @
<Declarations@
>=
30395 static void mp_do_new_internal
(MP mp
);
30397 @ @
<Internal library ...@
>=
30398 void mp_grow_internals
(MP mp
, int l
);
30401 void mp_grow_internals
(MP mp
, int l
) {
30402 mp_internal
*internal
;
30404 if
(l
> max_halfword
) {
30405 mp_confusion
(mp
, "out of memory space"); /* can't be reached
*/
30407 internal
= xmalloc
((l
+ 1), sizeof
(mp_internal
));
30408 for
(k
= 0; k
<= l
; k
++) {
30409 if
(k
<= mp-
>max_internal
) {
30410 memcpy
(internal
+ k
, mp-
>internal
+ k
, sizeof
(mp_internal
));
30412 memset
(internal
+ k
, 0, sizeof
(mp_internal
));
30413 new_number
(((mp_internal
*)(internal
+ k
))->v.data.n
);
30416 xfree
(mp-
>internal
);
30417 mp-
>internal
= internal
;
30418 mp-
>max_internal
= l
;
30420 void mp_do_new_internal
(MP mp
) {
30421 int the_type
= mp_known
;
30422 mp_get_x_next
(mp
);
30423 if
(cur_cmd
() == mp_type_name
&& cur_mod() == mp_string_type) {
30424 the_type
= mp_string_type
;
30426 if
(!(cur_cmd
() == mp_type_name
&& cur_mod() == mp_numeric_type)) {
30427 mp_back_input
(mp
);
30431 if
(mp-
>int_ptr
== mp-
>max_internal
) {
30432 mp_grow_internals
(mp
, (mp-
>max_internal
+ (mp-
>max_internal
/ 4)));
30434 mp_get_clear_symbol
(mp
);
30435 incr
(mp-
>int_ptr
);
30436 set_eq_type
(cur_sym
(), mp_internal_quantity
);
30437 set_equiv
(cur_sym
(), mp-
>int_ptr
);
30438 if
(internal_name
(mp-
>int_ptr
) != NULL)
30439 xfree
(internal_name
(mp-
>int_ptr
));
30440 set_internal_name
(mp-
>int_ptr
,
30441 mp_xstrdup
(mp
, mp_str
(mp
, text
(cur_sym
()))));
30442 if
(the_type
== mp_string_type
) {
30443 set_internal_string
(mp-
>int_ptr
, mp_rts
(mp
,""));
30445 set_number_to_zero
(internal_value
(mp-
>int_ptr
));
30447 set_internal_type
(mp-
>int_ptr
, the_type
);
30448 mp_get_x_next
(mp
);
30449 } while
(cur_cmd
() == mp_comma
);
30453 @ @
<Dealloc variables@
>=
30454 for
(k
= 0; k
<= mp-
>max_internal
; k
++) {
30455 free_number
(mp-
>internal
[k
].v.data.n
);
30456 xfree
(internal_name
(k
));
30458 xfree
(mp-
>internal
);
30461 @ The various `\
&{show}' commands are distinguished by modifier fields
30464 @d show_token_code
0 /* show the meaning of a single token
*/
30465 @d show_stats_code
1 /* show current memory and string usage
*/
30466 @d show_code
2 /* show a list of expressions
*/
30467 @d show_var_code
3 /* show a variable and its descendents
*/
30468 @d show_dependencies_code
4 /* show dependent variables in terms of independents
*/
30471 mp_primitive
(mp
, "showtoken", mp_show_command
, show_token_code
);
30472 @
:show_token_
}{\
&{showtoken} primitive@>;
30473 mp_primitive
(mp
, "showstats", mp_show_command
, show_stats_code
);
30474 @
:show_stats_
}{\
&{showstats} primitive@>;
30475 mp_primitive
(mp
, "show", mp_show_command
, show_code
);
30476 @
:show_
}{\
&{show} primitive@>;
30477 mp_primitive
(mp
, "showvariable", mp_show_command
, show_var_code
);
30478 @
:show_var_
}{\
&{showvariable} primitive@>;
30479 mp_primitive
(mp
, "showdependencies", mp_show_command
, show_dependencies_code
);
30480 @
:show_dependencies_
}{\
&{showdependencies} primitive@>
30483 @ @
<Cases of |print_cmd...@
>=
30484 case mp_show_command
:
30486 case show_token_code
:
30487 mp_print
(mp
, "showtoken");
30489 case show_stats_code
:
30490 mp_print
(mp
, "showstats");
30493 mp_print
(mp
, "show");
30495 case show_var_code
:
30496 mp_print
(mp
, "showvariable");
30499 mp_print
(mp
, "showdependencies");
30504 @ The value of |cur_mod| controls the |verbosity| in the |print_exp| routine
:
30505 if it's |show_code|
, complicated structures are abbreviated
, otherwise
30508 @
<Declare action procedures for use by |do_statement|@
>=
30509 static void mp_do_show
(MP mp
);
30512 void mp_do_show
(MP mp
) {
30515 memset
(&new_expr,0,sizeof(mp_value));
30516 new_number
(new_expr.data.n
);
30517 mp_get_x_next
(mp
);
30518 mp_scan_expression
(mp
);
30519 mp_print_nl
(mp
, ">> ");
30521 mp_print_exp
(mp
, NULL, 2);
30522 mp_flush_cur_exp
(mp
, new_expr
);
30523 } while
(cur_cmd
() == mp_comma
);
30527 @ @
<Declare action procedures for use by |do_statement|@
>=
30528 static void mp_disp_token
(MP mp
);
30531 void mp_disp_token
(MP mp
) {
30532 mp_print_nl
(mp
, "> ");
30534 if
(cur_sym
() == NULL) {
30535 @
<Show a numeric or string or capsule token@
>;
30537 mp_print_text
(cur_sym
());
30538 mp_print_char
(mp
, xord
('
='
));
30539 if
(eq_type
(cur_sym
()) >= mp_outer_tag
)
30540 mp_print
(mp
, "(outer) ");
30541 mp_print_cmd_mod
(mp
, cur_cmd
(), cur_mod
());
30542 if
(cur_cmd
() == mp_defined_macro
) {
30544 mp_show_macro
(mp
, cur_mod_node
(), NULL, 100000);
30545 } /* this avoids recursion between |show_macro| and |print_cmd_mod|
*/
30551 @ @
<Show a numeric or string or capsule token@
>=
30553 if
(cur_cmd
() == mp_numeric_token
) {
30554 print_number
(cur_mod_number
());
30555 } else if
(cur_cmd
() == mp_capsule_token
) {
30556 mp_print_capsule
(mp
, cur_mod_node
());
30558 mp_print_char
(mp
, xord
('
"'));
30559 mp_print_str (mp, cur_mod_str());
30560 mp_print_char (mp, xord ('"'
));
30561 delete_str_ref
(cur_mod_str
());
30566 @ The following cases of |print_cmd_mod| might arise in connection
30567 with |disp_token|
, although they don't necessarily correspond to
30570 @
<Cases of |print_cmd_...@
>=
30571 case mp_left_delimiter
:
30572 case mp_right_delimiter
:
30573 if
(c
== mp_left_delimiter
)
30574 mp_print
(mp
, "left");
30576 mp_print
(mp
, "right");
30578 mp_print
(mp
, " delimiter that matches ");
30581 mp_print
(mp
, " delimiter");
30585 if
(m
== 0) /* todo
: this was |null|
*/
30586 mp_print
(mp
, "tag");
30588 mp_print
(mp
, "variable");
30590 case mp_defined_macro
:
30591 mp_print
(mp
, "macro:");
30593 case mp_secondary_primary_macro
:
30594 case mp_tertiary_secondary_macro
:
30595 case mp_expression_tertiary_macro
:
30596 mp_print_cmd_mod
(mp
, mp_macro_def
,c
);
30597 mp_print
(mp
, "'d macro:");
30599 mp_show_token_list
(mp
, mp_link
(mp_link
(cur_mod_node
())),0,1000,0);
30601 case mp_repeat_loop
:
30602 mp_print
(mp
, "[repeat the loop]");
30604 case mp_internal_quantity
:
30605 mp_print
(mp
, internal_name
(m
));
30609 @ @
<Declare action procedures for use by |do_statement|@
>=
30610 static void mp_do_show_token
(MP mp
);
30613 void mp_do_show_token
(MP mp
) {
30616 mp_disp_token
(mp
);
30617 mp_get_x_next
(mp
);
30618 } while
(cur_cmd
() == mp_comma
);
30622 @ @
<Declare action procedures for use by |do_statement|@
>=
30623 static void mp_do_show_stats
(MP mp
);
30626 void mp_do_show_stats
(MP mp
) {
30627 mp_print_nl
(mp
, "Memory usage ");
30628 @.Memory usage...@
>;
30629 mp_print_int
(mp
, (integer
) mp-
>var_used
);
30631 mp_print_nl
(mp
, "String usage ");
30632 mp_print_int
(mp
, (int
) mp-
>strs_in_use
);
30633 mp_print_char
(mp
, xord
('
&'));
30634 mp_print_int
(mp
, (int
) mp-
>pool_in_use
);
30636 mp_get_x_next
(mp
);
30640 @ Here's a recursive procedure that gives an abbreviated account
30641 of a variable
, for use by |do_show_var|.
30643 @
<Declare action procedures for use by |do_statement|@
>=
30644 static void mp_disp_var
(MP mp
, mp_node p
);
30647 void mp_disp_var
(MP mp
, mp_node p
) {
30648 mp_node q
; /* traverses attributes and subscripts
*/
30649 int n
; /* amount of macro text to show
*/
30650 if
(mp_type
(p
) == mp_structured
) {
30651 @
<Descend the structure@
>;
30652 } else if
(mp_type
(p
) >= mp_unsuffixed_macro
) {
30653 @
<Display a variable macro@
>;
30654 } else if
(mp_type
(p
) != mp_undefined
) {
30655 mp_print_nl
(mp
, "");
30656 mp_print_variable_name
(mp
, p
);
30657 mp_print_char
(mp
, xord
('
='
));
30658 mp_print_exp
(mp
, p
, 0);
30663 @ @
<Descend the structure@
>=
30667 mp_disp_var
(mp
, q
);
30669 } while
(q
!= mp-
>end_attr
);
30670 q
= subscr_head
(p
);
30671 while
(mp_name_type
(q
) == mp_subscr
) {
30672 mp_disp_var
(mp
, q
);
30678 @ @
<Display a variable macro@
>=
30680 mp_print_nl
(mp
, "");
30681 mp_print_variable_name
(mp
, p
);
30682 if
(mp_type
(p
) > mp_unsuffixed_macro
)
30683 mp_print
(mp
, "@@#"); /* |suffixed_macro|
*/
30684 mp_print
(mp
, "=macro:");
30685 if
((int
) mp-
>file_offset
>= mp-
>max_print_line
- 20)
30688 n
= mp-
>max_print_line
- (int
) mp-
>file_offset
- 15;
30689 mp_show_macro
(mp
, value_node
(p
), NULL, n
);
30693 @ @
<Declare action procedures for use by |do_statement|@
>=
30694 static void mp_do_show_var
(MP mp
);
30697 void mp_do_show_var
(MP mp
) {
30700 if
(cur_sym
() != NULL)
30701 if
(cur_sym_mod
() == 0)
30702 if
(cur_cmd
() == mp_tag_token
)
30703 if
(cur_mod
() != 0 || cur_mod_node
()!=NULL) {
30704 mp_disp_var
(mp
, cur_mod_node
());
30707 mp_disp_token
(mp
);
30709 mp_get_x_next
(mp
);
30710 } while
(cur_cmd
() == mp_comma
);
30714 @ @
<Declare action procedures for use by |do_statement|@
>=
30715 static void mp_do_show_dependencies
(MP mp
);
30718 void mp_do_show_dependencies
(MP mp
) {
30719 mp_value_node p
; /* link that runs through all dependencies
*/
30720 p
= (mp_value_node
) mp_link
(mp-
>dep_head
);
30721 while
(p
!= mp-
>dep_head
) {
30722 if
(mp_interesting
(mp
, (mp_node
) p
)) {
30723 mp_print_nl
(mp
, "");
30724 mp_print_variable_name
(mp
, (mp_node
) p
);
30725 if
(mp_type
(p
) == mp_dependent
)
30726 mp_print_char
(mp
, xord
('
='
));
30728 mp_print
(mp
, " = "); /* extra spaces imply proto-dependency
*/
30729 mp_print_dependency
(mp
, (mp_value_node
) dep_list
(p
), mp_type
(p
));
30731 p
= (mp_value_node
) dep_list
(p
);
30732 while
(dep_info
(p
) != NULL)
30733 p
= (mp_value_node
) mp_link
(p
);
30734 p
= (mp_value_node
) mp_link
(p
);
30736 mp_get_x_next
(mp
);
30740 @ Finally we are ready for the procedure that governs all of the
30743 @
<Declare action procedures for use by |do_statement|@
>=
30744 static void mp_do_show_whatever
(MP mp
);
30747 void mp_do_show_whatever
(MP mp
) {
30748 if
(mp-
>interaction
== mp_error_stop_mode
)
30749 wake_up_terminal
();
30750 switch
(cur_mod
()) {
30751 case show_token_code
:
30752 mp_do_show_token
(mp
);
30754 case show_stats_code
:
30755 mp_do_show_stats
(mp
);
30760 case show_var_code
:
30761 mp_do_show_var
(mp
);
30763 case show_dependencies_code
:
30764 mp_do_show_dependencies
(mp
);
30766 } /* there are no other cases
*/
30767 if
(number_positive
(internal_value
(mp_showstopping
))) {
30768 const char
*hlp
[] = {
30769 "This isn't an error message; I'm just showing something.",
30771 if
(mp-
>interaction
< mp_error_stop_mode
) {
30773 decr
(mp-
>error_count
);
30775 if
(cur_cmd
() == mp_semicolon
) {
30776 mp_error
(mp
, "OK", hlp
, true
);
30778 mp_back_error
(mp
, "OK", hlp
, true
);
30779 mp_get_x_next
(mp
);
30786 @ The `\
&{addto}' command needs the following additional primitives:
30788 @d double_path_code
0 /* command modifier for `\
&{doublepath}' */
30789 @d contour_code
1 /* command modifier for `\
&{contour}' */
30790 @d also_code
2 /* command modifier for `\
&{also}' */
30792 @ Pre and postscripts need two new identifiers
:
30794 @d with_mp_pre_script
11
30795 @d with_mp_post_script
13
30798 mp_primitive
(mp
, "doublepath", mp_thing_to_add
, double_path_code
);
30799 @
:double_path_
}{\
&{doublepath} primitive@>;
30800 mp_primitive
(mp
, "contour", mp_thing_to_add
, contour_code
);
30801 @
:contour_
}{\
&{contour} primitive@>;
30802 mp_primitive
(mp
, "also", mp_thing_to_add
, also_code
);
30803 @
:also_
}{\
&{also} primitive@>;
30804 mp_primitive
(mp
, "withpen", mp_with_option
, mp_pen_type
);
30805 @
:with_pen_
}{\
&{withpen} primitive@>;
30806 mp_primitive
(mp
, "dashed", mp_with_option
, mp_picture_type
);
30807 @
:dashed_
}{\
&{dashed} primitive@>;
30808 mp_primitive
(mp
, "withprescript", mp_with_option
, with_mp_pre_script
);
30809 @
:with_mp_pre_script_
}{\
&{withprescript} primitive@>;
30810 mp_primitive
(mp
, "withpostscript", mp_with_option
, with_mp_post_script
);
30811 @
:with_mp_post_script_
}{\
&{withpostscript} primitive@>;
30812 mp_primitive
(mp
, "withoutcolor", mp_with_option
, mp_no_model
);
30813 @
:with_color_
}{\
&{withoutcolor} primitive@>;
30814 mp_primitive
(mp
, "withgreyscale", mp_with_option
, mp_grey_model
);
30815 @
:with_color_
}{\
&{withgreyscale} primitive@>;
30816 mp_primitive
(mp
, "withcolor", mp_with_option
, mp_uninitialized_model
);
30817 @
:with_color_
}{\
&{withcolor} primitive@>
30818 /* \
&{withrgbcolor} is an alias for \&{withcolor} */
30819 mp_primitive
(mp
, "withrgbcolor", mp_with_option
, mp_rgb_model
);
30820 @
:with_color_
}{\
&{withrgbcolor} primitive@>;
30821 mp_primitive
(mp
, "withcmykcolor", mp_with_option
, mp_cmyk_model
);
30822 @
:with_color_
}{\
&{withcmykcolor} primitive@>
30825 @ @
<Cases of |print_cmd...@
>=
30826 case mp_thing_to_add
:
30827 if
(m
== contour_code
)
30828 mp_print
(mp
, "contour");
30829 else if
(m
== double_path_code
)
30830 mp_print
(mp
, "doublepath");
30832 mp_print
(mp
, "also");
30834 case mp_with_option
:
30835 if
(m
== mp_pen_type
)
30836 mp_print
(mp
, "withpen");
30837 else if
(m
== with_mp_pre_script
)
30838 mp_print
(mp
, "withprescript");
30839 else if
(m
== with_mp_post_script
)
30840 mp_print
(mp
, "withpostscript");
30841 else if
(m
== mp_no_model
)
30842 mp_print
(mp
, "withoutcolor");
30843 else if
(m
== mp_rgb_model
)
30844 mp_print
(mp
, "withrgbcolor");
30845 else if
(m
== mp_uninitialized_model
)
30846 mp_print
(mp
, "withcolor");
30847 else if
(m
== mp_cmyk_model
)
30848 mp_print
(mp
, "withcmykcolor");
30849 else if
(m
== mp_grey_model
)
30850 mp_print
(mp
, "withgreyscale");
30852 mp_print
(mp
, "dashed");
30855 @ The |scan_with_list| procedure parses a $\langle$with list$\rangle$ and
30856 updates the list of graphical objects starting at |p|. Each $\langle$with
30857 clause$\rangle$ updates all graphical objects whose |type| is compatible.
30858 Other objects are ignored.
30860 @
<Declare action procedures for use by |do_statement|@
>=
30861 static void mp_scan_with_list
(MP mp
, mp_node p
);
30863 @ Forcing the color to be between |
0| and |unity| here guarantees that no
30864 picture will ever contain a color outside the legal range for \ps\ graphics.
30866 @d make_cp_a_colored_object
() do
{
30868 while
(cp
!= NULL) {
30869 if
(has_color
(cp
))
30875 @d clear_color
(A
) do
{
30876 set_number_to_zero
(((mp_stroked_node
)(A
))->cyan
);
30877 set_number_to_zero
(((mp_stroked_node
)(A
))->magenta
);
30878 set_number_to_zero
(((mp_stroked_node
)(A
))->yellow
);
30879 set_number_to_zero
(((mp_stroked_node
)(A
))->black
);
30880 mp_color_model
((A
)) = mp_uninitialized_model
;
30883 @d set_color_val
(A
,B
) do
{
30884 number_clone
(A
, (B
));
30885 if
(number_negative
(A
))
30886 set_number_to_zero
(A
);
30887 if
(number_greater
(A
,unity_t
))
30888 set_number_to_unity
(A
);
30892 static int is_invalid_with_list
(MP mp
, mp_variable_type t
) {
30893 return
((t
== with_mp_pre_script
) && (mp->cur_exp.type != mp_string_type)) ||
30894 ((t
== with_mp_post_script
) && (mp->cur_exp.type != mp_string_type)) ||
30895 ((t
== (mp_variable_type
) mp_uninitialized_model
) &&
30896 ((mp-
>cur_exp.type
!= mp_cmykcolor_type
)
30897 && (mp->cur_exp.type != mp_color_type)
30898 && (mp->cur_exp.type != mp_known)
30899 && (mp->cur_exp.type != mp_boolean_type))) || ((t == (mp_variable_type) mp_cmyk_model)
30900 && (mp->cur_exp.type !=
30901 mp_cmykcolor_type
))
30902 ||
((t
== (mp_variable_type
) mp_rgb_model
) && (mp->cur_exp.type != mp_color_type))
30903 ||
((t
== (mp_variable_type
) mp_grey_model
) && (mp->cur_exp.type != mp_known))
30904 ||
((t
== (mp_variable_type
) mp_pen_type
) && (mp->cur_exp.type != t))
30905 ||
((t
== (mp_variable_type
) mp_picture_type
) && (mp->cur_exp.type != t));
30907 static void complain_invalid_with_list
(MP mp
, mp_variable_type t
) {
30908 /* Complain about improper type
*/
30910 const char
*hlp
[] = {
30911 "Next time say `withpen <known pen expression>';",
30912 "I'll ignore the bad `with' clause and look for another.",
30914 memset
(&new_expr,0,sizeof(mp_value));
30915 new_number
(new_expr.data.n
);
30916 mp_disp_err
(mp
, NULL);
30917 if
(t
== with_mp_pre_script
)
30918 hlp
[0] = "Next time say `withprescript <known string expression>';";
30919 else if
(t
== with_mp_post_script
)
30920 hlp
[0] = "Next time say `withpostscript <known string expression>';";
30921 else if
(t
== mp_picture_type
)
30922 hlp
[0] = "Next time say `dashed <known picture expression>';";
30923 else if
(t
== (mp_variable_type
) mp_uninitialized_model
)
30924 hlp
[0] = "Next time say `withcolor <known color expression>';";
30925 else if
(t
== (mp_variable_type
) mp_rgb_model
)
30926 hlp
[0] = "Next time say `withrgbcolor <known color expression>';";
30927 else if
(t
== (mp_variable_type
) mp_cmyk_model
)
30928 hlp
[0] = "Next time say `withcmykcolor <known cmykcolor expression>';";
30929 else if
(t
== (mp_variable_type
) mp_grey_model
)
30930 hlp
[0] = "Next time say `withgreyscale <known numeric expression>';";;
30931 mp_back_error
(mp
, "Improper type", hlp
, true
);
30932 mp_get_x_next
(mp
);
30933 mp_flush_cur_exp
(mp
, new_expr
);
30936 void mp_scan_with_list
(MP mp
, mp_node p
) {
30937 mp_variable_type t
; /* |cur_mod| of the |with_option|
(should match |cur_type|
) */
30938 mp_node q
; /* for list manipulation
*/
30939 mp_node cp
, pp
, dp
, ap
, bp
;
30940 /* objects being updated
; |void| initially
; |
NULL| to suppress update
*/
30946 while
(cur_cmd
() == mp_with_option
) {
30947 /* todo this is not very nice
: the color models have their own enumeration
*/
30948 t
= (mp_variable_type
) cur_mod
();
30949 mp_get_x_next
(mp
);
30950 if
(t
!= (mp_variable_type
) mp_no_model
)
30951 mp_scan_expression
(mp
);
30952 if
(is_invalid_with_list
(mp
, t
)) {
30953 complain_invalid_with_list
(mp
, t
);
30956 if
(t
== (mp_variable_type
) mp_uninitialized_model
) {
30958 memset
(&new_expr,0,sizeof(mp_value));
30959 new_number
(new_expr.data.n
);
30961 make_cp_a_colored_object
();
30963 /* Transfer a color from the current expression to object~|cp|
*/
30964 if
(mp-
>cur_exp.type
== mp_color_type
) {
30965 /* Transfer a rgbcolor from the current expression to object~|cp|
*/
30966 mp_stroked_node cp0
= (mp_stroked_node
)cp
;
30967 q
= value_node
(cur_exp_node
());
30969 mp_color_model
(cp
) = mp_rgb_model
;
30970 set_color_val
(cp0-
>red
, value_number
(red_part
(q
)));
30971 set_color_val
(cp0-
>green
, value_number
(green_part
(q
)));
30972 set_color_val
(cp0-
>blue
, value_number
(blue_part
(q
)));
30973 } else if
(mp-
>cur_exp.type
== mp_cmykcolor_type
) {
30974 /* Transfer a cmykcolor from the current expression to object~|cp|
*/
30975 mp_stroked_node cp0
= (mp_stroked_node
)cp
;
30976 q
= value_node
(cur_exp_node
());
30977 set_color_val
(cp0-
>cyan
, value_number
(cyan_part
(q
)));
30978 set_color_val
(cp0-
>magenta
, value_number
(magenta_part
(q
)));
30979 set_color_val
(cp0-
>yellow
, value_number
(yellow_part
(q
)));
30980 set_color_val
(cp0-
>black
, value_number
(black_part
(q
)));
30981 mp_color_model
(cp
) = mp_cmyk_model
;
30982 } else if
(mp-
>cur_exp.type
== mp_known
) {
30983 /* Transfer a greyscale from the current expression to object~|cp|
*/
30985 mp_stroked_node cp0
= (mp_stroked_node
)cp
;
30987 number_clone
(qq
, cur_exp_value_number
());
30989 mp_color_model
(cp
) = mp_grey_model
;
30990 set_color_val
(cp0-
>grey
, qq
);
30992 } else if
(cur_exp_value_boolean
() == mp_false_code
) {
30993 /* Transfer a noncolor from the current expression to object~|cp|
*/
30995 mp_color_model
(cp
) = mp_no_model
;
30996 } else if
(cur_exp_value_boolean
() == mp_true_code
) {
30997 /* Transfer no color from the current expression to object~|cp|
*/
30999 mp_color_model
(cp
) = mp_uninitialized_model
;
31002 mp_flush_cur_exp
(mp
, new_expr
);
31003 } else if
(t
== (mp_variable_type
) mp_rgb_model
) {
31005 memset
(&new_expr,0,sizeof(mp_value));
31006 new_number
(new_expr.data.n
);
31008 make_cp_a_colored_object
();
31010 /* Transfer a rgbcolor from the current expression to object~|cp|
*/
31011 mp_stroked_node cp0
= (mp_stroked_node
)cp
;
31012 q
= value_node
(cur_exp_node
());
31014 mp_color_model
(cp
) = mp_rgb_model
;
31015 set_color_val
(cp0-
>red
, value_number
(red_part
(q
)));
31016 set_color_val
(cp0-
>green
, value_number
(green_part
(q
)));
31017 set_color_val
(cp0-
>blue
, value_number
(blue_part
(q
)));
31019 mp_flush_cur_exp
(mp
, new_expr
);
31020 } else if
(t
== (mp_variable_type
) mp_cmyk_model
) {
31022 memset
(&new_expr,0,sizeof(mp_value));
31023 new_number
(new_expr.data.n
);
31025 make_cp_a_colored_object
();
31027 /* Transfer a cmykcolor from the current expression to object~|cp|
*/
31028 mp_stroked_node cp0
= (mp_stroked_node
)cp
;
31029 q
= value_node
(cur_exp_node
());
31030 set_color_val
(cp0-
>cyan
, value_number
(cyan_part
(q
)));
31031 set_color_val
(cp0-
>magenta
, value_number
(magenta_part
(q
)));
31032 set_color_val
(cp0-
>yellow
, value_number
(yellow_part
(q
)));
31033 set_color_val
(cp0-
>black
, value_number
(black_part
(q
)));
31034 mp_color_model
(cp
) = mp_cmyk_model
;
31036 mp_flush_cur_exp
(mp
, new_expr
);
31037 } else if
(t
== (mp_variable_type
) mp_grey_model
) {
31039 memset
(&new_expr,0,sizeof(mp_value));
31040 new_number
(new_expr.data.n
);
31042 make_cp_a_colored_object
();
31044 /* Transfer a greyscale from the current expression to object~|cp|
*/
31046 mp_stroked_node cp0
= (mp_stroked_node
)cp
;
31048 number_clone
(qq
, cur_exp_value_number
());
31050 mp_color_model
(cp
) = mp_grey_model
;
31051 set_color_val
(cp0-
>grey
, qq
);
31054 mp_flush_cur_exp
(mp
, new_expr
);
31055 } else if
(t
== (mp_variable_type
) mp_no_model
) {
31057 make_cp_a_colored_object
();
31059 /* Transfer a noncolor from the current expression to object~|cp|
*/
31061 mp_color_model
(cp
) = mp_no_model
;
31063 } else if
(t
== mp_pen_type
) {
31064 if
(pp
== MP_VOID
) {
31065 /* Make |pp| an object in list~|p| that needs a pen
*/
31067 while
(pp
!= NULL) {
31075 switch
(mp_type
(pp
)) {
31076 case mp_fill_node_type
:
31077 if
(mp_pen_p
((mp_fill_node
) pp
) != NULL)
31078 mp_toss_knot_list
(mp
, mp_pen_p
((mp_fill_node
) pp
));
31079 mp_pen_p
((mp_fill_node
) pp
) = cur_exp_knot
();
31081 case mp_stroked_node_type
:
31082 if
(mp_pen_p
((mp_stroked_node
) pp
) != NULL)
31083 mp_toss_knot_list
(mp
, mp_pen_p
((mp_stroked_node
) pp
));
31084 mp_pen_p
((mp_stroked_node
) pp
) = cur_exp_knot
();
31090 mp-
>cur_exp.type
= mp_vacuous
;
31092 } else if
(t
== with_mp_pre_script
) {
31093 if
(cur_exp_str
()->len
) {
31096 while
((ap
!= NULL) && (!has_color (ap)))
31099 if
(mp_pre_script
(ap
) != NULL) { /* build a new
,combined string
*/
31100 unsigned old_setting
; /* saved |selector| setting
*/
31101 mp_string s
; /* for string cleanup after combining
*/
31102 s
= mp_pre_script
(ap
);
31103 old_setting
= mp-
>selector
;
31104 mp-
>selector
= new_string
;
31105 str_room
(mp_pre_script
(ap
)->len
+ cur_exp_str
()->len
+ 2);
31106 mp_print_str
(mp
, cur_exp_str
());
31107 append_char
(13); /* a forced \ps\ newline
*/
31108 mp_print_str
(mp
, mp_pre_script
(ap
));
31109 mp_pre_script
(ap
) = mp_make_string
(mp
);
31110 delete_str_ref
(s
);
31111 mp-
>selector
= old_setting
;
31113 mp_pre_script
(ap
) = cur_exp_str
();
31115 add_str_ref
(mp_pre_script
(ap
));
31116 mp-
>cur_exp.type
= mp_vacuous
;
31119 } else if
(t
== with_mp_post_script
) {
31120 if
(cur_exp_str
()->len
) {
31121 mp_node k
= NULL; /* for finding the near-last item in a list
*/
31125 while
(k
&& mp_link (k) != NULL) { /* clang: dereference null pointer 'k' */
31131 if
(mp_post_script
(bp
) != NULL) {
31132 unsigned old_setting
; /* saved |selector| setting
*/
31133 mp_string s
; /* for string cleanup after combining
*/
31134 s
= mp_post_script
(bp
);
31135 old_setting
= mp-
>selector
;
31136 mp-
>selector
= new_string
;
31137 str_room
(mp_post_script
(bp
)->len
+ cur_exp_str
()->len
+ 2);
31138 mp_print_str
(mp
, mp_post_script
(bp
));
31139 append_char
(13); /* a forced \ps\ newline
*/
31140 mp_print_str
(mp
, cur_exp_str
());
31141 mp_post_script
(bp
) = mp_make_string
(mp
);
31142 delete_str_ref
(s
);
31143 mp-
>selector
= old_setting
;
31145 mp_post_script
(bp
) = cur_exp_str
();
31147 add_str_ref
(mp_post_script
(bp
));
31148 mp-
>cur_exp.type
= mp_vacuous
;
31152 if
(dp
== MP_VOID
) {
31153 /* Make |dp| a stroked node in list~|p|
*/
31155 while
(dp
!= NULL) {
31156 if
(mp_type
(dp
) == mp_stroked_node_type
)
31162 if
(mp_dash_p
(dp
) != NULL)
31163 delete_edge_ref
(mp_dash_p
(dp
));
31164 mp_dash_p
(dp
) = (mp_node
)mp_make_dashes
(mp
, (mp_edge_header_node
)cur_exp_node
());
31165 set_number_to_unity
(((mp_stroked_node
)dp
)->dash_scale
);
31166 mp-
>cur_exp.type
= mp_vacuous
;
31170 /* Copy the information from objects |cp|
, |pp|
, and |dp| into the rest
31172 if
(cp
> MP_VOID
) {
31173 /* Copy |cp|'s color into the colored objects linked to~|cp|
*/
31175 while
(q
!= NULL) {
31176 if
(has_color
(q
)) {
31177 mp_stroked_node q0
= (mp_stroked_node
)q
;
31178 mp_stroked_node cp0
= (mp_stroked_node
)cp
;
31179 number_clone
(q0-
>red
, cp0-
>red
);
31180 number_clone
(q0-
>green
, cp0-
>green
);
31181 number_clone
(q0-
>blue
, cp0-
>blue
);
31182 number_clone
(q0-
>black
, cp0-
>black
);
31183 mp_color_model
(q
) = mp_color_model
(cp
);
31188 if
(pp
> MP_VOID
) {
31189 /* Copy |mp_pen_p
(pp
)| into stroked and filled nodes linked to |pp|
*/
31191 while
(q
!= NULL) {
31193 switch
(mp_type
(q
)) {
31194 case mp_fill_node_type
:
31195 if
(mp_pen_p
((mp_fill_node
) q
) != NULL)
31196 mp_toss_knot_list
(mp
, mp_pen_p
((mp_fill_node
) q
));
31197 mp_pen_p
((mp_fill_node
) q
) = copy_pen
(mp_pen_p
((mp_fill_node
) pp
));
31199 case mp_stroked_node_type
:
31200 if
(mp_pen_p
((mp_stroked_node
) q
) != NULL)
31201 mp_toss_knot_list
(mp
, mp_pen_p
((mp_stroked_node
) q
));
31202 mp_pen_p
((mp_stroked_node
) q
) =
31203 copy_pen
(mp_pen_p
((mp_stroked_node
) pp
));
31213 if
(dp
> MP_VOID
) {
31214 /* Make stroked nodes linked to |dp| refer to |mp_dash_p
(dp
)|
*/
31216 while
(q
!= NULL) {
31217 if
(mp_type
(q
) == mp_stroked_node_type
) {
31218 if
(mp_dash_p
(q
) != NULL)
31219 delete_edge_ref
(mp_dash_p
(q
));
31220 mp_dash_p
(q
) = mp_dash_p
(dp
);
31221 set_number_to_unity
(((mp_stroked_node
)q
)->dash_scale
);
31222 if
(mp_dash_p
(q
) != NULL)
31223 add_edge_ref
(mp_dash_p
(q
));
31231 @ One of the things we need to do when we've parsed an \
&{addto} or
31232 similar command is find the header of a supposed \
&{picture} variable, given
31233 a token list for that variable. Since the edge structure is about to be
31234 updated
, we use |private_edges| to make sure that this is possible.
31236 @
<Declare action procedures for use by |do_statement|@
>=
31237 static mp_edge_header_node mp_find_edges_var
(MP mp
, mp_node t
);
31240 mp_edge_header_node mp_find_edges_var
(MP mp
, mp_node t
) {
31242 mp_edge_header_node cur_edges
; /* the return value
*/
31243 p
= mp_find_variable
(mp
, t
);
31246 const char
*hlp
[] = {
31247 "It seems you did a nasty thing---probably by accident,",
31248 "but nevertheless you nearly hornswoggled me...",
31249 "While I was evaluating the right-hand side of this",
31250 "command, something happened, and the left-hand side",
31251 "is no longer a variable! So I won't change anything.",
31253 char
*msg
= mp_obliterated
(mp
, t
);
31254 mp_back_error
(mp
, msg
, hlp
, true
);
31256 mp_get_x_next
(mp
);
31257 } else if
(mp_type
(p
) != mp_picture_type
) {
31260 int old_setting
= mp-
>selector
;
31261 const char
*hlp
[] = {
31262 "I was looking for a \"known\
" picture variable.",
31263 "So I'll not change anything just now.",
31265 mp-
>selector
= new_string
;
31266 mp_show_token_list
(mp
, t
, NULL, 1000, 0);
31267 sname
= mp_make_string
(mp
);
31268 mp-
>selector
= old_setting
;
31269 mp_snprintf
(msg
, 256, "Variable %s is the wrong type(%s)",
31270 mp_str
(mp
, sname
), mp_type_string
(mp_type
(p
)));
31271 @.Variable x is the wrong type@
>;
31272 delete_str_ref
(sname
);
31273 mp_back_error
(mp
, msg
, hlp
, true
);
31274 mp_get_x_next
(mp
);
31276 set_value_node
(p
, (mp_node
)mp_private_edges
(mp
, (mp_edge_header_node
)value_node
(p
)));
31277 cur_edges
= (mp_edge_header_node
)value_node
(p
);
31279 mp_flush_node_list
(mp
, t
);
31285 mp_primitive
(mp
, "clip", mp_bounds_command
, mp_start_clip_node_type
);
31286 @
:clip_
}{\
&{clip} primitive@>;
31287 mp_primitive
(mp
, "setbounds", mp_bounds_command
, mp_start_bounds_node_type
);
31288 @
:set_bounds_
}{\
&{setbounds} primitive@>
31291 @ @
<Cases of |print_cmd...@
>=
31292 case mp_bounds_command
:
31293 if
(m
== mp_start_clip_node_type
)
31294 mp_print
(mp
, "clip");
31296 mp_print
(mp
, "setbounds");
31299 @ The following function parses the beginning of an \
&{addto} or \&{clip}
31300 command
: it expects a variable name followed by a token with |cur_cmd
=sep|
31301 and then an expression. The function returns the token list for the variable
31302 and stores the command modifier for the separator token in the global variable
31303 |last_add_type|. We must be careful because this variable might get overwritten
31304 any time we call |get_x_next|.
31307 quarterword last_add_type
;
31308 /* command modifier that identifies the last \
&{addto} command */
31310 @ @
<Declare action procedures for use by |do_statement|@
>=
31311 static mp_node mp_start_draw_cmd
(MP mp
, quarterword sep
);
31314 mp_node mp_start_draw_cmd
(MP mp
, quarterword sep
) {
31315 mp_node lhv
; /* variable to add to left
*/
31316 quarterword add_type
= 0; /* value to be returned in |last_add_type|
*/
31318 mp_get_x_next
(mp
);
31319 mp-
>var_flag
= sep
;
31320 mp_scan_primary
(mp
);
31321 if
(mp-
>cur_exp.type
!= mp_token_list
) {
31322 /* Abandon edges command because there's no variable
*/
31324 const char
*hlp
[] = {
31325 "At this point I needed to see the name of a picture variable.",
31326 "(Or perhaps you have indeed presented me with one; I might",
31327 "have missed it, if it wasn't followed by the proper token.)",
31328 "So I'll not change anything just now.",
31330 memset
(&new_expr,0,sizeof(mp_value));
31331 new_number
(new_expr.data.n
);
31332 mp_disp_err
(mp
, NULL);
31333 set_number_to_zero
(new_expr.data.n
);
31334 mp_back_error
(mp
, "Not a suitable variable", hlp
, true
);
31335 mp_get_x_next
(mp
);
31336 mp_flush_cur_exp
(mp
, new_expr
);
31338 lhv
= cur_exp_node
();
31339 add_type
= (quarterword
) cur_mod
();
31340 mp-
>cur_exp.type
= mp_vacuous
;
31341 mp_get_x_next
(mp
);
31342 mp_scan_expression
(mp
);
31344 mp-
>last_add_type
= add_type
;
31348 @ Here is an example of how to use |start_draw_cmd|.
31350 @
<Declare action procedures for use by |do_statement|@
>=
31351 static void mp_do_bounds
(MP mp
);
31354 void mp_do_bounds
(MP mp
) {
31355 mp_node lhv
; /* variable on left
, the corresponding edge structure
*/
31356 mp_edge_header_node lhe
;
31357 mp_node p
; /* for list manipulation
*/
31358 integer m
; /* initial value of |cur_mod|
*/
31360 lhv
= mp_start_draw_cmd
(mp
, mp_to_token
);
31363 memset
(&new_expr,0,sizeof(mp_value));
31364 lhe
= mp_find_edges_var
(mp
, lhv
);
31366 new_number
(new_expr.data.n
);
31367 set_number_to_zero
(new_expr.data.n
);
31368 mp_flush_cur_exp
(mp
, new_expr
);
31369 } else if
(mp-
>cur_exp.type
!= mp_path_type
) {
31370 const char
*hlp
[] ={
31371 "This expression should have specified a known path.",
31372 "So I'll not change anything just now.",
31374 mp_disp_err
(mp
, NULL);
31375 new_number
(new_expr.data.n
);
31376 set_number_to_zero
(new_expr.data.n
);
31377 mp_back_error
(mp
, "Improper `clip'", hlp
, true
);
31378 mp_get_x_next
(mp
);
31379 mp_flush_cur_exp
(mp
, new_expr
);
31380 } else if
(mp_left_type
(cur_exp_knot
()) == mp_endpoint
) {
31381 /* Complain about a non-cycle
*/
31382 const char
*hlp
[] = {
31383 "That contour should have ended with `..cycle' or `&cycle'.",
31384 "So I'll not change anything just now.",
31386 mp_back_error
(mp
, "Not a cycle" , hlp
, true
);
31387 mp_get_x_next
(mp
);
31389 /* Make |cur_exp| into a \
&{setbounds} or clipping path and add it to |lhe| */
31390 p
= mp_new_bounds_node
(mp
, cur_exp_knot
(), (quarterword
) m
);
31391 mp_link
(p
) = mp_link
(edge_list
(lhe
));
31392 mp_link
(edge_list
(lhe
)) = p
;
31393 if
(obj_tail
(lhe
) == edge_list
(lhe
))
31394 obj_tail
(lhe
) = p
;
31395 if
(m
== mp_start_clip_node_type
) {
31396 p
= mp_new_bounds_node
(mp
, NULL, mp_stop_clip_node_type
);
31397 } else if
(m
== mp_start_bounds_node_type
) {
31398 p
= mp_new_bounds_node
(mp
, NULL, mp_stop_bounds_node_type
);
31400 mp_link
(obj_tail
(lhe
)) = p
;
31401 obj_tail
(lhe
) = p
;
31402 mp_init_bbox
(mp
, lhe
);
31408 @ The |do_add_to| procedure is a little like |do_clip| but there are a lot more
31409 cases to deal with.
31411 @
<Declare action procedures for use by |do_statement|@
>=
31412 static void mp_do_add_to
(MP mp
);
31415 void mp_do_add_to
(MP mp
) {
31417 mp_edge_header_node lhe
; /* variable on left
, the corresponding edge structure
*/
31418 mp_node p
; /* the graphical object or list for |scan_with_list| to update
*/
31419 mp_edge_header_node e
; /* an edge structure to be merged
*/
31420 quarterword add_type
; /* |also_code|
, |contour_code|
, or |double_path_code|
*/
31421 lhv
= mp_start_draw_cmd
(mp
, mp_thing_to_add
);
31422 add_type
= mp-
>last_add_type
;
31424 if
(add_type
== also_code
) {
31425 /* Make sure the current expression is a suitable picture and set |e| and |p|
31427 /* Setting |p
:=NULL| causes the $\langle$with list$\rangle$ to be ignored
;
31428 setting |e
:=NULL| prevents anything from being added to |lhe|.
*/
31431 if
(mp-
>cur_exp.type
!= mp_picture_type
) {
31433 const char
*hlp
[]= {
31434 "This expression should have specified a known picture.",
31435 "So I'll not change anything just now.",
31437 memset
(&new_expr,0,sizeof(mp_value));
31438 new_number
(new_expr.data.n
);
31439 mp_disp_err
(mp
, NULL);
31440 set_number_to_zero
(new_expr.data.n
);
31441 mp_back_error
(mp
, "Improper `addto'", hlp
, true
);
31442 mp_get_x_next
(mp
);
31443 mp_flush_cur_exp
(mp
, new_expr
);
31445 e
= mp_private_edges
(mp
, (mp_edge_header_node
)cur_exp_node
());
31446 mp-
>cur_exp.type
= mp_vacuous
;
31447 p
= mp_link
(edge_list
(e
));
31451 /* Create a graphical object |p| based on |add_type| and the current
31453 /* In this case |add_type
<>also_code| so setting |p
:=NULL| suppresses future
31454 attempts to add to the edge structure.
*/
31457 if
(mp-
>cur_exp.type
== mp_pair_type
)
31458 mp_pair_to_path
(mp
);
31459 if
(mp-
>cur_exp.type
!= mp_path_type
) {
31461 const char
*hlp
[] = {
31462 "This expression should have specified a known path.",
31463 "So I'll not change anything just now.",
31465 memset
(&new_expr,0,sizeof(mp_value));
31466 new_number
(new_expr.data.n
);
31467 mp_disp_err
(mp
, NULL);
31468 set_number_to_zero
(new_expr.data.n
);
31469 mp_back_error
(mp
, "Improper `addto'", hlp
, true
);
31470 mp_get_x_next
(mp
);
31471 mp_flush_cur_exp
(mp
, new_expr
);
31472 } else if
(add_type
== contour_code
) {
31473 if
(mp_left_type
(cur_exp_knot
()) == mp_endpoint
) {
31474 /* Complain about a non-cycle
*/
31475 const char
*hlp
[] = {
31476 "That contour should have ended with `..cycle' or `&cycle'.",
31477 "So I'll not change anything just now.",
31479 mp_back_error
(mp
, "Not a cycle" , hlp
, true
);
31480 mp_get_x_next
(mp
);
31483 p
= mp_new_fill_node
(mp
, cur_exp_knot
());
31484 mp-
>cur_exp.type
= mp_vacuous
;
31487 p
= mp_new_stroked_node
(mp
, cur_exp_knot
());
31488 mp-
>cur_exp.type
= mp_vacuous
;
31492 mp_scan_with_list
(mp
, p
);
31493 /* Use |p|
, |e|
, and |add_type| to augment |lhv| as requested
*/
31494 lhe
= mp_find_edges_var
(mp
, lhv
);
31496 if
((e
== NULL) && (p != NULL))
31497 e
= mp_toss_gr_object
(mp
, p
);
31499 delete_edge_ref
(e
);
31500 } else if
(add_type
== also_code
) {
31502 /* Merge |e| into |lhe| and delete |e|
*/
31503 if
(mp_link
(edge_list
(e
)) != NULL) {
31504 mp_link
(obj_tail
(lhe
)) = mp_link
(edge_list
(e
));
31505 obj_tail
(lhe
) = obj_tail
(e
);
31506 obj_tail
(e
) = edge_list
(e
);
31507 mp_link
(edge_list
(e
)) = NULL;
31508 mp_flush_dash_list
(mp
, lhe
);
31510 mp_toss_edges
(mp
, e
);
31512 } else if
(p
!= NULL) {
31513 mp_link
(obj_tail
(lhe
)) = p
;
31514 obj_tail
(lhe
) = p
;
31515 if
(add_type
== double_path_code
) {
31516 if
(mp_pen_p
((mp_stroked_node
) p
) == NULL) {
31517 mp_pen_p
((mp_stroked_node
) p
) = mp_get_pen_circle
(mp
, zero_t
);
31524 @ @
<Declare action procedures for use by |do_statement|@
>=
31525 @
<Declare the \ps\ output procedures@
>;
31526 static void mp_do_ship_out
(MP mp
);
31529 void mp_do_ship_out
(MP mp
) {
31530 integer c
; /* the character code
*/
31532 memset
(&new_expr,0,sizeof(mp_value));
31533 new_number
(new_expr.data.n
);
31534 mp_get_x_next
(mp
);
31535 mp_scan_expression
(mp
);
31536 if
(mp-
>cur_exp.type
!= mp_picture_type
) {
31537 @
<Complain that it's not a known picture@
>;
31539 c
= round_unscaled
(internal_value
(mp_char_code
)) % 256;
31542 @
<Store the width information for character code~|c|@
>;
31543 mp_ship_out
(mp
, cur_exp_node
());
31544 set_number_to_zero
(new_expr.data.n
);
31545 mp_flush_cur_exp
(mp
, new_expr
);
31550 @ @
<Complain that it's not a known picture@
>=
31552 const char
*hlp
[] = { "I can only output known pictures.", NULL };
31553 mp_disp_err
(mp
, NULL);
31554 set_number_to_zero
(new_expr.data.n
);
31555 mp_back_error
(mp
, "Not a known picture", hlp
, true
);
31556 mp_get_x_next
(mp
);
31557 mp_flush_cur_exp
(mp
, new_expr
);
31561 @ The \
&{everyjob} command simply assigns a nonzero value to the global variable
31566 mp_sym start_sym
; /* a symbolic token to insert at beginning of job
*/
31569 mp-
>start_sym
= NULL;
31571 @ Finally
, we have only the ``message'' commands remaining.
31574 @d err_message_code
1
31576 @d filename_template_code
3
31577 @d print_with_leading_zeroes
(A
,B
) do
{
31578 size_t g
= mp-
>cur_length
;
31579 size_t f
= (size_t
)(B
);
31580 mp_print_int
(mp
, (A
));
31581 g
= mp-
>cur_length
- g
;
31583 mp-
>cur_length
= mp-
>cur_length
- g
;
31585 mp_print_char
(mp
, xord
('
0'
));
31588 mp_print_int
(mp
, (A
));
31594 mp_primitive
(mp
, "message", mp_message_command
, message_code
);
31595 @
:message_
}{\
&{message} primitive@>;
31596 mp_primitive
(mp
, "errmessage", mp_message_command
, err_message_code
);
31597 @
:err_message_
}{\
&{errmessage} primitive@>;
31598 mp_primitive
(mp
, "errhelp", mp_message_command
, err_help_code
);
31599 @
:err_help_
}{\
&{errhelp} primitive@>;
31600 mp_primitive
(mp
, "filenametemplate", mp_message_command
, filename_template_code
);
31601 @
:filename_template_
}{\
&{filenametemplate} primitive@>
31604 @ @
<Cases of |print_cmd...@
>=
31605 case mp_message_command
:
31606 if
(m
< err_message_code
)
31607 mp_print
(mp
, "message");
31608 else if
(m
== err_message_code
)
31609 mp_print
(mp
, "errmessage");
31610 else if
(m
== filename_template_code
)
31611 mp_print
(mp
, "filenametemplate");
31613 mp_print
(mp
, "errhelp");
31616 @ @
<Declare action procedures for use by |do_statement|@
>=
31617 @
<Declare a procedure called |no_string_err|@
>;
31618 static void mp_do_message
(MP mp
);
31622 void mp_do_message
(MP mp
) {
31623 int m
; /* the type of message
*/
31626 memset
(&new_expr,0,sizeof(mp_value));
31627 new_number
(new_expr.data.n
);
31628 mp_get_x_next
(mp
);
31629 mp_scan_expression
(mp
);
31630 if
(mp-
>cur_exp.type
!= mp_string_type
)
31631 mp_no_string_err
(mp
, "A message should be a known string expression.");
31635 mp_print_nl
(mp
, "");
31636 mp_print_str
(mp
, cur_exp_str
());
31638 case err_message_code
:
31639 @
<Print string |cur_exp| as an error message@
>;
31641 case err_help_code
:
31642 @
<Save string |cur_exp| as the |err_help|@
>;
31644 case filename_template_code
:
31645 @
<Save the filename template@
>;
31647 } /* there are no other cases
*/
31649 set_number_to_zero
(new_expr.data.n
);
31650 mp_flush_cur_exp
(mp
, new_expr
);
31654 @ @
<Save the filename template@
>=
31656 delete_str_ref
(internal_string
(mp_output_template
));
31657 if
(cur_exp_str
()->len
== 0) {
31658 set_internal_string
(mp_output_template
, mp_rts
(mp
, "%j.%c"));
31660 set_internal_string
(mp_output_template
, cur_exp_str
());
31661 add_str_ref
(internal_string
(mp_output_template
));
31666 @ @
<Declare a procedure called |no_string_err|@
>=
31667 static void mp_no_string_err
(MP mp
, const char
*s
) {
31668 const char
*hlp
[] = {s
, NULL};
31669 mp_disp_err
(mp
, NULL);
31670 mp_back_error
(mp
, "Not a string", hlp
, true
);
31672 mp_get_x_next
(mp
);
31676 @ The global variable |err_help| is zero when the user has most recently
31677 given an empty help string
, or if none has ever been given.
31679 @
<Save string |cur_exp| as the |err_help|@
>=
31681 if
(mp-
>err_help
!= NULL)
31682 delete_str_ref
(mp-
>err_help
);
31683 if
(cur_exp_str
()->len
== 0)
31684 mp-
>err_help
= NULL;
31686 mp-
>err_help
= cur_exp_str
();
31687 add_str_ref
(mp-
>err_help
);
31692 @ If \
&{errmessage} occurs often in |mp_scroll_mode|, without user-defined
31693 \
&{errhelp}, we don't want to give a long help message each time. So we
31694 give a verbose explanation only once.
31697 boolean long_help_seen
; /* has the long \.
{\\errmessage
} help been used?
*/
31700 mp-
>long_help_seen
= false
;
31702 @ @
<Print string |cur_exp| as an error message@
>=
31705 mp_snprintf
(msg
, 256, "%s", mp_str
(mp
, cur_exp_str
()));
31706 if
(mp-
>err_help
!= NULL) {
31707 mp-
>use_err_help
= true
;
31708 mp_back_error
(mp
, msg
, NULL, true
);
31709 } else if
(mp-
>long_help_seen
) {
31710 const char
*hlp
[] = { "(That was another `errmessage'.)", NULL };
31711 mp_back_error
(mp
, msg
, hlp
, true
);
31713 const char
*hlp
[] = {
31714 "This error message was generated by an `errmessage'",
31715 "command, so I can\'t give any explicit help.",
31716 "Pretend that you're Miss Marple: Examine all clues,",
31717 "and deduce the truth by inspired guesses.",
31720 if
(mp-
>interaction
< mp_error_stop_mode
)
31721 mp-
>long_help_seen
= true
;
31722 mp_back_error
(mp
, msg
, hlp
, true
);
31724 mp_get_x_next
(mp
);
31725 mp-
>use_err_help
= false
;
31729 @ @
<Declare action procedures for use by |do_statement|@
>=
31730 static void mp_do_write
(MP mp
);
31733 void mp_do_write
(MP mp
) {
31734 mp_string t
; /* the line of text to be written
*/
31735 write_index n
, n0
; /* for searching |wr_fname| and |wr_file| arrays
*/
31736 unsigned old_setting
; /* for saving |selector| during output
*/
31738 memset
(&new_expr,0,sizeof(mp_value));
31739 new_number
(new_expr.data.n
);
31740 mp_get_x_next
(mp
);
31741 mp_scan_expression
(mp
);
31742 if
(mp-
>cur_exp.type
!= mp_string_type
) {
31743 mp_no_string_err
(mp
,
31744 "The text to be written should be a known string expression");
31745 } else if
(cur_cmd
() != mp_to_token
) {
31746 const char
*hlp
[] = { "A write command should end with `to <filename>'", NULL };
31747 mp_back_error
(mp
, "Missing `to' clause", hlp
, true
);
31748 mp_get_x_next
(mp
);
31750 t
= cur_exp_str
();
31751 mp-
>cur_exp.type
= mp_vacuous
;
31752 mp_get_x_next
(mp
);
31753 mp_scan_expression
(mp
);
31754 if
(mp-
>cur_exp.type
!= mp_string_type
)
31755 mp_no_string_err
(mp
,
31756 "I can\'t write to that file name. It isn't a known string");
31758 @
<Write |t| to the file named by |cur_exp|@
>;
31760 /* |delete_str_ref
(t
);|
*//* todo
: is this right?
*/
31762 set_number_to_zero
(new_expr.data.n
);
31763 mp_flush_cur_exp
(mp
, new_expr
);
31767 @ @
<Write |t| to the file named by |cur_exp|@
>=
31769 @
<Find |n| where |wr_fname
[n
]=cur_exp| and call |open_write_file| if
31770 |cur_exp| must be inserted@
>;
31771 if
(mp_str_vs_str
(mp
, t
, mp-
>eof_line
) == 0) {
31772 @
<Record the end of file on |wr_file
[n
]|@
>;
31774 old_setting
= mp-
>selector
;
31775 mp-
>selector
= n
+ write_file
;
31776 mp_print_str
(mp
, t
);
31778 mp-
>selector
= old_setting
;
31783 @ @
<Find |n| where |wr_fname
[n
]=cur_exp| and call |open_write_file| if...@
>=
31785 char
*fn
= mp_str
(mp
, cur_exp_str
());
31786 n
= mp-
>write_files
;
31787 n0
= mp-
>write_files
;
31788 while
(mp_xstrcmp
(fn
, mp-
>wr_fname
[n
]) != 0) {
31789 if
(n
== 0) { /* bottom reached
*/
31790 if
(n0
== mp-
>write_files
) {
31791 if
(mp-
>write_files
< mp-
>max_write_files
) {
31792 incr
(mp-
>write_files
);
31797 l
= mp-
>max_write_files
+ (mp-
>max_write_files
/ 4);
31798 wr_file
= xmalloc
((l
+ 1), sizeof
(void
*));
31799 wr_fname
= xmalloc
((l
+ 1), sizeof
(char
*));
31800 for
(k
= 0; k
<= l
; k
++) {
31801 if
(k
<= mp-
>max_write_files
) {
31802 wr_file
[k
] = mp-
>wr_file
[k
];
31803 wr_fname
[k
] = mp-
>wr_fname
[k
];
31806 wr_fname
[k
] = NULL;
31809 xfree
(mp-
>wr_file
);
31810 xfree
(mp-
>wr_fname
);
31811 mp-
>max_write_files
= l
;
31812 mp-
>wr_file
= wr_file
;
31813 mp-
>wr_fname
= wr_fname
;
31817 mp_open_write_file
(mp
, fn
, n
);
31820 if
(mp-
>wr_fname
[n
] == NULL)
31827 @ @
<Record the end of file on |wr_file
[n
]|@
>=
31829 (mp-
>close_file
) (mp
, mp-
>wr_file
[n
]);
31830 xfree
(mp-
>wr_fname
[n
]);
31831 if
(n
== mp-
>write_files
- 1)
31832 mp-
>write_files
= n
;
31836 @
* Writing font metric data.
31837 \TeX\ gets its knowledge about fonts from font metric files
, also called
31838 \.
{TFM
} files
; the `\.T' in `\.
{TFM
}' stands for \TeX
,
31839 but other programs know about them too. One of \MP's duties is to
31840 write \.
{TFM
} files so that the user's fonts can readily be
31841 applied to typesetting.
31842 @
:TFM files
}{\.
{TFM
} files@
>
31843 @^font metric files@
>
31845 The information in a \.
{TFM
} file appears in a sequence of
8-bit bytes.
31846 Since the number of bytes is always a multiple of~
4, we could
31847 also regard the file as a sequence of
32-bit words
, but \MP\ uses the
31848 byte interpretation. The format of \.
{TFM
} files was designed by
31849 Lyle Ramshaw in
1980. The intent is to convey a lot of different kinds
31850 @^Ramshaw
, Lyle Harold@
>
31851 of information in a compact but useful form.
31854 void
*tfm_file
; /* the font metric output goes here
*/
31855 char
*metric_file_name
; /* full name of the font metric file
*/
31857 @ The first
24 bytes
(6 words
) of a \.
{TFM
} file contain twelve
16-bit
31858 integers that give the lengths of the various subsequent portions
31859 of the file. These twelve integers are
, in order
:
31860 $$\vbox
{\halign
{\hfil#
&$\null=\null$#\hfil\cr
31861 |lf|
&length of the entire file, in words;\cr
31862 |lh|
&length of the header data, in words;\cr
31863 |bc|
&smallest character code in the font;\cr
31864 |ec|
&largest character code in the font;\cr
31865 |nw|
&number of words in the width table;\cr
31866 |nh|
&number of words in the height table;\cr
31867 |nd|
&number of words in the depth table;\cr
31868 |ni|
&number of words in the italic correction table;\cr
31869 |nl|
&number of words in the lig/kern table;\cr
31870 |nk|
&number of words in the kern table;\cr
31871 |ne|
&number of words in the extensible character table;\cr
31872 |np|
&number of font parameter words.\cr}}$$
31873 They are all nonnegative and less than $
2^
{15}$. We must have |bc-1
<=ec
<=255|
,
31875 $$\hbox
{|lf
=6+lh
+(ec-bc
+1)+nw
+nh
+nd
+ni
+nl
+nk
+ne
+np|.
}$$
31876 Note that a font may contain as many as
256 characters
(if |bc
=0| and |ec
=255|
),
31877 and as few as
0 characters
(if |bc
=ec
+1|
).
31879 Incidentally
, when two or more
8-bit bytes are combined to form an integer of
31880 16 or more bits
, the most significant bytes appear first in the file.
31881 This is called BigEndian order.
31882 @^BigEndian order@
>
31884 @ The rest of the \.
{TFM
} file may be regarded as a sequence of ten data
31887 The most important data type used here is a |fix_word|
, which is
31888 a
32-bit representation of a binary fraction. A |fix_word| is a signed
31889 quantity
, with the two's complement of the entire word used to represent
31890 negation. Of the
32 bits in a |fix_word|
, exactly
12 are to the left of the
31891 binary point
; thus
, the largest |fix_word| value is $
2048-2^
{-20}$
, and
31892 the smallest is $
-2048$. We will see below
, however
, that all but two of
31893 the |fix_word| values must lie between $
-16$ and $
+16$.
31895 @ The first data array is a block of header information
, which contains
31896 general facts about the font. The header must contain at least two words
,
31897 |header
[0]| and |header
[1]|
, whose meaning is explained below. Additional
31898 header information of use to other software routines might also be
31899 included
, and \MP\ will generate it if the \.
{headerbyte
} command occurs.
31900 For example
, 16 more words of header information are in use at the Xerox
31901 Palo Alto Research Center
; the first ten specify the character coding
31902 scheme used
(e.g.
, `\.
{XEROX
TEXT}' or `\.
{TEX MATHSY
}'
), the next five
31903 give the font family name
(e.g.
, `\.
{HELVETICA
}' or `\.
{CMSY
}'
), and the
31904 last gives the ``face byte.''
31906 \yskip\hang|header
[0]| is a
32-bit check sum that \MP\ will copy into
31907 the \.
{GF
} output file. This helps ensure consistency between files
,
31908 since \TeX\ records the check sums from the \.
{TFM
}'s it reads
, and these
31909 should match the check sums on actual fonts that are used. The actual
31910 relation between this check sum and the rest of the \.
{TFM
} file is not
31911 important
; the check sum is simply an identification number with the
31912 property that incompatible fonts almost always have distinct check sums.
31915 \yskip\hang|header
[1]| is a |fix_word| containing the design size of the
31916 font
, in units of \TeX\ points. This number must be at least
1.0; it is
31917 fairly arbitrary
, but usually the design size is
10.0 for a ``
10 point''
31918 font
, i.e.
, a font that was designed to look best at a
10-point size
,
31919 whatever that really means. When a \TeX\ user asks for a font `\.
{at
}
31920 $\delta$ \.
{pt
}'
, the effect is to override the design size and replace it
31921 by $\delta$
, and to multiply the $x$ and~$y$ coordinates of the points in
31922 the font image by a factor of $\delta$ divided by the design size.
{\sl
31923 All other dimensions in the\
/ \.
{TFM
} file are |fix_word|\kern-1pt\
31924 numbers in design-size units.
} Thus
, for example
, the value of |param
[6]|
,
31925 which defines the \.
{em
} unit
, is often the |fix_word| value $
2^
{20}=1.0$
,
31926 since many fonts have a design size equal to one em. The other dimensions
31927 must be less than
16 design-size units in absolute value
; thus
,
31928 |header
[1]| and |param
[1]| are the only |fix_word| entries in the whole
31929 \.
{TFM
} file whose first byte might be something besides
0 or
255.
31932 @ Next comes the |char_info| array
, which contains one |char_info_word|
31933 per character. Each word in this part of the file contains six fields
31934 packed into four bytes as follows.
31936 \yskip\hang first byte
: |width_index|
(8 bits
)\par
31937 \hang second byte
: |height_index|
(4 bits
) times
16, plus |depth_index|
31939 \hang third byte
: |italic_index|
(6 bits
) times
4, plus |tag|
31941 \hang fourth byte
: |remainder|
(8 bits
)\par
31943 The actual width of a character is \\
{width
}|
[width_index
]|
, in design-size
31944 units
; this is a device for compressing information
, since many characters
31945 have the same width. Since it is quite common for many characters
31946 to have the same height
, depth
, or italic correction
, the \.
{TFM
} format
31947 imposes a limit of
16 different heights
, 16 different depths
, and
31948 64 different italic corrections.
31950 Incidentally
, the relation $\\
{width
}[0]=\\
{height
}[0]=\\
{depth
}[0]=
31951 \\
{italic
}[0]=0$ should always hold
, so that an index of zero implies a
31952 value of zero. The |width_index| should never be zero unless the
31953 character does not exist in the font
, since a character is valid if and
31954 only if it lies between |bc| and |ec| and has a nonzero |width_index|.
31956 @ The |tag| field in a |char_info_word| has four values that explain how to
31957 interpret the |remainder| field.
31959 \yskip\hang|tag
=0|
(|no_tag|
) means that |remainder| is unused.\par
31960 \hang|tag
=1|
(|lig_tag|
) means that this character has a ligature
/kerning
31961 program starting at location |remainder| in the |lig_kern| array.\par
31962 \hang|tag
=2|
(|list_tag|
) means that this character is part of a chain of
31963 characters of ascending sizes
, and not the largest in the chain. The
31964 |remainder| field gives the character code of the next larger character.\par
31965 \hang|tag
=3|
(|ext_tag|
) means that this character code represents an
31966 extensible character
, i.e.
, a character that is built up of smaller pieces
31967 so that it can be made arbitrarily large. The pieces are specified in
31968 |exten
[remainder
]|.\par
31970 Characters with |tag
=2| and |tag
=3| are treated as characters with |tag
=0|
31971 unless they are used in special circumstances in math formulas. For example
,
31972 \TeX's \.
{\\sum
} operation looks for a |list_tag|
, and the \.
{\\left
}
31973 operation looks for both |list_tag| and |ext_tag|.
31975 @d no_tag
0 /* vanilla character
*/
31976 @d lig_tag
1 /* character has a ligature
/kerning program
*/
31977 @d list_tag
2 /* character has a successor in a charlist
*/
31978 @d ext_tag
3 /* character is extensible
*/
31980 @ The |lig_kern| array contains instructions in a simple programming language
31981 that explains what to do for special letter pairs. Each word in this array is a
31982 |lig_kern_command| of four bytes.
31984 \yskip\hang first byte
: |skip_byte|
, indicates that this is the final program
31985 step if the byte is
128 or more
, otherwise the next step is obtained by
31986 skipping this number of intervening steps.\par
31987 \hang second byte
: |next_char|
, ``if |next_char| follows the current character
,
31988 then perform the operation and stop
, otherwise continue.''\par
31989 \hang third byte
: |op_byte|
, indicates a ligature step if less than
~128,
31990 a kern step otherwise.\par
31991 \hang fourth byte
: |remainder|.\par
31994 additional space equal to |kern
[256*(op_byte-128
)+remainder
]| is inserted
31995 between the current character and |next_char|. This amount is
31996 often negative
, so that the characters are brought closer together
31997 by kerning
; but it might be positive.
31999 There are eight kinds of ligature steps
, having |op_byte| codes $
4a
+2b
+c$ where
32000 $
0\le a\le b
+c$ and $
0\le b
,c\le1$. The character whose code is
32001 |remainder| is inserted between the current character and |next_char|
;
32002 then the current character is deleted if $b
=0$
, and |next_char| is
32003 deleted if $c
=0$
; then we pass over $a$~characters to reach the next
32004 current character
(which may have a ligature
/kerning program of its own
).
32006 If the very first instruction of the |lig_kern| array has |skip_byte
=255|
,
32007 the |next_char| byte is the so-called right boundary character of this font
;
32008 the value of |next_char| need not lie between |bc| and~|ec|.
32009 If the very last instruction of the |lig_kern| array has |skip_byte
=255|
,
32010 there is a special ligature
/kerning program for a left boundary character
,
32011 beginning at location |
256*op_byte
+remainder|.
32012 The interpretation is that \TeX\ puts implicit boundary characters
32013 before and after each consecutive string of characters from the same font.
32014 These implicit characters do not appear in the output
, but they can affect
32015 ligatures and kerning.
32017 If the very first instruction of a character's |lig_kern| program has
32018 |skip_byte
>128|
, the program actually begins in location
32019 |
256*op_byte
+remainder|. This feature allows access to large |lig_kern|
32020 arrays
, because the first instruction must otherwise
32021 appear in a location |
<=255|.
32023 Any instruction with |skip_byte
>128| in the |lig_kern| array must satisfy
32025 $$\hbox
{|
256*op_byte
+remainder
<nl|.
}$$
32026 If such an instruction is encountered during
32027 normal program execution
, it denotes an unconditional halt
; no ligature
32028 command is performed.
32031 /* value indicating `\.
{STOP}' in a lig
/kern program
*/
32032 @d kern_flag
(128) /* op code for a kern step
*/
32033 @d skip_byte
(A
) mp-
>lig_kern
[(A
)].b0
32034 @d next_char
(A
) mp-
>lig_kern
[(A
)].b1
32035 @d op_byte
(A
) mp-
>lig_kern
[(A
)].b2
32036 @d rem_byte
(A
) mp-
>lig_kern
[(A
)].b3
32038 @ Extensible characters are specified by an |extensible_recipe|
, which
32039 consists of four bytes called |top|
, |mid|
, |bot|
, and |rep|
(in this
32040 order
). These bytes are the character codes of individual pieces used to
32041 build up a large symbol. If |top|
, |mid|
, or |bot| are zero
, they are not
32042 present in the built-up result. For example
, an extensible vertical line is
32043 like an extensible bracket
, except that the top and bottom pieces are missing.
32045 Let $T$
, $M$
, $B$
, and $R$ denote the respective pieces
, or an empty box
32046 if the piece isn't present. Then the extensible characters have the form
32047 $TR^kMR^kB$ from top to bottom
, for some |k
>=0|
, unless $M$ is absent
;
32048 in the latter case we can have $TR^kB$ for both even and odd values of~|k|.
32049 The width of the extensible character is the width of $R$
; and the
32050 height-plus-depth is the sum of the individual height-plus-depths of the
32051 components used
, since the pieces are butted together in a vertical list.
32053 @d ext_top
(A
) mp-
>exten
[(A
)].b0
/* |top| piece in a recipe
*/
32054 @d ext_mid
(A
) mp-
>exten
[(A
)].b1
/* |mid| piece in a recipe
*/
32055 @d ext_bot
(A
) mp-
>exten
[(A
)].b2
/* |bot| piece in a recipe
*/
32056 @d ext_rep
(A
) mp-
>exten
[(A
)].b3
/* |rep| piece in a recipe
*/
32058 @ The final portion of a \.
{TFM
} file is the |param| array
, which is another
32059 sequence of |fix_word| values.
32061 \yskip\hang|param
[1]=slant| is the amount of italic slant
, which is used
32062 to help position accents. For example
, |slant
=.25| means that when you go
32063 up one unit
, you also go
.25 units to the right. The |slant| is a pure
32064 number
; it is the only |fix_word| other than the design size itself that is
32065 not scaled by the design size.
32068 \hang|param
[2]=space| is the normal spacing between words in text.
32069 Note that character
040 in the font need not have anything to do with
32072 \hang|param
[3]=space_stretch| is the amount of glue stretching between words.
32074 \hang|param
[4]=space_shrink| is the amount of glue shrinking between words.
32076 \hang|param
[5]=x_height| is the size of one ex in the font
; it is also
32077 the height of letters for which accents don't have to be raised or lowered.
32079 \hang|param
[6]=quad| is the size of one em in the font.
32081 \hang|param
[7]=extra_space| is the amount added to |param
[2]| at the
32085 If fewer than seven parameters are present
, \TeX\ sets the missing parameters
32090 @d space_stretch_code
3
32091 @d space_shrink_code
4
32094 @d extra_space_code
7
32096 @ So that is what \.
{TFM
} files hold. One of \MP's duties is to output such
32097 information
, and it does this all at once at the end of a job.
32098 In order to prepare for such frenetic activity
, it squirrels away the
32099 necessary facts in various arrays as information becomes available.
32101 Character dimensions
(\
&{charwd}, \&{charht}, \&{chardp}, and \&{charic})
32102 are stored respectively in |tfm_width|
, |tfm_height|
, |tfm_depth|
, and
32103 |tfm_ital_corr|. Other information about a character
(e.g.
, about
32104 its ligatures or successors
) is accessible via the |char_tag| and
32105 |char_remainder| arrays. Other information about the font as a whole
32106 is kept in additional arrays called |header_byte|
, |lig_kern|
,
32107 |kern|
, |exten|
, and |param|.
32109 @d max_tfm_int
32510
32110 @d undefined_label max_tfm_int
/* an undefined local label
*/
32113 #define TFM_ITEMS
257
32115 eight_bits ec
; /* smallest and largest character codes shipped out
*/
32116 mp_node tfm_width
[TFM_ITEMS
]; /* \
&{charwd} values */
32117 mp_node tfm_height
[TFM_ITEMS
]; /* \
&{charht} values */
32118 mp_node tfm_depth
[TFM_ITEMS
]; /* \
&{chardp} values */
32119 mp_node tfm_ital_corr
[TFM_ITEMS
]; /* \
&{charic} values */
32120 boolean char_exists
[TFM_ITEMS
]; /* has this code been shipped out?
*/
32121 int char_tag
[TFM_ITEMS
]; /* |remainder| category
*/
32122 int char_remainder
[TFM_ITEMS
]; /* the |remainder| byte
*/
32123 char
*header_byte
; /* bytes of the \.
{TFM
} header
*/
32124 int header_last
; /* last initialized \.
{TFM
} header byte
*/
32125 int header_size
; /* size of the \.
{TFM
} header
*/
32126 four_quarters
*lig_kern
; /* the ligature
/kern table
*/
32127 short nl
; /* the number of ligature
/kern steps so far
*/
32128 mp_number
*kern
; /* distinct kerning amounts
*/
32129 short nk
; /* the number of distinct kerns so far
*/
32130 four_quarters exten
[TFM_ITEMS
]; /* extensible character recipes
*/
32131 short ne
; /* the number of extensible characters so far
*/
32132 mp_number
*param
; /* \
&{fontinfo} parameters */
32133 short np
; /* the largest \
&{fontinfo} parameter specified so far */
32137 short ni
; /* sizes of \.
{TFM
} subtables
*/
32138 short skip_table
[TFM_ITEMS
]; /* local label status
*/
32139 boolean lk_started
; /* has there been a lig
/kern step in this command yet?
*/
32140 integer bchar
; /* right boundary character
*/
32141 short bch_label
; /* left boundary starting location
*/
32143 short lll
; /* registers used for lig
/kern processing
*/
32144 short label_loc
[257]; /* lig
/kern starting addresses
*/
32145 eight_bits label_char
[257]; /* characters for |label_loc|
*/
32146 short label_ptr
; /* highest position occupied in |label_loc|
*/
32148 @ @
<Allocate or initialize ...@
>=
32149 mp-
>header_last
= 7;
32150 mp-
>header_size
= 128; /* just for init
*/
32151 mp-
>header_byte
= xmalloc
(mp-
>header_size
, sizeof
(char
));
32153 @ @
<Dealloc variables@
>=
32154 xfree
(mp-
>header_byte
);
32155 xfree
(mp-
>lig_kern
);
32158 for
(i
=0;i
<(max_tfm_int
+ 1);i
++) {
32159 free_number
(mp-
>kern
[i
]);
32165 for
(i
=0;i
<(max_tfm_int
+ 1);i
++) {
32166 free_number
(mp-
>param
[i
]);
32172 for
(k
= 0; k
<= 255; k
++) {
32173 mp-
>tfm_width
[k
] = 0;
32174 mp-
>tfm_height
[k
] = 0;
32175 mp-
>tfm_depth
[k
] = 0;
32176 mp-
>tfm_ital_corr
[k
] = 0;
32177 mp-
>char_exists
[k
] = false
;
32178 mp-
>char_tag
[k
] = no_tag
;
32179 mp-
>char_remainder
[k
] = 0;
32180 mp-
>skip_table
[k
] = undefined_label
;
32182 memset
(mp-
>header_byte
, 0, (size_t
) mp-
>header_size
);
32189 set_internal_from_number
(mp_boundary_char
, unity_t
);
32190 number_negate
(internal_value
(mp_boundary_char
));
32191 mp-
>bch_label
= undefined_label
;
32192 mp-
>label_loc
[0] = -1;
32195 @ @
<Declarations@
>=
32196 static mp_node mp_tfm_check
(MP mp
, quarterword m
);
32199 static mp_node mp_tfm_check
(MP mp
, quarterword m
) {
32201 mp_node p
= mp_get_value_node
(mp
);
32203 number_clone
(absm
, internal_value
(m
));
32205 if
(number_greaterequal
(absm
, fraction_half_t
)) {
32207 const char
*hlp
[] = {
32208 "Font metric dimensions must be less than 2048pt.",
32210 mp_snprintf
(msg
, 256, "Enormous %s has been reduced", internal_name
(m
));
32211 @.Enormous charwd...@
>
32212 @.Enormous chardp...@
>
32213 @.Enormous charht...@
>
32214 @.Enormous charic...@
>
32215 @.Enormous designsize...@
>;
32216 mp_back_error
(mp
, msg
, hlp
, true
);
32217 mp_get_x_next
(mp
);
32218 if
(number_positive
(internal_value
(m
))) {
32219 set_value_number
(p
, fraction_half_t
);
32220 number_add_scaled
(value_number
(p
), -1);
32222 set_value_number
(p
, fraction_half_t
);
32223 number_negate
(value_number
(p
));
32224 number_add_scaled
(value_number
(p
), 1);
32227 set_value_number
(p
, internal_value
(m
));
32229 free_number
(absm
);
32233 @ @
<Store the width information for character code~|c|@
>=
32235 mp-
>bc
= (eight_bits
) c
;
32237 mp-
>ec
= (eight_bits
) c
;
32238 mp-
>char_exists
[c
] = true
;
32239 mp_free_value_node
(mp
, mp-
>tfm_width
[c
]);
32240 mp-
>tfm_width
[c
] = mp_tfm_check
(mp
, mp_char_wd
);
32241 mp_free_value_node
(mp
, mp-
>tfm_height
[c
]);
32242 mp-
>tfm_height
[c
] = mp_tfm_check
(mp
, mp_char_ht
);
32243 mp_free_value_node
(mp
, mp-
>tfm_depth
[c
]);
32244 mp-
>tfm_depth
[c
] = mp_tfm_check
(mp
, mp_char_dp
);
32245 mp_free_value_node
(mp
, mp-
>tfm_ital_corr
[c
]);
32246 mp-
>tfm_ital_corr
[c
] = mp_tfm_check
(mp
, mp_char_ic
)
32249 @ Now let's consider \MP's special \.
{TFM
}-oriented commands.
32252 @ @d char_list_code
0
32253 @d lig_table_code
1
32254 @d extensible_code
2
32255 @d header_byte_code
3
32256 @d font_dimen_code
4
32259 mp_primitive
(mp
, "charlist", mp_tfm_command
, char_list_code
);
32260 @
:char_list_
}{\
&{charlist} primitive@>;
32261 mp_primitive
(mp
, "ligtable", mp_tfm_command
, lig_table_code
);
32262 @
:lig_table_
}{\
&{ligtable} primitive@>;
32263 mp_primitive
(mp
, "extensible", mp_tfm_command
, extensible_code
);
32264 @
:extensible_
}{\
&{extensible} primitive@>;
32265 mp_primitive
(mp
, "headerbyte", mp_tfm_command
, header_byte_code
);
32266 @
:header_byte_
}{\
&{headerbyte} primitive@>;
32267 mp_primitive
(mp
, "fontdimen", mp_tfm_command
, font_dimen_code
);
32268 @
:font_dimen_
}{\
&{fontdimen} primitive@>
32271 @ @
<Cases of |print_cmd...@
>=
32272 case mp_tfm_command
:
32274 case char_list_code
:
32275 mp_print
(mp
, "charlist");
32277 case lig_table_code
:
32278 mp_print
(mp
, "ligtable");
32280 case extensible_code
:
32281 mp_print
(mp
, "extensible");
32283 case header_byte_code
:
32284 mp_print
(mp
, "headerbyte");
32287 mp_print
(mp
, "fontdimen");
32292 @ @
<Declare action procedures for use by |do_statement|@
>=
32293 static eight_bits mp_get_code
(MP mp
);
32296 eight_bits mp_get_code
(MP mp
) { /* scans a character code value
*/
32297 integer c
; /* the code value found
*/
32299 const char
*hlp
[] = {
32300 "I was looking for a number between 0 and 255, or for a",
32301 "string of length 1. Didn't find it; will use 0 instead.",
32303 memset
(&new_expr,0,sizeof(mp_value));
32304 new_number
(new_expr.data.n
);
32305 mp_get_x_next
(mp
);
32306 mp_scan_expression
(mp
);
32307 if
(mp-
>cur_exp.type
== mp_known
) {
32308 c
= round_unscaled
(cur_exp_value_number
());
32311 return
(eight_bits
) c
;
32312 } else if
(mp-
>cur_exp.type
== mp_string_type
) {
32313 if
(cur_exp_str
()->len
== 1) {
32314 c
= (integer
) (*(cur_exp_str
()->str
));
32315 return
(eight_bits
) c
;
32318 mp_disp_err
(mp
, NULL);
32319 set_number_to_zero
(new_expr.data.n
);
32320 mp_back_error
(mp
, "Invalid code has been replaced by 0", hlp
, true
);
32321 @.Invalid code...@
>;
32322 mp_get_x_next
(mp
);
32323 mp_flush_cur_exp
(mp
, new_expr
);
32325 return
(eight_bits
) c
;
32329 @ @
<Declare action procedures for use by |do_statement|@
>=
32330 static void mp_set_tag
(MP mp
, halfword c
, quarterword t
, halfword r
);
32333 void mp_set_tag
(MP mp
, halfword c
, quarterword t
, halfword r
) {
32334 if
(mp-
>char_tag
[c
] == no_tag
) {
32335 mp-
>char_tag
[c
] = t
;
32336 mp-
>char_remainder
[c
] = r
;
32337 if
(t
== lig_tag
) {
32339 mp-
>label_loc
[mp-
>label_ptr
] = (short
) r
;
32340 mp-
>label_char
[mp-
>label_ptr
] = (eight_bits
) c
;
32343 @
<Complain about a character tag conflict@
>;
32348 @ @
<Complain about a character tag conflict@
>=
32350 const char
*xtra
= NULL;
32352 const char
*hlp
[] = {
32353 "It's not legal to label a character more than once.",
32354 "So I'll not change anything just now.",
32356 switch
(mp-
>char_tag
[c
]) {
32357 case lig_tag
: xtra
= "in a ligtable"; break
;
32358 case list_tag
: xtra
= "in a charlist"; break
;
32359 case ext_tag
: xtra
= "extensible"; break
;
32360 default
: xtra
= ""; break
;
32362 if
((c
> ' '
) && (c < 127)) {
32363 mp_snprintf
(msg
, 256, "Character %c is already %s", xord
(c
), xtra
);
32364 } else if
(c
== 256) {
32365 mp_snprintf
(msg
, 256, "Character || is already %s", xtra
);
32367 mp_snprintf
(msg
, 256, "Character code %d is already %s", c
, xtra
);
32369 @.Character c is already...@
>;
32370 mp_back_error
(mp
, msg
, hlp
, true
);
32371 mp_get_x_next
(mp
);
32375 @ @
<Declare action procedures for use by |do_statement|@
>=
32376 static void mp_do_tfm_command
(MP mp
);
32379 void mp_do_tfm_command
(MP mp
) {
32380 int c
, cc
; /* character codes
*/
32381 int k
; /* index into the |kern| array
*/
32382 int j
; /* index into |header_byte| or |param|
*/
32384 memset
(&new_expr,0,sizeof(mp_value));
32385 new_number
(new_expr.data.n
);
32386 switch
(cur_mod
()) {
32387 case char_list_code
:
32388 c
= mp_get_code
(mp
);
32389 /* we will store a list of character successors
*/
32390 while
(cur_cmd
() == mp_colon
) {
32391 cc
= mp_get_code
(mp
);
32392 mp_set_tag
(mp
, c
, list_tag
, cc
);
32396 case lig_table_code
:
32397 if
(mp-
>lig_kern
== NULL)
32398 mp-
>lig_kern
= xmalloc
((max_tfm_int
+ 1), sizeof
(four_quarters
));
32399 if
(mp-
>kern
== NULL) {
32401 mp-
>kern
= xmalloc
((max_tfm_int
+ 1), sizeof
(mp_number
));
32402 for
(i
=0;i
<(max_tfm_int
+ 1);i
++)
32403 new_number
(mp-
>kern
[i
]);
32405 @
<Store a list of ligature
/kern steps@
>;
32407 case extensible_code
:
32408 @
<Define an extensible recipe@
>;
32410 case header_byte_code
:
32411 case font_dimen_code
:
32413 mp_get_x_next
(mp
);
32414 mp_scan_expression
(mp
);
32415 if
((mp-
>cur_exp.type
!= mp_known
) || number_less
(cur_exp_value_number
(), half_unit_t
)) {
32416 const char
*hlp
[] = {
32417 "I was looking for a known, positive number.",
32418 "For safety's sake I'll ignore the present command.",
32420 mp_disp_err
(mp
, NULL);
32421 mp_back_error
(mp
, "Improper location", hlp
, true
);
32422 @.Improper location@
>;
32423 mp_get_x_next
(mp
);
32425 j
= round_unscaled
(cur_exp_value_number
());
32426 if
(cur_cmd
() != mp_colon
) {
32427 const char
*hlp
[] = {
32428 "A colon should follow a headerbyte or fontinfo location.",
32430 mp_back_error
(mp
, "Missing `:' has been inserted", hlp
, true
);
32433 if
(c
== header_byte_code
) {
32434 @
<Store a list of header bytes@
>;
32436 if
(mp-
>param
== NULL) {
32438 mp-
>param
= xmalloc
((max_tfm_int
+ 1), sizeof
(mp_number
));
32439 for
(i
=0;i
<(max_tfm_int
+ 1);i
++)
32440 new_number
(mp-
>param
[i
]);
32442 @
<Store a list of font dimensions@
>;
32446 } /* there are no other cases
*/
32450 @ @
<Store a list of ligature
/kern steps@
>=
32452 mp-
>lk_started
= false
;
32454 mp_get_x_next
(mp
);
32455 if
((cur_cmd
() == mp_skip_to
) && mp->lk_started)
32456 @
<Process a |skip_to| command and |goto done|@
>;
32457 if
(cur_cmd
() == mp_bchar_label
) {
32459 set_cur_cmd
((mp_variable_type
)mp_colon
);
32461 mp_back_input
(mp
);
32462 c
= mp_get_code
(mp
);
32464 if
((cur_cmd
() == mp_colon
) ||
(cur_cmd
() == mp_double_colon
)) {
32465 @
<Record a label in a lig
/kern subprogram and |goto continue|@
>;
32467 if
(cur_cmd
() == mp_lig_kern_token
) {
32468 @
<Compile a ligature
/kern command@
>;
32470 const char
*hlp
[] = { "I was looking for `=:' or `kern' here.", NULL };
32471 mp_back_error
(mp
, "Illegal ligtable step", hlp
, true
);
32472 @.Illegal ligtable step@
>;
32473 next_char
(mp-
>nl
) = qi
(0);
32474 op_byte
(mp-
>nl
) = qi
(0);
32475 rem_byte
(mp-
>nl
) = qi
(0);
32476 skip_byte
(mp-
>nl
) = stop_flag
+ 1; /* this specifies an unconditional stop
*/
32478 if
(mp-
>nl
== max_tfm_int
)
32479 mp_fatal_error
(mp
, "ligtable too large");
32481 if
(cur_cmd
() == mp_comma
)
32483 if
(skip_byte
(mp-
>nl
- 1) < stop_flag
)
32484 skip_byte
(mp-
>nl
- 1) = stop_flag
;
32489 mp_primitive
(mp
, "=:", mp_lig_kern_token
, 0);
32490 @
:=:_
}{\.
{=:} primitive@
>;
32491 mp_primitive
(mp
, "=:|", mp_lig_kern_token
, 1);
32492 @
:=:/_
}{\.
{=:\char'
174} primitive@
>;
32493 mp_primitive
(mp
, "=:|>", mp_lig_kern_token
, 5);
32494 @
:=:/>_
}{\.
{=:\char'
174>} primitive@
>;
32495 mp_primitive
(mp
, "|=:", mp_lig_kern_token
, 2);
32496 @
:=:/_
}{\.
{\char'
174=:} primitive@
>;
32497 mp_primitive
(mp
, "|=:>", mp_lig_kern_token
, 6);
32498 @
:=:/>_
}{\.
{\char'
174=:>} primitive@
>;
32499 mp_primitive
(mp
, "|=:|", mp_lig_kern_token
, 3);
32500 @
:=:/_
}{\.
{\char'
174=:\char'
174} primitive@
>;
32501 mp_primitive
(mp
, "|=:|>", mp_lig_kern_token
, 7);
32502 @
:=:/>_
}{\.
{\char'
174=:\char'
174>} primitive@
>;
32503 mp_primitive
(mp
, "|=:|>>", mp_lig_kern_token
, 11);
32504 @
:=:/>_
}{\.
{\char'
174=:\char'
174>>} primitive@
>;
32505 mp_primitive
(mp
, "kern", mp_lig_kern_token
, mp_kern_flag
);
32506 @
:kern_
}{\
&{kern} primitive@>
32509 @ @
<Cases of |print_cmd...@
>=
32510 case mp_lig_kern_token
:
32513 mp_print
(mp
, "=:");
32516 mp_print
(mp
, "=:|");
32519 mp_print
(mp
, "|=:");
32522 mp_print
(mp
, "|=:|");
32525 mp_print
(mp
, "=:|>");
32528 mp_print
(mp
, "|=:>");
32531 mp_print
(mp
, "|=:|>");
32534 mp_print
(mp
, "|=:|>>");
32537 mp_print
(mp
, "kern");
32542 @ Local labels are implemented by maintaining the |skip_table| array
,
32543 where |skip_table
[c
]| is either |undefined_label| or the address of the
32544 most recent lig
/kern instruction that skips to local label~|c|. In the
32545 latter case
, the |skip_byte| in that instruction will
(temporarily
)
32546 be zero if there were no prior skips to this label
, or it will be the
32547 distance to the prior skip.
32549 We may need to cancel skips that span more than
127 lig
/kern steps.
32551 @d cancel_skips
(A
) mp-
>ll
=(A
);
32553 mp-
>lll
=qo
(skip_byte
(mp-
>ll
));
32554 skip_byte
(mp-
>ll
)=stop_flag
; mp-
>ll
=(short
)(mp-
>ll-mp-
>lll
);
32555 } while
(mp-
>lll
!=0)
32558 const char
*hlp
[] = { "At most 127 lig/kern steps can separate skipto1 from 1::.", NULL};
32559 mp_error
(mp
, "Too far to skip", hlp
, true
);
32560 @.Too far to skip@
>
32564 @
<Process a |skip_to| command and |goto done|@
>=
32566 c
= mp_get_code
(mp
);
32567 if
(mp-
>nl
- mp-
>skip_table
[c
] > 128) {
32568 skip_error
(mp-
>skip_table
[c
]);
32569 mp-
>skip_table
[c
] = (short
) undefined_label
;
32571 if
(mp-
>skip_table
[c
] == undefined_label
)
32572 skip_byte
(mp-
>nl
- 1) = qi
(0);
32574 skip_byte
(mp-
>nl
- 1) = qi
(mp-
>nl
- mp-
>skip_table
[c
] - 1);
32575 mp-
>skip_table
[c
] = (short
) (mp-
>nl
- 1);
32580 @ @
<Record a label in a lig
/kern subprogram and |goto continue|@
>=
32582 if
(cur_cmd
() == mp_colon
) {
32584 mp-
>bch_label
= mp-
>nl
;
32586 mp_set_tag
(mp
, c
, lig_tag
, mp-
>nl
);
32587 } else if
(mp-
>skip_table
[c
] < undefined_label
) {
32588 mp-
>ll
= mp-
>skip_table
[c
];
32589 mp-
>skip_table
[c
] = undefined_label
;
32591 mp-
>lll
= qo
(skip_byte
(mp-
>ll
));
32592 if
(mp-
>nl
- mp-
>ll
> 128) {
32593 skip_error
(mp-
>ll
);
32596 skip_byte
(mp-
>ll
) = qi
(mp-
>nl
- mp-
>ll
- 1);
32597 mp-
>ll
= (short
) (mp-
>ll
- mp-
>lll
);
32598 } while
(mp-
>lll
!= 0);
32604 @ @
<Compile a ligature
/kern...@
>=
32606 next_char
(mp-
>nl
) = qi
(c
);
32607 skip_byte
(mp-
>nl
) = qi
(0);
32608 if
(cur_mod
() < 128) { /* ligature op
*/
32609 op_byte
(mp-
>nl
) = qi
(cur_mod
());
32610 rem_byte
(mp-
>nl
) = qi
(mp_get_code
(mp
));
32612 mp_get_x_next
(mp
);
32613 mp_scan_expression
(mp
);
32614 if
(mp-
>cur_exp.type
!= mp_known
) {
32615 const char
*hlp
[] = {
32616 "The amount of kern should be a known numeric value.",
32617 "I'm zeroing this one. Proceed, with fingers crossed.",
32619 mp_disp_err
(mp
, NULL);
32620 set_number_to_zero
(new_expr.data.n
);
32621 mp_back_error
(mp
, "Improper kern", hlp
, true
);
32623 mp_get_x_next
(mp
);
32624 mp_flush_cur_exp
(mp
, new_expr
);
32626 number_clone
(mp-
>kern
[mp-
>nk
], cur_exp_value_number
());
32628 while
(!number_equal
(mp-
>kern
[k
], cur_exp_value_number
()))
32631 if
(mp-
>nk
== max_tfm_int
)
32632 mp_fatal_error
(mp
, "too many TFM kerns");
32635 op_byte
(mp-
>nl
) = qi
(kern_flag
+ (k
/ 256));
32636 rem_byte
(mp-
>nl
) = qi
((k
% 256));
32638 mp-
>lk_started
= true
;
32642 @ @d missing_extensible_punctuation
(A
)
32645 const char
*hlp
[] = { "I'm processing `extensible c: t,m,b,r'.", NULL };
32646 mp_snprintf
(msg
, 256, "Missing %s has been inserted", (A
));
32647 mp_back_error
(mp
, msg
, hlp
, true
);
32648 @.Missing `\char`\#'@
>
32651 @
<Define an extensible recipe@
>=
32654 mp_fatal_error
(mp
, "too many extensible recipies");
32655 c
= mp_get_code
(mp
);
32656 mp_set_tag
(mp
, c
, ext_tag
, mp-
>ne
);
32657 if
(cur_cmd
() != mp_colon
)
32658 missing_extensible_punctuation
(":");
32659 ext_top
(mp-
>ne
) = qi
(mp_get_code
(mp
));
32660 if
(cur_cmd
() != mp_comma
)
32661 missing_extensible_punctuation
(",");
32662 ext_mid
(mp-
>ne
) = qi
(mp_get_code
(mp
));
32663 if
(cur_cmd
() != mp_comma
)
32664 missing_extensible_punctuation
(",");
32665 ext_bot
(mp-
>ne
) = qi
(mp_get_code
(mp
));
32666 if
(cur_cmd
() != mp_comma
)
32667 missing_extensible_punctuation
(",");
32668 ext_rep
(mp-
>ne
) = qi
(mp_get_code
(mp
));
32673 @ The header could contain ASCII zeroes
, so can't use |strdup|.
32675 @
<Store a list of header bytes@
>=
32678 if
(j
>= mp-
>header_size
) {
32679 size_t l
= (size_t
) (mp-
>header_size
+ (mp-
>header_size
/ 4));
32680 char
*t
= xmalloc
(l
, 1);
32682 (void
) memcpy
(t
, mp-
>header_byte
, (size_t
) mp-
>header_size
);
32683 xfree
(mp-
>header_byte
);
32684 mp-
>header_byte
= t
;
32685 mp-
>header_size
= (int
) l
;
32687 mp-
>header_byte
[j
] = (char
) mp_get_code
(mp
);
32689 incr
(mp-
>header_last
);
32690 } while
(cur_cmd
() == mp_comma
)
32692 @ @
<Store a list of font dimensions@
>=
32694 if
(j
> max_tfm_int
)
32695 mp_fatal_error
(mp
, "too many fontdimens");
32696 while
(j
> mp-
>np
) {
32698 set_number_to_zero
(mp-
>param
[mp-
>np
]);
32700 mp_get_x_next
(mp
);
32701 mp_scan_expression
(mp
);
32702 if
(mp-
>cur_exp.type
!= mp_known
) {
32703 const char
*hlp
[] = { "I'm zeroing this one. Proceed, with fingers crossed.", NULL };
32704 mp_disp_err
(mp
, NULL);
32705 set_number_to_zero
(new_expr.data.n
);
32706 mp_back_error
(mp
, "Improper font parameter", hlp
, true
);
32707 @.Improper font parameter@
>;
32708 mp_get_x_next
(mp
);
32709 mp_flush_cur_exp
(mp
, new_expr
);
32711 number_clone
(mp-
>param
[j
], cur_exp_value_number
());
32713 } while
(cur_cmd
() == mp_comma
)
32715 @
OK: We've stored all the data that is needed for the \.
{TFM
} file.
32716 All that remains is to output it in the correct format.
32718 An interesting problem needs to be solved in this connection
, because
32719 the \.
{TFM
} format allows at most
256~widths
, 16~heights
, 16~depths
,
32720 and
64~italic corrections. If the data has more distinct values than
32721 this
, we want to meet the necessary restrictions by perturbing the
32722 given values as little as possible.
32724 \MP\ solves this problem in two steps. First the values of a given
32725 kind
(widths
, heights
, depths
, or italic corrections
) are sorted
;
32726 then the list of sorted values is perturbed
, if necessary.
32728 The sorting operation is facilitated by having a special node of
32729 essentially infinite |value| at the end of the current list.
32731 @
<Initialize table entries@
>=
32732 mp-
>inf_val
= mp_get_value_node
(mp
);
32733 set_value_number
(mp-
>inf_val
, fraction_four_t
);
32735 @ @
<Free table entries@
>=
32736 mp_free_value_node
(mp
, mp-
>inf_val
);
32738 @ Straight linear insertion is good enough for sorting
, since the lists
32739 are usually not terribly long. As we work on the data
, the current list
32740 will start at |mp_link
(temp_head
)| and end at |inf_val|
; the nodes in this
32741 list will be in increasing order of their |value| fields.
32743 Given such a list
, the |sort_in| function takes a value and returns a pointer
32744 to where that value can be found in the list. The value is inserted in
32745 the proper place
, if necessary.
32747 At the time we need to do these operations
, most of \MP's work has been
32748 completed
, so we will have plenty of memory to play with. The value nodes
32749 that are allocated for sorting will never be returned to free storage.
32751 @d clear_the_list mp_link
(mp-
>temp_head
)=mp-
>inf_val
32754 static mp_node mp_sort_in
(MP mp
, mp_number v
) {
32755 mp_node p
, q
, r
; /* list manipulation registers
*/
32759 if
(number_lessequal
(v
, value_number
(q
)))
32763 if
(number_less
(v
, value_number
(q
))) {
32764 r
= mp_get_value_node
(mp
);
32765 set_value_number
(r
, v
);
32769 return mp_link
(p
);
32773 @ Now we come to the interesting part
, where we reduce the list if necessary
32774 until it has the required size. The |min_cover| routine is basic to this
32775 process
; it computes the minimum number~|m| such that the values of the
32776 current sorted list can be covered by |m|~intervals of width~|d|. It
32777 also sets the global value |perturbation| to the smallest value $d'
>d$
32778 such that the covering found by this algorithm would be different.
32780 In particular
, |min_cover
(0)| returns the number of distinct values in the
32781 current list and sets |perturbation| to the minimum distance between
32785 static integer mp_min_cover
(MP mp
, mp_number d
) {
32786 mp_node p
; /* runs through the current list
*/
32787 mp_number l
; /* the least element covered by the current interval
*/
32789 integer m
; /* lower bound on the size of the minimum cover
*/
32793 p
= mp_link
(mp-
>temp_head
);
32794 set_number_to_inf
(mp-
>perturbation
);
32795 while
(p
!= mp-
>inf_val
) {
32797 number_clone
(l
, value_number
(p
));
32800 set_number_from_addition
(test
, l
, d
);
32801 } while
(number_lessequal
(value_number
(p
), test
));
32803 set_number_from_substraction
(test
, value_number
(p
), l
);
32804 if
(number_less
(test
, mp-
>perturbation
)) {
32805 number_clone
(mp-
>perturbation
, test
);
32808 free_number
(test
);
32815 mp_number perturbation
; /* quantity related to \.
{TFM
} rounding
*/
32816 integer excess
; /* the list is this much too long
*/
32818 @ @
<Initialize table...@
>=
32819 new_number
(mp-
>perturbation
);
32822 free_number
(mp-
>perturbation
);
32824 @ The smallest |d| such that a given list can be covered with |m| intervals
32825 is determined by the |threshold| routine
, which is sort of an inverse
32826 to |min_cover|. The idea is to increase the interval size rapidly until
32827 finding the range
, then to go sequentially until the exact borderline has
32831 static void mp_threshold
(MP mp
, mp_number
*ret
, integer m
) {
32832 mp_number d
, arg1
; /* lower bound on the smallest interval size
*/
32835 mp-
>excess
= mp_min_cover
(mp
, zero_t
) - m
;
32836 if
(mp-
>excess
<= 0) {
32837 number_clone
(*ret
, zero_t
);
32840 number_clone
(d
, mp-
>perturbation
);
32841 set_number_from_addition
(arg1
, d
, d
);
32842 } while
(mp_min_cover
(mp
, arg1
) > m
);
32843 while
(mp_min_cover
(mp
, d
) > m
) {
32844 number_clone
(d
, mp-
>perturbation
);
32846 number_clone
(*ret
, d
);
32849 free_number
(arg1
);
32853 @ The |skimp| procedure reduces the current list to at most |m| entries
,
32854 by changing values if necessary. It also sets |indep_value
(p
):=k| if |value
(p
)|
32855 is the |k|th distinct value on the resulting list
, and it sets
32856 |perturbation| to the maximum amount by which a |value| field has
32857 been changed. The size of the resulting list is returned as the
32861 static integer mp_skimp
(MP mp
, integer m
) {
32862 mp_number d
; /* the size of intervals being coalesced
*/
32863 mp_node p
, q
, r
; /* list manipulation registers
*/
32864 mp_number l
; /* the least value in the current interval
*/
32865 mp_number v
; /* a compromise value
*/
32868 mp_threshold
(mp
, &d, m);
32872 set_number_to_zero
(mp-
>perturbation
);
32875 p
= mp_link
(mp-
>temp_head
);
32876 while
(p
!= mp-
>inf_val
) {
32878 number_clone
(l
, value_number
(p
));
32879 set_indep_value
(p
,m
);
32880 set_number_from_addition
(l_d
, l
, d
);
32881 if
(number_lessequal
(value_number
(mp_link
(p
)), l_d
)) {
32882 @
<Replace an interval of values by its midpoint@
>;
32895 @ @
<Replace an interval...@
>=
32901 set_indep_value
(p
, m
);
32903 if
(mp-
>excess
== 0) {
32904 number_clone
(l_d
, l
);
32905 set_number_to_zero
(d
);
32907 } while
(number_lessequal
(value_number
(mp_link
(p
)), l_d
));
32908 set_number_from_substraction
(test
, value_number
(p
), l
);
32909 number_halfp
(test
);
32910 set_number_from_addition
(v
, l
, test
);
32911 set_number_from_substraction
(test
, value_number
(p
), v
);
32912 if
(number_greater
(test
, mp-
>perturbation
))
32913 number_clone
(mp-
>perturbation
, test
);
32917 set_value_number
(r
, v
);
32919 mp_link
(q
) = p
; /* remove duplicate values from the current list
*/
32920 free_number
(test
);
32924 @ A warning message is issued whenever something is perturbed by
32925 more than
1/16\thinspace pt.
32928 static void mp_tfm_warning
(MP mp
, quarterword m
) {
32929 mp_print_nl
(mp
, "(some ");
32930 mp_print
(mp
, internal_name
(m
));
32931 @.some charwds...@
>
32932 @.some chardps...@
>
32933 @.some charhts...@
>
32934 @.some charics...@
>;
32935 mp_print
(mp
, " values had to be adjusted by as much as ");
32936 print_number
(mp-
>perturbation
);
32937 mp_print
(mp
, "pt)");
32941 @ Here's an example of how we use these routines.
32942 The width data needs to be perturbed only if there are
256 distinct
32943 widths
, but \MP\ must check for this case even though it is
32946 An integer variable |k| will be defined when we use this code.
32947 The |dimen_head| array will contain pointers to the sorted
32948 lists of dimensions.
32950 @d tfm_warn_threshold_k
((math_data
*)mp-
>math
)->tfm_warn_threshold_t
32952 @
<Massage the \.
{TFM
} widths@
>=
32954 for
(k
= mp-
>bc
; k
<= mp-
>ec
; k
++) {
32955 if
(mp-
>char_exists
[k
])
32956 mp-
>tfm_width
[k
] = mp_sort_in
(mp
, value_number
(mp-
>tfm_width
[k
]));
32958 mp-
>nw
= (short
) (mp_skimp
(mp
, 255) + 1);
32959 mp-
>dimen_head
[1] = mp_link
(mp-
>temp_head
);
32960 if
(number_greaterequal
(mp-
>perturbation
, tfm_warn_threshold_k
))
32961 mp_tfm_warning
(mp
, mp_char_wd
)
32965 mp_node dimen_head
[5]; /* lists of \.
{TFM
} dimensions
*/
32967 @ Heights
, depths
, and italic corrections are different from widths
32968 not only because their list length is more severely restricted
, but
32969 also because zero values do not need to be put into the lists.
32971 @
<Massage the \.
{TFM
} heights
, depths
, and italic corrections@
>=
32973 for
(k
= mp-
>bc
; k
<= mp-
>ec
; k
++) {
32974 if
(mp-
>char_exists
[k
]) {
32975 if
(number_zero
(value_number
(mp-
>tfm_height
[k
])))
32976 mp-
>tfm_height
[k
] = mp-
>zero_val
;
32978 mp-
>tfm_height
[k
] = mp_sort_in
(mp
, value_number
(mp-
>tfm_height
[k
]));
32981 mp-
>nh
= (short
) (mp_skimp
(mp
, 15) + 1);
32982 mp-
>dimen_head
[2] = mp_link
(mp-
>temp_head
);
32983 if
(number_greaterequal
(mp-
>perturbation
, tfm_warn_threshold_k
))
32984 mp_tfm_warning
(mp
, mp_char_ht
);
32986 for
(k
= mp-
>bc
; k
<= mp-
>ec
; k
++) {
32987 if
(mp-
>char_exists
[k
]) {
32988 if
(number_zero
(value_number
(mp-
>tfm_depth
[k
])))
32989 mp-
>tfm_depth
[k
] = mp-
>zero_val
;
32991 mp-
>tfm_depth
[k
] = mp_sort_in
(mp
, value_number
(mp-
>tfm_depth
[k
]));
32994 mp-
>nd
= (short
) (mp_skimp
(mp
, 15) + 1);
32995 mp-
>dimen_head
[3] = mp_link
(mp-
>temp_head
);
32996 if
(number_greaterequal
(mp-
>perturbation
, tfm_warn_threshold_k
))
32997 mp_tfm_warning
(mp
, mp_char_dp
);
32999 for
(k
= mp-
>bc
; k
<= mp-
>ec
; k
++) {
33000 if
(mp-
>char_exists
[k
]) {
33001 if
(number_zero
(value_number
(mp-
>tfm_ital_corr
[k
])))
33002 mp-
>tfm_ital_corr
[k
] = mp-
>zero_val
;
33004 mp-
>tfm_ital_corr
[k
] = mp_sort_in
(mp
, value_number
(mp-
>tfm_ital_corr
[k
]));
33007 mp-
>ni
= (short
) (mp_skimp
(mp
, 63) + 1);
33008 mp-
>dimen_head
[4] = mp_link
(mp-
>temp_head
);
33009 if
(number_greaterequal
(mp-
>perturbation
, tfm_warn_threshold_k
))
33010 mp_tfm_warning
(mp
, mp_char_ic
)
33013 @ @
<Initialize table entries@
>=
33014 mp-
>zero_val
= mp_get_value_node
(mp
);
33015 set_value_number
(mp-
>zero_val
, zero_t
);
33017 @ @
<Free table entries@
>=
33018 mp_free_value_node
(mp
, mp-
>zero_val
);
33020 @ Bytes
5--8 of the header are set to the design size
, unless the user has
33021 some crazy reason for specifying them differently.
33024 Error messages are not allowed at the time this procedure is called
,
33025 so a warning is printed instead.
33027 The value of |max_tfm_dimen| is calculated so that
33028 $$\hbox
{|make_scaled
(16*max_tfm_dimen
,internal_value
(mp_design_size
))|
}
33029 < \\
{three\_bytes
}.$$
33031 @d three_bytes
0100000000 /* $
2^
{24}$
*/
33034 static void mp_fix_design_size
(MP mp
) {
33035 mp_number d
; /* the design size
*/
33037 number_clone
(d
, internal_value
(mp_design_size
));
33038 if
(number_less
(d
, unity_t
) || number_greaterequal
(d
, fraction_half_t
)) {
33039 if
(!number_zero
(d
))
33040 mp_print_nl
(mp
, "(illegal design size has been changed to 128pt)");
33041 @.illegal design size...@
>;
33042 set_number_from_scaled
(d
, 040000000);
33043 number_clone
(internal_value
(mp_design_size
), d
);
33045 if
(mp-
>header_byte
[4] == 0 && mp->header_byte[5] == 0 &&
33046 mp-
>header_byte
[6] == 0 && mp->header_byte[7] == 0) {
33047 integer dd
= number_to_scaled
(d
);
33048 mp-
>header_byte
[4] = (char
) (dd
/ 04000000);
33049 mp-
>header_byte
[5] = (char
) ((dd
/ 4096) % 256);
33050 mp-
>header_byte
[6] = (char
) ((dd
/ 16) % 256);
33051 mp-
>header_byte
[7] = (char
) ((dd
% 16) * 16);
33053 /* |mp-
>max_tfm_dimen
= 16 * internal_value
(mp_design_size
) - 1 - internal_value
(mp_design_size
) / 010000000|
*/
33055 mp_number secondpart
;
33056 new_number
(secondpart
);
33057 number_clone
(secondpart
, internal_value
(mp_design_size
));
33058 number_clone
(mp-
>max_tfm_dimen
, secondpart
);
33059 number_divide_int
(secondpart
, 010000000);
33060 number_multiply_int
(mp-
>max_tfm_dimen
, 16);
33061 number_add_scaled
(mp-
>max_tfm_dimen
, -1);
33062 number_substract
(mp-
>max_tfm_dimen
, secondpart
);
33063 free_number
(secondpart
);
33065 if
(number_greaterequal
(mp-
>max_tfm_dimen
, fraction_half_t
)) {
33066 number_clone
(mp-
>max_tfm_dimen
, fraction_half_t
);
33067 number_add_scaled
(mp-
>max_tfm_dimen
, -1);
33073 @ The |dimen_out| procedure computes a |fix_word| relative to the
33074 design size. If the data was out of range
, it is corrected and the
33075 global variable |tfm_changed| is increased by~one.
33078 static integer mp_dimen_out
(MP mp
, mp_number x_orig
) {
33082 new_number
(abs_x
);
33084 number_clone
(x
, x_orig
);
33085 number_clone
(abs_x
, x_orig
);
33086 number_abs
(abs_x
);
33087 if
(number_greater
(abs_x
, mp-
>max_tfm_dimen
)) {
33088 incr
(mp-
>tfm_changed
);
33089 if
(number_positive
(x
))
33090 number_clone
(x
, mp-
>max_tfm_dimen
);
33092 number_clone
(x
, mp-
>max_tfm_dimen
);
33099 number_clone
(arg1
, x
);
33100 number_multiply_int
(arg1
, 16);
33101 make_scaled
(x
, arg1
, internal_value
(mp_design_size
));
33102 free_number
(arg1
);
33104 free_number
(abs_x
);
33105 ret
= number_to_scaled
(x
);
33112 mp_number max_tfm_dimen
; /* bound on widths
, heights
, kerns
, etc.
*/
33113 integer tfm_changed
; /* the number of data entries that were out of bounds
*/
33115 @ @
<Initialize table...@
>=
33116 new_number
(mp-
>max_tfm_dimen
);
33119 free_number
(mp-
>max_tfm_dimen
);
33122 @ If the user has not specified any of the first four header bytes
,
33123 the |fix_check_sum| procedure replaces them by a ``check sum'' computed
33124 from the |tfm_width| data relative to the design size.
33128 static void mp_fix_check_sum
(MP mp
) {
33129 eight_bits k
; /* runs through character codes
*/
33130 eight_bits B1
, B2
, B3
, B4
; /* bytes of the check sum
*/
33131 integer x
; /* hash value used in check sum computation
*/
33132 if
(mp-
>header_byte
[0] == 0 && mp->header_byte[1] == 0 &&
33133 mp-
>header_byte
[2] == 0 && mp->header_byte[3] == 0) {
33134 @
<Compute a check sum in |
(b1
,b2
,b3
,b4
)|@
>;
33135 mp-
>header_byte
[0] = (char
) B1
;
33136 mp-
>header_byte
[1] = (char
) B2
;
33137 mp-
>header_byte
[2] = (char
) B3
;
33138 mp-
>header_byte
[3] = (char
) B4
;
33144 @ @
<Compute a check sum in |
(b1
,b2
,b3
,b4
)|@
>=
33149 mp-
>tfm_changed
= 0;
33150 for
(k
= mp-
>bc
; k
<= mp-
>ec
; k
++) {
33151 if
(mp-
>char_exists
[k
]) {
33152 x
= mp_dimen_out
(mp
, value_number
(mp-
>tfm_width
[k
])) + (k
+ 4) * 020000000; /* this is positive
*/
33153 B1
= (eight_bits
) ((B1
+ B1
+ x
) % 255);
33154 B2
= (eight_bits
) ((B2
+ B2
+ x
) % 253);
33155 B3
= (eight_bits
) ((B3
+ B3
+ x
) % 251);
33156 B4
= (eight_bits
) ((B4
+ B4
+ x
) % 247);
33163 @ Finally we're ready to actually write the \.
{TFM
} information.
33164 Here are some utility routines for this purpose.
33166 @d tfm_out
(A
) do
{ /* output one byte to |tfm_file|
*/
33167 unsigned char s
=(unsigned char
)(A
);
33168 (mp-
>write_binary_file
)(mp
,mp-
>tfm_file
,(void
*)&s,1);
33172 static void mp_tfm_two
(MP mp
, integer x
) { /* output two bytes to |tfm_file|
*/
33176 static void mp_tfm_four
(MP mp
, integer x
) { /* output four bytes to |tfm_file|
*/
33178 tfm_out
(x
/ three_bytes
);
33180 x
= x
+ 010000000000; /* use two's complement for negative values
*/
33181 x
= x
+ 010000000000;
33182 tfm_out
((x
/ three_bytes
) + 128);
33184 x
= x
% three_bytes
;
33185 tfm_out
(x
/ number_to_scaled
(unity_t
));
33186 x
= x
% number_to_scaled
(unity_t
);
33187 tfm_out
(x
/ 0400);
33188 tfm_out
(x
% 0400);
33190 static void mp_tfm_qqqq
(MP mp
, four_quarters x
) { /* output four quarterwords to |tfm_file|
*/
33191 tfm_out
(qo
(x.b0
));
33192 tfm_out
(qo
(x.b1
));
33193 tfm_out
(qo
(x.b2
));
33194 tfm_out
(qo
(x.b3
));
33198 @ @
<Finish the \.
{TFM
} file@
>=
33199 if
(mp-
>job_name
== NULL)
33200 mp_open_log_file
(mp
);
33201 mp_pack_job_name
(mp
, ".tfm");
33202 while
(!mp_open_out
(mp
, &mp->tfm_file, mp_filetype_metrics))
33203 mp_prompt_file_name
(mp
, "file name for font metrics", ".tfm");
33204 mp-
>metric_file_name
= xstrdup
(mp-
>name_of_file
);
33205 @
<Output the subfile sizes and header bytes@
>;
33206 @
<Output the character information bytes
, then
33207 output the dimensions themselves@
>;
33208 @
<Output the ligature
/kern program@
>;
33209 @
<Output the extensible character recipes and the font metric parameters@
>;
33210 if
(number_positive
(internal_value
(mp_tracing_stats
)))
33211 @
<Log the subfile sizes of the \.
{TFM
} file@
>;
33212 mp_print_nl
(mp
, "Font metrics written on ");
33213 mp_print
(mp
, mp-
>metric_file_name
);
33214 mp_print_char
(mp
, xord
('.'
));
33215 @.Font metrics written...@
>;
33216 (mp-
>close_file
) (mp
, mp-
>tfm_file
)
33219 @ Integer variables |lh|
, |k|
, and |lk_offset| will be defined when we use
33222 @
<Output the subfile sizes and header bytes@
>=
33223 k
= mp-
>header_last
;
33224 LH
= (k
+ 4) / 4; /* this is the number of header words
*/
33225 if
(mp-
>bc
> mp-
>ec
)
33226 mp-
>bc
= 1; /* if there are no characters
, |ec
=0| and |bc
=1|
*/
33227 @
<Compute the ligature
/kern program offset and implant the
33228 left boundary label@
>;
33230 6 + LH
+ (mp-
>ec
- mp-
>bc
+ 1) + mp-
>nw
+ mp-
>nh
+ mp-
>nd
+ mp-
>ni
+
33231 mp-
>nl
+ lk_offset
+ mp-
>nk
+ mp-
>ne
+ mp-
>np
);
33232 /* this is the total number of file words that will be output
*/
33233 mp_tfm_two
(mp
, LH
);
33234 mp_tfm_two
(mp
, mp-
>bc
);
33235 mp_tfm_two
(mp
, mp-
>ec
);
33236 mp_tfm_two
(mp
, mp-
>nw
);
33237 mp_tfm_two
(mp
, mp-
>nh
);
33238 mp_tfm_two
(mp
, mp-
>nd
);
33239 mp_tfm_two
(mp
, mp-
>ni
);
33240 mp_tfm_two
(mp
, mp-
>nl
+ lk_offset
);
33241 mp_tfm_two
(mp
, mp-
>nk
);
33242 mp_tfm_two
(mp
, mp-
>ne
);
33243 mp_tfm_two
(mp
, mp-
>np
);
33244 for
(k
= 0; k
< 4 * LH
; k
++) {
33245 tfm_out
(mp-
>header_byte
[k
]);
33249 @ @
<Output the character information bytes...@
>=
33250 for
(k
= mp-
>bc
; k
<= mp-
>ec
; k
++) {
33251 if
(!mp-
>char_exists
[k
]) {
33252 mp_tfm_four
(mp
, 0);
33254 tfm_out
(indep_value
(mp-
>tfm_width
[k
])); /* the width index
*/
33255 tfm_out
((indep_value
(mp-
>tfm_height
[k
])) * 16 + indep_value
(mp-
>tfm_depth
[k
]));
33256 tfm_out
((indep_value
(mp-
>tfm_ital_corr
[k
])) * 4 + mp-
>char_tag
[k
]);
33257 tfm_out
(mp-
>char_remainder
[k
]);
33260 mp-
>tfm_changed
= 0;
33261 for
(k
= 1; k
<= 4; k
++) {
33262 mp_tfm_four
(mp
, 0);
33263 p
= mp-
>dimen_head
[k
];
33264 while
(p
!= mp-
>inf_val
) {
33265 mp_tfm_four
(mp
, mp_dimen_out
(mp
, value_number
(p
)));
33271 @ We need to output special instructions at the beginning of the
33272 |lig_kern| array in order to specify the right boundary character
33273 and
/or to handle starting addresses that exceed
255. The |label_loc|
33274 and |label_char| arrays have been set up to record all the
33275 starting addresses
; we have $
-1=|label_loc|
[0]<|label_loc|
[1]\le\cdots
33276 \le|label_loc|
[|label_ptr
]|$.
33278 @
<Compute the ligature
/kern program offset...@
>=
33279 mp-
>bchar
= round_unscaled
(internal_value
(mp_boundary_char
));
33280 if
((mp-
>bchar
< 0) ||
(mp-
>bchar
> 255)) {
33282 mp-
>lk_started
= false
;
33285 mp-
>lk_started
= true
;
33288 @
<Find the minimum |lk_offset| and adjust all remainders@
>;
33289 if
(mp-
>bch_label
< undefined_label
) {
33290 skip_byte
(mp-
>nl
) = qi
(255);
33291 next_char
(mp-
>nl
) = qi
(0);
33292 op_byte
(mp-
>nl
) = qi
(((mp-
>bch_label
+ lk_offset
) / 256));
33293 rem_byte
(mp-
>nl
) = qi
(((mp-
>bch_label
+ lk_offset
) % 256));
33294 mp-
>nl
++; /* possibly |nl
=lig_table_size
+1|
*/
33297 @ @
<Find the minimum |lk_offset|...@
>=
33298 k
= mp-
>label_ptr
; /* pointer to the largest unallocated label
*/
33299 if
(mp-
>label_loc
[k
] + lk_offset
> 255) {
33301 mp-
>lk_started
= false
; /* location
0 can do double duty
*/
33303 mp-
>char_remainder
[mp-
>label_char
[k
]] = lk_offset
;
33304 while
(mp-
>label_loc
[k
- 1] == mp-
>label_loc
[k
]) {
33306 mp-
>char_remainder
[mp-
>label_char
[k
]] = lk_offset
;
33310 } while
(!(lk_offset
+ mp-
>label_loc
[k
] < 256));
33311 /* N.B.
: |lk_offset
=256| satisfies this when |k
=0|
*/
33313 if
(lk_offset
> 0) {
33315 mp-
>char_remainder
[mp-
>label_char
[k
]]
33316 = mp-
>char_remainder
[mp-
>label_char
[k
]] + lk_offset
;
33321 @ @
<Output the ligature
/kern program@
>=
33322 for
(k
= 0; k
<= 255; k
++) {
33323 if
(mp-
>skip_table
[k
] < undefined_label
) {
33324 mp_print_nl
(mp
, "(local label ");
33325 mp_print_int
(mp
, k
);
33326 mp_print
(mp
, ":: was missing)");
33327 @.local label l
:: was missing@
>;
33328 cancel_skips
(mp-
>skip_table
[k
]);
33331 if
(mp-
>lk_started
) { /* |lk_offset
=1| for the special |bchar|
*/
33333 tfm_out
(mp-
>bchar
);
33334 mp_tfm_two
(mp
, 0);
33336 for
(k
= 1; k
<= lk_offset
; k
++) { /* output the redirection specs
*/
33337 mp-
>ll
= mp-
>label_loc
[mp-
>label_ptr
];
33338 if
(mp-
>bchar
< 0) {
33343 tfm_out
(mp-
>bchar
);
33345 mp_tfm_two
(mp
, mp-
>ll
+ lk_offset
);
33348 } while
(!(mp-
>label_loc
[mp-
>label_ptr
] < mp-
>ll
));
33351 for
(k
= 0; k
< mp-
>nl
; k
++)
33352 mp_tfm_qqqq
(mp
, mp-
>lig_kern
[k
]);
33356 for
(k
= 0; k
< mp-
>nk
; k
++) {
33357 number_clone
(arg
, mp-
>kern
[k
]);
33358 mp_tfm_four
(mp
, mp_dimen_out
(mp
, arg
));
33363 @ @
<Output the extensible character recipes...@
>=
33364 for
(k
= 0; k
< mp-
>ne
; k
++)
33365 mp_tfm_qqqq
(mp
, mp-
>exten
[k
]);
33369 for
(k
= 1; k
<= mp-
>np
; k
++) {
33371 number_clone
(arg
, mp-
>param
[1]);
33373 if
(number_less
(arg
, fraction_half_t
)) {
33374 mp_tfm_four
(mp
, number_to_scaled
(mp-
>param
[1]) * 16);
33376 incr
(mp-
>tfm_changed
);
33377 if
(number_positive
(mp-
>param
[1]))
33378 mp_tfm_four
(mp
, max_integer
);
33380 mp_tfm_four
(mp
, -max_integer
);
33383 number_clone
(arg
, mp-
>param
[k
]);
33384 mp_tfm_four
(mp
, mp_dimen_out
(mp
, arg
));
33389 if
(mp-
>tfm_changed
> 0) {
33390 if
(mp-
>tfm_changed
== 1) {
33391 mp_print_nl
(mp
, "(a font metric dimension");
33392 @.a font metric dimension...@
>
33394 mp_print_nl
(mp
, "(");
33395 mp_print_int
(mp
, mp-
>tfm_changed
);
33396 @.font metric dimensions...@
>;
33397 mp_print
(mp
, " font metric dimensions");
33399 mp_print
(mp
, " had to be decreased)");
33402 @ @
<Log the subfile sizes of the \.
{TFM
} file@
>=
33406 if
(mp-
>bch_label
< undefined_label
)
33408 mp_snprintf
(s
, 128,
33409 "(You used %iw,%ih,%id,%ii,%il,%ik,%ie,%ip metric file positions)",
33410 mp-
>nw
, mp-
>nh
, mp-
>nd
, mp-
>ni
, mp-
>nl
, mp-
>nk
, mp-
>ne
, mp-
>np
);
33415 @
* Reading font metric data.
33417 \MP\ isn't a typesetting program but it does need to find the bounding box
33418 of a sequence of typeset characters. Thus it needs to read \.
{TFM
} files as
33419 well as write them.
33424 @ All the width
, height
, and depth information is stored in an array called
33425 |font_info|. This array is allocated sequentially and each font is stored
33426 as a series of |char_info| words followed by the width
, height
, and depth
33427 tables. Since |font_name| entries are permanent
, their |str_ref| values are
33428 set to |MAX_STR_REF|.
33431 typedef unsigned int font_number
; /* |
0..font_max|
*/
33433 @ The |font_info| array is indexed via a group directory arrays.
33434 For example
, the |char_info| data for character~|c| in font~|f| will be
33435 in |font_info
[char_base
[f
]+c
].qqqq|.
33438 font_number font_max
; /* maximum font number for included text fonts
*/
33439 size_t font_mem_size
; /* number of words for \.
{TFM
} information for text fonts
*/
33440 font_data
*font_info
; /* height
, width
, and depth data
*/
33441 char
**font_enc_name
; /* encoding names
, if any
*/
33442 boolean
*font_ps_name_fixed
; /* are the postscript names fixed already?
*/
33443 size_t next_fmem
; /* next unused entry in |font_info|
*/
33444 font_number last_fnum
; /* last font number used so far
*/
33445 integer
*font_dsize
; /* 16 times the ``design'' size in \ps\ points
*/
33446 char
**font_name
; /* name as specified in the \
&{infont} command */
33447 char
**font_ps_name
; /* PostScript name for use when |internal
[mp_prologues
]>0|
*/
33448 font_number last_ps_fnum
; /* last valid |font_ps_name| index
*/
33449 eight_bits
*font_bc
;
33450 eight_bits
*font_ec
; /* first and last character code
*/
33451 int
*char_base
; /* base address for |char_info|
*/
33452 int
*width_base
; /* index for zeroth character width
*/
33453 int
*height_base
; /* index for zeroth character height
*/
33454 int
*depth_base
; /* index for zeroth character depth
*/
33455 mp_node
*font_sizes
;
33457 @ @
<Allocate or initialize ...@
>=
33458 mp-
>font_mem_size
= 10000;
33459 mp-
>font_info
= xmalloc
((mp-
>font_mem_size
+ 1), sizeof
(font_data
));
33460 memset
(mp-
>font_info
, 0, sizeof
(font_data
) * (mp-
>font_mem_size
+ 1));
33461 mp-
>last_fnum
= null_font
;
33463 @ @
<Dealloc variables@
>=
33464 for
(k
= 1; k
<= (int
) mp-
>last_fnum
; k
++) {
33465 xfree
(mp-
>font_enc_name
[k
]);
33466 xfree
(mp-
>font_name
[k
]);
33467 xfree
(mp-
>font_ps_name
[k
]);
33469 for
(k
= 0; k
<= 255; k
++) {
33470 /* These are disabled for now following a bug-report about double free
33471 errors.
TO BE FIXED
, bug tracker id
831 */
33473 mp_free_value_node
(mp
, mp-
>tfm_width
[k
]);
33474 mp_free_value_node
(mp
, mp-
>tfm_height
[k
]);
33475 mp_free_value_node
(mp
, mp-
>tfm_depth
[k
]);
33476 mp_free_value_node
(mp
, mp-
>tfm_ital_corr
[k
]);
33480 xfree
(mp-
>font_info
);
33481 xfree
(mp-
>font_enc_name
);
33482 xfree
(mp-
>font_ps_name_fixed
);
33483 xfree
(mp-
>font_dsize
);
33484 xfree
(mp-
>font_name
);
33485 xfree
(mp-
>font_ps_name
);
33486 xfree
(mp-
>font_bc
);
33487 xfree
(mp-
>font_ec
);
33488 xfree
(mp-
>char_base
);
33489 xfree
(mp-
>width_base
);
33490 xfree
(mp-
>height_base
);
33491 xfree
(mp-
>depth_base
);
33492 xfree
(mp-
>font_sizes
);
33496 void mp_reallocate_fonts
(MP mp
, font_number l
) {
33498 XREALLOC
(mp-
>font_enc_name
, l
, char
*);
33499 XREALLOC
(mp-
>font_ps_name_fixed
, l
, boolean
);
33500 XREALLOC
(mp-
>font_dsize
, l
, integer
);
33501 XREALLOC
(mp-
>font_name
, l
, char
*);
33502 XREALLOC
(mp-
>font_ps_name
, l
, char
*);
33503 XREALLOC
(mp-
>font_bc
, l
, eight_bits
);
33504 XREALLOC
(mp-
>font_ec
, l
, eight_bits
);
33505 XREALLOC
(mp-
>char_base
, l
, int
);
33506 XREALLOC
(mp-
>width_base
, l
, int
);
33507 XREALLOC
(mp-
>height_base
, l
, int
);
33508 XREALLOC
(mp-
>depth_base
, l
, int
);
33509 XREALLOC
(mp-
>font_sizes
, l
, mp_node
);
33510 for
(f
= (mp-
>last_fnum
+ 1); f
<= l
; f
++) {
33511 mp-
>font_enc_name
[f
] = NULL;
33512 mp-
>font_ps_name_fixed
[f
] = false
;
33513 mp-
>font_name
[f
] = NULL;
33514 mp-
>font_ps_name
[f
] = NULL;
33515 mp-
>font_sizes
[f
] = NULL;
33521 @ @
<Internal library declarations@
>=
33522 void mp_reallocate_fonts
(MP mp
, font_number l
);
33525 @ A |null_font| containing no characters is useful for error recovery. Its
33526 |font_name| entry starts out empty but is reset each time an erroneous font is
33527 found. This helps to cut down on the number of duplicate error messages without
33528 wasting a lot of space.
33530 @d null_font
0 /* the |font_number| for an empty font
*/
33532 @
<Set initial...@
>=
33533 mp-
>font_dsize
[null_font
] = 0;
33534 mp-
>font_bc
[null_font
] = 1;
33535 mp-
>font_ec
[null_font
] = 0;
33536 mp-
>char_base
[null_font
] = 0;
33537 mp-
>width_base
[null_font
] = 0;
33538 mp-
>height_base
[null_font
] = 0;
33539 mp-
>depth_base
[null_font
] = 0;
33541 mp-
>last_fnum
= null_font
;
33542 mp-
>last_ps_fnum
= null_font
;
33544 static char nullfont_name
[] = "nullfont";
33545 static char nullfont_psname
[] = "";
33546 mp-
>font_name
[null_font
] = nullfont_name
;
33547 mp-
>font_ps_name
[null_font
] = nullfont_psname
;
33549 mp-
>font_ps_name_fixed
[null_font
] = false
;
33550 mp-
>font_enc_name
[null_font
] = NULL;
33551 mp-
>font_sizes
[null_font
] = NULL;
33553 @ Each |char_info| word is of type |four_quarters|. The |b0| field contains
33554 the |width index|
; the |b1| field contains the height
33555 index
; the |b2| fields contains the depth index
, and the |b3| field used only
33556 for temporary storage.
(It is used to keep track of which characters occur in
33557 an edge structure that is being shipped out.
)
33558 The corresponding words in the width
, height
, and depth tables are stored as
33559 |scaled| values in units of \ps\ points.
33561 With the macros below
, the |char_info| word for character~|c| in font~|f| is
33562 |char_mp_info
(f
,c
)| and the width is
33563 $$\hbox
{|char_width
(f
,char_mp_info
(f
,c
)).sc|.
}$$
33565 @d char_mp_info
(A
,B
) mp-
>font_info
[mp-
>char_base
[(A
)]+(B
)].qqqq
33566 @d char_width
(A
,B
) mp-
>font_info
[mp-
>width_base
[(A
)]+(B
).b0
].sc
33567 @d char_height
(A
,B
) mp-
>font_info
[mp-
>height_base
[(A
)]+(B
).b1
].sc
33568 @d char_depth
(A
,B
) mp-
>font_info
[mp-
>depth_base
[(A
)]+(B
).b2
].sc
33569 @d ichar_exists
(A
) ((A
).b0
>0)
33571 @ When we have a font name and we don't know whether it has been loaded yet
,
33572 we scan the |font_name| array before calling |read_font_info|.
33575 static font_number mp_find_font
(MP mp
, char
*f
);
33578 font_number mp_find_font
(MP mp
, char
*f
) {
33580 for
(n
= 0; n
<= mp-
>last_fnum
; n
++) {
33581 if
(mp_xstrcmp
(f
, mp-
>font_name
[n
]) == 0) {
33585 n
= mp_read_font_info
(mp
, f
);
33590 @ This is an interface function for getting the width of character
,
33591 as a double in ps units
33594 double mp_get_char_dimension
(MP mp
, char
*fname
, int c
, int t
) {
33599 for
(n
= 0; n
<= mp-
>last_fnum
; n
++) {
33600 if
(mp_xstrcmp
(fname
, mp-
>font_name
[n
]) == 0) {
33607 cc
= char_mp_info
(f
, c
);
33608 if
(!ichar_exists
(cc
))
33611 w
= (double
) char_width
(f
, cc
);
33613 w
= (double
) char_height
(f
, cc
);
33615 w
= (double
) char_depth
(f
, cc
);
33616 return w
/ 655.35 * (72.27 / 72);
33620 @ @
<Exported function ...@
>=
33621 double mp_get_char_dimension
(MP mp
, char
*fname
, int n
, int t
);
33624 @ If we discover that the font doesn't have a requested character
, we omit it
33625 from the bounding box computation and expect the \ps\ interpreter to drop it.
33626 This routine issues a warning message if the user has asked for it.
33629 static void mp_lost_warning
(MP mp
, font_number f
, int k
);
33632 void mp_lost_warning
(MP mp
, font_number f
, int k
) {
33633 if
(number_positive
(internal_value
(mp_tracing_lost_chars
))) {
33634 mp_begin_diagnostic
(mp
);
33635 if
(mp-
>selector
== log_only
)
33636 incr
(mp-
>selector
);
33637 mp_print_nl
(mp
, "Missing character: There is no ");
33638 @.Missing character@
>;
33639 mp_print_int
(mp
, k
);
33640 mp_print
(mp
, " in font ");
33641 mp_print
(mp
, mp-
>font_name
[f
]);
33642 mp_print_char
(mp
, xord
('
!'
));
33643 mp_end_diagnostic
(mp
, false
);
33648 @ The whole purpose of saving the height
, width
, and depth information is to be
33649 able to find the bounding box of an item of text in an edge structure. The
33650 |set_text_box| procedure takes a text node and adds this information.
33653 static void mp_set_text_box
(MP mp
, mp_text_node p
);
33656 void mp_set_text_box
(MP mp
, mp_text_node p
) {
33657 font_number f
; /* |mp_font_n
(p
)|
*/
33658 ASCII_code bc
, ec
; /* range of valid characters for font |f|
*/
33659 size_t k
, kk
; /* current character and character to stop at
*/
33660 four_quarters cc
; /* the |char_info| for the current character
*/
33661 mp_number h
, d
; /* dimensions of the current character
*/
33664 set_number_to_zero
(p-
>width
);
33665 set_number_to_neg_inf
(p-
>height
);
33666 set_number_to_neg_inf
(p-
>depth
);
33667 f
= (font_number
) mp_font_n
(p
);
33668 bc
= mp-
>font_bc
[f
];
33669 ec
= mp-
>font_ec
[f
];
33670 kk
= mp_text_p
(p
)->len
;
33673 @
<Adjust |p|'s bounding box to contain |str_pool
[k
]|
; advance |k|@
>;
33675 @
<Set the height and depth to zero if the bounding box is empty@
>;
33681 @ @
<Adjust |p|'s bounding box to contain |str_pool
[k
]|
; advance |k|@
>=
33683 if
((*(mp_text_p
(p
)->str
+ k
) < bc
) ||
(*(mp_text_p
(p
)->str
+ k
) > ec
)) {
33684 mp_lost_warning
(mp
, f
, *(mp_text_p
(p
)->str
+ k
));
33686 cc
= char_mp_info
(f
, *(mp_text_p
(p
)->str
+ k
));
33687 if
(!ichar_exists
(cc
)) {
33688 mp_lost_warning
(mp
, f
, *(mp_text_p
(p
)->str
+ k
));
33690 set_number_from_scaled
(p-
>width
, number_to_scaled
(p-
>width
) + char_width
(f
, cc
));
33691 set_number_from_scaled
(h
, char_height
(f
, cc
));
33692 set_number_from_scaled
(d
, char_depth
(f
, cc
));
33693 if
(number_greater
(h
, p-
>height
))
33694 number_clone
(p-
>height
, h
);
33695 if
(number_greater
(d
, p-
>depth
))
33696 number_clone
(p-
>depth
, d
);
33703 @ Let's hope modern compilers do comparisons correctly when the difference would
33706 @
<Set the height and depth to zero if the bounding box is empty@
>=
33707 if
(number_to_scaled
(p-
>height
) < -number_to_scaled
(p-
>depth
)) {
33708 set_number_to_zero
(p-
>height
);
33709 set_number_to_zero
(p-
>depth
);
33712 @ The new primitives fontmapfile and fontmapline.
33714 @
<Declare action procedures for use by |do_statement|@
>=
33715 static void mp_do_mapfile
(MP mp
);
33716 static void mp_do_mapline
(MP mp
);
33719 static void mp_do_mapfile
(MP mp
) {
33720 mp_get_x_next
(mp
);
33721 mp_scan_expression
(mp
);
33722 if
(mp-
>cur_exp.type
!= mp_string_type
) {
33723 @
<Complain about improper map operation@
>;
33725 mp_map_file
(mp
, cur_exp_str
());
33728 static void mp_do_mapline
(MP mp
) {
33729 mp_get_x_next
(mp
);
33730 mp_scan_expression
(mp
);
33731 if
(mp-
>cur_exp.type
!= mp_string_type
) {
33732 @
<Complain about improper map operation@
>;
33734 mp_map_line
(mp
, cur_exp_str
());
33739 @ @
<Complain about improper map operation@
>=
33741 const char
*hlp
[] = { "Only known strings can be map files or map lines.", NULL };
33742 mp_disp_err
(mp
, NULL);
33743 mp_back_error
(mp
, "Unsuitable expression", hlp
, true
);
33744 mp_get_x_next
(mp
);
33748 @ To print |scaled| value to PDF output we need some subroutines to ensure
33751 @d max_integer
0x7FFFFFFF /* $
2^
{31}-1$
*/
33754 integer ten_pow
[10]; /* $
10^
0.
.10^
9$
*/
33755 integer scaled_out
; /* amount of |scaled| that was taken out in |divide_scaled|
*/
33758 mp-
>ten_pow
[0] = 1;
33759 for
(i
= 1; i
<= 9; i
++) {
33760 mp-
>ten_pow
[i
] = 10 * mp-
>ten_pow
[i
- 1];
33764 @
* Shipping pictures out.
33765 The |ship_out| procedure
, to be described below
, is given a pointer to
33766 an edge structure. Its mission is to output a file containing the \ps\
33767 description of an edge structure.
33769 @ Each time an edge structure is shipped out we write a new \ps\ output
33770 file named according to the current \
&{charcode}.
33771 @
:char_code_
}{\
&{charcode} primitive@>
33773 This is the only backend function that remains in the main |mpost.w| file.
33774 There are just too many variable accesses needed for status reporting
33775 etcetera to make it worthwile to move the code to |psout.w|.
33777 @
<Internal library declarations@
>=
33778 void mp_open_output_file
(MP mp
);
33779 char
*mp_get_output_file_name
(MP mp
);
33780 char
*mp_set_output_file_name
(MP mp
, integer c
);
33783 static void mp_append_to_template
(MP mp
, integer ff
, integer c
, boolean rounding
) {
33784 if
(internal_type
(c
) == mp_string_type
) {
33785 char
*ss
= mp_str
(mp
, internal_string
(c
));
33787 } else if
(internal_type
(c
) == mp_known
) {
33789 int cc
= round_unscaled
(internal_value
(c
));
33790 print_with_leading_zeroes
(cc
, ff
);
33792 print_number
(internal_value
(c
));
33796 char
*mp_set_output_file_name
(MP mp
, integer c
) {
33797 char
*ss
= NULL; /* filename extension proposal
*/
33798 char
*nn
= NULL; /* temp string for str
() */
33799 unsigned old_setting
; /* previous |selector| setting
*/
33800 size_t i
; /* indexes into |filename_template|
*/
33801 integer f
; /* field width
*/
33803 if
(mp-
>job_name
== NULL)
33804 mp_open_log_file
(mp
);
33805 if
(internal_string
(mp_output_template
) == NULL) {
33806 char
*s
; /* a file extension derived from |c|
*/
33808 s
= xstrdup
(".ps");
33810 @
<Use |c| to compute the file extension |s|@
>;
33811 mp_pack_job_name
(mp
, s
);
33813 ss
= xstrdup
(mp-
>name_of_file
);
33814 } else
{ /* initializations
*/
33815 mp_string s
, n
, ftemplate
; /* a file extension derived from |c|
*/
33816 mp_number saved_char_code
;
33817 new_number
(saved_char_code
);
33818 number_clone
(saved_char_code
, internal_value
(mp_char_code
));
33819 set_internal_from_number
(mp_char_code
, unity_t
);
33820 number_multiply_int
(internal_value
(mp_char_code
), c
);
33821 if
(internal_string
(mp_job_name
) == NULL) {
33822 if
(mp-
>job_name
== NULL) {
33823 mp-
>job_name
= xstrdup
("mpout");
33825 @
<Fix up |mp-
>internal
[mp_job_name
]|@
>;
33827 old_setting
= mp-
>selector
;
33828 mp-
>selector
= new_string
;
33830 n
= mp_rts
(mp
,""); /* initialize
*/
33831 ftemplate
= internal_string
(mp_output_template
);
33832 while
(i
< ftemplate-
>len
) {
33834 if
(*(ftemplate-
>str
+ i
) == '
%'
) {
33837 if
(i
< ftemplate-
>len
) {
33838 switch
(*(ftemplate-
>str
+ i
)) {
33840 mp_append_to_template
(mp
, f
, mp_job_name
, true
);
33843 if
(number_negative
(internal_value
(mp_char_code
))) {
33844 mp_print
(mp
, "ps");
33846 mp_append_to_template
(mp
, f
, mp_char_code
, true
);
33850 mp_append_to_template
(mp
, f
, mp_output_format
, true
);
33853 mp_append_to_template
(mp
, f
, mp_day
, true
);
33856 mp_append_to_template
(mp
, f
, mp_month
, true
);
33859 mp_append_to_template
(mp
, f
, mp_year
, true
);
33862 mp_append_to_template
(mp
, f
, mp_hour
, true
);
33865 mp_append_to_template
(mp
, f
, mp_minute
, true
);
33869 /* look up a name
*/
33871 size_t frst
= i
+ 1;
33872 while
(i
< ftemplate-
>len
) {
33874 if
(*(ftemplate-
>str
+ i
) == '
}'
)
33880 mp_id_lookup
(mp
, (char
*) (ftemplate-
>str
+ frst
), l
, false
);
33881 char
*id
= xmalloc
((l
+ 1), 1);
33882 (void
) memcpy
(id
, (char
*) (ftemplate-
>str
+ frst
), (size_t
) l
);
33886 mp_snprintf
(err
, 256,
33887 "requested identifier (%s) in outputtemplate not found.",
33891 if
(eq_type
(p
) == mp_internal_quantity
) {
33892 if
(equiv
(p
) == mp_output_template
) {
33894 mp_snprintf
(err
, 256,
33895 "The appearance of outputtemplate inside outputtemplate is ignored.");
33898 mp_append_to_template
(mp
, f
, equiv
(p
), false
);
33902 mp_snprintf
(err
, 256,
33903 "requested identifier (%s) in outputtemplate is not an internal.",
33923 f
= (f
* 10) + ftemplate-
>str
[i
] - '
0'
;
33927 mp_print_char
(mp
, '
%'
);
33932 mp_snprintf
(err
, 256,
33933 "requested format (%c) in outputtemplate is unknown.",
33934 *(ftemplate-
>str
+ i
));
33937 mp_print_char
(mp
, *(ftemplate-
>str
+ i
));
33941 if
(*(ftemplate-
>str
+ i
) == '.'
)
33943 n
= mp_make_string
(mp
);
33944 mp_print_char
(mp
, *(ftemplate-
>str
+ i
));
33948 s
= mp_make_string
(mp
);
33949 number_clone
(internal_value
(mp_char_code
), saved_char_code
);
33950 free_number
(saved_char_code
);
33951 mp-
>selector
= old_setting
;
33956 ss
= mp_str
(mp
, s
);
33957 nn
= mp_str
(mp
, n
);
33958 mp_pack_file_name
(mp
, nn
, "", ss
);
33959 delete_str_ref
(n
);
33960 delete_str_ref
(s
);
33964 char
*mp_get_output_file_name
(MP mp
) {
33966 char
*saved_name
; /* saved |name_of_file|
*/
33967 saved_name
= xstrdup
(mp-
>name_of_file
);
33968 (void
) mp_set_output_file_name
(mp
, round_unscaled
(internal_value
(mp_char_code
)));
33969 f
= xstrdup
(mp-
>name_of_file
);
33970 mp_pack_file_name
(mp
, saved_name
, NULL, NULL);
33974 void mp_open_output_file
(MP mp
) {
33975 char
*ss
; /* filename extension proposal
*/
33976 int c
; /* \
&{charcode} rounded to the nearest integer */
33977 c
= round_unscaled
(internal_value
(mp_char_code
));
33978 ss
= mp_set_output_file_name
(mp
, c
);
33979 while
(!mp_open_out
(mp
, (void
*) &mp->output_file, mp_filetype_postscript))
33980 mp_prompt_file_name
(mp
, "file name for output", ss
);
33981 mp_store_true_output_filename
(mp
, c
);
33985 @ The file extension created here could be up to five characters long in
33986 extreme cases so it may have to be shortened on some systems.
33987 @^system dependencies@
>
33989 @
<Use |c| to compute the file extension |s|@
>=
33991 s
= xmalloc
(7, 1);
33992 mp_snprintf
(s
, 7, ".%i", (int
) c
);
33996 @ The user won't want to see all the output file names so we only save the
33997 first and last ones and a count of how many there were. For this purpose
33998 files are ordered primarily by \
&{charcode} and secondarily by order of
34000 @
:char_code_
}{\
&{charcode} primitive@>
34002 @
<Internal library ...@
>=
34003 void mp_store_true_output_filename
(MP mp
, int c
);
34006 void mp_store_true_output_filename
(MP mp
, int c
)
34008 if
((c
< mp-
>first_output_code
) && (mp->first_output_code >= 0)) {
34009 mp-
>first_output_code
= c
;
34010 xfree
(mp-
>first_file_name
);
34011 mp-
>first_file_name
= xstrdup
(mp-
>name_of_file
);
34013 if
(c
>= mp-
>last_output_code
) {
34014 mp-
>last_output_code
= c
;
34015 xfree
(mp-
>last_file_name
);
34016 mp-
>last_file_name
= xstrdup
(mp-
>name_of_file
);
34018 set_internal_string
(mp_output_filename
, mp_rts
(mp
, mp-
>name_of_file
));
34022 char
*first_file_name
;
34023 char
*last_file_name
; /* full file names
*/
34024 integer first_output_code
;
34025 integer last_output_code
; /* rounded \
&{charcode} values */
34026 @
:char_code_
}{\
&{charcode} primitive@>
34027 integer total_shipped
; /* total number of |ship_out| operations completed
*/
34030 mp-
>first_file_name
= xstrdup
("");
34031 mp-
>last_file_name
= xstrdup
("");
34032 mp-
>first_output_code
= 32768;
34033 mp-
>last_output_code
= -32768;
34034 mp-
>total_shipped
= 0;
34036 @ @
<Dealloc variables@
>=
34037 xfree
(mp-
>first_file_name
);
34038 xfree
(mp-
>last_file_name
);
34040 @ @
<Begin the progress report for the output of picture~|c|@
>=
34041 if
((int
) mp-
>term_offset
> mp-
>max_print_line
- 6)
34043 else if
((mp-
>term_offset
> 0) ||
(mp-
>file_offset
> 0))
34044 mp_print_char
(mp
, xord
(' '
));
34045 mp_print_char
(mp
, xord
('
['
));
34047 mp_print_int
(mp
, c
)
34050 @ @
<End progress report@
>=
34051 mp_print_char
(mp
, xord
('
]'
));
34053 incr
(mp-
>total_shipped
)
34056 @ @
<Explain what output files were written@
>=
34057 if
(mp-
>total_shipped
> 0) {
34058 mp_print_nl
(mp
, "");
34059 mp_print_int
(mp
, mp-
>total_shipped
);
34060 if
(mp-
>noninteractive
) {
34061 mp_print
(mp
, " figure");
34062 if
(mp-
>total_shipped
> 1)
34063 mp_print_char
(mp
, xord
('s'
));
34064 mp_print
(mp
, " created.");
34066 mp_print
(mp
, " output file");
34067 if
(mp-
>total_shipped
> 1)
34068 mp_print_char
(mp
, xord
('s'
));
34069 mp_print
(mp
, " written: ");
34070 mp_print
(mp
, mp-
>first_file_name
);
34071 if
(mp-
>total_shipped
> 1) {
34072 if
(31 + strlen
(mp-
>first_file_name
) +
34073 strlen
(mp-
>last_file_name
) > (unsigned
) mp-
>max_print_line
)
34075 mp_print
(mp
, " .. ");
34076 mp_print
(mp
, mp-
>last_file_name
);
34078 mp_print_nl
(mp
, "");
34082 @ @
<Internal library declarations@
>=
34083 boolean mp_has_font_size
(MP mp
, font_number f
);
34086 boolean mp_has_font_size
(MP mp
, font_number f
) {
34087 return
(mp-
>font_sizes
[f
] != NULL);
34091 @ The \
&{special} command saves up lines of text to be printed during the next
34092 |ship_out| operation. The saved items are stored as a list of capsule tokens.
34095 mp_node last_pending
; /* the last token in a list of pending specials
*/
34098 @ @
<Declare action procedures for use by |do_statement|@
>=
34099 static void mp_do_special
(MP mp
);
34102 void mp_do_special
(MP mp
) {
34103 mp_get_x_next
(mp
);
34104 mp_scan_expression
(mp
);
34105 if
(mp-
>cur_exp.type
!= mp_string_type
) {
34106 @
<Complain about improper special operation@
>;
34108 mp_link
(mp-
>last_pending
) = mp_stash_cur_exp
(mp
);
34109 mp-
>last_pending
= mp_link
(mp-
>last_pending
);
34110 mp_link
(mp-
>last_pending
) = NULL;
34115 @ @
<Complain about improper special operation@
>=
34117 const char
*hlp
[] = { "Only known strings are allowed for output as specials.", NULL };
34118 mp_disp_err
(mp
, NULL);
34119 mp_back_error
(mp
, "Unsuitable expression", hlp
, true
);
34120 mp_get_x_next
(mp
);
34124 @ On the export side
, we need an extra object type for special strings.
34126 @
<Graphical object codes@
>=
34127 mp_special_code
= 8,
34129 @ @
<Export pending specials@
>=
34130 p
= mp_link
(mp-
>spec_head
);
34131 while
(p
!= NULL) {
34132 mp_special_object
*tp
;
34133 tp
= (mp_special_object
*) mp_new_graphic_object
(mp
, mp_special_code
);
34134 gr_pre_script
(tp
) = mp_xstrdup
(mp
,mp_str
(mp
, value_str
(p
)));
34135 if
(hh-
>body
== NULL)
34136 hh-
>body
= (mp_graphic_object
*) tp
;
34138 gr_link
(hp
) = (mp_graphic_object
*) tp
;
34139 hp
= (mp_graphic_object
*) tp
;
34142 mp_flush_token_list
(mp
, mp_link
(mp-
>spec_head
));
34143 mp_link
(mp-
>spec_head
) = NULL;
34144 mp-
>last_pending
= mp-
>spec_head
34146 @ We are now ready for the main output procedure. Note that the |selector|
34147 setting is saved in a global variable so that |begin_diagnostic| can access it.
34149 @
<Declare the \ps\ output procedures@
>=
34150 static void mp_ship_out
(MP mp
, mp_node h
);
34152 @ Once again
, the |gr_XXXX| macros are defined in |mppsout.h|
34154 @d export_color
(q
,p
)
34155 if
( mp_color_model
(p
)==mp_uninitialized_model
) {
34156 gr_color_model
(q
) = (unsigned char
)(number_to_scaled
(internal_value
(mp_default_color_model
))/65536);
34157 gr_cyan_val
(q
) = 0;
34158 gr_magenta_val
(q
) = 0;
34159 gr_yellow_val
(q
) = 0;
34160 gr_black_val
(q
) = ((gr_color_model
(q
)==mp_cmyk_model ? number_to_scaled
(unity_t
) : 0) / 65536.0);
34162 gr_color_model
(q
) = (unsigned char
)mp_color_model
(p
);
34163 gr_cyan_val
(q
) = number_to_double
(p-
>cyan
);
34164 gr_magenta_val
(q
) = number_to_double
(p-
>magenta
);
34165 gr_yellow_val
(q
) = number_to_double
(p-
>yellow
);
34166 gr_black_val
(q
) = number_to_double
(p-
>black
);
34169 @d export_scripts
(q
,p
)
34170 if
(mp_pre_script
(p
)!=NULL) gr_pre_script
(q
) = mp_xstrdup
(mp
, mp_str
(mp
,mp_pre_script
(p
)));
34171 if
(mp_post_script
(p
)!=NULL) gr_post_script
(q
) = mp_xstrdup
(mp
, mp_str
(mp
,mp_post_script
(p
)));
34174 struct mp_edge_object
*mp_gr_export
(MP mp
, mp_edge_header_node h
) {
34175 mp_node p
; /* the current graphical object
*/
34176 integer t
; /* a temporary value
*/
34177 integer c
; /* a rounded charcode
*/
34178 mp_number d_width
; /* the current pen width
*/
34179 mp_edge_object
*hh
; /* the first graphical object
*/
34180 mp_graphic_object
*hq
; /* something |hp| points to
*/
34181 mp_text_object
*tt
;
34182 mp_fill_object
*tf
;
34183 mp_stroked_object
*ts
;
34184 mp_clip_object
*tc
;
34185 mp_bounds_object
*tb
;
34186 mp_graphic_object
*hp
= NULL; /* the current graphical object
*/
34187 mp_set_bbox
(mp
, h
, true
);
34188 hh
= xmalloc
(1, sizeof
(mp_edge_object
));
34192 hh-
>minx
= number_to_double
(h-
>minx
);
34193 hh-
>minx
= (fabs
(hh-
>minx
)<0.00001 ?
0 : hh-
>minx
);
34194 hh-
>miny
= number_to_double
(h-
>miny
);
34195 hh-
>miny
= (fabs
(hh-
>miny
)<0.00001 ?
0 : hh-
>miny
);
34196 hh-
>maxx
= number_to_double
(h-
>maxx
);
34197 hh-
>maxx
= (fabs
(hh-
>maxx
)<0.00001 ?
0 : hh-
>maxx
);
34198 hh-
>maxy
= number_to_double
(h-
>maxy
);
34199 hh-
>maxy
= (fabs
(hh-
>maxy
)<0.00001 ?
0 : hh-
>maxy
);
34200 hh-
>filename
= mp_get_output_file_name
(mp
);
34201 c
= round_unscaled
(internal_value
(mp_char_code
));
34203 hh-
>width
= number_to_double
(internal_value
(mp_char_wd
));
34204 hh-
>height
= number_to_double
(internal_value
(mp_char_ht
));
34205 hh-
>depth
= number_to_double
(internal_value
(mp_char_dp
));
34206 hh-
>ital_corr
= number_to_double
(internal_value
(mp_char_ic
));
34207 @
<Export pending specials@
>;
34208 p
= mp_link
(edge_list
(h
));
34209 while
(p
!= NULL) {
34210 hq
= mp_new_graphic_object
(mp
, (int
) ((mp_type
(p
) - mp_fill_node_type
) + 1));
34211 switch
(mp_type
(p
)) {
34212 case mp_fill_node_type
:
34214 mp_fill_node p0
= (mp_fill_node
)p
;
34215 tf
= (mp_fill_object
*) hq
;
34216 gr_pen_p
(tf
) = mp_export_knot_list
(mp
, mp_pen_p
(p0
));
34217 new_number
(d_width
);
34218 mp_get_pen_scale
(mp
, &d_width, mp_pen_p (p0)); /* whats the point ? */
34219 free_number
(d_width
);
34220 if
((mp_pen_p
(p0
) == NULL) || pen_is_elliptical
(mp_pen_p
(p0
))) {
34221 gr_path_p
(tf
) = mp_export_knot_list
(mp
, mp_path_p
(p0
));
34224 pc
= mp_copy_path
(mp
, mp_path_p
(p0
));
34225 pp
= mp_make_envelope
(mp
, pc
, mp_pen_p
(p0
), p0-
>ljoin
, 0, p0-
>miterlim
);
34226 gr_path_p
(tf
) = mp_export_knot_list
(mp
, pp
);
34227 mp_toss_knot_list
(mp
, pp
);
34228 pc
= mp_htap_ypoc
(mp
, mp_path_p
(p0
));
34229 pp
= mp_make_envelope
(mp
, pc
, mp_pen_p
((mp_fill_node
) p
), p0-
>ljoin
, 0, p0-
>miterlim
);
34230 gr_htap_p
(tf
) = mp_export_knot_list
(mp
, pp
);
34231 mp_toss_knot_list
(mp
, pp
);
34233 export_color
(tf
, p0
);
34234 export_scripts
(tf
, p
);
34235 gr_ljoin_val
(tf
) = p0-
>ljoin
;
34236 gr_miterlim_val
(tf
) = number_to_double
(p0-
>miterlim
);
34239 case mp_stroked_node_type
:
34241 mp_stroked_node p0
= (mp_stroked_node
)p
;
34242 ts
= (mp_stroked_object
*) hq
;
34243 gr_pen_p
(ts
) = mp_export_knot_list
(mp
, mp_pen_p
(p0
));
34244 new_number
(d_width
);
34245 mp_get_pen_scale
(mp
, &d_width, mp_pen_p (p0));
34246 if
(pen_is_elliptical
(mp_pen_p
(p0
))) {
34247 gr_path_p
(ts
) = mp_export_knot_list
(mp
, mp_path_p
(p0
));
34250 pc
= mp_copy_path
(mp
, mp_path_p
(p0
));
34252 if
(mp_left_type
(pc
) != mp_endpoint
) {
34253 mp_left_type
(mp_insert_knot
(mp
, pc
, pc-
>x_coord
, pc-
>y_coord
)) = mp_endpoint
;
34254 mp_right_type
(pc
) = mp_endpoint
;
34255 pc
= mp_next_knot
(pc
);
34259 mp_make_envelope
(mp
, pc
, mp_pen_p
(p0
),
34260 p0-
>ljoin
, (quarterword
) t
,
34262 gr_path_p
(ts
) = mp_export_knot_list
(mp
, pc
);
34263 mp_toss_knot_list
(mp
, pc
);
34265 export_color
(ts
, p0
);
34266 export_scripts
(ts
, p
);
34267 gr_ljoin_val
(ts
) = p0-
>ljoin
;
34268 gr_miterlim_val
(ts
) = number_to_double
(p0-
>miterlim
);
34269 gr_lcap_val
(ts
) = p0-
>lcap
;
34270 gr_dash_p
(ts
) = mp_export_dashes
(mp
, p0
, d_width
);
34271 free_number
(d_width
);
34274 case mp_text_node_type
:
34276 mp_text_node p0
= (mp_text_node
)p
;
34277 tt
= (mp_text_object
*) hq
;
34278 gr_text_p
(tt
) = mp_xstrldup
(mp
, mp_str
(mp
, mp_text_p
(p
)),mp_text_p
(p
)->len
);
34279 gr_text_l
(tt
) = (size_t
) mp_text_p
(p
)->len
;
34280 gr_font_n
(tt
) = (unsigned int
) mp_font_n
(p
);
34281 gr_font_name
(tt
) = mp_xstrdup
(mp
, mp-
>font_name
[mp_font_n
(p
)]);
34282 gr_font_dsize
(tt
) = mp-
>font_dsize
[mp_font_n
(p
)] / 65536.0;
34283 export_color
(tt
, p0
);
34284 export_scripts
(tt
, p
);
34285 gr_width_val
(tt
) = number_to_double
(p0-
>width
);
34286 gr_height_val
(tt
) = number_to_double
(p0-
>height
);
34287 gr_depth_val
(tt
) = number_to_double
(p0-
>depth
);
34288 gr_tx_val
(tt
) = number_to_double
(p0-
>tx
);
34289 gr_ty_val
(tt
) = number_to_double
(p0-
>ty
);
34290 gr_txx_val
(tt
) = number_to_double
(p0-
>txx
);
34291 gr_txy_val
(tt
) = number_to_double
(p0-
>txy
);
34292 gr_tyx_val
(tt
) = number_to_double
(p0-
>tyx
);
34293 gr_tyy_val
(tt
) = number_to_double
(p0-
>tyy
);
34296 case mp_start_clip_node_type
:
34297 tc
= (mp_clip_object
*) hq
;
34299 mp_export_knot_list
(mp
, mp_path_p
((mp_start_clip_node
) p
));
34301 case mp_start_bounds_node_type
:
34302 tb
= (mp_bounds_object
*) hq
;
34304 mp_export_knot_list
(mp
, mp_path_p
((mp_start_bounds_node
) p
));
34306 case mp_stop_clip_node_type
:
34307 case mp_stop_bounds_node_type
:
34308 /* nothing to do here
*/
34310 default
: /* there are no other valid cases
, but please the compiler
*/
34313 if
(hh-
>body
== NULL)
34324 @ This function is only used for the |glyph| operator
, so
34325 it takes quite a few shortcuts for cases that cannot appear
34326 in the output of |mp_ps_font_charstring|.
34329 mp_edge_header_node mp_gr_import
(MP mp
, struct mp_edge_object
*hh
) {
34330 mp_edge_header_node h
; /* the edge object
*/
34331 mp_node ph
, pn
, pt
; /* for adding items
*/
34332 mp_graphic_object
*p
; /* the current graphical object
*/
34333 h
= mp_get_edge_header_node
(mp
);
34334 mp_init_edges
(mp
, h
);
34335 ph
= edge_list
(h
);
34338 set_number_from_double
(h-
>minx
, hh-
>minx
);
34339 set_number_from_double
(h-
>miny
, hh-
>miny
);
34340 set_number_from_double
(h-
>maxx
, hh-
>maxx
);
34341 set_number_from_double
(h-
>maxy
, hh-
>maxy
);
34342 while
(p
!= NULL) {
34343 switch
(gr_type
(p
)) {
34345 if
(gr_pen_p
((mp_fill_object
*) p
) == NULL) {
34347 new_number
(turns
);
34348 pn
= mp_new_fill_node
(mp
, NULL);
34349 mp_path_p
((mp_fill_node
) pn
) =
34350 mp_import_knot_list
(mp
, gr_path_p
((mp_fill_object
*) p
));
34351 mp_color_model
(pn
) = mp_grey_model
;
34352 mp_turn_cycles
(mp
, &turns, mp_path_p ((mp_fill_node) pn));
34353 if
(number_negative
(turns
)) {
34354 set_number_to_unity
(((mp_fill_node
) pn
)->grey
);
34358 set_number_to_zero
(((mp_fill_node
) pn
)->grey
);
34359 mp_link
(pn
) = mp_link
(ph
);
34364 free_number
(turns
);
34367 case mp_stroked_code
:
34369 case mp_start_clip_code
:
34370 case mp_stop_clip_code
:
34371 case mp_start_bounds_code
:
34372 case mp_stop_bounds_code
:
34373 case mp_special_code
:
34375 } /* all cases are enumerated
*/
34378 mp_gr_toss_objects
(hh
);
34383 @ @
<Declarations@
>=
34384 struct mp_edge_object
*mp_gr_export
(MP mp
, mp_edge_header_node h
);
34385 mp_edge_header_node mp_gr_import
(MP mp
, struct mp_edge_object
*h
);
34387 @ This function is now nearly trivial.
34390 void mp_ship_out
(MP mp
, mp_node h
) { /* output edge structure |h|
*/
34391 int c
; /* \
&{charcode} rounded to the nearest integer */
34392 c
= round_unscaled
(internal_value
(mp_char_code
));
34393 @
<Begin the progress report for the output of picture~|c|@
>;
34394 (mp-
>shipout_backend
) (mp
, h
);
34395 @
<End progress report@
>;
34396 if
(number_positive
(internal_value
(mp_tracing_output
)))
34397 mp_print_edges
(mp
, h
, " (just shipped out)", true
);
34401 @ @
<Declarations@
>=
34402 static void mp_shipout_backend
(MP mp
, void
*h
);
34406 void mp_shipout_backend
(MP mp
, void
*voidh
) {
34408 mp_edge_object
*hh
; /* the first graphical object
*/
34409 mp_edge_header_node h
= (mp_edge_header_node
) voidh
;
34410 hh
= mp_gr_export
(mp
, h
);
34412 if
(internal_string
(mp_output_format
) != NULL)
34413 s
= mp_str
(mp
, internal_string
(mp_output_format
));
34414 if
(s
&& strcmp (s, "svg") == 0) {
34415 (void
) mp_svg_gr_ship_out
(hh
,
34416 (number_to_scaled
(internal_value
(mp_prologues
)) / 65536), false
);
34417 } else if
(s
&& strcmp (s, "png") == 0) {
34418 (void
) mp_png_gr_ship_out
(hh
, (const char
*)((internal_string
(mp_output_format_options
))->str
), false
);
34420 (void
) mp_gr_ship_out
(hh
,
34421 (number_to_scaled
(internal_value
(mp_prologues
)) / 65536),
34422 (number_to_scaled
(internal_value
(mp_procset
)) / 65536), false
);
34424 mp_gr_toss_objects
(hh
);
34428 @ @
<Exported types@
>=
34429 typedef void
(*mp_backend_writer
) (MP
, void
*);
34431 @ @
<Option variables@
>=
34432 mp_backend_writer shipout_backend
;
34434 @ Now that we've finished |ship_out|
, let's look at the other commands
34435 by which a user can send things to the \.
{GF
} file.
34442 @ @
<Allocate or initialize ...@
>=
34443 mp_ps_backend_initialize
(mp
);
34444 mp_svg_backend_initialize
(mp
);
34445 mp_png_backend_initialize
(mp
);
34448 mp_ps_backend_free
(mp
);
34449 mp_svg_backend_free
(mp
);
34450 mp_png_backend_free
(mp
);
34453 @
* Dumping and undumping the tables.
34455 When \.
{MP
} is started
, it is possible to preload a macro file
34456 containing definitions that will be usable in the main input
34457 file. This action even takes place automatically
, based on the
34458 name of the executable
(\.
{mpost
} will attempt to preload the
34459 macros in the file \.
{mpost.mp
}). If such a preload is not
34460 desired
, the option variable |ini_version| has to be set |true|.
34462 The variable |mem_file| holds the open file pointer.
34465 void
*mem_file
; /* file for input or preloaded macros
*/
34467 @ @
<Declarations@
>=
34468 extern boolean mp_load_preload_file
(MP mp
);
34470 @ Preloading a file is a lot like |mp_run| itself
, except that
34471 \MP\ should not exit and that a bit of trickery is needed with
34472 the input buffer to make sure that the preloading does not
34473 interfere with the actual job.
34476 boolean mp_load_preload_file
(MP mp
) {
34478 in_state_record old_state
;
34479 integer old_in_open
= mp-
>in_open
;
34480 void
*old_cur_file
= cur_file
;
34481 char
*fname
= xstrdup
(mp-
>name_of_file
);
34482 size_t l
= strlen
(fname
);
34483 old_state
= mp-
>cur_input
;
34485 for
(k
= 0; k
< l
; k
++) {
34486 append_char
(*(fname
+ k
));
34488 name
= mp_make_string
(mp
);
34489 if
(!mp-
>log_opened
) {
34490 mp_open_log_file
(mp
);
34491 } /* |open_log_file| doesn't |show_context|
, so |limit|
34492 and |loc| needn't be set to meaningful values yet
*/
34493 if
(((int
) mp-
>term_offset
+ (int
) strlen
(fname
)) > (mp-
>max_print_line
- 2))
34495 else if
((mp-
>term_offset
> 0) ||
(mp-
>file_offset
> 0))
34496 mp_print_char
(mp
, xord
(' '
));
34497 mp_print_char
(mp
, xord
('
('
));
34498 incr
(mp-
>open_parens
);
34499 mp_print
(mp
, fname
);
34503 start
= loc
= limit
+ (mp-
>noninteractive ?
0 : 1);
34504 cur_file
= mp-
>mem_file
;
34505 (void
) mp_input_ln
(mp
, cur_file
);
34506 mp_firm_up_the_line
(mp
);
34507 mp-
>buffer
[limit
] = xord
('
%'
);
34508 mp-
>first
= (size_t
) (limit
+ 1);
34511 mp-
>reading_preload
= true
;
34513 mp_do_statement
(mp
);
34514 } while
(!(cur_cmd
() == mp_stop
)); /* "dump" or EOF
*/
34515 mp-
>reading_preload
= false
;
34516 mp_primitive
(mp
, "dump", mp_relax
, 0); /* reset |dump|
*/
34517 while
(mp-
>input_ptr
> 0) {
34519 mp_end_token_list
(mp
);
34521 mp_end_file_reading
(mp
);
34523 while
(mp-
>loop_ptr
!= NULL)
34524 mp_stop_iteration
(mp
);
34525 while
(mp-
>open_parens
> 0) {
34526 mp_print
(mp
, " )");
34527 decr
(mp-
>open_parens
);
34529 while
(mp-
>cond_ptr
!= NULL) {
34530 mp_print_nl
(mp
, "(dump occurred when ");
34531 @.dump occurred...@
>;
34532 mp_print_cmd_mod
(mp
, mp_fi_or_else
, mp-
>cur_if
);
34533 /* `\.
{if
}' or `\.
{elseif
}' or `\.
{else
}'
*/
34534 if
(mp-
>if_line
!= 0) {
34535 mp_print
(mp
, " on line ");
34536 mp_print_int
(mp
, mp-
>if_line
);
34538 mp_print
(mp
, " was incomplete)");
34539 mp-
>if_line
= if_line_field
(mp-
>cond_ptr
);
34540 mp-
>cur_if
= mp_name_type
(mp-
>cond_ptr
);
34541 mp-
>cond_ptr
= mp_link
(mp-
>cond_ptr
);
34544 /* |
(mp-
>close_file
) (mp
, mp-
>mem_file
);|
*/
34545 cur_file
= old_cur_file
;
34546 mp-
>cur_input
= old_state
;
34547 mp-
>in_open
= old_in_open
;
34552 @
* The main program.
34553 This is it
: the part of \MP\ that executes all those procedures we have
34556 Well---almost. We haven't put the parsing subroutines into the
34557 program yet
; and we'd better leave space for a few more routines that may
34558 have been forgotten.
34561 @
<Declare the basic parsing subroutines@
>;
34562 @
<Declare miscellaneous procedures that were declared |forward|@
>
34565 @ Here we do whatever is needed to complete \MP's job gracefully on the
34566 local operating system. The code here might come into play after a fatal
34567 error
; it must therefore consist entirely of ``safe'' operations that
34568 cannot produce error messages. For example
, it would be a mistake to call
34569 |str_room| or |make_string| at this time
, because a call on |overflow|
34570 might lead to an infinite loop.
34571 @^system dependencies@
>
34574 void mp_close_files_and_terminate
(MP mp
) {
34575 integer k
; /* all-purpose index
*/
34576 integer LH
; /* the length of the \.
{TFM
} header
, in words
*/
34577 int lk_offset
; /* extra words inserted at beginning of |lig_kern| array
*/
34578 mp_node p
; /* runs through a list of \.
{TFM
} dimensions
*/
34581 @
<Close all open files in the |rd_file| and |wr_file| arrays@
>;
34582 if
(number_positive
(internal_value
(mp_tracing_stats
)))
34583 @
<Output statistics about this job@
>;
34584 wake_up_terminal
();
34585 @
<Do all the finishing work on the \.
{TFM
} file@
>;
34586 @
<Explain what output files were written@
>;
34587 if
(mp-
>log_opened
&& !mp->noninteractive) {
34589 (mp-
>close_file
) (mp
, mp-
>log_file
);
34590 mp-
>selector
= mp-
>selector
- 2;
34591 if
(mp-
>selector
== term_only
) {
34592 mp_print_nl
(mp
, "Transcript written on ");
34593 @.Transcript written...@
>;
34594 mp_print
(mp
, mp-
>log_name
);
34595 mp_print_char
(mp
, xord
('.'
));
34599 mp-
>finished
= true
;
34603 @ @
<Declarations@
>=
34604 static void mp_close_files_and_terminate
(MP mp
);
34606 @ @
<Close all open files in the |rd_file| and |wr_file| arrays@
>=
34607 if
(mp-
>rd_fname
!= NULL) {
34608 for
(k
= 0; k
< (int
) mp-
>read_files
; k
++) {
34609 if
(mp-
>rd_fname
[k
] != NULL) {
34610 (mp-
>close_file
) (mp
, mp-
>rd_file
[k
]);
34611 xfree
(mp-
>rd_fname
[k
]);
34615 if
(mp-
>wr_fname
!= NULL) {
34616 for
(k
= 0; k
< (int
) mp-
>write_files
; k
++) {
34617 if
(mp-
>wr_fname
[k
] != NULL) {
34618 (mp-
>close_file
) (mp
, mp-
>wr_file
[k
]);
34619 xfree
(mp-
>wr_fname
[k
]);
34625 for
(k
= 0; k
< (int
) mp-
>max_read_files
; k
++) {
34626 if
(mp-
>rd_fname
[k
] != NULL) {
34627 (mp-
>close_file
) (mp
, mp-
>rd_file
[k
]);
34628 xfree
(mp-
>rd_fname
[k
]);
34631 xfree
(mp-
>rd_file
);
34632 xfree
(mp-
>rd_fname
);
34633 for
(k
= 0; k
< (int
) mp-
>max_write_files
; k
++) {
34634 if
(mp-
>wr_fname
[k
] != NULL) {
34635 (mp-
>close_file
) (mp
, mp-
>wr_file
[k
]);
34636 xfree
(mp-
>wr_fname
[k
]);
34639 xfree
(mp-
>wr_file
);
34640 xfree
(mp-
>wr_fname
);
34643 @ We want to produce a \.
{TFM
} file if and only if |mp_fontmaking| is positive.
34645 We reclaim all of the variable-size memory at this point
, so that
34646 there is no chance of another memory overflow after the memory capacity
34647 has already been exceeded.
34649 @
<Do all the finishing work on the \.
{TFM
} file@
>=
34650 if
(number_positive
(internal_value
(mp_fontmaking
))) {
34651 @
<Massage the \.
{TFM
} widths@
>;
34652 mp_fix_design_size
(mp
);
34653 mp_fix_check_sum
(mp
);
34654 @
<Massage the \.
{TFM
} heights
, depths
, and italic corrections@
>;
34655 set_number_to_zero
(internal_value
(mp_fontmaking
)); /* avoid loop in case of fatal error
*/
34656 @
<Finish the \.
{TFM
} file@
>;
34659 @ The present section goes directly to the log file instead of using
34660 |print| commands
, because there's no need for these strings to take
34661 up |str_pool| memory when a non-
{\bf stat
} version of \MP\ is being used.
34663 @
<Output statistics...@
>=
34664 if
(mp-
>log_opened
) {
34667 wlog_ln
("Here is how much of MetaPost's memory you used:");
34668 @.Here is how much...@
>;
34669 mp_snprintf
(s
, 128, " %i string%s using %i character%s",
34670 (int
) mp-
>max_strs_used
, (mp-
>max_strs_used
!= 1 ?
"s" : ""),
34671 (int
) mp-
>max_pl_used
, (mp-
>max_pl_used
!= 1 ?
"s" : ""));
34673 mp_snprintf
(s
, 128, " %i bytes of node memory", (int
) mp-
>var_used_max
);
34675 mp_snprintf
(s
, 128, " %i symbolic tokens", (int
) mp-
>st_count
);
34677 mp_snprintf
(s
, 128,
34678 " %ii,%in,%ip,%ib,%if stack positions out of %ii,%in,%ip,%ib,%if",
34679 (int
) mp-
>max_in_stack
, (int
) mp-
>int_ptr
,
34680 (int
) mp-
>max_param_stack
, (int
) mp-
>max_buf_stack
+ 1,
34681 (int
) mp-
>in_open_max
- file_bottom
, (int
) mp-
>stack_size
,
34682 (int
) mp-
>max_internal
, (int
) mp-
>param_size
, (int
) mp-
>buf_size
,
34683 (int
) mp-
>max_in_open
- file_bottom
);
34687 @ It is nice to have have some of the stats available from the API.
34689 @
<Exported function ...@
>=
34690 int mp_memory_usage
(MP mp
);
34691 int mp_hash_usage
(MP mp
);
34692 int mp_param_usage
(MP mp
);
34693 int mp_open_usage
(MP mp
);
34696 int mp_memory_usage
(MP mp
) {
34697 return
(int
) mp-
>var_used
;
34699 int mp_hash_usage
(MP mp
) {
34700 return
(int
) mp-
>st_count
;
34702 int mp_param_usage
(MP mp
) {
34703 return
(int
) mp-
>max_param_stack
;
34705 int mp_open_usage
(MP mp
) {
34706 return
(int
) mp-
>max_in_stack
;
34710 @ We get to the |final_cleanup| routine when \
&{end} or \&{dump} has
34714 void mp_final_cleanup
(MP mp
) {
34715 /* -Wunused
: integer c
; */ /* 0 for \
&{end}, 1 for \&{dump} */
34716 /* clang
: never read
: |c
= cur_mod
();|
*/
34717 if
(mp-
>job_name
== NULL)
34718 mp_open_log_file
(mp
);
34719 while
(mp-
>input_ptr
> 0) {
34721 mp_end_token_list
(mp
);
34723 mp_end_file_reading
(mp
);
34725 while
(mp-
>loop_ptr
!= NULL)
34726 mp_stop_iteration
(mp
);
34727 while
(mp-
>open_parens
> 0) {
34728 mp_print
(mp
, " )");
34729 decr
(mp-
>open_parens
);
34731 while
(mp-
>cond_ptr
!= NULL) {
34732 mp_print_nl
(mp
, "(end occurred when ");
34733 @.end occurred...@
>;
34734 mp_print_cmd_mod
(mp
, mp_fi_or_else
, mp-
>cur_if
);
34735 /* `\.
{if
}' or `\.
{elseif
}' or `\.
{else
}'
*/
34736 if
(mp-
>if_line
!= 0) {
34737 mp_print
(mp
, " on line ");
34738 mp_print_int
(mp
, mp-
>if_line
);
34740 mp_print
(mp
, " was incomplete)");
34741 mp-
>if_line
= if_line_field
(mp-
>cond_ptr
);
34742 mp-
>cur_if
= mp_name_type
(mp-
>cond_ptr
);
34743 mp-
>cond_ptr
= mp_link
(mp-
>cond_ptr
);
34745 if
(mp-
>history
!= mp_spotless
)
34746 if
(((mp-
>history
== mp_warning_issued
)
34747 ||
(mp-
>interaction
< mp_error_stop_mode
)))
34748 if
(mp-
>selector
== term_and_log
) {
34749 mp-
>selector
= term_only
;
34751 "(see the transcript file for additional information)");
34752 @.see the transcript file...@
>;
34753 mp-
>selector
= term_and_log
;
34758 @ @
<Declarations@
>=
34759 static void mp_final_cleanup
(MP mp
);
34760 static void mp_init_prim
(MP mp
);
34761 static void mp_init_tab
(MP mp
);
34764 void mp_init_prim
(MP mp
) { /* initialize all the primitives
*/
34768 void mp_init_tab
(MP mp
) { /* initialize other tables
*/
34769 @
<Initialize table entries@
>;
34773 @ When we begin the following code
, \MP's tables may still contain garbage
;
34774 thus we must proceed cautiously to get bootstrapped in.
34776 But when we finish this part of the program
, \MP\ is ready to call on the
34777 |main_control| routine to do its work.
34779 @
<Get the first line...@
>=
34781 @
<Initialize the input routines@
>;
34782 if
(!mp-
>ini_version
) {
34783 if
(!mp_load_preload_file
(mp
)) {
34784 mp-
>history
= mp_fatal_error_stop
;
34788 @
<Initializations following first line@
>;
34792 @ @
<Initializations following first line@
>=
34793 mp-
>buffer
[limit
] = (ASCII_code
) '
%'
;
34794 mp_fix_date_and_time
(mp
);
34795 if
(mp-
>random_seed
== 0)
34796 mp-
>random_seed
= (number_to_scaled
(internal_value
(mp_time
)) / number_to_scaled
(unity_t
)) + number_to_scaled
(internal_value
(mp_day
));
34797 init_randoms
(mp-
>random_seed
);
34798 initialize_print_selector
();
34799 mp_normalize_selector
(mp
);
34801 if
(mp-
>buffer
[loc
] != '\\'
)
34802 mp_start_input
(mp
); /* \
&{input} assumed */
34807 @
* System-dependent changes.
34808 This section should be replaced
, if necessary
, by any special
34809 modification of the program
34810 that are necessary to make \MP\ work at a particular installation.
34811 It is usually best to design your change file so that all changes to
34812 previous sections preserve the section numbering
; then everybody's version
34813 will be consistent with the published program. More extensive changes
,
34814 which introduce new sections
, can be inserted here
; then only the index
34815 itself will get a new section number.
34816 @^system dependencies@
>
34819 Here is where you can find all uses of each identifier in the program
,
34820 with underlined entries pointing to where the identifier was defined.
34821 If the identifier is only one letter long
, however
, you get to see only
34822 the underlined entries.
{\sl All references are to section numbers instead of
34825 This index also lists error messages and other aspects of the program
34826 that you might want to look up some day. For example
, the entry
34827 for ``system dependencies'' lists all sections that should receive
34828 special attention from people who are installing \MP\ in a new
34829 operating environment. A list of various things that can't happen appears
34830 under ``this can't happen''.
34831 Approximately
25 sections are listed under ``inner loop''
; these account
34832 for more than
60\pct
! of \MP's running time
, exclusive of input and output.