SVGFonts 1.5.0.1 → 1.6.0.0

raw patch · 5 files changed

+89/−48 lines, 5 filesdep +bytestringdep +cerealdep +cereal-vectorPVP ok

version bump matches the API change (PVP)

Dependencies added: bytestring, cereal, cereal-vector

API changes (from Hackage documentation)

Files

• CHANGES.md +8/−0
• LICENSE +6/−0
• SVGFonts.cabal +5/−2
• src/Graphics/SVGFonts/ReadFont.hs +35/−14
• src/Graphics/SVGFonts/ReadPath.hs +35/−32

@@ -1,3 +1,11 @@+1.6 (8 August 2016)+-------------------++- Performance improvement: port ReadPath to use attoparsec+- New `loadFont'` function, to read font data from an XmlSource+- Export `Kern(..)` from `Graphics.SVGFonts.ReadFont`+- New `Serialize` instances for `FontData` and `Kern`+ 1.5.0.1 (6 June 2016) --------------------- 

@@ -1,6 +1,12 @@ Copyright (c) 2013, SVGFonts team:
 
+  Daniel Bergey <bergey@alum.mit.edu>
   Jan Bracker <jan.bracker@googlemail.com>
+  Christopher Chalmers <c.chalmers@me.com>
+  Ben Gamari <ben@smart-cactus.org>
+  Gabor Greif <ggreif@gmail.com>
+  Niklas Hambüchen <mail@nh2.me>
+  Sidharth Kapur <sidharthkapur1@gmail.com>
   Chris Mears <chris@cmears.id.au>
   Jeffrey Rosenbluth <jeffrey.rosenbluth@gmail.com>
   Tillmann Vogt <tillk.vogt@googlemail.com>

@@ -1,5 +1,5 @@ Name:             SVGFonts-Version:          1.5.0.1+Version:          1.6.0.0 Synopsis:         Fonts from the SVG-Font format Description:      Native font support for the diagrams framework (<http://projects.haskell.org/diagrams/>). Note that this package can be used with any diagrams backend, not just the SVG backend.  The SVG-font format is easy to parse                   and was therefore chosen for a font library completely written in Haskell.@@ -48,7 +48,7 @@ data-files:       fonts/*.svg extra-source-files: CHANGES.md, README.md, diagrams/*.svg extra-doc-files:    diagrams/*.svg-Tested-with:         GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.1+Tested-with:      GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.2, GHC == 8.0.1 source-repository head   type: git   location: https://github.com/diagrams/SVGFonts.git@@ -60,6 +60,9 @@     build-depends:         attoparsec,         base == 4.*,+        bytestring >= 0.10 && < 1.0,+        cereal,+        cereal-vector,         containers >= 0.4 && < 0.6,         data-default-class < 0.2,         diagrams-core >= 1.3 && < 1.4,

@@ -1,3 +1,4 @@+{-# LANGUAGE DeriveGeneric #-} module Graphics.SVGFonts.ReadFont        (          FontData(..)@@ -10,10 +11,12 @@         , horizontalAdvance        , kernAdvance+       , Kern(..)         , OutlineMap        , PreparedFont        , loadFont+       , loadFont'        ) where  import           Data.Char                       (isSpace)@@ -28,11 +31,16 @@ import           Diagrams.Path import           Diagrams.Prelude                hiding (font) import           Text.XML.Light+import           Text.XML.Light.Lexer (XmlSource)  import           Graphics.SVGFonts.CharReference (charsFromFullName) import           Graphics.SVGFonts.ReadPath      (PathCommand (..),                                                   pathFromString) +import           GHC.Generics                    (Generic)+import           Data.Serialize                  (Serialize)+import           Data.Vector.Serialize           ()+ -- | This type contains everything that a typical SVG font file produced --   by fontforge contains. data FontData n = FontData@@ -76,18 +84,20 @@   , fontDataVAlphabeticBaseline    :: Maybe n   , fontDataVMathematicalBaseline  :: Maybe n   , fontDataVHangingBaseline       :: Maybe n-  }+  } deriving (Generic) +instance Serialize n => Serialize (FontData n)+ -- | Open an SVG-Font File and extract the data-parseFont :: (Read n, RealFloat n) => FilePath -> String -> FontData n-parseFont filename contents = readFontData fontElement filename+parseFont :: (XmlSource s, Read n, RealFloat n) => FilePath -> s -> FontData n+parseFont basename contents = readFontData fontElement basename   where     xml = onlyElems $ parseXML $ contents     fontElement = head $ catMaybes $ map (findElement (unqual "font")) xml  -- | Read font data from an XML font element.-readFontData :: (Read n, RealFloat n) => Element -> FilePath -> FontData n-readFontData fontElement file = FontData+readFontData :: (Read n, RealFloat n) => Element -> String -> FontData n+readFontData fontElement basename = FontData   { fontDataGlyphs      = Map.fromList glyphs   , fontDataKerning     = Kern     { kernU1S = transformChars u1s@@ -97,7 +107,7 @@     , kernK = kAr     }   , fontDataBoundingBox = parsedBBox-  , fontDataFileName    = fname file+  , fontDataFileName    = basename   , fontDataUnderlinePos       = fontface `readAttr` "underline-position"   , fontDataUnderlineThickness = fontface `readAttr` "underline-thickness"   , fontDataHorizontalAdvance  = fontHadv@@ -201,7 +211,6 @@     multiSet (a:b:bs) | fst a == fst b = multiSet ( (fst a, (snd a) ++ (snd b)) : bs)                       | otherwise = a : (multiSet (b:bs)) -    fname f = last $ init $ concat (map (splitOn "/") (splitOn "." f))   type SvgGlyphs n = Map.Map String (String, n, String)@@ -234,8 +243,10 @@   , kernG1S :: Map.Map String [Int]   , kernG2S :: Map.Map String [Int]   , kernK   :: V.Vector n-  } deriving Show+  } deriving (Show, Generic) +instance Serialize n => Serialize (Kern n)+ -- | Change the horizontal advance of two consective chars (kerning) kernAdvance :: RealFloat n => String -> String -> Kern n -> Bool -> n kernAdvance ch0 ch1 kern u |     u && not (null s0) = (kernK kern) V.! (head s0)@@ -325,12 +336,22 @@ -- | Read font data from font file, and compute its outline map. loadFont :: (Read n, RealFloat n) => FilePath -> IO (PreparedFont n) loadFont filename = do-    fontData <- parseFont filename <$> readFile filename-    let (font, errs) = prepareFont fontData-    sequence_ [ putStrLn ("error parsing character '" ++ ch ++ "': " ++ err)-              | (ch, err) <- Map.toList errs-              ]-    return font+  s <- readFile filename+  let+    basename = last $ init $ concat (map (splitOn "/") (splitOn "." filename))+    (errors, font) = loadFont' basename s+  putStrLn errors+  return font++-- | Read font data from an XmlSource, and compute its outline map.+loadFont' :: (XmlSource s, Read n, RealFloat n) => String -> s -> (String, PreparedFont n)+loadFont' basename s =+  let+    fontData = parseFont basename s+    (font, errs) = prepareFont fontData+    errors = unlines $ map (\(ch, err) -> "error parsing character '" ++ ch ++ "': " ++ err) (Map.toList errs)+  in+    (errors, font)  commandsToTrails ::RealFloat n => [PathCommand n] -> [Segment Closed V2 n] -> V2 n -> V2 n -> V2 n -> [Path V2 n] commandsToTrails [] _ _ _ _ = []

@@ -14,48 +14,51 @@ 
 module Graphics.SVGFonts.ReadPath
  ( pathFromString,
+   pathFromByteString,
    PathCommand(..),
  )
  where
 
-#if __GLASGOW_HASKELL__ < 710
-import           Control.Applicative                    hiding (many, (<|>))
-#endif
+import           Control.Applicative
 
-import           Text.ParserCombinators.Parsec          hiding (spaces)
-import           Text.ParserCombinators.Parsec.Language (emptyDef)
-import qualified Text.ParserCombinators.Parsec.Token    as P
+import qualified Data.Attoparsec.ByteString.Char8 as P
+import Data.Attoparsec.ByteString.Char8 (Parser, skipMany, space, many1, try, char)
+import Data.ByteString.Char8 (ByteString)
+import qualified Data.ByteString.Char8 as BS
 
 data PathCommand n =
-  M_abs (n, n) | -- ^Establish a new current point (with absolute coords)
-  M_rel (n, n) | -- ^Establish a new current point (with coords relative to the current point)
+  M_abs !(n, n) | -- ^Establish a new current point (with absolute coords)
+  M_rel !(n, n) | -- ^Establish a new current point (with coords relative to the current point)
   Z | -- ^Close current subpath by drawing a straight line from current point to current subpath's initial point
-  L_abs (n, n) | -- ^A line from the current point to (n, n) which becomes the new current point
-  L_rel (n, n) |
-  H_abs n | -- ^A horizontal line from the current point (cpx, cpy) to (x, cpy)
-  H_rel n |
-  V_abs n | -- ^A vertical line from the current point (cpx, cpy) to (cpx, y)
-  V_rel n |
-  C_abs (n,n,n,n,n,n) | -- ^Draws a cubic Bézier curve from the current point to (x,y) using (x1,y1) as the
+  L_abs !(n, n) | -- ^A line from the current point to (n, n) which becomes the new current point
+  L_rel !(n, n) |
+  H_abs !n | -- ^A horizontal line from the current point (cpx, cpy) to (x, cpy)
+  H_rel !n |
+  V_abs !n | -- ^A vertical line from the current point (cpx, cpy) to (cpx, y)
+  V_rel !n |
+  C_abs !(n,n,n,n,n,n) | -- ^Draws a cubic Bézier curve from the current point to (x,y) using (x1,y1) as the
   -- ^control point at the beginning of the curve and (x2,y2) as the control point at the end of the curve.
-  C_rel (n,n,n,n,n,n) |
-  S_abs (n,n,n,n) | -- ^Draws a cubic Bézier curve from the current point to (x,y). The first control point is
+  C_rel !(n,n,n,n,n,n) |
+  S_abs !(n,n,n,n) | -- ^Draws a cubic Bézier curve from the current point to (x,y). The first control point is
 -- assumed to be the reflection of the second control point on the previous command relative to the current point.
 -- (If there is no previous command or if the previous command was not an C, c, S or s, assume the first control
 -- point is coincident with the current point.) (x2,y2) is the second control point (i.e., the control point at
 -- the end of the curve).
-  S_rel (n,n,n,n) |
-  Q_abs (n,n,n,n) | -- ^A quadr. Bézier curve from the curr. point to (x,y) using (x1,y1) as the control point
-  Q_rel (n,n,n,n) | -- ^Nearly the same as cubic, but with one point less
-  T_abs (n, n) | -- ^T_Abs = Shorthand/smooth quadratic Bezier curveto
-  T_rel (n, n) |
+  S_rel !(n,n,n,n) |
+  Q_abs !(n,n,n,n) | -- ^A quadr. Bézier curve from the curr. point to (x,y) using (x1,y1) as the control point
+  Q_rel !(n,n,n,n) | -- ^Nearly the same as cubic, but with one point less
+  T_abs !(n, n) | -- ^T_Abs = Shorthand/smooth quadratic Bezier curveto
+  T_rel !(n, n) |
   A_abs | -- ^A = Elliptic arc (not used)
   A_rel
   deriving Show
 
 -- | Convert a SVG path string into a list of commands
 pathFromString :: Fractional n => String -> Either String [PathCommand n]
-pathFromString str = case parse path "" str of
+pathFromString = pathFromByteString . BS.pack
+
+pathFromByteString :: Fractional n => ByteString -> Either String [PathCommand n]
+pathFromByteString str = case P.parseOnly path str of
   Left  err -> Left  (show err)
   Right p   -> Right p
 
@@ -64,7 +67,7 @@ 
 path :: Fractional n => Parser [PathCommand n]
 path = do{ l <- many pathElement
-         ; eof
+         ; P.endOfInput
          ; return (concat l)
          }
 
@@ -119,14 +122,14 @@           try float <|> -- 0 is not recognized as a float, so recognize it as an integer and then convert to float
               do { i<-integer; return(fromIntegral i) }
 
-lexer :: P.TokenParser a
-lexer = P.makeTokenParser emptyDef
-
 whiteSpace :: Parser ()
-whiteSpace      = P.whiteSpace lexer
-symbol :: String -> Parser String
-symbol          = P.symbol lexer
+whiteSpace      = P.skipSpace
+
+symbol :: String -> Parser ()
+symbol s        = P.string (BS.pack s) >> whiteSpace
+
 integer :: Parser Integer
-integer         = P.integer lexer
+integer         = P.decimal
+
 float :: Fractional n => Parser n
-float           = realToFrac <$> P.float lexer
+float           = realToFrac <$> P.double