From f2772de842b757a8f304710ee7eb8417c92a981d Mon Sep 17 00:00:00 2001 From: Adrian Cochrane Date: Fri, 11 Feb 2022 22:27:47 +1300 Subject: [PATCH] Implement conversion from functional Buffers to imperative Buffers. --- Data/Text/Glyphize/Buffer.hs | 95 ++++++++++++++++++++++++++++++++++++ Main.hs | 9 ++++ harfbuzz-pure.cabal | 16 +++++- 3 files changed, 119 insertions(+), 1 deletion(-) create mode 100644 Main.hs diff --git a/Data/Text/Glyphize/Buffer.hs b/Data/Text/Glyphize/Buffer.hs index 3c074e6..910c102 100644 --- a/Data/Text/Glyphize/Buffer.hs +++ b/Data/Text/Glyphize/Buffer.hs @@ -4,6 +4,19 @@ import Data.Text.Lazy as Lazy import Data.ByteString.Lazy as Lazy import Data.Text.Short +import Foreign.ForeignPtr +import Foreign.Ptr +import Foreign.C.Types +import Data.Word +import System.IO.Unsafe (unsafePerformIO) + +import Data.Text.Lazy.Encoding +import Data.ByteString.Lazy.Internal as Lazy +import Data.ByteString.Internal as Strict +import Data.ByteString.Short.Internal as Strict +import Data.Bits ((.|.)) +import Data.Char (ord) + data Buffer = Buffer { text :: Either Lazy.Text Lazy.ByteString, contentType :: Maybe ContentType, @@ -46,3 +59,85 @@ dirBackward dir = dir `Prelude.elem` [DirRTL, DirBTT] dirForward dir = dir `Prelude.elem` [DirLTR, DirTTB] dirHorizontal dir = dir `Prelude.elem` [DirLTR, DirRTL] dirVertical dir = dir `Prelude.elem` [DirTTB, DirBTT] + +--- + +type Buffer' = ForeignPtr Buffer'' +data Buffer'' + +buffer2buffer' buf = unsafePerformIO $ do + buffer <- hb_buffer_create + case text buf of + Right bs -> hb_buffer_add_bytestring buffer bs + -- Convert text to bytestring for now due to the text 2.0 UTF-8 transition. + -- Unfortunately this may prevent Harfbuzz from reading opening context + -- So for correctness we'll eventually want to depend on text>2.0 + Left txt -> hb_buffer_add_bytestring buffer $ encodeUtf8 txt + hb_buffer_set_content_type buffer $ case contentType buf of + Nothing -> 0 + Just ContentTypeUnicode -> 1 + Just ContentTypeGlyphs -> 2 + hb_buffer_set_direction buffer $ case direction buf of + Nothing -> 0 + Just DirLTR -> 4 + Just DirRTL -> 5 + Just DirTTB -> 6 + Just DirBTT -> 7 + case script buf of + Just script' -> hb_buffer_set_script buffer =<< hb_script_from_txt script' + Nothing -> return () + case language buf of + Just lang' -> hb_buffer_set_language buffer =<< hb_language_from_txt lang' + Nothing -> return () + hb_buffer_set_flags buffer $ Prelude.foldl (.|.) 0 [ + if beginsText buf then 1 else 0, + if endsText buf then 2 else 0, + if preserveDefaultIgnorables buf then 4 else 0, + if removeDefaultIgnorables buf then 8 else 0, + if don'tInsertDottedCircle buf then 16 else 0 + ] + hb_buffer_set_cluster_level buffer $ case clusterLevel buf of + ClusterMonotoneGraphemes -> 0 + ClusterMonotoneChars -> 1 + ClusterChars -> 2 + hb_buffer_set_invisible_glyph buffer $ ord $ invisibleGlyph buf + hb_buffer_set_not_found_glyph buffer $ ord $ notFoundGlyph buf + hb_buffer_set_replacement_codepoint buffer $ ord $ replacementCodepoint buf + newForeignPtr hb_buffer_destroy buffer + +buffer'2buffer buf' = unsafePerformIO $ do + return () + +foreign import ccall "hb_buffer_create" hb_buffer_create :: IO (Ptr Buffer'') +foreign import ccall "&hb_buffer_destroy" hb_buffer_destroy :: FunPtr (Ptr Buffer'' -> IO ()) +foreign import ccall "hb_buffer_add_utf8" hb_buffer_add_utf8 + :: Ptr Buffer'' -> Ptr Word8 -> Int -> Int -> Int -> IO () +hb_buffer_add_bytestring _ Lazy.Empty = return () +hb_buffer_add_bytestring buf (Lazy.Chunk (Strict.PS ptr offset length) next) = do + withForeignPtr ptr $ \ptr' -> hb_buffer_add_utf8 buf ptr' length offset (length - offset) + hb_buffer_add_bytestring buf next +foreign import ccall "hb_buffer_set_content_type" hb_buffer_set_content_type + :: Ptr Buffer'' -> Int -> IO () +foreign import ccall "hb_buffer_set_direction" hb_buffer_set_direction + :: Ptr Buffer'' -> Int -> IO () +foreign import ccall "hb_script_from_string" hb_script_from_string + :: Ptr Word8 -> Int -> Int +hb_script_from_txt txt = let Strict.PS ptr offset size = toByteString txt + in withForeignPtr ptr $ \ptr' -> return $ hb_script_from_string ptr' size +foreign import ccall "hb_buffer_set_script" hb_buffer_set_script + :: Ptr Buffer'' -> Int -> IO () +foreign import ccall "hb_language_from_string" hb_language_from_string + :: Ptr Word8 -> Int -> Int +hb_language_from_txt txt = let Strict.PS ptr offset size = toByteString txt + in withForeignPtr ptr $ \ptr' -> return $ hb_script_from_string ptr' size +foreign import ccall "hb_buffer_set_language" hb_buffer_set_language + :: Ptr Buffer'' -> Int -> IO () +foreign import ccall "hb_buffer_set_flags" hb_buffer_set_flags :: Ptr Buffer'' -> Int -> IO () +foreign import ccall "hb_buffer_set_cluster_level" hb_buffer_set_cluster_level + :: Ptr Buffer'' -> Int -> IO () +foreign import ccall "hb_buffer_set_invisible_glyph" hb_buffer_set_invisible_glyph + :: Ptr Buffer'' -> Int -> IO () +foreign import ccall "hb_buffer_set_not_found_glyph" hb_buffer_set_not_found_glyph + :: Ptr Buffer'' -> Int -> IO () +foreign import ccall "hb_buffer_set_replacement_codepoint" hb_buffer_set_replacement_codepoint + :: Ptr Buffer'' -> Int -> IO () diff --git a/Main.hs b/Main.hs new file mode 100644 index 0000000..456e290 --- /dev/null +++ b/Main.hs @@ -0,0 +1,9 @@ +{-# LANGUAGE PackageImports #-} +module Main where + +import "harfbuzz-pure" Data.Text.Glyphize + +main :: IO () +main = do + putStr "Hello, world!\n" + -- TODO test I can shape text! diff --git a/harfbuzz-pure.cabal b/harfbuzz-pure.cabal index 584bd26..052de30 100644 --- a/harfbuzz-pure.cabal +++ b/harfbuzz-pure.cabal @@ -68,4 +68,18 @@ library -- Base language which the package is written in. default-language: Haskell2010 - + +executable shape-text + -- .hs file containing the Main module + main-is: Main.hs + + -- Other library packages from which modules are imported + build-depends: base >=4.9 && <5, harfbuzz-pure + + -- Directories containing source files. + hs-source-dirs: . + + -- Base language which the package is written in. + default-language: Haskell2010 + + ghc-options: -threaded -- 2.30.2