+++ /dev/null
-(* Copyright (C) 2000, HELM Team.
- *
- * This file is part of HELM, an Hypertextual, Electronic
- * Library of Mathematics, developed at the Computer Science
- * Department, University of Bologna, Italy.
- *
- * HELM is free software; you can redistribute it and/or
- * modify it under the terms of the GNU General Public License
- * as published by the Free Software Foundation; either version 2
- * of the License, or (at your option) any later version.
- *
- * HELM is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- * GNU General Public License for more details.
- *
- * You should have received a copy of the GNU General Public License
- * along with HELM; if not, write to the Free Software
- * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
- * MA 02111-1307, USA.
- *
- * For details, see the HELM World-Wide-Web page,
- * http://cs.unibo.it/helm/.
- *)
-
-(**************************************************************************)
-(* *)
-(* PROJECT HELM *)
-(* *)
-(* Andrea Asperti <asperti@cs.unibo.it> *)
-(* 16/62003 *)
-(* *)
-(**************************************************************************)
-
-type
- mpres =
- (* token elements *)
- Mi of attr * string
- | Mn of attr * string
- | Mo of attr * string
- | Mtext of attr * string
- | Mspace of attr
- | Ms of attr * string
- | Mgliph of attr * string
- (* General Layout Schemata *)
- | Mrow of attr * mpres list
- | Mfrac of attr * mpres * mpres
- | Msqrt of attr * mpres
- | Mroot of attr * mpres * mpres
- | Mstyle of attr * mpres
- | Merror of attr * mpres
- | Mpadded of attr * mpres
- | Mphantom of attr * mpres
- | Mfenced of attr * mpres list
- | Menclose of attr * mpres
- (* Script and Limit Schemata *)
- | Msub of attr * mpres * mpres
- | Msup of attr * mpres * mpres
- | Msubsup of attr * mpres * mpres *mpres
- | Munder of attr * mpres * mpres
- | Mover of attr * mpres * mpres
- | Munderover of attr * mpres * mpres *mpres
-(* | Multiscripts of ??? NOT IMPLEMEMENTED *)
- (* Tables and Matrices *)
- | Mtable of attr * row list
- (* Enlivening Expressions *)
- | Maction of attr * mpres list
-
-and row = Mtr of attr * mtd list
-
-and mtd = Mtd of attr * mpres
-
-and attr = (string option * string * string) list
-;;
-
-let smallskip = Mspace([None,"width","0.1cm"]);;
-let indentation = Mspace([None,"width","0.3cm"]);;
-
-let indented elem =
- Mrow([],[indentation;elem]);;
-
-let standard_tbl_attr =
- [None,"align","baseline 1";None,"equalrows","false";None,"columnalign","left"]
-;;
-
-let two_rows_table attr a b =
- Mtable(attr@standard_tbl_attr,
- [Mtr([],[Mtd([],a)]);
- Mtr([],[Mtd([],b)])]);;
-
-let two_rows_table_with_brackets attr a b op =
- (* only the open bracket is added; the closed bracket must be in b *)
- Mtable(attr@standard_tbl_attr,
- [Mtr([],[Mtd([],Mrow([],[Mtext([],"(");a]))]);
- Mtr([],[Mtd([],Mrow([],[indentation;op;b]))])]);;
-
-let two_rows_table_without_brackets attr a b op =
- Mtable(attr@standard_tbl_attr,
- [Mtr([],[Mtd([],a)]);
- Mtr([],[Mtd([],Mrow([],[indentation;op;b]))])]);;
-
-let row_with_brackets attr a b op =
- (* by analogy with two_rows_table_with_brackets we only add the
- open brackets *)
- Mrow(attr,[Mtext([],"(");a;op;b])
-
-let row_without_brackets attr a b op =
- Mrow(attr,[a;op;b])
-
-(* MathML prefix *)
-let prefix = "m";;
-
-let rec print_mpres =
- let module X = Xml in
- function
- Mi (attr,s) -> X.xml_nempty ~prefix "mi" attr (X.xml_cdata s)
- | Mn (attr,s) -> X.xml_nempty ~prefix "mn" attr (X.xml_cdata s)
- | Mo (attr,s) -> X.xml_nempty ~prefix "mo" attr (X.xml_cdata s)
- | Mtext (attr,s) -> X.xml_nempty ~prefix "mtext" attr (X.xml_cdata s)
- | Mspace attr -> X.xml_empty ~prefix "mspace" attr
- | Ms (attr,s) -> X.xml_nempty ~prefix "ms" attr (X.xml_cdata s)
- | Mgliph (attr,s) -> X.xml_nempty ~prefix "mgliph" attr (X.xml_cdata s)
- (* General Layout Schemata *)
- | Mrow (attr,l) ->
- X.xml_nempty ~prefix "mrow" attr
- [< (List.fold_right (fun x i -> [< (print_mpres x) ; i >]) l [<>])
- >]
- | Mfrac (attr,m1,m2) ->
- X.xml_nempty ~prefix "mfrac" attr
- [< print_mpres m1;
- print_mpres m2
- >]
- | Msqrt (attr,m) ->
- X.xml_nempty ~prefix "msqrt" attr [< print_mpres m >]
- | Mroot (attr,m1,m2) ->
- X.xml_nempty ~prefix "mroot" attr
- [< print_mpres m1;
- print_mpres m2
- >]
- | Mstyle (attr,m) ->
- X.xml_nempty ~prefix "mstyle" attr [< print_mpres m >]
- | Merror (attr,m) ->
- X.xml_nempty ~prefix "merror" attr [< print_mpres m >]
- | Mpadded (attr,m) ->
- X.xml_nempty ~prefix "mpadded" attr [< print_mpres m >]
- | Mphantom (attr,m) ->
- X.xml_nempty ~prefix "mphantom" attr [< print_mpres m >]
- | Mfenced (attr,l) ->
- X.xml_nempty ~prefix "mfenced" attr
- [< (List.fold_right (fun x i -> [< (print_mpres x) ; i >]) l [<>])
- >]
- | Menclose (attr,m) ->
- X.xml_nempty ~prefix "menclose" attr [< print_mpres m >]
- (* Script and Limit Schemata *)
- | Msub (attr,m1,m2) ->
- X.xml_nempty ~prefix "msub" attr
- [< print_mpres m1;
- print_mpres m2
- >]
- | Msup (attr,m1,m2) ->
- X.xml_nempty ~prefix "msup" attr
- [< print_mpres m1;
- print_mpres m2
- >]
- | Msubsup (attr,m1,m2,m3) ->
- X.xml_nempty ~prefix "msubsup" attr
- [< print_mpres m1;
- print_mpres m2;
- print_mpres m3
- >]
- | Munder (attr,m1,m2) ->
- X.xml_nempty ~prefix "munder" attr
- [< print_mpres m1;
- print_mpres m2
- >]
- | Mover (attr,m1,m2) ->
- X.xml_nempty ~prefix "mover" attr
- [< print_mpres m1;
- print_mpres m2
- >]
- | Munderover (attr,m1,m2,m3) ->
- X.xml_nempty ~prefix "munderover" attr
- [< print_mpres m1;
- print_mpres m2;
- print_mpres m3
- >]
-(* | Multiscripts of ??? NOT IMPLEMEMENTED *)
- (* Tables and Matrices *)
- | Mtable (attr, rl) ->
- X.xml_nempty ~prefix "mtable" attr
- [< (List.fold_right (fun x i -> [< (print_mrow x) ; i >]) rl [<>])
- >]
- (* Enlivening Expressions *)
- | Maction (attr, l) ->
- X.xml_nempty ~prefix "maction" attr
- [< (List.fold_right (fun x i -> [< (print_mpres x) ; i >]) l [<>])
- >]
-
-and print_mrow =
- let module X = Xml in
- function
- Mtr (attr, l) ->
- X.xml_nempty ~prefix "mtr" attr
- [< (List.fold_right (fun x i -> [< (print_mtd x) ; i >]) l [<>])
- >]
-
-and print_mtd =
- let module X = Xml in
- function
- Mtd (attr,m) -> X.xml_nempty ~prefix "mtd" attr [< (print_mpres m) ; X.xml_nempty ~prefix "mphantom" [] (X.xml_nempty ~prefix "mtext" [] (X.xml_cdata "(")) >]
-;;
-
-let print_mpres pres =
- [< Xml.xml_cdata "<?xml version=\"1.0\" encoding=\"ISO-8859-1\"?>\n" ;
- Xml.xml_cdata "\n";
- Xml.xml_nempty ~prefix "math"
- [Some "xmlns","m","http://www.w3.org/1998/Math/MathML" ;
- Some "xmlns","helm","http://www.cs.unibo.it/helm" ;
- Some "xmlns","xlink","http://www.w3.org/1999/xlink"
- ] (Xml.xml_nempty ~prefix "mstyle" [None, "mathvariant", "normal"; None, "rowspacing", "0.6ex"] (print_mpres pres))
- >]
-
-
projects / helm.git / blobdiff