% 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 fmt_loaded : expandafter endinput fi ; 
   boolean fmt_loaded ; fmt_loaded := true ;

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 ; 

boolean fmt_metapost ; fmt_metapost := true ; % == use old method 

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

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

vardef dofmt_@#(expr f, x) = %%% adapted by HH %%%
  initialize_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 ;