diff --git a/lib-satysfi/dist/packages/math.satyh b/lib-satysfi/dist/packages/math.satyh index 9c6f82db5..faf009672 100644 --- a/lib-satysfi/dist/packages/math.satyh +++ b/lib-satysfi/dist/packages/math.satyh @@ -36,6 +36,9 @@ module Math :> sig val \mathfrak : math [math-text] val \mathbb : math [math-text] val \bm : math [math-text] + val \mathit : math [math-text] + val \mathsf : math [math-text] + val \mathtt : math [math-text] val \math-style-token : math [math-char-class, string] val \mathit-token : math [string] @@ -497,7 +500,9 @@ end = struct val math ctx \mathfrak m = read-math ctx ${\math-style!(MathFraktur){#m}} val math ctx \mathbb m = read-math ctx ${\math-style!(MathDoubleStruck){#m}} val math ctx \bm m = read-math ctx ${\math-style!(MathBoldItalic){#m}} - + val math ctx \mathit m = read-math ctx ${\math-style!(MathItalic){#m}} + val math ctx \mathsf m = read-math ctx ${\math-style!(MathSansSerif){#m}} + val math ctx \mathtt m = read-math ctx ${\math-style!(MathTypewriter){#m}} val math ctx \math-style-token sty s = embed-inline-to-math MathOrd ( @@ -607,95 +612,93 @@ end = struct val single cp = string-unexplode [cp] - val greek-lowercase ctx cp cpb = + val greek ctx cp cpi cpb cpbi cpbss cpbiss = let s = single cp in + let si = single cpi in let sb = single cpb in + let sbi = single cpbi in + let sbss = single cpbss in + let sbiss = single cpbiss in + % typefaces marked with (*) are not defined in Unicode let t = match get-math-char-class ctx with - | MathItalic -> s - | MathBoldItalic -> sb - | MathRoman -> s - | MathBoldRoman -> sb - | MathScript -> s - | MathBoldScript -> sb - | MathFraktur -> s - | MathBoldFraktur -> sb - | MathDoubleStruck -> s + | MathItalic -> si + | MathBoldItalic -> sbi + | MathRoman -> s + | MathBoldRoman -> sb + | MathScript -> si % (*) + | MathBoldScript -> sbi % (*) + | MathFraktur -> si % (*) + | MathBoldFraktur -> sbi % (*) + | MathDoubleStruck -> si % (*) + | MathSansSerif -> si % (*) + | MathBoldSansSerif -> sbss + | MathItalicSansSerif -> si % (*) + | MathBoldItalicSansSerif -> sbiss + | MathTypewriter -> s % (*) end in math-char ctx MathOrd t - val greek-uppercase ctx cp cpb cpr cprb = - let s = single cp in - let sb = single cpb in - let sr = single cpr in - let srb = single cprb in - let t = - match get-math-char-class ctx with - | MathItalic -> s - | MathBoldItalic -> sb - | MathRoman -> sr - | MathBoldRoman -> srb - | MathScript -> s - | MathBoldScript -> sb - | MathFraktur -> s - | MathBoldFraktur -> sb - | MathDoubleStruck -> s - end - in - math-char ctx MathOrd t - + val greek-lowercase ctx i = + greek ctx (0x003B1 + i) (0x1D6FC + i) (0x1D6C2 + i) (0x1D736 + i) (0x1D770 + i) (0x1D7AA + i) + + + val greek-uppercase ctx i = + greek ctx (0x00391 + i) (0x1D6E2 + i) (0x1D6A8 + i) (0x1D71C + i) (0x1D756 + i) (0x1D790 + i) + + + val math ctx \alpha = greek-lowercase ctx 0 + val math ctx \beta = greek-lowercase ctx 1 + val math ctx \gamma = greek-lowercase ctx 2 + val math ctx \delta = greek-lowercase ctx 3 + val math ctx \epsilon = greek-lowercase ctx 4 + val math ctx \zeta = greek-lowercase ctx 5 + val math ctx \eta = greek-lowercase ctx 6 + val math ctx \theta = greek-lowercase ctx 7 + val math ctx \iota = greek-lowercase ctx 8 + val math ctx \kappa = greek-lowercase ctx 9 + val math ctx \lambda = greek-lowercase ctx 10 + val math ctx \mu = greek-lowercase ctx 11 + val math ctx \nu = greek-lowercase ctx 12 + val math ctx \xi = greek-lowercase ctx 13 + val math ctx \omicron = greek-lowercase ctx 14 + val math ctx \pi = greek-lowercase ctx 15 + val math ctx \rho = greek-lowercase ctx 16 + val math ctx \sigma = greek-lowercase ctx 18 + val math ctx \tau = greek-lowercase ctx 19 + val math ctx \upsilon = greek-lowercase ctx 20 + val math ctx \phi = greek-lowercase ctx 21 + val math ctx \chi = greek-lowercase ctx 22 + val math ctx \psi = greek-lowercase ctx 23 + val math ctx \omega = greek-lowercase ctx 24 + + val math ctx \Alpha = greek-uppercase ctx 0 + val math ctx \Beta = greek-uppercase ctx 1 + val math ctx \Gamma = greek-uppercase ctx 2 + val math ctx \Delta = greek-uppercase ctx 3 + val math ctx \Epsilon = greek-uppercase ctx 4 + val math ctx \Zeta = greek-uppercase ctx 5 + val math ctx \Eta = greek-uppercase ctx 6 + val math ctx \Theta = greek-uppercase ctx 7 + val math ctx \Iota = greek-uppercase ctx 8 + val math ctx \Kappa = greek-uppercase ctx 9 + val math ctx \Lambda = greek-uppercase ctx 10 + val math ctx \Mu = greek-uppercase ctx 11 + val math ctx \Nu = greek-uppercase ctx 12 + val math ctx \Xi = greek-uppercase ctx 13 + val math ctx \Omicron = greek-uppercase ctx 14 + val math ctx \Pi = greek-uppercase ctx 15 + val math ctx \Rho = greek-uppercase ctx 16 + val math ctx \Sigma = greek-uppercase ctx 18 + val math ctx \Tau = greek-uppercase ctx 19 + val math ctx \Upsilon = greek-uppercase ctx 20 + val math ctx \Phi = greek-uppercase ctx 21 + val math ctx \Chi = greek-uppercase ctx 22 + val math ctx \Psi = greek-uppercase ctx 23 + val math ctx \Omega = greek-uppercase ctx 24 - val math ctx \alpha = greek-lowercase ctx 0x1D6FC 0x1D736 - val math ctx \beta = greek-lowercase ctx 0x1D6FD 0x1D737 - val math ctx \gamma = greek-lowercase ctx 0x1D6FE 0x1D738 - val math ctx \delta = greek-lowercase ctx 0x1D6FF 0x1D739 - val math ctx \epsilon = greek-lowercase ctx 0x1D700 0x1D73A - val math ctx \zeta = greek-lowercase ctx 0x1D701 0x1D73B - val math ctx \eta = greek-lowercase ctx 0x1D702 0x1D73C - val math ctx \theta = greek-lowercase ctx 0x1D703 0x1D73D - val math ctx \iota = greek-lowercase ctx 0x1D704 0x1D73E - val math ctx \kappa = greek-lowercase ctx 0x1D705 0x1D73F - val math ctx \lambda = greek-lowercase ctx 0x1D706 0x1D740 - val math ctx \mu = greek-lowercase ctx 0x1D707 0x1D741 - val math ctx \nu = greek-lowercase ctx 0x1D708 0x1D742 - val math ctx \xi = greek-lowercase ctx 0x1D709 0x1D743 - val math ctx \omicron = greek-lowercase ctx 0x1D70A 0x1D744 - val math ctx \pi = greek-lowercase ctx 0x1D70B 0x1D745 - val math ctx \rho = greek-lowercase ctx 0x1D70C 0x1D746 - val math ctx \sigma = greek-lowercase ctx 0x1D70E 0x1D748 - val math ctx \tau = greek-lowercase ctx 0x1D70F 0x1D749 - val math ctx \upsilon = greek-lowercase ctx 0x1D710 0x1D74A - val math ctx \phi = greek-lowercase ctx 0x1D711 0x1D74B - val math ctx \chi = greek-lowercase ctx 0x1D712 0x1D74C - val math ctx \psi = greek-lowercase ctx 0x1D713 0x1D74D - val math ctx \omega = greek-lowercase ctx 0x1D714 0x1D74E - - val math ctx \Alpha = greek-uppercase ctx 0x1D6E2 0x1D71C 0x0391 0x1D6A8 - val math ctx \Beta = greek-uppercase ctx 0x1D6E3 0x1D71D 0x0392 0x1D6A9 - val math ctx \Gamma = greek-uppercase ctx 0x1D6E4 0x1D71E 0x0393 0x1D6AA - val math ctx \Delta = greek-uppercase ctx 0x1D6E5 0x1D71F 0x0394 0x1D6AB - val math ctx \Epsilon = greek-uppercase ctx 0x1D6E6 0x1D720 0x0395 0x1D6AC - val math ctx \Zeta = greek-uppercase ctx 0x1D6E7 0x1D721 0x0396 0x1D6AD - val math ctx \Eta = greek-uppercase ctx 0x1D6E8 0x1D722 0x0397 0x1D6AE - val math ctx \Theta = greek-uppercase ctx 0x1D6E9 0x1D723 0x0398 0x1D6AF - val math ctx \Iota = greek-uppercase ctx 0x1D6EA 0x1D724 0x0399 0x1D6B0 - val math ctx \Kappa = greek-uppercase ctx 0x1D6EB 0x1D725 0x039A 0x1D6B1 - val math ctx \Lambda = greek-uppercase ctx 0x1D6EC 0x1D726 0x039B 0x1D6B2 - val math ctx \Mu = greek-uppercase ctx 0x1D6ED 0x1D727 0x039C 0x1D6B3 - val math ctx \Nu = greek-uppercase ctx 0x1D6EE 0x1D728 0x039D 0x1D6B4 - val math ctx \Xi = greek-uppercase ctx 0x1D6EF 0x1D729 0x039E 0x1D6B5 - val math ctx \Omicron = greek-uppercase ctx 0x1D6F0 0x1D72A 0x039F 0x1D6B6 - val math ctx \Pi = greek-uppercase ctx 0x1D6F1 0x1D72B 0x03A0 0x1D6B7 - val math ctx \Rho = greek-uppercase ctx 0x1D6F2 0x1D72C 0x03A1 0x1D6B8 - val math ctx \Sigma = greek-uppercase ctx 0x1D6F4 0x1D72E 0x03A3 0x1D6BA - val math ctx \Tau = greek-uppercase ctx 0x1D6F5 0x1D72F 0x03A4 0x1D6BB - val math ctx \Upsilon = greek-uppercase ctx 0x1D6F6 0x1D730 0x03A5 0x1D6BC - val math ctx \Phi = greek-uppercase ctx 0x1D6F7 0x1D731 0x03A6 0x1D6BD - val math ctx \Chi = greek-uppercase ctx 0x1D6F8 0x1D732 0x03A7 0x1D6BE - val math ctx \Psi = greek-uppercase ctx 0x1D6F9 0x1D733 0x03A8 0x1D6BF - val math ctx \Omega = greek-uppercase ctx 0x1D6FA 0x1D734 0x03A9 0x1D6C0 val ord ctx = math-char ctx MathOrd val bin ctx = math-char ctx MathBin diff --git a/src/backend/horzBox.ml b/src/backend/horzBox.ml index 48094edbb..b4d1d8c71 100644 --- a/src/backend/horzBox.ml +++ b/src/backend/horzBox.ml @@ -143,32 +143,15 @@ type math_char_class = | MathFraktur | MathBoldFraktur | MathDoubleStruck + | MathSansSerif + | MathBoldSansSerif + | MathItalicSansSerif + | MathBoldItalicSansSerif + | MathTypewriter [@@deriving show { with_path = false }] -(* TEMPORARY; should add more *) -type math_variant_style = - { - math_italic : Uchar.t list; - math_bold_italic : Uchar.t list; - math_roman : Uchar.t list; - math_bold_roman : Uchar.t list; - math_script : Uchar.t list; - math_bold_script : Uchar.t list; - math_fraktur : Uchar.t list; - math_bold_fraktur : Uchar.t list; - math_double_struck : Uchar.t list; - } - -let pp_math_variant_style = - (fun fmt _ -> Format.fprintf fmt "") - - -module MathVariantCharMap = Map.Make - (struct - type t = Uchar.t * math_char_class - let compare = Pervasives.compare - end) +module MathVariantCharMap = Map.Make(Uchar) module MathClassMap = Map.Make(Uchar) @@ -199,6 +182,9 @@ type math_script_level = | ScriptScriptLevel [@@deriving show { with_path = false; }] +type math_variant_char_map = + (math_char_class -> Uchar.t * math_kind) MathVariantCharMap.t + type context_main = { hyphen_dictionary : LoadHyph.t; [@printer (fun fmt _ -> Format.fprintf fmt "")] @@ -226,7 +212,7 @@ type context_main = { text_color : color; manual_rising : length; space_badness : pure_badness; - math_variant_char_map : (Uchar.t * math_kind) MathVariantCharMap.t; + math_variant_char_map : math_variant_char_map; [@printer (fun fmt _ -> Format.fprintf fmt "")] math_class_map : (Uchar.t * math_kind) MathClassMap.t; [@printer (fun fmt _ -> Format.fprintf fmt "")] @@ -402,19 +388,6 @@ and math_char_kern_func = length -> length -> length and math_kern_func = length -> length (* -- takes a y-position as a correction height and then returns a kerning value -- *) -and math_variant_value = math_kind * math_variant_value_main - -and math_variant_value_main = - | MathVariantToChar of bool * Uchar.t list - [@printer (fun fmt _ -> Format.fprintf fmt "")] - (* -- - (1) whether it is big or not - (2) contents - -- *) - - | MathVariantToCharWithKern of bool * Uchar.t list * math_char_kern_func * math_char_kern_func - [@printer (fun fmt _ -> Format.fprintf fmt "")] - and radical = length -> length -> length -> length -> color -> horz_box list (* -- 'radical': diff --git a/src/frontend/evalUtil.ml b/src/frontend/evalUtil.ml index 4737267a7..e202d3a68 100644 --- a/src/frontend/evalUtil.ml +++ b/src/frontend/evalUtil.ml @@ -276,31 +276,42 @@ let make_language_system_value langsys = let get_math_char_class (value : syntactic_value) : HorzBox.math_char_class = + let open HorzBox in match value with - | Constructor("MathItalic" , BaseConstant(BCUnit)) -> HorzBox.MathItalic - | Constructor("MathBoldItalic" , BaseConstant(BCUnit)) -> HorzBox.MathBoldItalic - | Constructor("MathRoman" , BaseConstant(BCUnit)) -> HorzBox.MathRoman - | Constructor("MathBoldRoman" , BaseConstant(BCUnit)) -> HorzBox.MathBoldRoman - | Constructor("MathScript" , BaseConstant(BCUnit)) -> HorzBox.MathScript - | Constructor("MathBoldScript" , BaseConstant(BCUnit)) -> HorzBox.MathBoldScript - | Constructor("MathFraktur" , BaseConstant(BCUnit)) -> HorzBox.MathFraktur - | Constructor("MathBoldFraktur" , BaseConstant(BCUnit)) -> HorzBox.MathBoldFraktur - | Constructor("MathDoubleStruck", BaseConstant(BCUnit)) -> HorzBox.MathDoubleStruck - | _ -> report_bug_value "get_math_char_class" value + | Constructor("MathItalic" , BaseConstant(BCUnit)) -> MathItalic + | Constructor("MathBoldItalic" , BaseConstant(BCUnit)) -> MathBoldItalic + | Constructor("MathRoman" , BaseConstant(BCUnit)) -> MathRoman + | Constructor("MathBoldRoman" , BaseConstant(BCUnit)) -> MathBoldRoman + | Constructor("MathScript" , BaseConstant(BCUnit)) -> MathScript + | Constructor("MathBoldScript" , BaseConstant(BCUnit)) -> MathBoldScript + | Constructor("MathFraktur" , BaseConstant(BCUnit)) -> MathFraktur + | Constructor("MathBoldFraktur" , BaseConstant(BCUnit)) -> MathBoldFraktur + | Constructor("MathDoubleStruck" , BaseConstant(BCUnit)) -> MathDoubleStruck + | Constructor("MathSansSerif" , BaseConstant(BCUnit)) -> MathSansSerif + | Constructor("MathBoldSansSerif" , BaseConstant(BCUnit)) -> MathBoldSansSerif + | Constructor("MathItalicSansSerif" , BaseConstant(BCUnit)) -> MathItalicSansSerif + | Constructor("MathBoldItalicSansSerif", BaseConstant(BCUnit)) -> MathBoldItalicSansSerif + | Constructor("MathTypewriter" , BaseConstant(BCUnit)) -> MathTypewriter + | _ -> report_bug_value "get_math_char_class" value let make_math_char_class (mccls : HorzBox.math_char_class) : syntactic_value = + let open HorzBox in match mccls with - | HorzBox.MathItalic -> Constructor("MathItalic" , BaseConstant(BCUnit)) - | HorzBox.MathBoldItalic -> Constructor("MathBoldItalic" , BaseConstant(BCUnit)) - | HorzBox.MathRoman -> Constructor("MathRoman" , BaseConstant(BCUnit)) - | HorzBox.MathBoldRoman -> Constructor("MathBoldRoman" , BaseConstant(BCUnit)) - | HorzBox.MathScript -> Constructor("MathScript" , BaseConstant(BCUnit)) - | HorzBox.MathBoldScript -> Constructor("MathBoldScript" , BaseConstant(BCUnit)) - | HorzBox.MathFraktur -> Constructor("MathFraktur" , BaseConstant(BCUnit)) - | HorzBox.MathBoldFraktur -> Constructor("MathBoldFraktur" , BaseConstant(BCUnit)) - | HorzBox.MathDoubleStruck -> Constructor("MathDoubleStruck", BaseConstant(BCUnit)) - + | MathItalic -> Constructor("MathItalic" , BaseConstant(BCUnit)) + | MathBoldItalic -> Constructor("MathBoldItalic" , BaseConstant(BCUnit)) + | MathRoman -> Constructor("MathRoman" , BaseConstant(BCUnit)) + | MathBoldRoman -> Constructor("MathBoldRoman" , BaseConstant(BCUnit)) + | MathScript -> Constructor("MathScript" , BaseConstant(BCUnit)) + | MathBoldScript -> Constructor("MathBoldScript" , BaseConstant(BCUnit)) + | MathFraktur -> Constructor("MathFraktur" , BaseConstant(BCUnit)) + | MathBoldFraktur -> Constructor("MathBoldFraktur" , BaseConstant(BCUnit)) + | MathDoubleStruck -> Constructor("MathDoubleStruck" , BaseConstant(BCUnit)) + | MathSansSerif -> Constructor("MathSansSerif" , BaseConstant(BCUnit)) + | MathBoldSansSerif -> Constructor("MathBoldSansSerif" , BaseConstant(BCUnit)) + | MathItalicSansSerif -> Constructor("MathItalicSansSerif" , BaseConstant(BCUnit)) + | MathBoldItalicSansSerif -> Constructor("MathBoldItalicSansSerif", BaseConstant(BCUnit)) + | MathTypewriter -> Constructor("MathTypewriter" , BaseConstant(BCUnit)) let get_math_class (value : syntactic_value) = let open HorzBox in @@ -443,56 +454,6 @@ let get_prepath (value : syntactic_value) : PrePath.t = | _ -> report_bug_value "get_prepath" value -let get_math_variant_style value = - let rcd = - match value with - | RecordValue(rcd) -> rcd - | _ -> report_bug_value "get_math_variant_style: not a record" value - in - match - ( rcd |> LabelMap.find_opt "italic", - rcd |> LabelMap.find_opt "bold-italic", - rcd |> LabelMap.find_opt "roman", - rcd |> LabelMap.find_opt "bold-roman", - rcd |> LabelMap.find_opt "script", - rcd |> LabelMap.find_opt "bold-script", - rcd |> LabelMap.find_opt "fraktur", - rcd |> LabelMap.find_opt "bold-fraktur", - rcd |> LabelMap.find_opt "double-struck" ) - with - | ( Some(vcpI), - Some(vcpBI), - Some(vcpR), - Some(vcpBR), - Some(vcpS), - Some(vcpBS), - Some(vcpF), - Some(vcpBF), - Some(vcpDS) ) -> - let uchlstI = get_uchar_list vcpI in - let uchlstBI = get_uchar_list vcpBI in - let uchlstR = get_uchar_list vcpR in - let uchlstBR = get_uchar_list vcpBR in - let uchlstS = get_uchar_list vcpS in - let uchlstBS = get_uchar_list vcpBS in - let uchlstF = get_uchar_list vcpF in - let uchlstBF = get_uchar_list vcpBF in - let uchlstDS = get_uchar_list vcpDS in - HorzBox.({ - math_italic = uchlstI ; - math_bold_italic = uchlstBI; - math_roman = uchlstR ; - math_bold_roman = uchlstBR; - math_script = uchlstS ; - math_bold_script = uchlstBS; - math_fraktur = uchlstF ; - math_bold_fraktur = uchlstBF; - math_double_struck = uchlstDS; - }) - - | _ -> report_bug_value "get_math_variant_style: missing some fields" value - - let get_outline (value : syntactic_value) = match value with | Tuple([ @@ -526,6 +487,15 @@ let make_context (ictx : input_context) : syntactic_value = Context(ictx) +let make_math_variant_char_selector (reducef : syntactic_value -> syntactic_value list -> syntactic_value) (value_selector : syntactic_value) = + (fun mccls -> + let value_mccls = make_math_char_class mccls in + let value_ret = reducef value_selector [ value_mccls ] in + let (cp_to, mk) = get_pair get_int get_math_class value_ret in + (Uchar.of_int cp_to, mk) + ) + + let make_page_break_info pbinfo = let asc = LabelMap.singleton "page-number" (BaseConstant(BCInt(pbinfo.HorzBox.current_page_number))) diff --git a/src/frontend/primitives.cppo.ml b/src/frontend/primitives.cppo.ml index 0ac45204e..8856b76ff 100644 --- a/src/frontend/primitives.cppo.ml +++ b/src/frontend/primitives.cppo.ml @@ -96,23 +96,6 @@ let make_row kts = ) RowEmpty -let tMCSTY = - let row = - [ - "italic"; - "bold-italic"; - "roman"; - "bold-roman"; - "script"; - "bold-script"; - "fraktur"; - "bold-fraktur"; - "double-struck"; - ] |> List.map (fun k -> (k, tS)) |> make_row - in - (~! "math-char-style", RecordType(row)) - - let tDOCINFODIC = let row = make_row [ @@ -241,15 +224,20 @@ let add_general_default_types (tyenvmid : Typeenv.t) : Typeenv.t = ("MathInner" , no_parameter); ]); ("math-char-class", vid_mccls, 0, [ - ("MathItalic" , no_parameter); - ("MathBoldItalic" , no_parameter); - ("MathRoman" , no_parameter); - ("MathBoldRoman" , no_parameter); - ("MathScript" , no_parameter); - ("MathBoldScript" , no_parameter); - ("MathFraktur" , no_parameter); - ("MathBoldFraktur" , no_parameter); - ("MathDoubleStruck", no_parameter); + ("MathItalic" , no_parameter); + ("MathBoldItalic" , no_parameter); + ("MathRoman" , no_parameter); + ("MathBoldRoman" , no_parameter); + ("MathScript" , no_parameter); + ("MathBoldScript" , no_parameter); + ("MathFraktur" , no_parameter); + ("MathBoldFraktur" , no_parameter); + ("MathDoubleStruck" , no_parameter); + ("MathSansSerif" , no_parameter); + ("MathBoldSansSerif" , no_parameter); + ("MathItalicSansSerif" , no_parameter); + ("MathBoldItalicSansSerif", no_parameter); + ("MathTypewriter" , no_parameter); ]); ] @@ -416,122 +404,188 @@ let default_radical hgt_bar t_bar dpt fontsize color = let code_point cp = Uchar.of_int cp -let default_math_variant_char_map : (Uchar.t * HorzBox.math_kind) HorzBox.MathVariantCharMap.t = +let default_math_variant_char_map : HorzBox.math_variant_char_map = let open HorzBox in - List.fold_left (fun map (uchfrom, mccls, uchto) -> - map |> MathVariantCharMap.add (uchfrom, mccls) (uchto, HorzBox.MathOrdinary) - ) MathVariantCharMap.empty - (List.concat [ - - (* -- Latin capital letter to its normal italic -- *) - (range 0 25) |> List.map (fun i -> - (ascii_capital_of_index i, MathItalic, code_point (0x1D434 + i))); - (* -- Latin small letter to its normal italic -- *) - (List.append (range 0 6) (range 8 25)) |> List.map (fun i -> - (ascii_small_of_index i, MathItalic, code_point (0x1D44E + i))); - [(uchar_of_char 'h', MathItalic, code_point 0x210E)]; - - (* -- Latin capital letter to its bold italic -- *) - (range 0 25) |> List.map (fun i -> - (ascii_capital_of_index i, MathBoldItalic, code_point (0x1D468 + i))); - (* -- Latin small letter to its bold italic -- *) - (range 0 25) |> List.map (fun i -> - (ascii_small_of_index i, MathBoldItalic, code_point (0x1D482 + i))); - - (* -- Latin capital letter to its roman -- *) - (range 0 25) |> List.map (fun i -> - (ascii_capital_of_index i, MathRoman, code_point (Char.code 'A' + i))); - (* -- Latin small letter to its roman -- *) - (range 0 25) |> List.map (fun i -> - (ascii_small_of_index i, MathRoman, code_point (Char.code 'a' + i))); - - (* -- Latin capital letter to its bold romain -- *) - (range 0 25) |> List.map (fun i -> - (ascii_capital_of_index i, MathBoldRoman, code_point (0x1D400 + i))); - (* -- Latin small letter to its bold roman -- *) - (range 0 25) |> List.map (fun i -> - (ascii_small_of_index i, MathBoldRoman, code_point (0x1D41A + i))); - - (* -- Latin capital letter to its script -- *) - [[0]; [2; 3]; [6]; [9; 10]; range 13 16; range 18 25] |> List.concat |> List.map (fun i -> - (ascii_capital_of_index i, MathScript, code_point (0x1D49C + i))); - [ - (uchar_of_char 'B', MathScript, code_point 0x212C); - (uchar_of_char 'E', MathScript, code_point 0x2130); - (uchar_of_char 'F', MathScript, code_point 0x2131); - (uchar_of_char 'H', MathScript, code_point 0x210B); - (uchar_of_char 'I', MathScript, code_point 0x2110); - (uchar_of_char 'L', MathScript, code_point 0x2112); - (uchar_of_char 'M', MathScript, code_point 0x2133); - (uchar_of_char 'R', MathScript, code_point 0x211B); - ]; - (* -- Latin small letter to its script -- *) - [range 0 3; [5]; range 7 13; range 15 25] |> List.concat |> List.map (fun i -> - (ascii_small_of_index i, MathScript, code_point (0x1D4B6 + i))); - [ - (uchar_of_char 'e', MathScript, code_point 0x212F); - (uchar_of_char 'g', MathScript, code_point 0x210A); - (uchar_of_char 'o', MathScript, code_point 0x2134); - ]; - - (* -- Latin capital letter to its bold script -- *) - (range 0 25) |> List.map (fun i -> - (ascii_capital_of_index i, MathBoldScript, code_point (0x1D4D0 + i))); - (* -- Latin small letter to its bold script -- *) - (range 0 25) |> List.map (fun i -> - (ascii_small_of_index i, MathBoldScript, code_point (0x1D4EA + i))); - - (* -- Latin capital letter to its Fraktur -- *) - [[0; 1]; range 3 6; range 9 16; range 18 24] |> List.concat |> List.map (fun i -> - (ascii_capital_of_index i, MathFraktur, code_point (0x1D504 + i))); - [ - (uchar_of_char 'C', MathFraktur, code_point 0x212D); - (uchar_of_char 'H', MathFraktur, code_point 0x210C); - (uchar_of_char 'I', MathFraktur, code_point 0x2111); - (uchar_of_char 'R', MathFraktur, code_point 0x211C); - (uchar_of_char 'Z', MathFraktur, code_point 0x2128); - ]; - (* -- Latin small letter to its Fraktur -- *) - (range 0 25) |> List.map (fun i -> - (ascii_small_of_index i, MathFraktur, code_point (0x1D51E + i))); - - (* -- Latin capital letter to its bold Fraktur -- *) - (range 0 25) |> List.map (fun i -> - (ascii_capital_of_index i, MathBoldFraktur, code_point (0x1D56C + i))); - (* -- Latin small letter to its bold Fraktur -- *) - (range 0 25) |> List.map (fun i -> - (ascii_small_of_index i, MathBoldFraktur, code_point (0x1D586 + i))); - - (* -- Latin capital letter to its double struck -- *) - [[0; 1]; range 3 6; range 8 12; [14]; range 18 24] |> List.concat |> List.map (fun i -> - (ascii_capital_of_index i, MathDoubleStruck, code_point (0x1D538 + i))); - [ - (uchar_of_char 'C', MathDoubleStruck, code_point 0x2102); - (uchar_of_char 'H', MathDoubleStruck, code_point 0x210D); - (uchar_of_char 'N', MathDoubleStruck, code_point 0x2115); - (uchar_of_char 'P', MathDoubleStruck, code_point 0x2119); - (uchar_of_char 'Q', MathDoubleStruck, code_point 0x211A); - (uchar_of_char 'R', MathDoubleStruck, code_point 0x211D); - (uchar_of_char 'Z', MathDoubleStruck, code_point 0x2124); - ]; - (* -- Latin small letter to its double struck -- *) - (range 0 25) |> List.map (fun i -> - (ascii_small_of_index i, MathDoubleStruck, code_point (0x1D552 + i))); - - - (* -- Digit to its boldface -- *) - (range 0 9) |> List.concat_map (fun i -> - [ - (ascii_digit_of_index i, MathBoldItalic, code_point (0x1D7CE + i)); - (ascii_digit_of_index i, MathBoldRoman, code_point (0x1D7CE + i)); - (ascii_digit_of_index i, MathBoldScript, code_point (0x1D7CE + i)); - (ascii_digit_of_index i, MathBoldFraktur, code_point (0x1D7CE + i)); - ]); - - (* -- Digit to its double struck -- *) - (range 0 9) |> List.map (fun i -> - (ascii_digit_of_index i, MathDoubleStruck, code_point (0x1D7D8 + i))); - ]) + let map = MathVariantCharMap.empty in + + (* Adds Latin capital letters: *) + let map = + (range 0 25) |> List.fold_left (fun map i -> + let uch_from = ascii_capital_of_index i in + let uch_italic = code_point (0x1D434 + i) in + let uch_bold_italic = code_point (0x1D468 + i) in + let uch_roman = code_point (Char.code 'A' + i) in + let uch_bold_roman = code_point (0x1D400 + i) in + let uch_script = + if Uchar.equal uch_from (uchar_of_char 'B') then + code_point 0x212C + else if Uchar.equal uch_from (uchar_of_char 'E') then + code_point 0x2130 + else if Uchar.equal uch_from (uchar_of_char 'F') then + code_point 0x2131 + else if Uchar.equal uch_from (uchar_of_char 'H') then + code_point 0x210B + else if Uchar.equal uch_from (uchar_of_char 'I') then + code_point 0x2110 + else if Uchar.equal uch_from (uchar_of_char 'L') then + code_point 0x2112 + else if Uchar.equal uch_from (uchar_of_char 'M') then + code_point 0x2133 + else if Uchar.equal uch_from (uchar_of_char 'R') then + code_point 0x211B + else + code_point (0x1D49C + i) + in + let uch_bold_script = code_point (0x1D4D0 + i) in + let uch_fraktur = + if Uchar.equal uch_from (uchar_of_char 'C') then + code_point 0x212D + else if Uchar.equal uch_from (uchar_of_char 'H') then + code_point 0x210C + else if Uchar.equal uch_from (uchar_of_char 'I') then + code_point 0x2111 + else if Uchar.equal uch_from (uchar_of_char 'R') then + code_point 0x211C + else if Uchar.equal uch_from (uchar_of_char 'Z') then + code_point 0x2128 + else + code_point (0x1D504 + i) + in + let uch_bold_fraktur = code_point (0x1D56C + i) in + let uch_double_struck = + if Uchar.equal uch_from (uchar_of_char 'C') then + code_point 0x2102 + else if Uchar.equal uch_from (uchar_of_char 'H') then + code_point 0x210D + else if Uchar.equal uch_from (uchar_of_char 'N') then + code_point 0x2115 + else if Uchar.equal uch_from (uchar_of_char 'P') then + code_point 0x2119 + else if Uchar.equal uch_from (uchar_of_char 'Q') then + code_point 0x211A + else if Uchar.equal uch_from (uchar_of_char 'R') then + code_point 0x211D + else if Uchar.equal uch_from (uchar_of_char 'Z') then + code_point 0x2124 + else + code_point (0x1D538 + i) + in + let uch_sans_serif = code_point (0x1D5A0 + i) in + let uch_bold_sans_serif = code_point (0x1D5D4 + i) in + let uch_italic_sans_serif = code_point (0x1D608 + i) in + let uch_bold_italic_sans_serif = code_point (0x1D63C + i) in + let uch_typewriter = code_point (0x1D670 + i) in + map |> MathVariantCharMap.add uch_from (function + | MathItalic -> (uch_italic, MathOrdinary) + | MathBoldItalic -> (uch_bold_italic, MathOrdinary) + | MathRoman -> (uch_roman, MathOrdinary) + | MathBoldRoman -> (uch_bold_roman, MathOrdinary) + | MathScript -> (uch_script, MathOrdinary) + | MathBoldScript -> (uch_bold_script, MathOrdinary) + | MathFraktur -> (uch_fraktur, MathOrdinary) + | MathBoldFraktur -> (uch_bold_fraktur, MathOrdinary) + | MathDoubleStruck -> (uch_double_struck, MathOrdinary) + | MathSansSerif -> (uch_sans_serif, MathOrdinary) + | MathBoldSansSerif -> (uch_bold_sans_serif, MathOrdinary) + | MathItalicSansSerif -> (uch_italic_sans_serif, MathOrdinary) + | MathBoldItalicSansSerif -> (uch_bold_italic_sans_serif, MathOrdinary) + | MathTypewriter -> (uch_typewriter, MathOrdinary) + ) + ) map + in + + (* Adds Latin small letters: *) + let map = + (range 0 25) |> List.fold_left (fun map i -> + let uch_from = ascii_small_of_index i in + let uch_italic = + if Uchar.equal uch_from (uchar_of_char 'h') then + code_point 0x210E + else + code_point (0x1D44E + i) + in + let uch_bold_italic = code_point (0x1D482 + i) in + let uch_roman = code_point (Char.code 'a' + i) in + let uch_bold_roman = code_point (0x1D41A + i) in + let uch_script = + if Uchar.equal uch_from (uchar_of_char 'e') then + code_point 0x212F + else if Uchar.equal uch_from (uchar_of_char 'g') then + code_point 0x210A + else if Uchar.equal uch_from (uchar_of_char 'o') then + code_point 0x2134 + else + code_point (0x1D4B6 + i) + in + let uch_bold_script = code_point (0x1D4EA + i) in + let uch_fraktur = code_point (0x1D51E + i) in + let uch_bold_fraktur = code_point (0x1D586 + i) in + let uch_double_struck = code_point (0x1D552 + i) in + let uch_sans_serif = code_point (0x1D5BA + i) in + let uch_bold_sans_serif = code_point (0x1D5EE + i) in + let uch_italic_sans_serif = code_point (0x1D622 + i) in + let uch_bold_italic_sans_serif = code_point (0x1D656 + i) in + let uch_typewriter = code_point (0x1D68A + i) in + map |> MathVariantCharMap.add uch_from (function + | MathItalic -> (uch_italic, MathOrdinary) + | MathBoldItalic -> (uch_bold_italic, MathOrdinary) + | MathRoman -> (uch_roman, MathOrdinary) + | MathBoldRoman -> (uch_bold_roman, MathOrdinary) + | MathScript -> (uch_script, MathOrdinary) + | MathBoldScript -> (uch_bold_script, MathOrdinary) + | MathFraktur -> (uch_fraktur, MathOrdinary) + | MathBoldFraktur -> (uch_bold_fraktur, MathOrdinary) + | MathDoubleStruck -> (uch_double_struck, MathOrdinary) + | MathSansSerif -> (uch_sans_serif, MathOrdinary) + | MathBoldSansSerif -> (uch_bold_sans_serif, MathOrdinary) + | MathItalicSansSerif -> (uch_italic_sans_serif, MathOrdinary) + | MathBoldItalicSansSerif -> (uch_bold_italic_sans_serif, MathOrdinary) + | MathTypewriter -> (uch_typewriter, MathOrdinary) + ) + ) map + in + + (* Adds digits: *) + let map = + (range 0 9) |> List.fold_left (fun map i -> + let uch_from = ascii_digit_of_index i in + + let uch_roman = uch_from in + let uch_bold_roman = code_point (0x1D7CE + i) in + let uch_double_struck = code_point (0x1D7D8 + i) in + let uch_sans_serif = code_point (0x1D7E2 + i) in + let uch_bold_sans_serif = code_point (0x1D7EC + i) in + let uch_typewriter = code_point (0x1D7F6 + i) in + + let uch_italic = uch_from in + let uch_bold_italic = uch_bold_roman in + let uch_bold_script = uch_bold_roman in + let uch_script = uch_from in + let uch_fraktur = uch_from in + let uch_bold_fraktur = uch_bold_roman in + let uch_italic_sans_serif = uch_sans_serif in + let uch_bold_italic_sans_serif = uch_bold_sans_serif in + + map |> MathVariantCharMap.add uch_from (function + | MathItalic -> (uch_italic, MathOrdinary) + | MathBoldItalic -> (uch_bold_italic, MathOrdinary) + | MathRoman -> (uch_roman, MathOrdinary) + | MathBoldRoman -> (uch_bold_roman, MathOrdinary) + | MathScript -> (uch_script, MathOrdinary) + | MathBoldScript -> (uch_bold_script, MathOrdinary) + | MathFraktur -> (uch_fraktur, MathOrdinary) + | MathBoldFraktur -> (uch_bold_fraktur, MathOrdinary) + | MathDoubleStruck -> (uch_double_struck, MathOrdinary) + | MathSansSerif -> (uch_sans_serif, MathOrdinary) + | MathBoldSansSerif -> (uch_bold_sans_serif, MathOrdinary) + | MathItalicSansSerif -> (uch_italic_sans_serif, MathOrdinary) + | MathBoldItalicSansSerif -> (uch_bold_italic_sans_serif, MathOrdinary) + | MathTypewriter -> (uch_typewriter, MathOrdinary) + ) + ) map + in + + map let default_math_class_map = diff --git a/src/frontend/types.cppo.ml b/src/frontend/types.cppo.ml index 35dd6eb0e..6cda88589 100644 --- a/src/frontend/types.cppo.ml +++ b/src/frontend/types.cppo.ml @@ -1421,18 +1421,19 @@ module MathContext let convert_math_variant_char ((ctx, _) : input_context) (uch : Uchar.t) = let open HorzBox in - let mcclsmap = ctx.math_variant_char_map in - let mccls = ctx.math_char_class in - let mkmap = ctx.math_class_map in - match mkmap |> HorzBox.MathClassMap.find_opt uch with - | Some(uchaft, mk) -> - (mk, uchaft) + match ctx.math_class_map |> HorzBox.MathClassMap.find_opt uch with + | Some((uch_after, mk)) -> + (mk, uch_after) | None -> begin - match mcclsmap |> HorzBox.MathVariantCharMap.find_opt (uch, mccls) with - | Some((uchaft, mk)) -> (mk, uchaft) - | None -> (MathOrdinary, uch) + match ctx.math_variant_char_map |> HorzBox.MathVariantCharMap.find_opt uch with + | Some(f) -> + let (uch_after, mk) = f ctx.math_char_class in + (mk, uch_after) + + | None -> + (MathOrdinary, uch) end diff --git a/tests/Makefile b/tests/Makefile index dce26e81b..17b20efcc 100644 --- a/tests/Makefile +++ b/tests/Makefile @@ -2,6 +2,7 @@ TARGETS = \ clip.pdf \ glue1.pdf \ math2.pdf \ + math-typefaces.pdf \ refactor1.pdf \ refactor2.pdf \ refactor3.pdf \ diff --git a/tests/math-typefaces.saty b/tests/math-typefaces.saty new file mode 100644 index 000000000..617bb29ba --- /dev/null +++ b/tests/math-typefaces.saty @@ -0,0 +1,52 @@ +@require: stdjareport +@require: itemize + +let open Pervasives in +let open Math in +let open Itemize in +let open StdJaReport in + +let block ctx +test-math-style name style = + let it = embed-string name in + read-block ctx '< + +p{ + #it;: + } + +p{ + ${\math-style!(style){abcdefghijklmnopqrstuvwxyz}} + ${\math-style!(style){ABCDEFGHIJKLMNOPQRSTUVWXYZ}} + } + +p{ + ${\math-style!(style){\alpha\beta\gamma\delta\epsilon\zeta\eta\theta\iota\kappa\lambda\mu\nu\xi\omicron\pi\rho\sigma\tau\upsilon\phi\chi\psi\omega}} + ${\math-style!(style){\Alpha\Beta\Gamma\Delta\Epsilon\Zeta\Eta\Theta\Iota\Kappa\Lambda\Mu\Nu\Xi\Omicron\Pi\Rho\Sigma\Tau\Upsilon\Phi\Chi\Psi\Omega}} + } + > +in +document (| + title = {\SATySFi;}, + author = {}, +|) '< + +section{Math char classes}< + +test-math-style(`Roman`)(MathRoman); + +test-math-style(`Bold`)(MathBoldRoman); + +test-math-style(`Italic`)(MathItalic); + +test-math-style(`Bold Italic`)(MathBoldItalic); + +test-math-style(`Script`)(MathScript); + +test-math-style(`Bold Script`)(MathBoldScript); + +test-math-style(`Fraktur`)(MathFraktur); + +test-math-style(`Bold Fraktur`)(MathBoldFraktur); + +test-math-style(`Double Struck`)(MathDoubleStruck); + +test-math-style(`Sans Serif`)(MathSansSerif); + +test-math-style(`Bold Sans Serif`)(MathBoldSansSerif); + +test-math-style(`Italic Sans Serif`)(MathItalicSansSerif); + +test-math-style(`Bold Italic Sans Serif`)(MathBoldItalicSansSerif); + +test-math-style(`Typewriter`)(MathTypewriter); + > + +section{Math font commands}< + +listing{ + * ${\mathtt{mathtt}} + * ${\mathit{mathit}} + * ${\mathsf{mathsf}} + } + > +> diff --git a/tools/gencode/vminst.ml b/tools/gencode/vminst.ml index 2edcf01b5..f7180d43b 100644 --- a/tools/gencode/vminst.ml +++ b/tools/gencode/vminst.ml @@ -35,24 +35,26 @@ make_string (s1 ^ s2) |} ; inst "PrimitiveSetMathVariantToChar" ~name:"set-math-variant-char" - ~type_:Type.(tMCCLS @-> tI @-> tI @-> tCTX @-> tCTX) + ~type_:Type.(tI @-> (tMCCLS @-> tI) @-> tCTX @-> tCTX) ~fields:[ ] ~params:[ - param "mccls" ~type_:"math_char_class"; - param "cpfrom" ~type_:"int"; - param "cpto" ~type_:"int"; + param "cp_from" ~type_:"int"; + param "value_selector"; param "(ctx, ctxsub)" ~type_:"context"; ] ~is_pdf_mode_primitive:true ~is_text_mode_primitive:true + ~needs_reducef:true ~code:{| -let uchfrom = Uchar.of_int cpfrom in -let uchto = Uchar.of_int cpto in -let mcclsmap = ctx.HorzBox.math_variant_char_map in -Context(HorzBox.({ ctx with - math_variant_char_map = mcclsmap |> MathVariantCharMap.add (uchfrom, mccls) (uchto, MathOrdinary); -}), ctxsub) +let uch_from = Uchar.of_int cp_from in +let selector = make_math_variant_char_selector (reducef ~msg:"set-math-variant-char") value_selector in +let ctx = + HorzBox.({ ctx with + math_variant_char_map = ctx.math_variant_char_map |> MathVariantCharMap.add uch_from selector; + }) +in +make_context (ctx, ctxsub) |} ; inst "PrimitiveSetMathChar" ~name:"set-math-char"