1signature MATH_TRANSLATE  =
2sig
3  val cleanBox: BasicTypes.style -> bool -> MathTypes.mlist -> BoxTypes.box
4  val doAccent: BasicTypes.style -> bool -> BasicTypes.family ->
5                BasicTypes.charCode -> MathTypes.mlist -> BoxTypes.box
6  val doGenFraction: BasicTypes.style -> bool -> MathTypes.genfraction ->
7                     BoxTypes.box
8  val doLeftRight: BasicTypes.style -> bool -> BasicTypes.delim ->
9                   MathTypes.mlist -> BasicTypes.delim -> BoxTypes.box
10  val doNucleus: BasicTypes.style -> bool -> bool -> MathTypes.mlist ->
11                 BoxTypes.node * BasicTypes.dist * bool
12  val doGenScripts: BasicTypes.style -> bool -> bool -> bool ->
13                    MathTypes.script -> BoxTypes.hlist
14  val doBigOp: BasicTypes.style -> bool -> MathTypes.limits ->
15               MathTypes.script -> BoxTypes.hlist
16  val doPlainScripts: BasicTypes.style -> bool -> MathTypes.script ->
17                      BoxTypes.hlist
18  val doAccentScripts: BasicTypes.style -> bool -> MathTypes.noad ->
19                       MathTypes.mlist -> MathTypes.mlist option ->
20                       MathTypes.mlist option -> BoxTypes.hlist
21  val NoadToHList: BasicTypes.style -> bool -> MathTypes.noad -> BoxTypes.hlist
22  val MListToIList: BasicTypes.style -> bool -> MathTypes.mlist ->
23                    IListTypes.ilist
24  val MListToHList: BasicTypes.style -> bool -> bool -> MathTypes.mlist ->
25                    BoxTypes.hlist
26end  (* signature MATH_TRANSLATE *)
27(*----------*)
28
29structure MathTranslate: MATH_TRANSLATE  =
30struct
31  open BasicTypes;  open BoxTypes;  open MathTypes;  open IListTypes
32  open General;  open Distance;  open BoxPack;  open AxisCenter
33  open Kind;  open ChangeStyle
34  open MakeChar;  open Accent;  open Radical;  open Boundaries
35  open MakeLine;  open GenFraction;  open MakeScripts;  open MakeLimOp
36  open IListTranslate
37
38  fun cleanBox st cr ml  =
39      boxList (MListToHList st cr false (* no penalties! *) ml)
40
41  and doAccent st cr fam ch ml =
42  let val singleChar = case ml of
43                         [MathChar (_,fam,ch)] => SOME (fam,ch)
44                       | _                     => NONE
45  in makeAccent singleChar st fam ch (cleanBox st true ml) end
46
47  and doGenFraction st cr {left, right, thickness, num, den}  =
48  let val  st'      =  fract st
49      val  numbox   =  cleanBox st' cr   num
50      val  denbox   =  cleanBox st' true den
51  in  makeGenFraction st thickness left right numbox denbox  end
52
53  and doLeftRight st cr left ml right  =
54  let val il   =  MListToIList st cr ml
55      val il'  =  attachBoundaries st left right il
56  in  boxList (IListToHList st false il')  end
57
58  and doNucleus st _ isOp [MathChar (_, fam, ch)]  =  makeNucChar st isOp fam ch
59  |   doNucleus st cr _    ml  =  (Box0 (cleanBox st cr ml), zero, false)
60
61  and doGenScripts st cr limits isOp {nucleus, supOpt, subOpt}  =
62  let val (nucNode, itCorr, isChar)  =  doNucleus st cr isOp nucleus
63      val st'  =  script st
64      val supOptBox  =  optMap (cleanBox st' cr)   supOpt
65      val subOptBox  =  optMap (cleanBox st' true) subOpt
66  in  if  limits
67        then  HL  (makeLimOp st        itCorr nucNode supOptBox subOptBox)
68        else  makeScripts st cr isChar itCorr nucNode supOptBox subOptBox
69  end
70
71  and doBigOp st cr lim script  =
72  let val limits  =  (st = D  andalso  lim = default)  orelse  lim = yes
73  in  doGenScripts st cr limits true script  end
74
75  and doPlainScripts st cr (script as {nucleus, supOpt, subOpt}) =
76  case #nucleus script of
77    [acc as (Accent (_,_,ml))] => doAccentScripts st cr acc ml supOpt subOpt
78  | _                          => doGenScripts st cr false false script
79
80  and doAccentScripts st cr nucleus nucleusNoAccent supOpt subOpt =
81  let
82    val scriptNoAccents  = {nucleus=nucleusNoAccent, supOpt=supOpt, subOpt=subOpt}
83    val scriptNoAccents' = doGenScripts st cr false false scriptNoAccents
84    val nucleus = NoadToHList st cr nucleus
85  in (hd nucleus) :: (tl scriptNoAccents') end
86  (* hd nucleus is a box with the accented nucleus,
87     tl scriptNoAccents' is the vbox holding the sub and/or superscript *)
88
89  and NoadToHList st cr  =
90  fn MathChar(_, fam, ch)  =>  makeChar st fam ch
91  |  Radical    (del, ml)  =>  HL (makeRadical st del    (cleanBox st true ml))
92  |  Accent (fam, ch, ml)  =>  HL (doAccent st cr fam ch ml)
93  |  VCenter    ml  =>  [axisCenter   st (cleanBox st cr ml)]
94  |  Overline   ml  =>  HL (makeOver  st (cleanBox st true ml))
95  |  Underline  ml  =>  HL (makeUnder st (cleanBox st cr ml))
96  |  GenFraction genFract  =>  HL (doGenFraction st cr genFract)
97  |  LeftRight (left, ml, right)  =>  HL (doLeftRight st cr left ml right)
98  |  Script script   =>  doPlainScripts st cr script
99  |  BigOp (lim, script)  =>  doBigOp st cr lim script
100  |  SubBox   b    =>  HL b
101  |  MList    ml   =>  HL (cleanBox st cr ml)
102  |  Kind (k, ml)  =>  HL (cleanBox st cr ml)
103  |  _             =>  raise CannotHappen
104  (* MPen, MSpace, Style, and Choice are handled differently. *)
105
106  and MListToIList st cr  =
107  fn []  =>  []
108  |  MPen   p     :: rest  =>  IPen   p   ::  MListToIList st  cr rest
109  |  MSpace s     :: rest  =>  ISpace s   ::  MListToIList st  cr rest
110  |  Style  st'   :: rest  =>  IStyle st' ::  MListToIList st' cr rest
111  |  Choice chfun :: rest  =>  MListToIList st cr (chfun st @ rest)
112  |  noad         :: rest  =>
113       INoad (noadKind noad, NoadToHList st cr noad)
114       :: MListToIList st cr rest
115
116  and MListToHList st cr pen ml  =
117  let val il  =  MListToIList st cr  ml
118      val hl  =  IListToHList st pen il
119  in  hl  end
120
121end  (* structure MathTranslate *)
122