matitaB/components/content_pres/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 (* $Id$ *)
  27
  28 type
  29   'expr box =
  30     Text of attr * string
  31   | Space of attr
  32   | Ink of attr
  33   | H of attr * ('expr box) list
  34   | V of attr * ('expr box) list
  35   | HV of attr * ('expr box) list
  36   | HOV of attr * ('expr box) list
  37   | Object of attr * 'expr
  38   | Action of attr * ('expr box) list
  39
  40 and attr = (string option * string * string) list
  41
  42 let smallskip = Space([None,"width","0.5em"]);;
  43 let skip = Space([None,"width","1em"]);;
  44
  45 let indent t = H([],[skip;t]);;
  46
  47 (* BoxML prefix *)
  48 let prefix = "b";;
  49
  50 let tag_of_box = function
  51   | H _ -> "h"
  52   | V _ -> "v"
  53   | HV _ -> "hv"
  54   | HOV _ -> "hov"
  55   | _ -> assert false
  56
  57 let box2xml ~obj2xml box =
  58   let rec aux =
  59    let module X = Xml in
  60     function
  61         Text (attr,s) -> X.xml_nempty ~prefix "text" attr (X.xml_cdata s)
  62       | Space attr -> X.xml_empty ~prefix "space" attr
  63       | Ink attr -> X.xml_empty ~prefix "ink" attr
  64       | H (attr,l)
  65       | V (attr,l)
  66       | HV (attr,l)
  67       | HOV (attr,l) as box ->
  68           X.xml_nempty ~prefix (tag_of_box box) attr
  69             [< (List.fold_right (fun x i -> [< (aux x) ; i >]) l [<>])
  70             >]
  71       | Object (attr,m) ->
  72           X.xml_nempty ~prefix "obj" attr [< obj2xml m >]
  73       | Action (attr,l) ->
  74           X.xml_nempty ~prefix "action" attr
  75             [< (List.fold_right (fun x i -> [< (aux x) ; i >]) l [<>]) >]
  76   in
  77   aux box
  78 ;;
  79
  80 let rec map f = function
  81   | (Text _) as box -> box
  82   | (Space _) as box -> box
  83   | (Ink _) as box -> box
  84   | H (attr, l) -> H (attr, List.map (map f) l)
  85   | V (attr, l) -> V (attr, List.map (map f) l)
  86   | HV (attr, l) -> HV (attr, List.map (map f) l)
  87   | HOV (attr, l) -> HOV (attr, List.map (map f) l)
  88   | Action (attr, l) -> Action (attr, List.map (map f) l)
  89   | Object (attr, obj) -> Object (attr, f obj)
  90 ;;
  91
  92 (*
  93 let document_of_box ~obj2xml pres =
  94  [< Xml.xml_cdata "<?xml version=\"1.0\" encoding=\"ISO-8859-1\"?>\n" ;
  95     Xml.xml_cdata "\n";
  96     Xml.xml_nempty ~prefix "box"
  97      [Some "xmlns","m","http://www.w3.org/1998/Math/MathML" ;
  98       Some "xmlns","b","http://helm.cs.unibo.it/2003/BoxML" ;
  99       Some "xmlns","helm","http://www.cs.unibo.it/helm" ;
 100       Some "xmlns","xlink","http://www.w3.org/1999/xlink"
 101      ] (print_box pres)
 102  >]
 103 *)
 104
 105 let b_h a b = H(a,b)
 106 let b_v a b = V(a,b)
 107 let b_hv a b = HV(a,b)
 108 let b_hov a b = HOV(a,b)
 109 let b_text a b = Text(a,b)
 110 let b_object b = Object ([],b)
 111 let b_indent = indent
 112 let b_space = Space [None, "width", "0.5em"]
 113 (* let b_kw = b_text (RenderingAttrs.object_keyword_attributes `BoxML) *)
 114 let b_toggle items = Action ([ None, "type", "toggle"], items)
 115
 116 let pp_attr attr =
 117   let pp (ns, n, v) =
 118     Printf.sprintf "%s%s=%s" (match ns with None -> "" | Some s -> s ^ ":") n v
 119   in
 120   String.concat " " (List.map pp attr)
 121
 122 let get_attr = function
 123   | Text (attr, _)
 124   | Space attr
 125   | Ink attr
 126   | H (attr, _)
 127   | V (attr, _)
 128   | HV (attr, _)
 129   | HOV (attr, _)
 130   | Object (attr, _)
 131   | Action (attr, _) ->
 132       attr
 133
 134 let set_attr attr = function
 135   | Text (_, x) -> Text (attr, x)
 136   | Space _ -> Space attr
 137   | Ink _ -> Ink attr
 138   | H (_, x) -> H (attr, x)
 139   | V (_, x) -> V (attr, x)
 140   | HV (_, x) -> HV (attr, x)
 141   | HOV (_, x) -> HOV (attr, x)
 142   | Object (_, x) -> Object (attr, x)
 143   | Action (_, x) -> Action (attr, x)
 144