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_BOX (_,s)::r -> s^html_render_flat ctx r
  51   | TEX_LITERAL (TEX_ONLY _)::_ -> raise Too_difficult_for_html
  52   | TEX_FUN1 _::_ -> raise Too_difficult_for_html
  53   | TEX_FUN2  _::_ -> raise Too_difficult_for_html
  54   | TEX_FUN2h  _::_ -> raise Too_difficult_for_html
  55   | TEX_FUN2sq  _::_ -> raise Too_difficult_for_html
  56   | TEX_INFIX _::_ -> raise Too_difficult_for_html
  57   | TEX_INFIXh _::_ -> raise Too_difficult_for_html
  58   | TEX_MATRIX _::_ -> raise Too_difficult_for_html
  59   | TEX_LR _::_ -> raise Too_difficult_for_html
  60   | TEX_BIG _::_ -> raise Too_difficult_for_html
  61   | [] -> ""
  62 and html_render_size ctx = function
  63     TEX_LITERAL (HTMLABLE_BIG (_,sh)) -> true,sh
  64   | x -> false,html_render_flat ctx [x]
  65
  66 let rec html_render_deep ctx = function
  67     TEX_LITERAL (HTMLABLE (ft,_,sh))::r -> (html_liberal (); ("",(font_render sh (ctx,ft)),"")::html_render_deep ctx r)
  68   | TEX_LITERAL (HTMLABLEM(ft,_,sh))::r -> (html_moderate(); ("",(font_render sh (ctx,ft)),"")::html_render_deep ctx r)
  69   | TEX_LITERAL (HTMLABLEC(ft,_,sh))::r -> ("",(font_render sh (ctx,ft)),"")::html_render_deep ctx r
  70   | TEX_LITERAL (MHTMLABLEC(ft,_,sh,_,_))::r -> ("",(font_render sh (ctx,ft)),"")::html_render_deep ctx r
  71   | TEX_LITERAL (HTMLABLE_BIG (_,sh))::r -> (html_liberal (); ("",sh,"")::html_render_deep ctx r)
  72   | TEX_FUN2h (_,f,a,b)::r -> (html_liberal (); (f a b)::html_render_deep ctx r)
  73   | TEX_INFIXh (_,f,a,b)::r -> (html_liberal (); (f a b)::html_render_deep ctx r)
  74   | TEX_CURLY ls::r -> html_render_deep ctx (ls @ r)
  75   | TEX_DQ (a,b)::r  -> (let bs = html_render_flat ctx [b] in match html_render_size ctx a with
  76                          true, s ->  "","<font size=+2>"^s^"</font>",bs
  77                        | false, s -> "",(s^"<sub>"^bs^"</sub>"),"")::html_render_deep ctx r
  78   | TEX_UQ (a,b)::r  -> (let bs = html_render_flat ctx [b] in match html_render_size ctx a with
  79                          true, s ->  bs,"<font size=+2>"^s^"</font>",""
  80                        | false, s -> "",(s^"<sup>"^bs^"</sup>"),"")::html_render_deep ctx r
  81   | TEX_FQ (a,b,c)::r -> (html_liberal ();
  82                          (let bs = html_render_flat ctx [b] in let cs = html_render_flat ctx [c] in
  83                           match html_render_size ctx a with
  84                           true, s ->  (cs,"<font size=+2>"^s^"</font>",bs)
  85                         | false, s -> ("",(s^"<sub>"^bs^"</sub><sup>"^cs^"</sup>"),""))::html_render_deep ctx r)
  86   | TEX_FUN1hl (_,(f1,f2),a)::r -> ("",f1,"")::(html_render_deep ctx [a]) @ ("",f2,"")::html_render_deep ctx r
  87   | TEX_FUN1hf (_,ff,a)::r -> (html_render_deep (new_ctx ff) [a]) @ html_render_deep ctx r
  88   | TEX_DECLh  (_,ff,a)::r -> (html_render_deep (new_ctx ff) a) @ html_render_deep ctx r
  89   | TEX_BOX (_,s)::r -> ("",s,"")::html_render_deep ctx r
  90   | TEX_LITERAL (TEX_ONLY _)::_ -> raise Too_difficult_for_html
  91   | TEX_FUN1 _::_ -> raise Too_difficult_for_html
  92   | TEX_FUN2 _::_ -> raise Too_difficult_for_html
  93   | TEX_FUN2sq  _::_ -> raise Too_difficult_for_html
  94   | TEX_INFIX _::_ -> raise Too_difficult_for_html
  95   | TEX_MATRIX _::_ -> raise Too_difficult_for_html
  96   | TEX_LR _::_ -> raise Too_difficult_for_html
  97   | TEX_BIG _::_ -> raise Too_difficult_for_html
  98   | [] -> []
  99
 100 let rec html_render_table = function
 101     sf,u,d,("",a,"")::("",b,"")::r -> html_render_table (sf,u,d,(("",a^b,"")::r))
 102   | sf,u,d,(("",a,"") as c)::r     -> html_render_table (c::sf,u,d,r)
 103   | sf,u,d,((_,a,"") as c)::r      -> html_render_table (c::sf,true,d,r)
 104   | sf,u,d,(("",a,_) as c)::r      -> html_render_table (c::sf,u,true,r)
 105   | sf,u,d,((_,a,_) as c)::r       -> html_render_table (c::sf,true,true,r)
 106   | sf,false,false,[]              -> mapjoin (function (u,m,d) -> m) (List.rev sf)
 107   | sf,true,false,[]               -> let ustr,mstr = List.fold_left (fun (us,ms) (u,m,d) -> (us^"<td>"^u,ms^"<td>"^u))
 108                                         ("","") (List.rev sf) in
 109                                         "<table><tr align=center valign=bottom>" ^ ustr ^ "</tr><tr align=center>" ^ mstr ^ "</tr></table>"
 110   | sf,false,true,[]               -> let mstr,dstr = List.fold_left (fun (ms,ds) (u,m,d) -> (ms^"<td>"^m,ds^"<td>"^d))
 111                                         ("","") (List.rev sf) in
 112                                         "<table><tr align=center>" ^ mstr ^ "</tr><tr align=center valign=top>" ^ dstr ^ "</tr></table>"
 113   | sf,true,true,[]               -> let ustr,mstr,dstr = List.fold_left (fun (us,ms,ds) (u,m,d) ->
 114                                         (us^"<td>"^u,ms^"<td>"^m,ds^"<td>"^d)) ("","","") (List.rev sf) in
 115                                         "<table><tr align=center valign=bottom>" ^ ustr ^ "</tr><tr align=center>" ^ mstr ^ "</tr><tr align=center valign=top>" ^ dstr ^ "</tr></table>"
 116
 117 let html_render tree = html_render_table ([],false,false,html_render_deep CTX_NORMAL tree)
 118
 119 let render tree = try Some (html_render tree) with _ -> None