math/html.ml

   1 open Render_info
   2 open Tex
   3 open Util
   4
   5 exception Too_difficult_for_html
   6 type context = CTX_NORMAL | CTX_IT | CTX_RM
   7 type conservativeness_t = CONSERVATIVE | MODERATE | LIBERAL
   8
   9 let conservativeness = ref CONSERVATIVE
  10 let html_liberal () = conservativeness := LIBERAL
  11 let html_moderate () = if !conservativeness = CONSERVATIVE then conservativeness := MODERATE else ()
  12
  13
  14 let new_ctx = function
  15     FONTFORCE_IT -> CTX_IT
  16   | FONTFORCE_RM -> CTX_RM
  17 let font_render lit = function
  18     (_,     FONT_UFH) -> lit
  19   | (_,     FONT_UF)  -> lit
  20   | (CTX_IT,FONT_RTI) -> raise Too_difficult_for_html
  21   | (_,     FONT_RTI) -> lit
  22   | (CTX_IT,FONT_RM)  -> "<i>"^lit^"</i>"
  23   | (_,     FONT_RM)  -> lit
  24   | (CTX_RM,FONT_IT)  -> lit
  25   | (_,     FONT_IT)  -> "<i>"^lit^"</i>"
  26
  27 let rec html_render_flat ctx = function
  28     TEX_LITERAL (HTMLABLE (ft,_,sh))::r -> (html_liberal (); (font_render sh (ctx,ft))^html_render_flat ctx r)
  29   | TEX_LITERAL (HTMLABLEC(ft,_,sh))::r -> (font_render sh (ctx,ft))^html_render_flat ctx r
  30   | TEX_LITERAL (MHTMLABLEC(ft,_,sh,_,_))::r -> (font_render sh (ctx,ft))^html_render_flat ctx r
  31   | TEX_LITERAL (HTMLABLEM(ft,_,sh))::r -> (html_moderate(); (font_render sh (ctx,ft))^html_render_flat ctx r)
  32   | TEX_LITERAL (HTMLABLE_BIG (_,sh))::r -> (html_liberal (); sh^html_render_flat ctx r)
  33   | TEX_FUN1hl (_,(f1,f2),a)::r -> f1^(html_render_flat ctx [a])^f2^html_render_flat ctx r
  34   | TEX_FUN1hf (_,ff,a)::r -> (html_render_flat (new_ctx ff) [a])^html_render_flat ctx r
  35   | TEX_DECLh (_,ff,a)::r -> (html_render_flat (new_ctx ff) a)^html_render_flat ctx r
  36   | TEX_CURLY ls::r -> html_render_flat ctx (ls @ r)
  37   | TEX_DQ (a,b)::r  -> (html_liberal ();
  38                          let bs = html_render_flat ctx [b] in match html_render_size ctx a with
  39                          true, s -> raise Too_difficult_for_html
  40                        | false, s -> s^"<sub>"^bs^"</sub>")^html_render_flat ctx r
  41   | TEX_UQ (a,b)::r  -> (html_liberal ();
  42                          let bs = html_render_flat ctx [b] in match html_render_size ctx a with
  43                          true, s ->  raise Too_difficult_for_html
  44                        | false, s -> s^"<sup>"^bs^"</sup>")^html_render_flat ctx r
  45   | TEX_FQ (a,b,c)::r -> (html_liberal ();
  46                          (let bs = html_render_flat ctx [b] in let cs = html_render_flat ctx [c] in
  47                           match html_render_size ctx a with
  48                           true, s -> raise Too_difficult_for_html
  49                         | false, s -> s^"<sub>"^bs^"</sub><sup>"^cs^"</sup>")^html_render_flat ctx r)
  50   | TEX_DQN (a)::r  -> (html_liberal ();
  51                  let bs = html_render_flat ctx [a] in "<sub>"^bs^"</sub>")^html_render_flat ctx r
  52   | TEX_UQN (a)::r  -> (html_liberal ();
  53                  let bs = html_render_flat ctx [a] in "<sup>"^bs^"</sup>")^html_render_flat ctx r
  54   | TEX_FQN (a,b)::r -> (html_liberal ();
  55                          (let bs = html_render_flat ctx [a] in let cs = html_render_flat ctx [b] in  "<sub>"^bs^"</sub><sup>"^cs^"</sup>")^html_render_flat ctx r)
  56   | TEX_BOX (_,s)::r -> s^html_render_flat ctx r
  57   | TEX_LITERAL (TEX_ONLY _)::_ -> raise Too_difficult_for_html
  58   | TEX_FUN1 _::_ -> raise Too_difficult_for_html
  59   | TEX_FUN2  _::_ -> raise Too_difficult_for_html
  60   | TEX_FUN2nb  _::_ -> raise Too_difficult_for_html
  61   | TEX_FUN2h  _::_ -> raise Too_difficult_for_html
  62   | TEX_FUN2sq  _::_ -> raise Too_difficult_for_html
  63   | TEX_INFIX _::_ -> raise Too_difficult_for_html
  64   | TEX_INFIXh _::_ -> raise Too_difficult_for_html
  65   | TEX_MATRIX _::_ -> raise Too_difficult_for_html
  66   | TEX_LR _::_ -> raise Too_difficult_for_html
  67   | TEX_BIG _::_ -> raise Too_difficult_for_html
  68   | [] -> ""
  69 and html_render_size ctx = function
  70     TEX_LITERAL (HTMLABLE_BIG (_,sh)) -> true,sh
  71   | x -> false,html_render_flat ctx [x]
  72
  73 let rec html_render_deep ctx = function
  74     TEX_LITERAL (HTMLABLE (ft,_,sh))::r -> (html_liberal (); ("",(font_render sh (ctx,ft)),"")::html_render_deep ctx r)
  75   | TEX_LITERAL (HTMLABLEM(ft,_,sh))::r -> (html_moderate(); ("",(font_render sh (ctx,ft)),"")::html_render_deep ctx r)
  76   | TEX_LITERAL (HTMLABLEC(ft,_,sh))::r -> ("",(font_render sh (ctx,ft)),"")::html_render_deep ctx r
  77   | TEX_LITERAL (MHTMLABLEC(ft,_,sh,_,_))::r -> ("",(font_render sh (ctx,ft)),"")::html_render_deep ctx r
  78   | TEX_LITERAL (HTMLABLE_BIG (_,sh))::r -> (html_liberal (); ("",sh,"")::html_render_deep ctx r)
  79   | TEX_FUN2h (_,f,a,b)::r -> (html_liberal (); (f a b)::html_render_deep ctx r)
  80   | TEX_INFIXh (_,f,a,b)::r -> (html_liberal (); (f a b)::html_render_deep ctx r)
  81   | TEX_CURLY ls::r -> html_render_deep ctx (ls @ r)
  82   | TEX_DQ (a,b)::r  -> (let bs = html_render_flat ctx [b] in match html_render_size ctx a with
  83   true, s ->  "","<span style='font-size: x-large; font-family: serif;'>"^s^"</span>",bs
  84                        | false, s -> "",(s^"<sub>"^bs^"</sub>"),"")::html_render_deep ctx r
  85   | TEX_UQ (a,b)::r  -> (let bs = html_render_flat ctx [b] in match html_render_size ctx a with
  86   true, s ->  bs,"<span style='font-size: x-large; font-family: serif;'>"^s^"</span>",""
  87                        | false, s -> "",(s^"<sup>"^bs^"</sup>"),"")::html_render_deep ctx r
  88   | TEX_FQ (a,b,c)::r -> (html_liberal ();
  89                          (let bs = html_render_flat ctx [b] in let cs = html_render_flat ctx [c] in
  90                           match html_render_size ctx a with
  91                   true, s ->  (cs,"<span style='font-size: x-large; font-family: serif;'>"^s^"</span>",bs)
  92                         | false, s -> ("",(s^"<sub>"^bs^"</sub><sup>"^cs^"</sup>"),""))::html_render_deep ctx r)
  93   | TEX_DQN (a)::r  -> (let bs = html_render_flat ctx [a] in "",("<sub>"^bs^"</sub>"),"")::html_render_deep ctx r
  94   | TEX_UQN (a)::r  -> (let bs = html_render_flat ctx [a] in "",("<sup>"^bs^"</sup>"),"")::html_render_deep ctx r
  95   | TEX_FQN (a,b)::r -> (html_liberal ();
  96                          (let bs = html_render_flat ctx [a] in let cs = html_render_flat ctx [b] in
  97                          ("",("<sub>"^bs^"</sub><sup>"^cs^"</sup>"),""))::html_render_deep ctx r)
  98   | TEX_FUN1hl (_,(f1,f2),a)::r -> ("",f1,"")::(html_render_deep ctx [a]) @ ("",f2,"")::html_render_deep ctx r
  99   | TEX_FUN1hf (_,ff,a)::r -> (html_render_deep (new_ctx ff) [a]) @ html_render_deep ctx r
 100   | TEX_DECLh  (_,ff,a)::r -> (html_render_deep (new_ctx ff) a) @ html_render_deep ctx r
 101   | TEX_BOX (_,s)::r -> ("",s,"")::html_render_deep ctx r
 102   | TEX_LITERAL (TEX_ONLY _)::_ -> raise Too_difficult_for_html
 103   | TEX_FUN1 _::_ -> raise Too_difficult_for_html
 104   | TEX_FUN2 _::_ -> raise Too_difficult_for_html
 105   | TEX_FUN2nb _::_ -> raise Too_difficult_for_html
 106   | TEX_FUN2sq  _::_ -> raise Too_difficult_for_html
 107   | TEX_INFIX _::_ -> raise Too_difficult_for_html
 108   | TEX_MATRIX _::_ -> raise Too_difficult_for_html
 109   | TEX_LR _::_ -> raise Too_difficult_for_html
 110   | TEX_BIG _::_ -> raise Too_difficult_for_html
 111   | [] -> []
 112
 113 let rec html_render_table = function
 114     sf,u,d,("",a,"")::("",b,"")::r -> html_render_table (sf,u,d,(("",a^b,"")::r))
 115   | sf,u,d,(("",a,"") as c)::r     -> html_render_table (c::sf,u,d,r)
 116   | sf,u,d,((_,a,"") as c)::r      -> html_render_table (c::sf,true,d,r)
 117   | sf,u,d,(("",a,_) as c)::r      -> html_render_table (c::sf,u,true,r)
 118   | sf,u,d,((_,a,_) as c)::r       -> html_render_table (c::sf,true,true,r)
 119   | sf,false,false,[]              -> mapjoin (function (u,m,d) -> m) (List.rev sf)
 120   | sf,true,false,[]               -> let ustr,mstr = List.fold_left (fun (us,ms) (u,m,d) -> (us^"<td>"^u^"</td>",ms^"<td>"^u^"</td>"))
 121                                         ("","") (List.rev sf) in
 122                     "\n<table>\n" ^
 123                     "\t\t<tr style='text-align: center; vertical-align: bottom;'>" ^ ustr ^ "</tr>\n" ^
 124                     "\t\t<tr style='text-align: center;'>" ^ mstr ^ "</tr>\n" ^
 125                     "</table>\n"
 126   | sf,false,true,[]               -> let mstr,dstr = List.fold_left (fun (ms,ds) (u,m,d) -> (ms^"<td>"^m^"</td>",ds^"<td>"^d^"</td>"))
 127                                         ("","") (List.rev sf) in
 128                     "\n<table>\n" ^
 129                     "\t\t<tr style='text-align: center;'>" ^ mstr ^ "</tr>\n" ^
 130                     "\t\t<tr style='text-align: center; vertical-align: top;'>" ^ dstr ^ "</tr>\n" ^
 131                     "</table>\n"
 132   | sf,true,true,[]               -> let ustr,mstr,dstr = List.fold_left (fun (us,ms,ds) (u,m,d) ->
 133                                         (us^"<td>"^u^"</td>",ms^"<td>"^m^"</td>",ds^"<td>"^d^"</td>")) ("","","") (List.rev sf) in
 134                                         "\n<table>\n" ^
 135                     "\t\t<tr style='text-align: center; vertical-align: bottom;'>" ^ ustr ^ "</tr>\n" ^
 136                     "\t\t<tr style='text-align: center;'>" ^ mstr ^ "</tr>\n" ^
 137                     "\t\t<tr style='text-align: center; vertical-align: top;'>" ^ dstr ^ "</tr>\n" ^
 138                     "</table>\n"
 139
 140 let html_render tree = html_render_table ([],false,false,html_render_deep CTX_NORMAL tree)
 141
 142 let render tree = try Some (html_render tree) with _ -> None