helm/ocaml/cic_notation/box.ml

   1 (* Copyright (C) 2000-2005, HELM Team.
   2  *
   3  * This file is part of HELM, an Hypertextual, Electronic
   4  * Library of Mathematics, developed at the Computer Science
   5  * Department, University of Bologna, Italy.
   6  *
   7  * HELM is free software; you can redistribute it and/or
   8  * modify it under the terms of the GNU General Public License
   9  * as published by the Free Software Foundation; either version 2
  10  * of the License, or (at your option) any later version.
  11  *
  12  * HELM is distributed in the hope that it will be useful,
  13  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  14  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15  * GNU General Public License for more details.
  16  *
  17  * You should have received a copy of the GNU General Public License
  18  * along with HELM; if not, write to the Free Software
  19  * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
  20  * MA  02111-1307, USA.
  21  *
  22  * For details, see the HELM World-Wide-Web page,
  23  * http://cs.unibo.it/helm/.
  24  *)
  25
  26 (*************************************************************************)
  27 (*                                                                       *)
  28 (*                           PROJECT HELM                                *)
  29 (*                                                                       *)
  30 (*                Andrea Asperti <asperti@cs.unibo.it>                   *)
  31 (*                             13/2/2004                                 *)
  32 (*                                                                       *)
  33 (*************************************************************************)
  34
  35 type
  36   'expr box =
  37     Text of attr * string
  38   | Space of attr
  39   | Ink of attr
  40   | H of attr * ('expr box) list
  41   | V of attr * ('expr box) list
  42   | HV of attr * ('expr box) list
  43   | HOV of attr * ('expr box) list
  44   | Object of attr * 'expr
  45   | Action of attr * ('expr box) list
  46
  47 and attr = (string option * string * string) list
  48
  49 let smallskip = Space([None,"width","0.5em"]);;
  50 let skip = Space([None,"width","1em"]);;
  51
  52 let indent t = H([],[skip;t]);;
  53
  54 (* BoxML prefix *)
  55 let prefix = "b";;
  56
  57 let tag_of_box = function
  58   | H _ -> "h"
  59   | V _ -> "v"
  60   | HV _ -> "hv"
  61   | HOV _ -> "hov"
  62   | _ -> assert false
  63
  64 let box2xml ~obj2xml box =
  65   let rec aux =
  66    let module X = Xml in
  67     function
  68         Text (attr,s) -> X.xml_nempty ~prefix "text" attr (X.xml_cdata s)
  69       | Space attr -> X.xml_empty ~prefix "space" attr
  70       | Ink attr -> X.xml_empty ~prefix "ink" attr
  71       | H (attr,l)
  72       | V (attr,l)
  73       | HV (attr,l)
  74       | HOV (attr,l) as box ->
  75           X.xml_nempty ~prefix (tag_of_box box) attr
  76             [< (List.fold_right (fun x i -> [< (aux x) ; i >]) l [<>])
  77             >]
  78       | Object (attr,m) ->
  79           X.xml_nempty ~prefix "obj" attr [< obj2xml m >]
  80       | Action (attr,l) ->
  81           X.xml_nempty ~prefix "action" attr
  82             [< (List.fold_right (fun x i -> [< (aux x) ; i >]) l [<>]) >]
  83   in
  84   aux box
  85 ;;
  86
  87 let rec map f = function
  88   | (Text _) as box -> box
  89   | (Space _) as box -> box
  90   | (Ink _) as box -> box
  91   | H (attr, l) -> H (attr, List.map (map f) l)
  92   | V (attr, l) -> V (attr, List.map (map f) l)
  93   | HV (attr, l) -> HV (attr, List.map (map f) l)
  94   | HOV (attr, l) -> HOV (attr, List.map (map f) l)
  95   | Action (attr, l) -> Action (attr, List.map (map f) l)
  96   | Object (attr, obj) -> Object (attr, f obj)
  97 ;;
  98
  99 (*
 100 let document_of_box ~obj2xml pres =
 101  [< Xml.xml_cdata "<?xml version=\"1.0\" encoding=\"ISO-8859-1\"?>\n" ;
 102     Xml.xml_cdata "\n";
 103     Xml.xml_nempty ~prefix "box"
 104      [Some "xmlns","m","http://www.w3.org/1998/Math/MathML" ;
 105       Some "xmlns","b","http://helm.cs.unibo.it/2003/BoxML" ;
 106       Some "xmlns","helm","http://www.cs.unibo.it/helm" ;
 107       Some "xmlns","xlink","http://www.w3.org/1999/xlink"
 108      ] (print_box pres)
 109  >]
 110 *)
 111
 112 let b_h a b = H(a,b)
 113 let b_v a b = V(a,b)
 114 let b_hv a b = HV(a,b)
 115 let b_hov a b = HOV(a,b)
 116 let b_text a b = Text(a,b)
 117 let b_object b = Object ([],b)
 118 let b_indent = indent
 119 let b_space = Space [None, "width", "0.5em"]
 120 let b_kw = b_text (RenderingAttrs.object_keyword_attributes `BoxML)
 121
 122 let pp_attr attr =
 123   let pp (ns, n, v) =
 124     Printf.sprintf "%s%s=%s" (match ns with None -> "" | Some s -> s ^ ":") n v
 125   in
 126   String.concat " " (List.map pp attr)
 127
 128 let get_attr = function
 129   | Text (attr, _)
 130   | Space attr
 131   | Ink attr
 132   | H (attr, _)
 133   | V (attr, _)
 134   | HV (attr, _)
 135   | HOV (attr, _)
 136   | Object (attr, _)
 137   | Action (attr, _) ->
 138       attr
 139
 140 let set_attr attr = function
 141   | Text (_, x) -> Text (attr, x)
 142   | Space _ -> Space attr
 143   | Ink _ -> Ink attr
 144   | H (_, x) -> H (attr, x)
 145   | V (_, x) -> V (attr, x)
 146   | HV (_, x) -> HV (attr, x)
 147   | HOV (_, x) -> HOV (attr, x)
 148   | Object (_, x) -> Object (attr, x)
 149   | Action (_, x) -> Action (attr, x)
 150