3 files changed, 31 insertions(+), 18 deletions(-)

M src/Typograffiti/Store.hs
M src/Typograffiti/Text.hs
M typograffiti2.cabal

@@ 37,6 37,7 @@ import           FreeType.Core.Base
 import           Typograffiti.Atlas
 import           Typograffiti.Cache
 import           Typograffiti.Text      (GlyphSize(..), drawLinesWrapper, SampleText(..))
+import           Typograffiti.Rich      (RichText(..))
 
 data FontStore n = FontStore {
     fontMap :: TMVar (Map (FilePath, GlyphSize, Int) Font),


@@ 52,7 53,7 @@ data Font = Font {
 makeDrawTextCached :: (MonadIO m, MonadFail m, MonadError TypograffitiError m,
     MonadIO n, MonadFail n, MonadError TypograffitiError n) =>
     FontStore n -> FilePath -> Int -> GlyphSize -> SampleText ->
-    m (String -> [HB.Feature] -> n (AllocatedRendering [TextTransform]))
+    m (RichText -> n (AllocatedRendering [TextTransform]))
 makeDrawTextCached store filepath index fontsize SampleText {..} = do
     s <- liftIO $ atomically $ readTMVar $ fontMap store
     font <- case M.lookup (filepath, fontsize, index) s of


@@ 61,7 62,7 @@ makeDrawTextCached store filepath index fontsize SampleText {..} = do
 
     let glyphs = map (codepoint . fst) $
             shape (harfbuzz font) defaultBuffer {
-                text = Txt.replicate (toEnum $ succ $ length sampleFeatures) sampleText
+                HB.text = Txt.replicate (toEnum $ succ $ length sampleFeatures) sampleText
             } sampleFeatures
     let glyphset = IS.fromList $ map fromEnum glyphs
 


@@ 70,8 71,8 @@ makeDrawTextCached store filepath index fontsize SampleText {..} = do
         (atlas:_) -> return atlas
         _ -> allocAtlas' (atlases font) (freetype font) glyphset
 
-    return $ drawLinesWrapper tabwidth $ \string features -> drawGlyphs store atlas $
-        shape (harfbuzz font) defaultBuffer { text = pack string } []
+    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

@@ 4,6 4,7 @@
 {-# LANGUAGE RankNTypes                 #-}
 {-# LANGUAGE ScopedTypeVariables        #-}
 {-# LANGUAGE RecordWildCards            #-}
+{-# LANGUAGE OverloadedStrings          #-}
 -- |
 -- Module:     Typograffiti.Monad
 -- Copyright:  (c) 2018 Schell Scivally


@@ 33,9 34,11 @@ import qualified Data.Text.Glyphize     as HB
 import           FreeType.Core.Base
 import           Data.Text.Lazy         (Text, pack)
 import qualified Data.Text.Lazy         as Txt
+import           Data.Word              (Word32)
 
 import           Typograffiti.Atlas
 import           Typograffiti.Cache
+import           Typograffiti.Rich      (RichText(..))
 
 data GlyphSize = CharSize Float Float Int Int
                | PixelSize Int Int


@@ 46,7 49,10 @@ data SampleText = SampleText {
     sampleText :: Text,
     tabwidth :: Int
 }
+
+defaultSample :: SampleText
 defaultSample = SampleText [] (pack $ map toEnum [32..126]) 4
+addSampleFeature :: String -> Word32 -> SampleText -> SampleText
 addSampleFeature name value sample@SampleText {..} = sample {
         sampleFeatures =
             HB.Feature (HB.tag_from_string name) value (n*i) (n*succ i) : sampleFeatures


@@ 60,7 66,7 @@ addSampleFeature name value sample@SampleText {..} = sample {
 makeDrawText :: (MonadIO m, MonadFail m, MonadError TypograffitiError m,
     MonadIO n, MonadFail n, MonadError TypograffitiError n) =>
     FT_Library -> FilePath -> Int -> GlyphSize -> SampleText ->
-    m (String -> [HB.Feature] -> n (AllocatedRendering [TextTransform]))
+    m (RichText -> n (AllocatedRendering [TextTransform]))
 makeDrawText lib filepath index fontsize SampleText {..} = do
     font <- liftIO $ ft_New_Face lib filepath $ toEnum index
     liftIO $ case fontsize of


@@ 73,26 79,27 @@ makeDrawText lib filepath index fontsize SampleText {..} = do
     let font' = HB.createFont $ HB.createFace bytes $ toEnum index
     let glyphs = map (codepoint . fst) $
             shape font' defaultBuffer {
-                text = Txt.replicate (toEnum $ succ $ length sampleFeatures) sampleText
+                HB.text = Txt.replicate (toEnum $ succ $ length sampleFeatures) sampleText
             } sampleFeatures
     let glyphs' = map toEnum $ IS.toList $ IS.fromList $ map fromEnum glyphs
     atlas <- allocAtlas (glyphRetriever font) glyphs'
     liftIO $ ft_Done_Face font
 
     drawGlyphs <- makeDrawGlyphs
-    return $ drawLinesWrapper tabwidth $ \string features ->
-        drawGlyphs atlas $ shape font' defaultBuffer { text = pack string } features
+    return $ drawLinesWrapper tabwidth $ \RichText {..} ->
+        drawGlyphs atlas $ shape font' defaultBuffer { HB.text = text } features
   where x2 = (*2)
 
 makeDrawText' a b c d =
     ft_With_FreeType $ \ft -> runExceptT $ makeDrawText ft a b c d
 
 drawLinesWrapper :: (MonadIO m, MonadFail m) =>
-    Int -> (String -> [HB.Feature] -> m (AllocatedRendering [TextTransform])) ->
-    String -> [HB.Feature] -> m (AllocatedRendering [TextTransform])
-drawLinesWrapper indent cb string features = do
-    let features' = splitFeatures 0 features $ lines string
-    renderers <- mapM (uncurry cb) $ flip zip features' $ map processLine $ lines string
+    Int -> (RichText -> m (AllocatedRendering [TextTransform])) ->
+    RichText -> m (AllocatedRendering [TextTransform])
+drawLinesWrapper indent cb RichText {..} = do
+    let features' = splitFeatures 0 features $ Txt.lines text
+    let cb' (a, b) = cb $ RichText a b
+    renderers <- mapM cb' $ flip zip features' $ map processLine $ Txt.lines text
     let drawLine ts wsz y renderer = do
             arDraw renderer (move 0 y:ts) wsz
             let V2 _ height = arSize renderer


@@ 111,9 118,10 @@ drawLinesWrapper indent cb string features = do
             arSize = size
           }
   where
+    splitFeatures :: Word -> [HB.Feature] -> [Text] -> [[HB.Feature]]
     splitFeatures _ [] _ = []
     splitFeatures _ _ [] = []
-    splitFeatures offset features' (line:lines') = let n = length line
+    splitFeatures offset features' (line:lines') = let n = fromEnum $ Txt.length line
         in [feat {
                 HB.featStart = max 0 (start - offset),
                 HB.featEnd = min (toEnum n) (end - offset)


@@ 122,10 130,13 @@ drawLinesWrapper indent cb string features = do
             fromEnum end <= n + fromEnum offset && end >= offset] :
             splitFeatures (offset + toEnum n) features' lines'
 
+    processLine :: Text -> Text
     processLine "" = " " -- enforce nonempty
     processLine cs = expandTabs 0 cs
     -- monospace tabshaping, good enough outside full line-layout.
-    expandTabs n cs = case break (== '\t') cs of
-        (pre, '\t':cs') -> let spaces = indent - ((length pre + n) `rem` indent)
-            in pre ++ replicate spaces ' ' ++ expandTabs (n + length pre + spaces) cs'
-        (tail, _) -> tail
+    expandTabs n cs = case Txt.break (== '\t') cs of
+        (tail, "") -> tail
+        (pre, cs') ->
+            let spaces = indent - ((fromEnum (Txt.length pre) + fromEnum n) `rem` indent)
+            in Txt.concat [pre, Txt.replicate (toEnum spaces) " ",
+                expandTabs (n + Txt.length pre + toEnum spaces) $ Txt.tail cs']

@@ 32,6 32,7 @@ library
       Typograffiti.GL
       Typograffiti.Store
       Typograffiti.Text
+      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