SVGFonts 1.1 → 1.1.1
raw patch · 6 files changed
+97/−62 lines, 6 filesdep ~diagrams-lib
Dependency ranges changed: diagrams-lib
Files
- LICENSE +1/−1
- README +27/−0
- SVGFonts.cabal +7/−7
- TODO +1/−1
- src/Graphics/SVGFonts/ReadFont.hs +59/−51
- src/Graphics/SVGFonts/ReadPath.hs +2/−2
LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) 2011, Tillmann Vogt +Copyright (c) 2012, Tillmann Vogt All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:
README view
@@ -1,5 +1,32 @@ SVGFonts +Native font support for the Diagrams library. The SVG-Font format is easy to parse and was therefore chosen for a font library completely written in Haskell + +You can convert your own font to SVG with http://fontforge.sourceforge.net/ or use the included LinLibertine, Bitstream + +Features + Complete implementation of the features that fontforge produces (but not the complete SVG format): + Kerning (i.e. the two characters in "VA" have a shorter distance than in "VV") + Unicode + Ligatures + +XML speed issues can be solved by trimming the svg file to only those characters that are used (or maybe binary xml one day) + +Version 1.0 of this library supports texturing which would only make sense in a Diagrams Backend that does rasterization in Haskell. + +Example: + # LANGUAGE NoMonomorphismRestriction # + + import Diagrams.Prelude + import Diagrams.Backend.Cairo.CmdLine + import Graphics.SVGFonts.ReadFont (textSVG,textSVG_) + + + main = defaultMain ( (text' "Hello World") <> (rect 8 1) # alignBL ) + + text' t = stroke (textSVG t 1) # fc purple # fillRule EvenOdd + text'' t = stroke (textSVG_ $ TextOpts t lin INSIDE_H KERN 1 1 ) # fc purple # fillRule EvenOdd + Usage: Convert your favourite font (i.e. .ttf) into a .svg file with fontforge (the menu item under "Save All"). If a font converted on your own doesn't work, try the repair options, and if this still
SVGFonts.cabal view
@@ -1,14 +1,14 @@ Name: SVGFonts -Version: 1.1 +Version: 1.1.1 Synopsis: Fonts from the SVG-Font format -Description: Native font support for the Diagrams library. The SVG-Font format is easy to parse - and was therefore chosen for a font library completely written in Haskell +Description: Native font support for the diagrams library. The SVG-Font format is easy to parse + and was therefore chosen for a font library completely written in Haskell. . You can convert your own font to SVG with <http://fontforge.sourceforge.net/> or use the included LinLibertine, Bitstream . Features . - * Complete implementation of the features that fontforge produces (but not the complete SVG format): + * Complete implementation of the features that Fontforge produces (but not the complete SVG format) . * Kerning (i.e. the two characters in \"VA\" have a shorter distance than in \"VV\") . @@ -16,7 +16,7 @@ . * Ligatures . - XML speed issues can be solved by trimming the svg file to only those characters that are used (or maybe binary xml one day) + XML speed issues can be solved by trimming the svg file to only those characters that are used (or maybe binary xml one day). . Version 1.0 of this library supports texturing which would only make sense in a Diagrams Backend that does rasterization in Haskell. . @@ -26,7 +26,7 @@ > > import Diagrams.Prelude > import Diagrams.Backend.Cairo.CmdLine - > import Graphics.SVGFonts.ReadFont (textSVG) + > import Graphics.SVGFonts.ReadFont (textSVG,textSVG_) > > > main = defaultMain ( (text' "Hello World") <> (rect 8 1) # alignBL ) @@ -52,7 +52,7 @@ base == 4.*, containers == 0.4.*, data-default, - diagrams-lib, + diagrams-lib >= 0.5, directory >= 1.0 && <1.2, parsec, split,
TODO view
@@ -1,5 +1,5 @@ Sorted after importance -- speed +- Speed - Binary XML (i.e. fast infoset), or a temp file, because xml-parsing has a speed problem) - Auto Hinting (this depends on how the rasterization in the backend works)
src/Graphics/SVGFonts/ReadFont.hs view
@@ -25,15 +25,7 @@ import System.IO.Unsafe (unsafePerformIO) import Text.XML.Light --- http://www.w3.org/TR/SVG/fonts.html#KernElements -type Kern = ( Map.Map String [Int], - Map.Map String [Int], - Map.Map String [Int], - Map.Map String [Int], Vector Double ) -- ^ u1s, u2s, g1s, g2s, k -type SvgGlyph = Map.Map String (String, Double, String) -- ^ \[ (unicode, (glyph_name, horiz_advance, ds)) \] -type FontData = (SvgGlyph, Kern, [Double], String) -- ^ (SvgGlyph, Kern, bbox-string, filename) - --- | Open an SVG-Font File and extract the data +-- | See <http://www.w3.org/TR/SVG/fonts.html#KernElements> -- -- Some explanation how kerning is computed: -- @@ -47,7 +39,16 @@ -- Now the g2s are converted in the same way as the g1s. -- Whenever two consecutive chars are being printed try to find an -- intersection of the list assigned to the first char and second char +type Kern = ( Map.Map String [Int], + Map.Map String [Int], + Map.Map String [Int], + Map.Map String [Int], Vector Double ) -- ^ u1s, u2s, g1s, g2s, k +type SvgGlyph = Map.Map String (String, Double, String) -- ^ \[ (unicode, (glyph_name, horiz_advance, ds)) \] +type FontData = (SvgGlyph, Kern, [Double], String) -- ^ (SvgGlyph, Kern, bbox-string, filename) + +-- | Open an SVG-Font File and extract the data +-- openFont :: FilePath -> FontData openFont file = ( Map.fromList (myZip4 (unicodes, glyphNames, horiz, ds)), -- Map with unicode keys (transform u1s, transform u2s, transform g1s, transform g2s, kAr), -- kerning data @@ -157,6 +158,7 @@ bit = outlMap (ro "src/Test/Bitstream.svg") lin = outlMap (ro "src/Test/LinLibertine.svg") +lin2 = outlMap (ro "src/Test/LinLibertineCut.svg") instance Default TextOpts where def = TextOpts "text" lin INSIDE_H KERN 1 1 @@ -182,17 +184,17 @@ where makeString w h = -- translate (-w/2, - h/2) $ -- origin in the middle scaleY (h/maxY) $ scaleX (w/sumh) $ - translate (0, - bbox_ly fontD) $ + translateY (- bbox_ly fontD) $ mconcat $ zipWith translate horPos (map (polygonChar outl) str) (fontD,outl) = (fdo to) polygonChar outl ch = fromJust (Map.lookup ch outl) - horPos = reverse $ added ( (0,0) : (map ((1,0) ^*) hs) ) + horPos = reverse $ added ( zeroV : (map (unitX ^*) hs) ) hs = horizontalAdvances str fontD (isKern (spacing to)) sumh = sum hs added = snd.(foldl (\(h,l) (b,_) -> (h ^+^ b, (h ^+^ b):l)) - ((0,0),[])). (map (\x->(x,[]))) -- [o,o+h0,o+h0+h1,..] + (zeroV,[])). (map (\x->(x,[]))) -- [o,o+h0,o+h0+h1,..] maxY = bbox_dy fontD -- max height of glyph ligatures = ((filter ((>1).length)).(Map.keys).sel1) fontD @@ -212,55 +214,61 @@ outlMap str = ( fontD, Map.fromList [ (ch, outlines ch) | ch <- allUnicodes ] ) where allUnicodes = Map.keys (sel1 fontD) - outlines ch = mconcat $ commandsToTrails (commands ch (sel1 fontD)) [] (0,0) (0,0) (0,0) + outlines ch = mconcat $ commandsToTrails (commands ch (sel1 fontD)) [] zeroV zeroV zeroV fontD = openFont str commandsToTrails :: [PathCommand] -> [Segment R2] -> R2 -> R2 -> R2 -> [Path R2] commandsToTrails [] _ _ _ _ = [] -commandsToTrails (c:cs) segments (lx,ly) lastContr beginPoint -- (lx,ly) is the endpoint of the last segment +commandsToTrails (c:cs) segments l lastContr beginPoint -- l is the endpoint of the last segment | isNothing nextSegment = (translate beginPoint (pathFromTrail $ fromSegments segments)) : - ( commandsToTrails cs [] (lx+x0, ly+y0) (contr c) (beginP c) ) -- one outline completed + ( commandsToTrails cs [] (l ^+^ offs) (contr c) (beginP c) ) -- one outline completed | otherwise = commandsToTrails cs (segments ++ [fromJust nextSegment]) - (lx+x0, ly+y0) (contr c) (beginP c) -- work on outline + (l ^+^ offs) (contr c) (beginP c) -- work on outline where nextSegment = go c - (x0,y0) | isJust nextSegment = segOffset (fromJust nextSegment) - | otherwise = (0,0) - (cx,cy) = lastContr -- last control point is always in absolute coordinates - beginP ( M_abs (x,y) ) = (x,y) - beginP ( M_rel (x,y) ) = (lx+x, ly+y) + offs | isJust nextSegment + = segOffset (fromJust nextSegment) + | otherwise = zeroV + (x0,y0) = unr2 offs + (cx,cy) = unr2 lastContr -- last control point is always in absolute coordinates + beginP ( M_abs (x,y) ) = r2 (x,y) + beginP ( M_rel (x,y) ) = l ^+^ r2 (x,y) beginP _ = beginPoint - contr ( C_abs (x1,y1,x2,y2,x,y) ) = (x0+x-x2, y0+y-y2 ) -- control point of bezier curve - contr ( C_rel (x1,y1,x2,y2,x,y) ) = ( x-x2, y-y2 ) - contr ( S_abs (x2,y2,x,y) ) = (x0+x-x2, y0+y-y2 ) - contr ( S_rel (x2,y2,x,y) ) = ( x-x2, y-y2 ) - contr ( Q_abs (x1,y1,x,y) ) = (x0+x-x1, y0+y-y1 ) - contr ( Q_rel (x1,y1,x,y) ) = ( x-x1, y-y1 ) - contr ( T_abs (x,y) ) = (2*x0-cx, 2*y0-cy ) - contr ( T_rel (x,y) ) = ( x-cx, y-cy ) - contr ( L_abs (x,y) ) = (x0, y0) - contr ( L_rel (x,y) ) = ( 0, 0) - contr ( M_abs (x,y) ) = (x0, y0) - contr ( M_rel (x,y) ) = ( 0, 0) - contr ( H_abs x ) = (x0, y0) - contr ( H_rel x ) = ( 0, y0) - contr ( V_abs y ) = (x0, y0) - contr ( V_rel y ) = (x0, 0) + contr ( C_abs (x1,y1,x2,y2,x,y) ) = r2 (x0+x-x2, y0+y-y2 ) -- control point of bezier curve + contr ( C_rel (x1,y1,x2,y2,x,y) ) = r2 ( x-x2, y-y2 ) + contr ( S_abs (x2,y2,x,y) ) = r2 (x0+x-x2, y0+y-y2 ) + contr ( S_rel (x2,y2,x,y) ) = r2 ( x-x2, y-y2 ) + contr ( Q_abs (x1,y1,x,y) ) = r2 (x0+x-x1, y0+y-y1 ) + contr ( Q_rel (x1,y1,x,y) ) = r2 ( x-x1, y-y1 ) + contr ( T_abs (x,y) ) = r2 (2*x0-cx, 2*y0-cy ) + contr ( T_rel (x,y) ) = r2 ( x-cx, y-cy ) + contr ( L_abs (x,y) ) = r2 (x0, y0) + contr ( L_rel (x,y) ) = r2 ( 0, 0) + contr ( M_abs (x,y) ) = r2 (x0, y0) + contr ( M_rel (x,y) ) = r2 ( 0, 0) + contr ( H_abs x ) = r2 (x0, y0) + contr ( H_rel x ) = r2 ( 0, y0) + contr ( V_abs y ) = r2 (x0, y0) + contr ( V_rel y ) = r2 (x0, 0) + + straight' = straight . r2 + bezier3' p1 p2 p3 = bezier3 (r2 p1) (r2 p2) (r2 p3) + go ( M_abs (x,y) ) = Nothing go ( M_rel (x,y) ) = Nothing - go ( L_abs (x,y) ) = Just $ straight (x0+x, y0+y) - go ( L_rel (x,y) ) = Just $ straight (x, y) - go ( H_abs x) = Just $ straight (x0 + x, y0) - go ( H_rel x) = Just $ straight (x, 0) - go ( V_abs y) = Just $ straight (x0, y0 + y) - go ( V_rel y) = Just $ straight (0, y) - go ( C_abs (x1,y1,x2,y2,x,y) ) = Just $ bezier3 (x0+x1, y0+y1) (x0+x2,y0+y2) (x0+x,y0+y) - go ( C_rel (x1,y1,x2,y2,x,y) ) = Just $ bezier3 (x1, y1) (x2, y2) (x, y) - go ( S_abs ( x2,y2,x,y) ) = Just $ bezier3 (cx, cy) (x0+x2, y0+y2) (x0+x, y0+y) - go ( S_rel ( x2,y2,x,y) ) = Just $ bezier3 (cx, cy) (x2, y2) (x, y) - go ( Q_abs (x1,y1,x,y) ) = Just $ bezier3 (x0 + x1, y0 + y1) (x0 + x1, y0 + y1) (x0 + x, y0 + y) - go ( Q_rel (x1,y1,x,y) ) = Just $ bezier3 (x1, y1) (x1, y1) (x, y) - go ( T_abs (x,y) ) = Just $ bezier3 (cx, cy) (cx, cy) (x0 + x, y0 + y) - go ( T_rel (x,y) ) = Just $ bezier3 (cx, cy) (cx, cy) (x, y) + go ( L_abs (x,y) ) = Just $ straight' (x0+x, y0+y) + go ( L_rel (x,y) ) = Just $ straight' (x, y) + go ( H_abs x) = Just $ straight' (x0 + x, y0) + go ( H_rel x) = Just $ straight' (x, 0) + go ( V_abs y) = Just $ straight' (x0, y0 + y) + go ( V_rel y) = Just $ straight' (0, y) + go ( C_abs (x1,y1,x2,y2,x,y) ) = Just $ bezier3' (x0+x1, y0+y1) (x0+x2,y0+y2) (x0+x,y0+y) + go ( C_rel (x1,y1,x2,y2,x,y) ) = Just $ bezier3' (x1, y1) (x2, y2) (x, y) + go ( S_abs ( x2,y2,x,y) ) = Just $ bezier3' (cx, cy) (x0+x2, y0+y2) (x0+x, y0+y) + go ( S_rel ( x2,y2,x,y) ) = Just $ bezier3' (cx, cy) (x2, y2) (x, y) + go ( Q_abs (x1,y1,x,y) ) = Just $ bezier3' (x0 + x1, y0 + y1) (x0 + x, y0 + y) (x0 + x, y0 + y) + go ( Q_rel (x1,y1,x,y) ) = Just $ bezier3' (x1, y1) (x, y) (x, y) + go ( T_abs (x,y) ) = Just $ bezier3' (cx, cy) (x0 + x, y0 + y) (x0 + x, y0 + y) + go ( T_rel (x,y) ) = Just $ bezier3' (cx, cy) (x, y) (x, y) go ( Z ) = Nothing commands :: String -> SvgGlyph -> [PathCommand]
src/Graphics/SVGFonts/ReadPath.hs view
@@ -8,7 +8,7 @@ -- Stability : stable -- Portability: portable -- --- parsing the SVG path command, see <http://www.w3.org/TR/SVG/paths.html#PathData> : +-- Parsing the SVG path command, see <http://www.w3.org/TR/SVG/paths.html#PathData> : module Graphics.SVGFonts.ReadPath ( pathFromString, @@ -59,7 +59,7 @@ A_rel deriving Show --- | convert a SVG path string into a list of commands +-- | Convert a SVG path string into a list of commands pathFromString :: String -> IO [PathCommand] pathFromString str = do{ case (parse path "" str) of