% 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 ;