1:- module(mathml, [pl_mathml/2, pl_mathml/3, pl_mathjax/2, pl_mathjax/3]).    2
    3:- discontiguous math/2, math/3, math/4, current/3, paren/3, prec/3.    4:- discontiguous type/3, denoting/3, ml/3, jax/3.    5
    6:- use_module(library(http/html_write)).    7:- use_module(library(rolog)).    8:- consult(['../inst/pl/lib/main.pl', '../inst/pl/lib/op.pl']).    9
   10% Hook to defined own macros
   11%
   12% Example
   13% assert(math_hook(t0, subscript(t, 0))).
   14%
   15% From R, the hook is installed by
   16% mathml:hook(t0, subscript(t, 0))
   17%
   18:- dynamic math_hook/2, math_hook/3, math_hook/4.   19:- multifile math_hook/2, math_hook/3, math_hook/4.   20
   21% Low-level functions (see, e.g. nthroot.pl)
   22%
   23% Example
   24% see nthroot.pl
   25%
   26:- multifile mlx/3.    % translate term to mathml
   27:- multifile jaxx/3.   % translate to LaTeX
   28:- multifile precx/3.  % operator precedence
   29:- multifile parenx/3. % count parentheses
   30:- multifile typex/3.  % some type information
   31
   32% Translate prolog expression to MathML string
   33%
   34% Example
   35% pl_mathml(sin(pi/2), M).
   36%
   37pl_mathml(R, S)
   38=> pl_mathml(R, S, []).
   39
   40% The flags allow for context-dependent translation
   41%
   42% Examples
   43% see vignette of R package mathml
   44%
   45pl_mathml(R, S, Flags0)
   46 => digits_(Flags0, Flags1),
   47    mathml(R, M, Flags1),
   48    html(M, H, []),
   49    maplist(atom_string, H, S).
   50
   51% R interface: Translate R expression to MathJax string
   52pl_mathjax(R, S)
   53 => pl_mathjax(R, S, []).
   54
   55pl_mathjax(R, S, Flags0)
   56 => digits_(Flags0, Flags1),
   57    mathjax(R, S, Flags1).
   58
   59 % Default digits if not defined in flags
   60 digits_(Flags0, Flags1),
   61    option(digits(_), Flags0)
   62 => Flags1 = Flags0.
   63
   64 digits_(Flags0, Flags1)
   65  => Flags1 = [digits(2) | Flags0]