diff --git a/Graphics/PDF/Draw.hs b/Graphics/PDF/Draw.hs index eff9001..a5402ca 100644 --- a/Graphics/PDF/Draw.hs +++ b/Graphics/PDF/Draw.hs @@ -252,9 +252,11 @@ pdfDictMember k (PDFDictionary d) = M.member k d -- | Get a new resource name supplyName :: Draw String supplyName = do - (x:xs) <- gets supplyNames - modifyStrict $ \s -> s {supplyNames = xs} - return x + xs <- gets supplyNames + modifyStrict $ \s -> s {supplyNames = tail xs} + if xs == [] + then return "" + else return (head xs) emptyDrawState :: Int -> DrawState emptyDrawState ref = diff --git a/Graphics/PDF/Fonts/AFMParser.hs b/Graphics/PDF/Fonts/AFMParser.hs index ff517f1..16e0a80 100644 --- a/Graphics/PDF/Fonts/AFMParser.hs +++ b/Graphics/PDF/Fonts/AFMParser.hs @@ -23,22 +23,15 @@ module Graphics.PDF.Fonts.AFMParser( ) where import Text.ParserCombinators.Parsec hiding(space) -import Text.ParserCombinators.Parsec.Prim -import Text.ParserCombinators.Parsec.Char hiding(space) import Text.Parsec(modifyState,getState) import Text.Parsec.Prim(parserZero) import Data.Char(toUpper) -import System.Environment -import Data.Maybe(isJust,fromJust,mapMaybe) -import qualified Data.IntMap as IM -import Data.List(intersperse) import qualified Data.Map.Strict as M import Graphics.PDF.Fonts.Font(emptyFontStructure) import Paths_HPDF import Graphics.PDF.LowLevel.Types import Graphics.PDF.Fonts.Encoding(PostscriptName) import Graphics.PDF.Fonts.FontTypes -import Control.Monad.State data Metric = Metric { charCode :: Int , metricWidth :: Int @@ -74,6 +67,7 @@ data AFMFont = AFMFont { metrics :: [Metric] type AFMParser = GenParser Char AFMFont +emptyAFM :: AFMFont emptyAFM = AFMFont { metrics = [] , underlinePosition = 0 , underlineThickness = 0 @@ -95,11 +89,11 @@ capitalize (h:t) = toUpper h : t line :: AFMParser () -line = do string "\r\n" <|> string "\n" +line = do _ <- string "\r\n" <|> string "\n" return () toEndOfLine :: AFMParser () -toEndOfLine = do many (noneOf "\r\n") +toEndOfLine = do _ <- many (noneOf "\r\n") line return () @@ -109,22 +103,21 @@ getString = do line return c -getSentence :: AFMParser String -getSentence = do - c <- many1 (alphaNum <|> oneOf " -+") - line - return c +-- getSentence :: AFMParser String +-- getSentence = do +-- c <- many1 (alphaNum <|> oneOf " -+") +-- line +-- return c -getName :: AFMParser String -getName = do - c <- alphaNum >> many (alphaNum <|> oneOf " -+") - line - return c +-- getName :: AFMParser String +-- getName = do +-- c <- alphaNum >> many (alphaNum <|> oneOf " -+") +-- line +-- return c getInt :: AFMParser Int -getInt = do c <- getString - return $ read c +getInt = read <$> getString getFloat :: AFMParser Double getFloat = do @@ -133,8 +126,7 @@ getFloat = do return $ read c getBool :: AFMParser Bool -getBool = do c <- getString - return $ read (capitalize c) +getBool = read . capitalize <$> getString data CharacterSet = ExtendedRoman | Special @@ -145,15 +137,12 @@ data Weight = Medium | Roman deriving(Eq,Read,Show) -getCharacterSet :: AFMParser CharacterSet -getCharacterSet = do c <- getString - return $ read c +-- getCharacterSet :: AFMParser CharacterSet +-- getCharacterSet = read <$> getString -getWeigth :: AFMParser Weight -getWeigth = do c <- getString - return $ read c - - +-- getWeigth :: AFMParser Weight +-- getWeigth = read <$> getString + array :: AFMParser [String] array = sepEndBy (many1 (oneOf "-+0123456789")) (many1 (oneOf " ")) @@ -184,40 +173,36 @@ data Elem = C Int deriving(Eq,Read,Show) metricElem :: AFMParser Elem -metricElem = do char 'C' +metricElem = do _ <- char 'C' spaces - c <- number - return $ C c + C <$> number <|> - do string "WX" + do _ <- string "WX" spaces - c <- number - return $ WX c + WX <$> number <|> - do char 'N' + do _ <- char 'N' spaces c <- many1 (alphaNum <|> char '.') return $ N c <|> - do char 'B' + do _ <- char 'B' spaces c <- array return . B . map read $ c <|> - do char 'L' + do _ <- char 'L' spaces - many1 letter + _ <- many1 letter spaces - many1 letter + _ <- many1 letter return L - - - -isEncoded :: Metric -> Bool -isEncoded (Metric c _ _ _) = c /= (-1) + +-- isEncoded :: Metric -> Bool +-- isEncoded (Metric c _ _ _) = c /= (-1) mkMetric :: [Elem] -> Metric -mkMetric l = foldr addElem (Metric (-1) 0 "" []) l +mkMetric = foldr addElem (Metric (-1) 0 "" []) where addElem (C c) m = m {charCode=c} addElem (WX c) m = m {metricWidth=c} @@ -234,7 +219,7 @@ charMetric = do kernPair :: AFMParser KX -kernPair = do string "KPX" +kernPair = do _ <- string "KPX" spaces namea <- many1 alphaNum spaces @@ -248,20 +233,20 @@ kernPair = do string "KPX" keyword :: String -> AFMParser () -> AFMParser () keyword s action = do - string s + _ <- string s spaces action return () -anyKeyWord :: AFMParser () -anyKeyWord = do - many1 alphaNum - spaces - toEndOfLine +-- anyKeyWord :: AFMParser () +-- anyKeyWord = do +-- _ <- many1 alphaNum +-- spaces +-- toEndOfLine header :: String -> AFMParser () header s = do - string s + _ <- string s toEndOfLine return () @@ -275,16 +260,16 @@ notHeader s = do toEndOfLine specific :: AFMParser () -specific = choice [ try $ keyword "FontName" (getString >>= \name -> modifyState $ \afm -> afm {type1BaseFont = name}) - , try $ keyword "UnderlinePosition" (getInt >>= \name -> modifyState $ \afm -> afm {underlinePosition = name}) - , try $ keyword "UnderlineThickness" (getInt >>= \name -> modifyState $ \afm -> afm {underlineThickness = name}) - , try $ keyword "EncodingScheme" (getEncoding >>= \name -> modifyState $ \afm -> afm {encodingScheme = name}) - , try $ keyword "CapHeight" (getInt >>= \name -> modifyState $ \afm -> afm {afmCapHeight = name}) - , try $ keyword "Ascender" (getInt >>= \name -> modifyState $ \afm -> afm {afmAscent = name}) - , try $ keyword "Descender" (getInt >>= \name -> modifyState $ \afm -> afm {afmDescent = name}) - , try $ keyword "ItalicAngle" (getFloat >>= \name -> modifyState $ \afm -> afm {afmItalic = name}) - , try $ keyword "IsFixedPitch" (getBool >>= \name -> modifyState $ \afm -> afm {afmFixedPitch = name}) - , try $ keyword "FontBBox" (getArray >>= \name -> modifyState $ \afm -> afm {afmBBox = name}) +specific = choice [ try $ keyword "FontName" (getString >>= \name' -> modifyState $ \afm' -> afm' {type1BaseFont = name'}) + , try $ keyword "UnderlinePosition" (getInt >>= \name' -> modifyState $ \afm' -> afm' {underlinePosition = name'}) + , try $ keyword "UnderlineThickness" (getInt >>= \name' -> modifyState $ \afm' -> afm' {underlineThickness = name'}) + , try $ keyword "EncodingScheme" (getEncoding >>= \name' -> modifyState $ \afm' -> afm' {encodingScheme = name'}) + , try $ keyword "CapHeight" (getInt >>= \name' -> modifyState $ \afm' -> afm' {afmCapHeight = name'}) + , try $ keyword "Ascender" (getInt >>= \name' -> modifyState $ \afm' -> afm' {afmAscent = name'}) + , try $ keyword "Descender" (getInt >>= \name' -> modifyState $ \afm' -> afm' {afmDescent = name'}) + , try $ keyword "ItalicAngle" (getFloat >>= \name' -> modifyState $ \afm' -> afm' {afmItalic = name'}) + , try $ keyword "IsFixedPitch" (getBool >>= \name' -> modifyState $ \afm' -> afm' {afmFixedPitch = name'}) + , try $ keyword "FontBBox" (getArray >>= \name' -> modifyState $ \afm' -> afm' {afmBBox = name'}) , try $ notHeader "StartCharMetrics" ] @@ -302,32 +287,32 @@ afm :: AFMParser AFMFont afm = do header "StartFontMetrics" - many1 specific + _ <- many1 specific header "StartCharMetrics" charMetrics <- many1 charMetric header "EndCharMetrics" kerns <- option Nothing getKernData - string "EndFontMetrics" + _ <- string "EndFontMetrics" - modifyState $ \afm -> afm { metrics = charMetrics - , kernData = kerns - } + modifyState $ \afm' -> afm' { metrics = charMetrics + , kernData = kerns + } - afm <- getState - let [xmin,ymin,xmax,ymax] = afmBBox afm - if afmAscent afm == 0 + afm' <- getState + let [_,ymin,_,ymax] = afmBBox afm' + if afmAscent afm' == 0 then - if afmCapHeight afm /= 0 + if afmCapHeight afm' /= 0 then - return $ afm { afmAscent = afmCapHeight afm - } + return $ afm' { afmAscent = afmCapHeight afm' + } else let h = floor (ymax - ymin) in - return $ afm { afmAscent = h - , afmDescent = 0 - } + return $ afm' { afmAscent = h + , afmDescent = 0 + } else - return $ afm + return $ afm' addMetric :: M.Map PostscriptName GlyphCode -> Metric -> FontStructure -> FontStructure addMetric nameToGlyph m fs = @@ -359,31 +344,31 @@ fontToStructure :: AFMFont -> M.Map PostscriptName Char -> Maybe (M.Map PostscriptName GlyphCode) -> FontStructure -fontToStructure afm encoding maybeMapNameToGlyph = - let h = (afmAscent afm - afmDescent afm) - fs = emptyFontStructure { descent = fromIntegral $ - (afmDescent afm) +fontToStructure afm' encoding' maybeMapNameToGlyph = + let h = (afmAscent afm' - afmDescent afm') + fs = emptyFontStructure { descent = fromIntegral $ - (afmDescent afm') , height = fromIntegral $ h - , ascent = fromIntegral $ afmAscent afm - , fontBBox = afmBBox afm - , italicAngle = afmItalic afm - , capHeight = fromIntegral $ afmCapHeight afm - , fixedPitch = afmFixedPitch afm + , ascent = fromIntegral $ afmAscent afm' + , fontBBox = afmBBox afm' + , italicAngle = afmItalic afm' + , capHeight = fromIntegral $ afmCapHeight afm' + , fixedPitch = afmFixedPitch afm' , serif = False - , symbolic = afmSymbolic afm + , symbolic = afmSymbolic afm' , script = False - , nonSymbolic = not (afmSymbolic afm) + , nonSymbolic = not (afmSymbolic afm') , italic = False , allCap = False , smallCap = False , forceBold = False - , baseFont = type1BaseFont afm + , baseFont = type1BaseFont afm' } addName m d | charCode m == -1 = d | otherwise = M.insert (name m) (fromIntegral $ charCode m) d - nameToGlyph = maybe (foldr addName M.empty (metrics afm)) id maybeMapNameToGlyph - fs1 = foldr (addMetric nameToGlyph) fs (metrics afm) + nameToGlyph = maybe (foldr addName M.empty (metrics afm')) id maybeMapNameToGlyph + fs1 = foldr (addMetric nameToGlyph) fs (metrics afm') addEncodingMapping (pname,glyphcode) d = - let unicodeM = M.lookup pname encoding + let unicodeM = M.lookup pname encoding' in case unicodeM of Nothing -> d @@ -391,7 +376,7 @@ fontToStructure afm encoding maybeMapNameToGlyph = mapping = foldr addEncodingMapping M.empty (M.toList nameToGlyph) fs2 = fs1 { encoding = mapping} in - case kernData afm of + case kernData afm' of Nothing -> fs2 Just k -> foldr (addKern nameToGlyph) fs2 k @@ -406,21 +391,21 @@ parseFont (Left s) = do r <- afmParseFromFile afm path case r of Left e -> error (show e) - Right r -> return $ Just r + Right r' -> return $ Just r' parseFont (Right path) = do r <- afmParseFromFile afm path case r of Left e -> error (show e) - Right r -> return $ Just r + Right r' -> return $ Just r' getFont :: Either String AFMFont -> M.Map PostscriptName Char -- ^ Glyph name to unicode -> Maybe (M.Map PostscriptName GlyphCode) -- ^ Glyph name to glyph code if not standard coding -> IO (Maybe FontStructure) -getFont (Left s) encoding nameToGlyph = do +getFont (Left s) encoding' nameToGlyph = do result <- parseFont (Left s) case result of Nothing -> return Nothing - Just r -> return (Just $ fontToStructure r encoding nameToGlyph) -getFont (Right result) encoding nameToGlyph = return . Just $ fontToStructure result encoding nameToGlyph + Just r -> return (Just $ fontToStructure r encoding' nameToGlyph) +getFont (Right result) encoding' nameToGlyph = return . Just $ fontToStructure result encoding' nameToGlyph diff --git a/Graphics/PDF/Fonts/Encoding.hs b/Graphics/PDF/Fonts/Encoding.hs index e54b68c..143ed7b 100644 --- a/Graphics/PDF/Fonts/Encoding.hs +++ b/Graphics/PDF/Fonts/Encoding.hs @@ -20,16 +20,12 @@ module Graphics.PDF.Fonts.Encoding( ) where import Graphics.PDF.LowLevel.Types -import Data.Char import qualified Data.Map.Strict as M -import Graphics.PDF.Fonts.Font import System.FilePath import Paths_HPDF import qualified Data.ByteString.Char8 as C import Data.Char(digitToInt) import Data.Maybe(mapMaybe) -import qualified Data.Text as T -import qualified Data.Text.IO as T type PostscriptName = String @@ -42,10 +38,10 @@ isLine c | not (C.null c) = C.head c /= '#' | otherwise = False from4Hexa :: C.ByteString -> Int -from4Hexa a = sum . map (\(x,y) -> x * y) $ zip (map digitToInt . C.unpack $ a) (map (\x -> 16^x) [3,2,1,0]) +from4Hexa a = sum . map (\(x,y) -> x * y) $ zip (map digitToInt . C.unpack $ a) (map (\x -> 16^x) ([3,2,1,0] :: [Integer])) from3Octal:: C.ByteString -> Int -from3Octal a = sum . map (\(x,y) -> x * y) $ zip (map digitToInt . C.unpack $ a) (map (\x -> 8^x) [2,1,0]) +from3Octal a = sum . map (\(x,y) -> x * y) $ zip (map digitToInt . C.unpack $ a) (map (\x -> 8^x) ([2,1,0] :: [Integer])) toData :: [C.ByteString] -> Maybe (PostscriptName,Char) diff --git a/Graphics/PDF/Fonts/FontTypes.hs b/Graphics/PDF/Fonts/FontTypes.hs index 07c8745..4bb5912 100644 --- a/Graphics/PDF/Fonts/FontTypes.hs +++ b/Graphics/PDF/Fonts/FontTypes.hs @@ -17,8 +17,6 @@ module Graphics.PDF.Fonts.FontTypes( , FontStructure(..) , GlyphPair(..) , FontData(..) - , StdFont(..) - , Type1Font(..) , mkFlags ) where @@ -73,11 +71,8 @@ mkFlags fs = bit (fixedPitch fs) 1 .|. bit True n = (1 `shiftL` (n-1)) bit False _ = 0 -data StdFont = StdFont FontStructure -data Type1Font = Type1Font FontStructure (PDFReference EmbeddedFont) - data FontData = Type1Data B.ByteString diff --git a/Graphics/PDF/Fonts/StandardFont.hs b/Graphics/PDF/Fonts/StandardFont.hs index ba770d2..c715c96 100644 --- a/Graphics/PDF/Fonts/StandardFont.hs +++ b/Graphics/PDF/Fonts/StandardFont.hs @@ -16,17 +16,16 @@ module Graphics.PDF.Fonts.StandardFont( IsFont , GlyphSize , FontName(..) - , StdFont + , StdFont(..) , mkStdFont ) where import Graphics.PDF.LowLevel.Types import Graphics.PDF.Resources -import Data.Char import qualified Data.Map.Strict as M import Graphics.PDF.Fonts.Font -import Graphics.PDF.Fonts.AFMParser(getFont,parseFont,AFMFont(..)) +import Graphics.PDF.Fonts.AFMParser(getFont) import System.FilePath import Graphics.PDF.Fonts.Encoding import Graphics.PDF.Fonts.FontTypes @@ -66,15 +65,18 @@ instance Show FontName where show ZapfDingbats = "ZapfDingbats" + +data StdFont = StdFont FontStructure + instance PdfResourceObject StdFont where toRsrc (StdFont f) = AnyPdfObject . PDFDictionary . M.fromList $ [(PDFName "Type",AnyPdfObject . PDFName $ "Font") , (PDFName "Subtype",AnyPdfObject . PDFName $ "Type1") , (PDFName "BaseFont",AnyPdfObject . PDFName $ baseFont f) - ] ++ encoding - where encoding | baseFont f == show Symbol = [] - | baseFont f == show ZapfDingbats = [] - | otherwise = [(PDFName "Encoding",AnyPdfObject . PDFName $ "MacRomanEncoding")] + ] ++ encoding' + where encoding' | baseFont f == show Symbol = [] + | baseFont f == show ZapfDingbats = [] + | otherwise = [(PDFName "Encoding",AnyPdfObject . PDFName $ "MacRomanEncoding")] instance IsFont StdFont where getDescent (StdFont fs) s = trueSize s $ descent fs diff --git a/Graphics/PDF/Fonts/Type1.hs b/Graphics/PDF/Fonts/Type1.hs index 7f095d1..892aea7 100644 --- a/Graphics/PDF/Fonts/Type1.hs +++ b/Graphics/PDF/Fonts/Type1.hs @@ -15,7 +15,7 @@ module Graphics.PDF.Fonts.Type1( IsFont , GlyphSize - , Type1Font + , Type1Font(..) , AFMData , Type1FontStructure(..) , getAfmData @@ -24,16 +24,15 @@ module Graphics.PDF.Fonts.Type1( import Graphics.PDF.LowLevel.Types import Graphics.PDF.Resources -import Data.Char import qualified Data.Map.Strict as M import Graphics.PDF.Fonts.Font -import Graphics.PDF.Fonts.AFMParser -import System.FilePath +-- import Graphics.PDF.Fonts.AFMParser import Graphics.PDF.Fonts.Encoding import Graphics.PDF.Fonts.FontTypes -import Graphics.PDF.Fonts.AFMParser (AFMFont, parseFont) -import Data.List -import Data.Function(on) +import Graphics.PDF.Fonts.AFMParser (AFMFont, getFont, parseFont) +import Data.List + +data Type1Font = Type1Font FontStructure (PDFReference EmbeddedFont) instance IsFont Type1Font where getDescent (Type1Font fs _) s = trueSize s $ descent fs diff --git a/Graphics/PDF/LowLevel/Serializer.hs b/Graphics/PDF/LowLevel/Serializer.hs index 488e135..eb97add 100644 --- a/Graphics/PDF/LowLevel/Serializer.hs +++ b/Graphics/PDF/LowLevel/Serializer.hs @@ -18,9 +18,6 @@ module Graphics.PDF.LowLevel.Serializer( SerializeValue(..) ) where - -import Data.Monoid - import Data.Word import qualified Data.ByteString.Lazy as B import qualified Data.Binary.Builder as BU diff --git a/Graphics/PDF/Pages.hs b/Graphics/PDF/Pages.hs index ee4b3bb..293836f 100644 --- a/Graphics/PDF/Pages.hs +++ b/Graphics/PDF/Pages.hs @@ -46,8 +46,8 @@ import Data.List(zip4) import Graphics.PDF.Fonts.Font import Graphics.PDF.Data.PDFTree(PDFTree,Key) import Control.Monad.Writer -import Data.Binary.Builder(Builder,fromLazyByteString,fromByteString) -import Graphics.PDF.Fonts.FontTypes(FontData(..),Type1Font(..)) +import Data.Binary.Builder(fromByteString) +import Graphics.PDF.Fonts.FontTypes(FontData(..)) import Graphics.PDF.Fonts.Type1 -- | Set page annotations diff --git a/Graphics/PDF/Typesetting.hs b/Graphics/PDF/Typesetting.hs index fed02f7..10ca2e3 100644 --- a/Graphics/PDF/Typesetting.hs +++ b/Graphics/PDF/Typesetting.hs @@ -110,8 +110,6 @@ import Graphics.PDF.Typesetting.Layout import Graphics.PDF.Typesetting.Box import Graphics.PDF.Typesetting.StandardStyle import Graphics.PDF.Typesetting.WritingSystem -import Data.List(unfoldr,intersperse) -import Data.Char(isSpace,isAlpha) import qualified Data.Text as T -- | Display a formatted text in a given bounding rectangle with a given default paragraph style, a given default text style. No clipping diff --git a/Graphics/PDF/Typesetting/Breaking.hs b/Graphics/PDF/Typesetting/Breaking.hs index 9af38cb..43d884e 100644 --- a/Graphics/PDF/Typesetting/Breaking.hs +++ b/Graphics/PDF/Typesetting/Breaking.hs @@ -635,7 +635,7 @@ ripText :: Style s -> BRState -> [SpecialChar] -- ^ Special meaning glyph -> [Letter s] -- ^ List of chars and char width taking into account kerning -ripText s settings [] = [] +ripText _ _ [] = [] ripText s settings (NormalChar ca:BreakingHyphen:NormalChar cb:l) = let PDFFont f fontSize = (textFont . textStyle $ s) ga = charGlyph f ca diff --git a/Graphics/PDF/Typesetting/Horizontal.hs b/Graphics/PDF/Typesetting/Horizontal.hs index 4fd2ec0..1a2c1dd 100644 --- a/Graphics/PDF/Typesetting/Horizontal.hs +++ b/Graphics/PDF/Typesetting/Horizontal.hs @@ -35,7 +35,6 @@ import Graphics.PDF.Typesetting.Box import Control.Monad.Writer(tell) import Control.Monad(when) import Graphics.PDF.LowLevel.Serializer -import Graphics.PDF.Fonts.Font(AnyFont) -- | Current word (created from letter) is converted to a PDFString saveCurrentword :: PDFGlyph -> PDFGlyph @@ -328,7 +327,6 @@ instance (Style s) => DisplayableBox (HBox s) where let de = boxDescent a he = boxHeight a y' = y - he + de - theFont = styleFont style -- In word mode we have to apply a special function to the word -- otherwise we apply a different function to the sentence if (isJust . wordStyle $ style) diff --git a/HPDF.cabal b/HPDF.cabal index 752fe9c..5f54cf2 100644 --- a/HPDF.cabal +++ b/HPDF.cabal @@ -17,7 +17,7 @@ extra-source-files: Test/Makefile Test/Penrose.hs Test/test.hs - README.txt + README.md NEWS.txt TODO.txt changelog diff --git a/stack.yaml b/stack.yaml index 655499c..f9d03ad 100644 --- a/stack.yaml +++ b/stack.yaml @@ -1,7 +1,7 @@ # For more information, see: https://github.com/commercialhaskell/stack/blob/release/doc/yaml_configuration.md # Specifies the GHC version and set of packages available (e.g., lts-3.5, nightly-2015-09-21, ghc-7.10.2) -resolver: lts-6.14 +resolver: lts-13.6 # Local packages, usually specified by relative directory name packages: