-- |
-- Module:     Typograffiti.Rich
-- Copyright:  (c) 2023 Adrian Cochrane
-- License:    MIT
-- Maintainer: Schell Scivally <schell@takt.com>
--             & Adrian Cochrane <alcinnz@argonaut-constellation.org>
--
-- Abstraction for building richtext strings to be rendered via Typograffiti.
--
module Typograffiti.Rich where
import           Data.Text.Lazy     (Text, append, pack)
import qualified Data.Text.Lazy as  Txt
import           Data.Text.Glyphize (Feature(..), tag_from_string, parseFeature)
import           Data.String        (IsString(..))
import           Data.Word          (Word32)

-- | Retreives the length of some text as a `Word` suitable for storing in a `Feature`.
length' :: Text -> Word
length' :: Text -> Word
length' = Int -> Word
forall a. Enum a => Int -> a
toEnum (Int -> Word) -> (Text -> Int) -> Text -> Word
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Int
forall a. Enum a => a -> Int
fromEnum (Int64 -> Int) -> (Text -> Int64) -> Text -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Int64
Txt.length

-- | Styled text to be rendered.
data RichText = RichText {
    RichText -> Text
text :: Text,
    RichText -> [Feature]
features :: [Feature]
}

instance IsString RichText where
    fromString :: String -> RichText
fromString String
x = (Text -> [Feature] -> RichText) -> [Feature] -> Text -> RichText
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> [Feature] -> RichText
RichText [] (Text -> RichText) -> Text -> RichText
forall a b. (a -> b) -> a -> b
$ String -> Text
pack String
x
-- | Converts a `String` to renderable `RichText`.
str :: String -> RichText
str :: String -> RichText
str = String -> RichText
forall a. IsString a => String -> a
fromString
-- | Converts `Text` to renderable `RichText`.
txt :: Text -> RichText
txt :: Text -> RichText
txt = (Text -> [Feature] -> RichText) -> [Feature] -> Text -> RichText
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> [Feature] -> RichText
RichText []

-- | Concatenate richtext data.
($$) :: RichText -> RichText -> RichText
RichText Text
ltext [Feature]
lfeat $$ :: RichText -> RichText -> RichText
$$ RichText Text
rtext [Feature]
rfeat = RichText :: Text -> [Feature] -> RichText
RichText {
    text :: Text
text = Text -> Text -> Text
append Text
ltext Text
rtext,
    features :: [Feature]
features = let n :: Word
n = Text -> Word
length' Text
ltext in [Feature]
lfeat [Feature] -> [Feature] -> [Feature]
forall a. [a] -> [a] -> [a]
++ [
        Feature
feat { featStart :: Word
featStart = Word
start Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
n, featEnd :: Word
featEnd = Word
end Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
n }
        | feat :: Feature
feat@Feature { featStart :: Feature -> Word
featStart = Word
start, featEnd :: Feature -> Word
featEnd = Word
end } <- [Feature]
rfeat]
  }

-- | Applies the given OpenType Feature to the given `RichText`.
-- Check your font for details on which OpenType features are supported.
-- Or see https://learn.microsoft.com/en-us/typography/opentype/spec/featurelist/
-- (from which much of this documentation is taken).
style :: String -> Word32 -> RichText -> RichText
style :: String -> Word32 -> RichText -> RichText
style String
feat Word32
value (RichText Text
text [Feature]
feats) = RichText :: Text -> [Feature] -> RichText
RichText {
    text :: Text
text = Text
text,
    features :: [Feature]
features = Word32 -> Word32 -> Word -> Word -> Feature
Feature (String -> Word32
tag_from_string String
feat) Word32
value Word
0 (Text -> Word
length' Text
text) Feature -> [Feature] -> [Feature]
forall a. a -> [a] -> [a]
: [Feature]
feats
  }
-- | Parses the given syntax akin to CSS font-feature-settings & apply to
-- The given RichText.
apply :: String -> RichText -> RichText
apply :: String -> RichText -> RichText
apply String
syntax RichText
rich | Just Feature
feat <- String -> Maybe Feature
parseFeature String
syntax = RichText
rich {
      features :: [Feature]
features = Feature
feat { featStart :: Word
featStart = Word
0, featEnd :: Word
featEnd = Text -> Word
length' (Text -> Word) -> Text -> Word
forall a b. (a -> b) -> a -> b
$ RichText -> Text
text RichText
rich } Feature -> [Feature] -> [Feature]
forall a. a -> [a] -> [a]
: RichText -> [Feature]
features RichText
rich
    }
  | Bool
otherwise = RichText
rich

alt, case_, centerCJKPunct, capSpace, ctxtSwash, petiteCaps', smallCaps', expertJ,
    finGlyph, fract, fullWidth, hist, hkana, histLig, hojo, halfWidth, italic,
    justifyAlt, jap78, jap83, jap90, jap04, kerning, lBounds, liningFig, localized,
    mathGreek, altAnnotation, nlcKanji, oldFig, ordinals, ornament, propAltWidth,
    petiteCaps, propKana, propFig, propWidth, quarterWidth, rand, rBounds, ruby,
    styleAlt, sciInferior, smallCaps, simpleCJ, subscript, superscript, swash,
    titling, traditionNameJ, tabularFig, traditionCJ, thirdWidth, unicase, vAlt,
    vert, vHalfAlt, vKanaAlt, vKerning, vPropAlt, vRotAlt, vrot,
    slash0 :: Word32 -> RichText -> RichText
altFrac, ctxtAlt, ctxtLig, optLigs, lig :: Bool -> RichText -> RichText
-- | This feature makes all variations of a selected character accessible.
-- This serves several purposes: An application may not support the feature by
-- which the desired glyph would normally be accessed; the user may need a glyph
-- outside the context supported by the normal substitution, or the user may not
-- know what feature produces the desired glyph. Since many-to-one substitutions
-- are not covered, ligatures would not appear in this table unless they were
-- variant forms of another ligature.
alt :: Word32 -> RichText -> RichText
alt         = String -> Word32 -> RichText -> RichText
style String
"aalt"
-- | Replaces figures separated by a slash with an alternative form.
altFrac :: Bool -> RichText -> RichText
altFrac Bool
True= String -> Word32 -> RichText -> RichText
style String
"afrc" Word32
4
altFrac Bool
False=String -> Word32 -> RichText -> RichText
style String
"afrc" Word32
0
-- | n specified situations, replaces default glyphs with alternate forms which
-- provide better joining behavior. Used in script typefaces which are designed
-- to have some or all of their glyphs join.
ctxtAlt :: Bool -> RichText -> RichText
ctxtAlt Bool
True= String -> Word32 -> RichText -> RichText
style String
"calt" Word32
6
ctxtAlt Bool
False=String -> Word32 -> RichText -> RichText
style String
"calt" Word32
0
-- | Shifts various punctuation marks up to a position that works better with
-- all-capital sequences or sets of lining figures; also changes oldstyle
-- figures to lining figures. By default, glyphs in a text face are designed to
-- work with lowercase characters. Some characters should be shifted vertically
-- to fit the higher visual center of all-capital or lining text. Also, lining
-- figures are the same height (or close to it) as capitals, and fit much better
-- with all-capital text.
case_ :: Word32 -> RichText -> RichText
case_       = String -> Word32 -> RichText -> RichText
style String
"case"
-- | Replaces a sequence of glyphs with a single glyph which is preferred for
-- typographic purposes. Unlike other ligature features, 'clig' specifies the
-- context in which the ligature is recommended. This capability is important
-- in some script designs and for swash ligatures.
ctxtLig :: Bool -> RichText -> RichText
ctxtLig Bool
True= String -> Word32 -> RichText -> RichText
style String
"clig" Word32
8
ctxtLig Bool
False=String -> Word32 -> RichText -> RichText
style String
"clig" Word32
0
-- | Centers specific punctuation marks for those fonts that do not include
-- centered and non-centered forms.
centerCJKPunct :: Word32 -> RichText -> RichText
centerCJKPunct = String -> Word32 -> RichText -> RichText
style String
"cpct"
-- | Globally adjusts inter-glyph spacing for all-capital text. Most typefaces
-- contain capitals and lowercase characters, and the capitals are positioned to
-- work with the lowercase. When capitals are used for words, they need more
-- space between them for legibility and esthetics. This feature would not apply
-- to monospaced designs. Of course the user may want to override this behavior
-- in order to do more pronounced letterspacing for esthetic reasons.
capSpace :: Word32 -> RichText -> RichText
capSpace    = String -> Word32 -> RichText -> RichText
style String
"cpsp"
-- | This feature replaces default character glyphs with corresponding swash
-- glyphs in a specified context. Note that there may be more than one swash
-- alternate for a given character.
ctxtSwash :: Word32 -> RichText -> RichText
ctxtSwash   = String -> Word32 -> RichText -> RichText
style String
"cswh"
-- | This feature turns capital characters into petite capitals. It is generally
-- used for words which would otherwise be set in all caps, such as acronyms,
-- but which are desired in petite-cap form to avoid disrupting the flow of text.
-- See the 'pcap' feature description for notes on the relationship of caps,
-- smallcaps and petite caps.
petiteCaps' :: Word32 -> RichText -> RichText
petiteCaps' = String -> Word32 -> RichText -> RichText
style String
"c2pc"
-- | This feature turns capital characters into small capitals. It is generally
-- used for words which would otherwise be set in all caps, such as acronyms,
-- but which are desired in small-cap form to avoid disrupting the flow of text.
smallCaps' :: Word32 -> RichText -> RichText
smallCaps'  = String -> Word32 -> RichText -> RichText
style String
"c2sc"
-- | Replaces a sequence of glyphs with a single glyph which is preferred for
-- typographic purposes. This feature covers those ligatures which may be used
-- for special effect, at the user’s preference.
optLigs :: Bool -> RichText -> RichText
optLigs Bool
True= String -> Word32 -> RichText -> RichText
style String
"dlig" Word32
4
optLigs Bool
False=String -> Word32 -> RichText -> RichText
style String
"dlig" Word32
0
-- | Like the JIS78 Forms feature, this feature replaces standard forms in
-- Japanese fonts with corresponding forms preferred by typographers. Although
-- most of the JIS78 substitutions are included, the expert substitution goes on
-- to handle many more characters.
expertJ :: Word32 -> RichText -> RichText
expertJ     = String -> Word32 -> RichText -> RichText
style String
"expt"
-- | Replaces line final glyphs with alternate forms specifically designed for
-- this purpose (they would have less or more advance width as need may be), to
-- help justification of text.
finGlyph :: Word32 -> RichText -> RichText
finGlyph    = String -> Word32 -> RichText -> RichText
style String
"falt"
-- | Replaces figures (digits) separated by a slash (U+002F or U+2044) with
-- “common” (diagonal) fractions.
fract :: Word32 -> RichText -> RichText
fract       = String -> Word32 -> RichText -> RichText
style String
"frac"
-- | Replaces glyphs set on other widths with glyphs set on full (usually em)
-- widths. In a CJKV font, this may include “lower ASCII” Latin characters and
-- various symbols. In a European font, this feature replaces proportionally-spaced
-- glyphs with monospaced glyphs, which are generally set on widths of 0.6 em.
fullWidth :: Word32 -> RichText -> RichText
fullWidth   = String -> Word32 -> RichText -> RichText
style String
"fwid"
-- | Some letterforms were in common use in the past, but appear anachronistic
-- today. The best-known example is the long form of s; others would include the
-- old Fraktur k. Some fonts include the historical forms as alternates, so they
-- can be used for a “period” effect. This feature replaces the default (current)
-- forms with the historical alternates. While some ligatures are also used for
-- historical effect, this feature deals only with single characters.
hist :: Word32 -> RichText -> RichText
hist        = String -> Word32 -> RichText -> RichText
style String
"hist"
-- | Replaces standard kana with forms that have been specially designed for only
-- horizontal writing. This is a typographic optimization for improved fit and
-- more even color. Also see 'vkana'.
hkana :: Word32 -> RichText -> RichText
hkana       = String -> Word32 -> RichText -> RichText
style String
"hkna"
-- | Some ligatures were in common use in the past, but appear anachronistic today.
-- Some fonts include the historical forms as alternates, so they can be used for
-- a “period” effect. This feature replaces the default (current) forms with the
-- historical alternates.
histLig :: Word32 -> RichText -> RichText
histLig        = String -> Word32 -> RichText -> RichText
style String
"hlig"
-- | The JIS X 0212-1990 (aka, “Hojo Kanji”) and JIS X 0213:2004 character sets
-- overlap significantly. In some cases their prototypical glyphs differ. When
-- building fonts that support both JIS X 0212-1990 and JIS X 0213:2004 (such as
-- those supporting the Adobe-Japan 1-6 character collection), it is recommended
-- that JIS X 0213:2004 forms be preferred as the encoded form. The 'hojo'
-- feature is used to access the JIS X 0212-1990 glyphs for the cases when the
-- JIS X 0213:2004 form is encoded.
hojo :: Word32 -> RichText -> RichText
hojo        = String -> Word32 -> RichText -> RichText
style String
"hojo"
-- | Replaces glyphs on proportional widths, or fixed widths other than half an
-- em, with glyphs on half-em (en) widths. Many CJKV fonts have glyphs which are
-- set on multiple widths; this feature selects the half-em version. There are
-- various contexts in which this is the preferred behavior, including
-- compatibility with older desktop documents.
halfWidth :: Word32 -> RichText -> RichText
halfWidth   = String -> Word32 -> RichText -> RichText
style String
"hwid"
-- | Some fonts (such as Adobe’s Pro Japanese fonts) will have both Roman and
-- Italic forms of some characters in a single font. This feature replaces the
-- Roman glyphs with the corresponding Italic glyphs.
italic :: Word32 -> RichText -> RichText
italic      = String -> Word32 -> RichText -> RichText
style String
"ital"
-- | Improves justification of text by replacing glyphs with alternate forms
-- specifically designed for this purpose (they would have less or more advance
-- width as need may be).
justifyAlt :: Word32 -> RichText -> RichText
justifyAlt  = String -> Word32 -> RichText -> RichText
style String
"jalt"
-- | This feature replaces default (JIS90) Japanese glyphs with the corresponding
-- forms from the JIS C 6226-1978 (JIS78) specification.
jap78 :: Word32 -> RichText -> RichText
jap78       = String -> Word32 -> RichText -> RichText
style String
"jp78"
-- | This feature replaces default (JIS90) Japanese glyphs with the corresponding
-- forms from the JIS X 0208-1983 (JIS83) specification.
jap83 :: Word32 -> RichText -> RichText
jap83       = String -> Word32 -> RichText -> RichText
style String
"jp83"
-- | This feature replaces Japanese glyphs from the JIS78 or JIS83 specifications
-- with the corresponding forms from the JIS X 0208-1990 (JIS90) specification.
jap90 :: Word32 -> RichText -> RichText
jap90       = String -> Word32 -> RichText -> RichText
style String
"jp90"
-- | The National Language Council (NLC) of Japan has defined new glyph shapes
-- for a number of JIS characters, which were incorporated into JIS X 0213:2004
-- as new prototypical forms. The 'jp04' feature is a subset of the 'nlck'
-- feature, and is used to access these prototypical glyphs in a manner that
-- maintains the integrity of JIS X 0213:2004.
jap04 :: Word32 -> RichText -> RichText
jap04       = String -> Word32 -> RichText -> RichText
style String
"jp04"
-- | Adjusts amount of space between glyphs, generally to provide optically
-- consistent spacing between glyphs. Although a well-designed typeface has
-- consistent inter-glyph spacing overall, some glyph combinations require
-- adjustment for improved legibility. Besides standard adjustment in the
-- horizontal direction, this feature can supply size-dependent kerning data
-- via device tables, “cross-stream” kerning in the Y text direction, and
-- adjustment of glyph placement independent of the advance adjustment. Note
-- that this feature may apply to runs of more than two glyphs, and would not
-- be used in monospaced fonts. Also note that this feature does not apply to
-- text set vertically.
kerning :: Word32 -> RichText -> RichText
kerning     = String -> Word32 -> RichText -> RichText
style String
"kern"
-- | Aligns glyphs by their apparent left extents at the left ends of horizontal
-- lines of text, replacing the default behavior of aligning glyphs by their origins.
lBounds :: Word32 -> RichText -> RichText
lBounds     = String -> Word32 -> RichText -> RichText
style String
"lfbd"
-- | Replaces a sequence of glyphs with a single glyph which is preferred for
-- typographic purposes. This feature covers the ligatures which the
-- designer or manufacturer judges should be used in normal conditions.
lig :: Bool -> RichText -> RichText
lig Bool
True    = String -> Word32 -> RichText -> RichText
style String
"liga" Word32
4
lig Bool
False   = String -> Word32 -> RichText -> RichText
style String
"liga" Word32
0
-- | This feature changes selected non-lining figures (digits) to lining figures.
liningFig :: Word32 -> RichText -> RichText
liningFig   = String -> Word32 -> RichText -> RichText
style String
"lnum"
-- | Many scripts used to write multiple languages over wide geographical areas
-- have developed localized variant forms of specific letters, which are used by
-- individual literary communities. For example, a number of letters in the
-- Bulgarian and Serbian alphabets have forms distinct from their Russian
-- counterparts and from each other. In some cases the localized form differs
-- only subtly from the script “norm”, in others the forms are radically distinct.
-- This feature enables localized forms of glyphs to be substituted for default forms.
localized :: Word32 -> RichText -> RichText
localized   = String -> Word32 -> RichText -> RichText
style String
"locl"
-- | Replaces standard typographic forms of Greek glyphs with corresponding forms
-- commonly used in mathematical notation (which are a subset of the Greek alphabet).
mathGreek :: Word32 -> RichText -> RichText
mathGreek   = String -> Word32 -> RichText -> RichText
style String
"mgrk"
-- | Replaces default glyphs with various notational forms (e.g. glyphs placed
-- in open or solid circles, squares, parentheses, diamonds or rounded boxes).
-- In some cases an annotation form may already be present, but the user may want
-- a different one.
altAnnotation :: Word32 -> RichText -> RichText
altAnnotation=String -> Word32 -> RichText -> RichText
style String
"nalt"
-- | The National Language Council (NLC) of Japan has defined new glyph shapes
-- for a number of JIS characters in 2000.
nlcKanji :: Word32 -> RichText -> RichText
nlcKanji    = String -> Word32 -> RichText -> RichText
style String
"nlck"
-- | This feature changes selected figures from the default or lining style to
-- oldstyle form.
oldFig :: Word32 -> RichText -> RichText
oldFig      = String -> Word32 -> RichText -> RichText
style String
"onum"
-- | Replaces default alphabetic glyphs with the corresponding ordinal forms for
-- use after figures. One exception to the follows-a-figure rule is the numero
-- character (U+2116), which is actually a ligature substitution, but is best
-- accessed through this feature.
ordinals :: Word32 -> RichText -> RichText
ordinals    = String -> Word32 -> RichText -> RichText
style String
"ordn"
-- | This is a dual-function feature, which uses two input methods to give the
-- user access to ornament glyphs (e.g. fleurons, dingbats and border elements)
-- in the font. One method replaces the bullet character with a selection from
-- the full set of available ornaments; the other replaces specific “lower ASCII”
-- characters with ornaments assigned to them. The first approach supports the
-- general or browsing user; the second supports the power user.
ornament :: Word32 -> RichText -> RichText
ornament    = String -> Word32 -> RichText -> RichText
style String
"ornm"
-- | Re-spaces glyphs designed to be set on full-em widths, fitting them onto
-- individual (more or less proportional) horizontal widths. This differs from
-- 'pwid' in that it does not substitute new glyphs (GPOS, not GSUB feature).
-- The user may prefer the monospaced form, or may simply want to ensure that
-- the glyph is well-fit and not rotated in vertical setting (Latin forms
-- designed for proportional spacing would be rotated).
propAltWidth :: Word32 -> RichText -> RichText
propAltWidth= String -> Word32 -> RichText -> RichText
style String
"palt"
-- | Some fonts contain an additional size of capital letters, shorter than the
-- regular smallcaps and whimsically referred to as petite caps. Such forms are
-- most likely to be found in designs with a small lowercase x-height, where they
-- better harmonise with lowercase text than the taller smallcaps (for examples
-- of petite caps, see the Emigre type families Mrs Eaves and Filosofia). This
-- feature turns glyphs for lowercase characters into petite capitals. Forms
-- related to petite capitals, such as specially designed figures, may be included.
petiteCaps :: Word32 -> RichText -> RichText
petiteCaps  = String -> Word32 -> RichText -> RichText
style String
"pcap"
-- | Replaces glyphs, kana and kana-related, set on uniform widths (half or
-- full-width) with proportional glyphs.
propKana :: Word32 -> RichText -> RichText
propKana    = String -> Word32 -> RichText -> RichText
style String
"pkna"
-- | Replaces figure glyphs set on uniform (tabular) widths with corresponding
-- glyphs set on glyph-specific (proportional) widths. Tabular widths will
-- generally be the default, but this cannot be safely assumed. Of course this
-- feature would not be present in monospaced designs.
propFig :: Word32 -> RichText -> RichText
propFig     = String -> Word32 -> RichText -> RichText
style String
"pnum"
-- | Replaces glyphs set on uniform widths (typically full or half-em) with
-- proportionally spaced glyphs. The proportional variants are often used for the
-- Latin characters in CJKV fonts, but may also be used for Kana in Japanese fonts.
propWidth :: Word32 -> RichText -> RichText
propWidth   = String -> Word32 -> RichText -> RichText
style String
"pwid"
-- | Replaces glyphs on other widths with glyphs set on widths of one quarter
-- of an em (half an en). The characters involved are normally figures and
-- some forms of punctuation.
quarterWidth :: Word32 -> RichText -> RichText
quarterWidth= String -> Word32 -> RichText -> RichText
style String
"qwid"
-- | In order to emulate the irregularity and variety of handwritten text, this
-- feature allows multiple alternate forms to be used.
rand :: Word32 -> RichText -> RichText
rand        = String -> Word32 -> RichText -> RichText
style String
"rand"
-- | Aligns glyphs by their apparent right extents at the right ends of horizontal
-- lines of text, replacing the default behavior of aligning glyphs by their origins.
rBounds :: Word32 -> RichText -> RichText
rBounds     = String -> Word32 -> RichText -> RichText
style String
"rtbd"
-- | Japanese typesetting often uses smaller kana glyphs, generally in
-- superscripted form, to clarify the meaning of kanji which may be unfamiliar
-- to the reader. These are called “ruby”, from the old typesetting term for
-- four-point-sized type. This feature identifies glyphs in the font which have
-- been designed for this use, substituting them for the default designs.
ruby :: Word32 -> RichText -> RichText
ruby        = String -> Word32 -> RichText -> RichText
style String
"ruby"
-- | Many fonts contain alternate glyph designs for a purely esthetic effect;
-- these don’t always fit into a clear category like swash or historical. As in
-- the case of swash glyphs, there may be more than one alternate form. This
-- feature replaces the default forms with the stylistic alternates.
styleAlt :: Word32 -> RichText -> RichText
styleAlt    = String -> Word32 -> RichText -> RichText
style String
"salt"
-- | Replaces lining or oldstyle figures (digits) with inferior figures (smaller
-- glyphs which sit lower than the standard baseline, primarily for chemical or
-- mathematical notation). May also replace glyphs for lowercase characters with
-- alphabetic inferiors.
sciInferior :: Word32 -> RichText -> RichText
sciInferior = String -> Word32 -> RichText -> RichText
style String
"sinf"
-- | This feature turns glyphs for lowercase characters into small capitals. It
-- is generally used for display lines set in Large & small caps, such as titles.
-- Forms related to small capitals, such as oldstyle figures, may be included.
smallCaps :: Word32 -> RichText -> RichText
smallCaps   = String -> Word32 -> RichText -> RichText
style String
"smcp"
-- | Replaces “traditional” Chinese or Japanese forms with the corresponding
-- “simplified” forms.
simpleCJ :: Word32 -> RichText -> RichText
simpleCJ    = String -> Word32 -> RichText -> RichText
style String
"smpl"
-- | The 'subs' feature may replace a default glyph with a subscript glyph, or it
-- may combine a glyph substitution with positioning adjustments for proper placement.
subscript :: Word32 -> RichText -> RichText
subscript   = String -> Word32 -> RichText -> RichText
style String
"subs"
-- | Replaces lining or oldstyle figures with superior figures (primarily for
-- footnote indication), and replaces lowercase letters with superior letters
-- (primarily for abbreviated French titles).
superscript :: Word32 -> RichText -> RichText
superscript = String -> Word32 -> RichText -> RichText
style String
"sups"
-- | This feature replaces default character glyphs with corresponding swash glyphs.
-- Note that there may be more than one swash alternate for a given character.
swash :: Word32 -> RichText -> RichText
swash       = String -> Word32 -> RichText -> RichText
style String
"swsh"
-- | This feature replaces the default glyphs with corresponding forms designed
-- specifically for titling. These may be all-capital and\/or larger on the body,
-- and adjusted for viewing at larger sizes.
titling :: Word32 -> RichText -> RichText
titling     = String -> Word32 -> RichText -> RichText
style String
"titl"
-- | Replaces “simplified” Japanese kanji forms with the corresponding
-- “traditional” forms. This is equivalent to the Traditional Forms feature,
-- but explicitly limited to the traditional forms considered proper for use
-- in personal names (as many as 205 glyphs in some fonts).
traditionNameJ :: Word32 -> RichText -> RichText
traditionNameJ = String -> Word32 -> RichText -> RichText
style String
"tnam"
-- | Replaces figure glyphs set on proportional widths with corresponding glyphs
-- set on uniform (tabular) widths. Tabular widths will generally be the default,
-- but this cannot be safely assumed. Of course this feature would not be present
-- in monospaced designs.
tabularFig :: Word32 -> RichText -> RichText
tabularFig  = String -> Word32 -> RichText -> RichText
style String
"tnum"
-- | Replaces 'simplified' Chinese hanzi or Japanese kanji forms with the
-- corresponding 'traditional' forms.
traditionCJ :: Word32 -> RichText -> RichText
traditionCJ = String -> Word32 -> RichText -> RichText
style String
"trad"
-- | Replaces glyphs on other widths with glyphs set on widths of one third of an
-- em. The characters involved are normally figures and some forms of punctuation.
thirdWidth :: Word32 -> RichText -> RichText
thirdWidth  = String -> Word32 -> RichText -> RichText
style String
"twid"
-- | This feature maps upper- and lowercase letters to a mixed set of lowercase
-- and small capital forms, resulting in a single case alphabet (for an example
-- of unicase, see the Emigre type family Filosofia). The letters substituted
-- may vary from font to font, as appropriate to the design. If aligning to the
-- x-height, smallcap glyphs may be substituted, or specially designed unicase
-- forms might be used. Substitutions might also include specially designed figures.
unicase :: Word32 -> RichText -> RichText
unicase     = String -> Word32 -> RichText -> RichText
style String
"unic"
-- | Repositions glyphs to visually center them within full-height metrics, for
-- use in vertical setting. Applies to full-width Latin, Greek, or Cyrillic
-- glyphs, which are typically included in East Asian fonts, and whose glyphs
-- are aligned on a common horizontal baseline and not rotated relative to the
-- page or text frame.
vAlt :: Word32 -> RichText -> RichText
vAlt        = String -> Word32 -> RichText -> RichText
style String
"valt"
-- | Transforms default glyphs into glyphs that are appropriate for upright
-- presentation in vertical writing mode. While the glyphs for most characters
-- in East Asian writing systems remain upright when set in vertical writing
-- mode, some must be transformed — usually by rotation, shifting, or different
-- component ordering — for vertical writing mode.
vert :: Word32 -> RichText -> RichText
vert        = String -> Word32 -> RichText -> RichText
style String
"vert"
-- | Re-spaces glyphs designed to be set on full-em heights, fitting them onto
-- half-em heights. This differs from 'valt', which repositions a glyph but does
-- not affect its advance.
vHalfAlt :: Word32 -> RichText -> RichText
vHalfAlt    = String -> Word32 -> RichText -> RichText
style String
"vhal"
-- | Replaces standard kana with forms that have been specially designed for only
-- vertical writing. This is a typographic optimization for improved fit and more
-- even color. Also see 'hkna'.
vKanaAlt :: Word32 -> RichText -> RichText
vKanaAlt    = String -> Word32 -> RichText -> RichText
style String
"vkna"
-- | Adjusts amount of space between glyphs, generally to provide optically
-- consistent spacing between glyphs. Although a well-designed typeface has
-- consistent inter-glyph spacing overall, some glyph combinations require
-- adjustment for improved legibility. Besides standard adjustment in the
-- vertical direction, this feature can supply size-dependent kerning data
-- via device tables, “cross-stream” kerning in the X text direction, and
-- adjustment of glyph placement independent of the advance adjustment. Note
-- that this feature may apply to runs of more than two glyphs, and would not
-- be used in monospaced fonts. Also note that this feature applies only to
-- text set vertically.
vKerning :: Word32 -> RichText -> RichText
vKerning    = String -> Word32 -> RichText -> RichText
style String
"vkrn"
-- | Re-spaces glyphs designed to be set on full-em heights, fitting them onto
-- individual (more or less proportional) vertical heights. This differs from
-- 'valt', which repositions a glyph but does not affect its advance.
vPropAlt :: Word32 -> RichText -> RichText
vPropAlt    = String -> Word32 -> RichText -> RichText
style String
"vpal"
-- | Replaces some fixed-width (half-, third- or quarter-width) or
-- proportional-width glyphs (mostly Latin or katakana) with forms suitable for
-- vertical writing (that is, rotated 90 degrees clockwise). Note that these are
-- a superset of the glyphs covered in the 'vert' table.
vRotAlt :: Word32 -> RichText -> RichText
vRotAlt     = String -> Word32 -> RichText -> RichText
style String
"vrt2"
-- | Transforms default glyphs into glyphs that are appropriate for sideways
-- presentation in vertical writing mode. While the glyphs for most characters
-- in East Asian writing systems remain upright when set in vertical writing mode,
-- glyphs for other characters — such as those of other scripts or for particular
-- Western-style punctuation — are expected to be presented sideways in vertical writing.
vrot :: Word32 -> RichText -> RichText
vrot        = String -> Word32 -> RichText -> RichText
style String
"vrtr"
-- | Some fonts contain both a default form of zero, and an alternative form
-- which uses a diagonal slash through the counter. Especially in condensed
-- designs, it can be difficult to distinguish between 0 and O (zero and capital
-- O) in any situation where capitals and lining figures may be arbitrarily mixed.
-- This feature allows the user to change from the default 0 to a slashed form.
slash0 :: Word32 -> RichText -> RichText
slash0      = String -> Word32 -> RichText -> RichText
style String
"zero"

off, on, alternate :: Word32
-- | Typical word to turn a font-feature off.
off :: Word32
off = Word32
0
-- | Typical word to turn a font-feature on
on :: Word32
on = Word32
1
-- | Typical word to switch to the alternate setting for a font-feature.
alternate :: Word32
alternate = Word32
3