summaryrefslogtreecommitdiff
path: root/Master/texmf-dist/metapost/context/base/mpii/mp-form.mpii
diff options
context:
space:
mode:
Diffstat (limited to 'Master/texmf-dist/metapost/context/base/mpii/mp-form.mpii')
-rw-r--r--Master/texmf-dist/metapost/context/base/mpii/mp-form.mpii392
1 files changed, 392 insertions, 0 deletions
diff --git a/Master/texmf-dist/metapost/context/base/mpii/mp-form.mpii b/Master/texmf-dist/metapost/context/base/mpii/mp-form.mpii
new file mode 100644
index 00000000000..d1dac32db23
--- /dev/null
+++ b/Master/texmf-dist/metapost/context/base/mpii/mp-form.mpii
@@ -0,0 +1,392 @@
+% Hans Hagen / October 2000
+%
+% This file is mostly a copy from the file format.mp, that
+% comes with MetaPost and is written by John Hobby. This file
+% is meant to be compatible, but has a few more features,
+% controlled by the variables:
+%
+% fmt_initialize when false, initialization is skipped
+% fmt_precision the default accuracy (default=3)
+% fmt_separator the pattern separator (default=%)
+% fmt_zerocheck activate extra sci notation zero check
+%
+% instead of a picture, one can format a number in a for TeX
+% acceptable input string
+
+boolean mant_font ; mant_font := true ; % signals graph not to load form
+
+if known context_form : endinput ; fi ;
+
+boolean context_form ; context_form := true ;
+
+if unknown fmt_metapost : boolean fmt_metapost ; fmt_metapost := true ; fi ; % == use old method
+if unknown fmt_precision : numeric fmt_precision ; fmt_precision := 3 ; fi ;
+if unknown fmt_initialize : boolean fmt_initialize ; fmt_initialize := true ; fi ;
+if unknown fmt_separator : string fmt_separator ; fmt_separator := "%" ; fi ;
+if unknown fmt_zerocheck : boolean fmt_zerocheck ; fmt_zerocheck := false ; fi ;
+
+% As said, all clever code is from John, the more stupid
+% extensions are mine. The following string variables are
+% responsible for the TeX formatting.
+
+% TeX specs when using TeX instead of pseudo TeX.
+
+string sFebraise_ ; sFebraise_ := "{" ;
+string sFeeraise_ ; sFeeraise_ := "}" ;
+string sFebmath_ ; sFebmath_ := "$" ;
+string sFeemath_ ; sFeemath_ := "$" ;
+
+string sFmneg_ ; sFmneg_ := "-" ;
+string sFemarker_ ; sFemarker_ := "{\times}10^" ;
+string sFeneg_ ; sFeneg_ := "-" ;
+string sFe_plus ; sFe_plus := "" ; % "+"
+
+def sFe_base = Fline_up_("1", sFemarker_) enddef ;
+
+% Macros for generating typeset pictures of computed numbers
+%
+% format(f,x) typeset generalized number x using format string f
+% Mformat(f,x) like format, but x is in Mlog form (see marith.mp)
+% init_numbers(s,m,x,sn,e) choose typeset style given sample sign, mantissa,...
+% roundd(x,d) round numeric x to d places right of decimal point
+% Fe_base what precedes the exponent for typeset powers of 10
+% Fe_plus plus sign if any for typesetting positive exponents
+% Ten_to[] powers of ten for indices 0,1,2,3,4
+%
+% New are:
+%
+% formatstr(f,x) TeX string representing x using format f
+% Mformatstr(f,x) like Mformatstr, but x is in Mlog form
+
+% Other than the above-documented user interface, all
+% externally visible names start with F and end with _.
+
+% Allow big numbers in token lists
+
+begingroup interim warningcheck := 0 ;
+
+%%% Load auxiliary macros.
+
+input string ;
+input marith ;
+
+%%% Choosing the Layout %%%
+
+picture Fmneg_, Femarker_, Feneg_, Fe_base, Fe_plus ;
+string Fmfont_, Fefont_ ;
+numeric Fmscale_, Fescale_, Feraise_ ;
+
+% Argument
+%
+% s is a leading minus sign
+% m is a 1-digit mantissa
+% x is whatever follows the mantissa
+% sn is a leading minus for the exponent, and
+% e is a 1-digit exponent.
+%
+% Numbers in scientific notation are constructed by placing
+% these pieces side-by-side; decimal numbers use only m
+% and/or s. To get exponents with leading plus signs, assign
+% to Fe_plus after calling init_numbers. To do something
+% special with a unit mantissa followed by x, assign to
+% Fe_base after calling init_numbers.
+
+vardef init_numbers(expr s, m, x, sn, e) =
+ Fmneg_ := s ;
+ for p within m :
+ Fmfont_ := fontpart p ;
+ Fmscale_ := xxpart p ;
+ exitif true ;
+ endfor
+ Femarker_ := x ;
+ Feneg_ := sn ;
+ for p within e :
+ Fefont_ := fontpart p ;
+ Fescale_ := xxpart p ;
+ Feraise_ := ypart llcorner p ;
+ exitif true ;
+ endfor
+ if fmt_metapost :
+ Fe_base := Fline_up_("1" infont Fmfont_ scaled Fmscale_, Femarker_) ;
+ % else :
+ % sFe_base := Fline_up_("1", sFemarker_) ;
+ fi ;
+ Fe_plus := nullpicture ;
+enddef ;
+
+%%% Low-Level Typesetting %%%
+
+vardef Fmant_(expr x) = %%% adapted by HH %%%
+ if fmt_metapost :
+ (decimal abs x infont Fmfont_ scaled Fmscale_)
+ else :
+ (decimal abs x)
+ fi
+enddef ;
+
+vardef Fexp_(expr x) = %%% adapted by HH %%%
+ if fmt_metapost :
+ (decimal x infont Fefont_ scaled Fescale_ shifted (0,Feraise_))
+ else :
+ (decimal x)
+ fi
+enddef ;
+
+vardef Fline_up_(text t_) = %%% adapted by HH %%%
+ if fmt_metapost :
+ save p_, c_ ;
+ picture p_ ; p_ = nullpicture ;
+ pair c_ ; c_ = (0,0) ;
+ for q_ = t_ :
+ addto p_ also q_ if string q_ : infont defaultfont scaled defaultscale fi
+ shifted c_ ;
+ c_ := (xpart lrcorner p_, 0) ;
+ endfor
+ p_
+ else :
+ "" for q_ = t_ : & q_ endfor
+ fi
+enddef ;
+
+vardef Fdec_o_(expr x) = %%% adapted by HH %%%
+ if x<0 :
+ Fline_up_(if fmt_metapost : Fmneg_ else : sFmneg_ fi, Fmant_(x))
+ else :
+ Fmant_(x)
+ fi
+enddef ;
+
+vardef Fsci_o_(expr x, e) = %%% adapted by HH %%%
+ if fmt_metapost :
+ Fline_up_
+ (if x < 0 : Fmneg_,fi
+ if abs x = 1 : Fe_base else : Fmant_(x), Femarker_ fi,
+ if e < 0 : Feneg_ else : Fe_plus fi,
+ Fexp_(abs e))
+ else :
+ Fline_up_
+ (if x < 0 : sFmneg_, fi
+ if abs x = 1 : sFe_base else : Fmant_(x), sFemarker_ fi,
+ sFebraise_,
+ if e < 0 : sFeneg_ else : sFe_plus fi,
+ Fexp_(abs e),
+ sFeeraise_)
+ fi
+enddef ;
+
+% Assume prologues=1 implies troff mode. TeX users who want
+% prologues on should use some other positive value. The mpx
+% file mechanism requires separate input files here.
+%
+% if fmt_initialize : %%% adapted by HH
+% if prologues = 1 : input troffnum else : input texnum fi
+% fi ;
+%
+% wrong assumption, so we need:
+
+if fmt_initialize :
+ input texnum ;
+fi ;
+
+%%% Scaling and Rounding %%%
+
+% Find a pair p where x = xpart p*10**ypart p and either p =
+% (0,0) or xpart p is between 1000 and 9999.99999. This is
+% the `exponent form' of x.
+
+vardef Feform_(expr x) =
+ interim warningcheck := 0 ;
+ if string x :
+ Meform(Mlog_str x)
+ else :
+ save b, e ;
+ b = x ; e = 0 ;
+ if abs b >= 10000 :
+ (b/10, 1)
+ elseif b = 0 :
+ origin
+ else :
+ forever :
+ exitif abs b >= 1000 ;
+ b := b*10 ; e := e-1 ;
+ endfor
+ (b, e)
+ fi
+ fi
+enddef ;
+
+% The marith.mp macros include a similar macro Meform that
+% converts from `Mlog form' to exponent form. In case
+% rounding has made the xpart of an exponent form number too
+% large, fix it.
+
+vardef Feadj_(expr x, y) =
+ if abs x >= 10000 : (x/10, y+1) else : (x,y) fi
+enddef ;
+
+% Round x to d places right of the decimal point. When d<0,
+% round to the nearest multiple of 10 to the -d.
+
+vardef roundd(expr x, d) =
+ if abs d > 4 :
+ if d > 0 : x else : 0 fi
+ elseif d > 0 :
+ save i ; i = floor x ;
+ i + round(Ten_to[d]*(x-i))/Ten_to[d]
+ else :
+ round(x/Ten_to[-d])*Ten_to[-d]
+ fi
+enddef ;
+
+Ten_to0 = 1 ;
+Ten_to1 = 10 ;
+Ten_to2 = 100 ;
+Ten_to3 = 1000 ;
+Ten_to4 = 10000 ;
+
+% Round an exponent form number p to k significant figures.
+
+primarydef p Fprec_ k =
+ Feadj_(roundd(xpart p,k-4), ypart p)
+enddef ;
+
+% Round an exponent form number p to k digits right of the
+% decimal point.
+
+primarydef p Fdigs_ k =
+ Feadj_(roundd(xpart p,k+ypart p), ypart p)
+enddef ;
+
+%%% High-Level Routines %%%
+
+% The following operators convert z from exponent form and
+% produce typeset output: Formsci_ generates scientific
+% notation; Formdec_ generates decimal notation; and
+% Formgen_ generates whatever is likely to be most compact.
+
+vardef Formsci_(expr z) = %%% adapted by HH %%%
+ if fmt_zerocheck and (z = origin) :
+ Fsci_o_(0,0)
+ else :
+ Fsci_o_(xpart z/1000, ypart z + 3)
+ fi
+enddef ;
+
+vardef Formdec_(expr z) =
+ if ypart z > 0 :
+ Formsci_(z)
+ else :
+ Fdec_o_
+ (xpart z if ypart z >= -4 :
+ /Ten_to[-ypart z]
+ else :
+ for i = ypart z upto -5 : /(10) endfor /10000
+ fi)
+ fi
+enddef ;
+
+vardef Formgen_(expr q) =
+ clearxy ; (x,y) = q ;
+ if x = 0 : Formdec_
+ elseif y >= -6 : Formdec_
+ else : Formsci_
+ fi (q)
+enddef ;
+
+def Fset_item_(expr s) = %%% adapted by HH %%%
+ if s <> "" :
+ if fmt_metapost :
+ s infont defaultfont scaled defaultscale,
+ else :
+ s,
+ fi
+ fi
+enddef ;
+
+% For each format letter, the table below tells how to
+% round and typeset a quantity z in exponent form.
+%
+% e scientific, p significant figures
+% f decimal, p digits right of the point
+% g decimal or scientific, p sig. figs.
+% G decimal or scientific, p digits
+
+string fmt_[] ;
+
+fmt_[ASCII "e"] = "Formsci_(z Fprec_ p)" ;
+fmt_[ASCII "f"] = "Formdec_(z Fdigs_ p)" ;
+fmt_[ASCII "g"] = "Formgen_(z Fprec_ p)" ;
+fmt_[ASCII "G"] = "Formgen_(z Fdigs_ p)" ;
+
+% The format and Mformat macros take a format string f and
+% generate typeset output for a numeric quantity x. String f
+% should contain a `%' followed by an optional number and one
+% of the format letters defined above. The number should be
+% an integer giving the precision (default 3).
+
+vardef isfmtseparator primary c = %%% added by HH %%%
+ ((c <> fmt_separator) and (c <> "%"))
+enddef ;
+
+def initialize_form_numbers =
+ initialize_numbers ; % in context: do_initialize_numbers ;
+enddef ;
+
+vardef dofmt_@#(expr f, x) = %%% adapted by HH %%%
+ initialize_form_numbers ;
+ if f = "" :
+ if fmt_metapost : nullpicture else : "" fi
+ else :
+ interim warningcheck := 0 ;
+ save k, l, s, p, z ;
+ pair z ; z = @#(x) ;
+ % the next adaption is okay
+ % k = 1 + cspan(f, fmt_separator <> ) ;
+ % but best is to support both % and fmt_separator
+ k = 1 + cspan(f, isfmtseparator) ;
+ %
+ l-k = cspan(substring(k,infinity) of f, isdigit) ;
+ p = if l > k :
+ scantokens substring(k,l) of f
+ else :
+ fmt_precision
+ fi ;
+ string s ; s = fmt_[ASCII substring (l,l+1) of f] ;
+ if unknown s :
+ if k <= length f :
+ errmessage("No valid format letter found in "&f) ;
+ fi
+ s = if fmt_metapost : "nullpicture" else : "" fi ;
+ fi
+ Fline_up_
+ (Fset_item_(substring (0,k-1) of f)
+ if not fmt_metapost : sFebmath_, fi
+ scantokens s,
+ if not fmt_metapost : sFeemath_, fi
+ Fset_item_(substring (l+1,infinity) of f)
+ if fmt_metapost : nullpicture else : "" fi)
+ fi
+ hide (fmt_metapost := true)
+enddef ;
+
+%%% so far %%%
+
+vardef format (expr f, x) =
+ fmt_metapost := true ; dofmt_.Feform_(f,x)
+enddef ;
+
+vardef Mformat(expr f, x) =
+ fmt_metapost := true ; dofmt_.Meform (f,x)
+enddef ;
+
+vardef formatstr (expr f, x) =
+ fmt_metapost := false ; dofmt_.Feform_(f,x)
+enddef ;
+
+vardef Mformatstr(expr f, x) =
+ fmt_metapost := false ; dofmt_.Meform (f,x)
+enddef ;
+
+% Restore warningcheck to previous value.
+
+endgroup ;