FontyFruity 0.5.2 → 0.5.3

raw patch · 4 files changed

+354/−345 lines, 4 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• FontyFruity.cabal +2/−2
• changelog +4/−0
• src/Graphics/Text/TrueType/FontFolders.hs +17/−10
• src/Graphics/Text/TrueType/Glyph.hs +331/−333

@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                FontyFruity-version:             0.5.2+version:             0.5.3 synopsis:            A true type file format loader description:              A haskell Truetype file parser.@@ -28,7 +28,7 @@ Source-Repository this     Type:      git     Location:  https://github.com/Twinside/FontyFruity.git-    Tag:       v0.5.2+    Tag:       v0.5.3  library   exposed-modules: Graphics.Text.TrueType

@@ -1,5 +1,9 @@ -*-change-log-*- +v0.5.3 February 2016+ * Fix: bug when trying to scan a directory+ * Addition: exposing descriptorOf function+ * Enhancement: Made FontDescriptor strictier.  v0.5.2 August 2015  * Fix: GHC 7.4 compilation

@@ -5,6 +5,7 @@     , loadWindowsFontFolderList     , fontFolders     , findFont+    , descriptorOf     , FontCache( .. )     , FontDescriptor( .. )     , emptyFontCache@@ -119,9 +120,9 @@ -- in a font cache. data FontDescriptor = FontDescriptor     { -- | The family name of the font-      _descriptorFamilyName :: T.Text+      _descriptorFamilyName :: !T.Text       -- | The desired style-    , _descriptorStyle :: FontStyle+    , _descriptorStyle :: !FontStyle     }     deriving (Eq, Ord, Show) @@ -173,6 +174,15 @@ enumerateFonts :: FontCache -> [FontDescriptor] enumerateFonts (FontCache fs) = M.keys fs ++-- | If possible, returns a descriptor of the Font.+descriptorOf :: Font -> Maybe FontDescriptor+descriptorOf font = do+  hdr <- _fontHeader font+  names <- _fontNames font+  return $ FontDescriptor (fontFamilyName names) (_fHdrMacStyle hdr)++ -- | Look in the system's folder for usable fonts. buildFontCache :: (FilePath -> IO (Maybe Font)) -> IO FontCache buildFontCache loader = do@@ -182,12 +192,6 @@          $ M.fromList [(d, path) | (Just d, path) <- found                                  , _descriptorFamilyName d /= ""]   where-    descriptorOf Font { _fontHeader = Just hdr-                      , _fontNames = Just names} =-        Just $ FontDescriptor (fontFamilyName names)-                              (_fHdrMacStyle hdr)-    descriptorOf _ = Nothing-     build [] = return []     build ((".", _):rest) = build rest     build (("..", _):rest) = build rest@@ -234,6 +238,9 @@         subRez <- searchIn [(s, n </> s) | s <- sub]         findOrRest subRez       else do-        font <- loader n-        findOrRest $ font >>= isMatching n+        isFile <- doesFileExist n+        if isFile then do+          font <- loader n+          findOrRest $ font >>= isMatching n+        else searchIn rest 

@@ -1,333 +1,331 @@-{-# LANGUAGE TupleSections #-}
-{-# LANGUAGE CPP #-}
-module Graphics.Text.TrueType.Glyph
-    ( GlyphHeader( .. )
-    , GlyphContour( .. )
-    , CompositeScaling( .. )
-    , GlyphComposition( .. )
-    , GlyphContent( .. )
-    , Glyph( .. )
-    , GlyphFlag( .. )
-    , extractFlatOutline
-    , emptyGlyph
-    ) where
-
-#if !MIN_VERSION_base(4,8,0)
-import Data.Monoid( mempty )
-import Control.Applicative( (<*>) )
-#endif
-
-import Control.Applicative( (<$>) )
-
-import Control.DeepSeq
-import Data.Bits( setBit, testBit, shiftL )
-import Data.Int( Int16 )
-import Data.List( mapAccumL, mapAccumR, zip4 )
-import Data.Word( Word8, Word16 )
-import Data.Binary( Binary( .. ) )
-import Data.Binary.Get( Get
-                      , getWord8
-                      , getWord16be )
-
-import Data.Binary.Put( putWord8, putWord16be )
-import Data.Tuple( swap )
-
-import qualified Data.Vector as V
-import qualified Data.Vector.Unboxed as VU
-
-{-import Text.Printf-}
-{-import Debug.Trace-}
-
-data GlyphHeader = GlyphHeader
-    { -- | If the number of contours is greater than or equal
-      -- to zero, this is a single glyph; if negative, this is
-      -- a composite glyph.
-      _glfNumberOfContours :: {-# UNPACK #-} !Int16
-      -- | Minimum x for coordinate data.
-    , _glfXMin             :: {-# UNPACK #-} !Int16
-      -- | Minimum y for coordinate data.
-    , _glfYMin             :: {-# UNPACK #-} !Int16
-      -- | Maximum x for coordinate data.
-    , _glfXMax             :: {-# UNPACK #-} !Int16
-      -- | Maximum y for coordinate data.
-    , _glfYMax             :: {-# UNPACK #-} !Int16
-    }
-    deriving (Eq, Show)
-
-instance NFData GlyphHeader where
-  rnf (GlyphHeader {}) = ()
-
-emptyGlyphHeader :: GlyphHeader
-emptyGlyphHeader = GlyphHeader 0 0 0 0 0
-
-instance Binary GlyphHeader where
-    get = GlyphHeader <$> g16 <*> g16 <*> g16 <*> g16 <*> g16
-      where g16 = fromIntegral <$> getWord16be
-
-    put (GlyphHeader count xmini ymini xmaxi ymaxi) =
-        p16 count >> p16 xmini >> p16 ymini >> p16 xmaxi >> p16 ymaxi
-      where p16 = putWord16be . fromIntegral
-
-data GlyphContour = GlyphContour
-    { _glyphInstructions :: !(VU.Vector Word8)
-    , _glyphFlags        :: ![GlyphFlag]
-    , _glyphPoints       :: ![VU.Vector (Int16, Int16)]
-    }
-    deriving (Eq, Show)
-
-instance NFData GlyphContour where
-    rnf (GlyphContour instr fl points) =
-        instr `seq` fl `seq` points `seq` ()
-
--- | Transformation matrix used to transform composite
--- glyph
---
--- @
---   | a b c |
---   | d e f |
--- @
---
-data CompositeScaling = CompositeScaling
-    { _a :: {-# UNPACK #-} !Int16 -- ^ a coeff.
-    , _b :: {-# UNPACK #-} !Int16 -- ^ b coeff.
-    , _c :: {-# UNPACK #-} !Int16 -- ^ c coeff.
-    , _d :: {-# UNPACK #-} !Int16 -- ^ d coeff.
-    , _e :: {-# UNPACK #-} !Int16 -- ^ e coeff.
-    , _f :: {-# UNPACK #-} !Int16 -- ^ f coeff.
-    }
-    deriving (Eq, Show)
-
-data GlyphComposition = GlyphComposition
-    { _glyphCompositeFlag    :: {-# UNPACK #-} !Word16
-    , _glyphCompositeIndex   :: {-# UNPACK #-} !Word16
-    , _glyphCompositionArg   :: {-# UNPACK #-} !(Int16, Int16)
-    , _glyphCompositionScale :: !CompositeScaling
-    }
-    deriving (Eq, Show)
-
-data GlyphContent
-    = GlyphEmpty
-    | GlyphSimple    !GlyphContour
-    | GlyphComposite !(V.Vector GlyphComposition) !(VU.Vector Word8)
-    deriving (Eq, Show)
-
-data Glyph = Glyph
-    { _glyphHeader  :: !GlyphHeader
-    , _glyphContent :: !GlyphContent
-    }
-    deriving (Eq, Show)
-
-instance NFData Glyph where
-  rnf (Glyph hdr cont) =
-      rnf hdr `seq` cont `seq` ()
-
-emptyGlyph :: Glyph
-emptyGlyph = Glyph emptyGlyphHeader GlyphEmpty
-
-getCompositeOutline :: Get GlyphContent
-getCompositeOutline =
-    (\(instr, vals) -> GlyphComposite (V.fromList vals) instr) <$> go
-  where
-    go = do
-      flag <- getWord16be
-      index <- getWord16be
-      args <- fetchArguments flag
-      scaling <- fetchScaling flag
-      let fullScaling = fetchOffset scaling args flag
-          value = GlyphComposition flag index args fullScaling
-
-      if flag `testBit` mORE_COMPONENTS then
-          (\(instr, acc) -> (instr, value : acc )) <$> go
-      else
-        if flag `testBit` wE_HAVE_INSTRUCTIONS then do
-            count <- fromIntegral <$> getWord16be
-            (, [value]) <$> VU.replicateM count getWord8
-        else
-            return (mempty, [value])
-
-
-    fetchArguments flag
-        | flag `testBit` aRG_1_AND_2_ARE_WORDS =
-            (,) <$> getInt16be <*> getInt16be
-        | otherwise =
-            (,) <$> getInt8 <*> getInt8
-
-    fetchScaling flag
-        | flag `testBit` wE_HAVE_A_SCALE =
-            (\v -> CompositeScaling v 0 0 v) <$> getF2Dot14
-        | flag `testBit` wE_HAVE_AN_X_AND_Y_SCALE =
-            (\x y -> CompositeScaling x 0 0 y) <$> getF2Dot14 <*> getF2Dot14
-        | flag `testBit` wE_HAVE_A_TWO_BY_TWO =
-            CompositeScaling <$> getF2Dot14 <*> getF2Dot14
-                             <*> getF2Dot14 <*> getF2Dot14
-        | otherwise = return $ CompositeScaling one 0 0 one
-           where one = 1 `shiftL` 14
-
-    fetchOffset scaling (a1, a2) flag
-        | flag `testBit` aRGS_ARE_XY_VALUES = scaling a1 a2
-        | otherwise = scaling 0 0 -- TODO fix this crap
-
-    {--
-    if (!ARGS_ARE_XY_VALUES)
-        1st short contains the index of matching point in compound being constructed
-        2nd short contains index of matching point in component -}
-
-    getInt16be = fromIntegral <$> getWord16be
-    getF2Dot14 = fromIntegral <$> getWord16be
-    getInt8 = fixByteSign . fromIntegral <$> getWord8
-
-    fixByteSign value = if value >= 0x80 then value - 0x100 else value
-
-    aRG_1_AND_2_ARE_WORDS  = 0
-    aRGS_ARE_XY_VALUES  = 1
-    {-rOUND_XY_TO_GRID  = 2-}
-    wE_HAVE_A_SCALE  = 3
-    {-rESERVED  = 4-}
-    mORE_COMPONENTS  = 5
-    wE_HAVE_AN_X_AND_Y_SCALE  = 6
-    wE_HAVE_A_TWO_BY_TWO  = 7
-    wE_HAVE_INSTRUCTIONS  = 8
-    {-uSE_MY_METRICS  = 9-}
-    {-oVERLAP_COMPOUND  = 10-}
-    {-sCALED_COMPONENT_OFFSET  = 11-}
-    {-uNSCALED_COMPONENT_OFFSET = 12-}
-
-data GlyphFlag = GlyphFlag
-    { -- | If set, the point is on the curve;
-      -- otherwise, it is off the curve.
-      _flagOnCurve :: !Bool
-      -- | If set, the corresponding x-coordinate is 1
-      -- byte long. If not set, 2 bytes.
-    , _flagXshort  :: !Bool
-      -- | If set, the corresponding y-coordinate is 1
-      -- byte long. If not set, 2 bytes.
-    , _flagYShort  :: !Bool
-      -- | If set, the next byte specifies the number of additional
-      -- times this set of flags is to be repeated. In this way, the
-      -- number of flags listed can be smaller than the number of
-      -- points in a character.
-    , _flagRepeat  :: !Bool
-      -- | This flag has two meanings, depending on how the x-Short
-      -- Vector flag is set. If x-Short Vector is set, this bit
-      -- describes the sign of the value, with 1 equalling positive and
-      -- 0 negative. If the x-Short Vector bit is not set and this bit is set,
-      -- then the current x-coordinate is the same as the previous x-coordinate.
-      -- If the x-Short Vector bit is not set and this bit is also not set, the
-      -- current x-coordinate is a signed 16-bit delta vector.
-    , _flagXSame   :: !Bool
-      -- | This flag has two meanings, depending on how the y-Short Vector flag
-      -- is set. If y-Short Vector is set, this bit describes the sign of the
-      -- value, with 1 equalling positive and 0 negative. If the y-Short Vector
-      -- bit is not set and this bit is set, then the current y-coordinate is the
-      -- same as the previous y-coordinate. If the y-Short Vector bit is not set
-      -- and this bit is also not set, the current y-coordinate is a signed
-      -- 16-bit delta vector.
-    , _flagYSame   :: !Bool
-    }
-    deriving (Eq, Show)
-
-instance Binary GlyphFlag where
-    put (GlyphFlag a0 a1 a2 a3 a4 a5) =
-        putWord8 . foldl setter 0 $ zip [0..] [a0, a1, a2, a3, a4, a5]
-      where setter v ( _, False) = v
-            setter v (ix, True) = setBit v ix
-    get = do
-      tester <- testBit <$> getWord8
-      return GlyphFlag
-        { _flagOnCurve = tester 0
-        , _flagXshort  = tester 1
-        , _flagYShort  = tester 2
-        , _flagRepeat  = tester 3
-        , _flagXSame   = tester 4
-        , _flagYSame   = tester 5
-        }
-
-getGlyphFlags :: Int -> Get [GlyphFlag]
-getGlyphFlags count = go 0
-  where
-    go n | n >= count = return []
-    go n = do
-      flag <- get
-      if _flagRepeat flag
-        then do
-          repeatCount <- fromIntegral <$> getWord8
-          let real = min (count - n) (repeatCount + 1)
-          (replicate real flag ++) <$> go (n + real)
-        else (flag :) <$> go (n + 1)
-
-getCoords :: [GlyphFlag] -> Get (VU.Vector (Int16, Int16))
-getCoords flags =
-    VU.fromList <$> (zip <$> go (_flagXSame, _flagXshort) 0 flags
-                         <*> go (_flagYSame, _flagYShort) 0 flags)
-  where
-    go _ _ [] = return []
-    go axx@(isSame, isShort) prevCoord (flag:flagRest) = do
-        let fetcher
-              | isShort flag && isSame flag =
-                  (prevCoord +) . fromIntegral <$> getWord8
-              | isShort flag = 
-                  (prevCoord - ) . fromIntegral <$> getWord8
-              | isSame flag =
-                  return prevCoord
-              | otherwise =
-                  (prevCoord +) . fromIntegral <$> getWord16be
-
-        newCoord <- fetcher
-        (newCoord :) <$> go axx newCoord flagRest
-
-extractFlatOutline :: GlyphContour
-                   -> [VU.Vector (Int16, Int16)]
-extractFlatOutline contour = zipWith (curry go) flagGroup coords
-  where
-    allFlags = _glyphFlags contour
-    coords = _glyphPoints contour
-    (_, flagGroup) =
-      mapAccumL (\acc v -> swap $ splitAt (VU.length v) acc) allFlags coords
-
-    go (flags, coord) 
-      | VU.null coord = mempty
-      | otherwise = VU.fromList . (firstPoint :) $ expand mixed
-      where
-       isOnSide = map _flagOnCurve flags
-       firstOnCurve = head isOnSide
-       lst@(firstPoint:xs) = VU.toList coord
-       mixed = zip4 isOnSide (tail isOnSide) lst xs
-       midPoint (x1, y1) (x2, y2) =
-           ((x1 + x2) `div` 2, (y1 + y2) `div` 2)
-
-       expand [] = []
-       expand [(onp, on, prevPoint, currPoint)]
-        | onp == on = (prevPoint `midPoint` currPoint) : endJunction
-        | otherwise = endJunction
-         where endJunction 
-                | on && firstOnCurve =
-                    [currPoint, currPoint `midPoint` firstPoint, firstPoint]
-                | otherwise = [currPoint, firstPoint]
-       expand ((onp, on, prevPoint, currPoint):rest)
-        | onp == on = prevPoint `midPoint` currPoint : currPoint : expand rest
-        | otherwise = currPoint : expand rest
-
-getSimpleOutline :: Int16 -> Get GlyphContent
-getSimpleOutline counterCount = do
-    endOfPoints <- VU.replicateM (fromIntegral counterCount) getWord16be
-    let pointCount = VU.last endOfPoints + 1
-    instructionCount <- fromIntegral <$> getWord16be
-    instructions <- VU.replicateM instructionCount getWord8
-
-    flags <- getGlyphFlags $ fromIntegral pointCount
-    GlyphSimple . GlyphContour instructions flags
-                . breakOutline endOfPoints <$> getCoords flags
-  where
-    prepender (v, lst) = v : lst
-    breakOutline endPoints coords =
-        prepender . mapAccumR breaker coords . VU.toList $ VU.init endPoints
-          where breaker array ix = VU.splitAt (fromIntegral ix + 1) array
-
-instance Binary Glyph where
-    put _ = fail "Glyph.put - unimplemented"
-    get = do
-      hdr <- get
-      case _glfNumberOfContours hdr of
-        -1 -> Glyph hdr <$> getCompositeOutline
-        n -> Glyph hdr <$> getSimpleOutline n
-
+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE CPP #-}+module Graphics.Text.TrueType.Glyph+    ( GlyphHeader( .. )+    , GlyphContour( .. )+    , CompositeScaling( .. )+    , GlyphComposition( .. )+    , GlyphContent( .. )+    , Glyph( .. )+    , GlyphFlag( .. )+    , extractFlatOutline+    , emptyGlyph+    ) where++#if !MIN_VERSION_base(4,8,0)+import Data.Monoid( mempty )+import Control.Applicative( (<*>), (<$>) )+#endif++import Control.DeepSeq+import Data.Bits( setBit, testBit, shiftL )+import Data.Int( Int16 )+import Data.List( mapAccumL, mapAccumR, zip4 )+import Data.Word( Word8, Word16 )+import Data.Binary( Binary( .. ) )+import Data.Binary.Get( Get+                      , getWord8+                      , getWord16be )++import Data.Binary.Put( putWord8, putWord16be )+import Data.Tuple( swap )++import qualified Data.Vector as V+import qualified Data.Vector.Unboxed as VU++{-import Text.Printf-}+{-import Debug.Trace-}++data GlyphHeader = GlyphHeader+    { -- | If the number of contours is greater than or equal+      -- to zero, this is a single glyph; if negative, this is+      -- a composite glyph.+      _glfNumberOfContours :: {-# UNPACK #-} !Int16+      -- | Minimum x for coordinate data.+    , _glfXMin             :: {-# UNPACK #-} !Int16+      -- | Minimum y for coordinate data.+    , _glfYMin             :: {-# UNPACK #-} !Int16+      -- | Maximum x for coordinate data.+    , _glfXMax             :: {-# UNPACK #-} !Int16+      -- | Maximum y for coordinate data.+    , _glfYMax             :: {-# UNPACK #-} !Int16+    }+    deriving (Eq, Show)++instance NFData GlyphHeader where+  rnf (GlyphHeader {}) = ()++emptyGlyphHeader :: GlyphHeader+emptyGlyphHeader = GlyphHeader 0 0 0 0 0++instance Binary GlyphHeader where+    get = GlyphHeader <$> g16 <*> g16 <*> g16 <*> g16 <*> g16+      where g16 = fromIntegral <$> getWord16be++    put (GlyphHeader count xmini ymini xmaxi ymaxi) =+        p16 count >> p16 xmini >> p16 ymini >> p16 xmaxi >> p16 ymaxi+      where p16 = putWord16be . fromIntegral++data GlyphContour = GlyphContour+    { _glyphInstructions :: !(VU.Vector Word8)+    , _glyphFlags        :: ![GlyphFlag]+    , _glyphPoints       :: ![VU.Vector (Int16, Int16)]+    }+    deriving (Eq, Show)++instance NFData GlyphContour where+    rnf (GlyphContour instr fl points) =+        instr `seq` fl `seq` points `seq` ()++-- | Transformation matrix used to transform composite+-- glyph+--+-- @+--   | a b c |+--   | d e f |+-- @+--+data CompositeScaling = CompositeScaling+    { _a :: {-# UNPACK #-} !Int16 -- ^ a coeff.+    , _b :: {-# UNPACK #-} !Int16 -- ^ b coeff.+    , _c :: {-# UNPACK #-} !Int16 -- ^ c coeff.+    , _d :: {-# UNPACK #-} !Int16 -- ^ d coeff.+    , _e :: {-# UNPACK #-} !Int16 -- ^ e coeff.+    , _f :: {-# UNPACK #-} !Int16 -- ^ f coeff.+    }+    deriving (Eq, Show)++data GlyphComposition = GlyphComposition+    { _glyphCompositeFlag    :: {-# UNPACK #-} !Word16+    , _glyphCompositeIndex   :: {-# UNPACK #-} !Word16+    , _glyphCompositionArg   :: {-# UNPACK #-} !(Int16, Int16)+    , _glyphCompositionScale :: !CompositeScaling+    }+    deriving (Eq, Show)++data GlyphContent+    = GlyphEmpty+    | GlyphSimple    !GlyphContour+    | GlyphComposite !(V.Vector GlyphComposition) !(VU.Vector Word8)+    deriving (Eq, Show)++data Glyph = Glyph+    { _glyphHeader  :: !GlyphHeader+    , _glyphContent :: !GlyphContent+    }+    deriving (Eq, Show)++instance NFData Glyph where+  rnf (Glyph hdr cont) =+      rnf hdr `seq` cont `seq` ()++emptyGlyph :: Glyph+emptyGlyph = Glyph emptyGlyphHeader GlyphEmpty++getCompositeOutline :: Get GlyphContent+getCompositeOutline =+    (\(instr, vals) -> GlyphComposite (V.fromList vals) instr) <$> go+  where+    go = do+      flag <- getWord16be+      index <- getWord16be+      args <- fetchArguments flag+      scaling <- fetchScaling flag+      let fullScaling = fetchOffset scaling args flag+          value = GlyphComposition flag index args fullScaling++      if flag `testBit` mORE_COMPONENTS then+          (\(instr, acc) -> (instr, value : acc )) <$> go+      else+        if flag `testBit` wE_HAVE_INSTRUCTIONS then do+            count <- fromIntegral <$> getWord16be+            (, [value]) <$> VU.replicateM count getWord8+        else+            return (mempty, [value])+++    fetchArguments flag+        | flag `testBit` aRG_1_AND_2_ARE_WORDS =+            (,) <$> getInt16be <*> getInt16be+        | otherwise =+            (,) <$> getInt8 <*> getInt8++    fetchScaling flag+        | flag `testBit` wE_HAVE_A_SCALE =+            (\v -> CompositeScaling v 0 0 v) <$> getF2Dot14+        | flag `testBit` wE_HAVE_AN_X_AND_Y_SCALE =+            (\x y -> CompositeScaling x 0 0 y) <$> getF2Dot14 <*> getF2Dot14+        | flag `testBit` wE_HAVE_A_TWO_BY_TWO =+            CompositeScaling <$> getF2Dot14 <*> getF2Dot14+                             <*> getF2Dot14 <*> getF2Dot14+        | otherwise = return $ CompositeScaling one 0 0 one+           where one = 1 `shiftL` 14++    fetchOffset scaling (a1, a2) flag+        | flag `testBit` aRGS_ARE_XY_VALUES = scaling a1 a2+        | otherwise = scaling 0 0 -- TODO fix this crap++    {--+    if (!ARGS_ARE_XY_VALUES)+        1st short contains the index of matching point in compound being constructed+        2nd short contains index of matching point in component -}++    getInt16be = fromIntegral <$> getWord16be+    getF2Dot14 = fromIntegral <$> getWord16be+    getInt8 = fixByteSign . fromIntegral <$> getWord8++    fixByteSign value = if value >= 0x80 then value - 0x100 else value++    aRG_1_AND_2_ARE_WORDS  = 0+    aRGS_ARE_XY_VALUES  = 1+    {-rOUND_XY_TO_GRID  = 2-}+    wE_HAVE_A_SCALE  = 3+    {-rESERVED  = 4-}+    mORE_COMPONENTS  = 5+    wE_HAVE_AN_X_AND_Y_SCALE  = 6+    wE_HAVE_A_TWO_BY_TWO  = 7+    wE_HAVE_INSTRUCTIONS  = 8+    {-uSE_MY_METRICS  = 9-}+    {-oVERLAP_COMPOUND  = 10-}+    {-sCALED_COMPONENT_OFFSET  = 11-}+    {-uNSCALED_COMPONENT_OFFSET = 12-}++data GlyphFlag = GlyphFlag+    { -- | If set, the point is on the curve;+      -- otherwise, it is off the curve.+      _flagOnCurve :: !Bool+      -- | If set, the corresponding x-coordinate is 1+      -- byte long. If not set, 2 bytes.+    , _flagXshort  :: !Bool+      -- | If set, the corresponding y-coordinate is 1+      -- byte long. If not set, 2 bytes.+    , _flagYShort  :: !Bool+      -- | If set, the next byte specifies the number of additional+      -- times this set of flags is to be repeated. In this way, the+      -- number of flags listed can be smaller than the number of+      -- points in a character.+    , _flagRepeat  :: !Bool+      -- | This flag has two meanings, depending on how the x-Short+      -- Vector flag is set. If x-Short Vector is set, this bit+      -- describes the sign of the value, with 1 equalling positive and+      -- 0 negative. If the x-Short Vector bit is not set and this bit is set,+      -- then the current x-coordinate is the same as the previous x-coordinate.+      -- If the x-Short Vector bit is not set and this bit is also not set, the+      -- current x-coordinate is a signed 16-bit delta vector.+    , _flagXSame   :: !Bool+      -- | This flag has two meanings, depending on how the y-Short Vector flag+      -- is set. If y-Short Vector is set, this bit describes the sign of the+      -- value, with 1 equalling positive and 0 negative. If the y-Short Vector+      -- bit is not set and this bit is set, then the current y-coordinate is the+      -- same as the previous y-coordinate. If the y-Short Vector bit is not set+      -- and this bit is also not set, the current y-coordinate is a signed+      -- 16-bit delta vector.+    , _flagYSame   :: !Bool+    }+    deriving (Eq, Show)++instance Binary GlyphFlag where+    put (GlyphFlag a0 a1 a2 a3 a4 a5) =+        putWord8 . foldl setter 0 $ zip [0..] [a0, a1, a2, a3, a4, a5]+      where setter v ( _, False) = v+            setter v (ix, True) = setBit v ix+    get = do+      tester <- testBit <$> getWord8+      return GlyphFlag+        { _flagOnCurve = tester 0+        , _flagXshort  = tester 1+        , _flagYShort  = tester 2+        , _flagRepeat  = tester 3+        , _flagXSame   = tester 4+        , _flagYSame   = tester 5+        }++getGlyphFlags :: Int -> Get [GlyphFlag]+getGlyphFlags count = go 0+  where+    go n | n >= count = return []+    go n = do+      flag <- get+      if _flagRepeat flag+        then do+          repeatCount <- fromIntegral <$> getWord8+          let real = min (count - n) (repeatCount + 1)+          (replicate real flag ++) <$> go (n + real)+        else (flag :) <$> go (n + 1)++getCoords :: [GlyphFlag] -> Get (VU.Vector (Int16, Int16))+getCoords flags =+    VU.fromList <$> (zip <$> go (_flagXSame, _flagXshort) 0 flags+                         <*> go (_flagYSame, _flagYShort) 0 flags)+  where+    go _ _ [] = return []+    go axx@(isSame, isShort) prevCoord (flag:flagRest) = do+        let fetcher+              | isShort flag && isSame flag =+                  (prevCoord +) . fromIntegral <$> getWord8+              | isShort flag = +                  (prevCoord - ) . fromIntegral <$> getWord8+              | isSame flag =+                  return prevCoord+              | otherwise =+                  (prevCoord +) . fromIntegral <$> getWord16be++        newCoord <- fetcher+        (newCoord :) <$> go axx newCoord flagRest++extractFlatOutline :: GlyphContour+                   -> [VU.Vector (Int16, Int16)]+extractFlatOutline contour = zipWith (curry go) flagGroup coords+  where+    allFlags = _glyphFlags contour+    coords = _glyphPoints contour+    (_, flagGroup) =+      mapAccumL (\acc v -> swap $ splitAt (VU.length v) acc) allFlags coords++    go (flags, coord) +      | VU.null coord = mempty+      | otherwise = VU.fromList . (firstPoint :) $ expand mixed+      where+       isOnSide = map _flagOnCurve flags+       firstOnCurve = head isOnSide+       lst@(firstPoint:xs) = VU.toList coord+       mixed = zip4 isOnSide (tail isOnSide) lst xs+       midPoint (x1, y1) (x2, y2) =+           ((x1 + x2) `div` 2, (y1 + y2) `div` 2)++       expand [] = []+       expand [(onp, on, prevPoint, currPoint)]+        | onp == on = (prevPoint `midPoint` currPoint) : endJunction+        | otherwise = endJunction+         where endJunction +                | on && firstOnCurve =+                    [currPoint, currPoint `midPoint` firstPoint, firstPoint]+                | otherwise = [currPoint, firstPoint]+       expand ((onp, on, prevPoint, currPoint):rest)+        | onp == on = prevPoint `midPoint` currPoint : currPoint : expand rest+        | otherwise = currPoint : expand rest++getSimpleOutline :: Int16 -> Get GlyphContent+getSimpleOutline counterCount = do+    endOfPoints <- VU.replicateM (fromIntegral counterCount) getWord16be+    let pointCount = VU.last endOfPoints + 1+    instructionCount <- fromIntegral <$> getWord16be+    instructions <- VU.replicateM instructionCount getWord8++    flags <- getGlyphFlags $ fromIntegral pointCount+    GlyphSimple . GlyphContour instructions flags+                . breakOutline endOfPoints <$> getCoords flags+  where+    prepender (v, lst) = v : lst+    breakOutline endPoints coords =+        prepender . mapAccumR breaker coords . VU.toList $ VU.init endPoints+          where breaker array ix = VU.splitAt (fromIntegral ix + 1) array++instance Binary Glyph where+    put _ = fail "Glyph.put - unimplemented"+    get = do+      hdr <- get+      case _glfNumberOfContours hdr of+        -1 -> Glyph hdr <$> getCompositeOutline+        n -> Glyph hdr <$> getSimpleOutline n+