Practice latest changes in Hufflepdf to implement various ways of revealing text and see how practical it is to actually write code with PDF.Box

This commit is contained in:
Tissevert 2020-02-25 17:39:18 +01:00
parent 308cfd4cbe
commit 4fe8ab2252

View file

@ -3,7 +3,7 @@
module Main where module Main where
import Codec.Compression.Zlib (compress, decompress) import Codec.Compression.Zlib (compress, decompress)
import Control.Monad.State (execState) import Control.Monad.State (execState, execStateT)
import Data.ByteString.Char8 (ByteString) import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as BS ( import qualified Data.ByteString.Char8 as BS (
length, readFile length, readFile
@ -12,8 +12,8 @@ import qualified Data.ByteString.Lazy.Char8 as Lazy (
fromStrict, intercalate, split, toStrict, writeFile fromStrict, intercalate, split, toStrict, writeFile
) )
import qualified Data.Map as Map (insert, lookup) import qualified Data.Map as Map (insert, lookup)
import PDF (Document(..), UnifiedLayers(..), parseDocument, render) import PDF (AllLayers(..), Document(..), UnifiedLayers(..), parseDocument, render)
import PDF.Box ((.@), modifyAt) import PDF.Box (I(..), (.@), edit, modifyAt)
import PDF.Layer (AllObjects(..)) import PDF.Layer (AllObjects(..))
import PDF.Object (DirectObject(..), Object(..), Name(..), Number(..)) import PDF.Object (DirectObject(..), Object(..), Name(..), Number(..))
import PDF.TextRendering (TextRendering(..), update) import PDF.TextRendering (TextRendering(..), update)
@ -47,6 +47,15 @@ reveal :: Document -> Document
reveal = execState $ do reveal = execState $ do
modifyAt (UnifiedLayers .@ AllObjects) (return . fmap revealObject) modifyAt (UnifiedLayers .@ AllObjects) (return . fmap revealObject)
revealFirst :: Document -> Document
revealFirst document = maybe document id $ execStateT (do
modifyAt (AllLayers .@ I 0 .@ AllObjects) (return . fmap revealObject)
) document
deepReveal :: Document -> Document
deepReveal = execState $ do
modifyAt AllLayers (mapM . edit AllObjects $ return . fmap revealObject)
main :: IO () main :: IO ()
main = do main = do
[inputPath, outputPath] <- getArgs [inputPath, outputPath] <- getArgs