FontyFruity 0.4.1 → 0.5

raw patch · 9 files changed

+129/−56 lines, 9 files

Files

• FontyFruity.cabal +3/−2
• changelog +9/−0
• src/Graphics/Text/TrueType.hs +69/−37
• src/Graphics/Text/TrueType/FontFolders.hs +5/−3
• src/Graphics/Text/TrueType/FontType.hs +14/−12
• src/Graphics/Text/TrueType/Header.hs +2/−0
• src/Graphics/Text/TrueType/HorizontalInfo.hs +4/−0
• src/Graphics/Text/TrueType/Internal.hs +21/−0
• src/Graphics/Text/TrueType/Types.hs +2/−2

@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/
 
 name:                FontyFruity
-version:             0.4.1
+version:             0.5
 synopsis:            A true type file format loader
 description:         
     A haskell Truetype file parser.
@@ -28,10 +28,11 @@ Source-Repository this
     Type:      git
     Location:  https://github.com/Twinside/FontyFruity.git
-    Tag:       v0.4.1
+    Tag:       v0.5
 
 library
   exposed-modules: Graphics.Text.TrueType
+                 , Graphics.Text.TrueType.Internal
   other-modules: Graphics.Text.TrueType.Bytecode    
                , Graphics.Text.TrueType.MaxpTable
                , Graphics.Text.TrueType.Header

@@ -1,5 +1,14 @@ -*-change-log-*-
 
+v0.5 January 2015
+ * BREAKING CHANGE: the point size is now Float!
+
+ ---- Non breaking change:
+ * Adding: lower level access to the structure, without
+   guaranteed stability.
+ * Adding: an helper function to retrieve the distance from
+   the top of the string bounding box to the baseline.
+
 v0.4.1 January 2015
  * Fixing: Warnings under GHC 7.1O
 

@@ -14,6 +14,8 @@     , getGlyphForStrings
     , stringBoundingBox
     , findFontOfFamily
+    , pointInPixelAtDpi
+    , pixelSizeInPointAtDpi
 
       -- * Font cache
     , FontCache
@@ -28,8 +30,9 @@     , FontStyle( .. )
     , RawGlyph( .. )
     , Dpi
-    , PointSize
-    , CompositeScaling ( .. )
+    , PointSize( .. )
+    , CompositeScaling( .. )
+    , BoundingBox( .. )
     ) where
 
 #if !MIN_VERSION_base(4,8,0)
@@ -246,8 +249,34 @@ type Dpi = Int
 
 -- | Font size expressed in points.
-type PointSize = Int
+-- You must convert size expressed in pixels to point using
+-- the DPI information.
+-- See pixelSizeInPointAtDpi
+newtype PointSize = PointSize { getPointSize :: Float }
+    deriving (Eq, Show)
 
+toPixelCoord :: (Integral a) => Font -> PointSize -> Dpi -> a -> Float
+toPixelCoord font pointSize dpi v =
+    (fromIntegral v * getPointSize pointSize * fromIntegral dpi) /
+    (72 * emSize)
+  where
+    emSize = fromIntegral $ unitsPerEm font
+
+toFCoord :: Integral a => Font -> PointSize -> Dpi -> Float -> a
+toFCoord font size dpi v = floor $ v * emSize / pixelSize
+  where
+    emSize = fromIntegral $ unitsPerEm font
+    pixelSize = size `pointInPixelAtDpi` dpi
+
+
+pointInPixelAtDpi :: PointSize -> Dpi -> Float
+pointInPixelAtDpi size dpi =
+    (getPointSize size * fromIntegral dpi) / 72
+
+pixelSizeInPointAtDpi :: Float -> Dpi -> PointSize
+pixelSizeInPointAtDpi pixelSize dpi =
+    PointSize $ (pixelSize / fromIntegral dpi) * 72
+
 glyphOfStrings :: Font -> String -> [(Glyph, HorizontalMetric)]
 glyphOfStrings Font { _fontMap = Just mapping
                     , _fontGlyph = Just glyphes
@@ -263,23 +292,37 @@     fromIntegral $ _fUnitsPerEm hdr
 unitsPerEm  _ = 1
 
+-- | String bounding box. with value for
+-- min/max.
+data BoundingBox = BoundingBox
+  { _xMin :: {-# UNPACK #-} !Float
+  , _yMin :: {-# UNPACK #-} !Float
+  , _xMax :: {-# UNPACK #-} !Float
+  , _yMax :: {-# UNPACK #-} !Float
+    -- | Should be 0 most of the times.
+  , _baselineHeight :: {-# UNPACK #-} !Float
+  }
+  deriving (Eq)
+
 -- | Compute the bounding box of a string displayed with a font at
 -- a given size. The resulting coordinate represent the width and the
 -- height in pixels.
-stringBoundingBox :: Font -> Dpi -> PointSize -> String -> (Float, Float)
+stringBoundingBox :: Font -> Dpi -> PointSize -> String -> BoundingBox
 stringBoundingBox font dpi size str =
-    foldl' go (0, 0) $ glyphOfStrings font str
+    BoundingBox 0 yMini width yMaxi 0
   where
-    emSize = fromIntegral $ unitsPerEm font
+    (width, yMini, yMaxi) =
+        foldl' go (0, 0, 0) $ glyphOfStrings font str
 
-    toPixel v = fromIntegral v * pixelSize / emSize
-      where pixelSize = fromIntegral (size * dpi) / 72
+    toPixel :: Integral a => a -> Float
+    toPixel = toPixelCoord font size dpi
 
-    go (xf, yf) (glyph, metric) = (width', height')
+    go (xf, yMin, yMax) (glyph, metric) = (width', yMin', yMax')
       where
         advance = _hmtxAdvanceWidth metric
         width' = xf + toPixel advance
-        height' = max yf . toPixel . _glfYMax $ _glyphHeader glyph
+        yMin' = max yMin. toPixel . _glfYMin $ _glyphHeader glyph
+        yMax' = max yMax. toPixel . _glfYMax $ _glyphHeader glyph
 
 
 -- | Extract a list of outlines for every char in the string.
@@ -290,27 +333,22 @@                       -> [(Font, PointSize, String)] -- ^ Text to draw
                       -> [[VU.Vector (Float, Float)]] -- ^ List of contours for each char
 getStringCurveAtPoint dpi initPos lst = snd $ mapAccumL go initPos glyphes where
-  glyphes = concat [(font, size, fromIntegral $ unitsPerEm font,)
-                            <$> glyphOfStrings font str | (font, size, str) <- lst]
-
-  toPixel (_, pointSize, emSize, _) v = fromIntegral v * pixelSize / emSize
-    where
-      pixelSize = fromIntegral (pointSize * dpi) / 72
+  glyphes = concat [(font, size,)
+                         <$> glyphOfStrings font str | (font, size, str) <- lst]
 
-  toFCoord (_, pointSize, emSize, _) v = floor $ v * emSize / pixelSize
-    where
-      pixelSize = fromIntegral (pointSize * dpi) / 72
+  toPixel (font, pointSize, _) = toPixelCoord font pointSize dpi
+  toCoord (font, pointSize, _) = toFCoord font pointSize dpi
 
   maximumSize = maximum [ toPixel p . _glfYMax $ _glyphHeader glyph
-                                | p@(_, _, _, (glyph, _)) <- glyphes ]
+                                | p@(_, _, (glyph, _)) <- glyphes ]
 
-  go (xf, yf) p@(font, pointSize, _, (glyph, metric)) = ((toPixel p $ xi + advance, yf), curves)
+  go (xf, yf) p@(font, pointSize, (glyph, metric)) = ((toPixel p $ xi + advance, yf), curves)
     where
-      (xi, yi) = (toFCoord p xf, toFCoord p yf)
+      (xi, yi) = (toCoord p xf, toCoord p yf)
       bearing = fromIntegral $ _hmtxLeftSideBearing metric
       advance = fromIntegral $ _hmtxAdvanceWidth metric
       curves =
-          getGlyphIndexCurvesAtPointSizeAndPos font dpi (toFCoord p maximumSize)
+          getGlyphIndexCurvesAtPointSizeAndPos font dpi (toCoord p maximumSize)
             (pointSize, glyph) (xi + bearing, yi)
 
 -- | This function return the list of all contour for all char with the given
@@ -321,24 +359,18 @@                    -> [[VU.Vector (Float, Float)]]
 getGlyphForStrings dpi lst =  go <$> glyphes where
   glyphes = concat
-    [(font, size, fromIntegral $ unitsPerEm font,)
-                            <$> glyphOfStrings font str | (font, size, str) <- lst]
-
-  toFCoord (_, pointSize, emSize, _) v = floor $ v * emSize / pixelSize :: Int
-    where
-      pixelSize = fromIntegral (pointSize * dpi) / 72
+    [(font, size,) <$> glyphOfStrings font str | (font, size, str) <- lst]
 
-  toPixel pointSize emSize v = fromIntegral v * pixelSize / emSize
-    where
-      pixelSize = fromIntegral (pointSize * dpi) / 72
+  toCoord (font, pointSize, _) = toFCoord font pointSize dpi
 
   maximumSize :: Float
-  maximumSize = maximum [ toPixel pointSize em . _glfYMax $ _glyphHeader glyph
-                                | (_, pointSize, em, (glyph, _)) <- glyphes ]
+  maximumSize =
+     maximum [ toPixelCoord font pointSize dpi . _glfYMax $ _glyphHeader glyph
+                   | (font, pointSize, (glyph, _)) <- glyphes ]
 
-  go p@(font, pointSize, _, (glyph, _metric)) =
+  go p@(font, pointSize, (glyph, _metric)) =
     getGlyphIndexCurvesAtPointSizeAndPos
-        font dpi (toFCoord p maximumSize) (pointSize, glyph) (0, 0)
+        font dpi (toCoord p maximumSize) (pointSize, glyph) (0, 0)
 
 getGlyphIndexCurvesAtPointSizeAndPos :: Font -> Dpi -> Int -> (PointSize, Glyph)
                                      -> (Int, Int)
@@ -352,7 +384,7 @@     go index | index >= V.length allGlyphs = []
              | otherwise = glyphExtract $ allGlyphs V.! index
 
-    pixelSize = fromIntegral (pointSize * dpi) / 72
+    pixelSize = pointSize `pointInPixelAtDpi` dpi
     emSize = fromIntegral $ _fUnitsPerEm hdr
 
     baseYF = toPixelCoordinate (0 :: Int) baseY

@@ -33,7 +33,7 @@ import Data.Binary.Put( Put
                       , putWord32be
                       , putByteString )
-import qualified Data.Map as M
+import qualified Data.Map.Strict as M
 import System.Environment( lookupEnv )
 import System.FilePath( (</>) )
 {-
@@ -128,13 +128,14 @@ -- version.
 newtype FontCache =
     FontCache (M.Map FontDescriptor FilePath)
+    deriving Show
 
 -- | Font cache with no pre-existing fonts in it.
 emptyFontCache :: FontCache
 emptyFontCache = FontCache M.empty
 
 signature :: B.ByteString
-signature = "FontyFruity__FONTCACHE:0.4"
+signature = "FontyFruity__FONTCACHE:0.5"
 
 putFontCache :: FontCache -> Put
 putFontCache (FontCache cache) = do
@@ -164,7 +165,8 @@   folders <- fontFolders
   found <- build [("", v) | v <- folders]
   return . FontCache
-         $ M.fromList [(d, path) | (Just d, path) <- found]
+         $ M.fromList [(d, path) | (Just d, path) <- found
+                                 , _descriptorFamilyName d /= ""]
   where
     descriptorOf Font { _fontHeader = Just hdr
                       , _fontNames = Just names} =

@@ -20,18 +20,20 @@ 
 -- | Type representing a font.
 data Font = Font
-    { _fontOffsetTable       :: !OffsetTable
-    , _fontTables            :: ![(B.ByteString, B.ByteString)]
-    , _fontNames             :: Maybe NameTable
-    , _fontHeader            :: Maybe FontHeader
-    , _fontMaxp              :: Maybe MaxpTable
-    , _fontMap               :: Maybe CharacterMaps
-    , _fontGlyph             :: Maybe (V.Vector Glyph)
-    , _fontLoca              :: Maybe (VU.Vector Word32)
-    , _fontHorizontalHeader  :: Maybe HorizontalHeader
-    , _fontHorizontalMetrics :: Maybe HorizontalMetricsTable
-    }
-    deriving (Show)
+ { -- | Field discribing various offsets/positions of table
+   -- inside the font file. Not available for reading.
+   _fontOffsetTable       :: !OffsetTable
+ , _fontTables            :: ![(B.ByteString, B.ByteString)]
+ , _fontNames             :: Maybe NameTable
+ , _fontHeader            :: Maybe FontHeader
+ , _fontMaxp              :: Maybe MaxpTable
+ , _fontMap               :: Maybe CharacterMaps
+ , _fontGlyph             :: Maybe (V.Vector Glyph)
+ , _fontLoca              :: Maybe (VU.Vector Word32)
+ , _fontHorizontalHeader  :: Maybe HorizontalHeader
+ , _fontHorizontalMetrics :: Maybe HorizontalMetricsTable
+ }
+ deriving (Show)
 
 instance NFData Font where
     rnf font =

@@ -51,6 +51,7 @@     let bitAt = testBit styleWord
     return $ FontStyle (bitAt 0) (bitAt 1)
 
+-- | Font header
 data FontHeader = FontHeader
     { -- | Table version number	0x00010000 for version 1.0.
       _fHdrVersionNumber    :: !Fixed
@@ -113,6 +114,7 @@             g64 = getWord64be
 
 
+-- | Header flags.
 data HeaderFlags = HeaderFlags
     { -- | Bit 0 - baseline for font at y=0;
       _hfBaselineY0           :: !Bool

@@ -23,6 +23,7 @@ 
 import Graphics.Text.TrueType.Types
 
+-- | Describe the "hhea" TrueType table.
 data HorizontalHeader = HorizontalHeader
     { -- | Distance from baseline of highest ascender
       _hheaAscent  :: {-# UNPACK #-} !FWord
@@ -86,6 +87,7 @@     startHdr <$> (fromIntegral <$> getWord16be)
              <*> getWord16be
 
+-- | Information of horizontal advance.
 data HorizontalMetric = HorizontalMetric
     { _hmtxAdvanceWidth    :: {-# UNPACK #-} !Word16
     , _hmtxLeftSideBearing :: {-# UNPACK #-} !Int16
@@ -99,6 +101,8 @@     get = HorizontalMetric <$> g16 <*> (fromIntegral <$> g16)
       where g16 = getWord16be
 
+-- | For every glyph (indexed by the glyph index),
+-- provide horizontal information.
 data HorizontalMetricsTable = HorizontalMetricsTable
     { _glyphMetrics :: !(V.Vector HorizontalMetric)
     }

@@ -0,0 +1,21 @@+-- | This module provide internal access to many structure,
+-- not exported by default. The stability of this module is
+-- absolutely not insured.
+module Graphics.Text.TrueType.Internal
+    ( Font( .. )
+    , FontHeader( .. )
+    , HeaderFlags( .. )
+    , HorizontalHeader( .. )
+    , HorizontalMetric( .. )
+    , HorizontalMetricsTable( .. )
+    , MaxpTable( .. )
+    , FWord( .. )
+    , Fixed( .. )
+    ) where
+
+import Graphics.Text.TrueType.MaxpTable
+import Graphics.Text.TrueType.HorizontalInfo
+import Graphics.Text.TrueType.FontType
+import Graphics.Text.TrueType.Header
+import Graphics.Text.TrueType.Types
+

@@ -1,7 +1,7 @@ {-# LANGUAGE CPP #-}
 module Graphics.Text.TrueType.Types
-    ( Fixed
-    , FWord
+    ( Fixed( .. )
+    , FWord( .. )
     , F26Dot6( .. )
     ) where