Implement proper text formatting into PDF instructions using the new encode feature available in Fonts

This commit is contained in:
Tissevert 2020-03-08 00:04:18 +01:00
parent 457f1755e6
commit 0ade9cc2f5
1 changed files with 13 additions and 8 deletions

View File

@ -14,9 +14,9 @@ import Control.Monad (foldM)
import Control.Monad.Fail (MonadFail(..)) import Control.Monad.Fail (MonadFail(..))
import Control.Monad.Reader (MonadReader(..), asks, runReaderT) import Control.Monad.Reader (MonadReader(..), asks, runReaderT)
import Control.Monad.State (MonadState(..), evalStateT) import Control.Monad.State (MonadState(..), evalStateT)
import Data.ByteString.Char8 (pack)
import Data.Map ((!)) import Data.Map ((!))
import Data.Text (Text) import Data.Text (Text, breakOn)
import qualified Data.Text as Text (drop)
import PDF.Box (Box(..)) import PDF.Box (Box(..))
import PDF.Content ( import PDF.Content (
Content, ContentUnit(..), Id(..), Indexed, GraphicContextUnit(..) Content, ContentUnit(..), Id(..), Indexed, GraphicContextUnit(..)
@ -27,6 +27,7 @@ import PDF.Content.Operator (Instruction, Operator(..))
import PDF.Content.Operator.Text (Operator(..)) import PDF.Content.Operator.Text (Operator(..))
import PDF.Font (Font(..), FontSet, emptyFont) import PDF.Font (Font(..), FontSet, emptyFont)
import PDF.Object (DirectObject(..), StringObject(..), toByteString) import PDF.Object (DirectObject(..), StringObject(..), toByteString)
import PDF.Pages (Page(..))
import Prelude hiding (fail) import Prelude hiding (fail)
data ROContext = ROContext { data ROContext = ROContext {
@ -91,9 +92,13 @@ renderInstruction (Text DQuote, [StringObject outputString]) =
renderInstruction _ = return [] renderInstruction _ = return []
format :: String -> [Instruction] format :: (MonadFail m, MonadReader Font m) => Text -> m [Instruction]
format s = format input =
case break (== '\n') s of case breakOn "\n" input of
("", "") -> [] ("", "") -> return []
("", left) -> (Text Tstar, []) : format (drop 1 left) ("", left) -> ((Text Tstar, []) :) <$> format (Text.drop 1 left)
(line, left) -> (Text Tj, [StringObject . Literal $ pack line]) : format left (line, left) -> (:) <$> tj line <*> format left
where
tj t = do
literal <- either fail (return . Literal) =<< asks (($t) . encode)
return (Text Tj, [StringObject literal])