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