diff --git a/README.md b/README.md deleted file mode 100644 --- a/README.md +++ /dev/null @@ -1,49 +0,0 @@ -# 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 -* Text boxes with syntax highlighting - -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 - -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 -doesn't work edit the file by hand or tell me. Remember that a lot of -fonts are not allowed to be distributed freely. diff --git a/SVGFonts.cabal b/SVGFonts.cabal --- a/SVGFonts.cabal +++ b/SVGFonts.cabal @@ -1,28 +1,28 @@ Name: SVGFonts -Version: 1.2.1 +Version: 1.3 Synopsis: Fonts from the SVG-Font format -Description: Native font support for the Diagrams library. The SVG-Font format is easy to parse +Description: Native font support for the diagrams framework (). Note that this package can be used with any diagrams backend, not just the SVG backend. The SVG-tont 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 or use the included LinLibertine, Bitstream + You can convert your own font to SVG with , or use the included LinLibertine and Bitstream fonts. . - Features + Features: . - * Complete implementation of the features that Fontforge produces (but not the complete SVG format) + * Complete implementation of the features that Fontforge produces (though not the complete SVG format) . - * Kerning (i.e. the two characters in \"VA\" have a shorter distance than in \"VV\") + * Kerning (/i.e./ the two characters in \"VA\" are closer than the characters in \"VV\") . * Unicode . * Ligatures . * An example that shows how to do text boxes with syntax highlighting using highlighting-kate: - . http://hackage.haskell.org/package/highlighting-kate-0.5.3.8 + . 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. . + Version 1.0 of this library supports texturing, though this would only sense in a diagrams backend that does rasterization in Haskell. + . Example: . > # LANGUAGE NoMonomorphismRestriction # @@ -31,7 +31,6 @@ > import Diagrams.Backend.Cairo.CmdLine > import Graphics.SVGFonts.ReadFont (textSVG) > - > > main = defaultMain (text' "Hello World") > > text' t = stroke (textSVG t 1) # fc purple # fillRule EvenOdd @@ -47,7 +46,7 @@ Cabal-Version: >=1.10 data-files: fonts/*.svg -extra-source-files: diagrams/* +extra-source-files: diagrams/*.svg source-repository head type: git @@ -61,8 +60,8 @@ attoparsec, base == 4.*, containers >= 0.4 && < 0.6, - data-default, - diagrams-lib >= 0.6, + data-default-class < 0.1, + diagrams-lib >= 0.7 && < 0.8, directory >= 1.1, parsec, split, @@ -72,8 +71,8 @@ vector-space, xml exposed-modules: + Graphics.SVGFonts Graphics.SVGFonts.ReadFont Graphics.SVGFonts.CharReference Graphics.SVGFonts.ReadPath default-language: Haskell2010 - diff --git a/TODO b/TODO deleted file mode 100644 --- a/TODO +++ /dev/null @@ -1,11 +0,0 @@ -Sorted after importance - -- Baseline calculations to make different fonts look better in combination and allow text on e.g. an arch - -- Speed: Think about: - - Binary XML (i.e. fast infoset), or a temp file, because xml-parsing has a speed problem) - - Parsing of Paths and Evaluation of bezier curves in parallel with Accelerate - -- Auto Hinting (this depends on how the rasterization in the backend works): - If you compare Example.hs opened in gedit with the SVG generated by Example.hs the advantage of - hinting becomes obvious. diff --git a/diagrams/textH.svg b/diagrams/textH.svg --- a/diagrams/textH.svg +++ b/diagrams/textH.svg @@ -1,4 +1,4 @@ - + diff --git a/diagrams/textHADV.svg b/diagrams/textHADV.svg --- a/diagrams/textHADV.svg +++ b/diagrams/textHADV.svg @@ -1,4 +1,4 @@ - + diff --git a/diagrams/textKern.svg b/diagrams/textKern.svg --- a/diagrams/textKern.svg +++ b/diagrams/textKern.svg @@ -1,4 +1,4 @@ - + diff --git a/diagrams/textPic0.svg b/diagrams/textPic0.svg --- a/diagrams/textPic0.svg +++ b/diagrams/textPic0.svg @@ -1,4 +1,4 @@ - + diff --git a/diagrams/textPic1.svg b/diagrams/textPic1.svg --- a/diagrams/textPic1.svg +++ b/diagrams/textPic1.svg @@ -1,4 +1,4 @@ - + diff --git a/diagrams/textSVGExample.svg b/diagrams/textSVGExample.svg new file mode 100644 --- /dev/null +++ b/diagrams/textSVGExample.svg @@ -0,0 +1,4 @@ + + + diff --git a/diagrams/textW.svg b/diagrams/textW.svg --- a/diagrams/textW.svg +++ b/diagrams/textW.svg @@ -1,4 +1,4 @@ - + diff --git a/diagrams/textWH.svg b/diagrams/textWH.svg --- a/diagrams/textWH.svg +++ b/diagrams/textWH.svg @@ -1,4 +1,4 @@ - + diff --git a/example/Example.hs b/example/Example.hs deleted file mode 100644 --- a/example/Example.hs +++ /dev/null @@ -1,64 +0,0 @@ -{-# LANGUAGE NoMonomorphismRestriction #-} - -import Diagrams.Prelude --- import Diagrams.Backend.Cairo.CmdLine -import Diagrams.Backend.SVG.CmdLine -import Graphics.SVGFonts.ReadFont -import Text.Highlighting.Kate -import qualified Diagrams.TwoD.Size as Size -import Data.Char - --- compile this example with: ghc --make Example --- main = defaultMain (text'' "Hello World") - -main = do getLines <- readFile "Example.hs" - defaultMain (highlightedText (lines getLines) 1 "haskell") - -text' t = stroke (textSVG t 1) # fc blue # lc blue # bg lightgrey # fillRule EvenOdd # showOrigin - -text'' t = stroke (textSVG' $ TextOpts t lin INSIDE_H KERN False 1 1 ) - # fc blue # lc blue # bg lightgrey # fillRule EvenOdd # showOrigin - -text''' t = (textSVG_ $ TextOpts t lin INSIDE_H KERN True 1 1 ) - # fc blue # lc blue # bg lightgrey # fillRule EvenOdd # showOrigin - -textBit t h c | null t = mempty - | otherwise = textSVG_ (TextOpts t bit INSIDE_H HADV False 1 h) - # fc c # lc c # alignBL # fillRule EvenOdd - --- copy and change it to your needs -highlightedText code h lang = (border 0 w hh placedTextLines) `atop` roundedBox - where - -- placing textLines below each other - placedTextLines = vcat' with { sep = h/5 } textLines # alignBL - textLines = map l hlines # alignBL - l line | null line = hcat' with { sep = 0.1 } [textBit " " h black] - | otherwise = hcat' with { sep = 0.1 } (map token line) - token (KeywordTok,str) = textBit str h darkred - token (DataTypeTok,str) = textBit str h seagreen - token (DecValTok,str) = textBit str h fuchsia - token (BaseNTok,str) = textBit str h fuchsia - token (FloatTok,str) = textBit str h fuchsia - token (CharTok,str) = textBit str h fuchsia - token (StringTok,str) = textBit str h fuchsia - token (CommentTok,str) = textBit str h blue - token (OtherTok,str) = textBit str h darkviolet - token (AlertTok,str) = textBit str h darkviolet - token (FunctionTok,str) = textBit str h black - token (RegionMarkerTok,str) = textBit str h black - token (ErrorTok,str) = textBit str h black - token (NormalTok,str) = textBit str h black - roundedBox = (roundedRect w hh (h/5)) # alignBL # opacity 0.8 - w = Size.width (placedTextLines :: D R2) - hh = Size.height (placedTextLines :: D R2) - hlines :: [SourceLine] - hlines = map concat $ map (highlightAs lang) code - --- reduce the size of an object by len in all directions -border hrel w h obj | w > len && h > len = obj # scaleX ((w-len)/w) - # scaleY ((h-len)/h) - # translateX (len/2) - # translateY (-len/2) - | otherwise = obj - where len = hrel*h - diff --git a/fonts/BodieMFHolly.svg b/fonts/BodieMFHolly.svg new file mode 100644 --- /dev/null +++ b/fonts/BodieMFHolly.svg @@ -0,0 +1,1040 @@ + + + + +Created by FontForge 20071110 at Tue Apr 14 11:23:28 2009 + By Tillmann Vogt,,, +1.01 (c)1995 By Rick W. Mueller - Licensed to http://www.1001freefonts.com + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/fonts/ElzevierCaps.svg b/fonts/ElzevierCaps.svg new file mode 100644 --- /dev/null +++ b/fonts/ElzevierCaps.svg @@ -0,0 +1,1104 @@ + + + + +Created by FontForge 20100429 at Wed Jun 22 18:01:42 2011 + By Tillmann Vogt,,, +Copyright (c) Typographer Mediengestaltung, 2000. All rights reserved. Elzevier Caps, from David Rakowski's EPS art. + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/src/Graphics/SVGFonts.hs b/src/Graphics/SVGFonts.hs new file mode 100644 --- /dev/null +++ b/src/Graphics/SVGFonts.hs @@ -0,0 +1,17 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE RankNTypes #-} + +module Graphics.SVGFonts + ( + -- * Drawing text + textSVG, textSVG', textSVG_ + + -- * Options + , TextOpts(..), Mode(..), Spacing(..) + + -- * Provided fonts + , bit, lin, lin2 + ) + where + +import Graphics.SVGFonts.ReadFont diff --git a/src/Graphics/SVGFonts/ReadFont.hs b/src/Graphics/SVGFonts/ReadFont.hs --- a/src/Graphics/SVGFonts/ReadFont.hs +++ b/src/Graphics/SVGFonts/ReadFont.hs @@ -4,7 +4,7 @@ where import Data.Char (isSpace) -import Data.Default +import Data.Default.Class import Data.List (intersect,sortBy) import Data.List.Split (splitOn, splitWhen) import Data.Maybe (fromMaybe, fromJust, isJust, isNothing, maybeToList, catMaybes) @@ -29,16 +29,11 @@ -- | A short version of textSVG' with standard values. The Double value is the height. -- --- @ --- \{-\# LANGUAGE NoMonomorphismRestriction \#-\} --- ---import Diagrams.Prelude ---import Diagrams.Backend.SVG.CmdLine ---import Graphics.SVGFonts.ReadFont --- ---main = defaultMain (textSVG \"Hello World\" 1) --- @ +-- > import Graphics.SVGFonts +-- > +-- > textSVGExample = stroke $ textSVG "Hello World" 1 -- +-- <> textSVG :: String -> Double -> Path R2 textSVG t h = textSVG' with { txt = t, textHeight = h } @@ -50,28 +45,19 @@ , underline :: Bool , textWidth :: Double , textHeight :: Double - } - --- > import Graphics.SVGFonts.ReadFont --- > text' t = stroke (textSVG' $ TextOpts t lin INSIDE_H KERN False 1 1 ) --- > # fc blue # lc blue # bg lightgrey # fillRule EvenOdd # showOrigin --- > textPic0 = (text' "Hello World") # showOrigin + } deriving Show --- | The origin is at the center of the text and the boundaries are given by the outlines of the chars. +-- | The origin is at the center of the text and the boundaries are +-- given by the outlines of the chars. -- --- @ --- \{-\# LANGUAGE NoMonomorphismRestriction \#-\} --- ---import Diagrams.Prelude ---import Diagrams.Backend.SVG.CmdLine ---import Graphics.SVGFonts.ReadFont --- ---main = defaultMain (text' \"Hello World\") ---text' t = stroke (textSVG' $ TextOpts t lin INSIDE_H KERN False 1 1 ) --- \# fc blue \# lc blue \# bg lightgrey \# fillRule EvenOdd \# showOrigin --- @ --- --- <> +-- > import Graphics.SVGFonts +-- > +-- > text' t = stroke (textSVG' $ TextOpts t lin INSIDE_H KERN False 1 1 ) +-- > # fc blue # lc blue # bg lightgrey # fillRule EvenOdd # showOrigin +-- > +-- > textPic0 = (text' "Hello World") # showOrigin +-- +-- <> textSVG' :: TextOpts -> Path R2 textSVG' to = case mode to of @@ -97,33 +83,22 @@ (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 + ligatures = ((filter ((>1) . length)) . (Map.keys) . fontDataGlyphs) fontD str = map T.unpack $ characterStrings (txt to) ligatures - --- > import Graphics.SVGFonts.ReadFont --- > text'' t = (textSVG_ $ TextOpts t lin INSIDE_H KERN True 1 1 ) --- > # fc blue # lc blue # bg lightgrey # fillRule EvenOdd # showOrigin --- > textPic1 = text'' "Hello World" --- | The origin is at the left end of the baseline of of the text and the boundaries +-- | The origin is at the left end of the baseline of of the text and the boundaries -- are given by the bounding box of the Font. This is best for combining Text of different -- fonts and for several lines of text. -- As you can see you can also underline text by setting underline to True. -- --- @ --- \{-\# LANGUAGE NoMonomorphismRestriction \#-\} --- ---import Diagrams.Prelude ---import Diagrams.Backend.SVG.CmdLine ---import Graphics.SVGFonts.ReadFont --- ---main = defaultMain (text'' \"Hello World\") +-- > import Graphics.SVGFonts +-- > +-- > text'' t = (textSVG_ $ TextOpts t lin INSIDE_H KERN True 1 1 ) +-- > # fc blue # lc blue # bg lightgrey # fillRule EvenOdd # showOrigin +-- > +-- > textPic1 = text'' "Hello World" -- ---text'' t = (textSVG_ $ TextOpts t lin INSIDE_H KERN True 1 1 ) --- \# fc blue \# lc blue \# bg lightgrey \# fillRule EvenOdd \# showOrigin --- @ --- --- <> +-- <> textSVG_ :: forall b . Renderable (Path R2) b => TextOpts -> QDiagram b R2 Any textSVG_ to = case mode to of @@ -152,29 +127,72 @@ (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 + ligatures = ((filter ((>1) . length)) . (Map.keys) . fontDataGlyphs) fontD str = map T.unpack $ characterStrings (txt to) ligatures -- | This type contains everything that a typical SVG font file produced by fontforge contains. -- --- (SvgGlyph, Kern, bbox-string, filename, (underlinePos, underlineThickness), +-- (SvgGlyph, Kern, bbox-string, filename, (underlinePos, underlineThickness), -- (fontHadv, fontFamily, fontWeight, fontStretch, unitsPerEm, panose, ascent, descent, xHeight, capHeight, stemh, stemv, unicodeRange) ) -- -type FontData = (SvgGlyph, Kern, [Double], String, (Double, Double), - (Double,String,String,String,String,String,String,String,String,String,String,String,String)) +data FontData = FontData + { fontDataGlyphs :: SvgGlyphs + , fontDataKerning :: Kern + , fontDataBoundingBox :: [Double] + , fontDataFileName :: String + , fontDataUnderlinePos :: Double + , fontDataUnderlineThickness :: Double + , fontDataHorizontalAdvance :: Double + , fontDataFamily :: String + , fontDataWeight :: Double + , fontDataStretch :: String + , fontDataUnitsPerEm :: Double + , fontDataPanose :: String + , fontDataAscent :: Double + , fontDataDescent :: Double + , fontDataXHeight :: Double + , fontDataCapHeight :: Double + , fontDataHorizontalStem :: Double + , fontDataVerticalStem :: Double + , fontDataUnicodeRange :: String + } deriving Show +--type FontData = (SvgGlyph, Kern, [Double], String, (Double, Double), +-- (Double,String,Double,String,Double,String,Double,Double,Double,Double,Double,Double,String)) -- | Open an SVG-Font File and extract the data -- openFont :: FilePath -> FontData -openFont file = ( Map.fromList glyphs, - (transformChars u1s, transformChars u2s, transformChars g1s, transformChars g2s, kAr), -- kerning data - parsedBBox, - fname file, - (underlinePos, underlineThick), - (fontHadv, fontFamily, fontWeight, fontStretch, unitsPerEm, panose, - ascent, descent, xHeight, capHeight, stemh, stemv, unicodeRange) - ) +openFont file = FontData + { fontDataGlyphs = Map.fromList glyphs + , fontDataKerning = Kern + { kernU1S = transformChars u1s + , kernU2S = transformChars u2s + , kernG1S = transformChars g1s + , kernG2S = transformChars g2s + , kernK = kAr + } + , fontDataBoundingBox = parsedBBox + , fontDataFileName = fname file + , fontDataUnderlinePos = fontface `readAttr` "underline-position" + , fontDataUnderlineThickness = fontface `readAttr` "underline-thickness" + , fontDataHorizontalAdvance = fontHadv + , fontDataFamily = fontFamily + , fontDataWeight = fontface `readAttr` "font-weight" + , fontDataStretch = fontStretch + , fontDataUnitsPerEm = fontface `readAttr` "units-per-em" + , fontDataPanose = panose + , fontDataAscent = fontface `readAttr` "ascent" + , fontDataDescent = fontface `readAttr` "descent" + , fontDataXHeight = fontface `readAttr` "x-height" + , fontDataCapHeight = fontface `readAttr` "cap-height" + , fontDataHorizontalStem = fontface `readAttr` "stemh" + , fontDataVerticalStem = fontface `readAttr` "stemv" + , fontDataUnicodeRange = unicodeRange + } where + readAttr :: (Read a) => Element -> String -> a + readAttr element attr = fromJust $ fmap read $ findAttr (unqual attr) element + xml = onlyElems $ parseXML $ unsafePerformIO $ readFile file fontElement = head $ catMaybes $ map (findElement (unqual "font")) xml @@ -184,20 +202,10 @@ bbox = fromMaybe "" $ findAttr (unqual "bbox") fontface parsedBBox :: [Double] parsedBBox = map read $ splitWhen isSpace bbox - underlineThick = read $ fromMaybe "" $ findAttr (unqual "underline-thickness") fontface - underlinePos = read $ fromMaybe "" $ findAttr (unqual "underline-position") fontface - fontFamily = read $ fromMaybe "" $ findAttr (unqual "font-family") fontface - fontWeight = read $ fromMaybe "" $ findAttr (unqual "font-weight") fontface - fontStretch = read $ fromMaybe "" $ findAttr (unqual "font-stretch") fontface - unitsPerEm = read $ fromMaybe "" $ findAttr (unqual "units-per-em") fontface - panose = read $ fromMaybe "" $ findAttr (unqual "panose") fontface - ascent = read $ fromMaybe "" $ findAttr (unqual "ascent") fontface - descent = read $ fromMaybe "" $ findAttr (unqual "descent") fontface - xHeight = read $ fromMaybe "" $ findAttr (unqual "xHeight") fontface - capHeight = read $ fromMaybe "" $ findAttr (unqual "capHeight") fontface - stemh = read $ fromMaybe "" $ findAttr (unqual "stemh") fontface - stemv = read $ fromMaybe "" $ findAttr (unqual "stemv") fontface - unicodeRange = read $ fromMaybe "" $ findAttr (unqual "unicode-range") fontface + fontFamily = fromMaybe "" $ findAttr (unqual "font-family") fontface + fontStretch = fromMaybe "" $ findAttr (unqual "font-stretch") fontface + panose = fromMaybe "" $ findAttr (unqual "panose-1") fontface + unicodeRange = fromMaybe "" $ findAttr (unqual "unicode-range") fontface glyphElements = findChildren (unqual "glyph") fontElement kernings = findChildren (unqual "hkern") fontElement @@ -220,7 +228,7 @@ ks = map (fromMaybe "") $ map (findAttr (unqual "k")) kernings kAr = V.fromList (map read ks) - transformChars chars = Map.fromList $ map ch $ multiSet $ + transformChars chars = Map.fromList $ map ch $ multiSet $ map (\(x,y) -> (x,[y])) $ sort fst $ concat $ index chars ch (x,y) | null x = ("",y) | otherwise = (x,y) @@ -239,14 +247,14 @@ fname f = last $ init $ concat (map (splitOn "/") (splitOn "." f)) -type SvgGlyph = Map.Map String (String, Double, String) -- ^ \[ (unicode, (glyph_name, horiz_advance, ds)) \] +type SvgGlyphs = Map.Map String (String, Double, String) -- ^ \[ (unicode, (glyph_name, horiz_advance, ds)) \] -- | Horizontal advances of characters inside a string. -- A character is stored with a string (because of ligatures like \"ffi\"). horizontalAdvances :: [String] -> FontData -> Bool -> [Double] horizontalAdvances [] _ _ = [] horizontalAdvances [ch] fd _ = [hadv ch fd] -horizontalAdvances (ch0:ch1:s) fd kerning = ((hadv ch0 fd) - (ka (sel2 fd))) : +horizontalAdvances (ch0:ch1:s) fd kerning = ((hadv ch0 fd) - (ka (fontDataKerning fd))) : (horizontalAdvances (ch1:s) fd kerning) where ka kern | kerning = (kernAdvance ch0 ch1 kern True) + (kernAdvance ch0 ch1 kern False) | otherwise = 0 @@ -254,8 +262,8 @@ -- | Horizontal advance of a character consisting of its width and spacing, extracted out of the font data hadv :: String -> FontData -> Double hadv ch fontD | isJust char = sel2 (fromJust char) - | otherwise = sel1 (sel6 fontD) - where char = (Map.lookup ch (sel1 fontD)) + | otherwise = fontDataHorizontalAdvance fontD + where char = (Map.lookup ch (fontDataGlyphs fontD)) -- | See -- @@ -271,56 +279,60 @@ -- 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 +data Kern = Kern + { kernU1S :: Map.Map String [Int] + , kernU2S :: Map.Map String [Int] + , kernG1S :: Map.Map String [Int] + , kernG2S :: Map.Map String [Int] + , kernK :: Vector Double + } deriving Show -- ^ u1s, u2s, g1s, g2s, k -- | Change the horizontal advance of two consective chars (kerning) kernAdvance :: String -> String -> Kern -> Bool -> Double -kernAdvance ch0 ch1 kern u | u && not (null s0) = (sel5 kern) V.! (head s0) - | not u && not (null s1) = (sel5 kern) V.! (head s1) +kernAdvance ch0 ch1 kern u | u && not (null s0) = (kernK kern) V.! (head s0) + | not u && not (null s1) = (kernK kern) V.! (head s1) | otherwise = 0 - where s0 = intersect (s sel1 ch0) (s sel2 ch1) - s1 = intersect (s sel3 ch0) (s sel4 ch1) + where s0 = intersect (s kernU1S ch0) (s kernU2S ch1) + s1 = intersect (s kernG1S ch0) (s kernG2S ch1) s sel ch = concat (maybeToList (Map.lookup ch (sel kern))) -type OutlineMap = Map.Map String (Path R2) - --- > import Graphics.SVGFonts.ReadFont --- > textWH0 = (rect 8 1) # alignBL <> ((textSVG_ $ TextOpts "SPACES" lin INSIDE_WH KERN False 8 1 ) +type OutlineMap = Map.Map String (Path R2) + +-- > import Graphics.SVGFonts.ReadFont +-- > textWH0 = (rect 8 1) # alignBL <> ((textSVG_ $ TextOpts "SPACES" lin INSIDE_WH KERN False 8 1 ) -- > # fc blue # lc blue # bg lightgrey # fillRule EvenOdd) # alignBL -- > textWH1 = (rect 8 1) # alignBL <> ((textSVG_ $ TextOpts "are sometimes better." lin INSIDE_WH KERN False 8 1 ) -- > # fc blue # lc blue # bg lightgrey # fillRule EvenOdd) # alignBL -- > textWH2 = (rect 8 1) # alignBL <> ((textSVG_ $ TextOpts "But too many chars are not good." lin INSIDE_WH KERN False 8 1 ) -- > # fc blue # lc blue # bg lightgrey # fillRule EvenOdd) # alignBL -- > textWH = textWH0 # alignBL === strutY 0.3 === textWH1 === strutY 0.3 === textWH2 # alignBL --- > textW0 = (rect 3 1) # alignBL <> ( (textSVG_ $ TextOpts "HEADLINE" lin INSIDE_W KERN False 3 1 ) --- > # fc blue # lc blue # bg lightgrey # fillRule EvenOdd ) # alignBL --- > textW1 = (rect 10 1) # alignBL <> ( (textSVG_ $ TextOpts "HEADLINE" lin INSIDE_W KERN False 10 1 ) --- > # fc blue # lc blue # bg lightgrey # fillRule EvenOdd ) # alignBL --- > textW = textW0 # alignBL ||| strutX 1 ||| textW1 # alignBL --- > textH0 = (rect 10 1) # alignBL <> ((textSVG_ $ TextOpts "Constant font size" lin INSIDE_H KERN False 10 1 ) --- > # fc blue # lc blue # bg lightgrey # fillRule EvenOdd) # alignBL --- > textH1 = (rect 3 1) # alignBL <> ((textSVG_ $ TextOpts "Constant font size" lin INSIDE_H KERN False 3 1 ) --- > # fc blue # lc blue # bg lightgrey # fillRule EvenOdd) # alignBL --- > textH = textH0 # alignBL === strutY 0.5 === textH1 # alignBL +-- > textW0 = (rect 3 1) # alignBL <> ( (textSVG_ $ TextOpts "HEADLINE" lin INSIDE_W KERN False 3 1 ) +-- > # fc blue # lc blue # bg lightgrey # fillRule EvenOdd ) # alignBL +-- > textW1 = (rect 10 1) # alignBL <> ( (textSVG_ $ TextOpts "HEADLINE" lin INSIDE_W KERN False 10 1 ) +-- > # fc blue # lc blue # bg lightgrey # fillRule EvenOdd ) # alignBL +-- > textW = textW0 # alignBL ||| strutX 1 ||| textW1 # alignBL +-- > textH0 = (rect 10 1) # alignBL <> ((textSVG_ $ TextOpts "Constant font size" lin INSIDE_H KERN False 10 1 ) +-- > # fc blue # lc blue # bg lightgrey # fillRule EvenOdd) # alignBL +-- > textH1 = (rect 3 1) # alignBL <> ((textSVG_ $ TextOpts "Constant font size" lin INSIDE_H KERN False 3 1 ) +-- > # fc blue # lc blue # bg lightgrey # fillRule EvenOdd) # alignBL +-- > textH = textH0 # alignBL === strutY 0.5 === textH1 # alignBL -data Mode = INSIDE_H -- ^ The string fills the complete height, width adjusted. Used in text editors. - -- The result can be smaller or bigger than the bounding box: - -- - -- <> - | INSIDE_W -- ^ The string fills the complete width, heigth adjusted. - -- Maybe useful for single words in a diagram or headlines. - -- The result can be smaller or bigger than the bounding box: - -- - -- <> +data Mode = INSIDE_H -- ^ The string fills the complete height, width adjusted. Used in text editors. + -- The result can be smaller or bigger than the bounding box: + -- + -- <> + | INSIDE_W -- ^ The string fills the complete width, heigth adjusted. + -- Maybe useful for single words in a diagram or headlines. + -- The result can be smaller or bigger than the bounding box: + -- + -- <> | INSIDE_WH -- ^ The string is stretched inside Width and Height boundaries. -- The horizontal advances are increased if the string is shorter than there is space. -- The horizontal advances are decreased if the string is longer than there is space. - -- This feature is experimental and might change in the future. + -- This feature is experimental and might change in the future. -- - -- <> + -- <> + deriving Show mWH :: Mode -> Bool mWH INSIDE_WH = True @@ -331,25 +343,26 @@ mH :: Mode -> Bool mH INSIDE_H = True mH _ = False - --- > import Graphics.SVGFonts.ReadFont --- > textHADV = (textSVG_ $ TextOpts "AVENGERS" lin INSIDE_H HADV False 10 1 ) --- > # fc blue # lc blue # bg lightgrey # fillRule EvenOdd - --- > import Graphics.SVGFonts.ReadFont --- > textKern = (textSVG_ $ TextOpts "AVENGERS" lin INSIDE_H KERN False 10 1 ) --- > # fc blue # lc blue # bg lightgrey # fillRule EvenOdd --- | See --- -data Spacing = HADV -- ^ Every glyph has a unique horiz. advance - -- - -- <> +-- > import Graphics.SVGFonts.ReadFont +-- > textHADV = (textSVG_ $ TextOpts "AVENGERS" lin INSIDE_H HADV False 10 1 ) +-- > # fc blue # lc blue # bg lightgrey # fillRule EvenOdd + +-- > import Graphics.SVGFonts.ReadFont +-- > textKern = (textSVG_ $ TextOpts "AVENGERS" lin INSIDE_H KERN False 10 1 ) +-- > # fc blue # lc blue # bg lightgrey # fillRule EvenOdd + +-- | See +-- +data Spacing = HADV -- ^ Every glyph has a unique horiz. advance + -- + -- <> | KERN -- ^ Recommended, same as HADV but sometimes overridden by kerning: - -- As You can see there is less space between \"A\" and \"V\": - -- - -- <> - + -- As You can see there is less space between \"A\" and \"V\": + -- + -- <> + deriving Show + isKern :: Spacing -> Bool isKern KERN = True isKern _ = False @@ -363,41 +376,41 @@ -- | Difference between highest and lowest y-value of bounding box bbox_dy :: FontData -> Double bbox_dy fontData = (bbox!!3) - (bbox!!1) - where bbox = sel3 fontData -- bbox = [lowest x, lowest y, highest x, highest y] + where bbox = fontDataBoundingBox fontData -- bbox = [lowest x, lowest y, highest x, highest y] -- | Lowest x-value of bounding box bbox_lx :: FontData -> Double -bbox_lx fontData = (sel3 fontData) !! 0 +bbox_lx fontData = (fontDataBoundingBox fontData) !! 0 -- | Lowest y-value of bounding box bbox_ly :: FontData -> Double -bbox_ly fontData = (sel3 fontData) !! 1 +bbox_ly fontData = (fontDataBoundingBox fontData) !! 1 -- | Position of the underline bar underlinePosition :: FontData -> Double -underlinePosition fontData = fst $ sel5 fontData +underlinePosition fontData = fontDataUnderlinePos fontData -- | Thickness of the underline bar underlineThickness :: FontData -> Double -underlineThickness fontData = snd $ sel5 fontData +underlineThickness fontData = fontDataUnderlineThickness fontData -- | Generate Font Data and a Map from chars to outline paths outlMap :: String -> (FontData, OutlineMap) outlMap str = ( fontD, Map.fromList [ (ch, outlines ch) | ch <- allUnicodes ] ) where - allUnicodes = Map.keys (sel1 fontD) - outlines ch = mconcat $ commandsToTrails (commands ch (sel1 fontD)) [] zeroV zeroV zeroV + allUnicodes = Map.keys (fontDataGlyphs fontD) + outlines ch = mconcat $ commandsToTrails (commands ch (fontDataGlyphs fontD)) [] zeroV zeroV zeroV fontD = openFont str -commandsToTrails :: [PathCommand] -> [Segment R2] -> R2 -> R2 -> R2 -> [Path R2] +commandsToTrails :: [PathCommand] -> [Segment Closed R2] -> R2 -> R2 -> R2 -> [Path R2] commandsToTrails [] _ _ _ _ = [] commandsToTrails (c:cs) segments l lastContr beginPoint -- l is the endpoint of the last segment - | isNothing nextSegment = (translate beginPoint (pathFromTrail . close $ fromSegments segments)) : + | isNothing nextSegment = (translate beginPoint (pathFromTrail . wrapTrail . closeLine $ lineFromSegments segments)) : ( commandsToTrails cs [] (l ^+^ offs) (contr c) (beginP c) ) -- one outline completed | otherwise = commandsToTrails cs (segments ++ [fromJust nextSegment]) (l ^+^ offs) (contr c) (beginP c) -- work on outline where nextSegment = go c - offs | isJust nextSegment + offs | isJust nextSegment = segOffset (fromJust nextSegment) | otherwise = zeroV (x0,y0) = unr2 offs @@ -448,7 +461,7 @@ go ( A_abs ) = Nothing go ( A_rel ) = Nothing -commands :: String -> SvgGlyph -> [PathCommand] +commands :: String -> SvgGlyphs -> [PathCommand] commands ch glyph | isJust element = unsafePerformIO $ pathFromString $ sel3 $ fromJust element | otherwise = [] where element = Map.lookup ch glyph