diff options
Diffstat (limited to 'source/luametatex/source/mp/mpc/mp.c')
| -rw-r--r-- | source/luametatex/source/mp/mpc/mp.c | 22101 |
1 files changed, 22101 insertions, 0 deletions
diff --git a/source/luametatex/source/mp/mpc/mp.c b/source/luametatex/source/mp/mpc/mp.c new file mode 100644 index 000000000..0e9c4bf2d --- /dev/null +++ b/source/luametatex/source/mp/mpc/mp.c @@ -0,0 +1,22101 @@ +/* This file is generated by "mtxrun --script "mtx-wtoc.lua" from the metapost cweb files. */ + + +# include "mpconfig.h" +# include "mp.h" +# include "mpmath.h" +# include "mpmathdouble.h" +# include "mpmathbinary.h" +# include "mpmathdecimal.h" +# include "mpstrings.h" + + +# define default_banner "This is MPLIB for LuaMetaTeX, version 3.14" +# define odd(A) (abs(A) % 2 == 1) +# define loc mp->cur_input.loc_field +# define inf_t mp->math->md_inf_t +# define negative_inf_t mp->math->md_negative_inf_t +# define check_arith() \ + if (mp->arith_error) { \ + mp_clear_arith(mp); \ + } +# define arc_tol_k mp->math->md_arc_tol_k +# define coef_bound_k mp->math->md_coef_bound_k +# define coef_bound_minus_1 mp->math->md_coef_bound_minus_1 +# define sqrt_8_e_k mp->math->md_sqrt_8_e_k +# define twelve_ln_2_k mp->math->md_twelve_ln_2_k +# define twelvebits_3 mp->math->md_twelvebits_3 +# define one_k mp->math->md_one_k +# define epsilon_t mp->math->md_epsilon_t +# define unity_t mp->math->md_unity_t +# define zero_t mp->math->md_zero_t +# define two_t mp->math->md_two_t +# define three_t mp->math->md_three_t +# define half_unit_t mp->math->md_half_unit_t +# define three_quarter_unit_t mp->math->md_three_quarter_unit_t +# define twentysixbits_sqrt2_t mp->math->md_twentysixbits_sqrt2_t +# define twentyeightbits_d_t mp->math->md_twentyeightbits_d_t +# define twentysevenbits_sqrt2_d_t mp->math->md_twentysevenbits_sqrt2_d_t +# define warning_limit_t mp->math->md_warning_limit_t +# define precision_default mp->math->md_precision_default +# define precision_min mp->math->md_precision_min +# define precision_max mp->math->md_precision_max +# define fraction_one_t mp->math->md_fraction_one_t +# define fraction_half_t mp->math->md_fraction_half_t +# define fraction_three_t mp->math->md_fraction_three_t +# define fraction_four_t mp->math->md_fraction_four_t +# define one_eighty_deg_t mp->math->md_one_eighty_deg_t +# define negative_one_eighty_deg_t mp->math->md_negative_one_eighty_deg_t +# define three_sixty_deg_t mp->math->md_three_sixty_deg_t +# define max_quarterword 0x3FFF +# define max_halfword 0xFFFFFFF +# define max_num_token_nodes 8000 +# define max_num_pair_nodes 1000 +# define max_num_knot_nodes 1000 +# define max_num_value_nodes 1000 +# define max_num_symbolic_nodes 1000 +# define mp_link(A) (A)->link +# define mp_type(A) (A)->type +# define mp_name_type(A) (A)->name_type +# define mp_set_link(A,B) (A)->link = (mp_node) (B) +# define mp_max_command_code mp_stop +# define mp_max_pre_command mp_etex_command +# define mp_min_command (mp_defined_macro_command+1) +# define mp_max_statement_command mp_type_name_command +# define mp_min_primary_command mp_type_name_command +# define mp_min_suffix_token mp_internal_command +# define mp_max_suffix_token mp_numeric_command +# define mp_max_primary_command mp_plus_or_minus_command +# define mp_min_tertiary_command mp_plus_or_minus_command +# define mp_max_tertiary_command mp_tertiary_binary_command +# define mp_min_expression_command mp_left_brace_command +# define mp_max_expression_command mp_equals_command +# define mp_min_secondary_command mp_and_command +# define mp_max_secondary_command mp_secondary_binary_command +# define mp_end_of_statement (cur_cmd>mp_comma_command) +# define unknown_tag 1 +# define mp_min_of_operation mp_substring_operation +# define max_given_internal mp_restore_clip_color_internal +# define set_text(A) { \ + (A)->text = (B) ; \ +} +# define set_eq_type(A,B) { \ + (A)->type = (B) ; \ +} +# define set_eq_property(A,B) { \ + (A)->property = (B) ; \ +} +# define set_equiv(A,B) { \ + (A)->v.data.node = NULL ; \ + (A)->v.data.indep.serial = (B); \ +} +# define set_equiv_node(A,B) { \ + (A)->v.data.node = (B) ; \ + (A)->v.data.indep.serial = 0; \ +} +# define set_equiv_sym(A,B) { \ + (A)->v.data.node = (mp_node) (B); \ + (A)->v.data.indep.serial = 0; \ +} +# define mp_id_lookup(A,B,C,D) mp_do_id_lookup((A), mp->symbols, (B), (C), (D)) +# define mp_set_value_sym(A,B) do_set_value_sym (mp, (mp_token_node) (A), (B)) +# define mp_set_value_number(A,B) do_set_value_number(mp, (mp_token_node) (A), &(B)) +# define mp_set_value_node(A,B) do_set_value_node (mp, (mp_token_node) (A), (B)) +# define mp_set_value_str(A,B) do_set_value_str (mp, (mp_token_node) (A), (B)) +# define mp_set_value_knot(A,B) do_set_value_knot (mp, (mp_token_node) (A), (B)) +# define mp_get_ref_count(A) mp_get_indep_value(A) +# define mp_set_ref_count(A,B) mp_set_indep_value(A,B) +# define mp_add_mac_ref(A) mp_set_ref_count((A), mp_get_ref_count((A))+1) +# define mp_decr_mac_ref(A) mp_set_ref_count((A), mp_get_ref_count((A))-1) +# define mp_get_attribute_head(A) mp_do_get_attribute_head(mp, (mp_value_node) (A)) +# define mp_set_attribute_head(A,B) mp_do_set_attribute_head(mp, (mp_value_node) (A),(mp_node) (B)) +# define mp_get_subscr_head(A) mp_do_get_subscr_head(mp,(mp_value_node) (A)) +# define mp_set_subscr_head(A,B) mp_do_set_subscr_head(mp,(mp_value_node) (A),(mp_node) (B)) +# define mp_collective_subscript (void *)0 +# define mp_subscript(A) ((mp_value_node)(A))->subscript +# define mp_x_part(A) ((mp_pair_node) (A))->x_part +# define mp_y_part(A) ((mp_pair_node) (A))->y_part +# define mp_tx_part(A) ((mp_transform_node) (A))->tx_part +# define mp_ty_part(A) ((mp_transform_node) (A))->ty_part +# define mp_xx_part(A) ((mp_transform_node) (A))->xx_part +# define mp_xy_part(A) ((mp_transform_node) (A))->xy_part +# define mp_yx_part(A) ((mp_transform_node) (A))->yx_part +# define mp_yy_part(A) ((mp_transform_node) (A))->yy_part +# define mp_red_part(A) ((mp_color_node) (A))->red_part +# define mp_green_part(A) ((mp_color_node) (A))->green_part +# define mp_blue_part(A) ((mp_color_node) (A))->blue_part +# define mp_grey_part(A) ((mp_color_node) (A))->grey_part +# define mp_cyan_part(A) ((mp_color_node) (A))->cyan_part +# define mp_magenta_part(A) ((mp_color_node) (A))->magenta_part +# define mp_yellow_part(A) ((mp_color_node) (A))->yellow_part +# define mp_black_part(A) ((mp_color_node) (A))->black_part +# define mp_next_knot(A) (A)->next +# define mp_left_type(A) (A)->left_type +# define mp_right_type(A) (A)->right_type +# define mp_prev_knot(A) (A)->prev +# define mp_knot_info(A) (A)->info +# define mp_originator(A) (A)->originator +# define mp_knotstate(A) (A)->state +# define mp_minx mp->bbmin[mp_x_code] +# define mp_maxx mp->bbmax[mp_x_code] +# define mp_miny mp->bbmin[mp_y_code] +# define mp_maxy mp->bbmax[mp_y_code] +# define one_third_inf_t mp->math->md_one_third_inf_t +# define mp_copy_pen(mp,A) mp_make_pen(mp, mp_copy_path(mp, (A)),0) +# define mp_pen_is_elliptical(A) ((A)==mp_next_knot((A))) +# define mp_fraction mp_number +# define mp_angle mp_number +# define new_number(A) mp->math->md_allocate(mp, &(A), mp_scaled_type) +# define new_fraction(A) mp->math->md_allocate(mp, &(A), mp_fraction_type) +# define new_angle(A) mp->math->md_allocate(mp, &(A), mp_angle_type) +# define new_number_clone(A,B) mp->math->md_allocate_clone(mp, &(A), mp_scaled_type, &(B)) +# define new_fraction_clone(A,B) mp->math->md_allocate_clone(mp, &(A), mp_fraction_type, &(B)) +# define new_angle_clone(A,B) mp->math->md_allocate_clone(mp, &(A), mp_angle_type, &(B)) +# define new_number_from_double(mp,A,B) mp->math->md_allocate_double(mp, &(A), B) +# define new_number_abs(A,B) mp->math->md_allocate_abs(mp, &(A), mp_scaled_type, &(B)) +# define free_number(A) mp->math->md_free(mp, &(A)) +# define set_precision() mp->math->md_set_precision(mp) +# define free_math() mp->math->md_free_math(mp) +# define scan_numeric_token(A) mp->math->md_scan_numeric(mp,A) +# define scan_fractional_token(A) mp->math->md_scan_fractional(mp,A) +# define set_number_from_of_the_way(A,t,B,C) mp->math->md_from_oftheway(mp,&(A),&(t),&(B),&(C)) +# define set_number_from_int(A,B) mp->math->md_from_int(&(A),B) +# define set_number_from_scaled(A,B) mp->math->md_from_scaled(&(A),B) +# define set_number_from_boolean(A,B) mp->math->md_from_boolean(&(A),B) +# define set_number_from_double(A,B) mp->math->md_from_double(&(A),B) +# define set_number_from_addition(A,B,C) mp->math->md_from_addition(&(A),&(B),&(C)) +# define set_number_half_from_addition(A,B,C) mp->math->md_half_from_addition(&(A),&(B),&(C)) +# define set_number_from_subtraction(A,B,C) mp->math->md_from_subtraction(&(A),&(B),&(C)) +# define set_number_half_from_subtraction(A,B,C) mp->math->md_half_from_subtraction(&(A),&(B),&(C)) +# define set_number_from_div(A,B,C) mp->math->md_from_div(&(A),&(B),&(C)) +# define set_number_from_mul(A,B,C) mp->math->md_from_mul(&(A),&(B),&(C)) +# define number_int_div(A,C) mp->math->md_from_int_div(&(A),&(A),C) +# define set_number_from_int_mul(A,B,C) mp->math->md_from_int_mul(&(A),&(B),C) +# define set_number_to_unity(A) mp->math->md_clone(&(A), &unity_t) +# define set_number_to_zero(A) mp->math->md_clone(&(A), &zero_t) +# define set_number_to_inf(A) mp->math->md_clone(&(A), &inf_t) +# define set_number_to_negative_inf(A) mp->math->md_clone(&(A), &negative_inf_t) +# define old_set_number_to_neg_inf(A) do { set_number_to_inf(A); number_negate(A); } while (0) +# define init_randoms(A) mp->math->md_init_randoms(mp,A) +# define print_number(A) mp->math->md_print(mp,&(A)) +# define number_tostring(A) mp->math->md_tostring(mp,&(A)) +# define make_scaled(R,A,B) mp->math->md_make_scaled(mp,&(R),&(A),&(B)) +# define take_scaled(R,A,B) mp->math->md_take_scaled(mp,&(R),&(A),&(B)) +# define make_fraction(R,A,B) mp->math->md_make_fraction(mp,&(R),&(A),&(B)) +# define take_fraction(R,A,B) mp->math->md_take_fraction(mp,&(R),&(A),&(B)) +# define pyth_add(R,A,B) mp->math->md_pyth_add(mp,&(R),&(A),&(B)) +# define pyth_sub(R,A,B) mp->math->md_pyth_sub(mp,&(R),&(A),&(B)) +# define power_of(R,A,B) mp->math->md_power_of(mp,&(R),&(A),&(B)) +# define n_arg(R,A,B) mp->math->md_n_arg(mp,&(R),&(A),&(B)) +# define m_log(R,A) mp->math->md_m_log(mp,&(R),&(A)) +# define m_exp(R,A) mp->math->md_m_exp(mp,&(R),&(A)) +# define m_unif_rand(R,A) mp->math->md_m_unif_rand(mp,&(R),&(A)) +# define m_norm_rand(R) mp->math->md_m_norm_rand(mp,&(R)) +# define velocity(R,A,B,C,D,E) mp->math->md_velocity(mp,&(R),&(A),&(B),&(C),&(D),&(E)) +# define ab_vs_cd(A,B,C,D) mp->math->md_ab_vs_cd(&(A),&(B),&(C),&(D)) +# define crossing_point(R,A,B,C) mp->math->md_crossing_point(mp,&(R),&(A),&(B),&(C)) +# define n_sin_cos(A,S,C) mp->math->md_sin_cos(mp,&(A),&(S),&(C)) +# define square_rt(A,S) mp->math->md_sqrt(mp,&(A),&(S)) +# define slow_add(R,A,B) mp->math->md_slow_add(mp,&(R),&(A),&(B)) +# define round_unscaled(A) mp->math->md_round_unscaled(&(A)) +# define floor_scaled(A) mp->math->md_floor_scaled(&(A)) +# define fraction_to_round_scaled(A) mp->math->md_fraction_to_round_scaled(&(A)) +# define number_to_int(A) mp->math->md_to_int(&(A)) +# define number_to_boolean(A) mp->math->md_to_boolean(&(A)) +# define number_to_scaled(A) mp->math->md_to_scaled(&(A)) +# define number_to_double(A) mp->math->md_to_double(&(A)) +# define number_negate(A) mp->math->md_negate(&(A)) +# define number_add(A,B) mp->math->md_add(&(A),&(B)) +# define number_subtract(A,B) mp->math->md_subtract(&(A),&(B)) +# define number_half(A) mp->math->md_half(&(A)) +# define number_double(A) mp->math->md_do_double(&(A)) +# define number_add_scaled(A,B) mp->math->md_add_scaled(&(A),B) +# define number_multiply_int(A,B) mp->math->md_multiply_int(&(A),B) +# define number_divide_int(A,B) mp->math->md_divide_int(&(A),B) +# define number_abs(A) mp->math->md_abs(&(A)) +# define number_modulo(A,B) mp->math->md_modulo(&(A),&(B)) +# define number_nonequalabs(A,B) mp->math->md_nonequalabs(&(A),&(B)) +# define number_odd(A) mp->math->md_odd(&(A)) +# define number_equal(A,B) mp->math->md_equal(&(A),&(B)) +# define number_greater(A,B) mp->math->md_greater(&(A),&(B)) +# define number_less(A,B) mp->math->md_less(&(A),&(B)) +# define number_clone(A,B) mp->math->md_clone(&(A),&(B)) +# define number_negated_clone(A,B) mp->math->md_negated_clone(&(A),&(B)) +# define number_abs_clone(A,B) mp->math->md_abs_clone(&(A),&(B)) +# define number_swap(A,B) mp->math->md_swap(&(A),&(B)); +# define convert_scaled_to_angle(A) mp->math->md_scaled_to_angle(&(A)); +# define convert_angle_to_scaled(A) mp->math->md_angle_to_scaled(&(A)); +# define convert_fraction_to_scaled(A) mp->math->md_fraction_to_scaled(&(A)); +# define convert_scaled_to_fraction(A) mp->math->md_scaled_to_fraction(&(A)); +# define number_zero(A) number_equal(A, zero_t) +# define number_infinite(A) number_equal(A, inf_t) +# define number_unity(A) number_equal(A, unity_t) +# define number_negative(A) number_less(A, zero_t) +# define number_nonnegative(A) (! number_negative(A)) +# define number_positive(A) number_greater(A, zero_t) +# define number_nonpositive(A) (! number_positive(A)) +# define number_nonzero(A) (! number_zero(A)) +# define number_greaterequal(A,B) (! number_less(A,B)) +# define number_lessequal(A,B) (! number_greater(A,B)) +# define mp_path_ptr(A) (A)->path +# define mp_pen_ptr(A) (A)->pen +# define mp_dash_ptr(A) ((mp_shape_node) (A))->dash +# define mp_line_cap(A) ((mp_shape_node) (A))->linecap +# define mp_line_join(A) ((mp_shape_node) (A))->linejoin +# define mp_miterlimit(A) ((mp_shape_node) (A))->miterlimit +# define mp_set_linecap(A,B) ((mp_shape_node) (A))->linecap = (short) (B) +# define mp_set_linejoin(A,B) ((mp_shape_node) (A))->linejoin = (short) (B) +# define mp_pre_script(A) ((mp_shape_node) (A))->pre_script +# define mp_post_script(A) ((mp_shape_node) (A))->post_script +# define mp_color_model(A) ((mp_shape_node) (A))->color_model +# define mp_stacking(A) ((mp_shape_node) (A))->stacking +# define mp_pen_type(A) ((mp_shape_node) (A))->pen_type +# define mp_cyan_color(A) ((mp_shape_node) (A))->cyan +# define mp_magenta_color(A) ((mp_shape_node) (A))->magenta +# define mp_yellow_color(A) ((mp_shape_node) (A))->yellow +# define mp_black_color(A) ((mp_shape_node) (A))->black +# define mp_red_color(A) ((mp_shape_node) (A))->red +# define mp_green_color(A) ((mp_shape_node) (A))->green +# define mp_blue_color(A) ((mp_shape_node) (A))->blue +# define mp_gray_color(A) ((mp_shape_node) (A))->grey +# define mp_grey_color(A) ((mp_shape_node) (A))->grey +# define mp_has_color(A) (mp_type((A))<mp_start_clip_node_type) +# define mp_has_script(A) (mp_type((A))<=mp_start_bounds_node_type) +# define mp_has_pen(A) (mp_type((A))<=mp_stroked_node_type) +# define mp_is_start_or_stop(A) (mp_type((A))>=mp_start_clip_node_type) +# define mp_is_stop(A) (mp_type((A))>=mp_stop_clip_node_type) +# define mp_get_dash_list(A) (mp_dash_node) (((mp_dash_node) (A))->link) +# define mp_set_dash_list(A,B) ((mp_dash_node) (A))->link = (mp_node) ((B)) +# define mp_bblast(A) ((mp_edge_header_node) (A))->bblast +# define mp_edge_list(A) ((mp_edge_header_node) (A))->list +# define mp_obj_tail(A) ((mp_edge_header_node) (A))->obj_tail +# define mp_edge_ref_count(A) ((mp_edge_header_node) (A))->ref_count +# define mp_add_edge_ref(mp,A) mp_edge_ref_count((A)) += 1 +# define mp_delete_edge_ref(mp,A) { \ + if (mp_edge_ref_count((A)) == 0) { \ + mp_toss_edges(mp, (mp_edge_header_node) (A)); \ + } else { \ + mp_edge_ref_count((A)) -= 1; \ + } \ +} +# define mp_dash_info(A) ((mp_dash_node) (A))->dash_info +# define zero_off 0 +# define near_zero_angle_k mp->math->md_near_zero_angle_t +# define stack_1(A) mp->bisect_stack[(A)] +# define stack_2(A) mp->bisect_stack[(A)+1] +# define stack_3(A) mp->bisect_stack[(A)+2] +# define stack_min(A) mp->bisect_stack[(A)+3] +# define stack_max(A) mp->bisect_stack[(A)+4] +# define int_packets 20 +# define u_packet(A) ((A)- 5) +# define v_packet(A) ((A)-10) +# define x_packet(A) ((A)-15) +# define y_packet(A) ((A)-20) +# define l_packets (mp->bisect_ptr-int_packets) +# define r_packets mp->bisect_ptr +# define ul_packet u_packet(l_packets) +# define vl_packet v_packet(l_packets) +# define xl_packet x_packet(l_packets) +# define yl_packet y_packet(l_packets) +# define ur_packet u_packet(r_packets) +# define vr_packet v_packet(r_packets) +# define xr_packet x_packet(r_packets) +# define yr_packet y_packet(r_packets) +# define u1l stack_1(ul_packet) +# define u2l stack_2(ul_packet) +# define u3l stack_3(ul_packet) +# define v1l stack_1(vl_packet) +# define v2l stack_2(vl_packet) +# define v3l stack_3(vl_packet) +# define x1l stack_1(xl_packet) +# define x2l stack_2(xl_packet) +# define x3l stack_3(xl_packet) +# define y1l stack_1(yl_packet) +# define y2l stack_2(yl_packet) +# define y3l stack_3(yl_packet) +# define u1r stack_1(ur_packet) +# define u2r stack_2(ur_packet) +# define u3r stack_3(ur_packet) +# define v1r stack_1(vr_packet) +# define v2r stack_2(vr_packet) +# define v3r stack_3(vr_packet) +# define x1r stack_1(xr_packet) +# define x2r stack_2(xr_packet) +# define x3r stack_3(xr_packet) +# define y1r stack_1(yr_packet) +# define y2r stack_2(yr_packet) +# define y3r stack_3(yr_packet) +# define stack_dx mp->bisect_stack[mp->bisect_ptr] +# define stack_dy mp->bisect_stack[mp->bisect_ptr+1] +# define stack_tol mp->bisect_stack[mp->bisect_ptr+2] +# define stack_uv mp->bisect_stack[mp->bisect_ptr+3] +# define stack_xy mp->bisect_stack[mp->bisect_ptr+4] +# define int_increment (int_packets+int_packets+5) +# define max_patience 5000 +# define half(A) ((A)/2) +# define intersection_run_shift 8 +# define mp_get_indep_scale(A) ((mp_value_node) (A))->data.indep.scale +# define mp_set_indep_scale(A,B) ((mp_value_node) (A))->data.indep.scale = (B) +# define mp_get_indep_value(A) ((mp_value_node) (A))->data.indep.serial +# define mp_set_indep_value(A,B) ((mp_value_node) (A))->data.indep.serial = (B) +# define mp_get_dep_value(A) ((mp_value_node) (A))->data.n +# define mp_get_dep_list(A) ((mp_value_node) (A))->attr_head +# define mp_get_prev_dep(A) ((mp_value_node) (A))->subscr_head +# define mp_get_dep_info(A) do_get_dep_info(mp, (A)) +# define mp_set_dep_value(A,B) do_set_dep_value(mp,(A),&(B)) +# define mp_set_dep_list(A,B) ((mp_value_node) (A))->attr_head = (mp_node) (B) +# define mp_set_prev_dep(A,B) ((mp_value_node) (A))->subscr_head = (mp_node) (B) +# define mp_set_dep_info(A,B) ((mp_value_node) (A))->parent = (mp_node) (B) +# define independent_needing_fix 0 +# define fraction_threshold_k mp->math->md_fraction_threshold_t +# define half_fraction_threshold_k mp->math->md_half_fraction_threshold_t +# define scaled_threshold_k mp->math->md_scaled_threshold_t +# define half_scaled_threshold_k mp->math->md_half_scaled_threshold_t +# define p_over_v_threshold_k mp->math->md_p_over_v_threshold_t +# define independent_being_fixed 1 +# define two_to_the(A) (1<<(unsigned)(A)) +# define cur_cmd mp->cur_mod_->command +# define cur_mod number_to_scaled(mp->cur_mod_->data.n) +# define cur_mod_number mp->cur_mod_->data.n +# define cur_mod_node mp->cur_mod_->data.node +# define cur_mod_str mp->cur_mod_->data.str +# define cur_sym mp->cur_mod_->data.sym +# define cur_sym_mod mp->cur_mod_->name_type +# define set_cur_cmd(A) mp->cur_mod_->command = (A) +# define set_cur_mod(A) set_number_from_scaled(mp->cur_mod_->data.n, (A)) +# define set_cur_mod_number(A) number_clone(mp->cur_mod_->data.n, (A)) +# define set_cur_mod_node(A) mp->cur_mod_->data.node = (A) +# define set_cur_mod_str(A) mp->cur_mod_->data.str = (A) +# define set_cur_sym(A) mp->cur_mod_->data.sym = (A) +# define set_cur_sym_mod(A) mp->cur_mod_->name_type = (A) +# define iindex mp->cur_input.index_field +# define start mp->cur_input.start_field +# define limit mp->cur_input.limit_field +# define name mp->cur_input.name_field +# define is_term (mp_string) 0 +# define is_read (mp_string) 1 +# define is_scantok (mp_string) 2 +# define max_spec_src is_scantok +# define terminal_input (name == is_term) +# define cur_file mp->input_file[iindex] +# define line mp->line_stack[iindex] +# define nloc mp->cur_input.nloc_field +# define nstart mp->cur_input.nstart_field +# define token_type iindex +# define token_state (iindex<=mp_macro_text) +# define file_state (iindex>mp_macro_text) +# define param_start limit +# define get_t_next(mp) do { \ + mp_get_next(mp); \ + if (cur_cmd <= mp_max_pre_command) { \ + mp_t_next(mp); \ + } \ +} while (0) +# define mp_if_line_field(A) ((mp_if_node) (A))->if_line_field +# define MP_VOID (mp_node) (1) +# define MP_PROGRESSION_FLAG (mp_node) (2) +# define cur_exp_value_boolean number_to_int(mp->cur_exp.data.n) +# define cur_exp_value_number mp->cur_exp.data.n +# define cur_exp_node mp->cur_exp.data.node +# define cur_exp_str mp->cur_exp.data.str +# define cur_exp_knot mp->cur_exp.data.p +# define min_tension three_quarter_unit_t +# define mp_floor(a) ((a) >= 0 ? (int) (a) : -(int) (-(a))) +# define bezier_error (720*(256*256*16))+1 +# define mp_sign(v) ((v) > 0 ? 1 : ((v)<0 ? -1 : 0 )) +# define mp_out(A) (double)((A)/16) +# define p_nextnext mp_next_knot(mp_next_knot(p)) +# define p_next mp_next_knot(p) +# define equation_threshold_k mp->math->md_equation_threshold_t +# define make_cp_a_colored_object(cp,p) do { \ + cp = p; \ + while (cp != NULL) { \ + if (mp_has_color(cp)) { \ + break; \ + } else { \ + cp = mp_link(cp); \ + } \ + } \ +} while (0) +# define set_color_val(A,B) do { \ + if (number_negative(A)) { \ + set_number_to_zero(A); \ + } else if (number_greater(A,unity_t)) { \ + set_number_to_unity(A); \ + } else { \ + number_clone(A, (B)); \ + } \ +} while (0) +# define message_code 0 +# define err_message_code 1 +# define err_help_code 2 +# define max_integer 0x7FFFFFFF +# define gr_next_knot(A) (A)->next +# define gr_originator(A) (A)->originator +# define mp_knotstate(A) (A)->state +# define gr_type(A) (A)->type +# define gr_link(A) (A)->next +# define gr_color_model(A) (A)->color_model +# define gr_red_val(A) (A)->color.a_val +# define gr_green_val(A) (A)->color.b_val +# define gr_blue_val(A) (A)->color.c_val +# define gr_cyan_val(A) (A)->color.a_val +# define gr_magenta_val(A) (A)->color.b_val +# define gr_yellow_val(A) (A)->color.c_val +# define gr_black_val(A) (A)->color.d_val +# define gr_grey_val(A) (A)->color.d_val +# define gr_path_ptr(A) (A)->path +# define gr_htap_ptr(A) (A)->htap +# define gr_pen_ptr(A) (A)->pen +# define gr_linejoin_val(A) (A)->linejoin +# define gr_linecap_val(A) (A)->linecap +# define gr_stacking_val(A) (A)->stacking +# define gr_miterlimit_val(A) (A)->miterlimit +# define gr_pre_script(A) (A)->pre_script +# define gr_post_script(A) (A)->post_script +# define gr_pre_length(A) (A)->pre_length +# define gr_post_length(A) (A)->post_length +# define gr_dash_ptr(A) (A)->dash +# define mp_gr_export_color(q,p) \ +if (mp_color_model(p) == mp_uninitialized_model) { \ + gr_color_model(q) = number_to_scaled(internal_value(mp_default_color_model_internal))/65536; \ + gr_cyan_val(q) = 0; \ + gr_magenta_val(q) = 0; \ + gr_yellow_val(q) = 0; \ + gr_black_val(q) = gr_color_model(q) == mp_cmyk_model ? (number_to_scaled(unity_t)/65536.0) : 0; \ +} else { \ + gr_color_model(q) = mp_color_model(p); \ + gr_cyan_val(q) = number_to_double(p->cyan); \ + gr_magenta_val(q) = number_to_double(p->magenta); \ + gr_yellow_val(q) = number_to_double(p->yellow); \ + gr_black_val(q) = number_to_double(p->black); \ +} +# define mp_gr_export_scripts(q,p) \ +if (mp_pre_script (p)) { \ + gr_pre_script(q) = mp_strndup((const char *) mp_pre_script(p)->str, mp_pre_script(p)->len); \ + gr_pre_length(q) = mp_pre_script(p)->len; \ +} \ +if (mp_post_script(p)) { \ + gr_post_script(q) = mp_strndup((const char *) mp_post_script(p)->str, mp_post_script(p)->len); \ + gr_post_length(q) = mp_post_script(p)->len; \ +} + MP_options *mp_options (void); + MP mp_initialize (MP_options * opt); + static char *mp_find_file (MP mp, const char *fname, const char *fmode, int ftype); + static void *mp_open_file (MP mp, const char *fname, const char *fmode, int ftype); + static char *mp_read_file (MP mp, void *f, size_t * size); + static void mp_close_file (MP mp, void *f); + static void mp_write_file (MP mp, void *f, const char *s); + static char *mp_run_script (MP mp, const char *str, size_t len, int n); + static void mp_run_internal (MP mp, int action, int n, int type, const char *iname); + static void mp_run_logger (MP mp, int target, const char *s, size_t l); + static int mp_run_overload (MP mp, int property, const char *, int); + static void mp_run_error (MP mp, const char *, const char *, int); + static void mp_run_warning (MP mp, const char *); + static char *mp_make_text (MP mp, const char *str, size_t len, int mode); + static void mp_print_str (MP mp, const char *s); + static void mp_print_nl (MP mp, const char *s); + static void mp_print_fmt (MP mp, const char *s, ...); + static void mp_print_ln (MP mp); + static void mp_print_chr (MP mp, unsigned char k); + static void mp_print_mp_str (MP mp, mp_string s); + static void mp_print_nl (MP mp, const char *s); + static void mp_print_two (MP mp, mp_number *x, mp_number *y); + static void mp_print_nl_only (MP mp); + static void mp_print_int (MP mp, int n); + static void mp_get_next (MP mp); + static void mp_begin_file_reading (MP mp); + static void mp_free_node (MP mp, mp_node p, size_t siz); + static void mp_free_symbolic_node (MP mp, mp_node p); + static void mp_free_value_node (MP mp, mp_node p); + static void mp_print_type (MP mp, int t); + static void mp_fix_date_and_time (MP mp); + static void mp_begin_diagnostic (MP mp); + static void mp_end_diagnostic (MP mp, int blank_line); + static void mp_print_diagnostic (MP mp, const char *s, const char *t, int nuline); + static int mp_compare_symbols_entry (void *p, const void *pa, const void *pb); + static void *mp_copy_symbols_entry (const void *p); + static void *mp_delete_symbols_entry (void *p); + static mp_sym new_symbols_entry (MP mp, unsigned char *nam, size_t len); + inline static void do_set_value_sym (MP mp, mp_token_node A, mp_sym B); + inline static void do_set_value_number (MP mp, mp_token_node A, mp_number *B); + inline static void do_set_value_str (MP mp, mp_token_node A, mp_string B); + inline static void do_set_value_node (MP mp, mp_token_node A, mp_node B); + inline static void do_set_value_knot (MP mp, mp_token_node A, mp_knot B); + static void mp_free_token_node (MP mp, mp_node p); + static void mp_flush_token_list (MP mp, mp_node p); + static void mp_show_token_list (MP mp, mp_node p, mp_node q); + static void mp_show_token_list_space (MP mp, mp_node p, mp_node q); + static void mp_print_capsule (MP mp, mp_node p); + static mp_node mp_do_get_subscr_head (MP mp, mp_value_node A); + static mp_node mp_do_get_attribute_head (MP mp, mp_value_node A); + static void mp_do_set_attribute_head (MP mp, mp_value_node A, mp_node d); + static void mp_do_set_subscr_head (MP mp, mp_value_node A, mp_node d); + static mp_node mp_new_value_node (MP mp); + static void mp_print_variable_name (MP mp, mp_node p); + static void mp_flush_cur_exp (MP mp, mp_value v); + static void mp_flush_below_variable (MP mp, mp_node p); + static void mp_pr_path (MP mp, mp_knot h); + static void mp_print_path (MP mp, mp_knot h, const char *s, int nuline); + static mp_knot mp_new_knot (MP mp); + static mp_gr_knot mp_gr_new_knot (MP mp); + static void mp_toss_knot_list (MP mp, mp_knot p); + static void mp_toss_knot (MP mp, mp_knot p); + static void mp_free_knot (MP mp, mp_knot p); + static void mp_reallocate_paths (MP mp, int l); + static void mp_solve_choices (MP mp, mp_knot p, mp_knot q, int n); + static void mp_reduce_angle (MP mp, mp_number *a); + static void mp_curl_ratio (MP mp, mp_number *ret, mp_number *gamma, mp_number *a_tension, mp_number *b_tension); + static void mp_set_controls (MP mp, mp_knot p, mp_knot q, int k); + static 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); + static void mp_pr_pen (MP mp, mp_knot h); + static void mp_print_pen (MP mp, mp_knot h, const char *s, int nuline); + static mp_knot mp_convex_hull (MP mp, mp_knot h); + void mp_simplify_path (MP mp, mp_knot h); + static void mp_move_knot (MP mp, mp_knot p, mp_knot q); + static 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); + static void mp_flush_dash_list (MP mp, mp_edge_header_node h); + static mp_edge_header_node mp_toss_gr_object (MP mp, mp_node p); + static void mp_toss_edges (MP mp, mp_edge_header_node h); + static mp_edge_header_node mp_copy_objects (MP mp, mp_node p, mp_node q); + static void mp_print_edges (MP mp, mp_node h, const char *s, int nuline); + static void mp_print_obj_color (MP mp, mp_node p); + static void mp_dash_offset (MP mp, mp_number *x, mp_dash_node h); + static void mp_x_retrace_error (MP mp); + static void mp_set_bbox (MP mp, mp_edge_header_node h, int top_level); + static void mp_split_cubic (MP mp, mp_knot p, mp_number *t); + static mp_knot mp_split_cubic_knot (MP mp, mp_knot p, mp_number *t); + static void mp_remove_cubic (MP mp, mp_knot p); + static mp_knot mp_pen_walk (MP mp, mp_knot w, int k); + static void mp_fin_offset_prep (MP mp, mp_knot p, mp_knot w, mp_number *x0, mp_number *x1, mp_number *x2, mp_number *y0, mp_number *y1, mp_number *y2, int rise, int turn_amt); + static int mp_get_turn_amt (MP mp, mp_knot w, mp_number *dx, mp_number *dy, int ccw); + static mp_knot mp_insert_knot (MP mp, mp_knot q, mp_number *x, mp_number *y); + static void mp_set_min_max (MP mp, int v); + static void mp_new_indep (MP mp, mp_node p); + inline static mp_node do_get_dep_info (MP mp, mp_value_node p); + inline static void do_set_dep_value (MP mp, mp_value_node p, mp_number *q); + static void mp_free_dep_node (MP mp, mp_value_node p); + static void mp_print_dependency (MP mp, mp_value_node p, int t); + static mp_value_node mp_p_plus_fq (MP mp, mp_value_node p, mp_number *f, mp_value_node q, mp_variable_type t, mp_variable_type tt); + static mp_value_node mp_p_over_v (MP mp, mp_value_node p, mp_number *v, int t0, int t1); + static void mp_val_too_big (MP mp, mp_number *x); + static void mp_make_known (MP mp, mp_value_node p, mp_value_node q); + static void mp_fix_dependencies (MP mp); + static void mp_ring_delete (MP mp, mp_node p); + static void mp_exclaim_redundant_equation (MP mp); + static const char *mp_cmd_mod_string (MP mp, int c, int m); + static void mp_print_cmd_mod (MP mp, int c, int m); + static void mp_reallocate_input_stack (MP mp, int newsize); + static int mp_true_line (MP mp); + static void mp_push_input (MP mp); + static void mp_pop_input (MP mp); + static void mp_back_input (MP mp); + static void mp_back_error (MP mp, const char *msg, const char *hlp) ; + static void mp_runaway (MP mp); + static void mp_firm_up_the_line (MP mp); + static int mp_move_to_next_line (MP mp); + static void mp_t_next (MP mp); + static void mp_scan_primary (MP mp); + static void mp_scan_secondary (MP mp); + static void mp_scan_tertiary (MP mp); + static void mp_scan_expression (MP mp); + static void mp_scan_suffix (MP mp); + static void mp_pass_text (MP mp); + static void mp_conditional (MP mp); + static void mp_start_input (MP mp); + static void mp_begin_iteration (MP mp); + static void mp_resume_iteration (MP mp); + static void mp_stop_iteration (MP mp); + static void check_script_result (MP mp, char *s); + static void mp_get_x_next (MP mp); + static void mp_macro_call (MP mp, mp_node def_ref, mp_node arg_list, mp_sym macro_name); + static void mp_print_macro_name (MP mp, mp_node a, mp_sym n); + static void mp_print_arg (MP mp, mp_node q, int n, int b, int bb); + static void mp_scan_text_arg (MP mp, mp_sym l_delim, mp_sym r_delim); + static void mp_push_condition_stack (MP mp); + static void mp_pop_condition_stack (MP mp); + static void mp_begin_name (MP mp); + static int mp_more_name (MP mp, unsigned char c); + static void mp_end_name (MP mp); + static void mp_open_write_file (MP mp, char *s, int n); + static void mp_set_cur_exp_knot (MP mp, mp_knot n); + static void mp_set_cur_exp_node (MP mp, mp_node n); + static void mp_set_cur_exp_value_boolean (MP mp, int b); + static void mp_set_cur_exp_value_scaled (MP mp, int s); + static void mp_set_cur_exp_value_number (MP mp, mp_number *n); + static void mp_set_cur_exp_str (MP mp, mp_string s); + static mp_node mp_stash_cur_exp (MP mp); + static void mp_print_dp (MP mp, int t, mp_value_node p, int verbosity); + static void mp_unstash_cur_exp (MP mp, mp_node p); + static void mp_print_exp (MP mp, mp_node p, int verbosity); + static void mp_print_big_node (MP mp, mp_node p, int verbosity); + static void mp_disp_err (MP mp, mp_node p); + static void mp_recycle_value (MP mp, mp_node p); + static void mp_recycle_independent_value (MP mp, mp_node p); + static void mp_show_transformed_dependency (MP mp, mp_number *v, mp_variable_type t, mp_node p); + static void mp_known_pair (MP mp); + static void do_boolean_error (MP mp); + static void push_of_path_result (MP mp, int what, mp_knot p); + static mp_knot mp_simple_knot(MP mp, mp_number *x, mp_number *y); + static mp_knot mp_complex_knot(MP mp, mp_knot o); + static int mp_pict_color_type (MP mp, int c); + static void mp_bad_color_part (MP mp, int c); + static mp_edge_header_node mp_scale_edges (MP mp, mp_number *se_sf, mp_edge_header_node se_pic); + static void mp_path_length (MP mp, mp_number *n); + static void mp_pair_value (MP mp, mp_number *x, mp_number *y); + static void mp_do_type_declaration (MP mp); + static void mp_do_max_knot_pool (MP mp); + static void mp_do_random_seed (MP mp); + static void mp_do_protection (MP mp); + static void mp_do_property (MP mp); + static void mp_def_delims (MP mp); + static void mp_do_statement (MP mp); + static void mp_do_interim (MP mp); + static void mp_do_let (MP mp); + static void mp_do_show (MP mp); + static void mp_disp_token (MP mp); + static void mp_do_show_token (MP mp); + static void mp_do_show_stats (MP mp); + static void mp_disp_var (MP mp, mp_node p); + static void mp_do_show_var (MP mp); + static void mp_do_show_dependencies (MP mp); + static void mp_do_show_whatever (MP mp); + static void mp_scan_with_list (MP mp, mp_node p, mp_node pp); + static mp_edge_header_node mp_find_edges_var (MP mp, mp_node t); + static mp_node mp_start_draw_cmd (MP mp, int sep); + static void mp_do_bounds (MP mp); + static void mp_do_add_to (MP mp); + static void mp_ship_out (MP mp, mp_node h); + + static void mp_do_ship_out (MP mp); + static void mp_do_message (MP mp); + static void mp_no_string_err (MP mp, const char *s); + static void mp_do_write (MP mp); + static void mp_do_write_string (MP mp, mp_string t); + + static void mp_make_eq (MP mp, mp_node lhs); + + static void mp_do_equation (MP mp); + static void mp_do_assignment (MP mp); + static void mp_try_eq (MP mp, mp_node l, mp_node r); + static mp_node mp_scan_declared_variable (MP mp); + static void mp_check_delimiter (MP mp, mp_sym l_delim, mp_sym r_delim); + static void mp_do_new_internal (MP mp); + static void mp_shipout_backend (MP mp, void *h); + static void mp_close_files (MP mp); + static void mp_close_files_and_terminate (MP mp); + static void mp_final_cleanup (MP mp); + static void mp_init_prim (MP mp); + static void mp_init_tab (MP mp); + +void mp_jump_out (MP mp) +{ + if (mp->internal != NULL && mp->history < mp_system_error_stop) { + mp_close_files_and_terminate(mp); + } + longjmp(*(mp->jump_buf), 1); +} +void mp_warn (MP mp, const char *msg) +{ + int selector = mp->selector; + mp_normalize_selector(mp); + mp_print_nl(mp, "Warning: "); + mp_print_str(mp, msg); + mp_print_ln(mp); + mp->selector = selector; +} +void mp_fatal_error (MP mp, const char *s) +{ + mp_normalize_selector(mp); + if (mp->interaction == mp_error_stop_mode) { + mp->interaction = mp_scroll_mode; + } + mp_error(mp, "Emergency stop", s); + mp->history = mp_fatal_error_stop; + mp_jump_out(mp); +} +void mp_confusion (MP mp, const char *s) +{ + char msg[256]; + const char *hlp = NULL; + mp_normalize_selector(mp); + if (mp->history < mp_error_message_issued) { + mp_snprintf(msg, 256, "This can't happen (%s)", s); + hlp = + "I'm broken. Please show this to someone who can fix can fix it and try\n" + "again"; + } else { + hlp = + "One of your faux pas seems to have wounded me deeply ... in fact, I'm barely\n" + "conscious. Please fix it and try again."; + mp_snprintf(msg, 256, "I can't go on meeting you like this"); + } + if (mp->interaction == mp_error_stop_mode) { + mp->interaction = mp_scroll_mode; + } + mp_error(mp, msg, hlp); + mp->history=mp_fatal_error_stop; + mp_jump_out(mp); +} + +MP_options *mp_options (void) +{ + MP_options *opt = mp_memory_clear_allocate(sizeof(MP_options)); + return opt; +} + +static MP mp_do_new (jmp_buf *buf) +{ + MP mp = mp_memory_clear_allocate(sizeof(MP_instance)); + if (mp == NULL) { + mp_memory_free(buf); + return NULL; + } else { + mp->jump_buf = buf; + return mp; + } +} + +static void mp_free (MP mp) +{ + mp_memory_free(mp->banner); + mp_memory_free(mp->buffer); + mp_dealloc_strings(mp); + for (int i = 0; i < 55; i++) { + free_number(mp->randoms[i]); + } + while (mp->value_nodes) { + mp_node p = mp->value_nodes; + mp->value_nodes = p->link; + mp_free_node(mp, p, sizeof(mp_value_node_data)); + } + while (mp->symbolic_nodes) { + mp_node p = mp->symbolic_nodes; + mp->symbolic_nodes = p->link; + mp_free_node(mp, p, sizeof(mp_node_data)); + } + while (mp->pair_nodes) { + mp_node p = mp->pair_nodes; + mp->pair_nodes = p->link; + mp_free_node(mp, p, sizeof(mp_pair_node_data)); + } + while (mp->token_nodes) { + mp_node p = mp->token_nodes; + mp->token_nodes = p->link; + mp_free_node(mp, p, sizeof(mp_node_data)); + } + while (mp->knot_nodes) { + mp_knot p = mp->knot_nodes; + mp->knot_nodes = p->next; + mp_free_knot(mp, p); + } + if (mp->symbols != NULL) { + avl_destroy (mp->symbols); + } + if (mp->frozen_symbols != NULL) { + avl_destroy (mp->frozen_symbols); + } + for (int k = 0; k<mp->path_size; k++) { + free_number(mp->delta_x[k]); + free_number(mp->delta_y[k]); + free_number(mp->delta[k]); + free_number(mp->psi[k]); + } + mp_memory_free(mp->delta_x); + mp_memory_free(mp->delta_y); + mp_memory_free(mp->delta); + mp_memory_free(mp->psi); + for (int k = 0; k < mp->path_size; k++) { + free_number(mp->theta[k]); + free_number(mp->uu[k]); + free_number(mp->vv[k]); + free_number(mp->ww[k]); + } + mp_memory_free(mp->theta); + mp_memory_free(mp->uu); + mp_memory_free(mp->vv); + mp_memory_free(mp->ww); + free_number(mp->st); + free_number(mp->ct); + free_number(mp->sf); + free_number(mp->cf); + for (int i = 0; i <= mp_y_code; i++) { + free_number(mp->bbmin[i]); + free_number(mp->bbmax[i]); + } + for (int k = 0; k <= 7; k++) { + free_number(mp->half_cos[k]); + free_number(mp->d_cos[k]); + } + free_number(mp->cur_x); + free_number(mp->cur_y); + for (int i=0; i<bistack_size + 1; i++) { + free_number(mp->bisect_stack[i]); + } + mp_memory_free(mp->bisect_stack); + free_number(mp->cur_t); + free_number(mp->cur_tt); + free_number(mp->max_t); + free_number(mp->delx); + free_number(mp->dely); + free_number(mp->appr_t); + free_number(mp->appr_tt); + mp_memory_free(mp->input_stack); + mp_memory_free(mp->input_file); + mp_memory_free(mp->line_stack); + mp_memory_free(mp->param_stack); + mp_memory_free(mp->cur_name); + mp_memory_free(mp->job_name); + for (int i = 0; i < mp_proto_dependent_type + 1; i++) { + free_number(mp->max_c[i]); + } + for (int k = 0; k <= mp->max_internal; k++) { + free_number(mp->internal[k].v.data.n); + mp_memory_free(internal_name(k)); + } + mp_memory_free(mp->internal); + mp_close_files(mp); + if (mp->rd_fname != NULL) { + mp_memory_free(mp->rd_file); + mp_memory_free(mp->rd_fname); + mp->rd_file = NULL; + mp->rd_fname = NULL; + } + if (mp->wr_fname != NULL) { + mp_memory_free(mp->wr_file); + mp_memory_free(mp->wr_fname); + mp->wr_file = NULL; + mp->wr_fname = NULL; + } + mp_memory_free(mp->term_in); + mp->term_in = NULL; + + mp_memory_free(mp->jump_buf); + mp_free_symbolic_node(mp, mp->spec_head); + mp_free_symbolic_node(mp, mp->temp_head); + mp_free_symbolic_node(mp, mp->hold_head); + mp_free_value_node(mp, mp->end_attr); + mp_free_node(mp, (mp_node) mp->null_dash, sizeof(mp_dash_node_data)); + mp_free_dep_node(mp, mp->dep_head); + mp_free_symbolic_node(mp, mp->cur_mod_); + mp_free_value_node(mp, mp->bad_vardef); + free_number(mp->cur_exp.data.n); + mp_free_value_node(mp, mp->temp_val); + free_number(mp->txx); + free_number(mp->txy); + free_number(mp->tyx); + free_number(mp->tyy); + free_number(mp->tx); + free_number(mp->ty); + mp_free_value_node(mp, mp->inf_val); + mp_free_value_node(mp, mp->zero_val); + + free_math(); + mp_memory_free(mp); +} + +static void mp_do_initialize (MP mp) +{ + mp->int_ptr = max_given_internal; + for (int k = '0'; k <= '9'; k++) { + mp->char_class[k] = mp_digit_class; + } + for (int k = 'A'; k <= 'Z'; k++) { + mp->char_class[k] = mp_letter_class; + } + for (int k = 'a'; k <= 'z'; k++) { + mp->char_class[k] = mp_letter_class; + } + mp->char_class['.'] = mp_period_class; + mp->char_class[' '] = mp_space_class; + mp->char_class['%'] = mp_percent_class; + mp->char_class['"'] = mp_string_class; + mp->char_class[','] = mp_comma_class; + mp->char_class[';'] = mp_semicolon_class; + mp->char_class['('] = mp_left_parenthesis_class; + mp->char_class[')'] = mp_right_parenthesis_class; + mp->char_class['_'] = mp_letter_class; + mp->char_class['<'] = 10; + mp->char_class['='] = 10; + mp->char_class['>'] = 10; + mp->char_class[':'] = 10; + mp->char_class['|'] = 10; + mp->char_class['`'] = 11; + mp->char_class['\''] = 11; + mp->char_class['+'] = 12; + mp->char_class['-'] = 12; + mp->char_class['/'] = 13; + mp->char_class['*'] = 13; + mp->char_class['\\'] = 13; + mp->char_class['^'] = 13; + mp->char_class['!'] = 14; + mp->char_class['?'] = 14; + mp->char_class['#'] = mp_suffix_class; + mp->char_class['&'] = mp_suffix_class; + mp->char_class['@'] = mp_suffix_class; + mp->char_class['$'] = mp_suffix_class; + mp->char_class['^'] = 16; + mp->char_class['~'] = 16; + mp->char_class['['] = mp_left_bracket_class; + mp->char_class[']'] = mp_right_bracket_class; + mp->char_class['{'] = mp_brace_class; + mp->char_class['}'] = mp_brace_class; + for (int k = 0; k < ' '; k++) { + mp->char_class[k] = mp_invalid_class; + } + mp->char_class['\r'] = mp_space_class; + mp->char_class['\n'] = mp_space_class; + mp->char_class['\t'] = mp_space_class; + mp->char_class['\f'] = mp_space_class; + for (int k = 127; k <= 255; k++) { + mp->char_class[k] = mp->utf8_mode ? mp_letter_class : mp_invalid_class; + } + if (mp->text_mode) { + mp->char_class[2] = mp_string_class; + } + mp->save_ptr = NULL; + for (int k = 0; k <= 7; k++) { + new_fraction(mp->half_cos[k]); + new_fraction(mp->d_cos[k]); + } + number_clone(mp->half_cos[0], fraction_half_t); + number_clone(mp->half_cos[1], twentysixbits_sqrt2_t); + number_clone(mp->half_cos[2], zero_t); + number_clone(mp->d_cos[0], twentyeightbits_d_t); + number_clone(mp->d_cos[1], twentysevenbits_sqrt2_d_t); + number_clone(mp->d_cos[2], zero_t); + for (int k = 3; k <= 4; k++) { + number_negated_clone(mp->half_cos[k], mp->half_cos[4 - k]); + number_negated_clone(mp->d_cos[k], mp->d_cos[4 - k]); + } + for (int k = 5; k <= 7; k++) { + number_clone(mp->half_cos[k], mp->half_cos[8 - k]); + number_clone(mp->d_cos[k], mp->d_cos[8 - k]); + } + mp->spec_p1 = NULL; + mp->spec_p2 = NULL; + mp->fix_needed = 0; + mp->watch_coefs = 1; + mp->expand_depth = 10000; + mp->cond_ptr = NULL; + mp->if_limit = mp_no_if_code; + mp->cur_if = 0; + mp->if_line = 0; + mp->loop_ptr = NULL; + mp->cur_name = mp_strdup(""); + memset(&mp->cur_exp.data, 0, sizeof(mp_value)); + new_number(mp->cur_exp.data.n); + mp->var_flag = 0; + mp->eof_line = mp_rtsl (mp, "\0", 1); + mp->eof_line->refs = MAX_STR_REF; + mp->eof_file = mp_rtsl (mp, "%", 1); + mp->eof_file->refs = MAX_STR_REF; + mp->every_job_sym = NULL; + mp->long_help_seen = 0; + mp->ten_pow[0] = 1; + for (int i = 1; i <= 9; i++) { + mp->ten_pow[i] = 10 * mp->ten_pow[i - 1]; + } +} + +MP mp_initialize (MP_options * opt) +{ + MP mp; + jmp_buf *buf = mp_memory_allocate(sizeof(jmp_buf)); + if (buf == NULL || setjmp(*buf) != 0) { + return NULL; + } + mp = mp_do_new(buf); + if (mp == NULL) { + return NULL; + } + if (opt->job_name == NULL || ! *(opt->job_name)) { + return NULL; + } + mp->job_name = mp_strdup(opt->job_name); + mp->userdata = opt->userdata; + mp->extensions = opt->extensions; + mp->find_file = mp_find_file; + mp->open_file = mp_open_file; + mp->close_file = mp_close_file; + mp->write_file = mp_write_file; + mp->read_file = mp_read_file; + mp->run_script = mp_run_script; + mp->run_internal = mp_run_internal; + mp->run_logger = mp_run_logger; + mp->run_overload = mp_run_overload; + mp->run_error = mp_run_error; + mp->run_warning = mp_run_warning; + mp->make_text = mp_make_text; + mp->shipout_backend = mp_shipout_backend; + mp->find_file_id = 0; + mp->run_script_id = 0; + mp->run_logger_id = 0; + mp->run_error_id = 0; + mp->run_warning_id = 0; + mp->run_overload_id = 0; + mp->make_text_id = 0; + mp->open_file_id = 0; + + + mp->find_file = opt->find_file ? opt->find_file : mp_find_file ; + mp->open_file = opt->open_file ? opt->open_file : mp_open_file ; + mp->read_file = opt->read_file ? opt->read_file : mp_read_file ; + mp->close_file = opt->close_file ? opt->close_file : mp_close_file ; + mp->write_file = opt->write_file ? opt->write_file : mp_write_file ; + mp->shipout_backend = opt->shipout_backend ? opt->shipout_backend : mp_shipout_backend; + mp->run_script = opt->run_script ? opt->run_script : mp_run_script ; + mp->run_internal = opt->run_internal ? opt->run_internal : mp_run_internal ; + mp->run_logger = opt->run_logger ? opt->run_logger : mp_run_logger ; + mp->run_overload = opt->run_overload ? opt->run_overload : mp_run_overload ; + mp->run_error = opt->run_error ? opt->run_error : mp_run_error ; + mp->run_warning = opt->run_warning ? opt->run_warning : mp_run_warning ; + mp->make_text = opt->make_text ? opt->make_text : mp_make_text ; + + mp->find_file_id = opt->find_file_id; + mp->run_script_id = opt->run_script_id; + mp->run_internal_id = opt->run_internal_id; + mp->run_logger_id = opt->run_logger_id; + mp->run_overload_id = opt->run_overload_id; + mp->run_error_id = opt->run_error_id; + mp->run_warning_id = opt->run_warning_id; + mp->make_text_id = opt->make_text_id; + mp->open_file_id = opt->open_file_id; + + if (opt->banner && *(opt->banner)) { + mp->banner = mp_strdup(opt->banner); + } else { + mp->banner = mp_strdup(default_banner); + } + switch (opt->math_mode) { + case mp_math_scaled_mode: + mp->math = mp_initialize_scaled_math(mp); + break; + case mp_math_decimal_mode: + mp->math = mp_initialize_decimal_math(mp); + break; + case mp_math_binary_mode: + mp->math = mp_initialize_binary_math(mp); + break; + default: + mp->math = mp_initialize_double_math(mp); + break; + } + mp->param_size = 4; + mp->max_in_open = 0; + mp->halt_on_error = opt->halt_on_error ? 1 : 0; + mp->utf8_mode = opt->utf8_mode ? 1 : 0; + mp->text_mode = opt->text_mode ? 1 : 0; + mp->show_mode = opt->show_mode ? 1 : 0; + mp->buf_size = 200; + mp->buffer = mp_memory_allocate((size_t) (mp->buf_size + 1) * sizeof(unsigned char)); + mp_initialize_strings(mp); + mp->interaction = opt->interaction; + if (mp->interaction == mp_unspecified_mode || mp->interaction > mp_silent_mode) { + mp->interaction = mp_error_stop_mode; + } + if (mp->interaction < mp_unspecified_mode) { + mp->interaction = mp_batch_mode; + } + mp->use_err_help = 0; + mp->finished = 0; + mp->arith_error = 0; + mp->random_seed = opt->random_seed; + for (int i = 0; i < 55; i++) { + new_fraction(mp->randoms[i]); + } + mp->math_mode = opt->math_mode; + mp->token_nodes = NULL; + mp->num_token_nodes = 0; + mp->pair_nodes = NULL; + mp->num_pair_nodes = 0; + mp->knot_nodes = NULL; + mp->max_knot_nodes = max_num_knot_nodes; + mp->num_knot_nodes = 0; + mp->value_nodes = NULL; + mp->num_value_nodes = 0; + mp->symbolic_nodes = NULL; + mp->num_symbolic_nodes = 0; + + mp->max_internal = 1000 + max_given_internal; + mp->internal = mp_memory_allocate((size_t) (mp->max_internal + 1) * sizeof(mp_internal)); + memset(mp->internal, 0, (size_t) (mp->max_internal + 1) * sizeof(mp_internal)); + for (int i = 1; i <= mp->max_internal; i++) { + new_number(mp->internal[i].v.data.n); + } + for (int i = 1; i <= max_given_internal; i++) { + set_internal_type(i, mp_known_type); + } + set_internal_type(mp_number_system_internal, mp_string_type); + set_internal_type(mp_job_name_internal, mp_string_type); + mp->symbols = avl_create(mp_compare_symbols_entry, mp_copy_symbols_entry, mp_delete_symbols_entry, mp_memory_allocate, mp_memory_free, NULL); + mp->frozen_symbols = avl_create(mp_compare_symbols_entry, mp_copy_symbols_entry, mp_delete_symbols_entry, mp_memory_allocate, mp_memory_free, NULL); + mp->bisect_stack = mp_memory_allocate((size_t) (bistack_size + 1) * sizeof(mp_number)); + for (int i=0; i<bistack_size + 1; i++) { + new_number(mp->bisect_stack[i]); + } + mp->stack_size = 16; + mp->input_stack = mp_memory_allocate((size_t) (mp->stack_size + 1) * sizeof(mp_in_state_record)); + mp_reallocate_input_stack(mp, mp_file_bottom_text + 4); + mp->param_stack = mp_memory_allocate((size_t) (mp->param_size + 1) * sizeof(mp_node)); + mp->max_read_files = 8; + mp->rd_file = mp_memory_allocate((size_t) (mp->max_read_files + 1) * sizeof(void *)); + mp->rd_fname = mp_memory_allocate((size_t) (mp->max_read_files + 1) * sizeof(char *)); + mp->max_write_files = 8; + mp->wr_file = mp_memory_allocate((size_t) (mp->max_write_files + 1) * sizeof(void *)); + mp->wr_fname = mp_memory_allocate((size_t) (mp->max_write_files + 1) * sizeof(char *)); + memset(mp->rd_fname, 0, sizeof(char *) * (mp->max_read_files + 1)); + memset(mp->wr_fname, 0, sizeof(char *) * (mp->max_write_files + 1)); + + mp_reallocate_paths(mp, 1000); + mp->history = mp_fatal_error_stop; + mp_do_initialize(mp); + mp_init_tab(mp); + switch (opt->math_mode) { + case mp_math_scaled_mode: + set_internal_string(mp_number_system_internal, mp_intern(mp, "scaled")); + break; + case mp_math_decimal_mode: + set_internal_string(mp_number_system_internal, mp_intern(mp, "decimal")); + break; + case mp_math_binary_mode: + set_internal_string(mp_number_system_internal, mp_intern(mp, "binary")); + break; + default: + set_internal_string(mp_number_system_internal, mp_intern(mp, "double")); + break; + } + mp_init_prim(mp); + mp_fix_date_and_time(mp); + mp->history = mp_spotless; + set_precision(); + if (mp->job_name != NULL) { + if (internal_string(mp_job_name_internal) != 0) { + delete_str_ref(internal_string(mp_job_name_internal)); + } + set_internal_string(mp_job_name_internal, mp_rts(mp, mp->job_name)); + } + return mp; +} + +int mp_status (MP mp) { return mp->history; } +int mp_finished (MP mp) { return mp->finished; } +void *mp_userdata (MP mp) { return mp->userdata; } + +static char *mp_find_file (MP mp, const char *fname, const char *fmode, int ftype) +{ + (void) mp; (void) fname; (void) fmode; (void) ftype; + mp_fatal_error(mp, "no 'find_file' callback set"); + return NULL; +} + +static char *mp_run_script (MP mp, const char *str, size_t len, int n) +{ + (void) mp; (void) str; (void) len; (void) n; + mp_fatal_error(mp, "no 'run_script' callback set"); + return NULL; +} + +void mp_run_internal (MP mp, int action, int n, int type, const char *iname) +{ + (void) mp; (void) action; (void) n; (void) type; (void) iname; + mp_fatal_error(mp, "no 'run_internal' callback set"); +} + +static void mp_run_logger (MP mp, int target, const char *s, size_t l) +{ + (void) mp; (void) target; (void) s; (void) l; + mp_fatal_error(mp, "no 'run_logger' callback set"); +} + +static int mp_run_overload (MP mp, int property, const char *str, int mode) +{ + (void) mp; (void) property; (void) str; (void) mode; + mp_fatal_error(mp, "no 'run_overload' callback set"); + return 0; +} + +static void mp_check_overload (MP mp, mp_sym p) +{ + if (number_nonzero(internal_value(mp_overloadmode_internal))) { + if (mp->run_overload(mp, p->property, (const char *) p->text->str, number_to_int(internal_value(mp_overloadmode_internal)))) { + p->property = 0; + } else { + } + } else { + p->property = 0; + } +} + +static void mp_run_error (MP mp, const char *msg, const char *hlp, int interaction) +{ + (void) mp; (void) msg; (void) hlp; (void) interaction; + mp_fatal_error(mp, "no 'run_error' callback set"); +} + +static void mp_run_warning (MP mp, const char *msg) +{ + (void) mp; (void) msg; + mp_fatal_error(mp, "no 'run_warning' callback set"); +} + +static char *mp_make_text (MP mp, const char *str, size_t len, int mode) +{ + (void) mp; (void) mode; (void) str; (void) len; + mp_fatal_error(mp, "no 'make_text' callback set"); + return NULL; +} + +static void *mp_open_file (MP mp, const char *fname, const char *fmode, int ftype) +{ + (void) mp; (void) fname; (void) fmode; (void) ftype; + mp_fatal_error(mp, "no 'open_file' callback set"); + return NULL; +} + +static int mp_do_open_file (MP mp, void **f, int ftype, const char *mode) +{ + char *s = (mp->find_file)(mp, mp->name_of_file, mode, ftype); + if (s != NULL) { + mp_memory_free(mp->name_of_file); + mp->name_of_file = mp_strdup(s); + + lmt_memory_free(s); + *f = (mp->open_file)(mp, mp->name_of_file, mode, ftype); + } else { + *f = NULL; + } + return (*f ? 1 : 0); +} + +static int mp_open_in (MP mp, void **f, int ftype) +{ + return mp_do_open_file(mp, f, ftype, "r"); +} + +static int mp_open_out (MP mp, void **f, int ftype) +{ + return mp_do_open_file(mp, f, ftype, "w"); +} + +static char *mp_read_file (MP mp, void *f, size_t *size) +{ + (void) mp; (void) f; (void) size; + mp_fatal_error(mp, "no 'read_file' callback set"); + return NULL; +} + +static void mp_write_file (MP mp, void *f, const char *s) +{ + (void) mp; (void) f; (void) s; + mp_fatal_error(mp, "no 'read_file' callback set"); +} + +static void mp_close_file (MP mp, void *f) +{ + (void) mp; (void) f; + mp_fatal_error(mp, "no 'close_file' callback set"); +} + +static void mp_reallocate_buffer (MP mp, size_t l) +{ + if (l > max_halfword) { + mp_confusion(mp, "buffer size"); + } else { + unsigned char *buffer = mp_memory_allocate((size_t) (l + 1) * sizeof(unsigned char)); + memcpy(buffer, mp->buffer, (mp->buf_size + 1)); + mp_memory_free(mp->buffer); + mp->buffer = buffer; + mp->buf_size = l; + } +} + +static int mp_input_ln (MP mp, void *f) +{ + char *s; + size_t size = 0; + mp->last = mp->first; + s = (mp->read_file)(mp, f, &size); + if (s == NULL) { + return 0; + } else if (size > 0) { + mp->last = mp->first + size; + if (mp->last >= mp->max_buf_stack) { + mp->max_buf_stack = mp->last + 1; + while (mp->max_buf_stack > mp->buf_size) { + mp_reallocate_buffer(mp, (mp->buf_size + (mp->buf_size >> 2))); + } + } + memcpy((mp->buffer + mp->first), s, size); + } + lmt_memory_free(s); + return 1; +} + +static void mp_print_ln (MP mp) +{ + switch (mp->selector) { + case mp_term_and_log_selector: + mp_log_cr(mp_both_logging_target); + mp->term_offset = 0; + mp->file_offset = 0; + break; + case mp_log_only_selector: + mp_log_cr(mp_file_logging_target); + mp->file_offset = 0; + break; + case mp_term_only_selector: + mp_log_cr(mp_term_logging_target); + mp->term_offset = 0; + break; + case mp_no_print_selector: + case mp_new_string_selector: + break; + default: + mp_fputs("\n", mp->wr_file[mp->selector - mp_first_file_selector]); + } +} + +static void mp_print_chr (MP mp, unsigned char s) +{ + switch (mp->selector) { + case mp_term_and_log_selector: + mp_log_chr(mp_both_logging_target, s); + mp->term_offset = 1; + mp->file_offset = 1; + break; + case mp_log_only_selector: + mp_log_chr(mp_file_logging_target, s); + mp->file_offset = 1; + break; + case mp_term_only_selector: + mp_log_chr(mp_term_logging_target, s); + mp->term_offset = 1; + break; + case mp_no_print_selector: + break; + case mp_new_string_selector: + mp_str_room(mp, 1); + mp_append_char(mp, s); + break; + default: + { + unsigned char ss[2] = { s, 0 }; + mp_fputs((char *) ss, mp->wr_file[mp->selector - mp_first_file_selector]); + } + } +} + +void mp_print_e_chr (MP mp, unsigned char s) +{ + mp_print_chr(mp, s); +} + +static void mp_do_print (MP mp, const char *s, size_t len) +{ + if (len == 0) { + return; + } else if (mp->selector == mp_new_string_selector) { + mp_str_room(mp, (int) len); + memcpy((mp->cur_string + mp->cur_length), s, len); + mp->cur_length += len; + } else { + switch (mp->selector) { + case mp_term_and_log_selector: + mp_log_mpstr(mp_both_logging_target, s, (int) len); + mp->term_offset = 1; + mp->file_offset = 1; + break; + case mp_log_only_selector: + mp_log_mpstr(mp_file_logging_target, s, (int) len); + mp->file_offset = 1; + break; + case mp_term_only_selector: + mp_log_mpstr(mp_term_logging_target, s, (int) len); + mp->term_offset = 1; + break; + case mp_no_print_selector: + break; + case mp_new_string_selector: + mp_str_room(mp, (int) len); + mp_append_str(mp, s); + break; + default: + mp_fputs(s, mp->wr_file[mp->selector - mp_first_file_selector]); + break; + } + } +} + +static void mp_print_str (MP mp, const char *s) +{ + mp_do_print(mp, s, strlen(s)); +} + +void mp_print_e_str (MP mp, const char *s) +{ + mp_print_str(mp,s); +} + +static void mp_print_fmt (MP mp, const char *s, ...) +{ + va_list ap; + char pval[256]; + va_start(ap, s); + vsnprintf(pval, 256, s, ap); + mp_do_print(mp, pval, strlen(pval)); + va_end(ap); +} + +static void mp_print_mp_str (MP mp, mp_string s) +{ + mp_do_print(mp, (const char *) s->str, s->len); +} + +static void mp_print_nl_only (MP mp) +{ + switch (mp->selector) { + case mp_term_and_log_selector: + if (mp->file_offset > 0) { + mp_log_cr(mp_file_logging_target); + mp->file_offset = 0; + } + if (mp->term_offset > 0) { + mp_log_cr(mp_term_logging_target); + mp->term_offset = 0; + } + break; + case mp_log_only_selector: + if (mp->file_offset > 0) { + mp_log_cr(mp_file_logging_target); + mp->file_offset = 0; + } + break; + case mp_term_only_selector: + if (mp->term_offset > 0) { + mp_log_cr(mp_term_logging_target); + mp->term_offset = 0; + } + break; + case mp_no_print_selector: + case mp_new_string_selector: + break; + } +} + +static void mp_print_nl (MP mp, const char *s) +{ + mp_print_nl_only(mp); + mp_print_str(mp, s); +} + +static void mp_print_int (MP mp, int n) +{ + char s[12]; + mp_snprintf(s, 12, "%d", (int) n); + mp_print_str(mp, s); +} + +void mp_error (MP mp, const char *msg, const char *hlp) +{ + int selector = mp->selector; + mp_normalize_selector(mp); + mp->run_error(mp, msg, hlp, mp->interaction); + if (mp->history < mp_error_message_issued) { + mp->history = mp_error_message_issued; + } + if (mp->halt_on_error) { + mp->history = mp_fatal_error_stop; + mp_jump_out(mp); + } + ++mp->error_count; + if (mp->error_count == 100) { + mp_print_nl(mp, "(That makes 100 errors; please try again.)"); + mp->history = mp_fatal_error_stop; + mp_jump_out(mp); + } + mp->selector = selector; +} + +void mp_normalize_selector (MP mp) +{ + mp->selector = mp->interaction == mp_batch_mode ? mp_log_only_selector : mp_term_and_log_selector; +} + +static void mp_clear_arith (MP mp) { + mp_error( + mp, + "Arithmetic overflow", + "Uh, oh. A little while ago one of the quantities that I was computing got too\n" + "large, so I'm afraid your answers will be somewhat askew. You'll probably have to\n" + "adopt different tactics next time. But I shall try to carry on anyway." + ); + mp->arith_error = 0; +} + +static void mp_print_two (MP mp, mp_number *x, mp_number *y) +{ + mp_print_chr(mp, '('); + print_number(*x); + mp_print_chr(mp, ','); + print_number(*y); + mp_print_chr(mp, ')'); +} + +void mp_new_randoms (MP mp) +{ + mp_number x; + new_number(x); + for (int k = 0; k <= 23; k++) { + set_number_from_subtraction(x, mp->randoms[k], mp->randoms[k + 31]); + if (number_negative(x)) { + number_add(x, fraction_one_t); + } + number_clone(mp->randoms[k], x); + } + for (int k = 24; k <= 54; k++) { + set_number_from_subtraction(x, mp->randoms[k], mp->randoms[k - 24]); + if (number_negative(x)) { + number_add(x, fraction_one_t); + } + number_clone(mp->randoms[k], x); + } + free_number(x); + mp->j_random = 54; +} + +void *mp_allocate_node (MP mp, size_t size) +{ + void *p = mp_memory_allocate(size); + ((mp_node) p)->link = NULL; + ((mp_node) p)->hasnumber = 0; + mp->var_used += size; + if (mp->var_used > mp->var_used_max) { + mp->var_used_max = mp->var_used; + } + return p; +} + +void *mp_allocate_dash (MP mp) +{ + void *p = mp_memory_allocate(sizeof(mp_dash_object)); + mp->var_used += sizeof(mp_dash_object); + if (mp->var_used > mp->var_used_max) { + mp->var_used_max = mp->var_used; + } + return p; +} + +void *mp_memory_allocate (size_t size) +{ + void *w = lmt_memory_malloc(size); + if (! w) { + printf("mplib ran out of memory, case 1"); + exit(EXIT_FAILURE); + } + return w; +} + +void *mp_memory_clear_allocate (size_t size) +{ + void *w = lmt_memory_calloc(1, size); + if (! w) { + printf("mplib ran out of memory, case 2"); + exit(EXIT_FAILURE); + } + return w; +} + +void *mp_memory_reallocate (void *p, size_t size) +{ + void *w = lmt_memory_realloc(p, size); + if (! w) { + printf("mplib ran out of memory, case 3"); + exit(EXIT_FAILURE); + } + return w; +} + +void mp_memory_free (void *p) +{ + lmt_memory_free(p); +} + +# define mp_get_sym_info(A) mp_get_indep_value(A) +# define mp_set_sym_info(A,B) mp_set_indep_value(A, (B)) +# define mp_get_sym_sym(A) (A)->data.sym +# define mp_set_sym_sym(A,B) (A)->data.sym = (mp_sym)(B) + +static mp_node mp_new_symbolic_node (MP mp) +{ + mp_symbolic_node p; + if (mp->symbolic_nodes) { + p = (mp_symbolic_node) mp->symbolic_nodes; + mp->symbolic_nodes = p->link; + mp->num_symbolic_nodes--; + p->link = NULL; + } else { + p = mp_allocate_node(mp, sizeof(mp_node_data)); + new_number(p->data.n); + p->hasnumber = 1; + } + p->type = mp_symbol_node_type; + p->name_type = mp_normal_operation; + return (mp_node) p; +} + +static void mp_free_node (MP mp, mp_node p, size_t siz) +{ + if (p) { + mp->var_used -= siz; + if (mp->math_mode > mp_math_double_mode) { + if (p->hasnumber >= 1 && is_number(((mp_symbolic_node) p)->data.n)) { + free_number(((mp_symbolic_node) p)->data.n); + } + if (p->hasnumber == 2 && is_number(((mp_value_node) p)->subscript)) { + free_number(((mp_value_node) p)->subscript); + } + if (mp_type(p) == mp_dash_node_type) { + free_number(((mp_dash_node) p)->start_x); + free_number(((mp_dash_node) p)->stop_x); + free_number(((mp_dash_node) p)->dash_y); + } + } + mp_memory_free(p); + } +} + +static void mp_free_symbolic_node (MP mp, mp_node p) +{ + if (p) { + if (mp->num_symbolic_nodes < max_num_symbolic_nodes) { + p->link = mp->symbolic_nodes; + mp->symbolic_nodes = p; + mp->num_symbolic_nodes++; + } else { + mp->var_used -= sizeof(mp_node_data); + mp_memory_free(p); + } + } +} + +static void mp_free_value_node (MP mp, mp_node p) +{ + if (p) { + if (mp->num_value_nodes < max_num_value_nodes) { + p->link = mp->value_nodes; + mp->value_nodes = p; + mp->num_value_nodes++; + } else { + mp->var_used -= sizeof(mp_value_node_data); + if (mp->math_mode > mp_math_double_mode) { + free_number(((mp_value_node) p)->data.n); + free_number(((mp_value_node) p)->subscript); + } + mp_memory_free(p); + } + } +} + +static void mp_flush_node_list (MP mp, mp_node p) +{ + while (p != NULL) { + mp_node q = p; + p = p->link; + if (q->type != mp_symbol_node_type) { + mp_free_token_node(mp, q); + } else { + mp_free_symbolic_node(mp, q); + } + } +} + +static const char *mp_type_string(int t) +{ + const char *s = NULL; + switch (t) { + case mp_undefined_type: s = "undefined"; break; + case mp_vacuous_type: s = "vacuous"; break; + case mp_boolean_type: s = "boolean"; break; + case mp_unknown_boolean_type: s = "unknown boolean"; break; + case mp_string_type: s = "string"; break; + case mp_unknown_string_type: s = "unknown string"; break; + case mp_pen_type: s = "pen"; break; + case mp_unknown_pen_type: s = "unknown pen"; break; + case mp_nep_type: s = "pen"; break; + case mp_unknown_nep_type: s = "unknown pen"; break; + case mp_path_type: s = "path"; break; + case mp_unknown_path_type: s = "unknown path"; break; + case mp_picture_type: s = "picture"; break; + case mp_unknown_picture_type: s = "unknown picture"; break; + case mp_transform_type: s = "transform"; break; + case mp_color_type: s = "color"; break; + case mp_cmykcolor_type: s = "cmykcolor"; break; + case mp_pair_type: s = "pair"; break; + case mp_known_type: s = "known numeric"; break; + case mp_dependent_type: s = "dependent"; break; + case mp_proto_dependent_type: s = "proto-dependent"; break; + case mp_numeric_type: s = "numeric"; break; + case mp_independent_type: s = "independent"; break; + case mp_token_list_type: s = "token list"; break; + case mp_structured_type: s = "mp_structured"; break; + case mp_unsuffixed_macro_type: s = "unsuffixed macro"; break; + case mp_suffixed_macro_type: s = "suffixed macro"; break; + case mp_symbol_node_type: s = "symbol node"; break; + case mp_token_node_type: s = "token node"; break; + case mp_value_node_type: s = "value node"; break; + case mp_attribute_node_type: s = "attribute node"; break; + case mp_subscript_node_type: s = "subscript node"; break; + case mp_pair_node_type: s = "pair node"; break; + case mp_transform_node_type: s = "transform node"; break; + case mp_color_node_type: s = "color node"; break; + case mp_cmykcolor_node_type: s = "cmykcolor node"; break; + case mp_fill_node_type: s = "fill node"; break; + case mp_stroked_node_type: s = "stroked node"; break; + case mp_start_clip_node_type: s = "start clip node"; break; + case mp_start_group_node_type: s = "start group node"; break; + case mp_start_bounds_node_type: s = "start bounds node"; break; + case mp_stop_clip_node_type: s = "stop clip node"; break; + case mp_stop_group_node_type: s = "stop group node"; break; + case mp_stop_bounds_node_type: s = "stop bounds node"; break; + case mp_dash_node_type: s = "dash node"; break; + case mp_dep_node_type: s = "dependency node"; break; + case mp_if_node_type: s = "if node"; break; + case mp_edge_header_node_type: s = "edge header node"; break; + default: + { + char ss[256]; + mp_snprintf(ss, 256, "<unknown type %d>", t); + s = mp_strdup(ss); + } + break; + } + return s; +} + +void mp_print_type (MP mp, int t) +{ + if (t >= 0 && t <= mp_edge_header_node_type) { + mp_print_str(mp, mp_type_string(t)); + } else { + mp_print_str(mp, "unknown"); + } +} + +static const char *mp_op_string (int c) +{ + if (c <= mp_numeric_type) { + return mp_type_string(c); + } else { + switch (c) { + case mp_true_operation : return "true"; + case mp_false_operation : return "false"; + case mp_null_picture_operation : return "nullpicture"; + case mp_null_pen_operation : return "nullpen"; + case mp_read_string_operation : return "readstring"; + case mp_pen_circle_operation : return "pencircle"; + case mp_normal_deviate_operation : return "normaldeviate"; + case mp_read_from_operation : return "readfrom"; + case mp_close_from_operation : return "closefrom"; + case mp_odd_operation : return "odd"; + case mp_known_operation : return "known"; + case mp_unknown_operation : return "unknown"; + case mp_not_operation : return "not"; + case mp_decimal_operation : return "decimal"; + case mp_reverse_operation : return "reverse"; + case mp_uncycle_operation : return "uncycle"; + case mp_make_path_operation : return "makepath"; + case mp_make_pen_operation : return "makepen"; + case mp_make_nep_operation : return "makenep"; + case mp_convexed_operation : return "convexed"; + case mp_uncontrolled_operation : return "uncontrolled"; + case mp_oct_operation : return "oct"; + case mp_hex_operation : return "hex"; + case mp_ASCII_operation : return "ASCII"; + case mp_char_operation : return "char"; + case mp_length_operation : return "length"; + case mp_turning_operation : return "turningnumber"; + case mp_x_part_operation : return "xpart"; + case mp_y_part_operation : return "ypart"; + case mp_xx_part_operation : return "xxpart"; + case mp_xy_part_operation : return "xypart"; + case mp_yx_part_operation : return "yxpart"; + case mp_yy_part_operation : return "yypart"; + case mp_red_part_operation : return "redpart"; + case mp_green_part_operation : return "greenpart"; + case mp_blue_part_operation : return "bluepart"; + case mp_cyan_part_operation : return "cyanpart"; + case mp_magenta_part_operation : return "magentapart"; + case mp_yellow_part_operation : return "yellowpart"; + case mp_black_part_operation : return "blackpart"; + case mp_grey_part_operation : return "greypart"; + case mp_color_model_operation : return "colormodel"; + case mp_prescript_part_operation : return "prescriptpart"; + case mp_postscript_part_operation : return "postscriptpart"; + case mp_stacking_part_operation : return "stackingpart"; + case mp_path_part_operation : return "pathpart"; + case mp_pen_part_operation : return "penpart"; + case mp_dash_part_operation : return "dashpart"; + case mp_sqrt_operation : return "sqrt"; + case mp_m_exp_operation : return "mexp"; + case mp_m_log_operation : return "mlog"; + case mp_sin_d_operation : return "sind"; + case mp_cos_d_operation : return "cosd"; + case mp_floor_operation : return "floor"; + case mp_uniform_deviate_operation : return "uniformdeviate"; + case mp_ll_corner_operation : return "llcorner"; + case mp_lr_corner_operation : return "lrcorner"; + case mp_ul_corner_operation : return "ulcorner"; + case mp_ur_corner_operation : return "urcorner"; + case mp_center_of_operation : return "centerof"; + case mp_center_of_mass_operation : return "centerofmass"; + case mp_corners_operation : return "corners"; + case mp_x_range_operation : return "xrange"; + case mp_y_range_operation : return "yrange"; + case mp_delta_point_operation : return "deltapoint"; + case mp_delta_precontrol_operation : return "deltaprecontrol"; + case mp_delta_postcontrol_operation: return "deltapostcontrol"; + case mp_delta_direction_operation : return "deltadirection"; + case mp_arc_length_operation : return "arclength"; + case mp_angle_operation : return "angle"; + case mp_cycle_operation : return "cycle"; + case mp_no_cycle_operation : return "nocycle"; + case mp_filled_operation : return "filled"; + case mp_stroked_operation : return "stroked"; + case mp_clipped_operation : return "clipped"; + case mp_grouped_operation : return "grouped"; + case mp_bounded_operation : return "bounded"; + case mp_plus_operation : return "+"; + case mp_minus_operation : return "-"; + case mp_times_operation : return "*"; + case mp_over_operation : return "/"; + case mp_power_operation : return "^"; + case mp_pythag_add_operation : return "++"; + case mp_pythag_sub_operation : return "+-+"; + case mp_or_operation : return "or"; + case mp_and_operation : return "and"; + case mp_less_than_operation : return "<"; + case mp_less_or_equal_operation : return "<="; + case mp_greater_than_operation : return ">"; + case mp_greater_or_equal_operation : return ">="; + case mp_equal_operation : return "="; + case mp_unequal_operation : return "<>"; + case mp_concatenate_operation : return "&"; + case mp_just_append_operation : return "&&"; + case mp_rotated_operation : return "rotated"; + case mp_slanted_operation : return "slanted"; + case mp_scaled_operation : return "scaled"; + case mp_shifted_operation : return "shifted"; + case mp_transformed_operation : return "transformed"; + case mp_x_scaled_operation : return "xscaled"; + case mp_y_scaled_operation : return "yscaled"; + case mp_z_scaled_operation : return "zscaled"; + case mp_intertimes_operation : return "intersectiontimes"; + case mp_intertimes_list_operation : return "intersectiontimeslist"; + case mp_substring_operation : return "substring"; + case mp_subpath_operation : return "subpath"; + case mp_direction_time_operation : return "directiontime"; + case mp_point_operation : return "point"; + case mp_precontrol_operation : return "precontrol"; + case mp_postcontrol_operation : return "postcontrol"; + case mp_direction_operation : return "direction"; + case mp_path_point_operation : return "pathpoint"; + case mp_path_precontrol_operation : return "pathprecontrol"; + case mp_path_postcontrol_operation : return "pathpostcontrol"; + case mp_path_direction_operation : return "pathdirection"; + case mp_pen_offset_operation : return "penoffset"; + case mp_arc_time_operation : return "arctime"; + case mp_arc_point_operation : return "arcpoint"; + case mp_arc_point_list_operation : return "arcpointlist"; + case mp_subarc_length_operation : return "subarclength"; + case mp_version_operation : return "mpversion"; + case mp_envelope_operation : return "envelope"; + case mp_boundingpath_operation : return "boundingpath"; + + case mp_pen_type_operation : return "pen"; + case mp_nep_type_operation : return "nep"; + case mp_path_type_operation : return "path"; + case mp_picture_type_operation : return "picture"; + case mp_transform_type_operation : return "transform"; + case mp_color_type_operation : return "color"; + case mp_cmykcolor_type_operation : return "cmykcolor"; + case mp_pair_type_operation : return "pair"; + case mp_numeric_type_operation : return "numeric"; + + default : return ".."; + } + } +} +static void mp_print_op (MP mp, int c) +{ + mp_print_str(mp, mp_op_string(c)); +} + +static void mp_fix_date_and_time (MP mp) +{ + time_t aclock = time ((time_t *) 0); + struct tm *tmptr = localtime (&aclock); + number_clone(internal_value(mp_time_internal), unity_t); + number_multiply_int(internal_value(mp_time_internal), (tmptr->tm_hour * 60 + tmptr->tm_min)); + number_clone(internal_value(mp_hour_internal), unity_t); + number_multiply_int(internal_value(mp_hour_internal), (tmptr->tm_hour)); + number_clone(internal_value(mp_minute_internal), unity_t); + number_multiply_int(internal_value(mp_minute_internal), (tmptr->tm_min)); + number_clone(internal_value(mp_day_internal), unity_t); + number_multiply_int(internal_value(mp_day_internal), (tmptr->tm_mday)); + number_clone(internal_value(mp_month_internal), unity_t); + number_multiply_int(internal_value(mp_month_internal), (tmptr->tm_mon + 1)); + number_clone(internal_value(mp_year_internal), unity_t); + number_multiply_int(internal_value(mp_year_internal), (tmptr->tm_year + 1900)); +} + +static void mp_begin_diagnostic (MP mp) +{ + mp->old_selector = mp->selector; + if (number_nonpositive(internal_value(mp_tracing_online_internal)) && (mp->selector == mp_term_and_log_selector)) { + mp->selector = mp_log_only_selector; + if (mp->history == mp_spotless) { + mp->history = mp_warning_issued; + } + } +} + +void mp_end_diagnostic (MP mp, int blank_line) +{ + mp_print_nl(mp, ""); + if (blank_line) { + mp_print_ln(mp); + } + mp->selector = mp->old_selector; +} + +static void mp_print_diagnostic (MP mp, const char *s, const char *t, int nuline) +{ + mp_begin_diagnostic(mp); + if (nuline) { + mp_print_nl(mp, s); + } else { + mp_print_str(mp, s); + } + mp_print_str(mp, " at line "); + mp_print_int(mp, mp_true_line(mp)); + mp_print_str(mp, t); + mp_print_chr(mp, ':'); +} + +# define text(A) (A)->text +# define eq_type(A) (A)->type +# define eq_property(A) (A)->property +# define equiv(A) (A)->v.data.indep.serial +# define equiv_node(A) (A)->v.data.node +# define equiv_sym(A) (mp_sym)(A)->v.data.node + +static int mp_compare_symbols_entry (void *p, const void *pa, const void *pb) +{ + const mp_symbol_entry *a = (const mp_symbol_entry *) pa; + const mp_symbol_entry *b = (const mp_symbol_entry *) pb; + (void) p; + if (a->text->len != b->text->len) { + return (a->text->len > b->text->len ? 1 : -1); + } + return strncmp ((const char *) a->text->str, (const char *) b->text->str, a->text->len); +} + +static void *mp_copy_symbols_entry (const void *p) +{ + + mp_symbol_entry *fp = (mp_symbol_entry *) p; + MP mp = (MP)fp->parent; + mp_sym ff = mp_memory_allocate(sizeof(mp_symbol_entry)); + if (ff == NULL) { + return NULL; + } + ff->text = mp_aux_copy_strings_entry(fp->text); + if (ff->text == NULL) { + return NULL; + } + ff->v = fp->v; + ff->type = fp->type; + ff->property = fp->property; + ff->parent = mp; + new_number_clone(ff->v.data.n, fp->v.data.n); + return ff; +} + +static void *mp_delete_symbols_entry (void *p) +{ + mp_sym ff = (mp_sym) p; + MP mp = (MP) ff->parent; + free_number(ff->v.data.n); + mp_memory_free(ff->text->str); + mp_memory_free(ff->text); + mp_memory_free(ff); + return NULL; +} + +static mp_sym new_symbols_entry (MP mp, unsigned char *nam, size_t len) +{ + mp_sym ff = mp_memory_clear_allocate(sizeof(mp_symbol_entry)); + ff->parent = mp; + ff->text = mp_memory_allocate(sizeof(mp_lstring)); + ff->text->str = nam; + ff->text->len = len; + ff->type = mp_tag_command; + ff->v.type = mp_known_type; + new_number(ff->v.data.n); + return ff; +} + +static mp_sym mp_do_id_lookup (MP mp, avl_tree symbols, char *j, size_t l, int insert_new) +{ + mp_sym str; + mp->id_lookup_test->text->str = (unsigned char *) j; + mp->id_lookup_test->text->len = l; + str = (mp_sym) avl_find(mp->id_lookup_test, symbols); + if (str == NULL && insert_new) { + unsigned char *nam = (unsigned char *) mp_strndup(j, l); + mp_sym s = new_symbols_entry(mp, nam, l); + mp->st_count++; + avl_ins(s, symbols, avl_false); + str = (mp_sym) avl_find(s, symbols); + mp_delete_symbols_entry(s); + } + return str; +} + +int mp_initialize_symbol_traverse (MP mp) +{ + mp->symbol_iterator = avl_iterator_new(mp->symbols, AVL_ITERATOR_INI_PRE); + return (mp->symbol_iterator != NULL); +} + +void mp_kill_symbol_traverse (MP mp) +{ + avl_iterator_kill(mp->symbol_iterator); +} + +void *mp_fetch_symbol_traverse (MP mp) +{ + return avl_iterator_next(mp->symbol_iterator); +} + +void *mp_fetch_symbol (MP mp, char *s) +{ + return mp_id_lookup(mp, s, strlen(s), 0); +} + +static void mp_primitive (MP mp, const char *ss, int c, int o) +{ + + set_cur_sym(mp_id_lookup(mp, (char *) ss, strlen(ss), 1)); + set_eq_type(cur_sym, c); + set_eq_property(cur_sym, 0x1); + set_equiv(cur_sym, o); +} + +static mp_sym mp_frozen_primitive (MP mp, const char *ss, int c, int o) +{ + + mp_sym str = mp_do_id_lookup(mp, mp->frozen_symbols, (char *) ss, strlen(ss), 1); + str->type = c; + str->property = 0x1; + str->v.data.indep.serial = o; + return str; +} + +static int mp_is_frozen (MP mp, mp_sym sym) +{ + mp_sym temp = mp_do_id_lookup(mp, mp->frozen_symbols, (char *) sym->text->str, sym->text->len, 0); + if (temp == mp->frozen_inaccessible) { + return 0; + } else { + return (temp == sym); + } +} + +# define mp_get_value_sym(A) ((mp_token_node) (A))->data.sym +# define mp_get_value_number(A) ((mp_token_node) (A))->data.n +# define mp_get_value_node(A) ((mp_token_node) (A))->data.node +# define mp_get_value_str(A) ((mp_token_node) (A))->data.str +# define mp_get_value_knot(A) ((mp_token_node) (A))->data.p + +inline static void do_set_value_sym (MP mp, mp_token_node A, mp_sym B) +{ + (void) mp; + A->data.sym=(B); +} + +inline static void do_set_value_number (MP mp, mp_token_node A, mp_number *B) +{ + (void) mp; + A->data.p = NULL; + A->data.str = NULL; + A->data.node = NULL; + number_clone(A->data.n, *B); +} + +inline static void do_set_value_str (MP mp, mp_token_node A, mp_string B) +{ + (void) mp; + A->data.p = NULL; + A->data.str = (B); + add_str_ref((B)); + A->data.node = NULL; + number_clone(A->data.n, zero_t); +} + +inline static void do_set_value_node (MP mp, mp_token_node A, mp_node B) +{ + (void) mp; + A->data.p = NULL; + A->data.str = NULL; + A->data.node = B; + number_clone(A->data.n, zero_t); +} + +inline static void do_set_value_knot (MP mp, mp_token_node A, mp_knot B) +{ + (void) mp; + A->data.p = (B); + A->data.str = NULL; + A->data.node = NULL; + number_clone(A->data.n, zero_t); +} + +static mp_node mp_new_token_node (MP mp) +{ + mp_node p; + if (mp->token_nodes) { + p = mp->token_nodes; + mp->token_nodes = p->link; + mp->num_token_nodes--; + p->link = NULL; + } else { + p = mp_allocate_node(mp, sizeof(mp_node_data)); + new_number(p->data.n); + p->hasnumber = 1; + } + p->type = mp_token_node_type; + return (mp_node) p; +} + +static void mp_free_token_node (MP mp, mp_node p) +{ + if (p) { + if (mp->num_token_nodes < max_num_token_nodes) { + p->link = mp->token_nodes; + mp->token_nodes = p; + mp->num_token_nodes++; + } else { + mp->var_used -= sizeof(mp_node_data); + if (mp->math_mode > mp_math_double_mode) { + free_number(((mp_value_node) p)->data.n); + } + mp_memory_free(p); + } + } +} + +static mp_node mp_new_num_tok (MP mp, mp_number *v) +{ + mp_node p = mp_new_token_node(mp); + mp_set_value_number(p, *v); + p->type = mp_known_type; + p->name_type = mp_token_operation; + return p; +} + +static void mp_flush_token_list (MP mp, mp_node p) +{ + while (p != NULL) { + mp_node q = p; + p = mp_link(p); + switch (mp_type(q)) { + case mp_symbol_node_type: + mp_free_symbolic_node(mp, q); + continue; + case mp_vacuous_type: + case mp_boolean_type: + case mp_known_type: + break; + case mp_string_type: + delete_str_ref(mp_get_value_str(q)); + break; + case mp_unknown_boolean_type: + case mp_unknown_string_type: + case mp_unknown_pen_type: + case mp_unknown_nep_type: + case mp_unknown_path_type: + case mp_unknown_picture_type: + case mp_pen_type: + case mp_nep_type: + case mp_path_type: + case mp_picture_type: + case mp_pair_type: + case mp_color_type: + case mp_cmykcolor_type: + case mp_transform_type: + case mp_dependent_type: + case mp_proto_dependent_type: + case mp_independent_type: + mp_recycle_value(mp, q); + break; + default: + mp_confusion(mp, "token"); + } + mp_free_token_node(mp, q); + } +} + +void mp_show_token_list (MP mp, mp_node p, mp_node q) +{ + int cclass = mp_percent_class; + (void) q; + while (p != NULL) { + int c = mp_letter_class; + if (mp_type(p) != mp_symbol_node_type) { + if (mp_name_type(p) == mp_token_operation) { + if (mp_type(p) == mp_known_type) { + if (cclass == mp_digit_class) { + mp_print_chr(mp, ' '); + } + if (number_negative(mp_get_value_number(p))) { + if (cclass == mp_left_bracket_class) { + mp_print_chr(mp, ' '); + } + mp_print_chr(mp, '['); + print_number(mp_get_value_number(p)); + mp_print_chr(mp, ']'); + c = mp_right_bracket_class; + } else { + print_number(mp_get_value_number(p)); + c = mp_digit_class; + } + } else if (mp_type(p) == mp_string_type) { + mp_print_chr(mp, '"'); + mp_print_mp_str(mp, mp_get_value_str(p)); + mp_print_chr(mp, '"'); + c = mp_string_class; + } else { + mp_print_str(mp, " BAD"); + } + } else if ((mp_name_type(p) != mp_capsule_operation) || (mp_type(p) < mp_vacuous_type) || (mp_type(p) > mp_independent_type)) { + mp_print_str(mp, " BAD"); + } else { + mp_print_capsule(mp, p); + c = mp_right_parenthesis_class; + } + } else if (mp_name_type(p) == mp_expr_operation || mp_name_type(p) == mp_suffix_operation || mp_name_type(p) == mp_text_operation) { + int r = mp_get_sym_info(p); + if (mp_name_type(p) == mp_expr_operation) { + mp_print_str(mp, "(EXPR"); + } else if (mp_name_type(p) == mp_suffix_operation) { + mp_print_str(mp, "(SUFFIX"); + } else { + mp_print_str(mp, "(TEXT"); + } + mp_print_int(mp, r); + mp_print_chr(mp, ')'); + c = mp_right_parenthesis_class; + } else { + mp_sym sr = mp_get_sym_sym(p); + if (sr == mp_collective_subscript) { + if (cclass == mp_left_bracket_class) { + mp_print_chr(mp, ' '); + } + mp_print_str(mp, "[]"); + c = mp_right_bracket_class; + } else { + mp_string rr = text(sr); + if (rr == NULL || rr->str == NULL) { + mp_print_str(mp, " NONEXISTENT"); + } else { + c = mp->char_class[(rr->str[0])]; + if (c == cclass) { + switch (c) { + case mp_letter_class: + mp_print_chr(mp, '.'); + break; + case mp_comma_class: + case mp_semicolon_class: + case mp_left_parenthesis_class: + case mp_right_parenthesis_class: + break; + default: + mp_print_chr(mp, ' '); + break; + } + } + mp_print_mp_str(mp, rr); + } + } + } + cclass = c; + p = mp_link(p); + } + return; +} + +void mp_show_token_list_space (MP mp, mp_node p, mp_node q) +{ + (void) q; + while (p != NULL) { + if (mp_type(p) != mp_symbol_node_type) { + if (mp_name_type(p) == mp_token_operation) { + if (mp_type(p) == mp_known_type) { + if (number_negative(mp_get_value_number(p))) { + mp_print_str(mp, "[ "); + print_number(mp_get_value_number(p)); + mp_print_str(mp, " ]"); + } else { + print_number(mp_get_value_number(p)); + } + } else if (mp_type(p) == mp_string_type) { + mp_print_chr(mp, '"'); + mp_print_mp_str(mp, mp_get_value_str(p)); + mp_print_chr(mp, '"'); + } else { + mp_print_str(mp, "BAD"); + } + } else if ((mp_name_type(p) != mp_capsule_operation) || (mp_type(p) < mp_vacuous_type) || (mp_type(p) > mp_independent_type)) { + mp_print_str(mp, "BAD"); + } else { + mp_print_capsule(mp, p); + } + } else if (mp_name_type(p) == mp_expr_operation || mp_name_type(p) == mp_suffix_operation || mp_name_type(p) == mp_text_operation) { + int r = mp_get_sym_info(p); + if (mp_name_type(p) == mp_expr_operation) { + mp_print_str(mp, "(EXPR "); + } else if (mp_name_type(p) == mp_suffix_operation) { + mp_print_str(mp, "(SUFFIX "); + } else { + mp_print_str(mp, "(TEXT "); + } + mp_print_int(mp, r); + mp_print_chr(mp, ')'); + } else { + mp_sym sr = mp_get_sym_sym(p); + if (sr == mp_collective_subscript) { + mp_print_str(mp, "[]"); + } else { + mp_string rr = text(sr); + if (rr == NULL || rr->str == NULL) { + mp_print_str(mp, "NONEXISTENT"); + } else { + mp_print_mp_str(mp, rr); + } + } + } + p = mp_link(p); + if (p) { + mp_print_chr(mp, ' '); + } + } + return; +} + +static void mp_delete_mac_ref (MP mp, mp_node p) +{ + if (mp_get_ref_count(p) == 0) { + mp_flush_token_list(mp, p); + } else { + mp_decr_mac_ref(p); + } +} + +static void mp_show_macro (MP mp, mp_node p, mp_node q) +{ + p = mp_link(p); + while (mp_name_type(p) != mp_macro_operation) { + mp_node r = mp_link(p); + mp_link(p) = NULL; + mp_show_token_list(mp, p, NULL); + mp_link(p) = r; + p = r; + } + switch (mp_get_sym_info(p)) { + case mp_general_macro: + mp_print_str(mp, "-> "); + break; + case mp_primary_macro: + case mp_secondary_macro: + case mp_tertiary_macro: + mp_print_str(mp, "<"); + mp_print_cmd_mod(mp, mp_parameter_commmand, mp_get_sym_info(p)); + mp_print_str(mp, "> -> "); + break; + case mp_expr_macro: + mp_print_str(mp, "<expr> -> "); + break; + case mp_of_macro: + mp_print_str(mp, "<expr> of <primary> -> "); + break; + case mp_suffix_macro: + mp_print_str(mp, "<suffix> -> "); + break; + case mp_text_macro: + mp_print_str(mp, "<text> -> "); + break; + } + mp_show_token_list(mp, mp_link(p), q); +} + +static mp_node mp_do_get_attribute_head (MP mp, mp_value_node A) +{ + (void) mp; + return A->attr_head; +} + +static mp_node mp_do_get_subscr_head (MP mp, mp_value_node A) +{ + return A->subscr_head; + (void) mp; +} + +static void mp_do_set_attribute_head (MP mp, mp_value_node A, mp_node d) +{ + (void) mp; + A->attr_head = d; +} + +static void mp_do_set_subscr_head (MP mp, mp_value_node A, mp_node d) +{ + (void) mp; + A->subscr_head = d; +} + +static mp_node mp_new_value_node (MP mp) +{ + mp_value_node p; + if (mp->value_nodes) { + p = (mp_value_node) mp->value_nodes; + mp->value_nodes = p->link; + mp->num_value_nodes--; + p->link = NULL; + } else { + p = mp_allocate_node(mp, sizeof(mp_value_node_data)); + new_number(p->data.n); + new_number(p->subscript); + p->hasnumber = 2; + } + mp_type(p) = mp_value_node_type; + return (mp_node) p; +} + +# define mp_get_hashloc(A) ((mp_value_node)(A))->hashloc_ +# define mp_set_hashloc(A,B) ((mp_value_node)(A))->hashloc_ = B +# define mp_get_parent(A) ((mp_value_node)(A))->parent +# define mp_set_parent(A,B) ((mp_value_node)(A))->parent = B + +static mp_value_node mp_get_attribute_node (MP mp) +{ + mp_value_node p = (mp_value_node) mp_new_value_node(mp); + mp_type(p) = mp_attribute_node_type; + return p; +} + +static mp_value_node mp_get_subscr_node (MP mp) +{ + mp_value_node p = (mp_value_node) mp_new_value_node(mp); + mp_type(p) = mp_subscript_node_type; + return p; +} + +static mp_node mp_get_pair_node (MP mp) +{ + mp_node p; + if (mp->pair_nodes) { + p = mp->pair_nodes; + mp->pair_nodes = p->link; + mp->num_pair_nodes--; + p->link = NULL; + } else { + p = mp_allocate_node(mp, sizeof(mp_pair_node_data)); + } + mp_type(p) = mp_pair_node_type; + return (mp_node) p; +} + +static void mp_free_pair_node (MP mp, mp_node p) +{ + if (p) { + if (mp->num_pair_nodes < max_num_pair_nodes) { + p->link = mp->pair_nodes; + mp->pair_nodes = p; + mp->num_pair_nodes++; + } else { + mp->var_used -= sizeof(mp_pair_node_data); + mp_memory_free(p); + } + } +} + +static void mp_init_pair_node (MP mp, mp_node p) +{ + mp_node q; + mp_type(p) = mp_pair_type; + q = mp_get_pair_node(mp); + mp_y_part(q) = mp_new_value_node(mp); + mp_new_indep(mp, mp_y_part(q)); + mp_name_type(mp_y_part(q)) = mp_y_part_operation; + mp_link(mp_y_part(q)) = p; + mp_x_part(q) = mp_new_value_node(mp); + mp_new_indep(mp, mp_x_part(q)); + mp_name_type(mp_x_part(q)) = mp_x_part_operation; + mp_link(mp_x_part(q)) = p; + mp_set_value_node(p, q); +} + +static mp_node mp_get_transform_node (MP mp) +{ + mp_transform_node p = (mp_transform_node) mp_allocate_node(mp, sizeof(mp_transform_node_data)); + mp_type(p) = mp_transform_node_type; + return (mp_node) p; +} + +static void mp_init_transform_node (MP mp, mp_node p) +{ + mp_node q; + mp_type(p) = mp_transform_type; + q = mp_get_transform_node(mp); + mp_yy_part(q) = mp_new_value_node(mp); + mp_new_indep(mp, mp_yy_part(q)); + mp_name_type(mp_yy_part(q)) = mp_yy_part_operation; + mp_link(mp_yy_part(q)) = p; + mp_yx_part(q) = mp_new_value_node(mp); + mp_new_indep(mp, mp_yx_part(q)); + mp_name_type(mp_yx_part(q)) = mp_yx_part_operation; + mp_link(mp_yx_part(q)) = p; + mp_xy_part(q) = mp_new_value_node(mp); + mp_new_indep(mp, mp_xy_part(q)); + mp_name_type(mp_xy_part(q)) = mp_xy_part_operation; + mp_link(mp_xy_part(q)) = p; + mp_xx_part(q) = mp_new_value_node(mp); + mp_new_indep(mp, mp_xx_part(q)); + mp_name_type(mp_xx_part(q)) = mp_xx_part_operation; + mp_link(mp_xx_part(q)) = p; + mp_ty_part(q) = mp_new_value_node(mp); + mp_new_indep(mp, mp_ty_part(q)); + mp_name_type(mp_ty_part(q)) = mp_y_part_operation; + mp_link(mp_ty_part(q)) = p; + mp_tx_part(q) = mp_new_value_node(mp); + mp_new_indep(mp, mp_tx_part(q)); + mp_name_type(mp_tx_part(q)) = mp_x_part_operation; + mp_link(mp_tx_part(q)) = p; + mp_set_value_node(p, q); +} + +static void mp_init_color_node (MP mp, mp_node p, int type) +{ + mp_node q = (mp_node) mp_allocate_node(mp, sizeof(mp_color_node_data)); + q->link = NULL; + mp_type(p) = type; + switch (type) { + case mp_color_type: + mp_type(q) = mp_color_node_type; + mp_red_part(q) = mp_new_value_node(mp); + mp_new_indep(mp, mp_red_part(q)); + mp_name_type(mp_red_part(q)) = mp_red_part_operation; + mp_link(mp_red_part(q)) = p; + mp_green_part(q) = mp_new_value_node(mp); + mp_new_indep(mp, mp_green_part(q)); + mp_name_type(mp_green_part(q)) = mp_green_part_operation; + mp_link(mp_green_part(q)) = p; + mp_blue_part(q) = mp_new_value_node(mp); + mp_new_indep(mp, mp_blue_part(q)); + mp_name_type(mp_blue_part(q)) = mp_blue_part_operation; + mp_link(mp_blue_part(q)) = p; + break; + case mp_cmykcolor_type: + mp_type(q) = mp_cmykcolor_node_type; + mp_cyan_part(q) = mp_new_value_node(mp); + mp_new_indep(mp, mp_cyan_part(q)); + mp_name_type(mp_cyan_part(q)) = mp_cyan_part_operation; + mp_link(mp_cyan_part(q)) = p; + mp_magenta_part(q) = mp_new_value_node(mp); + mp_new_indep(mp, mp_magenta_part(q)); + mp_name_type(mp_magenta_part(q)) = mp_magenta_part_operation; + mp_link(mp_magenta_part(q)) = p; + mp_yellow_part(q) = mp_new_value_node(mp); + mp_new_indep(mp, mp_yellow_part(q)); + mp_name_type(mp_yellow_part(q)) = mp_yellow_part_operation; + mp_link(mp_yellow_part(q)) = p; + mp_black_part(q) = mp_new_value_node(mp); + mp_new_indep(mp, mp_black_part(q)); + mp_name_type(mp_black_part(q)) = mp_black_part_operation; + mp_link(mp_black_part(q)) = p; + break; + } + mp_set_value_node(p, q); +} + +static mp_node mp_id_transform (MP mp) +{ + mp_node q; + mp_node p = mp_new_value_node(mp); + mp_name_type(p) = mp_capsule_operation; + mp_set_value_number(p, zero_t); + mp_init_transform_node(mp, p); + q = mp_get_value_node(p); + mp_type(mp_tx_part(q)) = mp_known_type; + mp_set_value_number(mp_tx_part(q), zero_t); + mp_type(mp_ty_part(q)) = mp_known_type; + mp_set_value_number(mp_ty_part(q), zero_t); + mp_type(mp_xy_part(q)) = mp_known_type; + mp_set_value_number(mp_xy_part(q), zero_t); + mp_type(mp_yx_part(q)) = mp_known_type; + mp_set_value_number(mp_yx_part(q), zero_t); + mp_type(mp_xx_part(q)) = mp_known_type; + mp_set_value_number(mp_xx_part(q), unity_t); + mp_type(mp_yy_part(q)) = mp_known_type; + mp_set_value_number(mp_yy_part(q), unity_t); + return p; +} + +static void mp_new_root (MP mp, mp_sym x) +{ + mp_node p = mp_new_value_node(mp); + mp_type(p) = mp_undefined_type; + mp_name_type(p) = mp_root_operation; + mp_set_value_sym(p, x); + set_equiv_node(x, p); +} + +void mp_print_variable_name (MP mp, mp_node p) +{ + mp_node q = NULL; + mp_node r = NULL; + while (mp_name_type(p) >= mp_x_part_operation) { + switch (mp_name_type(p)) { + case mp_x_part_operation : mp_print_str(mp, "xpart "); break; + case mp_y_part_operation : mp_print_str(mp, "ypart "); break; + case mp_xx_part_operation : mp_print_str(mp, "xxpart "); break; + case mp_xy_part_operation : mp_print_str(mp, "xypart "); break; + case mp_yx_part_operation : mp_print_str(mp, "yxpart "); break; + case mp_yy_part_operation : mp_print_str(mp, "yypart "); break; + case mp_red_part_operation : mp_print_str(mp, "redpart "); break; + case mp_green_part_operation : mp_print_str(mp, "greenpart "); break; + case mp_blue_part_operation : mp_print_str(mp, "bluepart "); break; + case mp_cyan_part_operation : mp_print_str(mp, "cyanpart "); break; + case mp_magenta_part_operation: mp_print_str(mp, "magentapart "); break; + case mp_yellow_part_operation : mp_print_str(mp, "yellowpart "); break; + case mp_black_part_operation : mp_print_str(mp, "blackpart "); break; + case mp_grey_part_operation : mp_print_str(mp, "greypart "); break; + case mp_capsule_operation : mp_print_fmt(mp, "%%CAPSULE%p", p); return; + default : break; + } + p = mp_link(p); + } + while (mp_name_type(p) > mp_saved_root_operation) { + if (mp_name_type(p) == mp_subscript_operation) { + r = mp_new_num_tok(mp, &(mp_subscript(p))); + do { + p = mp_link(p); + } while (mp_name_type(p) != mp_attribute_operation); + } else if (mp_name_type(p) == mp_structured_root_operation) { + p = mp_link(p); + goto FOUND; + } else if (mp_name_type(p) != mp_attribute_operation) { + mp_confusion(mp, "variable"); + } else { + r = mp_new_symbolic_node(mp); + mp_set_sym_sym(r, mp_get_hashloc(p)); + } + mp_set_link(r, q); + q = r; + FOUND: + p = mp_get_parent((mp_value_node) p); + } + r = mp_new_symbolic_node(mp); + mp_set_sym_sym(r, mp_get_value_sym(p)); + mp_link(r) = q; + if (mp_name_type(p) == mp_saved_root_operation) { + mp_print_str(mp, "(SAVED)"); + } + mp_show_token_list(mp, r, NULL); + mp_flush_token_list(mp, r); +} + +static int mp_interesting (MP mp, mp_node p) +{ + if (number_positive(internal_value(mp_tracing_capsules_internal))) { + return 1; + } else { + mp_name_type_type t = mp_name_type(p); + if (t >= mp_x_part_operation && t != mp_capsule_operation) { + mp_node tt = mp_get_value_node(mp_link(p)); + switch (t) { + case mp_x_part_operation: t = mp_name_type(mp_x_part (tt)); break; + case mp_y_part_operation: t = mp_name_type(mp_y_part (tt)); break; + case mp_xx_part_operation: t = mp_name_type(mp_xx_part (tt)); break; + case mp_xy_part_operation: t = mp_name_type(mp_xy_part (tt)); break; + case mp_yx_part_operation: t = mp_name_type(mp_yx_part (tt)); break; + case mp_yy_part_operation: t = mp_name_type(mp_yy_part (tt)); break; + case mp_red_part_operation: t = mp_name_type(mp_red_part (tt)); break; + case mp_green_part_operation: t = mp_name_type(mp_green_part (tt)); break; + case mp_blue_part_operation: t = mp_name_type(mp_blue_part (tt)); break; + case mp_cyan_part_operation: t = mp_name_type(mp_cyan_part (tt)); break; + case mp_magenta_part_operation: t = mp_name_type(mp_magenta_part(tt)); break; + case mp_yellow_part_operation: t = mp_name_type(mp_yellow_part (tt)); break; + case mp_black_part_operation: t = mp_name_type(mp_black_part (tt)); break; + case mp_grey_part_operation: t = mp_name_type(mp_grey_part (tt)); break; + default: break; + } + } + return (t != mp_capsule_operation); + } +} + +static mp_node mp_new_structure (MP mp, mp_node p) +{ + mp_node r = NULL; + switch (mp_name_type(p)) { + case mp_root_operation: + { + mp_sym q = mp_get_value_sym(p); + r = mp_new_value_node(mp); + set_equiv_node(q, r); + } + break; + case mp_subscript_operation: + { + mp_node q_new; + mp_node q = p; + do { + q = mp_link(q); + } while (mp_name_type(q) != mp_attribute_operation); + q = mp_get_parent((mp_value_node) q); + r = mp->temp_head; + mp_set_link(r, mp_get_subscr_head(q)); + do { + q_new = r; + r = mp_link(r); + } while (r != p); + r = (mp_node) mp_get_subscr_node(mp); + if (q_new == mp->temp_head) { + mp_set_subscr_head(q, r); + } else { + mp_set_link(q_new, r); + } + number_clone(mp_subscript(r), mp_subscript(p)); + } + break; + case mp_attribute_operation: + { + mp_value_node rr; + mp_node q = mp_get_parent((mp_value_node) p); + r = mp_get_attribute_head(q); + do { + q = r; + r = mp_link(r); + } while (r != p); + rr = mp_get_attribute_node(mp); + r = (mp_node) rr; + mp_set_link(q, rr); + mp_set_hashloc(rr, mp_get_hashloc(p)); + mp_set_parent(rr, mp_get_parent((mp_value_node) p)); + if (mp_get_hashloc(p) == mp_collective_subscript) { + q = mp->temp_head; + mp_set_link(q, mp_get_subscr_head(mp_get_parent((mp_value_node) p))); + while (mp_link(q) != p) { + q = mp_link(q); + } + if (q == mp->temp_head) { + mp_set_subscr_head(mp_get_parent((mp_value_node) p), (mp_node) rr); + } else { + mp_set_link(q, rr); + } + } + } + break; + default: + mp_confusion(mp, "structure"); + break; + } + if (r) { + mp_value_node q; + mp_set_link(r, mp_link(p)); + mp_set_value_sym(r, mp_get_value_sym(p)); + mp_type(r) = mp_structured_type; + mp_name_type(r) = mp_name_type(p); + mp_set_attribute_head(r, p); + mp_name_type(p) = mp_structured_root_operation; + q = mp_get_attribute_node(mp); + mp_set_link(p, q); + mp_set_subscr_head(r, (mp_node) q); + mp_set_parent(q, r); + mp_type(q) = mp_undefined_type; + mp_name_type(q) = mp_attribute_operation; + mp_set_link(q, mp->end_attr); + mp_set_hashloc(q, mp_collective_subscript); + } + return r; +} + +static mp_node mp_find_variable (MP mp, mp_node t) +{ + mp_sym p_sym = mp_get_sym_sym(t); + + if (eq_type(p_sym) != mp_tag_command) { + return NULL; + } else { + mp_node p, q, r, s; + mp_node pp, qq, rr, ss; + t = mp_link(t); + if (equiv_node(p_sym) == NULL) { + mp_new_root (mp, p_sym); + } + p = equiv_node(p_sym); + pp = p; + while (t != NULL) { + if (mp_type(pp) != mp_structured_type) { + if (mp_type(pp) > mp_structured_type) { + return NULL; + } else { + ss = mp_new_structure(mp, pp); + if (p == pp) { + p = ss; + } + pp = ss; + } + } + if (mp_type(p) != mp_structured_type) { + p = mp_new_structure(mp, p); + } + if (mp_type(t) != mp_symbol_node_type) { + mp_number nn, save_subscript; + new_number_clone(nn, mp_get_value_number(t)); + pp = mp_link(mp_get_attribute_head(pp)); + q = mp_link(mp_get_attribute_head(p)); + new_number_clone(save_subscript, mp_subscript(q)); + set_number_to_inf(mp_subscript(q)); + s = mp->temp_head; + mp_set_link(s, mp_get_subscr_head(p)); + do { + r = s; + s = mp_link(s); + } while (number_greater(nn, mp_subscript(s))); + if (number_equal(nn, mp_subscript(s))) { + p = s; + } else { + mp_value_node p1 = mp_get_subscr_node(mp); + if (r == mp->temp_head) { + mp_set_subscr_head(p, (mp_node) p1); + } else { + mp_set_link(r, p1); + } + mp_set_link(p1, s); + number_clone(mp_subscript(p1), nn); + mp_name_type(p1) = mp_subscript_operation; + mp_type(p1) = mp_undefined_type; + p = (mp_node) p1; + } + number_clone(mp_subscript(q), save_subscript); + free_number(save_subscript); + free_number(nn); + } else { + mp_sym nn1 = mp_get_sym_sym(t); + ss = mp_get_attribute_head(pp); + do { + rr = ss; + ss = mp_link(ss); + } while (nn1 > mp_get_hashloc(ss)); + if (nn1 < mp_get_hashloc(ss)) { + qq = (mp_node) mp_get_attribute_node(mp); + mp_set_link(rr, qq); + mp_set_link(qq, ss); + mp_set_hashloc(qq, nn1); + mp_name_type(qq) = mp_attribute_operation; + mp_type(qq) = mp_undefined_type; + mp_set_parent((mp_value_node) qq, pp); + ss = qq; + } + if (p == pp) { + p = ss; + pp = ss; + } else { + pp = ss; + s = mp_get_attribute_head(p); + do { + r = s; + s = mp_link(s); + } while (nn1 > mp_get_hashloc(s)); + if (nn1 == mp_get_hashloc(s)) { + p = s; + } else { + q = (mp_node) mp_get_attribute_node(mp); + mp_set_link(r, q); + mp_set_link(q, s); + mp_set_hashloc(q, nn1); + mp_name_type(q) = mp_attribute_operation; + mp_type(q) = mp_undefined_type; + mp_set_parent((mp_value_node) q, p); + p = q; + } + } + } + t = mp_link(t); + } + if (mp_type(pp) >= mp_structured_type) { + if (mp_type(pp) == mp_structured_type) { + pp = mp_get_attribute_head(pp); + } else { + return NULL; + } + } + if (mp_type(p) == mp_structured_type) { + p = mp_get_attribute_head(p); + } + if (mp_type(p) == mp_undefined_type) { + if (mp_type(pp) == mp_undefined_type) { + mp_type(pp) = mp_numeric_type; + mp_set_value_number(pp, zero_t); + } + mp_type(p) = mp_type(pp); + mp_set_value_number(p, zero_t); + } + return p; + } +} + +static void mp_flush_variable (MP mp, mp_node p, mp_node t, int discard_suffixes) +{ + while (t != NULL) { + if (mp_type(p) != mp_structured_type) { + return; + } else { + mp_sym n = mp_get_sym_sym(t); + t = mp_link(t); + if (n == mp_collective_subscript) { + mp_node q = mp_get_subscr_head(p); + mp_node r = NULL; + while (mp_name_type(q) == mp_subscript_operation) { + mp_flush_variable(mp, q, t, discard_suffixes); + if (t != NULL) { + r = q; + } else if (mp_type(q) == mp_structured_type) { + r = q; + } else { + if (r == NULL) { + mp_set_subscr_head(p, mp_link(q)); + } else { + mp_set_link(r, mp_link(q)); + } + mp_free_value_node(mp, q); + } + q = r == NULL ? mp_get_subscr_head(p) : mp_link(r); + } + } + p = mp_get_attribute_head(p); + do { + p = mp_link(p); + } while (mp_get_hashloc(p) < n); + if (mp_get_hashloc(p) != n) { + return; + } + } + } + if (discard_suffixes) { + mp_flush_below_variable(mp, p); + } else { + if (mp_type(p) == mp_structured_type) { + p = mp_get_attribute_head(p); + } + mp_recycle_value(mp, p); + } +} + +void mp_flush_below_variable (MP mp, mp_node p) +{ + if (mp_type(p) != mp_structured_type) { + mp_recycle_value(mp, p); + } else { + mp_node r; + mp_node q = mp_get_subscr_head(p); + while (mp_name_type(q) == mp_subscript_operation) { + mp_flush_below_variable(mp, q); + r = q; + q = mp_link(q); + mp_free_value_node(mp, r); + } + r = mp_get_attribute_head(p); + q = mp_link(r); + mp_recycle_value(mp, r); + mp_free_value_node(mp, r); + do { + mp_flush_below_variable(mp, q); + r = q; + q = mp_link(q); + mp_free_value_node(mp, r); + } while (q != mp->end_attr); + mp_type(p) = mp_undefined_type; + } +} + +static int mp_und_type (MP mp, mp_node p) +{ + (void) mp; + switch (mp_type(p)) { + case mp_vacuous_type: + return mp_undefined_type; + case mp_boolean_type: + case mp_unknown_boolean_type: + return mp_unknown_boolean_type; + case mp_string_type: + case mp_unknown_string_type: + return mp_unknown_string_type; + case mp_pen_type: + case mp_unknown_pen_type: + return mp_unknown_pen_type; + case mp_nep_type: + case mp_unknown_nep_type: + return mp_unknown_nep_type; + case mp_path_type: + case mp_unknown_path_type: + return mp_unknown_path_type; + case mp_picture_type: + case mp_unknown_picture_type: + return mp_unknown_picture_type; + case mp_transform_type: + case mp_color_type: + case mp_cmykcolor_type: + case mp_pair_type: + case mp_numeric_type: + return mp_type(p); + case mp_known_type: + case mp_dependent_type: + case mp_proto_dependent_type: + case mp_independent_type: + return mp_numeric_type; + default: + return 0; + } +} + +static void mp_clear_symbol (MP mp, mp_sym p, int saving) +{ + mp_node q = equiv_node(p); + if (eq_property(p) > 0) { + mp_check_overload(mp, p); + } + switch (eq_type(p)) { + case mp_defined_macro_command: + case mp_primary_def_command: + case mp_secondary_def_command: + case mp_tertiary_def_command: + if (!saving) { + mp_delete_mac_ref(mp, q); + } + break; + case mp_tag_command: + if (q != NULL) { + if (saving) { + mp_name_type(q) = mp_saved_root_operation; + } else { + mp_flush_below_variable(mp, q); + mp_free_value_node(mp, q); + } + } + break; + default: + break; + } + set_equiv(p, mp->frozen_undefined->v.data.indep.serial); + set_eq_type(p, mp->frozen_undefined->type); +} + +static void mp_save_boundary (MP mp) +{ + mp_save_data *p = mp_memory_allocate(sizeof(mp_save_data)); + p->type = 0; + p->link = mp->save_ptr; + mp->save_ptr = p; +} + +static void mp_save_variable (MP mp, mp_sym q) +{ + if (mp->save_ptr != NULL) { + mp_save_data *p = mp_memory_allocate(sizeof(mp_save_data)); + p->type = mp_normal_operation; + p->link = mp->save_ptr; + p->value.v.data.indep.scale = eq_type(q); + p->value.v.data.indep.serial = equiv(q); + p->value.v.data.node = equiv_node(q); + p->value.v.data.p = (mp_knot)q; + mp->save_ptr = p; + } + mp_clear_symbol(mp, q, (mp->save_ptr != NULL)); +} + +static void mp_unsave_variable (MP mp) +{ + mp_sym q = (mp_sym)mp->save_ptr->value.v.data.p; + if (number_positive(internal_value(mp_tracing_restores_internal))) { + mp_begin_diagnostic(mp); + mp_print_nl(mp, "{restoring "); + mp_print_mp_str(mp,text(q)); + mp_print_chr(mp, '}'); + mp_end_diagnostic(mp, 0); + } + mp_clear_symbol(mp, q, 0); + set_eq_type(q, mp->save_ptr->value.v.data.indep.scale); + set_equiv(q,mp->save_ptr->value.v.data.indep.serial); + q->v.data.node = mp->save_ptr->value.v.data.node; + + if (eq_type(q) == mp_tag_command) { + mp_node pp = q->v.data.node; + if (pp != NULL) { + mp_name_type(pp) = mp_root_operation; + } + } +} + +static void mp_save_internal (MP mp, int q) +{ + if (mp->save_ptr != NULL) { + mp_save_data *p = mp_memory_allocate(sizeof(mp_save_data)); + p->type = mp_internal_operation; + p->link = mp->save_ptr; + p->value = mp->internal[q]; + p->value.v.data.indep.serial = q; + if (internal_run(q) == 1) { + mp->run_internal(mp, 1, q, internal_type(q), internal_name(q)); + } + new_number_clone(p->value.v.data.n, mp->internal[q].v.data.n); + mp->save_ptr = p; + } +} + +static void mp_unsave_internal (MP mp) +{ + int q = mp->save_ptr->value.v.data.indep.serial; + mp_internal saved = mp->save_ptr->value; + if (number_positive(internal_value(mp_tracing_restores_internal))) { + mp_begin_diagnostic(mp); + mp_print_nl(mp, "{restoring "); + mp_print_str(mp, internal_name(q)); + mp_print_chr(mp, '='); + switch (internal_type(q)) { + case mp_known_type: + case mp_numeric_type: + print_number(saved.v.data.n); + break; + case mp_boolean_type: + mp_print_str(mp, number_to_boolean(saved.v.data.n) == mp_true_operation ? "true" : "false"); + break; + case mp_string_type: + { + char *s = mp_str(mp, saved.v.data.str); + mp_print_str(mp, s); + break; + } + default: + mp_confusion(mp, "internal restore"); + break; + } + mp_print_chr(mp, '}'); + mp_end_diagnostic(mp, 0); + } + free_number(mp->internal[q].v.data.n); + if (internal_run(q) == 1) { + mp->run_internal(mp, 2, q, internal_type(q), internal_name(q)); + } + mp->internal[q] = saved; +} + +static void mp_unsave (MP mp) +{ + mp_save_data *p; + while (mp->save_ptr->type != 0) { + if (mp->save_ptr->type == mp_internal_operation) { + mp_unsave_internal(mp); + } else { + mp_unsave_variable(mp); + } + p = mp->save_ptr->link; + mp_memory_free(mp->save_ptr); + mp->save_ptr = p; + } + p = mp->save_ptr->link; + mp_memory_free(mp->save_ptr); + mp->save_ptr = p; +} + +void mp_pr_path (MP mp, mp_knot h) +{ + mp_knot p = h; + do { + mp_knot q = mp_next_knot(p); + if ((p == NULL) || (q == NULL)) { + mp_print_nl(mp, "???"); + return; + } else { + mp_print_two(mp, &(p->x_coord), &(p->y_coord)); + switch (mp_knotstate(p)) { + case mp_begin_knot: + mp_print_str(mp, " {begin}"); + break; + case mp_end_knot: + mp_print_str(mp, " {end}"); + break; + } + switch (mp_right_type(p)) { + case mp_endpoint_knot: + { + if (mp_left_type(p) == mp_open_knot) { + mp_print_str(mp, " {open?}"); + } + if ((mp_left_type(q) != mp_endpoint_knot) || (q != h)) { + q = NULL; + } + goto DONE1; + } + break; + case mp_explicit_knot: + { + mp_print_str(mp, " .. controls "); + mp_print_two(mp, &(p->right_x), &(p->right_y)); + mp_print_str(mp, " and "); + if (mp_left_type(q) != mp_explicit_knot) { + mp_print_str(mp, "??"); + } else { + mp_print_two(mp, &(q->left_x), &(q->left_y)); + } + goto DONE1; + } + break; + case mp_open_knot: + { + if ((mp_left_type(p) != mp_explicit_knot) && (mp_left_type(p) != mp_open_knot)) { + mp_print_str(mp, " {open?}"); + } + } + break; + case mp_curl_knot: + case mp_given_knot: + { + if (mp_left_type(p) == mp_open_knot) { + mp_print_str(mp, " ??"); + } + if (mp_right_type(p) == mp_curl_knot) { + mp_print_str(mp, " {curl"); + print_number(p->right_curl); + } else { + mp_number n_sin, n_cos; + new_fraction(n_sin); + new_fraction(n_cos); + n_sin_cos(p->right_given, n_cos, n_sin); + mp_print_str(mp, " {"); + print_number(n_cos); + mp_print_chr(mp, ','); + print_number(n_sin); + free_number(n_sin); + free_number(n_cos); + } + mp_print_str(mp, "} "); + } + break; + default: + { + mp_print_str(mp, "???"); + } + break; + } + if (mp_left_type(q) <= mp_explicit_knot) { + mp_print_str(mp, " .. control ?"); + } else if ((! number_equal(p->right_tension, unity_t)) || (! number_equal(q->left_tension, unity_t))) { + mp_number v1; + mp_print_str(mp, " .. tension"); + if (number_negative(p->right_tension)) { + mp_print_str(mp, " atleast"); + } + new_number_abs(v1, p->right_tension); + print_number(v1); + if (! number_equal(p->right_tension, q->left_tension)) { + mp_print_str(mp, " and"); + if (number_negative(q->left_tension)) { + mp_print_str(mp, " atleast"); + } + number_abs_clone(v1, p->left_tension); + print_number(v1); + } + free_number(v1); + } + + DONE1: + p = q; + if (p && ((p != h) || (mp_left_type(h) != mp_endpoint_knot))) { + mp_number n_sin, n_cos; + new_fraction(n_sin); + new_fraction(n_cos); + mp_print_nl(mp, " .. "); + if (mp_left_type(p) == mp_given_knot) { + n_sin_cos(p->left_given, n_cos, n_sin); + mp_print_str(mp, "{"); + print_number(n_cos); + mp_print_chr(mp, ','); + print_number(n_sin); + mp_print_chr(mp, '}'); + } else if (mp_left_type(p) == mp_curl_knot) { + mp_print_str(mp, "{curl "); + print_number(p->left_curl); + mp_print_chr(mp, '}'); + } + free_number(n_sin); + free_number(n_cos); + } + } + } while (p != h); + if (mp_left_type(h) != mp_endpoint_knot) { + mp_print_str(mp, " cycle"); + } +} + +void mp_print_path (MP mp, mp_knot h, const char *s, int nuline) +{ + mp_print_diagnostic(mp, "Path", s, nuline); + mp_print_ln(mp); + mp_pr_path(mp, h); + mp_end_diagnostic(mp, 1); +} + +static mp_knot mp_new_knot (MP mp) +{ + mp_knot q; + if (mp->knot_nodes) { + q = mp->knot_nodes; + mp->knot_nodes = q->next; + mp->num_knot_nodes--; + } else { + q = mp_memory_clear_allocate(sizeof(struct mp_knot_data)); + } + new_number(q->x_coord); + new_number(q->y_coord); + new_number(q->left_x); + new_number(q->left_y); + new_number(q->right_x); + new_number(q->right_y); + return q; +} + +static mp_gr_knot mp_gr_new_knot (MP mp) +{ + mp_gr_knot q = mp_memory_allocate(sizeof(struct mp_gr_knot_data)); + (void) mp; + return q; +} + +static mp_knot mp_copy_knot (MP mp, mp_knot p) +{ + mp_knot q; + if (mp->knot_nodes) { + q = mp->knot_nodes; + mp->knot_nodes = q->next; + mp->num_knot_nodes--; + } else { + q = mp_memory_allocate(sizeof(struct mp_knot_data)); + } + memcpy(q, p, sizeof(struct mp_knot_data)); + if (mp->math_mode > mp_math_double_mode) { + new_number_clone(q->x_coord, p->x_coord); + new_number_clone(q->y_coord, p->y_coord); + new_number_clone(q->left_x, p->left_x); + new_number_clone(q->left_y, p->left_y); + new_number_clone(q->right_x, p->right_x); + new_number_clone(q->right_y, p->right_y); + } + mp_prev_knot(q) = NULL; + mp_next_knot(q) = NULL; + return q; +} + +static mp_gr_knot mp_export_knot (MP mp, mp_knot p) +{ + mp_gr_knot q = mp_gr_new_knot(mp); + q->x_coord = number_to_double(p->x_coord); + q->y_coord = number_to_double(p->y_coord); + q->left_x = number_to_double(p->left_x); + q->left_y = number_to_double(p->left_y); + q->right_x = number_to_double(p->right_x); + q->right_y = number_to_double(p->right_y); + q->left_type = p->left_type; + q->right_type = p->right_type; + q->info = p->info; + q->originator = p->originator; + q->state = p->state; + q->prev = NULL; + q->next = NULL; + return q; +} + +static mp_knot mp_copy_path (MP mp, mp_knot p) +{ + if (p == NULL) { + return NULL; + } else { + mp_knot q = mp_copy_knot(mp, p); + mp_knot qq = q; + mp_knot pp = mp_next_knot(p); + while (pp != p) { + mp_knot k = mp_copy_knot(mp, pp); + mp_next_knot(qq) = k; + mp_prev_knot(k) = qq; + qq = mp_next_knot(qq); + pp = mp_next_knot(pp); + } + mp_next_knot(qq) = q; + mp_prev_knot(q) = qq; + return q; + } +} + +static mp_gr_knot mp_export_path (MP mp, mp_knot p) +{ + if (p == NULL) { + return NULL; + } else { + mp_gr_knot q = mp_export_knot(mp, p); + mp_gr_knot qq = q; + mp_knot pp = mp_next_knot(p); + while (pp != p) { + mp_gr_knot k = mp_export_knot(mp, pp); + mp_prev_knot(k) = qq; + mp_next_knot(qq) = k; + qq = k; + pp = mp_next_knot(pp); + } + mp_prev_knot(q) = qq; + mp_next_knot(qq) = q; + return q; + } +} + +static mp_gr_knot mp_export_knot_list (MP mp, mp_knot p) +{ + if (p == NULL) { + return NULL; + } else { + mp_gr_knot q = mp_export_path(mp, p); + return q; + } +} + +static mp_knot mp_htap_ypoc (MP mp, mp_knot p) +{ + mp_knot q = mp_new_knot(mp); + mp_knot qq = q; + mp_knot pp = p; + while (1) { + mp_right_type(qq) = mp_left_type(pp); + mp_left_type(qq) = mp_right_type(pp); + number_clone(qq->x_coord, pp->x_coord); + number_clone(qq->y_coord, pp->y_coord); + number_clone(qq->right_x, pp->left_x); + number_clone(qq->right_y, pp->left_y); + number_clone(qq->left_x, pp->right_x); + number_clone(qq->left_y, pp->right_y); + mp_originator(qq) = mp_originator(pp); + mp_knotstate(qq) = mp_knotstate(pp); + if (mp_next_knot(pp) == p) { + mp_prev_knot(qq) = q; + mp_next_knot(q) = qq; + mp->path_tail = pp; + return q; + } else { + mp_knot rr = mp_new_knot(mp); + mp_prev_knot(qq) = rr; + mp_next_knot(rr) = qq; + qq = rr; + pp = mp_next_knot(pp); + } + } +} + +static void mp_free_knot (MP mp, mp_knot q) +{ + if (mp->math_mode > mp_math_double_mode) { + free_number(q->x_coord); + free_number(q->y_coord); + free_number(q->left_x); + free_number(q->left_y); + free_number(q->right_x); + free_number(q->right_y); + } + mp_memory_free(q); +} + +static void mp_toss_knot (MP mp, mp_knot q) +{ + if (mp->num_knot_nodes < mp->max_knot_nodes) { + mp_next_knot(q) = mp->knot_nodes; + mp->knot_nodes = q; + mp->num_knot_nodes++; + if (mp->math_mode > mp_math_double_mode) { + free_number(q->x_coord); + free_number(q->y_coord); + free_number(q->left_x); + free_number(q->left_y); + free_number(q->right_x); + free_number(q->right_y); + } + } else { + mp_free_knot(mp, q); + } +} + +static void mp_toss_knot_list (MP mp, mp_knot p) +{ + if (p == NULL) { + return; + } else { + mp_knot q = p; + do { + mp_knot r = mp_next_knot(q); + mp_toss_knot(mp, q); + q = r; + } while (q != p); + } +} + +void mp_make_choices (MP mp, mp_knot knots) +{ + mp_knot h; + mp_knot p, q; + int k, n; + mp_knot s, t; + + check_arith(); + if (number_positive(internal_value(mp_tracing_choices_internal))) { + mp_print_path(mp, knots, ", before choices", 1); + } + p = knots; + do { + q = mp_next_knot(p); + if (number_equal(p->x_coord, q->x_coord) && number_equal(p->y_coord, q->y_coord) && mp_right_type(p) > mp_explicit_knot) { + mp_right_type(p) = mp_explicit_knot; + if (mp_left_type(p) == mp_open_knot) { + mp_left_type(p) = mp_curl_knot; + set_number_to_unity(p->left_curl); + } + mp_left_type(q) = mp_explicit_knot; + if (mp_right_type(q) == mp_open_knot) { + mp_right_type(q) = mp_curl_knot; + set_number_to_unity(q->right_curl); + } + number_clone(p->right_x, p->x_coord); + number_clone(q->left_x, p->x_coord); + number_clone(p->right_y, p->y_coord); + number_clone(q->left_y, p->y_coord); + } + p = q; + } while (p != knots); + + h = knots; + while (1) { + if (mp_left_type(h) != mp_open_knot) { + break; + } else if (mp_right_type(h) != mp_open_knot) { + break; + } else { + h = mp_next_knot(h); + if (h == knots) { + mp_left_type(h) = mp_end_cycle_knot; + break; + } + } + } + p = h; + do { + q = mp_next_knot(p); + if (mp_right_type(p) >= mp_given_knot) { + while ((mp_left_type(q) == mp_open_knot) && (mp_right_type(q) == mp_open_knot)) { + q = mp_next_knot(q); + } + mp_number sine, cosine; + mp_number arg1, arg2, r1, r2; + mp_number delx, dely; + new_fraction(sine); + new_fraction(cosine); + new_number(arg1); + new_number(arg2); + new_fraction(r1); + new_fraction(r2); + new_number(delx); + new_number(dely); + + { + RESTART: + k = 0; + s = p; + n = mp->path_size; + do { + t = mp_next_knot(s); + set_number_from_subtraction(mp->delta_x[k], t->x_coord, s->x_coord); + set_number_from_subtraction(mp->delta_y[k], t->y_coord, s->y_coord); + pyth_add(mp->delta[k], mp->delta_x[k], mp->delta_y[k]); + if (k > 0) { + make_fraction(r1, mp->delta_y[k - 1], mp->delta[k - 1]); + number_clone(sine, r1); + make_fraction(r2, mp->delta_x[k - 1], mp->delta[k - 1]); + number_clone(cosine, r2); + take_fraction(r1, mp->delta_x[k], cosine); + take_fraction(r2, mp->delta_y[k], sine); + set_number_from_addition(arg1, r1, r2); + take_fraction(r1, mp->delta_y[k], cosine); + take_fraction(r2, mp->delta_x[k], sine); + set_number_from_subtraction(arg2, r1, r2); + n_arg(mp->psi[k], arg1, arg2 ); + } + ++k; + s = t; + if (k == mp->path_size) { + mp_reallocate_paths(mp, mp->path_size + (mp->path_size / 4)); + goto RESTART; + } else if (s == q) { + n = k; + } + } while (! ((k >= n) && (mp_left_type(s) != mp_end_cycle_knot))); + if (k == n) { + set_number_to_zero(mp->psi[k]); + } else { + number_clone(mp->psi[k], mp->psi[1]); + } + } + { + if (mp_left_type(q) == mp_open_knot) { + set_number_from_subtraction(delx, q->right_x, q->x_coord); + set_number_from_subtraction(dely, q->right_y, q->y_coord); + if (number_zero(delx) && number_zero(dely)) { + mp_left_type(q) = mp_curl_knot; + set_number_to_unity(q->left_curl); + } else { + mp_left_type(q) = mp_given_knot; + n_arg(q->left_given, delx, dely); + } + } + if ((mp_right_type(p) == mp_open_knot) && (mp_left_type(p) == mp_explicit_knot)) { + set_number_from_subtraction(delx, p->x_coord, p->left_x); + set_number_from_subtraction(dely, p->y_coord, p->left_y); + if (number_zero(delx) && number_zero(dely)) { + mp_right_type(p) = mp_curl_knot; + set_number_to_unity(p->right_curl); + } else { + mp_right_type(p) = mp_given_knot; + n_arg(p->right_given, delx, dely); + } + } + } + free_number(sine); + free_number(cosine); + free_number(arg1); + free_number(arg2); + free_number(r1); + free_number(r2); + free_number(delx); + free_number(dely); + + mp_solve_choices(mp, p, q, n); + } else if (mp_right_type(p) == mp_endpoint_knot) { + number_clone(p->right_x, p->x_coord); + number_clone(p->right_y, p->y_coord); + number_clone(q->left_x, q->x_coord); + number_clone(q->left_y, q->y_coord); + } + p = q; + } while (p != h); + if (number_positive(internal_value(mp_tracing_choices_internal))) { + mp_print_path(mp, knots, ", after choices", 1); + } + if (mp->arith_error) { + mp_back_error( + mp, + "Some number got too big", + "The path that I just computed is out of range. So it will probably look funny.\n" + "Proceed, for a laugh." + ); + mp_get_x_next(mp); + mp->arith_error = 0; + } +} + +void mp_reallocate_paths (MP mp, int l) +{ + mp->delta_x = mp_memory_reallocate(mp->delta_x, (size_t) (l + 1) * sizeof(mp_number)); + mp->delta_y = mp_memory_reallocate(mp->delta_y, (size_t) (l + 1) * sizeof(mp_number)); + mp->delta = mp_memory_reallocate(mp->delta, (size_t) (l + 1) * sizeof(mp_number)); + mp->psi = mp_memory_reallocate(mp->psi, (size_t) (l + 1) * sizeof(mp_number)); + mp->theta = mp_memory_reallocate(mp->theta, (size_t) (l + 1) * sizeof(mp_number)); + mp->uu = mp_memory_reallocate(mp->uu, (size_t) (l + 1) * sizeof(mp_number)); + mp->vv = mp_memory_reallocate(mp->vv, (size_t) (l + 1) * sizeof(mp_number)); + mp->ww = mp_memory_reallocate(mp->ww, (size_t) (l + 1) * sizeof(mp_number)); + for (int k = mp->path_size; k<l; k++) { + new_number(mp->delta_x[k]); + new_number(mp->delta_y[k]); + new_number(mp->delta[k]); + new_angle(mp->psi[k]); + new_angle(mp->theta[k]); + new_fraction(mp->uu[k]); + new_angle(mp->vv[k]); + new_fraction(mp->ww[k]); + } + mp->path_size = l; +} + +void mp_solve_choices (MP mp, mp_knot p, mp_knot q, int n) +{ + int k = 0; + mp_knot r = 0; + mp_knot s = p; + mp_number ff; + new_fraction(ff); + while (1) { + mp_knot t = mp_next_knot(s); + if (k == 0) { + switch (mp_right_type(s)) { + case mp_given_knot: + if (mp_left_type(t) == mp_given_knot) { + { + mp_number arg1; + mp_number narg; + new_angle(narg); + n_arg(narg, mp->delta_x[0], mp->delta_y[0]); + new_number(arg1); + set_number_from_subtraction(arg1, p->right_given, narg); + n_sin_cos(arg1, mp->ct, mp->st); + set_number_from_subtraction(arg1, q->left_given, narg); + n_sin_cos(arg1, mp->cf, mp->sf); + number_negate(mp->sf); + mp_set_controls (mp, p, q, 0); + free_number(narg); + free_number(arg1); + free_number(ff); + return; + } + } else { + { + mp_number narg; + new_angle(narg); + n_arg(narg, mp->delta_x[0], mp->delta_y[0]); + set_number_from_subtraction(mp->vv[0], s->right_given, narg); + free_number(narg); + mp_reduce_angle(mp, &mp->vv[0]); + set_number_to_zero(mp->uu[0]); + set_number_to_zero(mp->ww[0]); + } + } + break; + case mp_curl_knot: + if (mp_left_type(t) == mp_curl_knot) { + { + mp_number lt, rt; + mp_right_type(p) = mp_explicit_knot; + mp_left_type(q) = mp_explicit_knot; + new_number_abs(lt, q->left_tension); + new_number_abs(rt, p->right_tension); + if (number_unity(rt)) { + mp_number arg2; + new_number(arg2); + if (number_nonnegative(mp->delta_x[0])) { + set_number_from_addition(arg2, mp->delta_x[0], epsilon_t); + } else { + set_number_from_subtraction(arg2, mp->delta_x[0], epsilon_t); + } + number_int_div(arg2, 3); + set_number_from_addition(p->right_x, p->x_coord, arg2); + if (number_nonnegative(mp->delta_y[0])) { + set_number_from_addition(arg2, mp->delta_y[0], epsilon_t); + } else { + set_number_from_subtraction(arg2, mp->delta_y[0], epsilon_t); + } + number_int_div(arg2, 3); + set_number_from_addition(p->right_y, p->y_coord, arg2); + free_number(arg2); + } else { + mp_number arg2, r1; + new_fraction(r1); + new_number_clone(arg2, rt); + number_multiply_int(arg2, 3); + make_fraction(ff, unity_t, arg2); + free_number(arg2); + take_fraction(r1, mp->delta_x[0], ff); + set_number_from_addition(p->right_x, p->x_coord, r1); + take_fraction(r1, mp->delta_y[0], ff); + set_number_from_addition(p->right_y, p->y_coord, r1); + } + if (number_unity(lt)) { + mp_number arg2; + new_number(arg2); + if (number_nonnegative(mp->delta_x[0])) { + set_number_from_addition(arg2, mp->delta_x[0], epsilon_t); + } else { + set_number_from_subtraction(arg2, mp->delta_x[0], epsilon_t); + } + number_int_div(arg2, 3); + set_number_from_subtraction(q->left_x, q->x_coord, arg2); + if (number_nonnegative(mp->delta_y[0])) { + set_number_from_addition(arg2, mp->delta_y[0], epsilon_t); + } else { + set_number_from_subtraction(arg2, mp->delta_y[0], epsilon_t); + } + number_int_div(arg2, 3); + set_number_from_subtraction(q->left_y, q->y_coord, arg2); + free_number(arg2); + } else { + mp_number arg2, r1; + new_fraction(r1); + new_number_clone(arg2, lt); + number_multiply_int(arg2, 3); + make_fraction(ff, unity_t, arg2); + free_number(arg2); + take_fraction(r1, mp->delta_x[0], ff); + set_number_from_subtraction(q->left_x, q->x_coord, r1); + take_fraction(r1, mp->delta_y[0], ff); + set_number_from_subtraction(q->left_y, q->y_coord, r1); + free_number(r1); + } + free_number(ff); + free_number(lt); + free_number(rt); + return; + } + } else { + { + mp_number lt, rt, cc; + new_number_clone(cc, s->right_curl); + new_number_abs(lt, t->left_tension); + new_number_abs(rt, s->right_tension); + if (number_unity(rt) && number_unity(lt)) { + mp_number arg1, arg2; + new_number_clone(arg1, cc); + new_number_clone(arg2, cc); + number_double(arg1); + number_add(arg1, unity_t); + number_add(arg2, two_t); + make_fraction(mp->uu[0], arg1, arg2); + free_number(arg1); + free_number(arg2); + } else { + mp_curl_ratio(mp, &mp->uu[0], &cc, &rt, <); + } + take_fraction(mp->vv[0], mp->psi[1], mp->uu[0]); + number_negate(mp->vv[0]); + set_number_to_zero(mp->ww[0]); + free_number(rt); + free_number(lt); + free_number(cc); + } + } + break; + case mp_open_knot: + set_number_to_zero(mp->uu[0]); + set_number_to_zero(mp->vv[0]); + number_clone(mp->ww[0], fraction_one_t); + break; + } + } else { + switch (mp_left_type(s)) { + case mp_end_cycle_knot: + case mp_open_knot: + { + mp_number aa, bb, cc, acc; + mp_number dd, ee; + new_fraction(aa); + new_fraction(bb); + new_fraction(cc); + new_fraction(acc); + new_number(dd); + new_number(ee); + { + mp_number absval; + new_number_abs(absval, r->right_tension); + if (number_equal(absval, unity_t)) { + number_clone(aa, fraction_half_t); + number_clone(dd, mp->delta[k]); + number_double(dd); + } else { + mp_number arg1, arg2, ret; + new_number(arg1); + new_number_abs(arg2, r->right_tension); + number_multiply_int(arg2, 3); + number_subtract(arg2, unity_t); + make_fraction(aa, unity_t, arg2); + number_abs_clone(arg2, r->right_tension); + new_fraction(ret); + make_fraction(ret, unity_t, arg2); + set_number_from_subtraction(arg1, fraction_three_t, ret); + take_fraction(arg2, mp->delta[k], arg1); + number_clone(dd, arg2); + free_number(ret); + free_number(arg1); + free_number(arg2); + } + number_abs_clone(absval, t->left_tension); + if (number_equal(absval, unity_t)) { + number_clone(bb, fraction_half_t); + number_clone(ee, mp->delta[k - 1]); + number_double(ee); + } else { + mp_number arg1, arg2, ret; + new_number(arg1); + new_number_abs(arg2, t->left_tension); + number_multiply_int(arg2, 3); + number_subtract(arg2, unity_t); + make_fraction(bb, unity_t, arg2); + number_abs_clone(arg2, t->left_tension); + new_fraction(ret); + make_fraction(ret, unity_t, arg2); + set_number_from_subtraction(arg1, fraction_three_t, ret); + take_fraction(ee, mp->delta[k - 1], arg1); + free_number(ret); + free_number(arg1); + free_number(arg2); + } + free_number(absval); + } + { + mp_number r1; + new_number(r1); + take_fraction(r1, mp->uu[k - 1], aa); + set_number_from_subtraction(cc, fraction_one_t, r1); + free_number(r1); + } + { + mp_number rt, lt; + mp_number arg2; + new_number_clone(arg2, dd); + take_fraction(dd, arg2, cc); + new_number_abs(lt, s->left_tension); + new_number_abs(rt, s->right_tension); + if (! number_equal(lt, rt)) { + mp_number r1; + new_number(r1); + if (number_less(lt, rt)) { + make_fraction(r1, lt, rt); + take_fraction(ff, r1, r1); + number_clone(r1, dd); + take_fraction(dd, r1, ff); + } else { + make_fraction(r1, rt, lt); + take_fraction(ff, r1, r1); + number_clone(r1, ee); + take_fraction(ee, r1, ff); + } + free_number(r1); + } + free_number(rt); + free_number(lt); + set_number_from_addition(arg2, dd, ee); + make_fraction(ff, ee, arg2); + free_number(arg2); + } + take_fraction(mp->uu[k], ff, bb); + take_fraction(acc, mp->psi[k + 1], mp->uu[k]); + number_negate(acc); + if (mp_right_type(r) == mp_curl_knot) { + mp_number r1, arg2; + new_fraction(r1); + new_number(arg2); + set_number_from_subtraction(arg2, fraction_one_t, ff); + take_fraction(r1, mp->psi[1], arg2); + set_number_to_zero(mp->ww[k]); + set_number_from_subtraction(mp->vv[k], acc, r1); + free_number(r1); + free_number(arg2); + } else { + mp_number arg1, r1; + new_fraction(r1); + new_number(arg1); + set_number_from_subtraction(arg1, fraction_one_t, ff); + make_fraction(ff, arg1, cc); + free_number(arg1); + take_fraction(r1, mp->psi[k], ff); + number_subtract(acc, r1); + number_clone(r1, ff); + take_fraction(ff, r1, aa); + take_fraction(r1, mp->vv[k - 1], ff); + set_number_from_subtraction(mp->vv[k], acc, r1 ); + if (number_zero(mp->ww[k - 1])) { + set_number_to_zero(mp->ww[k]); + } else { + take_fraction(mp->ww[k], mp->ww[k - 1], ff); + number_negate(mp->ww[k]); + } + free_number(r1); + } + if (mp_left_type(s) == mp_end_cycle_knot) { + mp_number arg2, r1; + new_number(arg2); + new_number(r1); + set_number_to_zero(aa); + number_clone(bb, fraction_one_t); + do { + --k; + if (k == 0) { + k = n; + } + take_fraction(r1, aa, mp->uu[k]); + set_number_from_subtraction(aa, mp->vv[k], r1); + take_fraction(r1, bb, mp->uu[k]); + set_number_from_subtraction(bb, mp->ww[k], r1); + } while (k != n); + set_number_from_subtraction(arg2, fraction_one_t, bb); + make_fraction(r1, aa, arg2); + number_clone(aa, r1); + number_clone(mp->theta[n], aa); + number_clone(mp->vv[0], aa); + for (k = 1; k < n; k++) { + take_fraction(r1, aa, mp->ww[k]); + number_add(mp->vv[k], r1); + } + free_number(arg2); + free_number(r1); + free_number(aa); + free_number(bb); + free_number(cc); + free_number(acc); + free_number(dd); + free_number(ee); + goto FOUND; + } + free_number(aa); + free_number(bb); + free_number(cc); + free_number(acc); + free_number(dd); + free_number(ee); + } + break; + case mp_curl_knot: + { + mp_number lt, rt, cc; + new_number_clone(cc, s->left_curl); + new_number_abs(lt, s->left_tension); + new_number_abs(rt, r->right_tension); + if (number_unity(rt) && number_unity(lt)) { + mp_number arg1, arg2; + new_number_clone(arg1, cc); + new_number_clone(arg2, cc); + number_double(arg1); + number_add(arg1, unity_t); + number_add(arg2, two_t); + make_fraction(ff, arg1, arg2); + free_number(arg1); + free_number(arg2); + } else { + mp_curl_ratio(mp, &ff, &cc, <, &rt); + } + { + mp_number arg1, arg2, r1; + new_fraction(r1); + new_fraction(arg1); + new_number(arg2); + take_fraction(arg1, mp->vv[n - 1], ff); + take_fraction(r1, ff, mp->uu[n - 1]); + set_number_from_subtraction(arg2, fraction_one_t, r1); + make_fraction(mp->theta[n], arg1, arg2); + number_negate(mp->theta[n]); + free_number(r1); + free_number(arg1); + free_number(arg2); + } + free_number(rt); + free_number(lt); + free_number(cc); + goto FOUND; + } + break; + case mp_given_knot: + { + mp_number narg; + new_angle(narg); + n_arg(narg, mp->delta_x[n - 1], mp->delta_y[n - 1]); + set_number_from_subtraction(mp->theta[n], s->left_given, narg); + free_number(narg); + mp_reduce_angle(mp, &mp->theta[n]); + goto FOUND; + } + break; + } + } + r = s; + s = t; + ++k; + } +FOUND: + { + mp_number r1; + new_number(r1); + for (k = n - 1; k >= 0; k--) { + take_fraction(r1, mp->theta[k + 1], mp->uu[k]); + set_number_from_subtraction(mp->theta[k], mp->vv[k], r1); + } + free_number(r1); + } + s = p; + k = 0; + { + mp_number arg; + new_number(arg); + do { + mp_knot t = mp_next_knot(s); + n_sin_cos(mp->theta[k], mp->ct, mp->st); + number_negated_clone(arg, mp->psi[k + 1]); + number_subtract(arg, mp->theta[k + 1]); + n_sin_cos(arg, mp->cf, mp->sf); + mp_set_controls (mp, s, t, k); + ++k; + s = t; + } while (k != n); + free_number(arg); + } + free_number(ff); +} + +static void mp_reduce_angle (MP mp, mp_number *a) +{ + mp_number abs_a; + new_number_abs(abs_a, *a); + if (number_greater(abs_a, one_eighty_deg_t)) { + if (number_positive(*a)) { + number_subtract(*a, three_sixty_deg_t); + } else { + number_add(*a, three_sixty_deg_t); + } + } + free_number(abs_a); +} + +void mp_curl_ratio (MP mp, mp_number *ret, mp_number *gamma_orig, mp_number *a_tension, mp_number *b_tension) +{ + mp_number alpha, beta, gamma, num, denom, ff; + mp_number arg1; + new_number(arg1); + new_fraction(alpha); + new_fraction(beta); + new_fraction(gamma); + new_fraction(ff); + new_fraction(denom); + new_fraction(num); + make_fraction(alpha, unity_t, *a_tension); + make_fraction(beta, unity_t, *b_tension); + number_clone(gamma, *gamma_orig); + if (number_lessequal(alpha, beta)) { + make_fraction(ff, alpha, beta); + number_clone(arg1, ff); + take_fraction(ff, arg1, arg1); + number_clone(arg1, gamma); + take_fraction(gamma, arg1, ff); + convert_fraction_to_scaled(beta); + take_fraction(denom, gamma, alpha); + number_add(denom, three_t); + } else { + make_fraction(ff, beta, alpha); + number_clone(arg1, ff); + take_fraction(ff, arg1, arg1); + take_fraction(arg1, beta, ff); + convert_fraction_to_scaled(arg1); + number_clone(beta, arg1); + take_fraction(denom, gamma, alpha); + set_number_from_div(arg1, ff, twelvebits_3); + number_add(denom, arg1); + } + number_subtract(denom, beta); + set_number_from_subtraction(arg1, fraction_three_t, alpha); + take_fraction(num, gamma, arg1); + number_add(num, beta); + number_clone(arg1, denom); + number_double(arg1); + number_double(arg1); + if (number_greaterequal(num, arg1)) { + number_clone(*ret, fraction_four_t); + } else { + make_fraction(*ret, num, denom); + } + free_number(alpha); + free_number(beta); + free_number(gamma); + free_number(num); + free_number(denom); + free_number(ff); + free_number(arg1); +} + +void mp_set_controls (MP mp, mp_knot p, mp_knot q, int k) +{ + mp_number rr, ss; + mp_number lt, rt; + mp_number sine; + mp_number tmp; + mp_number r1, r2; + new_number(tmp); + new_number(r1); + new_number(r2); + new_number_abs(lt, q->left_tension); + new_number_abs(rt, p->right_tension); + new_fraction(sine); + new_fraction(rr); + new_fraction(ss); + velocity(rr, mp->st, mp->ct, mp->sf, mp->cf, rt); + velocity(ss, mp->sf, mp->cf, mp->st, mp->ct, lt); + if (number_negative(p->right_tension) || number_negative(q->left_tension)) { + if ((number_nonnegative(mp->st) && number_nonnegative(mp->sf)) || (number_nonpositive(mp->st) && number_nonpositive(mp->sf))) { + mp_number r1, r2, arg1; + new_fraction(r1); + new_fraction(r2); + new_number_abs(arg1, mp->st); + take_fraction(r1, arg1, mp->cf); + number_abs_clone(arg1, mp->sf); + take_fraction(r2, arg1, mp->ct); + set_number_from_addition(sine, r1, r2); + if (number_positive(sine)) { + set_number_from_addition(arg1, fraction_one_t, unity_t); + number_clone(r1, sine); + take_fraction(sine, r1, arg1); + if (number_negative(p->right_tension)) { + number_abs_clone(arg1, mp->sf); + if (ab_vs_cd(arg1, fraction_one_t, rr, sine) < 0) { + number_abs_clone(arg1, mp->sf); + make_fraction(rr, arg1, sine); + } + } + if (number_negative(q->left_tension)) { + number_abs_clone(arg1, mp->st); + if (ab_vs_cd(arg1, fraction_one_t, ss, sine) < 0) { + number_abs_clone(arg1, mp->st); + make_fraction(ss, arg1, sine); + } + } + } + free_number(arg1); + free_number(r1); + free_number(r2); + } + } + take_fraction(r1, mp->delta_x [k], mp->ct); + take_fraction(r2, mp->delta_y [k], mp->st); + number_subtract(r1, r2); + take_fraction(tmp, r1, rr); + set_number_from_addition(p->right_x, p->x_coord, tmp); + take_fraction(r1, mp->delta_y[k], mp->ct); + take_fraction(r2, mp->delta_x[k], mp->st); + number_add(r1, r2); + take_fraction(tmp, r1, rr); + set_number_from_addition(p->right_y, p->y_coord, tmp); + take_fraction(r1, mp->delta_x[k], mp->cf); + take_fraction(r2, mp->delta_y[k], mp->sf); + number_add(r1, r2); + take_fraction(tmp, r1, ss); + set_number_from_subtraction(q->left_x, q->x_coord, tmp); + take_fraction(r1, mp->delta_y[k], mp->cf); + take_fraction(r2, mp->delta_x[k], mp->sf); + number_subtract(r1, r2); + take_fraction(tmp, r1, ss); + set_number_from_subtraction(q->left_y, q->y_coord, tmp); + mp_right_type(p) = mp_explicit_knot; + mp_left_type(q) = mp_explicit_knot; + free_number(tmp); + free_number(r1); + free_number(r2); + free_number(lt); + free_number(rt); + free_number(rr); + free_number(ss); + free_number(sine); +} + +# define TOO_LARGE(a) (fabs((a))>4096.0) +# define PI 3.1415926535897932384626433832795028841971 + +static int out_of_range (MP mp, double a) +{ + (void) mp; + mp_number t; + new_number_from_double(mp, t, fabs(a)); + if (number_greaterequal(t, inf_t)) { + free_number(t); + return 1; + } else { + free_number(t); + return 0; + } +} + +static int mp_link_knotpair (MP mp, mp_knot p, mp_knot q) +{ + (void) mp; + if (p == NULL || q == NULL) { + return 0; + } else { + mp_prev_knot(q) = p; + mp_next_knot(p) = q; + set_number_from_double(p->right_tension, 1.0); + if (mp_right_type(p) == mp_endpoint_knot) { + mp_right_type(p) = mp_open_knot; + } + set_number_from_double(q->left_tension, 1.0); + if (mp_left_type(q) == mp_endpoint_knot) { + mp_left_type(q) = mp_open_knot; + } + return 1; + } +} + +static int mp_link_knotpair_xy (MP mp, mp_knot p, mp_knot q) +{ + (void) mp; + if (p == NULL || q == NULL) { + return 0; + } else { + mp_prev_knot(q) = p; + mp_next_knot(p) = q; + return 1; + } +} + +int mp_close_path_cycle (MP mp, mp_knot p, mp_knot q) +{ + return mp_link_knotpair(mp, p, q); +} + +int mp_close_path (MP mp, mp_knot q, mp_knot first) +{ + if (q == NULL || first == NULL) { + return 0; + } else { + mp_prev_knot(first) = q; + mp_next_knot(q) = first; + mp_right_type(q) = mp_endpoint_knot; + set_number_from_double(q->right_tension, 1.0); + mp_left_type(first) = mp_endpoint_knot; + set_number_from_double(first->left_tension, 1.0); + return 1; + } +} + +mp_knot mp_create_knot (MP mp) +{ + mp_knot q = mp_new_knot(mp); + mp_left_type(q) = mp_endpoint_knot; + mp_right_type(q) = mp_endpoint_knot; + return q; +} + +int mp_set_knot (MP mp, mp_knot p, double x, double y) +{ + if (p == NULL) { + return 0; + } else if (out_of_range(mp, x)) { + return 0; + } else if (out_of_range(mp, y)) { + return 0; + } else { + set_number_from_double(p->x_coord, x); + set_number_from_double(p->y_coord, y); + return 1; + } +} + +mp_knot mp_append_knot (MP mp, mp_knot p, double x, double y) +{ + mp_knot q = mp_create_knot(mp); + if (q == NULL) { + return NULL; + } else if (! mp_set_knot(mp, q, x, y)) { + mp_memory_free(q); + return NULL; + } else if (p == NULL) { + return q; + } else if (mp_link_knotpair(mp, p, q)) { + return q; + } else { + mp_memory_free(q); + return NULL; + } +} + +mp_knot mp_append_knot_xy (MP mp, mp_knot p, double x, double y) +{ + mp_knot q = mp_create_knot(mp); + if (q == NULL) { + return NULL; + } else if (! mp_set_knot(mp, q, x, y)) { + mp_memory_free(q); + return NULL; + } else if (p == NULL) { + return q; + } else if (mp_link_knotpair_xy(mp, p, q)) { + mp_right_type(p) = mp_explicit_knot; + mp_left_type(p) = mp_explicit_knot; + return q; + } else { + mp_memory_free(q); + return NULL; + } +} + +int mp_set_knot_curl (MP mp, mp_knot q, double value) +{ + if (q == NULL) { + return 0; + } else if (TOO_LARGE(value)) { + return 0; + } else { + mp_right_type(q) = mp_curl_knot; + set_number_from_double(q->right_curl, value); + if (mp_left_type(q) == mp_open_knot) { + mp_left_type(q) = mp_curl_knot; + set_number_from_double(q->left_curl, value); + } + return 1; + } +} + +int mp_set_knot_left_curl (MP mp, mp_knot q, double value) +{ + if (q == NULL) { + return 0; + } else if (TOO_LARGE(value)) { + return 0; + } else { + mp_left_type(q) = mp_curl_knot; + set_number_from_double(q->left_curl, value); + if (mp_right_type(q) == mp_open_knot) { + mp_right_type(q) = mp_curl_knot; + set_number_from_double(q->right_curl, value); + } + return 1; + } +} + +int mp_set_knot_right_curl (MP mp, mp_knot q, double value) +{ + if (q == NULL) { + return 0; + } else if (TOO_LARGE(value)) { + return 0; + } else { + mp_right_type(q) = mp_curl_knot; + set_number_from_double(q->right_curl, value); + if (mp_left_type(q) == mp_open_knot) { + mp_left_type(q) = mp_curl_knot; + set_number_from_double(q->left_curl, value); + } + return 1; + } +} + +int mp_set_knot_simple_curl (MP mp, mp_knot q) +{ + if (q == NULL) { + return 0; + } else { + mp_right_type(q) = mp_curl_knot; + set_number_from_double(q->right_curl, 1.0); + mp_left_type(q) = mp_curl_knot; + set_number_from_double(q->left_curl, 1.0); + return 1; + } +} + +int mp_set_knotpair_curls (MP mp, mp_knot p, mp_knot q, double t1, double t2) +{ + if (p == NULL || q == NULL) { + return 0; + } else if (mp_set_knot_curl(mp, p, t1)) { + return mp_set_knot_curl(mp, q, t2); + } else { + return 0; + } +} + +int mp_set_knotpair_tensions (MP mp, mp_knot p, mp_knot q, double t1, double t2) +{ + if (p == NULL || q == NULL) { + return 0; + } else if (TOO_LARGE(t1)) { + return 0; + } else if (TOO_LARGE(t2)) { + return 0; + } else if ((fabs(t1) < 0.75)) { + return 0; + } else if ((fabs(t2) < 0.75)) { + return 0; + } else { + set_number_from_double(p->right_tension, t1); + set_number_from_double(q->left_tension, t2); + return 1; + } +} + +int mp_set_knot_left_tension (MP mp, mp_knot p, double t1) +{ + if (p == NULL) { + return 0; + } else if (TOO_LARGE(t1)) { + return 0; + } else if ((fabs(t1) < 0.75)) { + return 0; + } else { + set_number_from_double(p->left_tension, t1); + return 1; + } +} + +int mp_set_knot_right_tension (MP mp, mp_knot p, double t1) +{ + if (p == NULL) { + return 0; + } else if (TOO_LARGE(t1)) { + return 0; + } else if ((fabs(t1) < 0.75)) { + return 0; + } else { + set_number_from_double(p->right_tension, t1); + return 1; + } +} + +int mp_set_knotpair_controls (MP mp, mp_knot p, mp_knot q, double x1, double y1, double x2, double y2) +{ + if (p == NULL || q == NULL) { + return 0; + } else if (out_of_range(mp, x1)) { + return 0; + } else if (out_of_range(mp, y1)) { + return 0; + } else if (out_of_range(mp, x2)) { + return 0; + } else if (out_of_range(mp, y2)) { + return 0; + } else { + mp_right_type(p) = mp_explicit_knot; + set_number_from_double(p->right_x, x1); + set_number_from_double(p->right_y, y1); + mp_left_type(q) = mp_explicit_knot; + set_number_from_double(q->left_x, x2); + set_number_from_double(q->left_y, y2); + return 1; + } +} + +int mp_set_knot_left_control (MP mp, mp_knot p, double x1, double y1) +{ + if (p == NULL) { + return 0; + } else if (out_of_range(mp, x1)) { + return 0; + } else if (out_of_range(mp, y1)) { + return 0; + } else { + mp_left_type(p) = mp_explicit_knot; + set_number_from_double(p->left_x, x1); + set_number_from_double(p->left_y, y1); + return 1; + } +} + +int mp_set_knot_right_control (MP mp, mp_knot p, double x1, double y1) +{ + if (p == NULL) { + return 0; + } else if (out_of_range(mp, x1)) { + return 0; + } else if (out_of_range(mp, y1)) { + return 0; + } else { + mp_right_type(p) = mp_explicit_knot; + set_number_from_double(p->right_x, x1); + set_number_from_double(p->right_y, y1); + return 1; + } +} + +int mp_set_knot_direction (MP mp, mp_knot q, double x, double y) +{ + if (q == NULL) { + return 0; + } else if (TOO_LARGE(x)) { + return 0; + } else if (TOO_LARGE(y)) { + return 0; + } else { + double value = 0; + if (!(x == 0 && y == 0)) { + value = atan2(y, x) * (180.0 / PI) * 16.0; + } + mp_right_type(q) = mp_given_knot; + set_number_from_double(q->right_curl, value); + if (mp_left_type(q) == mp_open_knot) { + mp_left_type(q) = mp_given_knot; + set_number_from_double(q->left_curl, value); + } + return 1; + } +} + +int mp_set_knotpair_directions (MP mp, mp_knot p, mp_knot q, double x1, double y1, double x2, double y2) +{ + if (p == NULL || q == NULL) { + return 0; + } else if (mp_set_knot_direction(mp,p, x1, y1)) { + return mp_set_knot_direction(mp,q, x2, y2); + } else { + return 0; + } +} + +static int path_needs_fixing(mp_knot source) +{ + mp_knot sourcehead = source; + do { + source = source->next; + } while (source && source != sourcehead); + if (! source) { + return 1; + } else { + return 0; + } +} + +int mp_solve_path (MP mp, mp_knot first) +{ + if (first == NULL) { + return 0; + } else if (path_needs_fixing(first)) { + return 0; + } else { + int saved_arith_error = mp->arith_error; + int retval = 1; + jmp_buf *saved_jump_buf = mp->jump_buf; + mp->jump_buf = mp_memory_allocate(sizeof(jmp_buf)); + if (mp->jump_buf == NULL || setjmp(*(mp->jump_buf)) != 0) { + return 0; + } else { + mp->arith_error = 0; + mp_make_choices(mp, first); + if (mp->arith_error) { + retval = 0; + } + mp->arith_error = saved_arith_error; + mp_memory_free(mp->jump_buf); + mp->jump_buf = saved_jump_buf; + return retval; + } + } +} + +void mp_free_path (MP mp, mp_knot p) +{ + mp_toss_knot_list(mp, p); +} + +double mp_number_as_double (MP mp, mp_number n) { + (void) mp; + return number_to_double(n); +} + +static void mp_eval_cubic (MP mp, mp_number *r, mp_knot p, mp_knot q, int c, mp_number *t) +{ + mp_number x1, x2, x3; + new_number(x1); + new_number(x2); + new_number(x3); + if (c == mp_x_code) { + set_number_from_of_the_way(x1, *t, p->x_coord, p->right_x); + set_number_from_of_the_way(x2, *t, p->right_x, q->left_x); + set_number_from_of_the_way(x3, *t, q->left_x, q->x_coord); + } else { + set_number_from_of_the_way(x1, *t, p->y_coord, p->right_y); + set_number_from_of_the_way(x2, *t, p->right_y, q->left_y); + set_number_from_of_the_way(x3, *t, q->left_y, q->y_coord); + } + set_number_from_of_the_way(x1, *t, x1, x2); + set_number_from_of_the_way(x2, *t, x2, x3); + set_number_from_of_the_way(*r, *t, x1, x2); + free_number(x1); + free_number(x2); + free_number(x3); +} + +static void mp_bound_cubic (MP mp, mp_knot p, mp_knot q, int c) +{ + int wavy; + mp_number del1, del2, del3, del, dmax; + mp_number t, tt; + mp_number x; + new_fraction(t); + new_fraction(tt); + if (c == mp_x_code) { + new_number_clone(x, q->x_coord); + } else { + new_number_clone(x, q->y_coord); + } + new_number(del1); + new_number(del2); + new_number(del3); + new_number(del); + new_number(dmax); + if (number_less(x, mp->bbmin[c])) { + number_clone(mp->bbmin[c], x); + } + if (number_greater(x, mp->bbmax[c])) { + number_clone(mp->bbmax[c], x); + } + wavy = 1; + if (c == mp_x_code) { + if (number_lessequal(mp->bbmin[c], p->right_x) && number_lessequal(p->right_x, mp->bbmax[c])) { + if (number_lessequal(mp->bbmin[c], q->left_x) && number_lessequal(q->left_x, mp->bbmax[c])) { + wavy = 0; + } + } + } else { + if (number_lessequal(mp->bbmin[c], p->right_y) && number_lessequal(p->right_y, mp->bbmax[c])) { + if (number_lessequal(mp->bbmin[c], q->left_y) && number_lessequal(q->left_y, mp->bbmax[c])) { + wavy = 0; + } + } + } + if (wavy) { + if (c == mp_x_code) { + set_number_from_subtraction(del1, p->right_x, p->x_coord); + set_number_from_subtraction(del2, q->left_x, p->right_x); + set_number_from_subtraction(del3, q->x_coord, q->left_x); + } else { + set_number_from_subtraction(del1, p->right_y, p->y_coord); + set_number_from_subtraction(del2, q->left_y, p->right_y); + set_number_from_subtraction(del3, q->y_coord, q->left_y); + } + if (number_nonzero(del1)) { + number_clone(del, del1); + } else if (number_nonzero(del2)) { + number_clone(del, del2); + } else { + number_clone(del, del3); + } + if (number_nonzero(del)) { + mp_number absval1; + new_number(absval1); + number_abs_clone(dmax, del1); + number_abs_clone(absval1, del2); + if (number_greater(absval1, dmax)) { + number_clone(dmax, absval1); + } + number_abs_clone(absval1, del3); + if (number_greater(absval1, dmax)) { + number_clone(dmax, absval1); + } + while (number_less(dmax, fraction_half_t)) { + number_double(dmax); + number_double(del1); + number_double(del2); + number_double(del3); + } + free_number(absval1); + } + if (number_negative(del)) { + number_negate(del1); + number_negate(del2); + number_negate(del3); + } + crossing_point(t, del1, del2, del3); + if (number_less(t, fraction_one_t)) { + { + mp_eval_cubic(mp, &x, p, q, c, &t); + if (number_less(x, mp->bbmin[c])) { + number_clone(mp->bbmin[c], x); + } + if (number_greater(x, mp->bbmax[c])) { + number_clone(mp->bbmax[c], x); + } + set_number_from_of_the_way(del2, t, del2, del3); + if (number_positive(del2)) { + set_number_to_zero(del2); + } + { + mp_number arg2, arg3; + new_number(arg2); + new_number(arg3); + number_negated_clone(arg2, del2); + number_negated_clone(arg3, del3); + crossing_point(tt, zero_t, arg2, arg3); + free_number(arg2); + free_number(arg3); + } + if (number_less(tt, fraction_one_t)) { + mp_number arg; + new_number(arg); + set_number_from_of_the_way(arg, t, tt, fraction_one_t); + mp_eval_cubic(mp, &x, p, q, c, &arg); + free_number(arg); + if (number_less(x, mp->bbmin[c])) { + number_clone(mp->bbmin[c], x); + } + if (number_greater(x, mp->bbmax[c])) { + number_clone(mp->bbmax[c], x); + } + } + } + } + } + free_number(del3); + free_number(del2); + free_number(del1); + free_number(del); + free_number(dmax); + free_number(x); + free_number(t); + free_number(tt); +} + +static void mp_path_bbox (MP mp, mp_knot h) +{ + mp_knot p = h; + number_clone(mp_minx, h->x_coord); + number_clone(mp_miny, h->y_coord); + number_clone(mp_maxx, mp_minx); + number_clone(mp_maxy, mp_miny); + do { + if (mp_right_type(p) == mp_endpoint_knot) { + return; + } else { + mp_knot q = mp_next_knot(p); + mp_bound_cubic(mp, p, q, mp_x_code); + mp_bound_cubic(mp, p, q, mp_y_code); + p = q; + } + } while (p != h); +} + +static void mp_path_xbox (MP mp, mp_knot h) +{ + mp_knot p = h; + number_clone(mp_minx, h->x_coord); + number_clone(mp_maxx, mp_minx); + set_number_to_zero(mp_miny); + set_number_to_zero(mp_maxy); + do { + if (mp_right_type(p) == mp_endpoint_knot) { + return; + } else { + mp_knot q = mp_next_knot(p); + mp_bound_cubic(mp, p, q, mp_x_code); + p = q; + } + } while (p != h); +} + +static void mp_path_ybox (MP mp, mp_knot h) +{ + mp_knot p = h; + set_number_to_zero(mp_minx); + set_number_to_zero(mp_maxx); + number_clone(mp_miny, h->y_coord); + number_clone(mp_maxy, mp_miny); + do { + if (mp_right_type(p) == mp_endpoint_knot) { + return; + } else { + mp_knot q = mp_next_knot(p); + mp_bound_cubic(mp, p, q, mp_y_code); + p = q; + } + } while (p != h); +} + +static void mp_arc_test (MP mp, + mp_number *ret, mp_number *dx0, mp_number *dy0, mp_number *dx1, + mp_number *dy1, mp_number *dx2, mp_number *dy2, mp_number *v0, + mp_number *v02, mp_number *v2, mp_number *a_goal, mp_number *tol_orig +) +{ + int simple; + mp_number dx01, dy01, dx12, dy12, dx02, dy02; + mp_number v002, v022; + mp_number arc; + mp_number arc1; + mp_number simply; + mp_number tol; + new_number(arc ); + new_number(arc1); + new_number(dx01); + new_number(dy01); + new_number(dx12); + new_number(dy12); + new_number(dx02); + new_number(dy02); + new_number(v002); + new_number(v022); + new_number(simply); + new_number_clone(tol, *tol_orig); + set_number_half_from_addition(dx01, *dx0, *dx1); + set_number_half_from_addition(dx12, *dx1, *dx2); + set_number_half_from_addition(dx02, dx01, dx12); + set_number_half_from_addition(dy01, *dy0, *dy1); + set_number_half_from_addition(dy12, *dy1, *dy2); + set_number_half_from_addition(dy02, dy01, dy12); + + { + mp_number tmp, arg1, arg2 ; + new_number(tmp); + new_number(arg1); + new_number(arg2); + set_number_half_from_addition(arg1, *dx0, dx02); + number_add(arg1, dx01); + set_number_half_from_addition(arg2, *dy0, dy02); + number_add(arg2, dy01); + pyth_add(v002, arg1, arg2); + set_number_half_from_addition(arg1, dx02, *dx2); + number_add(arg1, dx12); + set_number_half_from_addition(arg2, dy02, *dy2); + number_add(arg2, dy12); + pyth_add(v022, arg1, arg2); + free_number(arg1); + free_number(arg2); + number_clone(tmp, *v02); + number_add_scaled(tmp, 2); + number_half(tmp); + set_number_half_from_addition(arc1, *v0, tmp); + number_subtract(arc1, v002); + number_half(arc1); + set_number_from_addition(arc1, v002, arc1); + set_number_half_from_addition(arc, *v2, tmp); + number_subtract(arc, v022); + number_half(arc); + set_number_from_addition(arc, v022, arc); + set_number_to_inf(tmp); + number_subtract(tmp,arc1); + if (number_less(arc, tmp)) { + free_number(tmp); + number_add(arc, arc1); + } else { + free_number(tmp); + mp->arith_error = 1; + if (number_infinite(*a_goal)) { + set_number_to_inf(*ret); + } else { + set_number_to_unity(*ret); + number_double(*ret); + number_negate(*ret); + } + goto DONE; + } + } + simple = (number_nonnegative(*dx0) && number_nonnegative(*dx1) && number_nonnegative(*dx2)) + || (number_nonpositive(*dx0) && number_nonpositive(*dx1) && number_nonpositive(*dx2)); + if (simple) { + simple = (number_nonnegative(*dy0) && number_nonnegative(*dy1) && number_nonnegative(*dy2)) + || (number_nonpositive(*dy0) && number_nonpositive(*dy1) && number_nonpositive(*dy2)); + } + if (!simple) { + simple = (number_greaterequal(*dx0, *dy0) && number_greaterequal(*dx1, *dy1) && number_greaterequal(*dx2, *dy2)) + || (number_lessequal (*dx0, *dy0) && number_lessequal (*dx1, *dy1) && number_lessequal (*dx2, *dy2)); + if (simple) { + mp_number neg_dx0, neg_dx1, neg_dx2; + new_number(neg_dx0); + new_number(neg_dx1); + new_number(neg_dx2); + number_negated_clone(neg_dx0, *dx0); + number_negated_clone(neg_dx1, *dx1); + number_negated_clone(neg_dx2, *dx2); + simple = (number_greaterequal(neg_dx0, *dy0) && number_greaterequal(neg_dx1, *dy1) && number_greaterequal(neg_dx2, *dy2)) + || (number_lessequal (neg_dx0, *dy0) && number_lessequal (neg_dx1, *dy1) && number_lessequal (neg_dx2, *dy2)); + free_number(neg_dx0); + free_number(neg_dx1); + free_number(neg_dx2); + } + } + set_number_half_from_addition(simply, *v0, *v2); + number_negate(simply); + number_add(simply, arc); + number_subtract(simply, *v02); + number_abs(simply); + if (simple && number_lessequal(simply, tol)) { + if (number_less(arc, *a_goal)){ + number_clone(*ret, arc); + } else { + mp_number tmp; + mp_number tmp2; + mp_number tmp3; + mp_number tmp4; + mp_number tmp5; + new_number_clone(tmp, *v02); + new_number(tmp2); + new_number(tmp3); + new_number(tmp4); + new_number(tmp5); + number_add_scaled(tmp, 2); + number_half(tmp); + number_half(tmp); + if (number_lessequal(*a_goal, arc1)) { + number_clone(tmp2, *v0); + number_half(tmp2); + set_number_from_subtraction(tmp3, arc1, tmp2); + number_subtract(tmp3, tmp); + mp_solve_rising_cubic(mp, &tmp5, &tmp2, &tmp3, &tmp, a_goal); + number_half(tmp5); + set_number_to_unity(tmp3); + number_subtract(tmp5, tmp3); + number_subtract(tmp5, tmp3); + number_clone(*ret, tmp5); + } else { + number_clone(tmp2, *v2); + number_half(tmp2); + set_number_from_subtraction(tmp3, arc, arc1); + number_subtract(tmp3, tmp); + number_subtract(tmp3, tmp2); + set_number_from_subtraction(tmp4, *a_goal, arc1); + mp_solve_rising_cubic(mp, &tmp5, &tmp, &tmp3, &tmp2, &tmp4); + number_half(tmp5); + set_number_to_unity(tmp2); + set_number_to_unity(tmp3); + number_half(tmp2); + number_subtract(tmp2, tmp3); + number_subtract(tmp2, tmp3); + set_number_from_addition(*ret, tmp2, tmp5); + } + free_number(tmp); + free_number(tmp2); + free_number(tmp3); + free_number(tmp4); + free_number(tmp5); + } + } else { + mp_number a_new, a_aux; + mp_number a, b; + mp_number half_v02; + new_number(a_new); + new_number(a_aux); + new_number(half_v02); + set_number_to_inf(a_aux); + number_subtract(a_aux, *a_goal); + if (number_greater(*a_goal, a_aux)) { + set_number_from_subtraction(a_aux, *a_goal, a_aux); + set_number_to_inf(a_new); + } else { + set_number_from_addition(a_new, *a_goal, *a_goal); + set_number_to_zero(a_aux); + } + { + mp_number half_tol; + new_number_clone(half_tol, tol); + number_half(half_tol); + number_add(tol, half_tol); + free_number(half_tol); + } + number_clone(half_v02, *v02); + number_half(half_v02); + new_number(a); + mp_arc_test(mp, &a, dx0, dy0, &dx01, &dy01, &dx02, &dy02, v0, &v002, &half_v02, &a_new, &tol); + if (number_negative(a)) { + set_number_to_unity(*ret); + number_double(*ret); + number_subtract(*ret, a); + number_half(*ret); + number_negate(*ret); + } else { + if (number_greater(a, a_aux)) { + number_subtract(a_aux, a); + number_add(a_new, a_aux); + } + new_number(b); + mp_arc_test(mp, &b, &dx02, &dy02, &dx12, &dy12, dx2, dy2, &half_v02, &v022, v2, &a_new, &tol); + if (number_negative(b)) { + mp_number tmp ; + new_number(tmp); + number_negated_clone(tmp, b); + number_half(tmp); + number_negate(tmp); + number_clone(*ret, tmp); + set_number_to_unity(tmp); + number_half(tmp); + number_subtract(*ret, tmp); + free_number(tmp); + } else { + set_number_from_subtraction(*ret, b, a); + number_half(*ret); + set_number_from_addition(*ret, a, *ret); + } + free_number(b); + } + free_number(half_v02); + free_number(a_aux); + free_number(a_new); + free_number(a); + } + DONE: + free_number(arc); + free_number(arc1); + free_number(dx01); + free_number(dy01); + free_number(dx12); + free_number(dy12); + free_number(dx02); + free_number(dy02); + free_number(v002); + free_number(v022); + free_number(simply); + free_number(tol); +} + +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) +{ + mp_number abc; + mp_number a, b, c, x; + mp_number ab, bc, ac; + mp_number t; + mp_number xx; + mp_number neg_x; + if (number_negative(*a_orig) || number_negative(*c_orig)) { + mp_confusion(mp, "rising cubic"); + } + new_number(t); + new_number(abc); + new_number_clone(a, *a_orig); + new_number_clone(b, *b_orig); + new_number_clone(c, *c_orig); + new_number_clone(x, *x_orig); + new_number(ab); + new_number(bc); + new_number(ac); + new_number(xx); + new_number(neg_x); + set_number_from_addition(abc, a, b); + number_add(abc, c); + if (number_nonpositive(x)) { + set_number_to_zero(*ret); + } else if (number_greaterequal(x, abc)) { + set_number_to_unity(*ret); + } else { + number_clone(t, epsilon_t); + while (number_greater(a, one_third_inf_t) || number_greater(b, one_third_inf_t) || number_greater(c, one_third_inf_t)) { + number_half(a); + number_half(b); + number_half(c); + number_half(x); + } + do { + number_add(t, t); + set_number_half_from_addition(ab, a, b); + set_number_half_from_addition(bc, b, c); + set_number_half_from_addition(ac, ab, bc); + + number_clone(xx,x); + number_subtract(xx, a); + number_subtract(xx, ab); + number_subtract(xx, ac); + number_negated_clone(neg_x, x); + if (number_less(xx, neg_x)) { + number_double(x); + number_clone(b, ab); + number_clone(c, ac); + } else { + number_add(x, xx); + number_clone(a, ac); + number_clone(b, bc); + number_add(t, epsilon_t); + } + } while (number_less(t, unity_t)); + set_number_from_subtraction(*ret, t, unity_t); + } + free_number(abc); + free_number(t); + free_number(a); + free_number(b); + free_number(c); + free_number(ab); + free_number(bc); + free_number(ac); + free_number(xx); + free_number(x); + free_number(neg_x); +} + +static void mp_do_arc_test (MP mp, + mp_number *ret, mp_number *dx0, mp_number *dy0, mp_number *dx1, + mp_number *dy1, mp_number *dx2, mp_number *dy2, mp_number *a_goal +) +{ + mp_number v0, v1, v2; + mp_number v02; + new_number(v0); + new_number(v1); + new_number(v2); + pyth_add(v0, *dx0, *dy0); + pyth_add(v1, *dx1, *dy1); + pyth_add(v2, *dx2, *dy2); + if ((number_greaterequal(v0, fraction_four_t)) || (number_greaterequal(v1, fraction_four_t)) || (number_greaterequal(v2, fraction_four_t))) { + mp->arith_error = 1; + if (number_infinite(*a_goal)) { + set_number_to_inf(*ret); + } else { + set_number_to_unity(*ret); + number_double(*ret); + number_negate(*ret); + } + } else { + mp_number arg1, arg2; + new_number(v02); + new_number(arg1); + new_number(arg2); + set_number_half_from_addition(arg1, *dx0, *dx2); + number_add(arg1, *dx1); + set_number_half_from_addition(arg2, *dy0, *dy2); + number_add(arg2, *dy1); + pyth_add(v02, arg1, arg2); + free_number(arg1); + free_number(arg2); + mp_arc_test(mp, ret, dx0, dy0, dx1, dy1, dx2, dy2, &v0, &v02, &v2, a_goal, &arc_tol_k); + free_number(v02); + } + free_number(v0); + free_number(v1); + free_number(v2); +} + +static void mp_get_arc_length (MP mp, mp_number *ret, mp_knot h) +{ + mp_number a; + mp_number a_tot; + mp_number arg1, arg2, arg3, arg4, arg5, arg6; + mp_number arcgoal; + mp_knot p = h; + new_number(a_tot); + new_number(arg1); + new_number(arg2); + new_number(arg3); + new_number(arg4); + new_number(arg5); + new_number(arg6); + new_number(a); + new_number(arcgoal); + set_number_to_inf(arcgoal); + while (mp_right_type(p) != mp_endpoint_knot) { + mp_knot q = mp_next_knot(p); + set_number_from_subtraction(arg1, p->right_x, p->x_coord); + set_number_from_subtraction(arg2, p->right_y, p->y_coord); + set_number_from_subtraction(arg3, q->left_x, p->right_x); + set_number_from_subtraction(arg4, q->left_y, p->right_y); + set_number_from_subtraction(arg5, q->x_coord, q->left_x); + set_number_from_subtraction(arg6, q->y_coord, q->left_y); + mp_do_arc_test(mp, &a, &arg1, &arg2, &arg3, &arg4, &arg5, &arg6, &arcgoal); + slow_add(a_tot, a, a_tot); + + if (q == h) { + break; + } else { + p = q; + } + } + free_number(arcgoal); + free_number(a); + free_number(arg1); + free_number(arg2); + free_number(arg3); + free_number(arg4); + free_number(arg5); + free_number(arg6); + check_arith(); + number_clone(*ret, a_tot); + free_number(a_tot); +} + +static void mp_get_subarc_length (MP mp, mp_number *ret, mp_knot h, mp_number *first, mp_number *last) +{ + mp_number a; + mp_number a_tot, a_cnt; + mp_number arg1, arg2, arg3, arg4, arg5, arg6; + mp_number arcgoal; + mp_knot p = h; + new_number(a_tot); + new_number(a_cnt); + new_number(arg1); + new_number(arg2); + new_number(arg3); + new_number(arg4); + new_number(arg5); + new_number(arg6); + new_number(a); + new_number(arcgoal); + set_number_to_inf(arcgoal); + while (mp_right_type(p) != mp_endpoint_knot) { + mp_knot q = mp_next_knot(p); + if (number_greaterequal(a_cnt, *last)) { + break; + } else if (number_greaterequal(a_cnt, *first)) { + set_number_from_subtraction(arg1, p->right_x, p->x_coord); + set_number_from_subtraction(arg2, p->right_y, p->y_coord); + set_number_from_subtraction(arg3, q->left_x, p->right_x); + set_number_from_subtraction(arg4, q->left_y, p->right_y); + set_number_from_subtraction(arg5, q->x_coord, q->left_x); + set_number_from_subtraction(arg6, q->y_coord, q->left_y); + mp_do_arc_test(mp, &a, &arg1, &arg2, &arg3, &arg4, &arg5, &arg6, &arcgoal); + slow_add(a_tot, a, a_tot); + } + if (q == h) { + break; + } else { + p = q; + number_add(a_cnt, unity_t); + } + } + free_number(arcgoal); + free_number(a); + free_number(arg1); + free_number(arg2); + free_number(arg3); + free_number(arg4); + free_number(arg5); + free_number(arg6); + check_arith(); + number_clone(*ret, a_tot); + free_number(a_cnt); + free_number(a_tot); +} + +static mp_knot mp_get_arc_time(MP mp, mp_number *ret, mp_knot h, mp_number *arc0_orig, int local) +{ + if (number_negative(*arc0_orig)) { + if (mp_left_type(h) == mp_endpoint_knot) { + set_number_to_zero(*ret); + } else { + mp_number neg_arc0; + mp_knot p = mp_htap_ypoc(mp, h); + new_number(neg_arc0); + number_negated_clone(neg_arc0, *arc0_orig); + mp_get_arc_time(mp, ret, p, &neg_arc0, 0); + number_negate(*ret); + mp_toss_knot_list(mp, p); + free_number(neg_arc0); + } + check_arith(); + } else { + mp_knot p, q, k; + mp_number t_tot; + mp_number t; + mp_number arc, arc0; + mp_number arg1, arg2, arg3, arg4, arg5, arg6; + new_number(t_tot); + new_number_clone(arc0, *arc0_orig); + if (number_infinite(arc0)) { + number_add_scaled(arc0, -1); + } + new_number_clone(arc, arc0); + p = h; + k = h; + new_number(arg1); + new_number(arg2); + new_number(arg3); + new_number(arg4); + new_number(arg5); + new_number(arg6); + new_number(t); + while ((mp_right_type(p) != mp_endpoint_knot) && number_positive(arc)) { + k = p; + q = mp_next_knot(p); + set_number_from_subtraction(arg1, p->right_x, p->x_coord); + set_number_from_subtraction(arg2, p->right_y, p->y_coord); + set_number_from_subtraction(arg3, q->left_x, p->right_x); + set_number_from_subtraction(arg4, q->left_y, p->right_y); + set_number_from_subtraction(arg5, q->x_coord, q->left_x); + set_number_from_subtraction(arg6, q->y_coord, q->left_y); + mp_do_arc_test(mp, &t, &arg1, &arg2, &arg3, &arg4, &arg5, &arg6, &arc); + if (number_negative(t)) { + number_add(t_tot, t); + number_add(t_tot, two_t); + set_number_to_zero(arc); + } else { + number_add(t_tot, unity_t); + number_subtract(arc, t); + } + if (q == h) { + if (number_positive(arc)) { + mp_number n, n1, d1, v1; + new_number(n); + new_number(n1); + new_number(d1); + new_number(v1); + set_number_from_subtraction(d1, arc0, arc); + set_number_from_div(n1, arc, d1); + number_clone(n, n1); + set_number_from_mul(n1, n1, d1); + number_subtract(arc, n1); + number_clone(d1, inf_t); + number_clone(v1, n); + number_add(v1, epsilon_t); + set_number_from_div(d1, d1, v1); + if (number_greater(t_tot, d1)) { + mp->arith_error = 1; + check_arith(); + set_number_to_inf(*ret); + free_number(n); + free_number(n1); + free_number(d1); + free_number(v1); + goto RETURN; + } + set_number_from_mul(t_tot, t_tot, v1); + free_number(n); + free_number(n1); + free_number(d1); + free_number(v1); + } + } + p = q; + } + check_arith(); + if (local) { + number_add(t, two_t); + number_clone(*ret, t); + } else { + number_clone(*ret, t_tot); + } + h = k; + RETURN: + free_number(t_tot); + free_number(t); + free_number(arc); + free_number(arc0); + free_number(arg1); + free_number(arg2); + free_number(arg3); + free_number(arg4); + free_number(arg5); + free_number(arg6); + } + return h; +} + +static mp_knot mp_make_pen (MP mp, mp_knot h, int need_hull) +{ + mp_knot q = h; + do { + mp_knot p = q; + q = mp_next_knot(q); + mp_prev_knot(q) = p; + } while (q != h); + if (need_hull) { + h = mp_convex_hull(mp, h); + if (mp_pen_is_elliptical(h)) { + number_clone(h->left_x, h->x_coord); + number_clone(h->left_y, h->y_coord); + number_clone(h->right_x, h->x_coord); + number_clone(h->right_y, h->y_coord); + } + } + return h; +} + +static mp_knot mp_get_pen_circle (MP mp, mp_number *diam) +{ + mp_knot h = mp_new_knot(mp); + mp_next_knot(h) = h; + mp_prev_knot(h) = h; + mp_originator(h) = mp_program_code; + mp_knotstate(h) = mp_regular_knot; + set_number_to_zero(h->x_coord); + set_number_to_zero(h->y_coord); + number_clone(h->left_x, *diam); + set_number_to_zero(h->left_y); + set_number_to_zero(h->right_x); + number_clone(h->right_y, *diam); + return h; +} + +void mp_pr_pen (MP mp, mp_knot h) +{ + if (mp_pen_is_elliptical(h)) { + { + mp_number v1; + new_number(v1); + mp_print_str(mp, "pencircle transformed ("); + print_number(h->x_coord); + mp_print_chr(mp, ','); + print_number(h->y_coord); + mp_print_chr(mp, ','); + set_number_from_subtraction(v1, h->left_x, h->x_coord); + print_number(v1); + mp_print_chr(mp, ','); + set_number_from_subtraction(v1, h->right_x, h->x_coord); + print_number(v1); + mp_print_chr(mp, ','); + set_number_from_subtraction(v1, h->left_y, h->y_coord); + print_number(v1); + mp_print_chr(mp, ','); + set_number_from_subtraction(v1, h->right_y, h->y_coord); + print_number(v1); + mp_print_chr(mp, ')'); + free_number(v1); + } + } else { + mp_knot p = h; + do { + mp_knot q = mp_next_knot(p); + mp_print_two(mp, &(p->x_coord), &(p->y_coord)); + mp_print_nl(mp, " .. "); + if ((q == NULL) || (mp_prev_knot(q) != p)) { + mp_print_nl(mp, "???"); + return; + } + p = q; + } while (p != h); + mp_print_str(mp, "cycle"); + } +} + +void mp_print_pen (MP mp, mp_knot h, const char *s, int nuline) { + mp_print_diagnostic(mp, "Pen", s, nuline); + mp_print_ln(mp); + mp_pr_pen(mp, h); + mp_end_diagnostic(mp, 1); +} + +static void mp_make_path (MP mp, mp_knot h) +{ + if (mp_pen_is_elliptical(h)) { + mp_knot p; + mp_number center_x, center_y; + mp_number width_x, width_y; + mp_number height_x, height_y; + mp_number dx, dy; + new_number(width_x); + new_number(width_y); + new_number(height_x); + new_number(height_y); + new_number(dx); + new_number(dy); + new_number_clone(center_x, h->x_coord); + new_number_clone(center_y, h->y_coord); + set_number_from_subtraction(width_x, h->left_x, center_x); + set_number_from_subtraction(width_y, h->left_y, center_y); + set_number_from_subtraction(height_x, h->right_x, center_x); + set_number_from_subtraction(height_y, h->right_y, center_y); + p = h; + for (int k = 0; k <= 7; k++) { + + int kk = (k + 6) % 8; + mp_number r1, r2; + new_fraction(r1); + new_fraction(r2); + take_fraction(r1, mp->half_cos[k], width_x); + take_fraction(r2, mp->half_cos[kk], height_x); + number_add(r1, r2); + set_number_from_addition(p->x_coord, center_x, r1); + take_fraction(r1, mp->half_cos[k], width_y); + take_fraction(r2, mp->half_cos[kk], height_y); + number_add(r1, r2); + set_number_from_addition(p->y_coord, center_y, r1); + take_fraction(r1, mp->d_cos[kk], width_x); + take_fraction(r2, mp->d_cos[k], height_x); + number_negated_clone(dx, r1); + number_add(dx, r2); + take_fraction(r1, mp->d_cos[kk], width_y); + take_fraction(r2, mp->d_cos[k], height_y); + number_negated_clone(dy, r1); + number_add(dy, r2); + set_number_from_addition(p->right_x, p->x_coord, dx); + set_number_from_addition(p->right_y, p->y_coord, dy); + set_number_from_subtraction(p->left_x, p->x_coord, dx); + set_number_from_subtraction(p->left_y, p->y_coord, dy); + free_number(r1); + free_number(r2); + mp_left_type(p) = mp_explicit_knot; + mp_right_type(p) = mp_explicit_knot; + mp_originator(p) = mp_program_code; + mp_knotstate(p) = mp_regular_knot; + + if (k == 7) { + mp_prev_knot(h) = p; + mp_next_knot(p) = h; + } else { + mp_knot k = mp_new_knot(mp); + mp_prev_knot(k) = p; + mp_next_knot(p) = k; + } + p = mp_next_knot(p); + } + free_number(dx); + free_number(dy); + free_number(center_x); + free_number(center_y); + free_number(width_x); + free_number(width_y); + free_number(height_x); + free_number(height_y); + } else { + mp_knot p = h; + do { + mp_left_type(p) = mp_explicit_knot; + mp_right_type(p) = mp_explicit_knot; + number_clone(p->left_x, p->x_coord); + number_clone(p->left_y, p->y_coord); + number_clone(p->right_x, p->x_coord); + number_clone(p->right_y, p->y_coord); + p = mp_next_knot(p); + } while (p != h); + } +} + +mp_knot mp_convex_hull (MP mp, mp_knot h) +{ + if (mp_pen_is_elliptical(h)) { + return h; + } else { + mp_knot l, r; + mp_knot p, q; + mp_knot s; + mp_number dx, dy; + new_number(dx); + new_number(dy); + l = h; + p = mp_next_knot(h); + while (p != h) { + if (number_lessequal(p->x_coord, l->x_coord) && (number_less(p->x_coord, l->x_coord) || number_less(p->y_coord, l->y_coord))) { + l = p; + } + p = mp_next_knot(p); + } + r = h; + p = mp_next_knot(h); + while (p != h) { + if (number_greaterequal(p->x_coord, r->x_coord) && (number_greater(p->x_coord, r->x_coord) || number_greater(p->y_coord, r->y_coord))) { + r = p; + } + p = mp_next_knot(p); + } + if (l != r) { + mp_knot s = mp_next_knot(r); + { + mp_number arg1, arg2; + new_number(arg1); + new_number(arg2); + set_number_from_subtraction(dx, r->x_coord, l->x_coord); + set_number_from_subtraction(dy, r->y_coord, l->y_coord); + p = mp_next_knot(l); + while (p != r) { + q = mp_next_knot(p); + set_number_from_subtraction(arg1, p->y_coord, l->y_coord); + set_number_from_subtraction(arg2, p->x_coord, l->x_coord); + if (ab_vs_cd(dx, arg1, dy, arg2) > 0) { + mp_move_knot(mp, p, r); + } + p = q; + } + free_number(arg1); + free_number(arg2); + } + { + mp_number arg1, arg2; + new_number(arg1); + new_number(arg2); + p = s; + while (p != l) { + q = mp_next_knot(p); + set_number_from_subtraction(arg1, p->y_coord, l->y_coord); + set_number_from_subtraction(arg2, p->x_coord, l->x_coord); + if (ab_vs_cd(dx, arg1, dy, arg2) < 0) { + mp_move_knot(mp, p, l); + } + p = q; + } + free_number(arg1); + free_number(arg2); + } + p = mp_next_knot(l); + while (p != r) { + q = mp_prev_knot(p); + while (number_greater(q->x_coord, p->x_coord)) { + q = mp_prev_knot(q); + } + while (number_equal(q->x_coord, p->x_coord)) { + if (number_greater(q->y_coord, p->y_coord)) { + q = mp_prev_knot(q); + } else { + break; + } + } + if (q == mp_prev_knot(p)) { + p = mp_next_knot(p); + } else { + p = mp_next_knot(p); + mp_move_knot(mp, mp_prev_knot(p), q); + } + } + p = mp_next_knot(r); + while (p != l) { + q = mp_prev_knot(p); + while (number_less(q->x_coord, p->x_coord)) { + q = mp_prev_knot(q); + } + while (number_equal(q->x_coord, p->x_coord)) { + if (number_less(q->y_coord, p->y_coord)) { + q = mp_prev_knot(q); + } else { + break; + } + } + if (q == mp_prev_knot(p)) { + p = mp_next_knot(p); + } else { + p = mp_next_knot(p); + mp_move_knot(mp, mp_prev_knot(p), q); + } + } + } + if (l != mp_next_knot(l)) { + mp_number arg1, arg2; + new_number(arg1); + new_number(arg2); + p = l; + q = mp_next_knot(l); + while (1) { + set_number_from_subtraction(dx, q->x_coord, p->x_coord); + set_number_from_subtraction(dy, q->y_coord, p->y_coord); + p = q; + q = mp_next_knot(q); + if (p == l) { + break; + } else if (p != r) { + set_number_from_subtraction(arg1, q->y_coord, p->y_coord); + set_number_from_subtraction(arg2, q->x_coord, p->x_coord); + if (ab_vs_cd(dx, arg1, dy, arg2) <= 0) { + s = mp_prev_knot(p); + mp_memory_free(p); + mp_next_knot(s) = q; + mp_prev_knot(q) = s; + if (s == l) { + p = s; + } else { + p = mp_prev_knot(s); + q = s; + } + } + } + } + free_number(arg1); + free_number(arg2); + } + free_number(dx); + free_number(dy); + return l; + } +} + +void mp_simplify_path (MP mp, mp_knot h) +{ + mp_knot p = h; + (void) mp; + do { + p->left_x = p->x_coord; + p->left_y = p->y_coord; + p->right_x = p->x_coord; + p->right_y = p->y_coord; + p = mp_next_knot(p); + } while (p != h); +} + +void mp_move_knot (MP mp, mp_knot p, mp_knot q) +{ + (void) mp; + mp_next_knot(mp_prev_knot(p)) = mp_next_knot(p); + mp_prev_knot(mp_next_knot(p)) = mp_prev_knot(p); + mp_prev_knot(p) = q; + mp_next_knot(p) = mp_next_knot(q); + mp_next_knot(q) = p; + mp_prev_knot(mp_next_knot(p)) = p; +} + +static void mp_find_offset (MP mp, mp_number *x_orig, mp_number *y_orig, mp_knot h) +{ + if (mp_pen_is_elliptical(h)) { + mp_fraction xx, yy; + mp_number wx, wy, hx, hy; + mp_fraction d; + new_fraction(xx); + new_fraction(yy); + new_number(wx); + new_number(wy); + new_number(hx); + new_number(hy); + new_fraction(d); + if (number_zero(*x_orig) && number_zero(*y_orig)) { + number_clone(mp->cur_x, h->x_coord); + number_clone(mp->cur_y, h->y_coord); + } else { + mp_number x, y, abs_x, abs_y; + new_number_clone(x, *x_orig); + new_number_clone(y, *y_orig); + set_number_from_subtraction(wx, h->left_x, h->x_coord); + set_number_from_subtraction(wy, h->left_y, h->y_coord); + set_number_from_subtraction(hx, h->right_x, h->x_coord); + set_number_from_subtraction(hy, h->right_y, h->y_coord); + + new_number_abs(abs_x, x); + new_number_abs(abs_y, y); + while (number_less(abs_x, fraction_half_t) && number_less(abs_y, fraction_half_t)) { + number_double(x); + number_double(y); + number_abs_clone(abs_x, x); + number_abs_clone(abs_y, y); + } + { + mp_number r1, r2, arg1; + new_number(arg1); + new_fraction(r1); + new_fraction(r2); + take_fraction(r1, x, hy); + number_negated_clone(arg1, hx); + take_fraction(r2, y, arg1); + number_add(r1, r2); + number_negate(r1); + number_clone(yy, r1); + number_negated_clone(arg1, wy); + take_fraction(r1, x, arg1); + take_fraction(r2, y, wx); + number_add(r1, r2); + number_clone(xx, r1); + free_number(arg1); + free_number(r1); + free_number(r2); + } + pyth_add(d, xx, yy); + if (number_positive(d)) { + mp_number ret; + new_fraction(ret); + make_fraction(ret, xx, d); + number_half(ret); + number_clone(xx, ret); + make_fraction(ret, yy, d); + number_half(ret); + number_clone(yy, ret); + free_number(ret); + } + { + mp_number r1, r2; + new_fraction(r1); + new_fraction(r2); + take_fraction(r1, xx, wx); + take_fraction(r2, yy, hx); + number_add(r1, r2); + set_number_from_addition(mp->cur_x, h->x_coord, r1); + take_fraction(r1, xx, wy); + take_fraction(r2, yy, hy); + number_add(r1, r2); + set_number_from_addition(mp->cur_y, h->y_coord, r1); + free_number(r1); + free_number(r2); + } + free_number(abs_x); + free_number(abs_y); + free_number(x); + free_number(y); + } + free_number(xx); + free_number(yy); + free_number(wx); + free_number(wy); + free_number(hx); + free_number(hy); + free_number(d); + } else { + mp_knot p, q; + mp_number arg1, arg2; + new_number(arg1); + new_number(arg2); + q = h; + do { + p = q; + q = mp_next_knot(q); + set_number_from_subtraction(arg1, q->x_coord, p->x_coord); + set_number_from_subtraction(arg2, q->y_coord, p->y_coord); + } while (ab_vs_cd(arg1, *y_orig, arg2, *x_orig) < 0); + do { + p = q; + q = mp_next_knot(q); + set_number_from_subtraction(arg1, q->x_coord, p->x_coord); + set_number_from_subtraction(arg2, q->y_coord, p->y_coord); + } while (ab_vs_cd(arg1, *y_orig, arg2, *x_orig) > 0); + number_clone(mp->cur_x, p->x_coord); + number_clone(mp->cur_y, p->y_coord); + free_number(arg1); + free_number(arg2); + } +} + +static void mp_pen_bbox (MP mp, mp_knot h) +{ + if (mp_pen_is_elliptical(h)) { + mp_number arg1, arg2; + new_number(arg1); + new_fraction(arg2); + number_clone(arg2, fraction_one_t); + mp_find_offset(mp, &arg1, &arg2, h); + number_clone(mp_maxx, mp->cur_x); + number_clone(mp_minx, h->x_coord); + number_double(mp_minx); + number_subtract(mp_minx, mp->cur_x); + number_negate(arg2); + mp_find_offset(mp, &arg2, &arg1, h); + number_clone(mp_maxy, mp->cur_y); + number_clone(mp_miny, h->y_coord); + number_double(mp_miny); + number_subtract(mp_miny, mp->cur_y); + free_number(arg1); + free_number(arg2); + } else { + mp_knot p = mp_next_knot(h); + number_clone(mp_minx, h->x_coord); + number_clone(mp_maxx, mp_minx); + number_clone(mp_miny, h->y_coord); + number_clone(mp_maxy, mp_miny); + while (p != h) { + if (number_less(p->x_coord, mp_minx)) { + number_clone(mp_minx, p->x_coord); + } + if (number_less(p->y_coord, mp_miny)) { + number_clone(mp_miny, p->y_coord); + } + if (number_greater(p->x_coord, mp_maxx)) { + number_clone(mp_maxx, p->x_coord); + } + if (number_greater(p->y_coord, mp_maxy)) { + number_clone(mp_maxy, p->y_coord); + } + p = mp_next_knot(p); + } + } +} + +static mp_node mp_new_shape_node (MP mp, mp_knot p, int type) +{ + mp_shape_node t = mp_allocate_node(mp, sizeof(mp_shape_node_data)); + mp_type(t) = type; + mp_path_ptr(t) = p; + mp_pen_ptr(t) = NULL; + mp_dash_ptr(t) = NULL; + new_number(t->red); + new_number(t->green); + new_number(t->blue); + new_number(t->black); + new_number(t->miterlimit); + new_number(t->dashscale); + set_number_to_unity(t->dashscale); + mp_color_model(t) = mp_uninitialized_model; + mp_pen_type(t) = 0; + mp_pre_script(t) = NULL; + mp_post_script(t) = NULL; + if (number_greater(internal_value(mp_linejoin_internal), unity_t)) { + t->linejoin = mp_beveled_linejoin_code; + } else if (number_positive(internal_value(mp_linejoin_internal))) { + t->linejoin = mp_rounded_linejoin_code; + } else { + t->linejoin = mp_mitered_linejoin_code; + } + t->stacking = round_unscaled(internal_value(mp_stacking_internal)); + if (number_less(internal_value(mp_miterlimit_internal), unity_t)) { + set_number_to_unity(t->miterlimit); + } else { + number_clone(t->miterlimit, internal_value(mp_miterlimit_internal)); + } + if (number_greater(internal_value(mp_linecap_internal), unity_t)) { + t->linecap = mp_squared_linecap_code; + } else if (number_positive(internal_value(mp_linecap_internal))) { + t->linecap = mp_rounded_linecap_code; + } else { + t->linecap = mp_butt_linecap_code; + } + return (mp_node) t; +} + +static mp_edge_header_node mp_free_shape_node (MP mp, mp_shape_node p) +{ + mp_edge_header_node e = NULL; + mp_toss_knot_list(mp, mp_path_ptr(p)); + if (mp_pen_ptr(p) != NULL) { + mp_toss_knot_list(mp, mp_pen_ptr(p)); + } + if (mp_pre_script(p) != NULL) { + delete_str_ref(mp_pre_script(p)); + } + if (mp_post_script(p) != NULL) { + delete_str_ref(mp_post_script(p)); + } + e = (mp_edge_header_node) mp_dash_ptr(p); + free_number(p->red); + free_number(p->green); + free_number(p->blue); + free_number(p->black); + free_number(p->miterlimit); + free_number(p->dashscale); + mp_free_node(mp, (mp_node) p, sizeof(mp_shape_node_data)); + return e ; +} + +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) +{ + mp_number a, b, c, d; + mp_number maxabs; + unsigned s = 64; + mp_number tmp; + new_number_clone(a, *a_orig); + new_number_clone(b, *b_orig); + new_number_clone(c, *c_orig); + new_number_clone(d, *d_orig); + new_number_abs(maxabs, a); + new_number_abs(tmp, b); + if (number_greater(tmp, maxabs)) { + number_clone(maxabs, tmp); + } + number_abs_clone(tmp, c); + if (number_greater(tmp, maxabs)) { + number_clone(maxabs, tmp); + } + number_abs_clone(tmp, d); + if (number_greater(tmp, maxabs)) { + number_clone(maxabs, tmp); + } + free_number(tmp); + while ((number_less(maxabs, fraction_one_t)) && (s > 1)) { + number_double(a); + number_double(b); + number_double(c); + number_double(d); + number_double(maxabs); + s = s/2; + } + { + mp_number r1, r2; + new_fraction(r1); + new_fraction(r2); + take_fraction(r1, a, d); + take_fraction(r2, b, c); + number_subtract(r1, r2); + number_abs(r1); + square_rt(*ret, r1); + number_multiply_int(*ret, s); + free_number(r1); + free_number(r2); + } + free_number(a); + free_number(b); + free_number(c); + free_number(d); + free_number(maxabs); +} + +static void mp_get_pen_scale (MP mp, mp_number *ret, mp_knot p) +{ + if (p == NULL) { + set_number_to_zero(*ret); + } else { + mp_number a, b, c, d; + new_number(a); + new_number(b); + new_number(c); + new_number(d); + set_number_from_subtraction(a, p->left_x, p->x_coord); + set_number_from_subtraction(b, p->right_x, p->x_coord); + set_number_from_subtraction(c, p->left_y, p->y_coord); + set_number_from_subtraction(d, p->right_y, p->y_coord); + mp_sqrt_det(mp, ret, &a, &b, &c, &d); + free_number(a); + free_number(b); + free_number(c); + free_number(d); + } +} + +static mp_node mp_new_bounds_node (MP mp, mp_knot p, int c) +{ + switch (c) { + case mp_start_clip_node_type: + case mp_start_group_node_type: + case mp_start_bounds_node_type: + { + mp_start_node t = (mp_start_node) mp_allocate_node(mp, sizeof(mp_start_node_data)); + mp_type(t) = c; + t->path = p; + t->link = NULL; + t->stacking = round_unscaled(internal_value(mp_stacking_internal)); + mp_pre_script(t) = NULL; + mp_post_script(t) = NULL; + return (mp_node) t; + } + break; + case mp_stop_clip_node_type: + case mp_stop_group_node_type: + case mp_stop_bounds_node_type: + { + mp_stop_node t = (mp_stop_node) mp_allocate_node(mp, sizeof(mp_stop_node_data)); + mp_type(t) = c; + t->link = NULL; + t->stacking = round_unscaled(internal_value(mp_stacking_internal)); + return (mp_node) t; + } + break; + default: + break; + } + return NULL; +} + +static void mp_free_start_node (MP mp, mp_start_node p) +{ + mp_toss_knot_list(mp, mp_path_ptr(p)); + if (mp_pre_script(p) != NULL) { + delete_str_ref(mp_pre_script(p)); + } + if (mp_post_script(p) != NULL) { + delete_str_ref(mp_post_script(p)); + } + mp_free_node(mp, (mp_node) p, sizeof(mp_start_node_data)); +} + +static void mp_free_stop_node (MP mp, mp_stop_node p) +{ + mp_free_node(mp, (mp_node) p, sizeof(mp_stop_node_data)); +} + +static mp_dash_node mp_get_dash_node (MP mp) +{ + mp_dash_node p = (mp_dash_node) mp_allocate_node(mp, sizeof(mp_dash_node_data)); + p->hasnumber = 0; + new_number(p->start_x); + new_number(p->stop_x); + new_number(p->dash_y); + mp_type(p) = mp_dash_node_type; + return p; +} + +static void mp_init_bbox (MP mp, mp_edge_header_node h) +{ + (void) mp; + mp_bblast(h) = mp_edge_list(h); + h->bbtype = mp_no_bounds_code; + set_number_to_inf(h->minx); + set_number_to_inf(h->miny); + set_number_to_negative_inf(h->maxx); + set_number_to_negative_inf(h->maxy); +} + +static mp_edge_header_node mp_get_edge_header_node (MP mp) +{ + mp_edge_header_node p = (mp_edge_header_node) mp_allocate_node(mp, sizeof(mp_edge_header_node_data)); + mp_type(p) = mp_edge_header_node_type; + new_number(p->start_x); + new_number(p->stop_x); + new_number(p->dash_y); + new_number(p->minx); + new_number(p->miny); + new_number(p->maxx); + new_number(p->maxy); + p->list = mp_new_token_node(mp); + return p; +} + +static void mp_init_edges (MP mp, mp_edge_header_node h) +{ + mp_set_dash_list(h, mp->null_dash); + mp_obj_tail(h) = mp_edge_list(h); + mp_link(mp_edge_list(h)) = NULL; + mp_edge_ref_count(h) = 0; + mp_init_bbox(mp, h); +} + +void mp_toss_edges (MP mp, mp_edge_header_node h) +{ + mp_node q; + mp_edge_header_node r; + mp_flush_dash_list(mp, h); + q = mp_link(mp_edge_list(h)); + while (q != NULL) { + mp_node p = q; + q = mp_link(q); + r = mp_toss_gr_object(mp, p); + if (r != NULL) { + mp_delete_edge_ref(mp, r); + } + } + free_number(h->start_x); + free_number(h->stop_x); + free_number(h->dash_y); + free_number(h->minx); + free_number(h->miny); + free_number(h->maxx); + free_number(h->maxy); + mp_free_token_node(mp, h->list); + mp_free_node(mp, (mp_node) h, sizeof(mp_edge_header_node_data)); +} + +void mp_flush_dash_list (MP mp, mp_edge_header_node h) +{ + mp_dash_node q = mp_get_dash_list(h); + while (q != mp->null_dash) { + mp_dash_node p = q; + q = (mp_dash_node) mp_link(q); + mp_free_node(mp, (mp_node) p, sizeof(mp_dash_node_data)); + } + mp_set_dash_list(h, mp->null_dash); +} + +mp_edge_header_node mp_toss_gr_object (MP mp, mp_node p) +{ + switch (mp_type(p)) { + case mp_fill_node_type: + case mp_stroked_node_type: + return mp_free_shape_node(mp, (mp_shape_node) p); + case mp_start_clip_node_type: + case mp_start_group_node_type: + case mp_start_bounds_node_type: + mp_free_start_node(mp, (mp_start_node) p); + return NULL; + case mp_stop_clip_node_type: + case mp_stop_group_node_type: + case mp_stop_bounds_node_type: + mp_free_stop_node(mp, (mp_stop_node) p); + return NULL; + default: + return NULL; + } +} + +static mp_edge_header_node mp_private_edges (MP mp, mp_edge_header_node h) +{ + if (mp_edge_ref_count(h) == 0) { + return h; + } else { + mp_edge_header_node hh; + mp_dash_node p, pp; + mp_edge_ref_count(h) -= 1; + hh = (mp_edge_header_node) mp_copy_objects (mp, mp_link(mp_edge_list(h)), NULL); + pp = (mp_dash_node) hh; + p = mp_get_dash_list(h); + while ((p != mp->null_dash)) { + mp_link(pp) = (mp_node) mp_get_dash_node(mp); + pp = (mp_dash_node) mp_link(pp); + number_clone(pp->start_x, p->start_x); + number_clone(pp->stop_x, p->stop_x); + p = (mp_dash_node) mp_link(p); + } + mp_link(pp) = (mp_node) mp->null_dash; + number_clone(hh->dash_y, h->dash_y); + + number_clone(hh->minx, h->minx); + number_clone(hh->miny, h->miny); + number_clone(hh->maxx, h->maxx); + number_clone(hh->maxy, h->maxy); + hh->bbtype = h->bbtype; + p = (mp_dash_node) mp_edge_list(h); + pp = (mp_dash_node) mp_edge_list(hh); + while ((p != (mp_dash_node) mp_bblast(h))) { + if (p == NULL) { + mp_confusion(mp, "boundingbox last"); + } else { + p = (mp_dash_node) mp_link(p); + pp = (mp_dash_node) mp_link(pp); + } + } + mp_bblast(hh) = (mp_node) pp; + + return hh; + } +} + +static mp_dash_object *mp_export_dashes (MP mp, mp_shape_node q, mp_number *w) +{ + mp_dash_node h = (mp_dash_node) mp_dash_ptr(q); + if (h == NULL || mp_get_dash_list(h) == mp->null_dash) { + return NULL; + } else { + mp_dash_object *d; + mp_dash_node p; + mp_number scf; + mp_number dashoff; + double *dashes = NULL; + int num_dashes = 1; + new_number(scf); + p = mp_get_dash_list(h); + mp_get_pen_scale(mp, &scf, mp_pen_ptr(q)); + if (number_zero(scf)) { + if (number_zero(*w)) { + number_clone(scf, q->dashscale); + } else { + free_number(scf); + return NULL; + } + } else { + mp_number ret; + new_number(ret); + make_scaled(ret, *w, scf); + take_scaled(scf, ret, q->dashscale); + free_number(ret); + } + number_clone(*w, scf); + d = mp_allocate_dash(mp); + set_number_from_addition(mp->null_dash->start_x, p->start_x, h->dash_y); + { + mp_number ret, arg1; + new_number(ret); + new_number(arg1); + new_number(dashoff); + while (p != mp->null_dash) { + dashes = mp_memory_reallocate(dashes, (size_t) (num_dashes + 2) * sizeof(double)); + set_number_from_subtraction(arg1, p->stop_x, p->start_x); + take_scaled(ret, arg1, scf); + dashes[(num_dashes - 1)] = number_to_double(ret); + set_number_from_subtraction(arg1, ((mp_dash_node) mp_link(p))->start_x, p->stop_x); + take_scaled(ret, arg1, scf); + dashes[(num_dashes)] = number_to_double(ret); + dashes[(num_dashes + 1)] = -1.0; + num_dashes += 2; + p = (mp_dash_node) mp_link(p); + } + d->array = dashes; + mp_dash_offset(mp, &dashoff, h); + take_scaled(ret, dashoff, scf); + d->offset = number_to_double(ret); + free_number(ret); + free_number(arg1); + } + free_number(dashoff); + free_number(scf); + return d; + } +} + +mp_edge_header_node mp_copy_objects (MP mp, mp_node p, mp_node q) { + mp_node pp; + int k = 0; + mp_edge_header_node hh = mp_get_edge_header_node(mp); + mp_set_dash_list(hh, mp->null_dash); + mp_edge_ref_count(hh) = 0; + pp = mp_edge_list(hh); + while (p != q) { + { + switch (mp_type(p)) { + case mp_fill_node_type: + case mp_stroked_node_type: + k = sizeof(mp_shape_node_data); + break; + case mp_start_clip_node_type: + case mp_start_group_node_type: + case mp_start_bounds_node_type: + k = sizeof(mp_start_node_data); + break; + case mp_stop_clip_node_type: + case mp_stop_group_node_type: + case mp_stop_bounds_node_type: + k = sizeof(mp_stop_node_data); + break; + default: + break; + } + mp_link(pp) = mp_allocate_node(mp, (size_t) k); + pp = mp_link(pp); + memcpy(pp, p, (size_t) k); + pp->link = NULL; + switch (mp_type(p)) { + case mp_fill_node_type: + case mp_stroked_node_type: + { + mp_shape_node tt = (mp_shape_node) pp; + mp_shape_node t = (mp_shape_node) p; + new_number_clone(tt->red, t->red); + new_number_clone(tt->green, t->green); + new_number_clone(tt->blue, t->blue); + new_number_clone(tt->black, t->black); + new_number_clone(tt->miterlimit, t->miterlimit); + new_number_clone(tt->dashscale, t->dashscale); + mp_path_ptr(tt) = mp_copy_path(mp, mp_path_ptr(t)); + if (mp_pre_script(p) != NULL) { + add_str_ref(mp_pre_script(p)); + } + if (mp_post_script(p) != NULL) { + add_str_ref(mp_post_script(p)); + } + if (mp_pen_ptr(t) != NULL) { + mp_pen_ptr(tt) = mp_copy_pen(mp, mp_pen_ptr(t)); + } + if (mp_dash_ptr(p) != NULL) { + mp_add_edge_ref(mp, mp_dash_ptr(pp)); + } + } + break; + case mp_start_clip_node_type: + case mp_start_group_node_type: + case mp_start_bounds_node_type: + { + mp_start_node tt = (mp_start_node) pp; + mp_start_node t = (mp_start_node) p; + mp_path_ptr(tt) = mp_copy_path(mp, mp_path_ptr(t)); + if (mp_pre_script(p) != NULL) { + add_str_ref(mp_pre_script(p)); + } + if (mp_post_script(p) != NULL) { + add_str_ref(mp_post_script(p)); + } + } + break; + case mp_stop_clip_node_type: + case mp_stop_group_node_type: + case mp_stop_bounds_node_type: + break; + default: + break; + } + p = mp_link(p); + } + } + mp_obj_tail(hh) = pp; + mp_link(pp) = NULL; + return hh; +} + +static mp_node mp_skip_1component (MP mp, mp_node p) +{ + int lev = 0; + (void) mp; + do { + if (mp_is_start_or_stop (p)) { + if (mp_is_stop(p)) { + --lev; + } else { + ++lev; + } + } + p = mp_link(p); + } while (lev != 0); + return p; +} + +void mp_print_edges (MP mp, mp_node h, const char *s, int nuline) +{ + mp_node p = mp_edge_list(h); + mp_number scf; + new_number(scf); + mp_print_diagnostic(mp, "Edge structure", s, nuline); + while (mp_link(p) != NULL) { + p = mp_link(p); + mp_print_ln(mp); + switch (mp_type(p)) { + case mp_fill_node_type: + mp_print_str(mp, "Filled contour "); + mp_print_obj_color (mp, p); + mp_print_chr(mp, ':'); + mp_print_ln(mp); + mp_pr_path(mp, mp_path_ptr((mp_shape_node) p)); + mp_print_ln(mp); + if ((mp_pen_ptr((mp_shape_node) p) != NULL)) { + switch (((mp_shape_node) p)->linejoin) { + case mp_mitered_linejoin_code: + mp_print_str(mp, "mitered joins limited "); + print_number(((mp_shape_node) p)->miterlimit); + break; + case mp_rounded_linejoin_code: + mp_print_str(mp, "round joins"); + break; + case mp_beveled_linejoin_code: + mp_print_str(mp, "beveled joins"); + break; + default: + mp_print_str(mp, "?? joins"); + break; + } + mp_print_str(mp, " with pen"); + mp_print_ln(mp); + mp_pr_pen(mp, mp_pen_ptr((mp_shape_node) p)); + } + break; + case mp_stroked_node_type: + mp_print_str(mp, "Filled pen stroke "); + mp_print_obj_color (mp, p); + mp_print_chr(mp, ':'); + mp_print_ln(mp); + mp_pr_path(mp, mp_path_ptr((mp_shape_node) p)); + if (mp_dash_ptr(p) != NULL) { + mp_dash_node ppd, hhd; + int ok_to_dash = mp_pen_is_elliptical(mp_pen_ptr((mp_shape_node) p)); + mp_print_nl(mp, "dashed ("); + if (! ok_to_dash) { + set_number_to_unity(scf); + } else { + number_clone(scf, ((mp_shape_node) p)->dashscale); + } + hhd = (mp_dash_node) mp_dash_ptr(p); + ppd = mp_get_dash_list(hhd); + if ((ppd == mp->null_dash) || number_negative(hhd->dash_y)) { + mp_print_str(mp, " ??"); + } else { + mp_number dashoff; + mp_number ret, arg1; + new_number(ret); + new_number(arg1); + new_number(dashoff); + set_number_from_addition(mp->null_dash->start_x, ppd->start_x, hhd->dash_y ); + while (ppd != mp->null_dash) { + mp_print_str(mp, "on "); + set_number_from_subtraction(arg1, ppd->stop_x, ppd->start_x); + take_scaled(ret, arg1, scf); + print_number( ret); + mp_print_str(mp, " off "); + set_number_from_subtraction(arg1, ((mp_dash_node) mp_link(ppd))->start_x, ppd->stop_x); + take_scaled(ret, arg1, scf); + print_number(ret); + ppd = (mp_dash_node) mp_link(ppd); + if (ppd != mp->null_dash) { + mp_print_chr(mp, ' '); + } + } + mp_print_str(mp, ") shifted "); + mp_dash_offset(mp, &dashoff, hhd); + take_scaled(ret, dashoff, scf); + number_negate(ret); + print_number(ret); + free_number(dashoff); + free_number(ret); + free_number(arg1); + if (!ok_to_dash || number_zero(hhd->dash_y)) { + mp_print_str(mp, " (this will be ignored)"); + } + } + } + mp_print_ln(mp); + switch (((mp_shape_node) p)->linecap) { + case mp_butt_linecap_code: + mp_print_str(mp, "butt"); + break; + case mp_rounded_linecap_code: + mp_print_str(mp, "round"); + break; + case mp_squared_linecap_code: + mp_print_str(mp, "square"); + break; + default: + mp_print_str(mp, "??"); + break; + } + mp_print_str(mp, " ends, "); + switch (((mp_shape_node) p)->linejoin) { + case mp_mitered_linejoin_code: + mp_print_str(mp, "mitered joins limited "); + print_number(((mp_shape_node) p)->miterlimit); + break; + case mp_rounded_linejoin_code: + mp_print_str(mp, "round joins"); + break; + case mp_beveled_linejoin_code: + mp_print_str(mp, "beveled joins"); + break; + default: + mp_print_str(mp, "?? joins"); + break; + } + + mp_print_str(mp, " with pen"); + mp_print_ln(mp); + if (mp_pen_ptr((mp_shape_node) p) == NULL) { + mp_print_str(mp, "???"); + } else { + mp_pr_pen(mp, mp_pen_ptr((mp_shape_node) p)); + } + break; + case mp_start_clip_node_type: + mp_print_str(mp, "clipping path:"); + goto COMMONSTART; + case mp_start_group_node_type: + mp_print_str(mp, "setgroup path:"); + goto COMMONSTART; + case mp_start_bounds_node_type: + mp_print_str(mp, "setbounds path:"); + COMMONSTART: + mp_print_ln(mp); + mp_pr_path(mp, mp_path_ptr((mp_start_node) p)); + break; + case mp_stop_clip_node_type: + mp_print_str(mp, "stop clipping"); + break; + case mp_stop_group_node_type: + mp_print_str(mp, "stop group"); + break; + case mp_stop_bounds_node_type: + mp_print_str(mp, "end of setbounds"); + break; + + default: + mp_print_str(mp, "[unknown object type!]"); + break; + } + } + mp_print_nl(mp, "End edges"); + if (p != mp_obj_tail(h)) { + mp_print_str(mp, "?"); + } + mp_end_diagnostic(mp, 1); + free_number(scf); +} + +void mp_print_obj_color (MP mp, mp_node p) +{ + mp_shape_node p0 = (mp_shape_node) p; + switch (mp_color_model(p)) { + case mp_grey_model: + if (number_positive(p0->grey)) { + mp_print_str(mp, "greyed "); + mp_print_chr(mp, '('); + print_number(p0->grey); + mp_print_chr(mp, ')'); + }; + break; + case mp_cmyk_model: + if (number_positive(p0->cyan) || number_positive(p0->magenta) + || number_positive(p0->yellow) || number_positive(p0->black)) { + mp_print_str(mp, "processcolored "); + mp_print_chr(mp, '('); + print_number(p0->cyan); + mp_print_chr(mp, ','); + print_number(p0->magenta); + mp_print_chr(mp, ','); + print_number(p0->yellow); + mp_print_chr(mp, ','); + print_number(p0->black); + mp_print_chr(mp, ')'); + }; + break; + case mp_rgb_model: + if (number_positive(p0->red) || number_positive(p0->green) || number_positive(p0->blue)) { + mp_print_str(mp, "colored "); + mp_print_chr(mp, '('); + print_number(p0->red); + mp_print_chr(mp, ','); + print_number(p0->green); + mp_print_chr(mp, ','); + print_number(p0->blue); + mp_print_chr(mp, ')'); + } + break; + default: + break; + } +} + +void mp_dash_offset (MP mp, mp_number *x, mp_dash_node h) +{ + if (mp_get_dash_list(h) == mp->null_dash || number_negative(h->dash_y)) { + mp_confusion(mp, "dash offset"); + } else if (number_zero(h->dash_y)) { + set_number_to_zero(*x); + } else { + number_clone(*x, (mp_get_dash_list(h))->start_x); + number_modulo(*x, h->dash_y); + number_negate(*x); + if (number_negative(*x)) { + number_add(*x, h->dash_y); + } + } +} + +static mp_edge_header_node mp_make_dashes (MP mp, mp_edge_header_node h) +{ + if (mp_get_dash_list(h) != mp->null_dash) { + return h; + } else { + mp_node p; + mp_node p0; + mp_knot pp, qq, rr; + mp_dash_node d, dd; + mp_number y0; + mp_dash_node dln; + mp_edge_header_node hh; + mp_node ds; + + new_number(y0); + p0 = NULL; + p = mp_link(mp_edge_list(h)); + while (p != NULL) { + if (mp_type(p) != mp_stroked_node_type) { + mp_back_error( + mp, + "Picture is too complicated to use as a dash pattern", + "When you say 'dashed p', picture p should not contain any text, filled regions,\n" + "or clipping paths. This time it did so I'll just make it a solid line instead." + ); + mp_get_x_next(mp); + goto NOT_FOUND; + } + pp = mp_path_ptr((mp_shape_node) p); + if (p0 == NULL) { + p0 = p; + number_clone(y0, pp->y_coord); + } + if (! number_equal(((mp_shape_node) p)->red, ((mp_shape_node) p0)->red) + || ! number_equal(((mp_shape_node) p)->black, ((mp_shape_node) p0)->black) + || ! number_equal(((mp_shape_node) p)->green, ((mp_shape_node) p0)->green) + || ! number_equal(((mp_shape_node) p)->blue, ((mp_shape_node) p0)->blue) + ) { + mp_back_error( + mp, + "Picture is too complicated to use as a dash pattern", + "When you say 'dashed p', everything in picture p should be the same color. I\n" + "can't handle your color changes so I'll just make it a solid line instead." + ); + mp_get_x_next(mp); + goto NOT_FOUND; + } + rr = pp; + if (mp_next_knot(pp) != pp) { + do { + qq = rr; + rr = mp_next_knot(rr); + { + mp_number x0, x1, x2, x3; + new_number_clone(x0, qq->x_coord); + new_number_clone(x1, qq->right_x); + new_number_clone(x2, rr->left_x); + new_number_clone(x3, rr->x_coord); + if (number_greater(x0, x1) || number_greater(x1, x2) || number_greater(x2, x3)) { + if (number_less(x0, x1) || number_less(x1, x2) || number_less(x2, x3)) { + mp_number a1, a2, a3, a4; + int test; + new_number(a1); + new_number(a2); + new_number(a3); + new_number(a4); + set_number_from_subtraction(a1, x2, x1); + set_number_from_subtraction(a2, x2, x1); + set_number_from_subtraction(a3, x1, x0); + set_number_from_subtraction(a4, x3, x2); + test = ab_vs_cd(a1, a2, a3, a4); + free_number(a1); + free_number(a2); + free_number(a3); + free_number(a4); + if (test > 0) { + mp_x_retrace_error(mp); + free_number(x0); + free_number(x1); + free_number(x2); + free_number(x3); + goto NOT_FOUND; + } + } + } + if (number_greater(pp->x_coord, x0) || number_greater(x0, x3)) { + if (number_less(pp->x_coord, x0) || number_less(x0, x3)) { + mp_x_retrace_error(mp); + free_number(x0); + free_number(x1); + free_number(x2); + free_number(x3); + goto NOT_FOUND; + } + } + free_number(x0); + free_number(x1); + free_number(x2); + free_number(x3); + } + } while (mp_right_type(rr) != mp_endpoint_knot); + } + d = (mp_dash_node) mp_get_dash_node(mp); + if (mp_dash_ptr(p) == NULL) { + mp_dash_info(d) = NULL; + } else { + mp_dash_info(d) = p; + } + if (number_less(pp->x_coord, rr->x_coord)) { + number_clone(d->start_x, pp->x_coord); + number_clone(d->stop_x, rr->x_coord); + } else { + number_clone(d->start_x, rr->x_coord); + number_clone(d->stop_x, pp->x_coord); + } + number_clone(mp->null_dash->start_x, d->stop_x); + dd = (mp_dash_node) h; + while (number_less(((mp_dash_node) mp_link(dd))->start_x, d->stop_x)) { + dd = (mp_dash_node) mp_link(dd); + } + if ((dd != (mp_dash_node) h) && number_greater(dd->stop_x, d->start_x)) { + mp_x_retrace_error(mp); + goto NOT_FOUND; + } + mp_link(d) = mp_link(dd); + mp_link(dd) = (mp_node) d; + + p = mp_link(p); + } + if (mp_get_dash_list(h) == mp->null_dash) { + goto NOT_FOUND; + } else { + { + mp_number hsf; + new_number(hsf); + d = (mp_dash_node) h; + while (mp_link(d) != (mp_node) mp->null_dash) { + ds = mp_dash_info(mp_link(d)); + if (ds == NULL) { + d = (mp_dash_node) mp_link(d); + } else { + hh = (mp_edge_header_node) mp_dash_ptr(ds); + number_clone(hsf, ((mp_shape_node) ds)->dashscale); + if (hh == NULL) { + mp_confusion(mp, "dash pattern"); + return NULL; + } else if (number_zero(((mp_dash_node) hh)->dash_y )) { + d = (mp_dash_node) mp_link(d); + } else if (mp_get_dash_list (hh) == NULL) { + mp_confusion(mp, "dash list"); + return NULL; + } else { + mp_number xoff; + mp_number dashoff; + mp_number r1, r2; + new_number(r1); + new_number(r2); + dln = (mp_dash_node) mp_link(d); + dd = mp_get_dash_list(hh); + new_number(xoff); + new_number(dashoff); + mp_dash_offset(mp, &dashoff, (mp_dash_node) hh); + take_scaled(r1, hsf, dd->start_x); + take_scaled(r2, hsf, dashoff); + number_add(r1, r2); + set_number_from_subtraction(xoff, dln->start_x, r1); + free_number(dashoff); + take_scaled(r1, hsf, dd->start_x); + take_scaled(r2, hsf, hh->dash_y); + set_number_from_addition(mp->null_dash->start_x, r1, r2); + number_clone(mp->null_dash->stop_x, mp->null_dash->start_x); + { + mp_number r1; + new_number(r1); + take_scaled(r1, hsf, dd->stop_x); + number_add(r1, xoff); + while (number_less(r1, dln->start_x)) { + dd = (mp_dash_node) mp_link(dd); + take_scaled(r1, hsf, dd->stop_x); + number_add(r1, xoff); + } + free_number(r1); + } + while (number_lessequal(dln->start_x, dln->stop_x)) { + if (dd == mp->null_dash) { + mp_number ret; + new_number(ret); + dd = mp_get_dash_list(hh); + take_scaled(ret, hsf, hh->dash_y); + number_add(xoff, ret); + free_number(ret); + } + { + mp_number r1; + new_number(r1); + take_scaled(r1, hsf, dd->start_x); + number_add(r1, xoff); + if (number_lessequal(r1, dln->stop_x)) { + mp_link(d) = (mp_node) mp_get_dash_node(mp); + d = (mp_dash_node) mp_link(d); + mp_link(d) = (mp_node) dln; + take_scaled(r1, hsf, dd->start_x ); + number_add(r1, xoff); + if (number_greater(dln->start_x, r1)) { + number_clone(d->start_x, dln->start_x); + } else { + number_clone(d->start_x, r1); + } + take_scaled(r1, hsf, dd->stop_x); + number_add(r1, xoff); + if (number_less(dln->stop_x, r1)) { + number_clone(d->stop_x, dln->stop_x ); + } else { + number_clone(d->stop_x, r1); + } + } + free_number(r1); + } + dd = (mp_dash_node) mp_link(dd); + take_scaled(r1, hsf, dd->start_x); + set_number_from_addition(dln->start_x , xoff, r1); + } + free_number(xoff); + free_number(r1); + free_number(r2); + mp_link(d) = mp_link(dln); + mp_free_node(mp, (mp_node) dln, sizeof(mp_dash_node_data)); + } + } + } + free_number(hsf); + } + d = mp_get_dash_list(h); + while (mp_link(d) != (mp_node) mp->null_dash) { + d = (mp_dash_node) mp_link(d); + } + dd = mp_get_dash_list(h); + set_number_from_subtraction(h->dash_y, d->stop_x, dd->start_x); + { + mp_number absval; + new_number(absval); + number_abs_clone(absval, y0); + if (number_greater(absval, h->dash_y) ) { + number_clone(h->dash_y, absval); + } else if (d != dd) { + mp_set_dash_list(h, mp_link(dd)); + set_number_from_addition(d->stop_x, dd->stop_x, h->dash_y); + mp_free_node(mp, (mp_node) dd, sizeof(mp_dash_node_data)); + } + free_number(absval); + } + free_number(y0); + return h; + } + NOT_FOUND: + free_number(y0); + mp_flush_dash_list(mp, h); + mp_delete_edge_ref(mp, h); + return NULL; + } +} + +void mp_x_retrace_error (MP mp) +{ + mp_back_error( + mp, + "Picture is too complicated to use as a dash pattern", + "When you say 'dashed p', every path in p should be monotone in x and there must\n" + "be no overlapping. This failed so I'll just make it a solid line instead." + ); + mp_get_x_next(mp); +} + +static void mp_adjust_bbox (MP mp, mp_edge_header_node h) +{ + if (number_less(mp_minx, h->minx)) { + number_clone(h->minx, mp_minx); + } + if (number_less(mp_miny, h->miny)) { + number_clone(h->miny, mp_miny); + } + if (number_greater(mp_maxx, h->maxx)) { + number_clone(h->maxx, mp_maxx); + } + if (number_greater(mp_maxy, h->maxy)) { + number_clone(h->maxy, mp_maxy); + } +} + +static void mp_box_ends (MP mp, mp_knot p, mp_knot pp, mp_edge_header_node h) +{ + if (mp_right_type(p) != mp_endpoint_knot) { + mp_fraction dx, dy; + mp_number d; + mp_number z; + mp_number xx, yy; + new_fraction(dx); + new_fraction(dy); + new_number(xx); + new_number(yy); + new_number(z); + new_number(d); + mp_knot q = mp_next_knot(p); + while (1) { + if (q == mp_next_knot(p)) { + set_number_from_subtraction(dx, p->x_coord, p->right_x); + set_number_from_subtraction(dy, p->y_coord, p->right_y); + if (number_zero(dx) && number_zero(dy)) { + set_number_from_subtraction(dx, p->x_coord, q->left_x); + set_number_from_subtraction(dy, p->y_coord, q->left_y); + } + } else { + set_number_from_subtraction(dx, p->x_coord, p->left_x); + set_number_from_subtraction(dy, p->y_coord, p->left_y); + if (number_zero(dx) && number_zero(dy)) { + set_number_from_subtraction(dx, p->x_coord, q->right_x); + set_number_from_subtraction(dy, p->y_coord, q->right_y); + } + } + set_number_from_subtraction(dx, p->x_coord, q->x_coord); + set_number_from_subtraction(dy, p->y_coord, q->y_coord); + + pyth_add(d, dx, dy); + if (number_positive(d)) { + mp_number arg1, r; + new_fraction(r); + new_number(arg1); + make_fraction(r, dx, d); + number_clone(dx, r); + make_fraction(r, dy, d); + number_clone(dy, r); + free_number(r); + number_negated_clone(arg1, dy); + mp_find_offset(mp, &arg1, &dx, pp); + free_number(arg1); + number_clone(xx, mp->cur_x); + number_clone(yy, mp->cur_y); + + for (int i = 1; i <= 2; i++) { + mp_number r1, r2, arg1; + new_number(arg1); + new_fraction(r1); + new_fraction(r2); + mp_find_offset(mp, &dx, &dy, pp); + set_number_from_subtraction(arg1, xx, mp->cur_x); + take_fraction(r1, arg1, dx); + set_number_from_subtraction(arg1, yy, mp->cur_y); + take_fraction(r2, arg1, dy); + set_number_from_addition(d, r1, r2); + if ((number_negative(d) && (i == 1)) || (number_positive(d) && (i == 2))) { + mp_confusion(mp, "box ends"); + } + take_fraction(r1, d, dx); + set_number_from_addition(z, p->x_coord, mp->cur_x); + number_add(z, r1); + if (number_less(z, h->minx)) { + number_clone(h->minx, z); + } + if (number_greater(z, h->maxx)) { + number_clone(h->maxx, z); + } + take_fraction(r1, d, dy); + set_number_from_addition(z, p->y_coord, mp->cur_y); + number_add(z, r1); + if (number_less(z, h->miny)) { + number_clone(h->miny, z); + } + if (number_greater(z, h->maxy)) { + number_clone(h->maxy, z); + } + free_number(r1); + free_number(r2); + free_number(arg1); + + number_negate(dx); + number_negate(dy); + } + } + if (mp_right_type(p) == mp_endpoint_knot) { + goto DONE; + } else { + do { + q = p; + p = mp_next_knot(p); + } while (mp_right_type(p) != mp_endpoint_knot); + } + } + DONE: + free_number(dx); + free_number(dy); + free_number(xx); + free_number(yy); + free_number(z); + free_number(d); + } +} + +void mp_set_bbox (MP mp, mp_edge_header_node h, int top_level) +{ + switch (h->bbtype ) { + case mp_no_bounds_code: + break; + case mp_bounds_set_code: + if (number_positive(internal_value(mp_true_corners_internal))) { + mp_init_bbox(mp, h); + } + break; + case mp_bounds_unset_code: + if (number_nonpositive(internal_value(mp_true_corners_internal))) { + mp_init_bbox(mp, h); + } + break; + } + while (mp_link(mp_bblast(h)) != NULL) { + mp_node p = mp_link(mp_bblast(h)); + mp_bblast(h) = p; + switch (mp_type(p)) { + case mp_stop_clip_node_type: + if (top_level) { + mp_confusion(mp, "clip"); + break; + } else { + return; + } + case mp_start_bounds_node_type: + if (number_positive(internal_value(mp_true_corners_internal))) { + h->bbtype = mp_bounds_unset_code; + } else { + h->bbtype = mp_bounds_set_code; + mp_path_bbox(mp, mp_path_ptr((mp_start_node) p)); + mp_adjust_bbox(mp, h); + { + int lev = 1; + while (lev != 0) { + if (mp_link(p) == NULL) { + mp_confusion(mp, "bounds"); + } else { + p = mp_link(p); + if (mp_type(p) == mp_start_bounds_node_type) { + ++lev; + } else if (mp_type(p) == mp_stop_bounds_node_type) { + --lev; + } + } + } + mp_bblast(h) = p; + } + } + break; + case mp_stop_bounds_node_type: + if (number_nonpositive (internal_value(mp_true_corners_internal))) { + mp_confusion(mp, "bounds"); + } + break; + case mp_fill_node_type: + case mp_stroked_node_type: + { + mp_number x0a, y0a, x1a, y1a; + mp_path_bbox(mp, mp_path_ptr((mp_shape_node) p)); + if (mp_pen_ptr((mp_shape_node) p) != NULL) { + new_number_clone(x0a, mp_minx); + new_number_clone(y0a, mp_miny); + new_number_clone(x1a, mp_maxx); + new_number_clone(y1a, mp_maxy); + mp_pen_bbox(mp, mp_pen_ptr((mp_shape_node) p)); + number_add(mp_minx, x0a); + number_add(mp_miny, y0a); + number_add(mp_maxx, x1a); + number_add(mp_maxy, y1a); + free_number(x0a); + free_number(y0a); + free_number(x1a); + free_number(y1a); + } + mp_adjust_bbox(mp, h); + if ((mp_left_type(mp_path_ptr((mp_shape_node) p)) == mp_endpoint_knot) && (((mp_shape_node) p)->linecap == 2)) { + mp_box_ends(mp, mp_path_ptr((mp_shape_node) p), mp_pen_ptr((mp_shape_node) p), h); + } + } + break; + case mp_start_clip_node_type: + { + mp_number sminx, sminy, smaxx, smaxy; + mp_number x0a, y0a, x1a, y1a; + mp_path_bbox(mp, mp_path_ptr((mp_start_node) p)); + new_number_clone(x0a, mp_minx); + new_number_clone(y0a, mp_miny); + new_number_clone(x1a, mp_maxx); + new_number_clone(y1a, mp_maxy); + new_number_clone(sminx, h->minx); + new_number_clone(sminy, h->miny); + new_number_clone(smaxx, h->maxx); + new_number_clone(smaxy, h->maxy); + set_number_to_inf(h->minx); + set_number_to_inf(h->miny); + set_number_to_negative_inf(h->maxx); + set_number_to_negative_inf(h->maxy); + mp_set_bbox(mp, h, 0); + + if (number_less(h->minx, x0a)) { + number_clone(h->minx, x0a); + } + if (number_less(h->miny, y0a)) { + number_clone(h->miny, y0a); + } + if (number_greater(h->maxx, x1a)) { + number_clone(h->maxx, x1a); + } + if (number_greater(h->maxy, y1a)) { + number_clone(h->maxy, y1a); + } + number_clone(mp_minx, sminx); + number_clone(mp_miny, sminy); + number_clone(mp_maxx, smaxx); + number_clone(mp_maxy, smaxy); + mp_adjust_bbox(mp, h); + free_number(sminx); + free_number(sminy); + free_number(smaxx); + free_number(smaxy); + free_number(x0a); + free_number(y0a); + free_number(x1a); + free_number(y1a); + } + break; + + default: + break; + } + } + if (! top_level) { + mp_confusion(mp, "boundingbox"); + } +} + +static mp_knot mp_offset_prep (MP mp, mp_knot c, mp_knot h) +{ + int n; + mp_knot c0, p, q, q0, r, w, ww; + int k_needed; + mp_knot w0; + mp_number dxin, dyin; + int turn_amt; + mp_number max_coef; + mp_number ss; + mp_number x0, x1, x2, y0, y1, y2; + mp_number t0, t1, t2; + mp_number du, dv, dx, dy; + mp_number dx0, dy0; + mp_number x0a, x1a,x2a, y0a, y1a, y2a; + mp_number t; + mp_number s; + mp_number dx_m; + mp_number dy_m; + mp_number dxin_m; + mp_number u0, u1, v0, v1; + int d_sign; + new_number(max_coef); + new_number(dxin); + new_number(dyin); + new_number(dx0); + new_number(dy0); + new_number(x0); + new_number(y0); + new_number(x1); + new_number(y1); + new_number(x2); + new_number(y2); + new_number(du); + new_number(dv); + new_number(dx); + new_number(dy); + new_number(x0a); + new_number(y0a); + new_number(x1a); + new_number(y1a); + new_number(x2a); + new_number(y2a); + new_number(t0); + new_number(t1); + new_number(t2); + new_number(u0); + new_number(u1); + new_number(v0); + new_number(v1); + new_number(dx_m); + new_number(dy_m); + new_number(dxin_m); + new_fraction(ss); + new_fraction(s); + new_fraction(t); + n = 0; + p = h; + do { + ++n; + p = mp_next_knot(p); + } while (p != h); + + { + mp_knot hn = mp_next_knot(h); + mp_knot hp = mp_prev_knot(h); + set_number_from_subtraction(dxin, hn->x_coord, hp->x_coord); + set_number_from_subtraction(dyin, hn->y_coord, hp->y_coord); + if (number_zero(dxin) && number_zero(dyin)) { + set_number_from_subtraction(dxin, hp->y_coord, h->y_coord); + set_number_from_subtraction(dyin, h->x_coord, hp->x_coord); + } + } + w0 = h; + + p = c; + c0 = c; + k_needed = 0; + do { + q = mp_next_knot(p); + mp_knot_info(p) = zero_off + k_needed; + k_needed = 0; + set_number_from_subtraction(x0, p->right_x, p->x_coord); + set_number_from_subtraction(x2, q->x_coord, q->left_x); + set_number_from_subtraction(x1, q->left_x, p->right_x); + set_number_from_subtraction(y0, p->right_y, p->y_coord); + set_number_from_subtraction(y2, q->y_coord, q->left_y); + set_number_from_subtraction(y1, q->left_y, p->right_y); + { + + mp_number absval; + new_number_abs(absval, x1); + number_abs_clone(max_coef, x0); + if (number_greater(absval, max_coef)) { + number_clone(max_coef, absval); + } + number_abs_clone(absval, x2); + if (number_greater(absval, max_coef)) { + number_clone(max_coef, absval); + } + number_abs_clone(absval, y0); + if (number_greater(absval, max_coef)) { + number_clone(max_coef, absval); + } + number_abs_clone(absval, y1); + if (number_greater(absval, max_coef)) { + number_clone(max_coef, absval); + } + number_abs_clone(absval, y2); + if (number_greater(absval, max_coef)) { + number_clone(max_coef, absval); + } + free_number(absval); + if (number_zero(max_coef)) { + goto NOT_FOUND; + } + } + while (number_less(max_coef, fraction_half_t)) { + number_double(max_coef); + number_double(x0); + number_double(x1); + number_double(x2); + number_double(y0); + number_double(y1); + number_double(y2); + } + number_clone(dx_m, zero_t); + number_clone(dy_m, zero_t); + number_clone(dx, x0); + number_clone(dy, y0); + if (number_zero(dx) && number_zero(dy)) { + number_clone(dx, x1); + number_clone(dy, y1); + if (number_zero(dx) && number_zero(dy)) { + number_clone(dx, x2); + number_clone(dy, y2); + } + } + if (p == c) { + number_clone(dx0, dx); + number_clone(dy0, dy); + } + { + turn_amt = mp_get_turn_amt(mp, w0, &dx, &dy, ab_vs_cd(dy, dxin, dx, dyin) >= 0); + w = mp_pen_walk(mp, w0, turn_amt); + w0 = w; + mp_knot_info(p) = mp_knot_info(p) + turn_amt; + } + number_clone(dxin, x2); + number_clone(dyin, y2); + if (number_zero(dxin) && number_zero(dyin)) { + number_clone(dxin, x1); + number_clone(dyin, y1); + if (number_zero(dxin) && number_zero(dyin)) { + number_clone(dxin, x0); + number_clone(dyin, y0); + } + } + { + int sign = ab_vs_cd(dx, dyin, dxin, dy); + if (sign < 0) { + d_sign = -1; + } else if (sign == 0) { + d_sign = 0; + } else { + d_sign = 1; + } + } + if (d_sign == 0) { + { + int t; + set_number_from_subtraction(u0, q->x_coord, p->x_coord); + set_number_from_subtraction(u1, q->y_coord, p->y_coord); + t = ab_vs_cd(dx, u1, u0, dy) + ab_vs_cd(u0, dyin, dxin, u1); + + if (t < 0) { + d_sign = -1; + } else if (t == 0) { + d_sign = 0; + } else { + d_sign = 1; + } + } + } + if (d_sign == 0) { + if (number_zero(dx)) { + d_sign = number_positive(dy) ? 1 : -1; + } else { + d_sign = number_positive(dx) ? 1 : -1; + } + } + { + mp_number r1, r2, arg1; + new_number(arg1); + new_fraction(r1); + new_fraction(r2); + take_fraction(r1, x0, y2); + take_fraction(r2, x2, y0); + number_half(r1); + number_half(r2); + set_number_from_subtraction(t0, r1, r2); + set_number_from_addition(arg1, y0, y2); + take_fraction(r1, x1, arg1); + set_number_from_addition(arg1, x0, x2); + + take_fraction(r2, y1, arg1); + number_half(r1); + number_half(r2); + set_number_from_subtraction(t1, r1, r2); + free_number(arg1); + free_number(r1); + free_number(r2); + } + if (number_zero(t0)) { + set_number_from_scaled(t0, d_sign); + } + if (number_positive(t0)) { + mp_number arg3; + new_number(arg3); + number_negated_clone(arg3, t0); + crossing_point(t, t0, t1, arg3); + free_number(arg3); + set_number_from_of_the_way(u0, t, x0, x1); + set_number_from_of_the_way(u1, t, x1, x2); + set_number_from_of_the_way(v0, t, y0, y1); + set_number_from_of_the_way(v1, t, y1, y2); + } else { + mp_number arg1; + new_number(arg1); + number_negated_clone(arg1, t0); + crossing_point(t, arg1, t1, t0); + free_number(arg1); + set_number_from_of_the_way(u0, t, x2, x1); + set_number_from_of_the_way(u1, t, x1, x0); + set_number_from_of_the_way(v0, t, y2, y1); + set_number_from_of_the_way(v1, t, y1, y0); + } + { + mp_number tmp1, tmp2, r1, r2, arg1; + new_fraction(r1); + new_fraction(r2); + new_number(arg1); + new_number(tmp1); + new_number(tmp2); + set_number_from_of_the_way(tmp1, t, u0, u1); + set_number_from_of_the_way(tmp2, t, v0, v1); + set_number_from_addition(arg1, x0, x2); + take_fraction(r1, arg1, tmp1); + set_number_from_addition(arg1, y0, y2); + take_fraction(r2, arg1, tmp2); + set_number_from_addition(ss, r1, r2); + free_number(arg1); + free_number(r1); + free_number(r2); + free_number(tmp1); + free_number(tmp2); + } + turn_amt = mp_get_turn_amt(mp, w, &dxin, &dyin, (d_sign > 0)); + if (number_negative(ss)) { + turn_amt = turn_amt - d_sign * n; + } + ww = mp_prev_knot(w); + { + mp_number abs_du, abs_dv; + new_number(abs_du); + new_number(abs_dv); + set_number_from_subtraction(du, ww->x_coord, w->x_coord); + set_number_from_subtraction(dv, ww->y_coord, w->y_coord); + number_abs_clone(abs_du, du); + number_abs_clone(abs_dv, dv); + if (number_greaterequal(abs_du, abs_dv)) { + mp_number r1; + new_fraction(r1); + make_fraction(s, dv, du); + take_fraction(r1, x0, s); + set_number_from_subtraction(t0, r1, y0); + take_fraction(r1, x1, s); + set_number_from_subtraction(t1, r1, y1); + take_fraction(r1, x2, s); + set_number_from_subtraction(t2, r1, y2); + if (number_negative(du)) { + number_negate(t0); + number_negate(t1); + number_negate(t2); + } + free_number(r1); + } else { + mp_number r1; + new_fraction(r1); + make_fraction(s, du, dv); + take_fraction(r1, y0, s); + set_number_from_subtraction(t0, x0, r1); + take_fraction(r1, y1, s); + set_number_from_subtraction(t1, x1, r1); + take_fraction(r1, y2, s); + set_number_from_subtraction(t2, x2, r1); + if (number_negative(dv)) { + number_negate(t0); + number_negate(t1); + number_negate(t2); + } + free_number(r1); + } + free_number(abs_du); + free_number(abs_dv); + if (number_negative(t0)) { + set_number_to_zero(t0); + } + } + crossing_point(t, t0, t1, t2); + if (turn_amt >= 0) { + if (number_negative(t2)) { + number_clone(t, fraction_one_t); + number_add_scaled(t, 1); + } else { + mp_number tmp, arg1, r1; + new_fraction(r1); + new_number(tmp); + new_number(arg1); + set_number_from_of_the_way(u0, t, x0, x1); + set_number_from_of_the_way(u1, t, x1, x2); + set_number_from_of_the_way(tmp, t, u0, u1); + number_negated_clone(arg1, du); + take_fraction(ss, arg1, tmp); + set_number_from_of_the_way(v0, t, y0, y1); + set_number_from_of_the_way(v1, t, y1, y2); + set_number_from_of_the_way(tmp, t, v0, v1); + number_negated_clone(arg1, dv); + take_fraction(r1, arg1, tmp); + number_add(ss, r1); + free_number(tmp); + if (number_negative(ss)) { + number_clone(t, fraction_one_t); + number_add_scaled(t, 1); + } + free_number(arg1); + free_number(r1); + } + } else if (number_greater(t, fraction_one_t)) { + number_clone(t, fraction_one_t); + } + if (number_greater(t, fraction_one_t)) { + mp_fin_offset_prep(mp, p, w, &x0, &x1, &x2, &y0, &y1, &y2, 1, turn_amt); + } else { + mp_split_cubic(mp, p, &t); + r = mp_next_knot(p); + set_number_from_of_the_way(x1a, t, x0, x1); + set_number_from_of_the_way(x1, t, x1, x2); + set_number_from_of_the_way(x2a, t, x1a, x1); + set_number_from_of_the_way(y1a, t, y0, y1); + set_number_from_of_the_way(y1, t, y1, y2); + set_number_from_of_the_way(y2a, t, y1a, y1); + mp_fin_offset_prep (mp, p, w, &x0, &x1a, &x2a, &y0, &y1a, &y2a, 1, 0); + number_clone(x0, x2a); + number_clone(y0, y2a); + mp_knot_info(r) = zero_off - 1; + if (turn_amt >= 0) { + mp_number arg1, arg2, arg3; + new_number(arg1); + new_number(arg2); + new_number(arg3); + set_number_from_of_the_way(t1, t, t1, t2); + if (number_positive(t1)) { + set_number_to_zero(t1); + } + number_negated_clone(arg2, t1); + number_negated_clone(arg3, t2); + crossing_point(t, arg1, arg2, arg3); + free_number(arg1); + free_number(arg2); + free_number(arg3); + if (number_greater(t, fraction_one_t)) { + number_clone(t, fraction_one_t); + } + mp_split_cubic(mp, r, &t); + mp_knot_info(mp_next_knot(r)) = zero_off + 1; + set_number_from_of_the_way(x1a, t, x1, x2); + set_number_from_of_the_way(x1, t, x0, x1); + set_number_from_of_the_way(x0a, t, x1, x1a); + set_number_from_of_the_way(y1a, t, y1, y2); + set_number_from_of_the_way(y1, t, y0, y1); + set_number_from_of_the_way(y0a, t, y1, y1a); + mp_fin_offset_prep (mp, mp_next_knot(r), w, &x0a, &x1a, &x2, &y0a, &y1a, &y2, 1, turn_amt); + number_clone(x2, x0a); + number_clone(y2, y0a); + + mp_fin_offset_prep(mp, r, ww, &x0, &x1, &x2, &y0, &y1, &y2, -1, 0); + } else { + mp_fin_offset_prep(mp, r, ww, &x0, &x1, &x2, &y0, &y1, &y2, -1, (-1 - turn_amt)); + } + } + w0 = mp_pen_walk (mp, w0, turn_amt); + + NOT_FOUND: + q0 = q; + do { + r = mp_next_knot(p); + if (r != p && r != q + && number_equal(p->x_coord, p->right_x) + && number_equal(p->y_coord, p->right_y) + && number_equal(p->x_coord, r->left_x) + && number_equal(p->y_coord, r->left_y) + && number_equal(p->x_coord, r->x_coord) + && number_equal(p->y_coord, r->y_coord)) { + { + k_needed = mp_knot_info(p) - zero_off; + if (r == q) { + q = p; + } else { + mp_knot_info(p) = k_needed + mp_knot_info(r); + k_needed = 0; + } + if (r == c) { + mp_knot_info(p) = mp_knot_info(c); + c = p; + } + if (r == mp->spec_p1) { + mp->spec_p1 = p; + } + if (r == mp->spec_p2) { + mp->spec_p2 = p; + } + r = p; + mp_remove_cubic(mp, p); + } + } + p = r; + } while (p != q); + if ((q != q0) && (q != c || c == c0)) { + q = mp_next_knot(q); + } + } while (q != c); + mp->spec_offset = mp_knot_info(c) - zero_off; + if (mp_next_knot(c) == c) { + mp_knot_info(c) = zero_off + n; + } else { + mp_knot_info(c) += k_needed; + while (w0 != h) { + mp_knot_info(c) += 1; + w0 = mp_next_knot(w0); + } + while (mp_knot_info(c) <= zero_off - n) { + mp_knot_info(c) += n; + } + while (mp_knot_info(c) > zero_off) { + mp_knot_info(c) -= n; + } + ; + if ((mp_knot_info(c) != zero_off) && ab_vs_cd(dy0, dxin, dx0, dyin) >= 0) { + mp_knot_info(c) += n; + } + } + free_number(ss); + free_number(s); + free_number(dxin); + free_number(dyin); + free_number(dx0); + free_number(dy0); + free_number(x0); + free_number(y0); + free_number(x1); + free_number(y1); + free_number(x2); + free_number(y2); + free_number(max_coef); + free_number(du); + free_number(dv); + free_number(dx); + free_number(dy); + free_number(x0a); + free_number(y0a); + free_number(x1a); + free_number(y1a); + free_number(x2a); + free_number(y2a); + free_number(t0); + free_number(t1); + free_number(t2); + free_number(u0); + free_number(u1); + free_number(v0); + free_number(v1); + free_number(dx_m); + free_number(dy_m); + free_number(dxin_m); + free_number(t); + return c; +} + +void mp_split_cubic (MP mp, mp_knot p, mp_number *t) +{ + mp_number v; + mp_knot q = mp_next_knot(p); + mp_knot r = mp_new_knot(mp); + mp_prev_knot(r) = p; + mp_next_knot(p) = r; + mp_prev_knot(q) = r; + mp_next_knot(r) = q; + mp_originator(r) = mp_program_code; + mp_knotstate(r) = mp_regular_knot; + mp_left_type(r) = mp_explicit_knot; + mp_right_type(r) = mp_explicit_knot; + new_number(v); + set_number_from_of_the_way(v, *t, p->right_x, q->left_x); + set_number_from_of_the_way(p->right_x, *t, p->x_coord, p->right_x); + set_number_from_of_the_way(q->left_x, *t, q->left_x, q->x_coord); + set_number_from_of_the_way(r->left_x, *t, p->right_x, v); + set_number_from_of_the_way(r->right_x, *t, v, q->left_x); + set_number_from_of_the_way(r->x_coord, *t, r->left_x, r->right_x); + set_number_from_of_the_way(v, *t, p->right_y, q->left_y); + set_number_from_of_the_way(p->right_y, *t, p->y_coord, p->right_y); + set_number_from_of_the_way(q->left_y, *t, q->left_y, q->y_coord); + set_number_from_of_the_way(r->left_y, *t, p->right_y, v); + set_number_from_of_the_way(r->right_y, *t, v, q->left_y); + set_number_from_of_the_way(r->y_coord, *t, r->left_y, r->right_y); + free_number(v); +} + +static mp_knot mp_split_cubic_knot (MP mp, mp_knot p, mp_number *t) +{ + mp_number v; + mp_knot k = mp_new_knot(mp); + mp_knot r = mp_copy_knot(mp, mp_next_knot(p)); + mp_knot l = mp_copy_knot(mp, p); + mp_originator(k) = mp_program_code; + mp_knotstate(k) = mp_regular_knot; + mp_left_type(k) = mp_explicit_knot; + mp_right_type(k) = mp_explicit_knot; + new_number(v); + set_number_from_of_the_way(v, *t, l->right_x, r->left_x); + set_number_from_of_the_way(l->right_x, *t, l->x_coord, l->right_x); + set_number_from_of_the_way(r->left_x, *t, r->left_x, r->x_coord); + set_number_from_of_the_way(k->left_x, *t, l->right_x, v); + set_number_from_of_the_way(k->right_x, *t, v, r->left_x); + set_number_from_of_the_way(k->x_coord, *t, k->left_x, k->right_x); + set_number_from_of_the_way(v, *t, l->right_y, r->left_y); + set_number_from_of_the_way(l->right_y, *t, l->y_coord, l->right_y); + set_number_from_of_the_way(r->left_y, *t, r->left_y, r->y_coord); + set_number_from_of_the_way(k->left_y, *t, l->right_y, v); + set_number_from_of_the_way(k->right_y, *t, v, r->left_y); + set_number_from_of_the_way(k->y_coord, *t, k->left_y, k->right_y); + free_number(v); + mp_toss_knot(mp, l); + mp_toss_knot(mp, r); + return k; +} + +void mp_remove_cubic (MP mp, mp_knot p) +{ + mp_knot q = mp_next_knot(p); + mp_prev_knot(q) = mp_next_knot(p); + mp_next_knot(p) = mp_next_knot(q); + number_clone(p->right_x, q->right_x); + number_clone(p->right_y, q->right_y); + mp_toss_knot(mp, q); +} + +mp_knot mp_pen_walk (MP mp, mp_knot w, int k) +{ + (void) mp; + while (k > 0) { + w = mp_next_knot(w); + --k; + } + while (k < 0) { + w = mp_prev_knot(w); + ++k; + } + return w; +} + +void mp_fin_offset_prep (MP mp, mp_knot p, mp_knot w, mp_number *x0, mp_number *x1, mp_number *x2, mp_number *y0, mp_number *y1, mp_number *y2, int rise, int turn_amt) +{ + mp_number du, dv; + mp_number t0, t1, t2; + mp_number t; + mp_number s; + mp_number v; + mp_knot q = mp_next_knot(p); + new_number(du); + new_number(dv); + new_number(v); + new_number(t0); + new_number(t1); + new_number(t2); + new_fraction(s); + new_fraction(t); + while (1) { + mp_knot ww = rise > 0 ? mp_next_knot(w) : mp_prev_knot(w); + { + mp_number abs_du, abs_dv; + new_number(abs_du); + new_number(abs_dv); + set_number_from_subtraction(du, ww->x_coord, w->x_coord); + set_number_from_subtraction(dv, ww->y_coord, w->y_coord); + number_abs_clone(abs_du, du); + number_abs_clone(abs_dv, dv); + if (number_greaterequal(abs_du, abs_dv)) { + mp_number r1; + new_fraction(r1); + make_fraction(s, dv, du); + take_fraction(r1, *x0, s); + set_number_from_subtraction(t0, r1, *y0); + take_fraction(r1, *x1, s); + set_number_from_subtraction(t1, r1, *y1); + take_fraction(r1, *x2, s); + set_number_from_subtraction(t2, r1, *y2); + if (number_negative(du)) { + number_negate(t0); + number_negate(t1); + number_negate(t2); + } + free_number(r1); + } else { + mp_number r1; + new_fraction(r1); + make_fraction(s, du, dv); + take_fraction(r1, *y0, s); + set_number_from_subtraction(t0, *x0, r1); + take_fraction(r1, *y1, s); + set_number_from_subtraction(t1, *x1, r1); + take_fraction(r1, *y2, s); + set_number_from_subtraction(t2, *x2, r1); + if (number_negative(dv)) { + number_negate(t0); + number_negate(t1); + number_negate(t2); + } + free_number(r1); + } + free_number(abs_du); + free_number(abs_dv); + if (number_negative(t0)) { + set_number_to_zero(t0); + } + } + crossing_point(t, t0, t1, t2); + if (number_greaterequal(t, fraction_one_t)) { + if (turn_amt > 0) { + number_clone(t, fraction_one_t); + } else { + goto RETURN; + } + } + { + mp_split_cubic(mp, p, &t); + p = mp_next_knot(p); + mp_knot_info(p) = zero_off + rise; + --turn_amt; + set_number_from_of_the_way(v, t, *x0, *x1); + set_number_from_of_the_way(*x1, t, *x1, *x2); + set_number_from_of_the_way(*x0, t, v, *x1); + set_number_from_of_the_way(v, t, *y0, *y1); + set_number_from_of_the_way(*y1, t, *y1, *y2); + set_number_from_of_the_way(*y0, t, v, *y1); + if (turn_amt < 0) { + mp_number arg1, arg2, arg3; + new_number(arg1); + new_number(arg2); + new_number(arg3); + set_number_from_of_the_way(t1, t, t1, t2); + if (number_positive(t1)) { + set_number_to_zero(t1); + } + number_negated_clone(arg2, t1); + number_negated_clone(arg3, t2); + crossing_point(t, arg1, arg2, arg3); + free_number(arg1); + free_number(arg2); + free_number(arg3); + if (number_greater(t, fraction_one_t)) { + number_clone(t, fraction_one_t); + } + ++turn_amt; + if (number_equal(t,fraction_one_t) && (mp_next_knot(p) != q)) { + mp_knot_info(mp_next_knot(p)) = mp_knot_info(mp_next_knot(p)) - rise; + } else { + mp_split_cubic(mp, p, &t); + mp_knot_info(mp_next_knot(p)) = zero_off - rise; + set_number_from_of_the_way(v, t, *x1, *x2); + set_number_from_of_the_way(*x1, t, *x0, *x1); + set_number_from_of_the_way(*x2, t, *x1, v); + set_number_from_of_the_way(v, t, *y1, *y2); + set_number_from_of_the_way(*y1, t, *y0, *y1); + set_number_from_of_the_way(*y2, t, *y1, v); + } + } + } + w = ww; + } + RETURN: + free_number(s); + free_number(t); + free_number(du); + free_number(dv); + free_number(v); + free_number(t0); + free_number(t1); + free_number(t2); +} + +int mp_get_turn_amt (MP mp, mp_knot w, mp_number *dx, mp_number *dy, int ccw) +{ + int s = 0; + mp_number arg1, arg2; + new_number(arg1); + new_number(arg2); + if (ccw) { + int t; + mp_knot ww = mp_next_knot(w); + do { + set_number_from_subtraction(arg1, ww->x_coord, w->x_coord); + set_number_from_subtraction(arg2, ww->y_coord, w->y_coord); + t = ab_vs_cd(*dy, arg1, *dx, arg2); + if (t < 0) { + break; + } else { + ++s; + w = ww; + ww = mp_next_knot(ww); + } + } while (t > 0); + } else { + mp_knot ww = mp_prev_knot(w); + set_number_from_subtraction(arg1, w->x_coord, ww->x_coord); + set_number_from_subtraction(arg2, w->y_coord, ww->y_coord); + while (ab_vs_cd(*dy, arg1, *dx, arg2) < 0) { + --s; + w = ww; + ww = mp_prev_knot(ww); + set_number_from_subtraction(arg1, w->x_coord, ww->x_coord); + set_number_from_subtraction(arg2, w->y_coord, ww->y_coord); + } + } + free_number(arg1); + free_number(arg2); + return s; +} + +static void mp_print_spec (MP mp, mp_knot cur_spec, mp_knot cur_pen, const char *s) +{ + mp_knot w; + mp_knot p = cur_spec; + mp_print_diagnostic(mp, "Envelope spec", s, 1); + w = mp_pen_walk(mp, cur_pen, mp->spec_offset); + mp_print_ln(mp); + mp_print_two(mp, &(cur_spec->x_coord), &(cur_spec->y_coord)); + mp_print_str(mp, " % beginning with offset "); + mp_print_two(mp, &(w->x_coord), &(w->y_coord)); + do { + while (1) { + mp_knot q = mp_next_knot(p); + mp_print_nl(mp, " .. controls "); + mp_print_two(mp, &(p->right_x), &(p->right_y)); + mp_print_str(mp, " and "); + mp_print_two(mp, &(q->left_x), &(q->left_y)); + mp_print_nl(mp, " .. "); + mp_print_two(mp, &(q->x_coord), &(q->y_coord)); + + p = q; + if ((p == cur_spec) || (mp_knot_info(p) != zero_off)) { + break; + } + } + if (mp_knot_info(p) != zero_off) { + w = mp_pen_walk (mp, w, (mp_knot_info(p) - zero_off)); + mp_print_str(mp, " % "); + if (mp_knot_info(p) > zero_off) { + mp_print_str(mp, "counter"); + } + mp_print_str(mp, "clockwise to offset "); + mp_print_two(mp, &(w->x_coord), &(w->y_coord)); + } + } while (p != cur_spec); + mp_print_nl(mp, " & cycle"); + mp_end_diagnostic(mp, 1); +} + +static mp_knot mp_make_envelope (MP mp, mp_knot c, mp_knot h, int linejoin, int linecap, mp_number *miterlimit) +{ + mp_knot p, q, r, q0; + mp_knot w, w0; + int k, k0; + mp_number qx, qy; + mp_fraction dxin, dyin, dxout, dyout; + int join_type = 0; + mp_number tmp; + mp_number max_ht; + int kk; + mp_knot ww; + + new_number(max_ht); + new_number(tmp); + new_fraction(dxin); + new_fraction(dyin); + new_fraction(dxout); + new_fraction(dyout); + mp->spec_p1 = NULL; + mp->spec_p2 = NULL; + new_number(qx); + new_number(qy); + if (mp_left_type(c) == mp_endpoint_knot) { + mp->spec_p1 = mp_htap_ypoc(mp, c); + mp->spec_p2 = mp->path_tail; + mp_originator(mp->spec_p1) = mp_program_code; + mp_knotstate(mp->spec_p1) = mp_regular_knot; + mp_prev_knot(mp->spec_p1) = mp_next_knot(mp->spec_p2); + mp_next_knot(mp->spec_p2) = mp_next_knot(mp->spec_p1); + mp_prev_knot(c) = mp->spec_p1; + mp_next_knot(mp->spec_p1) = c; + mp_remove_cubic(mp, mp->spec_p1); + c = mp->spec_p1; + if (c != mp_next_knot(c)) { + mp_originator(mp->spec_p2) = mp_program_code; + mp_knotstate(mp->spec_p2) = mp_regular_knot; + mp_remove_cubic(mp, mp->spec_p2); + } else { + mp_left_type(c) = mp_explicit_knot; + mp_right_type(c) = mp_explicit_knot; + number_clone(c->left_x, c->x_coord); + number_clone(c->left_y, c->y_coord); + number_clone(c->right_x, c->x_coord); + number_clone(c->right_y, c->y_coord); + } + } + c = mp_offset_prep (mp, c, h); + if (number_positive(internal_value(mp_tracing_specs_internal))) { + mp_print_spec(mp, c, h, ""); + } + h = mp_pen_walk (mp, h, mp->spec_offset); + + w = h; + p = c; + do { + q = mp_next_knot(p); + q0 = q; + number_clone(qx, q->x_coord); + number_clone(qy, q->y_coord); + k = mp_knot_info(q); + k0 = k; + w0 = w; + if (k != zero_off) { + if (k < zero_off) { + join_type = 2; + } else { + if ((q != mp->spec_p1) && (q != mp->spec_p2)) { + join_type = linejoin; + } else if (linecap == mp_squared_linecap_code) { + join_type = 3; + } else { + join_type = 2 - linecap; + } + if ((join_type == 0) || (join_type == 3)) { + set_number_from_subtraction(dxin, q->x_coord, q->left_x); + set_number_from_subtraction(dyin, q->y_coord, q->left_y); + if (number_zero(dxin) && number_zero(dyin)) { + set_number_from_subtraction(dxin, q->x_coord, p->right_x); + set_number_from_subtraction(dyin, q->y_coord, p->right_y); + if (number_zero(dxin) && number_zero(dyin)) { + set_number_from_subtraction(dxin, q->x_coord, p->x_coord); + set_number_from_subtraction(dyin, q->y_coord, p->y_coord); + if (p != c) { + number_add(dxin, w->x_coord); + number_add(dyin, w->y_coord); + } + } + } + pyth_add(tmp, dxin, dyin); + if (number_zero(tmp)) { + join_type = 2; + } else { + mp_number r1; + new_fraction(r1); + make_fraction(r1, dxin, tmp); + number_clone(dxin, r1); + make_fraction(r1, dyin, tmp); + number_clone(dyin, r1); + free_number(r1); + set_number_from_subtraction(dxout, q->right_x, q->x_coord); + set_number_from_subtraction(dyout, q->right_y, q->y_coord); + if (number_zero(dxout) && number_zero(dyout)) { + r = mp_next_knot(q); + set_number_from_subtraction(dxout, r->left_x, q->x_coord); + set_number_from_subtraction(dyout, r->left_y, q->y_coord); + if (number_zero(dxout) && number_zero(dyout)) { + set_number_from_subtraction(dxout, r->x_coord, q->x_coord); + set_number_from_subtraction(dyout, r->y_coord, q->y_coord); + } + } + if (q == c) { + number_subtract(dxout, h->x_coord); + number_subtract(dyout, h->y_coord); + } + pyth_add(tmp, dxout, dyout); + if (number_zero(tmp)) { + } else { + mp_number r1; + new_fraction(r1); + make_fraction(r1, dxout, tmp); + number_clone(dxout, r1); + make_fraction(r1, dyout, tmp); + number_clone(dyout, r1); + free_number(r1); + } + } + if (join_type == 0) { + mp_number r1, r2; + new_fraction(r1); + new_fraction(r2); + take_fraction(r1, dxin, dxout); + take_fraction(r2, dyin, dyout); + number_add(r1, r2); + number_half(r1); + number_add(r1, fraction_half_t); + take_fraction(tmp, *miterlimit, r1); + if (number_less(tmp, unity_t)) { + mp_number ret; + new_number(ret); + take_scaled(ret, *miterlimit, tmp); + if (number_less(ret, unity_t)) { + join_type = 2; + } + free_number(ret); + } + free_number(r1); + free_number(r2); + } + } + } + } + number_add(p->right_x, w->x_coord); + number_add(p->right_y, w->y_coord); + number_add(q->left_x, w->x_coord); + number_add(q->left_y, w->y_coord); + number_add(q->x_coord, w->x_coord); + number_add(q->y_coord, w->y_coord); + mp_left_type(q) = mp_explicit_knot; + mp_right_type(q) = mp_explicit_knot; + + while (k != zero_off) { + if (k > zero_off) { + w = mp_next_knot(w); + --k; + } else { + w = mp_prev_knot(w); + ++k; + } + if ((join_type == 1) || (k == zero_off)) { + mp_number xtot, ytot; + new_number(xtot); + new_number(ytot); + set_number_from_addition(xtot, qx, w->x_coord); + set_number_from_addition(ytot, qy, w->y_coord); + q = mp_insert_knot(mp, q, &xtot, &ytot); + free_number(xtot); + free_number(ytot); + } + } + if (q != mp_next_knot(p)) { + p = mp_next_knot(p); + if ((join_type == 0) || (join_type == 3)) { + if (join_type == 0) { + mp_number det; + mp_number absdet; + mp_number r1, r2; + new_fraction(r1); + new_fraction(r2); + new_fraction(det); + new_fraction(absdet); + take_fraction(r1, dyout, dxin); + take_fraction(r2, dxout, dyin); + set_number_from_subtraction(det, r1, r2); + number_abs_clone(absdet, det); + if (number_less(absdet, near_zero_angle_k)) { + r = NULL; + } else { + mp_number xtot, ytot, xsub, ysub; + new_fraction(xsub); + new_fraction(ysub); + new_number(xtot); + new_number(ytot); + set_number_from_subtraction(tmp, q->x_coord, p->x_coord); + take_fraction(r1, tmp, dyout); + set_number_from_subtraction(tmp, q->y_coord, p->y_coord); + take_fraction(r2, tmp, dxout); + set_number_from_subtraction(tmp, r1, r2); + make_fraction(r1, tmp, det); + number_clone(tmp, r1); + take_fraction(xsub, tmp, dxin); + take_fraction(ysub, tmp, dyin); + set_number_from_addition(xtot, p->x_coord, xsub); + set_number_from_addition(ytot, p->y_coord, ysub); + r = mp_insert_knot(mp, p, &xtot, &ytot); + free_number(xtot); + free_number(ytot); + free_number(xsub); + free_number(ysub); + } + free_number(r1); + free_number(r2); + free_number(det); + free_number(absdet); + } else { + mp_number ht_x, ht_y; + mp_number ht_x_abs, ht_y_abs; + mp_number xtot, ytot, xsub, ysub; + new_fraction(xsub); + new_fraction(ysub); + new_number(xtot); + new_number(ytot); + new_fraction(ht_x); + new_fraction(ht_y); + new_fraction(ht_x_abs); + new_fraction(ht_y_abs); + set_number_from_subtraction(ht_x, w->y_coord, w0->y_coord); + set_number_from_subtraction(ht_y, w0->x_coord, w->x_coord); + number_abs_clone(ht_x_abs, ht_x); + number_abs_clone(ht_y_abs, ht_y); + while (number_less(ht_x_abs, fraction_half_t) && number_less(ht_y_abs, fraction_half_t)) { + number_double(ht_x); + number_double(ht_y); + number_abs_clone(ht_x_abs, ht_x); + number_abs_clone(ht_y_abs, ht_y); + } + set_number_to_zero(max_ht); + kk = zero_off; + ww = w; + while (1) { + if (kk > k0) { + ww = mp_next_knot(ww); + --kk; + } else { + ww = mp_prev_knot(ww); + ++kk; + } + if (kk == k0) { + break; + } else { + mp_number r1, r2; + new_fraction(r1); + new_fraction(r2); + set_number_from_subtraction(tmp, ww->x_coord, w0->x_coord); + take_fraction(r1, tmp, ht_x); + set_number_from_subtraction(tmp, ww->y_coord, w0->y_coord); + take_fraction(r2, tmp, ht_y); + set_number_from_addition(tmp, r1, r2); + free_number(r1); + free_number(r2); + if (number_greater(tmp, max_ht)) { + number_clone(max_ht, tmp); + } + } + } + { + mp_number r1 ,r2; + new_fraction(r1); + new_fraction(r2); + take_fraction(r1, dxin, ht_x); + take_fraction(r2, dyin, ht_y); + number_add(r1, r2); + make_fraction(tmp, max_ht, r1); + free_number(r1); + free_number(r2); + } + take_fraction(xsub, tmp, dxin); + take_fraction(ysub, tmp, dyin); + set_number_from_addition(xtot, p->x_coord, xsub); + set_number_from_addition(ytot, p->y_coord, ysub); + r = mp_insert_knot(mp, p, &xtot, &ytot); + { + mp_number r1 ,r2; + new_fraction(r1); + new_fraction(r2); + take_fraction(r1, dxout, ht_x); + take_fraction(r2, dyout, ht_y); + number_add(r1, r2); + make_fraction(tmp, max_ht, r1); + free_number(r1); + free_number(r2); + } + take_fraction(xsub, tmp, dxout); + take_fraction(ysub, tmp, dyout); + set_number_from_addition(xtot, q->x_coord, xsub); + set_number_from_addition(ytot, q->y_coord, ysub); + r = mp_insert_knot(mp, r, &xtot, &ytot); + free_number(xsub); + free_number(ysub); + free_number(xtot); + free_number(ytot); + free_number(ht_x); + free_number(ht_y); + free_number(ht_x_abs); + free_number(ht_y_abs); + } + if (r != NULL) { + number_clone(r->right_x, r->x_coord); + number_clone(r->right_y, r->y_coord); + } + } + } + p = q; + } while (q0 != c); + free_number(max_ht); + free_number(tmp); + free_number(qx); + free_number(qy); + free_number(dxin); + free_number(dyin); + free_number(dxout); + free_number(dyout); + return c; +} + +mp_knot mp_insert_knot (MP mp, mp_knot q, mp_number *x, mp_number *y) +{ + mp_knot r = mp_new_knot(mp); + mp_knot n = mp_next_knot(q); + mp_next_knot(r) = n; + mp_prev_knot(n) = r; + mp_prev_knot(r) = q; + mp_next_knot(q) = r; + number_clone(r->right_x, q->right_x); + number_clone(r->right_y, q->right_y); + number_clone(r->x_coord, *x); + number_clone(r->y_coord, *y); + number_clone(q->right_x, q->x_coord); + number_clone(q->right_y, q->y_coord); + number_clone(r->left_x, r->x_coord); + number_clone(r->left_y, r->y_coord); + mp_left_type(r) = mp_explicit_knot; + mp_right_type(r) = mp_explicit_knot; + mp_originator(r) = mp_program_code; + mp_knotstate(r) = mp_regular_knot; + return r; +} + +static void mp_find_direction_time (MP mp, mp_number *ret, mp_number *x_orig, mp_number *y_orig, mp_knot h) +{ + mp_number max; + mp_knot p, q; + mp_number n; + mp_number tt; + mp_number abs_x, abs_y; + mp_number x1, x2, x3, y1, y2, y3; + mp_number phi; + mp_number t; + mp_number x, y; + new_number(max); + new_number(x1); + new_number(x2); + new_number(x3); + new_number(y1); + new_number(y2); + new_number(y3); + new_fraction(t); + new_angle(phi); + set_number_to_zero(*ret); + new_number(x); + new_number(y); + new_number(abs_x); + new_number(abs_y); + new_number(n); + new_fraction(tt); + number_clone(x, *x_orig); + number_clone(y, *y_orig); + number_abs_clone(abs_x, *x_orig); + number_abs_clone(abs_y, *y_orig); + if (number_less(abs_x, abs_y)) { + mp_number r1; + new_fraction(r1); + make_fraction(r1, x, abs_y); + number_clone(x, r1); + free_number(r1); + if (number_positive(y)) { + number_clone(y, fraction_one_t); + } else { + number_negated_clone(y, fraction_one_t); + } + } else if (number_zero(x)) { + goto FREE; + } else { + mp_number r1; + new_fraction(r1); + make_fraction(r1, y, abs_x); + number_clone(y, r1); + free_number(r1); + if (number_positive(x)) { + number_clone(x, fraction_one_t); + } else { + number_negated_clone(x, fraction_one_t); + } + } + p = h; + while (1) { + if (mp_right_type(p) == mp_endpoint_knot) { + break; + } else { + q = mp_next_knot(p); + set_number_to_zero(tt); + { + mp_number absval; + new_number(absval); + set_number_from_subtraction(x1, p->right_x, p->x_coord); + set_number_from_subtraction(x2, q->left_x, p->right_x); + set_number_from_subtraction(x3, q->x_coord, q->left_x); + set_number_from_subtraction(y1, p->right_y, p->y_coord); + set_number_from_subtraction(y2, q->left_y, p->right_y); + set_number_from_subtraction(y3, q->y_coord, q->left_y); + number_abs_clone(absval, x2); + number_abs_clone(max, x1); + if (number_greater(absval, max)) { + number_clone(max, absval); + } + number_abs_clone(absval, x3); + if (number_greater(absval, max)) { + number_clone(max, absval); + } + number_abs_clone(absval, y1); + if (number_greater(absval, max)) { + number_clone(max, absval); + } + number_abs_clone(absval, y2); + if (number_greater(absval, max)) { + number_clone(max, absval); + } + number_abs_clone(absval, y3); + if (number_greater(absval, max)) { + number_clone(max, absval); + } + free_number(absval); + if (number_zero(max)) { + goto FOUND; + } + while (number_less(max, fraction_half_t)) { + number_double(max); + number_double(x1); + number_double(x2); + number_double(x3); + number_double(y1); + number_double(y2); + number_double(y3); + } + number_clone(t, x1); + { + mp_number r1, r2; + new_fraction(r1); + new_fraction(r2); + take_fraction(r1, x1, x); + take_fraction(r2, y1, y); + set_number_from_addition(x1, r1, r2); + take_fraction(r1, y1, x); + take_fraction(r2, t, y); + set_number_from_subtraction(y1, r1, r2); + number_clone(t, x2); + take_fraction(r1, x2, x); + take_fraction(r2, y2, y); + set_number_from_addition(x2, r1, r2); + take_fraction(r1, y2, x); + take_fraction(r2, t, y); + set_number_from_subtraction(y2, r1, r2); + number_clone(t, x3); + take_fraction(r1, x3 ,x); + take_fraction(r2, y3, y); + set_number_from_addition(x3, r1, r2); + take_fraction(r1, y3, x); + take_fraction(r2, t, y); + set_number_from_subtraction(y3, r1, r2); + free_number(r1); + free_number(r2); + } + } + if (number_zero(y1) && (number_zero(x1) || number_positive(x1))) { + goto FOUND; + } + if (number_positive(n)) { + mp_number theta; + mp_number tmp; + new_angle(theta); + n_arg(theta, x1, y1); + new_angle(tmp); + set_number_from_subtraction(tmp, theta, one_eighty_deg_t); + if (number_nonnegative(theta) && number_nonpositive(phi) && number_greaterequal(phi, tmp)) { + free_number(tmp); + free_number(theta); + goto FOUND; + } + set_number_from_addition(tmp, theta, one_eighty_deg_t); + if (number_nonpositive(theta) && number_nonnegative(phi) && number_lessequal(phi, tmp)) { + free_number(tmp); + free_number(theta); + goto FOUND; + } + free_number(tmp); + free_number(theta); + if (p == h) { + break; + } + } + if (number_nonzero(x3) || number_nonzero(y3)) { + n_arg(phi, x3, y3); + } + if (number_negative(x1) && number_negative(x2) && number_negative(x3)) { + goto DONE; + } + { + if (ab_vs_cd(y1, y3, y2, y2) == 0) { + { + if (ab_vs_cd(y1, y2, zero_t, zero_t) < 0) { + mp_number tmp, arg2; + new_number(tmp); + new_number(arg2); + set_number_from_subtraction(arg2, y1, y2); + make_fraction(t, y1, arg2); + free_number(arg2); + set_number_from_of_the_way(x1, t, x1, x2); + set_number_from_of_the_way(x2, t, x2, x3); + set_number_from_of_the_way(tmp, t, x1, x2); + if (number_zero(tmp) || number_positive(tmp)) { + free_number(tmp); + number_clone(tt, t); + fraction_to_round_scaled(tt); + goto FOUND; + } else { + free_number(tmp); + } + } else if (number_zero(y3)) { + if (number_zero(y1)) { + { + mp_number arg1, arg2, arg3; + new_number(arg1); + new_number(arg2); + new_number(arg3); + number_negated_clone(arg1, x1); + number_negated_clone(arg2, x2); + number_negated_clone(arg3, x3); + crossing_point(t, arg1, arg2, arg3); + free_number(arg1); + free_number(arg2); + free_number(arg3); + if (number_lessequal(t, fraction_one_t)) { + number_clone(tt, t); + fraction_to_round_scaled(tt); + goto FOUND; + } else if (ab_vs_cd(x1, x3, x2, x2) <= 0) { + mp_number arg2; + new_number(arg2); + set_number_from_subtraction(arg2, x1, x2); + make_fraction(t, x1, arg2); + free_number(arg2); + number_clone(tt, t); + fraction_to_round_scaled(tt); + goto FOUND; + } + } + } else if (number_zero(x3) || number_positive(x3)) { + set_number_to_unity(tt); + goto FOUND; + } + } + goto DONE; + } + } + } + if (number_zero(y1) || number_negative(y1)) { + if (number_negative(y1)) { + number_negate(y1); + number_negate(y2); + number_negate(y3); + } else if (number_positive(y2)) { + number_negate(y2); + number_negate(y3); + } + } + crossing_point(t, y1, y2, y3); + if (number_greater(t, fraction_one_t)) { + goto DONE; + } + set_number_from_of_the_way(y2, t, y2, y3); + set_number_from_of_the_way(x1, t, x1, x2); + set_number_from_of_the_way(x2, t, x2, x3); + set_number_from_of_the_way(x1, t, x1, x2); + if (number_zero(x1) || number_positive(x1)) { + number_clone(tt, t); + fraction_to_round_scaled(tt); + goto FOUND; + } + if (number_positive(y2)) { + set_number_to_zero(y2); + } + number_clone(tt, t); + { + mp_number arg1, arg2, arg3; + new_number(arg1); + new_number(arg2); + new_number(arg3); + number_negated_clone(arg2, y2); + number_negated_clone(arg3, y3); + crossing_point(t, arg1, arg2, arg3); + free_number(arg1); + free_number(arg2); + free_number(arg3); + } + if (number_greater(t, fraction_one_t)) { + goto DONE; + } else { + mp_number tmp; + new_number(tmp); + set_number_from_of_the_way(x1, t, x1, x2); + set_number_from_of_the_way(x2, t, x2, x3); + set_number_from_of_the_way(tmp, t, x1, x2); + if (number_nonnegative(tmp)) { + free_number(tmp); + set_number_from_of_the_way(t, t, tt, fraction_one_t); + number_clone(tt, t); + fraction_to_round_scaled(tt); + goto FOUND; + } + free_number(tmp); + } + DONE: + p = q; + number_add(n, unity_t); + } + } + set_number_to_unity(*ret); + number_negate(*ret); + goto FREE; + FOUND: + set_number_from_addition(*ret, n, tt); + goto FREE; + FREE: + free_number(x); + free_number(y); + free_number(abs_x); + free_number(abs_y); + free_number(x1); + free_number(x2); + free_number(x3); + free_number(y1); + free_number(y2); + free_number(y3); + free_number(t); + free_number(phi); + free_number(n); + free_number(max); + free_number(tt); +} + +void mp_set_min_max (MP mp, int v) +{ + if (number_negative(stack_1(v))) { + if (number_nonnegative (stack_3(v))) { + if (number_negative(stack_2(v))) { + set_number_from_addition(stack_min(v), stack_1(v), stack_2(v)); + } else { + number_clone(stack_min(v), stack_1(v)); + } + set_number_from_addition(stack_max(v), stack_1(v), stack_2(v)); + number_add(stack_max(v), stack_3(v)); + if (number_negative(stack_max(v))) { + set_number_to_zero(stack_max(v)); + } + } else { + set_number_from_addition(stack_min(v), stack_1(v), stack_2(v)); + number_add(stack_min(v), stack_3(v)); + if (number_greater(stack_min(v), stack_1(v))) { + number_clone(stack_min(v), stack_1(v)); + } + set_number_from_addition(stack_max(v), stack_1(v), stack_2(v)); + if (number_negative(stack_max(v))) { + set_number_to_zero(stack_max(v)); + } + } + } else if (number_nonpositive(stack_3(v))) { + if (number_positive(stack_2(v))) { + set_number_from_addition(stack_max(v), stack_1(v), stack_2(v)); + } else { + number_clone(stack_max(v), stack_1(v)); + } + set_number_from_addition(stack_min(v), stack_1(v), stack_2(v)); + number_add(stack_min(v), stack_3(v)); + if (number_positive(stack_min(v))) { + set_number_to_zero(stack_min(v)); + } + } else { + set_number_from_addition(stack_max(v), stack_1(v), stack_2(v)); + number_add(stack_max(v), stack_3(v)); + if (number_less(stack_max(v), stack_1(v))) { + number_clone(stack_max(v), stack_1(v)); + } + set_number_from_addition(stack_min(v), stack_1(v), stack_2(v)); + if (number_positive(stack_min(v))) { + set_number_to_zero(stack_min(v)); + } + } +} + +static int mp_cubic_intersection(MP mp, mp_knot p, mp_knot pp, int run) +{ + mp_knot q, qq; + mp_number x_two_t; + mp_number x_two_t_low_precision; + mp->time_to_go = max_patience; + set_number_from_scaled(mp->max_t, 2); + new_number_clone(x_two_t, two_t); + new_number(x_two_t_low_precision); + number_double(x_two_t); + number_double(x_two_t); + set_number_from_double(x_two_t_low_precision, -0.5); + number_add(x_two_t_low_precision, x_two_t); + q = mp_next_knot(p); + qq = mp_next_knot(pp); + mp->bisect_ptr = int_packets; + set_number_from_subtraction(u1r, p->right_x, p->x_coord); + set_number_from_subtraction(u2r, q->left_x, p->right_x); + set_number_from_subtraction(u3r, q->x_coord, q->left_x); + mp_set_min_max(mp, ur_packet); + set_number_from_subtraction(v1r, p->right_y, p->y_coord); + set_number_from_subtraction(v2r, q->left_y, p->right_y); + set_number_from_subtraction(v3r, q->y_coord, q->left_y); + mp_set_min_max(mp, vr_packet); + set_number_from_subtraction(x1r, pp->right_x, pp->x_coord); + set_number_from_subtraction(x2r, qq->left_x, pp->right_x); + set_number_from_subtraction(x3r, qq->x_coord, qq->left_x); + mp_set_min_max(mp, xr_packet); + set_number_from_subtraction(y1r, pp->right_y, pp->y_coord); + set_number_from_subtraction(y2r, qq->left_y, pp->right_y); + set_number_from_subtraction(y3r, qq->y_coord, qq->left_y); + mp_set_min_max(mp, yr_packet); + set_number_from_subtraction(mp->delx, p->x_coord, pp->x_coord); + set_number_from_subtraction(mp->dely, p->y_coord, pp->y_coord); + mp->tol = 0; + mp->uv = r_packets; + mp->xy = r_packets; + mp->three_l = 0; + set_number_from_scaled(mp->cur_t, 1); + set_number_from_scaled(mp->cur_tt, 1); + + CONTINUE: + while (1) { + if (((x_packet (mp->xy))+4)>bistack_size + || ((u_packet (mp->uv))+4)>bistack_size + || ((y_packet (mp->xy))+4)>bistack_size + || ((v_packet (mp->uv))+4)>bistack_size){ + set_number_from_scaled(mp->cur_t,1); + set_number_from_scaled(mp->cur_tt,1); + goto NOT_FOUND; + } + if (number_greater(mp->max_t, x_two_t)){ + set_number_from_scaled(mp->cur_t,1); + set_number_from_scaled(mp->cur_tt,1); + goto NOT_FOUND; + } + if (number_to_scaled(mp->delx) - mp->tol <= number_to_scaled(stack_max (x_packet (mp->xy))) - number_to_scaled(stack_min (u_packet (mp->uv)))) { + if (number_to_scaled(mp->delx) + mp->tol >= number_to_scaled(stack_min (x_packet (mp->xy))) - number_to_scaled(stack_max (u_packet (mp->uv)))) { + if (number_to_scaled(mp->dely) - mp->tol <= number_to_scaled(stack_max (y_packet (mp->xy))) - number_to_scaled(stack_min (v_packet (mp->uv)))) { + if (number_to_scaled(mp->dely) + mp->tol >= number_to_scaled(stack_min (y_packet (mp->xy))) - number_to_scaled(stack_max (v_packet (mp->uv)))) { + if (number_to_scaled(mp->cur_t) >= number_to_scaled(mp->max_t)) { + if (number_equal(mp->max_t, x_two_t) || number_greater(mp->max_t, x_two_t_low_precision)) { + if (run == 1) { + number_divide_int(mp->cur_t,1<<2); + number_divide_int(mp->cur_tt,1<<2); + set_number_from_scaled(mp->cur_t, ((number_to_scaled(mp->cur_t) + 1)/2)); + set_number_from_scaled(mp->cur_tt, ((number_to_scaled(mp->cur_tt) + 1)/2)); +free_number(x_two_t); +free_number(x_two_t_low_precision); + return 1; + } else { + run--; + goto NOT_FOUND; + } + } + number_double(mp->max_t); + number_clone(mp->appr_t, mp->cur_t); + number_clone(mp->appr_tt, mp->cur_tt); + } + number_clone(stack_dx, mp->delx); + number_clone(stack_dy, mp->dely); + set_number_from_scaled(stack_tol, mp->tol); + set_number_from_scaled(stack_uv, mp->uv); + set_number_from_scaled(stack_xy, mp->xy); + mp->bisect_ptr = mp->bisect_ptr + int_increment; + number_double(mp->cur_t); + number_double(mp->cur_tt); + number_clone(u1l, stack_1(u_packet (mp->uv))); + number_clone(u3r, stack_3(u_packet (mp->uv))); + set_number_half_from_addition(u2l, u1l, stack_2(u_packet(mp->uv))); + set_number_half_from_addition(u2r, u3r, stack_2(u_packet(mp->uv))); + set_number_half_from_addition(u3l, u2l, u2r); + number_clone(u1r, u3l); + mp_set_min_max(mp, ul_packet); + mp_set_min_max(mp, ur_packet); + number_clone(v1l, stack_1(v_packet (mp->uv))); + number_clone(v3r, stack_3(v_packet (mp->uv))); + set_number_half_from_addition(v2l, v1l, stack_2(v_packet(mp->uv))); + set_number_half_from_addition(v2r, v3r, stack_2(v_packet(mp->uv))); + set_number_half_from_addition(v3l, v2l, v2r); + number_clone(v1r, v3l); + mp_set_min_max(mp, vl_packet); + mp_set_min_max(mp, vr_packet); + number_clone(x1l, stack_1(x_packet (mp->xy))); + number_clone(x3r, stack_3(x_packet (mp->xy))); + set_number_half_from_addition(x2l, x1l, stack_2(x_packet(mp->xy))); + set_number_half_from_addition(x2r, x3r, stack_2(x_packet(mp->xy))); + set_number_half_from_addition(x3l, x2l, x2r); + number_clone(x1r, x3l); + mp_set_min_max(mp, xl_packet); + mp_set_min_max(mp, xr_packet); + number_clone(y1l, stack_1(y_packet (mp->xy))); + number_clone(y3r, stack_3(y_packet (mp->xy))); + set_number_half_from_addition(y2l, y1l, stack_2(y_packet(mp->xy))); + set_number_half_from_addition(y2r, y3r, stack_2(y_packet(mp->xy))); + set_number_half_from_addition(y3l, y2l, y2r); + number_clone(y1r, y3l); + mp_set_min_max(mp, yl_packet); + mp_set_min_max(mp, yr_packet); + mp->uv = l_packets; + mp->xy = l_packets; + number_double(mp->delx); + number_double(mp->dely); + mp->tol = mp->tol - mp->three_l + (int) mp->tol_step; + mp->tol += mp->tol; + mp->three_l = mp->three_l + (int) mp->tol_step; + + goto CONTINUE; + } + } + } + } + if (mp->time_to_go > 0) { + --mp->time_to_go; + } else { + number_divide_int(mp->appr_t, 1<<2); + number_divide_int(mp->appr_tt, 1<<2); + while (number_less(mp->appr_t, unity_t)) { + number_double(mp->appr_t); + number_double(mp->appr_tt); + } + number_clone(mp->cur_t, mp->appr_t); + number_clone(mp->cur_tt, mp->appr_tt); +free_number(x_two_t); +free_number(x_two_t_low_precision); + return 2; + } + NOT_FOUND: + if (odd(number_to_scaled(mp->cur_tt))) { + + if (odd(number_to_scaled(mp->cur_t))) { + + set_number_from_scaled(mp->cur_t, half (number_to_scaled(mp->cur_t))); + set_number_from_scaled(mp->cur_tt, half (number_to_scaled(mp->cur_tt))); + if (number_to_scaled(mp->cur_t) == 0) { +free_number(x_two_t); +free_number(x_two_t_low_precision); + return 3; + } else { + mp->bisect_ptr -= int_increment; + mp->three_l -= (int) mp->tol_step; + number_clone(mp->delx, stack_dx); + number_clone(mp->dely, stack_dy); + mp->tol = number_to_scaled(stack_tol); + mp->uv = number_to_scaled(stack_uv); + mp->xy = number_to_scaled(stack_xy); + goto NOT_FOUND; + } + } else { + set_number_from_scaled(mp->cur_t, number_to_scaled(mp->cur_t) + 1); + number_add(mp->delx, stack_1(u_packet (mp->uv))); + number_add(mp->delx, stack_2(u_packet (mp->uv))); + number_add(mp->delx, stack_3(u_packet (mp->uv))); + number_add(mp->dely, stack_1(v_packet (mp->uv))); + number_add(mp->dely, stack_2(v_packet (mp->uv))); + number_add(mp->dely, stack_3(v_packet (mp->uv))); + mp->uv = mp->uv + int_packets; + set_number_from_scaled(mp->cur_tt, number_to_scaled(mp->cur_tt) - 1); + mp->xy = mp->xy - int_packets; + number_add(mp->delx, stack_1(x_packet (mp->xy))); + number_add(mp->delx, stack_2(x_packet (mp->xy))); + number_add(mp->delx, stack_3(x_packet (mp->xy))); + number_add(mp->dely, stack_1(y_packet (mp->xy))); + number_add(mp->dely, stack_2(y_packet (mp->xy))); + number_add(mp->dely, stack_3(y_packet (mp->xy))); + } + } else { + set_number_from_scaled(mp->cur_tt, number_to_scaled(mp->cur_tt) + 1); + mp->tol = mp->tol + mp->three_l; + number_subtract(mp->delx, stack_1(x_packet (mp->xy))); + number_subtract(mp->delx, stack_2(x_packet (mp->xy))); + number_subtract(mp->delx, stack_3(x_packet (mp->xy))); + number_subtract(mp->dely, stack_1(y_packet (mp->xy))); + number_subtract(mp->dely, stack_2(y_packet (mp->xy))); + number_subtract(mp->dely, stack_3(y_packet (mp->xy))); + mp->xy = mp->xy + int_packets; + } + } +free_number(x_two_t); +free_number(x_two_t_low_precision); +} + +static mp_knot mp_path_intersection_add(MP mp, mp_knot list, mp_knot *last, mp_number *t, mp_number *tt) +{ + int a = number_to_scaled(*t) >> intersection_run_shift; + int aa = number_to_scaled(*tt) >> intersection_run_shift; + int b = (list ? number_to_scaled((*last)->x_coord) : -1) >> intersection_run_shift ; + int bb = (list ? number_to_scaled((*last)->y_coord) : -1) >> intersection_run_shift ; + if (a == b && aa == bb) { + } else { + mp_knot k = mp_new_knot(mp); + mp_left_type(k) = mp_explicit_knot; + mp_right_type(k) = mp_explicit_knot; + number_clone(k->x_coord, *t); + number_clone(k->y_coord, *tt); + if (list) { + mp_prev_knot(k) = *last; + mp_next_knot(*last) = k; + mp_prev_knot(list) = k; + mp_next_knot(k) = list; + } else { + list = k; + mp_prev_knot(k) = k; + mp_next_knot(k) = k; + } + *last = k; + } + return list; +} + +static mp_knot mp_path_intersection(MP mp, mp_knot h, mp_knot hh, int path, mp_knot *last) +{ + mp_number n, nn; + int done = 0; + mp_knot list = NULL; + mp_knot l = NULL; + mp_knot ll = NULL; + if (last) { + *last = NULL; + } + if (mp_right_type(h) == mp_endpoint_knot) { + number_clone(h->right_x, h->x_coord); + number_clone(h->left_x, h->x_coord); + number_clone(h->right_y, h->y_coord); + number_clone(h->left_y, h->y_coord); + mp_right_type(h) = mp_explicit_knot; + } + if (mp_right_type(hh) == mp_endpoint_knot) { + number_clone(hh->right_x, hh->x_coord); + number_clone(hh->left_x, hh->x_coord); + number_clone(hh->right_y, hh->y_coord); + number_clone(hh->left_y, hh->y_coord); + mp_right_type(hh) = mp_explicit_knot; + } + new_number(n); + new_number(nn); + mp->tol_step = 0; + do { + mp_knot p, pp; + int t = -1; + int tt = -1; + + + number_negated_clone(n, unity_t); + p = h; + do { + if (mp_right_type(p) != mp_endpoint_knot) { + + + number_negated_clone(nn, unity_t); + pp = hh; + do { + if (mp_right_type(pp) != mp_endpoint_knot) { + int run = 0; + int retrials = 0; + RETRY: + ++run; + mp_cubic_intersection(mp, p, pp, run); + if (number_positive(mp->cur_t)) { + number_add(mp->cur_t, n); + number_add(mp->cur_tt, nn); + done = 1; + if (path) { + list = mp_path_intersection_add(mp, list, last, &(mp->cur_t), &(mp->cur_tt)); + if (t == number_to_scaled(mp->cur_t) && tt == number_to_scaled(mp->cur_tt)) { + if (retrials == 8) { + break; + } else { + retrials += 1; + goto RETRY; + } + } else { + retrials = 0; + t = number_to_scaled(mp->cur_t); + tt = number_to_scaled(mp->cur_tt); + goto RETRY; + } + } else { + goto DONE; + } + } + } + number_add(nn, unity_t); + ll = pp; + pp = mp_next_knot(pp); + } while (pp != hh); + } + number_add(n, unity_t); + l = p; + p = mp_next_knot(p); + } while (p != h); + mp->tol_step = mp->tol_step + 3; + if (done) { + goto DONE; + } + } while (mp->tol_step <= 3); + DONE: + if (path && l && ll && number_equal(l->x_coord, ll->x_coord) && number_equal(l->y_coord, ll->y_coord)) { + list = mp_path_intersection_add(mp, list, last, &n, &nn); + } + if (! done) { + number_negated_clone(mp->cur_t, unity_t); + number_negated_clone(mp->cur_tt, unity_t); + if (path && ! list) { + mp_knot k = mp_new_knot(mp); + number_clone(k->x_coord, mp->cur_t); + number_clone(k->y_coord, mp->cur_tt); + mp_prev_knot(k) = k; + mp_next_knot(k) = k; + list = k; + if (last) { + *last = k; + } + } + } + free_number(n); + free_number(nn); + return list; +} + +static void mp_new_indep (MP mp, mp_node p) +{ + (void) mp; + if (mp->serial_no >= max_integer) { + mp_fatal_error(mp, "Variable instance identifiers exhausted"); + } + mp_type(p) = mp_independent_type; + mp->serial_no = mp->serial_no + 1; + mp_set_indep_scale(p, 0); + mp_set_indep_value(p, mp->serial_no); +} + +inline static mp_node do_get_dep_info (MP mp, mp_value_node p) +{ + (void) mp; + mp_node d; + d = p->parent; + return d; +} + +inline static void do_set_dep_value (MP mp, mp_value_node p, mp_number *q) +{ + number_clone(p->data.n, *q); + p->attr_head = NULL; + p->subscr_head = NULL; +} + +static mp_value_node mp_get_dep_node (MP mp) +{ + mp_value_node p = (mp_value_node) mp_new_value_node(mp); + mp_type(p) = mp_dep_node_type; + return p; +} + +static void mp_free_dep_node (MP mp, mp_value_node p) +{ + mp_free_value_node(mp, (mp_node) p); +} + +void mp_print_dependency (MP mp, mp_value_node p, int t) +{ + mp_number v; + mp_node q; + mp_value_node pp = p; + new_number(v); + while (1) { + number_abs_clone(v, mp_get_dep_value(p)); + q = mp_get_dep_info(p); + if (q == NULL) { + if (number_nonzero(v) || (p == pp)) { + if (number_positive(mp_get_dep_value(p)) && p != pp) { + mp_print_chr(mp, '+'); + } + print_number(mp_get_dep_value(p)); + } + return; + } + if (number_negative(mp_get_dep_value(p))) { + mp_print_chr(mp, '-'); + } else if (p != pp) { + mp_print_chr(mp, '+'); + } + if (t == mp_dependent_type) { + fraction_to_round_scaled(v); + } + if (! number_equal(v, unity_t)) { + print_number(v); + } + if (mp_type(q) != mp_independent_type) { + mp_confusion(mp, "dependency"); + } else { + mp_print_variable_name(mp, q); + set_number_from_scaled(v, mp_get_indep_scale(q)); + while (number_positive(v)) { + mp_print_str(mp, "*4"); + number_add_scaled(v, -2); + } + p = (mp_value_node) mp_link(p); + } + } +} + +static void mp_max_coef (MP mp, mp_number *x, mp_value_node p) +{ + mp_number(absv); + new_number(absv); + set_number_to_zero(*x); + while (mp_get_dep_info(p) != NULL) { + number_abs_clone(absv, mp_get_dep_value(p)); + if (number_greater(absv, *x)) { + number_clone(*x, absv); + } + p = (mp_value_node) mp_link(p); + } + free_number(absv); +} + +static mp_value_node mp_p_plus_fq (MP mp, + mp_value_node p, mp_number *f, + mp_value_node q, mp_variable_type t, + mp_variable_type tt +) +{ + mp_node pp, qq; + mp_value_node r, s; + mp_number threshold; + mp_number half_threshold; + mp_number v, vv; + new_number(v); + new_number(vv); + if (t == mp_dependent_type) { + new_number_clone(threshold, fraction_threshold_k); + new_number_clone(half_threshold, half_fraction_threshold_k); + } else { + new_number_clone(threshold, scaled_threshold_k); + new_number_clone(half_threshold, half_scaled_threshold_k); + } + r = (mp_value_node) mp->temp_head; + pp = mp_get_dep_info(p); + qq = mp_get_dep_info(q); + while (1) { + if (pp == qq) { + if (pp == NULL) { + break; + } else { + mp_number r1; + mp_number absv; + new_fraction(r1); + new_number(absv); + if (tt == mp_dependent_type) { + take_fraction(r1, *f, mp_get_dep_value(q)); + } else { + take_scaled(r1, *f, mp_get_dep_value(q)); + } + set_number_from_addition(v, mp_get_dep_value(p), r1); + free_number(r1); + mp_set_dep_value(p, v); + s = p; + p = (mp_value_node) mp_link(p); + number_abs_clone(absv, v); + if (number_less(absv, threshold)) { + mp_free_dep_node(mp, s); + } else { + if (number_greaterequal(absv, coef_bound_k) && mp->watch_coefs) { + mp_type(qq) = independent_needing_fix; + mp->fix_needed = 1; + } + mp_set_link(r, s); + r = s; + } + free_number(absv); + pp = mp_get_dep_info(p); + q = (mp_value_node) mp_link(q); + qq = mp_get_dep_info(q); + } + } else { + if (pp == NULL) { + set_number_to_negative_inf(v); + } else if (mp_type(pp) == mp_independent_type || (mp_type(pp) == independent_needing_fix && mp->fix_needed)) { + set_number_from_scaled(v, mp_get_indep_value(pp)); + } else { + number_clone(v, mp_get_value_number(pp)); + } + if (qq == NULL) { + set_number_to_negative_inf(vv); + } else if (mp_type(qq) == mp_independent_type || (mp_type(qq) == independent_needing_fix && mp->fix_needed)) { + set_number_from_scaled(vv, mp_get_indep_value(qq)); + } else { + number_clone(vv, mp_get_value_number(qq)); + } + if (number_less(v, vv)) { + mp_number absv; + { + mp_number r1; + mp_number arg1, arg2; + new_fraction(r1); + new_number_clone(arg1, *f); + new_number_clone(arg2, mp_get_dep_value(q)); + if (tt == mp_dependent_type) { + take_fraction(r1, arg1, arg2); + } else { + take_scaled(r1, arg1, arg2); + } + number_clone(v, r1); + free_number(r1); + free_number(arg1); + free_number(arg2); + } + new_number_abs(absv, v); + if (number_greater(absv, half_threshold)) { + s = mp_get_dep_node(mp); + mp_set_dep_info(s, qq); + mp_set_dep_value(s, v); + if (number_greaterequal(absv, coef_bound_k) && mp->watch_coefs) { + mp_type(qq) = independent_needing_fix; + mp->fix_needed = 1; + } + mp_set_link(r, s); + r = s; + } + q = (mp_value_node) mp_link(q); + qq = mp_get_dep_info(q); + free_number(absv); + } else { + mp_set_link(r, p); + r = p; + p = (mp_value_node) mp_link(p); + pp = mp_get_dep_info(p); + } + } + } + { + mp_number r1; + mp_number arg1, arg2; + new_fraction(r1); + new_number(arg1); + new_number(arg2); + number_clone(arg1, mp_get_dep_value(q)); + number_clone(arg2, *f); + if (t == mp_dependent_type) { + take_fraction(r1, arg1, arg2); + } else { + take_scaled(r1, arg1, arg2); + } + slow_add(arg1, mp_get_dep_value(p), r1); + mp_set_dep_value(p, arg1); + free_number(r1); + free_number(arg1); + free_number(arg2); + } + mp_set_link(r, p); + mp->dep_final = p; + free_number(threshold); + free_number(half_threshold); + free_number(v); + free_number(vv); + return (mp_value_node) mp_link(mp->temp_head); +} + +static mp_value_node mp_p_plus_q (MP mp, mp_value_node p, mp_value_node q, mp_variable_type t) +{ + mp_node pp, qq; + mp_value_node s; + mp_value_node r; + mp_number threshold; + mp_number v, vv; + new_number(v); + new_number(vv); + new_number(threshold); + if (t == mp_dependent_type) { + number_clone(threshold, fraction_threshold_k); + } else { + number_clone(threshold, scaled_threshold_k); + } + r = (mp_value_node) mp->temp_head; + pp = mp_get_dep_info(p); + qq = mp_get_dep_info(q); + while (1) { + if (pp == qq) { + if (pp == NULL) { + break; + } else { + mp_number test; + new_number(test); + set_number_from_addition(v, mp_get_dep_value(p), mp_get_dep_value(q)); + mp_set_dep_value(p, v); + s = p; + p = (mp_value_node) mp_link(p); + pp = mp_get_dep_info(p); + number_abs_clone(test, v); + if (number_less(test, threshold)) { + mp_free_dep_node(mp, s); + } else { + if (number_greaterequal(test, coef_bound_k) && mp->watch_coefs) { + mp_type(qq) = independent_needing_fix; + mp->fix_needed = 1; + } + mp_set_link(r, s); + r = s; + } + free_number(test); + q = (mp_value_node) mp_link(q); + qq = mp_get_dep_info(q); + } + } else { + if (pp == NULL) { + set_number_to_zero(v); + } else if (mp_type(pp) == mp_independent_type || (mp_type(pp) == independent_needing_fix && mp->fix_needed)) { + set_number_from_scaled(v, mp_get_indep_value(pp)); + } else { + number_clone(v, mp_get_value_number(pp)); + } + if (qq == NULL) { + set_number_to_zero(vv); + } else if (mp_type(qq) == mp_independent_type || (mp_type(qq) == independent_needing_fix && mp->fix_needed)) { + set_number_from_scaled(vv, mp_get_indep_value(qq)); + } else { + number_clone(vv, mp_get_value_number(qq)); + } + if (number_less(v, vv)) { + s = mp_get_dep_node(mp); + mp_set_dep_info(s, qq); + mp_set_dep_value(s, mp_get_dep_value(q)); + q = (mp_value_node) mp_link(q); + qq = mp_get_dep_info(q); + mp_set_link(r, s); + r = s; + } else { + mp_set_link(r, p); + r = p; + p = (mp_value_node) mp_link(p); + pp = mp_get_dep_info(p); + } + } + } + { + mp_number r1; + new_number(r1); + slow_add(r1, mp_get_dep_value(p), mp_get_dep_value(q)); + mp_set_dep_value(p, r1); + free_number(r1); + } + mp_set_link(r, p); + mp->dep_final = p; + free_number(v); + free_number(vv); + free_number(threshold); + return (mp_value_node) mp_link(mp->temp_head); +} + +static mp_value_node mp_p_times_v (MP mp, mp_value_node p, mp_number *v, int t0, int t1, int v_is_scaled) +{ + mp_value_node r, s; + mp_number w; + mp_number threshold; + int scaling_down = (t0 != t1) ? 1 : (! v_is_scaled); + new_number(threshold); + new_number(w); + if (t1 == mp_dependent_type) { + number_clone(threshold, half_fraction_threshold_k); + } else { + number_clone(threshold, half_scaled_threshold_k); + } + r = (mp_value_node) mp->temp_head; + while (mp_get_dep_info(p) != NULL) { + mp_number test; + new_number(test); + if (scaling_down) { + take_fraction(w, *v, mp_get_dep_value(p)); + } else { + take_scaled(w, *v, mp_get_dep_value(p)); + } + number_abs_clone(test, w); + if (number_lessequal(test, threshold)) { + s = (mp_value_node) mp_link(p); + mp_free_dep_node(mp, p); + p = s; + } else { + if (number_greaterequal(test, coef_bound_k)) { + mp->fix_needed = 1; + mp_type(mp_get_dep_info(p)) = independent_needing_fix; + } + mp_set_link(r, p); + r = p; + mp_set_dep_value(p, w); + p = (mp_value_node) mp_link(p); + } + free_number(test); + } + mp_set_link(r, p); + { + mp_number r1; + new_number(r1); + if (v_is_scaled) { + take_scaled(r1, mp_get_dep_value(p), *v); + } else { + take_fraction(r1, mp_get_dep_value(p), *v); + } + mp_set_dep_value(p, r1); + free_number(r1); + } + free_number(w); + free_number(threshold); + return (mp_value_node) mp_link(mp->temp_head); +} + +mp_value_node mp_p_over_v (MP mp, mp_value_node p, mp_number *v_orig, int t0, int t1) +{ + mp_value_node r, s; + mp_number w; + mp_number threshold; + mp_number v; + int scaling_down = (t0 != t1); + new_number(w); + new_number(threshold); + new_number_clone(v, *v_orig); + if (t1 == mp_dependent_type) { + number_clone(threshold, half_fraction_threshold_k); + } else { + number_clone(threshold, half_scaled_threshold_k); + } + r = (mp_value_node) mp->temp_head; + while (mp_get_dep_info(p) != NULL) { + if (scaling_down) { + mp_number x, absv; + new_number_abs(absv, v); + if (number_less(absv, p_over_v_threshold_k)) { + new_number_clone(x, v); + convert_scaled_to_fraction(x); + make_scaled(w, mp_get_dep_value(p), x); + } else { + new_number_clone(x, mp_get_dep_value(p)); + fraction_to_round_scaled(x); + make_scaled(w, x, v); + } + free_number(x); + free_number(absv); + } else { + make_scaled(w, mp_get_dep_value(p), v); + } + { + mp_number test; + new_number(test); + number_abs_clone(test, w); + if (number_lessequal(test, threshold)) { + s = (mp_value_node) mp_link(p); + mp_free_dep_node(mp, p); + p = s; + } else { + if (number_greaterequal(test, coef_bound_k)) { + mp->fix_needed = 1; + mp_type(mp_get_dep_info(p)) = independent_needing_fix; + } + mp_set_link(r, p); + r = p; + mp_set_dep_value(p, w); + p = (mp_value_node) mp_link(p); + } + free_number(test); + } + } + mp_set_link(r, p); + { + mp_number ret; + new_number(ret); + make_scaled(ret, mp_get_dep_value(p), v); + mp_set_dep_value(p, ret); + free_number(ret); + } + free_number(v); + free_number(w); + free_number(threshold); + return (mp_value_node) mp_link(mp->temp_head); +} + +static mp_value_node mp_p_with_x_becoming_q (MP mp, mp_value_node p, mp_node x, mp_node q, int t) +{ + mp_value_node s = p; + mp_value_node r = (mp_value_node) mp->temp_head; + int sx = mp_get_indep_value(x); + while (mp_get_dep_info(s) != NULL && mp_get_indep_value(mp_get_dep_info(s)) > sx) { + r = s; + s = (mp_value_node) mp_link(s); + } + if (mp_get_dep_info(s) == NULL || mp_get_dep_info(s) != x) { + return p; + } else { + mp_value_node ret; + mp_number v1; + mp_set_link(mp->temp_head, p); + mp_set_link(r, mp_link(s)); + new_number_clone(v1, mp_get_dep_value(s)); + mp_free_dep_node(mp, s); + ret = mp_p_plus_fq(mp, (mp_value_node) mp_link(mp->temp_head), &v1, (mp_value_node) q, t, mp_dependent_type); + free_number(v1); + return ret; + } +} + +static void mp_val_too_big (MP mp, mp_number *x) +{ + if (number_positive(internal_value(mp_warning_check_internal))) { + char msg[256]; + mp_snprintf(msg, 256, "Value is too large (%s)", number_tostring(*x)); + mp_error( + mp, + msg, + "The equation I just processed has given some variable a value outside of the\n" + "safetyp range. Continue and I'll try to cope with that big value; but it might be\n" + "dangerous. (Set 'warningcheck := 0' to suppress this message.)" + ); + } +} + +void mp_make_known (MP mp, mp_value_node p, mp_value_node q) +{ + mp_variable_type t = mp_type(p); + mp_number absp; + new_number(absp); + mp_set_prev_dep(mp_link(q), mp_get_prev_dep(p)); + mp_set_link(mp_get_prev_dep(p), mp_link(q)); + mp_type(p) = mp_known_type; + mp_set_value_number(p, mp_get_dep_value(q)); + mp_free_dep_node(mp, q); + number_abs_clone(absp, mp_get_value_number(p)); + if (number_greaterequal(absp, warning_limit_t)) { + mp_val_too_big (mp, &(mp_get_value_number(p))); + } + if ((number_positive(internal_value(mp_tracing_equations_internal))) && mp_interesting(mp, (mp_node) p)) { + mp_begin_diagnostic(mp); + mp_print_nl(mp, "#### "); + mp_print_variable_name(mp, (mp_node) p); + mp_print_chr(mp, '='); + print_number(mp_get_value_number(p)); + mp_end_diagnostic(mp, 0); + } + if (cur_exp_node == (mp_node) p && mp->cur_exp.type == t) { + mp->cur_exp.type = mp_known_type; + mp_set_cur_exp_value_number(mp, &(mp_get_value_number(p))); + mp_free_value_node(mp, (mp_node) p); + } + free_number(absp); +} + +static void mp_fix_dependencies (MP mp) +{ + mp_value_node r = (mp_value_node) mp_link(mp->dep_head); + mp_value_node s = NULL; + while (r != mp->dep_head) { + mp_value_node t = r; + mp_value_node q; + while (1) { + mp_node x; + if (t == r) { + q = (mp_value_node) mp_get_dep_list(t); + } else { + q = (mp_value_node) mp_link(r); + } + x = mp_get_dep_info(q); + if (x == NULL) { + break; + } else if (mp_type(x) <= independent_being_fixed) { + if (mp_type(x) < independent_being_fixed) { + mp_value_node p = mp_get_dep_node(mp); + mp_set_link(p, s); + s = p; + mp_set_dep_info(s, x); + mp_type(x) = independent_being_fixed; + } + mp_set_dep_value(q, mp_get_dep_value(q)); + number_divide_int(mp_get_dep_value(q), 4); + if (number_zero(mp_get_dep_value(q))) { + mp_set_link(r, mp_link(q)); + mp_free_dep_node(mp, q); + q = r; + } + } + r = q; + } + r = (mp_value_node) mp_link(q); + if (q == (mp_value_node) mp_get_dep_list(t)) { + mp_make_known(mp, t, q); + } + } + while (s != NULL) { + mp_value_node p = (mp_value_node) mp_link(s); + mp_node x = mp_get_dep_info(s); + mp_free_dep_node(mp, s); + s = p; + mp_type(x) = mp_independent_type; + mp_set_indep_scale(x, mp_get_indep_scale(x) + 2); + } + mp->fix_needed = 0; +} + +static void mp_new_dep (MP mp, mp_node q, mp_variable_type newtype, mp_value_node p) +{ + mp_node r; + mp_type(q) = newtype; + mp_set_dep_list(q, p); + mp_set_prev_dep(q, (mp_node) mp->dep_head); + r = mp_link(mp->dep_head); + mp_set_link(mp->dep_final, r); + mp_set_prev_dep(r, (mp_node) mp->dep_final); + mp_set_link(mp->dep_head, q); +} + +static mp_value_node mp_const_dependency (MP mp, mp_number *v) +{ + mp->dep_final = mp_get_dep_node(mp); + mp_set_dep_value(mp->dep_final, *v); + mp_set_dep_info(mp->dep_final, NULL); + return mp->dep_final; +} + +static mp_value_node mp_single_dependency (MP mp, mp_node p) +{ + mp_value_node q; + int m = mp_get_indep_scale(p); + if (m > 28) { + q = mp_const_dependency(mp, &zero_t); + } else { + mp_value_node rr; + q = mp_get_dep_node(mp); + mp_set_dep_value(q, zero_t); + set_number_from_scaled(mp_get_dep_value(q), (int) two_to_the(28 - m)); + mp_set_dep_info(q, p); + rr = mp_const_dependency(mp, &zero_t); + mp_set_link(q, rr); + } + return q; +} + +static mp_value_node mp_copy_dep_list (MP mp, mp_value_node p) +{ + mp_value_node q = mp_get_dep_node(mp); + mp->dep_final = q; + while (1) { + mp_set_dep_info(mp->dep_final, mp_get_dep_info(p)); + mp_set_dep_value(mp->dep_final, mp_get_dep_value(p)); + if (mp_get_dep_info(mp->dep_final) == NULL) { + break; + } else { + mp_set_link(mp->dep_final, mp_get_dep_node(mp)); + mp->dep_final = (mp_value_node) mp_link(mp->dep_final); + p = (mp_value_node) mp_link(p); + } + } + return q; +} + +static mp_value_node find_node_with_largest_coefficient (MP mp, mp_value_node p, mp_number *v); + +static void display_new_dependency (MP mp, mp_value_node p, mp_node x, int n); + +static void change_to_known (MP mp, mp_value_node p, mp_node x, mp_value_node final_node, int n); + +static mp_value_node divide_p_by_minusv_removing_q (MP mp, + mp_value_node p, mp_value_node q, + mp_value_node *final_node, mp_number *v, int t +); + +static mp_value_node divide_p_by_2_n (MP mp, mp_value_node p, int n); + +static void mp_linear_eq (MP mp, mp_value_node p, int t) +{ + mp_value_node r; + mp_node x; + int n; + mp_number v; + mp_value_node prev_r; + mp_value_node final_node; + mp_value_node qq; + new_number(v); + qq = find_node_with_largest_coefficient(mp, p, &v); + x = mp_get_dep_info(qq); + n = mp_get_indep_scale(x); + p = divide_p_by_minusv_removing_q(mp, p, qq, &final_node, &v, t); + if (number_positive(internal_value(mp_tracing_equations_internal))) { + display_new_dependency(mp, p, (mp_node) x, n); + } + prev_r = (mp_value_node) mp->dep_head; + r = (mp_value_node) mp_link(mp->dep_head); + while (r != mp->dep_head) { + mp_value_node s = (mp_value_node) mp_get_dep_list(r); + mp_value_node q = mp_p_with_x_becoming_q(mp, s, x, (mp_node) p, mp_type(r)); + if (mp_get_dep_info(q) == NULL) { + mp_make_known(mp, r, q); + } else { + mp_set_dep_list(r, q); + do { + q = (mp_value_node) mp_link(q); + } while (mp_get_dep_info(q) != NULL); + prev_r = q; + } + r = (mp_value_node) mp_link(prev_r); + } + if (n > 0) { + p = divide_p_by_2_n(mp, p, n); + } + change_to_known(mp, p, (mp_node) x, final_node, n); + if (mp->fix_needed) { + mp_fix_dependencies(mp); + } + free_number(v); +} + +static mp_value_node find_node_with_largest_coefficient (MP mp, mp_value_node p, mp_number *v) +{ + mp_number vabs; + mp_number rabs; + mp_value_node q = p; + mp_value_node r = (mp_value_node) mp_link(p); + new_number(vabs); + new_number(rabs); + number_clone(*v, mp_get_dep_value(q)); + while (mp_get_dep_info(r) != NULL) { + number_abs_clone(vabs, *v); + number_abs_clone(rabs, mp_get_dep_value(r)); + if (number_greater(rabs, vabs)) { + q = r; + number_clone(*v, mp_get_dep_value(r)); + } + r = (mp_value_node) mp_link(r); + } + free_number(vabs); + free_number(rabs); + return q; +} + +static mp_value_node divide_p_by_minusv_removing_q (MP mp, + mp_value_node p, mp_value_node q, + mp_value_node *final_node, mp_number *v, int t +) +{ + mp_value_node r = p; + mp_value_node s = (mp_value_node) mp->temp_head; + mp_set_link(s, p); + do { + if (r == q) { + mp_set_link(s, mp_link(r)); + mp_free_dep_node(mp, r); + } else { + mp_number w; + mp_number absw; + new_number(w); + new_number(absw); + make_fraction(w, mp_get_dep_value(r), *v); + number_abs_clone(absw, w); + if (number_lessequal(absw, half_fraction_threshold_k)) { + mp_set_link(s, mp_link(r)); + mp_free_dep_node(mp, r); + } else { + number_negate(w); + mp_set_dep_value(r, w); + s = r; + } + free_number(w); + free_number(absw); + } + r = (mp_value_node) mp_link(s); + } while (mp_get_dep_info(r) != NULL); + if (t == mp_proto_dependent_type) { + mp_number ret; + new_number(ret); + make_scaled(ret, mp_get_dep_value(r), *v); + number_negate(ret); + mp_set_dep_value(r, ret); + free_number(ret); + } else if (number_to_scaled(*v) != -number_to_scaled(fraction_one_t)) { + mp_number ret; + new_fraction(ret); + make_fraction(ret, mp_get_dep_value(r), *v); + number_negate(ret); + mp_set_dep_value(r, ret); + free_number(ret); + } + *final_node = r; + return (mp_value_node) mp_link(mp->temp_head); +} + +static void display_new_dependency (MP mp, mp_value_node p, mp_node x, int n) +{ + if (mp_interesting(mp, x)) { + mp_begin_diagnostic(mp); + mp_print_nl(mp, "## "); + mp_print_variable_name(mp, x); + while (n > 0) { + mp_print_str(mp, "*4"); + n = n - 2; + } + mp_print_chr(mp, '='); + mp_print_dependency(mp, p, mp_dependent_type); + mp_end_diagnostic(mp, 0); + } +} + +static mp_value_node divide_p_by_2_n (MP mp, mp_value_node p, int n) +{ + mp_value_node pp = NULL; + if (n > 0) { + mp_value_node r; + mp_value_node s; + mp_number absw; + mp_number w; + new_number(w); + new_number(absw); + s = (mp_value_node) mp->temp_head; + mp_set_link(mp->temp_head, p); + r = p; + do { + if (n > 30) { + set_number_to_zero(w); + } else { + number_clone(w, mp_get_dep_value(r)); + number_divide_int(w, two_to_the(n)); + } + number_abs_clone(absw, w); + if (number_lessequal(absw, half_fraction_threshold_k) && (mp_get_dep_info(r) != NULL)) { + mp_set_link(s, mp_link(r)); + mp_free_dep_node(mp, r); + } else { + mp_set_dep_value(r, w); + s = r; + } + r = (mp_value_node) mp_link(s); + } while (mp_get_dep_info(s) != NULL); + pp = (mp_value_node) mp_link(mp->temp_head); + free_number(absw); + free_number(w); + } + return pp; +} + +static void change_to_known (MP mp, mp_value_node p, mp_node x, mp_value_node final_node, int n) +{ + (void) n; + if (mp_get_dep_info(p) == NULL) { + mp_number absx; + mp_type(x) = mp_known_type; + mp_set_value_number(x, mp_get_dep_value(p)); + new_number_abs(absx, mp_get_value_number(x)); + if (number_greaterequal(absx, warning_limit_t)) { + mp_val_too_big(mp, &(mp_get_value_number(x))); + } + free_number(absx); + mp_free_dep_node(mp, p); + if (cur_exp_node == x && mp->cur_exp.type == mp_independent_type) { + mp_set_cur_exp_value_number(mp, &(mp_get_value_number(x))); + mp->cur_exp.type = mp_known_type; + mp_free_value_node(mp, x); + } + } else { + mp->dep_final = final_node; + mp_new_dep(mp, x, mp_dependent_type, p); + if (cur_exp_node == x && mp->cur_exp.type == mp_independent_type) { + mp->cur_exp.type = mp_dependent_type; + } + } +} + +static mp_node mp_new_ring_entry (MP mp, mp_node p) +{ + mp_node q = mp_new_value_node(mp); + mp_name_type(q) = mp_capsule_operation; + mp_type(q) = mp_type(p); + if (mp_get_value_node(p) == NULL) { + mp_set_value_node(q, p); + } else { + mp_set_value_node(q, mp_get_value_node(p)); + } + mp_set_value_node(p, q); + return q; +} + +void mp_ring_delete (MP mp, mp_node p) +{ + (void) mp; + mp_node q = mp_get_value_node(p); + if (q != NULL && q != p) { + while (mp_get_value_node(q) != p) { + q = mp_get_value_node(q); + } + mp_set_value_node(q, mp_get_value_node(p)); + } +} + +static void mp_nonlinear_eq (MP mp, mp_value v, mp_node p, int flush_p) +{ + mp_variable_type t = mp_type(p) - unknown_tag; + mp_node q = mp_get_value_node(p); + if (flush_p) { + mp_type(p) = mp_vacuous_type; + } else { + p = q; + } + do { + mp_node r = mp_get_value_node(q); + mp_type(q) = t; + switch (t) { + case mp_boolean_type: + mp_set_value_number(q, v.data.n); + break; + case mp_string_type: + mp_set_value_str(q, v.data.str); + add_str_ref(v.data.str); + break; + case mp_pen_type: + case mp_nep_type: + mp_set_value_knot(q, mp_copy_pen(mp, v.data.p)); + break; + case mp_path_type: + mp_set_value_knot(q, mp_copy_path(mp, v.data.p)); + break; + case mp_picture_type: + mp_set_value_node(q, v.data.node); + mp_add_edge_ref(mp, v.data.node); + break; + default: + break; + } + q = r; + } while (q != p); +} + +static void mp_ring_merge (MP mp, mp_node p, mp_node q) +{ + mp_node r = mp_get_value_node(p); + while (r != p) { + if (r == q) { + mp_exclaim_redundant_equation(mp); + return; + } else { + r = mp_get_value_node(r); + } + } + r = mp_get_value_node(p); + mp_set_value_node(p, mp_get_value_node(q)); + mp_set_value_node(q, r); +} + +static void mp_exclaim_redundant_equation (MP mp) +{ + mp_back_error( + mp, + "Redundant equation", + "I already knew that this equation was true. But perhaps no harm has been done;\n" + "let's continue." + ); + mp_get_x_next(mp); +} + +const char *mp_cmd_mod_string (MP mp, int c, int m) +{ + switch (c) { + case mp_add_to_command: return "addto"; + case mp_assignment_command: return ":="; + case mp_at_least_command: return "atleast"; + case mp_begin_group_command: return "begingroup"; + case mp_colon_command: return ":"; + case mp_comma_command: return ","; + case mp_controls_command: return "controls"; + case mp_curl_command: return "curl"; + case mp_delimiters_command: return "delimiters"; + case mp_end_group_command: return "endgroup"; + case mp_every_job_command: return "everyjob"; + case mp_exit_test_command: return "exitif"; + case mp_expand_after_command: return "expandafter"; + case mp_interim_command: return "interim"; + case mp_left_brace_command: return "{"; + case mp_left_bracket_command: return "["; + case mp_let_command: return "let"; + case mp_new_internal_command: return "newinternal"; + case mp_of_command: return "of"; + case mp_path_join_command: return ".."; + case mp_relax_command: return "\\"; + case mp_right_brace_command: return "}"; + case mp_right_bracket_command: return "]"; + case mp_save_command: return "save"; + case mp_scan_tokens_command: return "scantokens"; + case mp_runscript_command: return "runscript"; + case mp_maketext_command: return "maketext"; + case mp_semicolon_command: return ";"; + case mp_ship_out_command: return "shipout"; + case mp_step_command: return "step"; + case mp_str_command: return "str"; + case mp_void_command: return "void"; + case mp_tension_command: return "tension"; + case mp_to_command: return "to"; + case mp_until_command: return "until"; + case mp_within_command: return "within"; + case mp_write_command: return "write"; + case mp_btex_command: return m == mp_btex_code ? "btex" : "verbatimtex"; + case mp_etex_command: return "etex"; + case mp_macro_def_command: + switch (m) { + case mp_end_def_code : return "enddef"; + case mp_def_code : return "def"; + case mp_var_def_code : return "vardef"; + case mp_primary_def_code : return "primarydef"; + case mp_secondary_def_code: return "secondarydef"; + case mp_tertiary_def_code : return "tertiarydef"; + default: return "?def"; + } + break; + case mp_iteration_command: + switch (m) { + case mp_end_for_code : return "endfor"; + case mp_start_forever_code : return "forever"; + case mp_start_for_code : return "for"; + case mp_start_forsuffixes_code: return "forsuffixes"; + } + break; + case mp_only_set_command: + switch (m) { + case mp_random_seed_code : return"randomseed"; + case mp_max_knot_pool_code: return"maxknotpool"; + } + break; + case mp_macro_special_command: + switch (m) { + case mp_macro_prefix_code: return "#@"; + case mp_macro_at_code : return "@"; + case mp_macro_suffix_code: return "@#"; + case mp_macro_quote_code : return "quote"; + } + break; + case mp_parameter_commmand: + switch (m) { + case mp_expr_parameter : return "expr"; + case mp_suffix_parameter: return "suffix"; + case mp_text_parameter : return "text"; + case mp_primary_macro : return "primary"; + case mp_secondary_macro : return "secondary"; + default : return "tertiary"; + } + break; + case mp_input_command: + return m == 0 ? "input" : "endinput"; + case mp_if_test_command: + case mp_fi_or_else_command: + switch (m) { + case mp_if_code : return "if"; + case mp_fi_code : return "fi"; + case mp_else_code : return "else"; + case mp_else_if_code: return "elseif"; + } + break; + case mp_nullary_command: + case mp_unary_command: + case mp_of_binary_command: + case mp_secondary_binary_command: + case mp_tertiary_binary_command: + case mp_primary_binary_command: + case mp_cycle_command: + case mp_plus_or_minus_command: + case mp_slash_command: + case mp_ampersand_command: + case mp_equals_command: + case mp_and_command: + return mp_op_string((int) m); + case mp_type_name_command: + return ""; + case mp_stop_command: + return cur_mod == 0 ? "end" : "dump"; + case mp_mode_command: + switch (m) { + case mp_batch_mode : return "batchmode"; + case mp_nonstop_mode : return "nonstopmode"; + case mp_scroll_mode : return "scrollmode"; + case mp_error_stop_mode: return "errorstopmode"; + default : return "silentmode"; + } + break; + case mp_protection_command: + switch (m) { + case 0: return "inner"; + case 1: return "outer"; + } + break; + case mp_property_command: + return "setproperty"; + case mp_show_command: + switch (m) { + case mp_show_token_code : return "showtoken"; + case mp_show_stats_code : return "showstats"; + case mp_show_code : return "show"; + case mp_show_var_code : return "showvariable"; + case mp_show_dependencies_code: return "showdependencies"; + } + break; + case mp_left_delimiter_command: + case mp_right_delimiter_command: + return c == mp_left_delimiter_command ? "left delimiter" : "right delimiter"; + case mp_tag_command: + return m == 0 ? "tag" : "variable"; + case mp_defined_macro_command: + return "macro:"; + case mp_primary_def_command: + return "primarydef"; + case mp_secondary_def_command: + return "secondarydef"; + case mp_tertiary_def_command: + return "tertiarydef"; + case mp_repeat_loop_command: + return "[repeat the loop]"; + case mp_internal_command: + return internal_name(m); + case mp_thing_to_add_command: + switch (m) { + case mp_add_contour_code : return "contour"; + case mp_add_double_path_code: return "doublepath"; + case mp_add_also_code : return "also"; + } + break; + case mp_with_option_command: + switch (m) { + case mp_with_pen_code : return "withpen"; + case mp_with_pre_script_code : return "withprescript"; + case mp_with_post_script_code : return "withpostscript"; + case mp_with_stacking_code : return "withstacking"; + case mp_with_no_model_code : return "withoutcolor"; + case mp_with_rgb_model_code : return "withrgbcolor"; + case mp_with_uninitialized_model_code: return "withcolor"; + case mp_with_cmyk_model_code : return "withcmykcolor"; + case mp_with_grey_model_code : return "withgreyscale"; + case mp_with_linecap_code : return "withlinecap"; + case mp_with_linejoin_code : return "withlinejoin"; + case mp_with_miterlimit_code : return "withmiterlimit"; + default : return "dashed"; + } + break; + case mp_bounds_command: + switch (m) { + case mp_start_clip_node_type : return "clip"; + case mp_start_group_node_type : return "setgroup"; + case mp_start_bounds_node_type: return "setbounds"; + } + break; + case mp_message_command: + if (m < err_message_code) { + return "message"; + } else if (m == err_message_code) { + return "errmessage"; + } else { + return "errhelp"; + } + } + return "[unknown command code!]"; +} + +void mp_print_cmd_mod (MP mp, int c, int m) +{ + mp_print_str(mp, mp_cmd_mod_string(mp, c, m)); +} + +static void mp_show_cmd_mod (MP mp, int c, int m) +{ + mp_begin_diagnostic(mp); + mp_print_nl(mp, "{"); + switch (c) { + case mp_primary_def_command: + case mp_secondary_def_command: + case mp_tertiary_def_command: + mp_print_cmd_mod(mp, mp_macro_def_command, c); + mp_print_str(mp, "'d macro:"); + mp_print_ln(mp); + mp_show_token_list(mp, mp_link(mp_link(cur_mod_node)),0); + break; + default: + mp_print_cmd_mod(mp, c, m); + break; + } + mp_print_chr(mp, '}'); + mp_end_diagnostic(mp, 0); +} + +static void mp_reallocate_input_stack (MP mp, int newsize) +{ + int n = newsize + 1; + mp->input_file = mp_memory_reallocate(mp->input_file, (size_t) (n + 1) * sizeof(void *)); + mp->line_stack = mp_memory_reallocate(mp->line_stack, (size_t) (n + 1) * sizeof(int)); + for (int k = mp->max_in_open; k <= n; k++) { + mp->input_file[k] = NULL; + mp->line_stack[k] = 0; + } + mp->max_in_open = newsize; +} + +static void mp_check_param_size (MP mp, int k) +{ + while (k >= mp->param_size) { + mp->param_stack = mp_memory_reallocate(mp->param_stack, (size_t) ((k + k / 4) + 1) * sizeof(mp_node)); + mp->param_size = k + k / 4; + } +} + +int mp_true_line (MP mp) +{ + int k; + if (file_state && (name > max_spec_src)) { + return line; + } else { + k = mp->input_ptr; + while ((k > 0) && ((mp->input_stack[(k - 1)].index_field < mp_file_bottom_text) + || (mp->input_stack[(k - 1)].name_field <= max_spec_src))) { + --k; + } + return (k > 0 ? mp->line_stack[(k - 1) + mp_file_bottom_text] : 0); + } +} + +void mp_show_context (MP mp) +{ + mp->file_ptr = mp->input_ptr; + mp->input_stack[mp->file_ptr] = mp->cur_input; + while (1) { + mp->cur_input = mp->input_stack[mp->file_ptr]; + + if ((mp->file_ptr == mp->input_ptr) || file_state || (token_type != mp_backed_up_text) || (nloc != NULL)) { + if (file_state) { + if (name > max_spec_src) { + mp_print_nl(mp, "<line "); + mp_print_int(mp, mp_true_line(mp)); + mp_print_chr(mp, '>'); + } else if (terminal_input) { + if (mp->file_ptr == 0) { + mp_print_nl(mp, "<direct>"); + } else { + mp_print_nl(mp, "<insert>"); + } + } else if (name == is_scantok) { + mp_print_nl(mp, "<scantokens>"); + } else { + mp_print_nl(mp, "<read>"); + } + mp_print_chr(mp, ' '); + + if (limit > 0) { + for (int i = start; i <= limit - 1; i++) { + mp_print_chr(mp, mp->buffer[i]); + } + } + } else { + { + switch (token_type) { + case mp_forever_text: + mp_print_nl(mp, "<forever> "); + break; + case mp_loop_text: + { + mp_node pp = mp->param_stack[param_start]; + mp_print_nl(mp, "<for("); + if (pp != NULL) { + if (mp_link(pp) == MP_VOID) { + mp_print_exp(mp, pp, 0); + } else { + mp_show_token_list(mp, pp, NULL); + } + } + mp_print_str(mp, ")> "); + } + break; + case mp_parameter_text: + mp_print_nl(mp, "<argument> "); + break; + case mp_backed_up_text: + mp_print_nl(mp, nloc == NULL ? "<recently read> " : "<to be read again> "); + break; + case mp_inserted_text: + mp_print_nl(mp, "<inserted text> "); + break; + case mp_macro_text: + mp_print_nl(mp, "<macro> "); + + if (name != NULL) { + mp_print_mp_str(mp, name); + } else { + { + mp_node pp = mp->param_stack[param_start]; + if (pp == NULL) { + mp_show_token_list(mp, mp->param_stack[param_start + 1], NULL); + } else { + mp_node qq = pp; + while (mp_link(qq) != NULL) { + qq = mp_link(qq); + } + mp_link(qq) = mp->param_stack[param_start + 1]; + mp_show_token_list(mp, pp, NULL); + mp_link(qq) = NULL; + } + } + } + mp_print_str(mp, " -> "); + break; + default: + mp_print_nl(mp, "?"); + break; + } + } + if (token_type == mp_macro_text) { + mp_show_macro(mp, nstart, nloc); + } else if (mp->show_mode) { + mp_show_token_list_space(mp, nstart, nloc); + } else { + mp_show_token_list(mp, nstart, nloc); + } + } + } + if (file_state && (name > max_spec_src || mp->file_ptr == 0)) { + break; + } else { + --mp->file_ptr; + } + } + mp->cur_input = mp->input_stack[mp->input_ptr]; +} + +void mp_push_input (MP mp) +{ + if (mp->input_ptr > mp->max_in_stack) { + mp->max_in_stack = mp->input_ptr; + if (mp->input_ptr == mp->stack_size) { + int l = (mp->stack_size + (mp->stack_size/4)); + if (l > 1000) { + mp_fatal_error(mp, "job aborted, more than 1000 input levels"); + } else { + mp_in_state_record *s = mp_memory_reallocate(mp->input_stack, (size_t) (l + 1) * sizeof(mp_in_state_record)); + if (s) { + mp->input_stack = s; + mp->stack_size = l; + } else { + mp_fatal_error(mp, "job aborted, out of memory"); + } + } + } + } + mp->input_stack[mp->input_ptr] = mp->cur_input; + ++mp->input_ptr; +} + +void mp_pop_input (MP mp) +{ + --mp->input_ptr; + mp->cur_input = mp->input_stack[mp->input_ptr]; +} + +static void mp_begin_token_list (MP mp, mp_node p, int t) +{ + mp_push_input(mp); + nstart = p; + token_type = t; + param_start = mp->param_ptr; + nloc = p; +} + +static void mp_end_token_list (MP mp) +{ + if (token_type >= mp_backed_up_text) { + if (token_type <= mp_inserted_text) { + mp_flush_token_list(mp, nstart); + goto DONE; + } else { + mp_delete_mac_ref(mp, nstart); + } + } + while (mp->param_ptr > param_start) { + mp_node p; + --mp->param_ptr; + p = mp->param_stack[mp->param_ptr]; + if (p != NULL) { + if (mp_link(p) == MP_VOID) { + mp_recycle_value(mp, p); + mp_free_value_node(mp, p); + } else { + mp_flush_token_list(mp, p); + } + } + } + DONE: + mp_pop_input(mp); +} + +static void mp_encapsulate (MP mp, mp_value_node p) +{ + mp_node q = mp_new_value_node(mp); + mp_name_type(q) = mp_capsule_operation; + mp_new_dep(mp, q, mp->cur_exp.type, p); + mp_set_cur_exp_node(mp, q); +} +static void mp_install (MP mp, mp_node r, mp_node q) +{ + if (mp_type(q) == mp_known_type) { + mp_type(r) = mp_known_type; + mp_set_value_number(r, mp_get_value_number(q)); + } else if (mp_type(q) == mp_independent_type) { + mp_value_node p = mp_single_dependency(mp, q); + if (p == mp->dep_final) { + mp_type(r) = mp_known_type; + mp_set_value_number(r, zero_t); + mp_free_dep_node(mp, p); + } else { + mp_new_dep(mp, r, mp_dependent_type, p); + } + } else { + mp_new_dep(mp, r, mp_type(q), mp_copy_dep_list(mp, (mp_value_node) mp_get_dep_list((mp_value_node) q))); + } +} + +static void mp_make_exp_copy (MP mp, mp_node p) +{ + RESTART: + mp->cur_exp.type = mp_type(p); + switch (mp->cur_exp.type) { + case mp_vacuous_type: + case mp_boolean_type: + case mp_known_type: + mp_set_cur_exp_value_number(mp, &(mp_get_value_number(p))); + break; + case mp_unknown_boolean_type: + case mp_unknown_string_type: + case mp_unknown_pen_type: + case mp_unknown_nep_type: + case mp_unknown_path_type: + case mp_unknown_picture_type: + { + mp_node t = mp_new_ring_entry(mp, p); + mp_set_cur_exp_node(mp, t); + } + break; + case mp_string_type: + mp_set_cur_exp_str(mp, mp_get_value_str(p)); + break; + case mp_picture_type: + mp_set_cur_exp_node(mp, mp_get_value_node(p)); + mp_add_edge_ref(mp, cur_exp_node); + break; + case mp_pen_type: + case mp_nep_type: + mp_set_cur_exp_knot(mp, mp_copy_pen(mp, mp_get_value_knot(p))); + break; + case mp_path_type: + mp_set_cur_exp_knot(mp, mp_copy_path(mp, mp_get_value_knot(p))); + break; + case mp_transform_type: + case mp_color_type: + case mp_cmykcolor_type: + case mp_pair_type: + { + mp_node t; + mp_value_node q; + if (mp_get_value_node(p) == NULL) { + switch (mp_type(p)) { + case mp_pair_type: + mp_init_pair_node(mp, p); + break; + case mp_color_type: + mp_init_color_node(mp, p, mp_color_type); + break; + case mp_cmykcolor_type: + mp_init_color_node(mp, p, mp_cmykcolor_type); + break; + case mp_transform_type: + mp_init_transform_node(mp, p); + break; + default: + break; + } + } + t = mp_new_value_node(mp); + mp_name_type(t) = mp_capsule_operation; + q = (mp_value_node) mp_get_value_node(p); + switch (mp->cur_exp.type) { + case mp_pair_type: + mp_init_pair_node(mp, t); + mp_install(mp, mp_y_part(mp_get_value_node(t)), mp_y_part(q)); + mp_install(mp, mp_x_part(mp_get_value_node(t)), mp_x_part(q)); + break; + case mp_color_type: + mp_init_color_node(mp, t, mp_color_type); + mp_install(mp, mp_blue_part(mp_get_value_node(t)), mp_blue_part(q)); + mp_install(mp, mp_green_part(mp_get_value_node(t)), mp_green_part(q)); + mp_install(mp, mp_red_part(mp_get_value_node(t)), mp_red_part(q)); + break; + case mp_cmykcolor_type: + mp_init_color_node(mp, t, mp_cmykcolor_type); + mp_install(mp, mp_black_part(mp_get_value_node(t)), mp_black_part(q)); + mp_install(mp, mp_yellow_part(mp_get_value_node(t)), mp_yellow_part(q)); + mp_install(mp, mp_magenta_part(mp_get_value_node(t)), mp_magenta_part(q)); + mp_install(mp, mp_cyan_part(mp_get_value_node(t)), mp_cyan_part(q)); + break; + case mp_transform_type: + mp_init_transform_node(mp, t); + mp_install(mp, mp_yy_part(mp_get_value_node(t)), mp_yy_part(q)); + mp_install(mp, mp_yx_part(mp_get_value_node(t)), mp_yx_part(q)); + mp_install(mp, mp_xy_part(mp_get_value_node(t)), mp_xy_part(q)); + mp_install(mp, mp_xx_part(mp_get_value_node(t)), mp_xx_part(q)); + mp_install(mp, mp_ty_part(mp_get_value_node(t)), mp_ty_part(q)); + mp_install(mp, mp_tx_part(mp_get_value_node(t)), mp_tx_part(q)); + break; + default: + break; + } + mp_set_cur_exp_node(mp, t); + } + break; + case mp_dependent_type: + case mp_proto_dependent_type: + mp_encapsulate (mp, mp_copy_dep_list(mp, (mp_value_node) mp_get_dep_list((mp_value_node) p))); + break; + case mp_numeric_type: + mp_new_indep(mp, p); + goto RESTART; + case mp_independent_type: + { + mp_value_node q = mp_single_dependency(mp, p); + if (q == mp->dep_final) { + mp->cur_exp.type = mp_known_type; + mp_set_cur_exp_value_number(mp, &zero_t); + mp_free_dep_node(mp, q); + } else { + mp->cur_exp.type = mp_dependent_type; + mp_encapsulate (mp, q); + } + } + break; + case mp_undefined_type: + mp_confusion(mp, "undefined copy"); + break; + default: + mp_confusion(mp, "copy"); + break; + } +} + +static mp_node mp_cur_tok (MP mp) +{ + mp_node p; + if (cur_sym == NULL && (cur_sym_mod == 0 || cur_sym_mod == mp_normal_operation)) { + if (cur_cmd == mp_capsule_command) { + mp_number save_exp_num; + mp_value save_exp = mp->cur_exp; + new_number(save_exp_num); + number_clone(save_exp_num, cur_exp_value_number); + mp_make_exp_copy(mp, cur_mod_node); + p = mp_stash_cur_exp(mp); + mp_link(p) = NULL; + mp->cur_exp = save_exp; + number_clone(mp->cur_exp.data.n, save_exp_num); + free_number(save_exp_num); + } else { + p = mp_new_token_node(mp); + mp_name_type(p) = mp_token_operation; + if (cur_cmd == mp_numeric_command) { + mp_set_value_number(p, cur_mod_number); + mp_type(p) = mp_known_type; + } else { + mp_set_value_str(p, cur_mod_str); + mp_type(p) = mp_string_type; + } + } + } else { + p = mp_new_symbolic_node(mp); + mp_set_sym_sym(p, cur_sym); + mp_name_type(p) = cur_sym_mod; + } + return p; +} + +void mp_back_input (MP mp) +{ + mp_node p = mp_cur_tok(mp); + while (token_state && (nloc == NULL)) { + mp_end_token_list(mp); + } + mp_begin_token_list(mp, p, mp_backed_up_text); +} + +static void mp_back_error (MP mp, const char *msg, const char *hlp) +{ + mp_back_input(mp); + mp_error(mp, msg, hlp); +} + +static void mp_ins_error (MP mp, const char *msg, const char *hlp) +{ + mp_back_input(mp); + token_type = mp_inserted_text; + mp_error(mp, msg, hlp); +} + +void mp_begin_file_reading (MP mp) +{ + if (mp->in_open == (mp->max_in_open-1)) { + mp_reallocate_input_stack (mp, (mp->max_in_open + mp->max_in_open / 4)); + } + if (mp->first == mp->buf_size) { + mp_reallocate_buffer(mp, (mp->buf_size + mp->buf_size / 4)); + } + mp->in_open++; + mp_push_input(mp); + iindex = (int) mp->in_open; + if (mp->in_open_max < mp->in_open) { + mp->in_open_max = mp->in_open; + } + start = (int) mp->first; + name = is_term; +} + +static void mp_end_file_reading (MP mp) +{ + if (mp->in_open > iindex) { + if ((name <= max_spec_src)) { + mp_confusion(mp, "endinput"); + } else { + (mp->close_file) (mp, mp->input_file[mp->in_open]); + --mp->in_open; + } + } + mp->first = (size_t) start; + if (iindex != mp->in_open) { + mp_confusion(mp, "endinput"); + } else { + if (name > max_spec_src) { + (mp->close_file) (mp, cur_file); + } + mp_pop_input(mp); + --mp->in_open; + } +} + +static int mp_check_outer_validity (MP mp) +{ + if (mp->scanner_status == mp_normal_state) { + return 1; + } else if (mp->scanner_status == mp_tex_flushing_state) { + if (cur_sym != NULL) { + return 1; + } else { + char msg[256]; + mp_snprintf(msg, 256, "TeX mode didn't end; all text was ignored after line %d", (int) mp->warning_line); + set_cur_sym(mp->frozen_etex); + mp_ins_error( + mp, + msg, + "The file ended while I was looking for the 'etex' to finish this TeX material.\n" + "I've inserted 'etex' now." + ); + return 0; + } + } else { + + if (mp->scanner_status > mp_skipping_state) { + { + char msg[256]; + const char *mst = NULL; + const char *hlp = + "I suspect you have forgotten an 'enddef', causing me to read past where you\n" + "wanted me to stop. I'll try to recover."; + mp_runaway(mp); + if (cur_sym == NULL) { + mst = "File ended while scanning"; + } else { + mst = "Forbidden token found while scanning"; + } + switch (mp->scanner_status) { + case mp_flushing_state: + { + mp_snprintf(msg, 256, "%s to the end of the statement", mst); + hlp = + "A previous error seems to have propagated, causing me to read past where\n" + "you wanted me to stop. I'll try to recover."; + set_cur_sym(mp->frozen_semicolon); + } + break; + case mp_absorbing_state: + { + mp_snprintf(msg, 256, "%s a text argument", mst); + hlp = + "It seems that a right delimiter was left out, causing me to read past where\n" + "you wanted me to stop. I'll try to recover."; + if (mp->warning_info == NULL) { + set_cur_sym(mp->frozen_end_group); + } else { + set_cur_sym(mp->frozen_right_delimiter); + set_equiv_sym(cur_sym, mp->warning_info); + } + } + break; + case mp_var_defining_state: + { + mp_string s; + int selector = mp->selector; + mp->selector = mp_new_string_selector; + mp_print_variable_name(mp, mp->warning_info_node); + s = mp_make_string(mp); + mp->selector = selector; + mp_snprintf(msg, 256, "%s the definition of %s", mst, s->str); + delete_str_ref(s); + set_cur_sym(mp->frozen_end_def); + } + break; + case mp_op_defining_state: + { + char *s = mp_str(mp, text(mp->warning_info)); + mp_snprintf(msg, 256, "%s the definition of %s", mst, s); + set_cur_sym(mp->frozen_end_def); + } + break; + case mp_loop_defining_state: + { + char *s = mp_str(mp, text(mp->warning_info)); + mp_snprintf(msg, 256, "%s the text of a %s loop", mst, s); + hlp = + "I suspect you have forgotten an 'endfor', causing me to read past where\n" + "you wanted me to stop. I'll try to recover."; + set_cur_sym(mp->frozen_end_for); + } + break; + } + mp_ins_error(mp, msg, hlp); + } + } else { + char msg[256]; + const char *hlp = NULL; + mp_snprintf(msg, 256, "Incomplete if; all text was ignored after line %d", (int) mp->warning_line); + if (cur_sym == NULL) { + hlp = + "The file ended while I was skipping conditional text. This kind of error happens\n" + "when you say 'if ...' and forget the matching 'fi'. I've inserted a 'fi'; this\n" + "might work."; + } else { + hlp = + "A forbidden 'outer' token occurred in skipped text. This kind of error happens\n" + "when you say 'if ...' and forget the matching 'fi'. I've inserted a 'fi'; this\n" + "might work."; + } + set_cur_sym(mp->frozen_fi); + mp_ins_error(mp, msg, hlp); + } + return 0; + } +} + +void mp_runaway (MP mp) +{ + if (mp->scanner_status > mp_flushing_state) { + mp_print_nl(mp, "Runaway "); + switch (mp->scanner_status) { + case mp_absorbing_state: + mp_print_str(mp, "text?"); + break; + case mp_var_defining_state: + case mp_op_defining_state: + mp_print_str(mp, "definition?"); + break; + case mp_loop_defining_state: + mp_print_str(mp, "loop?"); + break; + } + mp_print_ln(mp); + mp_show_token_list(mp, mp_link(mp->hold_head), NULL); + } +} + +void mp_get_next (MP mp) +{ + mp_sym cur_sym_; + RESTART: + set_cur_sym(NULL); + set_cur_sym_mod(0); + if (file_state) { + int k; + unsigned char c; + int cclass; + SWITCH: + c = mp->buffer[loc]; + ++loc; + cclass = mp->char_class[c]; + switch (cclass) { + case mp_digit_class: + scan_numeric_token((c - '0')); + return; + case mp_period_class: + cclass = mp->char_class[mp->buffer[loc]]; + if (cclass > mp_period_class) { + goto SWITCH; + } else if (cclass < mp_period_class) { + scan_fractional_token(0); + return; + } else { + break; + } + case mp_space_class: + goto SWITCH; + case mp_percent_class: + if (mp->scanner_status == mp_tex_flushing_state && loc < limit) { + goto SWITCH; + } + if (mp_move_to_next_line(mp)) { + goto RESTART; + } else { + goto SWITCH; + } + case mp_string_class: + if (mp->scanner_status == mp_tex_flushing_state) { + goto SWITCH; + } else { + unsigned char cend = c == '"' ? '"' : 3 ; + if (mp->buffer[loc] == cend) { + set_cur_mod_str(mp_rts(mp,"")); + } else { + k = loc; + mp->buffer[limit + 1] = cend; + do { + ++loc; + } while (mp->buffer[loc] != cend); + if (loc > limit) { + loc = limit; + mp_error( + mp, + "Incomplete string token has been flushed", + "Strings should finish on the same line as they began. I've deleted the partial\n" + "string." + ); + goto RESTART; + } + mp_str_room(mp, (size_t) (loc - k)); + do { + mp_append_char(mp, mp->buffer[k]); + ++k; + } while (k != loc); + set_cur_mod_str(mp_make_string(mp)); + } + ++loc; + set_cur_cmd(mp_string_command); + return; + } + case mp_comma_class: + case mp_semicolon_class: + case mp_left_parenthesis_class: + case mp_right_parenthesis_class: + k = loc - 1; + goto FOUND; + case mp_invalid_class: + if (mp->scanner_status == mp_tex_flushing_state) { + goto SWITCH; + } else { + mp_error( + mp, + "Text line contains an invalid character", + "A funny symbol that I can\'t read has just been input. Continue, and I'll forget\n" + "that it ever happened." + ); + goto RESTART; + } + default: + break; + } + k = loc - 1; + while (mp->char_class[mp->buffer[loc]] == cclass) { + ++loc; + } + FOUND: + set_cur_sym(mp_id_lookup(mp, (char *) (mp->buffer + k), (size_t) (loc - k), 1)); + } else { + if (nloc != NULL && mp_type(nloc) == mp_symbol_node_type) { + int cur_sym_mod_ = mp_name_type(nloc); + int cur_info = mp_get_sym_info(nloc); + set_cur_sym(mp_get_sym_sym(nloc)); + set_cur_sym_mod(cur_sym_mod_); + nloc = mp_link(nloc); + if (cur_sym_mod_ == mp_expr_operation) { + set_cur_cmd(mp_capsule_command); + set_cur_mod_node(mp->param_stack[param_start + cur_info]); + set_cur_sym_mod(0); + set_cur_sym(NULL); + return; + } else if (cur_sym_mod_ == mp_suffix_operation || cur_sym_mod_ == mp_text_operation) { + mp_begin_token_list(mp, mp->param_stack[param_start + cur_info], (int) mp_parameter_text); + goto RESTART; + } + } else if (nloc != NULL) { + if (mp_name_type(nloc) == mp_token_operation) { + if (mp_type(nloc) == mp_known_type) { + set_cur_mod_number(mp_get_value_number(nloc)); + set_cur_cmd(mp_numeric_command); + } else { + set_cur_mod_str(mp_get_value_str(nloc)); + set_cur_cmd(mp_string_command); + add_str_ref(cur_mod_str); + } + } else { + set_cur_mod_node(nloc); + set_cur_cmd(mp_capsule_command); + } + nloc = mp_link(nloc); + return; + } else { + mp_end_token_list(mp); + goto RESTART; + } + } + cur_sym_ = cur_sym; + set_cur_cmd(eq_type(cur_sym_)); + set_cur_mod(equiv(cur_sym_)); + set_cur_mod_node(equiv_node(cur_sym_)); + +} + +static int mp_move_to_next_line (MP mp) +{ + if (name > max_spec_src) { + ++line; + mp->first = (size_t) start; + if (! mp->force_eof) { + if (mp_input_ln(mp, cur_file)) { + mp_firm_up_the_line(mp); + } else { + mp->force_eof = 1; + } + }; + if (mp->force_eof) { + mp->force_eof = 0; + --loc; + if (mp->interaction < mp_silent_mode) { + mp_print_chr(mp, ')'); + --mp->open_parens; + update_terminal(); + } + mp_end_file_reading(mp); + mp_check_outer_validity(mp); + return 1; + } else { + mp->buffer[limit] = '%'; + mp->first = (size_t) (limit + 1); + loc = start; + } + } else if (mp->input_ptr > 0) { + mp_end_file_reading(mp); + return 1; + } else if (mp->interaction > mp_nonstop_mode) { + if (limit == start && mp->interaction < mp_silent_mode) { + mp_print_nl(mp, "(Please type a command or say `end')"); + } + mp_print_ln(mp); + mp->first = (size_t) start; + if (! mp_input_ln(mp, mp->term_in)) { + longjmp(*(mp->jump_buf), 1); + } + mp->buffer[mp->last] = '%'; + limit = (int) mp->last; + mp->buffer[limit] = '%'; + mp->first = (size_t) (limit + 1); + loc = start; + } else { + mp_fatal_error(mp, "job aborted, no legal end found"); + } + return 0; +} + +void mp_firm_up_the_line (MP mp) +{ + limit = (int) mp->last; +} + +static void mp_t_next (MP mp) +{ + if ((mp->extensions == 1) && (cur_cmd == mp_btex_command)) { + char *txt = NULL; + char *ptr = NULL; + int slin = line; + int size = 0; + int done = 0; + int mode = round_unscaled(internal_value(mp_texscriptmode_internal)) ; + int verb = cur_mod == mp_verbatim_code; + int first; + if (loc <= limit && mp->char_class[mp->buffer[loc]] == mp_space_class) { + ++loc; + } else { + } + first = loc; + while (1) { + if (loc < limit - 4) { + if (mp->buffer[loc] == 'e') { + ++loc; + if (mp->buffer[loc] == 't') { + ++loc; + if (mp->buffer[loc] == 'e') { + ++loc; + if (mp->buffer[loc] == 'x') { + if (first == (loc - 3)) { + done = 1; + } else if (mp->char_class[mp->buffer[loc - 4]] == mp_space_class) { + done = 2; + } + if (done) { + if ((loc + 1) <= limit) { + int c = mp->char_class[mp->buffer[loc + 1]] ; + if (c != mp_letter_class) { + ++loc; + break; + } else { + done = 0; + } + } else { + ++loc; + break; + } + } + } + } + } + } + } + if (loc >= limit) { + if (size) { + txt = mp_memory_reallocate(txt, (size_t) (size + limit - first + 1)); + } else { + txt = mp_memory_allocate((size_t) (limit - first + 1)); + } + memcpy(txt + size, mp->buffer + first, limit - first); + size += limit - first + 1; + if (mode <= 0) { + txt[size - 1] = ' '; + } else if (verb) { + txt[size - 1] = '\n'; + } else if (mode >= 2) { + txt[size - 1] = '\n'; + } else { + txt[size - 1] = ' '; + } + if (mp_move_to_next_line(mp)) { + goto FATAL_ERROR; + } + first = loc; + } else { + ++loc; + } + } + if (done) { + int l = loc - 5 ; + int n = l - first + 1 ; + if (done == 2) { + l -= 1; + n -= 1; + } + if (size) { + txt = mp_memory_reallocate(txt, (size_t) (size + n + 1)); + } else { + txt = mp_memory_allocate((size_t) (n + 1)); + } + memcpy(txt + size, mp->buffer + first, n); + size += n; + if (verb && mode >= 3) { + txt[size] = '\0'; + ptr = txt; + } else if (mode >= 4) { + txt[size] = '\0'; + ptr = txt; + } else { + while ((size > 1) && (mp->char_class[(unsigned char) txt[size-1]] == mp_space_class || txt[size-1] == '\n')) { + --size; + } + txt[size] = '\0'; + ptr = txt; + while ((size > 1) && (mp->char_class[(unsigned char) ptr[0]] == mp_space_class || ptr[0] == '\n')) { + ++ptr; + --size; + } + } + check_script_result(mp, mp->make_text(mp, ptr, size, verb)); + mp_memory_free(txt); + mp_get_next(mp); + return; + } + FATAL_ERROR: + { + char msg[256]; + if (slin > 0) { + mp_snprintf(msg, 256, "No matching 'etex' for '%stex'.", verb ? "verbatim" : "b"); + } else { + mp_snprintf(msg, 256, "No matching 'etex' for '%stex' in line %d.", verb ? "verbatim" : "b",slin); + } + mp_error(mp, msg, "An 'etex' is missing at this input level, nothing gets done."); + mp_memory_free(txt); + } + } else { + { + mp_error( + mp, + "A 'btex/verbatimtex ... etex' definition needs an extension", + "This file contains picture expressions for 'btex ... etex' blocks. Such files\n" + "need an extension (plugin) that seems to be absent." + ); + } + } +} + +static mp_node mp_scan_toks (MP mp, mp_command_code terminator, mp_subst_list_item * subst_list, mp_node tail_end, int suffix_count) +{ + int cur_data; + int cur_data_mod = 0; + mp_node p = mp->hold_head; + int balance = 1; + mp_link(mp->hold_head) = NULL; + while (1) { + get_t_next(mp); + cur_data = -1; + if (cur_sym != NULL) { + { + mp_subst_list_item *q = subst_list; + while (q != NULL) { + if (q->info == cur_sym && q->info_mod == cur_sym_mod) { + cur_data = q->value_data; + cur_data_mod = q->value_mod; + set_cur_cmd(mp_relax_command); + break; + } + q = q->link; + } + } + if (cur_cmd == terminator) { + if (cur_mod > 0) { + ++balance; + } else { + --balance; + if (balance == 0) + break; + } + } else if (cur_cmd == mp_macro_special_command) { + if (cur_mod == mp_macro_quote_code) { + get_t_next(mp); + } else if (cur_mod <= suffix_count) { + cur_data = cur_mod - 1; + cur_data_mod = mp_suffix_operation; + } + } + } + if (cur_data != -1) { + mp_node pp = mp_new_symbolic_node(mp); + mp_set_sym_info(pp, cur_data); + mp_name_type(pp) = cur_data_mod; + mp_link(p) = pp; + } else { + mp_link(p) = mp_cur_tok(mp); + } + p = mp_link(p); + } + mp_link(p) = tail_end; + while (subst_list) { + mp_subst_list_item *q = subst_list->link; + mp_memory_free(subst_list); + subst_list = q; + } + return mp_link(mp->hold_head); +} + +static void mp_get_symbol (MP mp) +{ + RESTART: + get_t_next(mp); + if ((cur_sym == NULL) || mp_is_frozen(mp, cur_sym)) { + const char *hlp = NULL; + if (cur_sym != NULL) { + hlp = + "Sorry: You can't redefine my error-recovery tokens. I've inserted an\n" + "inaccessible symbol so that your definition will be completed without\n" + "mixing me up too badly."; + } else { + hlp = + "Sorry: You can't redefine a number, string, or expr. I've inserted an\n" + "inaccessible symbol so that your definition will be completed without\n" + "mixing me up too badly."; + if (cur_cmd == mp_string_command) { + delete_str_ref(cur_mod_str); + } + } + set_cur_sym(mp->frozen_inaccessible); + mp_ins_error(mp, "Missing symbolic token inserted", hlp); + goto RESTART; + } +} + +static void mp_get_clear_symbol (MP mp) +{ + mp_get_symbol(mp); + mp_clear_symbol(mp, cur_sym, 0); +} + +static void mp_check_equals (MP mp) +{ + if (cur_cmd != mp_equals_command && cur_cmd != mp_assignment_command) { + mp_back_error( + mp, + "Missing '=' has been inserted", + "The next thing in this 'def' should have been '=', because I've already looked at\n" + "the definition heading. But don't worry; I'll pretend that an equals sign was\n" + "present. Everything from here to 'enddef' will be the replacement text of this\n" + "macro." + ); + } +} + +static void mp_make_op_def (MP mp, int code) +{ + mp_node q, r; + mp_command_code m = (code == mp_primary_def_code) ? mp_primary_def_command : (code == mp_secondary_def_code ? mp_secondary_def_command : mp_tertiary_def_command); + mp_subst_list_item *qm = NULL; + mp_subst_list_item *qn = NULL; + mp_get_symbol(mp); + qm = mp_memory_allocate(sizeof(mp_subst_list_item)); + qm->link = NULL; + qm->info = cur_sym; + qm->info_mod = cur_sym_mod; + qm->value_data = 0; + qm->value_mod = mp_expr_operation; + mp_get_clear_symbol(mp); + mp->warning_info = cur_sym; + mp_get_symbol(mp); + qn = mp_memory_allocate(sizeof(mp_subst_list_item)); + qn->link = qm; + qn->info = cur_sym; + qn->info_mod = cur_sym_mod; + qn->value_data = 1; + qn->value_mod = mp_expr_operation; + get_t_next(mp); + mp_check_equals(mp); + mp->scanner_status = mp_op_defining_state; + q = mp_new_symbolic_node(mp); + mp_set_ref_count(q, 0); + r = mp_new_symbolic_node(mp); + mp_link(q) = r; + mp_set_sym_info(r, mp_general_macro); + mp_name_type(r) = mp_macro_operation; + mp_link(r) = mp_scan_toks(mp, mp_macro_def_command, qn, NULL, 0); + mp->scanner_status = mp_normal_state; + set_eq_type(mp->warning_info, m); + set_equiv_node(mp->warning_info, q); + mp_get_x_next(mp); +} + +static void mp_scan_def (MP mp, int code) +{ + int n; + int k; + mp_subst_list_item *r = NULL; + mp_subst_list_item *rp = NULL; + mp_node q; + mp_node p; + int sym_type; + mp_sym l_delim, r_delim; + int c = mp_general_macro; + mp_link(mp->hold_head) = NULL; + q = mp_new_symbolic_node(mp); + mp_set_ref_count(q, 0); + r = NULL; + if (code == mp_def_code) { + mp_get_clear_symbol(mp); + mp->warning_info = cur_sym; + get_t_next(mp); + mp->scanner_status = mp_op_defining_state; + n = 0; + set_eq_type(mp->warning_info, mp_defined_macro_command); + set_equiv_node(mp->warning_info, q); + } else { + p = mp_scan_declared_variable(mp); + mp_flush_variable(mp, equiv_node(mp_get_sym_sym(p)), mp_link(p), 1); + mp->warning_info_node = mp_find_variable(mp, p); + mp_flush_node_list(mp, p); + if (mp->warning_info_node == NULL) { + mp_error( + mp, + "This variable already starts with a macro", + "After 'vardef a' you can't say 'vardef a.b'. So I'll have to discard this\n" + "definition." + ); + mp->warning_info_node = mp->bad_vardef; + } + mp->scanner_status = mp_var_defining_state; + n = 2; + if (cur_cmd == mp_macro_special_command && cur_mod == mp_macro_suffix_code) { + n = 3; + get_t_next(mp); + } + mp_type(mp->warning_info_node) = mp_unsuffixed_macro_type - 2 + n; + mp_set_value_node(mp->warning_info_node, q); + } + k = n; + if (cur_cmd == mp_left_delimiter_command) { + do { + l_delim = cur_sym; + r_delim = equiv_sym(cur_sym); + get_t_next(mp); + if (cur_cmd == mp_parameter_commmand) { + switch (cur_mod) { + case mp_expr_parameter: + sym_type = mp_expr_operation; + goto OKAY; + break; + case mp_suffix_parameter: + sym_type = mp_suffix_operation; + goto OKAY; + break; + case mp_text_parameter: + sym_type = mp_text_operation; + goto OKAY; + break; + default: + break; + } + } + mp_back_error( + mp, + "Missing parameter type; 'expr' will be assumed", + "You should've had 'expr' or 'suffix' or 'text' here." + ); + sym_type = mp_expr_operation; + OKAY: + do { + mp_link(q) = mp_new_symbolic_node(mp); + q = mp_link(q); + mp_name_type(q) = sym_type; + mp_set_sym_info(q, k); + mp_get_symbol(mp); + rp = mp_memory_allocate(sizeof(mp_subst_list_item)); + rp->link = NULL; + rp->value_data = k; + rp->value_mod = sym_type; + rp->info = cur_sym; + rp->info_mod = cur_sym_mod; + mp_check_param_size(mp, k); + ++k; + rp->link = r; + r = rp; + get_t_next(mp); + } while (cur_cmd == mp_comma_command); + + mp_check_delimiter(mp, l_delim, r_delim); + get_t_next(mp); + } while (cur_cmd == mp_left_delimiter_command); + } + if (cur_cmd == mp_parameter_commmand) { + rp = mp_memory_allocate(sizeof(mp_subst_list_item)); + rp->link = NULL; + rp->value_data = k; + switch (cur_mod) { + case mp_expr_parameter: + rp->value_mod = mp_expr_operation; + c = mp_expr_macro; + break; + case mp_suffix_parameter: + rp->value_mod = mp_suffix_operation; + c = mp_suffix_macro; + break; + case mp_text_parameter: + rp->value_mod = mp_text_operation; + c = mp_text_macro; + break; + default: + c = cur_mod; + rp->value_mod = mp_expr_operation; + break; + } + mp_check_param_size(mp, k); + ++k; + mp_get_symbol(mp); + rp->info = cur_sym; + rp->info_mod = cur_sym_mod; + rp->link = r; + r = rp; + get_t_next(mp); + if (c == mp_expr_macro && cur_cmd == mp_of_command) { + c = mp_of_macro; + rp = mp_memory_allocate(sizeof(mp_subst_list_item)); + rp->link = NULL; + mp_check_param_size(mp, k); + rp->value_data = k; + rp->value_mod = mp_expr_operation; + mp_get_symbol(mp); + rp->info = cur_sym; + rp->info_mod = cur_sym_mod; + rp->link = r; + r = rp; + get_t_next(mp); + } + } + mp_check_equals(mp); + p = mp_new_symbolic_node(mp); + mp_set_sym_info(p, c); + mp_name_type(p) = mp_macro_operation; + mp_link(q) = p; + if (code == mp_def_code) { + mp_link(p) = mp_scan_toks(mp, mp_macro_def_command, r, NULL, (int) n); + } else { + mp_node qq = mp_new_symbolic_node(mp); + mp_set_sym_sym(qq, mp->bg_loc); + mp_link(p) = qq; + p = mp_new_symbolic_node(mp); + mp_set_sym_sym(p, mp->eg_loc); + mp_link(qq) = mp_scan_toks(mp, mp_macro_def_command, r, p, (int) n); + } + if (mp->warning_info_node == mp->bad_vardef) { + mp_flush_token_list(mp, mp_get_value_node(mp->bad_vardef)); + } + mp->scanner_status = mp_normal_state; + mp_get_x_next(mp); +} + +static void mp_check_expansion_depth (MP mp) +{ + if (++mp->expand_depth_count >= mp->expand_depth) { + if (mp->interaction >= mp_error_stop_mode) { + mp->interaction=mp_scroll_mode; + } + mp_error( + mp, + "Maximum expansion depth reached", + "Recursive macro expansion cannot be unlimited because of runtime stack\n" + "constraints. The limit is 10000 recursion levels in total." + ); + mp->history=mp_fatal_error_stop; + mp_jump_out(mp); + } +} + +static void mp_expand (MP mp) +{ + mp_check_expansion_depth(mp); + if (number_greater(internal_value(mp_tracing_commands_internal), unity_t) && cur_cmd != mp_defined_macro_command) { + mp_show_cmd_mod(mp, cur_cmd, cur_mod); + } + switch (cur_cmd) { + case mp_if_test_command: + mp_conditional(mp); + break; + case mp_fi_or_else_command: + if (cur_mod > mp->if_limit) { + if (mp->if_limit == mp_if_code) { + mp_back_input(mp); + set_cur_sym(mp->frozen_colon); + mp_ins_error(mp, "Missing ':' has been inserted", "Something was missing here"); + } else { + const char *hlp = "I'm ignoring this; it doesn't match any if."; + switch (cur_mod) { + case mp_fi_code: + mp_error(mp, "Extra 'fi'", hlp); + break; + case mp_else_code: + mp_error(mp, "Extra 'else'", hlp); + break; + default: + mp_error(mp, "Extra 'elseif'", hlp); + break; + } + } + } else { + while (cur_mod != mp_fi_code) { + mp_pass_text(mp); + } + mp_pop_condition_stack(mp); + } + break; + case mp_input_command: + if (cur_mod > 0) { + mp->force_eof = 1; + } else { + mp_start_input(mp); + } + break; + case mp_iteration_command: + if (cur_mod == mp_end_for_code) { + { + mp_error( + mp, + "Extra 'endfor'", + "I'm not currently working on a for loop, so I had better not try to end anything." + ); + } + } else { + mp_begin_iteration(mp); + } + break; + case mp_repeat_loop_command: + { + while (token_state && (nloc == NULL)) { + mp_end_token_list(mp); + } + if (mp->loop_ptr == NULL) { + mp_error( + mp, + "Lost loop", + "I'm confused; after exiting from a loop, I still seem to want to repeat it. I'll\n" + "try to forget the problem." + ); + } else { + mp_resume_iteration(mp); + } + } + break; + case mp_exit_test_command: + { + mp_get_x_next(mp); + mp_scan_expression(mp); + if (mp->cur_exp.type != mp_boolean_type) { + do_boolean_error(mp); + } + if (number_greater(internal_value(mp_tracing_commands_internal), unity_t)) { + mp_show_cmd_mod(mp, mp_nullary_command, cur_exp_value_boolean); + } + if (cur_exp_value_boolean == mp_true_operation) { + if (mp->loop_ptr != NULL) { + mp_node p = NULL; + do { + if (file_state) { + mp_end_file_reading(mp); + } else { + if (token_type <= mp_loop_text) { + p = nstart; + } + mp_end_token_list(mp); + } + } while (p == NULL); + if (p != mp->loop_ptr->info) { + mp_fatal_error(mp, "*** (loop confusion)"); + } + mp_stop_iteration(mp); + } else if (cur_cmd == mp_semicolon_command) { + mp_error( + mp, + "No loop is in progress", + "Why say 'exitif' when there's nothing to exit from?" + ); + } else { + mp_back_error( + mp, + "No loop is in progress", + "Why say 'exitif' when there's nothing to exit from?" + ); + } + } else if (cur_cmd != mp_semicolon_command) { + mp_back_error( + mp, + "Missing ';' has been inserted", + "After 'exitif <boolean exp>' I expect to see a semicolon. I shall pretend that\n" + "one was there." + ); + } + } + break; + case mp_relax_command: + break; + case mp_expand_after_command: + { + mp_node p; + get_t_next(mp); + p = mp_cur_tok(mp); + get_t_next(mp); + if (cur_cmd < mp_min_command) { + mp_expand(mp); + } else { + mp_back_input(mp); + } + mp_begin_token_list(mp, p, mp_backed_up_text); + } + break; + case mp_scan_tokens_command: + { + mp_get_x_next(mp); + mp_scan_primary(mp); + if (mp->cur_exp.type != mp_string_type) { + mp_value new_expr; + memset(&new_expr, 0, sizeof(mp_value)); + new_number(new_expr.data.n); + mp_disp_err(mp, NULL); + mp_back_error( + mp, + "Not a string", + "I'm going to flush this expression, since scantokens should be followed by a\n" + "known string." + ); + mp_get_x_next(mp); + mp_flush_cur_exp(mp, new_expr); + } else { + mp_back_input(mp); + if (cur_exp_str->len > 0) { + size_t k; + size_t j; + mp_value new_expr; + memset(&new_expr, 0, sizeof(mp_value)); + new_number(new_expr.data.n); + mp_begin_file_reading(mp); + name = is_scantok; + k = mp->first + (size_t) cur_exp_str->len; + if (k >= mp->max_buf_stack) { + while (k >= mp->buf_size) { + mp_reallocate_buffer(mp, (mp->buf_size + (mp->buf_size / 4))); + } + mp->max_buf_stack = k + 1; + } + j = 0; + limit = (int) k; + while (mp->first < (size_t) limit) { + mp->buffer[mp->first] = *(cur_exp_str->str + j); + j++; + ++mp->first; + } + mp->buffer[limit] = '%'; + mp->first = (size_t) (limit + 1); + loc = start; + mp_flush_cur_exp(mp, new_expr); + } + } + } + break; + case mp_runscript_command: + { + if (mp->extensions) { + mp_get_x_next(mp); + mp_scan_primary(mp); + switch (mp->cur_exp.type) { + case mp_string_type: + { + mp_back_input(mp); + if (cur_exp_str->len > 0) { + check_script_result(mp, mp->run_script(mp, (const char*) cur_exp_str->str, cur_exp_str->len, 0)); + } + } + break; + case mp_numeric_type: + case mp_known_type: + { + int n = 0 ; + mp_back_input(mp); + n = (int) number_to_scaled (cur_exp_value_number) / 65536; + if (n > 0) { + check_script_result(mp, mp->run_script(mp, NULL, 0, n)); + } + } + break; + default: + { + mp_value new_expr; + memset(&new_expr, 0, sizeof(mp_value)); + new_number(new_expr.data.n); + mp_disp_err(mp, NULL); + mp_back_error( + mp, + "Not a string", + "I'm going to flush this expression, since runscript should be followed by a known\n" + "string or number." + ); + mp_get_x_next(mp); + mp_flush_cur_exp(mp, new_expr); + } + break; + } + } + } + break; + case mp_maketext_command: + { + if (mp->extensions) { + mp_get_x_next(mp); + mp_scan_primary(mp); + if (mp->cur_exp.type == mp_string_type) { + mp_back_input(mp); + if (cur_exp_str->len > 0) { + check_script_result(mp, mp->make_text(mp, (const char*) cur_exp_str->str, cur_exp_str->len, 0)); + } + } else { + mp_value new_expr; + memset(&new_expr, 0, sizeof(mp_value)); + new_number(new_expr.data.n); + mp_disp_err(mp, NULL); + mp_back_error( + mp, + "Not a string", + "I'm going to flush this expression, since 'maketext' should be followed by a\n" + "known string." + ); + mp_get_x_next(mp); + mp_flush_cur_exp(mp, new_expr); + } + } + } + break; + case mp_defined_macro_command: + mp_macro_call(mp, cur_mod_node, NULL, cur_sym); + break; + default: + break; + }; + mp->expand_depth_count--; +} + +void check_script_result (MP mp, char *s) +{ + if (s) { + size_t size = strlen(s); + if (size > 0) { + size_t k ; + mp_value new_expr; + memset(&new_expr, 0, sizeof(mp_value)); + new_number(new_expr.data.n); + mp_begin_file_reading(mp); + name = is_scantok; + mp->last = mp->first; + k = mp->first + size; + if (k >= mp->max_buf_stack) { + while (k >= mp->buf_size) { + mp_reallocate_buffer(mp, (mp->buf_size + (mp->buf_size / 4))); + } + mp->max_buf_stack = k + 1; + } + limit = (int) k; + memcpy((mp->buffer + mp->first), s, size); + mp->buffer[limit] = '%'; + mp->first = (size_t) (limit + 1); + loc = start; + mp_flush_cur_exp(mp, new_expr); + } + lmt_memory_free(s); + } +} + +static void mp_get_x_next (MP mp) +{ + get_t_next(mp); + if (cur_cmd < mp_min_command) { + mp_node save_exp = mp_stash_cur_exp(mp); + do { + if (cur_cmd == mp_defined_macro_command) { + mp_macro_call(mp, cur_mod_node, NULL, cur_sym); + } else { + mp_expand(mp); + } + get_t_next(mp); + } while (cur_cmd < mp_min_command); + mp_unstash_cur_exp(mp, save_exp); + } +} + +static void mp_macro_call (MP mp, mp_node def_ref, mp_node arg_list, mp_sym macro_name) +{ + int n; + mp_node tail = 0; + mp_sym l_delim = NULL; + mp_sym r_delim = NULL; + mp_node r = mp_link(def_ref); + mp_add_mac_ref(def_ref); + if (arg_list == NULL) { + n = 0; + } else { + n = 1; + tail = arg_list; + while (mp_link(tail) != NULL) { + ++n; + tail = mp_link(tail); + } + } + if (number_positive(internal_value(mp_tracing_macros_internal))) { + mp_begin_diagnostic(mp); + mp_print_ln(mp); + mp_print_macro_name(mp, arg_list, macro_name); + if (n == 3) { + mp_print_str(mp, "@#"); + } + mp_show_macro (mp, def_ref, NULL); + if (arg_list != NULL) { + mp_node p = arg_list; + n = 0; + do { + mp_node q = (mp_node) mp_get_sym_sym(p); + mp_print_arg(mp, q, n, 0, 0); + ++n; + p = mp_link(p); + } while (p != NULL); + } + mp_end_diagnostic(mp, 0); + } + set_cur_cmd(mp_comma_command + 1); + while (mp_name_type(r) == mp_expr_operation || mp_name_type(r) == mp_suffix_operation || mp_name_type(r) == mp_text_operation) { + if (cur_cmd != mp_comma_command) { + mp_get_x_next(mp); + if (cur_cmd != mp_left_delimiter_command) { + char msg[256]; + mp_string sname; + int selector = mp->selector; + mp->selector = mp_new_string_selector; + mp_print_macro_name(mp, arg_list, macro_name); + sname = mp_make_string(mp); + mp->selector = selector; + mp_snprintf(msg, 256, "Missing argument to %s", mp_str(mp, sname)); + delete_str_ref(sname); + if (mp_name_type(r) == mp_suffix_operation || mp_name_type(r) == mp_text_operation) { + mp_set_cur_exp_value_number(mp, &zero_t); + mp->cur_exp.type = mp_token_list_type; + } else { + mp_set_cur_exp_value_number(mp, &zero_t); + mp->cur_exp.type = mp_known_type; + } + mp_back_error( + mp, + msg, + "That macro has more parameters than you thought. I'll continue by pretending that\n" + "each missing argument is either zero or null." + ); + set_cur_cmd(mp_right_delimiter_command); + goto FOUND; + } + l_delim = cur_sym; + r_delim = equiv_sym(cur_sym); + } + if (mp_name_type(r) == mp_text_operation) { + mp_scan_text_arg(mp, l_delim, r_delim); + } else { + mp_get_x_next(mp); + if (mp_name_type(r) == mp_suffix_operation) { + mp_scan_suffix(mp); + } else { + mp_scan_expression(mp); + } + } + if ((cur_cmd != mp_comma_command) && ((cur_cmd != mp_right_delimiter_command) || (equiv_sym(cur_sym) != l_delim))) { + switch (mp_name_type(mp_link(r))) { + case mp_expr_operation: + case mp_suffix_operation: + case mp_text_operation: + { + mp_back_error( + mp, + "Missing ',' has been inserted", + "I've finished reading a macro argument and am about to read another; the\n" + "arguments weren't delimited correctly." + ); + set_cur_cmd(mp_comma_command); + } + break; + default: + { + char msg[256]; + mp_snprintf(msg, 256, "Missing '%s' has been inserted", mp_str(mp, text(r_delim))); + mp_back_error(mp, msg, "I've gotten to the end of the macro parameter list."); + } + break; + } + } + FOUND: + { + mp_node p = mp_new_symbolic_node(mp); + if (mp->cur_exp.type == mp_token_list_type) { + mp_set_sym_sym(p, mp->cur_exp.data.node); + } else { + mp_set_sym_sym(p, mp_stash_cur_exp(mp)); + } + if (number_positive(internal_value(mp_tracing_macros_internal))) { + mp_begin_diagnostic(mp); + mp_print_arg(mp, (mp_node) mp_get_sym_sym(p), n, mp_get_sym_info(r), mp_name_type(r)); + mp_end_diagnostic(mp, 0); + } + if (arg_list == NULL) { + arg_list = p; + } else { + mp_link(tail) = p; + } + tail = p; + ++n; + } + + r = mp_link(r); + } + if (cur_cmd == mp_comma_command) { + char msg[256]; + mp_string rname; + int selector = mp->selector; + mp->selector = mp_new_string_selector; + mp_print_macro_name(mp, arg_list, macro_name); + rname = mp_make_string(mp); + mp->selector = selector; + mp_snprintf(msg, 256, "Too many arguments to %s; Missing '%s' has been inserted", + mp_str(mp, rname), mp_str(mp, text(r_delim))); + delete_str_ref(rname); + + mp_error( + mp, + msg, + "I'm going to assume that the comma I just read was a right delimiter, and then:\n" + "I'll begin expanding the macro." + ); + } + if (mp_get_sym_info(r) != mp_general_macro) { + if (mp_get_sym_info(r) < mp_text_macro) { + mp_get_x_next(mp); + if (mp_get_sym_info(r) != mp_suffix_macro) { + if ((cur_cmd == mp_equals_command) || (cur_cmd == mp_assignment_command)) { + mp_get_x_next(mp); + } + } + } + switch (mp_get_sym_info(r)) { + case mp_primary_macro: + mp_scan_primary(mp); + break; + case mp_secondary_macro: + mp_scan_secondary(mp); + break; + case mp_tertiary_macro: + mp_scan_tertiary(mp); + break; + case mp_expr_macro: + mp_scan_expression(mp); + break; + case mp_of_macro: + { + mp_node p; + mp_scan_expression(mp); + p = mp_new_symbolic_node(mp); + mp_set_sym_sym(p, mp_stash_cur_exp(mp)); + if (number_positive(internal_value(mp_tracing_macros_internal))) { + mp_begin_diagnostic(mp); + mp_print_arg(mp, (mp_node) mp_get_sym_sym(p), n, 0, 0); + mp_end_diagnostic(mp, 0); + } + if (arg_list == NULL) { + arg_list = p; + } else { + mp_link(tail) = p; + } + tail = p; + ++n; + if (cur_cmd != mp_of_command) { + char msg[256]; + mp_string sname; + int selector = mp->selector; + mp->selector = mp_new_string_selector; + mp_print_macro_name(mp, arg_list, macro_name); + sname = mp_make_string(mp); + mp->selector = selector; + mp_snprintf(msg, 256, "Missing 'of' has been inserted for %s", mp_str(mp, sname)); + delete_str_ref(sname); + mp_back_error(mp, msg, "I've got the first argument; will look now for the other."); + } + mp_get_x_next(mp); + mp_scan_primary(mp); + } + break; + case mp_suffix_macro: + { + if (cur_cmd != mp_left_delimiter_command) { + l_delim = NULL; + } else { + l_delim = cur_sym; + r_delim = equiv_sym(cur_sym); + mp_get_x_next(mp); + } + mp_scan_suffix(mp); + if (l_delim != NULL) { + if ((cur_cmd != mp_right_delimiter_command) || (equiv_sym(cur_sym) != l_delim)) { + char msg[256]; + mp_snprintf(msg, 256, "Missing '%s' has been inserted", mp_str(mp, text(r_delim))); + mp_back_error(mp, msg, "I've gotten to the end of the macro parameter list."); + } + mp_get_x_next(mp); + } + } + break; + case mp_text_macro: + mp_scan_text_arg(mp, NULL, NULL); + break; + } + mp_back_input(mp); + { + mp_node p = mp_new_symbolic_node(mp); + if (mp->cur_exp.type == mp_token_list_type) { + mp_set_sym_sym(p, mp->cur_exp.data.node); + } else { + mp_set_sym_sym(p, mp_stash_cur_exp(mp)); + } + if (number_positive(internal_value(mp_tracing_macros_internal))) { + mp_begin_diagnostic(mp); + mp_print_arg(mp, (mp_node) mp_get_sym_sym(p), n, mp_get_sym_info(r), mp_name_type(r)); + mp_end_diagnostic(mp, 0); + } + if (arg_list == NULL) { + arg_list = p; + } else { + mp_link(tail) = p; + } + tail = p; + ++n; + } + + } + r = mp_link(r); + + while (token_state && (nloc == NULL)) { + mp_end_token_list(mp); + } + if (mp->param_ptr + n > mp->max_param_stack) { + mp->max_param_stack = mp->param_ptr + n; + mp_check_param_size(mp, mp->max_param_stack); + } + mp_begin_token_list(mp, def_ref, mp_macro_text); + name = macro_name ? text(macro_name) : NULL; + nloc = r; + if (n > 0) { + mp_node p = arg_list; + do { + mp->param_stack[mp->param_ptr] = (mp_node) mp_get_sym_sym(p); + ++mp->param_ptr; + p = mp_link(p); + } while (p != NULL); + mp_flush_node_list(mp, arg_list); + } +} + +static void mp_print_macro_name (MP mp, mp_node a, mp_sym n) +{ + if (n) { + mp_print_mp_str(mp,text(n)); + } else { + mp_node p = (mp_node) mp_get_sym_sym(a); + if (p) { + mp_node q = p; + while (mp_link(q) != NULL) { + q = mp_link(q); + } + mp_link(q) = (mp_node) mp_get_sym_sym(mp_link(a)); + mp_show_token_list(mp, p, NULL); + mp_link(q) = NULL; + } else { + mp_print_mp_str(mp,text(mp_get_sym_sym((mp_node) mp_get_sym_sym(mp_link(a))))); + } + } +} + +static void mp_print_arg (MP mp, mp_node q, int n, int b, int bb) +{ + if (q && mp_link(q) == MP_VOID) { + mp_print_nl(mp, "(EXPR"); + } else if ((bb < mp_text_operation) && (b != mp_text_macro)) { + mp_print_nl(mp, "(SUFFIX"); + } else { + mp_print_nl(mp, "(TEXT"); + } + mp_print_int(mp, n); + mp_print_str(mp, ")<-"); + if (q && mp_link(q) == MP_VOID) { + mp_print_exp(mp, q, 1); + } else { + mp_show_token_list(mp, q, NULL); + } +} + +void mp_scan_text_arg (MP mp, mp_sym l_delim, mp_sym r_delim) +{ + int balance = 1; + mp->warning_info = l_delim; + mp->scanner_status = mp_absorbing_state; + mp_node p = mp->hold_head; + mp_link(mp->hold_head) = NULL; + while (1) { + get_t_next(mp); + if (l_delim == NULL) { + if (mp_end_of_statement) { + if (balance == 1) { + break; + } else if (cur_cmd == mp_end_group_command) { + --balance; + } + } else if (cur_cmd == mp_begin_group_command) { + ++balance; + } + } else { + if (cur_cmd == mp_right_delimiter_command) { + if (equiv_sym(cur_sym) == l_delim) { + --balance; + if (balance == 0) { + break; + } + } + } else if (cur_cmd == mp_left_delimiter_command) { + if (equiv_sym(cur_sym) == r_delim) { + ++balance; + } + } + } + mp_link(p) = mp_cur_tok(mp); + p = mp_link(p); + } + mp_set_cur_exp_node(mp, mp_link(mp->hold_head)); + mp->cur_exp.type = mp_token_list_type; + mp->scanner_status = mp_normal_state; +} + +static void mp_stack_argument (MP mp, mp_node p) +{ + if (mp->param_ptr == mp->max_param_stack) { + ++mp->max_param_stack; + mp_check_param_size(mp, mp->max_param_stack); + } + mp->param_stack[mp->param_ptr] = p; + ++mp->param_ptr; +} + +static mp_node mp_get_if_node (MP mp) { + mp_if_node p = (mp_if_node) mp_allocate_node(mp, sizeof(mp_if_node_data)); + mp_type(p) = mp_if_node_type; + return (mp_node) p; +} + +void mp_pass_text (MP mp) +{ + int level = 0; + mp->scanner_status = mp_skipping_state; + mp->warning_line = mp_true_line(mp); + while (1) { + get_t_next(mp); + if (cur_cmd <= mp_fi_or_else_command) { + if (cur_cmd < mp_fi_or_else_command) { + ++level; + } else if (level == 0) { + break; + } else if (cur_mod == mp_fi_code) { + --level; + } + } else { + if (cur_cmd == mp_string_command) { + delete_str_ref(cur_mod_str); + } + } + } + mp->scanner_status = mp_normal_state; +} + +static void mp_push_condition_stack (MP mp) +{ + mp_node p = mp_get_if_node(mp); + mp_link(p) = mp->cond_ptr; + mp_type(p) = (int) mp->if_limit; + mp_name_type(p) = mp->cur_if; + mp_if_line_field(p) = mp->if_line; + mp->cond_ptr = p; + mp->if_limit = mp_if_code; + mp->if_line = mp_true_line(mp); + mp->cur_if = mp_if_code; +} + +static void mp_pop_condition_stack (MP mp) +{ + mp_node p = mp->cond_ptr; + mp->if_line = mp_if_line_field(p); + mp->cur_if = mp_name_type(p); + mp->if_limit = mp_type(p); + mp->cond_ptr = mp_link(p); + mp_free_node(mp, p, sizeof(mp_if_node_data)); +} + +static void mp_change_if_limit (MP mp, int l, mp_node p) +{ + if (p == mp->cond_ptr) { + mp->if_limit = l; + } else { + mp_node q = mp->cond_ptr; + while (1) { + if (q == NULL) { + mp_confusion(mp, "if"); + return; + } else if (mp_link(q) == p) { + mp_type(q) = l; + return; + } else { + q = mp_link(q); + } + } + } +} + +static void mp_check_colon (MP mp) +{ + if (cur_cmd != mp_colon_command) { + mp_back_error( + mp, + "Missing ':' has been inserted", + "There should've been a colon after the condition. I shall pretend that one was\n" + "there." + ); + } +} + +void mp_conditional (MP mp) +{ + mp_node save_cond_ptr; + int new_if_limit; + mp_push_condition_stack(mp); + save_cond_ptr = mp->cond_ptr; + RESWITCH: + mp_get_x_next(mp); + mp_scan_expression(mp); + if (mp->cur_exp.type != mp_boolean_type) { + do_boolean_error(mp); + } + new_if_limit = mp_else_if_code; + if (number_greater(internal_value(mp_tracing_commands_internal), unity_t)) { + mp_begin_diagnostic(mp); + mp_print_str(mp, cur_exp_value_boolean == mp_true_operation ? "{true}" : "{false}"); + mp_end_diagnostic(mp, 0); + } + FOUND: + mp_check_colon(mp); + if (cur_exp_value_boolean == mp_true_operation) { + mp_change_if_limit (mp, (int) new_if_limit, save_cond_ptr); + return; + } + while (1) { + mp_pass_text(mp); + if (mp->cond_ptr == save_cond_ptr) { + goto DONE; + } else if (cur_mod == mp_fi_code) { + mp_pop_condition_stack(mp); + } + } + DONE: + mp->cur_if = (int) cur_mod; + mp->if_line = mp_true_line(mp); + if (cur_mod == mp_fi_code) { + mp_pop_condition_stack(mp); + } else if (cur_mod == mp_else_if_code) { + goto RESWITCH; + } else { + mp_set_cur_exp_value_boolean(mp, mp_true_operation); + new_if_limit = mp_fi_code; + mp_get_x_next(mp); + goto FOUND; + } +} + +static void mp_bad_for (MP mp, const char *s) +{ + char msg[256]; + mp_value new_expr; + memset(&new_expr, 0, sizeof(mp_value)); + new_number(new_expr.data.n); + mp_disp_err(mp, NULL); + mp_snprintf(msg, 256, "Improper %s has been replaced by 0", s); + mp_back_error( + mp, + msg, + "When you say 'for x=a step b until c', the initial value 'a' and the step size\n" + "'b' and the final value 'c' must have known numeric values. I'm zeroing this one.\n" + "Proceed, with fingers crossed." + ); + mp_get_x_next(mp); + mp_flush_cur_exp(mp, new_expr); +} + +void mp_begin_iteration (MP mp) +{ + mp_node q; + mp_sym n = cur_sym; + mp_subst_list_item *p = NULL; + int m = cur_mod; + mp_loop_data *s = mp_memory_allocate(sizeof(mp_loop_data)); + s->type = NULL; + s->list = NULL; + s->info = NULL; + s->list_start = NULL; + s->link = NULL; + s->var = NULL; + s->point = NULL; + new_number(s->value); + new_number(s->old_value); + new_number(s->step_size); + new_number(s->final_value); + if (m == mp_start_forever_code) { + s->type = MP_VOID; + mp_get_x_next(mp); + } else { + mp_get_symbol(mp); + p = mp_memory_allocate(sizeof(mp_subst_list_item)); + p->link = NULL; + p->info = cur_sym; + s->var = cur_sym; + p->info_mod = cur_sym_mod; + p->value_data = 0; + if (m == mp_start_for_code) { + p->value_mod = mp_expr_operation; + } else { + p->value_mod = mp_suffix_operation; + } + mp_get_x_next(mp); + if (p->value_mod == mp_expr_operation && cur_cmd == mp_within_command) { + mp_get_x_next(mp); + mp_scan_expression(mp); + if (mp->cur_exp.type == mp_path_type) { + number_clone(s->value, zero_t); + number_clone(s->old_value, zero_t); + number_clone(s->step_size, unity_t); + { + mp_knot p = cur_exp_knot; + + int l = 0; + while (1) { + mp_knot n = mp_next_knot(p); + if (n == cur_exp_knot) { + s->point = p; + set_number_from_int(s->final_value, l); + break; + } else { + p = n; + ++l; + } + } + } + s->type = MP_PROGRESSION_FLAG; + s->list = mp_new_symbolic_node(mp); + s->list_start = s->list; + q = s->list; + } else { + if (mp->cur_exp.type != mp_picture_type) { + mp_value new_expr; + memset(&new_expr, 0, sizeof(mp_value)); + new_number(new_expr.data.n); + new_expr.data.node = (mp_node) mp_get_edge_header_node(mp); + mp_disp_err(mp, NULL); + mp_back_error( + mp, + "Improper iteration spec has been replaced by nullpicture", + "When you say 'for x in p', p must be a known picture." + ); + mp_get_x_next(mp); + mp_flush_cur_exp(mp, new_expr); + mp_init_edges(mp, (mp_edge_header_node) mp->cur_exp.data.node); + mp->cur_exp.type = mp_picture_type; + } + s->type = mp->cur_exp.data.node; + mp->cur_exp.type = mp_vacuous_type; + q = mp_link(mp_edge_list(mp->cur_exp.data.node)); + if (q != NULL && mp_is_start_or_stop (q) && mp_skip_1component(mp, q) == NULL) { + q = mp_link(q); + } + s->list = q; + } + } else { + if ((cur_cmd != mp_equals_command) && (cur_cmd != mp_assignment_command)) { + mp_back_error( + mp, + "Missing '=' has been inserted", + "The next thing in this loop should have been '=' or ':='. But don't worry; I'll\n" + "pretend that an equals sign was present, and I'll look for the values next." + ); + } + s->type = NULL; + s->list = mp_new_symbolic_node(mp); + s->list_start = s->list; + q = s->list; + do { + mp_get_x_next(mp); + if (m != mp_start_for_code) { + mp_scan_suffix(mp); + } else { + if (cur_cmd >= mp_colon_command && cur_cmd <= mp_comma_command) { + goto CONTINUE; + } + mp_scan_expression(mp); + if (cur_cmd == mp_step_command && q == s->list) { + { + if (mp->cur_exp.type != mp_known_type) { + mp_bad_for (mp, "initial value"); + } + number_clone(s->value, cur_exp_value_number); + number_clone(s->old_value, cur_exp_value_number); + mp_get_x_next(mp); + mp_scan_expression(mp); + if (mp->cur_exp.type != mp_known_type) { + mp_bad_for (mp, "step size"); + } + number_clone(s->step_size, cur_exp_value_number); + if (cur_cmd != mp_until_command) { + mp_back_error( + mp, + "Missing 'until' has been inserted", + "I assume you meant to say 'until' after 'step'. So I'll look for the final value\n" + "and colon next." + ); + } + mp_get_x_next(mp); + mp_scan_expression(mp); + if (mp->cur_exp.type != mp_known_type) { + mp_bad_for (mp, "final value"); + } + number_clone(s->final_value, cur_exp_value_number); + s->type = MP_PROGRESSION_FLAG; + break; + } + } + mp_set_cur_exp_node(mp, mp_stash_cur_exp(mp)); + } + mp_link(q) = mp_new_symbolic_node(mp); + q = mp_link(q); + mp_set_sym_sym(q, mp->cur_exp.data.node); + if (m == mp_start_for_code) { + mp_name_type(q) = mp_expr_operation; + } else if (m == mp_start_forsuffixes_code) { + mp_name_type(q) = mp_suffix_operation; + } + mp->cur_exp.type = mp_vacuous_type; + CONTINUE: + ; + } while (cur_cmd == mp_comma_command); + } + } + if (cur_cmd != mp_colon_command) { + mp_back_error( + mp, + "Missing ':' has been inserted", + "The next thing in this loop should have been a ':'. So I'll pretend that a colon\n" + "was present; everything from here to 'endfor' will be iterated." + ); + } + q = mp_new_symbolic_node(mp); + mp_set_sym_sym(q, mp->frozen_repeat_loop); + mp->scanner_status = mp_loop_defining_state; + mp->warning_info = n; + s->info = mp_scan_toks(mp, mp_iteration_command, p, q, 0); + mp->scanner_status = mp_normal_state; + s->link = mp->loop_ptr; + mp->loop_ptr = s; + + mp_resume_iteration(mp); +} + +void mp_resume_iteration (MP mp) +{ + mp_node p, q; + p = mp->loop_ptr->type; + if (p == MP_PROGRESSION_FLAG) { + mp_set_cur_exp_value_number(mp, &(mp->loop_ptr->value)); + if ((number_positive(mp->loop_ptr->step_size) && number_greater(cur_exp_value_number, mp->loop_ptr->final_value)) + || (number_negative(mp->loop_ptr->step_size) && number_less (cur_exp_value_number, mp->loop_ptr->final_value))) { + mp_stop_iteration(mp); + return; + } + mp->cur_exp.type = mp_known_type; + q = mp_stash_cur_exp(mp); + number_clone(mp->loop_ptr->old_value, cur_exp_value_number); + set_number_from_addition(mp->loop_ptr->value, cur_exp_value_number, mp->loop_ptr->step_size); + if (number_positive(mp->loop_ptr->step_size) && number_less(mp->loop_ptr->value, cur_exp_value_number)) { + if (number_positive(mp->loop_ptr->final_value)) { + number_clone(mp->loop_ptr->value, mp->loop_ptr->final_value); + number_add_scaled(mp->loop_ptr->final_value, -1); + } else { + number_clone(mp->loop_ptr->value, mp->loop_ptr->final_value); + number_add_scaled(mp->loop_ptr->value, 1); + } + } else if (number_negative(mp->loop_ptr->step_size) && number_greater(mp->loop_ptr->value, cur_exp_value_number)) { + if (number_negative(mp->loop_ptr->final_value)) { + number_clone(mp->loop_ptr->value, mp->loop_ptr->final_value); + number_add_scaled(mp->loop_ptr->final_value, 1); + } else { + number_clone(mp->loop_ptr->value, mp->loop_ptr->final_value); + number_add_scaled(mp->loop_ptr->value, -1); + } + } + if (mp->loop_ptr->point != NULL) { + mp->loop_ptr->point = mp_next_knot(mp->loop_ptr->point); + } + } else if (p == NULL) { + p = mp->loop_ptr->list; + if (p != NULL && p == mp->loop_ptr->list_start) { + q = p; + p = mp_link(p); + mp_free_symbolic_node(mp, q); + mp->loop_ptr->list = p; + } + if (p == NULL) { + mp_stop_iteration(mp); + return; + } + mp->loop_ptr->list = mp_link(p); + q = (mp_node) mp_get_sym_sym(p); + if (q) { + number_clone(mp->loop_ptr->old_value, q->data.n); + } + mp_free_symbolic_node(mp, p); + } else if (p == MP_VOID) { + mp_begin_token_list(mp, mp->loop_ptr->info, mp_forever_text); + return; + } else { + q = mp->loop_ptr->list; + if (q == NULL) { + goto NOT_FOUND; + } else if (! mp_is_start_or_stop(q)) { + q = mp_link(q); + } else if (! mp_is_stop(q)) { + q = mp_skip_1component(mp, q); + } else { + goto NOT_FOUND; + } + mp_set_cur_exp_node(mp, (mp_node) mp_copy_objects (mp, mp->loop_ptr->list, q)); + mp_init_bbox(mp, (mp_edge_header_node) cur_exp_node); + mp->cur_exp.type = mp_picture_type; + mp->loop_ptr->list = q; + q = mp_stash_cur_exp(mp); + } + mp_begin_token_list(mp, mp->loop_ptr->info, mp_loop_text); + mp_stack_argument(mp, q); + if (number_greater(internal_value(mp_tracing_commands_internal), unity_t)) { + mp_begin_diagnostic(mp); + mp_print_nl(mp, "{loop value="); + if ((q != NULL) && (mp_link(q) == MP_VOID)) { + mp_print_exp(mp, q, 1); + } else { + mp_show_token_list(mp, q, NULL); + } + mp_print_chr(mp, '}'); + mp_end_diagnostic(mp, 0); + } + return; + NOT_FOUND: + mp_stop_iteration(mp); +} + +void mp_stop_iteration (MP mp) +{ + mp_node p = mp->loop_ptr->type; + if (p == MP_PROGRESSION_FLAG) { + mp_free_symbolic_node(mp, mp->loop_ptr->list); + if (mp->loop_ptr->point) { + mp_toss_knot_list(mp, mp->loop_ptr->point); + } + } else if (p == NULL) { + mp_node q = mp->loop_ptr->list; + while (q != NULL) { + p = (mp_node) mp_get_sym_sym(q); + if (p != NULL) { + if (mp_link(p) == MP_VOID) { + mp_recycle_value(mp, p); + mp_free_value_node(mp, p); + } else { + mp_flush_token_list(mp, p); + } + } + p = q; + q = mp_link(q); + mp_free_symbolic_node(mp, p); + } + } else if (p > MP_PROGRESSION_FLAG) { + mp_delete_edge_ref(mp, p); + } + { + mp_loop_data *tmp = mp->loop_ptr; + mp->loop_ptr = tmp->link; + mp_flush_token_list(mp, tmp->info); + free_number(tmp->value); + free_number(tmp->step_size); + free_number(tmp->final_value); + mp_memory_free(tmp); + } +} + +void mp_begin_name (MP mp) +{ + mp_memory_free(mp->cur_name); + mp->cur_name = NULL; + mp->quoted_filename = 0; +} + +int mp_more_name (MP mp, unsigned char c) +{ + if (c == '"') { + mp->quoted_filename = ! mp->quoted_filename; + } else if ((c == ' ' || c == '\t') && (mp->quoted_filename == 0)) { + return 0; + } else { + mp_str_room(mp, 1); + mp_append_char(mp, c); + } + return 1; +} + +void mp_end_name (MP mp) +{ + mp->cur_name = mp_memory_allocate((size_t) (mp->cur_length + 1) * sizeof(char)); + (void) memcpy(mp->cur_name, (char *) (mp->cur_string), mp->cur_length); + mp->cur_name[mp->cur_length] = 0; + mp_reset_cur_string(mp); +} + +void mp_pack_file_name (MP mp, const char *n) +{ + mp_memory_free(mp->name_of_file); + mp->name_of_file = mp_strdup(n); +} + +static mp_string mp_make_name_string (MP mp) +{ + int name_length = (int) strlen(mp->name_of_file); + mp_str_room(mp, name_length); + for (int k = 0; k < name_length; k++) { + mp_append_char(mp, (unsigned char) mp->name_of_file[k]); + } + return mp_make_string(mp); +} + +static void mp_scan_file_name (MP mp) +{ + mp_begin_name(mp); + while (mp->buffer[loc] == ' ') { + ++loc; + } + while (1) { + if ((mp->buffer[loc] == ';') || (mp->buffer[loc] == '%')) { + break; + } else if (! mp_more_name(mp, mp->buffer[loc])) { + break; + } else { + ++loc; + } + } + mp_end_name(mp); +} + +static void mp_ptr_scan_file (MP mp, char *s) +{ + char *p = s; + char *q = p + strlen(s); + mp_begin_name(mp); + while (p < q) { + if (! mp_more_name(mp, (unsigned char) (*p))) { + break; + } else { + p++; + } + } + mp_end_name(mp); +} + +void mp_start_input (MP mp) +{ + while (token_state && (nloc == NULL)) { + mp_end_token_list(mp); + } + if (token_state) { + mp_error( + mp, + "File names can't appear within macros", + "Sorry ... I've converted what follows to tokens, possibly garbaging the name you\n" + "gave. Please delete the tokens and insert the name again." + ); + } + if (file_state) { + mp_scan_file_name(mp); + } else { + mp_memory_free(mp->cur_name); + mp->cur_name = mp_strdup(""); + } + mp_begin_file_reading(mp); + mp_pack_file_name(mp, mp->cur_name); + if (mp_open_in(mp, &cur_file, mp_filetype_program)) { + char *fname = NULL; + name = mp_make_name_string(mp); + fname = mp_strdup(mp->name_of_file); + if (mp->interaction < mp_silent_mode) { + if ((mp->term_offset > 0) || (mp->file_offset > 0)) { + mp_print_chr(mp, ' '); + } + mp_print_chr(mp, '('); + ++mp->open_parens; + mp_print_str(mp, fname); + } + mp_memory_free(fname); + update_terminal(); + mp_flush_string(mp, name); + name = mp_rts(mp, mp->cur_name); + mp_memory_free(mp->cur_name); + mp->cur_name = NULL; + + line = 1; + mp_input_ln(mp, cur_file); + mp_firm_up_the_line(mp); + mp->buffer[limit] = '%'; + mp->first = (size_t) (limit + 1); + loc = start; + } else { + mp_fatal_error(mp, "invalid input file"); + mp_end_file_reading(mp); + } +} + +static int mp_start_read_input (MP mp, char *s, int n) +{ + mp_ptr_scan_file(mp, s); + mp_pack_file_name(mp, mp->cur_name); + mp_begin_file_reading(mp); + if (! mp_open_in(mp, &mp->rd_file[n], mp_filetype_text + n)) { + mp_end_file_reading(mp); + return 0; + } else if (! mp_input_ln(mp, mp->rd_file[n])) { + (mp->close_file)(mp, mp->rd_file[n]); + mp_end_file_reading(mp); + return 0; + } else { + mp->rd_fname[n] = mp_strdup(s); + return 1; + } +} + +void mp_open_write_file (MP mp, char *s, int n) +{ + mp_ptr_scan_file(mp, s); + mp_pack_file_name(mp, mp->cur_name); + if (mp_open_out(mp, &mp->wr_file[n], mp_filetype_text + n)) { + mp->wr_fname[n] = mp_strdup(s); + } else { + mp_fatal_error(mp, "invalid write file"); + } +} + +void mp_set_cur_exp_node (MP mp, mp_node n) +{ + if (cur_exp_str) { + delete_str_ref(cur_exp_str); + } + cur_exp_node = n; + cur_exp_str = NULL; + cur_exp_knot = NULL; + set_number_to_zero(mp->cur_exp.data.n); +} + +void mp_set_cur_exp_knot (MP mp, mp_knot n) +{ + if (cur_exp_str) { + delete_str_ref(cur_exp_str); + } + cur_exp_knot = n; + cur_exp_node = NULL; + cur_exp_str = NULL; + set_number_to_zero(mp->cur_exp.data.n); +} + +void mp_set_cur_exp_value_boolean (MP mp, int b) +{ + if (cur_exp_str) { + delete_str_ref(cur_exp_str); + } + set_number_from_boolean(mp->cur_exp.data.n, b); + cur_exp_node = NULL; + cur_exp_str = NULL; + cur_exp_knot = NULL; +} + +void mp_set_cur_exp_value_scaled (MP mp, int s) +{ + if (cur_exp_str) { + delete_str_ref(cur_exp_str); + } + set_number_from_scaled(mp->cur_exp.data.n, s); + cur_exp_node = NULL; + cur_exp_str = NULL; + cur_exp_knot = NULL; +} + +void mp_set_cur_exp_value_number (MP mp, mp_number *n) +{ + if (cur_exp_str) { + delete_str_ref(cur_exp_str); + } + number_clone(mp->cur_exp.data.n, *n); + cur_exp_node = NULL; + cur_exp_str = NULL; + cur_exp_knot = NULL; +} + +void mp_set_cur_exp_str (MP mp, mp_string s) +{ + if (cur_exp_str) { + delete_str_ref(cur_exp_str); + } + cur_exp_str = s; + add_str_ref(cur_exp_str); + cur_exp_node = NULL; + cur_exp_knot = NULL; + set_number_to_zero(mp->cur_exp.data.n); +} + +static mp_node mp_stash_cur_exp (MP mp) +{ + mp_node p; + mp_variable_type exp_type = mp->cur_exp.type; + switch (exp_type) { + case mp_unknown_boolean_type: + case mp_unknown_string_type: + case mp_unknown_pen_type: + case mp_unknown_nep_type: + case mp_unknown_path_type: + case mp_unknown_picture_type: + case mp_transform_type: + case mp_color_type: + case mp_pair_type: + case mp_dependent_type: + case mp_proto_dependent_type: + case mp_independent_type: + case mp_cmykcolor_type: + p = cur_exp_node; + break; + default: + p = mp_new_value_node(mp); + mp_name_type(p) = mp_capsule_operation; + mp_type(p) = mp->cur_exp.type; + mp_set_value_number(p, cur_exp_value_number); + if (cur_exp_str) { + mp_set_value_str(p, cur_exp_str); + } else if (cur_exp_knot) { + mp_set_value_knot(p, cur_exp_knot); + } else if (cur_exp_node) { + mp_set_value_node(p, cur_exp_node); + } + break; + } + mp->cur_exp.type = mp_vacuous_type; + mp_link(p) = MP_VOID; + return p; +} + +void mp_unstash_cur_exp (MP mp, mp_node p) +{ + mp->cur_exp.type = mp_type(p); + switch (mp->cur_exp.type) { + case mp_unknown_boolean_type: + case mp_unknown_string_type: + case mp_unknown_pen_type: + case mp_unknown_nep_type: + case mp_unknown_path_type: + case mp_unknown_picture_type: + case mp_transform_type: + case mp_color_type: + case mp_pair_type: + case mp_dependent_type: + case mp_proto_dependent_type: + case mp_independent_type: + case mp_cmykcolor_type: + mp_set_cur_exp_node(mp, p); + break; + case mp_token_list_type: + mp_set_cur_exp_node(mp, mp_get_value_node(p)); + mp_free_value_node(mp, p); + break; + case mp_path_type: + case mp_pen_type: + case mp_nep_type: + mp_set_cur_exp_knot(mp, mp_get_value_knot(p)); + mp_free_value_node(mp, p); + break; + case mp_string_type: + mp_set_cur_exp_str(mp, mp_get_value_str(p)); + mp_free_value_node(mp, p); + break; + case mp_picture_type: + mp_set_cur_exp_node(mp, mp_get_value_node(p)); + mp_free_value_node(mp, p); + break; + case mp_boolean_type: + case mp_known_type: + mp_set_cur_exp_value_number(mp, &(mp_get_value_number(p))); + mp_free_value_node(mp, p); + break; + default: + mp_set_cur_exp_value_number(mp, &(mp_get_value_number(p))); + if (mp_get_value_knot(p)) { + mp_set_cur_exp_knot(mp, mp_get_value_knot(p)); + } else if (mp_get_value_node(p)) { + mp_set_cur_exp_node(mp, mp_get_value_node(p)); + } else if (mp_get_value_str(p)) { + mp_set_cur_exp_str(mp, mp_get_value_str(p)); + } + mp_free_value_node(mp, p); + break; + } +} + +void mp_print_exp (MP mp, mp_node p, int verbosity) +{ + int restore_cur_exp; + mp_variable_type t; + mp_number vv; + mp_node v = NULL; + new_number(vv); + if (p != NULL) { + restore_cur_exp = 0; + } else { + p = mp_stash_cur_exp(mp); + restore_cur_exp = 1; + } + t = mp_type(p); + if (t < mp_dependent_type) { + if (t != mp_vacuous_type && t != mp_known_type && mp_get_value_node(p) != NULL) { + v = mp_get_value_node(p); + } else { + number_clone(vv, mp_get_value_number(p)); + } + } else if (t < mp_independent_type) { + v = (mp_node) mp_get_dep_list((mp_value_node) p); + } + switch (t) { + case mp_vacuous_type: + mp_print_str(mp, "vacuous"); + break; + case mp_boolean_type: + mp_print_str(mp, number_to_boolean(vv) == mp_true_operation ? "true": "false"); + break; + case mp_unknown_boolean_type: + case mp_unknown_string_type: + case mp_unknown_pen_type: + case mp_unknown_nep_type: + case mp_unknown_path_type: + case mp_unknown_picture_type: + case mp_numeric_type: + { + { + mp_print_type(mp, t); + if (v != NULL) { + mp_print_chr(mp, ' '); + while ((mp_name_type(v) == mp_capsule_operation) && (v != p)) { + v = mp_get_value_node(v); + } + mp_print_variable_name(mp, v); + }; + } + } + break; + case mp_string_type: + mp_print_chr(mp, '"'); + mp_print_mp_str(mp, mp_get_value_str(p)); + mp_print_chr(mp, '"'); + break; + case mp_pen_type: + case mp_nep_type: + case mp_path_type: + case mp_picture_type: + { + if (verbosity <= 1) { + mp_print_type(mp, t); + } else { + if (mp->selector == mp_term_and_log_selector) + if (number_nonpositive(internal_value(mp_tracing_online_internal))) { + mp->selector = mp_term_only_selector; + mp_print_type(mp, t); + mp_print_str(mp, " (see the transcript file)"); + mp->selector = mp_term_and_log_selector; + }; + switch (t) { + case mp_pen_type: + case mp_nep_type: + mp_print_pen(mp, mp_get_value_knot(p), "", 0); + break; + case mp_path_type: + mp_print_path(mp, mp_get_value_knot(p), "", 0); + break; + case mp_picture_type: + mp_print_edges(mp, v, "", 0); + break; + default: + break; + } + } + } + break; + case mp_transform_type: + if (number_zero(vv) && v == NULL) { + mp_print_type(mp, t); + } else { + mp_print_chr(mp, '('); + mp_print_big_node(mp, mp_tx_part(v), verbosity); + mp_print_chr(mp, ','); + mp_print_big_node(mp, mp_ty_part(v), verbosity); + mp_print_chr(mp, ','); + mp_print_big_node(mp, mp_xx_part(v), verbosity); + mp_print_chr(mp, ','); + mp_print_big_node(mp, mp_xy_part(v), verbosity); + mp_print_chr(mp, ','); + mp_print_big_node(mp, mp_yx_part(v), verbosity); + mp_print_chr(mp, ','); + mp_print_big_node(mp, mp_yy_part(v), verbosity); + mp_print_chr(mp, ')'); + } + break; + case mp_color_type: + if (number_zero(vv) && v == NULL) { + mp_print_type(mp, t); + } else { + mp_print_chr(mp, '('); + mp_print_big_node(mp, mp_red_part(v), verbosity); + mp_print_chr(mp, ','); + mp_print_big_node(mp, mp_green_part(v), verbosity); + mp_print_chr(mp, ','); + mp_print_big_node(mp, mp_blue_part(v), verbosity); + mp_print_chr(mp, ')'); + } + break; + case mp_pair_type: + if (number_zero(vv) && v == NULL) { + mp_print_type(mp, t); + } else { + mp_print_chr(mp, '('); + mp_print_big_node(mp, mp_x_part(v), verbosity); + mp_print_chr(mp, ','); + mp_print_big_node(mp, mp_y_part(v), verbosity); + mp_print_chr(mp, ')'); + } + break; + case mp_cmykcolor_type: + if (number_zero(vv) && v == NULL) { + mp_print_type(mp, t); + } else { + mp_print_chr(mp, '('); + mp_print_big_node(mp, mp_cyan_part(v), verbosity); + mp_print_chr(mp, ','); + mp_print_big_node(mp, mp_magenta_part(v), verbosity); + mp_print_chr(mp, ','); + mp_print_big_node(mp, mp_yellow_part(v), verbosity); + mp_print_chr(mp, ','); + mp_print_big_node(mp, mp_black_part(v), verbosity); + mp_print_chr(mp, ')'); + } + break; + case mp_known_type: + print_number(vv); + break; + case mp_dependent_type: + case mp_proto_dependent_type: + mp_print_dp(mp, t, (mp_value_node) v, verbosity); + break; + case mp_independent_type: + mp_print_variable_name(mp, p); + break; + default: + mp_confusion(mp, "expression"); + break; + } + if (restore_cur_exp) { + mp_unstash_cur_exp(mp, p); + } + free_number(vv); +} + +void mp_print_big_node (MP mp, mp_node v, int verbosity) +{ + switch (mp_type(v)) { + case mp_known_type: + print_number(mp_get_value_number(v)); + break; + case mp_independent_type: + mp_print_variable_name(mp, v); + break; + default: + mp_print_dp(mp, mp_type(v), (mp_value_node) mp_get_dep_list((mp_value_node) v), verbosity); + break; + } +} + +static void mp_print_dp (MP mp, int t, mp_value_node p, int verbosity) +{ + mp_value_node q = (mp_value_node) mp_link(p); + if ((mp_get_dep_info(q) == NULL) || (verbosity > 0)) { + mp_print_dependency(mp, p, t); + } else { + mp_print_str(mp, "linearform"); + } +} + +void mp_disp_err (MP mp, mp_node p) +{ + if (mp->interaction >= mp_error_stop_mode) { + wake_up_terminal(); + } + mp_print_nl(mp, "<error> "); + mp_print_exp(mp, p, 1); +} + +void mp_flush_cur_exp (MP mp, mp_value v) +{ + if (is_number(mp->cur_exp.data.n)) { + free_number(mp->cur_exp.data.n); + } + switch (mp->cur_exp.type) { + case mp_unknown_boolean_type: + case mp_unknown_string_type: + case mp_unknown_pen_type: + case mp_unknown_nep_type: + case mp_unknown_path_type: + case mp_unknown_picture_type: + case mp_transform_type: + case mp_color_type: + case mp_pair_type: + case mp_dependent_type: + case mp_proto_dependent_type: + case mp_independent_type: + case mp_cmykcolor_type: + mp_recycle_value(mp, cur_exp_node); + mp_free_value_node(mp, cur_exp_node); + break; + case mp_string_type: + delete_str_ref(cur_exp_str); + break; + case mp_pen_type: + case mp_nep_type: + case mp_path_type: + mp_toss_knot_list(mp, cur_exp_knot); + break; + case mp_picture_type: + mp_delete_edge_ref(mp, cur_exp_node); + break; + default: + break; + } + mp->cur_exp = v; + mp->cur_exp.type = mp_known_type; +} + +static void mp_recycle_value (MP mp, mp_node p) +{ + if (p != NULL && p != MP_VOID) { + mp_variable_type t = mp_type(p); + switch (t) { + case mp_vacuous_type: + case mp_boolean_type: + case mp_known_type: + case mp_numeric_type: + break; + case mp_unknown_boolean_type: + case mp_unknown_string_type: + case mp_unknown_pen_type: + case mp_unknown_nep_type: + case mp_unknown_path_type: + case mp_unknown_picture_type: + mp_ring_delete (mp, p); + break; + case mp_string_type: + delete_str_ref(mp_get_value_str(p)); + break; + case mp_path_type: + case mp_pen_type: + case mp_nep_type: + mp_toss_knot_list(mp, mp_get_value_knot(p)); + break; + case mp_picture_type: + mp_delete_edge_ref(mp, mp_get_value_node(p)); + break; + case mp_cmykcolor_type: + if (mp_get_value_node(p) != NULL) { + mp_recycle_value(mp, mp_cyan_part(mp_get_value_node(p))); + mp_recycle_value(mp, mp_magenta_part(mp_get_value_node(p))); + mp_recycle_value(mp, mp_yellow_part(mp_get_value_node(p))); + mp_recycle_value(mp, mp_black_part(mp_get_value_node(p))); + mp_free_value_node(mp, mp_cyan_part(mp_get_value_node(p))); + mp_free_value_node(mp, mp_magenta_part(mp_get_value_node(p))); + mp_free_value_node(mp, mp_black_part(mp_get_value_node(p))); + mp_free_value_node(mp, mp_yellow_part(mp_get_value_node(p))); + mp_free_node(mp, mp_get_value_node(p), sizeof(mp_color_node_data)); + } + break; + case mp_pair_type: + if (mp_get_value_node(p) != NULL) { + mp_recycle_value(mp, mp_x_part(mp_get_value_node(p))); + mp_recycle_value(mp, mp_y_part(mp_get_value_node(p))); + mp_free_value_node(mp, mp_x_part(mp_get_value_node(p))); + mp_free_value_node(mp, mp_y_part(mp_get_value_node(p))); + mp_free_pair_node(mp, mp_get_value_node(p)); + } + break; + case mp_color_type: + if (mp_get_value_node(p) != NULL) { + mp_recycle_value(mp, mp_red_part(mp_get_value_node(p))); + mp_recycle_value(mp, mp_green_part(mp_get_value_node(p))); + mp_recycle_value(mp, mp_blue_part(mp_get_value_node(p))); + mp_free_value_node(mp, mp_red_part(mp_get_value_node(p))); + mp_free_value_node(mp, mp_green_part(mp_get_value_node(p))); + mp_free_value_node(mp, mp_blue_part(mp_get_value_node(p))); + mp_free_node(mp, mp_get_value_node(p), sizeof(mp_color_node_data)); + } + break; + case mp_transform_type: + if (mp_get_value_node(p) != NULL) { + mp_recycle_value(mp, mp_tx_part(mp_get_value_node(p))); + mp_recycle_value(mp, mp_ty_part(mp_get_value_node(p))); + mp_recycle_value(mp, mp_xx_part(mp_get_value_node(p))); + mp_recycle_value(mp, mp_xy_part(mp_get_value_node(p))); + mp_recycle_value(mp, mp_yx_part(mp_get_value_node(p))); + mp_recycle_value(mp, mp_yy_part(mp_get_value_node(p))); + mp_free_value_node(mp, mp_tx_part(mp_get_value_node(p))); + mp_free_value_node(mp, mp_ty_part(mp_get_value_node(p))); + mp_free_value_node(mp, mp_xx_part(mp_get_value_node(p))); + mp_free_value_node(mp, mp_xy_part(mp_get_value_node(p))); + mp_free_value_node(mp, mp_yx_part(mp_get_value_node(p))); + mp_free_value_node(mp, mp_yy_part(mp_get_value_node(p))); + mp_free_node(mp, mp_get_value_node(p), sizeof(mp_transform_node_data)); + } + break; + case mp_dependent_type: + case mp_proto_dependent_type: + { + mp_value_node qq = (mp_value_node) mp_get_dep_list((mp_value_node) p); + while (mp_get_dep_info(qq) != NULL) { + qq = (mp_value_node) mp_link(qq); + } + mp_set_link(mp_get_prev_dep((mp_value_node) p), mp_link(qq)); + mp_set_prev_dep(mp_link(qq), mp_get_prev_dep((mp_value_node) p)); + mp_set_link(qq, NULL); + mp_flush_node_list(mp, (mp_node) mp_get_dep_list((mp_value_node) p)); + } + break; + case mp_independent_type: + mp_recycle_independent_value(mp, p); + break; + case mp_token_list_type: + case mp_structured_type: + mp_confusion(mp, "recycle"); + break; + case mp_unsuffixed_macro_type: + case mp_suffixed_macro_type: + mp_delete_mac_ref(mp, mp_get_value_node(p)); + break; + default: + break; + } + mp_type(p) = mp_undefined_type; + } +} + +static void mp_recycle_independent_value (MP mp, mp_node p) +{ + mp_value_node q, r, s; + mp_node pp; + mp_number v ; + mp_number test; + mp_variable_type t = mp_type(p); + new_number(test); + new_number(v); + if (t < mp_dependent_type) { + number_clone(v, mp_get_value_number(p)); + } + set_number_to_zero(mp->max_c[mp_dependent_type]); + set_number_to_zero(mp->max_c[mp_proto_dependent_type]); + mp->max_link[mp_dependent_type] = NULL; + mp->max_link[mp_proto_dependent_type] = NULL; + q = (mp_value_node) mp_link(mp->dep_head); + while (q != mp->dep_head) { + s = (mp_value_node) mp->temp_head; + mp_set_link(s, mp_get_dep_list(q)); + while (1) { + r = (mp_value_node) mp_link(s); + if (mp_get_dep_info(r) == NULL) { + break; + } else if (mp_get_dep_info(r) != p) { + s = r; + } else { + t = mp_type(q); + if (mp_link(s) == mp_get_dep_list(q)) { + mp_set_dep_list(q, mp_link(r)); + } + mp_set_link(s, mp_link(r)); + mp_set_dep_info(r, (mp_node) q); + number_abs_clone(test, mp_get_dep_value(r)); + if (number_greater(test, mp->max_c[t])) { + if (number_positive(mp->max_c[t])) { + mp_set_link(mp->max_ptr[t], (mp_node) mp->max_link[t]); + mp->max_link[t] = mp->max_ptr[t]; + } + number_clone(mp->max_c[t], test); + mp->max_ptr[t] = r; + } else { + mp_set_link(r, mp->max_link[t]); + mp->max_link[t] = r; + } + } + } + q = (mp_value_node) mp_link(r); + } + if (number_positive(mp->max_c[mp_dependent_type]) || number_positive(mp->max_c[mp_proto_dependent_type])) { + mp_number test, ret; + new_number(ret); + new_number_clone(test, mp->max_c[mp_dependent_type]); + number_divide_int(test, 4096); + if (number_greaterequal(test, mp->max_c[mp_proto_dependent_type])) { + t = mp_dependent_type; + } else { + t = mp_proto_dependent_type; + } + s = mp->max_ptr[t]; + pp = (mp_node) mp_get_dep_info(s); + number_clone(v, mp_get_dep_value(s)); + if (t == mp_dependent_type) { + mp_set_dep_value(s, fraction_one_t); + } else { + mp_set_dep_value(s, unity_t); + } + number_negate(mp_get_dep_value(s)); + r = (mp_value_node) mp_get_dep_list((mp_value_node) pp); + mp_set_link(s, r); + while (mp_get_dep_info(r) != NULL) { + r = (mp_value_node) mp_link(r); + } + q = (mp_value_node) mp_link(r); + mp_set_link(r, NULL); + mp_set_prev_dep(q, mp_get_prev_dep((mp_value_node) pp)); + mp_set_link(mp_get_prev_dep((mp_value_node) pp), (mp_node) q); + mp_new_indep(mp, pp); + if (cur_exp_node == pp && mp->cur_exp.type == t) { + mp->cur_exp.type = mp_independent_type; + } + if (number_positive(internal_value(mp_tracing_equations_internal)) && mp_interesting(mp, p)) { + mp_begin_diagnostic(mp); + mp_show_transformed_dependency(mp, &v, t, p); + mp_print_dependency(mp, s, t); + mp_end_diagnostic(mp, 0); + } + t = mp_dependent_type + mp_proto_dependent_type - t; + if (number_positive(mp->max_c[t])) { + mp_set_link(mp->max_ptr[t], (mp_node) mp->max_link[t]); + mp->max_link[t] = mp->max_ptr[t]; + } + if (t != mp_dependent_type) { + for (t = mp_dependent_type; t <= mp_proto_dependent_type; t=t+1) { + r = mp->max_link[t]; + while (r != NULL) { + q = (mp_value_node) mp_get_dep_info(r); + number_negated_clone(test, v); + make_fraction(ret, mp_get_dep_value(r), test); + mp_set_dep_list(q, mp_p_plus_fq(mp, (mp_value_node) mp_get_dep_list(q), &ret, s, t, mp_dependent_type)); + if (mp_get_dep_list(q) == (mp_node) mp->dep_final) { + mp_make_known(mp, q, mp->dep_final); + } + q = r; + r = (mp_value_node) mp_link(r); + mp_free_dep_node(mp, q); + } + } + } else { + for (t = mp_dependent_type; t <= mp_proto_dependent_type; t++) { + r = mp->max_link[t]; + while (r != NULL) { + q = (mp_value_node) mp_get_dep_info(r); + if (t == mp_dependent_type) { + if (cur_exp_node == (mp_node) q && mp->cur_exp.type == mp_dependent_type) { + mp->cur_exp.type = mp_proto_dependent_type; + } + mp_set_dep_list(q, mp_p_over_v(mp, (mp_value_node) mp_get_dep_list(q), &unity_t, mp_dependent_type, mp_proto_dependent_type)); + mp_type(q) = mp_proto_dependent_type; + fraction_to_round_scaled(mp_get_dep_value(r)); + } + number_negated_clone(test, v); + make_scaled(ret, mp_get_dep_value(r), test); + mp_set_dep_list(q, mp_p_plus_fq(mp, (mp_value_node) mp_get_dep_list(q), &ret, s, mp_proto_dependent_type, mp_proto_dependent_type)); + if (mp_get_dep_list(q) == (mp_node) mp->dep_final) { + mp_make_known(mp, q, mp->dep_final); + } + q = r; + r = (mp_value_node) mp_link(r); + mp_free_dep_node(mp, q); + } + } + } + mp_flush_node_list(mp, (mp_node) s); + if (mp->fix_needed) { + mp_fix_dependencies(mp); + } + check_arith(); + free_number(ret); + } + free_number(v); + free_number(test); +} + +static void mp_show_transformed_dependency (MP mp, mp_number *v, mp_variable_type t, mp_node p) +{ + mp_number vv; + mp_print_nl(mp, "### "); + if (number_positive(*v)) { + mp_print_chr(mp, '-'); + } + if (t == mp_dependent_type) { + new_number_clone(vv, mp->max_c[mp_dependent_type]); + fraction_to_round_scaled(vv); + } else { + new_number_clone(vv, mp->max_c[mp_proto_dependent_type]); + } + if (! number_equal(vv, unity_t)) { + print_number(vv); + } + mp_print_variable_name(mp, p); + while (mp_get_indep_scale(p) > 0) { + mp_print_str(mp, "*4"); + mp_set_indep_scale(p, mp_get_indep_scale(p)-2); + } + if (t == mp_dependent_type) { + mp_print_chr(mp, '='); + } else { + mp_print_str(mp, " = "); + } + free_number(vv); +} + +static void mp_bad_exp (MP mp, const char *s) +{ + char msg[256]; + int save_flag; + { + mp_string cm; + int selector = mp->selector; + mp->selector = mp_new_string_selector; + mp_print_cmd_mod(mp, cur_cmd, cur_mod); + mp->selector = selector; + cm = mp_make_string(mp); + mp_snprintf(msg, 256, "%s expression can't begin with '%s'", s, mp_str(mp, cm)); + delete_str_ref(cm); + } + mp_back_input(mp); + set_cur_sym(NULL); + set_cur_cmd(mp_numeric_command); + set_cur_mod_number(zero_t); + mp_ins_error( + mp, + msg, + "I'm afraid I need some sort of value in order to continue, so I've tentatively\n" + "inserted '0'." + ); + save_flag = mp->var_flag; + mp->var_flag = 0; + mp_get_x_next(mp); + mp->var_flag = save_flag; +} + +static void mp_stash_in (MP mp, mp_node p) +{ + mp_type(p) = mp->cur_exp.type; + if (mp->cur_exp.type == mp_known_type) { + mp_set_value_number(p, cur_exp_value_number); + } else if (mp->cur_exp.type == mp_independent_type) { + mp_value_node q = mp_single_dependency(mp, cur_exp_node); + if (q == mp->dep_final) { + mp_type(p) = mp_known_type; + mp_set_value_number(p, zero_t); + mp_free_dep_node(mp, q); + } else { + mp_new_dep(mp, p, mp_dependent_type, q); + } + mp_recycle_value(mp, cur_exp_node); + mp_free_value_node(mp, cur_exp_node); + } else { + mp_set_dep_list((mp_value_node) p, mp_get_dep_list((mp_value_node) cur_exp_node)); + mp_set_prev_dep((mp_value_node) p, mp_get_prev_dep((mp_value_node) cur_exp_node)); + mp_set_link(mp_get_prev_dep((mp_value_node) p), p); + mp_free_dep_node(mp, (mp_value_node) cur_exp_node); + } + mp->cur_exp.type = mp_vacuous_type; +} + +static void mp_back_expr (MP mp) +{ + mp_node p = mp_stash_cur_exp(mp); + mp_link(p) = NULL; + mp_begin_token_list(mp, p, mp_backed_up_text); +} + +static void mp_bad_subscript (MP mp) +{ + mp_value new_expr; + memset(&new_expr, 0, sizeof(mp_value)); + new_number(new_expr.data.n); + mp_disp_err(mp, NULL); + mp_error( + mp, + "Improper subscript has been replaced by zero", + "A bracketed subscript must have a known numeric value; unfortunately, what I\n" + "found was the value that appears just above this error message. So I'll try a\n" + "zero subscript." + ); + mp_flush_cur_exp(mp, new_expr); +} + +static char *mp_obliterated (MP mp, mp_node q) +{ + char msg[256]; + mp_string sname; + int selector = mp->selector; + mp->selector = mp_new_string_selector; + mp_show_token_list(mp, q, NULL); + sname = mp_make_string(mp); + mp->selector = selector; + mp_snprintf(msg, 256, "Variable %s has been obliterated", mp_str(mp, sname)); + delete_str_ref(sname); + return mp_strdup(msg); +} + +static void mp_binary_mac (MP mp, mp_node p, mp_node c, mp_sym n) +{ + mp_node q = mp_new_symbolic_node(mp); + mp_node r = mp_new_symbolic_node(mp); + mp_link(q) = r; + mp_set_sym_sym(q, p); + mp_set_sym_sym(r, mp_stash_cur_exp(mp)); + mp_macro_call(mp, c, q, n); +} + +static mp_knot mp_pair_to_knot (MP mp) +{ + mp_knot q = mp_new_knot(mp); + mp_left_type(q) = mp_endpoint_knot; + mp_right_type(q) = mp_endpoint_knot; + mp_originator(q) = mp_metapost_user; + mp_knotstate(q) = mp_regular_knot; + mp_prev_knot(q) = q; + mp_next_knot(q) = q; + mp_known_pair(mp); + number_clone(q->x_coord, mp->cur_x); + number_clone(q->y_coord, mp->cur_y); + return q; +} + +void mp_known_pair (MP mp) +{ + mp_value new_expr; + memset(&new_expr, 0, sizeof(mp_value)); + new_number(new_expr.data.n); + if (mp->cur_exp.type != mp_pair_type) { + mp_disp_err(mp, NULL); + mp_back_error( + mp, + "Undefined coordinates have been replaced by (0,0)", + "I need x and y numbers for this part of the path. The value I found (see above)\n" + "was no good; so I'll try to keep going by using zero instead." + ); + mp_get_x_next(mp); + mp_flush_cur_exp(mp, new_expr); + set_number_to_zero(mp->cur_x); + set_number_to_zero(mp->cur_y); + } else { + mp_node p = mp_get_value_node(cur_exp_node); + if (mp_type(mp_x_part(p)) == mp_known_type) { + number_clone(mp->cur_x, mp_get_value_number(mp_x_part(p))); + } else { + mp_disp_err(mp, mp_x_part(p)); + mp_back_error( + mp, + "Undefined x coordinate has been replaced by 0", + "I need a 'known' x value for this part of the path. The value I found (see above)\n" + "was no good; so I'll try to keep going by using zero instead." + ); + mp_get_x_next(mp); + mp_recycle_value(mp, mp_x_part(p)); + set_number_to_zero(mp->cur_x); + } + if (mp_type(mp_y_part(p)) == mp_known_type) { + number_clone(mp->cur_y, mp_get_value_number(mp_y_part(p))); + } else { + mp_disp_err(mp, mp_y_part(p)); + mp_back_error( + mp, + "Undefined y coordinate has been replaced by 0", + "I need a 'known' y value for this part of the path. The value I found (see above)\n" + "was no good; so I'll try to keep going by using zero instead." + ); + mp_get_x_next(mp); + mp_recycle_value(mp, mp_y_part(p)); + set_number_to_zero(mp->cur_y); + } + mp_flush_cur_exp(mp, new_expr); + } +} + +static int mp_scan_direction (MP mp) +{ + int t; + mp_get_x_next(mp); + if (cur_cmd == mp_curl_command) { + mp_get_x_next(mp); + mp_scan_expression(mp); + if ((mp->cur_exp.type != mp_known_type) || (number_negative(cur_exp_value_number))) { + mp_value new_expr; + memset(&new_expr, 0, sizeof(mp_value)); + new_number(new_expr.data.n); + set_number_to_unity(new_expr.data.n); + mp_disp_err(mp, NULL); + mp_back_error( + mp, + "Improper curl has been replaced by 1", + "A curl must be a known, nonnegative number." + ); + mp_get_x_next(mp); + mp_flush_cur_exp(mp, new_expr); + } + t = mp_curl_knot; + } else { + mp_scan_expression(mp); + if (mp->cur_exp.type > mp_pair_type) { + mp_number xx; + new_number(xx); + if (mp->cur_exp.type != mp_known_type) { + mp_value new_expr; + memset(&new_expr, 0, sizeof(mp_value)); + new_number(new_expr.data.n); + mp_disp_err(mp, NULL); + mp_back_error( + mp, + "Undefined x coordinate has been replaced by 0", + "I need a 'known' x value for this part of the path. The value I found (see above)\n" + "was no good; so I'll try to keep going by using zero instead." + ); + mp_get_x_next(mp); + mp_flush_cur_exp(mp, new_expr); + } + number_clone(xx, cur_exp_value_number); + if (cur_cmd != mp_comma_command) { + mp_back_error( + mp, + "Missing ',' has been inserted", + "I've got the x coordinate of a path direction; will look for the y coordinate\n" + "next." + ); + } + mp_get_x_next(mp); + mp_scan_expression(mp); + if (mp->cur_exp.type != mp_known_type) { + mp_value new_expr; + memset(&new_expr, 0, sizeof(mp_value)); + new_number(new_expr.data.n); + mp_disp_err(mp, NULL); + mp_back_error( + mp, + "Undefined y coordinate has been replaced by 0", + "I need a 'known' y value for this part of the path. The value I found (see above)\n" + "was no good; so I'll try to keep going by using zero instead." + ); + mp_get_x_next(mp); + mp_flush_cur_exp(mp, new_expr); + } + number_clone(mp->cur_y, cur_exp_value_number); + number_clone(mp->cur_x, xx); + free_number(xx); + } else { + mp_known_pair(mp); + } + if (number_zero(mp->cur_x) && number_zero(mp->cur_y)) { + t = mp_open_knot; + } else { + mp_number narg; + new_angle(narg); + n_arg(narg, mp->cur_x, mp->cur_y); + t = mp_given_knot; + mp_set_cur_exp_value_number(mp, &narg); + free_number(narg); + } + } + if (cur_cmd != mp_right_brace_command) { + mp_back_error( + mp, + "Missing '}' has been inserted", + "I've scanned a direction spec for part of a path, so a right brace should have\n" + "come next. I shall pretend that one was there." + ); + } + mp_get_x_next(mp); + return t; +} + +static void push_of_path_result (MP mp, int what, mp_knot p) +{ + switch (what) { + case 0: + mp_pair_value(mp, &(p->x_coord), &(p->y_coord)); + break; + case 1: + if (mp_left_type(p) == mp_endpoint_knot) { + mp_pair_value(mp, &(p->x_coord), &(p->y_coord)); + } else { + mp_pair_value(mp, &(p->left_x), &(p->left_y)); + } + break; + case 2: + if (mp_right_type(p) == mp_endpoint_knot) { + mp_pair_value(mp, &(p->x_coord), &(p->y_coord)); + } else { + mp_pair_value(mp, &(p->right_x), &(p->right_y)); + } + break; + case 3: + { + mp_number x, y; + if (mp_right_type(p) == mp_endpoint_knot) { + new_number_clone(x, p->x_coord); + new_number_clone(y, p->y_coord); + } else { + new_number_clone(x, p->right_x); + new_number_clone(y, p->right_y); + } + if (mp_left_type(p) == mp_endpoint_knot) { + number_subtract(x, p->x_coord); + number_subtract(y, p->y_coord); + } else { + number_subtract(x, p->left_x); + number_subtract(y, p->left_y); + } + mp_pair_value(mp, &x, &y); + free_number(x); + free_number(y); + } + break; + } +} + +static void mp_finish_read (MP mp) +{ + mp_str_room(mp, (int) mp->last - (int) start); + for (size_t k = (size_t) start; k < mp->last; k++) { + mp_append_char(mp, mp->buffer[k]); + } + mp_end_file_reading(mp); + mp->cur_exp.type = mp_string_type; + mp_set_cur_exp_str(mp, mp_make_string(mp)); + } +static void mp_do_nullary (MP mp, int c) +{ + check_arith(); + if (number_greater(internal_value(mp_tracing_commands_internal), two_t)) { + mp_show_cmd_mod(mp, mp_nullary_command, c); + } + switch (c) { + case mp_true_operation: + case mp_false_operation: + mp->cur_exp.type = mp_boolean_type; + mp_set_cur_exp_value_boolean(mp, c); + break; + case mp_null_picture_operation: + mp->cur_exp.type = mp_picture_type; + mp_set_cur_exp_node(mp, (mp_node) mp_get_edge_header_node(mp)); + mp_init_edges(mp, (mp_edge_header_node) cur_exp_node); + break; + case mp_null_pen_operation: + mp->cur_exp.type = mp_pen_type; + mp_set_cur_exp_knot(mp, mp_get_pen_circle(mp, &zero_t)); + break; + case mp_normal_deviate_operation: + { + mp_number r; + new_number(r); + m_norm_rand(r); + mp->cur_exp.type = mp_known_type; + mp_set_cur_exp_value_number(mp, &r); + free_number(r); + } + break; + case mp_pen_circle_operation: + mp->cur_exp.type = mp_pen_type; + mp_set_cur_exp_knot(mp, mp_get_pen_circle(mp, &unity_t)); + break; + case mp_version_operation: + mp->cur_exp.type = mp_string_type; + mp_set_cur_exp_str(mp, mp_intern(mp, metapost_version)); + break; + case mp_path_point_operation: + case mp_path_precontrol_operation: + case mp_path_postcontrol_operation: + case mp_path_direction_operation: + if (mp->loop_ptr && mp->loop_ptr->point != NULL) { + push_of_path_result(mp, c - mp_path_point_operation, mp->loop_ptr->point); + } else { + mp_pair_value(mp, &zero_t, &zero_t); + } + break; + } + check_arith(); +} + +static int mp_pict_color_type (MP mp, int c) +{ + return ( + (mp_link(mp_edge_list(cur_exp_node)) != NULL) + && + ( + (! mp_has_color(mp_link(mp_edge_list(cur_exp_node)))) + || + (( + (mp_color_model(mp_link(mp_edge_list(cur_exp_node))) == c) + || + ( + (mp_color_model(mp_link(mp_edge_list(cur_exp_node))) == mp_uninitialized_model) + && + (number_to_scaled(internal_value(mp_default_color_model_internal))/number_to_scaled(unity_t)) == c + ) + )) + ) + ); +} + +static mp_knot mp_simple_knot(MP mp, mp_number *x, mp_number *y) +{ + mp_knot k = mp_new_knot(mp); + mp_left_type(k) = mp_explicit_knot; + mp_right_type(k) = mp_explicit_knot; + mp_originator(k) = mp_program_code; + mp_knotstate(k) = mp_regular_knot; + number_clone(k->x_coord, *x); + number_clone(k->y_coord, *y); + number_clone(k->left_x, *x); + number_clone(k->left_y, *y); + number_clone(k->right_x, *x); + number_clone(k->right_y, *y); + return k; +} + +static mp_knot mp_complex_knot(MP mp, mp_knot o) +{ + mp_knot k = mp_new_knot(mp); + mp_left_type(k) = mp_explicit_knot; + mp_right_type(k) = mp_explicit_knot; + mp_originator(k) = mp_program_code; + mp_knotstate(k) = mp_regular_knot; + number_clone(k->x_coord, o->x_coord); + number_clone(k->y_coord, o->y_coord); + number_clone(k->left_x, o->left_x); + number_clone(k->left_y, o->left_y); + number_clone(k->right_x, o->right_x); + number_clone(k->right_y, o->right_y); + return k; +} + +static int mp_nice_pair (MP mp, mp_node p, int t) +{ + (void) mp; + if (t == mp_pair_type) { + p = mp_get_value_node(p); + if (mp_type(mp_x_part(p)) == mp_known_type && mp_type(mp_y_part(p)) == mp_known_type) + return 1; + } + return 0; +} +static int mp_nice_color_or_pair (MP mp, mp_node p, int t) +{ + mp_node q; + (void) mp; + switch (t) { + case mp_pair_type: + q = mp_get_value_node(p); + if (mp_type(mp_x_part(q)) == mp_known_type + && mp_type(mp_y_part(q)) == mp_known_type) + return 1; + break; + case mp_color_type: + q = mp_get_value_node(p); + if (mp_type(mp_red_part (q)) == mp_known_type + && mp_type(mp_green_part(q)) == mp_known_type + && mp_type(mp_blue_part (q)) == mp_known_type) + return 1; + break; + case mp_cmykcolor_type: + q = mp_get_value_node(p); + if (mp_type(mp_cyan_part (q)) == mp_known_type + && mp_type(mp_magenta_part(q)) == mp_known_type + && mp_type(mp_yellow_part (q)) == mp_known_type + && mp_type(mp_black_part (q)) == mp_known_type) + return 1; + break; + } + return 0; +} +static void mp_print_known_or_unknown_type (MP mp, int t, mp_node v) +{ + mp_print_chr(mp, '('); + if (t > mp_known_type) { + mp_print_str(mp, "unknown numeric"); + } else { + switch (t) { + case mp_pair_type: + case mp_color_type: + case mp_cmykcolor_type: + if (! mp_nice_color_or_pair (mp, v, t)) { + mp_print_str(mp, "unknown "); + } + break; + } + mp_print_type(mp, t); + } + mp_print_chr(mp, ')'); +} +static void mp_bad_unary (MP mp, int c) +{ + char msg[256]; + mp_string sname; + int selector = mp->selector; + mp->selector = mp_new_string_selector; + mp_print_op(mp, c); + mp_print_known_or_unknown_type(mp, mp->cur_exp.type, cur_exp_node); + sname = mp_make_string(mp); + mp->selector = selector; + mp_snprintf(msg, 256, "Not implemented: %s", mp_str(mp, sname)); + delete_str_ref(sname); + mp_disp_err(mp, NULL); + mp_back_error( + mp, + msg, + "I'm afraid I don't know how to apply that operation to that particular type.\n" + "Continue, and I'll simply return the argument (shown above) as the result of the\n" + "operation." + ); + mp_get_x_next(mp); +} +static void mp_negate_dep_list (MP mp, mp_value_node p) +{ + (void) mp; + while (1) { + number_negate(mp_get_dep_value(p)); + if (mp_get_dep_info(p) == NULL) + return; + p = (mp_value_node) mp_link(p); + } +} +static void mp_negate_value(MP mp, mp_node r) +{ + if (mp_type(r) == mp_known_type) { + mp_set_value_number(r, mp_get_value_number(r)); + number_negate(mp_get_value_number(r)); + } else { + mp_negate_dep_list(mp, (mp_value_node) mp_get_dep_list((mp_value_node) r)); + } +} +static void negate_cur_expr (MP mp) +{ + switch (mp->cur_exp.type) { + case mp_color_type: + case mp_cmykcolor_type: + case mp_pair_type: + case mp_independent_type: + { + mp_node q = cur_exp_node; + mp_make_exp_copy(mp, q); + if (mp->cur_exp.type == mp_dependent_type) { + mp_negate_dep_list(mp, (mp_value_node) mp_get_dep_list((mp_value_node) cur_exp_node)); + } else if (mp->cur_exp.type <= mp_pair_type) { + mp_node p = mp_get_value_node(cur_exp_node); + + switch (mp->cur_exp.type) { + case mp_pair_type: + mp_negate_value(mp, mp_x_part(p)); + mp_negate_value(mp, mp_y_part(p)); + break; + case mp_color_type: + mp_negate_value(mp, mp_red_part(p)); + mp_negate_value(mp, mp_green_part(p)); + mp_negate_value(mp, mp_blue_part(p)); + break; + case mp_cmykcolor_type: + mp_negate_value(mp, mp_cyan_part(p)); + mp_negate_value(mp, mp_magenta_part(p)); + mp_negate_value(mp, mp_yellow_part(p)); + mp_negate_value(mp, mp_black_part(p)); + break; + default: + break; + } + } + mp_recycle_value(mp, q); + mp_free_value_node(mp, q); + } + break; + case mp_dependent_type: + case mp_proto_dependent_type: + mp_negate_dep_list(mp, (mp_value_node) mp_get_dep_list((mp_value_node) cur_exp_node)); + break; + case mp_known_type: + if (is_number(cur_exp_value_number)) { + number_negate(cur_exp_value_number); + } + break; + default: + mp_bad_unary(mp, mp_minus_operation); + break; + } +} +static void mp_pair_to_path (MP mp) { + mp_set_cur_exp_knot(mp, mp_pair_to_knot(mp)); + mp->cur_exp.type = mp_path_type; +} +static void mp_take_part (MP mp, int c) +{ + mp_node p = mp_get_value_node(cur_exp_node); + mp_set_value_node(mp->temp_val, p); + mp_type(mp->temp_val) = mp->cur_exp.type; + mp_link(p) = mp->temp_val; + mp_free_value_node(mp, cur_exp_node); + switch (c) { + case mp_x_part_operation: + if (mp->cur_exp.type == mp_pair_type) { + mp_make_exp_copy(mp, mp_x_part(p)); + } else { + mp_make_exp_copy(mp, mp_tx_part(p)); + } + break; + case mp_y_part_operation: + if (mp->cur_exp.type == mp_pair_type) { + mp_make_exp_copy(mp, mp_y_part(p)); + } else { + mp_make_exp_copy(mp, mp_ty_part(p)); + } + break; + case mp_xx_part_operation: + mp_make_exp_copy(mp, mp_xx_part(p)); + break; + case mp_xy_part_operation: + mp_make_exp_copy(mp, mp_xy_part(p)); + break; + case mp_yx_part_operation: + mp_make_exp_copy(mp, mp_yx_part(p)); + break; + case mp_yy_part_operation: + mp_make_exp_copy(mp, mp_yy_part(p)); + break; + case mp_red_part_operation: + mp_make_exp_copy(mp, mp_red_part(p)); + break; + case mp_green_part_operation: + mp_make_exp_copy(mp, mp_green_part(p)); + break; + case mp_blue_part_operation: + mp_make_exp_copy(mp, mp_blue_part(p)); + break; + case mp_cyan_part_operation: + mp_make_exp_copy(mp, mp_cyan_part(p)); + break; + case mp_magenta_part_operation: + mp_make_exp_copy(mp, mp_magenta_part(p)); + break; + case mp_yellow_part_operation: + mp_make_exp_copy(mp, mp_yellow_part(p)); + break; + case mp_black_part_operation: + mp_make_exp_copy(mp, mp_black_part(p)); + break; + case mp_grey_part_operation: + mp_make_exp_copy(mp, mp_grey_part(p)); + break; + } + mp_recycle_value(mp, mp->temp_val); +} +static void mp_take_pict_part (MP mp, int c) +{ + mp_node p; + mp_value new_expr; + memset(&new_expr, 0, sizeof(mp_value)); + new_number(new_expr.data.n); + p = mp_link(mp_edge_list(cur_exp_node)); + if (p != NULL) { + switch (c) { + case mp_x_part_operation: + case mp_y_part_operation: + case mp_xx_part_operation: + case mp_xy_part_operation: + case mp_yx_part_operation: + case mp_yy_part_operation: + goto NOT_FOUND; + case mp_red_part_operation: + case mp_green_part_operation: + case mp_blue_part_operation: + if (mp_has_color(p)) { + switch (c) { + case mp_red_part_operation: + number_clone(new_expr.data.n, ((mp_shape_node) p)->red); + break; + case mp_green_part_operation: + number_clone(new_expr.data.n, ((mp_shape_node) p)->green); + break; + case mp_blue_part_operation: + number_clone(new_expr.data.n, ((mp_shape_node) p)->blue); + break; + } + mp_flush_cur_exp(mp, new_expr); + } else + goto NOT_FOUND; + break; + case mp_cyan_part_operation: + case mp_magenta_part_operation: + case mp_yellow_part_operation: + case mp_black_part_operation: + if (mp_has_color(p)) { + if (mp_color_model(p) == mp_uninitialized_model && c == mp_black_part_operation) { + set_number_to_unity(new_expr.data.n); + } else { + switch (c) { + case mp_cyan_part_operation: + number_clone(new_expr.data.n, ((mp_shape_node) p)->cyan); + break; + case mp_magenta_part_operation: + number_clone(new_expr.data.n, ((mp_shape_node) p)->magenta); + break; + case mp_yellow_part_operation: + number_clone(new_expr.data.n, ((mp_shape_node) p)->yellow); + break; + case mp_black_part_operation: + number_clone(new_expr.data.n, ((mp_shape_node) p)->black); + break; + } + } + mp_flush_cur_exp(mp, new_expr); + } else + goto NOT_FOUND; + break; + case mp_grey_part_operation: + if (mp_has_color(p)) { + number_clone(new_expr.data.n, ((mp_shape_node) p)->grey); + mp_flush_cur_exp(mp, new_expr); + } else + goto NOT_FOUND; + break; + case mp_color_model_operation: + if (mp_has_color(p)) { + if (mp_color_model(p) == mp_uninitialized_model) { + number_clone(new_expr.data.n, internal_value(mp_default_color_model_internal)); + } else { + number_clone(new_expr.data.n, unity_t); + number_multiply_int(new_expr.data.n, mp_color_model(p)); + } + mp_flush_cur_exp(mp, new_expr); + } else + goto NOT_FOUND; + break; + case mp_prescript_part_operation: + if (! mp_has_script(p)) { + goto NOT_FOUND; + } else { + if (mp_pre_script(p)) { + new_expr.data.str = mp_pre_script(p); + add_str_ref(new_expr.data.str); + } else { + new_expr.data.str = mp_rts(mp,""); + } + mp_flush_cur_exp(mp, new_expr); + mp->cur_exp.type = mp_string_type; + }; + break; + case mp_postscript_part_operation: + if (! mp_has_script(p)) { + goto NOT_FOUND; + } else { + if (mp_post_script(p)) { + new_expr.data.str = mp_post_script(p); + add_str_ref(new_expr.data.str); + } else { + new_expr.data.str = mp_rts(mp,""); + } + mp_flush_cur_exp(mp, new_expr); + mp->cur_exp.type = mp_string_type; + }; + break; + case mp_stacking_part_operation: + number_clone(new_expr.data.n, unity_t); + number_multiply_int(new_expr.data.n, mp_stacking(p)); + mp_flush_cur_exp(mp, new_expr); + break; + case mp_path_part_operation: + if (mp_is_stop(p)) { + mp_confusion(mp, "picture"); + } else { + new_expr.data.node = NULL; + switch (mp_type(p)) { + case mp_fill_node_type: + case mp_stroked_node_type: + new_expr.data.p = mp_copy_path(mp, mp_path_ptr((mp_shape_node) p)); + break; + case mp_start_clip_node_type: + case mp_start_group_node_type: + case mp_start_bounds_node_type: + new_expr.data.p = mp_copy_path(mp, mp_path_ptr((mp_start_node) p)); + break; + default: + break; + } + mp_flush_cur_exp(mp, new_expr); + mp->cur_exp.type = mp_path_type; + } + break; + case mp_pen_part_operation: + if (! mp_has_pen(p)) { + goto NOT_FOUND; + } else { + switch (mp_type(p)) { + case mp_fill_node_type: + case mp_stroked_node_type: + if (mp_pen_ptr((mp_shape_node) p) == NULL) { + goto NOT_FOUND; + } else { + new_expr.data.p = mp_copy_pen(mp, mp_pen_ptr((mp_shape_node) p)); + mp_flush_cur_exp(mp, new_expr); + mp->cur_exp.type = mp_pen_type((mp_shape_node) p) ? mp_nep_type : mp_pen_type ; + } + break; + default: + break; + } + } + break; + case mp_dash_part_operation: + if (mp_type(p) != mp_stroked_node_type) { + goto NOT_FOUND; + } else if (mp_dash_ptr(p) == NULL) { + goto NOT_FOUND; + } else { + mp_add_edge_ref(mp, mp_dash_ptr(p)); + new_expr.data.node = (mp_node) mp_scale_edges(mp, + &(((mp_shape_node) p)->dashscale), (mp_edge_header_node) mp_dash_ptr(p)); + mp_flush_cur_exp(mp, new_expr); + mp->cur_exp.type = mp_picture_type; + } + break; + } + return; + }; + NOT_FOUND: + switch (c) { + case mp_prescript_part_operation: + case mp_postscript_part_operation: + new_expr.data.str = mp_rts(mp,""); + mp_flush_cur_exp(mp, new_expr); + mp->cur_exp.type = mp_string_type; + break; + case mp_path_part_operation: + new_expr.data.p = mp_new_knot(mp); + mp_flush_cur_exp(mp, new_expr); + mp_left_type(cur_exp_knot) = mp_endpoint_knot; + mp_right_type(cur_exp_knot) = mp_endpoint_knot; + mp_prev_knot(cur_exp_knot) = cur_exp_knot; + mp_next_knot(cur_exp_knot) = cur_exp_knot; + set_number_to_zero(cur_exp_knot->x_coord); + set_number_to_zero(cur_exp_knot->y_coord); + mp_originator(cur_exp_knot) = mp_metapost_user; + mp_knotstate(cur_exp_knot) = mp_regular_knot; + mp->cur_exp.type = mp_path_type; + break; + case mp_pen_part_operation: + new_expr.data.p = mp_get_pen_circle(mp, &zero_t); + mp_flush_cur_exp(mp, new_expr); + mp->cur_exp.type = mp_pen_type; + break; + case mp_dash_part_operation: + new_expr.data.node = (mp_node) mp_get_edge_header_node(mp); + mp_flush_cur_exp(mp, new_expr); + mp_init_edges(mp, (mp_edge_header_node) cur_exp_node); + mp->cur_exp.type = mp_picture_type; + break; + default: + set_number_to_zero(new_expr.data.n); + mp_flush_cur_exp(mp, new_expr); + break; + } +} +static void mp_str_to_num (MP mp) +{ + int n; + mp_value new_expr; + memset(&new_expr, 0, sizeof(mp_value)); + new_number(new_expr.data.n); + if (cur_exp_str->len == 0) { + n = -1; + } else { + n = cur_exp_str->str[0]; + } + number_clone(new_expr.data.n, unity_t); + number_multiply_int(new_expr.data.n, n); + mp_flush_cur_exp(mp, new_expr); +} +static void mp_path_length (MP mp, mp_number *n) +{ + mp_knot p = cur_exp_knot; + int l = mp_left_type(p) == mp_endpoint_knot ? -1 : 0; + do { + p = mp_next_knot(p); + ++l; + } while (p != cur_exp_knot); + set_number_from_int(*n, l); +} +static void mp_picture_length (MP mp, mp_number *n) +{ + mp_node p = mp_link(mp_edge_list(cur_exp_node)); + int l = 0; + if (p != NULL) { + if (mp_is_start_or_stop(p) && mp_skip_1component(mp, p) == NULL) { + p = mp_link(p); + } + while (p != NULL) { + if (! mp_is_start_or_stop(p)) { + p = mp_link(p); + } else if (! mp_is_stop(p)) { + p = mp_skip_1component(mp, p); + } else { + break; + } + ++l; + } + } + set_number_from_int(*n, l); +} +static void mp_an_angle (MP mp, mp_number *ret, mp_number *xpar, mp_number *ypar) +{ + set_number_to_zero(*ret); + if (! (number_zero(*xpar) && number_zero(*ypar))) { + n_arg(*ret, *xpar, *ypar); + } +} +static void mp_bezier_slope (MP mp, + mp_number *ret, mp_number *AX, mp_number *AY, mp_number *BX, + mp_number *BY, mp_number *CX, mp_number *CY, mp_number *DX, + mp_number *DY +); +static void mp_turn_cycles (MP mp, mp_number *turns, mp_knot c) +{ + int selector; + mp_angle res, ang; + mp_knot p; + mp_number xp, yp; + mp_number x, y; + mp_number arg1, arg2; + mp_angle in_angle, out_angle; + mp_angle seven_twenty_deg_t; + set_number_to_zero(*turns); + new_number(arg1); + new_number(arg2); + new_number(xp); + new_number(yp); + new_number(x); + new_number(y); + new_angle(in_angle); + new_angle(out_angle); + new_angle(ang); + new_angle(res); + new_angle(seven_twenty_deg_t); + number_clone(seven_twenty_deg_t, three_sixty_deg_t); + number_double(seven_twenty_deg_t); + p = c; + selector = mp->selector; + mp->selector = mp_term_only_selector; + if (number_greater(internal_value(mp_tracing_commands_internal), unity_t)) { + mp_begin_diagnostic(mp); + mp_print_nl(mp, ""); + mp_end_diagnostic(mp, 0); + } + do { + number_clone(xp, p_next->x_coord); + number_clone(yp, p_next->y_coord); + mp_bezier_slope(mp, &ang, &(p->x_coord), &(p->y_coord), &(p->right_x), &(p->right_y), &(p_next->left_x), &(p_next->left_y), &xp, &yp); + if (number_greater(ang, seven_twenty_deg_t)) { + mp_error(mp, "Strange path", NULL); + mp->selector = selector; + set_number_to_zero(*turns); + goto DONE; + } + number_add(res, ang); + if (number_greater(res, one_eighty_deg_t)) { + number_subtract(res, three_sixty_deg_t); + number_add(*turns, unity_t); + } + if (number_lessequal(res, negative_one_eighty_deg_t)) { + number_add(res, three_sixty_deg_t); + number_subtract(*turns, unity_t); + } + number_clone(x, p_next->left_x); + number_clone(y, p_next->left_y); + if (number_equal(xp, x) && number_equal(yp, y)) { + number_clone(x, p->right_x); + number_clone(y, p->right_y); + } + if (number_equal(xp, x) && number_equal(yp, y)) { + number_clone(x, p->x_coord); + number_clone(y, p->y_coord); + } + set_number_from_subtraction(arg1, xp, x); + set_number_from_subtraction(arg2, yp, y); + mp_an_angle(mp, &in_angle, &arg1, &arg2); + number_clone(x, p_next->right_x); + number_clone(y, p_next->right_y); + if (number_equal(xp, x) && number_equal(yp, y)) { + number_clone(x, p_nextnext->left_x); + number_clone(y, p_nextnext->left_y); + } + if (number_equal(xp, x) && number_equal(yp, y)) { + number_clone(x, p_nextnext->x_coord); + number_clone(y, p_nextnext->y_coord); + } + set_number_from_subtraction(arg1, x, xp); + set_number_from_subtraction(arg2, y, yp); + mp_an_angle(mp, &out_angle, &arg1, &arg2); + set_number_from_subtraction(ang, out_angle, in_angle); + mp_reduce_angle(mp, &ang); + if (number_nonzero(ang)) { + number_add(res, ang); + if (number_greaterequal(res, one_eighty_deg_t)) { + number_subtract(res, three_sixty_deg_t); + number_add(*turns, unity_t); + } + if (number_lessequal(res, negative_one_eighty_deg_t)) { + number_add(res, three_sixty_deg_t); + number_subtract(*turns, unity_t); + } + } + p = mp_next_knot(p); + } while (p != c); + mp->selector = selector; + DONE: + free_number(xp); + free_number(yp); + free_number(x); + free_number(y); + free_number(seven_twenty_deg_t); + free_number(in_angle); + free_number(out_angle); + free_number(ang); + free_number(res); + free_number(arg1); + free_number(arg2); +} +static void mp_turn_cycles_wrapper (MP mp, mp_number *ret, mp_knot c) +{ + if (mp_next_knot(c) == c) { + set_number_to_unity(*ret); + } else { + mp_turn_cycles (mp, ret, c); + } +} +static int mp_test_known (MP mp, int c) +{ + int b = mp_false_operation; + switch (mp->cur_exp.type) { + case mp_vacuous_type: + case mp_boolean_type: + case mp_string_type: + case mp_pen_type: + case mp_nep_type: + case mp_path_type: + case mp_picture_type: + case mp_known_type: + b = mp_true_operation; + break; + case mp_transform_type: + { + mp_node p = mp_get_value_node(cur_exp_node); + if ( (mp_type(mp_tx_part(p)) == mp_known_type) && + (mp_type(mp_ty_part(p)) == mp_known_type) && + (mp_type(mp_xx_part(p)) == mp_known_type) && + (mp_type(mp_xy_part(p)) == mp_known_type) && + (mp_type(mp_yx_part(p)) == mp_known_type) && + (mp_type(mp_yy_part(p)) == mp_known_type) ) { + b = mp_true_operation; + } + } + break; + case mp_color_type: + { + mp_node p = mp_get_value_node(cur_exp_node); + if ( (mp_type(mp_red_part(p)) == mp_known_type) && + (mp_type(mp_green_part(p)) == mp_known_type) && + (mp_type(mp_blue_part(p)) == mp_known_type) ) { + b = mp_true_operation; + } + } + break; + case mp_cmykcolor_type: + { + mp_node p = mp_get_value_node(cur_exp_node); + if ( (mp_type(mp_cyan_part(p)) == mp_known_type) && + (mp_type(mp_magenta_part(p)) == mp_known_type) && + (mp_type(mp_yellow_part(p)) == mp_known_type) && + (mp_type(mp_black_part(p)) == mp_known_type) ) { + b = mp_true_operation; + } + } + break; + case mp_pair_type: + { + mp_node p = mp_get_value_node(cur_exp_node); + if ( (mp_type(mp_x_part(p)) == mp_known_type) && + (mp_type(mp_y_part(p)) == mp_known_type) ) { + b = mp_true_operation; + } + } + break; + default: + break; + } + if (c == mp_known_operation) { + return b; + } else { + return b == mp_true_operation ? mp_false_operation : mp_true_operation; + } +} +static void mp_pair_value (MP mp, mp_number *x, mp_number *y) +{ + mp_node p; + mp_value new_expr; + mp_number x1, y1; + new_number_clone(x1, *x); + new_number_clone(y1, *y); + memset(&new_expr, 0, sizeof(mp_value)); + new_number(new_expr.data.n); + p = mp_new_value_node(mp); + new_expr.type = mp_type(p); + new_expr.data.node = p; + mp_flush_cur_exp(mp, new_expr); + mp->cur_exp.type = mp_pair_type; + mp_name_type(p) = mp_capsule_operation; + mp_init_pair_node(mp, p); + p = mp_get_value_node(p); + mp_type(mp_x_part(p)) = mp_known_type; + mp_set_value_number(mp_x_part(p), x1); + mp_type(mp_y_part(p)) = mp_known_type; + mp_set_value_number(mp_y_part(p), y1); + free_number(x1); + free_number(y1); +} +static int mp_get_cur_bbox (MP mp) +{ + switch (mp->cur_exp.type) { + case mp_picture_type: + { + mp_edge_header_node p = (mp_edge_header_node) cur_exp_node; + mp_set_bbox(mp, p, 1); + if (number_greater(p->minx, p->maxx)) { + set_number_to_zero(mp_minx); + set_number_to_zero(mp_maxx); + set_number_to_zero(mp_miny); + set_number_to_zero(mp_maxy); + } else { + number_clone(mp_minx, p->minx); + number_clone(mp_maxx, p->maxx); + number_clone(mp_miny, p->miny); + number_clone(mp_maxy, p->maxy); + } + } + break; + case mp_path_type: + mp_path_bbox(mp, cur_exp_knot); + break; + case mp_pen_type: + case mp_nep_type: + mp_pen_bbox(mp, cur_exp_knot); + break; + default: + return 0; + } + return 1; +} +static int mp_get_cur_xbox (MP mp) +{ + if (mp->cur_exp.type == mp_path_type) { + mp_path_xbox(mp, cur_exp_knot); + return 1; + } else { + return mp_get_cur_bbox(mp); + } +} +static int mp_get_cur_ybox (MP mp) +{ + if (mp->cur_exp.type == mp_path_type) { + mp_path_ybox(mp, cur_exp_knot); + return 1; + } else { + return mp_get_cur_bbox(mp); + } +} +static void mp_do_read_or_close (MP mp, int c) +{ + int n = mp->read_files; + int n0 = mp->read_files; + char *fn = mp_strdup(mp_str(mp, cur_exp_str)); + mp_value new_expr; + memset(&new_expr, 0, sizeof(mp_value)); + new_number(new_expr.data.n); + while (mp_strcmp(fn, mp->rd_fname[n]) != 0) { + if (n > 0) { + --n; + } else if (c == mp_close_from_operation) { + goto CLOSE_FILE; + } else { + if (n0 == mp->read_files) { + if (mp->read_files < mp->max_read_files) { + ++mp->read_files; + } else { + void **rd_file; + char **rd_fname; + int l; + l = mp->max_read_files + (mp->max_read_files / 4); + rd_file = mp_memory_allocate((size_t) (l + 1) * sizeof(void *)); + rd_fname = mp_memory_allocate((size_t) (l + 1) * sizeof(char *)); + for (int k = 0; k <= l; k++) { + if (k <= mp->max_read_files) { + rd_file[k] = mp->rd_file[k]; + rd_fname[k] = mp->rd_fname[k]; + } else { + rd_file[k] = 0; + rd_fname[k] = NULL; + } + } + mp_memory_free(mp->rd_file); + mp_memory_free(mp->rd_fname); + mp->max_read_files = l; + mp->rd_file = rd_file; + mp->rd_fname = rd_fname; + } + } + n = n0; + if (mp_start_read_input(mp, fn, n)) { + goto FOUND; + } else { + goto NOT_FOUND; + } + } + if (mp->rd_fname[n] == NULL) { + n0 = n; + } + } + if (c == mp_close_from_operation) { + (mp->close_file) (mp, mp->rd_file[n]); + goto NOT_FOUND; + } + mp_begin_file_reading(mp); + name = is_read; + if (mp_input_ln(mp, mp->rd_file[n])) { + goto FOUND; + } + mp_end_file_reading(mp); + NOT_FOUND: + mp_memory_free(mp->rd_fname[n]); + mp->rd_fname[n] = NULL; + if (n == mp->read_files - 1) { + mp->read_files = n; + } + if (c == mp_close_from_operation) { + goto CLOSE_FILE; + } + new_expr.data.str = mp->eof_file; + add_str_ref(new_expr.data.str); + mp_flush_cur_exp(mp, new_expr); + mp->cur_exp.type = mp_string_type; + return; + CLOSE_FILE: + mp_flush_cur_exp(mp, new_expr); + mp->cur_exp.type = mp_vacuous_type; + return; + FOUND: + mp_flush_cur_exp(mp, new_expr); + mp_finish_read(mp); +} + + +static void mp_do_unary (MP mp, int c) +{ + check_arith(); + if (number_greater(internal_value(mp_tracing_commands_internal), two_t)) { + mp_begin_diagnostic(mp); + mp_print_nl(mp, "{"); + mp_print_op(mp, c); + mp_print_chr(mp, '('); + mp_print_exp(mp, NULL, 0); + mp_print_str(mp, ")}"); + mp_end_diagnostic(mp, 0); + } + switch (c) { + case mp_plus_operation: + if (mp->cur_exp.type < mp_color_type) { + mp_bad_unary(mp, mp_plus_operation); + } + break; + case mp_minus_operation: + negate_cur_expr(mp); + break; + case mp_not_operation: + if (mp->cur_exp.type != mp_boolean_type) { + mp_bad_unary(mp, mp_not_operation); + } else { + mp_set_cur_exp_value_boolean(mp, (cur_exp_value_boolean == mp_true_operation) ? mp_false_operation : mp_true_operation); + } + break; + case mp_sqrt_operation: + if (mp->cur_exp.type != mp_known_type) { + mp_bad_unary(mp, c); + } else { + mp_number n; + new_number(n); + square_rt(n, cur_exp_value_number); + mp_set_cur_exp_value_number(mp, &n); + free_number(n); + } + break; + case mp_m_exp_operation: + if (mp->cur_exp.type != mp_known_type) { + mp_bad_unary(mp, c); + } else { + mp_number n; + new_number(n); + m_exp(n, cur_exp_value_number); + mp_set_cur_exp_value_number(mp, &n); + free_number(n); + } + break; + case mp_m_log_operation: + if (mp->cur_exp.type != mp_known_type) { + mp_bad_unary(mp, c); + } else { + mp_number n; + new_number(n); + m_log(n, cur_exp_value_number); + mp_set_cur_exp_value_number(mp, &n); + free_number(n); + } + break; + case mp_sin_d_operation: + case mp_cos_d_operation: + if (mp->cur_exp.type != mp_known_type) { + mp_bad_unary(mp, c); + } else { + mp_number n_sin, n_cos, arg1, arg2; + new_number(arg1); + new_number(arg2); + new_fraction(n_sin); + new_fraction(n_cos); + number_clone(arg1, cur_exp_value_number); + number_clone(arg2, unity_t); + number_multiply_int(arg2, 360); + number_modulo(arg1, arg2); + convert_scaled_to_angle(arg1); + n_sin_cos(arg1, n_cos, n_sin); + if (c == mp_sin_d_operation) { + fraction_to_round_scaled(n_sin); + mp_set_cur_exp_value_number(mp, &n_sin); + } else { + fraction_to_round_scaled(n_cos); + mp_set_cur_exp_value_number(mp, &n_cos); + } + free_number(arg1); + free_number(arg2); + free_number(n_sin); + free_number(n_cos); + } + break; + case mp_floor_operation: + if (mp->cur_exp.type != mp_known_type) { + mp_bad_unary(mp, c); + } else { + mp_number n; + new_number(n); + number_clone(n, cur_exp_value_number); + floor_scaled(n); + mp_set_cur_exp_value_number(mp, &n); + free_number(n); + } + break; + case mp_uniform_deviate_operation: + if (mp->cur_exp.type != mp_known_type) { + mp_bad_unary(mp, c); + } else { + mp_number n; + new_number(n); + m_unif_rand(n, cur_exp_value_number); + mp_set_cur_exp_value_number(mp, &n); + free_number(n); + } + break; + case mp_odd_operation: + if (mp->cur_exp.type != mp_known_type) { + mp_bad_unary(mp, c); + } else { + mp_set_cur_exp_value_boolean(mp, number_odd(cur_exp_value_number) ? mp_true_operation : mp_false_operation); + mp->cur_exp.type = mp_boolean_type; + } + break; + case mp_angle_operation: + if (mp_nice_pair (mp, cur_exp_node, mp->cur_exp.type)) { + mp_value expr; + mp_node p; + mp_number narg; + memset(&expr, 0, sizeof(mp_value)); + new_number(expr.data.n); + new_angle(narg); + p = mp_get_value_node(cur_exp_node); + n_arg(narg, mp_get_value_number(mp_x_part(p)), mp_get_value_number(mp_y_part(p))); + number_clone(expr.data.n, narg); + convert_angle_to_scaled(expr.data.n); + free_number(narg); + mp_flush_cur_exp(mp, expr); + } else { + mp_bad_unary(mp, mp_angle_operation); + } + break; + case mp_x_part_operation: + case mp_y_part_operation: + switch (mp->cur_exp.type) { + case mp_pair_type: + case mp_transform_type: + mp_take_part(mp, c); + break; + case mp_picture_type: + mp_take_pict_part(mp, c); + break; + default: + mp_bad_unary(mp, c); + break; + } + break; + case mp_xx_part_operation: + case mp_xy_part_operation: + case mp_yx_part_operation: + case mp_yy_part_operation: + switch (mp->cur_exp.type) { + case mp_transform_type: + mp_take_part(mp, c); + break; + case mp_picture_type: + mp_take_pict_part(mp, c); + break; + default: + mp_bad_unary(mp, c); + break; + } + break; + case mp_red_part_operation: + case mp_green_part_operation: + case mp_blue_part_operation: + switch (mp->cur_exp.type) { + case mp_color_type: + mp_take_part(mp, c); + break; + case mp_picture_type: + if (mp_pict_color_type(mp, mp_rgb_model)) { + mp_take_pict_part(mp, c); + } else { + mp_bad_color_part(mp, c); + } + break; + default: + mp_bad_unary(mp, c); + break; + } + break; + case mp_cyan_part_operation: + case mp_magenta_part_operation: + case mp_yellow_part_operation: + case mp_black_part_operation: + switch (mp->cur_exp.type) { + case mp_cmykcolor_type: + mp_take_part(mp, c); + break; + case mp_picture_type: + if (mp_pict_color_type(mp, mp_cmyk_model)) { + mp_take_pict_part(mp, c); + } else { + mp_bad_color_part(mp, c); + } + break; + default: + mp_bad_unary(mp, c); + break; + } + break; + case mp_grey_part_operation: + switch (mp->cur_exp.type) { + case mp_known_type: + break; + case mp_picture_type: + if (mp_pict_color_type(mp, mp_grey_model)) { + mp_take_pict_part(mp, c); + } else { + mp_bad_color_part(mp, c); + } + break; + default: + mp_bad_unary(mp, c); + break; + } + break; + case mp_color_model_operation: + case mp_path_part_operation: + case mp_pen_part_operation: + case mp_dash_part_operation: + case mp_prescript_part_operation: + case mp_postscript_part_operation: + case mp_stacking_part_operation: + if (mp->cur_exp.type == mp_picture_type) { + mp_take_pict_part(mp, c); + } else { + mp_bad_unary(mp, c); + } + break; + case mp_char_operation: + if (mp->cur_exp.type != mp_known_type) { + mp_bad_unary(mp, mp_char_operation); + } else { + int n = round_unscaled(cur_exp_value_number) % 256; + unsigned char s[2]; + mp_set_cur_exp_value_scaled(mp, n); + mp->cur_exp.type = mp_string_type; + if (number_negative(cur_exp_value_number)) { + n = number_to_scaled(cur_exp_value_number) + 256; + mp_set_cur_exp_value_scaled(mp, n); + } + s[0] = (unsigned char) number_to_scaled(cur_exp_value_number); + s[1] = '\0'; + mp_set_cur_exp_str(mp, mp_rtsl (mp, (char *) s, 1)); + } + break; + case mp_decimal_operation: + if (mp->cur_exp.type != mp_known_type) { + mp_bad_unary(mp, mp_decimal_operation); + } else { + int selector = mp->selector; + mp->selector = mp_new_string_selector; + print_number(cur_exp_value_number); + mp_set_cur_exp_str(mp, mp_make_string(mp)); + mp->selector = selector; + mp->cur_exp.type = mp_string_type; + } + break; + case mp_oct_operation: + case mp_hex_operation: + case mp_ASCII_operation: + if (mp->cur_exp.type != mp_string_type) { + mp_bad_unary(mp, c); + } else { + mp_str_to_num(mp); + } + break; + case mp_length_operation: + switch (mp->cur_exp.type) { + case mp_string_type: + { + mp_value expr; + memset(&expr, 0, sizeof(mp_value)); + new_number(expr.data.n); + number_clone(expr.data.n, unity_t); + number_multiply_int(expr.data.n, (int) cur_exp_str->len); + mp_flush_cur_exp(mp, expr); + break; + } + case mp_path_type: + { + mp_value expr; + memset(&expr, 0, sizeof(mp_value)); + new_number(expr.data.n); + mp_path_length(mp, &expr.data.n); + mp_flush_cur_exp(mp, expr); + break; + } + case mp_known_type: + { + mp_set_cur_exp_value_number(mp, &cur_exp_value_number); + number_abs(cur_exp_value_number); + break; + } + case mp_picture_type: + { + mp_value expr; + memset(&expr, 0, sizeof(mp_value)); + new_number(expr.data.n); + mp_picture_length(mp, &expr.data.n); + mp_flush_cur_exp(mp, expr); + break; + } + default: + if (mp_nice_pair (mp, cur_exp_node, mp->cur_exp.type)) { + mp_value expr; + memset(&expr, 0, sizeof(mp_value)); + new_number(expr.data.n); + pyth_add(expr.data.n, + mp_get_value_number(mp_x_part(mp_get_value_node(cur_exp_node))), + mp_get_value_number(mp_y_part(mp_get_value_node(cur_exp_node))) + ); + mp_flush_cur_exp(mp, expr); + } else { + mp_bad_unary(mp, c); + } + break; + } + break; + case mp_turning_operation: + if (mp->cur_exp.type == mp_pair_type) { + mp_value expr; + memset(&expr, 0, sizeof(mp_value)); + new_number(expr.data.n); + mp_flush_cur_exp(mp, expr); + } else if (mp->cur_exp.type != mp_path_type) { + mp_bad_unary(mp, mp_turning_operation); + } else if (mp_left_type(cur_exp_knot) == mp_endpoint_knot) { + mp_value expr; + memset(&expr, 0, sizeof(mp_value)); + new_number(expr.data.n); + expr.data.p = NULL; + mp_flush_cur_exp(mp, expr); + } else { + mp_value expr; + memset(&expr, 0, sizeof(mp_value)); + new_number(expr.data.n); + mp_turn_cycles_wrapper(mp, &expr.data.n, cur_exp_knot); + mp_flush_cur_exp(mp, expr); + } + break; + + case mp_boolean_type_operation: + case mp_string_type_operation: + case mp_pen_type_operation: + case mp_nep_type_operation: + case mp_path_type_operation: + case mp_picture_type_operation: + { + mp_value expr; + int type = (c - mp_boolean_type_operation) * 2 + mp_boolean_type ; + memset(&expr, 0, sizeof(mp_value)); + new_number(expr.data.n); + set_number_from_boolean(expr.data.n, (mp->cur_exp.type == type || mp->cur_exp.type == (type + 1)) ? mp_true_operation : mp_false_operation); + mp_flush_cur_exp(mp, expr); + mp->cur_exp.type = mp_boolean_type; + break; + } + case mp_transform_type_operation: + case mp_color_type_operation: + case mp_cmykcolor_type_operation: + case mp_pair_type_operation: + { + mp_value expr; + int type = (c - mp_transform_type_operation) + mp_transform_type; + memset(&expr, 0, sizeof(mp_value)); + new_number(expr.data.n); + set_number_from_boolean(expr.data.n, mp->cur_exp.type == type ? mp_true_operation : mp_false_operation); + mp_flush_cur_exp(mp, expr); + mp->cur_exp.type = mp_boolean_type; + break; + } + case mp_numeric_type_operation: + { + mp_value expr; + memset(&expr, 0, sizeof(mp_value)); + new_number(expr.data.n); + set_number_from_boolean(expr.data.n, (mp->cur_exp.type >= mp_known_type && mp->cur_exp.type <= mp_independent_type) ? mp_true_operation : mp_false_operation); + mp_flush_cur_exp(mp, expr); + mp->cur_exp.type = mp_boolean_type; + break; + } + case mp_known_operation: + case mp_unknown_operation: + { + mp_value expr; + memset(&expr, 0, sizeof(mp_value)); + new_number(expr.data.n); + set_number_from_boolean(expr.data.n, mp_test_known(mp, c)); + mp_flush_cur_exp(mp, expr); + cur_exp_node = NULL; + mp->cur_exp.type = mp_boolean_type; + break; + } + case mp_cycle_operation: + case mp_no_cycle_operation: + { + mp_value expr; + int b = 0; + memset(&expr, 0, sizeof(mp_value)); + new_number(expr.data.n); + if (mp->cur_exp.type != mp_path_type) { + b = (c == mp_cycle_operation) ? mp_false_operation : mp_true_operation; + } else if (mp_left_type(cur_exp_knot) != mp_endpoint_knot) { + b = (c == mp_cycle_operation) ? mp_true_operation : mp_false_operation; + } else { + b = (c == mp_cycle_operation) ? mp_false_operation : mp_true_operation; + } + set_number_from_boolean(expr.data.n, b); + mp_flush_cur_exp(mp, expr); + mp->cur_exp.type = mp_boolean_type; + break; + } + case mp_arc_length_operation: + if (mp->cur_exp.type == mp_pair_type) { + mp_pair_to_path(mp); + } + if (mp->cur_exp.type != mp_path_type) { + mp_bad_unary(mp, mp_arc_length_operation); + } else { + mp_value expr; + memset(&expr, 0, sizeof(mp_value)); + new_number(expr.data.n); + mp_get_arc_length(mp, &expr.data.n, cur_exp_knot); + mp_flush_cur_exp(mp, expr); + } + break; + case mp_filled_operation: + case mp_stroked_operation: + case mp_clipped_operation: + case mp_grouped_operation: + case mp_bounded_operation: + { + mp_value expr; + memset(&expr, 0, sizeof(mp_value)); + new_number(expr.data.n); + if (mp->cur_exp.type != mp_picture_type) { + set_number_from_boolean(expr.data.n, mp_false_operation); + } else if (mp_link(mp_edge_list(cur_exp_node)) == NULL) { + set_number_from_boolean(expr.data.n, mp_false_operation); + } else { + int type = c - mp_filled_operation + mp_fill_node_type; + set_number_from_boolean(expr.data.n, mp_type(mp_link(mp_edge_list(cur_exp_node))) == type ? mp_true_operation: mp_false_operation); + } + mp_flush_cur_exp(mp, expr); + mp->cur_exp.type = mp_boolean_type; + break; + } + case mp_make_pen_operation: + if (mp->cur_exp.type == mp_pair_type) { + mp_pair_to_path(mp); + } + if (mp->cur_exp.type != mp_path_type) { + mp_bad_unary(mp, mp_make_pen_operation); + } else { + mp->cur_exp.type = mp_pen_type; + mp_set_cur_exp_knot(mp, mp_make_pen(mp, cur_exp_knot, 1)); + } + break; + case mp_make_nep_operation: + if (mp->cur_exp.type == mp_pair_type) { + mp_pair_to_path(mp); + } + if (mp->cur_exp.type != mp_path_type) { + mp_bad_unary(mp, c); + } else { + mp->cur_exp.type = mp_nep_type; + mp_set_cur_exp_knot(mp, cur_exp_knot); + } + break; + case mp_convexed_operation: + if (mp->cur_exp.type != mp_path_type) { + mp_bad_unary(mp, mp_convexed_operation); + } else { + mp->cur_exp.type = mp_path_type; + mp_set_cur_exp_knot(mp, mp_convex_hull(mp, cur_exp_knot)); + mp_simplify_path(mp, cur_exp_knot); + } + break; + case mp_uncontrolled_operation: + if (mp->cur_exp.type != mp_path_type) { + mp_bad_unary(mp, mp_uncontrolled_operation); + } else { + mp->cur_exp.type = mp_path_type; + mp_simplify_path(mp, cur_exp_knot); + } + break; + case mp_make_path_operation: + if (mp->cur_exp.type != mp_pen_type && mp->cur_exp.type != mp_nep_type) { + mp_bad_unary(mp, mp_make_path_operation); + } else { + mp->cur_exp.type = mp_path_type; + mp_make_path(mp, cur_exp_knot); + } + break; + case mp_reverse_operation: + switch (mp->cur_exp.type) { + case mp_path_type: + { + mp_knot pk = mp_htap_ypoc(mp, cur_exp_knot); + if (mp_right_type(pk) == mp_endpoint_knot) { + pk = mp_next_knot(pk); + } + mp_toss_knot_list(mp, cur_exp_knot); + mp_set_cur_exp_knot(mp, pk); + } + break; + case mp_pair_type: + mp_pair_to_path(mp); + break; + default: + mp_bad_unary(mp, mp_reverse_operation); + break; + } + break; + case mp_uncycle_operation: + switch (mp->cur_exp.type) { + case mp_path_type: + mp_right_type(mp_prev_knot(cur_exp_knot)) = mp_endpoint_knot; + mp_left_type(cur_exp_knot) = mp_endpoint_knot; + break; + case mp_pair_type: + mp_pair_to_path(mp); + break; + default: + mp_bad_unary(mp, mp_uncycle_operation); + break; + } + break; + case mp_ll_corner_operation: + if (mp_get_cur_bbox(mp)) { + mp_pair_value(mp, &mp_minx, &mp_miny); + } else { + mp_bad_unary(mp, mp_ll_corner_operation); + } + break; + case mp_lr_corner_operation: + if (mp_get_cur_bbox(mp)) { + mp_pair_value(mp, &mp_maxx, &mp_miny); + } else { + mp_bad_unary(mp, mp_lr_corner_operation); + } + break; + case mp_ul_corner_operation: + if (mp_get_cur_bbox(mp)) { + mp_pair_value(mp, &mp_minx, &mp_maxy); + } else { + mp_bad_unary(mp, mp_ul_corner_operation); + } + break; + case mp_ur_corner_operation: + if (! mp_get_cur_bbox(mp)) { + mp_bad_unary(mp, mp_ur_corner_operation); + } else { + mp_pair_value(mp, &mp_maxx, &mp_maxy); + } + break; + case mp_center_of_operation: + if (mp->cur_exp.type == mp_pair_type) { + } else if (mp_get_cur_bbox(mp)) { + mp_number x, y; + new_number(x); + new_number(y); + set_number_half_from_subtraction(x, mp_maxx, mp_minx); + set_number_half_from_subtraction(y, mp_maxy, mp_miny); + number_add(x, mp_minx); + number_add(y, mp_miny); + mp_pair_value(mp, &x, &y); + } else { + mp_bad_unary(mp, mp_center_of_operation); + } + break; + case mp_center_of_mass_operation: + if (mp->cur_exp.type == mp_pair_type) { + } else if (mp->cur_exp.type == mp_path_type) { + mp_knot p = cur_exp_knot; + int l = 0; + mp_number x, y; + new_number(x); + new_number(y); + do { + ++l; + p = mp_next_knot(p); + number_add(x, p->x_coord); + number_add(y, p->y_coord); + } while (p != cur_exp_knot); + number_divide_int(x, l); + number_divide_int(y, l); + mp_pair_value(mp, &x, &y); + free_number(x); + free_number(y); + } else { + mp_bad_unary(mp, mp_center_of_mass_operation); + } + break; + case mp_corners_operation: + if (! mp_get_cur_bbox(mp)) { + mp_bad_unary(mp, mp_corners_operation); + } else { + mp_knot ll = mp_simple_knot(mp, &mp_minx, &mp_miny); + mp_knot lr = mp_simple_knot(mp, &mp_maxx, &mp_miny); + mp_knot ur = mp_simple_knot(mp, &mp_maxx, &mp_maxy); + mp_knot ul = mp_simple_knot(mp, &mp_minx, &mp_maxy); + mp_prev_knot(lr) = ll; + mp_next_knot(ll) = lr; + mp_prev_knot(ur) = lr; + mp_next_knot(lr) = ur; + mp_prev_knot(ul) = ur; + mp_next_knot(ur) = ul; + mp_prev_knot(ll) = ul; + mp_next_knot(ul) = ll; + mp->cur_exp.type = mp_path_type; + mp_set_cur_exp_knot(mp, ll); + } + break; + case mp_x_range_operation: + if (mp_get_cur_xbox(mp)) { + mp_pair_value(mp, &mp_minx, &mp_maxx); + } else { + mp_bad_unary(mp, mp_x_range_operation); + } + break; + case mp_y_range_operation: + if (mp_get_cur_ybox(mp)) { + mp_pair_value(mp, &mp_miny, &mp_maxy); + } else { + mp_bad_unary(mp, mp_y_range_operation); + } + break; + case mp_delta_point_operation: + case mp_delta_precontrol_operation: + case mp_delta_postcontrol_operation: + case mp_delta_direction_operation: + if (mp->cur_exp.type == mp_known_type) { + mp_set_cur_exp_value_number(mp, &cur_exp_value_number); + if (mp->loop_ptr && mp->loop_ptr->point != NULL) { + mp_knot p = mp->loop_ptr->point; + int n = round_unscaled(cur_exp_value_number); + if (n > 0) { + while (n--) { + p = mp_next_knot(p); + } + } else if (n < 0) { + while (n++) { + p = mp_prev_knot(p); + } + } + push_of_path_result(mp, c - mp_delta_point_operation, p); + } + } else { + mp_bad_unary(mp, c); + } + break; + case mp_read_from_operation: + case mp_close_from_operation: + if (mp->cur_exp.type != mp_string_type) { + mp_bad_unary(mp, c); + } else { + mp_do_read_or_close(mp, c); + } + break; + } + check_arith(); +} + +static void mp_bad_color_part (MP mp, int c) +{ + mp_node p; + mp_value new_expr; + char msg[256]; + int selector; + mp_string sname; + memset(&new_expr, 0, sizeof(mp_value)); + new_number(new_expr.data.n); + p = mp_link(mp_edge_list(cur_exp_node)); + mp_disp_err(mp, NULL); + selector = mp->selector; + mp->selector = mp_new_string_selector; + mp_print_op(mp, c); + sname = mp_make_string(mp); + mp->selector = selector; + switch (mp_color_model(p)) { + case mp_grey_model: mp_snprintf(msg, 256, "Wrong picture color model: %s of grey object", mp_str(mp, sname)); break; + case mp_cmyk_model: mp_snprintf(msg, 256, "Wrong picture color model: %s of cmyk object", mp_str(mp, sname)); break; + case mp_rgb_model: mp_snprintf(msg, 256, "Wrong picture color model: %s of rgb object", mp_str(mp, sname)); break; + case mp_no_model: mp_snprintf(msg, 256, "Wrong picture color model: %s of marking object", mp_str(mp, sname)); break; + default: mp_snprintf(msg, 256, "Wrong picture color model: %s of defaulted object", mp_str(mp, sname)); break; + } + delete_str_ref(sname); + mp_error( + mp, + msg, + "You can only ask for the redpart, greenpart, bluepart of a rgb object, the\n" + "cyanpart, magentapart, yellowpart or blackpart of a cmyk object, or the greypart\n" + "of a grey object. No mixing and matching, please." + ); + if (c == mp_black_part_operation) { + number_clone(new_expr.data.n, unity_t); + } else { + set_number_to_zero(new_expr.data.n); + } + mp_flush_cur_exp(mp, new_expr); +} + +static void mp_bezier_slope (MP mp, + mp_number *ret, mp_number *AX, mp_number *AY, mp_number *BX, + mp_number *BY, mp_number *CX, mp_number *CY, mp_number *DX, + mp_number *DY +) +{ + double a, b, c; + mp_number deltax, deltay; + mp_number xi, xo, xm; + double res = 0.0; + double ax = number_to_double(*AX); + double ay = number_to_double(*AY); + double bx = number_to_double(*BX); + double by = number_to_double(*BY); + double cx = number_to_double(*CX); + double cy = number_to_double(*CY); + double dx = number_to_double(*DX); + double dy = number_to_double(*DY); + new_number(deltax); + new_number(deltay); + set_number_from_subtraction(deltax, *BX, *AX); + set_number_from_subtraction(deltay, *BY, *AY); + if (number_zero(deltax) && number_zero(deltay)) { + set_number_from_subtraction(deltax, *CX, *AX); + set_number_from_subtraction(deltay, *CY, *AY); + } + if (number_zero(deltax) && number_zero(deltay)) { + set_number_from_subtraction(deltax, *DX, *AX); + set_number_from_subtraction(deltay, *DY, *AY); + } + new_number(xi); + new_number(xm); + new_number(xo); + mp_an_angle(mp, &xi, &deltax, &deltay); + set_number_from_subtraction(deltax, *CX, *BX); + set_number_from_subtraction(deltay, *CY, *BY); + mp_an_angle(mp, &xm, &deltax, &deltay); + set_number_from_subtraction(deltax, *DX, *CX); + set_number_from_subtraction(deltay, *DY, *CY); + if (number_zero(deltax) && number_zero(deltay)) { + set_number_from_subtraction(deltax, *DX, *BX); + set_number_from_subtraction(deltay, *DY, *BY); + } + if (number_zero(deltax) && number_zero(deltay)) { + set_number_from_subtraction(deltax, *DX, *AX); + set_number_from_subtraction(deltay, *DY, *AY); + } + mp_an_angle(mp, &xo, &deltax, &deltay); + a = (bx - ax) * (cy - by) - (cx - bx) * (by - ay); + b = (bx - ax) * (dy - cy) - (by - ay) * (dx - cx); + c = (cx - bx) * (dy - cy) - (dx - cx) * (cy - by); + if ((a == 0.0) && (c == 0.0)) { + res = (b == 0.0 ? 0.0 : (mp_out(number_to_double(xo)) - mp_out(number_to_double(xi)))); + } else if ((a == 0.0) || (c == 0.0)) { + if ((mp_sign (b) == mp_sign (a)) || (mp_sign (b) == mp_sign (c))) { + res = mp_out(number_to_double(xo)) - mp_out(number_to_double(xi)); + if (res < -180.0) { + res += 360.0; + } else if (res > 180.0) { + res -= 360.0; + } + } else { + res = mp_out(number_to_double(xo)) - mp_out(number_to_double(xi)); + } + } else if ((mp_sign (a) * mp_sign (c)) < 0.0) { + res = mp_out(number_to_double(xo)) - mp_out(number_to_double(xi)); + if (res < -180.0) { + res += 360.0; + } else if (res > 180.0) { + res -= 360.0; + } + } else if (mp_sign (a) == mp_sign (b)) { + res = mp_out(number_to_double(xo)) - mp_out(number_to_double(xi)); + if (res < -180.0) { + res += 360.0; + } else if (res > 180.0) { + res -= 360.0; + } + } else if ((b * b) == (4.0 * a * c)) { + res = (double) bezier_error; + } else if ((b * b) < (4.0 * a * c)) { + res = mp_out(number_to_double(xo)) - mp_out(number_to_double(xi)); + if (res <= 0.0 && res > -180.0) { + res += 360.0; + } else if (res >= 0.0 && res < 180.0) { + res -= 360.0; + } + } else { + res = mp_out(number_to_double(xo)) - mp_out(number_to_double(xi)); + if (res < -180.0) { + res += 360.0; + } else if (res > 180.0) { + res -= 360.0; + } + } + free_number(deltax); + free_number(deltay); + free_number(xi); + free_number(xo); + free_number(xm); + set_number_from_double(*ret, res); + convert_scaled_to_angle(*ret); +} + +static void mp_bad_binary (MP mp, mp_node p, int c) +{ + char msg[256]; + mp_string sname; + int selector = mp->selector; + mp->selector = mp_new_string_selector; + if (c >= mp_min_of_operation) { + mp_print_op(mp, c); + } + mp_print_known_or_unknown_type(mp, mp_type(p), p); + if (c >= mp_min_of_operation) { + mp_print_str(mp, "of"); + } else { + mp_print_op(mp, c); + } + mp_print_known_or_unknown_type(mp, mp->cur_exp.type, cur_exp_node); + sname = mp_make_string(mp); + mp->selector = selector; + mp_snprintf(msg, 256, "Not implemented: %s", mp_str(mp, sname)); + delete_str_ref(sname); + mp_disp_err(mp, p); + mp_disp_err(mp, NULL); + mp_back_error( + mp, + msg, + "I'm afraid I don't know how to apply that operation to that combination of types.\n" + "Continue, and I'll return the second argument (see above) as the result of the" + "operation." + ); + mp_get_x_next(mp); +} +static void mp_bad_envelope_pen (MP mp) +{ + mp_disp_err(mp, NULL); + mp_disp_err(mp, NULL); + mp_back_error( + mp, + "Not implemented: 'envelope(elliptical pen) of (path)'", + "I'm afraid I don't know how to apply that operation to that combination of types.\n" + "Continue, and I'll return the second argument (see above) as the result of the\n" + "operation." + ); + mp_get_x_next(mp); +} +static mp_node mp_tarnished (MP mp, mp_node p) +{ + mp_node q = mp_get_value_node(p); + (void) mp; + switch (mp_type(p)) { + case mp_pair_type: + return ( + (mp_type(mp_x_part(q)) == mp_independent_type) || + (mp_type(mp_y_part(q)) == mp_independent_type) + ) ? MP_VOID : NULL; + case mp_color_type: + return ( + (mp_type(mp_red_part(q)) == mp_independent_type) || + (mp_type(mp_green_part(q)) == mp_independent_type) || + (mp_type(mp_blue_part(q)) == mp_independent_type) + ) ? MP_VOID : NULL; + case mp_cmykcolor_type: + return ( + (mp_type(mp_cyan_part(q)) == mp_independent_type) || + (mp_type(mp_magenta_part(q)) == mp_independent_type) || + (mp_type(mp_yellow_part(q)) == mp_independent_type) || + (mp_type(mp_black_part(q)) == mp_independent_type) + ) ? MP_VOID : NULL; + case mp_transform_type: + return ( + (mp_type(mp_tx_part(q)) == mp_independent_type) || + (mp_type(mp_ty_part(q)) == mp_independent_type) || + (mp_type(mp_xx_part(q)) == mp_independent_type) || + (mp_type(mp_xy_part(q)) == mp_independent_type) || + (mp_type(mp_yx_part(q)) == mp_independent_type) || + (mp_type(mp_yy_part(q)) == mp_independent_type) + ) ? MP_VOID : NULL; + default: + return NULL; + } +} +static void mp_dep_finish (MP mp, mp_value_node v, mp_value_node q, int t) +{ + mp_value_node p = (q == NULL) ? (mp_value_node) cur_exp_node : q; + mp_set_dep_list(p, v); + mp_type(p) = t; + if (mp_get_dep_info(v) == NULL) { + mp_number vv; + new_number_clone(vv, mp_get_value_number(v)); + if (q == NULL) { + mp_value new_expr; + memset(&new_expr, 0, sizeof(mp_value)); + new_number_clone(new_expr.data.n, vv); + mp_flush_cur_exp(mp, new_expr); + } else { + mp_recycle_value(mp, (mp_node) p); + mp_type(q) = mp_known_type; + mp_set_value_number(q, vv); + } + free_number(vv); + } else if (q == NULL) { + mp->cur_exp.type = t; + } + if (mp->fix_needed) { + mp_fix_dependencies(mp); + } +} + +static void mp_add_or_subtract (MP mp, mp_node p, mp_node q, int c) +{ + mp_variable_type s, t; + mp_value_node r; + mp_value_node v = NULL; + mp_number vv; + new_number(vv); + if (q == NULL) { + t = mp->cur_exp.type; + if (t < mp_dependent_type) { + number_clone(vv, cur_exp_value_number); + } else { + v = (mp_value_node) mp_get_dep_list((mp_value_node) cur_exp_node); + } + } else { + t = mp_type(q); + if (t < mp_dependent_type) { + number_clone(vv, mp_get_value_number(q)); + } else { + v = (mp_value_node) mp_get_dep_list((mp_value_node) q); + } + } + if (t == mp_known_type) { + mp_value_node qq = (mp_value_node) q; + if (c == mp_minus_operation) { + number_negate(vv); + } + if (mp_type(p) == mp_known_type) { + slow_add(vv, mp_get_value_number(p), vv); + if (q == NULL) { + mp_set_cur_exp_value_number(mp, &vv); + } else { + mp_set_value_number(q, vv); + } + free_number(vv); + return; + } else { + r = (mp_value_node) mp_get_dep_list((mp_value_node) p); + while (mp_get_dep_info(r) != NULL) { + r = (mp_value_node) mp_link(r); + } + slow_add(vv, mp_get_dep_value(r), vv); + mp_set_dep_value(r, vv); + if (qq == NULL) { + qq = mp_get_dep_node(mp); + mp_set_cur_exp_node(mp, (mp_node) qq); + mp->cur_exp.type = mp_type(p); + mp_name_type(qq) = mp_capsule_operation; + } + mp_set_dep_list(qq, mp_get_dep_list((mp_value_node) p)); + mp_type(qq) = mp_type(p); + mp_set_prev_dep(qq, mp_get_prev_dep((mp_value_node) p)); + mp_link(mp_get_prev_dep((mp_value_node) p)) = (mp_node) qq; + mp_type(p) = mp_known_type; + } + } else { + if (c == mp_minus_operation) { + mp_negate_dep_list(mp, v); + } + if (mp_type(p) == mp_known_type) { + while (mp_get_dep_info(v) != NULL) { + v = (mp_value_node) mp_link(v); + } + slow_add(vv, mp_get_value_number(p), mp_get_dep_value(v)); + mp_set_dep_value(v, vv); + } else { + s = mp_type(p); + r = (mp_value_node) mp_get_dep_list((mp_value_node) p); + if (t == mp_dependent_type) { + if (s == mp_dependent_type) { + int b; + mp_number ret1, ret2; + new_fraction(ret1); + new_fraction(ret2); + mp_max_coef(mp, &ret1, r); + mp_max_coef(mp, &ret2, v); + number_add(ret1, ret2); + b = number_less(ret1, coef_bound_k); + free_number(ret1); + free_number(ret2); + if (b) { + v = mp_p_plus_q(mp, v, r, mp_dependent_type); + goto DONE; + } + } + t = mp_proto_dependent_type; + v = mp_p_over_v(mp, v, &unity_t, mp_dependent_type, mp_proto_dependent_type); + } + if (s == mp_proto_dependent_type) { + v = mp_p_plus_q(mp, v, r, mp_proto_dependent_type); + } else { + v = mp_p_plus_fq(mp, v, &unity_t, r, mp_proto_dependent_type, mp_dependent_type); + } + DONE: + if (q != NULL) { + mp_dep_finish(mp, v, (mp_value_node) q, t); + } else { + mp->cur_exp.type = t; + mp_dep_finish(mp, v, NULL, t); + } + } + } + free_number(vv); +} +static void mp_dep_mult (MP mp, mp_value_node p, mp_number *v, int v_is_scaled) +{ + mp_value_node q; + int s, t; + if (p == NULL) { + q = (mp_value_node) cur_exp_node; + } else if (mp_type(p) != mp_known_type) { + q = p; + } else { + mp_number r1, arg1; + new_number_clone(arg1, mp_get_dep_value(p)); + if (v_is_scaled) { + new_number(r1); + take_scaled(r1, arg1, *v); + } else { + new_fraction(r1); + take_fraction(r1, arg1, *v); + } + mp_set_dep_value(p, r1); + free_number(r1); + free_number(arg1); + return; + } + t = mp_type(q); + q = (mp_value_node) mp_get_dep_list(q); + s = t; + if (t == mp_dependent_type && v_is_scaled) { + mp_number arg1, arg2; + new_fraction(arg1); + mp_max_coef(mp, &arg1, q); + new_number_abs(arg2, *v); + if (ab_vs_cd(arg1, arg2, coef_bound_minus_1, unity_t) >= 0) { + t = mp_proto_dependent_type; + } + free_number(arg1); + free_number(arg2); + } + q = mp_p_times_v(mp, q, v, s, t, v_is_scaled); + mp_dep_finish(mp, q, p, t); +} +static void mp_hard_times (MP mp, mp_node p) +{ + mp_value_node q; + mp_value_node pp; + mp_number v; + new_number(v); + if (mp_type(p) <= mp_pair_type) { + q = (mp_value_node) mp_stash_cur_exp(mp); + mp_unstash_cur_exp(mp, p); + p = (mp_node) q; + } + pp = (mp_value_node) p; + switch (mp->cur_exp.type) { + case mp_pair_type: + { + mp_node r = mp_x_part(mp_get_value_node(cur_exp_node)); + number_clone(v, mp_get_value_number(r)); + mp_new_dep(mp, r, mp_type(pp), mp_copy_dep_list(mp, (mp_value_node) mp_get_dep_list(pp))); + mp_dep_mult(mp, (mp_value_node) r, &v, 1); + r = mp_y_part(mp_get_value_node(cur_exp_node)); + number_clone(v, mp_get_value_number(r)); + mp_new_dep(mp, r, mp_type(pp), mp_copy_dep_list(mp, (mp_value_node) mp_get_dep_list(pp))); + mp_dep_mult(mp, (mp_value_node) r, &v, 1); + } + break; + case mp_color_type: + { + mp_node r = mp_red_part(mp_get_value_node(cur_exp_node)); + number_clone(v, mp_get_value_number(r)); + mp_new_dep(mp, r, mp_type(pp), mp_copy_dep_list(mp, (mp_value_node) mp_get_dep_list(pp))); + mp_dep_mult(mp, (mp_value_node) r, &v, 1); + r = mp_green_part(mp_get_value_node(cur_exp_node)); + number_clone(v, mp_get_value_number(r)); + mp_new_dep(mp, r, mp_type(pp), mp_copy_dep_list(mp, (mp_value_node) mp_get_dep_list(pp))); + mp_dep_mult(mp, (mp_value_node) r, &v, 1); + r = mp_blue_part(mp_get_value_node(cur_exp_node)); + number_clone(v, mp_get_value_number(r)); + mp_new_dep(mp, r, mp_type(pp), mp_copy_dep_list(mp, (mp_value_node) mp_get_dep_list(pp))); + mp_dep_mult(mp, (mp_value_node) r, &v, 1); + } + break; + case mp_cmykcolor_type: + { + mp_node r = mp_cyan_part(mp_get_value_node(cur_exp_node)); + number_clone(v, mp_get_value_number(r)); + mp_new_dep(mp, r, mp_type(pp), mp_copy_dep_list(mp, (mp_value_node) mp_get_dep_list(pp))); + mp_dep_mult(mp, (mp_value_node) r, &v, 1); + r = mp_yellow_part(mp_get_value_node(cur_exp_node)); + number_clone(v, mp_get_value_number(r)); + mp_new_dep(mp, r, mp_type(pp), mp_copy_dep_list(mp, (mp_value_node) mp_get_dep_list(pp))); + mp_dep_mult(mp, (mp_value_node) r, &v, 1); + r = mp_magenta_part(mp_get_value_node(cur_exp_node)); + number_clone(v, mp_get_value_number(r)); + mp_new_dep(mp, r, mp_type(pp), mp_copy_dep_list(mp, (mp_value_node) mp_get_dep_list(pp))); + mp_dep_mult(mp, (mp_value_node) r, &v, 1); + r = mp_black_part(mp_get_value_node(cur_exp_node)); + number_clone(v, mp_get_value_number(r)); + mp_new_dep(mp, r, mp_type(pp), mp_copy_dep_list(mp, (mp_value_node) mp_get_dep_list(pp))); + mp_dep_mult(mp, (mp_value_node) r, &v, 1); + } + break; + default: + break; + } + free_number(v); +} +static void mp_dep_div (MP mp, mp_value_node p, mp_number *v) +{ + mp_value_node q; + int s, t; + if (p == NULL) { + q = (mp_value_node) cur_exp_node; + } else if (mp_type(p) != mp_known_type) { + q = p; + } else { + mp_number ret; + new_number(ret); + make_scaled(ret, mp_get_value_number(p), *v); + mp_set_value_number(p, ret); + free_number(ret); + return; + } + t = mp_type(q); + q = (mp_value_node) mp_get_dep_list(q); + s = t; + if (t == mp_dependent_type) { + mp_number arg1, arg2; + new_number(arg2); + new_fraction(arg1); + mp_max_coef(mp, &arg1, q); + number_abs_clone(arg2, *v); + if (ab_vs_cd(arg1, unity_t, coef_bound_minus_1, arg2) >= 0) { + t = mp_proto_dependent_type; + } + free_number(arg1); + free_number(arg2); + } + q = mp_p_over_v(mp, q, v, s, t); + mp_dep_finish(mp, q, p, t); +} +static void mp_set_up_trans (MP mp, int c) +{ + mp_node p, q, r; + mp_value new_expr; + memset(&new_expr, 0, sizeof(mp_value)); + if ((c != mp_transformed_operation) || (mp->cur_exp.type != mp_transform_type)) { + p = mp_stash_cur_exp(mp); + mp_set_cur_exp_node(mp, mp_id_transform(mp)); + mp->cur_exp.type = mp_transform_type; + q = mp_get_value_node(cur_exp_node); + switch (c) { + case mp_rotated_operation: + if (mp_type(p) == mp_known_type) { + mp_number n_sin, n_cos, arg1, arg2; + new_fraction(n_sin); + new_fraction(n_cos); + new_number_clone(arg2, unity_t); + new_number_clone(arg1, mp_get_value_number(p)); + number_multiply_int(arg2, 360); + number_modulo(arg1, arg2); + convert_scaled_to_angle(arg1); + n_sin_cos(arg1, n_cos, n_sin); + fraction_to_round_scaled(n_sin); + fraction_to_round_scaled(n_cos); + mp_set_value_number(mp_xx_part(q), n_cos); + mp_set_value_number(mp_yx_part(q), n_sin); + mp_set_value_number(mp_xy_part(q), mp_get_value_number(mp_yx_part(q))); + number_negate(mp_get_value_number(mp_xy_part(q))); + mp_set_value_number(mp_yy_part(q), mp_get_value_number(mp_xx_part(q))); + free_number(arg1); + free_number(arg2); + free_number(n_sin); + free_number(n_cos); + goto DONE; + } + break; + case mp_slanted_operation: + if (mp_type(p) > mp_pair_type) { + mp_install(mp, mp_xy_part(q), p); + goto DONE; + } + break; + case mp_scaled_operation: + if (mp_type(p) > mp_pair_type) { + mp_install(mp, mp_xx_part(q), p); + mp_install(mp, mp_yy_part(q), p); + goto DONE; + } + break; + case mp_shifted_operation: + if (mp_type(p) == mp_pair_type) { + r = mp_get_value_node(p); + mp_install(mp, mp_tx_part(q), mp_x_part(r)); + mp_install(mp, mp_ty_part(q), mp_y_part(r)); + goto DONE; + } + break; + case mp_x_scaled_operation: + if (mp_type(p) > mp_pair_type) { + mp_install(mp, mp_xx_part(q), p); + goto DONE; + } + break; + case mp_y_scaled_operation: + if (mp_type(p) > mp_pair_type) { + mp_install(mp, mp_yy_part(q), p); + goto DONE; + } + break; + case mp_z_scaled_operation: + if (mp_type(p) == mp_pair_type) { + { + r = mp_get_value_node(p); + mp_install(mp, mp_xx_part(q), mp_x_part(r)); + mp_install(mp, mp_yy_part(q), mp_x_part(r)); + mp_install(mp, mp_yx_part(q), mp_y_part(r)); + if (mp_type(mp_y_part(r)) == mp_known_type) { + mp_set_value_number(mp_y_part(r), mp_get_value_number(mp_y_part(r))); + number_negate(mp_get_value_number(mp_y_part(r))); + } else { + mp_negate_dep_list(mp, (mp_value_node) mp_get_dep_list((mp_value_node) mp_y_part(r))); + } + mp_install(mp, mp_xy_part(q), mp_y_part(r)); + goto DONE; + } + } + break; + case mp_transformed_operation: + break; + } + mp_disp_err(mp, p); + mp_back_error( + mp, + "Improper transformation argument", + "The expression shown above has the wrong type, so I can't transform anything\n" + "using it. Proceed, and I'll omit the transformation." + ); + mp_get_x_next(mp); + DONE: + mp_recycle_value(mp, p); + mp_free_value_node(mp, p); + } + q = mp_get_value_node(cur_exp_node); + if ( (mp_type(mp_tx_part(q)) == mp_known_type) && + (mp_type(mp_ty_part(q)) == mp_known_type) && + (mp_type(mp_xx_part(q)) == mp_known_type) && + (mp_type(mp_xy_part(q)) == mp_known_type) && + (mp_type(mp_yx_part(q)) == mp_known_type) && + (mp_type(mp_yy_part(q)) == mp_known_type) ) { + number_clone(mp->txx, mp_get_value_number(mp_xx_part(q))); + number_clone(mp->txy, mp_get_value_number(mp_xy_part(q))); + number_clone(mp->tyx, mp_get_value_number(mp_yx_part(q))); + number_clone(mp->tyy, mp_get_value_number(mp_yy_part(q))); + number_clone(mp->tx, mp_get_value_number(mp_tx_part(q))); + number_clone(mp->ty, mp_get_value_number(mp_ty_part(q))); + new_number(new_expr.data.n); + mp_flush_cur_exp(mp, new_expr); + } +} +static void mp_set_up_known_trans (MP mp, int c) +{ + mp_set_up_trans(mp, c); + if (mp->cur_exp.type != mp_known_type) { + mp_value new_expr; + memset(&new_expr, 0, sizeof(mp_value)); + new_number(new_expr.data.n); + mp_disp_err(mp, NULL); + mp_back_error( + mp, + "Transform components aren't all known", + "I'm unable to apply a partially specified transformation except to a fully known\n" + "pair or transform. Proceed, and I'll omit the transformation." + ); + mp_get_x_next(mp); + mp_flush_cur_exp(mp, new_expr); + set_number_to_unity(mp->txx); + set_number_to_zero(mp->txy); + set_number_to_zero(mp->tyx); + set_number_to_unity(mp->tyy); + set_number_to_zero(mp->tx); + set_number_to_zero(mp->ty); + } +} +static void mp_number_trans (MP mp, mp_number *p, mp_number *q) +{ + mp_number r1, r2, v; + new_number(r1); + new_number(r2); + new_number(v); + take_scaled(r1, *p, mp->txx); + take_scaled(r2, *q, mp->txy); + number_add(r1, r2); + set_number_from_addition(v, r1, mp->tx); + take_scaled(r1, *p, mp->tyx); + take_scaled(r2, *q, mp->tyy); + number_add(r1, r2); + set_number_from_addition(*q, r1, mp->ty); + number_clone(*p,v); + free_number(r1); + free_number(r2); + free_number(v); +} +static void mp_do_path_trans (MP mp, mp_knot p) +{ + mp_knot q = p; + do { + if (mp_left_type(q) != mp_endpoint_knot) { + mp_number_trans(mp, &q->left_x, &q->left_y); + } + mp_number_trans(mp, &q->x_coord, &q->y_coord); + if (mp_right_type(q) != mp_endpoint_knot) { + mp_number_trans(mp, &q->right_x, &q->right_y); + } + q = mp_next_knot(q); + } while (q != p); +} +static void mp_do_pen_trans (MP mp, mp_knot p) +{ + mp_knot q = p; + if (mp_pen_is_elliptical(p)) { + mp_number_trans(mp, &p->left_x, &p->left_y); + mp_number_trans(mp, &p->right_x, &p->right_y); + } + do { + mp_number_trans(mp, &q->x_coord, &q->y_coord); + q = mp_next_knot(q); + } while (q != p); +} +static void mp_do_path_pen_trans (MP mp, mp_shape_node p, mp_number *sqdet, int sgndet) +{ + mp_number sx, sy; + if (mp_pen_ptr(p) != NULL) { + new_number_clone(sx, mp->tx); + new_number_clone(sy, mp->ty); + set_number_to_zero(mp->tx); + set_number_to_zero(mp->ty); + mp_do_pen_trans(mp, mp_pen_ptr(p)); + if (number_nonzero(*sqdet) && ((mp_type(p) == mp_stroked_node_type) && (mp_dash_ptr(p) != NULL))) { + mp_number ret; + new_number(ret); + take_scaled(ret, ((mp_shape_node) p)->dashscale, *sqdet); + number_clone(((mp_shape_node) p)->dashscale, ret); + free_number(ret); + } + if (! mp_pen_is_elliptical(mp_pen_ptr(p)) && sgndet < 0) { + mp_pen_ptr(p) = mp_make_pen(mp, mp_copy_path(mp, mp_pen_ptr(p)), 1); + } + number_clone(mp->tx, sx); + number_clone(mp->ty, sy); + free_number(sx); + free_number(sy); + } +} +static mp_edge_header_node mp_edges_trans (MP mp, mp_edge_header_node h) +{ + mp_node q; + mp_dash_node r, s; + mp_number sqdet; + int sgndet; + h = mp_private_edges(mp, h); + new_number(sqdet); + mp_sqrt_det(mp, &sqdet, &(mp->txx), &(mp->txy), &(mp->tyx), &(mp->tyy)); + sgndet = ab_vs_cd(mp->txx, mp->tyy, mp->txy, mp->tyx); + if (mp_get_dash_list(h) != mp->null_dash) { + if (number_nonzero(mp->txy) || number_nonzero(mp->tyx) || number_nonzero(mp->ty) || number_nonequalabs(mp->txx, mp->tyy)) { + mp_flush_dash_list(mp, h); + } else { + mp_number abs_tyy, ret; + new_number(abs_tyy); + if (number_negative(mp->txx)) { + { + r = mp_get_dash_list(h); + mp_set_dash_list(h, mp->null_dash); + while (r != mp->null_dash) { + s = r; + r = (mp_dash_node) mp_link(r); + number_swap(s->start_x, s->stop_x ); + mp_link(s) = (mp_node) mp_get_dash_list(h); + mp_set_dash_list(h, s); + } + } + } + r = mp_get_dash_list(h); + { + mp_number arg1; + new_number(arg1); + while (r != mp->null_dash) { + take_scaled(arg1, r->start_x, mp->txx); + set_number_from_addition(r->start_x, arg1, mp->tx); + take_scaled(arg1, r->stop_x, mp->txx); + set_number_from_addition(r->stop_x, arg1, mp->tx); + r = (mp_dash_node) mp_link(r); + } + free_number(arg1); + } + number_abs_clone(abs_tyy, mp->tyy); + new_number(ret); + take_scaled(ret, h->dash_y, abs_tyy); + number_clone(h->dash_y, ret); + free_number(ret); + free_number(abs_tyy); + } + } + if (number_zero(mp->txx) && number_zero(mp->tyy)) { + number_swap(h->minx, h->miny); + number_swap(h->maxx, h->maxy); + } else if (number_nonzero(mp->txy) || number_nonzero(mp->tyx)) { + mp_init_bbox(mp, h); + goto DONE1; + } + if (number_lessequal(h->minx, h->maxx)) { + mp_number tot, ret; + new_number(tot); + new_number(ret); + set_number_from_addition(tot,mp->txx,mp->txy); + take_scaled(ret, h->minx, tot); + set_number_from_addition(h->minx,ret, mp->tx); + take_scaled(ret, h->maxx, tot); + set_number_from_addition(h->maxx,ret, mp->tx); + set_number_from_addition(tot,mp->tyx,mp->tyy); + take_scaled(ret, h->miny, tot); + set_number_from_addition(h->miny, ret, mp->ty); + take_scaled(ret, h->maxy, tot); + set_number_from_addition(h->maxy, ret, mp->ty); + set_number_from_addition(tot, mp->txx, mp->txy); + if (number_negative(tot)) { + number_swap(h->minx, h->maxx); + } + set_number_from_addition(tot, mp->tyx, mp->tyy); + if (number_negative(tot)) { + number_swap(h->miny, h->maxy); + } + free_number(ret); + free_number(tot); + } + DONE1: + q = mp_link(mp_edge_list(h)); + while (q != NULL) { + switch (mp_type(q)) { + case mp_fill_node_type: + case mp_stroked_node_type: + mp_do_path_trans(mp, mp_path_ptr((mp_shape_node) q)); + mp_do_path_pen_trans(mp, (mp_shape_node) q, &sqdet, sgndet); + break; + case mp_start_clip_node_type: + case mp_start_group_node_type: + case mp_start_bounds_node_type: + mp_do_path_trans(mp, mp_path_ptr((mp_start_node) q)); + break; + case mp_stop_clip_node_type: + case mp_stop_group_node_type: + case mp_stop_bounds_node_type: + break; + default: + break; + } + q = mp_link(q); + } + free_number(sqdet); + return h; +} +static void mp_do_edges_trans (MP mp, mp_node p, int c) +{ + mp_set_up_known_trans (mp, c); + mp_set_value_node(p, (mp_node) mp_edges_trans(mp, (mp_edge_header_node) mp_get_value_node(p))); + mp_unstash_cur_exp(mp, p); +} +static mp_edge_header_node mp_scale_edges (MP mp, mp_number *se_sf, mp_edge_header_node se_pic) +{ + number_clone(mp->txx, *se_sf); + number_clone(mp->tyy, *se_sf); + set_number_to_zero(mp->txy); + set_number_to_zero(mp->tyx); + set_number_to_zero(mp->tx); + set_number_to_zero(mp->ty); + return mp_edges_trans(mp, se_pic); +} +static void mp_bilin1 (MP mp, mp_node p, mp_number *t, mp_node q, mp_number *u, mp_number *delta_orig) +{ + mp_number delta; + new_number_clone(delta, *delta_orig); + if (! number_equal(*t, unity_t)) { + mp_dep_mult(mp, (mp_value_node) p, t, 1); + } + if (number_nonzero(*u)) { + if (mp_type(q) == mp_known_type) { + mp_number tmp; + new_number(tmp); + take_scaled(tmp, mp_get_value_number(q), *u); + number_add(delta, tmp); + free_number(tmp); + } else { + if (mp_type(p) != mp_proto_dependent_type) { + if (mp_type(p) == mp_known_type) { + mp_new_dep(mp, p, mp_type(p), mp_const_dependency(mp, &(mp_get_value_number(p)))); + } else { + mp_set_dep_list((mp_value_node) p, + mp_p_times_v(mp, + (mp_value_node) mp_get_dep_list((mp_value_node) p), &unity_t, + mp_dependent_type, mp_proto_dependent_type, 1)); + } + mp_type(p) = mp_proto_dependent_type; + } + mp_set_dep_list((mp_value_node) p, + mp_p_plus_fq(mp, + (mp_value_node) mp_get_dep_list((mp_value_node) p), u, + (mp_value_node) mp_get_dep_list((mp_value_node) q), + mp_proto_dependent_type, mp_type(q))); + } + } + if (mp_type(p) == mp_known_type) { + mp_set_value_number(p, mp_get_value_number(p)); + number_add(mp_get_value_number(p), delta); + } else { + mp_number tmp; + mp_value_node r = (mp_value_node) mp_get_dep_list((mp_value_node) p); + while (mp_get_dep_info(r) != NULL) { + r = (mp_value_node) mp_link(r); + } + new_number_clone(tmp, mp_get_value_number(r)); + number_add(delta, tmp); + + if (r != (mp_value_node) mp_get_dep_list((mp_value_node) p)) { + mp_set_value_number(r, delta); + } else { + mp_recycle_value(mp, p); + mp_type(p) = mp_known_type; + mp_set_value_number(p, delta); + } + free_number(tmp); + } + if (mp->fix_needed) { + mp_fix_dependencies(mp); + } + free_number(delta); +} +static void mp_add_mult_dep (MP mp, mp_value_node p, mp_number *v, mp_node r) +{ + if (mp_type(r) == mp_known_type) { + mp_number ret; + new_number(ret); + take_scaled(ret, mp_get_value_number(r), *v); + mp_set_dep_value(mp->dep_final, mp_get_dep_value(mp->dep_final)); + number_add(mp_get_dep_value(mp->dep_final), ret); + free_number(ret); + } else { + mp_set_dep_list(p, mp_p_plus_fq(mp, (mp_value_node) mp_get_dep_list(p), v, (mp_value_node) mp_get_dep_list((mp_value_node) r), mp_proto_dependent_type, mp_type(r))); + if (mp->fix_needed) { + mp_fix_dependencies(mp); + } + } +} +static void mp_bilin2 (MP mp, mp_node p, mp_node t, mp_number *v, mp_node u, mp_node q) +{ + mp_number vv; + new_number_clone(vv, mp_get_value_number(p)); + mp_new_dep(mp, p, mp_proto_dependent_type, mp_const_dependency(mp, &zero_t)); + if (number_nonzero(vv)) { + mp_add_mult_dep(mp, (mp_value_node) p, &vv, t); + } + if (number_nonzero(*v)) { + mp_number arg1; + new_number_clone(arg1, *v); + mp_add_mult_dep(mp, (mp_value_node) p, &arg1, u); + free_number(arg1); + } + if (q != NULL) { + mp_add_mult_dep(mp, (mp_value_node) p, &unity_t, q); + } + if (mp_get_dep_list((mp_value_node) p) == (mp_node) mp->dep_final) { + number_clone(vv, mp_get_dep_value(mp->dep_final)); + mp_recycle_value(mp, p); + mp_type(p) = mp_known_type; + mp_set_value_number(p, vv); + } + free_number(vv); +} +static void mp_bilin3 (MP mp, mp_node p, mp_number *t, mp_number *v, mp_number *u, mp_number *delta_orig) +{ + mp_number delta; + mp_number tmp; + new_number(tmp); + new_number_clone(delta, *delta_orig); + if (! number_equal(*t, unity_t)) { + take_scaled(tmp, mp_get_value_number(p), *t); + } else { + number_clone(tmp, mp_get_value_number(p)); + } + number_add(delta, tmp); + if (number_nonzero(*u)) { + mp_number ret; + new_number(ret); + take_scaled(ret, *v, *u); + mp_set_value_number(p, delta); + number_add(mp_get_value_number(p), ret); + free_number(ret); + } else { + mp_set_value_number(p, delta); + } + free_number(tmp); + free_number(delta); +} + +static void mp_big_trans (MP mp, mp_node p, int c) +{ + mp_node q = mp_get_value_node(p); + if (mp_type(q) == mp_pair_node_type) { + if (mp_type(mp_x_part(q)) != mp_known_type || mp_type(mp_y_part(q)) != mp_known_type) { + goto UNKNOWN; + } + } else if (mp_type(mp_tx_part(q)) != mp_known_type || mp_type(mp_ty_part(q)) != mp_known_type || + mp_type(mp_xx_part(q)) != mp_known_type || mp_type(mp_xy_part(q)) != mp_known_type || + mp_type(mp_yx_part(q)) != mp_known_type || mp_type(mp_yy_part(q)) != mp_known_type) { + goto UNKNOWN; + } + { + mp_node r, pp, qq; + mp_set_up_trans(mp, c); + if (mp->cur_exp.type == mp_known_type) { + mp_make_exp_copy(mp, p); + r = mp_get_value_node(cur_exp_node); + if (mp->cur_exp.type == mp_transform_type) { + mp_bilin3(mp, mp_yy_part(r), &(mp->tyy), &(mp_get_value_number(mp_xy_part(q))), &(mp->tyx), &zero_t); + mp_bilin3(mp, mp_yx_part(r), &(mp->tyy), &(mp_get_value_number(mp_xx_part(q))), &(mp->tyx), &zero_t); + mp_bilin3(mp, mp_xy_part(r), &(mp->txx), &(mp_get_value_number(mp_yy_part(q))), &(mp->txy), &zero_t); + mp_bilin3(mp, mp_xx_part(r), &(mp->txx), &(mp_get_value_number(mp_yx_part(q))), &(mp->txy), &zero_t); + } + mp_bilin3(mp, mp_y_part(r), &(mp->tyy), &(mp_get_value_number(mp_x_part(q))), &(mp->tyx), &(mp->ty)); + mp_bilin3(mp, mp_x_part(r), &(mp->txx), &(mp_get_value_number(mp_y_part(q))), &(mp->txy), &(mp->tx)); + } else { + pp = mp_stash_cur_exp(mp); + qq = mp_get_value_node(pp); + mp_make_exp_copy(mp, p); + r = mp_get_value_node(cur_exp_node); + if (mp->cur_exp.type == mp_transform_type) { + mp_bilin2(mp, mp_yy_part(r), mp_yy_part(qq), &(mp_get_value_number(mp_xy_part(q))), mp_yx_part(qq), NULL); + mp_bilin2(mp, mp_yx_part(r), mp_yy_part(qq), &(mp_get_value_number(mp_xx_part(q))), mp_yx_part(qq), NULL); + mp_bilin2(mp, mp_xy_part(r), mp_xx_part(qq), &(mp_get_value_number(mp_yy_part(q))), mp_xy_part(qq), NULL); + mp_bilin2(mp, mp_xx_part(r), mp_xx_part(qq), &(mp_get_value_number(mp_yx_part(q))), mp_xy_part(qq), NULL); + } + mp_bilin2(mp, mp_y_part(r), mp_yy_part(qq), &(mp_get_value_number(mp_x_part(q))), mp_yx_part(qq), mp_y_part(qq)); + mp_bilin2(mp, mp_x_part(r), mp_xx_part(qq), &(mp_get_value_number(mp_y_part(q))), mp_xy_part(qq), mp_x_part(qq)); + mp_recycle_value(mp, pp); + mp_free_value_node(mp, pp); + } + return; + } + UNKNOWN: + { + mp_node r; + mp_set_up_known_trans(mp, c); + mp_make_exp_copy(mp, p); + r = mp_get_value_node(cur_exp_node); + if (mp->cur_exp.type == mp_transform_type) { + mp_bilin1(mp, mp_yy_part(r), &(mp->tyy), mp_xy_part(q), &(mp->tyx), &zero_t); + mp_bilin1(mp, mp_yx_part(r), &(mp->tyy), mp_xx_part(q), &(mp->tyx), &zero_t); + mp_bilin1(mp, mp_xy_part(r), &(mp->txx), mp_yy_part(q), &(mp->txy), &zero_t); + mp_bilin1(mp, mp_xx_part(r), &(mp->txx), mp_yx_part(q), &(mp->txy), &zero_t); + } + mp_bilin1(mp, mp_y_part(r), &(mp->tyy), mp_x_part(q), &(mp->tyx), &(mp->ty)); + mp_bilin1(mp, mp_x_part(r), &(mp->txx), mp_y_part(q), &(mp->txy), &(mp->tx)); + + return; + } +} +static void mp_chop_path (MP mp, mp_node p) +{ + mp_knot q; + mp_knot pp, qq; + mp_number a, b; + mp_number l; + int reversed; + new_number(l); + mp_path_length(mp, &l); + new_number_clone(a, mp_get_value_number(mp_x_part(p))); + new_number_clone(b, mp_get_value_number(mp_y_part(p))); + if (number_lessequal(a, b)) { + reversed = 0; + } else { + reversed = 1; + number_swap (a, b); + } + if (number_negative(a)) { + if (mp_left_type(cur_exp_knot) == mp_endpoint_knot) { + set_number_to_zero(a); + if (number_negative(b)) { + set_number_to_zero(b); + } + } else { + do { + number_add(a, l); + number_add(b, l); + } while (number_negative(a)); + } + } + if (number_greater(b, l)) { + if (mp_left_type(cur_exp_knot) == mp_endpoint_knot) { + number_clone(b, l); + if (number_greater(a, l)) { + number_clone(a, l); + } + } else { + while (number_greaterequal(a, l)) { + number_subtract(a, l); + number_subtract(b, l); + } + } + } + q = cur_exp_knot; + while (number_greaterequal(a, unity_t)) { + q = mp_next_knot(q); + number_subtract(a, unity_t); + number_subtract(b, unity_t); + } + if (number_equal(b, a)) { + if (number_positive(a)) { + mp_number arg1; + new_number_clone(arg1, a); + convert_scaled_to_fraction(arg1); + mp_split_cubic(mp, q, &arg1); + free_number(arg1); + q = mp_next_knot(q); + } + pp = mp_copy_knot(mp, q); + qq = pp; + } else { + mp_knot rr; + pp = mp_copy_knot(mp, q); + qq = pp; + do { + q = mp_next_knot(q); + rr = qq; + qq = mp_copy_knot(mp, q); + mp_prev_knot(qq) = rr; + mp_next_knot(rr) = qq; + number_subtract(b, unity_t); + } while (number_positive(b)); + if (number_positive(a)) { + mp_knot ss = pp; + mp_number arg1; + new_number_clone(arg1, a); + convert_scaled_to_fraction(arg1); + mp_split_cubic(mp, ss, &arg1); + free_number(arg1); + pp = mp_next_knot(ss); + mp_toss_knot(mp, ss); + if (rr == ss) { + mp_number arg1, arg2; + new_number(arg1); + set_number_from_subtraction(arg1, unity_t, a); + new_number_clone(arg2, b); + make_scaled(b, arg2, arg1); + free_number(arg1); + free_number(arg2); + rr = pp; + } + } + if (number_negative(b)) { + mp_number arg1; + new_number(arg1); + set_number_from_addition(arg1, b, unity_t); + convert_scaled_to_fraction(arg1); + mp_split_cubic(mp, rr, &arg1); + free_number(arg1); + mp_toss_knot(mp, qq); + qq = mp_next_knot(rr); + } + } + mp_left_type(pp) = mp_endpoint_knot; + mp_right_type(qq) = mp_endpoint_knot; + mp_prev_knot(pp) = qq; + mp_next_knot(qq) = pp; + mp_toss_knot_list(mp, cur_exp_knot); + if (reversed) { + mp_set_cur_exp_knot(mp, mp_next_knot(mp_htap_ypoc(mp, pp))); + mp_toss_knot_list(mp, pp); + } else { + mp_set_cur_exp_knot(mp, pp); + } + free_number(l); + free_number(a); + free_number(b); +} +static void mp_set_up_offset (MP mp, mp_node p) +{ + mp_find_offset(mp, &(mp_get_value_number(mp_x_part(p))), &(mp_get_value_number(mp_y_part(p))), cur_exp_knot); + mp_pair_value(mp, &(mp->cur_x), &(mp->cur_y)); +} +static void mp_set_up_direction_time (MP mp, mp_node p) +{ + mp_value new_expr; + memset(&new_expr, 0, sizeof(mp_value)); + new_number(new_expr.data.n); + mp_find_direction_time(mp, &new_expr.data.n, &(mp_get_value_number(mp_x_part(p))), &(mp_get_value_number(mp_y_part(p))), cur_exp_knot); + mp_flush_cur_exp(mp, new_expr); +} +static void mp_set_up_envelope (MP mp, mp_node p) +{ + mp_knot q = mp_copy_path(mp, cur_exp_knot); + + if (mp_pen_is_elliptical(mp_get_value_knot(p))) { + mp_bad_envelope_pen(mp); + mp_set_cur_exp_knot(mp, q); + mp->cur_exp.type = mp_path_type; + } else { + int linejoin = mp_mitered_linejoin_code; + int linecap = mp_butt_linecap_code; + mp_number miterlimit; + new_number(miterlimit); + if (number_greater(internal_value(mp_linejoin_internal), unity_t)) { + linejoin = mp_beveled_linejoin_code; + } else if (number_positive(internal_value(mp_linejoin_internal))) { + linejoin = mp_rounded_linejoin_code; + } + if (number_greater(internal_value(mp_linecap_internal), unity_t)) { + linecap = mp_squared_linecap_code; + } else if (number_positive(internal_value(mp_linecap_internal))) { + linecap = mp_rounded_linecap_code; + } + if (number_less(internal_value(mp_miterlimit_internal), unity_t)) { + set_number_to_unity(miterlimit); + } else { + number_clone(miterlimit, internal_value(mp_miterlimit_internal)); + } + mp_set_cur_exp_knot(mp, mp_make_envelope(mp, q, mp_get_value_knot(p), linejoin, linecap, &miterlimit)); + mp->cur_exp.type = mp_path_type; + } +} +static void mp_set_up_boundingpath (MP mp, mp_node p) +{ + mp_number miterlimit; + mp_knot q = mp_copy_path(mp, cur_exp_knot); + mp_knot qq; + int linejoin = mp_mitered_linejoin_code; + int linecap = mp_butt_linecap_code; + mp_knot pen = mp_get_value_knot(p); + new_number(miterlimit); + if (mp_pen_is_elliptical(mp_get_value_knot(p))) { + mp_knot kp, kq; + pen = mp_copy_pen(mp, mp_get_value_knot(p)); + mp_make_path(mp, pen); + kq = pen; + do { + kp = kq; + kq = mp_next_knot(kq); + mp_prev_knot(kq) = kp; + } while (kq != pen); + mp_close_path_cycle(mp, kp, pen); + } + if (number_greater(internal_value(mp_linejoin_internal), unity_t)) { + linejoin = mp_beveled_linejoin_code; + } else if (number_positive(internal_value(mp_linejoin_internal))) { + linejoin = mp_rounded_linejoin_code; + } + if (number_greater(internal_value(mp_linecap_internal), unity_t)) { + linecap = mp_squared_linecap_code; + } else if (number_positive(internal_value(mp_linecap_internal))) { + linecap = mp_rounded_linecap_code; + } + if (number_less(internal_value(mp_miterlimit_internal), unity_t)) { + set_number_to_unity(miterlimit); + } else { + number_clone(miterlimit, internal_value(mp_miterlimit_internal)); + } + qq = mp_make_envelope(mp, q, pen, linejoin, linecap, &miterlimit); + mp_set_cur_exp_knot(mp, qq); + mp->cur_exp.type = mp_path_type; + if (! mp_get_cur_bbox(mp)) { + mp_bad_binary(mp, p, mp_boundingpath_operation); + mp_set_cur_exp_knot(mp, q); + mp->cur_exp.type = mp_path_type; + return; + } else { + mp_knot ll = mp_new_knot(mp); + mp_knot lr = mp_new_knot(mp); + mp_knot ur = mp_new_knot(mp); + mp_knot ul = mp_new_knot(mp); + if (ll == NULL || lr == NULL || ur == NULL || ul == NULL){ + mp_bad_binary(mp, p, mp_boundingpath_operation); + mp_set_cur_exp_knot(mp, q); + mp->cur_exp.type = mp_path_type; + return; + } else { + mp_left_type(ll) = mp_endpoint_knot; + mp_right_type(ll) = mp_endpoint_knot; + mp_originator(ll) = mp_program_code; + mp_knotstate(ll) = mp_regular_knot; + number_clone(ll->x_coord, mp_minx); + number_clone(ll->y_coord, mp_miny); + mp_originator(lr) = mp_program_code; + mp_knotstate(lr) = mp_regular_knot; + number_clone(lr->x_coord, mp_maxx); + number_clone(lr->y_coord, mp_miny); + mp_originator(ur) = mp_program_code; + mp_knotstate(ur) = mp_regular_knot; + number_clone(ur->x_coord, mp_maxx); + number_clone(ur->y_coord, mp_maxy); + mp_originator(ul) = mp_program_code; + mp_knotstate(ul) = mp_regular_knot; + number_clone(ul->x_coord, mp_minx); + number_clone(ul->y_coord, mp_maxy); + mp_prev_knot(lr) = ll; + mp_next_knot(ll) = lr; + mp_prev_knot(ur) = lr; + mp_next_knot(lr) = ur; + mp_prev_knot(ul) = ur; + mp_next_knot(ur) = ul; + mp_close_path_cycle(mp, ul, ll); + mp_make_path(mp,ll); + mp->cur_exp.type = mp_path_type; + mp_set_cur_exp_knot(mp, ll); + mp_free_path(mp,qq); + } + } +} +static void mp_find_point (MP mp, mp_number *v_orig, int c) +{ + mp_knot p; + mp_number n; + mp_number v; + new_number(n); + new_number_clone(v, *v_orig); + p = cur_exp_knot; + if (mp_left_type(p) == mp_endpoint_knot) { + set_number_to_unity(n); + number_negate(n); + } + do { + p = mp_next_knot(p); + number_add(n, unity_t); + } while (p != cur_exp_knot); + if (number_zero(n)) { + set_number_to_zero(v); + } else if (number_negative(v)) { + if (mp_left_type(p) == mp_endpoint_knot) { + set_number_to_zero(v); + } else { + number_negate(v); + number_add_scaled(v, -1); + number_modulo(v, n); + number_negate(v); + number_add_scaled(v, -1); + number_add(v, n); + } + } else if (number_greater(v, n)) { + if (mp_left_type(p) == mp_endpoint_knot) { + number_clone(v, n); + } else { + number_modulo(v, n); + } + } + p = cur_exp_knot; + while (number_greaterequal(v, unity_t)) { + p = mp_next_knot(p); + number_subtract(v, unity_t); + } + if (number_nonzero(v)) { + convert_scaled_to_fraction(v); + mp_split_cubic(mp, p, &v); + p = mp_next_knot(p); + } + push_of_path_result(mp, c - mp_point_operation, p); + free_number(v); + free_number(n); +} + +static void mp_finish_binary (MP mp, mp_node old_p, mp_node old_exp) +{ + check_arith(); + if (old_p != NULL) { + mp_recycle_value(mp, old_p); + mp_free_value_node(mp, old_p); + } + if (old_exp != NULL) { + mp_recycle_value(mp, old_exp); + mp_free_value_node(mp, old_exp); + } +} + +static void mp_do_binary (MP mp, mp_node p, int c) +{ + mp_node old_p, old_exp; + mp_value new_expr; + check_arith(); + if (number_greater(internal_value(mp_tracing_commands_internal), two_t)) { + mp_begin_diagnostic(mp); + mp_print_nl(mp, "{("); + mp_print_exp(mp, p, 0); + mp_print_chr(mp, ')'); + mp_print_op(mp, (int) c); + mp_print_chr(mp, '('); + mp_print_exp(mp, NULL, 0); + mp_print_str(mp, ")}"); + mp_end_diagnostic(mp, 0); + } + switch (mp_type(p)) { + case mp_transform_type: + case mp_color_type: + case mp_cmykcolor_type: + case mp_pair_type: + old_p = mp_tarnished(mp, p); + break; + case mp_independent_type: + old_p = MP_VOID; + break; + default: + old_p = NULL; + break; + } + if (old_p != NULL) { + mp_node q = mp_stash_cur_exp(mp); + old_p = p; + mp_make_exp_copy(mp, old_p); + p = mp_stash_cur_exp(mp); + mp_unstash_cur_exp(mp, q); + } + switch (mp->cur_exp.type) { + case mp_transform_type: + case mp_color_type: + case mp_cmykcolor_type: + case mp_pair_type: + old_exp = mp_tarnished(mp, cur_exp_node); + break; + case mp_independent_type: + old_exp = MP_VOID; + break; + default: + old_exp = NULL; + break; + } + if (old_exp != NULL) { + old_exp = cur_exp_node; + mp_make_exp_copy(mp, old_exp); + } + switch (c) { + case mp_plus_operation: + case mp_minus_operation: + if ((mp->cur_exp.type < mp_color_type) || (mp_type(p) < mp_color_type)) { + mp_bad_binary(mp, p, c); + } else { + if ((mp->cur_exp.type > mp_pair_type) && (mp_type(p) > mp_pair_type)) { + mp_add_or_subtract(mp, p, NULL, c); + } else if (mp->cur_exp.type != mp_type(p)) { + + mp_bad_binary(mp, p, c); + } else { + mp_node q = mp_get_value_node(p); + mp_node r = mp_get_value_node(cur_exp_node); + switch (mp->cur_exp.type) { + case mp_pair_type: + mp_add_or_subtract(mp, mp_x_part(q), mp_x_part(r), c); + mp_add_or_subtract(mp, mp_y_part(q), mp_y_part(r), c); + break; + case mp_color_type: + mp_add_or_subtract(mp, mp_red_part(q), mp_red_part(r), c); + mp_add_or_subtract(mp, mp_green_part(q), mp_green_part(r), c); + mp_add_or_subtract(mp, mp_blue_part(q), mp_blue_part(r), c); + break; + case mp_cmykcolor_type: + mp_add_or_subtract(mp, mp_cyan_part(q), mp_cyan_part(r), c); + mp_add_or_subtract(mp, mp_magenta_part(q), mp_magenta_part(r), c); + mp_add_or_subtract(mp, mp_yellow_part(q), mp_yellow_part(r), c); + mp_add_or_subtract(mp, mp_black_part(q), mp_black_part(r), c); + break; + case mp_transform_type: + mp_add_or_subtract(mp, mp_tx_part(q), mp_tx_part(r), c); + mp_add_or_subtract(mp, mp_ty_part(q), mp_ty_part(r), c); + mp_add_or_subtract(mp, mp_xx_part(q), mp_xx_part(r), c); + mp_add_or_subtract(mp, mp_xy_part(q), mp_xy_part(r), c); + mp_add_or_subtract(mp, mp_yx_part(q), mp_yx_part(r), c); + mp_add_or_subtract(mp, mp_yy_part(q), mp_yy_part(r), c); + break; + default: + break; + } + } + } + break; + case mp_less_than_operation: + case mp_less_or_equal_operation: + case mp_greater_than_operation: + case mp_greater_or_equal_operation: + case mp_equal_operation: + case mp_unequal_operation: + check_arith(); + if ((mp->cur_exp.type > mp_pair_type) && (mp_type(p) > mp_pair_type)) { + mp_add_or_subtract(mp, p, NULL, mp_minus_operation); + } else if (mp->cur_exp.type != mp_type(p)) { + mp_bad_binary(mp, p, (int) c); + goto DONE; + } else { + switch (mp->cur_exp.type) { + case mp_string_type: + { + memset(&new_expr, 0, sizeof(mp_value)); + new_number(new_expr.data.n); + set_number_from_scaled(new_expr.data.n, mp_str_vs_str(mp, mp_get_value_str(p), cur_exp_str)); + mp_flush_cur_exp(mp, new_expr); + } + break; + case mp_unknown_string_type: + case mp_unknown_boolean_type: + { + mp_node q = mp_get_value_node(cur_exp_node); + while ((q != cur_exp_node) && (q != p)) { + q = mp_get_value_node(q); + } + if (q == p) { + memset(&new_expr, 0, sizeof(mp_value)); + new_number(new_expr.data.n); + mp_set_cur_exp_node(mp, NULL); + mp_flush_cur_exp(mp, new_expr); + } + } + break; + case mp_pair_type: + { + int part_type = 0; + mp_node q = mp_get_value_node(p); + mp_node r = mp_get_value_node(cur_exp_node); + while (part_type == 0) { + mp_node rr = mp_x_part(r); + part_type = mp_x_part_operation; + mp_add_or_subtract(mp, mp_x_part(q), rr, mp_minus_operation); + if (mp_type(rr) != mp_known_type || ! number_zero(mp_get_value_number(rr))) { + break; + } + rr = mp_y_part(r); + part_type = mp_y_part_operation; + mp_add_or_subtract(mp, mp_y_part(q), rr, mp_minus_operation); + if (mp_type(rr) != mp_known_type || ! number_zero(mp_get_value_number(rr))) { + break; + } + } + mp_take_part(mp, part_type); + } + break; + case mp_color_type: + { + int part_type = 0; + mp_node q = mp_get_value_node(p); + mp_node r = mp_get_value_node(cur_exp_node); + while (part_type == 0) { + mp_node rr = mp_red_part(r); + part_type = mp_red_part_operation; + mp_add_or_subtract(mp, mp_red_part(q), rr, mp_minus_operation); + if (mp_type(rr) != mp_known_type || ! number_zero(mp_get_value_number(rr))) { + break; + } + rr = mp_green_part(r); + part_type = mp_green_part_operation; + mp_add_or_subtract(mp, mp_green_part(q), rr, mp_minus_operation); + if (mp_type(rr) != mp_known_type || ! number_zero(mp_get_value_number(rr))) { + break; + } + rr = mp_blue_part(r); + part_type = mp_blue_part_operation; + mp_add_or_subtract(mp, mp_blue_part(q), rr, mp_minus_operation); + if (mp_type(rr) != mp_known_type || ! number_zero(mp_get_value_number(rr))) { + break; + } + } + mp_take_part(mp, part_type); + } + break; + case mp_cmykcolor_type: + { + int part_type = 0; + mp_node q = mp_get_value_node(p); + mp_node r = mp_get_value_node(cur_exp_node); + while (part_type == 0) { + mp_node rr = mp_cyan_part(r); + part_type = mp_cyan_part_operation; + mp_add_or_subtract(mp, mp_cyan_part(q), rr, mp_minus_operation); + if (mp_type(rr) != mp_known_type || ! number_zero(mp_get_value_number(rr))) { + break; + } + rr = mp_magenta_part(r); + part_type = mp_magenta_part_operation; + mp_add_or_subtract(mp, mp_magenta_part(q), rr, mp_minus_operation); + if (mp_type(rr) != mp_known_type || ! number_zero(mp_get_value_number(rr))) { + break; + } + rr = mp_yellow_part(r); + part_type = mp_yellow_part_operation; + mp_add_or_subtract(mp, mp_yellow_part(q), rr, mp_minus_operation); + if (mp_type(rr) != mp_known_type || ! number_zero(mp_get_value_number(rr))) { + break; + } + rr = mp_black_part(r); + part_type = mp_black_part_operation; + mp_add_or_subtract(mp, mp_black_part(q), rr, mp_minus_operation); + if (mp_type(rr) != mp_known_type || ! number_zero(mp_get_value_number(rr))) { + break; + } + } + mp_take_part(mp, part_type); + } + break; + case mp_transform_type: + { + int part_type = 0; + mp_node q = mp_get_value_node(p); + mp_node r = mp_get_value_node(cur_exp_node); + while (part_type == 0) { + mp_node rr = mp_tx_part(r); + part_type = mp_x_part_operation; + mp_add_or_subtract(mp, mp_tx_part(q), rr, mp_minus_operation); + if (mp_type(rr) != mp_known_type || ! number_zero(mp_get_value_number(rr))) { + break; + } + rr = mp_ty_part(r); + part_type = mp_y_part_operation; + mp_add_or_subtract(mp, mp_ty_part(q), rr, mp_minus_operation); + if (mp_type(rr) != mp_known_type || ! number_zero(mp_get_value_number(rr))) { + break; + } + rr = mp_xx_part(r); + part_type = mp_xx_part_operation; + mp_add_or_subtract(mp, mp_xx_part(q), rr, mp_minus_operation); + if (mp_type(rr) != mp_known_type || ! number_zero(mp_get_value_number(rr))) { + break; + } + rr = mp_xy_part(r); + part_type = mp_xy_part_operation; + mp_add_or_subtract(mp, mp_xy_part(q), rr, mp_minus_operation); + if (mp_type(rr) != mp_known_type || ! number_zero(mp_get_value_number(rr))) { + break; + } + rr = mp_yx_part(r); + part_type = mp_yx_part_operation; + mp_add_or_subtract(mp, mp_yx_part(q), rr, mp_minus_operation); + if (mp_type(rr) != mp_known_type || ! number_zero(mp_get_value_number(rr))) { + break; + } + rr = mp_yy_part(r); + part_type = mp_yy_part_operation; + mp_add_or_subtract(mp, mp_yy_part(q), rr, mp_minus_operation); + if (mp_type(rr) != mp_known_type || ! number_zero(mp_get_value_number(rr))) { + break; + } + } + mp_take_part(mp, part_type); + } + break; + case mp_boolean_type: + { + memset(&new_expr, 0, sizeof(mp_value)); + new_number(new_expr.data.n); + set_number_from_boolean(new_expr.data.n, number_to_scaled(cur_exp_value_number) - number_to_scaled(mp_get_value_number(p))); + mp_flush_cur_exp(mp, new_expr); + } + break; + default: + mp_bad_binary(mp, p, (int) c); + goto DONE; + break; + } + } + if (mp->cur_exp.type != mp_known_type) { + const char *hlp = NULL; + if (mp->cur_exp.type < mp_known_type) { + mp_disp_err(mp, p); + hlp = "The quantities shown above have not been equated."; + } else { + hlp = + "Oh dear. I can't decide if the expression above is positive, negative, or zero.\n" + "So this comparison test won't be 'true'."; + } + mp_disp_err(mp, NULL); + memset(&new_expr, 0, sizeof(mp_value)); + new_number(new_expr.data.n); + set_number_from_boolean(new_expr.data.n, mp_false_operation); + mp_back_error(mp, "Unknown relation will be considered false", hlp); + mp_get_x_next(mp); + mp_flush_cur_exp(mp, new_expr); + } else { + int b = 0; + switch (c) { + case mp_less_than_operation: + b = number_negative(cur_exp_value_number); + break; + case mp_less_or_equal_operation: + b = number_nonpositive(cur_exp_value_number); + break; + case mp_greater_than_operation: + b = number_positive(cur_exp_value_number); + break; + case mp_greater_or_equal_operation: + b = number_nonnegative(cur_exp_value_number); + break; + case mp_equal_operation: + b = number_zero(cur_exp_value_number); + break; + case mp_unequal_operation: + b = number_nonzero(cur_exp_value_number); + break; + }; + mp_set_cur_exp_value_boolean(mp, b ? mp_true_operation : mp_false_operation); + } + mp->cur_exp.type = mp_boolean_type; + DONE: + mp->arith_error = 0; + break; + case mp_and_operation: + case mp_or_operation: + if ((mp_type(p) != mp_boolean_type) || (mp->cur_exp.type != mp_boolean_type)) { + mp_bad_binary(mp, p, (int) c); + } else if (number_to_boolean(p->data.n) == c + mp_false_operation - mp_and_operation) { + mp_set_cur_exp_value_boolean(mp, number_to_boolean(p->data.n)); + } + break; + case mp_times_operation: + if ((mp->cur_exp.type < mp_color_type) || (mp_type(p) < mp_color_type)) { + mp_bad_binary(mp, p, mp_times_operation); + } else if ((mp->cur_exp.type == mp_known_type) || (mp_type(p) == mp_known_type)) { + mp_number vv; + new_fraction(vv); + if (mp_type(p) == mp_known_type) { + number_clone(vv, mp_get_value_number(p)); + mp_free_value_node(mp, p); + } else { + number_clone(vv, cur_exp_value_number); + mp_unstash_cur_exp(mp, p); + } + switch (mp->cur_exp.type) { + case mp_known_type: + { + mp_number ret; + new_number(ret); + take_scaled(ret, cur_exp_value_number, vv); + mp_set_cur_exp_value_number(mp, &ret); + free_number(ret); + } + break; + case mp_pair_type: + { + mp_dep_mult(mp, (mp_value_node) mp_x_part(mp_get_value_node(cur_exp_node)), &vv, 1); + mp_dep_mult(mp, (mp_value_node) mp_y_part(mp_get_value_node(cur_exp_node)), &vv, 1); + } + break; + case mp_color_type: + { + mp_dep_mult(mp, (mp_value_node) mp_red_part (mp_get_value_node(cur_exp_node)), &vv, 1); + mp_dep_mult(mp, (mp_value_node) mp_green_part(mp_get_value_node(cur_exp_node)), &vv, 1); + mp_dep_mult(mp, (mp_value_node) mp_blue_part (mp_get_value_node(cur_exp_node)), &vv, 1); + } + break; + case mp_cmykcolor_type: + { + mp_dep_mult(mp, (mp_value_node) mp_cyan_part (mp_get_value_node(cur_exp_node)), &vv, 1); + mp_dep_mult(mp, (mp_value_node) mp_magenta_part(mp_get_value_node(cur_exp_node)), &vv, 1); + mp_dep_mult(mp, (mp_value_node) mp_yellow_part (mp_get_value_node(cur_exp_node)), &vv, 1); + mp_dep_mult(mp, (mp_value_node) mp_black_part (mp_get_value_node(cur_exp_node)), &vv, 1); + } + break; + default: + { + mp_dep_mult(mp, NULL, &vv, 1); + } + break; + } + free_number(vv); + mp_finish_binary(mp, old_p, old_exp); + return; + } else if ((mp_nice_color_or_pair(mp, p, mp_type(p)) && (mp->cur_exp.type > mp_pair_type)) + || (mp_nice_color_or_pair(mp, cur_exp_node, mp->cur_exp.type) && (mp_type(p) > mp_pair_type))) { + mp_hard_times(mp, p); + mp_finish_binary(mp, old_p, old_exp); + return; + } else { + mp_bad_binary(mp, p, mp_times_operation); + } + break; + case mp_over_operation: + if ((mp->cur_exp.type != mp_known_type) || (mp_type(p) < mp_color_type)) { + mp_bad_binary(mp, p, mp_over_operation); + } else { + mp_number v_n; + new_number_clone(v_n, cur_exp_value_number); + mp_unstash_cur_exp(mp, p); + if (number_zero(v_n)) { + mp_disp_err(mp, NULL); + mp_back_error( + mp, + "Division by zero", + "You're trying to divide the quantity shown above the error message by zero. I'm\n" + "going to divide it by one instead." + ); + mp_get_x_next(mp); + } else { + switch (mp->cur_exp.type) { + case mp_known_type: + { + mp_number ret; + new_number(ret); + make_scaled(ret, cur_exp_value_number, v_n); + mp_set_cur_exp_value_number(mp, &ret); + free_number(ret); + } + break; + case mp_pair_type: + { + mp_dep_div(mp, (mp_value_node) mp_x_part(mp_get_value_node(cur_exp_node)), &v_n); + mp_dep_div(mp, (mp_value_node) mp_y_part(mp_get_value_node(cur_exp_node)), &v_n); + } + break; + case mp_color_type: + { + mp_dep_div(mp, (mp_value_node) mp_red_part (mp_get_value_node(cur_exp_node)), &v_n); + mp_dep_div(mp, (mp_value_node) mp_green_part(mp_get_value_node(cur_exp_node)), &v_n); + mp_dep_div(mp, (mp_value_node) mp_blue_part (mp_get_value_node(cur_exp_node)), &v_n); + } + break; + case mp_cmykcolor_type: + { + mp_dep_div(mp, (mp_value_node) mp_cyan_part (mp_get_value_node(cur_exp_node)), &v_n); + mp_dep_div(mp, (mp_value_node) mp_magenta_part(mp_get_value_node(cur_exp_node)), &v_n); + mp_dep_div(mp, (mp_value_node) mp_yellow_part (mp_get_value_node(cur_exp_node)), &v_n); + mp_dep_div(mp, (mp_value_node) mp_black_part (mp_get_value_node(cur_exp_node)), &v_n); + } + break; + default: + { + mp_dep_div(mp, NULL, &v_n); + } + break; + } + } + free_number(v_n); + mp_finish_binary(mp, old_p, old_exp); + return; + } + break; + case mp_power_operation: + if ((mp->cur_exp.type == mp_known_type) && (mp_type(p) == mp_known_type)) { + mp_number r; + new_number(r); + power_of(r, mp_get_value_number(p), cur_exp_value_number); + check_arith(); + mp_set_cur_exp_value_number(mp, &r); + free_number(r); + } else + mp_bad_binary(mp, p, (int) c); + break; + case mp_pythag_add_operation: + case mp_pythag_sub_operation: + if ((mp->cur_exp.type == mp_known_type) && (mp_type(p) == mp_known_type)) { + mp_number r; + new_number(r); + if (c == mp_pythag_add_operation) { + pyth_add(r, mp_get_value_number(p), cur_exp_value_number); + } else { + pyth_sub(r, mp_get_value_number(p), cur_exp_value_number); + } + mp_set_cur_exp_value_number(mp, &r); + free_number(r); + } else + mp_bad_binary(mp, p, (int) c); + break; + case mp_rotated_operation: + case mp_slanted_operation: + case mp_scaled_operation: + case mp_shifted_operation: + case mp_transformed_operation: + case mp_x_scaled_operation: + case mp_y_scaled_operation: + case mp_z_scaled_operation: + switch (mp_type(p)) { + case mp_path_type: + mp_set_up_known_trans(mp, (int) c); + mp_unstash_cur_exp(mp, p); + mp_do_path_trans(mp, cur_exp_knot); + mp_finish_binary(mp, old_p, old_exp); + return; + case mp_pen_type: + mp_set_up_known_trans(mp, (int) c); + mp_unstash_cur_exp(mp, p); + mp_do_pen_trans(mp, cur_exp_knot); + mp_set_cur_exp_knot(mp, mp_convex_hull(mp, cur_exp_knot)); + mp_finish_binary(mp, old_p, old_exp); + return; + case mp_nep_type: + mp_set_up_known_trans(mp, (int) c); + mp_unstash_cur_exp(mp, p); + mp_do_pen_trans(mp, cur_exp_knot); + mp_set_cur_exp_knot(mp, cur_exp_knot); + mp_finish_binary(mp, old_p, old_exp); + return; + case mp_pair_type: + case mp_transform_type: + mp_big_trans(mp, p, (int) c); + break; + case mp_picture_type: + mp_do_edges_trans(mp, p, (int) c); + mp_finish_binary(mp, old_p, old_exp); + return; + default: + mp_bad_binary(mp, p, (int) c); + break; + } + break; + case mp_concatenate_operation: + case mp_just_append_operation: + if ((mp->cur_exp.type == mp_string_type) && (mp_type(p) == mp_string_type)) { + mp_string str = mp_cat(mp, mp_get_value_str(p), cur_exp_str); + delete_str_ref(cur_exp_str) ; + mp_set_cur_exp_str(mp, str); + } else { + mp_bad_binary(mp, p, c); + } + break; + case mp_substring_operation: + if (mp_nice_pair(mp, p, mp_type(p)) && (mp->cur_exp.type == mp_string_type)) { + mp_string str = mp_chop_string (mp, + cur_exp_str, + round_unscaled(mp_get_value_number(mp_x_part(mp_get_value_node(p)))), + round_unscaled(mp_get_value_number(mp_y_part(mp_get_value_node(p)))) + ); + delete_str_ref(cur_exp_str) ; + mp_set_cur_exp_str(mp, str); + } else { + mp_bad_binary(mp, p, mp_substring_operation); + } + break; + case mp_subpath_operation: + if (mp->cur_exp.type == mp_pair_type) { + mp_pair_to_path(mp); + } + if (mp_nice_pair(mp, p, mp_type(p)) && (mp->cur_exp.type == mp_path_type)) { + mp_chop_path(mp, mp_get_value_node(p)); + } else { + mp_bad_binary(mp, p, mp_subpath_operation); + } + break; + case mp_point_operation: + case mp_precontrol_operation: + case mp_postcontrol_operation: + case mp_direction_operation: + if (mp->cur_exp.type == mp_pair_type) { + mp_pair_to_path(mp); + } + if ((mp->cur_exp.type == mp_path_type) && (mp_type(p) == mp_known_type)) { + mp_find_point(mp, &(mp_get_value_number(p)), (int) c); + } else { + mp_bad_binary(mp, p, c); + } + break; + case mp_pen_offset_operation: + if ((mp->cur_exp.type == mp_pen_type || mp->cur_exp.type == mp_nep_type) && mp_nice_pair(mp, p, mp_type(p))) { + mp_set_up_offset(mp, mp_get_value_node(p)); + } else { + mp_bad_binary(mp, p, mp_pen_offset_operation); + } + break; + case mp_direction_time_operation: + if (mp->cur_exp.type == mp_pair_type) { + mp_pair_to_path(mp); + } + if ((mp->cur_exp.type == mp_path_type) && mp_nice_pair(mp, p, mp_type(p))) { + mp_set_up_direction_time(mp, mp_get_value_node(p)); + } else { + mp_bad_binary(mp, p, mp_direction_time_operation); + } + break; + case mp_envelope_operation: + if ((mp_type(p) != mp_pen_type && mp_type(p) != mp_nep_type) || (mp->cur_exp.type != mp_path_type)) { + mp_bad_binary(mp, p, mp_envelope_operation); + } else { + mp_set_up_envelope(mp, p); + } + break; + case mp_boundingpath_operation: + if ((mp_type(p) != mp_pen_type && mp_type(p) != mp_nep_type) || (mp->cur_exp.type != mp_path_type)) { + mp_bad_binary(mp, p, mp_boundingpath_operation); + } else { + mp_set_up_boundingpath(mp, p); + } + break; + case mp_arc_time_operation: + if (mp->cur_exp.type == mp_pair_type) { + mp_pair_to_path(mp); + } + if ((mp->cur_exp.type == mp_path_type) && (mp_type(p) == mp_known_type)) { + memset(&new_expr, 0, sizeof(mp_value)); + new_number(new_expr.data.n); + mp_get_arc_time(mp, &new_expr.data.n, cur_exp_knot, &(mp_get_value_number(p)), 0); + mp_flush_cur_exp(mp, new_expr); + } else { + mp_bad_binary(mp, p, (int) c); + } + break; + case mp_arc_point_operation: + if (mp->cur_exp.type == mp_pair_type) { + mp_pair_to_path(mp); + } + if ((mp->cur_exp.type == mp_path_type) && (mp_type(p) == mp_known_type || mp_type(p) == mp_pair_type)) { + mp_knot k; + memset(&new_expr, 0, sizeof(mp_value)); + new_number(new_expr.data.n); + if (mp_type(p) == mp_pair_type) { + mp_knot f = cur_exp_knot; + mp_node q = mp_get_value_node(p); + mp_number x; + new_number_clone(x, mp_get_value_number(mp_x_part(q))); + if (number_greater(x, zero_t)) { + while (number_greater(x, zero_t)) { + f = mp_next_knot(f); + number_subtract(x, unity_t); + } + } else { + while (number_less(x, zero_t)) { + f = mp_next_knot(f); + number_add(x, unity_t); + } + } + k = mp_get_arc_time(mp, &new_expr.data.n, f, &(mp_get_value_number(mp_y_part(q))), 1); + free_number(x); + } else { + k = mp_get_arc_time(mp, &new_expr.data.n, cur_exp_knot, &(mp_get_value_number(p)), 1); + } + if (k) { + int toss = 0; + if (number_equal(new_expr.data.n, unity_t)) { + k = mp_next_knot(k); + } else if (! number_equal(new_expr.data.n, zero_t)) { + convert_scaled_to_fraction(new_expr.data.n); + k = mp_split_cubic_knot(mp, k, &new_expr.data.n); + toss = 1; + } + mp_pair_value(mp, &(k->x_coord), &(k->y_coord)); + if (toss) { + mp_toss_knot(mp, k); + } + } else { + mp_bad_unary(mp, mp_arc_point_operation); + } + } else { + mp_bad_unary(mp, mp_arc_point_operation); + } + break; + case mp_arc_point_list_operation: + + if (mp->cur_exp.type == mp_pair_type) { + mp_pair_to_path(mp); + } + if ((mp->cur_exp.type == mp_path_type) && mp_type(p) == mp_known_type) { + + mp_knot cur = cur_exp_knot; + mp_number len, aln, seg, tot, tim, stp, acc, tmp; + mp_knot last = NULL; + mp_knot list = NULL; + int iscycle = mp_left_type(cur_exp_knot) == mp_explicit_knot; + new_number(len); + mp_path_length(mp, &len); + new_number(aln); + mp_get_arc_length(mp, &aln, cur_exp_knot); + new_number(seg); + new_number(tot); + new_number(tim); + new_number(stp); + set_number_from_div(stp, aln, mp_get_value_number(p)); + new_number(acc); + mp_get_subarc_length(mp, &acc, cur_exp_knot, &zero_t, &unity_t); + new_number(tmp); + memset(&new_expr, 0, sizeof(mp_value)); + new_number(new_expr.data.n); + list = mp_complex_knot(mp, cur_exp_knot); + mp_prev_knot(list) = list; + mp_next_knot(list) = list; + last = list; + number_clone(tot, stp); + while (number_lessequal(tot, aln)) { + mp_knot k; + while (1) { + if (number_lessequal(tot, acc)) { + break; + } else { + number_add(seg, unity_t); + number_clone(tim, acc); + cur = mp_next_knot(cur); + mp_get_subarc_length(mp, &tmp, cur, &zero_t, &unity_t); + number_add(acc, tmp) ; + } + } + number_clone(tmp, tot); + number_subtract(tmp, tim); + k = mp_get_arc_time(mp, &new_expr.data.n, cur, &tmp, 1); + if (k) { + int toss = 0; + mp_knot kk; + if (number_equal(new_expr.data.n, unity_t)) { + k = mp_next_knot(k); + } else if (! number_equal(new_expr.data.n, zero_t)) { + convert_scaled_to_fraction(new_expr.data.n); + k = mp_split_cubic_knot(mp, k, &new_expr.data.n); + toss = 1; + } + kk = mp_complex_knot(mp, k); + mp_prev_knot(list) = kk; + mp_next_knot(kk) = list; + mp_prev_knot(kk) = last; + mp_next_knot(last) = kk; + last = kk; + if (toss) { + mp_toss_knot(mp, k); + } + number_add(tot, stp); + } else { + break; + } + } + free_number(len); + free_number(aln); + free_number(seg); + free_number(tot); + free_number(tim); + free_number(stp); + free_number(acc); + free_number(tmp); + if (list) { + if (iscycle) { + mp_left_type(list) = mp_explicit_knot; + mp_right_type(last) = mp_explicit_knot; + } else { + mp_left_type(list) = mp_endpoint_knot; + mp_right_type(last) = mp_endpoint_knot; + } + mp->cur_exp.type = mp_path_type; + mp_set_cur_exp_knot(mp, list); + } else { + mp_bad_unary(mp, mp_arc_point_list_operation); + } + } else { + mp_bad_unary(mp, mp_arc_point_list_operation); + } + break; + case mp_subarc_length_operation: + if (mp->cur_exp.type == mp_pair_type) { + mp_pair_to_path(mp); + } + if ((mp->cur_exp.type == mp_path_type) && mp_type(p) == mp_pair_type) { + memset(&new_expr, 0, sizeof(mp_value)); + new_number(new_expr.data.n); + mp_node q = mp_get_value_node(p); + mp_get_subarc_length(mp, &new_expr.data.n, cur_exp_knot, &(mp_get_value_number(mp_x_part(q))), &(mp_get_value_number(mp_y_part(q)))); + mp_flush_cur_exp(mp, new_expr); + } else { + mp_bad_unary(mp, mp_subarc_length_operation); + } + break; + case mp_intertimes_operation: + case mp_intertimes_list_operation: + if (mp_type(p) == mp_pair_type) { + mp_node q = mp_stash_cur_exp(mp); + mp_unstash_cur_exp(mp, p); + mp_pair_to_path(mp); + p = mp_stash_cur_exp(mp); + mp_unstash_cur_exp(mp, q); + } + if (mp->cur_exp.type == mp_pair_type) { + mp_pair_to_path(mp); + } + if ((mp->cur_exp.type == mp_path_type) && (mp_type(p) == mp_path_type)) { + if (c == mp_intertimes_operation) { + + mp_path_intersection(mp, mp_get_value_knot(p), cur_exp_knot, 0, NULL); + mp_pair_value(mp, &mp->cur_t, &mp->cur_tt); + } else { + mp_knot last = NULL; + mp_knot list = mp_path_intersection(mp, mp_get_value_knot(p), cur_exp_knot, 1, &last); + mp_left_type(list) = mp_endpoint_knot; + mp_right_type(last) = mp_endpoint_knot; + mp->cur_exp.type = mp_path_type; + mp_set_cur_exp_knot(mp, list); + } + } else { + mp_bad_binary(mp, p, c); + } + break; + } + mp_recycle_value(mp, p); + mp_free_value_node(mp, p); + mp_finish_binary(mp, old_p, old_exp); +} + +static void mp_frac_mult (MP mp, mp_number *n, mp_number *d) +{ + mp_node old_exp; + mp_number v; + new_fraction(v); + if (number_greater(internal_value(mp_tracing_commands_internal), two_t)) { + mp_begin_diagnostic(mp); + mp_print_nl(mp, "{("); + print_number(*n); + mp_print_chr(mp, '/'); + print_number(*d); + mp_print_str(mp, ")*("); + mp_print_exp(mp, NULL, 0); + mp_print_str(mp, ")}"); + mp_end_diagnostic(mp, 0); + } + switch (mp->cur_exp.type) { + case mp_transform_type: + case mp_color_type: + case mp_cmykcolor_type: + case mp_pair_type: + old_exp = mp_tarnished(mp, cur_exp_node); + break; + case mp_independent_type: + old_exp = MP_VOID; + break; + default: + old_exp = NULL; + break; + } + if (old_exp != NULL) { + old_exp = cur_exp_node; + mp_make_exp_copy(mp, old_exp); + } + make_fraction(v, *n, *d); + switch (mp->cur_exp.type) { + case mp_known_type: + { + mp_number r1, arg1; + new_fraction(r1); + new_number_clone(arg1, cur_exp_value_number); + take_fraction(r1, arg1, v); + mp_set_cur_exp_value_number(mp, &r1); + free_number(r1); + free_number(arg1); + } + break; + case mp_pair_type: + { + mp_dep_mult(mp, (mp_value_node) mp_x_part(mp_get_value_node(cur_exp_node)), &v, 0); + mp_dep_mult(mp, (mp_value_node) mp_y_part(mp_get_value_node(cur_exp_node)), &v, 0); + } + break; + case mp_color_type: + { + mp_dep_mult(mp, (mp_value_node) mp_red_part (mp_get_value_node(cur_exp_node)), &v, 0); + mp_dep_mult(mp, (mp_value_node) mp_green_part(mp_get_value_node(cur_exp_node)), &v, 0); + mp_dep_mult(mp, (mp_value_node) mp_blue_part (mp_get_value_node(cur_exp_node)), &v, 0); + } + break; + case mp_cmykcolor_type: + { + mp_dep_mult(mp, (mp_value_node) mp_cyan_part (mp_get_value_node(cur_exp_node)), &v, 0); + mp_dep_mult(mp, (mp_value_node) mp_magenta_part(mp_get_value_node(cur_exp_node)), &v, 0); + mp_dep_mult(mp, (mp_value_node) mp_yellow_part (mp_get_value_node(cur_exp_node)), &v, 0); + mp_dep_mult(mp, (mp_value_node) mp_black_part (mp_get_value_node(cur_exp_node)), &v, 0); + } + break; + default: + { + mp_dep_mult(mp, NULL, &v, 0); + } + break; + } + if (old_exp != NULL) { + mp_recycle_value(mp, old_exp); + mp_free_value_node(mp, old_exp); + } + free_number(v); +} + +static void worry_about_bad_statement (MP mp); + +static void flush_unparsable_junk_after_statement (MP mp); + +void mp_do_statement (MP mp) +{ + mp->cur_exp.type = mp_vacuous_type; + mp_get_x_next(mp); + if (cur_cmd > mp_max_primary_command) { + worry_about_bad_statement(mp); + } else if (cur_cmd > mp_max_statement_command) { + mp_value new_expr; + mp->var_flag = mp_assignment_command; + mp_scan_expression(mp); + if (cur_cmd < mp_end_group_command) { + if (cur_cmd == mp_equals_command) { + mp_do_equation(mp); + } else if (cur_cmd == mp_assignment_command) { + mp_do_assignment(mp); + } else if (mp->cur_exp.type == mp_string_type) { + if (number_positive(internal_value(mp_tracing_titles_internal))) { + mp_print_nl(mp, ""); + mp_print_mp_str(mp, cur_exp_str); + update_terminal(); + } + } else if (mp->cur_exp.type != mp_vacuous_type) { + mp_disp_err(mp, NULL); + mp_back_error( + mp, + "Isolated expression", + "I couldn't find an '=' or ':=' after the expression that is shown above this\n" + "error message, so I guess I'll just ignore it and carry on." + ); + mp_get_x_next(mp); + } + memset(&new_expr, 0, sizeof(mp_value)); + new_number(new_expr.data.n); + mp_flush_cur_exp(mp, new_expr); + mp->cur_exp.type = mp_vacuous_type; + } + } else { + if (number_positive(internal_value(mp_tracing_commands_internal))) { + mp_show_cmd_mod(mp, cur_cmd, cur_mod); + } + switch (cur_cmd) { + case mp_type_name_command: + mp_do_type_declaration(mp); + break; + case mp_macro_def_command: + switch (cur_mod) { + case mp_def_code: + case mp_var_def_code: + mp_scan_def(mp, cur_mod); + break; + case mp_primary_def_code: + case mp_secondary_def_code: + case mp_tertiary_def_code: + mp_make_op_def(mp, cur_mod); + break; + } + break; + case mp_only_set_command: + switch (cur_mod) { + case mp_random_seed_code: + mp_do_random_seed(mp); + break; + case mp_max_knot_pool_code: + mp_do_max_knot_pool(mp); + break; + } + break; + case mp_mode_command: + mp_print_ln(mp); + mp->interaction = cur_mod; + mp->selector = mp->interaction == mp_batch_mode ? mp_log_only_selector : mp_term_and_log_selector; + mp_get_x_next(mp); + break; + case mp_protection_command: + mp_do_protection(mp); + break; + case mp_property_command: + mp_do_property(mp); + break; + case mp_delimiters_command: + mp_def_delims(mp); + break; + case mp_save_command: + do { + mp_get_symbol(mp); + mp_save_variable(mp, cur_sym); + mp_get_x_next(mp); + } while (cur_cmd == mp_comma_command); + break; + case mp_interim_command: + mp_do_interim(mp); + break; + case mp_let_command: + mp_do_let(mp); + break; + case mp_new_internal_command: + mp_do_new_internal(mp); + break; + case mp_show_command: + mp_do_show_whatever(mp); + break; + case mp_add_to_command: + mp_do_add_to(mp); + break; + case mp_bounds_command: + mp_do_bounds(mp); + break; + case mp_ship_out_command: + mp_do_ship_out(mp); + break; + case mp_every_job_command: + mp_get_symbol(mp); + mp->every_job_sym = cur_sym; + mp_get_x_next(mp); + break; + case mp_message_command: + mp_do_message(mp); + break; + case mp_write_command: + mp_do_write(mp); + break; + default: + break; + } + mp->cur_exp.type = mp_vacuous_type; + } + if (cur_cmd < mp_semicolon_command) { + flush_unparsable_junk_after_statement(mp); + } + mp->error_count = 0; +} + +static void worry_about_bad_statement (MP mp) +{ + if (cur_cmd < mp_semicolon_command) { + char msg[256]; + mp_string sname; + int selector = mp->selector; + mp->selector = mp_new_string_selector; + mp_print_cmd_mod(mp, cur_cmd, cur_mod); + sname = mp_make_string(mp); + mp->selector = selector; + mp_snprintf(msg, 256, "A statement can't begin with '%s'", mp_str(mp, sname)); + delete_str_ref(sname); + mp_back_error( + mp, + msg, + "I was looking for the beginning of a new statement. If you just proceed without\n" + "changing anything, I'll ignore everything up to the next ';'." + ); + mp_get_x_next(mp); + } +} + +static void flush_unparsable_junk_after_statement (MP mp) +{ + mp_back_error( + mp, + "Extra tokens will be flushed", + "I've just read as much of that statement as I could fathom, so a semicolon should\n" + "have been next. It's very puzzling ... but I'll try to get myself back together,\n" + "by ignoring everything up to the next ';'." + ); + mp->scanner_status = mp_flushing_state; + do { + get_t_next(mp); + if (cur_cmd == mp_string_command) { + delete_str_ref(cur_mod_str); + } + } while (! mp_end_of_statement); + mp->scanner_status = mp_normal_state; +} + +static void trace_equation (MP mp, mp_node lhs) +{ + mp_begin_diagnostic(mp); + mp_print_nl(mp, "{("); + mp_print_exp(mp, lhs, 0); + mp_print_str(mp, ")=("); + mp_print_exp(mp, NULL, 0); + mp_print_str(mp, ")}"); + mp_end_diagnostic(mp, 0); +} + +void mp_do_equation (MP mp) +{ + mp_node lhs = mp_stash_cur_exp(mp); + mp_get_x_next(mp); + mp->var_flag = mp_assignment_command; + mp_scan_expression(mp); + if (cur_cmd == mp_equals_command) { + mp_do_equation(mp); + } else if (cur_cmd == mp_assignment_command) { + mp_do_assignment(mp); + } + if (number_greater(internal_value(mp_tracing_commands_internal), two_t)) { + trace_equation(mp, lhs); + } + if (mp->cur_exp.type == mp_unknown_path_type) { + if (mp_type(lhs) == mp_pair_type) { + mp_node p; + p = mp_stash_cur_exp(mp); + mp_unstash_cur_exp(mp, lhs); + lhs = p; + } + } + mp_make_eq(mp, lhs); +} + +static void bad_lhs (MP mp) +{ + mp_disp_err(mp, NULL); + mp_error( + mp, + "Improper ':=' will be changed to '='", + "I didn't find a variable name at the left of the ':=', so I'm going to pretend\n" + "that you said '=' instead." + ); + mp_do_equation(mp); +} + +static void bad_internal_assignment (MP mp, mp_node lhs) +{ + char msg[256]; + mp_disp_err(mp, NULL); + if (internal_type(mp_get_sym_info(lhs)) == mp_known_type) { + mp_snprintf(msg, 256, + "Internal quantity '%s' must receive a known numeric value", + internal_name(mp_get_sym_info(lhs)) + ); + mp_back_error( + mp, + msg, + "I can't set this internal quantity to anything but a known numeric value, so I'll\n" + "have to ignore this assignment." + ); + } else if (internal_type(mp_get_sym_info(lhs)) == mp_boolean_type) { + mp_snprintf(msg, 256, + "Internal quantity '%s' must receive a known boolean value", + internal_name(mp_get_sym_info(lhs)) + ); + mp_back_error( + mp, + msg, + "I can't set this internal quantity to anything but a known boolean value, so I'll\n" + "have to ignore this assignment." + ); + } else { + mp_snprintf(msg, 256, + "Internal quantity '%s' must receive a known string", + internal_name(mp_get_sym_info(lhs)) + ); + mp_back_error( + mp, + msg, + "I can't set this internal quantity to anything but a known string value, so I'll\n" + "have to ignore this assignment." + ); + } + mp_get_x_next(mp); +} + +static void forbidden_internal_assignment (MP mp, mp_node lhs) +{ + char msg[256]; + mp_snprintf(msg, 256,"Internal quantity '%s' is read-only", internal_name(mp_get_sym_info(lhs))); + mp_back_error( + mp, + msg, + "I can't set this internal quantity to anything just yet (it is read-only), so\n" + "I'll have to ignore this assignment." + ); + mp_get_x_next(mp); +} + +static void bad_internal_assignment_precision (MP mp, mp_node lhs, mp_number *min, mp_number *max) +{ + char msg[256]; + char hlp[256]; + mp_snprintf(msg, 256, + "Bad '%s' has been ignored", + internal_name(mp_get_sym_info(lhs))); + mp_snprintf(hlp, 256, + "Precision values are limited by the current numbersystem.\n" + "Currently I am using '%s'; the allowed precision range is [%s,%s].", + mp_str(mp, internal_string(mp_number_system_internal)), number_tostring(*min), number_tostring(*max)); + mp_back_error(mp, msg, hlp); + mp_get_x_next(mp); +} + +static void bad_expression_assignment (MP mp, mp_node lhs) +{ + char *msg = mp_obliterated(mp, lhs); + mp_back_error( + mp, + msg, + "It seems you did a nasty thing --- probably by accident, but nevertheless you\n" + "nearly hornswoggled me ... While I was evaluating the right-hand side of this\n" + "command, something happened, and the left-hand side is no longer a variable! So I\n" + "won't change anything." + ); + mp_memory_free(msg); + mp_get_x_next(mp); +} + +static void trace_assignment (MP mp, mp_node lhs) +{ + mp_begin_diagnostic(mp); + mp_print_nl(mp, "{"); + if (mp_name_type(lhs) == mp_internal_operation) { + mp_print_str(mp, internal_name(mp_get_sym_info(lhs))); + } else { + mp_show_token_list(mp, lhs, NULL); + } + mp_print_str(mp, ":="); + mp_print_exp(mp, NULL, 0); + mp_print_chr(mp, '}'); + mp_end_diagnostic(mp, 0); +} + +void mp_do_assignment (MP mp) +{ + if (mp->cur_exp.type != mp_token_list_type) { + bad_lhs(mp); + } else { + mp_node lhs = cur_exp_node; + mp->cur_exp.type = mp_vacuous_type; + mp_get_x_next(mp); + mp->var_flag = mp_assignment_command; + mp_scan_expression(mp); + if (cur_cmd == mp_equals_command) { + mp_do_equation(mp); + } else if (cur_cmd == mp_assignment_command) { + mp_do_assignment(mp); + } + if (number_greater(internal_value(mp_tracing_commands_internal), two_t)) { + trace_assignment (mp, lhs); + } + if (mp_name_type(lhs) == mp_internal_operation) { + switch (mp->cur_exp.type) { + case mp_known_type: + case mp_string_type: + case mp_boolean_type: + if (internal_type(mp_get_sym_info(lhs)) == mp->cur_exp.type) { + switch (mp_get_sym_info(lhs)) { + case mp_number_system_internal: + forbidden_internal_assignment(mp, lhs); + break; + + case mp_number_precision_internal: + if (mp->cur_exp.type == mp_known_type + && (! number_less (cur_exp_value_number, precision_min)) + && (! number_greater(cur_exp_value_number, precision_max)) + ) { + if (internal_type(mp_get_sym_info(lhs)) == mp_string_type) { + add_str_ref(cur_exp_str); + set_internal_string(mp_get_sym_info(lhs), cur_exp_str); + } else { + number_clone(internal_value(mp_get_sym_info(lhs)), cur_exp_value_number); + } + set_precision(); + } else { + bad_internal_assignment_precision(mp, lhs, &precision_min, &precision_max); + } + default: + if (internal_type(mp_get_sym_info(lhs)) == mp_string_type) { + add_str_ref(cur_exp_str); + set_internal_string(mp_get_sym_info(lhs), cur_exp_str); + } else { + number_clone(internal_value(mp_get_sym_info(lhs)), cur_exp_value_number); + } + break; + } + } else { + bad_internal_assignment(mp, lhs); + } + break; + default: + bad_internal_assignment(mp, lhs); + } + } else { + mp_node p = mp_find_variable(mp, lhs); + if (p != NULL) { + mp_node q = mp_stash_cur_exp(mp); + mp->cur_exp.type = mp_und_type(mp, p); + mp_recycle_value(mp, p); + mp_type(p) = mp->cur_exp.type; + mp_set_value_number(p, zero_t); + mp_make_exp_copy(mp, p); + p = mp_stash_cur_exp(mp); + mp_unstash_cur_exp(mp, q); + mp_make_eq(mp, p); + } else { + bad_expression_assignment(mp, lhs); + } + } + mp_flush_node_list(mp, lhs); + } +} + +static void announce_bad_equation (MP mp, mp_node lhs) +{ + char msg[256]; + mp_snprintf(msg, 256, + "Equation cannot be performed (%s=%s)", + (mp_type(lhs) <= mp_pair_type ? mp_type_string(mp_type(lhs)) : "numeric"), + (mp->cur_exp.type <= mp_pair_type ? mp_type_string(mp->cur_exp.type) : "numeric")); + mp_disp_err(mp, lhs); + mp_disp_err(mp, NULL); + mp_back_error( + mp, + msg, + "I'm sorry, but I don't know how to make such things equal. (See the two\n" + "expressions just above the error message.)" + ); + mp_get_x_next(mp); +} + +static void mp_exclaim_inconsistent_equation (MP mp) +{ + mp_back_error( + mp, + "Inconsistent equation", + "The equation I just read contradicts what was said before. But don't worry;\n" + "continue and I'll just ignore it." + ); + mp_get_x_next(mp); +} + +static void mp_exclaim_redundant_or_inconsistent_equation (MP mp) +{ + mp_back_error( + mp, + "Redundant or inconsistent equation", + "An equation between already-known quantities can't help. But don't worry;\n" + "continue and I'll just ignore it." + ); + mp_get_x_next(mp); +} + +static void report_redundant_or_inconsistent_equation (MP mp, mp_node lhs, mp_number *v) +{ + if (mp->cur_exp.type <= mp_string_type) { + if (mp->cur_exp.type == mp_string_type) { + if (mp_str_vs_str(mp, mp_get_value_str(lhs), cur_exp_str) != 0) { + mp_exclaim_inconsistent_equation(mp); + } else { + mp_exclaim_redundant_equation(mp); + } + } else if (number_equal(*v, cur_exp_value_number)) { + mp_exclaim_redundant_equation(mp); + } else { + mp_exclaim_inconsistent_equation(mp); + } + } else { + mp_exclaim_redundant_or_inconsistent_equation(mp); + } +} + +void mp_make_eq (MP mp, mp_node lhs) +{ + mp_value new_expr; + mp_variable_type t; + mp_number v; + memset(&new_expr, 0, sizeof(mp_value)); + new_number(v); + RESTART: + t = mp_type(lhs); + if (t <= mp_pair_type) { + number_clone(v, mp_get_value_number(lhs)); + } + switch (t) { + case mp_boolean_type: + case mp_string_type: + case mp_pen_type: + case mp_nep_type: + case mp_path_type: + case mp_picture_type: + if (mp->cur_exp.type == t + unknown_tag) { + new_number(new_expr.data.n); + switch (t) { + case mp_boolean_type: + number_clone(new_expr.data.n, v); + break; + case mp_string_type: + new_expr.data.str = mp_get_value_str(lhs); + break; + case mp_picture_type: + new_expr.data.node = mp_get_value_node(lhs); + break; + default: + new_expr.data.p = mp_get_value_knot(lhs); + break; + } + mp_nonlinear_eq(mp, new_expr, cur_exp_node, 0); + mp_unstash_cur_exp(mp, cur_exp_node); + } else if (mp->cur_exp.type == t) { + report_redundant_or_inconsistent_equation(mp, lhs, &v); + } else { + announce_bad_equation(mp, lhs); + } + break; + case mp_unknown_boolean_type: + case mp_unknown_string_type: + case mp_unknown_pen_type: + case mp_unknown_nep_type: + case mp_unknown_path_type: + case mp_unknown_picture_type: + if (mp->cur_exp.type == t - unknown_tag) { + mp_nonlinear_eq(mp, mp->cur_exp, lhs, 1); + } else if (mp->cur_exp.type == t) { + mp_ring_merge (mp, lhs, cur_exp_node); + } else if (mp->cur_exp.type == mp_pair_type) { + if (t == mp_unknown_path_type) { + mp_pair_to_path(mp); + goto RESTART; + } + } else { + announce_bad_equation(mp, lhs); + } + break; + case mp_transform_type: + case mp_color_type: + case mp_cmykcolor_type: + case mp_pair_type: + if (mp->cur_exp.type == t) { + mp_node q = mp_get_value_node(cur_exp_node); + mp_node p = mp_get_value_node(lhs); + switch (t) { + case mp_transform_type: + mp_try_eq(mp, mp_yy_part(p), mp_yy_part(q)); + mp_try_eq(mp, mp_yx_part(p), mp_yx_part(q)); + mp_try_eq(mp, mp_xy_part(p), mp_xy_part(q)); + mp_try_eq(mp, mp_xx_part(p), mp_xx_part(q)); + mp_try_eq(mp, mp_ty_part(p), mp_ty_part(q)); + mp_try_eq(mp, mp_tx_part(p), mp_tx_part(q)); + break; + case mp_color_type: + mp_try_eq(mp, mp_blue_part(p), mp_blue_part(q)); + mp_try_eq(mp, mp_green_part(p), mp_green_part(q)); + mp_try_eq(mp, mp_red_part(p), mp_red_part(q)); + break; + case mp_cmykcolor_type: + mp_try_eq(mp, mp_black_part(p), mp_black_part(q)); + mp_try_eq(mp, mp_yellow_part(p), mp_yellow_part(q)); + mp_try_eq(mp, mp_magenta_part(p), mp_magenta_part(q)); + mp_try_eq(mp, mp_cyan_part(p), mp_cyan_part(q)); + break; + case mp_pair_type: + mp_try_eq(mp, mp_y_part(p), mp_y_part(q)); + mp_try_eq(mp, mp_x_part(p), mp_x_part(q)); + break; + default: + break; + } + } else { + announce_bad_equation(mp, lhs); + } + break; + case mp_known_type: + case mp_dependent_type: + case mp_proto_dependent_type: + case mp_independent_type: + if (mp->cur_exp.type >= mp_known_type) { + mp_try_eq(mp, lhs, NULL); + } else { + announce_bad_equation(mp, lhs); + } + break; + case mp_vacuous_type: + announce_bad_equation(mp, lhs); + break; + default: + announce_bad_equation(mp, lhs); + break; + } + check_arith(); + mp_recycle_value(mp, lhs); + free_number(v); + mp_free_value_node(mp, lhs); +} + +static void deal_with_redundant_or_inconsistent_equation (MP mp, mp_value_node p, mp_node r) +{ + mp_number absp; + new_number_abs(absp, mp_get_value_number(p)); + if (number_greater(absp, equation_threshold_k)) { + char msg[256]; + mp_snprintf(msg, 256, "Inconsistent equation (off by %s)", number_tostring (mp_get_value_number(p))); + mp_back_error( + mp, + msg, + "The equation I just read contradicts what was said before. But don't worry;\n" + "continue and I'll just ignore it." + ); + mp_get_x_next(mp); + } else if (r == NULL) { + mp_exclaim_redundant_equation(mp); + } + free_number(absp); + mp_free_dep_node(mp, p); +} + +void mp_try_eq (MP mp, mp_node l, mp_node r) +{ + mp_value_node p; + mp_value_node q; + mp_value_node pp; + mp_variable_type tt; + int copied; + mp_variable_type t = mp_type(l); + switch (t) { + case mp_known_type: + { + mp_number arg1; + new_number(arg1); + number_negated_clone(arg1, mp_get_value_number(l)); + t = mp_dependent_type; + p = mp_const_dependency(mp, &arg1); + q = p; + free_number(arg1); + } + break; + case mp_independent_type: + { + t = mp_dependent_type; + p = mp_single_dependency(mp, l); + number_negate(mp_get_dep_value(p)); + q = mp->dep_final; + } + break; + default: + { + mp_value_node ll = (mp_value_node) l; + p = (mp_value_node) mp_get_dep_list(ll); + q = p; + while (1) { + number_negate(mp_get_dep_value(q)); + if (mp_get_dep_info(q) == NULL) { + break; + } else { + q = (mp_value_node) mp_link(q); + } + } + mp_link(mp_get_prev_dep(ll)) = mp_link(q); + mp_set_prev_dep((mp_value_node) mp_link(q), mp_get_prev_dep(ll)); + mp_type(ll) = mp_known_type; + } + break; + } + if (r == NULL) { + if (mp->cur_exp.type == mp_known_type) { + number_add(mp_get_value_number(q), cur_exp_value_number); + goto DONE1; + } else { + tt = mp->cur_exp.type; + if (tt == mp_independent_type) { + pp = mp_single_dependency(mp, cur_exp_node); + } else { + pp = (mp_value_node) mp_get_dep_list((mp_value_node) cur_exp_node); + } + } + } else if (mp_type(r) == mp_known_type) { + number_add(mp_get_dep_value(q), mp_get_value_number(r)); + goto DONE1; + } else { + tt = mp_type(r); + if (tt == mp_independent_type) { + pp = mp_single_dependency(mp, r); + } else { + pp = (mp_value_node) mp_get_dep_list((mp_value_node) r); + } + } + if (tt != mp_independent_type) { + copied = 0; + } else { + copied = 1; + tt = mp_dependent_type; + } + mp->watch_coefs = 0; + if (t == tt) { + p = mp_p_plus_q(mp, p, pp, (int) t); + } else if (t == mp_proto_dependent_type) { + p = mp_p_plus_fq(mp, p, &unity_t, pp, mp_proto_dependent_type, mp_dependent_type); + } else { + mp_number x; + new_number(x); + q = p; + while (mp_get_dep_info(q) != NULL) { + number_clone(x, mp_get_dep_value(q)); + fraction_to_round_scaled(x); + mp_set_dep_value(q, x); + q = (mp_value_node) mp_link(q); + } + free_number(x); + t = mp_proto_dependent_type; + p = mp_p_plus_q(mp, p, pp, (int) t); + } + mp->watch_coefs = 1; + if (copied) { + mp_flush_node_list(mp, (mp_node) pp); + } + DONE1: + if (mp_get_dep_info(p) == NULL) { + deal_with_redundant_or_inconsistent_equation(mp, p, r); + } else { + mp_linear_eq(mp, p, (int) t); + if (r == NULL && mp->cur_exp.type != mp_known_type && mp_type(cur_exp_node) == mp_known_type) { + mp_node pp = cur_exp_node; + mp_set_cur_exp_value_number(mp, &(mp_get_value_number(pp))); + mp->cur_exp.type = mp_known_type; + mp_free_value_node(mp, pp); + } + } +} + +mp_node mp_scan_declared_variable (MP mp) +{ + mp_sym x; + mp_node h, t; + mp_get_symbol(mp); + x = cur_sym; + if (cur_cmd != mp_tag_command) { + mp_clear_symbol(mp, x, 0); + } + h = mp_new_symbolic_node(mp); + mp_set_sym_sym(h, x); + t = h; + while (1) { + mp_get_x_next(mp); + if (cur_sym == NULL) { + break; + } else if (cur_cmd != mp_tag_command) { + if (cur_cmd != mp_internal_command) { + if (cur_cmd == mp_left_bracket_command) { + mp_sym ll = cur_sym; + mp_get_x_next(mp); + if (cur_cmd == mp_right_bracket_command) { + set_cur_sym(mp_collective_subscript); + } else { + mp_back_input(mp); + set_cur_sym(ll); + set_cur_cmd(mp_left_bracket_command); + break; + } + } else { + break; + } + } + } + mp_link(t) = mp_new_symbolic_node(mp); + t = mp_link(t); + mp_set_sym_sym(t, cur_sym); + mp_name_type(t) = cur_sym_mod; + } + if (eq_property(x) != 0) { + mp_check_overload(mp, x); + } + if (eq_type(x) != mp_tag_command) { + mp_clear_symbol(mp, x, 0); + } + if (equiv_node(x) == NULL) { + mp_new_root (mp, x); + } + return h; +} + +static void flush_spurious_symbols_after_declared_variable (MP mp); + +void mp_do_type_declaration (MP mp) +{ + int t = mp_numeric_type; + switch (cur_mod) { + case mp_string_type_operation: t = mp_unknown_string_type; break; + case mp_boolean_type_operation: t = mp_unknown_boolean_type; break; + case mp_path_type_operation: t = mp_unknown_path_type; break; + case mp_pen_type_operation: t = mp_unknown_pen_type; break; + case mp_nep_type_operation: t = mp_unknown_nep_type; break; + case mp_picture_type_operation: t = mp_unknown_picture_type; break; + case mp_transform_type_operation: t = mp_transform_type; break; + case mp_color_type_operation: t = mp_color_type; break; + case mp_cmykcolor_type_operation: t = mp_cmykcolor_type; break; + case mp_pair_type_operation: t = mp_pair_type; break; + case mp_numeric_type_operation: t = mp_numeric_type; break; + } + do { + mp_node p = mp_scan_declared_variable(mp); + mp_node q; + mp_flush_variable(mp, equiv_node(mp_get_sym_sym(p)), mp_link(p), 0); + q = mp_find_variable(mp, p); + if (q != NULL) { + mp_type(q) = t; + mp_set_value_number(q, zero_t); + } else { + mp_back_error( + mp, + "Declared variable conflicts with previous vardef", + "You can't use, e.g., 'numeric foo[]' after 'vardef foo'. Proceed, and I'll ignore\n" + "the illegal redeclaration." + ); + mp_get_x_next(mp); + } + mp_flush_node_list(mp, p); + if (cur_cmd < mp_comma_command) { + flush_spurious_symbols_after_declared_variable(mp); + } + } while (! mp_end_of_statement); +} + +static void flush_spurious_symbols_after_declared_variable (MP mp) +{ + const char *hlp = NULL; + if (cur_cmd == mp_numeric_command) { + hlp = + "Variables in declarations must consist entirely of names and explicit subscripts\n" + "like 'x15a' aren't permitted. I'm going to discard the junk I found here, up to the\n" + "next comma or the end of the declaration."; + } else { + hlp = + "Variables in declarations must consist entirely of names and collective\n" + "subscripts, e.g., 'x[]a'. Are you trying to use a reserved word in a variable\n" + "name? I'm going to discard the junk I found here, up to the next comma or the end\n" + "of the declaration."; + } + mp_back_error( + mp, + "Illegal suffix of declared variable will be flushed", + hlp + ); + mp_get_x_next(mp); + mp->scanner_status = mp_flushing_state; + do { + get_t_next(mp); + if (cur_cmd == mp_string_command) { + delete_str_ref(cur_mod_str); + } + } while (cur_cmd < mp_comma_command); + mp->scanner_status = mp_normal_state; +} + +static void mp_main_control (MP mp) { + do { + mp_do_statement(mp); + if (cur_cmd == mp_end_group_command) { + mp_value new_expr; + memset(&new_expr, 0, sizeof(mp_value)); + new_number(new_expr.data.n); + mp_error( + mp, + "Extra 'endgroup'", + "I'm not currently working on a 'begingroup', so I had better not try to end\n" + "anything." + ); + mp_flush_cur_exp(mp, new_expr); + } + } while (cur_cmd != mp_stop_command); +} + +int mp_run (MP mp) +{ + if (mp->history < mp_fatal_error_stop) { + mp_memory_free(mp->jump_buf); + mp->jump_buf = mp_memory_allocate(sizeof(jmp_buf)); + if (mp->jump_buf == NULL || setjmp (*(mp->jump_buf)) != 0) { + return mp->history; + } + mp_main_control(mp); + mp_final_cleanup(mp); + mp_close_files_and_terminate(mp); + } + return mp->history; +} + +void mp_set_internal (MP mp, char *n, char *v, int isstring) +{ + size_t l = strlen(n); + char err[256]; + const char *errid = NULL; + if (l > 0) { + mp_sym p = mp_id_lookup(mp, n, l, 0); + if (p == NULL) { + errid = "variable does not exist"; + } else if (eq_type(p) != mp_internal_command) { + errid = "variable is not an internal"; + } else if ((internal_type(equiv(p)) == mp_string_type) && (isstring)) { + set_internal_string(equiv(p), mp_rts(mp, v)); + } else if ((internal_type(equiv(p)) == mp_known_type) && (! isstring)) { + int test = atoi(v); + if (test > 16383 && mp->math_mode == mp_math_scaled_mode) { + errid = "value is too large"; + } else if (test < -16383 && mp->math_mode == mp_math_scaled_mode) { + errid = "value is too small"; + } else { + number_clone(internal_value(equiv(p)), unity_t); + number_multiply_int(internal_value(equiv(p)), test); + } + } else { + errid = "value has the wrong type"; + } + } + if (errid != NULL) { + if (isstring) { + mp_snprintf(err, 256, "%s=\"%s\": %s, assignment ignored.", n, v, errid); + } else { + mp_snprintf(err, 256, "%s=%d: %s, assignment ignored.", n, atoi (v), errid); + } + mp_warn(mp, err); + } +} + +void mplib_shipout_backend (MP mp, void *voidh) +{ + mp_edge_header_node h = (mp_edge_header_node) voidh; + mp_edge_object *hh = mp_gr_export (mp, h); + if (hh) { + mp_run_data *run = mp_rundata(mp); + if (run->edges == NULL) { + run->edges = hh; + } else { + mp_edge_object *p = run->edges; + while (p->next != NULL) { + p = p->next; + } + p->next = hh; + } + } +} + +mp_run_data *mp_rundata (MP mp) { + return &(mp->run_data); +} + +int mp_execute (MP mp, const char *s, size_t l) +{ + (void) l; + if (mp->finished) { + return mp->history; + } else if (mp->history < mp_fatal_error_stop) { + mp_memory_free(mp->jump_buf); + mp->jump_buf = mp_memory_allocate(sizeof(jmp_buf)); + if (mp->jump_buf == NULL || setjmp (*(mp->jump_buf)) != 0) { + return mp->history; + } else { + mp->term_offset = 0; + mp->file_offset = 0; + if (mp->term_in == NULL) { + mp->term_in = (mp->open_file)(mp,"terminal", "r", mp_filetype_terminal); + mp->last = 0; + } + if (s && l > 0) { + (mp->write_file)(mp, mp->term_in, s); + } else { + } + if (mp->run_state == 0) { + + mp->term_offset = 0; + mp->file_offset = 0; + mp_log_string(mp_term_logging_target, mp->banner); + mp_log_string(mp_term_logging_target, ", running in "); + mp_log_string(mp_term_logging_target, mp_str(mp, internal_string(mp_number_system_internal))); + mp_log_string(mp_term_logging_target, " mode."); + mp_print_ln(mp); + update_terminal(); + + mp->input_ptr = 0; + mp->max_in_stack = mp_file_bottom_text; + mp->in_open = mp_file_bottom_text; + mp->open_parens = 0; + mp->max_buf_stack = 0; + mp->param_ptr = 0; + mp->max_param_stack = 0; + start = loc = 0; + iindex = mp_file_bottom_text; + nloc = nstart = NULL; + mp->first = 0; + line = 0; + name = is_term; + mp->force_eof = 0; + if (mp->term_in == NULL) { + mp->term_in = (mp->open_file)(mp,"terminal", "r", mp_filetype_terminal); + } + mp->last = 0; + mp->scanner_status = mp_normal_state; + mp_fix_date_and_time(mp); + if (mp->random_seed == 0) { + mp->random_seed = (number_to_scaled(internal_value(mp_time_internal))/number_to_scaled(unity_t)) + + number_to_scaled(internal_value(mp_day_internal)); + } + init_randoms(mp->random_seed); + mp->selector = mp->interaction == mp_batch_mode ? mp_no_print_selector : mp_term_only_selector; + mp->history = mp_spotless; + if (mp->every_job_sym != NULL) { + set_cur_sym(mp->every_job_sym); + mp_back_input(mp); + } + } + mp->run_state = 1; + mp_input_ln(mp, mp->term_in); + mp_firm_up_the_line(mp); + mp->buffer[limit] = '%'; + mp->first = (size_t) (limit + 1); + loc = start; + do { + mp_do_statement(mp); + } while (cur_cmd != mp_stop_command); + mp_final_cleanup(mp); + mp_close_files_and_terminate(mp); + } + } + return mp->history; +} + +int mp_finish (MP mp) +{ + int history = 0; + if (mp->finished || mp->history >= mp_fatal_error_stop) { + history = mp->history; + mp_free(mp); + } else { + mp_memory_free(mp->jump_buf); + mp->jump_buf = mp_memory_allocate(sizeof(jmp_buf)); + if (mp->jump_buf == NULL || setjmp (*(mp->jump_buf)) != 0) { + history = mp->history; + } else { + history = mp->history; + mp_final_cleanup(mp); + } + mp_close_files_and_terminate(mp); + mp_free(mp); + } + return history; +} + +char *mp_metapost_version(void) { + return mp_strdup(metapost_version); +} + +void mp_do_max_knot_pool (MP mp) +{ + mp_value new_expr; + memset(&new_expr, 0, sizeof(mp_value)); + new_number(new_expr.data.n); + mp_get_x_next(mp); + if (cur_cmd != mp_assignment_command) { + mp_back_error( + mp, + "Missing ':=' has been inserted", + "Always say 'maxknotpool := <numeric expression>'." + ); + }; + mp_get_x_next(mp); + mp_scan_expression(mp); + if (mp->cur_exp.type != mp_known_type) { + mp_disp_err(mp, NULL); + mp_back_error( + mp, + "Unknown value will be ignored", + "Your expression was too random for me to handle, so I won't change the maximum\n" + "seed just now." + ); + mp_get_x_next(mp); + mp_flush_cur_exp(mp, new_expr); + } else { + int p = (int) number_to_scaled (cur_exp_value_number) / 65536; + if (p > mp->max_knot_nodes) { + mp->max_knot_nodes = p; + } else if (p > max_num_knot_nodes) { + } else { + } + } +} + +void mp_do_random_seed (MP mp) +{ + mp_value new_expr; + memset(&new_expr, 0, sizeof(mp_value)); + new_number(new_expr.data.n); + mp_get_x_next(mp); + if (cur_cmd != mp_assignment_command) { + mp_back_error( + mp, + "Missing ':=' has been inserted", + "Always say 'randomseed := <numeric expression>'." + ); + }; + mp_get_x_next(mp); + mp_scan_expression(mp); + if (mp->cur_exp.type != mp_known_type) { + mp_disp_err(mp, NULL); + mp_back_error( + mp, + "Unknown value will be ignored", + "Your expression was too random for me to handle, so I won't change the random\n" + "seed just now." + ); + mp_get_x_next(mp); + mp_flush_cur_exp(mp, new_expr); + } else { + init_randoms(number_to_scaled(cur_exp_value_number)); + if (mp->interaction < mp_silent_mode && (mp->selector == mp_log_only_selector || mp->selector == mp_term_and_log_selector)) { + int selector = mp->selector; + mp->selector = mp_log_only_selector; + mp_print_nl(mp, "{randomseed:="); + print_number(cur_exp_value_number); + mp_print_chr(mp, '}'); + mp_print_nl(mp, ""); + mp->selector = selector; + } + } +} + +void mp_do_protection (MP mp) +{ + + do { + + mp_get_symbol(mp); + + mp_get_x_next(mp); + } while (cur_cmd == mp_comma_command); +} + +void mp_do_property (MP mp) +{ + int p = 0; + mp_get_x_next(mp); + mp_scan_primary(mp); + switch (mp->cur_exp.type) { + case mp_numeric_type: + case mp_known_type: + { + mp_back_input(mp); + p = (int) number_to_scaled (cur_exp_value_number) / 65536; + } + break; + default: + mp_back_error(mp, "Bad property value", NULL); + break; + } + mp_get_x_next(mp); + if (cur_cmd == mp_colon_command) { + do { + mp_get_symbol(mp); + set_eq_property(cur_sym, p); + mp_get_x_next(mp); + } while (cur_cmd == mp_comma_command); + } else { + mp_back_error(mp, "Bad property specification, colon expected", NULL); + } +} + +void mp_def_delims (MP mp) +{ + mp_sym l_delim, r_delim; + mp_get_clear_symbol(mp); + l_delim = cur_sym; + mp_get_clear_symbol(mp); + r_delim = cur_sym; + set_eq_type(l_delim, mp_left_delimiter_command); + set_equiv_sym(l_delim, r_delim); + set_eq_type(r_delim, mp_right_delimiter_command); + set_equiv_sym(r_delim, l_delim); + mp_get_x_next(mp); +} + +void mp_check_delimiter (MP mp, mp_sym l_delim, mp_sym r_delim) +{ + if (cur_cmd == mp_right_delimiter_command && equiv_sym(cur_sym) == l_delim) { + return; + } else if (cur_sym != r_delim) { + char msg[256]; + mp_snprintf(msg, 256, "Missing '%s' has been inserted", mp_str(mp, text(r_delim))); + mp_back_error( + mp, + msg, + "I found no right delimiter to match a left one. So I've put one in, behind the\n" + "scenes; this may fix the problem." + ); + } else { + char msg[256]; + mp_snprintf(msg, 256, "The token '%s' is no longer a right delimiter", mp_str(mp, text(r_delim))); + mp_error( + mp, + msg, + "Strange: This token has lost its former meaning! I'll read it as a right\n" + "delimiter this time; but watch out, I'll probably miss it later." + ); + } +} + +void mp_do_interim (MP mp) { + mp_get_x_next(mp); + if (cur_cmd != mp_internal_command) { + char msg[256]; + mp_snprintf(msg, 256, + "The token '%s' isn't an internal quantity", + (cur_sym == NULL ? "(%CAPSULE)" : mp_str(mp, text(cur_sym))) + ); + mp_back_error(mp, msg, "Something like 'tracingonline' should follow 'interim'."); + } else { + mp_save_internal(mp, cur_mod); + mp_back_input(mp); + } + mp_do_statement(mp); +} + +void mp_do_let (MP mp) +{ + mp_sym l; + mp_get_symbol(mp); + l = cur_sym; + mp_get_x_next(mp); + if (cur_cmd != mp_equals_command && cur_cmd != mp_assignment_command) { + mp_back_error( + mp, + "Missing '=' has been inserted", + "You should have said 'let symbol = something'. But don't worry; I'll pretend that\n" + "an equals sign was present. The next token I read will be 'something'." + ); + } + mp_get_symbol(mp); + switch (cur_cmd) { + case mp_defined_macro_command: + case mp_primary_def_command: + case mp_secondary_def_command: + case mp_tertiary_def_command: + mp_add_mac_ref(cur_mod_node); + break; + default: + break; + } + mp_clear_symbol(mp, l, 0); + set_eq_type(l, cur_cmd); + switch (cur_cmd) { + case mp_tag_command: + set_equiv(l, 0); + break; + case mp_defined_macro_command: + case mp_primary_def_command: + case mp_secondary_def_command: + case mp_tertiary_def_command: + set_equiv_node(l, cur_mod_node); + break; + case mp_left_delimiter_command: + case mp_right_delimiter_command: + set_equiv_sym(l, equiv_sym(cur_sym)); + break; + default: + set_equiv(l, cur_mod); + break; + } + mp_get_x_next(mp); +} + +void mp_grow_internals (MP mp, int l) +{ + if (l > max_halfword) { + mp_confusion(mp, "out of memory"); + } else { + mp_internal *internal = mp_memory_allocate((size_t) (l + 1) * sizeof(mp_internal)); + for (int k = 0; k <= l; k++) { + if (k <= mp->max_internal) { + memcpy(internal + k, mp->internal + k, sizeof(mp_internal)); + } else { + memset(internal + k, 0, sizeof(mp_internal)); + new_number(((mp_internal *)(internal + k))->v.data.n); + } + } + mp_memory_free(mp->internal); + mp->internal = internal; + mp->max_internal = l; + } +} + +void mp_do_new_internal (MP mp) +{ + int the_type = mp_known_type; + int run_script = 0; + mp_get_next(mp); + if (cur_cmd == mp_type_name_command && cur_mod == mp_string_type_operation) { + the_type = mp_string_type; + } else if (cur_cmd == mp_type_name_command && cur_mod == mp_boolean_type_operation) { + the_type = mp_boolean_type; + } else if (cur_cmd == mp_type_name_command && cur_mod == mp_numeric_type_operation) { + the_type = mp_numeric_type; + } else if (! (cur_cmd == mp_type_name_command && cur_mod == mp_numeric_type_operation)) { + mp_back_input(mp); + } + if (mp_numeric_type == mp_known_type) { + } else { + if (the_type == mp_numeric_type) { + the_type = mp_known_type; + } + mp_get_next(mp); + if (cur_cmd == mp_runscript_command) { + run_script = 1; + } else { + mp_back_input(mp); + } + } + do { + if (mp->int_ptr == mp->max_internal) { + mp_grow_internals(mp, (mp->max_internal + (mp->max_internal / 4))); + } + mp_get_clear_symbol(mp); + ++mp->int_ptr; + set_eq_type(cur_sym, mp_internal_command); + set_equiv(cur_sym, mp->int_ptr); + mp_memory_free(internal_name(mp->int_ptr)); + set_internal_name(mp->int_ptr, mp_strdup(mp_str(mp, text(cur_sym)))); + if (the_type == mp_string_type) { + set_internal_string(mp->int_ptr, mp_rts(mp,"")); + } else { + set_number_to_zero(internal_value(mp->int_ptr)); + } + set_internal_type(mp->int_ptr, the_type); + set_internal_run(mp->int_ptr, run_script); + if (run_script) { + mp->run_internal(mp, 0, mp->int_ptr, the_type, internal_name(mp->int_ptr)); + } + mp_get_x_next(mp); + } while (cur_cmd == mp_comma_command); +} + +void mp_do_show (MP mp) +{ + do { + mp_value new_expr; + memset(&new_expr, 0, sizeof(mp_value)); + new_number(new_expr.data.n); + mp_get_x_next(mp); + mp_scan_expression(mp); + mp_print_nl(mp, ">> "); + mp_print_exp(mp, NULL, 2); + mp_flush_cur_exp(mp, new_expr); + } while (cur_cmd == mp_comma_command); +} + +void mp_disp_token (MP mp) +{ + mp_print_nl(mp, "> "); + if (cur_sym == NULL) { + switch (cur_cmd) { + case mp_numeric_command: + print_number(cur_mod_number); + break; + case mp_capsule_command: + mp_print_capsule(mp, cur_mod_node); + break; + default: + mp_print_chr(mp, '"'); + mp_print_mp_str(mp, cur_mod_str); + mp_print_chr(mp, '"'); + delete_str_ref(cur_mod_str); + break; + } + } else { + mp_print_mp_str(mp,text(cur_sym)); + mp_print_chr(mp, '='); + + mp_print_cmd_mod(mp, cur_cmd, cur_mod); + if (cur_cmd == mp_defined_macro_command) { + mp_print_ln(mp); + mp_show_macro (mp, cur_mod_node, NULL); + } + } +} + +void mp_do_show_token (MP mp) +{ + do { + get_t_next(mp); + mp_disp_token(mp); + mp_get_x_next(mp); + } while (cur_cmd == mp_comma_command); +} + +void mp_do_show_stats (MP mp) +{ + mp_print_nl(mp, "Memory usage "); + mp_print_int(mp, (int) mp->var_used); + mp_print_ln(mp); + mp_print_nl(mp, "String usage "); + mp_print_int(mp, (int) mp->strs_in_use); + mp_print_chr(mp, '&'); + mp_print_int(mp, (int) mp->pool_in_use); + mp_print_ln(mp); + mp_get_x_next(mp); +} + +void mp_disp_var (MP mp, mp_node p) +{ + if (mp_type(p) == mp_structured_type) { + mp_node q = mp_get_attribute_head(p); + do { + mp_disp_var(mp, q); + q = mp_link(q); + } while (q != mp->end_attr); + q = mp_get_subscr_head(p); + while (mp_name_type(q) == mp_subscript_operation) { + mp_disp_var(mp, q); + q = mp_link(q); + } + } else if (mp_type(p) >= mp_unsuffixed_macro_type) { + mp_print_nl(mp, ""); + mp_print_variable_name(mp, p); + if (mp_type(p) > mp_unsuffixed_macro_type) { + mp_print_str(mp, "@#"); + } + mp_print_str(mp, "=macro:"); + mp_show_macro(mp, mp_get_value_node(p), NULL); + } else if (mp_type(p) != mp_undefined_type) { + mp_print_nl(mp, ""); + mp_print_variable_name(mp, p); + mp_print_chr(mp, '='); + mp_print_exp(mp, p, 0); + } +} + +void mp_do_show_var (MP mp) +{ + do { + get_t_next(mp); + if (cur_sym != NULL && cur_sym_mod == 0 && cur_cmd == mp_tag_command) { + if (cur_mod != 0 || cur_mod_node != NULL) { + mp_disp_var(mp, cur_mod_node); + goto DONE; + } + } + mp_disp_token(mp); + DONE: + mp_get_x_next(mp); + } while (cur_cmd == mp_comma_command); +} + +void mp_do_show_dependencies (MP mp) +{ + mp_value_node p = (mp_value_node) mp_link(mp->dep_head); + while (p != mp->dep_head) { + if (mp_interesting(mp, (mp_node) p)) { + mp_print_nl(mp, ""); + mp_print_variable_name(mp, (mp_node) p); + if (mp_type(p) == mp_dependent_type) { + mp_print_chr(mp, '='); + } else { + mp_print_str(mp, " = "); + } + mp_print_dependency(mp, (mp_value_node) mp_get_dep_list(p), mp_type(p)); + } + p = (mp_value_node) mp_get_dep_list(p); + while (mp_get_dep_info(p) != NULL) + p = (mp_value_node) mp_link(p); + p = (mp_value_node) mp_link(p); + } + mp_get_x_next(mp); +} + +void mp_do_show_whatever (MP mp) +{ + if (mp->interaction == mp_error_stop_mode) { + wake_up_terminal(); + } + switch (cur_mod) { + case mp_show_token_code: + mp_do_show_token(mp); + break; + case mp_show_stats_code: + mp_do_show_stats(mp); + break; + case mp_show_code: + mp_do_show(mp); + break; + case mp_show_var_code: + mp_do_show_var(mp); + break; + case mp_show_dependencies_code: + mp_do_show_dependencies(mp); + break; + } + if (number_positive(internal_value(mp_showstopping_internal))) { + const char *hlp = NULL; + if (mp->interaction < mp_error_stop_mode) { + --mp->error_count; + } else { + hlp = "This isn't an error message; I'm just showing something."; + } + if (cur_cmd == mp_semicolon_command) { + mp_error(mp, "OK", hlp); + } else { + mp_back_error(mp, "OK", hlp); + mp_get_x_next(mp); + } + } +} + +static void complain_invalid_with_list (MP mp, mp_variable_type t) +{ + mp_value new_expr; + const char *hlp = NULL; + memset(&new_expr, 0, sizeof(mp_value)); + new_number(new_expr.data.n); + mp_disp_err(mp, NULL); + switch (t) { + case mp_with_pre_script_code: + hlp = + "Next time say 'withprescript <known string expression>'; I'll ignore the bad\n" + "'with' clause and look for another."; + break; + case mp_with_post_script_code: + hlp = + "Next time say 'withpostscript <known string expression>'; I'll ignore the bad\n" + "'with' clause and look for another."; + break; + case mp_with_stacking_code: + hlp = + "Next time say 'withstacking <known numeric expression>'; I'll ignore the bad\n" + "'with' clause and look for another."; + break; + case mp_with_dashed_code: + hlp = + "Next time say 'dashed <known picture expression>'; I'll ignore the bad 'with'\n" + "clause and look for another."; + break; + case mp_with_uninitialized_model_code: + hlp = + "Next time say 'withcolor <known color expression>'; I'll ignore the bad 'with'\n" + "clause and look for another."; + break; + case mp_with_rgb_model_code: + hlp = + "Next time say 'withrgbcolor <known color expression>'; I'll ignore the bad 'with'\n" + "clause and look for another."; + break; + case mp_with_cmyk_model_code: + hlp = + "Next time say 'withcmykcolor <known cmykcolor expression>'; I'll ignore the bad\n" + "'with' clause and look for another."; + break; + case mp_with_grey_model_code: + hlp = + "Next time say 'withgreyscale <known numeric expression>'; I'll ignore the bad\n" + " with' clause and look for another."; + break; + case mp_with_linecap_code: + hlp = + "Next time say 'withlinecap <known numeric expression>'; I'll ignore the bad\n" + "'with' clause and look for another."; + break; + case mp_with_linejoin_code: + hlp = + "Next time say 'withlinejoin <known numeric expression>'; I'll ignore the bad\n" + "'with' clause and look for another."; + break; + case mp_with_miterlimit_code: + hlp = + "Next time say 'miterlimit <known numeric expression>'; I'll ignore the bad\n" + "'with' clause and look for another."; + break; + default: + hlp = + "Next time say 'withpen <known pen expression>'; I'll ignore the bad 'with' clause\n" + "and look for another."; + break; + } + mp_back_error(mp, "Improper type", hlp); + mp_get_x_next(mp); + mp_flush_cur_exp(mp, new_expr); +} + +void mp_scan_with_list (MP mp, mp_node p, mp_node pstop) +{ + mp_node cp = MP_VOID; + mp_node pp = MP_VOID; + mp_node dp = MP_VOID; + mp_node ap = MP_VOID; + mp_node bp = MP_VOID; + mp_node sp = MP_VOID; + mp_node spstop = MP_VOID; + mp_number ml; + int miterlimit = 0; + int linecap = -1; + int linejoin = -1; + while (cur_cmd == mp_with_option_command) { + int t; + CONTINUE: + t = cur_mod; + mp_get_x_next(mp); + if (t != mp_with_no_model_code) { + mp_scan_expression(mp); + } + switch (t) { + case mp_with_uninitialized_model_code : + switch (mp->cur_exp.type) { + case mp_cmykcolor_type: + case mp_color_type: + case mp_known_type: + case mp_boolean_type: + { + mp_value new_expr; + memset(&new_expr, 0, sizeof(mp_value)); + new_number(new_expr.data.n); + if (cp == MP_VOID) { + make_cp_a_colored_object(cp, p); + } + if (cp != NULL) { + switch (mp->cur_exp.type) { + case mp_color_type: + { + mp_node q = mp_get_value_node(cur_exp_node); + mp_color_model(cp) = mp_rgb_model; + set_color_val(mp_red_color(cp), mp_get_value_number(mp_red_part(q))); + set_color_val(mp_green_color(cp), mp_get_value_number(mp_green_part(q))); + set_color_val(mp_blue_color(cp), mp_get_value_number(mp_blue_part(q))); + set_number_to_zero(mp_black_color(cp)); + } + break; + case mp_cmykcolor_type: + { + mp_node q = mp_get_value_node(cur_exp_node); + mp_color_model(cp) = mp_cmyk_model; + set_color_val(mp_cyan_color(cp), mp_get_value_number(mp_cyan_part(q))); + set_color_val(mp_magenta_color(cp), mp_get_value_number(mp_magenta_part(q))); + set_color_val(mp_yellow_color(cp), mp_get_value_number(mp_yellow_part(q))); + set_color_val(mp_black_color(cp), mp_get_value_number(mp_black_part(q))); + } + break; + case mp_known_type: + { + + + mp_color_model(cp) = mp_grey_model; + set_number_to_zero(mp_cyan_color(cp)); + set_number_to_zero(mp_magenta_color(cp)); + set_number_to_zero(mp_yellow_color(cp)); + set_color_val(mp_grey_color(cp), cur_exp_value_number); + + } + break; + default: + switch (cur_exp_value_boolean) { + case mp_false_operation: + mp_color_model(cp) = mp_no_model; + break; + case mp_true_operation: + mp_color_model(cp) = mp_uninitialized_model; + break; + default: + break; + } + set_number_to_zero(mp_cyan_color(cp)); + set_number_to_zero(mp_magenta_color(cp)); + set_number_to_zero(mp_yellow_color(cp)); + set_number_to_zero(mp_black_color(cp)); + break; + } + } + mp_flush_cur_exp(mp, new_expr); + } + break; + default: + complain_invalid_with_list(mp, t); + goto CONTINUE; + } + break; + case mp_with_rgb_model_code: + if (mp->cur_exp.type != mp_color_type) { + complain_invalid_with_list(mp, t); + goto CONTINUE; + } else { + mp_value new_expr; + memset(&new_expr, 0, sizeof(mp_value)); + new_number(new_expr.data.n); + if (cp == MP_VOID) { + make_cp_a_colored_object(cp, p); + } + if (cp != NULL) { + mp_node q = mp_get_value_node(cur_exp_node); + mp_color_model(cp) = mp_rgb_model; + set_color_val(mp_red_color(cp), mp_get_value_number(mp_red_part(q))); + set_color_val(mp_green_color(cp), mp_get_value_number(mp_green_part(q))); + set_color_val(mp_blue_color(cp), mp_get_value_number(mp_blue_part(q))); + set_number_to_zero(mp_black_color(cp)); + } + mp_flush_cur_exp(mp, new_expr); + } + break; + case mp_with_cmyk_model_code: + if (mp->cur_exp.type != mp_cmykcolor_type) { + complain_invalid_with_list(mp, t); + goto CONTINUE; + } else { + mp_value new_expr; + memset(&new_expr, 0, sizeof(mp_value)); + new_number(new_expr.data.n); + if (cp == MP_VOID) { + make_cp_a_colored_object(cp, p); + } + if (cp != NULL) { + mp_node q = mp_get_value_node(cur_exp_node); + mp_color_model(cp) = mp_cmyk_model; + set_color_val(mp_cyan_color(cp), mp_get_value_number(mp_cyan_part(q))); + set_color_val(mp_magenta_color(cp), mp_get_value_number(mp_magenta_part(q))); + set_color_val(mp_yellow_color(cp), mp_get_value_number(mp_yellow_part(q))); + set_color_val(mp_black_color(cp), mp_get_value_number(mp_black_part(q))); + } + mp_flush_cur_exp(mp, new_expr); + } + break; + case mp_with_grey_model_code: + if (mp->cur_exp.type != mp_known_type) { + complain_invalid_with_list(mp, t); + goto CONTINUE; + } else { + mp_value new_expr; + memset(&new_expr, 0, sizeof(mp_value)); + new_number(new_expr.data.n); + if (cp == MP_VOID) { + make_cp_a_colored_object(cp, p); + } + if (cp != NULL) { + + + mp_color_model(cp) = mp_grey_model; + set_number_to_zero(mp_cyan_color(cp)); + set_number_to_zero(mp_magenta_color(cp)); + set_number_to_zero(mp_yellow_color(cp)); + set_color_val(mp_grey_color(cp), cur_exp_value_number); + + } + mp_flush_cur_exp(mp, new_expr); + } + break; + case mp_with_no_model_code: + if (cp == MP_VOID) { + make_cp_a_colored_object(cp, p); + } + if (cp != NULL) { + mp_color_model(cp) = mp_no_model; + set_number_to_zero(mp_cyan_color(cp)); + set_number_to_zero(mp_magenta_color(cp)); + set_number_to_zero(mp_yellow_color(cp)); + set_number_to_zero(mp_grey_color(cp)); + } + break; + case mp_with_pen_code: + if (mp->cur_exp.type != mp_pen_type && mp->cur_exp.type != mp_nep_type) { + complain_invalid_with_list(mp, t); + goto CONTINUE; + } else { + if (pp == MP_VOID) { + pp = p; + while (pp != NULL) { + if (mp_has_pen(pp)) { + break; + } else { + pp = mp_link(pp); + } + } + } + if (pp != NULL) { + switch (mp_type(pp)) { + case mp_fill_node_type: + case mp_stroked_node_type: + if (mp_pen_ptr((mp_shape_node) pp) != NULL) { + mp_toss_knot_list(mp, mp_pen_ptr((mp_shape_node) pp)); + } + mp_pen_ptr((mp_shape_node) pp) = cur_exp_knot; + mp_pen_type((mp_shape_node) pp) = mp->cur_exp.type == mp_nep_type; + break; + default: + break; + } + mp->cur_exp.type = mp_vacuous_type; + } + } + break; + case mp_with_pre_script_code: + if (mp->cur_exp.type != mp_string_type) { + complain_invalid_with_list(mp, t); + goto CONTINUE; + } else if (cur_exp_str->len) { + if (ap == MP_VOID) { + ap = p; + } + while ((ap != NULL) && (! mp_has_script(ap))) { + ap = mp_link(ap); + } + if (ap != NULL) { + if (mp_pre_script(ap) != NULL) { + int selector = mp->selector; + mp_string s = mp_pre_script(ap); + mp->selector = mp_new_string_selector; + mp_str_room(mp, (int) (mp_pre_script(ap)->len + cur_exp_str->len + 2)); + mp_print_mp_str(mp, cur_exp_str); + mp_str_room(mp, 1); + mp_append_char(mp, 13); + mp_print_mp_str(mp, mp_pre_script(ap)); + mp_pre_script(ap) = mp_make_string(mp); + delete_str_ref(s); + mp->selector = selector; + } else { + mp_pre_script(ap) = cur_exp_str; + } + add_str_ref(mp_pre_script(ap)); + mp->cur_exp.type = mp_vacuous_type; + } + } + break; + case mp_with_post_script_code: + if (mp->cur_exp.type != mp_string_type) { + complain_invalid_with_list(mp, t); + goto CONTINUE; + } else if (cur_exp_str->len) { + if (bp == MP_VOID) { + bp = p; + } + while ((bp != NULL) && (! mp_has_script(bp))) { + bp = mp_link(bp); + } + if (bp != NULL) { + if (mp_post_script(bp) != NULL) { + int selector = mp->selector; + mp_string s = mp_post_script(bp); + mp->selector = mp_new_string_selector; + mp_str_room(mp, (int) (mp_post_script(bp)->len + cur_exp_str->len + 2)); + mp_print_mp_str(mp, mp_post_script(bp)); + mp_str_room(mp, 1); + mp_append_char(mp, 13); + mp_print_mp_str(mp, cur_exp_str); + mp_post_script(bp) = mp_make_string(mp); + delete_str_ref(s); + mp->selector = selector; + } else { + mp_post_script(bp) = cur_exp_str; + } + add_str_ref(mp_post_script(bp)); + mp->cur_exp.type = mp_vacuous_type; + } + } + break; + case mp_with_stacking_code: + switch (mp->cur_exp.type) { + case mp_known_type: + { + if (sp == MP_VOID) { + sp = p; + } + if (pp && spstop == MP_VOID) { + spstop = pstop; + } + if (sp != NULL) { + mp_stacking(sp) = round_unscaled(cur_exp_value_number); + } + if (pp && spstop != NULL) { + mp_stacking(spstop) = round_unscaled(cur_exp_value_number); + } + mp->cur_exp.type = mp_vacuous_type; + } + break; + case mp_pair_type: + { + if (pp && mp_nice_pair(mp, cur_exp_node, mp->cur_exp.type)) { + if (sp == MP_VOID) { + sp = p; + } + if (spstop == MP_VOID) { + spstop = pstop; + } + if (sp != NULL) { + mp_stacking(sp) = round_unscaled(mp_get_value_number(mp_x_part(mp_get_value_node(cur_exp_node)))); + } + if (spstop != NULL) { + mp_stacking(spstop) = round_unscaled(mp_get_value_number(mp_y_part(mp_get_value_node(cur_exp_node)))); + } + mp->cur_exp.type = mp_vacuous_type; + } else { + complain_invalid_with_list(mp, t); + goto CONTINUE; + } + } + break; + default: + { + complain_invalid_with_list(mp, t); + goto CONTINUE; + } + } + break; + case mp_with_linecap_code: + switch (mp->cur_exp.type) { + case mp_known_type: + { + linecap = round_unscaled(cur_exp_value_number); + mp->cur_exp.type = mp_vacuous_type; + break; + } + default: + { + complain_invalid_with_list(mp, t); + goto CONTINUE; + } + } + break; + case mp_with_linejoin_code: + switch (mp->cur_exp.type) { + case mp_known_type: + { + linejoin = round_unscaled(cur_exp_value_number); + mp->cur_exp.type = mp_vacuous_type; + break; + } + default: + { + complain_invalid_with_list(mp, t); + goto CONTINUE; + } + } + break; + case mp_with_miterlimit_code: + switch (mp->cur_exp.type) { + case mp_known_type: + { + miterlimit = 1; + new_number_clone(ml, cur_exp_value_number); + mp->cur_exp.type = mp_vacuous_type; + break; + } + default: + { + complain_invalid_with_list(mp, t); + goto CONTINUE; + } + } + break; + case mp_with_dashed_code: + if (mp->cur_exp.type != mp_picture_type) { + complain_invalid_with_list(mp, t); + goto CONTINUE; + } + // fall through + default: + if (dp == MP_VOID) { + dp = p; + while (dp != NULL) { + if (mp_type(dp) == mp_stroked_node_type) { + break; + } else { + dp = mp_link(dp); + } + } + } + if (dp != NULL) { + if (mp_dash_ptr(dp) != NULL) { + mp_delete_edge_ref(mp, mp_dash_ptr(dp)); + } + mp_dash_ptr(dp) = (mp_node) mp_make_dashes(mp, (mp_edge_header_node) cur_exp_node); + set_number_to_unity(((mp_shape_node) dp)->dashscale); + mp->cur_exp.type = mp_vacuous_type; + } + break; + } + } + if (cp > MP_VOID) { + mp_node q = mp_link(cp); + while (q != NULL) { + if (mp_has_color(q)) { + mp_shape_node q0 = (mp_shape_node) q; + mp_shape_node cp0 = (mp_shape_node) cp; + number_clone(q0->red, cp0->red); + number_clone(q0->green, cp0->green); + number_clone(q0->blue, cp0->blue); + number_clone(q0->black, cp0->black); + mp_color_model(q) = mp_color_model(cp); + } + q = mp_link(q); + } + } + if (pp > MP_VOID) { + mp_node q = mp_link(pp); + while (q != NULL) { + if (mp_has_pen(q)) { + switch (mp_type(q)) { + case mp_fill_node_type: + case mp_stroked_node_type: + if (mp_pen_ptr((mp_shape_node) q) != NULL) { + mp_toss_knot_list(mp, mp_pen_ptr((mp_shape_node) q)); + } + mp_pen_ptr((mp_shape_node) q) = mp_copy_pen(mp, mp_pen_ptr((mp_shape_node) pp)); + break; + default: + break; + } + } + q = mp_link(q); + } + } + if (dp > MP_VOID) { + mp_node q = mp_link(dp); + while (q != NULL) { + if (mp_type(q) == mp_stroked_node_type) { + if (mp_dash_ptr(q) != NULL) { + mp_delete_edge_ref(mp, mp_dash_ptr(q)); + } + mp_dash_ptr(q) = mp_dash_ptr(dp); + set_number_to_unity(((mp_shape_node) q)->dashscale); + if (mp_dash_ptr(q) != NULL) { + mp_add_edge_ref(mp, mp_dash_ptr(q)); + } + } + q = mp_link(q); + } + } + if (linecap >= 0 && linecap < mp_weird_linecap_code) { + mp_node q = p; + while (q != NULL) { + switch (mp_type(q)) { + case mp_fill_node_type: + case mp_stroked_node_type: + mp_set_linecap(q, linecap); + break; + default: + break; + } + q = mp_link(q); + } + } + if (linejoin >= 0 && linejoin < mp_weird_linejoin_code) { + mp_node q = p; + while (q != NULL) { + switch (mp_type(q)) { + case mp_fill_node_type: + case mp_stroked_node_type: + mp_set_linejoin(q, linejoin); + break; + default: + break; + } + q = mp_link(q); + } + } + if (miterlimit) { + mp_node q = p; + while (q != NULL) { + switch (mp_type(q)) { + case mp_fill_node_type: + case mp_stroked_node_type: + number_clone(mp_miterlimit(q), ml); + break; + default: + break; + } + q = mp_link(q); + } + free_number(ml); + } + if (! pp && sp > MP_VOID) { + mp_node q = mp_link(sp); + while (q != NULL) { + mp_stacking(q) = mp_stacking(sp); + q = mp_link(q); + } + } +} + +mp_edge_header_node mp_find_edges_var (MP mp, mp_node t) +{ + mp_edge_header_node cur_edges = NULL; + mp_node p = mp_find_variable(mp, t); + if (p == NULL) { + char *msg = mp_obliterated(mp, t); + mp_back_error( + mp, + msg, + "It seems you did a nasty thing --- probably by accident, but nevertheless you\n" + "nearly hornswoggled me ... While I was evaluating the right-hand side of thisn" + "command, something happened, and the left-hand side is no longer a variable! So In" + "won't change anything." + ); + mp_memory_free(msg); + mp_get_x_next(mp); + } else if (mp_type(p) != mp_picture_type) { + char msg[256]; + mp_string sname; + int selector = mp->selector; + mp->selector = mp_new_string_selector; + mp_show_token_list(mp, t, NULL); + sname = mp_make_string(mp); + mp->selector = selector; + mp_snprintf(msg, 256, "Variable %s is the wrong type(%s)", mp_str(mp, sname), mp_type_string(mp_type(p))); + delete_str_ref(sname); + mp_back_error( + mp, + msg, + "I was looking for a 'known' picture variable. So I'll not change anything just\n" + "now." + ); + mp_get_x_next(mp); + } else { + mp_set_value_node(p, (mp_node) mp_private_edges(mp, (mp_edge_header_node) mp_get_value_node(p))); + cur_edges = (mp_edge_header_node) mp_get_value_node(p); + } + mp_flush_node_list(mp, t); + return cur_edges; +} + +mp_node mp_start_draw_cmd (MP mp, int sep) +{ + mp_node lhv = NULL; + int add_type = 0; + mp_get_x_next(mp); + mp->var_flag = sep; + mp_scan_primary(mp); + if (mp->cur_exp.type != mp_token_list_type) { + mp_value new_expr; + memset(&new_expr, 0, sizeof(mp_value)); + new_number(new_expr.data.n); + mp_disp_err(mp, NULL); + mp_back_error( + mp, + "Not a suitable variable", + "At this point I needed to see the name of a picture variable. (Or perhaps you\n" + "have indeed presented me with one; I might have missed it, if it wasn't followed\n" + "by the proper token.) So I'll not change anything just now.\n" + ); + mp_get_x_next(mp); + mp_flush_cur_exp(mp, new_expr); + } else { + lhv = cur_exp_node; + add_type = (int) cur_mod; + mp->cur_exp.type = mp_vacuous_type; + mp_get_x_next(mp); + mp_scan_expression(mp); + } + mp->last_add_type = add_type; + return lhv; +} + +void mp_do_bounds (MP mp) +{ + mp_edge_header_node lhe; + int c = cur_cmd; + int m = cur_mod; + mp_node lhv = mp_start_draw_cmd(mp, mp_to_command); + if (lhv != NULL) { + mp_value new_expr; + memset(&new_expr, 0, sizeof(mp_value)); + lhe = mp_find_edges_var(mp, lhv); + if (lhe == NULL) { + new_number(new_expr.data.n); + mp_flush_cur_exp(mp, new_expr); + } else if (mp->cur_exp.type != mp_path_type) { + char msg[256]; + mp_disp_err(mp, NULL); + new_number(new_expr.data.n); + mp_snprintf(msg, 256, "Improper '%s'", mp_cmd_mod_string(mp, c, m)); + mp_back_error( + mp, + msg, + "This expression should have specified a known path. So I'll not change anything\n" + "just now." + ); + mp_get_x_next(mp); + mp_flush_cur_exp(mp, new_expr); + } else if (mp_left_type(cur_exp_knot) == mp_endpoint_knot) { + mp_back_error( + mp, + "Not a cycle", + "That contour should have ended with '..cycle' or '&cycle'. So I'll not change\n" + "anything just now." + ); + mp_get_x_next(mp); + } else { + mp_node p = mp_new_bounds_node(mp, cur_exp_knot, (int) m); + mp_node pp; + int mm = 0; + switch (m) { + case mp_start_clip_node_type : mm = mp_stop_clip_node_type; break; + case mp_start_group_node_type : mm = mp_stop_group_node_type; break; + case mp_start_bounds_node_type: mm = mp_stop_bounds_node_type; break; + } + pp = mp_new_bounds_node(mp, NULL, mm); + mp_scan_with_list(mp, p, pp); + mp_link(p) = mp_link(mp_edge_list(lhe)); + mp_link(mp_edge_list(lhe)) = p; + if (mp_obj_tail(lhe) == mp_edge_list(lhe)) { + mp_obj_tail(lhe) = p; + } + mp_link(mp_obj_tail(lhe)) = pp; + mp_obj_tail(lhe) = pp; + mp_init_bbox(mp, lhe); + } + } +} + +void mp_do_add_to (MP mp) +{ + mp_node lhv = mp_start_draw_cmd(mp, mp_thing_to_add_command); + if (lhv != NULL) { + mp_edge_header_node lhe; + mp_node p; + mp_edge_header_node e; + int add_type = mp->last_add_type; + if (add_type == mp_add_also_code) { + p = NULL; + e = NULL; + if (mp->cur_exp.type != mp_picture_type) { + mp_value new_expr; + memset(&new_expr, 0, sizeof(mp_value)); + new_number(new_expr.data.n); + mp_disp_err(mp, NULL); + mp_back_error( + mp, + "Improper 'addto'", + "This expression should have specified a known picture. So I'll not change\n" + "anything just now." + ); + mp_get_x_next(mp); + mp_flush_cur_exp(mp, new_expr); + } else { + e = mp_private_edges(mp, (mp_edge_header_node) cur_exp_node); + mp->cur_exp.type = mp_vacuous_type; + p = mp_link(mp_edge_list(e)); + } + } else { + e = NULL; + p = NULL; + if (mp->cur_exp.type == mp_pair_type) { + mp_pair_to_path(mp); + } + if (mp->cur_exp.type != mp_path_type) { + mp_value new_expr; + memset(&new_expr, 0, sizeof(mp_value)); + new_number(new_expr.data.n); + mp_disp_err(mp, NULL); + mp_back_error( + mp, + "Improper 'addto'", + "This expression should have specified a known path. So I'll not change anything\n" + "just now." + ); + mp_get_x_next(mp); + mp_flush_cur_exp(mp, new_expr); + } else if (add_type != mp_add_contour_code) { + p = mp_new_shape_node(mp, cur_exp_knot, mp_stroked_node_type); + mp->cur_exp.type = mp_vacuous_type; + } else if (mp_left_type(cur_exp_knot) == mp_endpoint_knot) { + mp_back_error( + mp, + "Not a cycle", + "That contour should have ended with '.. cycle' or '& cycle'. So I'll not change\n" + "anything just now." + ); + mp_get_x_next(mp); + } else { + p = mp_new_shape_node(mp, cur_exp_knot, mp_fill_node_type); + mp->cur_exp.type = mp_vacuous_type; + } + } + mp_scan_with_list(mp, p, NULL); + lhe = mp_find_edges_var(mp, lhv); + if (lhe == NULL) { + if ((e == NULL) && (p != NULL)) { + e = mp_toss_gr_object(mp, p); + } + if (e != NULL) { + mp_delete_edge_ref(mp, e); + } + } else if (add_type == mp_add_also_code) { + if (e != NULL) { + if (mp_link(mp_edge_list(e)) != NULL) { + mp_link(mp_obj_tail(lhe)) = mp_link(mp_edge_list(e)); + mp_obj_tail(lhe) = mp_obj_tail(e); + mp_obj_tail(e) = mp_edge_list(e); + mp_link(mp_edge_list(e)) = NULL; + mp_flush_dash_list(mp, lhe); + } + mp_toss_edges(mp, e); + } + } else if (p != NULL) { + mp_link(mp_obj_tail(lhe)) = p; + mp_obj_tail(lhe) = p; + if (add_type == mp_add_double_path_code) { + if (mp_pen_ptr((mp_shape_node) p) == NULL) { + mp_pen_ptr((mp_shape_node) p) = mp_get_pen_circle(mp, &zero_t); + } + } + } + } +} + +void mp_do_ship_out (MP mp) +{ + mp_value new_expr; + memset(&new_expr, 0, sizeof(mp_value)); + new_number(new_expr.data.n); + mp_get_x_next(mp); + mp_scan_expression(mp); + if (mp->cur_exp.type != mp_picture_type) { + mp_disp_err(mp, NULL); + set_number_to_zero(new_expr.data.n); + mp_back_error(mp, "Not a known picture", "I can only output known pictures."); + mp_get_x_next(mp); + mp_flush_cur_exp(mp, new_expr); + } else { + mp_ship_out(mp, cur_exp_node); + set_number_to_zero(new_expr.data.n); + mp_flush_cur_exp(mp, new_expr); + } +} + +void mp_do_message (MP mp) +{ + mp_value new_expr; + int m = cur_mod; + memset(&new_expr, 0, sizeof(mp_value)); + new_number(new_expr.data.n); + mp_get_x_next(mp); + mp_scan_expression(mp); + if (mp->cur_exp.type != mp_string_type) { + mp_no_string_err(mp, "A message should be a known string expression."); + } else { + switch (m) { + case message_code: + mp_print_nl(mp, ""); + mp_print_mp_str(mp, cur_exp_str); + break; + case err_message_code: + { + char msg[256]; + mp_snprintf(msg, 256, "%s", mp_str(mp, cur_exp_str)); + if (mp->err_help != NULL) { + mp->use_err_help = 1; + mp_back_error(mp, msg, NULL); + } else if (mp->long_help_seen) { + mp_back_error(mp, msg, "(That was another 'errmessage'.)"); + } else { + if (mp->interaction < mp_error_stop_mode) { + mp->long_help_seen = 1; + } + mp_back_error( + mp, + msg, + "This error message was generated by an 'errmessage' command, so I can't give any\n" + "explicit help. Pretend that you're Miss Marple: Examine all clues, and deduce the\n" + "truth by inspired guesses." + ); + } + mp_get_x_next(mp); + mp->use_err_help = 0; + } + break; + case err_help_code: + { + if (mp->err_help != NULL) { + delete_str_ref(mp->err_help); + } if (cur_exp_str->len == 0) { + mp->err_help = NULL; + } else { + mp->err_help = cur_exp_str; + add_str_ref(mp->err_help); + } + } + break; + } + } + set_number_to_zero(new_expr.data.n); + mp_flush_cur_exp(mp, new_expr); +} + +static void mp_no_string_err (MP mp, const char *s) +{ + mp_disp_err(mp, NULL); + mp_back_error(mp, "Not a string", s); + mp_get_x_next(mp); +} + +void mp_do_write (MP mp) +{ + mp_value new_expr; + memset(&new_expr, 0, sizeof(mp_value)); + new_number(new_expr.data.n); + mp_get_x_next(mp); + mp_scan_expression(mp); + if (mp->cur_exp.type != mp_string_type) { + mp_no_string_err(mp, "The text to be written should be a known string expression"); + } else if (cur_cmd != mp_to_command) { + mp_back_error(mp, "Missing 'to' clause", "A write command should end with 'to <filename>'"); + mp_get_x_next(mp); + } else { + mp_string t = cur_exp_str; + mp->cur_exp.type = mp_vacuous_type; + mp_get_x_next(mp); + mp_scan_expression(mp); + if (mp->cur_exp.type != mp_string_type) { + mp_no_string_err(mp, "I can\'t write to that file name. It isn't a known string"); + } else { + mp_do_write_string(mp, t); + } + } + set_number_to_zero(new_expr.data.n); + mp_flush_cur_exp(mp, new_expr); +} + +static void mp_do_write_string (MP mp, mp_string t) +{ + char *fn = mp_str(mp, cur_exp_str); + int n = mp->write_files; + int n0 = mp->write_files; + while (mp_strcmp(fn, mp->wr_fname[n]) != 0) { + if (n == 0) { + if (n0 == mp->write_files) { + if (mp->write_files < mp->max_write_files) { + ++mp->write_files; + } else { + int l = mp->max_write_files + (mp->max_write_files / 4); + void **wr_file = mp_memory_allocate((size_t) (l + 1) * sizeof(void *)); + char **wr_fname = mp_memory_allocate((size_t) (l + 1) * sizeof(char *)); + for (int k = 0; k <= l; k++) { + if (k <= mp->max_write_files) { + wr_file[k] = mp->wr_file[k]; + wr_fname[k] = mp->wr_fname[k]; + } else { + wr_file[k] = 0; + wr_fname[k] = NULL; + } + } + mp_memory_free(mp->wr_file); + mp_memory_free(mp->wr_fname); + mp->max_write_files = l; + mp->wr_file = wr_file; + mp->wr_fname = wr_fname; + } + } + n = n0; + mp_open_write_file(mp, fn, n); + } else { + --n; + if (mp->wr_fname[n] == NULL) { + n0 = n; + } + } + } + if (mp_str_vs_str(mp, t, mp->eof_line) == 0) { + (mp->close_file)(mp, mp->wr_file[n]); + mp_memory_free(mp->wr_fname[n]); + mp->wr_fname[n] = NULL; + if (n == mp->write_files - 1) { + mp->write_files = n; + } + } else { + int selector = mp->selector; + mp->selector = n + mp_first_file_selector; + mp_print_mp_str(mp, t); + mp_print_ln(mp); + mp->selector = selector; + } +} + +struct mp_edge_object *mp_gr_export (MP mp, mp_edge_header_node h) +{ + mp_node p; + mp_edge_object *hh = mp_memory_allocate(sizeof(mp_edge_object)); + mp_graphic_object *hp = NULL; + mp_set_bbox(mp, h, 1); + hh->parent = mp; + hh->body = NULL; + hh->next = NULL; + hh->minx = number_to_double(h->minx); + hh->minx = fabs(hh->minx) < 0.00001 ? 0 : hh->minx; + hh->miny = number_to_double(h->miny); + hh->miny = fabs(hh->miny) < 0.00001 ? 0 : hh->miny; + hh->maxx = number_to_double(h->maxx); + hh->maxx = fabs(hh->maxx) < 0.00001 ? 0 : hh->maxx; + hh->maxy = number_to_double(h->maxy); + hh->maxy = fabs(hh->maxy) < 0.00001 ? 0 : hh->maxy; + hh->charcode = round_unscaled(internal_value(mp_char_code_internal)); + hh->width = number_to_double(internal_value(mp_char_wd_internal)); + hh->height = number_to_double(internal_value(mp_char_ht_internal)); + hh->depth = number_to_double(internal_value(mp_char_dp_internal)); + hh->italic = number_to_double(internal_value(mp_char_ic_internal)); + p = mp_link(mp_edge_list(h)); + while (p != NULL) { + mp_graphic_object *hq = mp_new_graphic_object(mp, (int) ((mp_type(p) - mp_fill_node_type) + 1)); + switch (mp_type(p)) { + case mp_fill_node_type: + { + mp_number d_width; + mp_shape_node p0 = (mp_shape_node) p; + mp_shape_object *tf = (mp_shape_object *) hq; + gr_pen_ptr(tf) = mp_export_knot_list(mp, mp_pen_ptr(p0)); + new_number(d_width); + mp_get_pen_scale(mp, &d_width, mp_pen_ptr(p0)); + free_number(d_width); + if ((mp_pen_ptr(p0) == NULL) || mp_pen_is_elliptical(mp_pen_ptr(p0))) { + gr_path_ptr(tf) = mp_export_knot_list(mp, mp_path_ptr(p0)); + } else { + mp_knot pc = mp_copy_path(mp, mp_path_ptr(p0)); + mp_knot pp = mp_make_envelope(mp, pc, mp_pen_ptr(p0), p0->linejoin, 0, &(p0->miterlimit)); + gr_path_ptr(tf) = mp_export_knot_list(mp, pp); + mp_toss_knot_list(mp, pp); + pc = mp_htap_ypoc(mp, mp_path_ptr(p0)); + pp = mp_make_envelope(mp, pc, mp_pen_ptr((mp_shape_node) p), p0->linejoin, 0, &(p0->miterlimit)); + gr_htap_ptr(tf) = mp_export_knot_list(mp, pp); + mp_toss_knot_list(mp, pp); + } + mp_gr_export_color(tf, p0); + mp_gr_export_scripts(tf, p); + gr_linejoin_val(tf) = p0->linejoin; + gr_stacking_val(tf) = p0->stacking; + gr_miterlimit_val(tf) = number_to_double(p0->miterlimit); + } + break; + case mp_stroked_node_type: + { + mp_number d_width; + mp_shape_node p0 = (mp_shape_node) p; + mp_shape_object *ts = (mp_shape_object *) hq; + gr_pen_ptr(ts) = mp_export_knot_list(mp, mp_pen_ptr(p0)); + new_number(d_width); + mp_get_pen_scale(mp, &d_width, mp_pen_ptr(p0)); + if (mp_pen_is_elliptical(mp_pen_ptr(p0))) { + gr_path_ptr(ts) = mp_export_knot_list(mp, mp_path_ptr(p0)); + } else { + mp_knot pc = mp_copy_path(mp, mp_path_ptr(p0)); + int t = p0->linecap; + if (mp_left_type(pc) != mp_endpoint_knot) { + mp_left_type(mp_insert_knot(mp, pc, &(pc->x_coord), &(pc->y_coord))) = mp_endpoint_knot; + mp_right_type(pc) = mp_endpoint_knot; + pc = mp_next_knot(pc); + t = 1; + } + pc = mp_make_envelope(mp, pc, mp_pen_ptr(p0), p0->linejoin, (int) t, &(p0->miterlimit)); + gr_path_ptr(ts) = mp_export_knot_list(mp, pc); + mp_toss_knot_list(mp, pc); + } + mp_gr_export_color(ts, p0); + mp_gr_export_scripts(ts, p); + gr_linejoin_val(ts) = p0->linejoin; + gr_miterlimit_val(ts) = number_to_double(p0->miterlimit); + gr_linecap_val(ts) = p0->linecap; + gr_stacking_val(ts) = p0->stacking; + gr_dash_ptr(ts) = mp_export_dashes(mp, p0, &d_width); + free_number(d_width); + } + break; + case mp_start_clip_node_type: + case mp_start_group_node_type: + case mp_start_bounds_node_type: + { + mp_start_node p0 = (mp_start_node) p; + mp_start_object *tb = (mp_start_object *) hq; + gr_path_ptr(tb) = mp_export_knot_list(mp, mp_path_ptr((mp_start_node) p)); + gr_stacking_val(tb) = p0->stacking; + mp_gr_export_scripts(tb, p); + } + break; + case mp_stop_clip_node_type: + case mp_stop_group_node_type: + case mp_stop_bounds_node_type: + { + mp_stop_node p0 = (mp_stop_node) p; + mp_stop_object *tb = (mp_stop_object *) hq; + gr_stacking_val(tb) = p0->stacking; + } + break; + default: + break; + } + if (hh->body == NULL) { + hh->body = hq; + } else { + gr_link(hp) = hq; + } + hp = hq; + p = mp_link(p); + } + return hh; +} + +static void mp_do_gr_toss_dashes (mp_dash_object *dl) { + if (dl) { + mp_memory_free(dl->array); + mp_memory_free(dl); + } +} + +static void mp_do_gr_toss_knot_list (mp_gr_knot p) +{ + if (p) { + mp_gr_knot q = p; + do { + mp_gr_knot r = gr_next_knot(q); + mp_memory_free(q); + q = r; + } while (q != p); + } +} + +mp_graphic_object *mp_new_graphic_object (MP mp, int type) +{ + mp_graphic_object *p; + size_t size; + (void) mp; + switch (type) { + case mp_fill_code: + case mp_stroked_code: + size = sizeof(mp_shape_object); + break; + case mp_start_clip_code: + case mp_start_group_code: + case mp_start_bounds_code: + size = sizeof(mp_start_object); + break; + default: + size = sizeof(mp_graphic_object); + break; + } + p = (mp_graphic_object *) mp_memory_allocate(size); + memset(p, 0, size); + gr_type(p) = type; + return p; +} + +void mp_gr_toss_object (mp_graphic_object *p) +{ + switch (gr_type(p)) { + case mp_fill_code: + case mp_stroked_code: + { + mp_shape_object *o = (mp_shape_object *) p; + mp_memory_free(gr_pre_script(o)); + mp_memory_free(gr_post_script(o)); + mp_do_gr_toss_knot_list(gr_pen_ptr(o)); + mp_do_gr_toss_knot_list(gr_path_ptr(o)); + if (gr_htap_ptr(o)) { + mp_do_gr_toss_knot_list(gr_htap_ptr(o)); + } + if (gr_dash_ptr(o)) { + mp_do_gr_toss_dashes(gr_dash_ptr(o)); + } + } + break; + case mp_start_clip_code: + case mp_start_group_code: + case mp_start_bounds_code: + { + mp_start_object *o = (mp_start_object *) p; + mp_memory_free(gr_pre_script(o)); + mp_memory_free(gr_post_script(o)); + mp_do_gr_toss_knot_list(gr_path_ptr(o)); + } + break; + case mp_stop_clip_code: + case mp_stop_group_code: + case mp_stop_bounds_code: + break; + } + mp_memory_free(p); +} + +void mp_gr_toss_objects (mp_edge_object *hh) +{ + mp_graphic_object *p = hh->body; + while (p) { + mp_graphic_object *q = gr_link(p); + mp_gr_toss_object(p); + p = q; + } + mp_memory_free(hh); +} + +void mp_ship_out (MP mp, mp_node h) { + (mp->shipout_backend)(mp, h); +} + +static void mp_shipout_backend (MP mp, void *voidh) +{ + (void) mp; + (void) voidh; +} + +void mp_scan_symbol_value (MP mp, int keep, char **s, int expand) +{ + if (mp->extensions) { + if (expand) { + mp_get_x_next(mp); + } else { + mp_get_next(mp); + } + if (keep) { + mp_back_input(mp); + } + if (cur_sym == NULL && (cur_sym_mod == 0 || cur_sym_mod == mp_normal_operation)) { + *s = NULL; + } else { + unsigned char *r = NULL; + mp_node p = mp_new_symbolic_node(mp); + mp_set_sym_sym(p, cur_sym); + mp_name_type(p) = cur_sym_mod; + if (mp_type(p) == mp_symbol_node_type) { + mp_sym sr = mp_get_sym_sym(p); + mp_string rr = text(sr); + if (rr && rr->str) { + r = rr->str; + } + } else if (mp_name_type(p) == mp_token_operation) { + if (mp_type(p) == mp_string_type) { + r = mp_get_value_str(p)->str; + } + } + mp_free_symbolic_node(mp, p); + if (r) { + *s = (char *) mp_strdup((char *) r); + } else { + *s = NULL; + } + } + } +} + +void mp_scan_property_value (MP mp, int keep, int *kind, char **str, int *property, int *detail) +{ + if (mp->extensions) { + mp_symbol_entry *entry; + mp_get_symbol(mp); + entry = cur_sym; + if (entry) { + mp_node node = entry->type == mp_tag_command ? entry->v.data.node : NULL; + *kind = entry->type; + *str = (char *) mp_strdup((char *) entry->text->str); + *property = entry->property; + if (node) { + *detail = node->type; + } + if (keep) { + mp_back_input(mp); + } + } + } +} + +void mp_scan_next_value (MP mp, int keep, int *token, int *mode, int *kind) +{ + if (mp->extensions) { + mp_get_next(mp); + if (keep) { + mp_back_input(mp); + } + *token = cur_cmd; + *mode = cur_mod; + *kind = mp->cur_exp.type; + } +} + +void mp_scan_expr_value (MP mp, int keep, int *kind) +{ + if (mp->extensions) { + mp_get_next(mp); + mp_scan_primary(mp); + *kind = mp->cur_exp.type; + if (keep) { + mp_back_input(mp); + mp_back_expr(mp); + } + } +} + +void mp_scan_token_value (MP mp, int keep, int *token, int *mode, int *kind) +{ + if (mp->extensions) { + mp_get_x_next(mp); + if (keep) { + mp_back_input(mp); + } + *token = cur_cmd; + *mode = cur_mod; + *kind = mp->cur_exp.type; + } +} + +int mp_skip_token_value (MP mp, int token) +{ + if (mp->extensions) { + mp_get_x_next(mp); + if (token == cur_cmd) { + return 1; + } else { + mp_back_input(mp); + } + } + return 0; +} + +static void mp_scan_something (MP mp, int primary) +{ + mp_get_x_next(mp); + switch (primary) { + case 0: mp_scan_expression(mp); break; + case 1: mp_scan_primary(mp); break; + case 2: mp_scan_secondary(mp); break; + case 3: mp_scan_tertiary(mp); break; + default: mp_scan_expression(mp); break; + } +} + +void mp_scan_numeric_value (MP mp, int primary, double *d) +{ + if (mp->extensions) { + mp_scan_something(mp, primary); + if (mp->cur_exp.type != mp_known_type) { + mp_back_input(mp); + } else { + mp_back_input(mp); + *d = number_to_double(cur_exp_value_number); + } + } +} + +# define mp_set_double_value(mp,target,what) \ +if (mp_type(what) == mp_known_type) { \ + *target = number_to_double(mp_get_value_number(what)); \ +} + +void mp_scan_pair_value (MP mp, int primary, double *x, double *y) +{ + if (mp->extensions) { + mp_scan_something(mp, primary); + if (mp->cur_exp.type != mp_pair_type) { + mp_back_input(mp); + } else { + mp_node p ; + mp_back_input(mp); + p = mp_get_value_node(cur_exp_node); + mp_set_double_value(mp, x, mp_x_part(p)); + mp_set_double_value(mp, y, mp_y_part(p)); + } + } +} + +void mp_scan_color_value (MP mp, int primary, double *r, double *g, double *b) +{ + if (mp->extensions) { + mp_scan_something(mp, primary); + if (mp->cur_exp.type != mp_color_type) { + mp_back_input(mp); + } else { + mp_node p ; + mp_back_input(mp); + p = mp_get_value_node(cur_exp_node); + mp_set_double_value(mp, r, mp_red_part(p)); + mp_set_double_value(mp, g, mp_green_part(p)); + mp_set_double_value(mp, b, mp_blue_part(p)); + } + } +} + +void mp_scan_cmykcolor_value (MP mp, int primary, double *c, double *m, double *y, double *k) +{ + if (mp->extensions) { + mp_scan_something(mp, primary); + if (mp->cur_exp.type != mp_cmykcolor_type) { + mp_back_input(mp); + } else { + mp_node p ; + mp_back_input(mp); + p = mp_get_value_node(cur_exp_node); + mp_set_double_value(mp, c, mp_cyan_part(p)); + mp_set_double_value(mp, m, mp_magenta_part(p)); + mp_set_double_value(mp, y, mp_yellow_part(p)); + mp_set_double_value(mp, k, mp_black_part(p)); + } + } +} + +void mp_scan_transform_value (MP mp, int primary, double *x, double *y, double *xx, double *xy, double *yx, double *yy) +{ + if (mp->extensions) { + mp_scan_something(mp, primary); + if (mp->cur_exp.type != mp_transform_type) { + mp_back_input(mp); + } else { + mp_node p ; + mp_back_input(mp); + p = mp_get_value_node(cur_exp_node); + mp_set_double_value(mp, x, mp_x_part(p)); + mp_set_double_value(mp, y, mp_y_part(p)); + mp_set_double_value(mp, xx, mp_xx_part(p)); + mp_set_double_value(mp, xy, mp_xy_part(p)); + mp_set_double_value(mp, yx, mp_yx_part(p)); + mp_set_double_value(mp, yy, mp_yy_part(p)); + } + } +} + +void mp_scan_path_value (MP mp, int primary, mp_knot *k) +{ + if (mp->extensions) { + mp_scan_something(mp, primary); + if (mp->cur_exp.type != mp_path_type && mp->cur_exp.type != mp_pen_type) { + mp_back_input(mp); + } else { + mp_back_input(mp); + *k = cur_exp_knot; + } + } +} + +void mp_scan_boolean_value (MP mp, int primary, int *b) +{ + if (mp->extensions) { + mp_scan_something(mp, primary); + if (mp->cur_exp.type != mp_boolean_type) { + mp_back_input(mp); + } else { + mp_back_input(mp); + *b = cur_exp_value_boolean == mp_true_operation ? 1 : 0 ; + } + } +} + +void mp_scan_string_value (MP mp, int primary, char **s, size_t *l) +{ + if (mp->extensions) { + mp_scan_something(mp, primary); + if (mp->cur_exp.type != mp_string_type) { + mp_back_input(mp); + *s = NULL ; + *l = 0; + } else { + mp_back_input(mp); + *s = (char *) cur_exp_str->str ; + *l = cur_exp_str->len; + } + } +} + +void mp_push_numeric_value (MP mp, double n) +{ + mp_number m; + new_number_from_double(mp, m, n); + mp->cur_exp.type = mp_known_type; + mp_set_cur_exp_value_number(mp, &m); + mp_back_expr(mp); +} + +void mp_push_integer_value (MP mp, int i) +{ + mp_number m; + new_number(m); + set_number_from_int(m, i); + mp->cur_exp.type = mp_known_type; + mp_set_cur_exp_value_number(mp, &m); + mp_back_expr(mp); +} + +void mp_push_boolean_value (MP mp, int b) +{ + mp->cur_exp.type = mp_boolean_type; + mp_set_cur_exp_value_boolean(mp, b ? mp_true_operation : mp_false_operation); + mp_back_expr(mp); +} + +void mp_push_string_value (MP mp, const char *s, int l) +{ + mp->cur_exp.type = mp_string_type; + mp_set_cur_exp_str(mp, mp_rtsl(mp, (char *) s, l)); + mp_back_expr(mp); +} + +void mp_push_pair_value (MP mp, double x, double y) +{ + mp_number px, py; + mp_node p = mp_new_value_node(mp); + mp_node v; + mp_init_pair_node(mp, p); + v = mp_get_value_node(p); + new_number_from_double(mp, px, x); + new_number_from_double(mp, py, y); + mp_type(mp_x_part(v)) = mp_known_type; + mp_type(mp_y_part(v)) = mp_known_type; + mp_set_value_number(mp_x_part(v), px); + mp_set_value_number(mp_y_part(v), py); + free_number(px); + free_number(py); + mp_name_type(p) = mp_capsule_operation; + mp->cur_exp.type = mp_pair_type; + mp_set_cur_exp_node(mp, p); + mp_back_expr(mp); +} + +void mp_push_color_value (MP mp, double r, double g, double b) +{ + mp_number pr, pg, pb; + mp_node p = mp_new_value_node(mp); + mp_node v; + mp_init_color_node(mp, p, mp_color_type); + v = mp_get_value_node(p); + new_number_from_double(mp, pr, r); + new_number_from_double(mp, pg, g); + new_number_from_double(mp, pb, b); + mp_type(mp_red_part (v)) = mp_known_type; + mp_type(mp_green_part(v)) = mp_known_type; + mp_type(mp_blue_part (v)) = mp_known_type; + mp_set_value_number(mp_red_part (v), pr); + mp_set_value_number(mp_green_part(v), pg); + mp_set_value_number(mp_blue_part (v), pb); + free_number(pr); + free_number(pg); + free_number(pb); + mp_name_type(p) = mp_capsule_operation; + mp->cur_exp.type = mp_color_type; + mp_set_cur_exp_node(mp, p); + mp_back_expr(mp); +} + +void mp_push_cmykcolor_value (MP mp, double c, double m, double y, double k) +{ + mp_number pc, pm, py, pk; + mp_node p = mp_new_value_node(mp); + mp_node v; + mp_init_color_node(mp, p, mp_cmykcolor_type); + v = mp_get_value_node(p); + new_number_from_double(mp, pc, c); + new_number_from_double(mp, pm, m); + new_number_from_double(mp, py, y); + new_number_from_double(mp, pk, k); + mp_type(mp_cyan_part (v)) = mp_known_type; + mp_type(mp_magenta_part(v)) = mp_known_type; + mp_type(mp_yellow_part (v)) = mp_known_type; + mp_type(mp_black_part (v)) = mp_known_type; + mp_set_value_number(mp_cyan_part (v), pc); + mp_set_value_number(mp_magenta_part(v), pm); + mp_set_value_number(mp_yellow_part (v), py); + mp_set_value_number(mp_black_part (v), pk); + free_number(pc); + free_number(pm); + free_number(py); + free_number(pk); + mp_name_type(p) = mp_capsule_operation; + mp->cur_exp.type = mp_cmykcolor_type; + mp_set_cur_exp_node(mp, p); + mp_back_expr(mp); +} + +void mp_push_transform_value (MP mp, double x, double y, double xx, double xy, double yx, double yy) +{ + mp_number px, py, pxx, pxy, pyx, pyy ; + mp_node p = mp_new_value_node(mp); + mp_node v; + mp_init_transform_node(mp, p); + v = mp_get_value_node(p); + new_number_from_double(mp, px, x); + new_number_from_double(mp, py, y); + new_number_from_double(mp, pxx, xx); + new_number_from_double(mp, pxy, xy); + new_number_from_double(mp, pyx, yx); + new_number_from_double(mp, pyy, yy); + mp_type(mp_x_part (v)) = mp_known_type; + mp_type(mp_y_part (v)) = mp_known_type; + mp_type(mp_xx_part(v)) = mp_known_type; + mp_type(mp_xy_part(v)) = mp_known_type; + mp_type(mp_yx_part(v)) = mp_known_type; + mp_type(mp_yy_part(v)) = mp_known_type; + mp_set_value_number(mp_x_part (v), px); + mp_set_value_number(mp_y_part (v), py); + mp_set_value_number(mp_xx_part(v), pxx); + mp_set_value_number(mp_xy_part(v), pxy); + mp_set_value_number(mp_yx_part(v), pyx); + mp_set_value_number(mp_yy_part(v), pyy); + free_number(px); + free_number(py); + free_number(pxx); + free_number(pxy); + free_number(pyx); + free_number(pyy); + mp_name_type(p) = mp_capsule_operation; + mp->cur_exp.type = mp_transform_type; + mp_set_cur_exp_node(mp, p); + mp_back_expr(mp); +} + +void mp_push_path_value (MP mp, mp_knot k) +{ + mp->cur_exp.type = mp_path_type; + mp_set_cur_exp_knot(mp, k); + mp_back_expr(mp); +} + +static void check_for_mediation (MP mp); +static void mp_primary_error(MP mp) +{ + mp_value new_expr; + memset(&new_expr, 0, sizeof(mp_value)); + mp_disp_err(mp, NULL); + new_number(new_expr.data.n); + mp_back_error( + mp, + "Nonnumeric part has been replaced by 0", + "I've started to scan a pair (x,y), color (r,g,b), cmykcolor (c,m,y,k) or\n" + "transform (tx,ty,xx,xy,yx,yy) but ran into a non-numeric type. I'll recover\n" + "as good as possible." + ); + mp_get_x_next(mp); + mp_flush_cur_exp(mp, new_expr); +} +void mp_scan_primary (MP mp) +{ + mp_command_code my_var_flag = mp->var_flag; + mp->var_flag = 0; + RESTART: + check_arith(); + switch (cur_cmd) { + case mp_left_delimiter_command: + { + mp_sym l_delim = cur_sym; + mp_sym r_delim = equiv_sym(cur_sym); + mp_get_x_next(mp); + mp_scan_expression(mp); + if ((cur_cmd == mp_comma_command) && (mp->cur_exp.type >= mp_known_type)) { + mp_node q = mp_new_value_node(mp); + mp_node p1 = mp_stash_cur_exp(mp); + mp_node r; + mp_name_type(q) = mp_capsule_operation; + mp_get_x_next(mp); + mp_scan_expression(mp); + if (mp->cur_exp.type < mp_known_type) { + mp_primary_error(mp); + } + if (cur_cmd != mp_comma_command) { + mp_init_pair_node(mp, q); + r = mp_get_value_node(q); + mp_stash_in(mp, mp_y_part(r)); + mp_unstash_cur_exp(mp, p1); + mp_stash_in(mp, mp_x_part(r)); + } else { + mp_node p2 = mp_stash_cur_exp(mp); + mp_get_x_next(mp); + mp_scan_expression(mp); + if (mp->cur_exp.type < mp_known_type) { + mp_primary_error(mp); + } + if (cur_cmd != mp_comma_command) { + mp_init_color_node(mp, q, mp_color_type); + r = mp_get_value_node(q); + mp_stash_in(mp, mp_blue_part(r)); + mp_unstash_cur_exp(mp, p1); + mp_stash_in(mp, mp_red_part(r)); + mp_unstash_cur_exp(mp, p2); + mp_stash_in(mp, mp_green_part(r)); + } else { + mp_node p3 = mp_stash_cur_exp(mp); + mp_get_x_next(mp); + mp_scan_expression(mp); + if (mp->cur_exp.type < mp_known_type) { + mp_primary_error(mp); + } + if (cur_cmd != mp_comma_command) { + mp_init_color_node(mp, q, mp_cmykcolor_type); + r = mp_get_value_node(q); + mp_stash_in(mp, mp_black_part(r)); + mp_unstash_cur_exp(mp, p1); + mp_stash_in(mp, mp_cyan_part(r)); + mp_unstash_cur_exp(mp, p2); + mp_stash_in(mp, mp_magenta_part(r)); + mp_unstash_cur_exp(mp, p3); + mp_stash_in(mp, mp_yellow_part(r)); + } else { + mp_node p4 = mp_stash_cur_exp(mp); + mp_node p5; + mp_get_x_next(mp); + mp_scan_expression(mp); + if (mp->cur_exp.type < mp_known_type) { + mp_primary_error(mp); + p5 = mp_stash_cur_exp(mp); + goto HERE; + } + if (cur_cmd != mp_comma_command) { + mp_primary_error(mp); + p5 = mp_stash_cur_exp(mp); + goto HERE; + } + p5 = mp_stash_cur_exp(mp); + mp_get_x_next(mp); + mp_scan_expression(mp); + if (mp->cur_exp.type < mp_known_type) { + mp_primary_error(mp); + } + HERE: + mp_init_transform_node(mp, q); + r = mp_get_value_node(q); + mp_stash_in(mp, mp_ty_part(r)); + mp_unstash_cur_exp(mp, p5); + mp_stash_in(mp, mp_tx_part(r)); + mp_unstash_cur_exp(mp, p4); + mp_stash_in(mp, mp_yy_part(r)); + mp_unstash_cur_exp(mp, p3); + mp_stash_in(mp, mp_yx_part(r)); + mp_unstash_cur_exp(mp, p2); + mp_stash_in(mp, mp_xy_part(r)); + mp_unstash_cur_exp(mp, p1); + mp_stash_in(mp, mp_xx_part(r)); + } + } + } + mp_check_delimiter(mp, l_delim, r_delim); + mp->cur_exp.type = mp_type(q); + mp_set_cur_exp_node(mp, q); + } else { + mp_check_delimiter(mp, l_delim, r_delim); + } + } + break; + case mp_begin_group_command: + { + int group_line = mp_true_line(mp); + if (number_positive(internal_value(mp_tracing_commands_internal))) { + mp_show_cmd_mod(mp, cur_cmd, cur_mod); + } + mp_save_boundary(mp); + do { + mp_do_statement(mp); + } while (cur_cmd == mp_semicolon_command); + if (cur_cmd != mp_end_group_command) { + char msg[256]; + mp_snprintf(msg, 256, "A group begun on line %d never ended", (int) group_line); + mp_back_error( + mp, + msg, + "I saw a 'begingroup' back there that hasn't been matched by 'endgroup'. So I've\n" + "inserted 'endgroup' now." + ); + set_cur_cmd(mp_end_group_command); + } + mp_unsave(mp); + if (number_positive(internal_value(mp_tracing_commands_internal))) { + mp_show_cmd_mod(mp, cur_cmd, cur_mod); + } + } + break; + case mp_string_command: + mp->cur_exp.type = mp_string_type; + mp_set_cur_exp_str(mp, cur_mod_str); + break; + case mp_numeric_command: + { + mp_number num, denom; + mp_set_cur_exp_value_number(mp, &cur_mod_number); + mp->cur_exp.type = mp_known_type; + mp_get_x_next(mp); + + + if (cur_cmd != mp_slash_command) { + new_number(num); + new_number(denom); + } else { + mp_get_x_next(mp); + if (cur_cmd != mp_numeric_command) { + mp_back_input(mp); + set_cur_cmd(mp_slash_command); + set_cur_mod(mp_over_operation); + set_cur_sym(mp->frozen_slash); + + goto DONE; + } else { + new_number_clone(num, cur_exp_value_number); + new_number_clone(denom, cur_mod_number); + + + if (number_zero(denom)) { + mp_error(mp, "Division by zero", "I'll pretend that you meant to divide by 1."); + } else { + mp_number ret; + new_number(ret); + make_scaled(ret, num, denom); + mp_set_cur_exp_value_number(mp, &ret); + free_number(ret); + } + check_arith(); + mp_get_x_next(mp); + } + } + if (cur_cmd >= mp_min_primary_command && cur_cmd < mp_numeric_command) { + mp_number absnum, absdenom; + mp_node p = mp_stash_cur_exp(mp); + mp_scan_primary(mp); + new_number_abs(absnum, num); + new_number_abs(absdenom, denom); + if (number_greaterequal(absnum, absdenom) || (mp->cur_exp.type < mp_color_type)) { + mp_do_binary(mp, p, mp_times_operation); + } else { + mp_frac_mult(mp, &num, &denom); + mp_free_value_node(mp, p); + } + free_number(absnum); + free_number(absdenom); + } + free_number(num); + free_number(denom); + goto DONE; + } + case mp_nullary_command: + mp_do_nullary(mp, (int) cur_mod); + break; + case mp_unary_command: + case mp_type_name_command: + case mp_cycle_command: + case mp_plus_or_minus_command: + { + int c = (int) cur_mod; + mp_get_x_next(mp); + mp_scan_primary(mp); + mp_do_unary(mp, c); + goto DONE; + } + case mp_of_binary_command: + { + mp_node p; + int c = (int) cur_mod; + mp_get_x_next(mp); + mp_scan_expression(mp); + if (cur_cmd != mp_of_command) { + char msg[256]; + mp_string sname; + int selector = mp->selector; + mp->selector = mp_new_string_selector; + mp_print_cmd_mod(mp, mp_of_binary_command, c); + mp->selector = selector; + sname = mp_make_string(mp); + mp_snprintf(msg, 256, "Missing 'of' has been inserted for %s", mp_str(mp, sname)); + delete_str_ref(sname); + mp_back_error(mp, msg, "I've got the first argument; will look now for the other."); + } + p = mp_stash_cur_exp(mp); + mp_get_x_next(mp); + mp_scan_primary(mp); + mp_do_binary(mp, p, c); + goto DONE; + } + case mp_str_command: + { + int selector = mp->selector; + mp_get_x_next(mp); + mp_scan_suffix(mp); + mp->selector = mp_new_string_selector; + mp_show_token_list(mp, cur_exp_node, NULL); + mp_flush_token_list(mp, cur_exp_node); + mp_set_cur_exp_str(mp, mp_make_string(mp)); + mp->selector = selector; + mp->cur_exp.type = mp_string_type; + goto DONE; + } + case mp_void_command: + { + mp_value new_expr; + memset(&new_expr, 0, sizeof(mp_value)); + new_number(new_expr.data.n); + mp_get_x_next(mp); + mp_scan_suffix(mp); + if (cur_exp_node == NULL) { + set_number_from_boolean(new_expr.data.n, mp_true_operation); + } else { + set_number_from_boolean(new_expr.data.n, mp_false_operation); + } + mp_flush_cur_exp(mp, new_expr); + cur_exp_node = NULL; + mp->cur_exp.type = mp_boolean_type; + goto DONE; + } + case mp_internal_command: + { + int qq = cur_mod; + if (my_var_flag == mp_assignment_command) { + mp_get_x_next(mp); + if (cur_cmd == mp_assignment_command) { + mp_set_cur_exp_node(mp, mp_new_symbolic_node(mp)); + mp_set_sym_info(cur_exp_node, qq); + mp_name_type(cur_exp_node) = mp_internal_operation; + mp->cur_exp.type = mp_token_list_type; + goto DONE; + } + mp_back_input(mp); + } + if (internal_type(qq) == mp_string_type) { + mp_set_cur_exp_str(mp, internal_string(qq)); + } else { + mp_set_cur_exp_value_number(mp, &(internal_value(qq))); + } + mp->cur_exp.type = internal_type(qq); + } + break; + case mp_capsule_command: + mp_make_exp_copy(mp, cur_mod_node); + break; + case mp_tag_command: + { + mp_node p = 0; + mp_node q = 0; + mp_node t = 0; + mp_node macro_ref = 0; + int tt = mp_vacuous_type; + mp_node pre_head = mp_new_symbolic_node(mp); + mp_node tail = pre_head; + mp_node post_head = NULL; + while (1) { + t = mp_cur_tok(mp); + mp_link(tail) = t; + if (tt != mp_undefined_type) { + mp_sym qq; + p = mp_link(pre_head); + qq = mp_get_sym_sym(p); + tt = mp_undefined_type; + + if (eq_type(qq) == mp_tag_command) { + q = equiv_node(qq); + if (q == NULL) { + goto DONE2; + } + while (1) { + p = mp_link(p); + if (p == NULL) { + tt = mp_type(q); + goto DONE2; + } + if (mp_type(q) != mp_structured_type) { + goto DONE2; + } + q = mp_link(mp_get_attribute_head(q)); + if (mp_type(p) == mp_symbol_node_type) { + do { + q = mp_link(q); + } while (! (mp_get_hashloc(q) >= mp_get_sym_sym(p))); + if (mp_get_hashloc(q) > mp_get_sym_sym(p)) { + goto DONE2; + } + } + } + } + DONE2: + if (tt >= mp_unsuffixed_macro_type) { + mp_link(tail) = NULL; + if (tt > mp_unsuffixed_macro_type) { + post_head = mp_new_symbolic_node(mp); + tail = post_head; + mp_link(tail) = t; + tt = mp_undefined_type; + macro_ref = mp_get_value_node(q); + mp_add_mac_ref(macro_ref); + } else { + p = mp_new_symbolic_node(mp); + mp_set_sym_sym(pre_head, mp_link(pre_head)); + mp_link(pre_head) = p; + mp_set_sym_sym(p, t); + mp_macro_call(mp, mp_get_value_node(q), pre_head, NULL); + mp_get_x_next(mp); + goto RESTART; + } + } + } + mp_get_x_next(mp); + tail = t; + if (cur_cmd == mp_left_bracket_command) { + mp_get_x_next(mp); + mp_scan_expression(mp); + if (cur_cmd != mp_right_bracket_command) { + mp_back_input(mp); + mp_back_expr(mp); + set_cur_cmd(mp_left_bracket_command); + set_cur_mod_number(zero_t); + set_cur_sym(mp->frozen_left_bracket); + } else { + if (mp->cur_exp.type != mp_known_type) { + mp_bad_subscript(mp); + } + set_cur_cmd(mp_numeric_command); + set_cur_mod_number(cur_exp_value_number); + set_cur_sym(NULL); + } + } + if (cur_cmd > mp_max_suffix_token) { + break; + } else if (cur_cmd < mp_min_suffix_token) { + break; + } + } + if (post_head != NULL) { + mp_back_input(mp); + p = mp_new_symbolic_node(mp); + q = mp_link(post_head); + mp_set_sym_sym(pre_head, mp_link(pre_head)); + mp_link(pre_head) = post_head; + mp_set_sym_sym(post_head, q); + mp_link(post_head) = p; + mp_set_sym_sym(p, mp_link(q)); + mp_link(q) = NULL; + mp_macro_call(mp, macro_ref, pre_head, NULL); + mp_decr_mac_ref(macro_ref); + mp_get_x_next(mp); + goto RESTART; + } + q = mp_link(pre_head); + mp_free_symbolic_node(mp, pre_head); + if (cur_cmd == my_var_flag) { + mp->cur_exp.type = mp_token_list_type; + mp_set_cur_exp_node(mp, q); + goto DONE; + } + p = mp_find_variable(mp, q); + if (p != NULL) { + mp_make_exp_copy(mp, p); + } else { + mp_value new_expr; + char *msg = mp_obliterated (mp, q); + memset(&new_expr, 0, sizeof(mp_value)); + new_number(new_expr.data.n); + mp_back_error( + mp, + msg, + "While I was evaluating the suffix of this variable, something was redefined, and\n" + "it's no longer a variable! In order to get back on my feet, I've inserted '0'\n" + "instead." + ); + mp_memory_free(msg); + mp_get_x_next(mp); + mp_flush_cur_exp(mp, new_expr); + } + mp_flush_node_list(mp, q); + goto DONE; + } + break; + default: + mp_bad_exp(mp, "A primary"); + goto RESTART; + break; + } + mp_get_x_next(mp); + DONE: + check_for_mediation(mp); +} +static void check_for_mediation (MP mp) +{ + if (cur_cmd == mp_left_bracket_command && mp->cur_exp.type >= mp_known_type) { + mp_node p = mp_stash_cur_exp(mp); + mp_get_x_next(mp); + mp_scan_expression(mp); + if (cur_cmd != mp_comma_command) { + mp_back_input(mp); + mp_back_expr(mp); + set_cur_cmd(mp_left_bracket_command); + set_cur_mod_number(zero_t); + set_cur_sym(mp->frozen_left_bracket); + mp_unstash_cur_exp(mp, p); + } else { + mp_node q = mp_stash_cur_exp(mp); + mp_node r; + mp_get_x_next(mp); + mp_scan_expression(mp); + if (cur_cmd != mp_right_bracket_command) { + mp_back_error( + mp, + "Missing ']' has been inserted", + "I've scanned an expression of the form 'a[b,c', so a right bracket should have\n" + "come next. I shall pretend that one was there." + ); + } + r = mp_stash_cur_exp(mp); + mp_make_exp_copy(mp, q); + mp_do_binary(mp, r, mp_minus_operation); + mp_do_binary(mp, p, mp_times_operation); + mp_do_binary(mp, q, mp_plus_operation); + mp_get_x_next(mp); + } + } +} +static void mp_scan_suffix (MP mp) +{ + mp_node h = mp_new_symbolic_node(mp); + mp_node t = h; + while (1) { + mp_node p; + if (cur_cmd == mp_left_bracket_command) { + mp_get_x_next(mp); + mp_scan_expression(mp); + if (mp->cur_exp.type != mp_known_type) { + mp_bad_subscript(mp); + } + if (cur_cmd != mp_right_bracket_command) { + mp_back_error( + mp, + "Missing ']' has been inserted", + "I've seen a '[' and a subscript value, in a suffix, so a right bracket should\n" + "have come next. I shall pretend that one was there." + ); + } + set_cur_cmd(mp_numeric_command); + set_cur_mod_number(cur_exp_value_number); + } + if (cur_cmd == mp_numeric_command) { + mp_number arg1; + new_number_clone(arg1, cur_mod_number); + p = mp_new_num_tok(mp, &arg1); + free_number(arg1); + } else if ((cur_cmd == mp_tag_command) || (cur_cmd == mp_internal_command)) { + p = mp_new_symbolic_node(mp); + mp_set_sym_sym(p, cur_sym); + mp_name_type(p) = cur_sym_mod; + } else { + break; + } + mp_link(t) = p; + t = p; + mp_get_x_next(mp); + } + mp_set_cur_exp_node(mp, mp_link(h)); + mp_free_symbolic_node(mp, h); + mp->cur_exp.type = mp_token_list_type; +} +static void mp_scan_secondary (MP mp) +{ + mp_node cc = NULL; + mp_sym mac_name = NULL; + RESTART: + if ((cur_cmd < mp_min_primary_command) || (cur_cmd > mp_max_primary_command)) { + mp_bad_exp(mp, "A secondary"); + } + mp_scan_primary(mp); + CONTINUE: + if (cur_cmd <= mp_max_secondary_command && cur_cmd >= mp_min_secondary_command) { + mp_node p = mp_stash_cur_exp(mp); + int d = cur_cmd; + int c = cur_mod; + if (d == mp_primary_def_command) { + cc = cur_mod_node; + mac_name = cur_sym; + mp_add_mac_ref(cc); + } + mp_get_x_next(mp); + mp_scan_primary(mp); + if (d != mp_primary_def_command) { + mp_do_binary(mp, p, c); + } else { + mp_back_input(mp); + mp_binary_mac(mp, p, cc, mac_name); + mp_decr_mac_ref(cc); + mp_get_x_next(mp); + goto RESTART; + } + goto CONTINUE; + } +} +static void mp_scan_tertiary (MP mp) +{ + mp_node cc = NULL; + mp_sym mac_name = NULL; + RESTART: + if ((cur_cmd < mp_min_primary_command) || (cur_cmd > mp_max_primary_command)) { + mp_bad_exp(mp, "A tertiary"); + } + mp_scan_secondary(mp); + CONTINUE: + if (cur_cmd <= mp_max_tertiary_command && cur_cmd >= mp_min_tertiary_command) { + mp_node p = mp_stash_cur_exp(mp); + int c = cur_mod; + int d = cur_cmd; + if (d == mp_secondary_def_command) { + cc = cur_mod_node; + mac_name = cur_sym; + mp_add_mac_ref(cc); + } + mp_get_x_next(mp); + mp_scan_secondary(mp); + if (d != mp_secondary_def_command) { + mp_do_binary(mp, p, c); + } else { + mp_back_input(mp); + mp_binary_mac(mp, p, cc, mac_name); + mp_decr_mac_ref(cc); + mp_get_x_next(mp); + goto RESTART; + } + goto CONTINUE; + } +} +static int mp_scan_path (MP mp); +static void mp_scan_expression (MP mp) +{ + int my_var_flag = mp->var_flag; + mp_check_expansion_depth(mp); + RESTART: + if ((cur_cmd < mp_min_primary_command) || (cur_cmd > mp_max_primary_command)) { + mp_bad_exp(mp, "An"); + } + mp_scan_tertiary(mp); + CONTINUE: + if (cur_cmd <= mp_max_expression_command) { + if (cur_cmd >= mp_min_expression_command) { + if ((cur_cmd != mp_equals_command) || (my_var_flag != mp_assignment_command)) { + mp_node cc = NULL; + mp_sym mac_name; + mac_name = NULL; + mp_node p = mp_stash_cur_exp(mp); + int d = cur_cmd; + int c = cur_mod; + if (d == mp_tertiary_def_command) { + cc = cur_mod_node; + mac_name = cur_sym; + mp_add_mac_ref(cc); + } + if ((d < mp_ampersand_command) || ((d == mp_ampersand_command) && ((mp_type(p) == mp_pair_type) || (mp_type(p) == mp_path_type)))) { + mp_unstash_cur_exp(mp, p); + if (! mp_scan_path(mp)) { + mp->expand_depth_count--; + return; + } + } else { + mp_get_x_next(mp); + mp_scan_tertiary(mp); + if (d != mp_tertiary_def_command) { + mp_do_binary(mp, p, c); + } else { + mp_back_input(mp); + mp_binary_mac(mp, p, cc, mac_name); + mp_decr_mac_ref(cc); + mp_get_x_next(mp); + goto RESTART; + } + } + goto CONTINUE; + } + } + } + mp->expand_depth_count--; +} +static void force_valid_tension_setting (MP mp) +{ + if ((mp->cur_exp.type != mp_known_type) || number_less(cur_exp_value_number, min_tension)) { + mp_value new_expr; + memset(&new_expr, 0, sizeof(mp_value)); + new_number(new_expr.data.n); + mp_disp_err(mp, NULL); + number_clone(new_expr.data.n, unity_t); + mp_back_error( + mp, + "Improper tension has been set to 1", + "The expression above should have been a number >= 3/4." + ); + mp_get_x_next(mp); + mp_flush_cur_exp(mp, new_expr); + } +} +static int mp_scan_path (MP mp) +{ + mp_knot path_p, path_q, r; + mp_knot pp = NULL; + mp_knot qq = NULL; + int d, dd; + int cycle_hit = 0; + mp_number x, y; + int t = mp_endpoint_knot; + if (mp->cur_exp.type == mp_pair_type) { + path_p = mp_pair_to_knot(mp); + } else if (mp->cur_exp.type == mp_path_type) { + path_p = cur_exp_knot; + } else { + return 0; + } + path_q = path_p; + while (mp_next_knot(path_q) != path_p) { + path_q = mp_next_knot(path_q); + } + if (mp_left_type(path_p) != mp_endpoint_knot) { + r = mp_copy_knot(mp, path_p); + mp_prev_knot(r) = path_q; + mp_next_knot(path_q) = r; + path_q = r; + } + mp_left_type(path_p) = mp_open_knot; + mp_right_type(path_q) = mp_open_knot; + new_number(y); + new_number(x); + CONTINUE_PATH: + if (cur_cmd == mp_left_brace_command) { + t = mp_scan_direction(mp); + if (t != mp_open_knot) { + mp_right_type(path_q) = (unsigned char) t; + number_clone(path_q->right_given, cur_exp_value_number); + if (mp_left_type(path_q) == mp_open_knot) { + mp_left_type(path_q) = (unsigned char) t; + number_clone(path_q->left_given, cur_exp_value_number); + } + } + } + d = cur_cmd; + dd = cur_mod; + if (d == mp_path_join_command) { + mp_get_x_next(mp); + switch (cur_cmd) { + case mp_tension_command: + mp_get_x_next(mp); + set_number_from_scaled(y, cur_cmd); + if (cur_cmd == mp_at_least_command) { + mp_get_x_next(mp); + } + mp_scan_primary(mp); + force_valid_tension_setting(mp); + if (number_to_scaled(y) == mp_at_least_command && is_number(cur_exp_value_number)) { + number_negate(cur_exp_value_number); + } + number_clone(path_q->right_tension, cur_exp_value_number); + if (cur_cmd == mp_and_command) { + mp_get_x_next(mp); + set_number_from_scaled(y, cur_cmd); + if (cur_cmd == mp_at_least_command) { + mp_get_x_next(mp); + } + mp_scan_primary(mp); + force_valid_tension_setting(mp); + if (number_to_scaled(y) == mp_at_least_command && is_number(cur_exp_value_number)) { + number_negate(cur_exp_value_number); + } + } + number_clone(y, cur_exp_value_number); + break; + case mp_controls_command: + mp_right_type(path_q) = mp_explicit_knot; + t = mp_explicit_knot; + mp_get_x_next(mp); + mp_scan_primary(mp); + mp_known_pair(mp); + number_clone(path_q->right_x, mp->cur_x); + number_clone(path_q->right_y, mp->cur_y); + if (cur_cmd != mp_and_command) { + number_clone(x, path_q->right_x); + number_clone(y, path_q->right_y); + } else { + mp_get_x_next(mp); + mp_scan_primary(mp); + mp_known_pair(mp); + number_clone(x, mp->cur_x); + number_clone(y, mp->cur_y); + } + break; + default: + set_number_to_unity(path_q->right_tension); + set_number_to_unity(y); + mp_back_input(mp); + goto DONE; + break; + } + if (cur_cmd != mp_path_join_command) { + mp_back_error( + mp, + "Missing '..' has been inserted", + "A path join command should end with two dots." + ); + } + DONE: + ; + } else if (d != mp_ampersand_command) { + goto FINISH_PATH; + } + mp_get_x_next(mp); + if (cur_cmd == mp_left_brace_command) { + t = mp_scan_direction(mp); + if (mp_right_type(path_q) != mp_explicit_knot) { + number_clone(x, cur_exp_value_number); + } else { + t = mp_explicit_knot; + } + } else if (mp_right_type(path_q) != mp_explicit_knot) { + t = mp_open_knot; + set_number_to_zero(x); + } + if (cur_cmd == mp_cycle_command) { + if (cur_mod == mp_cycle_operation) { + cycle_hit = 1; + mp_get_x_next(mp); + pp = path_p; + qq = path_p; + if (d == mp_ampersand_command && path_p == path_q) { + d = mp_path_join_command; + set_number_to_unity(path_q->right_tension); + set_number_to_unity(y); + } + } else { + mp_get_x_next(mp); + qq = pp; + goto FINISH_PATH; + } + } else { + mp_scan_tertiary(mp); + if (mp->cur_exp.type != mp_path_type) { + pp = mp_pair_to_knot(mp); + } else { + pp = cur_exp_knot; + } + qq = pp; + while (mp_next_knot(qq) != pp) { + qq = mp_next_knot(qq); + } + if (mp_left_type(pp) != mp_endpoint_knot) { + r = mp_copy_knot(mp, pp); + mp_prev_knot(r) = qq; + mp_next_knot(qq) = r; + qq = r; + } + mp_left_type(pp) = mp_open_knot; + mp_right_type(qq) = mp_open_knot; + } + if (d == mp_ampersand_command && dd != mp_just_append_operation) { + if (! (number_equal(path_q->x_coord, pp->x_coord)) || ! (number_equal(path_q->y_coord, pp->y_coord))) { + mp_back_error( + mp, + "Paths don't touch; '&' will be changed to '..'", + "When you join paths 'p & q', the ending point of p must be exactly equal to the\n" + "starting point of q. So I'm going to pretend that you said 'p .. q' instead." + ); + mp_get_x_next(mp); + d = mp_path_join_command; + set_number_to_unity(path_q->right_tension); + set_number_to_unity(y); + } + } + if (mp_right_type(pp) == mp_open_knot && ((t == mp_curl_knot) || (t == mp_given_knot))) { + mp_right_type(pp) = (unsigned char) t; + number_clone(pp->right_given, x); + } + if (d == mp_ampersand_command) { + if (dd == mp_just_append_operation) { + mp_left_type(pp) = mp_explicit_knot; + mp_right_type(path_q) = mp_explicit_knot; + mp_prev_knot(pp) = path_q; + mp_next_knot(path_q) = pp; + number_clone(pp->left_x, path_q->x_coord); + number_clone(pp->left_y, path_q->y_coord); + number_clone(path_q->right_x, pp->x_coord); + number_clone(path_q->right_y, pp->y_coord); + mp_knotstate(pp) = mp_begin_knot; + mp_knotstate(path_q) = mp_end_knot; + path_q = pp; + } else { + if (mp_left_type(path_q) == mp_open_knot && mp_right_type(path_q) == mp_open_knot) { + mp_left_type(path_q) = mp_curl_knot; + set_number_to_unity(path_q->left_curl); + } + if (mp_right_type(pp) == mp_open_knot && t == mp_open_knot) { + mp_right_type(pp) = mp_curl_knot; + set_number_to_unity(pp->right_curl); + } + mp_right_type(path_q) = mp_right_type(pp); + mp_prev_knot(pp) = mp_next_knot(path_q); + mp_next_knot(path_q) = mp_next_knot(pp); + number_clone(path_q->right_x, pp->right_x); + number_clone(path_q->right_y, pp->right_y); + mp_memory_free(pp); + } + if (qq == pp) { + qq = path_q; + } + } else { + if (mp_right_type(path_q) == mp_open_knot && ((mp_left_type(path_q) == mp_curl_knot) || (mp_left_type(path_q) == mp_given_knot))) { + mp_right_type(path_q) = mp_left_type(path_q); + number_clone(path_q->right_given, path_q->left_given); + } + mp_prev_knot(pp) = path_q; + mp_next_knot(path_q) = pp; + number_clone(pp->left_y, y); + if (t != mp_open_knot) { + number_clone(pp->left_x, x); + mp_left_type(pp) = (unsigned char) t; + }; + } + path_q = qq; + if (cur_cmd >= mp_min_expression_command && cur_cmd <= mp_ampersand_command && ! cycle_hit) { + goto CONTINUE_PATH; + } + FINISH_PATH: + if (cycle_hit) { + if (d == mp_ampersand_command) { + path_p = path_q; + } + } else { + mp_left_type(path_p) = mp_endpoint_knot; + if (mp_right_type(path_p) == mp_open_knot) { + mp_right_type(path_p) = mp_curl_knot; + set_number_to_unity(path_p->right_curl); + } + mp_right_type(path_q) = mp_endpoint_knot; + if (mp_left_type(path_q) == mp_open_knot) { + mp_left_type(path_q) = mp_curl_knot; + set_number_to_unity(path_q->left_curl); + } + mp_prev_knot(path_p) = path_q; + mp_next_knot(path_q) = path_p; + } + mp_make_choices(mp, path_p); + mp->cur_exp.type = mp_path_type; + mp_set_cur_exp_knot(mp, path_p); + free_number(x); + free_number(y); + return 1; +} +static void do_boolean_error (MP mp) +{ + mp_value new_expr; + memset(&new_expr, 0, sizeof(mp_value)); + new_number(new_expr.data.n); + mp_disp_err(mp, NULL); + set_number_from_boolean(new_expr.data.n, mp_false_operation); + mp_back_error( + mp, + "Undefined condition will be treated as 'false'", + "The expression shown above should have had a definite true-or-false value. I'm\n" + "changing it to 'false'." + ); + mp_get_x_next(mp); + mp_flush_cur_exp(mp, new_expr); + mp->cur_exp.type = mp_boolean_type; +} + +void mp_print_capsule (MP mp, mp_node p) +{ + mp_print_chr(mp, '('); + mp_print_exp(mp, p, 0); + mp_print_chr(mp, ')'); +} + +static void mp_close_files (MP mp) +{ + if (mp->rd_fname != NULL) { + for (int k = 0; k < (int) mp->read_files; k++) { + if (mp->rd_fname[k] != NULL) { + (mp->close_file)(mp, mp->rd_file[k]); + mp_memory_free(mp->rd_fname[k]); + mp->rd_fname[k] = NULL; + } + } + } + if (mp->wr_fname != NULL) { + for (int k = 0; k < (int) mp->write_files; k++) { + if (mp->wr_fname[k] != NULL) { + (mp->close_file)(mp, mp->wr_file[k]); + mp_memory_free(mp->wr_fname[k]); + mp->wr_fname[k] = NULL; + } + } + } +} + +void mp_close_files_and_terminate (MP mp) +{ + if (mp->finished) { + return; + } else { + mp_close_files(mp); + wake_up_terminal(); + mp_print_ln(mp); + mp->finished = 1; + } +} + +void mp_final_cleanup (MP mp) +{ + while (mp->input_ptr > 0) { + if (token_state) { + mp_end_token_list(mp); + } else { + mp_end_file_reading(mp); + } + } + while (mp->loop_ptr != NULL) { + mp_stop_iteration(mp); + } + if (mp->interaction < mp_silent_mode) { + while (mp->open_parens > 0) { + mp_print_str(mp, " )"); + --mp->open_parens; + } + } + while (mp->cond_ptr != NULL) { + mp_print_nl(mp, "(end occurred when "); + mp_print_cmd_mod(mp, mp_fi_or_else_command, mp->cur_if); + if (mp->if_line != 0) { + mp_print_str(mp, " on line "); + mp_print_int(mp, mp->if_line); + } + mp_print_str(mp, " was incomplete)"); + mp->if_line = mp_if_line_field(mp->cond_ptr); + mp->cur_if = mp_name_type(mp->cond_ptr); + mp->cond_ptr = mp_link(mp->cond_ptr); + } + if (mp->history != mp_spotless) { + if (((mp->history == mp_warning_issued) || (mp->interaction < mp_error_stop_mode))) { + if (mp->selector == mp_term_and_log_selector) { + mp->selector = mp_term_only_selector; + mp_print_nl(mp, "(see the transcript file for additional information)"); + mp->selector = mp_term_and_log_selector; + } + } + } +} + + void mp_init_prim (MP mp) +{ + mp_primitive(mp, "tracingtitles", mp_internal_command, mp_tracing_titles_internal); + mp_primitive(mp, "tracingequations", mp_internal_command, mp_tracing_equations_internal); + mp_primitive(mp, "tracingcapsules", mp_internal_command, mp_tracing_capsules_internal); + mp_primitive(mp, "tracingchoices", mp_internal_command, mp_tracing_choices_internal); + mp_primitive(mp, "tracingspecs", mp_internal_command, mp_tracing_specs_internal); + mp_primitive(mp, "tracingcommands", mp_internal_command, mp_tracing_commands_internal); + mp_primitive(mp, "tracingrestores", mp_internal_command, mp_tracing_restores_internal); + mp_primitive(mp, "tracingmacros", mp_internal_command, mp_tracing_macros_internal); + mp_primitive(mp, "tracingoutput", mp_internal_command, mp_tracing_output_internal); + mp_primitive(mp, "tracingstats", mp_internal_command, mp_tracing_stats_internal); + mp_primitive(mp, "tracingonline", mp_internal_command, mp_tracing_online_internal); + mp_primitive(mp, "year", mp_internal_command, mp_year_internal); + mp_primitive(mp, "month", mp_internal_command, mp_month_internal); + mp_primitive(mp, "day", mp_internal_command, mp_day_internal); + mp_primitive(mp, "time", mp_internal_command, mp_time_internal); + mp_primitive(mp, "hour", mp_internal_command, mp_hour_internal); + mp_primitive(mp, "minute", mp_internal_command, mp_minute_internal); + mp_primitive(mp, "charcode", mp_internal_command, mp_char_code_internal); + mp_primitive(mp, "charwd", mp_internal_command, mp_char_wd_internal); + mp_primitive(mp, "charht", mp_internal_command, mp_char_ht_internal); + mp_primitive(mp, "chardp", mp_internal_command, mp_char_dp_internal); + mp_primitive(mp, "charic", mp_internal_command, mp_char_ic_internal); + mp_primitive(mp, "pausing", mp_internal_command, mp_pausing_internal); + mp_primitive(mp, "showstopping", mp_internal_command, mp_showstopping_internal); + mp_primitive(mp, "texscriptmode", mp_internal_command, mp_texscriptmode_internal); + mp_primitive(mp, "overloadmode", mp_internal_command, mp_overloadmode_internal); + mp_primitive(mp, "linejoin", mp_internal_command, mp_linejoin_internal); + mp_primitive(mp, "linecap", mp_internal_command, mp_linecap_internal); + mp_primitive(mp, "stacking", mp_internal_command, mp_stacking_internal); + mp_primitive(mp, "miterlimit", mp_internal_command, mp_miterlimit_internal); + mp_primitive(mp, "warningcheck", mp_internal_command, mp_warning_check_internal); + mp_primitive(mp, "truecorners", mp_internal_command, mp_true_corners_internal); + mp_primitive(mp, "defaultcolormodel", mp_internal_command, mp_default_color_model_internal); + mp_primitive(mp, "restoreclipcolor", mp_internal_command, mp_restore_clip_color_internal); + mp_primitive(mp, "numbersystem", mp_internal_command, mp_number_system_internal); + mp_primitive(mp, "numberprecision", mp_internal_command, mp_number_precision_internal); + mp_primitive(mp, "jobname", mp_internal_command, mp_job_name_internal); + mp_primitive(mp, "..", mp_path_join_command, 0); + mp_primitive(mp, "[", mp_left_bracket_command, 0); + mp->frozen_left_bracket = mp_frozen_primitive (mp, "[", mp_left_bracket_command, 0); + mp_primitive(mp, "]", mp_right_bracket_command, 0); + mp_primitive(mp, "}", mp_right_brace_command, 0); + mp_primitive(mp, "{", mp_left_brace_command, 0); + mp_primitive(mp, ":", mp_colon_command, 0); + mp->frozen_colon = mp_frozen_primitive (mp, ":", mp_colon_command, 0); + mp_primitive(mp, ":=", mp_assignment_command, 0); + mp_primitive(mp, ",", mp_comma_command, 0); + mp_primitive(mp, ";", mp_semicolon_command, 0); + mp->frozen_semicolon = mp_frozen_primitive (mp, ";", mp_semicolon_command, 0); + mp_primitive(mp, "\\", mp_relax_command, 0); + mp_primitive(mp, "addto", mp_add_to_command, 0); + mp_primitive(mp, "atleast", mp_at_least_command, 0); + mp_primitive(mp, "begingroup", mp_begin_group_command, 0); + mp->bg_loc = cur_sym; + mp_primitive(mp, "controls", mp_controls_command, 0); + mp_primitive(mp, "curl", mp_curl_command, 0); + mp_primitive(mp, "delimiters", mp_delimiters_command, 0); + mp_primitive(mp, "endgroup", mp_end_group_command, 0); + mp->eg_loc = cur_sym; + mp->frozen_end_group = mp_frozen_primitive (mp, "endgroup", mp_end_group_command, 0); + mp_primitive(mp, "everyjob", mp_every_job_command, 0); + mp_primitive(mp, "exitif", mp_exit_test_command, 0); + mp_primitive(mp, "expandafter", mp_expand_after_command, 0); + mp_primitive(mp, "interim", mp_interim_command, 0); + mp_primitive(mp, "let", mp_let_command, 0); + mp_primitive(mp, "newinternal", mp_new_internal_command, 0); + mp_primitive(mp, "of", mp_of_command, 0); + mp_primitive(mp, "randomseed", mp_only_set_command, mp_random_seed_code); + mp_primitive(mp, "maxknotpool", mp_only_set_command, mp_max_knot_pool_code); + mp_primitive(mp, "save", mp_save_command, 0); + mp_primitive(mp, "scantokens", mp_scan_tokens_command, 0); + mp_primitive(mp, "runscript", mp_runscript_command, 0); + mp_primitive(mp, "maketext", mp_maketext_command, 0); + mp_primitive(mp, "shipout", mp_ship_out_command, 0); + mp_primitive(mp, "step", mp_step_command, 0); + mp_primitive(mp, "str", mp_str_command, 0); + mp_primitive(mp, "void", mp_void_command, 0); + mp_primitive(mp, "tension", mp_tension_command, 0); + mp_primitive(mp, "to", mp_to_command, 0); + mp_primitive(mp, "until", mp_until_command, 0); + mp_primitive(mp, "within", mp_within_command, 0); + mp_primitive(mp, "write", mp_write_command, 0); + mp_primitive(mp, "btex", mp_btex_command, mp_btex_code); + mp_primitive(mp, "verbatimtex", mp_btex_command, mp_verbatim_code); + mp_primitive(mp, "etex", mp_etex_command, 0); + mp->frozen_etex = mp_frozen_primitive (mp, "etex", mp_etex_command, 0); + mp_primitive(mp, "def", mp_macro_def_command, mp_def_code); + mp_primitive(mp, "vardef", mp_macro_def_command, mp_var_def_code); + mp_primitive(mp, "primarydef", mp_macro_def_command, mp_primary_def_code); + mp_primitive(mp, "secondarydef", mp_macro_def_command, mp_secondary_def_code); + mp_primitive(mp, "tertiarydef", mp_macro_def_command, mp_tertiary_def_code); + mp_primitive(mp, "enddef", mp_macro_def_command, mp_end_def_code); + mp->frozen_end_def = mp_frozen_primitive(mp, "enddef", mp_macro_def_command, mp_end_def_code); + mp_primitive(mp, "for", mp_iteration_command, mp_start_for_code); + mp_primitive(mp, "forsuffixes", mp_iteration_command, mp_start_forsuffixes_code); + mp_primitive(mp, "forever", mp_iteration_command, mp_start_forever_code); + mp_primitive(mp, "endfor", mp_iteration_command, mp_end_for_code); + mp->frozen_end_for = mp_frozen_primitive (mp, "endfor", mp_iteration_command, mp_end_for_code); + mp_primitive(mp, "quote", mp_macro_special_command, mp_macro_quote_code); + mp_primitive(mp, "#@", mp_macro_special_command, mp_macro_prefix_code); + mp_primitive(mp, "@", mp_macro_special_command, mp_macro_at_code); + mp_primitive(mp, "@#", mp_macro_special_command, mp_macro_suffix_code); + mp_primitive(mp, "expr", mp_parameter_commmand, mp_expr_parameter); + mp_primitive(mp, "suffix", mp_parameter_commmand, mp_suffix_parameter); + mp_primitive(mp, "text", mp_parameter_commmand, mp_text_parameter); + mp_primitive(mp, "primary", mp_parameter_commmand, mp_primary_macro); + mp_primitive(mp, "secondary", mp_parameter_commmand, mp_secondary_macro); + mp_primitive(mp, "tertiary", mp_parameter_commmand, mp_tertiary_macro); + mp_primitive(mp, "input", mp_input_command, 0); + mp_primitive(mp, "endinput", mp_input_command, 1); + mp_primitive(mp, "if", mp_if_test_command, mp_if_code); + mp_primitive(mp, "fi", mp_fi_or_else_command, mp_fi_code); + mp->frozen_fi = mp_frozen_primitive (mp, "fi", mp_fi_or_else_command, mp_fi_code); + mp_primitive(mp, "else", mp_fi_or_else_command, mp_else_code); + mp_primitive(mp, "elseif", mp_fi_or_else_command, mp_else_if_code); + mp_primitive(mp, "true", mp_nullary_command, mp_true_operation); + mp_primitive(mp, "false", mp_nullary_command, mp_false_operation); + mp_primitive(mp, "nullpicture", mp_nullary_command, mp_null_picture_operation); + mp_primitive(mp, "nullpen", mp_nullary_command, mp_null_pen_operation); + mp_primitive(mp, "readstring", mp_nullary_command, mp_read_string_operation); + mp_primitive(mp, "pencircle", mp_nullary_command, mp_pen_circle_operation); + mp_primitive(mp, "normaldeviate", mp_nullary_command, mp_normal_deviate_operation); + mp_primitive(mp, "readfrom", mp_unary_command, mp_read_from_operation); + mp_primitive(mp, "closefrom", mp_unary_command, mp_close_from_operation); + mp_primitive(mp, "odd", mp_unary_command, mp_odd_operation); + mp_primitive(mp, "known", mp_unary_command, mp_known_operation); + mp_primitive(mp, "unknown", mp_unary_command, mp_unknown_operation); + mp_primitive(mp, "not", mp_unary_command, mp_not_operation); + mp_primitive(mp, "decimal", mp_unary_command, mp_decimal_operation); + mp_primitive(mp, "reverse", mp_unary_command, mp_reverse_operation); + mp_primitive(mp, "uncycle", mp_unary_command, mp_uncycle_operation); + mp_primitive(mp, "makepath", mp_unary_command, mp_make_path_operation); + mp_primitive(mp, "makepen", mp_unary_command, mp_make_pen_operation); + mp_primitive(mp, "makenep", mp_unary_command, mp_make_nep_operation); + mp_primitive(mp, "convexed", mp_unary_command, mp_convexed_operation); + mp_primitive(mp, "uncontrolled", mp_unary_command, mp_uncontrolled_operation); + mp_primitive(mp, "oct", mp_unary_command, mp_oct_operation); + mp_primitive(mp, "hex", mp_unary_command, mp_hex_operation); + mp_primitive(mp, "ASCII", mp_unary_command, mp_ASCII_operation); + mp_primitive(mp, "char", mp_unary_command, mp_char_operation); + mp_primitive(mp, "length", mp_unary_command, mp_length_operation); + mp_primitive(mp, "turningnumber", mp_unary_command, mp_turning_operation); + mp_primitive(mp, "xpart", mp_unary_command, mp_x_part_operation); + mp_primitive(mp, "ypart", mp_unary_command, mp_y_part_operation); + mp_primitive(mp, "xxpart", mp_unary_command, mp_xx_part_operation); + mp_primitive(mp, "xypart", mp_unary_command, mp_xy_part_operation); + mp_primitive(mp, "yxpart", mp_unary_command, mp_yx_part_operation); + mp_primitive(mp, "yypart", mp_unary_command, mp_yy_part_operation); + mp_primitive(mp, "redpart", mp_unary_command, mp_red_part_operation); + mp_primitive(mp, "greenpart", mp_unary_command, mp_green_part_operation); + mp_primitive(mp, "bluepart", mp_unary_command, mp_blue_part_operation); + mp_primitive(mp, "cyanpart", mp_unary_command, mp_cyan_part_operation); + mp_primitive(mp, "magentapart", mp_unary_command, mp_magenta_part_operation); + mp_primitive(mp, "yellowpart", mp_unary_command, mp_yellow_part_operation); + mp_primitive(mp, "blackpart", mp_unary_command, mp_black_part_operation); + mp_primitive(mp, "greypart", mp_unary_command, mp_grey_part_operation); + mp_primitive(mp, "colormodel", mp_unary_command, mp_color_model_operation); + mp_primitive(mp, "prescriptpart", mp_unary_command, mp_prescript_part_operation); + mp_primitive(mp, "postscriptpart", mp_unary_command, mp_postscript_part_operation); + mp_primitive(mp, "stackingpart", mp_unary_command, mp_stacking_part_operation); + mp_primitive(mp, "pathpart", mp_unary_command, mp_path_part_operation); + mp_primitive(mp, "penpart", mp_unary_command, mp_pen_part_operation); + mp_primitive(mp, "dashpart", mp_unary_command, mp_dash_part_operation); + mp_primitive(mp, "sqrt", mp_unary_command, mp_sqrt_operation); + mp_primitive(mp, "mexp", mp_unary_command, mp_m_exp_operation); + mp_primitive(mp, "mlog", mp_unary_command, mp_m_log_operation); + mp_primitive(mp, "sind", mp_unary_command, mp_sin_d_operation); + mp_primitive(mp, "cosd", mp_unary_command, mp_cos_d_operation); + mp_primitive(mp, "floor", mp_unary_command, mp_floor_operation); + mp_primitive(mp, "uniformdeviate", mp_unary_command, mp_uniform_deviate_operation); + mp_primitive(mp, "llcorner", mp_unary_command, mp_ll_corner_operation); + mp_primitive(mp, "lrcorner", mp_unary_command, mp_lr_corner_operation); + mp_primitive(mp, "ulcorner", mp_unary_command, mp_ul_corner_operation); + mp_primitive(mp, "urcorner", mp_unary_command, mp_ur_corner_operation); + mp_primitive(mp, "centerof", mp_unary_command, mp_center_of_operation); + mp_primitive(mp, "centerofmass", mp_unary_command, mp_center_of_mass_operation); + mp_primitive(mp, "corners", mp_unary_command, mp_corners_operation); + mp_primitive(mp, "xrange", mp_unary_command, mp_x_range_operation); + mp_primitive(mp, "yrange", mp_unary_command, mp_y_range_operation); + mp_primitive(mp, "deltapoint", mp_unary_command, mp_delta_point_operation); + mp_primitive(mp, "deltaprecontrol", mp_unary_command, mp_delta_precontrol_operation); + mp_primitive(mp, "deltapostcontrol", mp_unary_command, mp_delta_postcontrol_operation); + mp_primitive(mp, "deltadirection", mp_unary_command, mp_delta_direction_operation); + mp_primitive(mp, "arclength", mp_unary_command, mp_arc_length_operation); + mp_primitive(mp, "angle", mp_unary_command, mp_angle_operation); + mp_primitive(mp, "cycle", mp_cycle_command, mp_cycle_operation); + mp_primitive(mp, "nocycle", mp_cycle_command, mp_no_cycle_operation); + mp_primitive(mp, "stroked", mp_unary_command, mp_stroked_operation); + mp_primitive(mp, "filled", mp_unary_command, mp_filled_operation); + mp_primitive(mp, "clipped", mp_unary_command, mp_clipped_operation); + mp_primitive(mp, "grouped", mp_unary_command, mp_grouped_operation); + mp_primitive(mp, "bounded", mp_unary_command, mp_bounded_operation); + mp_primitive(mp, "+", mp_plus_or_minus_command, mp_plus_operation); + mp_primitive(mp, "-", mp_plus_or_minus_command, mp_minus_operation); + mp_primitive(mp, "*", mp_secondary_binary_command, mp_times_operation); + mp_primitive(mp, "/", mp_slash_command, mp_over_operation); + mp->frozen_slash = mp_frozen_primitive (mp, "/", mp_slash_command, mp_over_operation); + mp_primitive(mp, "^", mp_secondary_binary_command, mp_power_operation); + mp_primitive(mp, "++", mp_tertiary_binary_command, mp_pythag_add_operation); + mp_primitive(mp, "+-+", mp_tertiary_binary_command, mp_pythag_sub_operation); + mp_primitive(mp, "or", mp_tertiary_binary_command, mp_or_operation); + mp_primitive(mp, "and", mp_and_command, mp_and_operation); + mp_primitive(mp, "<", mp_primary_binary_command, mp_less_than_operation); + mp_primitive(mp, "<=", mp_primary_binary_command, mp_less_or_equal_operation); + mp_primitive(mp, ">", mp_primary_binary_command, mp_greater_than_operation); + mp_primitive(mp, ">=", mp_primary_binary_command, mp_greater_or_equal_operation); + mp_primitive(mp, "=", mp_equals_command, mp_equal_operation); + mp_primitive(mp, "<>", mp_primary_binary_command, mp_unequal_operation); + mp_primitive(mp, "substring", mp_of_binary_command, mp_substring_operation); + mp_primitive(mp, "subpath", mp_of_binary_command, mp_subpath_operation); + mp_primitive(mp, "directiontime", mp_of_binary_command, mp_direction_time_operation); + mp_primitive(mp, "point", mp_of_binary_command, mp_point_operation); + mp_primitive(mp, "precontrol", mp_of_binary_command, mp_precontrol_operation); + mp_primitive(mp, "postcontrol", mp_of_binary_command, mp_postcontrol_operation); + mp_primitive(mp, "direction", mp_of_binary_command, mp_direction_operation); + mp_primitive(mp, "pathpoint", mp_nullary_command, mp_path_point_operation); + mp_primitive(mp, "pathprecontrol", mp_nullary_command, mp_path_precontrol_operation); + mp_primitive(mp, "pathpostcontrol", mp_nullary_command, mp_path_postcontrol_operation); + mp_primitive(mp, "pathdirection", mp_nullary_command, mp_path_direction_operation); + mp_primitive(mp, "penoffset", mp_of_binary_command, mp_pen_offset_operation); + mp_primitive(mp, "arctime", mp_of_binary_command, mp_arc_time_operation); + mp_primitive(mp, "arcpoint", mp_of_binary_command, mp_arc_point_operation); + mp_primitive(mp, "arcpointlist", mp_of_binary_command, mp_arc_point_list_operation); + mp_primitive(mp, "subarclength", mp_of_binary_command, mp_subarc_length_operation); + mp_primitive(mp, "mpversion", mp_nullary_command, mp_version_operation); + mp_primitive(mp, "&", mp_ampersand_command, mp_concatenate_operation); + mp_primitive(mp, "&&", mp_ampersand_command, mp_just_append_operation); + mp_primitive(mp, "rotated", mp_secondary_binary_command, mp_rotated_operation); + mp_primitive(mp, "slanted", mp_secondary_binary_command, mp_slanted_operation); + mp_primitive(mp, "scaled", mp_secondary_binary_command, mp_scaled_operation); + mp_primitive(mp, "shifted", mp_secondary_binary_command, mp_shifted_operation); + mp_primitive(mp, "transformed", mp_secondary_binary_command, mp_transformed_operation); + mp_primitive(mp, "xscaled", mp_secondary_binary_command, mp_x_scaled_operation); + mp_primitive(mp, "yscaled", mp_secondary_binary_command, mp_y_scaled_operation); + mp_primitive(mp, "zscaled", mp_secondary_binary_command, mp_z_scaled_operation); + mp_primitive(mp, "intersectiontimes", mp_tertiary_binary_command, mp_intertimes_operation); + mp_primitive(mp, "intersectiontimeslist", mp_tertiary_binary_command, mp_intertimes_list_operation); + mp_primitive(mp, "envelope", mp_of_binary_command, mp_envelope_operation); + mp_primitive(mp, "boundingpath", mp_of_binary_command, mp_boundingpath_operation); + mp_primitive(mp, "numeric", mp_type_name_command, mp_numeric_type_operation); + mp_primitive(mp, "string", mp_type_name_command, mp_string_type_operation); + mp_primitive(mp, "boolean", mp_type_name_command, mp_boolean_type_operation); + mp_primitive(mp, "path", mp_type_name_command, mp_path_type_operation); + mp_primitive(mp, "pen", mp_type_name_command, mp_pen_type_operation); + mp_primitive(mp, "nep", mp_type_name_command, mp_nep_type_operation); + mp_primitive(mp, "picture", mp_type_name_command, mp_picture_type_operation); + mp_primitive(mp, "transform", mp_type_name_command, mp_transform_type_operation); + mp_primitive(mp, "color", mp_type_name_command, mp_color_type_operation); + mp_primitive(mp, "rgbcolor", mp_type_name_command, mp_color_type_operation); + mp_primitive(mp, "cmykcolor", mp_type_name_command, mp_cmykcolor_type_operation); + mp_primitive(mp, "pair", mp_type_name_command, mp_pair_type_operation); + mp_primitive(mp, "end", mp_stop_command, 0); + mp_primitive(mp, "dump", mp_stop_command, 1); + mp->frozen_dump = mp_frozen_primitive (mp, "dump", mp_stop_command, 1); + mp_primitive(mp, "batchmode", mp_mode_command, mp_batch_mode); + mp_primitive(mp, "nonstopmode", mp_mode_command, mp_nonstop_mode); + mp_primitive(mp, "scrollmode", mp_mode_command, mp_scroll_mode); + mp_primitive(mp, "errorstopmode", mp_mode_command, mp_error_stop_mode); + mp_primitive(mp, "silentmode", mp_mode_command, mp_silent_mode); + mp_primitive(mp, "inner", mp_protection_command, 0); + mp_primitive(mp, "outer", mp_protection_command, 1); + mp_primitive(mp, "setproperty", mp_property_command, 1); + mp_primitive(mp, "showtoken", mp_show_command, mp_show_token_code); + mp_primitive(mp, "showstats", mp_show_command, mp_show_stats_code); + mp_primitive(mp, "show", mp_show_command, mp_show_code); + mp_primitive(mp, "showvariable", mp_show_command, mp_show_var_code); + mp_primitive(mp, "showdependencies", mp_show_command, mp_show_dependencies_code); + mp_primitive(mp, "doublepath", mp_thing_to_add_command, mp_add_double_path_code); + mp_primitive(mp, "contour", mp_thing_to_add_command, mp_add_contour_code); + mp_primitive(mp, "also", mp_thing_to_add_command, mp_add_also_code); + mp_primitive(mp, "withpen", mp_with_option_command, mp_with_pen_code); + mp_primitive(mp, "dashed", mp_with_option_command, mp_with_dashed_code); + mp_primitive(mp, "withprescript", mp_with_option_command, mp_with_pre_script_code); + mp_primitive(mp, "withpostscript", mp_with_option_command, mp_with_post_script_code); + mp_primitive(mp, "withstacking", mp_with_option_command, mp_with_stacking_code); + mp_primitive(mp, "withlinecap", mp_with_option_command, mp_with_linecap_code); + mp_primitive(mp, "withlinejoin", mp_with_option_command, mp_with_linejoin_code); + mp_primitive(mp, "withmiterlimit", mp_with_option_command, mp_with_miterlimit_code); + mp_primitive(mp, "withoutcolor", mp_with_option_command, mp_with_no_model_code); + mp_primitive(mp, "withgreyscale", mp_with_option_command, mp_with_grey_model_code); + mp_primitive(mp, "withcolor", mp_with_option_command, mp_with_uninitialized_model_code); + mp_primitive(mp, "withrgbcolor", mp_with_option_command, mp_with_rgb_model_code); + mp_primitive(mp, "withcmykcolor", mp_with_option_command, mp_with_cmyk_model_code); + mp_primitive(mp, "clip", mp_bounds_command, mp_start_clip_node_type); + mp_primitive(mp, "setgroup", mp_bounds_command, mp_start_group_node_type); + mp_primitive(mp, "setbounds", mp_bounds_command, mp_start_bounds_node_type); + mp_primitive(mp, "message", mp_message_command, message_code); + mp_primitive(mp, "errmessage", mp_message_command, err_message_code); + mp_primitive(mp, "errhelp", mp_message_command, err_help_code); + +} + + void mp_init_tab (MP mp) +{ + mp->spec_head = mp_new_symbolic_node(mp); + mp->temp_head = mp_new_symbolic_node(mp); + mp->hold_head = mp_new_symbolic_node(mp); + number_clone(internal_value(mp_default_color_model_internal),unity_t); + number_multiply_int(internal_value(mp_default_color_model_internal), mp_rgb_model); + number_clone(internal_value(mp_restore_clip_color_internal), unity_t); + set_internal_string(mp_number_system_internal, mp_intern (mp, "scaled")); + number_clone(internal_value(mp_number_precision_internal), precision_default); + number_clone(internal_value(mp_texscriptmode_internal), unity_t); + number_clone(internal_value(mp_overloadmode_internal), zero_t); + set_internal_name(mp_tracing_titles_internal, mp_strdup("tracingtitles")); + set_internal_name(mp_tracing_equations_internal, mp_strdup("tracingequations")); + set_internal_name(mp_tracing_capsules_internal, mp_strdup("tracingcapsules")); + set_internal_name(mp_tracing_choices_internal, mp_strdup("tracingchoices")); + set_internal_name(mp_tracing_specs_internal, mp_strdup("tracingspecs")); + set_internal_name(mp_tracing_commands_internal, mp_strdup("tracingcommands")); + set_internal_name(mp_tracing_restores_internal, mp_strdup("tracingrestores")); + set_internal_name(mp_tracing_macros_internal, mp_strdup("tracingmacros")); + set_internal_name(mp_tracing_output_internal, mp_strdup("tracingoutput")); + set_internal_name(mp_tracing_stats_internal, mp_strdup("tracingstats")); + set_internal_name(mp_tracing_online_internal, mp_strdup("tracingonline")); + set_internal_name(mp_year_internal, mp_strdup("year")); + set_internal_name(mp_month_internal, mp_strdup("month")); + set_internal_name(mp_day_internal, mp_strdup("day")); + set_internal_name(mp_time_internal, mp_strdup("time")); + set_internal_name(mp_hour_internal, mp_strdup("hour")); + set_internal_name(mp_minute_internal, mp_strdup("minute")); + set_internal_name(mp_char_code_internal, mp_strdup("charcode")); + set_internal_name(mp_char_wd_internal, mp_strdup("charwd")); + set_internal_name(mp_char_ht_internal, mp_strdup("charht")); + set_internal_name(mp_char_dp_internal, mp_strdup("chardp")); + set_internal_name(mp_char_ic_internal, mp_strdup("charic")); + set_internal_name(mp_pausing_internal, mp_strdup("pausing")); + set_internal_name(mp_showstopping_internal, mp_strdup("showstopping")); + set_internal_name(mp_texscriptmode_internal, mp_strdup("texscriptmode")); + set_internal_name(mp_overloadmode_internal, mp_strdup("overloadmode")); + set_internal_name(mp_linejoin_internal, mp_strdup("linejoin")); + set_internal_name(mp_linecap_internal, mp_strdup("linecap")); + set_internal_name(mp_stacking_internal, mp_strdup("stacking")); + set_internal_name(mp_miterlimit_internal, mp_strdup("miterlimit")); + set_internal_name(mp_warning_check_internal, mp_strdup("warningcheck")); + set_internal_name(mp_true_corners_internal, mp_strdup("truecorners")); + set_internal_name(mp_default_color_model_internal, mp_strdup("defaultcolormodel")); + set_internal_name(mp_restore_clip_color_internal, mp_strdup("restoreclipcolor")); + set_internal_name(mp_job_name_internal, mp_strdup("jobname")); + set_internal_name(mp_number_system_internal, mp_strdup("numbersystem")); + set_internal_name(mp_number_precision_internal, mp_strdup("numberprecision")); + mp->id_lookup_test = new_symbols_entry(mp, NULL, 0); + mp->st_count = 0; + mp->frozen_bad_vardef = mp_frozen_primitive(mp, "a bad variable", mp_tag_command, 0); + mp->frozen_right_delimiter = mp_frozen_primitive(mp, ")", mp_right_delimiter_command, 0); + mp->frozen_inaccessible = mp_frozen_primitive(mp, " INACCESSIBLE", mp_tag_command, 0); + mp->frozen_undefined = mp_frozen_primitive(mp, " UNDEFINED", mp_tag_command, 0); + mp->end_attr = (mp_node) mp_get_attribute_node(mp); + mp_set_hashloc(mp->end_attr, (mp_sym)-1); + mp_set_parent((mp_value_node) mp->end_attr, NULL); + new_fraction(mp->st); + new_fraction(mp->ct); + new_fraction(mp->sf); + new_fraction(mp->cf); + for (int i = 0; i <= mp_y_code; i++) { + new_number(mp->bbmin[i]); + new_number(mp->bbmax[i]); + } + new_number(mp->cur_x); + new_number(mp->cur_y); + mp->null_dash = mp_get_dash_node(mp); + new_number(mp->cur_t); + new_number(mp->cur_tt); + new_number(mp->max_t); + new_number(mp->delx); + new_number(mp->dely); + new_number(mp->appr_t); + new_number(mp->appr_tt); + mp->serial_no = 0; + mp->dep_head = mp_get_dep_node(mp); + mp_set_link(mp->dep_head, mp->dep_head); + mp_set_prev_dep(mp->dep_head, mp->dep_head); + mp_set_dep_info(mp->dep_head, NULL); + mp_set_dep_list(mp->dep_head, NULL); + mp->cur_mod_ = mp_new_symbolic_node(mp); + mp->bad_vardef = mp_new_value_node(mp); + mp_name_type(mp->bad_vardef) = mp_root_operation; + mp_set_value_sym(mp->bad_vardef, mp->frozen_bad_vardef); + mp->frozen_repeat_loop = + + mp_frozen_primitive (mp, " ENDFOR", mp_repeat_loop_command, 0); + for (int i = 0; i < mp_proto_dependent_type + 1; i++) { + new_number(mp->max_c[i]); + } + mp->temp_val = mp_new_value_node(mp); + mp_name_type(mp->temp_val) = mp_capsule_operation; + new_number(mp->txx); + new_number(mp->txy); + new_number(mp->tyx); + new_number(mp->tyy); + new_number(mp->tx); + new_number(mp->ty); + mp->inf_val = mp_new_value_node(mp); + mp_set_value_number(mp->inf_val, fraction_four_t); + mp->zero_val = mp_new_value_node(mp); + mp_set_value_number(mp->zero_val, zero_t); + +} + |