6 files changed, 188 insertions(+), 39 deletions(-)

D cabal.sandbox.config
M src/Typograffiti.hs
A src/Typograffiti/Rich.hs
M src/Typograffiti/Store.hs
M src/Typograffiti/Text.hs
R typograffiti2.cabal => typograffiti.cabal

@@ 1,27 0,0 @@
--- This is a Cabal package environment file.
--- THIS FILE IS AUTO-GENERATED. DO NOT EDIT DIRECTLY.
--- Please create a 'cabal.config' file in the same directory
--- if you want to change the default settings for this sandbox.
-
-
-local-repo: /home/alcinnz/argonaut/typograffiti2/.cabal-sandbox/packages
-logs-dir: /home/alcinnz/argonaut/typograffiti2/.cabal-sandbox/logs
-world-file: /home/alcinnz/argonaut/typograffiti2/.cabal-sandbox/world
-user-install: False
-package-db: /home/alcinnz/argonaut/typograffiti2/.cabal-sandbox/x86_64-linux-ghc-8.6.5-packages.conf.d
-build-summary: /home/alcinnz/argonaut/typograffiti2/.cabal-sandbox/logs/build.log
-
-install-dirs
-  prefix: /home/alcinnz/argonaut/typograffiti2/.cabal-sandbox
-  bindir: $prefix/bin
-  libdir: $prefix/lib
-  libsubdir: $abi/$libname
-  dynlibdir: $libdir/$abi
-  libexecdir: $prefix/libexec
-  libexecsubdir: $abi/$pkgid
-  datadir: $prefix/share
-  datasubdir: $abi/$pkgid
-  docdir: $datadir/doc/$abi/$pkgid
-  htmldir: $docdir/html
-  haddockdir: $htmldir
-  sysconfdir: $prefix/etc

@@ 12,7 12,9 @@ module Typograffiti(
     makeDrawGlyphs, AllocatedRendering(..), Layout(..),
     SpatialTransform(..), TextTransform(..), move, scale, rotate, color, alpha,
     withFontStore, newFontStore, FontStore(..), Font(..),
-    SampleText (..), defaultSample, addSampleFeature,
+    SampleText (..), defaultSample, addSampleFeature, parseSampleFeature, parseSampleFeatures,
+        addFontVariant, parseFontVariant, parseFontVariants,
+        varItalic, varOptSize, varSlant, varWidth, varWeight,
     RichText (..), str, txt, ($$), style, apply, on, off, alternate,
         alt, case_, centerCJKPunct, capSpace, ctxtSwash, petiteCaps', smallCaps',
         expertJ, finGlyph, fract, fullWidth, hist, hkana, hlig, hojo, halfWidth,

@@ 0,0 1,128 @@
+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)
+
+length' = toEnum . fromEnum . Txt.length
+
+data RichText = RichText {
+    text :: Text,
+    features :: [Feature]
+}
+
+instance IsString RichText where
+    fromString x = flip RichText [] $ pack x
+str :: String -> RichText
+str = fromString
+txt :: Text -> RichText
+txt = flip RichText []
+
+($$) :: RichText -> RichText -> RichText
+RichText ltext lfeat $$ RichText rtext rfeat = RichText {
+    text = append ltext rtext,
+    features = let n = length' ltext in lfeat ++ [
+        feat { featStart = start + n, featEnd = end + n }
+        | feat@Feature { featStart = start, featEnd = end } <- rfeat]
+  }
+
+style :: String -> Word32 -> RichText -> RichText
+style feat value (RichText text feats) = RichText {
+    text = text,
+    features = Feature (tag_from_string feat) value 0 (length' text) : feats
+  }
+apply :: String -> RichText -> RichText
+apply syntax rich | Just feat <- parseFeature syntax = rich {
+      features = feat { featStart = 0, featEnd = length' $ text rich } : features rich
+    }
+  | otherwise = rich
+
+alt, case_, centerCJKPunct, capSpace, ctxtSwash, petiteCaps', smallCaps', expertJ,
+    finGlyph, fract, fullWidth, hist, hkana, hlig, hojo, halfWidth, italic, justifyAlt,
+    jap78, jap83, jap90, jap04, kerning, lBounds, liningFig, localized, mathGreek,
+    altAnnotation, nlcKanji, oldFig, ordinals, ornament, propAltWidth, petiteCaps,
+    propKana, propFig, propWidth, quarterWidth, 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, rand :: Bool -> RichText -> RichText
+alt         = style "aalt"
+altFrac True= style "afrc" 4
+altFrac False=style "afrc" 0
+ctxtAlt True= style "calt" 6
+ctxtAlt False=style "calt" 0
+case_       = style "case"
+ctxtLig True= style "clig" 8
+ctxtLig False=style "clig" 0
+centerCJKPunct = style "cpct"
+capSpace    = style "cpsp"
+ctxtSwash   = style "cswh"
+petiteCaps' = style "c2pc"
+smallCaps'  = style "c2sc"
+optLigs True= style "dlig" 4
+optLigs False=style "dlig" 0
+expertJ     = style "expt"
+finGlyph    = style "falt"
+fract       = style "frac"
+fullWidth   = style "fwid"
+hist        = style "hist"
+hkana       = style "hkna"
+hlig        = style "hlig"
+hojo        = style "hojo"
+halfWidth   = style "hwid"
+italic      = style "ital"
+justifyAlt  = style "jalt"
+jap78       = style "jp78"
+jap83       = style "jp83"
+jap90       = style "jp90"
+jap04       = style "jp04"
+kerning     = style "kern"
+lBounds     = style "lfbd"
+lig True    = style "liga" 4
+lig False   = style "liga" 0
+liningFig   = style "lnum"
+localized   = style "locl"
+mathGreek   = style "mgrk"
+altAnnotation=style "nalt"
+nlcKanji    = style "nlck"
+oldFig      = style "onum"
+ordinals    = style "ordn"
+ornament    = style "ornm"
+propAltWidth= style "palt"
+petiteCaps  = style "pcap"
+propKana    = style "pkna"
+propFig     = style "pnum"
+propWidth   = style "pwid"
+quarterWidth= style "qwid"
+rand True   = style "rand" 3
+rand False  = style "rand" 0
+rBounds     = style "rtbd"
+ruby        = style "ruby"
+styleAlt    = style "salt"
+sciInferior = style "sinf"
+smallCaps   = style "smcp"
+simpleCJ    = style "smpl"
+subscript   = style "subs"
+superscript = style "sups"
+swash       = style "swsh"
+titling     = style "titl"
+traditionNameJ = style "tnam"
+tabularFig  = style "tnum"
+traditionCJ = style "trad"
+thirdWidth  = style "twid"
+unicase     = style "unic"
+vAlt        = style "valt"
+vert        = style "vert"
+vHalfAlt    = style "vhal"
+vKanaAlt    = style "vkna"
+vKerning    = style "vkrn"
+vPropAlt    = style "vpal"
+vRotAlt     = style "vrt2"
+vrot        = style "vrtr"
+slash0      = style "zero"
+
+off, on, alternate :: Word32
+off = 0
+on = 1
+alternate = 3

@@ 33,6 33,8 @@ import qualified Data.Text.Glyphize     as HB
 import           Data.Text.Lazy         (Text, pack)
 import qualified Data.Text.Lazy         as Txt
 import           FreeType.Core.Base
+import           FreeType.Core.Types    (FT_Fixed)
+import           FreeType.Format.Multiple (ft_Set_Var_Design_Coordinates)
 
 import           Typograffiti.Atlas
 import           Typograffiti.Cache


@@ 57,7 59,7 @@ makeDrawTextCached :: (MonadIO m, MonadFail m, MonadError TypograffitiError m,
 makeDrawTextCached store filepath index fontsize SampleText {..} = do
     s <- liftIO $ atomically $ readTMVar $ fontMap store
     font <- case M.lookup (filepath, fontsize, index) s of
-        Nothing -> allocFont store filepath index fontsize
+        Nothing -> allocFont store filepath index fontsize fontOptions
         Just font -> return font
 
     let glyphs = map (codepoint . fst) $


@@ 74,8 76,9 @@ makeDrawTextCached store filepath index fontsize SampleText {..} = do
     return $ drawLinesWrapper tabwidth $ \RichText {..} -> drawGlyphs store atlas $
         shape (harfbuzz font) defaultBuffer { HB.text = text } []
 
-allocFont :: (MonadIO m) => FontStore n -> FilePath -> Int -> GlyphSize -> m Font
-allocFont FontStore {..} filepath index fontsize = liftIO $ do
+allocFont :: (MonadIO m) =>
+        FontStore n -> FilePath -> Int -> GlyphSize -> HB.FontOptions -> m Font
+allocFont FontStore {..} filepath index fontsize options = liftIO $ do
     font <- ft_New_Face lib filepath $ toEnum index
     case fontsize of
         PixelSize w h -> ft_Set_Pixel_Sizes font (toEnum $ x2 w) (toEnum $ x2 h)


@@ 84,7 87,8 @@ allocFont FontStore {..} filepath index fontsize = liftIO $ do
                                                     (toEnum dpix) (toEnum dpiy)
 
     bytes <- B.readFile filepath
-    let font' = HB.createFont $ HB.createFace bytes $ toEnum index
+    let font' = HB.createFontWithOptions options $ HB.createFace bytes $ toEnum index
+    liftIO $ ft_Set_Var_Design_Coordinates font $ map float2fixed $ HB.fontVarCoordsDesign font'
 
     atlases <- liftIO $ atomically $ newTMVar []
     let ret = Font font' font atlases


@@ 93,7 97,10 @@ allocFont FontStore {..} filepath index fontsize = liftIO $ do
         map <- takeTMVar fontMap
         putTMVar fontMap $ M.insert (filepath, fontsize, index) ret map
     return ret
-  where x2 = (*2)
+  where
+    x2 = (*2)
+    float2fixed :: Float -> FT_Fixed
+    float2fixed = toEnum . fromEnum . (*65536)
 
 allocAtlas' :: (MonadIO m, MonadFail m) =>
     TMVar [(IS.IntSet, Atlas)] -> FT_Face -> IS.IntSet -> m Atlas

@@ 29,9 29,13 @@ import qualified Data.Set               as S
 import qualified Data.IntSet            as IS
 import           Linear
 import qualified Data.ByteString        as B
-import           Data.Text.Glyphize     (defaultBuffer, Buffer(..), shape, GlyphInfo(..))
+import           Data.Text.Glyphize     (defaultBuffer, Buffer(..), shape, GlyphInfo(..),
+                                        parseFeature, parseVariation, Variation(..),
+                                        FontOptions(..), defaultFontOptions)
 import qualified Data.Text.Glyphize     as HB
 import           FreeType.Core.Base
+import           FreeType.Core.Types    (FT_Fixed)
+import           FreeType.Format.Multiple (ft_Set_Var_Design_Coordinates)
 import           Data.Text.Lazy         (Text, pack)
 import qualified Data.Text.Lazy         as Txt
 import           Data.Word              (Word32)


@@ 47,11 51,12 @@ data GlyphSize = CharSize Float Float Int Int
 data SampleText = SampleText {
     sampleFeatures :: [HB.Feature],
     sampleText :: Text,
-    tabwidth :: Int
+    tabwidth :: Int,
+    fontOptions :: FontOptions
 }
 
 defaultSample :: SampleText
-defaultSample = SampleText [] (pack $ map toEnum [32..126]) 4
+defaultSample = SampleText [] (pack $ map toEnum [32..126]) 4 defaultFontOptions
 addSampleFeature :: String -> Word32 -> SampleText -> SampleText
 addSampleFeature name value sample@SampleText {..} = sample {
         sampleFeatures =


@@ 62,6 67,35 @@ addSampleFeature name value sample@SampleText {..} = sample {
     i = w $ length sampleFeatures
     w :: Int -> Word
     w = toEnum
+parseSampleFeature :: String -> SampleText -> SampleText
+parseSampleFeature syntax sample | Just feat <- parseFeature syntax = sample {
+        sampleFeatures = feat : sampleFeatures sample
+    }
+  | otherwise = sample
+parseSampleFeatures :: [String] -> SampleText -> SampleText
+parseSampleFeatures = flip $ foldl $ flip parseSampleFeature
+addFontVariant :: String -> Float -> SampleText -> SampleText
+addFontVariant name val sampleText = sampleText {
+    fontOptions = (fontOptions sampleText) {
+        optionVariations = Variation (HB.tag_from_string name) val :
+            optionVariations (fontOptions sampleText)
+    }
+  }
+parseFontVariant :: String -> SampleText -> SampleText
+parseFontVariant syntax sample | Just var <- parseVariation syntax = sample {
+        fontOptions = (fontOptions sample) {
+            optionVariations = var : optionVariations (fontOptions sample)
+        }
+    }
+  | otherwise = sample
+parseFontVariants :: [String] -> SampleText -> SampleText
+parseFontVariants = flip $ foldl $ flip parseFontVariant
+
+varItalic = "ital"
+varOptSize = "opsz"
+varSlant = "slnt"
+varWidth = "wdth"
+varWeight = "wght"
 
 makeDrawText :: (MonadIO m, MonadFail m, MonadError TypograffitiError m,
     MonadIO n, MonadFail n, MonadError TypograffitiError n) =>


@@ 76,19 110,24 @@ makeDrawText lib filepath index fontsize SampleText {..} = do
                                                     (toEnum dpix) (toEnum dpiy)
 
     bytes <- liftIO $ B.readFile filepath
-    let font' = HB.createFont $ HB.createFace bytes $ toEnum index
+    let font' = HB.createFontWithOptions fontOptions $ HB.createFace bytes $ toEnum index
     let glyphs = map (codepoint . fst) $
             shape font' defaultBuffer {
                 HB.text = Txt.replicate (toEnum $ succ $ length sampleFeatures) sampleText
             } sampleFeatures
     let glyphs' = map toEnum $ IS.toList $ IS.fromList $ map fromEnum glyphs
+    -- FIXME expose this function...
+    liftIO $ ft_Set_Var_Design_Coordinates font $ map float2fixed $ HB.fontVarCoordsDesign font'
     atlas <- allocAtlas (glyphRetriever font) glyphs'
     liftIO $ ft_Done_Face font
 
     drawGlyphs <- makeDrawGlyphs
     return $ drawLinesWrapper tabwidth $ \RichText {..} ->
         drawGlyphs atlas $ shape font' defaultBuffer { HB.text = text } features
-  where x2 = (*2)
+  where
+    x2 = (*2)
+    float2fixed :: Float -> FT_Fixed
+    float2fixed = toEnum . fromEnum . (*65536)
 
 makeDrawText' a b c d =
     ft_With_FreeType $ \ft -> runExceptT $ makeDrawText ft a b c d

@@ 35,7 35,7 @@ library
       Typograffiti.Rich
   build-depends:       base >=4.12 && <4.13, linear>=1.20, containers >= 0.6,
                         freetype2 >= 0.2, gl >= 0.8, mtl >= 2.2, stm >= 2.5, text,
-                        vector >= 0.12, harfbuzz-pure >= 0.0.7, bytestring >= 0.10
+                        vector >= 0.12, harfbuzz-pure >= 1.0.1, bytestring >= 0.10
   hs-source-dirs:      src
   default-language:    Haskell2010