% mathematical symbols by Anthony Phan. % file: mathbase.mf (base file) % last modification: May 16, 2005. mathbase := 1; % when |mathbase| is known, this file has been input newinternal slant, currentbreadth, math_spread, superness, stress; slant := 0; superness := 1/sqrt 2; stress := 0.5; string main_name_string, tmp_string, extra_beginchar_save, extra_endchar_save; picture tmp_picture; path tmp_path, tmpp_path; boolean true_size, tmp_boolean, dagesh; true_size := false;% see mathhbrw.mf pair both; both = (1, 1); def autorounded = interim autorounding := 2 enddef; def localtransform = save currenttransform; transform currenttransform; currenttransform enddef; numeric currentlocation_; vardef currentlocation = currentlocation_ := currentlocation_+1; currentlocation_-1 enddef; def main_name_with(suffix $) = scantokens(main_name_string & str$) enddef; def math_setup = autorounding := 0; smoothing := 0; appr# := u#+letter_fit#; Appr# := 1.5u#+letter_fit#; numeric paren_depth#, asc_depth#, body_depth#; 0.5[body_height#, -paren_depth#] = math_axis#; 0.5[asc_height#, -asc_depth#] = math_axis#; body_depth# := desc_depth#+body_height#-asc_height#; % define_pixels(u, dh, dish, stem_corr, vair_corr); define_whole_blacker_pixels(hair, stem, curve, cap_hair, cap_stem, cap_curve, dtsz, ast_curve, ast_stem); define_whole_vertical_blacker_pixels(vair, slab);% cap_bar... define_whole_vertical_pixels(body_height, asc_height, cap_height, fig_height, x_height, desc_depth, asc_depth, body_depth, paren_depth); define_whole_pixels(letter_fit, appr, Appr, crisp, tiny, fine, ast_size); define_corrected_pixels(o); define_horizontal_corrected_pixels(ho); lowres_fix(stem, curve) 1.2; lowres_fix(cap_stem, cap_curve) 1.2; lowres_fix(hair, cap_hair) 1.2; oo := vround(0.5o#*hppp*o_correction)+eps; dw := (curve#-stem#)*hppp; bold := curve#*hppp+blacker; vair' := vround(vair+vair_corr); % % usual pens. % clear_pen_memory; if fine = 0: fine := 1; fi null := 0; forsuffixes $ = null, crisp, tiny, fine: $.breadth := $; pickup if $ = 0: nullpen else: pencircle scaled $ fi; $ := $-eps; $.nib := savepen; breadth_[$.nib] := $; endfor $ := 0; forever: exitif unknown rth[$].#; rth[$] := ceiling(rth[$].#*hppp); pickup pencircle scaled rth[$]; rule.nib[$] := savepen; $ := $+1; endfor % % spreads % for $ = 0 upto 10: if known spread[$].#: spread[$] := 2ceiling(0.5spread[$].#*hppp); fi endfor % % current transform (slant is not taken into account) % currenttransform = identity yscaled aspect_ratio scaled granularity; % % proofing % standard_proofing; use_rule1; enddef; % The following environment enables people to draw a picture % almost like drawing a character. The resulting picture is % stored in $_picture and then it can be used in at any % place later. def beginpicture(suffix $)(expr w_sharp, h_sharp, d_sharp) = begingroup save picturename; w := hround(w_sharp*hppp); h := vround(h_sharp*hppp); d := vround(d_sharp*hppp); clearxy; clearit; clearpen; string picturename; picturename = str $ &"_picture"; enddef; def endpicture = expandafter picture scantokens picturename; scantokens picturename = currentpicture; endgroup enddef; vardef use_rule@# = rth := rth@#; rth# := rth@#.#; rule.nib := rule.nib@#; math_axis := vround(math_axis#*hppp-0.5rth)+0.5rth; enddef; def numeric_pickup_ primary q = currentpen := pen_[q]; pen_lft := pen_lft_[q]; pen_rt := pen_rt_[q]; pen_top := pen_top_[q]; pen_bot := pen_bot_[q]; currentpen_path := pen_path_[q]; if known breadth_[q]: currentbreadth := breadth_[q]; fi enddef; %def compute_spread(expr normal_spread, big_spread) = % spread# := math_spread[normal_spread, big_spread]; % spread := 2ceiling((spread#)*hppp/2) %enddef; def v_center(expr h_sharp) = .5h_sharp+math_axis#, .5h_sharp-math_axis# enddef; def ensure_centering_of(expr stem) = if hround 0.5(w-hround stem)+0.5hround stem<> 0.5w: change_width; fi enddef; vardef v_adjust(suffix $, $$)(expr middle, height) = top y$-middle = middle-bot y$$ = vround 0.5(height-rth)+0.5rth enddef; def arithmetic_bounds = 12u#+2appr#, math_axis#+6u#, 6u#-math_axis# enddef; def padded expr del_sharp = charht := charht+del_sharp; chardp := chardp+del_sharp enddef; %vardef pos@#(expr b, d) = % if known b: if b <= currentbreadth: errmessage "bad pos"; fi fi % save d_; pair d_; d_ = dir d; % z@#r-z@#l+penoffset d_ of currentpen+penoffset -d_ of currentpen = b*d_; % x@# = .5(x@#l+x@#r); y@# = .5(y@#l+y@#r) enddef; vardef pos@#(expr b, d) = if known b: if b <= currentbreadth: errmessage "bad pos"; fi fi (x@#r-x@#l, y@#r-y@#l) = (b-currentbreadth, 0) rotated d; x@# = .5(x@#l+x@#r); y@# = .5(y@#l+y@#r) enddef; vardef stroke text t = forsuffixes e = l, r: path_.e := t;endfor if cycle path_.l: errmessage "Beware: `stroke' doesn't work with cycles"; fi path_.l -- reverse path_.r -- cycle enddef; % DIAGONALS def diag_width(expr $, $$) = $/abs sind angle $$ enddef; %vardef diag_height(expr $, $$) = % $/abs cosd angle $$ %enddef; % $ <---> $$$; $$ <---> $$$$. sign = +1 for \, -1 for /. vardef adjust_slanted_bar(suffix $, $$, $$$, $$$$)(expr thickness, sign) = save a, b; if abs(y$$-y$) = thickness: (a1, a2) = (z$$-z$); if a1 = 0: b = 0;% b should then be infinite. else: b = if sign<0: - fi (a1++a2)*((a1++a2)/2a1); fi else: a = angle(z$$-z$); b = (cosd(a)/sind(a) if sign<0: - else: + fi (((y$$-y$)/(thickness)/sind(a))+-+1)) /(((y$$-y$)/(thickness))**2-1)*(y$$-y$); fi z$$$ = (x$-b, y$); z$$$$ = (x$$+b, y$$) enddef; % supplementary points for diagonal strokes % as in cm's \#. (see MetaFontbook, p. 200--201) % Well, ... vardef diag_stroke.@#(suffix $, $$, s)(text y_list) = z$.@#--for y_ = y_list: (good.x(((x$.s-x$$.s)/(y$.s-y$$.s))*(y_-y$$r)+x$$.s), y_) +z$.@#-z$.s --endfor z$$.@# enddef; % CIRCLES, ELLIPSES AND RELATED THINGS primarydef w up_to_right z = w{0, ypart(z-w)} ...(superness[xpart z, xpart w], superness[ypart w, ypart z]){z-w} ...{xpart(z-w), 0}z enddef; let up_to_left = up_to_right; let down_to_right = up_to_right; let down_to_left = up_to_right; primarydef w right_to_up z = w{xpart(z-w), 0} ...(superness[xpart w, xpart z], superness[ypart z, ypart w]){z-w} ...{0, ypart(z-w)}z enddef; let right_to_down = right_to_up; let left_to_up = right_to_up; let left_to_down = right_to_up; def ellipse_set(suffix $, @, @@, $$) = alpha_ := slope*(x@-x$); beta_ := y$$-y$-slope*(x$$-x$); gamma_ := alpha_/beta_; y@-y$ = .5(beta_-alpha_*gamma_); x@@-x$ = -2gamma_*(x@-x$)/(1+gamma_*gamma_); y@@-y$$ = slope*(x@@-x$$) enddef; def hellipse_set(suffix $, @, @@, $$) = alpha_ := (y@-y$)/slope; beta_ := x$$-x$-(y$$-y$)/slope; gamma_ := alpha_/beta_; x@-x$ = .5(beta_-alpha_*gamma_); y@@-y$ = -2gamma_*(y@-y$)/(1+gamma_*gamma_); x@@-x$$ = (y@@-y$$)/slope enddef; vardef adjust_elliptic_arc(suffix $, $$, $$$) = save a, b; if known (y$$$-y$): a = (1+-+((y$$$-y$)/(y$$-y$))); x$$-x$ = (x$$$-x$)/(1+a); b = (1+-+((x$$$-x$$)/(x$$-x$))); else: b = (1+-+((x$$$-x$$)/(x$$-x$))); y$$$-y$ = (y$$-y$)*b; a = (1+-+((y$$$-y$)/(y$$-y$))); fi y$$$' = y$$; x$$$' = (((1-b)/a)*(b/a))[x$$$, x$$]; enddef; def flatcup(expr zi, zii, ziii) = zi..controls (xpart zi, flatness[ypart zi, ypart zii]) and (xpart zi, ypart zii) ..zii..controls (xpart ziii, ypart zii) and (xpart ziii, flatness[ypart ziii, ypart zii])..ziii enddef; % DOTS boolean full_dot; full_dot := true; def dot(suffix $, $$) = autorounded; if full_dot: filldraw else: draw fi dot_path($, $$); full_dot := true; enddef; def dot_path(suffix $, $$) = (x$, 0.5[y$, y$$]) down_to_right (0.5[x$, x$$], y$) right_to_up (x$$, 0.5[y$, y$$]) up_to_left (0.5[x$, x$$], y$$) left_to_down (x$, 0.5[y$, y$$])...cycle enddef; vardef adjust_dot@#(expr center, diameter, h_fit, v_fit) = if v_fit: save y_min, y_max; bot y_min = vround(ypart center-0.5diameter)-eps; top y_max = vround(ypart center+0.5diameter)+eps; y@#'-ypart center = ypart center-y@# = max(y_max-ypart center, ypart center-y_min); else: bot y@# = vround(ypart center-0.5diameter)-eps; top y@#'-bot y@# = vround diameter+2eps; fi if h_fit: save x_min, x_max; lft x_min = hround(xpart center-0.5diameter)-eps; rt x_max = hround(xpart center+0.5diameter)+eps; x@#'-xpart center = xpart center-x@# = max(x_max-xpart center, xpart center-x_min); else: lft x@# = vround(xpart center-0.5diameter)-eps; rt x@#'-lft x@# = hround(diameter)+2eps; fi labels(@#, @#'); enddef; % VERY DESIGN DEPENDENT MACROS % DAGGERS AND ASTERISKS vardef dagger_stroke@#(expr height, curve, stem, u_) = save alpha, a, b, c, R; alpha = angle u_-90; R = 0.5(curve-currentbreadth); a = stress*(height-curve+0.5currentbreadth)+R; b = 0.5(stem-currentbreadth); c = (a*R-b*sqrt(a**2+b**2-R**2))/(a**2+b**2); z@#c-z@# = (height-0.5currentbreadth)*u_; z@#c-z@#b = R*u_; z@#d-z@#b = -a*u_; z@#a = (c*(R/a))[z@#b, z@#d]; penpos@#(2b, alpha); penpos@#d(2b, alpha); penpos@#a(2R*(1+-+c), alpha); penpos@#b(2R, alpha); penlabels(@#a, @#b, @#c, @#d, @#); z@#r{u_}...z@#a.r{z@#a.r-z@#d.r}...z@#b.r{u_}... (superness[z@#b, z@#b.r]+superness[z@#b, z@#c]-z@#b){z@#c-z@#b.r} ...z@#c{z@#b.l-z@#b.r}... (superness[z@#b, z@#b.l]+superness[z@#b, z@#c]-z@#b){z@#b.l-z@#c} ...z@#b.l{-u_}...z@#a.l{z@#d.l-z@#a.l}...{-u_}z@#l enddef; % ARROWS numeric arrow_height, arrow_width, arrow_breadth, arrow_stress, arrow_tense[], arrow_time, double_arrow_height, double_arrow_width, double_arrow_tense, double_arrow_flatness; boolean arrow_head_fitting; arrow_head_fitting := false; vardef arrow_head@#(expr p, side) = save a, t; numeric a[]; a1 = angle direction infinity of p; pos@#a(rth, a1-90); z@#a = point infinity of p if arrow_head_fitting: -0.5currentbreadth*dir a1 fi; t := xpart(p intersectiontimes (halfcircle rotated(a1+90) scaled (2arrow_stress*arrow_height-currentbreadth) shifted z@#a)); a2 := angle direction t of p; arrow_time := t; z@# = point t of p; pos@#(rth, a2-90); z@#-z@#c = (1-arrow_stress)*arrow_height*dir a2; z@#c.r-z@#c = z@#c-z@#c.l = 0.5(arrow_width-currentbreadth)*dir(a2-90); z@#b.r-z@#c.r = z@#b.l-z@#c.l = max(arrow_breadth-currentbreadth, 0)*dir a2; z@#b = p intersectionpoint (z@#b.r..z@#b.l); t := xpart(p intersectiontimes (halfcircle rotated(a1+90) scaled (2arrow_tense2[1, arrow_stress]*arrow_height-currentbreadth) shifted z@#a)); a3 = angle direction t of p; z@#' = point t of p; pos@#'(rth, a3-90); z@#a' = if arrow_tense1<1: p intersectionpoint (halfcircle rotated(a1+90) scaled(arrow_tense1[length(z@#b-z@#a), 0]*2) shifted z@#a); else: z@#a; fi filldraw if side = right: z@#a.l{-dir a1}...{-dir a2}z@#l else: z@#a...{z@#b.l-z@#a'}z@#b.l--z@#c.l{z@#'l-z@#c.l}...z@#l fi -- if side = left: z@#r{dir a2}...z@#a.r{dir a1} else: z@#r...{z@#c.r-z@#'r}z@#c.r--z@#b.r{z@#a'-z@#b.r}...z@#a fi -- cycle; labels(@#a'); penlabels(@#', @#a, @#b, @#c); arrow_head_fitting := false; enddef; vardef double_arrow_head@#(expr head, vect) = save a, b, u_, v_; pair u_, v_; u_ = unitvector vect; v_ = u_ rotated 90; z@# = z@#' = head; z@#-z@#m = double_arrow_height*u_; pos@#'(rth, angle u_-90); pos@#m(rth, angle u_-90); z@#-z@#b.r = z@#m-z@#m.b = 0.5rth*double_arrow_flatness*v_; a = angle(-double_arrow_height, 0.5double_arrow_width); b = (cosd(a)/sind(a)+ ((0.5double_arrow_width/rth/sind(a))+-+1)) /((0.5double_arrow_width/rth)**2-1) *0.5double_arrow_width; z@#c.l = double_arrow_tense[z@#m.b, z@#b.r-b*u_]; z@#m-z@#a.l = 0.5double_arrow_width*v_; b := rth/abs sind(angle(z@#a.l-z@#c.l)-angle(-u_)); z@#a.r-z@#a.l = z@#c.r-z@#c.l = b*u_; z@#ab = 0.5[z@#a.r, z@#c.r]; penpos@#b(rth, angle(z@#b.r-z@#ab)-90); % save p, t; path p[]; numeric t[]; z@#a = 0.5[z@#a.r, z@#a.l]; p1 = z@#a{z@#ab-z@#a.r}...{z@#b.r-z@#ab}z@#b; p3 = z@#a.r{z@#ab-z@#a.r}...{z@#b.r-z@#ab}z@#b.r; p5 = if (z@#b.l-z@#) dotprod v_<0: z@#'l+(u_ dotprod (z@#b.l-z@#))*u_-- fi z@#b.l{z@#ab-z@#b.r}...{z@#a.r-z@#ab}z@#a.l; p2 = reverse p1 reflectedabout (z@#, z@#m); p4 = reverse p3 reflectedabout (z@#, z@#m); p6 = reverse p5 reflectedabout (z@#, z@#m); t5 = xpart(p5 intersectiontimes (z@#+eps*v_ .. z@#m+eps*v_)); t6 = xpart(p6 intersectiontimes (z@#-eps*v_ .. z@#m-eps*v_)); fill p3--z@#+eps*v_--subpath (t5, length p5) of p5--cycle; fill z@#-eps*v_--p4--subpath (0, t6) of p6--cycle; forsuffixes $ = l, , r: z@#r$ = p1 intersectionpoint ((z@#'$..z@#m$) shifted (-0.5spread1*v_)); z@#l$ = p2 intersectionpoint ((z@#'$..z@#m$) shifted (0.5spread1*v_)); endfor penlabels(@#, @#', @#a, @#b, @#c, @#r, @#l, @#m); labels(@#ab, @#m.b); enddef; % ARM, BEAK and SERIFS (personal taste) % vardef arm@#(expr beak, beak_jut, breadth, darkness, orientation, x_limit) = % save a; a = 90; % if orientation = up: y@#a = min(y@#l, y@#r); y@#d = max(y@#l, y@#r); % y@#b-y@#d = vround beak; a := -a; % else: y@#a = max(y@#l, y@#r); y@#d = min(y@#l, y@#r); % y@#b-y@#d = -vround beak; fi % if x_limit>x@#: rt x@#b = hround x_limit; x@#b-x@#a = hround beak_jut; % else: lft x@#b = hround x_limit; x@#b-x@#a = -hround beak_jut; a := -a; fi % z@#c-z@#b = max(0, breadth-currentbreadth) % *unitvector(z@#a-z@#b)rotated a; % z@#d-z@#c = whatever*(z@#a-z@#b); % filldraw z@#c{z@#d-z@#c}... % if y@#l = y@#.d: darkness[z@#d, 0.5[z@#c, z@#l]]{z@#l-z@#c} % ...z@#l{z@#l-z@#d}--z@#r % else: darkness[z@#d, 0.5[z@#c, z@#r]]{z@#r-z@#c} % ...z@#r{z@#r-z@#d}--z@#l fi % --z@#a--z@#b--cycle; % labels(@#a, @#b, @#c, @#d); % enddef; vardef arm@#(expr beak, beak_jut, hair, darkness, direction, limit) = y@#d = y@#r; y@#a = y@#b = y@#r if ypart direction > 0: + else: - fi vround beak; y@#c = y@#l; rt x@#b = hround limit; lft x@#a = hround(limit-hair); x@#b-x@#c = hround beak_jut; z@#d-z@#a = whatever*(z@#c-z@#b); filldraw z@#r{z@#d-z@#r}...darkness[z@#d, 0.5[z@#r, z@#a]]... z@#a{z@#a-z@#d}--z@#b--z@#c--z@#l--cycle; labels(@#a, @#b, @#c, @#d); enddef; vardef serif(suffix $, $$) (expr bracket, left_jut, left_slab, dished_left, left_dish, right_jut, right_slab, dished_right, right_dish) = save a, b; b = cosd angle(z$$-z$); a = max(0.5left_jut, 0.5right_jut, bracket); if y$0: rule((w-xoffset+charic*hppp, h.o_), (w-xoffset+charic*hppp, .5[h, -d].o_)); fi enddef; def accents_proofing = for $ = 0 upto 19: makelabel("", (0.5w-xoffset, 0.5x_height) +(4u*cosd($*360/20), 0.5x_height*sind($*360/20))); endfor enddef; def diacritics_proofing = if proofing>0: extra_endchar := extra_endchar&"accents_proofing;"; fi enddef; def standard_proofing = if proofing>0: extra_endchar := "additions_to_proof;"; fi enddef; def additions_to_proof = makelabel.lft("baseline", (-xoffset, 0)); if h>math_axis: makelabel.lft("math axis", (-xoffset, math_axis)); fi enddef; % `iff' CONSTRUCTION let semi_ = ;; let colon_ = :; let endchar_ = endchar; def iff expr b = if b:let next_ = use_it else:let next_ = lose_it fi; next_ enddef; def use_it = let : = restore_colon; enddef; def restore_colon = let : = colon_; enddef; def lose_it = let endchar = fi; let ; = fix_ semi_ if false enddef; def fix_ = let ; = semi_; let endchar = endchar_; enddef; def always_iff = let : = endgroup; killboolean enddef; def killboolean text t = use_it enddef; % Not the fastest solution def beginchar(expr c, w_sharp, h_sharp, d_sharp) = iff known c: begingroup charcode := byte c; charwd := w_sharp; charht := h_sharp; chardp := d_sharp; w := hround(charwd*hppp); h := vround(charht*hppp); d := vround(chardp*hppp); charic := 0; clearxy; clearit; clearpen; scantokens extra_beginchar; enddef; endinput;