(* 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 *) (* 16/62003 *) (* *) (**************************************************************************) type 'a mpres = 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 | Mrow of attr * 'a mpres list | Mfrac of attr * 'a mpres * 'a mpres | Msqrt of attr * 'a mpres | Mroot of attr * 'a mpres * 'a mpres | Mstyle of attr * 'a mpres | Merror of attr * 'a mpres | Mpadded of attr * 'a mpres | Mphantom of attr * 'a mpres | Mfenced of attr * 'a mpres list | Menclose of attr * 'a mpres | Msub of attr * 'a mpres * 'a mpres | Msup of attr * 'a mpres * 'a mpres | Msubsup of attr * 'a mpres * 'a mpres *'a mpres | Munder of attr * 'a mpres * 'a mpres | Mover of attr * 'a mpres * 'a mpres | Munderover of attr * 'a mpres * 'a mpres *'a mpres (* | Multiscripts of ??? NOT IMPLEMEMENTED *) | Mtable of attr * 'a row list | Maction of attr * 'a mpres list | Mobject of attr * 'a and 'a row = Mtr of attr * 'a mtd list and 'a mtd = Mtd of attr * 'a mpres and attr = (string option * string * string) list ;; let smallskip = Mspace([None,"width","0.5em"]);; let indentation = Mspace([None,"width","1em"]);; 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;Mtext([],")")]) let row_without_brackets attr a b op = Mrow(attr,[a;op;b]) (* MathML prefix *) let prefix = "m";; let print_mpres obj_printer mpres = let module X = Xml in let rec aux = 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 -> [< (aux x) ; i >]) l [<>]) >] | Mfrac (attr,m1,m2) -> X.xml_nempty ~prefix "mfrac" attr [< aux m1; aux m2 >] | Msqrt (attr,m) -> X.xml_nempty ~prefix "msqrt" attr [< aux m >] | Mroot (attr,m1,m2) -> X.xml_nempty ~prefix "mroot" attr [< aux m1; aux m2 >] | Mstyle (attr,m) -> X.xml_nempty ~prefix "mstyle" attr [< aux m >] | Merror (attr,m) -> X.xml_nempty ~prefix "merror" attr [< aux m >] | Mpadded (attr,m) -> X.xml_nempty ~prefix "mpadded" attr [< aux m >] | Mphantom (attr,m) -> X.xml_nempty ~prefix "mphantom" attr [< aux m >] | Mfenced (attr,l) -> X.xml_nempty ~prefix "mfenced" attr [< (List.fold_right (fun x i -> [< (aux x) ; i >]) l [<>]) >] | Menclose (attr,m) -> X.xml_nempty ~prefix "menclose" attr [< aux m >] (* Script and Limit Schemata *) | Msub (attr,m1,m2) -> X.xml_nempty ~prefix "msub" attr [< aux m1; aux m2 >] | Msup (attr,m1,m2) -> X.xml_nempty ~prefix "msup" attr [< aux m1; aux m2 >] | Msubsup (attr,m1,m2,m3) -> X.xml_nempty ~prefix "msubsup" attr [< aux m1; aux m2; aux m3 >] | Munder (attr,m1,m2) -> X.xml_nempty ~prefix "munder" attr [< aux m1; aux m2 >] | Mover (attr,m1,m2) -> X.xml_nempty ~prefix "mover" attr [< aux m1; aux m2 >] | Munderover (attr,m1,m2,m3) -> X.xml_nempty ~prefix "munderover" attr [< aux m1; aux m2; aux m3 >] (* | Multiscripts of ??? NOT IMPLEMEMENTED *) (* Tables and Matrices *) | Mtable (attr, rl) -> X.xml_nempty ~prefix "mtable" attr [< (List.fold_right (fun x i -> [< (aux_mrow x) ; i >]) rl [<>]) >] (* Enlivening Expressions *) | Maction (attr, l) -> X.xml_nempty ~prefix "maction" attr [< (List.fold_right (fun x i -> [< (aux x) ; i >]) l [<>]) >] | Mobject (attr, obj) -> let box_stream = obj_printer obj in X.xml_nempty ~prefix "semantics" attr [< X.xml_nempty ~prefix "annotation-xml" [None, "encoding", "BoxML"] box_stream >] and aux_mrow = let module X = Xml in function Mtr (attr, l) -> X.xml_nempty ~prefix "mtr" attr [< (List.fold_right (fun x i -> [< (aux_mtd x) ; i >]) l [<>]) >] and aux_mtd = let module X = Xml in function Mtd (attr,m) -> X.xml_nempty ~prefix "mtd" attr [< (aux m) ; X.xml_nempty ~prefix "mphantom" [] (X.xml_nempty ~prefix "mtext" [] (X.xml_cdata "(")) >] in aux mpres ;; let document_of_mpres pres = [< Xml.xml_cdata "\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 (fun _ -> assert false) pres)) >]