(* 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 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 * string) list ;; let smallskip = Mspace([("width","0.1cm")]);; let indentation = Mspace([("width","0.3cm")]);; let indented elem = Mrow([],[indentation;elem]);; let standard_tbl_attr = [("align","baseline 1");("equalrows","false");("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;smallskip;b]))])]);; let two_rows_table_without_brackets attr a b op = Mtable(attr@standard_tbl_attr, [Mtr([],[Mtd([],a)]); Mtr([],[Mtd([],Mrow([],[indentation;op;smallskip;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;smallskip;op;smallskip;b]) let row_without_brackets attr a b op = Mrow(attr,[a;smallskip;op;smallskip;b]) let rec print_mpres = let module X = Xml in function Mi (attr,s) -> X.xml_nempty "mi" attr (X.xml_cdata s) | Mn (attr,s) -> X.xml_nempty "mn" attr (X.xml_cdata s) | Mo (attr,s) -> X.xml_nempty "mo" attr (X.xml_cdata s) | Mtext (attr,s) -> X.xml_nempty "mtext" attr (X.xml_cdata s) | Mspace attr -> X.xml_empty "mspace" attr | Ms (attr,s) -> X.xml_nempty "ms" attr (X.xml_cdata s) | Mgliph (attr,s) -> X.xml_nempty "mgliph" attr (X.xml_cdata s) (* General Layout Schemata *) | Mrow (attr,l) -> X.xml_nempty "mrow" attr [< (List.fold_right (fun x i -> [< (print_mpres x) ; i >]) l [<>]) >] | Mfrac (attr,m1,m2) -> X.xml_nempty "mfrac" attr [< print_mpres m1; print_mpres m2 >] | Msqrt (attr,m) -> X.xml_nempty "msqrt" attr [< print_mpres m >] | Mroot (attr,m1,m2) -> X.xml_nempty "mroot" attr [< print_mpres m1; print_mpres m2 >] | Mstyle (attr,m) -> X.xml_nempty "mstyle" attr [< print_mpres m >] | Merror (attr,m) -> X.xml_nempty "merror" attr [< print_mpres m >] | Mpadded (attr,m) -> X.xml_nempty "mpadded" attr [< print_mpres m >] | Mphantom (attr,m) -> X.xml_nempty "mphantom" attr [< print_mpres m >] | Mfenced (attr,l) -> X.xml_nempty "mfenced" attr [< (List.fold_right (fun x i -> [< (print_mpres x) ; i >]) l [<>]) >] | Menclose (attr,m) -> X.xml_nempty "menclose" attr [< print_mpres m >] (* Script and Limit Schemata *) | Msub (attr,m1,m2) -> X.xml_nempty "msub" attr [< print_mpres m1; print_mpres m2 >] | Msup (attr,m1,m2) -> X.xml_nempty "msup" attr [< print_mpres m1; print_mpres m2 >] | Msubsup (attr,m1,m2,m3) -> X.xml_nempty "msubsup" attr [< print_mpres m1; print_mpres m2; print_mpres m3 >] | Munder (attr,m1,m2) -> X.xml_nempty "munder" attr [< print_mpres m1; print_mpres m2 >] | Mover (attr,m1,m2) -> X.xml_nempty "mover" attr [< print_mpres m1; print_mpres m2 >] | Munderover (attr,m1,m2,m3) -> X.xml_nempty "munderover" attr [< print_mpres m1; print_mpres m2; print_mpres m3 >] (* | Multiscripts of ??? NOT IMPLEMEMENTED *) (* Tables and Matrices *) | Mtable (attr, rl) -> X.xml_nempty "mtable" attr [< (List.fold_right (fun x i -> [< (print_mrow x) ; i >]) rl [<>]) >] (* Enlivening Expressions *) | Maction (attr, l) -> X.xml_nempty "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 "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 "mtd" attr (print_mpres m) ;;